SUBROUTINE BLOKCNTL( 1,4BLOKCNTL.3
C======================================================================= BLOKCNTL.4
CLL BLOKCNTL.5
CLL Subroutine : BLOKCNTL BLOKCNTL.6
CLL BLOKCNTL.7
CLL Author : R.Hill BLOKCNTL.8
CLL BLOKCNTL.9
CLL Date : 01.09.94 BLOKCNTL.10
CLL BLOKCNTL.11
CLL Rewiewer : BLOKCNTL.12
CLL BLOKCNTL.13
CLL Version : 3.4 BLOKCNTL.14
CLL BLOKCNTL.15
CLL Purpose : This subroutine controls the routines used for row BLOKCNTL.16
CLL by row computation. It calls BLOKINIT to initialise BLOKCNTL.17
CLL the first row of an ocean block and the ROWCALC to BLOKCNTL.18
CLL perform the main computation. BLOKCNTL.19
CLL 4.1 23.5.96 J.M.Gregory Diags for rate of change of salinity OJG2F401.334
CLL 4.1 23.5.96 J.M.Gregory Diagnostic for total ocean velocity OJG5F401.22
CLL BLOKCNTL.20
CLL Calling Routine : BLOKCALC BLOKCNTL.21
CLL BLOKCNTL.22
CLL Routines Called : BLOKINIT BLOKCNTL.23
CLL ROWCALC BLOKCNTL.24
CLL BLOKCNTL.25
! Modification History: ORH3F403.1
! UM Version Description ORH3F403.2
! 4.3 Declare RHOSRN to be passed from BLOKINIT to ORH3F403.3
! ROWCALC for mpp code use. R. Hill ORH3F403.4
! 4.4 Pass stash flag 30285 into ROWCALC (R.Forbes) OFRAF404.57
! ORH3F403.5
! 4.4 Enable actual temperature to be output OMB1F404.152
! by stash M. Bell 21.5.97 OMB1F404.153
! 4.4 Pass swrk_* arrays through and expand dt and ds ORH3F405.24
! components in call to ROWCALC. R. Hill ORH3F405.25
CLL 4.5 03.11.98 Pass row j+2 data (TPP etc) to ROWCALC OOM3F405.290
CLL M. Roberts OOM3F405.291
CLL 4.5 G.J.Rickard Introduce some hard-wired logicals and OOM1F405.338
CLL parameters for use in full Large scheme OOM1F405.339
CLL OOM1F405.340
CLL===================================================================== BLOKCNTL.26
C BLOKCNTL.27
C BLOKCNTL.28
C*L Argument list BLOKCNTL.29
*CALL ARGSIZE 
BLOKCNTL.30
*CALL ARGD1 BLOKCNTL.31
*CALL ARGDUMO BLOKCNTL.32
*CALL ARGPTRO BLOKCNTL.33
*CALL ARGOCALL BLOKCNTL.34
*CALL ARGOINDX ORH7F402.275
*CALL COCAROWS BLOKCNTL.35
*CALL ARGOC2DG ORH0F400.18
*CALL ARGOC3DG ORH0F400.19
*CALL ARGOSTFL ORH3F405.26
&,SWNCOL,sw201_30,sw202_30,sw203_30,sw204_30,sw205_30 BLOKCNTL.36
&,sw208_30 BLOKCNTL.37
&,sw248_30,sw249_30,sw250_30,sw251_30 BLOKCNTL.38
&,sw292_30,sw293_30 OJP0F404.912
&,sf201_30,sf202_30,sf203_30,sf204_30,sf205_30 BLOKCNTL.39
&,sf208_30 BLOKCNTL.40
&,sf248_30,sf249_30,sf250_30,sf251_30 BLOKCNTL.41
&,sf292_30,sf293_30 OJP0F404.913
&,sf285_30 OFRAF404.58
&,mead_diag,sirel_mead,sf_mead,Lpl_mead,tracer_xref ORH1F305.3398
&,SWZUN,SWZVN,SF_ZN ORH1F305.3399
&,utot,vtot,sfutot,sfvtot,Temperature,SFTemp OMB1F404.154
&,AICE, HICE, HSNOW, HICE_REF, CARYHEAT, ICY, FLXTOICE ORH5F401.15
&,CARYSALT, anomiceh, fluxcorh, fluxcorw ORH5F401.16
&,ISX, ISY, WSX_LEADS, WSY_LEADS ORH5F401.17
&,LL_ASS_BTRP, DU_ASS_BTRP, DV_ASS_BTRP ORH5F401.18
&,SURFTEMP, SURFSAL, NEWICE, UCURRENT, VCURRENT ORH5F401.19
&,TTN, ISTRESS, ISTRESS_UV, TMT ORH0F405.2
&,BUOY, EKTOT, ENGINT ORH5F401.21
&,DTABS, TVAR, TTDTOT, co2_tot ORH5F401.22
&,PCO2_ATM, c14to12_atm ORH5F401.23
&,TA,UA,VA,TBP,UBP,VBP BLOKCNTL.109
&,TP,UP,VP,TB,UB,VB BLOKCNTL.110
&,T,U,V,TBM,UBM,VBM BLOKCNTL.111
&,TM,UM,VM,TF,UF,VF BLOKCNTL.112
&,UOVER,UDIF,UUNDER BLOKCNTL.113
&,VOVER,VDIF,VUNDER BLOKCNTL.114
&,TPX, UPX, VPX BLOKCNTL.115
&,TBPX,UBPX,VBPX BLOKCNTL.116
&,TPP,UPP,VPP,TBPP,UBPP,VBPP,TPPX,UPPX,VPPX,TBPPX,UBPPX,VBPPX OOM3F405.292
&,mldsav,FTARR,IMT_IPD_ARG,KM_IPD_ARG,KMP1_IPD_ARG,NT_IPD_ARG ORH1F405.464
&,IMT_GM_ARG,KM_GM_ARG OLA0F401.93
&,ATTEND,HUDTEND OOM2F405.134
& ) ORH7F402.310
C BLOKCNTL.121
IMPLICIT NONE BLOKCNTL.122
C BLOKCNTL.123
C--------------------------------------------------------------------- BLOKCNTL.124
C DEFINE GLOBAL DATA BLOKCNTL.125
C--------------------------------------------------------------------- BLOKCNTL.126
C BLOKCNTL.127
C BLOKCNTL.128
*CALL OARRYSIZ ORH6F401.33
*CALL TYPSIZE BLOKCNTL.129
*CALL TYPD1 BLOKCNTL.130
*CALL TYPDUMO BLOKCNTL.131
*CALL TYPPTRO BLOKCNTL.132
*CALL TYPOINDX PXORDER.2
*CALL TYPOCALL BLOKCNTL.133
*CALL UMSCALAR BLOKCNTL.134
*CALL C_MDI BLOKCNTL.135
*CALL CNTLOCN ORH1F305.3405
*CALL OTIMER ORH1F305.3407
C BLOKCNTL.136
*CALL COCTROWS BLOKCNTL.137
C LL TYPOCTOT BLOKCNTL.138
REAL BLOKCNTL.140
& AICE(*) ! INOUT Fractional ice concentration. ORH1F305.3408
&,HICE(*) ! INOUT Ice depth avged over grid box. ORH1F305.3409
&,HSNOW(*) ! INOUT Snow depth over ice fraction of grid box. ORH1F305.3410
&,HICE_REF(*) ! IN CLIMATOLOGICAL ice depth. ORH1F305.3411
&,anomiceh(*) ! OUT anomalous seaice heat flux ORH1F305.3412
ORH1F305.3413
REAL BLOKCNTL.150
& CARYHEAT(*) ORH1F305.3414
&,FLXTOICE(*) ORH1F305.3415
&,CARYSALT(*) ORH1F305.3416
&,SURFTEMP(*) ORH1F305.3417
&,SURFSAL(*) ORH1F305.3418
&,UCURRENT(*) ORH1F305.3419
&,VCURRENT(*) ORH1F305.3420
&,ISX(*) ORH1F305.3421
&,ISY(*) ORH1F305.3422
&,WSX_LEADS(*) ORH1F305.3423
&,WSY_LEADS(*) ORH1F305.3424
ORH1F305.3425
REAL BLOKCNTL.168
& fluxcorh(*) ORH1F305.3426
&,fluxcorw(*) ORH1F305.3427
ORH1F305.3428
LOGICAL BLOKCNTL.173
& NEWICE(*) ORH1F305.3429
&,ICY(*) ORH1F305.3430
ORH1F305.3431
REAL BLOKCNTL.178
& DU_ASS_BTRP(*) ! u_component data assimilation increment ORH1F305.3432
&,DV_ASS_BTRP(*) ! v_component data assimilation increment ORH1F305.3433
ORH1F305.3434
LOGICAL BLOKCNTL.181
& LL_ASS_BTRP ! logical selecting data assimilation ORH1F305.3435
ORH1F305.3436
C BLOKCNTL.184
INTEGER SWNCOL ! first dimension of stash workspace ORH1F305.3437
&, IMT_IPD_ARG !} ORH1F305.3438
&, KM_IPD_ARG !} For dynamic allocation. ORH1F305.3439
&, KMP1_IPD_ARG !} ORH1F305.3440
&, NT_IPD_ARG !} ORH1F305.3441
&, IMT_GM_ARG !} OLA0F401.94
&, KM_GM_ARG !} OLA0F401.95
REAL BLOKCNTL.186
& sw201_30(*) ! stash workspace for vertical velocity ORH1F305.3442
&,sw202_30(*) ! mixed layer depth ORH1F305.3443
&,sw203_30(*) ! anomalous heat flux ORH1F305.3444
&,sw204_30(*) ! anomalous water flux ORH1F305.3445
&,sw205_30(*) ! anomalous sea ice heat flux ORH1F305.3446
&,sw208_30(*) ! caryheat heat flux (W/m2) ORH1F305.3447
&,mead_diag(*) ! tracer transport (mead) diagnostics ORH1F305.3448
&,sw248_30(*) ! stash workspace for PCO2 ORH1F305.3449
&,sw249_30(*) ! stash workspace for CO2 flux ORH1F305.3450
&,sw250_30(*) ! stash workspace for invasion ORH1F305.3451
&,sw251_30(*) ! stash workspace for evasion ORH1F305.3452
&,sw292_30(*) ! stash workspace for virtual CO2 flux OJP0F404.914
&,sw293_30(*) ! stash workspace for virtual ALK flux OJP0F404.915
ORH1F305.3453
LOGICAL BLOKCNTL.208
& sf201_30,sf202_30,sf203_30,sf204_30,sf205_30 BLOKCNTL.209
&,sf208_30 BLOKCNTL.210
&,sf248_30,sf249_30,sf250_30,sf251_30 BLOKCNTL.211
&,sf292_30,sf293_30 OJP0F404.916
&,sf285_30 OFRAF404.59
ORH1F305.3454
INTEGER BLOKCNTL.213
& sirel_mead(*) ORH1F305.3455
&,tracer_xref(*) ORH1F305.3456
LOGICAL BLOKCNTL.216
& sf_mead(*) ORH1F305.3457
&,Lpl_mead(*) ORH1F305.3458
REAL ATTEND(KM,NT,4) ! Mixing tendencies caused by Med outflow OOM1F403.62
REAL HUDTEND(KM,NT,4) OOM2F405.135
ORH1F305.3459
C Barotropic acceleration diagnostics BLOKCNTL.230
REAL SWZUN(*),SWZVN(*) ORH1F305.3461
LOGICAL SF_ZN(*) ORH1F305.3462
real OJG5F401.24
& utot(*),vtot(*) ! Total 3D velocity diagnostics OJG5F401.25
&,Temperature(*) ! actual temperature diagnostic OMB1F404.155
logical OJG5F401.26
& sfutot,sfvtot ! Stash flags for 3D velocity diagnostics OJG5F401.27
&, SFTemp ! Stash flag for temperature diagnostic OMB1F404.156
C BLOKCNTL.282
C--------------------------------------------------------------------- BLOKCNTL.283
C DIMENSION AND EQUIVALENCE LOCAL DATA BLOKCNTL.284
C--------------------------------------------------------------------- BLOKCNTL.285
C BLOKCNTL.286
REAL BLOKCNTL.301
& TMT(*) ! MERIDIONAL MASS TRANSPORT ORH1F305.3494
&, TTN(*) ! NORTHWARD TRANSPORT OF TRACERS ORH1F305.3503
&, co2_tot ! Total net air-sea flux of CO2 ORH1F305.3504
&, PCO2_ATM ! pp CO2 in atmosphere (ppm) ORH1F305.3505
&, c14to12_atm ! Atmosphere C14/C12 ratio (standard =100) ORH1F305.3506
ORH1F305.3507
ORH1F305.3508
REAL BLOKCNTL.326
& rxp(IMT_IPD_ARG,KM_IPD_ARG) ! delta-rho in x dirn. ORH1F305.3509
&,ry(IMT_IPD_ARG,KM_IPD_ARG) ! delta-rho in y dirn. ORH1F305.3510
&,rrzp(IMT_IPD_ARG,KMP1_IPD_ARG) ! delta-rho in z dirn. ORH1F305.3511
&,esav(IMT_IPD_ARG,KM_IPD_ARG,NT_IPD_ARG) ! Used to save ORH1F305.3512
! e(I,K,2) in IPDFLXCL ORH1F305.3513
REAL OLA0F401.96
& VISOPN(IMT_GM_ARG,KM_GM_ARG) OLA0F401.97
C ! G&McW v* at north face of T gridbox OLA0F401.98
& ,drhob1p(IMT_GM_ARG),drhob2p(IMT_GM_ARG,2) OLA0F401.99
ORH1F305.3514
REAL RHOSRN(IMT,KM),RHOSRNA(IMT,KM+1),RHOSRNB(IMT,KM+1) OOM1F405.341
REAL ORH1F305.3515
& ISTRESS_UV(*) ! MAGNITUDE OF ICE-OCEAN BASAL STRESS. ORH1F305.3516
&,ISTRESS(*) ! ISTRESS_UV ON TRACER PTS. ORH1F305.3517
C ORH1F305.3520
REAL BLOKCNTL.330
& mldsav(*) ! saved mld values ORH1F305.3521
&, FTARR(IMTIMT_FLT) ! Big filtering work array ORH1F405.465
ORH1F305.3522
C--------------------------------------------------------------------- BLOKCNTL.351
C DIMENSION LOCAL DATA BLOKCNTL.352
C--------------------------------------------------------------------- BLOKCNTL.353
*CALL COCTWRKA BLOKCNTL.354
*CALL TYPOC2DG ORH0F400.20
*CALL TYPOC3DG ORH0F400.21
*CALL TYPOSTFL ORH3F405.27
C BLOKCNTL.355
REAL TPX (*) ORH1F305.3523
&, UPX (*) ORH1F305.3524
&, VPX (*) ORH1F305.3525
&, TBPX(*) ORH1F305.3526
&, UBPX(*) ORH1F305.3527
&, VBPX(*) ORH1F305.3528
REAL TPPX(*) OOM3F405.293
&, UPPX(*) OOM3F405.294
&, VPPX(*) OOM3F405.295
&, TBPPX(*) OOM3F405.296
&, UBPPX(*) OOM3F405.297
&, VBPPX(*) OOM3F405.298
C BLOKCNTL.362
C BLOKCNTL.366
LOGICAL L_OBULKRI,L_OWINDMIX OOM1F405.343
LOGICAL L_OBULKMAXMLD OOM1F405.344
REAL LAMBDA_LARGE OOM1F405.345
C* BLOKCNTL.367
EXTERNAL BLOKCNTL.368
& BLOKINIT BLOKCNTL.369
&, ROWCALC BLOKCNTL.370
C BLOKCNTL.371
C======================================================================= BLOKCNTL.372
C BEGIN EXECUTABLE CODE BLOKCNTL.373
C======================================================================= BLOKCNTL.374
C OOM1F405.346
C SOME HARD-WIRED LOGICALS OOM1F405.347
C OOM1F405.348
C OOM1F405.349
C L_OBULKRI=.F. MEANS USING GRADIENT RI TO SET FULL LARGE DEPTHS OOM1F405.350
C L_OBULKRI=.T. MEANS USING BULK RI TO SET FULL LARGE DEPTHS OOM1F405.351
C OOM1F405.352
L_OBULKRI=.FALSE. BLOKCTMD.1
C BLOKCTMD.2
L_OWINDMIX=.TRUE. BLOKCTMD.3
L_OBULKMAXMLD=.FALSE. BLOKCTMD.4
C OOM1F405.357
IF (L_OBULKRI)THEN OOM1F405.358
L_OWINDMIX=.FALSE. BLOKCTMD.5
L_OBULKMAXMLD=.TRUE. BLOKCTMD.6
ENDIF OOM1F405.361
C OOM1F405.362
C HARDWIRE VALUE TO BE USED IN CALCULATING MINIMUM VALUE FOR MLD OOM1F405.363
C OOM1F405.364
LAMBDA_LARGE = 0.05 OOM1F405.365
C OOM1F405.366
C BLOKCNTL.375
C BLOKCNTL.376
IF (L_OTIMER) CALL TIMER('BLOKCNTL',3) ORH1F305.3529
C BLOKCNTL.380
C--------------------------------------------------------------------- BLOKCNTL.381
CL Initialise arrays at the start of this block BLOKCNTL.382
C--------------------------------------------------------------------- BLOKCNTL.383
CALL BLOKINIT ( BLOKCNTL.384
*CALL ARGSIZE BLOKCNTL.385
*CALL ARGD1 BLOKCNTL.386
*CALL ARGDUMO BLOKCNTL.387
*CALL ARGPTRO BLOKCNTL.388
*CALL ARGOCALL BLOKCNTL.389
*CALL ARGOINDX ORH7F402.277
*CALL COCAROWS BLOKCNTL.390
&,ISX, ISY, WSX_LEADS, WSY_LEADS OLA0F404.10
&,TTN ORH1F305.3530
&,TMT, BLOKCNTL.394
*CALL COCAWRKA BLOKCNTL.395
*CALL ARGOC2DG OOM1F405.367
&,L_OBULKRI,L_OWINDMIX,L_OBULKMAXMLD OOM1F405.368
&,CARYSALT,CARYHEAT,FLXTOICE,LAMBDA_LARGE OOM1F405.369
&,co2_tot BLOKCNTL.397
&,LL_ASS_BTRP,DU_ASS_BTRP,DV_ASS_BTRP ORH1F305.3531
&,rxp,ry,rrzp,esav ORH7F402.311
&,VISOPN OLA0F401.100
&,drhob1p,drhob2p OLA0F401.101
&,MLDSAV,RHOSRN,RHOSRNA,RHOSRNB OOM1F405.342
&,IMT_IPD_NOMIX ORH1F305.3533
&) BLOKCNTL.406
C BLOKCNTL.407
C--------------------------------------------------------------------- BLOKCNTL.408
CL Perform the main computations BLOKCNTL.409
C--------------------------------------------------------------------- BLOKCNTL.410
C BLOKCNTL.411
CALL ROWCALC ( BLOKCNTL.412
C*L BLOKCNTL.413
*CALL ARGSIZE BLOKCNTL.414
*CALL ARGD1 BLOKCNTL.415
*CALL ARGDUMO BLOKCNTL.416
*CALL ARGPTRO BLOKCNTL.417
*CALL ARGOCALL BLOKCNTL.418
*CALL ARGOINDX ORH7F402.278
*CALL COCAROWS BLOKCNTL.419
*CALL ARGOC2DG ORH0F400.22
*CALL ARGOC3DG ORH0F400.23
&,swrk_dt(si_dt(1)),swrk_dt(si_dt(2)),swrk_dt(si_dt(3)) ORH3F405.28
&,swrk_dt(si_dt(4)),swrk_dt(si_dt(5)),swrk_dt(si_dt(6)) ORH3F405.29
&,swrk_dt(si_dt(7)),swrk_dt(si_dt(8)),swrk_dt(si_dt(9)) ORH3F405.30
&,swrk_dt(si_dt(10)),swrk_dt(si_dt(11)),swrk_dt(si_dt(12)) ORH3F405.31
&,swrk_dt(si_dt(13)),swrk_dt(si_dt(14)),swrk_dt(si_dt(15)),sf_dt ORH3F405.32
&,swrk_ds(si_ds(1)),swrk_ds(si_ds(2)),swrk_ds(si_ds(3)) ORH3F405.33
&,swrk_ds(si_ds(4)),swrk_ds(si_ds(5)),swrk_ds(si_ds(6)) ORH3F405.34
&,swrk_ds(si_ds(7)),swrk_ds(si_ds(8)),swrk_ds(si_ds(9)) ORH3F405.35
&,swrk_ds(si_ds(10)),swrk_ds(si_ds(11)),swrk_ds(si_ds(12)) ORH3F405.36
&,swrk_ds(si_ds(13)),swrk_ds(si_ds(14)),sf_ds ORH3F405.37
&,swrk_bio,si_bio,sf_bio ORH3F405.38
&,SWNCOL,sw201_30,sw202_30,sw203_30,sw204_30,sw205_30,sw208_30 BLOKCNTL.420
&,sw248_30,sw249_30,sw250_30,sw251_30 BLOKCNTL.421
&,sw292_30,sw293_30 OJP0F404.917
&,sf201_30,sf202_30,sf203_30,sf204_30,sf205_30,sf208_30 BLOKCNTL.422
&,sf248_30,sf249_30,sf250_30,sf251_30 BLOKCNTL.423
&,sf292_30,sf293_30 OJP0F404.918
OJP0F404.919
&,sf285_30 OFRAF404.60
&,mead_diag,sirel_mead,sf_mead,Lpl_mead,tracer_xref ORH1F305.3534
&,SWZUN,SWZVN,SF_ZN ORH1F305.3535
&,utot,vtot,sfutot,sfvtot,Temperature,SFTemp OMB1F404.157
&,AICE, HICE, HSNOW, HICE_REF, CARYHEAT, ICY, FLXTOICE ORH5F401.25
&,CARYSALT, anomiceh, fluxcorh, fluxcorw ORH5F401.26
&,ISX, ISY, WSX_LEADS, WSY_LEADS ORH5F401.27
&,LL_ASS_BTRP, DU_ASS_BTRP, DV_ASS_BTRP ORH5F401.28
&,SURFTEMP, SURFSAL, NEWICE, UCURRENT, VCURRENT ORH5F401.29
&,TTN, TMT,L_OBULKRI,L_OWINDMIX,L_OBULKMAXMLD, OOM1F405.370
& LAMBDA_LARGE, OOM1F405.371
*CALL COCAWRKA BLOKCNTL.475
&,ISTRESS,ISTRESS_UV BLOKCNTL.477
&,co2_tot,PCO2_ATM BLOKCNTL.483
&,c14to12_atm, FTARR ORH1F405.466
&,rxp,ry,rrzp,esav,TPX,UPX,VPX,TBPX,UBPX,VBPX ORH7F402.312
&,TPPX,UPPX,VPPX,TBPPX,UBPPX,VBPPX,VISOPN OOM3F405.299
&,DRHOB1P,DRHOB2P,RHOSRN,RHOSRNA,RHOSRNB OOM1F405.372
&,IMT_GLN,KM_GLN ! For dynamic allocation ORH1F305.3540
&,ATTEND,HUDTEND OOM2F405.136
OOM2F405.137
&) BLOKCNTL.489
C BLOKCNTL.490
C======================================================================= BLOKCNTL.491
C END OF BLOCK OF ROWS COMPUTATION =================================== BLOKCNTL.492
C======================================================================= BLOKCNTL.493
C BLOKCNTL.494
IF (L_OTIMER) CALL TIMER('BLOKCNTL',4) ORH1F305.3541
ORH1F305.3542
C BLOKCNTL.498
RETURN BLOKCNTL.499
END BLOKCNTL.500
C BLOKCNTL.501
*ENDIF BLOKCNTL.502