*IF DEF,C82_1A,AND,DEF,WAVE GHM2F405.25
C ******************************COPYRIGHT****************************** RPANCW1A.3
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. RPANCW1A.4
C RPANCW1A.5
C Use, duplication or disclosure of this code is subject to the RPANCW1A.6
C restrictions as set forth in the contract. RPANCW1A.7
C RPANCW1A.8
C Meteorological Office RPANCW1A.9
C London Road RPANCW1A.10
C BRACKNELL RPANCW1A.11
C Berkshire UK RPANCW1A.12
C RG12 2SZ RPANCW1A.13
C RPANCW1A.14
C If no contract has been raised with this copy of the code, the use, RPANCW1A.15
C duplication or disclosure of it is strictly prohibited. Permission RPANCW1A.16
C to do so must first be obtained in writing from the Head of Numerical RPANCW1A.17
C Modelling at the above address. RPANCW1A.18
C ******************************COPYRIGHT****************************** RPANCW1A.19
C RPANCW1A.20
CLL SUBROUTINE REPLANCW RPANCW1A.21
CLL RPANCW1A.22
CLL Purpose: Updates ancillary fields as requested in FIELDCODE array. RPANCW1A.23
CLL Tests whether update is required for each field, allowing for RPANCW1A.24
CLL dependencies between fields. Uses LOOKUP array to find data for RPANCW1A.25
CLL appropriate time, reads a record and checks for current data RPANCW1A.26
CLL type. Reads second record if time interpolation required. Updates RPANCW1A.27
CLL the field. Under DEF RECON, the interface to the routine is RPANCW1A.28
CLL modified for use in the reconfiguration rather than the model. RPANCW1A.29
CLL At present there is no reconfiguration for the wave sub-model. RPANCW1A.30
CLL Under DEF CAL360 the 360 day rather than the Gregorian calender RPANCW1A.31
CLL is used. RPANCW1A.32
CLL RPANCW1A.33
CLL Model Modification history RPANCW1A.34
CLL version Date RPANCW1A.35
CLL 4.1 08/05/96 New routine for wave sub-model. RTHBarnes. RPANCW1A.36
CLL RPANCW1A.37
CLL PROGRAMMING STANDARD: UMDP NO 3 VERSION NO 2, DATED 07/09/90 RPANCW1A.38
CLL RPANCW1A.39
CLL SYSTEM COMPONENTS COVERED: C71 RPANCW1A.40
CLL RPANCW1A.41
CLL SYSTEM TASK C7 RPANCW1A.42
CLL RPANCW1A.43
CLL External documentation: UMDP C7 RPANCW1A.44
CLL RPANCW1A.45
CLLEND RPANCW1A.46
RPANCW1A.47
SUBROUTINE REPLANCW ,21RPANCW1A.48
&(I_YEAR,I_MONTH,I_DAY,I_HOUR,I_MINUTE,I_SECOND,I_DAY_NUMBER, RPANCW1A.49
& ANCIL_REFTIME,OFFSET_STEPS,IMT,JMT,D1, RPANCW1A.50
CCC *IF -DEF,RECON RPANCW1A.51
& W_STEP,W_STEPS_P_P,W_SECS_P_P, RPANCW1A.52
CCC *ENDIF RPANCW1A.53
& LEN1_LOOKUP, RPANCW1A.54
& LEN_FIXHD, RPANCW1A.55
& LEN_INTHD, RPANCW1A.56
& LEN_REALHD, RPANCW1A.57
& LEN_D1, RPANCW1A.58
& FIXHD, RPANCW1A.59
& INTHD, RPANCW1A.60
& REALHD, RPANCW1A.61
& LOOKUP, RPANCW1A.62
& RLOOKUP, RPANCW1A.63
& FTNANCIL, RPANCW1A.64
& LOOKUP_START, RPANCW1A.65
& NDATASETS, RPANCW1A.66
& NLOOKUPS, RPANCW1A.67
CCC *IF DEF,RECON RPANCW1A.68
CCC & IOUNIT, RPANCW1A.69
CCC *ENDIF RPANCW1A.70
*CALL ARGPPX
RPANCW1A.71
& ICODE,CMESSAGE,LCAL360) RPANCW1A.72
RPANCW1A.73
RPANCW1A.74
IMPLICIT NONE RPANCW1A.75
RPANCW1A.76
LOGICAL LCAL360 RPANCW1A.77
C Include COMDECKS RPANCW1A.78
*CALL CSUBMODL
RPANCW1A.79
*CALL CPPXREF
RPANCW1A.80
*CALL PPXLOOK
RPANCW1A.81
*CALL CANCILW
RPANCW1A.82
*CALL CLOOKADD
RPANCW1A.83
*CALL CPHYSCON
RPANCW1A.84
RPANCW1A.85
INTEGER RPANCW1A.86
& I_YEAR, ! Curent Model Time RPANCW1A.87
& I_MONTH, ! " " " RPANCW1A.88
& I_DAY, ! " " " RPANCW1A.89
& I_HOUR, ! " " " RPANCW1A.90
& I_MINUTE, ! " " " RPANCW1A.91
& I_SECOND, ! " " " RPANCW1A.92
& I_DAY_NUMBER, ! RPANCW1A.93
& ANCIL_REFTIME(6), ! Reference time for ancillary updating RPANCW1A.94
& OFFSET_STEPS, ! Offset in timesteps of ref. from basis RPANCW1A.95
CCC *IF -DEF,RECON RPANCW1A.96
& W_STEP, ! RPANCW1A.97
& W_STEPS_P_P, ! steps per period RPANCW1A.98
& W_SECS_P_P, ! seconds per period RPANCW1A.99
CCC *ENDIF RPANCW1A.100
CCC & BASIS_TIME_DAYS, ! Model basis time in whole days RPANCW1A.101
CCC & BASIS_TIME_SECS, ! Model basis time in extra seconds RPANCW1A.102
& NDATASETS, ! Number of ancillary datasets RPANCW1A.103
& NLOOKUPS, ! Number of lookup tables RPANCW1A.104
& LEN_D1 ! Size of primary data array RPANCW1A.105
& ,IMT ! Zonal dimension of arrays RPANCW1A.106
& ,JMT ! Meridional dimension of arrays RPANCW1A.107
RPANCW1A.108
INTEGER RPANCW1A.109
& LEN1_LOOKUP, ! First dimension of lookup table RPANCW1A.110
& LEN_FIXHD, ! Length of headers in data sets RPANCW1A.111
& LEN_INTHD, RPANCW1A.112
& LEN_REALHD, RPANCW1A.113
& FIXHD(LEN_FIXHD,NDATASETS), ! Data set headers RPANCW1A.114
& INTHD(LEN_INTHD,NDATASETS), ! RPANCW1A.115
& FTNANCIL(NDATASETS), ! FTN numbers of data sets RPANCW1A.116
& LOOKUP_START(NDATASETS), ! Start of lookup tables RPANCW1A.117
C ! referring to data set RPANCW1A.118
& LOOKUP(LEN1_LOOKUP,NLOOKUPS) ! Data set lookup tables RPANCW1A.119
RPANCW1A.120
REAL RPANCW1A.121
& D1(LEN_D1), ! Primary data array RPANCW1A.122
& REALHD(LEN_REALHD,NDATASETS), RPANCW1A.123
& RLOOKUP(LEN1_LOOKUP,NLOOKUPS) RPANCW1A.124
RPANCW1A.125
INTEGER RPANCW1A.126
& I_AO, ! Sub-model indicator = 1 Atmosphere RPANCW1A.127
C = 2 Ocean = 4 Wave RPANCW1A.128
& ICODE, ! Return code RPANCW1A.129
& IOUNIT ! OUT I/O unit passed out in recon mode RPANCW1A.130
RPANCW1A.131
CHARACTER*(80) RPANCW1A.132
& CMESSAGE ! Error message RPANCW1A.133
RPANCW1A.134
RPANCW1A.135
C*L Subroutines called; RPANCW1A.136
EXTERNAL RPANCW1A.137
& TIME2SEC, RPANCW1A.138
& READFLDS, RPANCW1A.139
CCC *IF -DEF,RECON RPANCW1A.140
& SEC2TIME,TIME_DF, RPANCW1A.141
CCC *ENDIF RPANCW1A.142
& T_INT RPANCW1A.143
RPANCW1A.144
C*L Local integer arrays RPANCW1A.145
REAL RPANCW1A.146
& ANCIL1(IMT*JMT), ! Buffers to hold values of ancillary RPANCW1A.147
C ! data for time interpolation. RPANCW1A.148
& ANCIL2(IMT*JMT), ! RPANCW1A.149
& ANCIL_DATA(IMT*JMT) ! Field of ancillary data held prior RPANCW1A.150
C ! to selective updating. RPANCW1A.151
RPANCW1A.152
C Local variables RPANCW1A.153
INTEGER RPANCW1A.154
& I, ! RPANCW1A.155
& JADDR, RPANCW1A.156
& J, ! RPANCW1A.157
& I1, ! used for checking stash item code in sec 2.3 RPANCW1A.158
& I2, ! ptr to 1st field; calculated in sec 2.3 RPANCW1A.159
& I1LEV, ! ptr to 2nd field for this level; used in sec 3 RPANCW1A.160
& I2LEV, ! ptr to 1st field for this level; used in sec 3 RPANCW1A.161
& ID, ! RPANCW1A.162
& IM, ! RPANCW1A.163
& IY, ! RPANCW1A.164
& FIELD, ! Current field number. RPANCW1A.165
& FILE ! RPANCW1A.166
INTEGER RPANCW1A.167
& INTERVAL, ! Interval between data times. RPANCW1A.168
& STEP, ! Number of data times skipped RPANCW1A.169
& MONTHS, ! Used in calculations of position of RPANCW1A.170
C ! data required RPANCW1A.171
& HOURS, RPANCW1A.172
& DAYS,SECONDS, ! Times used in intermediate calculation RPANCW1A.173
& PERIOD, RPANCW1A.174
& START_MONTH, ! RPANCW1A.175
& NFTIN, ! Current FTN number for ancillary field RPANCW1A.176
& ANCIL_REF_DAYS, ! Ancil.reference time in whole days RPANCW1A.177
& ANCIL_REF_SECS, ! Ancil.reference time in extra seconds RPANCW1A.178
& DAY,SEC, ! Times relative to basis time RPANCW1A.179
& DAY1,SEC1, ! Times relative to basis time RPANCW1A.180
& INCR_SEC, ! Increment in sec RPANCW1A.181
& LEN_IO RPANCW1A.182
& ,LEVEL ! loop index for level number RPANCW1A.183
& ,LEN_FLD ! length of (single level) field RPANCW1A.184
& ,LEN_FLD_ACC ! accumulated length of fields on RPANCW1A.185
C previous levels RPANCW1A.186
& ,POS_STRT ! start position in D1 array RPANCW1A.187
RPANCW1A.188
CCC *IF -DEF,RECON RPANCW1A.189
INTEGER RPANCW1A.190
& I_YEAR1, ! Copy of Curent Model Time year RPANCW1A.191
& I_MONTH1, ! " " " month RPANCW1A.192
& I_DAY1, ! " " " day RPANCW1A.193
& I_HOUR1, ! " " " hour RPANCW1A.194
& I_MINUTE1, ! " " " minute RPANCW1A.195
& I_SECOND1 ! " " " second RPANCW1A.196
RPANCW1A.197
INTEGER RPANCW1A.198
& UPDATE_MONTHS ! update frequency (months) if Gregorian RPANCW1A.199
LOGICAL RPANCW1A.200
& LGREG_MONTHLY ! True for Gregorian monthly updating RPANCW1A.201
INTEGER RPANCW1A.202
& I_YEAR_BASIS, ! Basis Model Time RPANCW1A.203
& I_MONTH_BASIS, ! " " " RPANCW1A.204
& I_DAY_BASIS, ! " " " RPANCW1A.205
& I_HOUR_BASIS, ! " " " RPANCW1A.206
& I_MINUTE_BASIS, ! " " " RPANCW1A.207
& I_SECOND_BASIS, ! " " " RPANCW1A.208
& I_DAY_NUMBER_BASIS RPANCW1A.209
INTEGER RPANCW1A.210
& I_YEAR_REF, ! Reference Time RPANCW1A.211
& I_MONTH_REF, ! " " RPANCW1A.212
& I_DAY_REF, ! " " RPANCW1A.213
& I_HOUR_REF, ! " " RPANCW1A.214
& I_MINUTE_REF, ! " " RPANCW1A.215
& I_SECOND_REF ! " " RPANCW1A.216
CCC *ENDIF RPANCW1A.217
RPANCW1A.218
RPANCW1A.219
LOGICAL RPANCW1A.220
& LINTERPOLATE, ! Indicates whether time RPANCW1A.221
C ! interpolation needed. RPANCW1A.222
& LMISMATCH, ! Used in header chacks RPANCW1A.223
& LICE_DEPTH, ! Number of data times skipped RPANCW1A.224
& SINGLE_TIME, ! Indicates that only one time is RPANCW1A.225
C ! available in data set RPANCW1A.226
& PERIODIC, ! Data set is periodic RPANCW1A.227
& REGULAR ! Interval between data times in RPANCW1A.228
C ! dataset is regular in model timesteps. RPANCW1A.229
RPANCW1A.230
REAL RPANCW1A.231
& A_IO ! Used in check for I/O errors RPANCW1A.232
&, TIME ! Target time for time interpolation RPANCW1A.233
&, TIME1 ! Times if data used in time interpn. RPANCW1A.234
&, TIME2 ! " RPANCW1A.235
RPANCW1A.236
RPANCW1A.237
CL 1. Initialisation for ocean RPANCW1A.238
RPANCW1A.239
C Ocean fields RPANCW1A.240
C FIELD= 1 u-component wind RPANCW1A.241
C 2 v-component wind RPANCW1A.242
RPANCW1A.243
IOUNIT=0 RPANCW1A.244
INCR_SEC = 0 RPANCW1A.245
CL 1.1 Set logical switches for each ancillary field independently RPANCW1A.246
RPANCW1A.247
DO FIELD=1,NANCIL_FIELDS RPANCW1A.248
RPANCW1A.249
CCC *IF -DEF,RECON RPANCW1A.250
RPANCW1A.251
UPDATE(FIELD)=.FALSE. RPANCW1A.252
IF(STEPS(FIELD).NE.0) THEN RPANCW1A.253
C UPDATE(FIELD)=MOD(W_STEP,STEPS(FIELD)).EQ.0 RPANCW1A.254
UPDATE(FIELD)=(MOD(W_STEP+OFFSET_STEPS,STEPS(FIELD)).EQ.0 RPANCW1A.255
& .OR.W_STEP.EQ.0) RPANCW1A.256
& .AND.FIELDCODE(1,FIELD).GT.0 RPANCW1A.257
& .AND.D1_ANCILADD(FIELD).GT.1 RPANCW1A.258
END IF RPANCW1A.259
RPANCW1A.260
CL 1.05 Copy ancillary updating reference time to local variables RPANCW1A.261
I_YEAR_REF = ANCIL_REFTIME(1) RPANCW1A.262
I_MONTH_REF = ANCIL_REFTIME(2) RPANCW1A.263
I_DAY_REF = ANCIL_REFTIME(3) RPANCW1A.264
I_HOUR_REF = ANCIL_REFTIME(4) RPANCW1A.265
I_MINUTE_REF = ANCIL_REFTIME(5) RPANCW1A.266
I_SECOND_REF = ANCIL_REFTIME(6) RPANCW1A.267
CL and convert to reference days & secs RPANCW1A.268
CALL TIME2SEC
(I_YEAR_REF,I_MONTH_REF,I_DAY_REF, RPANCW1A.269
& I_HOUR_REF,I_MINUTE_REF,I_SECOND_REF, RPANCW1A.270
& 0,0,ANCIL_REF_DAYS,ANCIL_REF_SECS,LCAL360) RPANCW1A.271
RPANCW1A.272
IF (.NOT. LCAL360) THEN RPANCW1A.273
RPANCW1A.274
CL 1.11 Set logical UPDATE for Gregorian calender updates at monthly RPANCW1A.275
CL or yearly intervals. NB STEPS value set to 1 day in INANCILO RPANCW1A.276
IF(FIELDCODE(1,FIELD).EQ.1.OR.FIELDCODE(1,FIELD).EQ.2) THEN RPANCW1A.277
MONTHS=I_MONTH+I_YEAR*12-(I_MONTH_REF+I_YEAR_REF*12) RPANCW1A.278
UPDATE_MONTHS= FIELDCODE(2,FIELD)* RPANCW1A.279
& ((3-FIELDCODE(1,FIELD))/2 *12+ 1-(3-FIELDCODE(1,FIELD))/2) RPANCW1A.280
UPDATE(FIELD)=MOD(MONTHS,UPDATE_MONTHS).EQ.0.AND.I_DAY.EQ.1 RPANCW1A.281
END IF RPANCW1A.282
RPANCW1A.283
END IF RPANCW1A.284
CCC *ELSE RPANCW1A.285
CCC UPDATE(FIELD)=FIELDCODE(FIELD).GT.0 RPANCW1A.286
CCC *ENDIF RPANCW1A.287
RPANCW1A.288
END DO RPANCW1A.289
RPANCW1A.290
RPANCW1A.291
CL Loop over ancillary fields (wave) RPANCW1A.292
RPANCW1A.293
DO FIELD=1,NANCIL_FIELDS RPANCW1A.294
RPANCW1A.295
RPANCW1A.296
IF (UPDATE(FIELD)) THEN ! (1st level IF block) RPANCW1A.297
FILE=FILEANCIL(FIELD) RPANCW1A.298
NFTIN=FTNANCIL(FILE) RPANCW1A.299
RPANCW1A.300
C Update required for field RPANCW1A.301
RPANCW1A.302
WRITE(6,*)'REPLANCW: UPDATE REQUIRED FOR FIELD',FIELD GIE0F403.612
RPANCW1A.304
CL Check whether more than one data time available in data set RPANCW1A.305
RPANCW1A.306
SINGLE_TIME=FIXHD(10,FILE).EQ.0 RPANCW1A.307
RPANCW1A.308
CL Set default values for time interpolation RPANCW1A.309
RPANCW1A.310
LINTERPOLATE=.TRUE. RPANCW1A.311
IF(SINGLE_TIME) THEN RPANCW1A.312
LINTERPOLATE=.FALSE. RPANCW1A.313
END IF RPANCW1A.314
RPANCW1A.315
RPANCW1A.316
CL 2.1 Find position of input record RPANCW1A.317
RPANCW1A.318
CL Default settings of search parameters if only one time present RPANCW1A.319
RPANCW1A.320
IF(SINGLE_TIME) THEN RPANCW1A.321
STEP=0 RPANCW1A.322
ELSE RPANCW1A.323
RPANCW1A.324
CCC *IF -DEF,RECON RPANCW1A.325
RPANCW1A.326
UPDATE_MONTHS=0 RPANCW1A.327
LGREG_MONTHLY=.FALSE. RPANCW1A.328
IF (.NOT. LCAL360) THEN RPANCW1A.329
RPANCW1A.330
IF(FIELDCODE(1,FIELD).EQ.1.OR.FIELDCODE(1,FIELD).EQ.2) THEN RPANCW1A.331
LGREG_MONTHLY=.TRUE. RPANCW1A.332
UPDATE_MONTHS= FIELDCODE(2,FIELD)* RPANCW1A.333
& ((3-FIELDCODE(1,FIELD))/2 *12+ 1-(3-FIELDCODE(1,FIELD))/2) RPANCW1A.334
END IF RPANCW1A.335
RPANCW1A.336
END IF RPANCW1A.337
CCC *ENDIF RPANCW1A.338
RPANCW1A.339
PERIODIC=FIXHD(10,FILE).EQ.2 RPANCW1A.340
REGULAR=.TRUE. RPANCW1A.341
IF (.NOT. LCAL360) THEN RPANCW1A.342
RPANCW1A.343
REGULAR=FIXHD(35,FILE).EQ.0.AND.FIXHD(36,FILE). RPANCW1A.344
& EQ.0 RPANCW1A.345
C i.e. data at intervals of days/hours & non-periodic RPANCW1A.346
IF(PERIODIC) REGULAR=REGULAR.AND.FIXHD(37,FILE).EQ.0 RPANCW1A.347
C i.e. data at intervals of hours & periodic RPANCW1A.348
RPANCW1A.349
END IF RPANCW1A.350
IF(.NOT.PERIODIC) THEN RPANCW1A.351
RPANCW1A.352
CL If data taken from full time series of input data. RPANCW1A.353
RPANCW1A.354
CALL TIME2SEC
(I_YEAR,I_MONTH,I_DAY,I_HOUR RPANCW1A.355
& ,I_MINUTE,I_SECOND RPANCW1A.356
& ,ANCIL_REF_DAYS,ANCIL_REF_SECS,DAY,SEC RPANCW1A.357
& ,LCAL360) RPANCW1A.358
RPANCW1A.359
CCC *IF -DEF,RECON RPANCW1A.360
RPANCW1A.361
CL Adjust time to middle of updating interval RPANCW1A.362
RPANCW1A.363
IF(.NOT.LGREG_MONTHLY) THEN RPANCW1A.364
SEC=SEC+STEPS(FIELD)*W_SECS_P_P/(W_STEPS_P_P*2) RPANCW1A.365
RPANCW1A.366
C If start-up, adjust for offset of reference time from initial time, RPANCW1A.367
C & update with values for half a period before first standard update. RPANCW1A.368
IF (W_STEP.EQ.0) THEN RPANCW1A.369
DAY1 = DAY RPANCW1A.370
SEC1 = SEC RPANCW1A.371
INCR_SEC = -W_SECS_P_P*MOD(OFFSET_STEPS,STEPS(FIELD))/W_STEPS_P_P RPANCW1A.372
CALL TIME_DF
(DAY1,SEC1,0,INCR_SEC,DAY,SEC) RPANCW1A.373
END IF RPANCW1A.374
RPANCW1A.375
ELSE RPANCW1A.376
IM=MOD(I_MONTH+UPDATE_MONTHS-1,12) + 1 RPANCW1A.377
IY=I_YEAR+(I_MONTH+UPDATE_MONTHS-1)/12 RPANCW1A.378
CALL TIME2SEC
(IY,IM,I_DAY,I_HOUR RPANCW1A.379
& ,I_MINUTE,I_SECOND RPANCW1A.380
& ,ANCIL_REF_DAYS,ANCIL_REF_SECS,DAY1,SEC1 RPANCW1A.381
& ,LCAL360) RPANCW1A.382
IF (MOD(DAY+DAY1,2).EQ.0) THEN RPANCW1A.383
DAY=(DAY+DAY1)/2 RPANCW1A.384
SEC=(SEC+SEC1)/2 RPANCW1A.385
ELSE RPANCW1A.386
DAY=(DAY+DAY1-1)/2 RPANCW1A.387
SEC=(SEC+SEC1+86400)/2 RPANCW1A.388
ENDIF RPANCW1A.389
C If start-up, adjust for offset of reference time from initial time, RPANCW1A.390
C & update with values for half a period before first standard update. RPANCW1A.391
IF (W_STEP.EQ.0) THEN RPANCW1A.392
DAY1 = DAY RPANCW1A.393
SEC1 = SEC RPANCW1A.394
INCR_SEC = -W_SECS_P_P*MOD(OFFSET_STEPS,STEPS(FIELD))/W_STEPS_P_P RPANCW1A.395
CALL TIME_DF
(DAY1,SEC1,0,INCR_SEC,DAY,SEC) RPANCW1A.396
END IF RPANCW1A.397
ENDIF RPANCW1A.398
RPANCW1A.399
CCC *ENDIF RPANCW1A.400
RPANCW1A.401
IF(REGULAR) THEN RPANCW1A.402
CL 2.1.1 Standard cases:360 day calender; RPANCW1A.403
CL 2.1.1 or Gregorian calendar with RPANCW1A.404
CL interval between data times in days or hours RPANCW1A.405
CL updating interval may be regular in model timesteps, RPANCW1A.406
CL or (LGREG_MONTHLY=T) irregular in model timesteps, RPANCW1A.407
RPANCW1A.408
DAYS =DAY RPANCW1A.409
SECONDS=SEC RPANCW1A.410
CL FInd time(in seconds) of first ancillary data on file RPANCW1A.411
CALL TIME2SEC
(FIXHD(21,FILE),FIXHD(22,FILE), RPANCW1A.412
& FIXHD(23,FILE),FIXHD(24,FILE), RPANCW1A.413
& FIXHD(25,FILE),FIXHD(26,FILE), RPANCW1A.414
& ANCIL_REF_DAYS,ANCIL_REF_SECS,DAY,SEC, RPANCW1A.415
& LCAL360) RPANCW1A.416
DAYS =DAYS -DAY RPANCW1A.417
SECONDS=SECONDS-SEC RPANCW1A.418
SECONDS=SECONDS+86400*DAYS RPANCW1A.419
RPANCW1A.420
IF(SECONDS.LT.0) THEN RPANCW1A.421
ICODE=400+FIELD RPANCW1A.422
CMESSAGE='REPLANCW: Current time precedes start time of data' RPANCW1A.423
RETURN RPANCW1A.424
END IF RPANCW1A.425
RPANCW1A.426
CL FInd interval(in seconds) between ancillary data on file RPANCW1A.427
INTERVAL=(FIXHD(35,FILE)*8640+FIXHD(36,FILE)*720+ RPANCW1A.428
& FIXHD(37,FILE)*24+FIXHD(38,FILE))*3600+ RPANCW1A.429
& FIXHD(39,FILE)*60+FIXHD(40,FILE) RPANCW1A.430
RPANCW1A.431
C Do not interpolate in time if data time exactly matches model time RPANCW1A.432
RPANCW1A.433
IF(MOD(SECONDS,INTERVAL).EQ.0) THEN RPANCW1A.434
LINTERPOLATE=.FALSE. RPANCW1A.435
END IF RPANCW1A.436
RPANCW1A.437
STEP=SECONDS/INTERVAL RPANCW1A.438
TIME=REAL(SECONDS) RPANCW1A.439
TIME1=STEP*INTERVAL RPANCW1A.440
TIME2=(STEP+1)*INTERVAL RPANCW1A.441
RPANCW1A.442
ELSE RPANCW1A.443
RPANCW1A.444
CL 2.1.2 Gregorian calender;ancillary data interval is in months or RPANCW1A.445
CL years,which is irregular in model timesteps. RPANCW1A.446
RPANCW1A.447
CCC *IF -DEF,RECON RPANCW1A.448
RPANCW1A.449
CL Adjust YMD time to middle of updating interval RPANCW1A.450
RPANCW1A.451
I_YEAR1=I_YEAR RPANCW1A.452
I_MONTH1=I_MONTH RPANCW1A.453
I_DAY1=I_DAY RPANCW1A.454
I_HOUR1=I_HOUR RPANCW1A.455
CALL SEC2TIME
(DAY,SEC,ANCIL_REF_DAYS,ANCIL_REF_SECS, RPANCW1A.456
& I_YEAR,I_MONTH,I_DAY, RPANCW1A.457
& I_HOUR,I_MINUTE,I_SECOND,I_DAY_NUMBER, RPANCW1A.458
& LCAL360) RPANCW1A.459
RPANCW1A.460
CCC *ENDIF RPANCW1A.461
RPANCW1A.462
CL Find interval(in months) between ancillary data on file RPANCW1A.463
INTERVAL=FIXHD(35,FILE)*12+FIXHD(36,FILE) RPANCW1A.464
MONTHS=I_YEAR*12+I_MONTH RPANCW1A.465
START_MONTH=FIXHD(21,FILE)*12+FIXHD(22,FILE) RPANCW1A.466
MONTHS=MONTHS-START_MONTH RPANCW1A.467
C Check for time within month RPANCW1A.468
IF((I_DAY*24+I_HOUR).LT. RPANCW1A.469
* (FIXHD(23,FILE)*24+FIXHD(24,FILE))) THEN RPANCW1A.470
MONTHS=MONTHS-1 RPANCW1A.471
END IF RPANCW1A.472
RPANCW1A.473
IF(MONTHS.LT.0) THEN RPANCW1A.474
ICODE=400+FIELD RPANCW1A.475
CMESSAGE='REPLANCW: Current time precedes start time of data' RPANCW1A.476
RETURN RPANCW1A.477
END IF RPANCW1A.478
RPANCW1A.479
CCC *IF -DEF,RECON RPANCW1A.480
RPANCW1A.481
CL Adjust YMD time back to start of updating interval RPANCW1A.482
RPANCW1A.483
I_YEAR=I_YEAR1 RPANCW1A.484
I_MONTH=I_MONTH1 RPANCW1A.485
I_DAY=I_DAY1 RPANCW1A.486
I_HOUR=I_HOUR1 RPANCW1A.487
RPANCW1A.488
CCC *ENDIF RPANCW1A.489
RPANCW1A.490
RPANCW1A.491
STEP=MONTHS/INTERVAL RPANCW1A.492
C NB INTERVAL may be > 1 month RPANCW1A.493
MONTHS=STEP*INTERVAL RPANCW1A.494
C Calculate data times for time interpolation RPANCW1A.495
TIME=REAL(SEC)/3600+REAL(DAY*24) RPANCW1A.496
IM=MOD(FIXHD(22,FILE)+MONTHS-1,12)+1 RPANCW1A.497
IY=FIXHD(21,FILE)+(MONTHS+FIXHD(22,FILE)-1)/12 RPANCW1A.498
CALL TIME2SEC
(IY,IM,FIXHD(23,FILE),FIXHD(24,FILE), RPANCW1A.499
& FIXHD(25,FILE),FIXHD(26,FILE), RPANCW1A.500
& ANCIL_REF_DAYS,ANCIL_REF_SECS,DAY,SEC, RPANCW1A.501
& LCAL360) RPANCW1A.502
TIME1=REAL(SEC)/3600+REAL(DAY*24) RPANCW1A.503
IM=MOD(FIXHD(22,FILE)+MONTHS+INTERVAL-1,12)+1 RPANCW1A.504
IY=FIXHD(21,FILE)+(MONTHS+INTERVAL+FIXHD(22,FILE)-1)/12 RPANCW1A.505
CALL TIME2SEC
(IY,IM,FIXHD(23,FILE),FIXHD(24,FILE), RPANCW1A.506
& FIXHD(25,FILE),FIXHD(26,FILE), RPANCW1A.507
& ANCIL_REF_DAYS,ANCIL_REF_SECS,DAY,SEC, RPANCW1A.508
& LCAL360) RPANCW1A.509
TIME2=REAL(SEC)/3600+REAL(DAY*24) RPANCW1A.510
RPANCW1A.511
C Do not interpolate in time if data time exactly matches model time RPANCW1A.512
RPANCW1A.513
IF(TIME.EQ.TIME1) THEN RPANCW1A.514
LINTERPOLATE=.FALSE. RPANCW1A.515
END IF RPANCW1A.516
RPANCW1A.517
ENDIF ! End of REGULAR/not REGULAR RPANCW1A.518
RPANCW1A.519
ELSE ! PERIODIC data RPANCW1A.520
RPANCW1A.521
CL 2.2 If data is taken from ancillary periodic data. RPANCW1A.522
RPANCW1A.523
CALL TIME2SEC
(I_YEAR,I_MONTH,I_DAY,I_HOUR, RPANCW1A.524
& I_MINUTE,I_SECOND, RPANCW1A.525
& ANCIL_REF_DAYS,ANCIL_REF_SECS,DAY,SEC, RPANCW1A.526
& LCAL360) RPANCW1A.527
RPANCW1A.528
*IF -DEF,RECON RPANCW1A.529
RPANCW1A.530
CL Adjust time to middle of updating interval RPANCW1A.531
RPANCW1A.532
IF(.NOT.LGREG_MONTHLY) THEN RPANCW1A.533
SEC=SEC+STEPS(FIELD)*W_SECS_P_P/(W_STEPS_P_P*2) RPANCW1A.534
RPANCW1A.535
C If start-up, adjust for offset of reference time from initial time, RPANCW1A.536
C & update with values for half a period before first standard update. RPANCW1A.537
IF (W_STEP.EQ.0) THEN RPANCW1A.538
DAY1 = DAY RPANCW1A.539
SEC1 = SEC RPANCW1A.540
INCR_SEC = -W_SECS_P_P*MOD(OFFSET_STEPS,STEPS(FIELD))/W_STEPS_P_P RPANCW1A.541
CALL TIME_DF
(DAY1,SEC1,0,INCR_SEC,DAY,SEC) RPANCW1A.542
END IF RPANCW1A.543
RPANCW1A.544
ELSE RPANCW1A.545
IM=MOD(I_MONTH+UPDATE_MONTHS-1,12) + 1 RPANCW1A.546
IY=I_YEAR+(I_MONTH+UPDATE_MONTHS-1)/12 RPANCW1A.547
CALL TIME2SEC
(IY,IM,I_DAY,I_HOUR RPANCW1A.548
& ,I_MINUTE,I_SECOND RPANCW1A.549
& ,ANCIL_REF_DAYS,ANCIL_REF_SECS,DAY1,SEC1 RPANCW1A.550
& ,LCAL360) RPANCW1A.551
IF (MOD(DAY+DAY1,2).EQ.0) THEN RPANCW1A.552
DAY=(DAY+DAY1)/2 RPANCW1A.553
SEC=(SEC+SEC1)/2 RPANCW1A.554
ELSE RPANCW1A.555
DAY=(DAY+DAY1-1)/2 RPANCW1A.556
SEC=(SEC+SEC1+86400)/2 RPANCW1A.557
ENDIF RPANCW1A.558
C If start-up, adjust for offset of reference time from initial time, RPANCW1A.559
C & update with values for half a period before first standard update. RPANCW1A.560
IF (W_STEP.EQ.0) THEN RPANCW1A.561
DAY1 = DAY RPANCW1A.562
SEC1 = SEC RPANCW1A.563
INCR_SEC = -W_SECS_P_P*MOD(OFFSET_STEPS,STEPS(FIELD))/W_STEPS_P_P RPANCW1A.564
CALL TIME_DF
(DAY1,SEC1,0,INCR_SEC,DAY,SEC) RPANCW1A.565
END IF RPANCW1A.566
ENDIF RPANCW1A.567
RPANCW1A.568
RPANCW1A.569
CL Adjust YMD time to middle of updating interval RPANCW1A.570
RPANCW1A.571
I_YEAR1=I_YEAR RPANCW1A.572
I_MONTH1=I_MONTH RPANCW1A.573
I_DAY1=I_DAY RPANCW1A.574
I_HOUR1=I_HOUR RPANCW1A.575
I_MINUTE1=I_MINUTE RPANCW1A.576
I_SECOND1=I_SECOND RPANCW1A.577
CALL SEC2TIME
(DAY,SEC,ANCIL_REF_DAYS,ANCIL_REF_SECS, RPANCW1A.578
& I_YEAR,I_MONTH,I_DAY, RPANCW1A.579
& I_HOUR,I_MINUTE,I_SECOND,I_DAY_NUMBER, RPANCW1A.580
& LCAL360) RPANCW1A.581
RPANCW1A.582
RPANCW1A.583
*ENDIF RPANCW1A.584
RPANCW1A.585
IF (REGULAR) THEN RPANCW1A.586
CL 2.2.1 Standard cases:1) 360 day calender, with allowed periods of RPANCW1A.587
CL 1 day, 1 month or 1 year; RPANCW1A.588
CL RPANCW1A.589
CL 2) Gregorian calender with update in hours,and period of RPANCW1A.590
CL data 1 day. RPANCW1A.591
CL RPANCW1A.592
CL For both updating interval and number of RPANCW1A.593
CL data times to be skipped in data set calculated in seconds. RPANCW1A.594
RPANCW1A.595
DAYS =DAY RPANCW1A.596
SECONDS=SEC RPANCW1A.597
INTERVAL=(FIXHD(35,FILE)*8640+FIXHD(36,FILE)*720+ RPANCW1A.598
& FIXHD(37,FILE)*24+FIXHD(38,FILE))*3600+ RPANCW1A.599
& FIXHD(39,FILE)*60+FIXHD(40,FILE) RPANCW1A.600
RPANCW1A.601
C PERIOD=INTHD(3,FILE)*INTERVAL RPANCW1A.602
PERIOD=(FIXHD(28,FILE)-FIXHD(21,FILE))*8640*3600 RPANCW1A.603
& + (FIXHD(29,FILE)-FIXHD(22,FILE))*720*3600 RPANCW1A.604
& + (FIXHD(30,FILE)-FIXHD(23,FILE))*24*3600 RPANCW1A.605
& + (FIXHD(31,FILE)-FIXHD(24,FILE))*3600 RPANCW1A.606
& + (FIXHD(32,FILE)-FIXHD(25,FILE))*60 RPANCW1A.607
& + (FIXHD(33,FILE)-FIXHD(26,FILE))+INTERVAL RPANCW1A.608
PERIOD=PERIOD/3600 RPANCW1A.609
RPANCW1A.610
CL Do not allow non-standard periods RPANCW1A.611
RPANCW1A.612
IF (LCAL360) THEN RPANCW1A.613
RPANCW1A.614
IF(PERIOD.NE.8640.AND.PERIOD.NE.720.AND.PERIOD.NE.24)THEN RPANCW1A.615
ICODE=600+FIELD RPANCW1A.616
CMESSAGE='REPLANCW: Non-standard period for periodic data' RPANCW1A.617
RETURN RPANCW1A.618
ENDIF RPANCW1A.619
ELSE RPANCW1A.620
IF(PERIOD.NE.24)THEN RPANCW1A.621
ICODE=600+FIELD RPANCW1A.622
CMESSAGE='REPLANCW: Non-standard period for periodic data' RPANCW1A.623
RETURN RPANCW1A.624
ENDIF RPANCW1A.625
END IF RPANCW1A.626
IF(PERIOD.EQ.24)THEN RPANCW1A.627
C Ancillary data interval in hour(s), period is 1 day RPANCW1A.628
RPANCW1A.629
IY=I_YEAR RPANCW1A.630
IM=I_MONTH RPANCW1A.631
ID=I_DAY RPANCW1A.632
IF((I_HOUR*3600+I_MINUTE*60+I_SECOND).LT.(FIXHD(24,FILE) RPANCW1A.633
& *3600+FIXHD(25,FILE)*60+FIXHD(26,FILE))) RPANCW1A.634
& DAYS=DAYS+1 RPANCW1A.635
RPANCW1A.636
ELSE IF(PERIOD.EQ.720)THEN RPANCW1A.637
C Ancillary data interval in day(s) or hours , period is 1 month RPANCW1A.638
RPANCW1A.639
IY=I_YEAR RPANCW1A.640
IM=I_MONTH RPANCW1A.641
ID=FIXHD(23,FILE) RPANCW1A.642
IF((I_DAY*24*3600+I_HOUR*3600+I_MINUTE*60+I_SECOND).LT. RPANCW1A.643
& (FIXHD(23,FILE)*24*3600+FIXHD(24,FILE)*3600+ RPANCW1A.644
& FIXHD(25,FILE)*60+FIXHD(26,FILE))) RPANCW1A.645
& DAYS=DAYS+30 RPANCW1A.646
RPANCW1A.647
ELSE IF(PERIOD.EQ.8640)THEN RPANCW1A.648
C Ancillary data interval in month(s)or days or hours, period is 1 year RPANCW1A.649
RPANCW1A.650
IY=I_YEAR RPANCW1A.651
IM=FIXHD(22,FILE) RPANCW1A.652
ID=FIXHD(23,FILE) RPANCW1A.653
IF((I_MONTH*720*3600+I_DAY*24*3600+I_HOUR*3600+ RPANCW1A.654
& I_MINUTE*60+I_SECOND).LT.(FIXHD(22,FILE)*720*3600+ RPANCW1A.655
& FIXHD(23,FILE)*24*3600+FIXHD(24,FILE)*3600+ RPANCW1A.656
& FIXHD(25,FILE)*60+FIXHD(26,FILE))) RPANCW1A.657
& DAYS=DAYS+360 RPANCW1A.658
RPANCW1A.659
END IF RPANCW1A.660
RPANCW1A.661
CALL TIME2SEC
(IY,IM,ID,FIXHD(24,FILE), RPANCW1A.662
& FIXHD(25,FILE),FIXHD(26,FILE), RPANCW1A.663
& ANCIL_REF_DAYS,ANCIL_REF_SECS,DAY,SEC, RPANCW1A.664
& LCAL360) RPANCW1A.665
DAYS =DAYS -DAY RPANCW1A.666
SECONDS=SECONDS-SEC RPANCW1A.667
SECONDS=SECONDS+86400*DAYS RPANCW1A.668
RPANCW1A.669
C Do not interpolate in time if data time exactly matches model time RPANCW1A.670
RPANCW1A.671
IF(MOD(SECONDS,INTERVAL).EQ.0) THEN RPANCW1A.672
LINTERPOLATE=.FALSE. RPANCW1A.673
END IF RPANCW1A.674
STEP=SECONDS/INTERVAL RPANCW1A.675
TIME=REAL(SECONDS) RPANCW1A.676
TIME1=STEP*INTERVAL RPANCW1A.677
TIME2=(STEP+1)*INTERVAL RPANCW1A.678
RPANCW1A.679
ELSE ! non regular case RPANCW1A.680
RPANCW1A.681
CL 2.2.2 Gregorian calender,and data interval is in months, RPANCW1A.682
CL period is 1 year RPANCW1A.683
CL Updating interval and number of data times to be skipped RPANCW1A.684
CL calculated in months. RPANCW1A.685
RPANCW1A.686
TIME=REAL(SEC)/3600+REAL(DAY*24) RPANCW1A.687
INTERVAL=FIXHD(36,FILE)+FIXHD(35,FILE)*12 RPANCW1A.688
C PERIOD=INTHD(3,FILE)*INTERVAL RPANCW1A.689
PERIOD=(FIXHD(28,FILE)-FIXHD(21,FILE))*12 RPANCW1A.690
& + (FIXHD(29,FILE)-FIXHD(22,FILE))+INTERVAL RPANCW1A.691
IF(PERIOD.NE.12)THEN RPANCW1A.692
ICODE=600+FIELD RPANCW1A.693
CMESSAGE='REPLANCW: Non-standard period for periodic data' RPANCW1A.694
RETURN RPANCW1A.695
ENDIF RPANCW1A.696
RPANCW1A.697
MONTHS=I_MONTH-FIXHD(22,FILE) RPANCW1A.698
C Check for time within month RPANCW1A.699
IF((I_DAY*24+I_HOUR).LT. RPANCW1A.700
& (FIXHD(23,FILE)*24+FIXHD(24,FILE))) THEN RPANCW1A.701
MONTHS=MONTHS-1 RPANCW1A.702
END IF RPANCW1A.703
IF(MONTHS.LT.0) THEN RPANCW1A.704
MONTHS=MONTHS+12 RPANCW1A.705
END IF RPANCW1A.706
RPANCW1A.707
STEP=MONTHS/INTERVAL RPANCW1A.708
C NB INTERVAL may be > 1 month RPANCW1A.709
MONTHS=STEP*INTERVAL RPANCW1A.710
C Calculate TIME1 for first ancillary data time RPANCW1A.711
C set IY correctly for time interpolation calculations RPANCW1A.712
IY=I_YEAR RPANCW1A.713
IM=MOD(FIXHD(22,FILE)+MONTHS-1,12)+1 RPANCW1A.714
IF(IM.GT.I_MONTH) IY=IY-1 RPANCW1A.715
CALL TIME2SEC
(IY,IM,FIXHD(23,FILE),FIXHD(24,FILE), RPANCW1A.716
& FIXHD(25,FILE),FIXHD(26,FILE), RPANCW1A.717
& ANCIL_REF_DAYS,ANCIL_REF_SECS,DAY,SEC,LCAL360) RPANCW1A.718
TIME1=REAL(SEC)/3600+REAL(DAY*24) RPANCW1A.719
C Calculate TIME2 for second ancillary data time RPANCW1A.720
C set IY correctly for time interpolation calculations RPANCW1A.721
IY=I_YEAR RPANCW1A.722
IM=MOD(FIXHD(22,FILE)+MONTHS+INTERVAL-1,12)+1 RPANCW1A.723
IF(IM.LT.I_MONTH) IY=IY+1 RPANCW1A.724
CALL TIME2SEC
(IY,IM,FIXHD(23,FILE),FIXHD(24,FILE), RPANCW1A.725
& FIXHD(25,FILE),FIXHD(26,FILE), RPANCW1A.726
& ANCIL_REF_DAYS,ANCIL_REF_SECS,DAY,SEC,LCAL360) RPANCW1A.727
TIME2=REAL(SEC)/3600+REAL(DAY*24) RPANCW1A.728
RPANCW1A.729
C Do not interpolate in time if data time exactly matches model time RPANCW1A.730
RPANCW1A.731
IF(TIME.EQ.TIME1) THEN RPANCW1A.732
LINTERPOLATE=.FALSE. RPANCW1A.733
END IF RPANCW1A.734
RPANCW1A.735
ENDIF ! regular/non-regular RPANCW1A.736
RPANCW1A.737
*IF -DEF,RECON RPANCW1A.738
RPANCW1A.739
CL Adjust YMD time back to start of updating interval RPANCW1A.740
RPANCW1A.741
I_YEAR=I_YEAR1 RPANCW1A.742
I_MONTH=I_MONTH1 RPANCW1A.743
I_DAY=I_DAY1 RPANCW1A.744
I_HOUR=I_HOUR1 RPANCW1A.745
I_MINUTE=I_MINUTE1 RPANCW1A.746
I_SECOND=I_SECOND1 RPANCW1A.747
RPANCW1A.748
*ENDIF RPANCW1A.749
RPANCW1A.750
ENDIF ! non-periodic/periodic RPANCW1A.751
RPANCW1A.752
CCC *IF -DEF,RECON RPANCW1A.753
IF (LINTERPOLATE) THEN RPANCW1A.754
WRITE(6,*)' REPLANCW - time interpolation for field ',field GIE0F403.613
WRITE(6,*)' time,time1,time2 ',time,time1,time2 GIE0F403.614
WRITE(6,*)' seconds,int,period ',seconds,interval,period GIE0F403.615
END IF RPANCW1A.758
CCC *ENDIF RPANCW1A.759
RPANCW1A.760
END IF ! singletime/non-singletime RPANCW1A.761
RPANCW1A.762
CL 2.3 Check STASH Code RPANCW1A.763
RPANCW1A.764
I2=NLOOKUP(FIELD)+LOOKUP_STEP(FIELD)*STEP RPANCW1A.765
RPANCW1A.766
I1=LOOKUP(ITEM_CODE,I2+LOOKUP_START(FILE)-1) RPANCW1A.767
RPANCW1A.768
LMISMATCH=.FALSE. RPANCW1A.769
WRITE(6,*)' Information used in checking ancillary data set:', RPANCW1A.770
* ' position of lookup table in dataset:',I2 RPANCW1A.771
WRITE(6,*)' Position of first lookup table referring to ', RPANCW1A.772
* 'data type ',NLOOKUP(FIELD) RPANCW1A.773
WRITE(6,*)' Interval between lookup tables referring to data ', RPANCW1A.774
* 'type ', LOOKUP_STEP(FIELD),' Number of steps', STEP RPANCW1A.775
WRITE(6,*)' STASH code in dataset ',I1, RPANCW1A.776
* ' STASH code requested ',STASHANCIL(FIELD) RPANCW1A.777
WRITE(6,*)'''Start'' position of lookup tables for dataset ', RPANCW1A.778
* 'in overall lookup array ' ,LOOKUP_START(FILE) RPANCW1A.779
RPANCW1A.780
IF(I1.NE.STASHANCIL(FIELD)) THEN RPANCW1A.781
WRITE(6,*)I1,STASHANCIL(FIELD),FIELD RPANCW1A.782
LMISMATCH=.TRUE. RPANCW1A.783
END IF RPANCW1A.784
RPANCW1A.785
CL Error exit if checks fail RPANCW1A.786
RPANCW1A.787
IF(LMISMATCH) THEN RPANCW1A.788
ICODE=200+FIELD RPANCW1A.789
CMESSAGE='REPLANCO: PP HEADERS ON ANCILLARY FILE DO NOT MATCH' RPANCW1A.790
RETURN RPANCW1A.791
END IF RPANCW1A.792
RPANCW1A.793
IF(LINTERPOLATE.AND..NOT.SINGLE_TIME) THEN RPANCW1A.794
CL Check time interpolation factors RPANCW1A.795
IF(TIME.LT.TIME1.OR.TIME.GT.TIME2) THEN RPANCW1A.796
WRITE(6,*)' Information used in interpolation/replacement:' RPANCW1A.797
WRITE(6,*)' Time of first data=', TIME1 RPANCW1A.798
WRITE(6,*)' Validity Time for update=', TIME RPANCW1A.799
WRITE(6,*)' Time of second data=', TIME2 RPANCW1A.800
RPANCW1A.801
ICODE=500+FIELD RPANCW1A.802
CMESSAGE='REPLANCW: TIME INTERPOLATION ERROR' RPANCW1A.803
RETURN RPANCW1A.804
END IF RPANCW1A.805
END IF RPANCW1A.806
RPANCW1A.807
CL 3. Extract ancillary data for field I and transfer to D1 array RPANCW1A.808
RPANCW1A.809
C set accumulated length of fields input to zero RPANCW1A.810
LEN_FLD_ACC = 0 RPANCW1A.811
RPANCW1A.812
C start loop over levels (ends near end of routine) RPANCW1A.813
DO LEVEL=1,LEVELS(FIELD) RPANCW1A.814
RPANCW1A.815
I2LEV = I2 + LEVEL - 1 RPANCW1A.816
RPANCW1A.817
CL 3.0 Determine number of values in each field to be input RPANCW1A.818
RPANCW1A.819
C LEN_FLD is length of first field to be read RPANCW1A.820
LEN_FLD = LOOKUP(LBLREC, LOOKUP_START(FILE) - 1 + I2LEV ) RPANCW1A.821
RPANCW1A.822
IF ( LEN_FLD .GT. IMT*JMT ) THEN RPANCW1A.823
ICODE = 1 RPANCW1A.824
WRITE(6,*) ' length of ancillary field longer than allowed' RPANCW1A.825
WRITE(6,*) 'LEN_FLD, IMT*JMT = ', LEN_FLD, IMT*JMT RPANCW1A.826
CMESSAGE='REPLANCW : field length error' RPANCW1A.827
GO TO 900 RPANCW1A.828
END IF RPANCW1A.829
RPANCW1A.830
RPANCW1A.831
CL 3.1 Read data for single level of ancillary field. RPANCW1A.832
RPANCW1A.833
CALL READFLDS
(NFTIN,1,I2LEV,LOOKUP(1,LOOKUP_START(FILE)), RPANCW1A.834
& LEN1_LOOKUP,ANCIL1,LEN_FLD,FIXHD(1,FILE), RPANCW1A.835
*CALL ARGPPX
RPANCW1A.836
& ICODE,CMESSAGE) RPANCW1A.837
IF(ICODE.GT.0) THEN RPANCW1A.838
ICODE=FIELD+100 RPANCW1A.839
CMESSAGE='REPLANCW :I/O error' RPANCW1A.840
RETURN RPANCW1A.841
END IF RPANCW1A.842
RPANCW1A.843
CLL 3.2 If time interpolation required, read second record RPANCW1A.844
IF(LINTERPOLATE) THEN RPANCW1A.845
RPANCW1A.846
I1LEV=I2LEV+LOOKUP_STEP(FIELD) RPANCW1A.847
RPANCW1A.848
IF (I1LEV.LE.FIXHD(152,FILE)) THEN RPANCW1A.849
CALL READFLDS
(NFTIN,1,I1LEV,LOOKUP(1,LOOKUP_START(FILE)), RPANCW1A.850
& LEN1_LOOKUP,ANCIL2,LEN_FLD,FIXHD(1,FILE), RPANCW1A.851
*CALL ARGPPX
RPANCW1A.852
& ICODE,CMESSAGE) RPANCW1A.853
IF(ICODE.GT.0) THEN RPANCW1A.854
ICODE=FIELD+100 RPANCW1A.855
IOUNIT=NFTIN RPANCW1A.856
CMESSAGE='REPLANCW :I/O error' RPANCW1A.857
RETURN RPANCW1A.858
END IF RPANCW1A.859
RPANCW1A.860
ELSE ! end of data on file RPANCW1A.861
RPANCW1A.862
CL If end of data has been reached go back to the start if periodic RPANCW1A.863
CL otherwise cancel time interpolation RPANCW1A.864
RPANCW1A.865
IF(PERIODIC) THEN RPANCW1A.866
RPANCW1A.867
C find number of field to access RPANCW1A.868
I1LEV=NLOOKUP(FIELD) + LEVEL - 1 RPANCW1A.869
RPANCW1A.870
CALL READFLDS
(NFTIN,1,I1LEV,LOOKUP(1,LOOKUP_START(FILE)), RPANCW1A.871
& LEN1_LOOKUP,ANCIL2,LEN_FLD,FIXHD(1,FILE), RPANCW1A.872
*CALL ARGPPX
RPANCW1A.873
& ICODE,CMESSAGE) RPANCW1A.874
IF(ICODE.GT.0) THEN RPANCW1A.875
ICODE=FIELD+300 RPANCW1A.876
IOUNIT=NFTIN RPANCW1A.877
CMESSAGE='REPLANCW :I/O error' RPANCW1A.878
RETURN RPANCW1A.879
END IF RPANCW1A.880
ELSE RPANCW1A.881
LINTERPOLATE=.FALSE. RPANCW1A.882
END IF RPANCW1A.883
END IF ! end of position of file test RPANCW1A.884
ICODE=0 RPANCW1A.885
END IF ! end of LINTERPOLATE RPANCW1A.886
RPANCW1A.887
CL 3.3 Set number of rows of data (no longer required) RPANCW1A.888
RPANCW1A.889
CL 3.4 Perform time interpolation RPANCW1A.890
RPANCW1A.891
IF(LINTERPOLATE) THEN RPANCW1A.892
RPANCW1A.893
C Linear interpolation in time, unless missing data indicator RPANCW1A.894
C present at either time. RPANCW1A.895
RPANCW1A.896
CALL T_INT
(ANCIL1,TIME1,ANCIL2,TIME2,ANCIL_DATA, RPANCW1A.897
& TIME,LEN_FLD) RPANCW1A.898
RPANCW1A.899
C If no interpolation, copy data into final array RPANCW1A.900
RPANCW1A.901
ELSE RPANCW1A.902
DO I=1,LEN_FLD RPANCW1A.903
ANCIL_DATA(I)=ANCIL1(I) RPANCW1A.904
END DO RPANCW1A.905
END IF RPANCW1A.906
RPANCW1A.907
CL 3.5 Updating action for each field at each level RPANCW1A.908
CL Fields replaced. RPANCW1A.909
RPANCW1A.910
POS_STRT = D1_ANCILADD(FIELD) + LEN_FLD_ACC RPANCW1A.911
DO I=1,LEN_FLD RPANCW1A.912
D1(POS_STRT+I-1)=ANCIL_DATA(I) RPANCW1A.913
END DO RPANCW1A.914
RPANCW1A.915
CL End loop over levels RPANCW1A.916
RPANCW1A.917
LEN_FLD_ACC = LEN_FLD_ACC + LEN_FLD RPANCW1A.918
RPANCW1A.919
END DO ! LEVEL loop ends RPANCW1A.920
RPANCW1A.921
CL End loop over ancillary fields (ocean) RPANCW1A.922
RPANCW1A.923
END IF ! End UPDATE(FIELD) test : 1st level IF block RPANCW1A.924
RPANCW1A.925
END DO RPANCW1A.926
RPANCW1A.927
900 RETURN RPANCW1A.928
END RPANCW1A.929
*ENDIF RPANCW1A.930