*IF DEF,C80_1A,OR,DEF,UTILIO,OR,DEF,RECON UIE3F404.52
C ******************************COPYRIGHT****************************** GTS2F400.7993
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.7994
C GTS2F400.7995
C Use, duplication or disclosure of this code is subject to the GTS2F400.7996
C restrictions as set forth in the contract. GTS2F400.7997
C GTS2F400.7998
C Meteorological Office GTS2F400.7999
C London Road GTS2F400.8000
C BRACKNELL GTS2F400.8001
C Berkshire UK GTS2F400.8002
C RG12 2SZ GTS2F400.8003
C GTS2F400.8004
C If no contract has been raised with this copy of the code, the use, GTS2F400.8005
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.8006
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.8007
C Modelling at the above address. GTS2F400.8008
C ******************************COPYRIGHT****************************** GTS2F400.8009
C GTS2F400.8010
CLL SUBROUTINE READ_FLH -------------------------------------- READFH1A.3
CLL READFH1A.4
CLL Written by D. Robinson 17/06/92 READFH1A.5
CLL READFH1A.6
CLL Model Modification history from model version 3.0: READFH1A.7
CLL version date READFH1A.8
CLL 3.2 13/07/93 Changed CHARACTER*(*) to CHARACTER*(80) for TS150793.150
CLL portability. Author Tracey Smith. TS150793.151
CLL READFH1A.9
CLL Programming standard: Unified Model Documentation Paper No 3 READFH1A.10
CLL Version No 4 5/2/92 READFH1A.11
CLL READFH1A.12
CLL System component: R30 READFH1A.13
CLL READFH1A.14
CLL System task: F3 READFH1A.15
CLL READFH1A.16
CLL Purpose: READFH1A.17
CLL Reads in the fixed length header from file attached to READFH1A.18
CLL unit NFTIN. READFH1A.19
CLL READFH1A.20
CLL Documentation: READFH1A.21
CLL Unified Model Documentation Paper No F3 READFH1A.22
CLL Version No 5 9/2/90 READFH1A.23
CLL READFH1A.24
CLL------------------------------------------------------------ READFH1A.25
C*L Arguments:------------------------------------------------- READFH1A.26
SUBROUTINE READ_FLH (NFTIN,FIXHD,LEN_FIXHD, 15,2READFH1A.27
* ICODE,CMESSAGE) READFH1A.28
READFH1A.29
IMPLICIT NONE READFH1A.30
READFH1A.31
INTEGER READFH1A.32
* NFTIN ! IN Unit no of dump READFH1A.33
*,LEN_FIXHD ! IN Length of fixed length header READFH1A.34
*,FIXHD(LEN_FIXHD) ! OUT Fixed length header READFH1A.35
READFH1A.36
INTEGER ICODE ! OUT Return code; successful=0, error > 0 READFH1A.37
CHARACTER*(80) TS150793.152
* CMESSAGE !OUT Error message if ICODE > 0 READFH1A.39
READFH1A.40
C Local arrays:------------------------------------------------ READFH1A.41
C None READFH1A.42
C ------------------------------------------------------------- READFH1A.43
C External subroutines called:--------------------------------- READFH1A.44
EXTERNAL IOERROR,BUFFIN READFH1A.45
C Local variables:--------------------------------------------- READFH1A.46
INTEGER LEN_IO READFH1A.47
REAL A READFH1A.48
C ------------------------------------------------------------- READFH1A.49
READFH1A.50
ICODE=0 READFH1A.51
CMESSAGE=' ' READFH1A.52
READFH1A.53
CL 1. Buffer in fixed length header record READFH1A.54
READFH1A.55
CALL BUFFIN
(NFTIN,FIXHD(1),LEN_FIXHD,LEN_IO,A) READFH1A.56
READFH1A.57
CL 2. Check for I/O errors READFH1A.58
IF(A.NE.-1.0.OR.LEN_IO.NE.LEN_FIXHD)THEN READFH1A.59
CALL IOERROR('buffer in of fixed length header',A,LEN_IO READFH1A.60
* ,LEN_FIXHD) READFH1A.61
CMESSAGE='READ_FLH: I/O error' READFH1A.62
ICODE=1 READFH1A.63
ENDIF READFH1A.64
READFH1A.65
RETURN READFH1A.66
END READFH1A.67
*ENDIF READFH1A.68