SUBROUTINE REPLANCA(I_YEAR,I_MONTH,I_DAY,I_HOUR, 2,36GDG0F401.1356
& I_MINUTE,I_SECOND,I_DAY_NUMBER, GDG0F401.1357
& ANCIL_REFTIME,OFFSET_STEPS, GDG0F401.1358
& P_FIELD,P_ROWS,U_FIELD,D1,LAND, GDG0F401.1359
*IF -DEF,RECON GDG0F401.1360
& A_STEP,LAND_FIELD,STEPS_PER_HR, GDG0F401.1361
*ENDIF GDG0F401.1362
& ICE_FRACTION,TSTAR,TSTAR_ANOM, GDG0F401.1363
& NS_SPACE,FIRST_LAT, GRS2F404.3
& LEN1_LOOKUP,LEN_FIXHD,LEN_INTHD, GDG0F401.1364
& LEN_REALHD,LEN_D1,FIXHD,INTHD,REALHD, GDG0F401.1365
& LOOKUP,RLOOKUP,FTNANCIL,LOOKUP_START, GDG0F401.1366
& NDATASETS,NLOOKUPS, GDG0F401.1367
*CALL ARGPPX 
GDG0F401.1368
*IF DEF,RECON GDG0F401.1369
& LPOLARCHK, UDG4F402.254
& IOUNIT,ICODE,CMESSAGE,LCAL360) ! Intent Out GDG0F401.1370
*ELSE GDG0F401.1371
& ICODE,CMESSAGE,LCAL360) ! Intent Out GDG0F401.1372
*ENDIF GDG0F401.1373
RPANCA1A.67
IMPLICIT NONE RPANCA1A.68
RPANCA1A.69
LOGICAL LCAL360 GSS1F304.547
RPANCA1A.70
INTEGER RPANCA1A.72
& I_YEAR, ! Curent Model Time RPANCA1A.73
& I_MONTH, ! " " " RPANCA1A.74
& I_DAY, ! " " " RPANCA1A.75
& I_HOUR, ! " " " RPANCA1A.76
& I_MINUTE, ! " " " RPANCA1A.77
& I_SECOND, ! " " " RPANCA1A.78
& I_DAY_NUMBER, RPANCA1A.79
& ANCIL_REFTIME(6), ! Reference time for ancillary updating GRB1F304.48
& OFFSET_STEPS, ! Offset in timesteps of ref. from basis GRB1F304.49
RPANCA1A.80
*IF -DEF,RECON RPANCA1A.81
RPANCA1A.82
& A_STEP,LAND_FIELD,STEPS_PER_HR, RPANCA1A.83
RPANCA1A.84
*ENDIF RPANCA1A.85
RPANCA1A.86
& P_FIELD, ! Size of horizontal fields RPANCA1A.88
& P_ROWS, ! RPANCA1A.89
& U_FIELD, ! " " " " RPANCA1A.90
& NDATASETS, ! Number of ancillary datasets RPANCA1A.91
& NLOOKUPS, ! Number of lookup tables RPANCA1A.92
& LEN_D1 ! Size of primary data array RPANCA1A.93
RPANCA1A.94
INTEGER RPANCA1A.95
& LEN1_LOOKUP, ! First dimension of lookup table RPANCA1A.96
& LEN_FIXHD, ! Length of headers in data sets RPANCA1A.97
& LEN_INTHD, ! RPANCA1A.98
& LEN_REALHD, ! RPANCA1A.99
& FIXHD(LEN_FIXHD,NDATASETS), ! Data set headers RPANCA1A.100
& INTHD(LEN_INTHD,NDATASETS), ! RPANCA1A.101
& LOOKUP(LEN1_LOOKUP,NLOOKUPS),! Data set lookup tables RPANCA1A.102
& FTNANCIL(NDATASETS), ! FTN numbers of data sets RPANCA1A.103
& LOOKUP_START(NDATASETS) ! Start of lookup tables RPANCA1A.104
C ! referring to each data set. RPANCA1A.105
RPANCA1A.106
REAL RPANCA1A.107
& D1(LEN_D1), !INOUT Primary data array used to hold RPANCA1A.108
C ! all fields except TSTAR and RPANCA1A.109
C ! ICE_FRACTION RPANCA1A.110
& ICE_FRACTION(P_FIELD), !INOUT Ice fraction, updated if RPANCA1A.111
C ! requested RPANCA1A.112
& TSTAR(P_FIELD), !INOUT TSTAR, updated if requested RPANCA1A.113
& TSTAR_ANOM(P_FIELD),!INOUT SST anomaly,formed in recon; RPANCA1A.114
& ! added if requested in model run RPANCA1A.115
& REALHD(LEN_REALHD,NDATASETS), RPANCA1A.116
& RLOOKUP(LEN1_LOOKUP,NLOOKUPS) RPANCA1A.117
& ,NS_SPACE ! NS latitude spacing GRS2F404.4
& ,FIRST_LAT ! latitude of first gridpoint GRS2F404.5
RPANCA1A.118
LOGICAL RPANCA1A.119
& LAND(P_FIELD) ! Land sea mask RPANCA1A.120
RPANCA1A.121
INTEGER RPANCA1A.122
& ICODE ! Return code RPANCA1A.123
& ,IOUNIT !OUT I/O unit passed out in RECON mode RPANCA1A.124
RPANCA1A.125
CHARACTER*(80) TS150793.167
& CMESSAGE ! Error message RPANCA1A.127
C* RPANCA1A.129
! Comdecks:------------------------------------------------------------ GDG0F401.1374
*CALL CSUBMODL GDG0F401.1375
*CALL CPPXREF GDG0F401.1376
*CALL PPXLOOK GDG0F401.1377
*CALL CANCILA RPANCA1A.131
*CALL CLOOKADD RPANCA1A.132
*CALL CPHYSCON RPANCA1A.133
*IF DEF,MPP GRS2F404.6
*CALL PARVARS GRS2F404.7
*ENDIF GRS2F404.8
RPANCA1A.134
C*L Subroutines called; RPANCA1A.135
RPANCA1A.136
EXTERNAL RPANCA1A.137
& TIME2SEC, RPANCA1A.138
& READFLDS, RPANCA1A.139
& T_INT, RPANCA1A.140
*IF -DEF,RECON RPANCA1A.141
RPANCA1A.142
& TO_LAND_POINTS, RPANCA1A.143
& SEC2TIME,TIME_DF, GRB1F304.50
RPANCA1A.145
*ENDIF RPANCA1A.146
& T_INT_C RPANCA1A.147
RPANCA1A.148
C* RPANCA1A.149
C*L Local real arrays RPANCA1A.150
RPANCA1A.151
REAL RPANCA1A.152
& ANCIL1(P_FIELD), ! Buffers to hold values of ancillary RPANCA1A.153
C ! data for time interpolation. RPANCA1A.154
& ANCIL2(P_FIELD), ! RPANCA1A.155
& ANCIL_DATA(P_FIELD),! Field of ancillary data held prior RPANCA1A.156
C ! to selective updating. RPANCA1A.157
& SNOW_CHANGE(P_FIELD),! Fractional time of change of RPANCA1A.158
C ! snow cover RPANCA1A.159
& ICE_EXTENT(P_FIELD,2),! Fractional time of change RPANCA1A.160
C ! of ice cover RPANCA1A.161
& PRES_VALUE(P_FIELD) ! Prescribed value of data when RPANCA1A.162
C ! controlling field is zero. RPANCA1A.163
&, NO_ICE_EXTENT(P_FIELD)! Indicator for no sea ice RPANCA1A.164
C ! =0 if ice cover RPANCA1A.165
C* RPANCA1A.166
C Local variables RPANCA1A.167
RPANCA1A.168
INTEGER RPANCA1A.169
& I, ! RPANCA1A.170
& I1, ! RPANCA1A.171
& I2, ! RPANCA1A.172
& I3, AWI2F304.2
& ID, ! RPANCA1A.173
& IM, ! RPANCA1A.174
& IY, ! RPANCA1A.175
& K, UDG4F402.255
& FIELD, ! Current field number. RPANCA1A.176
& FILE ! RPANCA1A.177
RPANCA1A.178
INTEGER RPANCA1A.179
& INTERVAL, ! Interval between data times RPANCA1A.180
& STEP, ! Number of data times skipped. RPANCA1A.181
& MONTHS, ! Used in calculation of position RPANCA1A.182
C ! of data required. RPANCA1A.183
& HOURS, ! RPANCA1A.184
& PERIOD, ! Period of periodic data RPANCA1A.185
& START_MONTH, ! RPANCA1A.186
& LEVEL, ! RPANCA1A.187
& NFTIN, ! Current FTN number for ancillary field RPANCA1A.188
& ANCIL_REF_DAYS, ! Ancil.reference time in whole days GRB1F304.51
& ANCIL_REF_SECS, ! Ancil.reference time in extra seconds GRB1F304.52
& DAY,SEC, ! Times relative to reference time GRB1F304.53
& DAY1,SEC1, ! Times relative to reference time GRB1F304.54
& INCR_SEC, ! Increment in sec GRB1F304.55
& LEN RPANCA1A.191
& ,IEND GRS2F404.9
& ,II,ROW_LENGTH,J GRS2F404.10
INTEGER RPANCA1A.193
& I_YEAR1, ! Copy of Curent Model Time year RPANCA1A.194
& I_MONTH1, ! " " " month RPANCA1A.195
& I_DAY1, ! " " " day RPANCA1A.196
& I_HOUR1 ! " " " hour RPANCA1A.197
*IF -DEF,RECON GRS2F404.11
RPANCA1A.198
INTEGER RPANCA1A.199
& UPDATE_MONTHS ! update frequency (months) if Gregorian RPANCA1A.200
LOGICAL RPANCA1A.201
& LGREG_MONTHLY ! True for Gregorian monthly updating RPANCA1A.202
C GSS1F304.548
C *IF -DEF,CAL360 GSS1F304.549
C GSS1F304.550
INTEGER RPANCA1A.204
& I_YEAR_BASIS, ! Basis Model Time RPANCA1A.205
& I_MONTH_BASIS, ! " " " RPANCA1A.206
& I_DAY_BASIS, ! " " " RPANCA1A.207
& I_HOUR_BASIS, ! " " " RPANCA1A.208
& I_MINUTE_BASIS, ! " " " RPANCA1A.209
& I_SECOND_BASIS, ! " " " RPANCA1A.210
& I_DAY_NUMBER_BASIS RPANCA1A.211
C GSS1F304.551
C *ENDIF GSS1F304.552
C GSS1F304.553
RPANCA1A.214
INTEGER GRB1F304.56
& I_YEAR_REF, ! Reference Time GRB1F304.57
& I_MONTH_REF, ! " " GRB1F304.58
& I_DAY_REF, ! " " GRB1F304.59
& I_HOUR_REF, ! " " GRB1F304.60
& I_MINUTE_REF, ! " " GRB1F304.61
& I_SECOND_REF ! " " GRB1F304.62
GRB1F304.63
*ENDIF RPANCA1A.215
RPANCA1A.216
LOGICAL RPANCA1A.217
& LINTERPOLATE, ! Indicates whether time RPANCA1A.218
C ! interpolation needed. RPANCA1A.219
& LT_INT_C, ! Indicates use of controlled time RPANCA1A.220
C ! interpolation RPANCA1A.221
& LMISMATCH, ! Used in header checks RPANCA1A.222
& LICE_FRACTION, ! RPANCA1A.223
& LSNOW_DEPTH, ! RPANCA1A.224
& SINGLE_TIME, ! Indicates that only one time is RPANCA1A.225
C ! available in data set RPANCA1A.226
& PERIODIC, ! Data set is periodic RPANCA1A.227
& REGULAR ! Interval between data times in RPANCA1A.228
C ! dataset is regular in model timesteps. RPANCA1A.229
& ,LICE_DEPTH GRS2F404.12
RPANCA1A.230
REAL RPANCA1A.231
& ZERO, ! RPANCA1A.232
& TIME1, ! Times if data used in time interpolation RPANCA1A.233
& TIME2, ! RPANCA1A.234
& TIME !Target time for time interpolation RPANCA1A.235
& ,LAT_P ! latitude of point GRS2F404.13
*IF DEF,RECON UDG4F402.256
REAL RP_ROW_SUM UDG4F402.257
LOGICAL LPOLARCHK UDG4F402.258
*ENDIF UDG4F402.259
RPANCA1A.236
CL Internal structure RPANCA1A.237
RPANCA1A.238
CL List of Atmosphere & Slab Ancillary fields. GDR1F401.96
*CALL CANCLSTA GDR1F401.97
GDR1F401.98
CL 1. Initialisation for atmosphere RPANCA1A.239
RPANCA1A.240
RPANCA1A.264
ICODE=0 UDG4F402.260
IOUNIT=0 RPANCA1A.265
*IF -DEF,RECON NF171193.2
UPDATE_MONTHS=0 NF171193.3
INCR_SEC = 0 GRB1F304.64
*ENDIF NF171193.4
RPANCA1A.266
! Initialise ANCIL1/2. Includes Halos for MPP runs. APB1F402.272
DO I=1,P_FIELD APB1F402.273
ANCIL1(I)=0.0 APB1F402.274
ANCIL2(I)=0.0 APB1F402.275
ENDDO APB1F402.276
CL 1.1 Set logical UPDATE for each ancillary field independently RB221193.90
RPANCA1A.268
DO FIELD=1,NANCIL_FIELDS RPANCA1A.269
RPANCA1A.270
*IF -DEF,RECON RPANCA1A.271
RPANCA1A.272
UPDATE(FIELD)=.FALSE. RPANCA1A.273
IF(STEPS(FIELD).NE.0) THEN RPANCA1A.274
C UPDATE(FIELD)=MOD(A_STEP,STEPS(FIELD)).EQ.0 GRB1F304.65
UPDATE(FIELD)=(MOD(A_STEP+OFFSET_STEPS,STEPS(FIELD)).EQ.0 GRB1F304.66
& .OR.A_STEP.EQ.0) GRB1F304.67
& .AND.FIELDCODE(1,FIELD).GT.0 RPANCA1A.276
& .AND.D1_ANCILADD(FIELD).GT.1 GDR3F305.311
END IF RPANCA1A.277
GRB1F304.68
CL 1.05 Copy ancillary updating reference time to local variables GRB1F304.69
I_YEAR_REF = ANCIL_REFTIME(1) GRB1F304.70
I_MONTH_REF = ANCIL_REFTIME(2) GRB1F304.71
I_DAY_REF = ANCIL_REFTIME(3) GRB1F304.72
I_HOUR_REF = ANCIL_REFTIME(4) GRB1F304.73
I_MINUTE_REF = ANCIL_REFTIME(5) GRB1F304.74
I_SECOND_REF = ANCIL_REFTIME(6) GRB1F304.75
CL and convert to reference days & secs GRB1F304.76
CALL TIME2SEC(I_YEAR_REF,I_MONTH_REF,I_DAY_REF, GRB1F304.77
& I_HOUR_REF,I_MINUTE_REF,I_SECOND_REF, GRB1F304.78
& 0,0,ANCIL_REF_DAYS,ANCIL_REF_SECS,LCAL360) GRB1F304.79
GRB1F304.80
C GSS1F304.555
IF (.NOT. LCAL360) THEN GSS1F304.556
RPANCA1A.282
CL 1.11 Set logical UPDATE for Gregorian calender updates at monthly RPANCA1A.283
CL or yearly intervals. NB STEPS value set to 1 day in INANCILA RPANCA1A.284
IF(FIELDCODE(1,FIELD).EQ.1.OR.FIELDCODE(1,FIELD).EQ.2) THEN RPANCA1A.285
MONTHS=I_MONTH+I_YEAR*12-(I_MONTH_REF+I_YEAR_REF*12) GRB1F304.81
UPDATE_MONTHS= FIELDCODE(2,FIELD)* RPANCA1A.287
& ((3-FIELDCODE(1,FIELD))/2 *12+ 1-(3-FIELDCODE(1,FIELD))/2) RPANCA1A.288
UPDATE(FIELD)=MOD(MONTHS,UPDATE_MONTHS).EQ.0.AND.I_DAY.EQ.1 RPANCA1A.289
END IF RPANCA1A.290
END IF ! (.NOT.LCAL360) GSS1F304.557
C GSS1F304.558
RPANCA1A.292
*ELSE RPANCA1A.293
RPANCA1A.294
UPDATE(FIELD)=FIELDCODE(FIELD).GT.0 RPANCA1A.295
! Initialise for valid time interpolation in reconfiguration mode. GDG0F401.1378
ANCIL_REF_DAYS = 0 GDG0F401.1379
ANCIL_REF_SECS = 0 GDG0F401.1380
RPANCA1A.296
*ENDIF RPANCA1A.297
RPANCA1A.298
END DO RPANCA1A.299
RPANCA1A.300
CL 1.2 Allow for dependencies between fields RPANCA1A.301
C Sea surface temperature must be updated when sea ice is updated RPANCA1A.302
RPANCA1A.303
UPDATE(28)=UPDATE(27).OR.UPDATE(28) RPANCA1A.304
RPANCA1A.305
C Both surface current components must be updated together RPANCA1A.306
RPANCA1A.307
UPDATE(30)=UPDATE(30).OR.UPDATE(31) RPANCA1A.308
UPDATE(31)=UPDATE(30) RPANCA1A.309
RPANCA1A.310
CL Select method of time interpolation for SST. The interpolation RPANCA1A.311
CL allows for sea ice if ice data is available at the same times RPANCA1A.312
CL as the temperature data. Otherwise linear interpolation is used. RB221193.91
RPANCA1A.314
LT_INT_C=.TRUE. RPANCA1A.315
RPANCA1A.316
IF(UPDATE(28)) THEN RPANCA1A.317
IF(FIXHD(10,FILEANCIL(27)).EQ.0) LT_INT_C=.FALSE. RPANCA1A.318
IF(LT_INT_C) THEN CW150193.3
DO I=21,41 RPANCA1A.319
IF(FIXHD(I,FILEANCIL(27)).NE.FIXHD(I, RPANCA1A.320
& FILEANCIL(28))) THEN RPANCA1A.321
LT_INT_C=.FALSE. RPANCA1A.322
WRITE(6,*)' WARNING:controlled time interpolation for SST', RPANCA1A.323
& ' not available: Mismatch in SST and SEA-ICE ancillary data' RPANCA1A.324
& ,' times in FIXED HEADER' RPANCA1A.325
WRITE(6,*)' position=',I,' SEA-ICE=',FIXHD(I,FILEANCIL(27)) RPANCA1A.326
WRITE(6,*)' position=',I,' SST=',FIXHD(I,FILEANCIL(28)) RPANCA1A.327
END IF RPANCA1A.328
END DO RPANCA1A.329
ENDIF CW150193.4
END IF RPANCA1A.330
RPANCA1A.331
RPANCA1A.332
RPANCA1A.333
CL Loop over ancillary fields(atmosphere) RPANCA1A.334
RPANCA1A.335
DO FIELD=1,NANCIL_FIELDS RPANCA1A.336
RPANCA1A.337
LICE_DEPTH=field.eq.29 ! required for LAMIPII GRS2F404.14
RPANCA1A.339
IF (UPDATE(FIELD)) THEN ! (1st level IF) RPANCA1A.340
FILE=FILEANCIL(FIELD) RPANCA1A.341
NFTIN=FTNANCIL(FILE) RPANCA1A.342
RPANCA1A.343
IF(LICE_DEPTH.AND.LAMIPII) THEN GRS2F404.15
GRS2F404.16
! Uses ice fraction set earlier in field loop. GRS2F404.17
! WARNING this will fail if the order of ancillary fields is ever GRS2F404.18
! changed so that ice-depth preceeds ice fraction GRS2F404.19
! Note : For complete sea ice cover GRS2F404.20
! Arctic ice depth = 2m GRS2F404.21
! Antarctic ice depth = 1m GRS2F404.22
! For ice concentrations less than 1. ice depth is 1 or 2 times conc. GRS2F404.23
! This results in similar values to those from runs using ancillary GRS2F404.24
! files containing ice depths set to 1 or 2m. GRS2F404.25
GRS2F404.26
ROW_LENGTH=P_FIELD/P_ROWS GRS2F404.27
DO I=1,P_ROWS GRS2F404.28
! work out latitude in radians GRS2F404.29
*IF -DEF,MPP GRS2F404.30
LAT_P=FIRST_LAT-NS_SPACE*(I-1) GRS2F404.31
*ELSE GRS2F404.32
LAT_P=FIRST_LAT-NS_SPACE*(I+datastart(2)-Offy-1) GRS2F404.33
*ENDIF GRS2F404.34
DO J=1,ROW_LENGTH GRS2F404.35
II=J+(I-1)*ROW_LENGTH GRS2F404.36
ANCIL_DATA(II)=0.0 GRS2F404.37
IF (ICE_FRACTION(II).gt.0.0) THEN GRS2F404.38
IF (LAT_P.GT.0.0) THEN ! Arctic ice depth GRS2F404.39
ANCIL_DATA(II)=2.*ICE_FRACTION(II) GRS2F404.40
ELSE ! Antarctic ice depth GRS2F404.41
ANCIL_DATA(II)=1.*ICE_FRACTION(II) GRS2F404.42
ENDIF GRS2F404.43
ENDIF GRS2F404.44
ENDDO GRS2F404.45
ENDDO GRS2F404.46
!L Sea ice thickness GRS2F404.47
!L Update over all sea points (all sea ice points are the only GRS2F404.48
!L ones strictly required, but this cannot be determined easily) GRS2F404.49
GRS2F404.50
DO I=1,P_FIELD GRS2F404.51
IF(.NOT.LAND(I)) THEN GRS2F404.52
D1(D1_ANCILADD(FIELD)+I-1)=ANCIL_DATA(I) GRS2F404.53
END IF GRS2F404.54
END DO GRS2F404.55
ELSE GRS2F404.56
C Update required for field RPANCA1A.344
RPANCA1A.345
WRITE(6,*)'REPLANCA: UPDATE REQUIRED FOR FIELD',FIELD GIE0F403.603
RPANCA1A.347
IF ( FIXHD(10,FILE) .LT. 0 .OR. FIXHD(10,FILE) .GT. 2 ) THEN AWI2F304.3
ICODE = 700 + FIELD AWI2F304.4
CMESSAGE = 'REPLANCA: Error in fixed header(10) of ancillary AWI2F304.5
& file ' AWI2F304.6
RETURN AWI2F304.7
ENDIF AWI2F304.8
AWI2F304.9
CL Check whether more than one data time available in data set RPANCA1A.348
RPANCA1A.349
SINGLE_TIME=FIXHD(10,FILE).EQ.0 RPANCA1A.350
RPANCA1A.351
CL Set default values for time interpolation RPANCA1A.352
RPANCA1A.353
LINTERPOLATE=.TRUE. RPANCA1A.354
IF(SINGLE_TIME) THEN RPANCA1A.355
LINTERPOLATE=.FALSE. RPANCA1A.356
END IF RPANCA1A.357
RPANCA1A.358
IF (FIELD.GT.9 .AND. FIELD.LT.27) THEN GDR4F400.3
LINTERPOLATE=.FALSE. RPANCA1A.360
END IF RPANCA1A.361
RPANCA1A.362
CL 2.1 Find position of input record RPANCA1A.363
RPANCA1A.364
CL Default settings of search parameters if only one time present RPANCA1A.365
RPANCA1A.366
IF(SINGLE_TIME) THEN RPANCA1A.367
STEP=0 RPANCA1A.368
ELSE RPANCA1A.369
RPANCA1A.370
*IF -DEF,RECON RPANCA1A.371
RPANCA1A.372
LGREG_MONTHLY=.FALSE. RPANCA1A.373
C GSS1F304.561
IF (.NOT. LCAL360) THEN GSS1F304.562
IF(FIELDCODE(1,FIELD).EQ.1.OR.FIELDCODE(1,FIELD).EQ.2) THEN RPANCA1A.375
LGREG_MONTHLY=.TRUE. RPANCA1A.376
UPDATE_MONTHS= FIELDCODE(2,FIELD)* RPANCA1A.377
& ((3-FIELDCODE(1,FIELD))/2 *12+ 1-(3-FIELDCODE(1,FIELD))/2) RPANCA1A.378
END IF RPANCA1A.379
END IF GSS1F304.563
C GSS1F304.564
RPANCA1A.381
*ENDIF RPANCA1A.382
RPANCA1A.383
PERIODIC=FIXHD(10,FILE).EQ.2 RPANCA1A.384
REGULAR=.TRUE. RPANCA1A.385
RPANCA1A.386
C GSS1F304.567
IF (.NOT. LCAL360) THEN GSS1F304.568
REGULAR=FIXHD(35,FILE).EQ.0.AND.FIXHD(36,FILE). RPANCA1A.389
& EQ.0 RPANCA1A.390
C i.e. data at intervals of days/hours & non-periodic RPANCA1A.391
IF(PERIODIC) REGULAR=REGULAR.AND.FIXHD(37,FILE).EQ.0 RPANCA1A.392
C i.e. data at intervals of hours & periodic RPANCA1A.393
END IF GSS1F304.569
C GSS1F304.570
RPANCA1A.396
C Error checking on time information. AWI2F304.10
AWI2F304.11
IF ( FIXHD(35,FILE) .LT. 0 .OR. AWI2F304.12
& FIXHD(36,FILE) .LT. 0 .OR. FIXHD(36,FILE) .GT. 12 .OR. AWI2F304.13
& REGULAR .AND. ( FIXHD(37,FILE) .LT. 0 .OR. FIXHD(37,FILE) .GT. 31 AWI2F304.14
& .OR. FIXHD(38,FILE) .LT. 0 .OR. FIXHD(38,FILE) .GT. 24 ) ) THEN AWI2F304.15
C FIXHD(39-40) are not used by REPLANCA. AWI2F304.16
C FIXHD(35-37) have already been used if not CAL360. AWI2F304.17
ICODE = 700 + FIELD AWI2F304.18
CMESSAGE = 'REPLANCA: Error in validity time interval given AWI2F304.19
&in ancillary file (FIXHD(35-38))' AWI2F304.20
RETURN AWI2F304.21
ENDIF AWI2F304.22
AWI2F304.23
IF ( FIXHD(21,FILE) .LT. 0 .AND. .NOT. PERIODIC AWI2F304.24
& .OR. .NOT. ( REGULAR .AND. PERIODIC ) .AND. AWI2F304.25
C ! If it is REGULAR & PERIODIC more detailed check is applied below AWI2F304.26
& ( FIXHD(22,FILE) .LT. 0 .OR. FIXHD(22,FILE) .GT. 12 .OR. AWI2F304.27
& FIXHD(23,FILE) .LT. 0 .OR. FIXHD(23,FILE) .GT. 31 .OR. AWI2F304.28
& FIXHD(24,FILE) .LT. 0 .OR. FIXHD(24,FILE) .GT. 24 .OR. AWI2F304.29
& FIXHD(25,FILE) .LT. 0 .OR. FIXHD(25,FILE) .GT. 60 .OR. AWI2F304.30
& FIXHD(26,FILE) .LT. 0 .OR. FIXHD(26,FILE) .GT. 60 ) ) THEN AWI2F304.31
ICODE = 700 + FIELD AWI2F304.32
CMESSAGE = 'REPLANCA: Error in first validity time given in AWI2F304.33
& ancillary file (FIXHD(21-26)) ' AWI2F304.34
RETURN AWI2F304.35
ENDIF AWI2F304.36
AWI2F304.37
IF(.NOT.PERIODIC) THEN RPANCA1A.397
RPANCA1A.398
CL If data taken from full time series of input data. RPANCA1A.399
RPANCA1A.400
CALL TIME2SEC(I_YEAR,I_MONTH,I_DAY,I_HOUR RPANCA1A.401
& ,I_MINUTE,I_SECOND TJ080294.346
& ,ANCIL_REF_DAYS,ANCIL_REF_SECS,DAY,SEC GSS1F304.572
& ,LCAL360) GSS1F304.573
RPANCA1A.403
*IF -DEF,RECON RPANCA1A.404
RPANCA1A.405
CL Adjust time to middle of updating interval RPANCA1A.406
RPANCA1A.407
IF(.NOT.LGREG_MONTHLY) THEN RPANCA1A.408
SEC=SEC+STEPS(FIELD)*1800/STEPS_PER_HR RPANCA1A.409
RPANCA1A.410
C If start-up, adjust for offset of reference time from initial time, GRB1F304.82
C & update with values for half a period before first standard update. GRB1F304.83
IF (A_STEP.EQ.0) THEN GRB1F304.84
DAY1 = DAY GRB1F304.85
SEC1 = SEC GRB1F304.86
INCR_SEC=-3600*MOD(OFFSET_STEPS,STEPS(FIELD))/STEPS_PER_HR GRB1F304.87
CALL TIME_DF(DAY1,SEC1,0,INCR_SEC,DAY,SEC) GRB1F304.88
END IF GRB1F304.89
GRB1F304.90
ELSE RPANCA1A.411
IM=MOD(I_MONTH+UPDATE_MONTHS-1,12) + 1 RPANCA1A.412
IY=I_YEAR+(I_MONTH+UPDATE_MONTHS-1)/12 RPANCA1A.413
CALL TIME2SEC(IY,IM,I_DAY,I_HOUR RPANCA1A.414
& ,I_MINUTE,I_SECOND TJ080294.348
& ,ANCIL_REF_DAYS,ANCIL_REF_SECS,DAY1,SEC1 GSS1F304.574
& ,LCAL360) GSS1F304.575
IF (MOD(DAY+DAY1,2).EQ.0) THEN TJ080294.350
DAY=(DAY+DAY1)/2 TJ080294.351
SEC=(SEC+SEC1)/2 TJ080294.352
ELSE TJ080294.353
DAY=(DAY+DAY1-1)/2 TJ080294.354
SEC=(SEC+SEC1+86400)/2 TJ080294.355
ENDIF TJ080294.356
C If start-up, adjust for offset of reference time from initial time, GRB1F304.91
C & update with values for half a period before first standard update. GRB1F304.92
IF (A_STEP.EQ.0) THEN GRB1F304.93
DAY1 = DAY GRB1F304.94
SEC1 = SEC GRB1F304.95
INCR_SEC=-3600*MOD(OFFSET_STEPS,STEPS(FIELD))/STEPS_PER_HR GRB1F304.96
CALL TIME_DF(DAY1,SEC1,0,INCR_SEC,DAY,SEC) GRB1F304.97
END IF GRB1F304.98
ENDIF RPANCA1A.417
RPANCA1A.418
*ENDIF RPANCA1A.419
RPANCA1A.420
IF(REGULAR) THEN RPANCA1A.421
CL 2.1.1 Standard cases:360 day calender; RPANCA1A.422
CL 2.1.1 or Gregorian calendar with RPANCA1A.423
CL interval between data times in days or hours RPANCA1A.424
CL updating interval may be regular in model timesteps, RPANCA1A.425
CL or (LGREG_MONTHLY=T) irregular in model timesteps, RPANCA1A.426
RPANCA1A.427
HOURS=SEC/3600+DAY*24 TJ080294.357
CL FInd time(in hours) of first ancillary data on file RPANCA1A.429
CALL TIME2SEC(FIXHD(21,FILE),FIXHD(22,FILE), RPANCA1A.430
& FIXHD(23,FILE),FIXHD(24,FILE), RPANCA1A.431
& FIXHD(25,FILE),FIXHD(26,FILE), RPANCA1A.432
& ANCIL_REF_DAYS,ANCIL_REF_SECS,DAY,SEC, GSS1F304.576
& LCAL360) GSS1F304.577
HOURS=HOURS-SEC/3600-DAY*24 TJ080294.359
RPANCA1A.435
IF(HOURS.LT.0) THEN RPANCA1A.436
ICODE=400+FIELD RPANCA1A.437
CMESSAGE='REPLANCA: Current time precedes start time of data' RPANCA1A.438
RETURN RPANCA1A.439
END IF RPANCA1A.440
RPANCA1A.441
CL FInd interval(in hours) between ancillary data on file RPANCA1A.442
INTERVAL=FIXHD(35,FILE)*8640+FIXHD(36,FILE)*720+ RPANCA1A.443
& FIXHD(37,FILE)*24+FIXHD(38,FILE) RPANCA1A.444
RPANCA1A.445
C Do not interpolate in time if data time exactly matches model time RPANCA1A.446
RPANCA1A.447
IF(MOD(HOURS,INTERVAL).EQ.0) THEN RPANCA1A.448
LINTERPOLATE=.FALSE. RPANCA1A.449
END IF RPANCA1A.450
RPANCA1A.451
STEP=HOURS/INTERVAL RPANCA1A.452
TIME=REAL(HOURS) RPANCA1A.453
TIME1=STEP*INTERVAL RPANCA1A.454
TIME2=(STEP+1)*INTERVAL RPANCA1A.455
RPANCA1A.456
ELSE RPANCA1A.457
RPANCA1A.458
CL 2.1.2 Gregorian calender;ancillary data interval is in months or RPANCA1A.459
CL years,which is irregular in model timesteps. RPANCA1A.460
!L original code is inaccurate for this section - corrected code under GRS2F404.57
!L LAMIPII makes use of dates in lookup headers GRS2F404.58
!L For a real calendar year the mid-point of each month is different GRS2F404.59
!L in terms of its hour and day. The old inaccurate method assumes GRS2F404.60
!L the hour and day are taken from the fixhd values. These are only GRS2F404.61
!L usually correct for the first month on the ancillary file. GRS2F404.62
RPANCA1A.461
*IF -DEF,RECON RPANCA1A.462
RPANCA1A.463
CL Adjust YMD time to middle of updating interval RPANCA1A.464
RPANCA1A.465
I_YEAR1=I_YEAR RPANCA1A.466
I_MONTH1=I_MONTH RPANCA1A.467
I_DAY1=I_DAY RPANCA1A.468
I_HOUR1=I_HOUR RPANCA1A.469
CALL SEC2TIME(DAY,SEC,ANCIL_REF_DAYS,ANCIL_REF_SECS, GRB1F304.99
& I_YEAR,I_MONTH,I_DAY, TJ080294.361
& I_HOUR,I_MINUTE,I_SECOND,I_DAY_NUMBER, GSS1F304.578
& LCAL360) GSS1F304.579
RPANCA1A.472
*ENDIF RPANCA1A.473
RPANCA1A.474
CL FInd interval(in months) between ancillary data on file RPANCA1A.475
INTERVAL=FIXHD(35,FILE)*12+FIXHD(36,FILE) RPANCA1A.476
MONTHS=I_YEAR*12+I_MONTH RPANCA1A.477
START_MONTH=FIXHD(21,FILE)*12+FIXHD(22,FILE) RPANCA1A.478
MONTHS=MONTHS-START_MONTH RPANCA1A.479
C Check for time within month RPANCA1A.480
IF (LAMIPII) THEN ! corrected code uses pp header GRS2F404.63
STEP=MONTHS/INTERVAL GRS2F404.64
I2=NLOOKUP(FIELD)+LOOKUP_STEP(FIELD)*STEP GRS2F404.65
I1=I2+LOOKUP_START(FILE)-1 GRS2F404.66
! Check against day and hour of actual lookup header not first field GRS2F404.67
IF((I_DAY*24+I_HOUR).LT. RPANCA1A.481
& (LOOKUP(3,I1)*24+LOOKUP(4,I1))) THEN GRS2F404.68
MONTHS=MONTHS-1 GRS2F404.69
END IF GRS2F404.70
ELSE ! old less accurate code uses FIXHD GRS2F404.71
IF((I_DAY*24+I_HOUR).LT. GRS2F404.72
* (FIXHD(23,FILE)*24+FIXHD(24,FILE))) THEN RPANCA1A.482
MONTHS=MONTHS-1 RPANCA1A.483
END IF RPANCA1A.484
ENDIF ! LAMIPII GRS2F404.73
RPANCA1A.485
IF(MONTHS.LT.0) THEN RPANCA1A.486
ICODE=400+FIELD RPANCA1A.487
CMESSAGE='REPLANCA: Current time precedes start time of data' RPANCA1A.488
RETURN RPANCA1A.489
END IF RPANCA1A.490
RPANCA1A.491
*IF -DEF,RECON RPANCA1A.492
RPANCA1A.493
CL Adjust YMD time back to start of updating interval RPANCA1A.494
RPANCA1A.495
I_YEAR=I_YEAR1 RPANCA1A.496
I_MONTH=I_MONTH1 RPANCA1A.497
I_DAY=I_DAY1 RPANCA1A.498
I_HOUR=I_HOUR1 RPANCA1A.499
RPANCA1A.500
*ENDIF RPANCA1A.501
RPANCA1A.502
RPANCA1A.503
STEP=MONTHS/INTERVAL RPANCA1A.504
GRS2F404.74
IF (LAMIPII) THEN ! corrected code GRS2F404.75
TIME=REAL(SEC)/3600+REAL(DAY*24) GRS2F404.76
! correct calculation of dates uses lookup table dates not fixhd date GRS2F404.77
I2=NLOOKUP(FIELD)+LOOKUP_STEP(FIELD)*STEP GRS2F404.78
I1=I2+LOOKUP_START(FILE)-1 GRS2F404.79
I_YEAR1=lookup(1,i1) GRS2F404.80
I_MONTH1=lookup(2,i1) GRS2F404.81
I_DAY1=lookup(3,i1) GRS2F404.82
I_HOUR1=lookup(4,i1) GRS2F404.83
CALL TIME2SEC(I_YEAR1,I_MONTH1,I_DAY1,I_HOUR1, GRS2F404.84
& FIXHD(25,FILE),FIXHD(26,FILE), GRS2F404.85
& ANCIL_REF_DAYS,ANCIL_REF_SECS,DAY,SEC, GRS2F404.86
& LCAL360) GRS2F404.87
TIME1=REAL(SEC)/3600+REAL(DAY*24) GRS2F404.88
! I1+1 correct pointer to next field as only one field in ancil file GRS2F404.89
I_YEAR1=lookup(1,i1+1) GRS2F404.90
I_MONTH1=lookup(2,i1+1) GRS2F404.91
I_DAY1=lookup(3,i1+1) GRS2F404.92
I_HOUR1=lookup(4,i1+1) GRS2F404.93
CALL TIME2SEC(I_YEAR1,I_MONTH1,I_DAY1,I_HOUR1, GRS2F404.94
& FIXHD(25,FILE),FIXHD(26,FILE), GRS2F404.95
& ANCIL_REF_DAYS,ANCIL_REF_SECS,DAY,SEC, GRS2F404.96
& LCAL360) GRS2F404.97
TIME2=REAL(SEC)/3600+REAL(DAY*24) GRS2F404.98
GRS2F404.99
ELSE ! LAMIPII test - old inaccurate code using FIXHD GRS2F404.100
C NB INTERVAL may be > 1 month RPANCA1A.505
MONTHS=STEP*INTERVAL RPANCA1A.506
C Calculate data times for time interpolation RPANCA1A.507
TIME=REAL(SEC)/3600+REAL(DAY*24) TJ080294.362
IM=MOD(FIXHD(22,FILE)+MONTHS-1,12)+1 RPANCA1A.509
IY=FIXHD(21,FILE)+(MONTHS+FIXHD(22,FILE)-1)/12 RPANCA1A.510
CALL TIME2SEC(IY,IM,FIXHD(23,FILE),FIXHD(24,FILE), RPANCA1A.511
& FIXHD(25,FILE),FIXHD(26,FILE), TJ080294.363
& ANCIL_REF_DAYS,ANCIL_REF_SECS,DAY,SEC, GSS1F304.580
& LCAL360) GSS1F304.581
TIME1=REAL(SEC)/3600+REAL(DAY*24) TJ080294.365
IM=MOD(FIXHD(22,FILE)+MONTHS+INTERVAL-1,12)+1 RPANCA1A.514
IY=FIXHD(21,FILE)+(MONTHS+INTERVAL+FIXHD(22,FILE)-1)/12 RPANCA1A.515
CALL TIME2SEC(IY,IM,FIXHD(23,FILE),FIXHD(24,FILE), RPANCA1A.516
& FIXHD(25,FILE),FIXHD(26,FILE), TJ080294.366
& ANCIL_REF_DAYS,ANCIL_REF_SECS,DAY,SEC, GSS1F304.582
& LCAL360) GSS1F304.583
TIME2=REAL(SEC)/3600+REAL(DAY*24) TJ080294.368
ENDIF ! end LAMIPII test GRS2F404.101
RPANCA1A.519
C Do not interpolate in time if data time exactly matches model time RPANCA1A.520
RPANCA1A.521
IF(TIME.EQ.TIME1) THEN RPANCA1A.522
LINTERPOLATE=.FALSE. RPANCA1A.523
END IF RPANCA1A.524
RPANCA1A.525
ENDIF ! End of REGULAR/not REGULAR RPANCA1A.526
RPANCA1A.527
ELSE ! PERIODIC data RPANCA1A.528
RPANCA1A.529
CL 2.2 If data is taken from ancillary periodic data. RPANCA1A.530
RPANCA1A.531
CALL TIME2SEC(I_YEAR,I_MONTH,I_DAY,I_HOUR, RPANCA1A.532
& I_MINUTE,I_SECOND, TJ080294.369
& ANCIL_REF_DAYS,ANCIL_REF_SECS,DAY,SEC, GSS1F304.584
& LCAL360) GSS1F304.585
RPANCA1A.534
*IF -DEF,RECON RPANCA1A.535
RPANCA1A.536
CL Adjust time to middle of updating interval RPANCA1A.537
RPANCA1A.538
IF(.NOT.LGREG_MONTHLY) THEN RPANCA1A.539
SEC=SEC+STEPS(FIELD)*1800/STEPS_PER_HR RPANCA1A.540
RPANCA1A.541
C If start-up, adjust for offset of reference time from initial time, GRB1F304.100
C & update with values for half a period before first standard update. GRB1F304.101
IF (A_STEP.EQ.0) THEN GRB1F304.102
DAY1 = DAY GRB1F304.103
SEC1 = SEC GRB1F304.104
INCR_SEC=-3600*MOD(OFFSET_STEPS,STEPS(FIELD))/STEPS_PER_HR GRB1F304.105
CALL TIME_DF(DAY1,SEC1,0,INCR_SEC,DAY,SEC) GRB1F304.106
END IF GRB1F304.107
GRB1F304.108
ELSE RPANCA1A.542
IM=MOD(I_MONTH+UPDATE_MONTHS-1,12) + 1 RPANCA1A.543
IY=I_YEAR+(I_MONTH+UPDATE_MONTHS-1)/12 RPANCA1A.544
CALL TIME2SEC(IY,IM,I_DAY,I_HOUR RPANCA1A.545
& ,I_MINUTE,I_SECOND TJ080294.371
& ,ANCIL_REF_DAYS,ANCIL_REF_SECS,DAY1,SEC1 GSS1F304.586
& ,LCAL360) GSS1F304.587
IF (MOD(DAY+DAY1,2).EQ.0) THEN TJ080294.373
DAY=(DAY+DAY1)/2 TJ080294.374
SEC=(SEC+SEC1)/2 TJ080294.375
ELSE TJ080294.376
DAY=(DAY+DAY1-1)/2 TJ080294.377
SEC=(SEC+SEC1+86400)/2 TJ080294.378
ENDIF TJ080294.379
C If start-up, adjust for offset of reference time from initial time, GRB1F304.109
C & update with values for half a period before first standard update. GRB1F304.110
IF (A_STEP.EQ.0) THEN GRB1F304.111
DAY1 = DAY GRB1F304.112
SEC1 = SEC GRB1F304.113
INCR_SEC=-3600*MOD(OFFSET_STEPS,STEPS(FIELD))/STEPS_PER_HR GRB1F304.114
CALL TIME_DF(DAY1,SEC1,0,INCR_SEC,DAY,SEC) GRB1F304.115
END IF GRB1F304.116
ENDIF RPANCA1A.548
RPANCA1A.549
RPANCA1A.550
CL Adjust YMD time to middle of updating interval RPANCA1A.551
RPANCA1A.552
I_YEAR1=I_YEAR RPANCA1A.553
I_MONTH1=I_MONTH RPANCA1A.554
I_DAY1=I_DAY RPANCA1A.555
I_HOUR1=I_HOUR RPANCA1A.556
CALL SEC2TIME(DAY,SEC,ANCIL_REF_DAYS,ANCIL_REF_SECS, GRB1F304.117
& I_YEAR,I_MONTH,I_DAY, TJ080294.381
& I_HOUR,I_MINUTE,I_SECOND,I_DAY_NUMBER, GSS1F304.588
& LCAL360) GSS1F304.589
RPANCA1A.559
RPANCA1A.560
*ENDIF RPANCA1A.561
RPANCA1A.562
IF (REGULAR) THEN RPANCA1A.563
CL 2.2.1 Standard cases:1) 360 day calender, with allowed periods of RPANCA1A.564
CL 1 day, 1 month or 1 year; RPANCA1A.565
CL RPANCA1A.566
CL 2) Gregorian calender with update in hours,and period of RPANCA1A.567
CL data 1 day. RPANCA1A.568
CL RPANCA1A.569
CL For both updating interval and number of RPANCA1A.570
CL data times to be skipped in data set calculated in hours. RPANCA1A.571
RPANCA1A.572
HOURS=SEC/3600+DAY*24 TJ080294.382
INTERVAL=FIXHD(35,FILE)*8640+FIXHD(36,FILE)*720+ RPANCA1A.574
& FIXHD(37,FILE)*24+FIXHD(38,FILE) RPANCA1A.575
RPANCA1A.576
PERIOD=INTHD(3,FILE)*INTERVAL RPANCA1A.577
RPANCA1A.578
CL Do not allow non-standard periods RPANCA1A.579
IF (LCAL360) THEN GSS1F304.590
IF(PERIOD.NE.8640.AND.PERIOD.NE.720.AND.PERIOD.NE.24)THEN RPANCA1A.581
ICODE=600+FIELD RPANCA1A.585
CMESSAGE='REPLANCA: Non-standard period for periodic data' RPANCA1A.586
RETURN RPANCA1A.587
ENDIF RPANCA1A.588
ELSE GSS1F304.591
IF(PERIOD.NE.24)THEN GSS1F304.592
ICODE=600+FIELD GSS1F304.593
CMESSAGE='REPLANCA: Non-standard period for periodic data' GSS1F304.594
RETURN GSS1F304.595
ENDIF GSS1F304.596
ENDIF GSS1F304.597
IF(PERIOD.EQ.24)THEN RPANCA1A.590
C Ancillary data interval in hour(s), period is 1 day RPANCA1A.591
RPANCA1A.592
IY=I_YEAR RPANCA1A.593
IM=I_MONTH RPANCA1A.594
ID=I_DAY RPANCA1A.595
IF(I_HOUR.LT.FIXHD(24,FILE)) HOURS=HOURS+24 RPANCA1A.596
RPANCA1A.597
ELSE IF(PERIOD.EQ.720)THEN RPANCA1A.598
C Ancillary data interval in day(s) or hours , period is 1 month RPANCA1A.599
RPANCA1A.600
IY=I_YEAR RPANCA1A.601
IM=I_MONTH RPANCA1A.602
ID=FIXHD(23,FILE) RPANCA1A.603
IF((I_DAY*24+I_HOUR).LT. RPANCA1A.604
& (FIXHD(23,FILE)*24+FIXHD(24,FILE))) RPANCA1A.605
& HOURS=HOURS+720 RPANCA1A.606
RPANCA1A.607
ELSE IF(PERIOD.EQ.8640)THEN RPANCA1A.608
C Ancillary data interval in month(s)or days or hours, period is 1 year RPANCA1A.609
RPANCA1A.610
IY=I_YEAR RPANCA1A.611
IM=FIXHD(22,FILE) RPANCA1A.612
ID=FIXHD(23,FILE) RPANCA1A.613
IF((I_MONTH*720+I_DAY*24+I_HOUR).LT. RPANCA1A.614
& (FIXHD(22,FILE)*720+FIXHD(23,FILE)*24+FIXHD(24,FILE))) RPANCA1A.615
& HOURS=HOURS+8640 RPANCA1A.616
RPANCA1A.617
END IF RPANCA1A.618
RPANCA1A.619
CALL TIME2SEC(IY,IM,ID,FIXHD(24,FILE), RPANCA1A.620
& FIXHD(25,FILE),FIXHD(26,FILE), RPANCA1A.621
& ANCIL_REF_DAYS,ANCIL_REF_SECS,DAY,SEC, GSS1F304.598
& LCAL360) GSS1F304.599
HOURS=HOURS-SEC/3600-DAY*24 TJ080294.384
RPANCA1A.624
C Do not interpolate in time if data time exactly matches model time RPANCA1A.625
RPANCA1A.626
IF(MOD(HOURS,INTERVAL).EQ.0) THEN RPANCA1A.627
LINTERPOLATE=.FALSE. RPANCA1A.628
END IF RPANCA1A.629
STEP=HOURS/INTERVAL RPANCA1A.630
TIME=REAL(HOURS) RPANCA1A.631
TIME1=STEP*INTERVAL RPANCA1A.632
TIME2=(STEP+1)*INTERVAL RPANCA1A.633
RPANCA1A.634
ELSE ! non regular case RPANCA1A.635
RPANCA1A.636
CL 2.2.2 Gregorian calender,and data interval is in months, RPANCA1A.637
CL period is 1 year RPANCA1A.638
CL Updating interval and number of data times to be skipped RPANCA1A.639
CL calculated in months. RPANCA1A.640
RPANCA1A.641
TIME=REAL(SEC)/3600+REAL(DAY*24) TJ080294.385
INTERVAL=FIXHD(36,FILE)+FIXHD(35,FILE)*12 RPANCA1A.643
PERIOD=INTHD(3,FILE)*INTERVAL RPANCA1A.644
IF(PERIOD.NE.12)THEN RPANCA1A.645
ICODE=600+FIELD RPANCA1A.646
CMESSAGE='REPLANCA: Non-standard period for periodic data' RPANCA1A.647
RETURN RPANCA1A.648
ENDIF RPANCA1A.649
! Difference between date now (month) & first date ancil file (month) GRS2F404.102
MONTHS=I_MONTH-FIXHD(22,FILE) RPANCA1A.651
GRS2F404.103
GRS2F404.104
IF (LAMIPII) THEN ! correct code to use lookup header dates GRS2F404.105
! Correctly use day and hour from lookup header not fixhd which GRS2F404.106
! contains values for first field on ancillary file only. GRS2F404.107
step=months/INTERVAL GRS2F404.108
I2=NLOOKUP(FIELD)+LOOKUP_STEP(FIELD)*step GRS2F404.109
I1=I2+LOOKUP_START(FILE)-1 GRS2F404.110
! Check for time within month - using ppheader information GRS2F404.111
IF((I_DAY*24+I_HOUR).LT.(lookup(3,i1)*24+lookup(4,i1))) THEN GRS2F404.112
MONTHS=MONTHS-1 GRS2F404.113
END IF GRS2F404.114
IF(MONTHS.LT.0) THEN GRS2F404.115
MONTHS=MONTHS+12 GRS2F404.116
END IF GRS2F404.117
! recalculate STEP GRS2F404.118
STEP=MONTHS/INTERVAL GRS2F404.119
! NB INTERVAL may be > 1 month GRS2F404.120
MONTHS=STEP*INTERVAL GRS2F404.121
IY=I_YEAR GRS2F404.122
IM=MOD(FIXHD(22,FILE)+MONTHS-1,12)+1 GRS2F404.123
IF(IM.GT.I_MONTH) IY=IY-1 GRS2F404.124
I2=NLOOKUP(FIELD)+LOOKUP_STEP(FIELD)*STEP GRS2F404.125
I1=I2+LOOKUP_START(FILE)-1 GRS2F404.126
CALL TIME2SEC(IY,IM,lookup(3,i1),lookup(4,i1), GRS2F404.127
& FIXHD(25,FILE),FIXHD(26,FILE), GRS2F404.128
& ANCIL_REF_DAYS,ANCIL_REF_SECS,DAY,SEC,LCAL360) GRS2F404.129
TIME1=REAL(SEC)/3600+REAL(DAY*24) GRS2F404.130
! Calculate TIME2 for second ancillary data time GRS2F404.131
! set IY correctly for time interpolation calculations GRS2F404.132
IY=I_YEAR GRS2F404.133
IM=MOD(FIXHD(22,FILE)+MONTHS+INTERVAL-1,12)+1 GRS2F404.134
IF(IM.LT.I_MONTH) IY=IY+1 GRS2F404.135
I1=(IM-1)/INTERVAL GRS2F404.136
I2=NLOOKUP(FIELD)+LOOKUP_STEP(FIELD)*I1 GRS2F404.137
I1=I2+LOOKUP_START(FILE)-1 GRS2F404.138
CALL TIME2SEC(IY,IM,lookup(3,i1),lookup(4,i1), GRS2F404.139
& FIXHD(25,FILE),FIXHD(26,FILE), GRS2F404.140
& ANCIL_REF_DAYS,ANCIL_REF_SECS,DAY,SEC,LCAL360) GRS2F404.141
TIME2=REAL(SEC)/3600+REAL(DAY*24) GRS2F404.142
GRS2F404.143
ELSE ! original code inaccurate use of FIXHD dates GRS2F404.144
C Check for time within month RPANCA1A.652
IF((I_DAY*24+I_HOUR).LT. RPANCA1A.653
& (FIXHD(23,FILE)*24+FIXHD(24,FILE))) THEN RPANCA1A.654
MONTHS=MONTHS-1 RPANCA1A.655
END IF RPANCA1A.656
IF(MONTHS.LT.0) THEN RPANCA1A.657
MONTHS=MONTHS+12 RPANCA1A.658
END IF RPANCA1A.659
RPANCA1A.660
STEP=MONTHS/INTERVAL RPANCA1A.661
C NB INTERVAL may be > 1 month RPANCA1A.662
MONTHS=STEP*INTERVAL RPANCA1A.663
C Calculate TIME1 for first ancillary data time RPANCA1A.664
C set IY correctly for time interpolation calculations RPANCA1A.665
IY=I_YEAR RPANCA1A.666
IM=MOD(FIXHD(22,FILE)+MONTHS-1,12)+1 RPANCA1A.667
IF(IM.GT.I_MONTH) IY=IY-1 RPANCA1A.668
CALL TIME2SEC(IY,IM,FIXHD(23,FILE),FIXHD(24,FILE), RPANCA1A.669
& FIXHD(25,FILE),FIXHD(26,FILE), TJ080294.386
& ANCIL_REF_DAYS,ANCIL_REF_SECS,DAY,SEC, GSS1F304.600
& LCAL360) GSS1F304.601
TIME1=REAL(SEC)/3600+REAL(DAY*24) TJ080294.388
C Calculate TIME2 for second ancillary data time RPANCA1A.672
C set IY correctly for time interpolation calculations RPANCA1A.673
IY=I_YEAR RPANCA1A.674
IM=MOD(FIXHD(22,FILE)+MONTHS+INTERVAL-1,12)+1 RPANCA1A.675
IF(IM.LT.I_MONTH) IY=IY+1 RPANCA1A.676
CALL TIME2SEC(IY,IM,FIXHD(23,FILE),FIXHD(24,FILE), RPANCA1A.677
& FIXHD(25,FILE),FIXHD(26,FILE), TJ080294.389
& ANCIL_REF_DAYS,ANCIL_REF_SECS,DAY,SEC, GSS1F304.602
& LCAL360) GSS1F304.603
TIME2=REAL(SEC)/3600+REAL(DAY*24) TJ080294.391
ENDIF ! end LAMIPII test GRS2F404.145
RPANCA1A.680
C Do not interpolate in time if data time exactly matches model time RPANCA1A.681
RPANCA1A.682
IF(TIME.EQ.TIME1) THEN RPANCA1A.683
LINTERPOLATE=.FALSE. RPANCA1A.684
END IF RPANCA1A.685
RPANCA1A.686
ENDIF ! regular/non-regular GRB1F304.118
RPANCA1A.688
*IF -DEF,RECON RPANCA1A.689
RPANCA1A.690
CL Adjust YMD time back to start of updating interval RPANCA1A.691
RPANCA1A.692
I_YEAR=I_YEAR1 RPANCA1A.693
I_MONTH=I_MONTH1 RPANCA1A.694
I_DAY=I_DAY1 RPANCA1A.695
I_HOUR=I_HOUR1 RPANCA1A.696
RPANCA1A.697
*ENDIF RPANCA1A.698
RPANCA1A.699
ENDIF ! non-periodic/periodic GRB1F304.119
RPANCA1A.701
*IF -DEF,RECON GRB1F304.120
IF (LINTERPOLATE) THEN GRB1F400.65
WRITE(6,*)' REPLANCA - time interpolation for field ',field GIE0F403.604
WRITE(6,*)' time,time1,time2 ',time,time1,time2 GIE0F403.605
WRITE(6,*)' hours,int,period ',hours,interval,period GIE0F403.606
END IF GRB1F400.66
*ENDIF GRB1F304.124
GRB1F304.125
END IF ! singletime/non-singletime GRB1F304.126
RPANCA1A.703
CL 2.3 Check STASH Code RPANCA1A.704
RPANCA1A.705
I2=NLOOKUP(FIELD)+LOOKUP_STEP(FIELD)*STEP RPANCA1A.706
RPANCA1A.707
I1=LOOKUP(ITEM_CODE,I2+LOOKUP_START(FILE)-1) RPANCA1A.708
RPANCA1A.709
LMISMATCH=.FALSE. RPANCA1A.710
WRITE(6,*)' Information used in checking ancillary data set:', RPANCA1A.711
* ' position of lookup table in dataset:',I2 RPANCA1A.712
WRITE(6,*)' Position of first lookup table referring to ', RPANCA1A.713
* 'data type ',NLOOKUP(FIELD) RPANCA1A.714
WRITE(6,*)' Interval between lookup tables referring to data ', RPANCA1A.715
* 'type ', LOOKUP_STEP(FIELD),' Number of steps', STEP RPANCA1A.716
WRITE(6,*)' STASH code in dataset ',I1, RPANCA1A.717
* ' STASH code requested ',STASHANCIL(FIELD) RPANCA1A.718
WRITE(6,*)'''Start'' position of lookup tables for dataset ', RPANCA1A.719
* 'in overall lookup array ' ,LOOKUP_START(FILE) RPANCA1A.720
RPANCA1A.721
IF(I1.NE.STASHANCIL(FIELD)) THEN RPANCA1A.722
WRITE(6,*)I1,STASHANCIL(FIELD),FIELD RPANCA1A.723
LMISMATCH=.TRUE. RPANCA1A.724
END IF RPANCA1A.725
RPANCA1A.726
CL Error exit if checks fail RPANCA1A.727
RPANCA1A.728
IF(LMISMATCH) THEN RPANCA1A.729
ICODE=200+FIELD RPANCA1A.730
CMESSAGE='REPLANCA: PP HEADERS ON ANCILLARY FILE DO NOT MATCH' RPANCA1A.731
RETURN RPANCA1A.732
END IF RPANCA1A.733
RPANCA1A.734
IF(LINTERPOLATE.AND..NOT.SINGLE_TIME) THEN RPANCA1A.735
CL Check time interpolation factors RPANCA1A.736
IF(TIME.LT.TIME1.OR.TIME.GT.TIME2) THEN RPANCA1A.737
WRITE(6,*)' Information used in interpolation/replacement:' RPANCA1A.738
WRITE(6,*)' Time of first data=', TIME1 RPANCA1A.739
WRITE(6,*)' Validity Time for update=', TIME RPANCA1A.740
WRITE(6,*)' Time of second data=', TIME2 RPANCA1A.741
RPANCA1A.742
ICODE=500+FIELD RPANCA1A.743
CMESSAGE='REPLANCA: TIME INTERPOLATION ERROR' RPANCA1A.744
RETURN RPANCA1A.745
END IF RPANCA1A.746
END IF RPANCA1A.747
RPANCA1A.748
CL 3 Loop over levels of ancillary data for field I RPANCA1A.749
CL Reset pointer for dataset RPANCA1A.750
RPANCA1A.751
RPANCA1A.752
CL Includes loop over X and Y components of surface currents RPANCA1A.753
RPANCA1A.754
LICE_FRACTION=FIELD.EQ.27 RPANCA1A.755
LSNOW_DEPTH=FIELD.EQ.9 RPANCA1A.756
LICE_DEPTH=FIELD.EQ.29 GRS2F404.146
RPANCA1A.757
DO 30 LEVEL=1,LEVELS(FIELD) RPANCA1A.758
RPANCA1A.759
CL Do not go through loop for ice edge or snow edge RPANCA1A.760
RPANCA1A.761
IF((LICE_FRACTION.OR.LSNOW_DEPTH).AND.LEVEL.EQ.2) THEN RPANCA1A.762
GOTO 30 RPANCA1A.763
END IF RPANCA1A.764
RPANCA1A.765
CL 3.1 Read data for single level of ancillary field. RPANCA1A.766
RPANCA1A.767
IF(.NOT.LICE_FRACTION) THEN RPANCA1A.768
! AMIPII case ice depth field not read from ancillary file GRS2F404.147
IF(.NOT.(LICE_DEPTH.and.LAMIPII)) THEN GRS2F404.148
CALL READFLDS(NFTIN,1,I2,LOOKUP(1,LOOKUP_START(FILE)), GDG0F401.1381
& LEN1_LOOKUP,ANCIL1,P_FIELD,FIXHD(1,FILE), GDG0F401.1382
*CALL ARGPPX GDG0F401.1383
& ICODE,CMESSAGE) GDG0F401.1384
RPANCA1A.772
ENDIF GRS2F404.149
*IF DEF,RECON UDG4F402.261
IF(LOOKUP(ITEM_CODE,LOOKUP_START(FILE)).NE.30)THEN UDG4F402.262
IF(ICODE.EQ.1501)THEN UDG4F402.263
IF(LPOLARCHK)THEN UDG4F402.264
write(6,*) 'REPLANCA: Averaging polar rows to make them ', ARR5F405.29
& 'constant' ARR5F405.30
! North polar row UDG4F402.266
RP_ROW_SUM=0.0 UDG4F402.267
DO I=1,LOOKUP(LBNPT,LOOKUP_START(FILE)) UDG4F402.268
RP_ROW_SUM=RP_ROW_SUM+ANCIL1(I) UDG4F402.269
END DO UDG4F402.270
DO I=1,LOOKUP(LBNPT,LOOKUP_START(FILE)) UDG4F402.271
ANCIL1(I)=RP_ROW_SUM/LOOKUP(LBNPT,LOOKUP_START(FILE)) UDG4F402.272
END DO UDG4F402.273
! South polar row UDG4F402.274
RP_ROW_SUM=0.0 UDG4F402.275
DO I=1,LOOKUP(LBNPT,LOOKUP_START(FILE)) UDG4F402.276
RP_ROW_SUM=RP_ROW_SUM+ANCIL1( UDG4F402.277
& (LOOKUP(LBROW,LOOKUP_START(FILE))-1)* UDG4F402.278
& LOOKUP(LBNPT,LOOKUP_START(FILE))+I) UDG4F402.279
END DO UDG4F402.280
DO I=1,LOOKUP(LBNPT,LOOKUP_START(FILE)) UDG4F402.281
ANCIL1((LOOKUP(LBROW,LOOKUP_START(FILE))-1)* UDG4F402.282
& LOOKUP(LBNPT,LOOKUP_START(FILE))+I) UDG4F402.283
& =RP_ROW_SUM/LOOKUP(LBNPT,LOOKUP_START(FILE)) UDG4F402.284
END DO UDG4F402.285
ICODE = 0 ! Re-set condition code after correction URR0F404.4
END IF UDG4F402.286
ELSE IF(ICODE.NE.0)THEN UDG4F402.287
ICODE=FIELD+100 UDG4F402.288
IOUNIT=NFTIN UDG4F402.289
CMESSAGE='REPLANCA :I/O ERROR ' UDG4F402.290
RETURN UDG4F402.291
END IF UDG4F402.292
END IF UDG4F402.293
*ELSE UDG4F402.294
IF(ICODE.NE.0)THEN UDG4F402.295
ICODE=FIELD+100 RPANCA1A.774
IOUNIT=NFTIN RPANCA1A.775
CMESSAGE='REPLANCA :I/O ERROR ' RPANCA1A.776
RETURN RPANCA1A.777
END IF RPANCA1A.778
*ENDIF UDG4F402.296
RPANCA1A.779
ELSE RPANCA1A.780
RPANCA1A.781
CL If ice-fraction,read fractional time field as well RPANCA1A.782
CL UNLESS IT IS A SINGLE TIME FIELD RPANCA1A.783
CL If snow-depth,read fractional time field as well only if time RPANCA1A.784
CL interpolation required. RPANCA1A.785
RPANCA1A.786
IF(.NOT.SINGLE_TIME.and..NOT.LAMIPII) THEN GRS2F404.150
IF(LOOKUP(ITEM_CODE,I2+LOOKUP_START(FILE)).EQ.38) THEN RPANCA1A.788
CALL READFLDS(NFTIN,2,I2,LOOKUP(1,LOOKUP_START(FILE)), GDG0F401.1385
& LEN1_LOOKUP,ICE_EXTENT,P_FIELD,FIXHD(1,FILE), GDG0F401.1386
*CALL ARGPPX GDG0F401.1387
& ICODE,CMESSAGE) GDG0F401.1388
*IF DEF,RECON UDG4F402.297
IF(ICODE.EQ.1501)THEN UDG4F402.298
IF(LPOLARCHK)THEN UDG4F402.299
write(6,*) 'REPLANCA: Averaging polar rows to make them ', ARR5F405.31
& 'constant' ARR5F405.32
UDG4F402.301
DO K=1,2 ! loop over ice_extent fields GRS2F404.151
! North polar row UDG4F402.303
RP_ROW_SUM=0.0 UDG4F402.304
DO I=1,LOOKUP(LBNPT,LOOKUP_START(FILE)+K-1) UDG4F402.305
RP_ROW_SUM=RP_ROW_SUM+ICE_EXTENT(I,K) UDG4F402.306
END DO UDG4F402.307
DO I=1,LOOKUP(LBNPT,LOOKUP_START(FILE)+K-1) UDG4F402.308
ICE_EXTENT(I,K)= UDG4F402.309
& RP_ROW_SUM/LOOKUP(LBNPT,LOOKUP_START(FILE)+K-1) UDG4F402.310
END DO UDG4F402.311
! South polar row UDG4F402.312
RP_ROW_SUM=0.0 UDG4F402.313
DO I=1,LOOKUP(LBNPT,LOOKUP_START(FILE)+K-1) UDG4F402.314
RP_ROW_SUM=RP_ROW_SUM+ICE_EXTENT( UDG4F402.315
& (LOOKUP(LBROW,LOOKUP_START(FILE)+K-1)-1)* UDG4F402.316
& LOOKUP(LBNPT,LOOKUP_START(FILE)+K-1)+I,K) UDG4F402.317
END DO UDG4F402.318
DO I=1,LOOKUP(LBNPT,LOOKUP_START(FILE)+K-1) UDG4F402.319
ICE_EXTENT((LOOKUP(LBROW,LOOKUP_START(FILE)+K-1)-1)* UDG4F402.320
& LOOKUP(LBNPT,LOOKUP_START(FILE)+K-1)+I,K) UDG4F402.321
& =RP_ROW_SUM/LOOKUP(LBNPT,LOOKUP_START(FILE)+K-1) UDG4F402.322
END DO UDG4F402.323
END DO UDG4F402.324
ICODE = 0 ! Re-set condition code after correction URR0F404.5
END IF UDG4F402.325
ELSE IF(ICODE.NE.0)THEN UDG4F402.326
ICODE=FIELD+100 UDG4F402.327
UDG4F402.328
IOUNIT=NFTIN UDG4F402.329
CMESSAGE='REPLANCA :I/O ERROR ' UDG4F402.330
RETURN UDG4F402.331
ENDIF UDG4F402.332
*ELSE UDG4F402.333
IF(ICODE.NE.0)THEN UDG4F402.334
ICODE=FIELD+100 RPANCA1A.793
IOUNIT=NFTIN RPANCA1A.794
CMESSAGE='REPLANCA :I/O ERROR ' RPANCA1A.795
RETURN RPANCA1A.796
END IF RPANCA1A.797
*ENDIF UDG4F402.335
RPANCA1A.798
ELSE RPANCA1A.799
ICODE=FIELD+100 RPANCA1A.800
IOUNIT=NFTIN RPANCA1A.801
CMESSAGE='REPLANCA :ICE CHANGE DATA MISSING' RPANCA1A.802
RETURN RPANCA1A.803
END IF RPANCA1A.804
ELSE ! single time or LAMIPII - ie no time change field GRS2F404.152
CALL READFLDS(NFTIN,1,I2,LOOKUP(1,LOOKUP_START(FILE)), GDG0F401.1389
& LEN1_LOOKUP,ICE_EXTENT,P_FIELD,FIXHD(1,FILE), GDG0F401.1390
*CALL ARGPPX GDG0F401.1391
& ICODE,CMESSAGE) GDG0F401.1392
*IF DEF,RECON UDG4F402.336
IF(ICODE.EQ.1501)THEN UDG4F402.337
IF(LPOLARCHK)THEN UDG4F402.338
write(6,*) 'REPLANCA: Averaging polar rows to make them ', ARR5F405.33
& 'constant' ARR5F405.34
! North polar row UDG4F402.340
RP_ROW_SUM=0.0 UDG4F402.341
DO I=1,LOOKUP(LBNPT,LOOKUP_START(FILE)) UDG4F402.342
RP_ROW_SUM=RP_ROW_SUM+ICE_EXTENT(I,1) UDG4F402.343
END DO UDG4F402.344
DO I=1,LOOKUP(LBNPT,LOOKUP_START(FILE)) UDG4F402.345
ICE_EXTENT(I,1)=RP_ROW_SUM/ UDG4F402.346
& LOOKUP(LBNPT,LOOKUP_START(FILE)) UDG4F402.347
END DO UDG4F402.348
! South polar row UDG4F402.349
RP_ROW_SUM=0.0 UDG4F402.350
DO I=1,LOOKUP(LBNPT,LOOKUP_START(FILE)) UDG4F402.351
RP_ROW_SUM=RP_ROW_SUM+ICE_EXTENT( UDG4F402.352
& (LOOKUP(LBROW,LOOKUP_START(FILE))-1)* UDG4F402.353
& LOOKUP(LBNPT,LOOKUP_START(FILE))+I,1) UDG4F402.354
END DO UDG4F402.355
DO I=1,LOOKUP(LBNPT,LOOKUP_START(FILE)) UDG4F402.356
ICE_EXTENT((LOOKUP(LBROW,LOOKUP_START(FILE))-1)* UDG4F402.357
& LOOKUP(LBNPT,LOOKUP_START(FILE))+I,1) UDG4F402.358
& =RP_ROW_SUM/LOOKUP(LBNPT,LOOKUP_START(FILE)) UDG4F402.359
END DO UDG4F402.360
ICODE = 0 ! Re-set condition code after correction URR0F404.6
END IF UDG4F402.361
ELSE IF(ICODE.NE.0)THEN UDG4F402.362
ICODE=FIELD+100 UDG4F402.363
IOUNIT=NFTIN UDG4F402.364
CMESSAGE='REPLANCA :I/O ERROR ' UDG4F402.365
RETURN UDG4F402.366
ENDIF UDG4F402.367
*ELSE UDG4F402.368
IF(ICODE.NE.0)THEN UDG4F402.369
ICODE=FIELD+100 RPANCA1A.810
IOUNIT=NFTIN RPANCA1A.811
CMESSAGE='REPLANCA: I/O ERROR' RPANCA1A.812
RETURN RPANCA1A.813
ENDIF RPANCA1A.814
*ENDIF UDG4F402.370
END IF RPANCA1A.815
ENDIF RPANCA1A.816
RPANCA1A.817
IF(LSNOW_DEPTH.AND.LINTERPOLATE) THEN RPANCA1A.818
IF(LOOKUP(ITEM_CODE,I2+LOOKUP_START(FILE)).EQ.27) THEN RPANCA1A.819
RPANCA1A.820
CALL READFLDS(NFTIN,1,I2+1,LOOKUP(1,LOOKUP_START(FILE)), GDG0F401.1393
& LEN1_LOOKUP,SNOW_CHANGE,P_FIELD,FIXHD(1,FILE), GDG0F401.1394
*CALL ARGPPX GDG0F401.1395
& ICODE,CMESSAGE) GDG0F401.1396
*IF DEF,RECON UDG4F402.371
IF(ICODE.EQ.1501)THEN UDG4F402.372
IF(LPOLARCHK)THEN UDG4F402.373
write(6,*) 'REPLANCA: Averaging polar rows to make them ', ARR5F405.35
& 'constant' ARR5F405.36
! North polar row UDG4F402.375
RP_ROW_SUM=0.0 UDG4F402.376
DO I=1,LOOKUP(LBNPT,LOOKUP_START(FILE)) UDG4F402.377
RP_ROW_SUM=RP_ROW_SUM+SNOW_CHANGE(I) UDG4F402.378
END DO UDG4F402.379
DO I=1,LOOKUP(LBNPT,LOOKUP_START(FILE)) UDG4F402.380
SNOW_CHANGE(I)=RP_ROW_SUM/ UDG4F402.381
& LOOKUP(LBNPT,LOOKUP_START(FILE)) UDG4F402.382
END DO UDG4F402.383
! South polar row UDG4F402.384
RP_ROW_SUM=0.0 UDG4F402.385
DO I=1,LOOKUP(LBNPT,LOOKUP_START(FILE)) UDG4F402.386
RP_ROW_SUM=RP_ROW_SUM+SNOW_CHANGE( UDG4F402.387
& (LOOKUP(LBROW,LOOKUP_START(FILE))-1)* UDG4F402.388
& LOOKUP(LBNPT,LOOKUP_START(FILE))+I) UDG4F402.389
END DO UDG4F402.390
DO I=1,LOOKUP(LBNPT,LOOKUP_START(FILE)) UDG4F402.391
SNOW_CHANGE((LOOKUP(LBROW,LOOKUP_START(FILE))-1)* UDG4F402.392
& LOOKUP(LBNPT,LOOKUP_START(FILE))+I) UDG4F402.393
& =RP_ROW_SUM/LOOKUP(LBNPT,LOOKUP_START(FILE)) UDG4F402.394
END DO UDG4F402.395
ICODE = 0 ! Re-set condition code after correction URR0F404.7
END IF UDG4F402.396
ELSE IF(ICODE.NE.0)THEN UDG4F402.397
ICODE=FIELD+100 UDG4F402.398
IOUNIT=NFTIN UDG4F402.399
CMESSAGE='REPLANCA :I/O ERROR ' UDG4F402.400
RETURN UDG4F402.401
ENDIF UDG4F402.402
*ELSE UDG4F402.403
IF(ICODE.NE.0)THEN UDG4F402.404
ICODE=FIELD+100 RPANCA1A.824
IOUNIT=NFTIN RPANCA1A.825
CMESSAGE='REPLANCA :I/O ERROR ' RPANCA1A.826
RETURN RPANCA1A.827
END IF RPANCA1A.828
*ENDIF UDG4F402.405
RPANCA1A.829
ELSE RPANCA1A.830
ICODE=FIELD+100 RPANCA1A.831
IOUNIT=NFTIN RPANCA1A.832
CMESSAGE='REPLANCA :SNOW CHANGE DATA MISSING' RPANCA1A.833
RETURN RPANCA1A.834
END IF RPANCA1A.835
END IF RPANCA1A.836
RPANCA1A.837
CL If sea surface temperature or other ice fields, read ice fraction RPANCA1A.838
CL and fractional time field if not already pressent and if required RPANCA1A.839
CL by time interpolation. Similar if SLAB ref SST or ice depth needed. TJ240293.23
RPANCA1A.841
IF(FIELD.EQ.29.OR.(FIELD.EQ.28.AND.LT_INT_C).OR. TJ240293.24
& FIELD.EQ.38.OR.(FIELD.EQ.37.AND.LT_INT_C)) TJ240293.25
& THEN RPANCA1A.843
RPANCA1A.844
IF(.NOT.UPDATE(27)) THEN RPANCA1A.845
I3 = NLOOKUP(27) + LOOKUP_STEP(27)*STEP + LOOKUP_START( AWI2F304.38
& FILEANCIL(27)) RPANCA1A.847
IF ( LOOKUP(ITEM_CODE,I3) .EQ. 38 ) THEN AWI2F304.39
RPANCA1A.849
CALL READFLDS(FTNANCIL(FILEANCIL(27)),2, GDG0F401.1397
& NLOOKUP(27)+LOOKUP_STEP(27)*STEP, GDG0F401.1398
& LOOKUP(1,LOOKUP_START(FILEANCIL(27))), GDG0F401.1399
& LEN1_LOOKUP,ICE_EXTENT, GDG0F401.1400
& P_FIELD,FIXHD(1,FILEANCIL(27)), GDG0F401.1401
*CALL ARGPPX GDG0F401.1402
& ICODE,CMESSAGE) GDG0F401.1403
*IF DEF,RECON UDG4F402.406
IF(ICODE.EQ.1501)THEN UDG4F402.407
IF(LPOLARCHK)THEN UDG4F402.408
write(6,*) 'REPLANCA: Averaging polar rows to make them ', ARR5F405.37
& 'constant' ARR5F405.38
UDG4F402.410
DO K=1,2 UDG4F402.411
! North polar row UDG4F402.412
RP_ROW_SUM=0.0 UDG4F402.413
DO I=1,LOOKUP(LBNPT,LOOKUP_START(FILEANCIL(27))+K-1) UDG4F402.414
RP_ROW_SUM=RP_ROW_SUM+ICE_EXTENT(I,K) UDG4F402.415
END DO UDG4F402.416
DO I=1,LOOKUP(LBNPT,LOOKUP_START(FILEANCIL(27))+K-1) UDG4F402.417
ICE_EXTENT(I,K)= UDG4F402.418
& RP_ROW_SUM/ UDG4F402.419
& LOOKUP(LBNPT,LOOKUP_START(FILEANCIL(27))+K-1) UDG4F402.420
END DO UDG4F402.421
! South polar row UDG4F402.422
RP_ROW_SUM=0.0 UDG4F402.423
DO I=1,LOOKUP(LBNPT,LOOKUP_START(FILEANCIL(27))+K-1) UDG4F402.424
RP_ROW_SUM=RP_ROW_SUM+ICE_EXTENT( UDG4F402.425
& (LOOKUP(LBROW,LOOKUP_START(FILEANCIL(27))+K-1)-1)* UDG4F402.426
& LOOKUP(LBNPT,LOOKUP_START(FILEANCIL(27))+K-1)+I, UDG4F402.427
& K) UDG4F402.428
END DO UDG4F402.429
DO I=1,LOOKUP(LBNPT,LOOKUP_START(FILEANCIL(27))+K-1) UDG4F402.430
ICE_EXTENT(( UDG4F402.431
& LOOKUP(LBROW,LOOKUP_START(FILEANCIL(27))+K-1)-1)* UDG4F402.432
& LOOKUP(LBNPT,LOOKUP_START(FILEANCIL(27))+K-1)+I,K) UDG4F402.433
& =RP_ROW_SUM/ UDG4F402.434
& LOOKUP(LBNPT,LOOKUP_START(FILEANCIL(27))+K-1) UDG4F402.435
END DO UDG4F402.436
END DO UDG4F402.437
ICODE = 0 ! Re-set condition code after correction URR0F404.8
END IF UDG4F402.438
ELSE IF(ICODE.NE.0)THEN UDG4F402.439
ICODE=FIELD+100 UDG4F402.440
IOUNIT=NFTIN UDG4F402.441
CMESSAGE='REPLANCA :I/O ERROR ' UDG4F402.442
RETURN UDG4F402.443
ENDIF UDG4F402.444
*ELSE UDG4F402.445
IF(ICODE.NE.0)THEN UDG4F402.446
ICODE=FIELD+100 RPANCA1A.854
IOUNIT=NFTIN RPANCA1A.855
CMESSAGE='REPLANCA :I/O ERROR ' RPANCA1A.856
RETURN RPANCA1A.857
END IF RPANCA1A.858
*ENDIF UDG4F402.447
IF ( RLOOKUP(BMDI,I3-1) .NE. RMDI ) THEN AWI2F304.40
ICODE = 700 + FIELD AWI2F304.41
CMESSAGE = 'REPLANCA: RMDI in lookup of ancillary file of ti AWI2F304.42
&mes of sea-ice chge not standard' AWI2F304.43
RETURN AWI2F304.44
ENDIF AWI2F304.45
AWI2F304.46
RPANCA1A.859
ELSE RPANCA1A.860
ICODE=FIELD+100 RPANCA1A.861
IOUNIT=NFTIN RPANCA1A.862
CMESSAGE='REPLANCA :ICE FIELD DATA MISSING' RPANCA1A.863
RETURN RPANCA1A.864
END IF RPANCA1A.865
END IF RPANCA1A.866
END IF RPANCA1A.867
RPANCA1A.868
CL 3.3 If time interpolation required, read second record RPANCA1A.869
RPANCA1A.870
IF(LINTERPOLATE) THEN RPANCA1A.871
RPANCA1A.872
I1=I2+ LOOKUP_STEP(FIELD) RPANCA1A.873
IF(I1.LE.FIXHD(152,FILE)) THEN RPANCA1A.874
RPANCA1A.875
! AMIP II and ice depth don't read in ice depth field GRS2F404.153
IF (.NOT.(LAMIPII.and.LICE_DEPTH)) THEN GRS2F404.154
GRS2F404.155
CALL READFLDS(NFTIN,1,I1,LOOKUP(1,LOOKUP_START(FILE)), GDG0F401.1404
& LEN1_LOOKUP,ANCIL2,P_FIELD,FIXHD(1,FILE), GDG0F401.1405
*CALL ARGPPX GDG0F401.1406
& ICODE,CMESSAGE) GDG0F401.1407
ENDIF GRS2F404.156
*IF DEF,RECON UDG4F402.448
IF(ICODE.EQ.1501)THEN UDG4F402.449
IF(LPOLARCHK)THEN UDG4F402.450
write(6,*) 'REPLANCA: Averaging polar rows to make them ', ARR5F405.39
& 'constant' ARR5F405.40
! North polar row UDG4F402.452
RP_ROW_SUM=0.0 UDG4F402.453
DO I=1,LOOKUP(LBNPT,LOOKUP_START(FILE)) UDG4F402.454
RP_ROW_SUM=RP_ROW_SUM+ANCIL2(I) UDG4F402.455
END DO UDG4F402.456
DO I=1,LOOKUP(LBNPT,LOOKUP_START(FILE)) UDG4F402.457
ANCIL2(I)=RP_ROW_SUM/LOOKUP(LBNPT,LOOKUP_START(FILE)) UDG4F402.458
END DO UDG4F402.459
! South polar row UDG4F402.460
RP_ROW_SUM=0.0 UDG4F402.461
DO I=1,LOOKUP(LBNPT,LOOKUP_START(FILE)) UDG4F402.462
RP_ROW_SUM=RP_ROW_SUM+ANCIL2( UDG4F402.463
& (LOOKUP(LBROW,LOOKUP_START(FILE))-1)* UDG4F402.464
& LOOKUP(LBNPT,LOOKUP_START(FILE))+I) UDG4F402.465
END DO UDG4F402.466
DO I=1,LOOKUP(LBNPT,LOOKUP_START(FILE)) UDG4F402.467
ANCIL2((LOOKUP(LBROW,LOOKUP_START(FILE))-1)* UDG4F402.468
& LOOKUP(LBNPT,LOOKUP_START(FILE))+I) UDG4F402.469
& =RP_ROW_SUM/LOOKUP(LBNPT,LOOKUP_START(FILE)) UDG4F402.470
END DO UDG4F402.471
ICODE = 0 ! Re-set condition code after correction URR0F404.9
END IF UDG4F402.472
ELSE IF(ICODE.NE.0)THEN UDG4F402.473
ICODE=FIELD+100 UDG4F402.474
IOUNIT=NFTIN UDG4F402.475
CMESSAGE='REPLANCA :I/O ERROR ' UDG4F402.476
RETURN UDG4F402.477
ENDIF UDG4F402.478
*ELSE UDG4F402.479
IF(ICODE.NE.0)THEN UDG4F402.480
ICODE=FIELD+300 RPANCA1A.879
IOUNIT=NFTIN RPANCA1A.880
CMESSAGE='REPLANCA :I/O ERROR ' RPANCA1A.881
RETURN RPANCA1A.882
END IF RPANCA1A.883
*ENDIF UDG4F402.481
RPANCA1A.884
ELSE !end of data on file RPANCA1A.885
RPANCA1A.886
CL If end of data has been reached go back to the start.If data is RPANCA1A.887
CL periodic. RPANCA1A.888
CL Otherwise cancel time interpolation RPANCA1A.889
RPANCA1A.890
IF(PERIODIC) THEN RPANCA1A.891
RPANCA1A.892
I1 = NLOOKUP(FIELD) + LEVEL - 1 GDR1F405.3
RPANCA1A.894
CALL READFLDS(NFTIN,1,I1,LOOKUP(1,LOOKUP_START(FILE)), GDG0F401.1408
& LEN1_LOOKUP,ANCIL2,P_FIELD,FIXHD(1,FILE), GDG0F401.1409
*CALL ARGPPX GDG0F401.1410
& ICODE,CMESSAGE) GDG0F401.1411
*IF DEF,RECON UDG4F402.482
IF(ICODE.EQ.1501)THEN UDG4F402.483
IF(LPOLARCHK)THEN UDG4F402.484
write(6,*) 'REPLANCA: Averaging polar rows to make them ', ARR5F405.41
& 'constant' ARR5F405.42
! North polar row UDG4F402.486
RP_ROW_SUM=0.0 UDG4F402.487
DO I=1,LOOKUP(LBNPT,LOOKUP_START(FILE)) UDG4F402.488
RP_ROW_SUM=RP_ROW_SUM+ANCIL2(I) UDG4F402.489
END DO UDG4F402.490
DO I=1,LOOKUP(LBNPT,LOOKUP_START(FILE)) UDG4F402.491
ANCIL2(I)=RP_ROW_SUM/LOOKUP(LBNPT,LOOKUP_START(FILE)) UDG4F402.492
END DO UDG4F402.493
! South polar row UDG4F402.494
RP_ROW_SUM=0.0 UDG4F402.495
DO I=1,LOOKUP(LBNPT,LOOKUP_START(FILE)) UDG4F402.496
RP_ROW_SUM=RP_ROW_SUM+ANCIL2( UDG4F402.497
& (LOOKUP(LBROW,LOOKUP_START(FILE))-1)* UDG4F402.498
& LOOKUP(LBNPT,LOOKUP_START(FILE))+I) UDG4F402.499
END DO UDG4F402.500
DO I=1,LOOKUP(LBNPT,LOOKUP_START(FILE)) UDG4F402.501
ANCIL2((LOOKUP(LBROW,LOOKUP_START(FILE))-1)* UDG4F402.502
& LOOKUP(LBNPT,LOOKUP_START(FILE))+I) UDG4F402.503
& =RP_ROW_SUM/LOOKUP(LBNPT,LOOKUP_START(FILE)) UDG4F402.504
END DO UDG4F402.505
ICODE = 0 ! Re-set condition code after correction URR0F404.10
END IF UDG4F402.506
ELSE IF(ICODE.NE.0)THEN UDG4F402.507
ICODE=FIELD+100 UDG4F402.508
IOUNIT=NFTIN UDG4F402.509
CMESSAGE='REPLANCA :I/O ERROR ' UDG4F402.510
RETURN UDG4F402.511
ENDIF UDG4F402.512
*ELSE UDG4F402.513
IF(ICODE.NE.0)THEN UDG4F402.514
ICODE=FIELD+300 RPANCA1A.898
IOUNIT=NFTIN RPANCA1A.899
CMESSAGE='REPLANCA :I/O ERROR ' RPANCA1A.900
RETURN RPANCA1A.901
END IF RPANCA1A.902
*ENDIF UDG4F402.515
ELSE RPANCA1A.903
LINTERPOLATE=.FALSE. RPANCA1A.904
END IF RPANCA1A.905
END IF! End of position on file test RPANCA1A.906
RPANCA1A.907
ICODE=0 RPANCA1A.908
END IF ! End LINTERPOLATE RPANCA1A.909
RPANCA1A.910
CL 3.4 Perform time interpolation RPANCA1A.911
RPANCA1A.912
IF(LINTERPOLATE) THEN RPANCA1A.913
RPANCA1A.914
ZERO=0.0 RPANCA1A.915
RPANCA1A.916
CL Select appropriate time interpolation for each field RPANCA1A.917
C Snowdepth: set equal to zero if no snow cover RPANCA1A.918
RPANCA1A.919
IF(LSNOW_DEPTH) THEN RPANCA1A.920
DO I=1,P_FIELD RPANCA1A.921
PRES_VALUE(I)=ZERO RPANCA1A.922
END DO RPANCA1A.923
RPANCA1A.924
C For the call to T_INT_C, need to know BMDI is OK for SNOW_CHANGE AWI2F304.47
C which was read in from position I2+1. AWI2F304.48
IF ( RLOOKUP(BMDI,LOOKUP_START(FILE)+I2) .NE. RMDI ) THEN AWI2F304.49
ICODE = 700 + FIELD AWI2F304.50
CMESSAGE = 'REPLANCA: RMDI in lookup of ancillary file of ti AWI2F304.51
&mes of snow change non-standard ' AWI2F304.52
RETURN AWI2F304.53
ENDIF AWI2F304.54
AWI2F304.55
CALL T_INT_C (ANCIL1,TIME1,ANCIL2,TIME2,ANCIL_DATA, RPANCA1A.925
& TIME,P_FIELD,SNOW_CHANGE,ANCIL1,PRES_VALUE) RPANCA1A.926
RPANCA1A.927
C Ice fraction: ice depth set equal to zero if no ice RPANCA1A.928
RPANCA1A.929
ELSE IF(FIELD.EQ.27.OR.FIELD.EQ.29.OR.FIELD.EQ.38) THEN TJ240293.28
IF(FIELD.EQ.27) THEN RPANCA1A.931
C For the call to T_INT_C, need to know BMDI is OK for ICE_EXTENT(1,2) AWI2F304.56
C which was read in from position I1+1 AWI2F304.57
IF(.NOT.LAMIPII) THEN GRS2F404.157
IF ( RLOOKUP(BMDI,LOOKUP_START(FILE)+I1) .NE. RMDI ) THEN AWI2F304.58
ICODE = 700 + FIELD AWI2F304.59
CMESSAGE = 'REPLANCA: RMDI in lookup of ancillary file of ti AWI2F304.60
&mes of sea-ice chge non-standard' AWI2F304.61
RETURN AWI2F304.62
ENDIF AWI2F304.63
ENDIF GRS2F404.158
AWI2F304.64
IF (LAMIPII) THEN GRS2F404.159
! linear uncontrolled time interpolation GRS2F404.160
CALL T_INT (ICE_EXTENT,TIME1,ANCIL2,TIME2,ANCIL_DATA, GRS2F404.161
& TIME,P_FIELD) GRS2F404.162
GRS2F404.163
! For AMIP II strictly ice concentrations should range between GRS2F404.164
! 0.0 and 1.0 but because of assumptions on T* made by the boundary GRS2F404.165
! layer and radiation schemes ice concentrations are restricted to GRS2F404.166
! 0.3 to 1.0. This will allow SSTs in areas of less than 30% ice to GRS2F404.167
! be used rather than TFS=-1.8C. GRS2F404.168
GRS2F404.169
DO I=1,P_FIELD RPANCA1A.932
IF (ANCIL_DATA(I).lt.0.3) ANCIL_DATA(I)=0.0 GRS2F404.170
IF (ANCIL_DATA(I).gt.1.0) ANCIL_DATA(I)=1.0 GRS2F404.171
ENDDO GRS2F404.172
GRS2F404.173
ELSE ! non AMIPII option GRS2F404.174
DO I=1,P_FIELD GRS2F404.175
PRES_VALUE(I)=0 RPANCA1A.933
END DO RPANCA1A.934
GRS2F404.176
CALL T_INT_C (ICE_EXTENT,TIME1,ANCIL2,TIME2,ANCIL_DATA, RPANCA1A.935
& TIME,P_FIELD,ICE_EXTENT(1,2),ICE_EXTENT,PRES_VALUE) RPANCA1A.936
RPANCA1A.937
ENDIF ! end AMIPII test GRS2F404.177
RPANCA1A.938
ELSE IF (FIELD.EQ.29.OR.FIELD.EQ.38) THEN TJ240293.29
RPANCA1A.940
DO I=1,P_FIELD RPANCA1A.941
PRES_VALUE(I)=0 RPANCA1A.942
END DO RPANCA1A.943
RPANCA1A.944
CALL T_INT_C (ANCIL1,TIME1,ANCIL2,TIME2,ANCIL_DATA, RPANCA1A.945
& TIME,P_FIELD,ICE_EXTENT(1,2),ICE_EXTENT,PRES_VALUE) RPANCA1A.946
RPANCA1A.947
RPANCA1A.948
END IF RPANCA1A.949
RPANCA1A.950
RPANCA1A.951
C Sea surface temperature, set equal to TFS if ice present RPANCA1A.952
RPANCA1A.953
ELSE IF ((FIELD.EQ.28.OR.FIELD.EQ.37).AND.LT_INT_C) THEN TJ240293.30
IF (LAMIPII) THEN GRS2F404.178
RPANCA1A.955
CALL T_INT (ANCIL1,TIME1,ANCIL2,TIME2,ANCIL_DATA, GRS2F404.179
& TIME,P_FIELD) GRS2F404.180
! remove any T below TFS GRS2F404.181
DO I=1,P_FIELD RPANCA1A.956
IF (ANCIL_DATA(i).LT.TFS) ANCIL_DATA(I)=TFS GRS2F404.182
ENDDO GRS2F404.183
GRS2F404.184
ELSE ! non AMIPII option GRS2F404.185
GRS2F404.186
DO I=1,P_FIELD GRS2F404.187
PRES_VALUE(I)=TFS RPANCA1A.957
RPANCA1A.958
C Set no_ice_extent indicator for controlled SST interpolation RPANCA1A.959
IF(ICE_EXTENT(I,1).EQ.0) THEN RPANCA1A.960
NO_ICE_EXTENT(I)=1.0 RPANCA1A.961
ELSE RPANCA1A.962
NO_ICE_EXTENT(I)=0.0 RPANCA1A.963
ENDIF RPANCA1A.964
END DO RPANCA1A.965
RPANCA1A.966
CALL T_INT_C (ANCIL1,TIME1,ANCIL2,TIME2,ANCIL_DATA, RPANCA1A.967
& TIME,P_FIELD,ICE_EXTENT(1,2),NO_ICE_EXTENT,PRES_VALUE) RPANCA1A.968
RPANCA1A.969
ENDIF ! end AMIPII test GRS2F404.188
C Otherwise linear interpolation in time, unless missing data indicator RPANCA1A.970
C present at either time. RPANCA1A.971
RPANCA1A.972
ELSE RPANCA1A.973
RPANCA1A.974
C Time interpolation checks the data against the standard missing data AWI2F304.65
C indicator - check that the field is labelled as using the same one. AWI2F304.66
C (It is to have the right I1 here that I3 is used above.) AWI2F304.67
IF ( RLOOKUP(BMDI,LOOKUP_START(FILE)+I1-1) .NE. RMDI .OR. AWI2F304.68
& RLOOKUP(BMDI,LOOKUP_START(FILE)+I2-1) .NE. RMDI ) THEN AWI2F304.69
WRITE (6, *) 'LOOKUPS:', AWI2F304.70
& RLOOKUP(BMDI,LOOKUP_START(FILE)+I1-1), AWI2F304.71
& RLOOKUP(BMDI,LOOKUP_START(FILE)+I2-1) AWI2F304.72
ICODE = 700 + FIELD AWI2F304.73
CMESSAGE = 'REPLANCA: Missing data indicator in lookup of an AWI2F304.74
&cillary file is non-standard ' AWI2F304.75
RETURN AWI2F304.76
ENDIF AWI2F304.77
RPANCA1A.975
LEN=P_FIELD GDR4F400.4
CL Ozone, test for zonal mean or full field GDR4F400.5
IF(FIELD.EQ.7) THEN GDR4F400.6
IF(LOOKUP(LBNPT,LOOKUP_START(FILE)+I2-1).EQ.1) THEN GDR4F400.7
LEN=P_ROWS GDR4F400.8
END IF GDR4F400.9
END IF GDR4F400.10
GDR4F400.11
CALL T_INT(ANCIL1,TIME1,ANCIL2,TIME2,ANCIL_DATA, RPANCA1A.976
& TIME,LEN) GDR4F400.12
RPANCA1A.978
END IF ! End Lsnow_depth RPANCA1A.979
RPANCA1A.980
C If no interpolation, copy data into final array RPANCA1A.981
RPANCA1A.982
ELSE ! no interpolation RPANCA1A.983
IF(LICE_FRACTION) THEN RPANCA1A.984
IF (LAMIPII) THEN GRS2F404.189
DO I=1,P_FIELD RPANCA1A.985
GRS2F404.190
ANCIL_DATA(I)=ICE_EXTENT(I,1) RPANCA1A.986
GRS2F404.191
! For AMIP II strictly ice concentrations should range between GRS2F404.192
! 0.0 and 1.0 but because of assumptions on T* made by the boundary GRS2F404.193
! layer and radiation schemes ice concentrations are restricted to GRS2F404.194
! 0.3 to 1.0. This will allow SSTs in areas of less than 30% ice to GRS2F404.195
! be used rather than TFS=-1.8C. GRS2F404.196
GRS2F404.197
IF (ANCIL_DATA(I).lt.0.3) ANCIL_DATA(I)=0.0 GRS2F404.198
IF (ANCIL_DATA(I).gt.1.0) ANCIL_DATA(I)=1.0 GRS2F404.199
GRS2F404.200
ENDDO RPANCA1A.987
ELSE ! non AMIP II option GRS2F404.201
DO I=1,P_FIELD GRS2F404.202
ANCIL_DATA(I)=ICE_EXTENT(I,1) GRS2F404.203
ENDDO GRS2F404.204
ENDIF ! end of AMIPII test GRS2F404.205
ELSE IF (LAMIPII.AND.FIELD.EQ.28) THEN GRS2F404.206
DO I=1,P_FIELD GRS2F404.207
ANCIL_DATA(I)=ANCIL1(I) GRS2F404.208
IF (ANCIL_DATA(I).lt.TFS) ANCIL_DATA(I)=TFS GRS2F404.209
ENDDO GRS2F404.210
ELSE RPANCA1A.988
DO I=1,P_FIELD RPANCA1A.989
ANCIL_DATA(I)=ANCIL1(I) RPANCA1A.990
END DO RPANCA1A.991
ENDIF RPANCA1A.992
END IF !End interpolate/no interpolate RPANCA1A.993
RPANCA1A.994
CL 3.5 Updating action for each field at each level RPANCA1A.995
CL Fields replaced except that Sea Surface Temperature may be RPANCA1A.996
CL incremented. Take apropriate action for each field. RPANCA1A.997
RPANCA1A.998
IF(FIELD.LE.2.OR.FIELD.EQ.7.OR.FIELD.EQ.39.OR.FIELD.EQ.40. RB221193.92
& OR.FIELD.EQ.41.OR.FIELD.EQ.42.OR.FIELD.EQ.43. GRB0F304.160
& OR.FIELD.EQ.44.OR.FIELD.EQ.45. ! multi-level murk GRB0F304.161
& OR.(FIELD.GE.68.AND.FIELD.LE.70). !NH3,soot aerosol emissions ARR5F405.28
& OR.(FIELD.GE.72.AND.FIELD.LE.77). !Sulphur cycle UDG0F404.21
& OR.FIELD.EQ.78. !CO2 EMISSIONS ACN1F405.164
& OR.FIELD.EQ.82. !HADCM2 sulphate aerosol GDG2F405.104
& OR.(FIELD.GE.90.AND.FIELD.LE.109) !multi-level user ancillaries GDG2F405.105
& )THEN GDG2F405.106
RPANCA1A.1000
CL 3.5.0 Updates at all points RPANCA1A.1001
RPANCA1A.1002
LEN=P_FIELD RPANCA1A.1003
CL Ozone, test for zonal mean or full field RPANCA1A.1004
IF(FIELD.EQ.7) THEN RPANCA1A.1005
IF(LOOKUP(LBNPT,LOOKUP_START(FILE)+I2-1).EQ.1) THEN RPANCA1A.1006
LEN=P_ROWS RPANCA1A.1007
END IF RPANCA1A.1008
END IF RPANCA1A.1009
RPANCA1A.1010
DO I=1,LEN RPANCA1A.1011
D1(D1_ANCILADD(FIELD)+I-1+(LEVEL-1)*LEN)=ANCIL_DATA(I) RPANCA1A.1012
END DO RPANCA1A.1013
RPANCA1A.1014
CL 3.5.1 Updates over all land points RPANCA1A.1015
RPANCA1A.1016
ELSEIF((FIELD.GT.2.AND.FIELD.LT.7). GRB0F304.163
& OR.(FIELD.GT.7.AND.FIELD.LT.27). GRB0F304.164
& OR.(FIELD.EQ.32).OR.(FIELD.GE.34.AND.FIELD.LE.36).OR. GRB0F304.165
& (FIELD.GE.48.AND.FIELD.LE.67). ! single level user ancillaries GRB0F304.166
& OR.(FIELD.GE.46.AND.FIELD.LE.47). !Orographic roughness UDG0F404.23
& OR.(FIELD.GE.79.AND.FIELD.LE.81). !MOSES-I UDG0F404.24
& OR.(FIELD.GE.83.AND.FIELD.LE.89)) THEN !MOSES-II UDG0F404.25
RPANCA1A.1020
*IF DEF,RECON RPANCA1A.1021
C Set default value of Z0 over sea RPANCA1A.1022
RPANCA1A.1023
DO I=1,P_FIELD RPANCA1A.1024
IF(.NOT.LAND(I).AND.FIELD.EQ.26) THEN RPANCA1A.1025
D1(D1_ANCILADD(FIELD)+I-1+(LEVEL-1)*P_FIELD)=10.E-4 RPANCA1A.1026
END IF RPANCA1A.1027
END DO RPANCA1A.1028
RPANCA1A.1029
DO I=1,P_FIELD RPANCA1A.1030
IF (LAND(I)) THEN RPANCA1A.1031
D1(D1_ANCILADD(FIELD)+I-1+(LEVEL-1)*P_FIELD)=ANCIL_DATA(I) RPANCA1A.1032
END IF RPANCA1A.1033
END DO RPANCA1A.1034
RPANCA1A.1035
CL Reset TSTAR to TM if snow cover present RPANCA1A.1036
IF(LSNOW_DEPTH) THEN RPANCA1A.1037
DO I=1,P_FIELD RPANCA1A.1038
IF (LAND(I).AND.ANCIL_DATA(I).GT.0.0) THEN RPANCA1A.1039
IF(TSTAR(I).GT.TM) TSTAR(I)=TM RPANCA1A.1040
END IF RPANCA1A.1041
END DO RPANCA1A.1042
END IF RPANCA1A.1043
*ELSE RPANCA1A.1044
RPANCA1A.1045
CL If not reconfiguration, set snowdepth values at all land points RPANCA1A.1046
CL Reset TSTAR to TM if snow cover present RPANCA1A.1047
RPANCA1A.1048
IF(LSNOW_DEPTH) THEN RPANCA1A.1049
DO I=1,P_FIELD RPANCA1A.1050
IF(LAND(I)) THEN RPANCA1A.1051
D1(D1_ANCILADD(FIELD)+I-1)=ANCIL_DATA(I) RPANCA1A.1052
IF(TSTAR(I).GT.TM.AND.ANCIL_DATA(I).GT.0.0) THEN RPANCA1A.1053
TSTAR(I)=TM RPANCA1A.1054
END IF RPANCA1A.1055
END IF RPANCA1A.1056
END DO RPANCA1A.1057
RPANCA1A.1058
CL Set all other fields , which are stored at land points only RPANCA1A.1059
RPANCA1A.1060
ELSE RPANCA1A.1061
CALL TO_LAND_POINTS(ANCIL_DATA,D1(D1_ANCILADD(FIELD)+ RPANCA1A.1062
& (LEVEL-1)*LAND_FIELD),LAND,P_FIELD,I) RPANCA1A.1063
END IF RPANCA1A.1064
RPANCA1A.1065
*ENDIF RPANCA1A.1066
RPANCA1A.1067
RPANCA1A.1068
CL 3.5.2 Ice fraction RPANCA1A.1069
RPANCA1A.1070
ELSE IF(FIELD.EQ.27) THEN RPANCA1A.1071
DO I=1,P_FIELD RPANCA1A.1072
ICE_FRACTION(I)=0. RPANCA1A.1073
IF (.NOT.LAND(I)) THEN RPANCA1A.1074
ICE_FRACTION(I)=ANCIL_DATA(I) RPANCA1A.1075
END IF RPANCA1A.1076
END DO RPANCA1A.1077
RPANCA1A.1078
CL Reduce TSTAR to TFS where ice fraction greater than zero RPANCA1A.1079
! Required at present because radiation and boundary layer codes GRS2F404.211
! assume T* is TFS and ignore any value set in TSTAR. GRS2F404.212
RPANCA1A.1080
DO I=1,P_FIELD RPANCA1A.1081
IF(ICE_FRACTION(I).GT.0.0) THEN RPANCA1A.1082
TSTAR(I)=AMIN1(TSTAR(I),TFS) RPANCA1A.1083
ENDIF RPANCA1A.1084
END DO RPANCA1A.1085
RPANCA1A.1086
CL 3.5.3 Sea surface temperatures for atmosphere, allow fields to be RPANCA1A.1087
CL incremented rather than replaced RPANCA1A.1088
RPANCA1A.1089
ELSE IF (FIELD.EQ.28) THEN RPANCA1A.1090
RPANCA1A.1091
*IF DEF,RECON RPANCA1A.1092
IF(L_SSTANOM) THEN RPANCA1A.1093
DO I=1,P_FIELD RPANCA1A.1094
TSTAR_ANOM(I)=0.0 RPANCA1A.1095
END DO RPANCA1A.1096
END IF RPANCA1A.1097
*ENDIF RPANCA1A.1098
RPANCA1A.1099
DO I=1,P_FIELD RPANCA1A.1100
IF (.NOT.LAND(I).AND.ICE_FRACTION(I).EQ.0.0) THEN RPANCA1A.1101
IF(L_SSTANOM) THEN RPANCA1A.1102
*IF -DEF,RECON RPANCA1A.1103
TSTAR(I)=ANCIL_DATA(I)+TSTAR_ANOM(I) RPANCA1A.1104
*ELSE RPANCA1A.1105
TSTAR_ANOM(I)=TSTAR(I)-ANCIL_DATA(I) RPANCA1A.1106
*ENDIF RPANCA1A.1107
ELSE RPANCA1A.1108
TSTAR(I)=ANCIL_DATA(I) RPANCA1A.1109
END IF RPANCA1A.1110
END IF RPANCA1A.1111
END DO RPANCA1A.1112
RPANCA1A.1113
CL 3.5.3.1 Reference SSTs for SLAB model TJ240293.32
TJ240293.33
ELSE IF (FIELD.EQ.37) THEN TJ240293.34
TJ240293.35
DO I=1,P_FIELD TJ240293.36
IF (.NOT.LAND(I)) THEN GJT1F304.121
D1(D1_ANCILADD(FIELD)+I-1)=ANCIL_DATA(I) TJ240293.38
ELSE TJ240293.39
D1(D1_ANCILADD(FIELD)+I-1)=TSTAR(I) TJ240293.40
ENDIF TJ240293.41
END DO TJ240293.42
TJ240293.43
CL 3.5.4 Sea ice thickness/Reference seaice thickness for SLAB TJ240293.44
CL Update over all sea points (all sea ice points are the only RPANCA1A.1115
CL ones strictly required, but this cannot be determined easily) RPANCA1A.1116
RPANCA1A.1117
ELSE IF (FIELD.EQ.29.OR.FIELD.EQ.38) THEN TJ240293.45
RPANCA1A.1119
DO I=1,P_FIELD RPANCA1A.1120
IF(.NOT.LAND(I)) THEN RPANCA1A.1121
D1(D1_ANCILADD(FIELD)+I-1)=ANCIL_DATA(I) RPANCA1A.1122
END IF RPANCA1A.1123
END DO RPANCA1A.1124
RPANCA1A.1125
CL 3.5.5 Surface currents RPANCA1A.1126
RPANCA1A.1127
ELSE IF (FIELD.EQ.30.OR.FIELD.EQ.31) THEN RPANCA1A.1128
DO I=1,U_FIELD RPANCA1A.1129
IF(.NOT.LAND(I)) THEN RPANCA1A.1130
D1(D1_ANCILADD(FIELD)+I-1)=ANCIL_DATA(I) RPANCA1A.1131
ELSE GDR5F400.62
D1(D1_ANCILADD(FIELD)+I-1) = 0.0 GDR5F400.63
END IF RPANCA1A.1132
END DO RPANCA1A.1133
RPANCA1A.1134
CL 3.5.6 Heat convergence (slab model) RPANCA1A.1135
CL Update over all non-land points RPANCA1A.1136
RPANCA1A.1137
ELSE IF (FIELD.EQ.33) THEN RPANCA1A.1138
RPANCA1A.1139
DO I=1,P_FIELD RPANCA1A.1140
IF(.NOT.LAND(I)) THEN RPANCA1A.1141
D1(D1_ANCILADD(FIELD)+I-1)=ANCIL_DATA(I) RPANCA1A.1142
ELSE GDR5F400.64
D1(D1_ANCILADD(FIELD)+I-1) = 0.0 GDR5F400.65
END IF RPANCA1A.1143
END DO RPANCA1A.1144
RPANCA1A.1145
ELSE GRB0F304.168
GRB0F304.169
WRITE(6,*)' REPLANCA: ERROR - FIELD ',FIELD, GIE0F403.607
& ' omitted from update block' GRB0F304.171
RPANCA1A.1146
END IF !End tests on FIELD numbers RPANCA1A.1147
RPANCA1A.1148
CL End loop over levels RPANCA1A.1149
RPANCA1A.1150
I2=I2+1 RPANCA1A.1151
RPANCA1A.1152
30 CONTINUE RPANCA1A.1153
RPANCA1A.1154
CL End loop over ancillary fields (atmosphere) RPANCA1A.1155
ENDIF ! LAMIPII and ice depth test GRS2F404.213
RPANCA1A.1156
END IF ! End UPDATE(field) test level 1 IF RPANCA1A.1157
RPANCA1A.1158
RPANCA1A.1159
END DO RPANCA1A.1160
RPANCA1A.1161
900 RETURN RPANCA1A.1162
END RPANCA1A.1163
RPANCA1A.1164
*ENDIF RPANCA1A.1165