*IF DEF,C70_1A,AND,-DEF,SCMA AJC0F405.268
C ******************************COPYRIGHT****************************** GTS2F400.12956
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.12957
C GTS2F400.12958
C Use, duplication or disclosure of this code is subject to the GTS2F400.12959
C restrictions as set forth in the contract. GTS2F400.12960
C GTS2F400.12961
C Meteorological Office GTS2F400.12962
C London Road GTS2F400.12963
C BRACKNELL GTS2F400.12964
C Berkshire UK GTS2F400.12965
C RG12 2SZ GTS2F400.12966
C GTS2F400.12967
C If no contract has been raised with this copy of the code, the use, GTS2F400.12968
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.12969
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.12970
C Modelling at the above address. GTS2F400.12971
C GTS2F400.12972
!+ Reads History & control files; also interim for CRUN and HK for Op. UMSETUP1.3
! UMSETUP1.4
! Subroutine Interface: UMSETUP1.5
SUBROUTINE UM_SETUP(ICODE,CMESSAGE) 1,9UMSETUP1.6
UMSETUP1.7
IMPLICIT NONE UMSETUP1.8
! UMSETUP1.9
! Description: UMSETUP1.10
! Reads History and control namelist files for all runs. UMSETUP1.11
! For CRUNs also reads interim control file of values changed by user. UMSETUP1.12
! For operational runs reads housekeeping file. UMSETUP1.13
! UMSETUP1.14
! Method: as above UMSETUP1.15
! UMSETUP1.16
! Current Code Owner: RTHBarnes. UMSETUP1.17
! UMSETUP1.18
! History: UMSETUP1.19
! Version Date Comment UMSETUP1.20
! ------- ---- ------- UMSETUP1.21
! 3.5 04/05/95 Sub-models stage 1: New routine. RTHBarnes. UMSETUP1.22
! 4.0 06/09/95 Add Timer stop section. RTHBarnes. GRB1F400.71
! 4.0 06/12/95 Check env.var. TYPE for CRUN as well as HSTEPim. RTHB GRB1F400.72
! 4.1 14/05/96 Change GETENV to more portable FORT_GET_ENV P.Burton GPB0F401.1
! 4.2 11/09/96 Remove EXTERNAL GET_ENV statement P.Burton APB1F402.18
! 4.5 23/10/98 Introduce Single Column Model. J-C Thil. AJC0F405.267
! UMSETUP1.23
! Code Description: UMSETUP1.24
! Language: FORTRAN 77 + common extensions. UMSETUP1.25
! This code is written to UMDP3 v6 programming standards. UMSETUP1.26
! UMSETUP1.27
! System component covered: C0 UMSETUP1.28
! System Task: C0 UMSETUP1.29
! UMSETUP1.30
! Declarations: UMSETUP1.31
! UMSETUP1.32
! Global variables (*CALLed COMDECKs etc...): UMSETUP1.33
*CALL CSUBMODL 
UMSETUP1.34
*CALL CHSUNITS UMSETUP1.35
*CALL CHISTORY UMSETUP1.36
*CALL CCONTROL UMSETUP1.37
UMSETUP1.38
! Subroutine arguments UMSETUP1.39
! Scalar arguments with intent(in): UMSETUP1.40
! Array arguments with intent(in): UMSETUP1.41
! Scalar arguments with intent(InOut): UMSETUP1.42
! Array arguments with intent(InOut): UMSETUP1.43
! Scalar arguments with intent(out): UMSETUP1.44
Integer ICODE ! Error code UMSETUP1.45
Character*80 CMESSAGE ! Error message UMSETUP1.46
! Array arguments with intent(out): UMSETUP1.47
UMSETUP1.48
! Local parameters: UMSETUP1.49
UMSETUP1.50
! Local scalars: UMSETUP1.51
INTEGER I ! Loop variable UMSETUP1.52
INTEGER UNITICTL ! Unit no. for Interim Control file UMSETUP1.53
LOGICAL CRUN ! T if continuation run UMSETUP1.54
INTEGER J ! dummy for use with FORT_GET_ENV APB1F402.19
CHARACTER*4 TYPE ! Type of run - NRUN or CRUN GRB1F400.74
UMSETUP1.55
! Local dynamic arrays: UMSETUP1.56
UMSETUP1.57
! Function & Subroutine calls: UMSETUP1.58
External TIMER, READHIST, READCNTL, READHK, EREPORT, ABORT UMSETUP1.59
& ,FORT_GET_ENV APB1F402.20
UMSETUP1.60
!- End of header UMSETUP1.61
! UMSETUP1.62
! ---------------------------------------------------------------------- UMSETUP1.63
! 0. Start Timer running UMSETUP1.64
! UMSETUP1.65
CALL TIMER('UM_SETUP',3) UMSETUP1.66
ICODE=0 UMSETUP1.67
! ---------------------------------------------------------------------- UMSETUP1.68
! 1. Read History file. UMSETUP1.69
! UMSETUP1.70
CALL READHIST ( IHIST_UNIT,ICODE,CMESSAGE ) UMSETUP1.71
IF(ICODE .GT. 0) GOTO 999 UMSETUP1.72
UMSETUP1.73
! ---------------------------------------------------------------------- UMSETUP1.74
! 2. Read Control file on standard input. UMSETUP1.75
! UMSETUP1.76
CALL READCNTL ( 5,ICODE,CMESSAGE ) UMSETUP1.77
IF(ICODE .GT. 0) GOTO 999 UMSETUP1.78
UMSETUP1.79
! ---------------------------------------------------------------------- UMSETUP1.80
! 3. Read Interim Control file for CRUNs only. UMSETUP1.81
! UMSETUP1.82
CALL FORT_GET_ENV('TYPE',4,TYPE,4,J) GPB0F401.2
CRUN = .false. UMSETUP1.83
DO I = 1,N_INTERNAL_MODEL_MAX UMSETUP1.84
IF (H_STEPim(I) .gt. 0) THEN UMSETUP1.85
CRUN = .true. UMSETUP1.86
GO TO 300 UMSETUP1.87
END IF UMSETUP1.88
END DO UMSETUP1.89
300 CONTINUE UMSETUP1.90
IF (CRUN .or. TYPE.eq.'CRUN') THEN GRB1F400.77
WRITE(6,*)' UMSETUP; CRUN, read CONTCNTL from unit 9' GIE0F403.664
! Open and read Interim Control file UMSETUP1.92
UNITICTL = 9 UMSETUP1.93
CALL READCNTL ( UNITICTL,ICODE,CMESSAGE ) UMSETUP1.94
IF(ICODE .GT. 0) GOTO 999 UMSETUP1.95
CLOSE (UNITICTL) UMSETUP1.96
END IF UMSETUP1.97
UMSETUP1.98
! ---------------------------------------------------------------------- UMSETUP1.99
! 4. Read Housekeeping file for operational runs only. UMSETUP1.100
! UMSETUP1.101
IF(MODEL_STATUS .EQ. 'Operational') THEN UMSETUP1.102
CALL READHK(HKFILE_UNIT,ICODE,CMESSAGE) UMSETUP1.103
IF(ICODE .GT. 0) GOTO 999 UMSETUP1.104
END IF UMSETUP1.105
UMSETUP1.106
! ---------------------------------------------------------------------- UMSETUP1.107
! 5. Output any error/warning message and stop if error. UMSETUP1.108
! UMSETUP1.109
999 CONTINUE UMSETUP1.110
IF(ICODE .NE. 0) CALL EREPORT(ICODE,CMESSAGE) UMSETUP1.111
IF(ICODE .GT. 0) CALL ABORT UMSETUP1.112
GRB1F400.79
! ---------------------------------------------------------------------- GRB1F400.80
! 6. Stop Timer for this routine. GRB1F400.81
! GRB1F400.82
CALL TIMER('UM_SETUP',4) GRB1F400.83
UMSETUP1.113
RETURN UMSETUP1.114
END UMSETUP1.115
*ENDIF UMSETUP1.116