SUBROUTINE READMHIS( UNITHIST,ICODE,CMESSAGE ) 1,1READMHS1.6
READMHS1.7
IMPLICIT NONE READMHS1.8
! READMHS1.9
! Description: READMHS1.10
! Read master history namelist input file to set up history READMHS1.11
! common block variables READMHS1.12
! READMHS1.13
! Method: READMHS1.14
! READMHS1.15
! Current Code Owner: R.T.H.Barnes. READMHS1.16
! READMHS1.17
! History: READMHS1.18
! Version Date Comment READMHS1.19
! ------- ---- ------- READMHS1.20
! 3.5 23/05/95 Original code for submodels stage 1. Based on old READMHS1.21
! routine READMCTL. RTHBarnes. READMHS1.22
! 4.0 18/10/95 Add ICODE error return to GET_FILE call. RTHBarnes GRB2F400.10
! READMHS1.23
! Code Description: READMHS1.24
! Language: FORTRAN 77 + common extensions. READMHS1.25
! This code is written to UMDP3 v6 programming standards. READMHS1.26
! READMHS1.27
! System component covered: <appropriate code> READMHS1.28
! System Task: <appropriate code> READMHS1.29
! READMHS1.30
! Declarations: READMHS1.31
! READMHS1.32
! Global variables (*CALLed COMDECKs etc...): READMHS1.33
*CALL CSUBMODL 
READMHS1.34
*CALL CHSUNITS READMHS1.35
*CALL CHISTORY READMHS1.36
READMHS1.37
! Subroutine arguments READMHS1.38
! Scalar arguments with intent(in): READMHS1.39
INTEGER UNITHIST ! IN - Master history file unit no. READMHS1.40
! Array arguments with intent(in): READMHS1.41
! Scalar arguments with intent(InOut): READMHS1.42
! Array arguments with intent(InOut): READMHS1.43
! Scalar arguments with intent(out): READMHS1.44
INTEGER ICODE ! Out - Return code from routine READMHS1.45
CHARACTER*80 CMESSAGE ! Out - Return message if failure occured READMHS1.46
! Array arguments with intent(out): READMHS1.47
READMHS1.48
! ErrorStatus <Delete if ErrorStatus not used> READMHS1.49
INTEGER ErrorStatus ! Error flag (0 = OK) READMHS1.50
READMHS1.51
! Local parameters: READMHS1.52
READMHS1.53
! Local scalars: READMHS1.54
CHARACTER *80 FILENAME READMHS1.55
READMHS1.56
! Local dynamic arrays: READMHS1.57
READMHS1.58
! Function & Subroutine calls: READMHS1.59
External GET_FILE READMHS1.60
READMHS1.61
!- End of header READMHS1.62
CL READMHS1.63
CL 1. Read Master Control file namelist information READMHS1.64
CL READMHS1.65
CL NLIHISTO : Integer overall model history data READMHS1.66
CL NLCHISTO : Character overall model history data READMHS1.67
CL NLIHISTG : Integer generic model history data READMHS1.68
CL NLCHISTG : Character generic model history data READMHS1.69
CL NLCFILES : Character variables used for logical filenames READMHS1.70
CL READMHS1.71
CALL GET_FILE(UNITHIST,FILENAME,80,ICODE) GRB2F400.11
OPEN(UNITHIST,FILE=FILENAME,IOSTAT=ICODE,DELIM='APOSTROPHE') PXNAMLST.13
C READMHS1.74
C Check for error READMHS1.75
C READMHS1.76
IF(ICODE .GT.0)THEN READMHS1.77
CMESSAGE='READMHIS : Failed in OPEN of Master History File' READMHS1.78
GOTO 999 READMHS1.79
ELSEIF(ICODE .LT. 0)THEN READMHS1.80
WRITE(6,*)'READMHIS : GIE0F403.590
& Warning message on OPEN of Master History File' READMHS1.82
WRITE(6,*)'IOSTAT= ',ICODE GIE0F403.591
ENDIF READMHS1.84
C READMHS1.85
CMESSAGE='READMHIS: Problem reading namelist NLIHISTO' READMHS1.86
READ(UNITHIST,NLIHISTO,ERR=999) READMHS1.87
C READMHS1.88
CMESSAGE='READMHIS: Problem reading namelist NLCHISTO' READMHS1.89
READ(UNITHIST,NLCHISTO,ERR=999) READMHS1.90
C READMHS1.91
CMESSAGE='READMHIS: Problem reading namelist NLIHISTG' READMHS1.92
READ(UNITHIST,NLIHISTG,ERR=999) READMHS1.93
C READMHS1.94
CMESSAGE='READMHIS: Problem reading namelist NLCHISTG' READMHS1.95
READ(UNITHIST,NLCHISTG,ERR=999) READMHS1.96
C READMHS1.97
CMESSAGE='READMHIS: Problem reading namelist NLCFILES' READMHS1.98
READ(UNITHIST,NLCFILES,ERR=999) READMHS1.99
C READMHS1.100
C Normal return READMHS1.101
C READMHS1.102
ICODE=0 READMHS1.103
CMESSAGE='READMHIS: Normal return' READMHS1.104
RETURN READMHS1.105
C READMHS1.106
C Error return READMHS1.107
C READMHS1.108
999 ICODE=1 READMHS1.109
RETURN READMHS1.110
END READMHS1.111
*ENDIF READMHS1.112