*IF DEF,FLUXPROC FPRDLMHD.2
C ******************************COPYRIGHT****************************** FPRDLMHD.3
C (c) CROWN COPYRIGHT 1998, METEOROLOGICAL OFFICE, All Rights Reserved. FPRDLMHD.4
C FPRDLMHD.5
C Use, duplication or disclosure of this code is subject to the FPRDLMHD.6
C restrictions as set forth in the contract. FPRDLMHD.7
C FPRDLMHD.8
C Meteorological Office FPRDLMHD.9
C London Road FPRDLMHD.10
C BRACKNELL FPRDLMHD.11
C Berkshire UK FPRDLMHD.12
C RG12 2SZ FPRDLMHD.13
C FPRDLMHD.14
C If no contract has been raised with this copy of the code, the use, FPRDLMHD.15
C duplication or disclosure of it is strictly prohibited. Permission FPRDLMHD.16
C to do so must first be obtained in writing from the Head of Numerical FPRDLMHD.17
C Modelling at the above address. FPRDLMHD.18
C ******************************COPYRIGHT****************************** FPRDLMHD.19
C FPRDLMHD.20
C Programming standard: Unified Model Documentation Paper No 3 FPRDLMHD.21
C Version No 1 15/1/90 FPRDLMHD.22
C History: FPRDLMHD.23
C version date change FPRDLMHD.24
C 4.5 03/09/98 New code FPRDLMHD.25
C FPRDLMHD.26
! Author: M. J. Bell FPRDLMHD.27
!---------------------------------------------------------------------- FPRDLMHD.28
! contains routines: read_lsm_headers FPRDLMHD.29
! FPRDLMHD.30
! Purpose: Flux processing routine. FPRDLMHD.31
! Opens and reads lookup tables for land sea masks used by FPRDLMHD.32
! FOAM_Flux_Process. Also sets LCyclic = T if atmosphere FPRDLMHD.33
! grid has wrap-round points FPRDLMHD.34
!---------------------------------------------------------------------- FPRDLMHD.35
subroutine read_lsm_headers ( 1,8FPRDLMHD.36
*CALL AFLDDIMS 
FPRDLMHD.37
# ppxRecs,icode) FPRDLMHD.38
FPRDLMHD.39
implicit none FPRDLMHD.40
FPRDLMHD.41
! declaration of argument list FPRDLMHD.42
! dimensions of ocean and atmosphere fields FPRDLMHD.43
*CALL CFLDDIMS FPRDLMHD.44
integer icode ! IN/OUT error code ; > 0 => fatal error detected FPRDLMHD.45
FPRDLMHD.46
! declaration of parameters FPRDLMHD.47
*CALL CSUBMODL FPRDLMHD.48
*CALL CPPXREF FPRDLMHD.49
*CALL PPXLOOK FPRDLMHD.50
*CALL PLOOKUPS FPRDLMHD.51
*CALL CLOOKADD FPRDLMHD.52
FPRDLMHD.53
! declaration of globals used FPRDLMHD.54
*CALL CUNITNOS FPRDLMHD.55
*CALL CMESS FPRDLMHD.56
*CALL CLOOKUPS FPRDLMHD.57
FPRDLMHD.58
! no local arrays FPRDLMHD.59
FPRDLMHD.60
! declaration of local scalars FPRDLMHD.61
integer Len2_Lookup_lsm ! max 2nd dimension for lsms FPRDLMHD.62
integer Len2_Lookup_Actual ! actual 2nd dimension for lsms FPRDLMHD.63
integer IROW_NUMBER FPRDLMHD.64
character*80 cmessage FPRDLMHD.65
FPRDLMHD.66
external read_one_header, set_lookup_lsmu FPRDLMHD.67
!---------------------------------------------------------------------- FPRDLMHD.68
! 0. Preliminaries FPRDLMHD.69
CSub = 'read_lsm_headers'! subroutine name for error messages FPRDLMHD.70
Len2_Lookup_lsm = 1 ! all lsm ancillary files contain 1 field FPRDLMHD.71
FPRDLMHD.72
! 0.1 Read StashMaster files FPRDLMHD.73
IROW_NUMBER=0 FPRDLMHD.74
CALL GETPPX(22,2,'STASHmaster_A',IROW_NUMBER, FPRDLMHD.75
*CALL ARGPPX FPRDLMHD.76
& ICODE,CMESSAGE) FPRDLMHD.77
CALL GETPPX(22,2,'STASHmaster_O',IROW_NUMBER, FPRDLMHD.78
*CALL ARGPPX FPRDLMHD.79
& ICODE,CMESSAGE) FPRDLMHD.80
CALL GETPPX(22,2,'STASHmaster_S',IROW_NUMBER, FPRDLMHD.81
*CALL ARGPPX FPRDLMHD.82
& ICODE,CMESSAGE) FPRDLMHD.83
CALL GETPPX(22,2,'STASHmaster_W',IROW_NUMBER, FPRDLMHD.84
*CALL ARGPPX FPRDLMHD.85
& ICODE,CMESSAGE) FPRDLMHD.86
FPRDLMHD.87
FPRDLMHD.88
! 1. read atmosphere tracer land / sea mask fixed header and lookup FPRDLMHD.89
! table from an an ancillary file FPRDLMHD.90
call read_one_header(UnitNWPlsmt, icode, FPRDLMHD.91
# Len_FixHd, Len1_Lookup, Len2_Lookup_lsm, FPRDLMHD.92
# Len2_Lookup_Actual, FixHdlsmt, FPRDLMHD.93
*CALL ARGPPX FPRDLMHD.94
# Lookuplsmt) FPRDLMHD.95
FPRDLMHD.96
if ( icode .gt. 0 ) then FPRDLMHD.97
write(UnErr,*)CErr,CSub, FPRDLMHD.98
# ' step 1. unable to read NWP tracer land sea mask headers' FPRDLMHD.99
go to 9999 FPRDLMHD.100
end if FPRDLMHD.101
FPRDLMHD.102
! 1.1 extract the number of rows and columns from the lookup table FPRDLMHD.103
ncols = Lookuplsmt(LBNPT) FPRDLMHD.104
nrowst = Lookuplsmt(LBROW) FPRDLMHD.105
FPRDLMHD.106
! 2. set atmosphere velocity land/sea mask lookup table from the tracer FPRDLMHD.107
! land / sea mask (calculations assume B grid) ! FPRDLMHD.108
call set_lookup_lsmu ( Len1_Lookup, Lookuplsmt, Lookuplsmu ) FPRDLMHD.109
FPRDLMHD.110
! 2.1 extract the number of rows from the lookup table FPRDLMHD.111
nrowsu = Lookuplsmu(LBROW) FPRDLMHD.112
FPRDLMHD.113
! 3. Set LCyclic (T if atmosphere grid has wrap points) FPRDLMHD.114
! if fixhd(4) FPRDLMHD.115
if ( MOD ( FixHdlsmt (4) , 100 ) .ne. 3 ) then FPRDLMHD.116
LCyclic = .True. FPRDLMHD.117
else FPRDLMHD.118
LCyclic = .False. FPRDLMHD.119
end if FPRDLMHD.120
FPRDLMHD.121
! 4. read ocean tracer land / sea mask lookup table FPRDLMHD.122
call read_one_header(UnitFOAMlsmt, icode, FPRDLMHD.123
# Len_FixHd, Len1_Lookup, Len2_Lookup_lsm, FPRDLMHD.124
# Len2_Lookup_Actual, FixHdlsmtO, FPRDLMHD.125
*CALL ARGPPX FPRDLMHD.126
# LookuplsmtO) FPRDLMHD.127
FPRDLMHD.128
FPRDLMHD.129
if ( icode .gt. 0 ) then FPRDLMHD.130
write(UnErr,*)CErr,CSub, FPRDLMHD.131
# ' step 4. unable to read ocean tracer land sea mask ' FPRDLMHD.132
go to 9999 FPRDLMHD.133
end if FPRDLMHD.134
FPRDLMHD.135
! 4.1 extract the number of rows and columns from the lookup table FPRDLMHD.136
ncolsO = LookuplsmtO(LBNPT) FPRDLMHD.137
nrowstO = LookuplsmtO(LBROW) FPRDLMHD.138
FPRDLMHD.139
! 5. read ocean velocity land / sea mask lookup table FPRDLMHD.140
call read_one_header(UnitFOAMlsmu, icode, FPRDLMHD.141
# Len_FixHd, Len1_Lookup, Len2_Lookup_lsm, FPRDLMHD.142
# Len2_Lookup_Actual, FixHdlsmuO, FPRDLMHD.143
*CALL ARGPPX FPRDLMHD.144
# LookuplsmuO) FPRDLMHD.145
FPRDLMHD.146
if ( icode .gt. 0 ) then FPRDLMHD.147
write(UnErr,*)CErr,CSub, FPRDLMHD.148
# ' step 5. unable to read ocean velocity land sea mask ' FPRDLMHD.149
go to 9999 FPRDLMHD.150
end if FPRDLMHD.151
FPRDLMHD.152
! 5.1 extract the number of rows and columns from the lookup table FPRDLMHD.153
nrowsuO = LookuplsmuO(LBROW) FPRDLMHD.154
FPRDLMHD.155
9999 continue FPRDLMHD.156
return FPRDLMHD.157
end FPRDLMHD.158
!---------------------------------------------------------------------- FPRDLMHD.159
*ENDIF FPRDLMHD.160