*IF DEF,FLUXPROC FPADLOOK.2
C ******************************COPYRIGHT****************************** FPADLOOK.3
C (c) CROWN COPYRIGHT 1998, METEOROLOGICAL OFFICE, All Rights Reserved. FPADLOOK.4
C FPADLOOK.5
C Use, duplication or disclosure of this code is subject to the FPADLOOK.6
C restrictions as set forth in the contract. FPADLOOK.7
C FPADLOOK.8
C Meteorological Office FPADLOOK.9
C London Road FPADLOOK.10
C BRACKNELL FPADLOOK.11
C Berkshire UK FPADLOOK.12
C RG12 2SZ FPADLOOK.13
C FPADLOOK.14
C If no contract has been raised with this copy of the code, the use, FPADLOOK.15
C duplication or disclosure of it is strictly prohibited. Permission FPADLOOK.16
C to do so must first be obtained in writing from the Head of Numerical FPADLOOK.17
C Modelling at the above address. FPADLOOK.18
C ******************************COPYRIGHT****************************** FPADLOOK.19
C FPADLOOK.20
C Programming standard: Unified Model Documentation Paper No 3 FPADLOOK.21
C Version No 1 15/1/90 FPADLOOK.22
C History: FPADLOOK.23
C version date change FPADLOOK.24
C 4.5 03/09/98 New code FPADLOOK.25
C FPADLOOK.26
! Author: M. J. Bell FPADLOOK.27
!---------------------------------------------------------------------- FPADLOOK.28
! contains routines: add_lookups FPADLOOK.29
! FPADLOOK.30
! Purpose: Flux processing routine. FPADLOOK.31
! This routine modifies the lookup table for a file (copy in FPADLOOK.32
! memory only) to add further headers that are appropriate to FPADLOOK.33
! additional times. This is needed because the input fields FPADLOOK.34
! may be for a single time (eg SST) but the fields are needed FPADLOOK.35
! throughout the period of a FOAM forecast. By adding further FPADLOOK.36
! headers to the lookup table in memory, it is possible to FPADLOOK.37
! allow direct access to the fields on disk using the same FPADLOOK.38
! method whether the required time is actually in the file FPADLOOK.39
! or is obtained by re-labelling the field. FPADLOOK.40
! FPADLOOK.41
! Important: if readff used element LBEGIN in the lookup table to FPADLOOK.42
! determine the start location of a data field, the array FPADLOOK.43
! LookFldNo would not be necessary. But as things stand the FPADLOOK.44
! original lookup table has to be used to read in the data. FPADLOOK.45
! As there is no spare space in the Lookup table I have had FPADLOOK.46
! to use an additional array LookFldNo to store this field FPADLOOK.47
! number. The validity date of copied data read in by FPADLOOK.48
! read_one_field will thus be taken from the original lookup FPADLOOK.49
! table and will not be the validity date searched for !! FPADLOOK.50
! M. J. Bell 24/09/96 FPADLOOK.51
!---------------------------------------------------------------------- FPADLOOK.52
subroutine add_lookups ( 3,4FPADLOOK.53
# NoAddTimes, ISrchOffHr, INewOffHr, l_climate_field, FPADLOOK.54
# Len1_Lookup, Len2_Lookup, FPADLOOK.55
# Len2_Lookup_Actual, Lookup, LookFldNo, icode ) FPADLOOK.56
FPADLOOK.57
FPADLOOK.58
implicit none FPADLOOK.59
FPADLOOK.60
! declaration of argument list FPADLOOK.61
integer NoAddTimes ! IN # of additional lookups to make FPADLOOK.62
integer ISrchOffHr(NoAddTimes+1) ! IN offset hours to look for FPADLOOK.63
integer INewOffHr (NoAddTimes+1) ! IN new offset hours FPADLOOK.64
logical l_climate_field ! IN F => not a climate field FPADLOOK.65
integer Len1_Lookup ! IN length of lookup table (64) FPADLOOK.66
integer Len2_Lookup ! IN length allocated for lookup table FPADLOOK.67
integer Len2_Lookup_Actual ! IN/OUT actual # of lookup tables FPADLOOK.68
integer Lookup(Len1_Lookup, Len2_Lookup) ! IN/OUT lookups FPADLOOK.69
integer LookFldNo(Len2_Lookup) ! OUT field nos for lookups FPADLOOK.70
integer icode ! IN/OUT error code ; > 0 => fatal error detected FPADLOOK.71
FPADLOOK.72
! declaration of parameters FPADLOOK.73
*CALL CLOOKADD 
FPADLOOK.74
*CALL CFDCODES FPADLOOK.75
FPADLOOK.76
! declaration of globals used FPADLOOK.77
*CALL CUNITNOS FPADLOOK.78
*CALL CMESS FPADLOOK.79
*CALL CREFTIM FPADLOOK.80
*CALL CCLM1TIM FPADLOOK.81
*CALL CCLM2TIM FPADLOOK.82
FPADLOOK.83
! declaration of local arrays FPADLOOK.84
FPADLOOK.85
! declaration of local scalars FPADLOOK.86
integer Len2_Original ! FPADLOOK.87
integer i ! loop index over lookup tables FPADLOOK.88
integer iadd ! loop index over additional times FPADLOOK.89
integer inew ! index of new lookup table FPADLOOK.90
integer j ! loop index over elements in lookup FPADLOOK.91
integer StCode ! stash code of field FPADLOOK.92
FPADLOOK.93
logical l_data_time ! T => use data time; F => use validity time FPADLOOK.94
logical Itemfound ! T => item found in lookup table FPADLOOK.95
FPADLOOK.96
! externals used FPADLOOK.97
external add_hours, time_to_use FPADLOOK.98
!---------------------------------------------------------------------- FPADLOOK.99
! 0. Preliminaries FPADLOOK.100
CSub = 'add_lookups' ! subroutine name for error messages FPADLOOK.101
FPADLOOK.102
! 1.0 Check that all Len2_Lookup_Actual lookup tables are non-empty; FPADLOOK.103
! Reset Len2_lookup_Actual and Len2_Original if an empty table is FPADLOOK.104
! found (empty lookup tables have -99 in all entries; entry 1 has FPADLOOK.105
! the year of validity in a non-empty table.) FPADLOOK.106
FPADLOOK.107
Len2_Original = Len2_Lookup_Actual FPADLOOK.108
FPADLOOK.109
do i = 1, Len2_Original FPADLOOK.110
if ( Lookup (1, i) .eq. -99 ) then FPADLOOK.111
Len2_Lookup_Actual = i - 1 FPADLOOK.112
go to 100 FPADLOOK.113
end if FPADLOOK.114
end do ! i FPADLOOK.115
FPADLOOK.116
100 continue FPADLOOK.117
FPADLOOK.118
Len2_Original = Len2_Lookup_Actual FPADLOOK.119
FPADLOOK.120
! 1.1 Set field numbers for original lookup tables FPADLOOK.121
FPADLOOK.122
do i = 1, Len2_Lookup_Actual FPADLOOK.123
LookFldNo(i) = i FPADLOOK.124
end do FPADLOOK.125
FPADLOOK.126
! 2. Start Loop over validity times to copy headers and calculate FPADLOOK.127
! new validity dates FPADLOOK.128
FPADLOOK.129
do iadd = 1, NoAddTimes FPADLOOK.130
FPADLOOK.131
! 3. Calculate old and new validity dates FPADLOOK.132
FPADLOOK.133
call add_hours ( FPADLOOK.134
*CALL AREFTIM FPADLOOK.135
*CALL ACLM1TIM FPADLOOK.136
# ISrchOffHr(iadd) ) FPADLOOK.137
FPADLOOK.138
call add_hours ( FPADLOOK.139
*CALL AREFTIM FPADLOOK.140
*CALL ACLM2TIM FPADLOOK.141
# INewOffHr(iadd) ) FPADLOOK.142
FPADLOOK.143
! 4. Check that there are no original lookup tables present FPADLOOK.144
! which have the new validity date FPADLOOK.145
FPADLOOK.146
ItemFound = .false. FPADLOOK.147
do i = 1, Len2_Original FPADLOOK.148
FPADLOOK.149
StCode = Lookup(ITEM_CODE, i) FPADLOOK.150
call time_to_use ( StCode, l_climate_field, l_data_time) FPADLOOK.151
FPADLOOK.152
if ( l_data_time ) then FPADLOOK.153
FPADLOOK.154
if (Lookup(LBYRD,i) .eq. Clim2Year .and. FPADLOOK.155
# Lookup(LBMOND,i) .eq. Clim2Month .and. FPADLOOK.156
# Lookup(LBDATD,i) .eq. Clim2Day .and. FPADLOOK.157
# Lookup(LBHRD,i) .eq. Clim2Hour .and. FPADLOOK.158
# Lookup(LBMIND,i) .eq. Clim2Min ) then FPADLOOK.159
FPADLOOK.160
ItemFound = .true. FPADLOOK.161
end if FPADLOOK.162
FPADLOOK.163
else ! .not. l_data_time FPADLOOK.164
FPADLOOK.165
if (Lookup(LBYR,i) .eq. Clim2Year .and. FPADLOOK.166
# Lookup(LBMON,i) .eq. Clim2Month .and. FPADLOOK.167
# Lookup(LBDAT,i) .eq. Clim2Day .and. FPADLOOK.168
# Lookup(LBHR,i) .eq. Clim2Hour .and. FPADLOOK.169
# Lookup(LBMIN,i) .eq. Clim2Min ) then FPADLOOK.170
FPADLOOK.171
ItemFound = .true. FPADLOOK.172
end if FPADLOOK.173
FPADLOOK.174
end if ! l_data_time FPADLOOK.175
FPADLOOK.176
end do ! i FPADLOOK.177
FPADLOOK.178
if ( ItemFound ) then FPADLOOK.179
icode = 13 FPADLOOK.180
write(UnErr,*)CErr,CSub, FPADLOOK.181
# ' step 4. data already exists with new validity time ' FPADLOOK.182
go to 9999 FPADLOOK.183
end if FPADLOOK.184
FPADLOOK.185
! 5. Start loop over original lookups to look for fields with FPADLOOK.186
! old validity date FPADLOOK.187
FPADLOOK.188
do i = 1, Len2_Original FPADLOOK.189
ItemFound = .false. FPADLOOK.190
FPADLOOK.191
! 6. Look for a validity date FPADLOOK.192
FPADLOOK.193
StCode = Lookup(ITEM_CODE, i) FPADLOOK.194
call time_to_use ( StCode, l_climate_field, l_data_time) FPADLOOK.195
FPADLOOK.196
! 6.1 Do not add lookup for accumulations fields FPADLOOK.197
if ( StCode .ne. StCDrain .and. FPADLOOK.198
# StCode .ne. StCConvrain .and. FPADLOOK.199
# StCode .ne. StCDsnow .and. FPADLOOK.200
# StCode .ne. StCConvsnow ) then FPADLOOK.201
FPADLOOK.202
if ( l_data_time ) then FPADLOOK.203
FPADLOOK.204
if (Lookup(LBYRD,i) .eq. Clim1Year .and. FPADLOOK.205
# Lookup(LBMOND,i) .eq. Clim1Month .and. FPADLOOK.206
# Lookup(LBDATD,i) .eq. Clim1Day .and. FPADLOOK.207
# Lookup(LBHRD,i) .eq. Clim1Hour .and. FPADLOOK.208
# Lookup(LBMIND,i) .eq. Clim1Min ) then FPADLOOK.209
FPADLOOK.210
ItemFound = .true. FPADLOOK.211
end if FPADLOOK.212
FPADLOOK.213
else ! .not. l_data_time FPADLOOK.214
FPADLOOK.215
if (Lookup(LBYR,i) .eq. Clim1Year .and. FPADLOOK.216
# Lookup(LBMON,i) .eq. Clim1Month .and. FPADLOOK.217
# Lookup(LBDAT,i) .eq. Clim1Day .and. FPADLOOK.218
# Lookup(LBHR,i) .eq. Clim1Hour .and. FPADLOOK.219
# Lookup(LBMIN,i) .eq. Clim1Min ) then FPADLOOK.220
FPADLOOK.221
ItemFound = .true. FPADLOOK.222
end if FPADLOOK.223
FPADLOOK.224
end if ! l_data_time FPADLOOK.225
FPADLOOK.226
end if ! StCode FPADLOOK.227
! 7. If found FPADLOOK.228
FPADLOOK.229
if ( ItemFound ) then FPADLOOK.230
FPADLOOK.231
! 7.1 check space available for new lookup FPADLOOK.232
FPADLOOK.233
if ( Len2_Lookup_Actual + 1 .gt. Len2_Lookup) then FPADLOOK.234
icode = 14 FPADLOOK.235
write(UnErr,*)CErr,CSub, FPADLOOK.236
# ' step 4. not enough space to add an extra', FPADLOOK.237
# ' field in lookups. Len2_Lookup = ', Len2_Lookup FPADLOOK.238
go to 9999 FPADLOOK.239
end if FPADLOOK.240
FPADLOOK.241
! 7.2 Copy the lookup table and amend dates in new lookup table FPADLOOK.242
FPADLOOK.243
inew = Len2_Lookup_Actual + 1 FPADLOOK.244
FPADLOOK.245
do j = 1, Len1_Lookup FPADLOOK.246
Lookup(j,inew) = Lookup(j,i) FPADLOOK.247
end do FPADLOOK.248
FPADLOOK.249
FPADLOOK.250
if ( l_data_time ) then FPADLOOK.251
FPADLOOK.252
Lookup(LBYRD,inew) = Clim2Year FPADLOOK.253
Lookup(LBMOND,inew) = Clim2Month FPADLOOK.254
Lookup(LBDATD,inew) = Clim2Day FPADLOOK.255
Lookup(LBHRD,inew) = Clim2Hour FPADLOOK.256
Lookup(LBMIND,inew) = Clim2Min FPADLOOK.257
FPADLOOK.258
else ! .not. l_data_time FPADLOOK.259
FPADLOOK.260
Lookup(LBYR,inew) = Clim2Year FPADLOOK.261
Lookup(LBMON,inew) = Clim2Month FPADLOOK.262
Lookup(LBDAT,inew) = Clim2Day FPADLOOK.263
Lookup(LBHR,inew) = Clim2Hour FPADLOOK.264
Lookup(LBMIN,inew) = Clim2Min FPADLOOK.265
FPADLOOK.266
end if ! l_data_time FPADLOOK.267
FPADLOOK.268
! 7.3 Amend number of non-empty lookup tables and set FPADLOOK.269
! pointer to lookup table to actually use FPADLOOK.270
FPADLOOK.271
Len2_Lookup_Actual = Len2_Lookup_Actual + 1 FPADLOOK.272
LookFldNo(inew) = i FPADLOOK.273
FPADLOOK.274
end if ! ItemFound FPADLOOK.275
FPADLOOK.276
! 8. End loop over lookups (started in 5.) FPADLOOK.277
FPADLOOK.278
end do ! i = 1, Len2_Original FPADLOOK.279
FPADLOOK.280
! 9. End loop over validity times (started in 2.) FPADLOOK.281
FPADLOOK.282
end do ! iadd = 1, NoAddTimes FPADLOOK.283
FPADLOOK.284
FPADLOOK.285
9999 continue FPADLOOK.286
return FPADLOOK.287
end FPADLOOK.288
!---------------------------------------------------------------------- FPADLOOK.289
*ENDIF FPADLOOK.290