*IF DEF,CONTROL,OR,DEF,COMB,OR,DEF,PICK,OR,DEF,HPRT READHIS1.2
C ******************************COPYRIGHT****************************** GTS2F400.8047
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.8048
C GTS2F400.8049
C Use, duplication or disclosure of this code is subject to the GTS2F400.8050
C restrictions as set forth in the contract. GTS2F400.8051
C GTS2F400.8052
C Meteorological Office GTS2F400.8053
C London Road GTS2F400.8054
C BRACKNELL GTS2F400.8055
C Berkshire UK GTS2F400.8056
C RG12 2SZ GTS2F400.8057
C GTS2F400.8058
C If no contract has been raised with this copy of the code, the use, GTS2F400.8059
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.8060
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.8061
C Modelling at the above address. GTS2F400.8062
C ******************************COPYRIGHT****************************** GTS2F400.8063
C GTS2F400.8064
CLL Routine: READHIST READHIS1.3
CLL READHIS1.4
CLL Purpose: To initialise History common block from most recent GRB1F305.416
CLL record in history file input GRB1F305.417
CLL READHIS1.7
CLL Tested under compiler: cft77 READHIS1.8
CLL Tested under OS version: UNICOS 5.0 READHIS1.9
CLL READHIS1.10
CLL Author: A.Sangster READHIS1.11
CLL READHIS1.12
CLL Model Modification history from model version 3.0: READHIS1.13
CLL version date READHIS1.14
CLL AD050293.77
CLL 3.1 05/02/93 Portable Fortran unit no assigns AD050293.78
CLL Author: A. Dickinson Reviewer: R. Stratton AD050293.79
CLL 3.2 13/07/93 Changed CHARACTER*(*) to CHARACTER*(80) for TS150793.156
CLL portability. Author Tracey Smith. TS150793.157
CLL 3.5 06/04/95 Sub-Models stage 1: revise History and Control file GRB1F305.418
CLL contents. RTHBarnes. GRB1F305.419
CLL READHIS1.15
CLL Programming standard: UM Doc Paper 3, draft version 3 (15/1/90) READHIS1.16
CLL READHIS1.17
CLL Logical components covered: H2,H20 READHIS1.18
CLL READHIS1.19
CLL Project task: H READHIS1.20
CLL READHIS1.21
CLL Documentation: Unified Model Documentation Paper READHIS1.22
CLL H- History Bricks READHIS1.23
CLL READHIS1.25
C READHIS1.26
C*L Interface and arguments: READHIS1.27
C READHIS1.28
SUBROUTINE READHIST 4,2READHIS1.29
* ( UNITHIST,ICODE,CMESSAGE ) READHIS1.30
C READHIS1.31
IMPLICIT NONE READHIS1.32
C READHIS1.33
INTEGER UNITHIST ! In - History file unit GRB1F305.420
INTEGER ICODE ! Out - Return code from routine READHIS1.35
CHARACTER*80 CMESSAGE ! Out - Return message if failure occured GRB1F305.421
C* READHIS1.37
C READHIS1.38
CL Common blocks READHIS1.39
C READHIS1.40
*CALL CSUBMODL 
GRB1F305.422
*CALL CHSUNITS GRB1F305.423
*CALL CHISTORY READHIS1.41
C READHIS1.42
CHARACTER*80 FILENAME AD050293.80
CHARACTER*8 NLNAME GRB1F305.424
C*L EXTERNAL subroutines called READHIS1.43
EXTERNAL INITCHST,GET_FILE AD050293.81
C* READHIS1.45
CL READHIS1.46
CL 1. Set common block area to zero or blank READHIS1.47
CL READHIS1.48
CALL INITCHST READHIS1.49
ICODE = 0 GRB1F305.425
CL READHIS1.50
CL 2. Open history file and rewind GRB1F305.426
CL READHIS1.52
CALL GET_FILE(UNITHIST,FILENAME,80,ICODE) GTD0F400.166
OPEN(UNITHIST,FILE=FILENAME,FORM='FORMATTED',IOSTAT=ICODE, PXNAMLST.10
& DELIM='APOSTROPHE') PXNAMLST.11
C READHIS1.55
C Check for error READHIS1.56
C READHIS1.57
IF(ICODE .GT.0)THEN READHIS1.58
CMESSAGE='READHIST: Failed in OPEN of permanent history file' READHIS1.59
GOTO 999 READHIS1.60
ELSEIF(ICODE .LT. 0)THEN READHIS1.61
WRITE(6,*)'READHIST: Warning message on OPEN of permanent history GIE0F403.584
* file' READHIS1.63
WRITE(6,*)'IOSTAT= ',ICODE GIE0F403.585
ENDIF READHIS1.65
C READHIS1.66
REWIND(UNITHIST) READHIS1.67
CL GRB1F305.428
CL 3. Read most recent records GRB1F305.429
CL GRB1F305.430
NLNAME = 'NLIHISTO' GRB1F305.431
READ(UNITHIST,NLIHISTO,END=100,ERR=200) GRB1F305.432
NLNAME = 'NLCHISTO' GRB1F305.433
READ(UNITHIST,NLCHISTO,END=100,ERR=200) GRB1F305.434
NLNAME = 'NLIHISTG' GRB1F305.435
READ(UNITHIST,NLIHISTG,END=100,ERR=200) GRB1F305.436
NLNAME = 'NLCHISTG' GRB1F305.437
READ(UNITHIST,NLCHISTG,END=100,ERR=200) GRB1F305.438
NLNAME = 'NLCFILES' GRB1F305.439
READ(UNITHIST,NLCFILES,END=100,ERR=200) GRB1F305.440
GRB1F305.441
go to 999 GRB1F305.442
C READHIS1.69
C Check for error READHIS1.70
C READHIS1.71
! End-of-file GRB1F305.443
100 continue GRB1F305.444
ICODE = 1 GRB1F305.445
CMESSAGE='READHIST: End of file in READ from history file for name GRB1F305.446
&list '//NLNAME GRB1F305.447
go to 999 GRB1F305.448
! Read error GRB1F305.449
200 continue GRB1F305.450
ICODE = 2 GRB1F305.451
CMESSAGE='READHIST: Read ERROR on history file for namelist '// GDR1F401.45
& NLNAME GRB1F305.453
C READHIS1.104
999 CONTINUE READHIS1.105
CL READHIS1.106
CL 4. Close and return READHIS1.107
CL READHIS1.108
CLOSE(UNITHIST) READHIS1.109
RETURN READHIS1.110
END READHIS1.111
*ENDIF READHIS1.112