SUBROUTINE INTF_CTL ( 2,4@DYALLOC.2186
*CALL ARGSIZE 
@DYALLOC.2187
*CALL ARGINFA GDR2F405.59
& ICODE,CMESSAGE) GDR3F305.261
@DYALLOC.2189
IMPLICIT NONE INTFCTL1.27
@DYALLOC.2190
*CALL CMAXSIZE GDR2F405.60
*CALL TYPSIZE @DYALLOC.2191
*CALL TYPINFA GDR2F405.61
@DYALLOC.2192
INTEGER @DYALLOC.2193
& ICODE ! Out - Return Code @DYALLOC.2194
@DYALLOC.2195
CHARACTER*80 CMESSAGE ! Out - Error message on failure TS150793.101
C*---------------------------------------------------------------------- INTFCTL1.31
C Common blocks INTFCTL1.32
C INTFCTL1.33
*CALL CSUBMODL GDR3F305.262
*CALL CHSUNITS RS030293.116
*CALL CMAXSIZO GMB1F405.140
*CALL CHISTORY GDR3F305.264
*CALL CCONTROL GDR3F305.265
*CALL CTIME GDR3F305.266
*IF DEF,ATMOS GDR2F405.62
*CALL CINTFA GDR2F405.63
*ENDIF GDR2F405.64
GDR2F405.65
*IF DEF,OCEAN GMB1F405.141
*CALL CINTFO GMB1F405.142
*ENDIF GMB1F405.143
C INTFCTL1.40
C Subroutines called ABCALC UDG1F305.161
C UDG1F305.162
EXTERNAL ABCALC,INTF_AREA GDR2F405.66
C UDG1F305.164
C----------------------------------------------------------------------- UDG1F305.165
*CALL C_MDI UDG1F305.166
C----------------------------------------------------------------------- UDG1F305.167
C INTFCTL1.43
C Local variables INTFCTL1.44
C INTFCTL1.45
INTEGER JINTF ! Interface area index GMB1F405.144
INTEGER INTF_AREA_NO ! Interface area number GMB1F405.145
INTEGER INTF_UNIT_NO ! Interface unit number GMB1F405.146
GMB1F405.147
*IF DEF,ATMOS GMB1F405.148
INTEGER IUNIT ! Counter for loop over unit nos. INTFCTL1.46
INTEGER NFTUNIT ! Fortran unit no. selected INTFCTL1.47
INTEGER STEP ! Current atmos. step INTFCTL1.48
INTEGER A_STEPS_PER_HR ! steps per hour for atmosphere GDR3F305.267
GMB1F405.149
INTEGER UDG1F305.169
& IERR !Return code from ABCALC UDG1F305.170
&,J UDG1F305.178
&,NQ ! number of water variables in interface files ARB1F404.373
UDG1F305.179
C Namelist for interface constants INTFCTL1.50
C INTFCTL1.51
*CALL CNAMINFA GDR2F405.67
*ENDIF UDG1F305.185
INTFCTL1.56
*IF DEF,OCEAN GMB1F405.150
INTEGER O_STEPS_PER_HR ! steps per hour (for ocean) GMB1F405.151
INTEGER I ! loop index over levels GMB1F405.152
INTEGER NFTOUT ! output unit number GMB1F405.153
INTEGER J ! For setting LBC_UNIT_NO_O GMB1F405.154
*CALL CNAMINFO GMB1F405.155
*ENDIF GMB1F405.156
GMB1F405.157
GMB1F405.158
ICODE=0 INTFCTL1.57
CMESSAGE=' ' INTFCTL1.58
INTFCTL1.59
CL 1. Atmosphere data GMB1F405.159
GMB1F405.160
*IF DEF,ATMOS GSS1F304.5
IF (LLBOUTim(a_im)) THEN GDR3F305.268
INTFCTL1.61
C Initialise namelist parameters to cater for no boundary datasets DR240293.877
DO JINTF = 1,MAX_N_INTF_A GDR2F405.68
A_INTF_START_HR(JINTF) = 0 DR240293.879
A_INTF_END_HR (JINTF) = 0 DR240293.880
A_INTF_FREQ_HR (JINTF) = 0 DR240293.881
INTF_METH_LEV_CALC(JINTF) = 5 UDG1F305.186
INTF_MAX_SIG_HLEV(JINTF) = 0 UDG1F305.187
INTF_MIN_PRS_HLEV(JINTF) = 0 UDG1F305.188
INTF_PACK(JINTF) = 1 ! 32 bit packing GDR1F400.6
DO J=1,MAX_INTF_LEVELS+1 GDR2F405.69
INTF_ETAH(J,JINTF)=RMDI GDR2F405.70
ENDDO GDR2F405.71
ENDDO DR240293.882
DR240293.883
C Read namelist for interface INTFCTL1.62
INTFCTL1.63
REWIND (5) GGH2F401.14
READ(5,INTFCNSTA) GDR2F405.72
CL UDG1F305.189
GDR2F405.73
CL Initialise LBC_UNIT_NO_A and FT_OUTPUT. GDR2F405.74
GDR2F405.75
DO JINTF=1,MAX_N_INTF_A GDR2F405.76
LBC_UNIT_NO_A(JINTF) = 0 GDR2F405.77
ENDDO GDR2F405.78
DO JINTF=1,N_INTF_A GDR2F405.79
J = 139+LBC_STREAM_A(JINTF) GDR2F405.80
LBC_UNIT_NO_A(JINTF) = J GDR2F405.81
FT_Output(J) = 'Y' GDR2F405.82
ENDDO GDR2F405.83
GDR2F405.84
write (6,*) ' ' GDR2F405.85
write (6,*) 'LBC_STREAM_A and LBC_UNIT_NO_A' GDR2F405.86
do jintf=1,n_intf_a GDR2F405.87
write (6,*) jintf,' stream no ',lbc_stream_a(jintf), GDR2F405.88
& ' unit_no ',lbc_unit_no_a(jintf) GDR2F405.89
enddo GDR2F405.90
write (6,*) ' ' GDR2F405.91
write (6,*) 'FT_Output for Boundary Files.' GDR2F405.92
do j=140,147 GDR2F405.93
write (6,*) ' Unit No ',J,' FT_Output ',ft_output(j) GDR2F405.94
enddo GDR2F405.95
GDR2F405.96
CL Calculate INTF_AK,INTF_BK,INTF_AKH,INTF_BKH from INTF_ETAH UDG1F305.190
CL UDG1F305.191
C Initialise arrays UDG1F305.192
DO JINTF = 1,N_INTF_A UDG1F305.193
DO J=1,MAX_INTF_P_LEVELS GDR2F405.97
INTF_AK(J,JINTF)=RMDI UDG1F305.195
INTF_BK(J,JINTF)=RMDI UDG1F305.196
END DO UDG1F305.197
DO J=1,MAX_INTF_P_LEVELS+1 GDR2F405.98
INTF_AKH(J,JINTF)=RMDI UDG1F305.199
INTF_BKH(J,JINTF)=RMDI UDG1F305.200
ENDDO UDG1F305.201
ENDDO UDG1F305.202
UDG1F305.203
DO JINTF = 1,N_INTF_A UDG1F305.204
IF(INTF_VERT_INTERP(JINTF)) THEN ! Vertical interpolation needed UDG1F305.205
CALL ABCALC(INTF_METH_LEV_CALC(JINTF),1,1 UDG1F305.206
&, INTF_P_LEVELS(JINTF) UDG1F305.207
&, INTF_ETAH(INTF_MIN_PRS_HLEV(JINTF),JINTF) UDG1F305.208
&, INTF_ETAH(INTF_MAX_SIG_HLEV(JINTF),JINTF) UDG1F305.209
&, INTF_ETAH(1,JINTF) UDG1F305.210
&, INTF_AK(1,JINTF),INTF_BK(1,JINTF) UDG1F305.211
&, INTF_AKH(1,JINTF),INTF_BKH(1,JINTF),IERR) UDG1F305.212
UDG1F305.213
IF(IERR.NE.0) THEN UDG1F305.214
WRITE(6,*) ' *ERROR* IN ABCALC FROM INTF_CTL. IERR ' UDG1F305.215
& ,IERR UDG1F305.216
WRITE(6,*) ' CHECK YOUR ATMOS LEVEL SPEC FOR MODEL' UDG1F305.217
ICODE = 2 GDR2F405.99
WRITE (cmessage,*) 'INTF_CTL : Error IN ABCALC.' GDR2F405.100
GO TO 9999 ! Return GDR2F405.101
END IF UDG1F305.219
UDG1F305.220
WRITE(6,*) 'INTF_AK=' UDG1F305.221
WRITE(6,'(3(E22.15,'',''))') UDG1F305.222
& (INTF_AK(J,JINTF),J=1,INTF_P_LEVELS(JINTF)) UDG1F305.223
WRITE(6,*) 'INTF_BK=' UDG1F305.224
WRITE(6,'(3(E22.15,'',''))') UDG1F305.225
& (INTF_BK(J,JINTF),J=1,INTF_P_LEVELS(JINTF)) UDG1F305.226
WRITE(6,*) 'INTF_AKH=' UDG1F305.227
WRITE(6,'(3(E22.15,'',''))') UDG1F305.228
& (INTF_AKH(J,JINTF),J=1,INTF_P_LEVELS(JINTF)+1) UDG1F305.229
WRITE(6,*) 'INTF_BKH=' UDG1F305.230
WRITE(6,'(3(E22.15,'',''))') UDG1F305.231
& (INTF_BKH(J,JINTF),J=1,INTF_P_LEVELS(JINTF)+1) UDG1F305.232
UDG1F305.233
END IF UDG1F305.240
UDG1F305.241
IF (INTF_PACK(JINTF).LT.0 .OR. INTF_PACK(JINTF).GT.2) THEN APB4F401.495
CMESSAGE = 'INTFCTL : Invalid value for INTF_PACK.' GDR1F400.8
ICODE = 1 GDR1F400.9
WRITE (6,*) ' INTF_PACK ',INTF_PACK GDR1F400.10
WRITE (6,*) ' Valid values for INTF_PACK are 0 and 1' GDR1F400.11
GO TO 9999 ! Return GDR1F400.12
ENDIF GDR1F400.13
GDR1F400.14
END DO UDG1F305.242
DR240293.885
C Initialise variables in CTIME comdeck. DR240293.886
A_STEPS_PER_HR = 3600*STEPS_PER_PERIODim(a_im)/ GDR3F305.269
& SECS_PER_PERIODim(a_im) GDR3F305.270
DO JINTF = 1,N_INTF_A DR240293.887
INTERFACE_FSTEPim(JINTF,a_im) = GDR5F305.88
& A_INTF_START_HR(JINTF)*A_STEPS_PER_HR GDR5F305.89
INTERFACE_LSTEPim(JINTF,a_im) = GDR5F305.90
& A_INTF_END_HR(JINTF) *A_STEPS_PER_HR GDR5F305.91
INTERFACE_STEPSim(JINTF,a_im) = GDR5F305.92
& A_INTF_FREQ_HR(JINTF) *A_STEPS_PER_HR GDR5F305.93
ENDDO DR240293.891
C INTFCTL1.65
C Initialise variables in CINTF comdeck. DR240293.892
DO JINTF = 1,N_INTF_A DR240293.893
DR240293.894
C Length of interface field on p* grid DR240293.895
LEN_INTFA_P(JINTF) = DR240293.896
& (INTF_ROW_LENGTH(JINTF)+INTF_P_ROWS(JINTF)-2*INTFWIDTHA(JINTF)) DR240293.897
& *2*INTFWIDTHA(JINTF) DR240293.898
DR240293.899
C Length of interface field on wind grid DR240293.900
LEN_INTFA_U(JINTF) = LEN_INTFA_P(JINTF) - 4*INTFWIDTHA(JINTF) DR240293.901
DR240293.902
C Length of interface data DR240293.903
IF (L_LSPICE) THEN ! mixed phase precipitation scheme ARB1F404.374
NQ = 2 ARB1F404.375
ELSE ARB1F404.376
NQ = 1 ARB1F404.377
END IF ARB1F404.378
LEN_INTFA_DATA(JINTF) = LEN_INTFA_P(JINTF) * DR240293.904
& (INTF_P_LEVELS(JINTF) + INTF_Q_LEVELS(JINTF)*NQ + 1 + ARB1F404.379
& INTF_TR_LEVELS(JINTF)*TR_VARS) + DR240293.906
& LEN_INTFA_U(JINTF)*INTF_P_LEVELS(JINTF)*2 DR240293.907
DR240293.908
ENDDO DR240293.909
C INTFCTL1.68
STEP = STEPim(a_im) GDR5F305.94
C INTFCTL1.70
C Loop over all possible fortran unit numbers to find GMB1F405.161
C new output boundary files (i.e. set LNEWBND) GMB1F405.162
DR240293.918
call intf_new_files (20, NUNITS, MAX_N_INTF_A, A_IM, GMB1F405.163
& TYPE_LETTER_1, FT_OUTPUT, A_INTF_FREQ_HR, FT_STEPS, STEP, GMB1F405.164
& FT_FIRSTSTEP, INTERFACE_STEPSim(1,A_IM), GMB1F405.165
& LNEWBND ) GMB1F405.166
DR240293.920
END IF ! LLBOUTim(a_im) GDR3F305.271
*ENDIF GSS1F304.8
GMB1F405.167
CL 2. Ocean data GMB1F405.168
GMB1F405.169
*IF DEF,OCEAN GMB1F405.170
IF (LLBOUTim(o_im)) THEN GMB1F405.171
GMB1F405.172
CL 2.1 Initialise namelist parameters GMB1F405.173
GMB1F405.174
DO JINTF = 1,N_INTF_O GMB1F405.175
GMB1F405.176
CL 2.1.1 to cater for no boundary datasets GMB1F405.177
O_INTF_START_HR(JINTF) = 0 GMB1F405.178
O_INTF_END_HR (JINTF) = 0 GMB1F405.179
O_INTF_FREQ_HR (JINTF) = 0 GMB1F405.180
GMB1F405.181
CL 2.1.2 set to "null" values variables which are not used GMB1F405.182
INTFO_Q_LEVELS (JINTF) = 1 GMB1F405.183
INTFO_TR_LEVELS(JINTF) = 1 GMB1F405.184
GMB1F405.185
CL 2.1.3 set to RMDIs height of target model levels GMB1F405.186
DO I = 1, MAX_INTF_LEVELS_O GMB1F405.187
O_INTF_AK (I,JINTF) = RMDI GMB1F405.188
O_INTF_BK (I,JINTF) = RMDI GMB1F405.189
O_INTF_AKH(I,JINTF) = RMDI GMB1F405.190
O_INTF_BKH(I,JINTF) = RMDI GMB1F405.191
END DO GMB1F405.192
GMB1F405.193
INTFO_PACK(JINTF) = 1 ! => 32 bit packing GMB1F405.194
ENDDO GMB1F405.195
GMB1F405.196
CL 2.2 Read namelist for interface GMB1F405.197
GMB1F405.198
REWIND (5) GMB1F405.199
READ(5,INTFCNSTO) GMB1F405.200
GMB1F405.201
CL Initialise LBC_UNIT_NO_O and FT_OUTPUT. GMB1F405.202
GMB1F405.203
DO JINTF=1,MAX_N_INTF_O GMB1F405.204
LBC_UNIT_NO_O(JINTF) = 0 GMB1F405.205
ENDDO GMB1F405.206
DO JINTF=1,N_INTF_O GMB1F405.207
J = 99+LBC_STREAM_O(JINTF) GMB1F405.208
LBC_UNIT_NO_O(JINTF) = J GMB1F405.209
FT_Output(J) = 'Y' GMB1F405.210
ENDDO GMB1F405.211
GMB1F405.212
write (6,*) ' ' GMB1F405.213
write (6,*) 'LBC_STREAM_O and LBC_UNIT_NO_O' GMB1F405.214
do jintf=1,n_intf_O GMB1F405.215
write (6,*) jintf,' stream no ',lbc_stream_o(jintf), GMB1F405.216
& ' unit_no ',lbc_unit_no_o(jintf) GMB1F405.217
enddo GMB1F405.218
write (6,*) ' ' GMB1F405.219
write (6,*) 'FT_Output for Boundary Files.' GMB1F405.220
do j=100,103 GMB1F405.221
write (6,*) ' Unit No ',J,' FT_Output ',ft_output(j) GMB1F405.222
enddo GMB1F405.223
GMB1F405.224
CL 2.3 Set up constants required for vertical interpolation GMB1F405.225
CL For vertical interpolation only depths of tracer / velocity GMB1F405.226
CL levels are needed. These must be set by the user in array GMB1F405.227
CL O_INTF_AK. The other arrays O_INTF_BK,O_INTF_AKH,O_INTF_BKH GMB1F405.228
CL are not used and only retained for "consistency" with GMB1F405.229
CL atmosphere code. GMB1F405.230
GMB1F405.231
CL 2.4 Check packing indicator GMB1F405.232
DO JINTF = 1,N_INTF_O GMB1F405.233
IF (INTFO_PACK(JINTF).LT.0 .OR. INTFO_PACK(JINTF).GT.2) THEN GMB1F405.234
CMESSAGE = 'INTFCTL : Invalid value for INTFO_PACK.' GMB1F405.235
ICODE = 1 GMB1F405.236
WRITE (6,*) ' INTFO_PACK ',INTFO_PACK GMB1F405.237
WRITE (6,*) ' Valid values for INTF_PACK are 0 and 1' GMB1F405.238
GO TO 9999 ! Return GMB1F405.239
ENDIF GMB1F405.240
END DO GMB1F405.241
GMB1F405.242
CL 2.5 Initialise variables in CTIME comdeck. GMB1F405.243
O_STEPS_PER_HR = 3600*STEPS_PER_PERIODim(o_im)/ GMB1F405.244
& SECS_PER_PERIODim(o_im) GMB1F405.245
DO JINTF = 1,N_INTF_O GMB1F405.246
INTERFACE_FSTEPim(JINTF,o_im) = GMB1F405.247
& O_INTF_START_HR(JINTF)*O_STEPS_PER_HR GMB1F405.248
INTERFACE_LSTEPim(JINTF,o_im) = GMB1F405.249
& O_INTF_END_HR(JINTF) *O_STEPS_PER_HR GMB1F405.250
INTERFACE_STEPSim(JINTF,o_im) = GMB1F405.251
& O_INTF_FREQ_HR(JINTF) *O_STEPS_PER_HR GMB1F405.252
ENDDO GMB1F405.253
GMB1F405.254
C!!!! temporary write!!!! GMB1F405.255
do JINTF = 1,N_INTF_O GMB1F405.256
write(6,*) 'INTERFACE _FSTEPim,_LSTEPim,_STEPSim ',JINTF GMB1F405.257
write(6,*) INTERFACE_FSTEPim(JINTF,o_im), GMB1F405.258
& INTERFACE_LSTEPim(JINTF,o_im),INTERFACE_STEPSim(JINTF,o_im) GMB1F405.259
end do GMB1F405.260
C!!!! temporary write ends!!!! GMB1F405.261
GMB1F405.262
CL 2.6 Initialise variables in CINTF comdeck. GMB1F405.263
DO JINTF = 1,N_INTF_O GMB1F405.264
GMB1F405.265
C LEN_INTFO_P(JINTF) (length of single level interface field GMB1F405.266
C on p* grid) and LEN_INTFO_U(JINTF) (length of single level GMB1F405.267
C interface field on wind grid) are set in CALC_INTFO which GMB1F405.268
C is called by READSIZE GMB1F405.269
GMB1F405.270
C Total Length of all interface data output on one timestep GMB1F405.271
C Hard-wired for T,S,u,v at all levels and 5 single level GMB1F405.272
C fields on p grid (streamfn, streamfn tendency, snow depth GMB1F405.273
C sea-ice concentration and sea-ice thickness. GMB1F405.274
LEN_INTFO_DATA(JINTF) = GMB1F405.275
& LEN_INTFO_P(JINTF)*INTFO_P_LEVELS(JINTF)*2 GMB1F405.276
& + LEN_INTFO_U(JINTF)*INTFO_P_LEVELS(JINTF)*2 GMB1F405.277
& + 5 * LEN_INTFO_P(JINTF) GMB1F405.278
GMB1F405.279
C!!!! temporary write !!!! GMB1F405.280
write(6,*) 'intfctl1: LEN_INTFO_DATA',LEN_INTFO_DATA(JINTF) GMB1F405.281
C!!!! temporary write ends!!!! GMB1F405.282
GMB1F405.283
GMB1F405.284
ENDDO ! JINTF GMB1F405.285
C GMB1F405.286
CL 2.7 Loop over all possible fortran unit numbers to find GMB1F405.287
CL new output boundary files (i.e. set LNEWBND_O) GMB1F405.288
GMB1F405.289
call intf_new_files (20, NUNITS, MAX_N_INTF_O, O_IM, GMB1F405.290
& TYPE_LETTER_1, FT_OUTPUT, O_INTF_FREQ_HR, FT_STEPS, GMB1F405.291
& FT_FIRSTSTEP, INTERFACE_STEPSim(1,O_IM), STEPim(o_im), GMB1F405.292
& LNEWBND_O ) GMB1F405.293
GMB1F405.294
GMB1F405.295
CL 2.8 Set up NTIMESO . GMB1F405.296
O_STEPS_PER_HR = 3600*STEPS_PER_PERIODim(o_im)/ GMB1F405.297
& SECS_PER_PERIODim(o_im) GMB1F405.298
GMB1F405.299
DO JINTF = 1,N_INTF_O GMB1F405.300
CALL INTF_UNIT(o_im, JINTF, NFTOUT) GMB1F405.301
IF (FT_STEPS(NFTOUT).EQ.0) THEN GMB1F405.302
INTFO_NTIMES(JINTF) = GMB1F405.303
+ (O_INTF_END_HR(JINTF)-O_INTF_START_HR(JINTF)) GMB1F405.304
+ / O_INTF_FREQ_HR(JINTF) + 1 GMB1F405.305
ELSE ! reinitialisation GMB1F405.306
IF (STEPim(o_im)-1.LE.FT_FIRSTSTEP(NFTOUT)) THEN ! 1st file GMB1F405.307
INTFO_NTIMES(JINTF) = FT_STEPS(NFTOUT)/O_STEPS_PER_HR/ GMB1F405.308
+ O_INTF_FREQ_HR(JINTF) + 1 GMB1F405.309
ELSE ! not first file GMB1F405.310
INTFO_NTIMES(JINTF) = FT_STEPS(NFTOUT)/O_STEPS_PER_HR/ GMB1F405.311
+ O_INTF_FREQ_HR(JINTF) GMB1F405.312
ENDIF GMB1F405.313
ENDIF GMB1F405.314
ENDDO ! JINTF GMB1F405.315
GMB1F405.316
END IF ! LLBOUTim(o_im) GMB1F405.317
GMB1F405.318
*ENDIF OCEAN GMB1F405.319
GMB1F405.320
C INTFCTL1.109
CL End of routine INTFCTL1.110
C INTFCTL1.111
9999 CONTINUE GDR1F400.15
RETURN INTFCTL1.112
END INTFCTL1.113
*ENDIF INTFCTL1.114