subroutine ini_z_ptr ( 2,13INIZPTR.53
*CALL ARGSIZE 
INIZPTR.54
*CALL ARGD1 INIZPTR.55
*CALL ARGSTS INIZPTR.56
*CALL ARGDUMA INIZPTR.57
*CALL ARGDUMO INIZPTR.58
*CALL ARGPTRA INIZPTR.59
*CALL ARGPTRO INIZPTR.60
& internal_model, INIZPTR.61
& ICODE,CMESSAGE ) INIZPTR.62
C INIZPTR.63
IMPLICIT NONE INIZPTR.64
C INIZPTR.65
*CALL CMAXSIZE INIZPTR.66
*CALL CSUBMODL INIZPTR.67
*CALL TYPSIZE INIZPTR.68
*CALL TYPD1 INIZPTR.69
*CALL TYPSTS INIZPTR.70
*CALL TYPDUMA INIZPTR.71
*CALL TYPDUMO INIZPTR.72
*CALL TYPPTRA INIZPTR.73
*CALL TYPPTRO INIZPTR.74
C INIZPTR.75
integer INIZPTR.76
& internal_model INIZPTR.77
INIZPTR.78
INTEGER ICODE ! OUT - Error return code INIZPTR.79
CHARACTER*(*) CMESSAGE ! OUT - Error return message INIZPTR.80
INIZPTR.81
INIZPTR.82
C INIZPTR.83
C ------------------------------------------------------------------- INIZPTR.84
C INIZPTR.85
INIZPTR.86
C INIZPTR.87
C*------------------------------------------------------------------- INIZPTR.88
INIZPTR.89
C INIZPTR.90
C Common blocks INIZPTR.91
C INIZPTR.92
*CALL CAOPTR INIZPTR.93
*CALL C_MDI INIZPTR.94
*CALL STPARAM INIZPTR.95
*CALL COASIS INIZPTR.96
*IF DEF,MPP INIZPTR.97
*CALL PARVARS INIZPTR.98
*CALL DECOMPTP INIZPTR.99
*CALL DECOMPDB INIZPTR.100
*ENDIF INIZPTR.103
C INIZPTR.104
C Subroutines called INIZPTR.105
C INIZPTR.106
EXTERNAL FINDPTR INIZPTR.107
! & , FINDLOOKPTR INIZPTR.108
C INIZPTR.109
C Local variables INIZPTR.110
C INIZPTR.111
INIZPTR.112
integer INIZPTR.113
& process_code, ! processing code INIZPTR.114
& freq_code, ! frequency code INIZPTR.115
& start,end,period, ! start, end and period step INIZPTR.116
& gridpt_code,weight_code,! gridpt and weighting codes INIZPTR.117
& bottom_level,top_level, ! bottom and top input level INIZPTR.118
& grid_n,grid_s,grid_w,grid_e, ! grid corner definitions INIZPTR.119
& stashmacro_tag ! stashmacro tag number INIZPTR.120
INIZPTR.121
integer INIZPTR.122
& StashCode, ! integer describing the stash code of INIZPTR.123
& item, section ! the item code and section code of INIZPTR.124
! the field. INIZPTR.125
INIZPTR.126
integer INIZPTR.127
& im_ident ! Internal Model Identifier INIZPTR.128
& ,im_index ! Internal Model Index in Stash arrays INIZPTR.129
INIZPTR.130
c*------------------------------------------------------------------- INIZPTR.131
cl------------------------------------------------------------------- INIZPTR.132
cl 0. set grid definition information (undefined as search is on INIZPTR.133
cl stashmacro tag number) INIZPTR.134
cl INIZPTR.135
process_code=imdi INIZPTR.136
freq_code=imdi INIZPTR.137
start=imdi INIZPTR.138
end=imdi INIZPTR.139
period=imdi INIZPTR.140
gridpt_code=imdi INIZPTR.141
weight_code=imdi INIZPTR.142
bottom_level=imdi INIZPTR.143
top_level=imdi INIZPTR.144
grid_n=imdi INIZPTR.145
grid_s=imdi INIZPTR.146
grid_e=imdi INIZPTR.147
grid_w=imdi INIZPTR.148
INIZPTR.149
c set up internal model identifier and stash index INIZPTR.150
im_index = internal_model_index(internal_model) INIZPTR.151
INIZPTR.152
if (internal_model .eq. atmos_im) then INIZPTR.153
*IF DEF,ATMOS INIZPTR.154
cl-------------------------------------------------------------------- INIZPTR.155
cl atmosphere -> ocean (tag=10) INIZPTR.156
stashmacro_tag = 10 INIZPTR.157
INIZPTR.158
cl-------------------------------------------------------------------- INIZPTR.159
cl 1. get address for each field from its stash section/item code INIZPTR.160
cl and stashmacro tag if a diagnostic, or from its primary pointer INIZPTR.161
cl if prognostic or ancillary field INIZPTR.162
INIZPTR.163
im_ident = internal_model INIZPTR.164
im_index = internal_model_index(im_ident) INIZPTR.165
INIZPTR.166
do i = 1, NoCouplingField INIZPTR.167
C read the stash code from the user namelist INIZPTR.168
read(FieldLocator(istash, i),'(i8)') StashCode INIZPTR.169
section = StashCode / 1000 INIZPTR.170
item = StashCode - section * 1000 INIZPTR.171
INIZPTR.172
C Fields in primary space : extracted from pointers set INIZPTR.173
C elsewhere into the set_atm_ptr. INIZPTR.174
if (StashCode .eq. 00024) then INIZPTR.175
C SST: INIZPTR.176
D1_Zptr(i) = jtstar INIZPTR.177
elseif (StashCode .eq. 00028) then INIZPTR.178
C U surface current : INIZPTR.179
D1_Zptr(i) = ju_sea INIZPTR.180
elseif (StashCode .eq. 00029) then INIZPTR.181
C V surface current : INIZPTR.182
D1_Zptr(i) = jv_sea INIZPTR.183
elseif (StashCode .eq. 00032) then INIZPTR.184
C Ice depth : INIZPTR.185
D1_Zptr(i) = jice_thickness INIZPTR.186
elseif (StashCode .eq. 00023) then INIZPTR.187
C Snow depth : INIZPTR.188
D1_Zptr(i) = jsnodep INIZPTR.189
elseif (StashCode .eq. 00031) then INIZPTR.190
C Seaice fraction : INIZPTR.191
!*IF DEF,SEAICE INIZPTR.192
D1_Zptr(i) = JICE_FRACTION INIZPTR.193
ptr_ice = JICE_FRACTION INIZPTR.194
!*ENDIF INIZPTR.195
else INIZPTR.196
C Fields in secondary space have their pointers INIZPTR.197
C extracted with findptr : INIZPTR.198
call findptr(internal_model, section, item, INIZPTR.199
& process_code,freq_code,start,end,period, INIZPTR.200
& gridpt_code,weight_code, INIZPTR.201
& bottom_level,top_level,grid_n,grid_s,grid_w,grid_e, INIZPTR.202
& stashmacro_tag,imdi,D1_Zptr(i), INIZPTR.203
*CALL ARGSIZE INIZPTR.204
*CALL ARGSTS INIZPTR.205
& icode,cmessage ) INIZPTR.206
if (icode.lt.0) goto 999 INIZPTR.207
endif INIZPTR.208
enddo INIZPTR.209
INIZPTR.210
! Setup of the dedicated coupling fields to couple the atmosphere INIZPTR.211
! with the current UM-ocean. INIZPTR.212
C Net integrated downward solar on atmos grid INIZPTR.213
call findptr(internal_model, 1, 203, INIZPTR.214
& process_code,freq_code,start,end,period, INIZPTR.215
& gridpt_code,weight_code, INIZPTR.216
& bottom_level,top_level,grid_n,grid_s,grid_w,grid_e, INIZPTR.217
& stashmacro_tag,imdi,ptr_solar, INIZPTR.218
*CALL ARGSIZE INIZPTR.219
*CALL ARGSTS INIZPTR.220
& icode,cmessage ) INIZPTR.221
if (icode.lt.0) goto 999 INIZPTR.222
C Net downward blueband solar on atmos grid INIZPTR.223
call findptr(internal_model, 1, 204, INIZPTR.224
& process_code,freq_code,start,end,period, INIZPTR.225
& gridpt_code,weight_code, INIZPTR.226
& bottom_level,top_level,grid_n,grid_s,grid_w,grid_e, INIZPTR.227
& stashmacro_tag,imdi,ptr_blue, INIZPTR.228
*CALL ARGSIZE INIZPTR.229
*CALL ARGSTS INIZPTR.230
& icode,cmessage ) INIZPTR.231
if (icode.lt.0) goto 999 INIZPTR.232
C Net downward longwave on atmos grid INIZPTR.233
call findptr(internal_model, 2, 203, INIZPTR.234
& process_code,freq_code,start,end,period, INIZPTR.235
& gridpt_code,weight_code, INIZPTR.236
& bottom_level,top_level,grid_n,grid_s,grid_w,grid_e, INIZPTR.237
& stashmacro_tag,imdi,ptr_longwave, INIZPTR.238
*CALL ARGSIZE INIZPTR.239
*CALL ARGSTS INIZPTR.240
& icode,cmessage ) INIZPTR.241
if (icode.lt.0) goto 999 INIZPTR.242
C Sensible heat on atmos grid, area mean over open sea INIZPTR.243
call findptr(internal_model, 3, 228, INIZPTR.244
& process_code,freq_code,start,end,period, INIZPTR.245
& gridpt_code,weight_code, INIZPTR.246
& bottom_level,top_level,grid_n,grid_s,grid_w,grid_e, INIZPTR.247
& stashmacro_tag,imdi,ptr_sensible, INIZPTR.248
*CALL ARGSIZE INIZPTR.249
*CALL ARGSTS INIZPTR.250
& icode,cmessage ) INIZPTR.251
if (icode.lt.0) goto 999 INIZPTR.252
C Surface evaporation over sea weighted by fractional leads INIZPTR.253
call findptr(internal_model, 3, 232, INIZPTR.254
& process_code,freq_code,start,end,period, INIZPTR.255
& gridpt_code,weight_code, INIZPTR.256
& bottom_level,top_level,grid_n,grid_s,grid_w,grid_e, INIZPTR.257
& stashmacro_tag,imdi,ptr_evap, INIZPTR.258
*CALL ARGSIZE INIZPTR.259
*CALL ARGSTS INIZPTR.260
& icode,cmessage ) INIZPTR.261
if (icode.lt.0) goto 999 INIZPTR.262
C Large-scale snowfall rate on atmos grid INIZPTR.263
C Convective snowfall rate on atmos grid INIZPTR.264
call findptr(internal_model, 4, 204, INIZPTR.265
& process_code,freq_code,start,end,period, INIZPTR.266
& gridpt_code,weight_code, INIZPTR.267
& bottom_level,top_level,grid_n,grid_s,grid_w,grid_e, INIZPTR.268
& stashmacro_tag,imdi,ptr_snowls, INIZPTR.269
*CALL ARGSIZE INIZPTR.270
*CALL ARGSTS INIZPTR.271
& icode,cmessage ) INIZPTR.272
if (icode.lt.0) goto 999 INIZPTR.273
C Convective snowfall rate on atmos grid INIZPTR.274
call findptr(internal_model, 5, 206, INIZPTR.275
& process_code,freq_code,start,end,period, INIZPTR.276
& gridpt_code,weight_code, INIZPTR.277
& bottom_level,top_level,grid_n,grid_s,grid_w,grid_e, INIZPTR.278
& stashmacro_tag,imdi,ptr_snowconv, INIZPTR.279
*CALL ARGSIZE INIZPTR.280
*CALL ARGSTS INIZPTR.281
& icode,cmessage ) INIZPTR.282
if (icode.lt.0) goto 999 INIZPTR.283
C Large-scale rainfall rate on atmos grid INIZPTR.284
call findptr(internal_model, 4, 203, INIZPTR.285
& process_code,freq_code,start,end,period, INIZPTR.286
& gridpt_code,weight_code, INIZPTR.287
& bottom_level,top_level,grid_n,grid_s,grid_w,grid_e, INIZPTR.288
& stashmacro_tag,imdi,ptr_rainls, INIZPTR.289
*CALL ARGSIZE INIZPTR.290
*CALL ARGSTS INIZPTR.291
& icode,cmessage ) INIZPTR.292
if (icode.lt.0) goto 999 INIZPTR.293
C Convective rainfall rate on atmos grid INIZPTR.294
call findptr(internal_model, 5, 205, INIZPTR.295
& process_code,freq_code,start,end,period, INIZPTR.296
& gridpt_code,weight_code, INIZPTR.297
& bottom_level,top_level,grid_n,grid_s,grid_w,grid_e, INIZPTR.298
& stashmacro_tag,imdi,ptr_rainconv, INIZPTR.299
*CALL ARGSIZE INIZPTR.300
*CALL ARGSTS INIZPTR.301
& icode,cmessage ) INIZPTR.302
if (icode.lt.0) goto 999 INIZPTR.303
C SLOW runoff on atmos grid INIZPTR.304
call findptr(internal_model, 8, 205, INIZPTR.305
& process_code,freq_code,start,end,period, INIZPTR.306
& gridpt_code,weight_code, INIZPTR.307
& bottom_level,top_level,grid_n,grid_s,grid_w,grid_e, INIZPTR.308
& stashmacro_tag,imdi,ptr_slowrunoff, INIZPTR.309
*CALL ARGSIZE INIZPTR.310
*CALL ARGSTS INIZPTR.311
& icode,cmessage ) INIZPTR.312
if (icode.lt.0) goto 999 INIZPTR.313
C FAST runoff on atmos grid INIZPTR.314
call findptr(internal_model, 8, 204, INIZPTR.315
& process_code,freq_code,start,end,period, INIZPTR.316
& gridpt_code,weight_code, INIZPTR.317
& bottom_level,top_level,grid_n,grid_s,grid_w,grid_e, INIZPTR.318
& stashmacro_tag,imdi,ptr_fastrunoff, INIZPTR.319
*CALL ARGSIZE INIZPTR.320
*CALL ARGSTS INIZPTR.321
& icode,cmessage ) INIZPTR.322
if (icode.lt.0) goto 999 INIZPTR.323
C Sublimation in atm D1 : INIZPTR.324
call findptr(internal_model, 3, 231, INIZPTR.325
& process_code,freq_code,start,end,period, INIZPTR.326
& gridpt_code,weight_code, INIZPTR.327
& bottom_level,top_level,grid_n,grid_s,grid_w,grid_e, INIZPTR.328
& stashmacro_tag,imdi,ptr_sublimation_accumul, INIZPTR.329
*CALL ARGSIZE INIZPTR.330
*CALL ARGSTS INIZPTR.331
& icode,cmessage ) INIZPTR.332
if (icode.lt.0) goto 999 INIZPTR.333
INIZPTR.334
C Runoff coastal outflow point (pointer): INIZPTR.335
ptr_ocentpts = si(93,0,im_index) INIZPTR.336
INIZPTR.337
*ENDIF INIZPTR.338
elseif (internal_model .eq. ocean_im) then INIZPTR.339
*IF DEF,OCEAN INIZPTR.340
cccccccccccccccccccccccccccccccccccccccccccccccccccccccc INIZPTR.341
c ocean code : INIZPTR.342
cl ocean -> atmosphere (tag=11) INIZPTR.343
stashmacro_tag = 11 INIZPTR.344
cl-------------------------------------------------------------------- INIZPTR.345
cl 1. get address for each field from its stash section/item code INIZPTR.346
cl and stashmacro tag if a diagnostic, or from its primary pointer INIZPTR.347
cl if prognostic or ancillary field INIZPTR.348
INIZPTR.349
im_ident = internal_model INIZPTR.350
im_index = internal_model_index(im_ident) INIZPTR.351
INIZPTR.352
do i = 1, NoCouplingField INIZPTR.353
C read the stash code from the user namelist INIZPTR.354
read(FieldLocator(istash, i),'(i8)') StashCode INIZPTR.355
section = StashCode / 1000 INIZPTR.356
item = StashCode - section * 1000 INIZPTR.357
C Test the flags associated with each of the fields : INIZPTR.358
if (sf(item, section)) then INIZPTR.359
D1_Zptr(i) = si(item, section, im_index) INIZPTR.360
else INIZPTR.361
D1_Zptr(i) = si(item, section, im_index) INIZPTR.362
endif INIZPTR.363
enddo INIZPTR.364
INIZPTR.365
*ENDIF INIZPTR.366
endif INIZPTR.367
INIZPTR.368
999 continue INIZPTR.369
if(icode.ne.0) then INIZPTR.370
write(nulou,*) cmessage,icode INIZPTR.371
endif INIZPTR.372
return INIZPTR.373
end INIZPTR.374
*ENDIF INIZPTR.375