subroutine read_field_headers ( ppxRecs,icode ) 1,10FPRDHDRS.36
FPRDHDRS.37
implicit none FPRDHDRS.38
FPRDHDRS.39
! declaration of argument list FPRDHDRS.40
integer icode ! IN/OUT error code ; > 0 => fatal error detected FPRDHDRS.41
FPRDHDRS.42
! declaration of parameters FPRDHDRS.43
*CALL CSUBMODL 
FPRDHDRS.44
*CALL CPPXREF FPRDHDRS.45
*CALL PPXLOOK FPRDHDRS.46
*CALL PLOOKUPS FPRDHDRS.47
FPRDHDRS.48
! declaration of globals used FPRDHDRS.49
*CALL CUNITNOS FPRDHDRS.50
*CALL CMESS FPRDHDRS.51
*CALL CLOOKUPS FPRDHDRS.52
*CALL CVALOFF FPRDHDRS.53
FPRDHDRS.54
! no local arrays or scalars FPRDHDRS.55
FPRDHDRS.56
! declaration of logicals FPRDHDRS.57
logical l_climate_field ! T => Climate Field being used FPRDHDRS.58
integer IROW_NUMBER FPRDHDRS.59
character*80 cmessage FPRDHDRS.60
FPRDHDRS.61
external read_one_header, add_lookups FPRDHDRS.62
!---------------------------------------------------------------------- FPRDHDRS.63
! 0. Preliminaries FPRDHDRS.64
!---------------------------------------------------------------------- FPRDHDRS.65
CSub = 'read_field_headers' ! subroutine name for error messages FPRDHDRS.66
FPRDHDRS.67
! 0.1 Read StashMaster files FPRDHDRS.68
IROW_NUMBER=0 FPRDHDRS.69
CALL GETPPX(22,2,'STASHmaster_A',IROW_NUMBER, FPRDHDRS.70
*CALL ARGPPX FPRDHDRS.71
& ICODE,CMESSAGE) FPRDHDRS.72
CALL GETPPX(22,2,'STASHmaster_O',IROW_NUMBER, FPRDHDRS.73
*CALL ARGPPX FPRDHDRS.74
& ICODE,CMESSAGE) FPRDHDRS.75
CALL GETPPX(22,2,'STASHmaster_S',IROW_NUMBER, FPRDHDRS.76
*CALL ARGPPX FPRDHDRS.77
& ICODE,CMESSAGE) FPRDHDRS.78
CALL GETPPX(22,2,'STASHmaster_W',IROW_NUMBER, FPRDHDRS.79
*CALL ARGPPX FPRDHDRS.80
& ICODE,CMESSAGE) FPRDHDRS.81
FPRDHDRS.82
!---------------------------------------------------------------------- FPRDHDRS.83
! 1. Read and amend fixed header and lookups of preferred file FPRDHDRS.84
!---------------------------------------------------------------------- FPRDHDRS.85
FPRDHDRS.86
FPRDHDRS.87
! 1.0 read headers FPRDHDRS.88
FPRDHDRS.89
LPreferred = .True. FPRDHDRS.90
call read_one_header(UnitPreferred, icode, FPRDHDRS.91
# Len_FixHd, Len1_Lookup, Len2_LookupPreferred, FPRDHDRS.92
# Len2_ActualPreferred, FixHdPreferred, FPRDHDRS.93
*CALL ARGPPX FPRDHDRS.94
# LookupPreferred) FPRDHDRS.95
FPRDHDRS.96
if (icode .ne. 0) then FPRDHDRS.97
LPreferred = .False. FPRDHDRS.98
write(UnWarn,*)CWarn,CSub, FPRDHDRS.99
# ' step 1.0 unable to open and read headers of' // FPRDHDRS.100
# ' preferred flux file ' FPRDHDRS.101
icode = 0 FPRDHDRS.102
end if FPRDHDRS.103
FPRDHDRS.104
! 1.1 amend headers FPRDHDRS.105
FPRDHDRS.106
if ( LPreferred ) then FPRDHDRS.107
l_climate_field = .false. FPRDHDRS.108
FPRDHDRS.109
call add_lookups ( FPRDHDRS.110
# NoAddTimesPreferred, ISrchOffHrPreferred, INewOffHrPreferred, FPRDHDRS.111
# l_climate_field, Len1_Lookup, Len2_LookupPreferred, FPRDHDRS.112
# Len2_ActualPreferred, FPRDHDRS.113
# LookupPreferred, LookFldNoPreferred, icode ) FPRDHDRS.114
FPRDHDRS.115
if ( icode .gt. 0) then FPRDHDRS.116
write(UnErr,*)CErr,CSub, FPRDHDRS.117
# ' step 1.1 add_lookups failed for preferred file' FPRDHDRS.118
go to 9999 FPRDHDRS.119
end if FPRDHDRS.120
FPRDHDRS.121
end if ! LPreferred FPRDHDRS.122
FPRDHDRS.123
! 1.2 check that preferred field is on a B grid; if not exit with error FPRDHDRS.124
if ( LPreferred ) then FPRDHDRS.125
if ( FixHdPreferred ( 9 ) .ne. 2 ) then FPRDHDRS.126
write(UnErr,*)CErr,CSub, FPRDHDRS.127
# ' step 1.2 Preferred file is not defined to be on a B grid', FPRDHDRS.128
# ' This program must be amended to cope with other grids.' FPRDHDRS.129
icode = 15 FPRDHDRS.130
go to 9999 FPRDHDRS.131
end if FPRDHDRS.132
end if FPRDHDRS.133
FPRDHDRS.134
!---------------------------------------------------------------------- FPRDHDRS.135
! 2. Read and amend fixed header and lookups of previous file FPRDHDRS.136
!---------------------------------------------------------------------- FPRDHDRS.137
FPRDHDRS.138
! 2.0 read headers FPRDHDRS.139
FPRDHDRS.140
LPrevious = .True. FPRDHDRS.141
call read_one_header(UnitPrevious, icode, FPRDHDRS.142
# Len_FixHd, Len1_Lookup, Len2_LookupPrevious, FPRDHDRS.143
# Len2_ActualPrevious, FixHdPrevious, FPRDHDRS.144
*CALL ARGPPX FPRDHDRS.145
# LookupPrevious) FPRDHDRS.146
FPRDHDRS.147
if (icode .ne. 0) then FPRDHDRS.148
LPrevious = .False. FPRDHDRS.149
write(UnWarn,*)CWarn,CSub, FPRDHDRS.150
# ' step 2.0 failed to open and read headers of' // FPRDHDRS.151
# ' previous flux file ' FPRDHDRS.152
icode = 0 FPRDHDRS.153
end if FPRDHDRS.154
FPRDHDRS.155
! 2.1 amend headers FPRDHDRS.156
FPRDHDRS.157
if ( LPrevious ) then FPRDHDRS.158
l_climate_field = .false. FPRDHDRS.159
FPRDHDRS.160
call add_lookups ( FPRDHDRS.161
# NoAddTimesPrevious, ISrchOffHrPrevious, INewOffHrPrevious, FPRDHDRS.162
# l_climate_field, Len1_Lookup, Len2_LookupPrevious, FPRDHDRS.163
# Len2_ActualPrevious, FPRDHDRS.164
# LookupPrevious, LookFldNoPrevious, icode ) FPRDHDRS.165
FPRDHDRS.166
if ( icode .gt. 0) then FPRDHDRS.167
write(UnErr,*)CErr,CSub, FPRDHDRS.168
# ' step 2.1 add_lookups failed for Previous file' FPRDHDRS.169
icode = icode + 2000 FPRDHDRS.170
go to 9999 FPRDHDRS.171
end if FPRDHDRS.172
FPRDHDRS.173
end if ! LPrevious FPRDHDRS.174
FPRDHDRS.175
!---------------------------------------------------------------------- FPRDHDRS.176
! 3. Read and amend fixed header and lookups of climate file FPRDHDRS.177
!---------------------------------------------------------------------- FPRDHDRS.178
FPRDHDRS.179
! 3.0 read headers FPRDHDRS.180
FPRDHDRS.181
LClimate = .True. FPRDHDRS.182
call read_one_header(UnitClimate, icode, FPRDHDRS.183
# Len_FixHd, Len1_Lookup, Len2_LookupClimate, FPRDHDRS.184
# Len2_ActualClimate, FixHdClimate, FPRDHDRS.185
*CALL ARGPPX FPRDHDRS.186
# LookupClimate) FPRDHDRS.187
FPRDHDRS.188
if (icode .gt. 0) then FPRDHDRS.189
LClimate = .false. FPRDHDRS.190
write(UnWarn,*)CWarn,CSub, FPRDHDRS.191
# ' step 3.0 failed to read headers of climate flux file ' FPRDHDRS.192
icode = 0 FPRDHDRS.193
end if FPRDHDRS.194
FPRDHDRS.195
! 3.1 amend headers FPRDHDRS.196
FPRDHDRS.197
if ( LClimate ) then FPRDHDRS.198
l_climate_field = .true. FPRDHDRS.199
FPRDHDRS.200
call add_lookups ( FPRDHDRS.201
# NoAddTimesClimate, ISrchOffHrClimate, INewOffHrClimate, FPRDHDRS.202
# l_climate_field, Len1_Lookup, Len2_LookupClimate, FPRDHDRS.203
# Len2_ActualClimate, FPRDHDRS.204
# LookupClimate, LookFldNoClimate, icode ) FPRDHDRS.205
FPRDHDRS.206
if ( icode .gt. 0) then FPRDHDRS.207
write(UnErr,*)CErr,CSub, FPRDHDRS.208
# ' step 3.1 add_lookups failed for Climate file' FPRDHDRS.209
icode = icode + 2500 FPRDHDRS.210
go to 9999 FPRDHDRS.211
end if FPRDHDRS.212
FPRDHDRS.213
end if ! LClimate FPRDHDRS.214
FPRDHDRS.215
!---------------------------------------------------------------------- FPRDHDRS.216
! 4. If no file headers have been read exit with a fatal error FPRDHDRS.217
!---------------------------------------------------------------------- FPRDHDRS.218
if ( .not. ( LPreferred .or. LPrevious .or. LClimate) ) then FPRDHDRS.219
icode = 16 FPRDHDRS.220
write(UnErr,*)CErr,CSub, FPRDHDRS.221
# ' step 4. failed to read headers of any flux file ' FPRDHDRS.222
go to 9999 FPRDHDRS.223
end if FPRDHDRS.224
FPRDHDRS.225
9999 continue FPRDHDRS.226
return FPRDHDRS.227
end FPRDHDRS.228
!---------------------------------------------------------------------- FPRDHDRS.229
*ENDIF FPRDHDRS.230