*IF DEF,C80_1A,OR,DEF,UTILIO,OR,DEF,RECON UIE3F404.42
C ******************************COPYRIGHT****************************** GTS2F400.7543
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.7544
C GTS2F400.7545
C Use, duplication or disclosure of this code is subject to the GTS2F400.7546
C restrictions as set forth in the contract. GTS2F400.7547
C GTS2F400.7548
C Meteorological Office GTS2F400.7549
C London Road GTS2F400.7550
C BRACKNELL GTS2F400.7551
C Berkshire UK GTS2F400.7552
C RG12 2SZ GTS2F400.7553
C GTS2F400.7554
C If no contract has been raised with this copy of the code, the use, GTS2F400.7555
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.7556
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.7557
C Modelling at the above address. GTS2F400.7558
C ******************************COPYRIGHT****************************** GTS2F400.7559
C GTS2F400.7560
CLL SUBROUTINE PR_FIXHD--------------------------------------- PRFIXH1A.3
CLL PRFIXH1A.4
CLL Purpose: Prints out fixed length header record and checks PRFIXH1A.5
CLL validity of information. PRFIXH1A.6
CLL PRFIXH1A.7
CLL AD, DR, SI <- programmer of some or all of previous code or changes PRFIXH1A.8
CLL PRFIXH1A.9
CLL Model Modification history from model version 3.0: PRFIXH1A.10
CLL version Date PRFIXH1A.11
CLL AD221292.17
CLL 3.1 22/12/92 Allow use by ancillary field headers AD221292.18
CLL Author A. Dickinson Reviewer C. Wilson AD221292.19
CLL 3.2 13/07/93 Changed CHARACTER*(*) to CHARACTER*(80) for TS150793.120
CLL portability. Author Tracey Smith. TS150793.121
CLL 3.2 19/04/93 Code for new real missing data indicator. TJ050593.52
CLL Author T.Johns Reviewer A.Dickinson TJ050593.53
CLL 3.4 5/07/94 Allowed for new PF model vert coord (density*r*r) VSB1F304.138
CLL and for Varobs file. Author Colin Parrett. VSB1F304.139
CLL 4.0 21/11/95 Allowed for Covariance files. C.Parrett VSB1F400.8
CLL 4.1 09/04/96 Introduce wave sub-model. RTHBarnes. WRB1F401.694
CLL 4.1 16/04/96 Allowed for OPS Obstore files. Author Colin Parret VSB1F401.99
!LL 4.1 23/05/96 Removed check of data length for MPP code P.Burton GPB0F401.270
CLL 4.1 22/05/96 Print out UM Version Number D. Robinson GDR1F401.46
CLL PRFIXH1A.12
CLL Programming standard: PRFIXH1A.13
CLL Unified Model Documentation Paper No 3 PRFIXH1A.14
CLL Version No 2 09/09/91 PRFIXH1A.15
CLL PRFIXH1A.16
CLL System component: C25 PRFIXH1A.17
CLL PRFIXH1A.18
CLL System task: F3 PRFIXH1A.19
CLL PRFIXH1A.20
CLL Documentation: PRFIXH1A.21
CLL Unified Model Documentation Paper No F3 PRFIXH1A.22
CLL Version No 5 9/2/90 PRFIXH1A.23
CLL PRFIXH1A.24
CLL------------------------------------------------------------ PRFIXH1A.25
C*L Arguments:------------------------------------------------- PRFIXH1A.26
SUBROUTINE PR_FIXHD 4PRFIXH1A.27
*(FIXHD,LEN_FIXHD,LEN_INTHD,LEN_REALHD,LEN1_LEVDEPC PRFIXH1A.28
*,LEN2_LEVDEPC,LEN1_ROWDEPC,LEN2_ROWDEPC,LEN1_COLDEPC,LEN2_COLDEPC PRFIXH1A.29
*,LEN1_FLDDEPC,LEN2_FLDDEPC,LEN_EXTCNST,LEN_DUMPHIST,LEN_CFI1 PRFIXH1A.30
*,LEN_CFI2,LEN_CFI3,LEN1_LOOKUP,LEN2_LOOKUP,LEN_DATA PRFIXH1A.31
*,ICODE,CMESSAGE) PRFIXH1A.32
PRFIXH1A.33
IMPLICIT NONE PRFIXH1A.34
PRFIXH1A.35
INTEGER PRFIXH1A.36
* LEN_FIXHD !IN Length of fixed length header PRFIXH1A.37
*,LEN_INTHD !IN Length of integer header PRFIXH1A.38
*,LEN_REALHD !IN Length of real header PRFIXH1A.39
*,LEN1_LEVDEPC !IN 1st dim of level dep consts PRFIXH1A.40
*,LEN2_LEVDEPC !IN 2nd dim of level dep consts PRFIXH1A.41
*,LEN1_ROWDEPC !IN 1st dim of row dep consts PRFIXH1A.42
*,LEN2_ROWDEPC !IN 2nd dim of row dep consts PRFIXH1A.43
&,LEN1_COLDEPC !IN 1st dim of column dep consts PRFIXH1A.44
&,LEN2_COLDEPC !IN 2nd dim of column dep consts PRFIXH1A.45
&,LEN1_FLDDEPC !IN 1st dim of field dep consts PRFIXH1A.46
&,LEN2_FLDDEPC !IN 2nd dim of field dep consts PRFIXH1A.47
&,LEN_EXTCNST !IN Length of extra constants PRFIXH1A.48
&,LEN_DUMPHIST !IN Length of history block PRFIXH1A.49
&,LEN_CFI1 !IN Length of comp field index 1 PRFIXH1A.50
&,LEN_CFI2 !IN Length of comp field index 2 PRFIXH1A.51
&,LEN_CFI3 !IN Length of comp field index 3 PRFIXH1A.52
&,LEN1_LOOKUP !IN 1st dim of lookup PRFIXH1A.53
&,LEN2_LOOKUP !IN 2nd dim of lookup PRFIXH1A.54
PRFIXH1A.55
INTEGER PRFIXH1A.56
* FIXHD(LEN_FIXHD) !IN Fixed length header PRFIXH1A.57
&,LEN_DATA !IN Length of real data PRFIXH1A.58
*,ICODE !OUT Return code; successful=0 PRFIXH1A.59
* ! error > 0 PRFIXH1A.60
PRFIXH1A.61
CHARACTER*(80) TS150793.122
* CMESSAGE !OUT Error message if ICODE > 0 PRFIXH1A.63
PRFIXH1A.64
C ------------------------------------------------------------- PRFIXH1A.65
C Workspace usage:--------------------------------------------- PRFIXH1A.66
C None PRFIXH1A.67
C ------------------------------------------------------------- PRFIXH1A.68
C*L External subroutines called:------------------------------- PRFIXH1A.69
C None PRFIXH1A.70
C*------------------------------------------------------------- PRFIXH1A.71
*CALL C_MDI 
PRFIXH1A.72
C Local variables:--------------------------------------------- PRFIXH1A.73
INTEGER I PRFIXH1A.74
C-------------------------------------------------------------- PRFIXH1A.75
PRFIXH1A.76
ICODE=0 PRFIXH1A.77
CMESSAGE=' ' PRFIXH1A.78
PRFIXH1A.79
WRITE(6,'('' '')') PRFIXH1A.80
WRITE(6,'('' FIXED LENGTH HEADER'')') PRFIXH1A.81
WRITE(6,'('' -------------------'')') PRFIXH1A.82
PRFIXH1A.83
WRITE(6,'('' Dump format version'',I6)')FIXHD(1) PRFIXH1A.84
WRITE(6,'('' UM Version No '',I6)')FIXHD(12) GDR1F401.47
PRFIXH1A.85
IF(FIXHD(2).EQ.1)THEN PRFIXH1A.86
WRITE(6,'('' Atmospheric data'')') PRFIXH1A.87
ELSE IF(FIXHD(2).EQ.2)THEN PRFIXH1A.88
WRITE(6,'('' Oceanic data'')') PRFIXH1A.89
ELSE IF (FIXHD(2).EQ.4) THEN WRB1F401.695
WRITE(6,'('' Wave sub-model data'')') WRB1F401.696
ELSE PRFIXH1A.90
WRITE(6,'('' ***FATAL ERROR*** Invalid data type: FIXHD(2)='', PRFIXH1A.91
*I9)')FIXHD(2) PRFIXH1A.92
ICODE=4 PRFIXH1A.93
CMESSAGE='PR_FIXHD: Consistency check' PRFIXH1A.94
RETURN PRFIXH1A.95
ENDIF PRFIXH1A.96
PRFIXH1A.97
IF(FIXHD(3).EQ.1)THEN PRFIXH1A.98
WRITE(6,'('' On hybrid levels'')') PRFIXH1A.99
ELSEIF(FIXHD(3).EQ.2)THEN PRFIXH1A.100
WRITE(6,'('' On sigma levels'')') PRFIXH1A.101
ELSEIF(FIXHD(3).EQ.3)THEN PRFIXH1A.102
WRITE(6,'('' On pressure levels'')') PRFIXH1A.103
ELSEIF(FIXHD(3).EQ.4)THEN PRFIXH1A.104
WRITE(6,'('' On depth levels'')') PRFIXH1A.105
ELSEIF(FIXHD(3).EQ.5)THEN VSB1F304.140
WRITE(6,'('' Charney-Phillips on radius levels'')') VSB1F304.141
ELSEIF (FIXHD(3).EQ.6) THEN WRB1F401.697
WRITE(6,'('' Wave model direction levels and frequency pseudo-le WRB1F401.698
&vels'')') WRB1F401.699
ELSEIF(FIXHD(3).EQ.IMDI.AND.FIXHD(5).EQ.4)THEN TJ050593.54
WRITE(6,'('' Missing data indicator used for vert coord type PRFIXH1A.107
*'')') PRFIXH1A.108
ELSE PRFIXH1A.109
WRITE(6,'('' ***FATAL ERROR*** Invalid level type: FIXHD(3)='', PRFIXH1A.110
*I9)')FIXHD(3) PRFIXH1A.111
ICODE=4 PRFIXH1A.112
CMESSAGE='PR_FIXHD: Consistency check' PRFIXH1A.113
RETURN PRFIXH1A.114
ENDIF PRFIXH1A.115
PRFIXH1A.116
IF(FIXHD(4).EQ.0)THEN PRFIXH1A.117
WRITE(6,'('' Over global domain'')') PRFIXH1A.118
ELSEIF(FIXHD(4).EQ.1)THEN PRFIXH1A.119
WRITE(6,'('' Over N. Hemispheric domain'')') PRFIXH1A.120
ELSEIF(FIXHD(4).EQ.2)THEN PRFIXH1A.121
WRITE(6,'('' Over S. Hemispheric domain'')') PRFIXH1A.122
ELSEIF(FIXHD(4).EQ.3)THEN PRFIXH1A.123
WRITE(6,'('' Over LA domain with no wrap around'')') PRFIXH1A.124
ELSEIF(FIXHD(4).EQ.4)THEN PRFIXH1A.125
WRITE(6,'('' Over LA domain with wrap around'')') PRFIXH1A.126
ELSEIF(FIXHD(4).EQ.103)THEN PRFIXH1A.127
WRITE(6,'('' Over rotated LA domain'')') PRFIXH1A.128
ELSE PRFIXH1A.129
WRITE(6,'('' ***FATAL ERROR*** Invalid domain: FIXHD(4)='', PRFIXH1A.130
*I9)')FIXHD(4) PRFIXH1A.131
ICODE=4 PRFIXH1A.132
CMESSAGE='PR_FIXHD: Consistency check' PRFIXH1A.133
RETURN PRFIXH1A.134
ENDIF PRFIXH1A.135
PRFIXH1A.136
IF(FIXHD(5).EQ.1)THEN PRFIXH1A.137
WRITE(6,'('' Instantaneous dump'')') PRFIXH1A.138
ELSEIF(FIXHD(5).EQ.2)THEN PRFIXH1A.139
WRITE(6,'('' Meaned dump'')') PRFIXH1A.140
ELSEIF(FIXHD(5).EQ.3)THEN PRFIXH1A.141
WRITE(6,'('' FIELDS file'')') PRFIXH1A.142
ELSEIF(FIXHD(5).EQ.4)THEN PRFIXH1A.143
WRITE(6,'('' Ancillary dataset'')') PRFIXH1A.144
ELSEIF(FIXHD(5).EQ.5)THEN PRFIXH1A.145
WRITE(6,'('' Boundary dataset'')') PRFIXH1A.146
ELSEIF(FIXHD(5).EQ.6)THEN PRFIXH1A.147
WRITE(6,'('' AC Observation File'')') VSB1F304.142
ELSEIF(FIXHD(5).EQ.7)THEN VSB1F304.143
WRITE(6,'('' Var Observation File'')') VSB1F304.144
ELSEIF(FIXHD(5).EQ.8)THEN VSB1F304.145
WRITE(6,'('' Cx file (model columns at ob locations)'')') VSB1F304.146
ELSEIF(FIXHD(5).EQ.9)THEN VSB1F400.9
WRITE(6,'('' Covariance File'')') VSB1F400.10
ELSE IF (FIXHD(5).EQ.10) THEN VSB1F401.100
WRITE (6, '('' OPS Obstore file '')') VSB1F401.101
ELSE PRFIXH1A.149
WRITE(6,'('' ***FATAL ERROR*** Invalid dump type: FIXHD(5)='', PRFIXH1A.150
*I9)')FIXHD(5) PRFIXH1A.151
ICODE=4 PRFIXH1A.152
CMESSAGE='PR_FIXHD: Consistency check' PRFIXH1A.153
RETURN PRFIXH1A.154
ENDIF PRFIXH1A.155
PRFIXH1A.156
WRITE(6,'('' Exp No ='',I6,'' Run Id ='',I6)') FIXHD(7),FIXHD(6) PRFIXH1A.157
PRFIXH1A.158
IF(FIXHD(8).EQ.1)THEN PRFIXH1A.159
WRITE(6,'('' Gregorian calendar'')') PRFIXH1A.160
ELSEIF(FIXHD(8).EQ.2)THEN PRFIXH1A.161
WRITE(6,'('' 360-day calendar'')') PRFIXH1A.162
ELSEIF(FIXHD(8).EQ.IMDI.AND.FIXHD(5).EQ.4)THEN TJ050593.55
WRITE(6,'('' Missing data indcator used as calendar'')') PRFIXH1A.164
ELSE PRFIXH1A.165
WRITE(6,'('' *** FATAL ERROR *** Invalid calendar type: FIXHD(8) PRFIXH1A.166
*='',I9)')FIXHD(8) PRFIXH1A.167
ICODE=4 PRFIXH1A.168
CMESSAGE='PR_FIXHD: Consistency check' PRFIXH1A.169
RETURN PRFIXH1A.170
ENDIF PRFIXH1A.171
PRFIXH1A.172
IF(FIXHD(9).EQ.1)THEN PRFIXH1A.173
WRITE(6,'('' Arakawa A grid'')') PRFIXH1A.174
ELSEIF(FIXHD(9).EQ.2)THEN PRFIXH1A.175
WRITE(6,'('' Arakawa B grid'')') PRFIXH1A.176
ELSEIF(FIXHD(9).EQ.3)THEN PRFIXH1A.177
WRITE(6,'('' Arakawa C grid'')') PRFIXH1A.178
ELSEIF(FIXHD(9).EQ.4)THEN PRFIXH1A.179
WRITE(6,'('' Arakawa D grid'')') PRFIXH1A.180
ELSEIF(FIXHD(9).EQ.5)THEN PRFIXH1A.181
WRITE(6,'('' Arakawa E grid'')') PRFIXH1A.182
ELSEIF(FIXHD(9).EQ.IMDI.AND.FIXHD(5).EQ.4)THEN TJ050593.56
WRITE(6,'('' Missing data indicator used for grid type'')') PRFIXH1A.184
ELSEIF(FIXHD(9).EQ.IMDI.AND.FIXHD(5).EQ.5)THEN TJ050593.57
WRITE(6,'('' Missing data indicator used for grid type'')') PRFIXH1A.186
ELSE PRFIXH1A.187
WRITE(6,'('' *** FATAL ERROR *** Invalid grid type: FIXHD(9)='' PRFIXH1A.188
* ,I9)')FIXHD(9) PRFIXH1A.189
ICODE=4 PRFIXH1A.190
CMESSAGE='PR_FIXHD: Consistency check' PRFIXH1A.191
RETURN PRFIXH1A.192
ENDIF PRFIXH1A.193
PRFIXH1A.194
WRITE(6,'('' Year Month Day Hour Min Sec DayNo PRFIXH1A.195
*'')') PRFIXH1A.196
WRITE(6,'('' Data time ='',7I5)')(FIXHD(I),I=21,27) PRFIXH1A.197
WRITE(6,'('' Validity time ='',7I5)')(FIXHD(I),I=28,34) PRFIXH1A.198
WRITE(6,'('' Creation time ='',7I5)')(FIXHD(I),I=35,41) PRFIXH1A.199
PRFIXH1A.200
WRITE(6,'('' Start 1st dim 2nd dim 1st pa PRFIXH1A.201
*rm 2nd parm'')') PRFIXH1A.202
WRITE(6,'('' Integer Consts '',2I9,9X,I9)')FIXHD(100), PRFIXH1A.203
*FIXHD(101),LEN_INTHD PRFIXH1A.204
WRITE(6,'('' Real Consts '',2I9,9X,I9)')FIXHD(105), PRFIXH1A.205
*FIXHD(106),LEN_REALHD PRFIXH1A.206
WRITE(6,'('' Level Dep Consts '',5I9)')FIXHD(110), PRFIXH1A.207
*FIXHD(111),FIXHD(112),LEN1_LEVDEPC,LEN2_LEVDEPC PRFIXH1A.208
WRITE(6,'('' Row Dep Consts '',5I9)')FIXHD(115), PRFIXH1A.209
*FIXHD(116),FIXHD(117),LEN1_ROWDEPC,LEN2_ROWDEPC PRFIXH1A.210
WRITE(6,'('' Column Dep Consts'',5I9)')FIXHD(120), PRFIXH1A.211
*FIXHD(121),FIXHD(122),LEN1_COLDEPC,LEN2_COLDEPC PRFIXH1A.212
WRITE(6,'('' Fields of Consts '',5I9)')FIXHD(125), PRFIXH1A.213
*FIXHD(126),FIXHD(127),LEN1_FLDDEPC,LEN2_FLDDEPC PRFIXH1A.214
WRITE(6,'('' Extra Consts '',2I9,9X,I9)')FIXHD(130), PRFIXH1A.215
*FIXHD(131),LEN_EXTCNST PRFIXH1A.216
WRITE(6,'('' History Block '',2I9,9X,I9)')FIXHD(135), PRFIXH1A.217
*FIXHD(136),LEN_DUMPHIST PRFIXH1A.218
WRITE(6,'('' CFI No 1 '',2I9,9X,I9)')FIXHD(140), PRFIXH1A.219
*FIXHD(141),LEN_CFI1 PRFIXH1A.220
WRITE(6,'('' CFI No 2 '',2I9,9X,I9)')FIXHD(142), PRFIXH1A.221
*FIXHD(143),LEN_CFI2 PRFIXH1A.222
WRITE(6,'('' CFI No 3 '',2I9,9X,I9)')FIXHD(144), PRFIXH1A.223
*FIXHD(145),LEN_CFI3 PRFIXH1A.224
WRITE(6,'('' Lookup Tables '',5I9)')FIXHD(150), PRFIXH1A.225
*FIXHD(151),FIXHD(152),LEN1_LOOKUP,LEN2_LOOKUP PRFIXH1A.226
WRITE(6,'('' Model Data '',2I9,9X,I9)')FIXHD(160), PRFIXH1A.227
*FIXHD(161),LEN_DATA PRFIXH1A.228
PRFIXH1A.229
C Check model parameters against header record entries PRFIXH1A.230
PRFIXH1A.231
IF(FIXHD(101).GT.0)THEN PRFIXH1A.232
IF(LEN_INTHD.NE.FIXHD(101))THEN PRFIXH1A.233
WRITE(6,'('' *ERROR* Integer Consts'')') PRFIXH1A.234
WRITE(6,'('' Parameter and header values dont match'')') PRFIXH1A.235
ICODE=4 PRFIXH1A.236
CMESSAGE='PR_FIXHD: Consistency check' PRFIXH1A.237
RETURN PRFIXH1A.238
ENDIF PRFIXH1A.239
ENDIF PRFIXH1A.240
PRFIXH1A.241
IF(FIXHD(105).GT.0)THEN PRFIXH1A.242
IF(LEN_REALHD.NE.FIXHD(106))THEN PRFIXH1A.243
WRITE(6,'('' *ERROR* Real Consts'')') PRFIXH1A.244
WRITE(6,'('' Parameter and header values dont match'')') PRFIXH1A.245
ICODE=4 PRFIXH1A.246
CMESSAGE='PR_FIXHD: Consistency check' PRFIXH1A.247
RETURN PRFIXH1A.248
ENDIF PRFIXH1A.249
ENDIF PRFIXH1A.250
PRFIXH1A.251
IF(FIXHD(110).GT.0)THEN PRFIXH1A.252
IF(LEN1_LEVDEPC.NE.0)THEN AD221292.20
IF(LEN1_LEVDEPC.NE.FIXHD(111).OR.LEN2_LEVDEPC.NE.FIXHD(112))THEN PRFIXH1A.253
WRITE(6,'('' *ERROR* Level Dep Consts'')') PRFIXH1A.254
WRITE(6,'('' Parameter and header values dont match'')') PRFIXH1A.255
ICODE=4 PRFIXH1A.256
CMESSAGE='PR_FIXHD: Consistency check' PRFIXH1A.257
RETURN PRFIXH1A.258
ENDIF PRFIXH1A.259
ENDIF AD221292.21
ENDIF PRFIXH1A.260
PRFIXH1A.261
IF(FIXHD(115).GT.0)THEN PRFIXH1A.262
IF(LEN1_ROWDEPC.NE.0)THEN AD221292.22
IF(LEN1_ROWDEPC.NE.FIXHD(116).OR.LEN2_ROWDEPC.NE.FIXHD(117))THEN PRFIXH1A.263
WRITE(6,'('' *ERROR* Row Dep Consts'')') PRFIXH1A.264
WRITE(6,'('' Parameter and header values dont match'')') PRFIXH1A.265
ICODE=4 PRFIXH1A.266
CMESSAGE='PR_FIXHD: Consistency check' PRFIXH1A.267
RETURN PRFIXH1A.268
ENDIF PRFIXH1A.269
ENDIF AD221292.23
ENDIF PRFIXH1A.270
PRFIXH1A.271
IF(FIXHD(120).GT.0)THEN PRFIXH1A.272
IF(LEN1_COLDEPC.NE.0)THEN AD221292.24
IF(LEN1_COLDEPC.NE.FIXHD(121).OR.LEN2_COLDEPC.NE.FIXHD(122))THEN PRFIXH1A.273
WRITE(6,'('' *ERROR* Column Dep Consts'')') PRFIXH1A.274
WRITE(6,'('' Parameter and header values dont match'')') PRFIXH1A.275
ICODE=4 PRFIXH1A.276
CMESSAGE='PR_FIXHD: Consistency check' PRFIXH1A.277
RETURN PRFIXH1A.278
ENDIF PRFIXH1A.279
ENDIF AD221292.25
ENDIF PRFIXH1A.280
PRFIXH1A.281
IF(FIXHD(125).GT.0)THEN PRFIXH1A.282
IF(LEN1_FLDDEPC.NE.0)THEN AD221292.26
IF(LEN1_FLDDEPC.NE.FIXHD(126).OR.LEN2_FLDDEPC.NE.FIXHD(127))THEN PRFIXH1A.283
WRITE(6,'('' *ERROR* Fields of Consts'')') PRFIXH1A.284
WRITE(6,'('' Parameter and header values dont match'')') PRFIXH1A.285
ICODE=4 PRFIXH1A.286
CMESSAGE='PR_FIXHD: Consistency check' PRFIXH1A.287
RETURN PRFIXH1A.288
ENDIF PRFIXH1A.289
ENDIF AD221292.27
ENDIF PRFIXH1A.290
PRFIXH1A.291
IF(FIXHD(130).GT.0)THEN PRFIXH1A.292
IF(LEN_EXTCNST.NE.0)THEN AD221292.28
IF(LEN_EXTCNST.NE.FIXHD(131))THEN PRFIXH1A.293
WRITE(6,'('' *ERROR* Extra Consts'')') PRFIXH1A.294
WRITE(6,'('' Parameter and header values dont match'')') PRFIXH1A.295
ICODE=4 PRFIXH1A.296
CMESSAGE='PR_FIXHD: Consistency check' PRFIXH1A.297
RETURN PRFIXH1A.298
ENDIF PRFIXH1A.299
ENDIF AD221292.29
ENDIF PRFIXH1A.300
PRFIXH1A.301
IF(FIXHD(135).GT.0)THEN PRFIXH1A.302
IF(LEN_DUMPHIST.NE.0)THEN AD221292.30
IF(LEN_DUMPHIST.NE.FIXHD(136))THEN PRFIXH1A.303
WRITE(6,'('' *ERROR* History File'')') PRFIXH1A.304
WRITE(6,'('' Parameter and header values dont match'')') PRFIXH1A.305
ICODE=4 PRFIXH1A.306
CMESSAGE='PR_FIXHD: Consistency check' PRFIXH1A.307
RETURN PRFIXH1A.308
ENDIF PRFIXH1A.309
ENDIF AD221292.31
ENDIF PRFIXH1A.310
PRFIXH1A.311
IF(FIXHD(140).GT.0)THEN PRFIXH1A.312
IF(LEN_CFI1.NE.0)THEN AD221292.32
IF(LEN_CFI1.NE.FIXHD(141))THEN PRFIXH1A.313
WRITE(6,'('' *ERROR* CFI No 1'')') PRFIXH1A.314
WRITE(6,'('' Parameter and header values dont match'')') PRFIXH1A.315
ICODE=4 PRFIXH1A.316
CMESSAGE='PR_FIXHD: Consistency check' PRFIXH1A.317
RETURN PRFIXH1A.318
ENDIF PRFIXH1A.319
ENDIF AD221292.33
ENDIF PRFIXH1A.320
PRFIXH1A.321
IF(FIXHD(142).GT.0)THEN PRFIXH1A.322
IF(LEN_CFI2.NE.0)THEN AD221292.34
IF(LEN_CFI2.NE.FIXHD(143))THEN PRFIXH1A.323
WRITE(6,'('' *ERROR* CFI No 2'')') PRFIXH1A.324
WRITE(6,'('' Parameter and header values dont match'')') PRFIXH1A.325
ICODE=4 PRFIXH1A.326
CMESSAGE='PR_FIXHD: Consistency check' PRFIXH1A.327
RETURN PRFIXH1A.328
ENDIF PRFIXH1A.329
ENDIF AD221292.35
ENDIF PRFIXH1A.330
PRFIXH1A.331
IF(FIXHD(144).GT.0)THEN PRFIXH1A.332
IF(LEN_CFI3.NE.0)THEN AD221292.36
IF(LEN_CFI3.NE.FIXHD(145))THEN PRFIXH1A.333
WRITE(6,'('' *ERROR* CFI No 3'')') PRFIXH1A.334
WRITE(6,'('' Parameter and header values dont match'')') PRFIXH1A.335
ICODE=4 PRFIXH1A.336
CMESSAGE='PR_FIXHD: Consistency check' PRFIXH1A.337
RETURN PRFIXH1A.338
ENDIF PRFIXH1A.339
ENDIF AD221292.37
ENDIF PRFIXH1A.340
PRFIXH1A.341
IF(FIXHD(150).GT.0)THEN PRFIXH1A.342
IF(LEN2_LOOKUP.NE.IMDI)THEN PRFIXH1A.343
IF(LEN1_LOOKUP.NE.FIXHD(151).OR.LEN2_LOOKUP.NE.FIXHD(152))THEN PRFIXH1A.344
WRITE(6,'('' *ERROR* Lookup Table'')') PRFIXH1A.345
WRITE(6,'('' Parameter and header values dont match'')') PRFIXH1A.346
ICODE=4 PRFIXH1A.347
CMESSAGE='PR_FIXHD: Consistency check' PRFIXH1A.348
RETURN PRFIXH1A.349
ENDIF PRFIXH1A.350
ENDIF PRFIXH1A.351
ENDIF PRFIXH1A.352
PRFIXH1A.353
*IF -DEF,MPP GPB0F401.271
IF(FIXHD(160).GT.0)THEN PRFIXH1A.354
IF(LEN_DATA.NE.IMDI)THEN PRFIXH1A.355
IF(LEN_DATA.NE.FIXHD(161))THEN PRFIXH1A.356
WRITE(6,'('' *ERROR* Model Data'')') PRFIXH1A.357
WRITE(6,'('' Parameter and header values dont match'')') PRFIXH1A.358
ICODE=4 PRFIXH1A.359
CMESSAGE='PR_FIXHD: Consistency check' PRFIXH1A.360
RETURN PRFIXH1A.361
ENDIF PRFIXH1A.362
ENDIF PRFIXH1A.363
ENDIF PRFIXH1A.364
*ENDIF GPB0F401.272
PRFIXH1A.365
RETURN PRFIXH1A.366
END PRFIXH1A.367
*ENDIF PRFIXH1A.368