*IF DEF,SETUP SETUP1.2
C ******************************COPYRIGHT****************************** GTS2F400.8767
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.8768
C GTS2F400.8769
C Use, duplication or disclosure of this code is subject to the GTS2F400.8770
C restrictions as set forth in the contract. GTS2F400.8771
C GTS2F400.8772
C Meteorological Office GTS2F400.8773
C London Road GTS2F400.8774
C BRACKNELL GTS2F400.8775
C Berkshire UK GTS2F400.8776
C RG12 2SZ GTS2F400.8777
C GTS2F400.8778
C If no contract has been raised with this copy of the code, the use, GTS2F400.8779
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.8780
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.8781
C Modelling at the above address. GTS2F400.8782
C ******************************COPYRIGHT****************************** GTS2F400.8783
C GTS2F400.8784
CLL Routine: SETUP-------------------------------------------------- SETUP1.3
CLL SETUP1.4
CLL Purpose: To create an Interim History File from the Master History URB1F305.46
CLL file namelist input and to create the associated SETUP1.6
CLL logical/physical filename lookup file for this run. SETUP1.7
CLL SETUP1.8
CLL Tested under compiler: cft77 SETUP1.9
CLL Tested under OS version: UNICOS 5.0 SETUP1.10
CLL SETUP1.11
CLL Author: A.Sangster SETUP1.12
CLL SETUP1.13
CLL Model Modification history from model version 3.0: SETUP1.14
CLL version date SETUP1.15
CLL 3.1 29/01/93 : Added CHSUNITS to list of comdecks to define RS030293.62
CLL nunits for i/o arrays. RS030293.63
CLL 3.4 17/06/94 *CALL CCONTROL added: declares logical switches GSS1F304.667
CLL which replace *DEFs LCAL360 passed to READHK URB1F305.47
CLL S.J.Swarbrick GSS1F304.670
CLL 3.5 30/04/95 Sub-models stage 1: History/control. RTHBarnes. URB1F305.48
CLL 4.5 10/11/98 Remove superfluous *CCONTROL and associated GRR2F405.62
CLL variables: this information is only available GRR2F405.63
CLL within the model and hence all such variables are GRR2F405.64
CLL uninitialised. R Rawlins GRR2F405.65
CLL SETUP1.16
CLL Programming standard: UM Doc Paper 3, draft version 3 (15/1/90) SETUP1.17
CLL SETUP1.18
CLL Logical components covered: H81 SETUP1.19
CLL SETUP1.20
CLL Project task: H SETUP1.21
CLL SETUP1.22
CLL Documentation: Unified Model Documentation Paper SETUP1.23
CLL H- History Bricks Version 5 18/6/90 SETUP1.24
CLL SETUP1.25
C*L Interface and arguments SETUP1.26
C SETUP1.27
PROGRAM SETUP ,5SETUP1.28
C SETUP1.29
IMPLICIT NONE SETUP1.30
C* SETUP1.31
C SETUP1.32
CL Common blocks SETUP1.33
C SETUP1.34
*CALL CSUBMODL 
URB1F305.49
*CALL CHSUNITS RS030293.64
*CALL CHISTORY URB1F305.50
C*L EXTERNAL subroutines called SETUP1.39
EXTERNAL INITCHST,READMHIS,TEMPHIST,WRITFTXX,EREPORT,ABORT URB1F305.51
C* SETUP1.41
C SETUP1.42
C Local variables SETUP1.43
C SETUP1.44
INTEGER IOERR SETUP1.45
INTEGER ICODE,IABORT ! Work- Return codes from called routines SETUP1.46
CHARACTER*80 CMESSAGE ! Work- Return message if failure occured URB1F305.52
CL SETUP1.48
CL 1. Set common block area to zero or blank SETUP1.49
CL SETUP1.50
CALL INITCHST SETUP1.51
CL SETUP1.52
CL 2. Read Master History file namelist information URB1F305.53
CL SETUP1.54
CALL READMHIS(MCTL_UNIT,ICODE,CMESSAGE) URB1F305.54
IF(ICODE .GT. 0) GOTO 999 SETUP1.56
C SETUP1.57
CL SETUP1.59
CL 3. Read Operational housekeeping file SETUP1.60
CL Transfer to model URB1F305.55
C SETUP1.77
CL SETUP1.78
CL 4. Write history common block data to Interim History File SETUP1.79
CL SETUP1.80
RUN_HIST_TYPE='Interim' SETUP1.81
CALL TEMPHIST(IHIST_UNIT,ICODE,CMESSAGE) SETUP1.82
IF(ICODE .GT. 0) GOTO 999 SETUP1.83
CL SETUP1.84
CL 5. Write logical/physical filename file SETUP1.85
CL SETUP1.86
CALL WRITFTXX(FTXX_UNIT,ICODE,CMESSAGE) SETUP1.87
IF(ICODE .GT. 0) GOTO 999 SETUP1.88
999 CONTINUE SETUP1.89
CL SETUP1.90
CL 6. Output error message if problem SETUP1.91
CL SETUP1.92
IABORT=ICODE SETUP1.93
IF(ICODE .NE. 0) CALL EREPORT(ICODE,CMESSAGE) SETUP1.94
CL SETUP1.95
CL 7. Stop and abort if error occured SETUP1.96
CL SETUP1.97
IF(IABORT .GT. 0)CALL ABORT SETUP1.98
STOP SETUP1.99
END SETUP1.100
*ENDIF SETUP1.101