subroutine gen_intf_o ( 1,13GENINTO1.31
*CALL ADUMLEN 
GENINTO1.32
*CALL AINFLEN GENINTO1.33
*CALL AINTF GENINTO1.34
*CALL ARGDUM GENINTO1.35
*CALL ARGINF GENINTO1.36
*CALL ARGPPX GENINTO1.37
+ JINTF,NFTOUT, GENINTO1.38
+ imt, jmt, km, GENINTO1.39
+ NITEMS, PPINDEX, GENINTO1.40
+ theta, salinity, u, v, streamfn, GENINTO1.41
+ streamfn_tendency, snow_depth, aice, hice, GENINTO1.42
+ depths_srce, GENINTO1.43
& ICODE,CMESSAGE) GENINTO1.44
GENINTO1.45
IMPLICIT NONE GENINTO1.46
GENINTO1.47
*CALL CDUMLEN GENINTO1.48
*CALL CINFLEN GENINTO1.49
*CALL CINTF GENINTO1.50
*CALL TYPDUM GENINTO1.51
*CALL TYPINF GENINTO1.52
GENINTO1.53
*CALL CSUBMODL GENINTO1.54
*CALL CPPXREF GENINTO1.55
*CALL PPXLOOK GENINTO1.56
GENINTO1.57
integer GENINTO1.58
& JINTF, ! file number GENINTO1.59
& NFTOUT, ! output unit no. GENINTO1.60
& imt, ! no of columns for source model GENINTO1.61
& jmt, ! no of tracer rows for source model GENINTO1.62
& km, ! no of levels for source model GENINTO1.63
& NITEMS, ! number of stash items (array dimension) GENINTO1.64
& PPINDEX(NITEMS,N_INTERNAL_MODEL) GENINTO1.65
real GENINTO1.66
& theta (imt,jmt,km), GENINTO1.67
& salinity (imt,jmt,km), GENINTO1.68
& u(imt,jmt-1,km), v(imt,jmt-1,km), GENINTO1.69
& streamfn(imt,jmt), streamfn_tendency(imt,jmt), GENINTO1.70
& snow_depth(imt,jmt), aice(imt,jmt), hice(imt,jmt), GENINTO1.71
& depths_srce(km) GENINTO1.72
GENINTO1.73
integer icode GENINTO1.74
character*256 CMESSAGE GENINTO1.75
!--------------------------------------- GENINTO1.76
GENINTO1.77
*CALL PARVARS GENINTO1.78
*CALL GCCOM GENINTO1.79
*CALL DECOMPTP GENINTO1.80
GENINTO1.81
*CALL COCTOL ! uses TOL_SMALL in checking closeness of reals GENINTO1.82
GENINTO1.83
CL Local arrays GENINTO1.84
real intf_data( LEN_INTF_DATA(JINTF) ) ! boundary data output GENINTO1.85
integer item_intfo (intf_lookups) ! stash item numbers GENINTO1.86
integer dump_lookup_intfo (intf_lookups) ! dump lookup table GENINTO1.87
! for this variable GENINTO1.88
integer len_bdy_flds (intf_lookups) ! lengths of boundary fields GENINTO1.89
real u_temp(LEN_INTF_U(JINTF)) ! one level of u-velocity data GENINTO1.90
real v_temp(LEN_INTF_U(JINTF)) ! one level of v-velocity data GENINTO1.91
GENINTO1.92
CL Local scalars GENINTO1.93
integer var ! loop index for variable type GENINTO1.94
integer iaddr ! next location to write to in intf_data GENINTO1.95
integer IP_P ! { start location in interpolation coefficient GENINTO1.96
integer IP_U ! { arrays for this file GENINTO1.97
integer proc_to_use GENINTO1.98
integer proc_group GENINTO1.99
integer im ! sub-model identifier GENINTO1.100
integer im_index ! STASH internal model sequence number GENINTO1.101
integer j ! do loop index GENINTO1.102
integer level ! level number; do loop index GENINTO1.103
integer iaddr_u ! { address in intf_data of start of u and v GENINTO1.104
integer iaddr_v ! { data on the present level GENINTO1.105
integer n_levs_trgt ! number of levels to interpolate to GENINTO1.106
GENINTO1.107
logical ROT_IN, ! T => source grid is rotated GENINTO1.108
& ROT_OUT, ! T => output grid rotated GENINTO1.109
& ll_vrt_interp ! F => no vertical interpolation GENINTO1.110
GENINTO1.111
*IF -DEF,MPP GENINTO1.112
! Dummy mype to keep argument lists consistent GENINTO1.113
INTEGER mype GENINTO1.114
*ENDIF GENINTO1.115
GENINTO1.116
GENINTO1.117
GENINTO1.118
!--------------------------------------- GENINTO1.119
GENINTO1.120
GENINTO1.121
CL 0. Preliminaries GENINTO1.122
GENINTO1.123
*IF DEF,MPP GENINTO1.124
CL 0.0 Check that global sizes match present sub-model to ensure GENINTO1.125
CL that glsize values will be correct GENINTO1.126
call CHANGE_DECOMPOSITION(decomp_standard_ocean ,icode) GENINTO1.127
GENINTO1.128
CL 0.1 Miscellaneous (sub-model and processor codes) GENINTO1.129
proc_to_use = 0 GENINTO1.130
proc_group = GC_ALL_PROC_GROUP GENINTO1.131
*ELSE GENINTO1.132
! Non-mpp case set mype for sake of consistency GENINTO1.133
mype = 0 GENINTO1.134
*ENDIF GENINTO1.135
im = o_im GENINTO1.136
im_index = internal_model_index(im) GENINTO1.137
GENINTO1.138
CL 0.2 Set up list of stash item numbers for the variables expected GENINTO1.139
CL to be in the boundary file. GENINTO1.140
ITEM_INTFO(1) = 101 ! theta GENINTO1.141
ITEM_INTFO(2) = 102 ! salinity GENINTO1.142
ITEM_INTFO(3) = 121 ! U (baroclinic) GENINTO1.143
ITEM_INTFO(4) = 122 ! V (baroclinic) GENINTO1.144
ITEM_INTFO(5) = 130 ! streamfunction GENINTO1.145
ITEM_INTFO(6) = 132 ! streamfunction tendency GENINTO1.146
ITEM_INTFO(7) = 141 ! snow depth GENINTO1.147
ITEM_INTFO(8) = 146 ! AICE : ICE CONCENTRATION GENINTO1.148
ITEM_INTFO(9) = 147 ! HICE: MEAN ICE DEPTH OVER GRIDBOX M GENINTO1.149
GENINTO1.150
CL 0.3 Set up for each output lookup table the number of the dump GENINTO1.151
CL lookup table of the corresponding variable. GENINTO1.152
DO var = 1, INTF_LOOKUPS GENINTO1.153
dump_lookup_intfo(var) = PPINDEX(item_intfo(var),im_index) GENINTO1.154
END DO GENINTO1.155
GENINTO1.156
CL 0.4 Set up the output lengths for each variable GENINTO1.157
CL (used as input to INTF_OUT) GENINTO1.158
len_bdy_flds(1) = LEN_INTF_P(JINTF) * INTF_P_LEVELS(JINTF) ! T GENINTO1.159
len_bdy_flds(2) = len_bdy_flds(1) ! salinity GENINTO1.160
len_bdy_flds(3) = LEN_INTF_U(JINTF) * INTF_P_LEVELS(JINTF) ! U GENINTO1.161
len_bdy_flds(4) = len_bdy_flds(3) ! V GENINTO1.162
len_bdy_flds(5) = LEN_INTF_P(JINTF) ! streamfunction GENINTO1.163
len_bdy_flds(6) = LEN_INTF_P(JINTF) ! streamfunction tendency GENINTO1.164
len_bdy_flds(7) = LEN_INTF_P(JINTF) ! snow depth GENINTO1.165
len_bdy_flds(8) = LEN_INTF_P(JINTF) ! AICE : ICE CONCENTRATION GENINTO1.166
len_bdy_flds(9) = LEN_INTF_P(JINTF) ! HICE: MEAN ICE DEPTH GENINTO1.167
GENINTO1.168
CL 0.5 Set up pointers to interpolation coefficients for this area GENINTO1.169
iaddr = 1 GENINTO1.170
IP_P = 1 GENINTO1.171
IP_U = 1 GENINTO1.172
IF (JINTF.GT.1) THEN GENINTO1.173
DO J=1,JINTF-1 GENINTO1.174
IP_P = IP_P + LEN_INTF_P(J) GENINTO1.175
IP_U = IP_U + LEN_INTF_U(J) GENINTO1.176
ENDDO GENINTO1.177
ENDIF GENINTO1.178
GENINTO1.179
CL 0.6 Set logical indicating if model grids are rotated GENINTO1.180
GENINTO1.181
C Logical to indicate input grid is rotated GENINTO1.182
ROT_IN = ABS(REALHD(5) - 90.) .GT. TOL_SMALL .OR. GENINTO1.183
# ABS ( REALHD(6) ) .GT. TOL_SMALL GENINTO1.184
GENINTO1.185
C Logical to indicate output grid is rotated GENINTO1.186
ROT_OUT = ABS( INTF_POLELAT(JINTF) - 90. ) .GT. TOL_SMALL .OR. GENINTO1.187
# ABS ( INTF_POLELONG(JINTF) ) .GT. TOL_SMALL GENINTO1.188
GENINTO1.189
GENINTO1.190
CL 1.1 Tracer fields GENINTO1.191
GENINTO1.192
CL 1.1.1 Theta data GENINTO1.193
GENINTO1.194
write(6,*) '***** THETA *********' GENINTO1.195
GENINTO1.196
call gen_intf_fld ( icode, cmessage, KM, GENINTO1.197
& JMT,IMT, GENINTO1.198
*IF DEF,MPP GENINTO1.199
& mype, proc_to_use, proc_group, GENINTO1.200
& glsize(2),glsize(1), GENINTO1.201
*ENDIF GENINTO1.202
& LEN_INTF_P(JINTF), TOT_LEN_INTF_P, INTF_P_LEVELS(JINTF), GENINTO1.203
& IP_P, P_INDEX_B_L, P_INDEX_B_R, GENINTO1.204
& P_WEIGHT_B_L, P_WEIGHT_B_R, GENINTO1.205
& P_WEIGHT_T_L, P_WEIGHT_T_R, GENINTO1.206
& INTF_VERT_INTERP(JINTF), GENINTO1.207
& depths_srce, INTF_AK(1,JINTF), GENINTO1.208
& theta, intf_data(iaddr) ) GENINTO1.209
GENINTO1.210
iaddr = iaddr + LEN_INTF_P(JINTF)*INTF_P_LEVELS(JINTF) GENINTO1.211
GENINTO1.212
CL 1.1.2 Salinity data GENINTO1.213
GENINTO1.214
write(6,*) '*********SALINITY *********' GENINTO1.215
call gen_intf_fld ( icode, cmessage, KM, GENINTO1.216
& JMT,IMT, GENINTO1.217
*IF DEF,MPP GENINTO1.218
& mype, proc_to_use, proc_group, GENINTO1.219
& glsize(2),glsize(1), GENINTO1.220
*ENDIF GENINTO1.221
& LEN_INTF_P, TOT_LEN_INTF_P, INTF_P_LEVELS(JINTF), GENINTO1.222
& IP_P, P_INDEX_B_L, P_INDEX_B_R, GENINTO1.223
& P_WEIGHT_B_L, P_WEIGHT_B_R, GENINTO1.224
& P_WEIGHT_T_L, P_WEIGHT_T_R, GENINTO1.225
& INTF_VERT_INTERP(JINTF), GENINTO1.226
& depths_srce, INTF_AK(1,JINTF), GENINTO1.227
& salinity, intf_data(iaddr) ) GENINTO1.228
GENINTO1.229
iaddr = iaddr + LEN_INTF_P(JINTF)*INTF_P_LEVELS(JINTF) GENINTO1.230
GENINTO1.231
GENINTO1.232
CL 1.2 Horizontal currents GENINTO1.233
GENINTO1.234
CL 1.2.1 Interpolate u current GENINTO1.235
GENINTO1.236
write(6,*) '********* U *********' GENINTO1.237
call gen_intf_fld ( icode, cmessage, KM, GENINTO1.238
& JMT,IMT, GENINTO1.239
*IF DEF,MPP GENINTO1.240
& mype, proc_to_use, proc_group, GENINTO1.241
!!! check next line - is this right !!! GENINTO1.242
& glsize(2)-1,glsize(1), GENINTO1.243
*ENDIF GENINTO1.244
& LEN_INTF_U, TOT_LEN_INTF_U, INTF_P_LEVELS(JINTF), GENINTO1.245
& IP_U, U_INDEX_B_L, U_INDEX_B_R, GENINTO1.246
& U_WEIGHT_B_L, U_WEIGHT_B_R, GENINTO1.247
& U_WEIGHT_T_L, U_WEIGHT_T_R, GENINTO1.248
& INTF_VERT_INTERP(JINTF), GENINTO1.249
& depths_srce, INTF_AK(1,JINTF), GENINTO1.250
& u, intf_data(iaddr) ) GENINTO1.251
GENINTO1.252
iaddr_u = iaddr GENINTO1.253
iaddr = iaddr + LEN_INTF_U(JINTF)*INTF_P_LEVELS(JINTF) GENINTO1.254
GENINTO1.255
CL 1.2.2 Interpolate v current GENINTO1.256
GENINTO1.257
write(6,*) '********* V *********' GENINTO1.258
call gen_intf_fld ( icode, cmessage, KM, GENINTO1.259
& JMT,IMT, GENINTO1.260
*IF DEF,MPP GENINTO1.261
& mype, proc_to_use, proc_group, GENINTO1.262
& glsize(2)-1,glsize(1), GENINTO1.263
*ENDIF GENINTO1.264
& LEN_INTF_U, TOT_LEN_INTF_U, INTF_P_LEVELS(JINTF), GENINTO1.265
& IP_U, U_INDEX_B_L, U_INDEX_B_R, GENINTO1.266
& U_WEIGHT_B_L, U_WEIGHT_B_R, GENINTO1.267
& U_WEIGHT_T_L, U_WEIGHT_T_R, GENINTO1.268
& INTF_VERT_INTERP(JINTF), GENINTO1.269
& depths_srce, INTF_AK(1,JINTF), GENINTO1.270
& v, intf_data(iaddr) ) GENINTO1.271
GENINTO1.272
iaddr_v = iaddr GENINTO1.273
iaddr = iaddr + LEN_INTF_U(JINTF)*INTF_P_LEVELS(JINTF) GENINTO1.274
GENINTO1.275
Cl 1.2.3 Rotate currents GENINTO1.276
GENINTO1.277
*IF DEF,MPP GENINTO1.278
if ( mype .eq. proc_to_use) then GENINTO1.279
*ENDIF GENINTO1.280
GENINTO1.281
DO LEVEL = 1, INTF_P_LEVELS(JINTF) GENINTO1.282
GENINTO1.283
if ( ROT_IN ) then GENINTO1.284
GENINTO1.285
call w_eqtoll (COEFF5(IP_U),COEFF6(IP_U), GENINTO1.286
& intf_data(iaddr_u), intf_data(iaddr_v), GENINTO1.287
& u_temp,v_temp, GENINTO1.288
& LEN_INTF_U(JINTF), LEN_INTF_U(JINTF)) GENINTO1.289
else GENINTO1.290
GENINTO1.291
do j = 1,LEN_INTF_U(JINTF) GENINTO1.292
u_temp(j) = intf_data(iaddr_u + j - 1) GENINTO1.293
v_temp(j) = intf_data(iaddr_v + j - 1) GENINTO1.294
end do GENINTO1.295
GENINTO1.296
end if ! ROT_IN GENINTO1.297
GENINTO1.298
if ( ROT_OUT ) then GENINTO1.299
GENINTO1.300
call w_lltoeq (COEFF1(IP_U),COEFF2(IP_U), GENINTO1.301
& u_temp,v_temp, GENINTO1.302
& intf_data(iaddr_u), intf_data(iaddr_v), GENINTO1.303
& LEN_INTF_U(JINTF), LEN_INTF_U(JINTF)) GENINTO1.304
GENINTO1.305
iaddr_u = iaddr_u + LEN_INTF_U(JINTF) GENINTO1.306
iaddr_v = iaddr_v + LEN_INTF_U(JINTF) GENINTO1.307
GENINTO1.308
else GENINTO1.309
GENINTO1.310
do j = 1,LEN_INTF_U(JINTF) GENINTO1.311
intf_data(iaddr_u + j - 1) = u_temp(j) GENINTO1.312
intf_data(iaddr_v + j - 1) = v_temp(j) GENINTO1.313
end do GENINTO1.314
GENINTO1.315
end if ! ROT_OUT GENINTO1.316
GENINTO1.317
END DO ! LEVEL GENINTO1.318
GENINTO1.319
*IF DEF,MPP GENINTO1.320
end if ! mype .eq. proc_to_use GENINTO1.321
*ENDIF GENINTO1.322
GENINTO1.323
CL 1.3 Streamfunction GENINTO1.324
GENINTO1.325
n_levs_trgt = 1 GENINTO1.326
ll_vrt_interp = .false. GENINTO1.327
GENINTO1.328
write(6,*) '********* PSI *********' GENINTO1.329
call gen_intf_fld ( icode, cmessage, 1, GENINTO1.330
& JMT,IMT, GENINTO1.331
*IF DEF,MPP GENINTO1.332
& mype, proc_to_use, proc_group, GENINTO1.333
& glsize(2),glsize(1), GENINTO1.334
*ENDIF GENINTO1.335
& LEN_INTF_P, TOT_LEN_INTF_P, n_levs_trgt, GENINTO1.336
& IP_P, P_INDEX_B_L, P_INDEX_B_R, GENINTO1.337
& P_WEIGHT_B_L, P_WEIGHT_B_R, GENINTO1.338
& P_WEIGHT_T_L, P_WEIGHT_T_R, GENINTO1.339
& ll_vrt_interp, GENINTO1.340
& depths_srce, INTF_AK(1,JINTF), GENINTO1.341
& streamfn, intf_data(iaddr) ) GENINTO1.342
GENINTO1.343
iaddr = iaddr + LEN_INTF_P(JINTF) GENINTO1.344
GENINTO1.345
CL 1.4 Streamfunction tendency GENINTO1.346
GENINTO1.347
write(6,*) '********* PTD *********' GENINTO1.348
n_levs_trgt = 1 GENINTO1.349
ll_vrt_interp = .false. GENINTO1.350
GENINTO1.351
call gen_intf_fld ( icode, cmessage, 1, GENINTO1.352
& JMT,IMT, GENINTO1.353
*IF DEF,MPP GENINTO1.354
& mype, proc_to_use, proc_group, GENINTO1.355
& glsize(2),glsize(1), GENINTO1.356
*ENDIF GENINTO1.357
& LEN_INTF_P, TOT_LEN_INTF_P, n_levs_trgt, GENINTO1.358
& IP_P, P_INDEX_B_L, P_INDEX_B_R, GENINTO1.359
& P_WEIGHT_B_L, P_WEIGHT_B_R, GENINTO1.360
& P_WEIGHT_T_L, P_WEIGHT_T_R, GENINTO1.361
& ll_vrt_interp, GENINTO1.362
& depths_srce, INTF_AK(1,JINTF), GENINTO1.363
& streamfn_tendency, intf_data(iaddr) ) GENINTO1.364
GENINTO1.365
iaddr = iaddr + LEN_INTF_P(JINTF) GENINTO1.366
GENINTO1.367
CL 1.5 Snow depth GENINTO1.368
GENINTO1.369
n_levs_trgt = 1 GENINTO1.370
ll_vrt_interp = .false. GENINTO1.371
GENINTO1.372
write(6,*) '********* SNOW DEPTH *********' GENINTO1.373
call gen_intf_fld ( icode, cmessage, 1, GENINTO1.374
& JMT,IMT, GENINTO1.375
*IF DEF,MPP GENINTO1.376
& mype, proc_to_use, proc_group, GENINTO1.377
& glsize(2),glsize(1), GENINTO1.378
*ENDIF GENINTO1.379
& LEN_INTF_P, TOT_LEN_INTF_P, n_levs_trgt, GENINTO1.380
& IP_P, P_INDEX_B_L, P_INDEX_B_R, GENINTO1.381
& P_WEIGHT_B_L, P_WEIGHT_B_R, GENINTO1.382
& P_WEIGHT_T_L, P_WEIGHT_T_R, GENINTO1.383
& ll_vrt_interp, GENINTO1.384
& depths_srce, INTF_AK(1,JINTF), GENINTO1.385
& snow_depth, intf_data(iaddr) ) GENINTO1.386
GENINTO1.387
iaddr = iaddr + LEN_INTF_P(JINTF) GENINTO1.388
GENINTO1.389
CL 1.6 Ice concentration GENINTO1.390
GENINTO1.391
n_levs_trgt = 1 GENINTO1.392
ll_vrt_interp = .false. GENINTO1.393
GENINTO1.394
write(6,*) '********* ICE CONC *********' GENINTO1.395
call gen_intf_fld ( icode, cmessage, 1, GENINTO1.396
& JMT,IMT, GENINTO1.397
*IF DEF,MPP GENINTO1.398
& mype, proc_to_use, proc_group, GENINTO1.399
& glsize(2),glsize(1), GENINTO1.400
*ENDIF GENINTO1.401
& LEN_INTF_P, TOT_LEN_INTF_P, n_levs_trgt, GENINTO1.402
& IP_P, P_INDEX_B_L, P_INDEX_B_R, GENINTO1.403
& P_WEIGHT_B_L, P_WEIGHT_B_R, GENINTO1.404
& P_WEIGHT_T_L, P_WEIGHT_T_R, GENINTO1.405
& ll_vrt_interp, GENINTO1.406
& depths_srce, INTF_AK(1,JINTF), GENINTO1.407
& aice, intf_data(iaddr) ) GENINTO1.408
GENINTO1.409
iaddr = iaddr + LEN_INTF_P(JINTF) GENINTO1.410
GENINTO1.411
CL 1.7 Ice depth GENINTO1.412
GENINTO1.413
n_levs_trgt = 1 GENINTO1.414
ll_vrt_interp = .false. GENINTO1.415
GENINTO1.416
write(6,*) '********* ICE DEPTH *********' GENINTO1.417
call gen_intf_fld ( icode, cmessage, 1, GENINTO1.418
& JMT,IMT, GENINTO1.419
*IF DEF,MPP GENINTO1.420
& mype, proc_to_use, proc_group, GENINTO1.421
& glsize(2),glsize(1), GENINTO1.422
*ENDIF GENINTO1.423
& LEN_INTF_P, TOT_LEN_INTF_P, n_levs_trgt, GENINTO1.424
& IP_P, P_INDEX_B_L, P_INDEX_B_R, GENINTO1.425
& P_WEIGHT_B_L, P_WEIGHT_B_R, GENINTO1.426
& P_WEIGHT_T_L, P_WEIGHT_T_R, GENINTO1.427
& ll_vrt_interp, GENINTO1.428
& depths_srce, INTF_AK(1,JINTF), GENINTO1.429
& hice, intf_data(iaddr) ) GENINTO1.430
GENINTO1.431
iaddr = iaddr + LEN_INTF_P(JINTF) GENINTO1.432
GENINTO1.433
CL 2. Output values to disk GENINTO1.434
GENINTO1.435
CALL intf_out ( GENINTO1.436
*CALL ADUMLEN GENINTO1.437
*CALL AINFLEN GENINTO1.438
*CALL ARGDUM GENINTO1.439
*CALL ARGINF GENINTO1.440
*CALL ARGPPX GENINTO1.441
& NFTOUT, JINTF, im, mype, GENINTO1.442
& INTF_PACK, INTFWIDTH, LEN_INTF_P, LEN_INTF_U, GENINTO1.443
& LEN_INTF_DATA(JINTF), item_intfo, len_bdy_flds, GENINTO1.444
& dump_lookup_intfo, intf_data, icode, cmessage ) GENINTO1.445
GENINTO1.446
return GENINTO1.447
end GENINTO1.448
!----------------------------------------- GENINTO1.449
*ENDIF GENINTO1.450