*IF DEF,CONTROL,AND,DEF,OCEAN STOCNPT1.2
C ******************************COPYRIGHT****************************** GTS2F400.9739
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.9740
C GTS2F400.9741
C Use, duplication or disclosure of this code is subject to the GTS2F400.9742
C restrictions as set forth in the contract. GTS2F400.9743
C GTS2F400.9744
C Meteorological Office GTS2F400.9745
C London Road GTS2F400.9746
C BRACKNELL GTS2F400.9747
C Berkshire UK GTS2F400.9748
C RG12 2SZ GTS2F400.9749
C GTS2F400.9750
C If no contract has been raised with this copy of the code, the use, GTS2F400.9751
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.9752
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.9753
C Modelling at the above address. GTS2F400.9754
C ******************************COPYRIGHT****************************** GTS2F400.9755
C GTS2F400.9756
CLL SUBROUTINE SET_OCN_POINTERS --------------------------------------- STOCNPT1.3
CLL STOCNPT1.4
CLL Initialisation routine for CRAY YMP STOCNPT1.5
CLL Set pointer for primary ocean fields. STOCNPT1.6
CLL Purpose: Sets integer pointers to ocean STOCNPT1.7
CLL variables from STASHIN addresses. STOCNPT1.8
CLL STOCNPT1.9
CLL MC, TJ, SI <- programmer of some or all of previous code or changes STOCNPT1.10
CLL STOCNPT1.11
CLL Model Modification history from model version 3.0: STOCNPT1.12
CLL version Date STOCNPT1.13
CLL 3.1 24/02/93 Ocean tracers are no longer assumed to have been SI240293.5
CLL assigned consecutive item numbers SI240293.6
CLL 3.4 05/10/94 Add user ancillary pointers. RTHBarnes GRB0F304.241
CLL 3.4 16/6/94 : Change CHARACTER*(*) to CHARACTER*(80) N.Farnon ANF0F304.34
CLL 3.4 04/08/94 Remove joc_anom_ice. (JFT) OJT0F304.5
CLL 3.5 05/06/95 Chgs to SI & STINDEX arrays. RTHBarnes GRB4F305.453
CLL 4.1 13/06/96 Add pointers for conjugate gradient solver ORH1F401.38
CLL residual values. R. Hill ORH1F401.39
CLL 4.3 25/02/97 Add pointers for spacially varying thickness OLA2F403.22
CLL diffusion coeff for Visbeck scheme C.Roberts OLA2F403.23
CLL 4.2 05/11/96 Pntrs for LPRIM_O2 allowing uncompressed dump. SI OSI0F402.135
! 4.2 20/12/96 START_POINT dependent on O_LEN_DATA now not ORH6F402.6
! static dump header information which is not ORH6F402.7
! consistent with domain decomposition. R. Hill ORH6F402.8
! 4.4 03/10/97 Set up super array pointers for T,S,U,V in case ORH9F404.29
! of STASH call on timestep 0. R. Hill ORH9F404.30
CLL 4.4 15/06/97 Add pointer for the free surface barotropic ORL1F404.98
CLL solution. R.Lenton ORL1F404.99
! 4.5 13/07/98 Delete all initialisation of O_ADVECT_SCHEME, OSY1F405.7
! now set in namelist NLSTCOCN. D.Storkey OSY1F405.8
CLL 4.5 12/08/97 Pointers for ocean lateral boundary conditions added GSI1F405.244
CLL joc_bounds, joc_bounds_tendency renamed. M.J. Bell GSI1F405.245
CLL 4.5 1/07/98 Add pointer for CO2 passing. C.D.Jones CCN1F405.15
CLL STOCNPT1.14
CLL STOCNPT1.15
CLL Programming Standard: UNIFIED MODEL DP NO. 3, Version 3 STOCNPT1.16
CLL STOCNPT1.17
CLL System Task: P0 STOCNPT1.18
CLL STOCNPT1.19
CLL System Components: C21 ( Ocean part) STOCNPT1.20
CLL STOCNPT1.21
CLL External documentation: UMDP NO. C4 VERSION NO. 4 STOCNPT1.22
CLL STOCNPT1.23
CLLEND------------------------------------------------------------- STOCNPT1.24
STOCNPT1.25
SUBROUTINE SET_OCN_POINTERS( 1@DYALLOC.3447
*CALL ARGSIZE 
@DYALLOC.3448
*CALL ARGPTRO @DYALLOC.3449
*CALL ARGSTS @DYALLOC.3450
*CALL ARGDUMO @DYALLOC.3451
& ICODE,CMESSAGE) @DYALLOC.3452
STOCNPT1.28
IMPLICIT NONE STOCNPT1.29
STOCNPT1.30
*CALL CSUBMODL GRB4F305.454
*CALL TYPSIZE @DYALLOC.3453
*CALL TYPPTRO @DYALLOC.3454
*CALL TYPSTS @DYALLOC.3455
*CALL TYPDUMO @DYALLOC.3456
*CALL CNTLOCN GSI1F405.246
! OTRACPNT is common block of pointers into tracer array OJP0F404.685
*CALL OTRACPNT OJP0F404.686
STOCNPT1.33
C @DYALLOC.3457
C Other agruments @DYALLOC.3458
C @DYALLOC.3459
INTEGER ICODE ! INOUT Error number (unchanged by routine) @DYALLOC.3460
CHARACTER*(80) CMESSAGE ! INOUT Error message (unchanged) ANF0F304.35
C @DYALLOC.3462
C local variables STOCNPT1.34
STOCNPT1.35
INTEGER STOCNPT1.36
& IFLD, STOCNPT1.37
& joc_bdy_count, ! Local counter for ocean bdy pointers GSI1F405.247
& START_POINT, SI240293.7
& cox_tracer SI240293.8
& ,IM_IDENT ! internal model identifier GRB4F305.455
& ,IM_INDEX ! internal model index for STASH arrays GRB4F305.456
& ,len_t,len_u ! length of 3d tracer, u_current field OSI0F402.136
STOCNPT1.39
CL STOCNPT1.40
CL Primary variables for ocean model STOCNPT1.41
STOCNPT1.42
C Set up internal model identifier and STASH index GRB4F305.457
im_ident = ocean_im GRB4F305.458
im_index = internal_model_index(im_ident) GRB4F305.459
GRB4F305.460
C Ocean primary variables have section number 0 STOCNPT1.43
C Now assign values to the named pointers (primary data area only) STOCNPT1.44
STOCNPT1.45
C Tracers. Space is always allocated for stash items 101 and 102 SI240293.9
C in this model version. SI240293.10
STOCNPT1.47
cox_tracer = 1 SI240293.11
joc_tracer(cox_tracer,1) = SI(101,0,im_index) GRB4F305.461
T_TRACER = 1 OJP0F404.687
cox_tracer = 2 SI240293.13
joc_tracer(cox_tracer,1) = SI(102,0,im_index) GRB4F305.462
S_TRACER = 2 OJP0F404.689
SI240293.15
DO IFLD = 3, O_MAX_TRACERS SI240293.16
IF (SI(100+IFLD,0,im_index).GT.1) THEN GRB4F305.463
cox_tracer = cox_tracer + 1 SI240293.18
joc_tracer(cox_tracer,1) = SI(100+IFLD,0,im_index) GRB4F305.464
IF (IFLD.EQ.3) THEN OJP0F404.694
TCO2_TRACER = cox_tracer OJP0F404.695
ENDIF OJP0F404.697
IF (IFLD.EQ.4) THEN OJP0F404.698
ALK_TRACER = cox_tracer OJP0F404.699
ENDIF OJP0F404.701
IF (IFLD.EQ.5) THEN OJP0F404.702
NUTRIENT_TRACER = cox_tracer OJP0F404.703
ENDIF OJP0F404.705
IF (IFLD.EQ.6) THEN OJP0F404.706
PHYTO_TRACER = cox_tracer OJP0F404.707
ENDIF OJP0F404.709
IF (IFLD.EQ.7) THEN OJP0F404.710
ZOO_TRACER = cox_tracer OJP0F404.711
ENDIF OJP0F404.713
IF (IFLD.EQ.8) THEN OJP0F404.714
DETRITUS_TRACER = cox_tracer OJP0F404.715
ENDIF OJP0F404.717
IF (IFLD.EQ.9) THEN OJP0F404.718
C14_TRACER = cox_tracer OJP0F404.719
ENDIF OJP0F404.721
END IF SI240293.20
END DO STOCNPT1.50
STOCNPT1.51
C Now currents STOCNPT1.52
STOCNPT1.53
joc_u(1) = SI(121,0,im_index) GRB4F305.465
joc_v(1) = SI(122,0,im_index) GRB4F305.466
STOCNPT1.56
C Stream functions STOCNPT1.57
STOCNPT1.58
joc_stream(1) = SI(130,0,im_index) GRB4F305.467
joc_stream(2) = SI(131,0,im_index) GRB4F305.468
joc_tend(1) = SI(132,0,im_index) GRB4F305.469
joc_tend(2) = SI(133,0,im_index) GRB4F305.470
STOCNPT1.63
C Stream function residuals for conjugate gradient solver ORH1F401.40
joc_cgres = SI(192,0,im_index) ORH1F401.41
joc_cgresb = SI(193,0,im_index) ORH1F401.42
C Free surface variables STOCNPT1.64
STOCNPT1.65
joc_eta = SI(134,0,im_index) ORL1F404.100
joc_etab = SI(195,0,im_index) ORL1F404.101
joc_ubt = SI(135,0,im_index) ORL1F404.102
joc_ubtbbt = SI(196,0,im_index) ORL1F404.103
joc_vbt = SI(136,0,im_index) ORL1F404.104
joc_vbtbbt = SI(197,0,im_index) ORL1F404.105
joc_ubtbbc = SI(198,0,im_index) ORL1F404.106
joc_vbtbbc = SI(199,0,im_index) ORL1F404.107
STOCNPT1.69
C Miscellaneous variables STOCNPT1.70
STOCNPT1.71
joc_mld = SI(137,0,im_index) GRB4F305.474
C Spacially varying thickness diffusion coeff for Visbeck scheme OLA2F403.24
joc_athkdft = SI(194,0,im_index) OLA2F403.25
STOCNPT1.73
C Sea ice variables STOCNPT1.74
STOCNPT1.75
joc_isx = SI(139,0,im_index) GRB4F305.475
joc_isy = SI(140,0,im_index) GRB4F305.476
joc_snow = SI(141,0,im_index) GRB4F305.477
joc_mischt = SI(142,0,im_index) GRB4F305.478
joc_htotoi = SI(143,0,im_index) GRB4F305.479
joc_salinc = SI(144,0,im_index) GRB4F305.480
joc_icy = SI(145,0,im_index) GRB4F305.481
joc_icecon = SI(146,0,im_index) GRB4F305.482
joc_icedep = SI(147,0,im_index) GRB4F305.483
joc_topmelt = SI(190,0,im_index) GRB4F305.484
joc_botmelt = SI(191,0,im_index) GRB4F305.485
joc_iceu = SI(148,0,im_index) GRB4F305.486
joc_icev = SI(149,0,im_index) GRB4F305.487
STOCNPT1.89
C Ancillary fields STOCNPT1.90
STOCNPT1.91
joc_taux = SI(150,0,im_index) GRB4F305.488
joc_tauy = SI(151,0,im_index) GRB4F305.489
joc_wme = SI(152,0,im_index) GRB4F305.490
joc_surfp = SI(153,0,im_index) GRB4F305.491
joc_solar = SI(161,0,im_index) GRB4F305.492
joc_heat = SI(162,0,im_index) GRB4F305.493
joc_ple = SI(165,0,im_index) GRB4F305.494
joc_river = SI(166,0,im_index) GRB4F305.495
joc_watop = SI(167,0,im_index) GRB4F305.496
joc_solice = SI(170,0,im_index) GRB4F305.497
joc_snowrate = SI(171,0,im_index) GRB4F305.498
joc_sublim = SI(172,0,im_index) GRB4F305.499
joc_atmco2 = SI(200,0,im_index) CCN1F405.16
joc_bounds_prev = SI(175,0,im_index) GSI1F405.248
joc_bounds_next = SI(176,0,im_index) GSI1F405.249
STOCNPT1.106
C Flux correction STOCNPT1.107
STOCNPT1.108
joc_climsst = SI(180,0,im_index) GRB4F305.502
joc_climsal = SI(181,0,im_index) GRB4F305.503
joc_climair = SI(182,0,im_index) GRB4F305.504
joc_climicedep = SI(183,0,im_index) GRB4F305.505
joc_anom_heat = SI(185,0,im_index) GRB4F305.506
joc_anom_salt = SI(186,0,im_index) GRB4F305.507
GRB0F304.242
C User ancillaries GRB0F304.243
GRB0F304.244
jousr_anc1 = SI(331,0,im_index) GRB4F305.508
jousr_anc2 = SI(332,0,im_index) GRB4F305.509
jousr_anc3 = SI(333,0,im_index) GRB4F305.510
jousr_anc4 = SI(334,0,im_index) GRB4F305.511
jousr_anc5 = SI(335,0,im_index) GRB4F305.512
jousr_anc6 = SI(336,0,im_index) GRB4F305.513
jousr_anc7 = SI(337,0,im_index) GRB4F305.514
jousr_anc8 = SI(338,0,im_index) GRB4F305.515
jousr_anc9 = SI(339,0,im_index) GRB4F305.516
jousr_anc10 = SI(340,0,im_index) GRB4F305.517
jousr_mult1 = SI(351,0,im_index) ! multi-level GRB4F305.518
jousr_mult2 = SI(352,0,im_index) ! multi-level GRB4F305.519
jousr_mult3 = SI(353,0,im_index) ! multi-level GRB4F305.520
jousr_mult4 = SI(354,0,im_index) ! multi-level GRB4F305.521
STOCNPT1.116
C Housekeeping STOCNPT1.117
STOCNPT1.118
joc_index_comp = O_FIXHD(140) STOCNPT1.119
joc_index_exp = O_FIXHD(142) STOCNPT1.120
joc_index_start = O_FIXHD(144) STOCNPT1.121
joc_no_seapts = O_INTHD(11) STOCNPT1.122
joc_no_segs = O_FIXHD(141) STOCNPT1.123
GSI1F405.250
C Calculate ocean lateral boundary pointers; pointers to start GSI1F405.251
C locations of fields in the DTEMP_BOUND array used by boundvol GSI1F405.252
GSI1F405.253
joc_bdy_count=1 GSI1F405.254
GSI1F405.255
if (l_obdy_tracer) then GSI1F405.256
GSI1F405.257
do ifld = 1,NT GSI1F405.258
joc_bdy_tracer(ifld) = joc_bdy_count GSI1F405.259
joc_bdy_count=joc_bdy_count + (LENRIMO * KM) GSI1F405.260
enddo GSI1F405.261
GSI1F405.262
else GSI1F405.263
GSI1F405.264
do ifld = 1,NT GSI1F405.265
joc_bdy_tracer(ifld) = 0 GSI1F405.266
enddo GSI1F405.267
GSI1F405.268
endif GSI1F405.269
GSI1F405.270
if (l_obdy_uv) then GSI1F405.271
GSI1F405.272
joc_bdy_u = joc_bdy_count GSI1F405.273
joc_bdy_count = joc_bdy_count + (LENRIMO_U * KM) GSI1F405.274
GSI1F405.275
joc_bdy_v = joc_bdy_count GSI1F405.276
joc_bdy_count = joc_bdy_count + (LENRIMO_U * KM) GSI1F405.277
GSI1F405.278
else GSI1F405.279
GSI1F405.280
joc_bdy_u = 0 GSI1F405.281
joc_bdy_v = 0 GSI1F405.282
GSI1F405.283
endif GSI1F405.284
GSI1F405.285
if (l_obdy_stream) then GSI1F405.286
GSI1F405.287
joc_bdy_stream = joc_bdy_count GSI1F405.288
joc_bdy_count = joc_bdy_count + LENRIMO GSI1F405.289
GSI1F405.290
joc_bdy_tend = joc_bdy_count GSI1F405.291
joc_bdy_count = joc_bdy_count + LENRIMO GSI1F405.292
GSI1F405.293
!!! joc_bdy_ztd = joc_bdy_count GSI1F405.294
!!! joc_bdy_count = joc_bdy_count + LENRIMO GSI1F405.295
GSI1F405.296
else GSI1F405.297
GSI1F405.298
joc_bdy_stream = 0 GSI1F405.299
joc_bdy_tend = 0 GSI1F405.300
joc_bdy_ztd = 0 GSI1F405.301
GSI1F405.302
endif GSI1F405.303
GSI1F405.304
GSI1F405.305
if (l_obdy_ice) then GSI1F405.306
joc_bdy_snow = joc_bdy_count GSI1F405.307
joc_bdy_count = joc_bdy_count + LENRIMO GSI1F405.308
joc_bdy_aice = joc_bdy_count GSI1F405.309
joc_bdy_count = joc_bdy_count + LENRIMO GSI1F405.310
joc_bdy_hice = joc_bdy_count GSI1F405.311
joc_bdy_count = joc_bdy_count + LENRIMO GSI1F405.312
GSI1F405.313
else GSI1F405.314
GSI1F405.315
joc_bdy_snow = 0 GSI1F405.316
joc_bdy_aice = 0 GSI1F405.317
joc_bdy_hice = 0 GSI1F405.318
end if GSI1F405.319
GSI1F405.320
STOCNPT1.124
C Now set pointers for second time level in workspace STOCNPT1.125
STOCNPT1.126
C Assume start of work array follows immediately from DATA STOCNPT1.127
STOCNPT1.128
START_POINT = 1+O_LEN_DATA OSI0F402.137
len_t = joc_tracer(2,1)-joc_tracer(1,1) OSI0F402.138
DO IFLD = 1, NT STOCNPT1.130
joc_tracer(IFLD,2) = (IFLD-1)*len_t + START_POINT OSI0F402.139
END DO STOCNPT1.132
C STOCNPT1.133
len_u = joc_v(1)-joc_u(1) OSI0F402.140
joc_u(2) = NT*len_t + START_POINT OSI0F402.141
joc_v(2) = NT*len_t + len_u + START_POINT OSI0F402.142
STOCNPT1.136
ORH9F404.31
! We must ensure that super array pointers to tracers and velocities ORH9F404.32
! are set up in readiness for any call to STASH on timestep 0. ORH9F404.33
ORH9F404.34
do IFLD = 1, nt ORH9F404.35
o_spsts(o_ixsts(1) + IFLD-1) = JOC_TRACER(IFLD,1) ORH9F404.36
o_spsts(o_ixsts(1) + nt + IFLD-1) = JOC_TRACER(IFLD,2) ORH9F404.37
end do ORH9F404.38
ORH9F404.39
o_spsts(o_ixsts(2)) = JOC_U(1) ORH9F404.40
o_spsts(o_ixsts(2)+1) = JOC_U(2) ORH9F404.41
o_spsts(o_ixsts(3)) = JOC_V(1) ORH9F404.42
o_spsts(o_ixsts(3)+1) = JOC_V(2) ORH9F404.43
ORH9F404.44
C Finally (for ocean), write out confirmation STOCNPT1.137
STOCNPT1.138
WRITE (6,1040) 'Temp ', joc_tracer(1,1) STOCNPT1.139
WRITE (6,1040) 'Salinity', joc_tracer(2,1) STOCNPT1.140
DO IFLD = 3, NT STOCNPT1.141
WRITE (6,1040) 'Tracer ', joc_tracer(IFLD,1) STOCNPT1.142
END DO STOCNPT1.143
WRITE (6,1040) 'Baroc u ', joc_u(1) STOCNPT1.144
WRITE (6,1040) 'Baroc v ', joc_v(1) STOCNPT1.145
WRITE (6,1040) 'Stream f', joc_stream(1) STOCNPT1.146
WRITE (6,1040) 'Surface ', joc_eta ORL1F404.108
WRITE (6,1040) 'Sfc -dtb', joc_etab ORL1F404.109
WRITE (6,1040) 'Barot u ', joc_ubt ORL1F404.110
WRITE (6,1040) 'Barot v ', joc_ubt ORL1F404.111
WRITE (6,1040) 'ubt -dtt', joc_ubtbbt ORL1F404.112
WRITE (6,1040) 'vbt -dtt', joc_vbtbbt ORL1F404.113
WRITE (6,1040) 'ubt -dtc', joc_ubtbbc ORL1F404.114
WRITE (6,1040) 'vbt -dtc', joc_vbtbbc ORL1F404.115
1040 FORMAT (1x,A8,' at dump store index ',I8) STOCNPT1.150
STOCNPT1.151
RETURN STOCNPT1.152
END STOCNPT1.153
STOCNPT1.154
*ENDIF STOCNPT1.155