SUBROUTINE IN_BOUND ( 2,43@DYALLOC.1272
*CALL ARGSIZE 
@DYALLOC.1273
*CALL ARGDUMA @DYALLOC.1274
*CALL ARGDUMO @DYALLOC.1275
*CALL ARGDUMW WRB1F401.186
*CALL ARGSTS ARB1F404.331
*CALL ARGPTRA @DYALLOC.1276
*CALL ARGPTRO @DYALLOC.1277
*CALL ARGPTRW WRB1F401.187
*CALL ARGBND @DYALLOC.1278
*IF DEF,ATMOS NF171193.25
& A_LEN1_LEVDEPCDA,A_LEN2_LEVDEPCDA, NF171193.26
*ENDIF NF171193.27
*IF DEF,OCEAN NF171193.28
& O_LEN1_LEVDEPCDA,O_LEN2_LEVDEPCDA, NF171193.29
*ENDIF NF171193.30
*IF DEF,WAVE WRB1F401.188
& W_LEN1_LEVDEPCDA,W_LEN2_LEVDEPCDA, WRB1F401.189
*ENDIF WRB1F401.190
*CALL ARGPPX GDG0F401.799
& ICODE,CMESSAGE) GDR3F305.239
INBOUND1.32
IMPLICIT NONE INBOUND1.33
@DYALLOC.1280
*CALL CMAXSIZE @DYALLOC.1281
*CALL CSUBMODL PXORDER.23
*CALL TYPSIZE @DYALLOC.1282
*CALL TYPDUMA @DYALLOC.1283
*CALL TYPDUMO @DYALLOC.1284
*CALL TYPDUMW WRB1F401.191
*CALL TYPSTS ARB1F404.332
*CALL TYPPTRA @DYALLOC.1285
*CALL TYPPTRO @DYALLOC.1286
*CALL TYPPTRW WRB1F401.192
*CALL TYPBND @DYALLOC.1287
INBOUND1.34
INTEGER INBOUND1.35
*IF DEF,ATMOS NF171193.31
& A_LEN1_LEVDEPCDA, ! IN : copy of A_LEN1_LEVDEPC NF171193.32
& A_LEN2_LEVDEPCDA, ! IN : copy of A_LEN2_LEVDEPC NF171193.33
*ENDIF NF171193.34
*IF DEF,OCEAN NF171193.35
& O_LEN1_LEVDEPCDA, ! IN : copy of O_LEN1_LEVDEPC NF171193.36
& O_LEN2_LEVDEPCDA, ! IN : copy of O_LEN2_LEVDEPC NF171193.37
*ENDIF NF171193.38
*IF DEF,WAVE WRB1F401.193
& W_LEN1_LEVDEPCDA, ! IN : copy of W_LEN1_LEVDEPC WRB1F401.194
& W_LEN2_LEVDEPCDA, ! IN : copy of W_LEN2_LEVDEPC WRB1F401.195
*ENDIF WRB1F401.196
& ICODE ! Return code = 0 Normal Exit INBOUND1.36
C ! " " > 0 Error Exit INBOUND1.37
INBOUND1.38
CHARACTER*(80) CMESSAGE ! Error message if ICODE > 0 TS071093.3
C* INBOUND1.40
INBOUND1.41
*CALL PPXLOOK GDG0F401.801
*CALL CHSUNITS GDR3F305.241
*CALL CHISTORY GDR3F305.242
*CALL CCONTROL GDR3F305.243
*CALL CTIME GDR3F305.244
*CALL C_MDI GDR3F305.245
*CALL CENVIR INBOUND1.48
*CALL CTRACERA ARB1F404.333
INBOUND1.49
C Local variables INBOUND1.50
INBOUND1.51
INTEGER INBOUND1.52
& I, ! INBOUND1.53
& J, ! INBOUND1.54
& J1, ! INBOUND1.55
& START_BLOCK, ! GDR1F404.3
& NFTIN, ! INBOUND1.57
& DAYS,SECS, ! Various clock times TJ080294.264
& DAYS_DATA_START,SECS_DATA_START, ! related to time range TJ080294.265
& DAYS_DATA_END,SECS_DATA_END, ! of data files TJ080294.266
& ELAPSED_STEPS, ! Elapsed timesteps from data start time TJ080294.267
& DATA_TO_SKIP ! no of data times from first entry in lookup INBOUND1.66
C table to current model time INBOUND1.67
&, BASISMDATA_STEPS ! model basis time minus first data time INBOUND1.68
&, INTERVAL ! time interval between data times (seconds) INBOUND1.69
&, PERIOD ! length of periodic data set (seconds) INBOUND1.70
&, im_index ! internal model index ARB1F404.334
&, ITEM_BOUNDA(RIM_LOOKUPSA) ! boundary updatable item list ARB1F404.335
INBOUND1.71
*IF DEF,ATMOS,AND,-DEF,GLOBAL @DYALLOC.1288
REAL A_LEVDEPC_BO(A_LEN1_LEVDEPCDA,A_LEN2_LEVDEPCDA) GDR1F404.4
*ENDIF @DYALLOC.1290
*IF DEF,OCEAN,AND,DEF,BOUNDSO @DYALLOC.1291
REAL O_LEVDEPC_BO(O_LEN1_LEVDEPCDA,O_LEN2_LEVDEPCDA) GDR1F404.5
*ENDIF @DYALLOC.1293
INTEGER DUMMY APB4F401.399
DATA DUMMY /1/ APB4F401.400
INBOUND1.75
*IF DEF,MPP APB4F401.401
*CALL PARVARS APB4F401.402
*ENDIF APB4F401.403
INBOUND1.76
CL Subroutines called: INBOUND1.77
INBOUND1.78
EXTERNAL INBOUND1.79
& TIME2SEC,TIM2STEP GDR6F405.27
! & ,PR_REHDA ! Commented out in routine GDR6F405.28
*IF DEF,ATMOS,AND,-DEF,GLOBAL,OR,DEF,ATMOS,AND,DEF,FLOOR GDR6F405.29
& ,CHK_LOOK_BOUNDA GDR6F405.30
*ENDIF GDR6F405.31
INBOUND1.82
CL Functions called: TJ080294.269
TJ080294.270
EXTERNAL TJ080294.271
& TIME_EQ,TIME_LT TJ080294.272
TJ080294.273
LOGICAL TIME_EQ,TIME_LT TJ080294.274
TJ080294.275
NAMELIST/BOUNCNST/BOUND_FIELDCODE,RIMWEIGHTSA,RIMWEIGHTSO INBOUND1.83
INBOUND1.84
REAL P1,P2 INBOUND1.85
LOGICAL LNER INBOUND1.86
LNER(P1,P2) = ((ABS(P1-P2)) .GT. (1.E-6*ABS(P1+P2))) INBOUND1.87
INBOUND1.88
INBOUND1.89
CL Internal Structure INBOUND1.90
INBOUND1.91
ICODE=0 INBOUND1.92
CMESSAGE=' ' INBOUND1.93
INBOUND1.94
*IF DEF,ATMOS,AND,-DEF,GLOBAL,OR,DEF,OCEAN,AND,DEF,BOUNDSO INBOUND1.95
INBOUND1.96
! Rewind file and read namelist for boundary updating constants GDR3F305.246
INBOUND1.98
REWIND 5 GDR3F305.247
READ(5,BOUNCNST) INBOUND1.99
INBOUND1.100
*ENDIF INBOUND1.101
CL 1.0 Initialise variables in COMMON/CBND/, lest undefined for some RB300393.33
CL choices of boundary updating, eg. -DEF,GLOBAL but not DEF,FLOOR, RB300393.34
CL as used in section 2 to set BOUNDARY_STEPSim for atmos GDR5F305.33
RIM_STEPSA = 0 RB300393.36
RIM_STEPSO = 0 RB300393.37
FLOOR_STEPSA = 0 RB300393.38
! Initialise bndary_offset for all internal model ids. GOK1F401.3
DO I=1,INTERNAL_ID_MAX GOK1F401.4
BNDARY_OFFSETim(I) = 0 GOK1F401.5
END DO GOK1F401.6
GOK1F401.7
*IF DEF,ATMOS,AND,-DEF,GLOBAL INBOUND1.102
INBOUND1.103
CL 1.1 Update interval for lateral boundaries for atmosphere INBOUND1.104
CL Read headers and test whether boundary updating required INBOUND1.105
INBOUND1.106
RIM_STEPSA =IMDI INBOUND1.107
IF ( BOUND_FIELDCODE(1).LE.0) THEN INBOUND1.108
RIM_STEPSA=0 INBOUND1.109
ELSE INBOUND1.110
INBOUND1.111
C Check that space has been reserved for boundary tendencies INBOUND1.112
INBOUND1.113
IF(JRIM.LE.0.OR.JRIM_TENDENCY.LE.0) THEN INBOUND1.114
ICODE= 1 INBOUND1.115
CMESSAGE=' INBOUND: No space reserved for boundary data' INBOUND1.116
RETURN INBOUND1.117
END IF INBOUND1.118
INBOUND1.119
CL Open input boundary file and read headers INBOUND1.120
INBOUND1.121
NFTIN=95 INBOUND1.122
APB4F401.404
NBOUND_LOOKUP(1)=1 APB4F401.405
INBOUND1.123
CALL FILE_OPEN(NFTIN,FT_ENVIRON(NFTIN), GPB1F305.49
* LEN_FT_ENVIR(NFTIN),0,0,ICODE) INBOUND1.125
IF(ICODE.NE.0) THEN INBOUND1.126
CMESSAGE=' IN_BOUND: Failure of opening boundary file' INBOUND1.127
RETURN INBOUND1.128
ENDIF INBOUND1.129
INBOUND1.130
C Read in fixed header to get array dimensions APB4F401.406
CALL READ_FLH(NFTIN,FIXHD_BOUNDA(1,1),LEN_FIXHD,ICODE,CMESSAGE) APB4F401.407
IF (ICODE.GT.0) THEN APB4F401.408
WRITE (6,*) 'INBOUND : Error in READ_FLH for BOUNDA(1,1)' APB4F401.409
WRITE (6,*) 'ICODE ',ICODE,' CMESSAGE ',CMESSAGE APB4F401.410
GO TO 9999 ! Return APB4F401.411
ENDIF APB4F401.412
APB4F401.413
C Check for negative dimensions APB4F401.414
IF (FIXHD_BOUNDA(101,1).LE.0) FIXHD_BOUNDA(101,1)=1 APB4F401.415
IF (FIXHD_BOUNDA(106,1).LE.0) FIXHD_BOUNDA(106,1)=1 APB4F401.416
IF (FIXHD_BOUNDA(111,1).LE.0) FIXHD_BOUNDA(111,1)=1 APB4F401.417
IF (FIXHD_BOUNDA(112,1).LE.0) FIXHD_BOUNDA(112,1)=1 APB4F401.418
IF (FIXHD_BOUNDA(151,1).LE.0) FIXHD_BOUNDA(151,1)=1 APB4F401.419
IF (FIXHD_BOUNDA(152,1).LE.0) FIXHD_BOUNDA(152,1)=1 APB4F401.420
IF (FIXHD_BOUNDA(161,1).LE.0) FIXHD_BOUNDA(161,1)=1 APB4F401.421
APB4F401.422
! Check if sufficient space allocated for LOOKUP table APB4F401.423
IF (FIXHD_BOUNDA(152,1).GT.BOUND_LOOKUPSA) THEN APB4F401.424
write(6,*)' IN_BOUND; not enough space for LBC lookup headers.' ARB1F404.336
write(6,*)' try increasing value specified in umui' ARB1F404.337
write(6,*)' window atmos_Infile_Options_Headers' ARB1F404.338
CMESSAGE = 'INBOUND: Insufficient space for Lookup Table' APB4F401.425
ICODE = 2 APB4F401.426
GO TO 9999 ! Return APB4F401.427
ENDIF APB4F401.428
APB4F401.429
CALL SETPOS (NFTIN,0,ICODE) APB4F401.430
IF (ICODE.GT.0) THEN APB4F401.431
WRITE (6,*) 'INBOUND: Problem with SETPOS for BOUNDA(1,1)' APB4F401.432
WRITE (6,*) 'ICODE ',ICODE,' NFTIN ',NFTIN APB4F401.433
GO TO 9999 ! Return APB4F401.434
ENDIF APB4F401.435
APB4F401.436
CALL READHEAD(NFTIN, APB4F401.437
& FIXHD_BOUNDA(1,1),LEN_FIXHD, APB4F401.438
& INTHD_BOUNDA(1,1),FIXHD_BOUNDA(101,1), APB4F401.439
& REALHD_BOUNDA(1,1),FIXHD_BOUNDA(106,1), APB4F401.440
& A_LEVDEPC_BO(1,1), APB4F401.441
& FIXHD_BOUNDA(111,1),FIXHD_BOUNDA(112,1), APB4F401.442
& DUMMY,DUMMY,DUMMY, APB4F401.443
& DUMMY,DUMMY,DUMMY, APB4F401.444
& DUMMY,DUMMY,DUMMY, APB4F401.445
& DUMMY,DUMMY, APB4F401.446
& DUMMY,DUMMY, APB4F401.447
& DUMMY,DUMMY, APB4F401.448
& DUMMY,DUMMY, APB4F401.449
& DUMMY,DUMMY, APB4F401.450
& LOOKUP_BOUNDA(1,NBOUND_LOOKUP(1)), APB4F401.451
& FIXHD_BOUNDA(151,1),FIXHD_BOUNDA(152,1), APB4F401.452
& FIXHD_BOUNDA(161,1), APB4F401.453
*CALL ARGPPX APB4F401.454
& START_BLOCK,ICODE,CMESSAGE) GDR1F404.7
APB4F401.456
IF (ICODE.GT.0) THEN APB4F401.457
WRITE (6,*) 'INBOUND: Problem with READHEAD for BOUNDA(1,1)' APB4F401.458
WRITE (6,*) 'ICODE ',ICODE,' CMESSAGE ',CMESSAGE APB4F401.459
GO TO 9999 ! Return APB4F401.460
ENDIF APB4F401.461
APB4F401.462
INBOUND1.146
C Check validity of data and print out fixed header information INBOUND1.147
C Allow variable length of data and level dependent constants INBOUND1.148
C in boundary data set.Do not check other constants arrays. INBOUND1.149
WRITE(6,*) ' HEADER FOR LATERAL BOUNDARY DATASET - ATMOSPHERE' INBOUND1.150
INBOUND1.151
CL 1.1.2 Buffer in integer constants INBOUND1.162
INBOUND1.163
IF(FIXHD_BOUNDA(100,1).GT.0) THEN INBOUND1.164
INBOUND1.165
*IF -DEF,MPP APB4F401.463
IF(INTHD_BOUNDA(6,1).NE.ROW_LENGTH) THEN INBOUND1.197
WRITE(6,*)'Mismatch in row_length:data set has',INTHD_BOUNDA GIE0F403.303
& (6,1),'required value is',ROW_LENGTH INBOUND1.199
*ELSE APB4F401.464
IF(INTHD_BOUNDA(6,1).NE.glsize(1)) THEN APB4F401.465
WRITE(6,*)'Mismatch in row_length:data set has',INTHD_BOUNDA GIE0F403.304
& (6,1),'required value is',glsize(1) APB4F401.467
*ENDIF APB4F401.468
ICODE=5 INBOUND1.200
CMESSAGE='IN_BOUND:integer header error' INBOUND1.201
RETURN INBOUND1.202
END IF INBOUND1.203
INBOUND1.204
*IF -DEF,MPP APB4F401.469
IF(INTHD_BOUNDA(7,1).NE.P_ROWS) THEN INBOUND1.205
WRITE(6,*)'Mismatch in numbers of rows:data set GIE0F403.305
& has',INTHD_BOUNDA(7,1),'required values are', INBOUND1.207
& P_ROWS INBOUND1.208
*ELSE APB4F401.470
IF(INTHD_BOUNDA(7,1).NE.glsize(2)) THEN APB4F401.471
WRITE(6,*)'Mismatch in numbers of rows:data set GIE0F403.306
& has',INTHD_BOUNDA(7,1),'required values are', APB4F401.473
& glsize(2) APB4F401.474
*ENDIF APB4F401.475
ICODE=6 INBOUND1.209
CMESSAGE='IN_BOUND:integer header error' INBOUND1.210
RETURN INBOUND1.211
END IF INBOUND1.212
INBOUND1.213
IF(ICODE.GT.0) RETURN INBOUND1.214
INBOUND1.215
END IF INBOUND1.216
INBOUND1.217
CL 1.1.3 Buffer in real constants INBOUND1.218
INBOUND1.219
IF(FIXHD_BOUNDA(105,1).GT.0) THEN INBOUND1.220
INBOUND1.221
C Check validity of real data and print out information INBOUND1.247
INBOUND1.248
C CALL PR_REHDA(REALHD_BOUNDA(1,1),PP_LEN_REALHD) INBOUND1.249
INBOUND1.250
DO 113 J=1,6 INBOUND1.251
! Check real headers agree to near 32 bit accuracy GDR5F305.34
IF(LNER(REALHD_BOUNDA(J,1),A_REALHD(J))) THEN GDR5F305.35
WRITE(6,*)'Mismatch in real header position',J,'data set GIE0F403.307
& has',REALHD_BOUNDA(J,1),'required value is:',A_ INBOUND1.254
& REALHD(J) INBOUND1.255
ICODE=9 INBOUND1.256
CMESSAGE=' INBOUND: Real header error.' INBOUND1.257
RETURN INBOUND1.258
END IF INBOUND1.259
113 CONTINUE INBOUND1.260
INBOUND1.261
END IF INBOUND1.262
INBOUND1.263
CL 1.1.4 Buffer in level dependent constants INBOUND1.264
INBOUND1.265
IF(FIXHD_BOUNDA(110,1).GT.0) THEN INBOUND1.266
INBOUND1.267
CL check against model levels INBOUND1.294
INBOUND1.295
DO J=1,P_LEVELS INBOUND1.296
DO J1=1,FIXHD_BOUNDA(112,1) INBOUND1.297
IF(LNER(A_LEVDEPC_BO(J,J1), @DYALLOC.1297
& A_LEVDEPC(J+(J1-1)*A_LEN1_LEVDEPC))) THEN @DYALLOC.1298
WRITE(6,*)'INBOUND:Error in level dependent constants' GIE0F403.308
WRITE(6,*)'level=',J,' Position=',J1 GIE0F403.309
WRITE(6,*)'Value in model = ', GIE0F403.310
& A_LEVDEPC(J+(J1-1)*A_LEN1_LEVDEPC) INBOUND1.303
WRITE(6,*)'Value in lateral bound. data =',A_LEVDEPC_BO(J,J1) GIE0F403.311
ICODE=100 INBOUND1.305
CMESSAGE='INBOUND : error in A_LEVDEPC_BO.' @DYALLOC.1300
RETURN INBOUND1.307
END IF INBOUND1.308
END DO INBOUND1.309
END DO INBOUND1.310
INBOUND1.311
END IF INBOUND1.312
CL Set update interval INBOUND1.313
C If update interval includes months or years, a 360 day INBOUND1.314
C calender assumed. INBOUND1.315
INBOUND1.316
RIM_STEPSA=(FIXHD_BOUNDA(35,1)*8640+FIXHD_BOUNDA(36,1)*720 INBOUND1.317
& +FIXHD_BOUNDA(37,1)*24+FIXHD_BOUNDA(38,1)) GDR3F305.248
& *3600*STEPS_PER_PERIODim(a_im)/SECS_PER_PERIODim(a_im) GDR3F305.249
INBOUND1.319
END IF INBOUND1.320
INBOUND1.321
*ENDIF INBOUND1.322
INBOUND1.323
*IF DEF,OCEAN,AND,DEF,BOUNDSO INBOUND1.324
INBOUND1.325
CL 1.2 Update interval for lateral boundaries for ocean INBOUND1.326
CL Read headers and test whether boundary updating required INBOUND1.327
INBOUND1.328
RIM_STEPSO =IMDI INBOUND1.329
IF ( BOUND_FIELDCODE(2).LE.0) THEN INBOUND1.330
RIM_STEPSO=0 INBOUND1.331
ELSE INBOUND1.332
INBOUND1.333
C Check that space has been reserved for boundary tendencies INBOUND1.334
INBOUND1.335
IF(joc_bounds_prev.LE.0.OR.joc_bounds_next.LE.0) THEN GSI1F405.159
ICODE= 1 INBOUND1.337
CMESSAGE=' INBOUND: No space reserved for ocean bndry data' INBOUND1.338
RETURN INBOUND1.339
END IF INBOUND1.340
INBOUND1.341
CL Open input boundary file and read headers INBOUND1.342
INBOUND1.343
NFTIN=98 INBOUND1.344
GDR1F404.8
NBOUND_LOOKUP(2)=1 GDR1F404.9
INBOUND1.345
CALL FILE_OPEN(NFTIN,FT_ENVIRON(NFTIN), GPB1F305.50
* LEN_FT_ENVIR(NFTIN),0,0,ICODE) INBOUND1.347
IF(ICODE.NE.0) THEN INBOUND1.348
CMESSAGE=' IN_BOUND: Failure of opening boundary file' INBOUND1.349
RETURN INBOUND1.350
ENDIF INBOUND1.351
INBOUND1.352
! Read in fixed header to get array dimensions GDR1F404.10
CALL READ_FLH(NFTIN,FIXHD_BOUNDO(1,1),LEN_FIXHD,ICODE,CMESSAGE) GDR1F404.11
IF (ICODE.GT.0) THEN GDR1F404.12
WRITE (6,*) 'INBOUND : Error in READ_FLH for BOUNDO(1,1)' GDR1F404.13
WRITE (6,*) 'ICODE ',ICODE,' CMESSAGE ',CMESSAGE GDR1F404.14
GO TO 9999 ! Return GDR1F404.15
ENDIF GDR1F404.16
GDR1F404.17
! Check for negative dimensions GDR1F404.18
IF (FIXHD_BOUNDO(101,1).LE.0) FIXHD_BOUNDO(101,1)=1 GDR1F404.19
IF (FIXHD_BOUNDO(106,1).LE.0) FIXHD_BOUNDO(106,1)=1 GDR1F404.20
IF (FIXHD_BOUNDO(111,1).LE.0) FIXHD_BOUNDO(111,1)=1 GDR1F404.21
IF (FIXHD_BOUNDO(112,1).LE.0) FIXHD_BOUNDO(112,1)=1 GDR1F404.22
IF (FIXHD_BOUNDO(151,1).LE.0) FIXHD_BOUNDO(151,1)=1 GDR1F404.23
IF (FIXHD_BOUNDO(152,1).LE.0) FIXHD_BOUNDO(152,1)=1 GDR1F404.24
IF (FIXHD_BOUNDO(161,1).LE.0) FIXHD_BOUNDO(161,1)=1 GDR1F404.25
GDR1F404.26
! Check if sufficient space allocated for LOOKUP table GDR1F404.27
IF (FIXHD_BOUNDO(152,1).GT.BOUND_LOOKUPSO) THEN GDR1F404.28
CMESSAGE = 'INBOUND: Insufficient space for Lookup Table' GDR1F404.29
ICODE = 2 GDR1F404.30
GO TO 9999 ! Return GDR1F404.31
ENDIF GDR1F404.32
GDR1F404.33
CALL SETPOS (NFTIN,0,ICODE) GDR1F404.34
IF (ICODE.GT.0) THEN GDR1F404.35
WRITE (6,*) 'INBOUND: Problem with SETPOS for BOUNDO(1,1)' GDR1F404.36
WRITE (6,*) 'ICODE ',ICODE,' NFTIN ',NFTIN GDR1F404.37
GO TO 9999 ! Return GDR1F404.38
ENDIF GDR1F404.39
GDR1F404.40
CALL READHEAD(NFTIN, GDR1F404.41
& FIXHD_BOUNDO(1,1),LEN_FIXHD, GDR1F404.42
& INTHD_BOUNDO(1,1),FIXHD_BOUNDO(101,1), GDR1F404.43
& REALHD_BOUNDO(1,1),FIXHD_BOUNDO(106,1), GDR1F404.44
& O_LEVDEPC_BO(1,1), GDR1F404.45
& FIXHD_BOUNDO(111,1),FIXHD_BOUNDO(112,1), GDR1F404.46
& DUMMY,DUMMY,DUMMY, GDR1F404.47
& DUMMY,DUMMY,DUMMY, GDR1F404.48
& DUMMY,DUMMY,DUMMY, GDR1F404.49
& DUMMY,DUMMY, GDR1F404.50
& DUMMY,DUMMY, GDR1F404.51
& DUMMY,DUMMY, GDR1F404.52
& DUMMY,DUMMY, GDR1F404.53
& DUMMY,DUMMY, GDR1F404.54
& LOOKUP_BOUNDO(1,NBOUND_LOOKUP(2)), GDR1F404.55
& FIXHD_BOUNDO(151,1),FIXHD_BOUNDO(152,1), GDR1F404.56
& FIXHD_BOUNDO(161,1), GDR1F404.57
*CALL ARGPPX GDR1F404.58
& START_BLOCK,ICODE,CMESSAGE) GDR1F404.59
GDR1F404.60
IF (ICODE.GT.0) THEN GDR1F404.61
WRITE (6,*) 'INBOUND: Problem with READHEAD for BOUNDO(1,1)' GDR1F404.62
WRITE (6,*) 'ICODE ',ICODE,' CMESSAGE ',CMESSAGE GDR1F404.63
GO TO 9999 ! Return GDR1F404.64
ENDIF GDR1F404.65
INBOUND1.477
CL Set update interval INBOUND1.478
INBOUND1.479
INTERVAL=(FIXHD_BOUNDO(35,1)*8640*3600+ INBOUND1.480
& FIXHD_BOUNDO(36,1)*720*3600+FIXHD_BOUNDO(37,1)*24*3600+ INBOUND1.481
& FIXHD_BOUNDO(38,1)*3600) INBOUND1.482
RIM_STEPSO=(INTERVAL*STEPS_PER_PERIODim(o_im))/ GDR3F305.250
& SECS_PER_PERIODim(o_im) GDR3F305.251
INBOUND1.484
END IF INBOUND1.485
INBOUND1.486
*ENDIF INBOUND1.487
INBOUND1.488
INBOUND1.489
*IF DEF,ATMOS,AND,DEF,FLOOR INBOUND1.490
INBOUND1.491
CL 1.3 Set update interval for lower boundary update for atmosphere INBOUND1.492
C Assume all lower boundary fields updated together INBOUND1.493
INBOUND1.494
FLOOR_STEPSA=IMDI INBOUND1.495
IF ( BOUND_FIELDCODE(3).LE.0) THEN INBOUND1.496
FLOOR_STEPSA=0 INBOUND1.497
ELSE INBOUND1.498
CL Open input boundary file and read headers INBOUND1.499
INBOUND1.500
NFTIN=96 INBOUND1.501
GDR1F404.66
NBOUND_LOOKUP(3)=1 GDR1F404.67
INBOUND1.502
CALL FILE_OPEN(NFTIN,FT_ENVIRON(NFTIN), GPB1F305.51
* LEN_FT_ENVIR(NFTIN),0,0,ICODE) INBOUND1.504
IF(ICODE.NE.0) THEN INBOUND1.505
CMESSAGE=' IN_BOUND: Failure of opening boundary file' INBOUND1.506
RETURN INBOUND1.507
ENDIF INBOUND1.508
INBOUND1.509
! Read in fixed header to get array dimensions GDR1F404.68
CALL READ_FLH(NFTIN,FIXHD_BOUNDA(1,2),LEN_FIXHD,ICODE,CMESSAGE) GDR1F404.69
IF (ICODE.GT.0) THEN GDR1F404.70
WRITE (6,*) 'INBOUND : Error in READ_FLH for BOUNDA(1,2)' GDR1F404.71
WRITE (6,*) 'ICODE ',ICODE,' CMESSAGE ',CMESSAGE GDR1F404.72
GO TO 9999 ! Return GDR1F404.73
ENDIF GDR1F404.74
GDR1F404.75
! Check for negative dimensions GDR1F404.76
IF (FIXHD_BOUNDA(101,2).LE.0) FIXHD_BOUNDA(101,2)=1 GDR1F404.77
IF (FIXHD_BOUNDA(106,2).LE.0) FIXHD_BOUNDA(106,2)=1 GDR1F404.78
IF (FIXHD_BOUNDA(111,2).LE.0) FIXHD_BOUNDA(111,2)=1 GDR1F404.79
IF (FIXHD_BOUNDA(112,2).LE.0) FIXHD_BOUNDA(112,2)=1 GDR1F404.80
IF (FIXHD_BOUNDA(151,2).LE.0) FIXHD_BOUNDA(151,2)=1 GDR1F404.81
IF (FIXHD_BOUNDA(152,2).LE.0) FIXHD_BOUNDA(152,2)=1 GDR1F404.82
IF (FIXHD_BOUNDA(161,2).LE.0) FIXHD_BOUNDA(161,2)=1 GDR1F404.83
GDR1F404.84
! Check if sufficient space allocated for LOOKUP table GDR1F404.85
IF (FIXHD_BOUNDA(152,2).GT.BOUND_LOOKUPSA) THEN GDR1F404.86
CMESSAGE = 'INBOUND: Insufficient space for Lookup Table' GDR1F404.87
ICODE = 2 GDR1F404.88
GO TO 9999 ! Return GDR1F404.89
ENDIF GDR1F404.90
GDR1F404.91
CALL SETPOS (NFTIN,0,ICODE) GDR1F404.92
IF (ICODE.GT.0) THEN GDR1F404.93
WRITE (6,*) 'INBOUND: Problem with SETPOS for BOUNDA(1,2)' GDR1F404.94
WRITE (6,*) 'ICODE ',ICODE,' NFTIN ',NFTIN GDR1F404.95
GO TO 9999 ! Return GDR1F404.96
ENDIF GDR1F404.97
GDR1F404.98
CALL READHEAD(NFTIN, GDR1F404.99
& FIXHD_BOUNDA(1,2),LEN_FIXHD, GDR1F404.100
& INTHD_BOUNDA(1,2),FIXHD_BOUNDA(101,2), GDR1F404.101
& REALHD_BOUNDA(1,2),FIXHD_BOUNDA(106,2), GDR1F404.102
& A_LEVDEPC_BO(1,2), GDR1F404.103
& FIXHD_BOUNDA(111,2),FIXHD_BOUNDA(112,2), GDR1F404.104
& DUMMY,DUMMY,DUMMY, GDR1F404.105
& DUMMY,DUMMY,DUMMY, GDR1F404.106
& DUMMY,DUMMY,DUMMY, GDR1F404.107
& DUMMY,DUMMY, GDR1F404.108
& DUMMY,DUMMY, GDR1F404.109
& DUMMY,DUMMY, GDR1F404.110
& DUMMY,DUMMY, GDR1F404.111
& DUMMY,DUMMY, GDR1F404.112
& LOOKUP_BOUNDA(1,NBOUND_LOOKUP(3)), GDR1F404.113
& FIXHD_BOUNDA(151,2),FIXHD_BOUNDA(152,2), GDR1F404.114
& FIXHD_BOUNDA(161,2), GDR1F404.115
*CALL ARGPPX GDR1F404.116
& START_BLOCK,ICODE,CMESSAGE) GDR1F404.117
GDR1F404.118
IF (ICODE.GT.0) THEN GDR1F404.119
WRITE (6,*) 'INBOUND: Problem with READHEAD for BOUNDA(1,2)' GDR1F404.120
WRITE (6,*) 'ICODE ',ICODE,' CMESSAGE ',CMESSAGE GDR1F404.121
GO TO 9999 ! Return GDR1F404.122
ENDIF GDR1F404.123
INBOUND1.541
IF(FIXHD_BOUNDA(100,2).GT.0) THEN INBOUND1.542
INBOUND1.568
IF(INTHD_BOUNDA(6,2).NE.ROW_LENGTH) THEN INBOUND1.575
WRITE(6,*)'Mismatch in row_length:data set has',INTHD_BOUNDA GIE0F403.312
& (6,2),'required value is',ROW_LENGTH INBOUND1.577
ICODE=15 INBOUND1.578
CMESSAGE='IN_BOUND:integer header error' INBOUND1.579
RETURN INBOUND1.580
END IF INBOUND1.581
INBOUND1.582
IF(INTHD_BOUNDA(7,2).NE.P_ROWS) THEN INBOUND1.583
WRITE(6,*)'Mismatch in numbers of rows:data set GIE0F403.313
& has',INTHD_BOUNDA(7,2),'required values are', INBOUND1.585
& P_ROWS INBOUND1.586
ICODE=16 INBOUND1.587
CMESSAGE='IN_BOUND:integer header error' INBOUND1.588
RETURN INBOUND1.589
END IF INBOUND1.590
INBOUND1.591
IF(ICODE.GT.0) RETURN INBOUND1.592
INBOUND1.593
END IF INBOUND1.594
INBOUND1.595
IF(FIXHD_BOUNDA(105,2).GT.0) THEN INBOUND1.598
INBOUND1.599
C Check validity of integer data and print out information INBOUND1.625
INBOUND1.626
C CALL PR_REHDA(REALHD_BOUNDA(1,2),PP_LEN_REALHD) INBOUND1.627
INBOUND1.628
DO 133 J=1,6 INBOUND1.629
IF(REALHD_BOUNDA(J,2).NE.A_REALHD(J)) THEN INBOUND1.630
WRITE(6,*)'Mismatch in real header position',J,'data set GIE0F403.314
& has',REALHD_BOUNDA(J,2),'required value is:',A_ INBOUND1.632
& REALHD(J) INBOUND1.633
ICODE=19 INBOUND1.634
CMESSAGE=' INBOUND: Real header error.' INBOUND1.635
RETURN INBOUND1.636
END IF INBOUND1.637
133 CONTINUE INBOUND1.638
INBOUND1.639
INBOUND1.640
END IF INBOUND1.641
INBOUND1.642
CL Set update interval INBOUND1.643
C If update interval includes months or years, a 360 day INBOUND1.644
C calender assumed. INBOUND1.645
FLOOR_STEPSA=(FIXHD_BOUNDA(35,2)*8640+FIXHD_BOUNDA(36,2)*720 INBOUND1.646
& +FIXHD_BOUNDA(37,2)*24+FIXHD_BOUNDA(38,2)) GDR3F305.252
& *3600*STEPS_PER_PERIODim(a_im)/SECS_PER_PERIODim(a_im) GDR3F305.253
END IF INBOUND1.648
INBOUND1.649
*ENDIF INBOUND1.650
INBOUND1.651
*IF DEF,OCEAN,AND,DEF,FLOOR INBOUND1.652
INBOUND1.653
INBOUND1.654
CL 1.4 Set update interval for lower boundary update for ocean INBOUND1.655
INBOUND1.656
C NOT YET AVAILABLE INBOUND1.657
GDR5F305.36
C Assign value to INTERVAL to prevent error message GDR5F305.37
C when compiling for OCEAN/FLOOR GDR5F305.38
GDR5F305.39
INTERVAL = 1 ! Temporary value GDR5F305.40
INBOUND1.658
*ENDIF INBOUND1.659
INBOUND1.660
*IF DEF,ATMOS,AND,-DEF,GLOBAL,OR,DEF,ATMOS,AND,DEF,FLOOR INBOUND1.661
INBOUND1.662
CL 2 Set interval for setting any boundary field INBOUND1.663
INBOUND1.664
IF (RIM_STEPSA.EQ.FLOOR_STEPSA ) THEN INBOUND1.665
BOUNDARY_STEPSim(a_im) = RIM_STEPSA GDR5F305.41
ELSE IF ( RIM_STEPSA.EQ.0 ) THEN INBOUND1.667
BOUNDARY_STEPSim(a_im) = FLOOR_STEPSA GDR5F305.42
ELSE IF ( FLOOR_STEPSA.EQ.0 ) THEN INBOUND1.669
BOUNDARY_STEPSim(a_im) = RIM_STEPSA GDR5F305.43
ELSE IF ( RIM_STEPSA.LT.FLOOR_STEPSA ) THEN INBOUND1.671
INBOUND1.672
IF ( MOD(FLOOR_STEPSA,RIM_STEPSA).EQ.0) THEN INBOUND1.673
BOUNDARY_STEPSim(a_im) = RIM_STEPSA GDR5F305.44
ELSE INBOUND1.675
INBOUND1.676
DO 200 I=RIM_STEPSA,1,-1 INBOUND1.677
INBOUND1.678
IF (MOD(FLOOR_STEPSA,I).EQ.0.AND.MOD(RIM_STEPSA,I).EQ.0) THEN INBOUND1.679
BOUNDARY_STEPSim(a_im)=I GDR5F305.45
END IF INBOUND1.681
INBOUND1.682
200 CONTINUE INBOUND1.683
INBOUND1.684
END IF INBOUND1.685
INBOUND1.686
ELSE IF (FLOOR_STEPSA.LT.RIM_STEPSA) THEN INBOUND1.687
INBOUND1.688
IF(MOD(RIM_STEPSA,FLOOR_STEPSA).EQ.0) THEN INBOUND1.689
BOUNDARY_STEPSim(a_im)=FLOOR_STEPSA GDR5F305.46
ELSE INBOUND1.691
INBOUND1.692
DO 210 I=FLOOR_STEPSA,1,-1 INBOUND1.693
INBOUND1.694
IF(MOD(FLOOR_STEPSA,I).EQ.0.AND.MOD(RIM_STEPSA,I).EQ.0) THEN INBOUND1.695
BOUNDARY_STEPSim(a_im) = I GDR5F305.47
END IF INBOUND1.697
INBOUND1.698
210 CONTINUE INBOUND1.699
INBOUND1.700
END IF INBOUND1.701
INBOUND1.702
END IF INBOUND1.703
INBOUND1.704
CL 3 Check LOOKUP Table GDR1F404.124
INBOUND1.706
J1=0 INBOUND1.707
IF (BOUND_FIELDCODE(1).NE.0) THEN INBOUND1.708
J1=FIXHD_BOUNDA(152,1) INBOUND1.710
INBOUND1.711
IF(FIXHD_BOUNDA(150,1).GT.0) THEN INBOUND1.716
INBOUND1.717
! Set up list of variables expected to be boundary updated. ARB1F404.339
ITEM_BOUNDA(1) = 1 ! Pstar ARB1F404.340
ITEM_BOUNDA(2) = 2 ! u-compt wind ARB1F404.341
ITEM_BOUNDA(3) = 3 ! v-compt wind ARB1F404.342
ITEM_BOUNDA(4) = 5 ! thetal ARB1F404.343
ITEM_BOUNDA(5) = 11 ! qt ARB1F404.344
IF (TR_VARS .gt. 0) THEN ARB1F404.345
! Find STASH item no. for each tracer in use. ARB1F404.346
I=0 ! count tracers in use ARB1F404.347
im_index=internal_model_index(A_IM) ARB1F404.348
DO J = A_TRACER_FIRST,A_TRACER_LAST ARB1F404.349
IF (SI(J,0,im_index).NE.1) THEN ! tracer is in use ARB1F404.350
I = I+1 ARB1F404.351
ITEM_BOUNDA(5+I) = J ARB1F404.352
END IF ARB1F404.353
END DO ARB1F404.354
! Number of tracers found should correspond to TR_VARS ARB1F404.355
IF (I.NE.TR_VARS) THEN ARB1F404.356
WRITE(6,*)' INBOUND: no.of tracers found, ',I, ARB1F404.357
& ', differs from TR_VARS, ',TR_VARS ARB1F404.358
CMESSAGE=' INBOUND: inconsistency in number of tracers' ARB1F404.359
ICODE = 100 ARB1F404.360
GO TO 9999 ARB1F404.361
END IF ARB1F404.362
END IF ARB1F404.363
IF (L_LSPICE_BDY) THEN ! mixed phase precipitation scheme ARB1F404.364
ITEM_BOUNDA(6+TR_VARS) = 12 ! qcf (cloud ice) ARB1F404.365
END IF ARB1F404.366
C Check LOOKUP for consistency INBOUND1.750
CALL CHK_LOOK_BOUNDA(ITEM_BOUNDA,RIM_LOOKUPSA, ARB1F404.367
*CALL ARGSIZE @DYALLOC.1303
*CALL ARGBND @DYALLOC.1304
*CALL ARGPPX GDG0F401.802
& ICODE,CMESSAGE) @DYALLOC.1305
INBOUND1.752
CL Find start position in lookup tables INBOUND1.753
INBOUND1.754
CALL TIME2SEC(I_YEAR,I_MONTH,I_DAY,I_HOUR,I_MINUTE,I_SECOND, INBOUND1.755
& BASIS_TIME_DAYS,BASIS_TIME_SECS,DAYS,SECS, GSS1F304.373
& LCAL360) GSS1F304.374
CALL TIME2SEC(FIXHD_BOUNDA(21,1),FIXHD_BOUNDA(22,1),FIXHD_BOUNDA INBOUND1.757
& (23,1),FIXHD_BOUNDA(24,1),FIXHD_BOUNDA(25,1),FIXHD_BOUNDA( INBOUND1.758
& 26,1),BASIS_TIME_DAYS,BASIS_TIME_SECS, TJ080294.277
& DAYS_DATA_START,SECS_DATA_START,LCAL360) GSS1F304.375
INBOUND1.760
CALL TIME2SEC(FIXHD_BOUNDA(28,1),FIXHD_BOUNDA(29,1),FIXHD_BOUNDA INBOUND1.761
& (30,1),FIXHD_BOUNDA(31,1),FIXHD_BOUNDA(32,1),FIXHD_BOUNDA( INBOUND1.762
& 33,1),BASIS_TIME_DAYS,BASIS_TIME_SECS, TJ080294.279
& DAYS_DATA_END,SECS_DATA_END,LCAL360) GSS1F304.376
INBOUND1.764
CALL TIM2STEP(DAYS_DATA_START-DAYS,SECS_DATA_START-SECS, TJ080294.281
& STEPS_PER_PERIODim(a_im),SECS_PER_PERIODim(a_im), GDR3F305.254
& ELAPSED_STEPS) GDR3F305.255
TJ080294.283
IF((TIME_LT(DAYS_DATA_START,SECS_DATA_START,DAYS,SECS) .OR. TJ080294.284
& TIME_EQ(DAYS_DATA_START,SECS_DATA_START,DAYS,SECS)) .AND. TJ080294.285
& (TIME_LT(DAYS,SECS,DAYS_DATA_END,SECS_DATA_END) .OR. TJ080294.286
& TIME_EQ(DAYS,SECS,DAYS_DATA_END,SECS_DATA_END))) THEN TJ080294.287
NBOUND_LOOKUP(1)=-ELAPSED_STEPS*RIM_LOOKUPSA/RIM_STEPSA+1 TJ080294.288
IF (STEPim(a_im).GT.0) THEN GDR5F305.48
NBOUND_LOOKUP(1)=NBOUND_LOOKUP(1)+ RIM_LOOKUPSA INBOUND1.769
ENDIF INBOUND1.770
C Continuation run with new boundary data file INBOUND1.771
ELSE IF(ELAPSED_STEPS.EQ.RIM_STEPSA .AND. GDR5F305.49
& STEPim(a_im).GT.0) THEN GDR5F305.50
NBOUND_LOOKUP(1)=1 INBOUND1.774
ELSE IF(TIME_LT(DAYS,SECS,DAYS_DATA_START,SECS_DATA_START)) TJ080294.290
& THEN TJ080294.291
CMESSAGE=' INBOUND: Model time preceeds 1st validty time of INBOUND1.776
&lateral boundary data' INBOUND1.777
ICODE=101 INBOUND1.778
RETURN INBOUND1.779
ELSE INBOUND1.780
CMESSAGE=' INBOUND: Model time after last validty time of INBOUND1.781
&lateral boundary data' INBOUND1.782
ICODE=102 INBOUND1.783
RETURN INBOUND1.784
ENDIF INBOUND1.785
INBOUND1.786
END IF INBOUND1.787
INBOUND1.788
END IF ! lateral boundary INBOUND1.789
INBOUND1.790
IF (BOUND_FIELDCODE(3).NE.0) THEN INBOUND1.791
J1=J1+1 INBOUND1.792
NBOUND_LOOKUP(3)=J1 INBOUND1.793
C J1 used to correctly position in LOOKUP_BOUNDA INBOUND1.794
INBOUND1.795
IF(FIXHD_BOUNDA(150,2).GT.0) THEN INBOUND1.800
INBOUND1.840
CL Find start position in lookup tables INBOUND1.841
INBOUND1.842
CALL TIME2SEC(I_YEAR,I_MONTH,I_DAY,I_HOUR,I_MINUTE,I_SECOND, INBOUND1.843
& BASIS_TIME_DAYS,BASIS_TIME_SECS,DAYS,SECS, GSS1F304.377
& LCAL360) GSS1F304.378
CALL TIME2SEC(FIXHD_BOUNDA(21,2),FIXHD_BOUNDA(22,2),FIXHD_BOUNDA INBOUND1.845
& (23,2),FIXHD_BOUNDA(24,2),FIXHD_BOUNDA(25,2),FIXHD_BOUNDA( INBOUND1.846
& 26,2),BASIS_TIME_DAYS,BASIS_TIME_SECS, TJ080294.293
& DAYS_DATA_START,SECS_DATA_START,LCAL360) GSS1F304.379
INBOUND1.848
IF (TIME_LT(DAYS_DATA_START,SECS_DATA_START,DAYS,SECS) .OR. TJ080294.295
& TIME_EQ(DAYS_DATA_START,SECS_DATA_START,DAYS,SECS)) THEN TJ080294.296
CALL TIM2STEP(DAYS-DAYS_DATA_START,SECS-SECS_DATA_START, TJ080294.297
& STEPS_PER_PERIODim(a_im),SECS_PER_PERIODim(a_im), GDR3F305.256
& ELAPSED_STEPS) GDR3F305.257
NBOUND_LOOKUP(3)=ELAPSED_STEPS*FLOORFLDSA/FLOOR_STEPSA+ TJ080294.299
& NBOUND_LOOKUP(3) TJ080294.300
IF (STEPim(a_im).GT.0) THEN GDR5F305.51
NBOUND_LOOKUP(3)=NBOUND_LOOKUP(3)+ FLOORFLDSA INBOUND1.853
ENDIF INBOUND1.854
ELSE IF (TIME_LT(DAYS,SECS,DAYS_DATA_START,SECS_DATA_START)) TJ080294.301
& THEN TJ080294.302
CMESSAGE=' INBOUND: Model time preceeds 1st validty time of INBOUND1.856
&lower boundary data' INBOUND1.857
ICODE=103 INBOUND1.858
RETURN INBOUND1.859
ENDIF INBOUND1.860
INBOUND1.861
END IF INBOUND1.862
INBOUND1.863
END IF INBOUND1.864
INBOUND1.865
*ENDIF INBOUND1.866
INBOUND1.867
*IF DEF,OCEAN,AND,DEF,BOUNDSO GSI1F405.160
INBOUND1.869
CL 2 Set interval for setting any boundary field INBOUND1.870
INBOUND1.871
BOUNDARY_STEPSim(o_im)=RIM_STEPSO GDR5F305.52
INBOUND1.873
CL 3 Check LOOKUP Table GDR1F404.125
INBOUND1.875
IF (BOUND_FIELDCODE(2).NE.0) THEN INBOUND1.876
INBOUND1.882
IF(FIXHD_BOUNDO(150,1).GT.0) THEN INBOUND1.883
GDR1F404.126
C Checking routine for lateral boundary data set not available yet INBOUND1.918
INBOUND1.919
INBOUND1.921
IF (FIXHD_BOUNDO(10,1).EQ.1) THEN ! timeseries data INBOUND1.922
INBOUND1.923
CALL TIME2SEC(I_YEAR,I_MONTH,I_DAY,I_HOUR,I_MINUTE,I_SECOND, INBOUND1.924
& BASIS_TIME_DAYS,BASIS_TIME_SECS,DAYS,SECS, GSS1F304.380
& LCAL360) GSS1F304.381
CALL TIME2SEC(FIXHD_BOUNDO(21,1),FIXHD_BOUNDO(22,1), INBOUND1.926
& FIXHD_BOUNDO(23,1),FIXHD_BOUNDO(24,1), INBOUND1.927
& FIXHD_BOUNDO(25,1),FIXHD_BOUNDO(26,1), INBOUND1.928
& BASIS_TIME_DAYS,BASIS_TIME_SECS, TJ080294.304
& DAYS_DATA_START,SECS_DATA_START,LCAL360) GSS1F304.382
CALL TIME2SEC(FIXHD_BOUNDO(28,1),FIXHD_BOUNDO(29,1), INBOUND1.930
& FIXHD_BOUNDO(30,1),FIXHD_BOUNDO(31,1), INBOUND1.931
& FIXHD_BOUNDO(32,1),FIXHD_BOUNDO(33,1), INBOUND1.932
& BASIS_TIME_DAYS,BASIS_TIME_SECS, TJ080294.306
& DAYS_DATA_END,SECS_DATA_END,LCAL360) GSS1F304.383
CALL TIM2STEP(DAYS-DAYS_DATA_START,SECS-SECS_DATA_START, TJ080294.308
& STEPS_PER_PERIODim(o_im),SECS_PER_PERIODim(o_im), GDR3F305.258
& ELAPSED_STEPS) TJ080294.310
INBOUND1.934
IF((TIME_LT(DAYS_DATA_START,SECS_DATA_START,DAYS,SECS) .OR. TJ080294.311
& TIME_EQ(DAYS_DATA_START,SECS_DATA_START,DAYS,SECS)) .AND. TJ080294.312
& (TIME_LT(DAYS,SECS,DAYS_DATA_END,SECS_DATA_END) .OR. TJ080294.313
& TIME_EQ(DAYS,SECS,DAYS_DATA_END,SECS_DATA_END))) THEN TJ080294.314
DATA_TO_SKIP=ELAPSED_STEPS/RIM_STEPSO TJ080294.315
ELSE IF(TIME_LT(DAYS,SECS,DAYS_DATA_START,SECS_DATA_START)) GDR5F305.53
& THEN TJ080294.317
CMESSAGE=' INBOUND: Model time preceeds first validity time INBOUND1.939
&of lateral boundary data' INBOUND1.940
ICODE=101 INBOUND1.941
RETURN INBOUND1.942
ELSE INBOUND1.943
CMESSAGE=' INBOUND: Model time after last validity time of INBOUND1.944
&lateral boundary data' INBOUND1.945
ICODE=102 INBOUND1.946
RETURN INBOUND1.947
ENDIF INBOUND1.948
INBOUND1.949
GSI1F405.161
C Calculate no of steps from first data time to basis time GSI1F405.162
GSI1F405.163
CALL TIM2STEP(-DAYS_DATA_START,-SECS_DATA_START, GSI1F405.164
& STEPS_PER_PERIODim(o_im),SECS_PER_PERIODim(o_im), GSI1F405.165
& BASISMDATA_STEPS) GSI1F405.166
GSI1F405.167
C Calculate no of steps of "previous" boundary time relative to the GSI1F405.168
C the model basis time GSI1F405.169
GSI1F405.170
O_BDY_STEP_PREV = DATA_TO_SKIP*RIM_STEPSO-BASISMDATA_STEPS GSI1F405.171
GSI1F405.172
C If this is a continuation step, boundary data has already been GSI1F405.173
C read into the dump and the first field to be read next is 1 or 2 GSI1F405.174
C sets of data further on in the boundary file GSI1F405.175
GSI1F405.176
IF (STEPim(o_im).NE.0) THEN GSI1F405.177
IF (MOD(ELAPSED_STEPS,RIM_STEPSO).EQ.0) THEN GSI1F405.178
DATA_TO_SKIP=DATA_TO_SKIP+1 GSI1F405.179
ELSE GSI1F405.180
DATA_TO_SKIP=DATA_TO_SKIP+2 GSI1F405.181
END IF GSI1F405.182
GSI1F405.183
O_BDY_STEP_PREV = (DATA_TO_SKIP-2)*RIM_STEPSO GSI1F405.184
& -BASISMDATA_STEPS GSI1F405.185
END IF GSI1F405.186
GSI1F405.187
NBOUND_LOOKUP(2)=DATA_TO_SKIP*RIM_LOOKUPSO+1 GSI1F405.188
GSI1F405.189
BNDARY_OFFSETim(o_im)=MOD(BASISMDATA_STEPS,RIM_STEPSO) GSI1F405.190
INBOUND1.960
ELSEIF (FIXHD_BOUNDO(10,1).EQ.2) THEN ! periodic data INBOUND1.961
INBOUND1.962
C Assume a 360 day calender and data of period one year INBOUND1.963
C GSS1F304.385
IF (.NOT. LCAL360) THEN GSS1F304.386
CMESSAGE= 'IN_BOUND: Gregorian calender not allowed with INBOUND1.965
& periodic boundary data' INBOUND1.966
ICODE=1 INBOUND1.967
RETURN INBOUND1.968
END IF GSS1F304.387
C GSS1F304.388
PERIOD=INTHD_BOUNDO(3,1)*INTERVAL INBOUND1.970
IF (PERIOD.NE.8640*3600) THEN INBOUND1.971
CMESSAGE= 'IN_BOUND: Period for periodic boundary data must INBOUND1.972
& be one year ' INBOUND1.973
ICODE=1 INBOUND1.974
RETURN INBOUND1.975
ENDIF INBOUND1.976
INBOUND1.977
CALL TIME2SEC(I_YEAR,I_MONTH,I_DAY,I_HOUR,I_MINUTE,I_SECOND, INBOUND1.978
& BASIS_TIME_DAYS,BASIS_TIME_SECS,DAYS,SECS, GSS1F304.390
& LCAL360) GSS1F304.391
INBOUND1.980
GSI1F405.191
IF ((I_MONTH*720+I_DAY*24+I_HOUR).LT.(FIXHD_BOUNDO(22,1)*720+ GSI1F405.192
& FIXHD_BOUNDO(23,1)*24+FIXHD_BOUNDO(24,1))) THEN GSI1F405.193
GSI1F405.194
CALL TIME2SEC(I_YEAR-1,FIXHD_BOUNDO(22,1),FIXHD_BOUNDO(23,1), GSI1F405.195
& FIXHD_BOUNDO(24,1),FIXHD_BOUNDO(25,1),FIXHD_BOUNDO(26,1), GSI1F405.196
& BASIS_TIME_DAYS,BASIS_TIME_SECS, GSI1F405.197
& DAYS_DATA_START,SECS_DATA_START,LCAL360) GSI1F405.198
GSI1F405.199
ELSE GSI1F405.200
GSI1F405.201
CALL TIME2SEC(I_YEAR,FIXHD_BOUNDO(22,1),FIXHD_BOUNDO(23,1), GSI1F405.202
& FIXHD_BOUNDO(24,1),FIXHD_BOUNDO(25,1),FIXHD_BOUNDO(26,1), GSI1F405.203
& BASIS_TIME_DAYS,BASIS_TIME_SECS, GSI1F405.204
& DAYS_DATA_START,SECS_DATA_START,LCAL360) GSI1F405.205
GSI1F405.206
ENDIF GSI1F405.207
GSI1F405.208
CALL TIM2STEP(DAYS-DAYS_DATA_START,SECS-SECS_DATA_START, GSI1F405.209
& STEPS_PER_PERIODim(o_im),SECS_PER_PERIODim(o_im), GSI1F405.210
& ELAPSED_STEPS) GSI1F405.211
GSI1F405.212
DATA_TO_SKIP=ELAPSED_STEPS/RIM_STEPSO GSI1F405.213
GSI1F405.214
C Calculate no of steps from first data time to basis time GSI1F405.215
GSI1F405.216
CALL TIM2STEP(-DAYS_DATA_START,-SECS_DATA_START, GSI1F405.217
& STEPS_PER_PERIODim(o_im),SECS_PER_PERIODim(o_im), GSI1F405.218
& BASISMDATA_STEPS) GSI1F405.219
GSI1F405.220
O_BDY_STEP_PREV = DATA_TO_SKIP*RIM_STEPSO-BASISMDATA_STEPS GSI1F405.221
GSI1F405.222
C If this is a continuation step, boundary data has already been GSI1F405.223
C read into the dump and the first field to be read next is 1 or 2 GSI1F405.224
C sets of data further on in the boundary file GSI1F405.225
GSI1F405.226
IF (STEPim(o_im).NE.0) THEN GSI1F405.227
IF (MOD(ELAPSED_STEPS,RIM_STEPSO).EQ.0) THEN GSI1F405.228
DATA_TO_SKIP=DATA_TO_SKIP+1 GSI1F405.229
ELSE GSI1F405.230
DATA_TO_SKIP=DATA_TO_SKIP+2 GSI1F405.231
END IF GSI1F405.232
GSI1F405.233
O_BDY_STEP_PREV = (DATA_TO_SKIP-2)*RIM_STEPSO GSI1F405.234
& -BASISMDATA_STEPS GSI1F405.235
END IF GSI1F405.236
GSI1F405.237
DATA_TO_SKIP=MOD(DATA_TO_SKIP,INTHD_BOUNDO(3,1)) GSI1F405.238
GSI1F405.239
NBOUND_LOOKUP(2)=DATA_TO_SKIP*RIM_LOOKUPSO+1 GSI1F405.240
GSI1F405.241
BNDARY_OFFSETim(o_im)=MOD(BASISMDATA_STEPS,RIM_STEPSO) GSI1F405.242
GSI1F405.243
INBOUND1.1006
END IF ! End if timeseries or periodic data INBOUND1.1007
INBOUND1.1008
INBOUND1.1018
ENDIF ! End if length of lookup table gt 0 INBOUND1.1019
ENDIF ! End if boundary update chosen INBOUND1.1020
INBOUND1.1021
CL Section for lower boundary conditions omitted INBOUND1.1022
INBOUND1.1023
*ENDIF WRB1F401.197
WRB1F401.198
*IF DEF,WAVE WRB1F401.199
WRITE(6,*)'INBOUND;wave sub-model boundary code yet to be written' GIE0F403.315
*ENDIF INBOUND1.1024
INBOUND1.1025
INBOUND1.1026
INBOUND1.1027
CL 4 End of routine INBOUND1.1028
INBOUND1.1029
9999 CONTINUE APB4F401.480
RETURN INBOUND1.1030
END INBOUND1.1031
*----------------------------------------------------------------------- INBOUND1.1032
INBOUND1.1033
*ENDIF INBOUND1.1034