SUBROUTINE ROW_CTL( 1,20@DYALLOC.4513
*CALL ARGSIZE 
@DYALLOC.4514
*CALL ARGD1 @DYALLOC.4515
*CALL ARGDUMA @DYALLOC.4516
*CALL ARGDUMO @DYALLOC.4517
*CALL ARGDUMW GKR1F401.256
*CALL ARGPTRO @DYALLOC.4519
*CALL ARGSTS @DYALLOC.4520
*CALL ARGCONO @DYALLOC.4522
*CALL ARGOCALL @DYALLOC.4523
*CALL ARGPPX GKR0F305.979
*CALL ARGOINDX ORH7F402.263
& ICODE,CMESSAGE ! ############################################ @DYALLOC.4524
ROW_CTL.29
C IN: model description held in dump ROW_CTL.30
ROW_CTL.31
&,ITT,TTSEC,SWLDEG,FKMP_GLOBAL ORH6F402.68
ROW_CTL.33
C INOUT: primary variables ROW_CTL.34
&,ZU,ZV OFRAF404.31
&,P,PB,PTD,PTDB,UBT,VBT,UBTBBC,VBTBBC,MLD,AICE,HICE,HSNOW OOM1F405.380
&,HICE_REF,CARYHEAT,FLXTOICE,CARYSALT OOM1F405.381
&,ISX,ISY,WSX_LEADS,WSY_LEADS,ATHKDFT OLA2F403.49
ROW_CTL.51
C IN: array required for sea ice calculation ROW_CTL.52
ROW_CTL.53
&,ICY,OCEANHEATFLUX,OCEANSNOWRATE OOM1F405.382
ROW_CTL.55
C IN: array required for haney forcing of seaice ROW_CTL.58
ROW_CTL.59
&,anomiceh ROW_CTL.60
ROW_CTL.61
C IN: arrays required for flux correction ROW_CTL.64
ROW_CTL.65
&,fluxcorh,fluxcorw OJT0F304.30
ROW_CTL.67
C IN: Data assimilation ROW_CTL.70
ROW_CTL.71
&,LL_ASS_BTRP,DU_ASS_BTRP,DV_ASS_BTRP ROW_CTL.72
ROW_CTL.73
C OUT: arrays for interfacing between sections ROW_CTL.75
ROW_CTL.76
&,SURFTEMP,SURFSAL,NEWICE,UCURRENT,VCURRENT,ZTD,XF,YF,SWZVRT OOM1F405.383
ROW_CTL.86
C IN: pointers and stashflags to diagnostics ROW_CTL.93
ROW_CTL.94
&,SI201_30,SI202_30,SI203_30,SI204_30,SI205_30 ROW_CTL.95
&,SI208_30 ROW_CTL.96
&,SI248_30,SI249_30,SI250_30,SI251_30 NT071293.270
&,SI292_30,SI293_30 OJP0F404.897
&,SF201_30,SF202_30,SF203_30,SF204_30,SF205_30 ROW_CTL.97
&,SF208_30 ROW_CTL.98
&,SF248_30,SF249_30,SF250_30,SF251_30 NT071293.271
&,SF292_30,SF293_30 OJP0F404.898
ROW_CTL.99
C IN: STASH_MAXLEN for dynamically allocating STASH workspace ROW_CTL.100
ROW_CTL.101
&,sw_len30 ROW_CTL.102
*CALL ARGOCTOT ORH1F304.134
ROW_CTL.103
&,LCAL360 OFR8F404.8
& ) ROW_CTL.104
ROW_CTL.105
IMPLICIT NONE ROW_CTL.106
ROW_CTL.107
INTEGER ROW_CTL.108
& SI201_30,SI202_30,SI203_30,SI204_30,SI205_30 @DYALLOC.4525
&,SI208_30 ROW_CTL.120
&,SI248_30,SI249_30,SI250_30,SI251_30 NT071293.272
&,SI292_30,SI293_30 OJP0F404.899
&,sw_len30 ROW_CTL.121
&,ICODE ROW_CTL.122
ROW_CTL.123
LOGICAL ROW_CTL.124
& SF201_30,SF202_30,SF203_30,SF204_30,SF205_30 @DYALLOC.4526
&,SF208_30 ROW_CTL.127
&,SF248_30,SF249_30,SF250_30,SF251_30 NT071293.273
&,SF292_30,SF293_30 OJP0F404.900
ROW_CTL.128
LOGICAL OFR8F404.9
& LCAL360 OFR8F404.10
CHARACTER*(80) ONF0F304.12
& CMESSAGE ROW_CTL.130
ROW_CTL.131
REAL ROW_CTL.132
& STASHWORK(sw_len30) ROW_CTL.133
ROW_CTL.134
*CALL CSUBMODL GRB4F305.433
*CALL OARRYSIZ ORH6F401.34
*CALL CMAXSIZE @DYALLOC.4527
*CALL TYPSIZE @DYALLOC.4528
*CALL TYPD1 @DYALLOC.4529
*CALL TYPDUMA @DYALLOC.4530
*CALL TYPDUMO @DYALLOC.4531
*CALL TYPDUMW GKR1F401.257
*CALL TYPPTRO @DYALLOC.4533
*CALL TYPSTS @DYALLOC.4534
*CALL TYPCONO @DYALLOC.4536
*CALL TYPOINDX PXORDER.45
*CALL TYPOCALL @DYALLOC.4537
*CALL TYPOC2DG ORH0F400.10
*CALL TYPOCTOT ORH1F304.135
*CALL C_MDI ROW_CTL.139
*CALL CNTLOCN ORH1F305.492
*CALL PPXLOOK GKR0F305.980
*CALL PARVARS OLA2F403.50
ROW_CTL.140
INTEGER ROW_CTL.141
& ITT ROW_CTL.142
REAL ROW_CTL.143
& TTSEC,SWLDEG,FKMP_GLOBAL(IMT,JMT_GLOBAL) ORH6F402.69
&,ZU(IMT,JMT),ZV(IMT,JMT) ORH1F304.173
&,ZUENG(IMT,8,JMT),ZVENG(IMT,8,JMT) ORH1F304.174
&,P(IMT_STREAM,0:JMT_STREAM+1),PB(IMT_STREAM,0:JMT_STREAM+1) ORH1F402.47
&,PTD(IMT_STREAM,JMT_STREAM),PTDB(IMT_STREAM,JMT_STREAM) ORH1F305.495
&,UBT(IMT_FSF,JMTM1_FSF),VBT(IMT_FSF,JMTM1_FSF) ORL1F404.733
&,UBTBBC(IMT_FSF,JMTM1_FSF),VBTBBC(IMT_FSF,JMTM1_FSF) ORL1F404.734
&,MLD(IMT_IPD_MIX,JMT_IPD_MIX) ORH1F305.498
REAL ROW_CTL.155
& SURFTEMP(IMT_ICE,JMT_ICE),SURFSAL(IMT_ICE,JMT_ICE) ORH1F305.499
&,ISX(IMT_Idr,JMTM1_idr),ISY(IMT_idr,JMTM1_idr) ODC1F405.418
&,WSX_LEADS(IMT_idr,JMTM1_idr),WSY_LEADS(IMT_idr,JMTM1_idr) ODC1F405.419
&,CARYHEAT(IMT_ICE,JMT_ICE) ORH1F305.502
&,FLXTOICE(IMT_ICE,JMT_ICE),CARYSALT(IMT_ICE,JMT_ICE) ORH1F305.503
&,UCURRENT(IMT_DRsa,JMTM1_DRsa),VCURRENT(IMT_DRsa,JMTM1_DRsa) ODC1F405.420
ORH1F305.505
LOGICAL ROW_CTL.159
& ICY(IMT_ICE,JMT_ICE),NEWICE(IMT_ICE,JMT_ICE) ORH1F305.506
ORH1F305.507
REAL ROW_CTL.163
& anomiceh(IMT_IHY,JMT_IHY) ORH1F305.508
ORH1F305.509
REAL ROW_CTL.167
& fluxcorh(IMT_FLX,JMT_FLX),fluxcorw(IMT_FLX,JMT_FLX) ORH1F305.510
ORH1F305.511
REAL ROW_CTL.171
& AICE(IMT_ICE,JMT_ICE),HICE(IMT_ICE,JMT_ICE) ORH1F305.512
&,HSNOW(IMT_ICE,JMT_ICE) ORH1F305.513
&,HICE_REF(IMT_IHY,JMT_IHY) ORH1F305.514
ORH1F305.515
REAL ROW_CTL.175
& DU_ASS_BTRP(IMT_ASM,JMT_ASM),DV_ASS_BTRP(IMT_ASM,JMT_ASM) ORH1F305.516
LOGICAL ROW_CTL.177
& LL_ASS_BTRP ROW_CTL.178
ORH1F305.517
REAL ROW_CTL.181
& ZTD(IMT_STREAM,JMT_STREAM) ORH1F305.518
REAL ROW_CTL.185
& XF(IMT_FSF,JMT_FSF),YF(IMT_FSF,JMT_FSF) ORH1F305.519
# ,SWZVRT(IMT_ZVRT,JMT_ZVRT,N_ZVRT)! vorticity diagnostics OMB3F401.50
OMB3F401.51
C local variables OMB3F401.52
REAL ZCONU(IMT_ZVRT,JMT_ZVRT,N_ZVRT) ! } contributions to barotrop OMB3F401.53
# ,ZCONV(IMT_ZVRT,JMT_ZVRT,N_ZVRT) ! } u and v tendencies OMB3F401.54
OMB3F401.55
OMB3F401.56
C Local scalar parameters and pointer variables OMB3F401.57
ROW_CTL.188
REAL OFRAF404.32
& RLSRFP(IMT,JMT) ! Rigid-lid surface pressure OFRAF404.33
INTEGER I,J,K,N,IPOINT ORH1F304.130
&,SWNCOL ! number of columns JG170893.18
&,DTITEM1 ! item no. of first heating-rate diagnostic JG170893.19
&,NDTITEM ! no. of heating-rate diagnostics JG170893.20
&,DSITEM1 ! item no. of 1st diag. for rate salinity change OJG2F401.280
&,NDSITEM ! no. of diags. for rate of change of salinity OJG2F401.281
&,ZNITEM1 ! item no. of baroclinic x-acceleration diagnostic ORH1F305.520
&,BIOITEM1 ! Item no. of first biology diagnostic ONT1F304.3
&,NBIOITEM ! No. of biology diagnostics ONT1F304.4
&,heatsinkitem OJG0F400.8
&,diagswitem OJG1F400.8
&,GMWITEM ! item no. of first Gent & McWilliams diagnostic OLA0F401.64
&,NGMWITEM ! no. of Gent & McWilliams diagnostics OLA0F401.65
&,gnumitem ! item no for vertical momentum diffusion coeff OLA3F403.18
&,gnuTitem ! item no for vertical tracer diffusion coeff OLA3F403.19
&,Rimitem ! item no for momentum Richardson no OLA3F403.20
&,RiTitem ! item no for tracer Richardson no OLA3F403.21
&,hmitem ! item no for max depth Large scheme momentum OLA3F403.22
&,hTitem ! item no for max depth Large scheme tracer OLA3F403.23
&,LMITEM ! ITEM NO MONIN OBUKHOV LENGTH LARGE SCHEME MOMENTUM OOM1F405.384
&,LTITEM ! ITEM NO MONIN OBUKHOV LENGTH LARGE SCHEME TRACER OOM1F405.385
&,RIMLDCALCITEM ! ITEM NO FOR RICHARDSON NO FROM MLD CALCULATION OOM1F405.386
ORH0F404.24
INTEGER UV_J_DIM ! J dimension for special use on UV ORH0F404.25
! grid diagnostics. ORH0F404.26
ORH0F404.27
REAL OLA2F403.57
C The variables defined below are used for the Visbeck scheme OLA2F403.58
& athkdft(imt_vis,jmt_vis) ! thickness diffusion coeff on T grid OLA2F403.59
C OJG0F400.9
parameter(heatsinkitem=279) OJG0F400.10
parameter(diagswitem=280) OJG1F400.9
PARAMETER(hmitem=290,hTitem=291) OOM1F405.387
PARAMETER(LMITEM=302,LTITEM=303,RIMLDCALCITEM=294) OOM1F405.388
PARAMETER(gnumitem=296,gnuTitem=297,Rimitem=298,RiTitem=299) OOM1F405.389
C Note that the 5th item is not directly after the first four OJG2F404.104
PARAMETER(GMWITEM=281,NGMWITEM=5) OJG2F404.105
PARAMETER(DTITEM1=231,NDTITEM=15,DSITEM1=306,NDSITEM=14) OJG2F401.282
PARAMETER(ZNITEM1=246) JG170893.26
integer utotitem ! Stash item number for total velocity OJG5F401.37
parameter(utotitem=320) OJG5F401.38
integer tempitem ! Stash item number for temperature OMB1F404.165
parameter(tempitem=301) OMB1F404.166
ORH1F305.523
PARAMETER(BIOITEM1=252,NBIOITEM=27) ONT1F304.7
C stashwork addresses of heating-rate diagnostics JG170893.28
INTEGER SI_DT(NDTITEM),SI_DS(NDSITEM) OJG2F401.283
C stashwork addresses of barotropic acceleration diagnostics OMB3F401.58
INTEGER SI_ZUN,SI_ZVN JG170893.32
C Stashwork addresses of biology diagnostics ONT1F304.10
INTEGER SI_BIO(NBIOITEM) ONT1F304.11
INTEGER SI_DT_LOCAL(NDTITEM) ORH3F405.5
&, SI_DS_LOCAL(NDSITEM) ORH3F405.6
&, SI_BIO_LOCAL(NBIOITEM) ORH3F405.7
&, dt_size ! Size of stashwork chunk relevant to DT ORH3F405.8
&, ds_size ! Size of stashwork chunk relevant to DS ORH3F405.9
&, bio_size ! Size of stashwork chunk relevant to biology ORH3F405.10
ORH3F405.11
INTEGER ITEM ! local index ORH1F305.525
INTEGER IM_IDENT ! internal model identifier GRB4F305.434
INTEGER IM_INDEX ! internal model index for STASH arrays GRB4F305.435
ROW_CTL.211
INTEGER SI_GMW(NGMWITEM) OLA0F401.67
INTEGER ROW_CTL.212
& tracer_xref(O_MAX_TRACERS_MEA)!maps model trcers to cox trcers ORH1F305.526
&,sirel_mead(O_MAX_TRACERS_MEA) !ptrs to STASHWS rel.to SI(211,30) ORH1F305.527
&,mead_index ! to find position of 1st mead diagnostic in SW ROW_CTL.215
&,tracer_count,L,pl_count,LD ! local indices JG170893.35
LOGICAL ROW_CTL.217
& Lpl_mead(4*LSEGC_MEA,O_MAX_TRACERS_MEA)!pseudo levels indicator ORH1F305.528
&,sf_mead(O_MAX_TRACERS_MEA) ! stash flags for mead diagnostics ORH1F305.529
&,land ROW_CTL.220
ORH1F305.530
LOGICAL JG170893.37
& SF_DT(NDTITEM) ! stash flags for heating-rate diagnostics JG170893.38
&,SF_DS(NDSITEM) ! stash flags for rates of change of salinity OJG2F401.284
&,SF_ZN(2) ! stash flags for barotropic acceleration diagnostics OMB3F401.59
ORH1F305.531
C Stashwork addresses of biology diagnostics ONT1F304.14
&,SF_BIO(NBIOITEM) ! stash flags for biology diagnostics ONT1F304.15
LOGICAL OCEAN(IMT,JMT) OJG2F401.285
INTEGER IMT_STASH OJG2F401.286
ROW_CTL.222
LOGICAL SF_GMW(NGMWITEM) OLA0F401.68
C External subroutines called ROW_CTL.223
ROW_CTL.224
EXTERNAL ROW_CTL.225
& BLOKCALC ORH1F304.128
& ,STASH ROW_CTL.227
& ,TIMER ROW_CTL.229
& ,SET_PSEUDO_LIST ROW_CTL.232
&,maskodiagn,copyodiagn,copyodiagl OJG5F401.39
ORH1F305.532
ROW_CTL.234
C Set up internal model identifier and STASH index GRB4F305.436
im_ident = ocean_im GRB4F305.437
im_index = internal_model_index(im_ident) GRB4F305.438
GRB4F305.439
ICODE=0 ROW_CTL.235
CMESSAGE=' ' ROW_CTL.236
C ORH5F400.3
C Initialise arrays for vertically averaged barotropic acceleration OMB3F401.73
C ORH5F400.5
do j=j_1,j_jmt ORH3F402.269
do i=1,imt ORH5F400.7
zu(i,j)=0. ORH5F400.8
zv(i,j)=0. ORH5F400.9
enddo ORH5F400.10
enddo ORH5F400.11
ROW_CTL.237
C OMB3F401.60
C Initialise arrays for vorticity diagnostics OMB3F401.61
C OMB3F401.62
IF ( L_OZVRT ) THEN OMB3F401.63
DO item = 1,N_ZVRT OMB3F401.64
DO J = J_1,J_JMT ORH3F402.270
DO I=1,IMT OMB3F401.66
ZCONU(I,J,item)=0.0 OMB3F401.67
ZCONV(I,J,item)=0.0 OMB3F401.68
END DO ! I OMB3F401.69
END DO ! J OMB3F401.70
END DO ! ID OMB3F401.71
END IF ! L_OZVRT OMB3F401.72
ORH1F305.533
IF (L_OHMEAD) THEN ORH1F305.534
ORH1F305.535
CL Set up variables to enable tracer transport diagnostics ROW_CTL.239
SI061093.1
mead_index=1 SI061093.2
DO item=O_MAX_TRACERS,1,-1 SI061093.3
IF (SF(210+item,30)) mead_index=SI(210+item,30,im_index) GRB4F305.440
END DO SI061093.5
ROW_CTL.240
DO item = 1,O_MAX_TRACERS ROW_CTL.241
ROW_CTL.242
tracer_xref(item) = 0 ROW_CTL.243
sf_mead(item) = SF(210+item,30) ROW_CTL.244
sirel_mead(item) = 1 SI061093.6
ROW_CTL.246
IF (SF(210+item,30)) THEN ROW_CTL.247
sirel_mead(item) = SI(210+item,30,im_index) - mead_index + 1 GRB4F305.441
CALL SET_PSEUDO_LIST(LSEGC*4,LEN_STLIST ROW_CTL.248
&,STLIST(1,STINDEX(1,210+item,30,im_index)),Lpl_mead(1,item) GRB4F305.442
&,STASH_PSEUDO_LEVELS,NUM_STASH_PSEUDO,ICODE,CMESSAGE) ROW_CTL.250
IF (ICODE.GT.0) RETURN ROW_CTL.251
ENDIF ROW_CTL.252
ROW_CTL.253
END DO ROW_CTL.254
ROW_CTL.255
tracer_count=1 ROW_CTL.256
tracer_xref(tracer_count)=1 ROW_CTL.257
tracer_count=2 ROW_CTL.258
tracer_xref(tracer_count)=2 ROW_CTL.259
DO item= 3, O_MAX_TRACERS ROW_CTL.260
IF (SI(100+item,0,im_index).GT.1) THEN GRB4F305.443
tracer_count = tracer_count + 1 ROW_CTL.262
tracer_xref(item) = tracer_count ROW_CTL.263
ENDIF ROW_CTL.264
END DO ROW_CTL.265
ROW_CTL.266
ELSE ! L_OHMEAD = true ORH1F305.536
mead_index = 1 ORH1F305.537
ENDIF ! L_OHMEAD = true ORH1F305.538
ORH1F305.539
CL Initialise STASH workspace ROW_CTL.272
ROW_CTL.273
DO N=1,sw_len30 ROW_CTL.274
STASHWORK(N)=RMDI ROW_CTL.275
END DO ROW_CTL.276
ROW_CTL.277
C JG170893.41
C Stash pointers and flags for heating-rate diagnostics JG170893.42
C JG170893.43
DO ITEM=1,NDTITEM JG170893.44
SI_DT(ITEM)=SI(DTITEM1-1+ITEM,30,im_index) GRB4F305.444
SF_DT(ITEM)=SF(DTITEM1-1+ITEM,30) JG170893.46
SI_DT_LOCAL(ITEM) = SI_DT(ITEM) - SI_DT(1) + 1 ORH3F405.12
ENDDO JG170893.47
DO ITEM=1,NDSITEM OJG2F401.287
SI_DS(ITEM)=SI(DSITEM1-1+ITEM,30,im_index) OJG2F401.288
SF_DS(ITEM)=SF(DSITEM1-1+ITEM,30) OJG2F401.289
SI_DS_LOCAL(ITEM) = SI_DS(ITEM) - SI_DS(1) + 1 ORH3F405.13
ENDDO OJG2F401.290
C JG170893.49
C Stash pointers and flags for barotropic acceleration diagnostics OMB3F401.74
C JG170893.51
SI_ZUN=SI(ZNITEM1,30,im_index) GRB4F305.445
SI_ZVN=SI(ZNITEM1+1,30,im_index) GRB4F305.446
SF_ZN(1)=SF(ZNITEM1,30) JG170893.54
SF_ZN(2)=SF(ZNITEM1+1,30) JG170893.55
ORH1F305.541
ORH1F305.542
C ONT1F304.18
C Stash pointers and flags for biology diagnostics ONT1F304.19
C ONT1F304.20
DO ITEM=1,NBIOITEM ONT1F304.21
SI_BIO(ITEM)=SI(BIOITEM1-1+ITEM,30,im_index) GRB4F305.447
SF_BIO(ITEM)=SF(BIOITEM1-1+ITEM,30) ONT1F304.23
SI_BIO_LOCAL(ITEM) = SI_BIO(ITEM) - SI_BIO(1) + 1 ORH3F405.14
ENDDO ONT1F304.24
C OLA0F401.69
C Stash pointers and flags for Gent & McWilliams diagnostics OLA0F401.70
C OLA0F401.71
DO ITEM=1,4 OJG2F404.106
SI_GMW(ITEM)=SI(GMWITEM-1+ITEM,30,im_index) OLA0F401.73
SF_GMW(ITEM)=SF(GMWITEM-1+ITEM,30) OLA0F401.74
ENDDO OLA0F401.75
si_gmw(5)=si(322,30,im_index) OJG2F404.107
sf_gmw(5)=sf(322,30) OJG2F404.108
C OLA0F401.76
ORH1F305.543
C JG170893.57
C Length of a row JG170893.58
C JG170893.59
IF (L_OCYCLIC) THEN ORH1F305.544
SWNCOL=IMTM2 ORH1F305.545
ELSE ORH1F305.546
SWNCOL=IMT ORH1F305.547
ENDIF ORH1F305.548
IMT_STASH=SWNCOL OJC2F400.91
ORH1F305.549
IF (L_OBIOLOGY) THEN ORH1F305.550
SWNCOL_BIO = SWNCOL ORH1F305.551
ELSE ORH1F305.552
SWNCOL_BIO = 1 ORH1F305.553
ENDIF ORH1F305.554
ORH1F305.555
IF (.NOT.L_ONOCLIN) THEN ORH1F305.556
SWNCOL_CLN = SWNCOL ORH1F305.557
ELSE ORH1F305.558
SWNCOL_CLN = 1 ORH1F305.559
ENDIF ORH1F305.560
ORH1F305.561
C JG170893.65
IF ((L_OISOPYCGM.AND.L_OVISBECK).or.(L_OISOGM.AND.L_OVISBECK)) OOM1F405.78
& THEN OOM1F405.79
c Average the thickness diffusion coefficent onto the C grid OLA2F403.71
c for the Visbeck scheme. Set cyclic conditions OLA2F403.72
*IF DEF,MPP OLA2F403.73
CALL SWAPBOUNDS(ATHKDFT,IMT,JMT,O_EW_HALO,O_NS_HALO,1) OLA2F403.74
*ENDIF OLA2F403.75
do j=j_1,j_jmt OLA2F403.76
do i=1,imtm1 OLA2F403.77
ATHKDFTU(i,j)=(ATHKDFT(i,j)+ATHKDFT(i+1,j))/2. OLA2F403.78
ATHKDFTV(i,j)=(ATHKDFT(i,j)+ATHKDFT(i,j+1))/2. OLA2F403.79
enddo OLA2F403.80
enddo OLA2F403.81
IF (L_OCYCLIC) THEN OLA2F403.82
do j=j_1,j_jmt OLA2F403.83
ATHKDFTU(1,j)=ATHKDFTU(imtm1,j) OLA2F403.84
ATHKDFTU(imt,j)=ATHKDFTU(2,j) OLA2F403.85
ATHKDFTV(1,j)=ATHKDFTV(imtm1,j) OLA2F403.86
ATHKDFTV(imt,j)=ATHKDFTV(2,j) OLA2F403.87
enddo OLA2F403.88
ELSE OLA2F403.89
do j=j_1,j_jmt OLA2F403.90
ATHKDFTU(imt,j)=ATHKDFT(imt,j) OLA2F403.91
ATHKDFTV(imt,j)=(ATHKDFT(imt,j)+ATHKDFT(imt,j+1))/2. OLA2F403.92
enddo OLA2F403.93
ENDIF OLA2F403.94
*IF DEF,MPP OLA2F403.95
CALL SWAPBOUNDS(ATHKDFTV,IMT,JMT,O_EW_HALO,O_NS_HALO,1) OLA2F403.96
CALL SWAPBOUNDS(ATHKDFTU,IMT,JMT,O_EW_HALO,O_NS_HALO,1) OLA2F403.97
*ENDIF OLA2F403.98
ENDIF ! for L_OISOPYCGM.AND.L_OVISBECK OLA2F403.99
OLA2F403.100
OLA2F403.101
CL Section 30: Row calculations ROW_CTL.302
ROW_CTL.303
CALL BLOKCALC ( ORH1F304.129
*CALL ARGSIZE @DYALLOC.4539
*CALL ARGD1 @DYALLOC.4540
*CALL ARGDUMO @DYALLOC.4541
*CALL ARGPTRO @DYALLOC.4542
*CALL ARGOCALL @DYALLOC.4543
*CALL ARGOINDX ORH7F402.265
ROW_CTL.305
C IN: model description held in dump ROW_CTL.306
ROW_CTL.307
& ITT,TTSEC,SWLDEG,FKMP_GLOBAL ORH6F402.70
ROW_CTL.309
C INOUT: primary variables ROW_CTL.310
&,ZU,ZV,ZUENG,ZVENG,ZCONU,ZCONV,SWZVRT ORH3F403.246
&,P,PB,PTD,PTDB,UBT,VBT,UBTBBC,VBTBBC,MLD ORL1F404.735
C OUT: arrays for interfacing between sections ROW_CTL.322
&,ZTD,XF,YF ORH3F403.248
C OUT: diagnostic quantities, IN: STASH flags ROW_CTL.331
*CALL ARGOC2DG ORH0F400.11
ROW_CTL.332
&,imt_stash,sf(210,30),stashwork(si(210,30,im_index)) ORH3F403.249
&,STASHWORK(SI_GMW(1)),STASHWORK(SI_GMW(2)),STASHWORK(SI_GMW(3)) OJG2F404.109
&,STASHWORK(SI_GMW(4)),STASHWORK(SI_GMW(5)) OJG2F404.110
&,SF_GMW(1),SF_GMW(2),SF_GMW(3),SF_GMW(4),SF_GMW(5) OJG2F404.111
&,STASHWORK(SI(gnumitem,30,im_index)) OLA3F403.26
&,STASHWORK(SI(gnuTitem,30,im_index)) OLA3F403.27
&,STASHWORK(SI(Rimitem,30,im_index)) OLA3F403.28
&,STASHWORK(SI(RiTitem,30,im_index)) OLA3F403.29
&,STASHWORK(SI(hmitem,30,im_index)) OLA3F403.30
&,STASHWORK(SI(hTitem,30,im_index)) OLA3F403.31
&,SF(gnumitem,30),SF(gnuTitem,30),SF(Rimitem,30),SF(RiTitem,30) OLA3F403.32
&,SF(hmitem,30),SF(hTitem,30) OLA3F403.33
&,STASHWORK(SI(LMITEM,30,IM_INDEX)),SF(LMITEM,30) OOM1F405.390
&,STASHWORK(SI(LTITEM,30,IM_INDEX)),SF(LTITEM,30) OOM1F405.391
&,STASHWORK(SI(RIMLDCALCITEM,30,IM_INDEX)),SF(RIMLDCALCITEM,30) OOM1F405.392
&,SWNCOL,STASHWORK(SI201_30),STASHWORK(SI202_30) JG170893.66
&,STASHWORK(SI203_30),STASHWORK(SI204_30),STASHWORK(SI205_30) JG170893.67
&,STASHWORK(SI208_30),STASHWORK(SI248_30),STASHWORK(SI249_30) OOM1F405.393
&,STASHWORK(SI250_30),STASHWORK(SI251_30) NT071293.275
&,STASHWORK(SI292_30),STASHWORK(SI293_30) OJP0F404.901
&,SF201_30,SF202_30,SF203_30,SF204_30,SF205_30,SF208_30 OOM1F405.394
&,SF248_30,SF249_30,SF250_30,SF251_30,SF(285,30) OFRAF404.34
&,STASHWORK(mead_index),sirel_mead,sf_mead,Lpl_mead,tracer_xref ORH3F403.250
&,SF292_30,SF293_30 OJP0F404.902
OJP0F404.903
&,stashwork(si_dt(1)),si_dt_local,sf_dt,dt_size ORH3F405.15
&,stashwork(si_ds(1)),si_ds_local,sf_ds,ds_size ORH3F405.16
&,stashwork(si_bio(1)),si_bio_local,sf_bio,bio_size ORH3F405.17
&,stashwork(si_zun),stashwork(si_zvn),sf_zn ORH1F305.564
&,stashwork(si(utotitem,30,im_index)) OJG5F401.40
&,stashwork(si(utotitem+1,30,im_index)) OJG5F401.41
&,sf(utotitem,30),sf(utotitem+1,30) OJG5F401.42
&,stashwork(si(tempitem,30,im_index)),sf(tempitem,30) OMB1F404.167
ORH1F305.565
C INOUT: arrays for interfacing between sections 30 and 32 ROW_CTL.344
ROW_CTL.345
&,AICE,HICE,HSNOW,HICE_REF,CARYHEAT ORH3F403.252
ROW_CTL.352
C IN: ROW_CTL.353
ROW_CTL.354
&,ICY,FLXTOICE,CARYSALT,anomiceh,fluxcorh,fluxcorw ORH3F403.253
&,ISX,ISY,WSX_LEADS,WSY_LEADS JT161193.103
ORH1F305.567
C IN: Data assimilation variables and model calendar OFR8F404.11
&,LL_ASS_BTRP,DU_ASS_BTRP,DV_ASS_BTRP,LCAL360 OFR8F404.12
ROW_CTL.370
C OUT: ROW_CTL.373
ROW_CTL.374
&,SURFTEMP,SURFSAL,NEWICE,UCURRENT,VCURRENT ORH3F403.254
ROW_CTL.386
*CALL ARGOCTOT ORH1F304.136
&, IMT_IPD_MIX,JMT_IPD_MIX,IMT_idr,JMTM1_idr ! For dynamic ODC1F405.421
&, IMT_idr_MIX,JMT_idr_MIX,JMTM1_idr_MIX ! allocation ODC1F405.422
&, IMTIMT_FLT, NTMIN2, NBLOCK, NSLAB ) OOM1F405.395
ROW_CTL.388
IF (L_OHMEAD) THEN ORH1F305.572
C Set land points to RMDI for mead diagnostics ROW_CTL.390
ROW_CTL.391
Do item = 1,O_MAX_TRACERS ROW_CTL.392
IF (sf_mead(item)) THEN ROW_CTL.393
DO J = J_1,J_JMTM1 ORH3F402.271
DO L = 1,LSEGC ROW_CTL.395
land =.true. ROW_CTL.396
DO LD=1,LDIV ROW_CTL.397
IF (ISHT(J,L,LD).NE.0) land=.FALSE. ROW_CTL.398
END DO ROW_CTL.399
IF (land) THEN ROW_CTL.400
DO N=1,4 ROW_CTL.401
pl_count=(L-1)*4+N ROW_CTL.402
IF (Lpl_mead(pl_count,item)) THEN ROW_CTL.403
STASHWORK(SI(210+item,30,im_index) -1 + GRB4F305.448
& (pl_count-1)*(J_JMTM1-J_1+1)+J-O_NS_HALO) = RMDI ORH0F404.1
ENDIF ROW_CTL.406
END DO ROW_CTL.407
END IF ROW_CTL.408
END DO ROW_CTL.409
END DO ROW_CTL.410
ENDIF ROW_CTL.411
END DO ROW_CTL.412
ORH1F305.573
ENDIF ! L_OHMEAD = true ORH1F305.574
C OJG1F400.10
if (sf(diagswitem,30)) call copyodiagn(imt,jmt,1,.true.,0. OJG1F400.11
&,diagsw,fkmp,stashwork(si(diagswitem,30,im_index))) OJG1F400.12
C JG170893.77
C Blank out non-water points in heating-rate diagnostics OJG2F404.112
C in stash workspace. OJG2F404.113
C JG170893.79
DO ITEM=1,NDTITEM JG170893.80
IF (SF(DTITEM1-1+ITEM,30)) OJG2F404.114
& call maskodiagn(imt,jmt,km,.true.,0.,fkmp OJG2F404.115
& ,stashwork(SI(DTITEM1-1+ITEM,30,im_index))) OJG2F404.116
ENDDO OJG2F404.117
IF (SF_GMW(4)) call maskodiagn(imt,jmt,km,.true.,0.,fkmp OJG2F404.118
&,stashwork(si_gmw(4))) OJG2F404.119
IF (SF(210,30)) call maskodiagn(imt,jmt,km,.true.,0.,fkmp OJG2F404.120
&,stashwork(SI(210,30,im_index))) OJG2F404.121
C OJG2F404.122
C Copy diags for snow and heat into ocean into stash workspace OJG2F404.123
C OJG2F404.124
DO J=1,JMT ORH5F403.14
DO I=1,IMT OJC2F400.106
OCEAN(I,J)=FKMP(I,J).GT.0.1 OJC2F400.107
ENDDO OJC2F400.108
ENDDO OJC2F400.109
K=1 OJC2F400.110
IF (SF(206,30)) OJC2F400.111
&CALL COPYODIAGL(IMT,JMT,K,.TRUE.,0. OJC2F400.112
& ,OCEANHEATFLUX,OCEAN,STASHWORK(SI(206,30,im_index))) OJC2F400.113
IF (SF(207,30)) OJC2F400.114
&CALL COPYODIAGL(IMT,JMT,K,.TRUE.,0. OJC2F400.115
& ,OCEANSNOWRATE,OCEAN,STASHWORK(SI(207,30,im_index))) OJC2F400.116
C OJG2F401.297
C Blank out non-water points in rates of change of salinity OJG2F404.125
C in stash workspace. Note that items 8 and 9 are single-level OJG2F404.126
C fields, the others on all levels. OJG2F404.127
C OJG2F404.128
DO ITEM=1,NDSITEM OJG2F401.298
IF (SF(DSITEM1-1+ITEM,30)) THEN OJG2F401.300
IPOINT=SI(DSITEM1-1+ITEM,30,im_index) OJG2F404.129
IF (ITEM.EQ.7.OR.ITEM.EQ.8) THEN OJG2F404.130
call maskodiagn(imt,jmt,1,.true.,0.,fkmp OJG2F404.131
& ,stashwork(ipoint)) OJG2F404.132
ELSE OJG2F401.310
call maskodiagn(imt,jmt,km,.true.,0.,fkmp OJG2F404.133
& ,stashwork(ipoint)) OJG2F404.134
ENDIF OJG2F401.321
ENDIF OJG2F401.322
ENDDO OJG2F401.323
IF (SF_GMW(5)) call maskodiagn(imt,jmt,km,.true.,0.,fkmp OJG2F404.135
&,stashwork(si_gmw(5))) OJG2F404.136
C ONT1F304.40
C Blank out land points for ocean biology diagnostics ONT1F304.41
C First 2 diagnostics are single-layer. ONT1F304.42
C Rest are full-depth (all levels). ONT1F304.43
C ONT1F304.44
DO ITEM=1,2 ONT1F304.45
IPOINT=SI(BIOITEM1-1+ITEM,30,im_index) GRB4F305.451
IF (SF(BIOITEM1-1+ITEM,30)) THEN ONT1F304.47
DO J=1,JMT ORH5F403.17
DO I=1,SWNCOL ONT1F304.49
IF (INT(FKMP(I,J)).LT.1) STASHWORK(IPOINT)=RMDI ONT1F304.50
IPOINT=IPOINT+1 ONT1F304.51
ENDDO ONT1F304.52
ENDDO ONT1F304.53
ENDIF ONT1F304.54
ENDDO ONT1F304.55
C ONT1F304.56
DO ITEM=3,NBIOITEM ONT1F304.57
IPOINT=SI(BIOITEM1-1+ITEM,30,im_index) GRB4F305.452
IF (SF(BIOITEM1-1+ITEM,30)) THEN ONT1F304.59
DO K=1,KM ONT1F304.60
DO J=1,JMT ORH5F403.18
DO I=1,SWNCOL ONT1F304.62
IF (K.GT.INT(FKMP(I,J))) STASHWORK(IPOINT)=RMDI ONT1F304.63
IPOINT=IPOINT+1 ONT1F304.64
ENDDO ONT1F304.65
ENDDO ONT1F304.66
ENDDO ONT1F304.67
ENDIF ONT1F304.68
ENDDO ONT1F304.69
OFRAF404.35
C--------------------------------------------------------------------- OFRAF404.36
C Calculate rigid lid surface pressure for the case of no stfn OFRAF404.37
C--------------------------------------------------------------------- OFRAF404.38
OFRAF404.39
IF (SF(285,30) .AND. L_ONOCLIN) THEN OFRAF404.40
OFRAF404.41
CALL CALC_RLIDP( OFRAF404.42
*CALL ARGSIZE OFRAF404.43
*CALL ARGOCALL OFRAF404.44
*CALL ARGOINDX OFRAF404.45
& ICODE,CMESSAGE,ITT,ZU,ZV,PTD,RLSRFP ) OFRAF404.46
OFRAF404.47
! Place data in STASH array removing cyclic points (if present) OFRAF404.48
CALL COPYODIAGN(IMT,JMT,1,.TRUE.,0.,RLSRFP,FKMP, OFRAF404.49
& STASHWORK(SI(285,30,im_index)) ) OFRAF404.50
OFRAF404.51
ENDIF OFRAF404.52
OLA2F403.102
c Calculate length scale for Visbeck scheme if this is a mixing OLA2F403.103
c timestep. lscale is the min number of grid points needed to find OLA2F403.104
c a value of tmin1 le tmin1_max (set to min 1 max 7). OLA2F403.105
IF ((L_OISOPYCGM.AND.L_OVISBECK.and.mix.eq.1).or. OOM1F405.80
& (L_OISOGM.AND.L_OVISBECK.and.mix.eq.1)) THEN OOM1F405.81
OLA2F403.189
CALL VISBECK_CALC( ORH4F405.5
& athkdft ORH4F405.6
*CALL ARGOC2DG ORH4F405.7
&,CST,DXT,DYT ORH4F405.8
&,IMT,JMT,IMT_VIS,JMT_VIS,IMT_IPD,IMTM2,JMT_GLOBAL ORH4F405.9
&,JST,JFIN,J_1,J_JMT,O_MYPE,L_OVISHADCM4 ORH4F405.10
&) ORH4F405.11
OLA2F403.191
OLA2F403.194
ENDIF ORH4F405.12
ORH4F405.13
*IF DEF,MPP ORH0F404.28
! Stash overdimesions UV fields generally - this ORH0F404.29
! must be catered for although this smacks of the tail ORH0F404.30
! (STASH) wagging the dog (the Ocean model). ORH0F404.31
UV_J_DIM = JMT ORH0F404.32
*ELSE ORH0F404.33
UV_J_DIM = JMTM1 ORH0F404.34
*ENDIF ORH0F404.35
c OMB1F404.168
c mask out land points in selected 3D stashed arrays OMB1F404.169
c OMB1F404.170
if (sf(utotitem,30)) OJG5F401.43
& call maskodiagn(imt,uv_j_dim,km,.true.,0.,fkmq ORH0F404.36
&,stashwork(si(utotitem,30,im_index))) OJG5F401.45
if (sf(utotitem+1,30)) OJG5F401.46
& call maskodiagn(imt,uv_j_dim,km,.true.,0.,fkmq ORH0F404.37
&,stashwork(si(utotitem+1,30,im_index))) OJG5F401.48
if (sf(tempitem,30)) then OMB1F404.171
call maskodiagn( imt,jmt,km,.true.,0.,fkmp OMB1F404.172
&, stashwork(si(tempitem,30,im_index)) ) OMB1F404.173
end if ! sf(tempitem,30) OMB1F404.174
OMB1F404.175
C OJG0F400.11
C--------------------------------------------------------------------- OJG0F400.12
C Copy heatsink, the heat 'lost' from the model due to resetting of OJG0F400.13
C the temperature to -1.8 C at the bottom level, to STASH workspace. OJG0F400.14
C--------------------------------------------------------------------- OJG0F400.15
C OJG0F400.16
if (sf(heatsinkitem,30)) call copyodiagn(imt,jmt,1,.true.,0. OJG0F400.17
&,heatsink,fkmp,stashwork(si(heatsinkitem,30,im_index))) OJG0F400.18
ROW_CTL.414
CALL STASH(o_sm,o_im,30,STASHWORK, GKR0F305.981
*CALL ARGSIZE @DYALLOC.4545
*CALL ARGD1 @DYALLOC.4546
*CALL ARGDUMA @DYALLOC.4547
*CALL ARGDUMO @DYALLOC.4548
*CALL ARGDUMW GKR1F401.258
*CALL ARGSTS @DYALLOC.4549
*CALL ARGPPX GKR0F305.982
& ICODE,CMESSAGE) @DYALLOC.4553
ROW_CTL.416
RETURN ROW_CTL.417
END ROW_CTL.418
*ENDIF @DYALLOC.4554