SUBROUTINE BLOKCALC( 1,16BLOKCALC.24
*CALL ARGSIZE 
BLOKCALC.25
*CALL ARGD1 BLOKCALC.26
*CALL ARGDUMO BLOKCALC.27
*CALL ARGPTRO BLOKCALC.28
*CALL ARGOCALL BLOKCALC.29
*CALL ARGOINDX ORH7F402.266
*CALL COCAROWS BLOKCALC.30
*CALL ARGOC2DG ORH0F400.12
*CALL ARGOC3DG ORH0F400.13
&,SWNCOL,sw201_30,sw202_30,sw203_30,sw204_30,sw205_30 BLOKCALC.31
&,sw208_30 BLOKCALC.32
&,sw248_30,sw249_30,sw250_30,sw251_30 BLOKCALC.33
&,sw292_30,sw293_30 OJP0F404.904
&,sf201_30,sf202_30,sf203_30,sf204_30,sf205_30,sf208_30 ORH3F403.240
&,sf248_30,sf249_30,sf250_30,sf251_30 BLOKCALC.36
&,sf285_30 OFRAF404.54
&,mead_diag,sirel_mead,sf_mead,Lpl_mead,tracer_xref BLOKCALC.38
&,sf292_30,sf293_30 OJP0F404.905
*CALL ARGOSTFL ORH3F405.22
&,SWZUN,SWZVN,SF_ZN BLOKCALC.43
&,utot,vtot,sfutot,sfvtot,Temperature,SFTemp OMB1F404.160
&,AICE,HICE,HSNOW,HICE_REF,CARYHEAT ORH3F403.243
&,ICY,FLXTOICE,CARYSALT,anomiceh,fluxcorh,fluxcorw ORH3F403.244
&,ISX,ISY,WSX_LEADS,WSY_LEADS BLOKCALC.73
&,LL_ASS_BTRP,DU_ASS_BTRP,DV_ASS_BTRP,LCAL360 OFR8F404.14
&,SURFTEMP,SURFSAL,NEWICE,UCURRENT,VCURRENT ORH3F403.245
*CALL ARGOCTOT BLOKCALC.84
&, IMT_IPD_MIX_ARG, JMT_IPD_MIX_ARG,IMT_idr_ARG,JMTM1_idr_ARG ODC1F405.3
&, IMT_idr_MIX_ARG,JMT_idr_MIX_ARG,JMTM1_idr_MIX_ARG ODC1F405.4
&, IMTIMT_FLT_ARG , NTMIN2_ARG, NBLOCK_ARG, NSLAB_ARG ORH6F401.37
&) BLOKCALC.85
C BLOKCALC.86
C BLOKCALC.87
C======================================================================= BLOKCALC.88
C === BLOKCALC.89
C BLOKCALC IS CALLED ONCE PER TIMESTEP. IT INITIALIZES VARIOUS === BLOKCALC.90
C QUANTITIES, BOOTSTRAPS THE BASIC ROW BY ROW COMPUTATION === BLOKCALC.91
C OF PROGNOSTIC VARIABLES, MANAGES THE I/O FOR THE LATTER, === BLOKCALC.92
C AND PERFORMS VARIOUS ANALYSIS PROCEDURES ON THE PROGRESSING === BLOKCALC.93
C SOLUTION. === BLOKCALC.94
C === BLOKCALC.95
C======================================================================= BLOKCALC.96
IMPLICIT NONE BLOKCALC.97
C--------------------------------------------------------------------- BLOKCALC.98
C DEFINE GLOBAL DATA BLOKCALC.99
C--------------------------------------------------------------------- BLOKCALC.100
C BLOKCALC.101
C BLOKCALC.102
*CALL TYPSIZE BLOKCALC.103
*CALL OARRYSIZ ORH6F401.36
*CALL TYPD1 BLOKCALC.104
*CALL TYPDUMO BLOKCALC.105
*CALL TYPPTRO BLOKCALC.106
*CALL TYPOINDX PXORDER.1
*CALL TYPOCALL BLOKCALC.107
*CALL UMSCALAR BLOKCALC.108
*CALL C_MDI BLOKCALC.109
C BLOKCALC.110
*CALL COCTROWS BLOKCALC.111
*CALL TYPOC2DG ORH0F400.14
*CALL TYPOC3DG ORH0F400.15
*CALL TYPOSTFL ORH3F405.21
*CALL TYPOCTOT BLOKCALC.112
*CALL CNTLOCN ORH1F305.3548
*CALL OTIMER ORH1F305.3550
ORH1F305.3551
INTEGER ! Sizes for dynamic allocation of ORH6F401.38
& IMT_idr_ARG ! arrays local to this routine ODC1F405.5
&,JMTM1_idr_ARG ! - passed via arg list to avoid ODC1F405.6
&,IMT_IPD_MIX_ARG ! portability problems. ORH6F401.41
&,JMT_IPD_MIX_ARG ORH6F401.42
&,IMT_idr_MIX_ARG ODC1F405.7
&,JMTM1_idr_MIX_ARG ODC1F405.8
&,JMT_idr_MIX_ARG ODC1F405.9
&,IMTIMT_FLT_ARG , NTMIN2_ARG, NBLOCK_ARG, NSLAB_ARG ORH6F401.46
REAL ORH1F305.3552
& AICE(*) ! INOUT Fractional ice conc. ORH1F305.3553
&,HICE(*) ! INOUT Ice depth avgd over grid box ORH1F305.3554
&,HSNOW(*) ! INOUT Snow depth over ORH1F305.3555
! ! ice fraction of grid box. ORH1F305.3556
&,HICE_REF(*) ! IN CLIMATOLOGICAL ice depth. ORH1F305.3557
&,anomiceh(*) ! OUT anomalous seaice heat flux ORH1F305.3558
ORH1F305.3559
REAL ORH1F305.3560
& CARYHEAT(*) ORH1F305.3561
&,FLXTOICE(*) ORH1F305.3562
&,CARYSALT(*) ORH1F305.3563
&,SURFTEMP(*) ORH1F305.3564
&,SURFSAL(*) ORH1F305.3565
&,UCURRENT(IMT_drsa,JMTM1_drsa) ODC1F405.10
&,VCURRENT(IMT_drsa,JMTM1_drsa) ODC1F405.11
&,ISX(IMT_idr,JMTM1_idr) ODC1F405.12
&,ISY(IMT_idr,JMTM1_idr) ODC1F405.13
&,WSX_LEADS(*) ORH1F305.3570
&,WSY_LEADS(*) ORH1F305.3571
&,AICE_UV(IMT_idr_ARG,JMTM1_idr_ARG) ! Ice fract interpolated ODC1F405.14
! ! to UV points. ORH1F305.3573
ORH1F305.3574
REAL ORH1F305.3575
& fluxcorh(*) ORH1F305.3576
&,fluxcorw(*) ORH1F305.3577
ORH1F305.3578
LOGICAL ORH1F305.3579
& NEWICE(*) ORH1F305.3580
&,ICY(*) ORH1F305.3581
ORH1F305.3582
REAL ORH1F305.3583
& DU_ASS_BTRP(*) ! u_component data assimilation increment ORH1F305.3584
&,DV_ASS_BTRP(*) ! v_component data assimilation increment ORH1F305.3585
LOGICAL ORH1F305.3586
& LL_ASS_BTRP ! logical selecting data assimilation ORH1F305.3587
&,LCAL360 OFR8F404.15
C BLOKCALC.158
INTEGER SWNCOL ! first dimension of stash workspace BLOKCALC.159
REAL BLOKCALC.160
& sw201_30(SWNCOL,JMT,KMM1) ! stash workspace for vertical velocity BLOKCALC.161
&,sw202_30(SWNCOL,JMT) ! mixed layer depth BLOKCALC.162
&,sw203_30(SWNCOL,JMT) ! anomalous heat flux BLOKCALC.163
&,sw204_30(SWNCOL,JMT) ! anomalous water flux BLOKCALC.164
&,sw205_30(SWNCOL,JMT) ! anomalous sea ice heat flux BLOKCALC.165
&,sw208_30(SWNCOL,JMT) ! caryheat heat flux (W/m2) BLOKCALC.166
&,mead_diag(*) ! tracer transport (mead) diagnostics BLOKCALC.168
&,sw248_30(*) ! stash workspace for PCO2 ORH1F305.3588
&,sw249_30(*) ! stash workspace for CO2 flux ORH1F305.3589
&,sw250_30(*) ! stash workspace for invasion ORH1F305.3590
&,sw251_30(*) ! stash workspace for evasion ORH1F305.3591
&,sw292_30(*) ! stash workspace for virtual CO2 flux OJP0F404.906
&,sw293_30(*) ! stash workspace for virtual ALK flux OJP0F404.907
LOGICAL BLOKCALC.182
& sf201_30,sf202_30,sf203_30,sf204_30,sf205_30 BLOKCALC.183
&,sf208_30 BLOKCALC.184
&,sf248_30,sf249_30,sf250_30,sf251_30 BLOKCALC.185
&,sf292_30,sf293_30 OJP0F404.908
&,sf285_30 OFRAF404.55
INTEGER ORH1F305.3592
& sirel_mead(*) ORH1F305.3593
&,tracer_xref(*) ORH1F305.3594
ORH1F305.3595
ORH1F305.3605
LOGICAL ORH1F305.3606
& sf_mead(*) ORH1F305.3607
&,Lpl_mead(*) ORH1F305.3608
ORH1F305.3609
C Barotropic acceleration diagnostics ORH1F305.3610
REAL SWZUN(*), SWZVN(*) ORH1F305.3611
LOGICAL SF_ZN(*) ORH1F305.3612
C BLOKCALC.209
real OJG5F401.31
& utot(*),vtot(*) ! Total 3D velocity diagnostics OJG5F401.32
&,Temperature(*) ! actual temperature diagnostic OMB1F404.161
logical OJG5F401.33
& sfutot,sfvtot ! Stash flags for 3D velocity diagnostics OJG5F401.34
&, SFTemp ! Stash flag for temperature diagnostic OMB1F404.162
ORH1F305.3659
REAL ORH1F305.3660
& mldsav(IMT_IPD_MIX_ARG,JMT_IPD_MIX_ARG) ! saved mld values ORH1F305.3661
REAL ATTEND(KM,NT,4) ! Mixing tendencies caused by Med outflow OOM1F403.35
REAL HUDTEND(KM,NT,4) OOM2F405.131
C ORH1F305.3662
C BLOKCALC.260
C--------------------------------------------------------------------- BLOKCALC.261
C DIMENSION AND EQUIVALENCE LOCAL DATA BLOKCALC.262
C--------------------------------------------------------------------- BLOKCALC.263
C BLOKCALC.264
INTEGER I, ! Grid point index (Zonal) BLOKCALC.265
& J, ! Grid point index (Meridional) BLOKCALC.266
& K, ! Grid point index (Vertical) BLOKCALC.267
& L, ! Ocean segment loop control BLOKCALC.268
& M, ! Tracer indicator BLOKCALC.269
& N, ! Control index BLOKCALC.270
& JJ, ! Meridional grid pt index BLOKCALC.271
& LL, ! Loop control for energy components BLOKCALC.272
& IE, ! Adjustable end index used in ZTD calc BLOKCALC.279
& IS ! Adjustable start " " " " " BLOKCALC.280
& ,IM ! length of string to be filtered BLOKCALC.281
& ,II ! Loop counter BLOKCALC.282
& ,ID ! loop index for vorticity diagnostics OMB3F401.136
& ,INFO ! For use in MPP message passing code ORH6F404.514
ORH6F404.515
REAL BLOKCALC.283
& VBR(KM) ! ZONAL SUMMATION OF MERIDIONAL VELOCITY ORH6F404.516
&, TMT(JMT,KM) ! MERIDIONAL MASS TRANSPORT ORH6F404.517
&, DAYSYR ! No of days per year BLOKCALC.287
&, FX ! Temporary value BLOKCALC.290
&, SCL ! Scaling factor for printout BLOKCALC.291
&, TTDAY ! Current day of year BLOKCALC.294
&, TTYEAR ! No. of years of completed integration BLOKCALC.295
&, ENGTMP ! Temporary cumulative energy variable ORH1F305.3663
ORH1F305.3664
REAL ORH1F305.3665
& TTN(8,JMT,NTMIN2_ARG) !NORTWARD TRANSPORT OF TRACERS ORH6F401.70
REAL BLOKCALC.310
& co2_tot ! Total net air-sea flux of CO2 ORH6F404.518
& ,PCO2_ATM ! pp CO2 in atmosphere (ppm) ORH6F404.519
& ,c14to12_atm ! Atmosphere C14/C12 ratio (standard =100) ORH6F404.520
ORH6F404.521
REAL ORH1F305.3667
& ISTRESS_UV(IMT_idr_MIX_ARG,JMTM1_idr_MIX_ARG) ! MAGNITUDE OF ODC1F405.15
! ! ICE-OCEAN BASAL STRESS. ORH1F305.3669
&,ISTRESS(IMT_idr_MIX_ARG,JMT_idr_MIX_ARG) ! ISTRESS_UV ON ODC1F405.16
! ! TRACER POINTS ORH1F305.3671
&,PSI ! CONSTANT TURNING ANGLE UNDER ICE. ORH1F305.3672
&,CDRAG_ICE ! CONSTANT ICE-OCEAN DRAG COEFFICIENT. ORH1F305.3673
ORH6F404.522
REAL BLOKCALC.329
& ENGINT(8) ! Internal energy components BLOKCALC.330
&,ENGEXT(8) ! External energy components BLOKCALC.331
&,DTABS(NT) ! Absolute change in tracers BLOKCALC.332
&,TVAR(NT) ! Variance of tracer change BLOKCALC.333
&,TTDTOT(6,NT) ! Integral diagnostics of tracers BLOKCALC.334
C BLOKCALC.335
C BLOKCALC.336
C-------------------------------------------------------------------- BLOKCALC.337
CL Variables required for parallel processing BLOKCALC.338
C-------------------------------------------------------------------- BLOKCALC.339
C BLOKCALC.340
INTEGER BLOKCALC.341
& IBLOCK ! Index over number of blocks of rows BLOKCALC.342
&, JROWS ! Number of rows per block BLOKCALC.345
&, JIND ! Index over J. Dependent on symmetry conditions BLOKCALC.346
C BLOKCALC.347
CL Define arrays holding block by block sub-totals BLOKCALC.348
C BLOKCALC.349
REAL BLOCK_ENGINT (8,NBLOCK_ARG) ! ENGINT(1:8) sub total ORH6F401.47
&, BLOCK_DTABS (NT,NBLOCK_ARG) ! TVAR(1:NT) sub total ORH6F401.48
&, BLOCK_TVAR (NT,NBLOCK_ARG) ! TVAR(1:NT) sub total ORH6F401.49
&, BLOCK_TTDTOT (6,NT,NBLOCK_ARG) ! TTDTOT(8,NT) sub total ORH6F401.50
&, BLOCK_BUOY (NBLOCK_ARG) ! BUOY sub total ORH6F401.51
&, BLOCK_EKTOT (NBLOCK_ARG) ! EKTOT sub total ORH6F401.52
&, BLOCK_CO2_TOT(NBLOCK_ARG) ! CO2_TOT sub total ORH6F401.53
C BLOKCALC.359
C-------------------------------------------------------------------- BLOKCALC.360
C Define variables used to allocate contiguous work space for BLOKCALC.361
C heavily used areas. BLOKCALC.362
C-------------------------------------------------------------------- BLOKCALC.363
C BLOKCALC.364
REAL BLOKCALC.365
& TA(NSLAB_ARG) ! slabs of ocean primary variables ORH6F401.54
&,TBP(NSLAB_ARG) ! suffixes: ORH6F401.55
&,TP(NSLAB_ARG) ! A: timestep after present ORH6F401.56
&,TB(NSLAB_ARG) ! B: timestep before present ORH6F401.57
&,T(NSLAB_ARG) ! M: row J-1 ORH6F401.58
&,TBM(NSLAB_ARG) ! P: row J+1 ORH6F401.59
&,TM(NSLAB_ARG) ! F: time filtering ORH6F401.60
&,TF(NSLAB_ARG) ! ORH6F401.61
&,TPP(NSLAB_ARG) ! PP: row j+2 OOM3F405.275
&,TBPP(NSLAB_ARG) ! OOM3F405.276
&,TPPZ(NSLAB_ARG) ! Initial values for TPP at JFIN+2 OOM3F405.277
&,TBPPZ(NSLAB_ARG) ! Initial values for TBPP at JFIN+2 OOM3F405.278
&,UDIF(IMT+KM*IMT+IMT) BLOKCALC.374
&,VDIF(IMT+KM*IMT+IMT) BLOKCALC.375
&,TPZ (NSLAB_ARG) ! Initial values for TP at JFIN+1 ORH6F401.68
&,TBPZ(NSLAB_ARG) ! Initial values for TBP at JFIN+1 ORH6F401.69
C BLOKCALC.384
INTEGER BLOKCALC.385
& index_u ! pointer to UA,UBP,UP,UB,U,UBM,UM,UF BLOKCALC.386
&,index_v ! pointer to VA,VBP,VP,VB,V,VBM,VM,VF BLOKCALC.387
&,index_over ! pointer to UOVER,VOVER BLOKCALC.388
&,index_udif ! pointer to UDIF,VDIF BLOKCALC.389
&,index_under ! pointer to UUNDER,VUNDER BLOKCALC.390
C BLOKCALC.391
REAL FTARR(IMTIMT_FLT_ARG) ! COEF USED IN FILTERING ROUTINE ORH1F305.3674
C local variables for the inflow/outflow into the Mediterranean and OOM2F405.325
C Hudson Bay OOM2F405.326
INTEGER imsend(4),jmsend(4),J_PE_IND_OUT(4) OOM2F405.327
INTEGER lev_top,lev_bot,medorhud OOM2F405.328
LOGICAL inflow_top ! true if inflow to marginal sea is at OOM2F405.329
C ! surface, otherwise false OOM2F405.330
REAL TENDIN(km,nt,4) OOM2F405.331
OOM2F405.332
C BLOKCALC.395
C BLOKCALC.396
C*-------------------------------------------------------------------- BLOKCALC.397
C BEGIN EXECUTABLE CODE BLOKCALC.398
C--------------------------------------------------------------------- BLOKCALC.399
C BLOKCALC.400
EXTERNAL BLOKCNTL BLOKCALC.401
&, MATRIX BLOKCALC.403
C BLOKCALC.404
IF (L_OTIMER) CALL TIMER('BLOKCALC ',3) ORH1F305.3675
C BLOKCALC.408
NERGY = 0 BLOKCALC.409
IF (MOD(ITT,NNERGY).EQ.0) NERGY=1 BLOKCALC.410
C BLOKCALC.411
! Initialise sub totals ORH6F404.523
IF (NERGY.EQ.1) THEN BLOKCALC.412
DO M=1,NT ORH2F305.15
DO LL = 1,6 ORH2F305.16
TTDTOT(LL,M)=0.0 ORH2F305.17
ENDDO ! Over LL ORH2F305.18
ENDDO ! Over M ORH2F305.19
DO LL=1,8 BLOKCALC.413
ENGINT(LL) = 0.0 ORH2F305.20
ENGEXT(LL) = 0.0 BLOKCALC.414
END DO BLOKCALC.415
ENDIF ORH2F305.43
ORH6F404.524
DO N=1,NBLOCK ORH6F404.525
BLOCK_BUOY(N)=0.0 ORH6F404.526
DO M=1,NT ORH6F404.527
DO LL=1,6 ORH6F404.528
BLOCK_TTDTOT(LL,M,N)=0.0 ORH6F404.529
END DO BLOKCALC.422
END DO BLOKCALC.423
END DO ORH6F404.530
C BLOKCALC.424
C BLOKCALC.426
! Ensure variables initialised for all model configurations ORH0F401.42
PCO2_ATM = 0.0 ORH0F401.43
c14to12_atm = 0.0 ORH0F401.44
ORH6F404.531
IF (L_OCARBON) THEN ORH1F305.3676
C Initialise atmospheric CO2 variables BLOKCALC.428
! If full carbon-cycle running, surface CO2 is fed in from the OCN1F405.1
! dump. Otherwise, initial values are read in from NAMELIST, OCN1F405.2
! and assumed to be temporally and spatially constant. OCN1F405.3
OCN1F405.4
C BLOKCALC.435
PCO2_ATM = pco2_atm_0 BLOKCALC.436
IF (L_OCARB14) c14to12_atm = c14to12_atm_0 ORH0F401.46
ENDIF ORH1F305.3682
ORH6F404.532
do ii=1,4 ORH6F404.533
do m=1,nt ORH6F404.534
do k=1,km ORH6F404.535
attend(k,m,ii)=0. ORH6F404.536
hudtend(k,m,ii)=0. OOM2F405.333
tendin(k,m,ii)=0. OOM2F405.334
OOM2F405.335
enddo ORH6F404.537
enddo OOM1F403.40
enddo ORH6F404.538
ORH6F404.539
IF (L_OMEDOUT) THEN ORH6F404.540
C OOM1F403.44
C No need to call MED_OUTFLOW if rows on this processor not involved OOM1F403.45
C Always need to call if not on MPP machine OOM1F403.46
C OOM1F403.47
C Do Mediterranean outflow calculations OOM2F405.336
do i=1,4 OOM2F405.337
imsend(i)=imout(i) OOM2F405.338
jmsend(i)=jmout(i) OOM2F405.339
J_PE_IND_OUT(i)=J_PE_IND_MED(i) OOM2F405.340
enddo OOM2F405.341
lev_top=med_topflow OOM2F405.342
lev_bot=lev_med OOM2F405.343
inflow_top=.true. OOM2F405.344
C variable to define if dealing with Mediterranean or Hudson Bay OOM2F405.345
medorhud=1 OOM2F405.346
OOM2F405.347
C need to include all the variables which are being changed in the OOM2F405.348
C argument list, else they will not be communicated as desired. OOM2F405.349
OOM2F405.350
CALL MED_CALC( OOM2F405.351
*CALL ARGSIZE OOM2F405.352
*CALL ARGD1 OOM2F405.353
*CALL ARGDUMO OOM2F405.354
*CALL ARGPTRO OOM2F405.355
*CALL ARGOCALL OOM2F405.356
*CALL ARGOINDX OOM2F405.357
& NSLAB_ARG OOM2F405.358
& ,TENDIN,ATTEND,HUDTEND OOM2F405.359
& ,tendfrc,imsend,jmsend,lev_top,lev_bot,inflow_top OOM2F405.360
&,L_OMEDADV,J_PE_IND_OUT,medorhud OOM2F405.361
& ) OOM2F405.362
C OOM2F405.363
C OOM1F403.58
ENDIF ! Med outflow true ORH6F404.542
IF (L_OHUDOUT) THEN OOM2F405.364
C Do Hudson Bay outflow calculations OOM2F405.365
do i=1,4 OOM2F405.366
imsend(i)=imout_hud(i) OOM2F405.367
jmsend(i)=jmout_hud(i) OOM2F405.368
J_PE_IND_OUT(i)=J_PE_IND_HUD(i) OOM2F405.369
enddo OOM2F405.370
lev_top=lev_hud-1 OOM2F405.371
lev_bot=lev_hud OOM2F405.372
inflow_top=.false. OOM2F405.373
medorhud=2 OOM2F405.374
OOM2F405.375
CALL MED_CALC( OOM2F405.376
*CALL ARGSIZE OOM2F405.377
*CALL ARGD1 OOM2F405.378
*CALL ARGDUMO OOM2F405.379
*CALL ARGPTRO OOM2F405.380
*CALL ARGOCALL OOM2F405.381
*CALL ARGOINDX OOM2F405.382
& NSLAB_ARG OOM2F405.383
& ,TENDIN,ATTEND,HUDTEND OOM2F405.384
& ,tendfrc,imsend,jmsend,lev_top,lev_bot,inflow_top OOM2F405.385
&,L_OMEDADV,J_PE_IND_OUT,medorhud OOM2F405.386
& ) OOM2F405.387
ENDIF ! L_OHUDOUT OOM2F405.388
OOM2F405.389
C BLOKCALC.441
C======================================================================= BLOKCALC.442
C BEGIN SECTION FOR THE INITIALIZATION OF ============================ BLOKCALC.443
C VARIOUS QUANTITIES ON EACH TIMESTEP ============================ BLOKCALC.444
C======================================================================= BLOKCALC.445
C BLOKCALC.446
IF (L_ICEFREEDR) THEN ODC1F405.17
C--------------------------------------------------------------------- BLOKCALC.448
C Interpolate sea ice fraction to UV points for dynamic sea ice model BLOKCALC.449
C--------------------------------------------------------------------- BLOKCALC.450
C BLOKCALC.451
PSI = 0.4363 ORH6F404.543
CDRAG_ICE = 0.0055 ORH6F404.544
CALL H_TO_UV( ORH6F404.545
*CALL ARGOINDX ORH7F402.269
& AICE,AICE_UV,IMT,JMT,JMTM1) ORH6F404.546
ORH6F404.547
IF (L_OMIXLAY) THEN ORH6F404.548
DO J = J_1, J_JMTM1 ORH6F404.549
DO I=1,IMT ORH6F404.550
ISTRESS_UV(I,J) = SQRT (ISX(I,J)**2 + ISY(I,J)**2) ORH6F404.551
END DO ORH6F404.552
END DO ORH6F404.553
CALL UV_TO_H( ORH6F404.554
*CALL ARGOINDX ORH7F402.272
& ISTRESS_UV,ISTRESS,IMT,JMT,JMTM1) ORH6F404.555
ENDIF ORH6F404.556
ORH6F404.557
ENDIF ORH1F305.3686
C BLOKCALC.465
IF (L_ICESIMPLE.OR.L_ICEFREEDR) THEN ODC1F405.18
DO I=1,IMT ORH6F404.558
*IF DEF,MPP ORH3F402.2
IF (JST.LE.1.AND.JFIN.GE.1) THEN ORH3F402.3
UCURRENT(I,J_1) = 0.0 ORH3F402.4
VCURRENT(I,J_1) = 0.0 ORH3F402.5
ENDIF ORH3F402.6
IF (JST.LE.2.AND.JFIN.GE.2) THEN ORH3F402.7
UCURRENT(I,J_2) = 0.0 ORH3F402.8
VCURRENT(I,J_2) = 0.0 ORH3F402.9
ENDIF ORH3F402.10
IF (JST.LE.JMTM1_GLOBAL.AND.JFIN.GE.JMTM1_GLOBAL) THEN ORH3F402.11
UCURRENT(I,J_JMTM1) = 0.0 ORH3F402.12
VCURRENT(I,J_JMTM1) = 0.0 ORH3F402.13
ENDIF ORH3F402.14
*ELSE ORH3F402.15
UCURRENT(I,1) = 0.0 ORH6F404.559
VCURRENT(I,1) = 0.0 ORH6F404.560
UCURRENT(I,2) = 0.0 ORH6F404.561
VCURRENT(I,2) = 0.0 ORH6F404.562
UCURRENT(I,JMTM1) = 0.0 ORH6F404.563
VCURRENT(I,JMTM1) = 0.0 ORH6F404.564
*ENDIF ORH3F402.16
ENDDO ORH6F404.565
ENDIF ORH1F305.3688
C BLOKCALC.479
C BLOKCALC.517
C--------------------------------------------------------- BLOKCALC.518
C Initialise variables used in allocation of workspace BLOKCALC.519
C--------------------------------------------------------- BLOKCALC.520
index_u=IMT*KM*NT+1 BLOKCALC.521
index_v=IMT*KM*(NT+1)+1 BLOKCALC.522
index_over=1 BLOKCALC.523
index_udif=IMT+1 BLOKCALC.524
index_under=IMT+IMT*KM+1 BLOKCALC.525
C BLOKCALC.526
C BLOKCALC.527
C BLOKCALC.538
C BLOKCALC.539
BLOKCALC.540
IF (L_OISOPYC.AND.L_OMIXLAY) THEN ORH1F305.3718
DO I=1,IMT ORH6F404.567
DO J = J_1, J_JMT ORH6F404.568
mldsav(I,J) = mld(I,J) ORH6F404.569
ENDDO ! Over J ORH6F404.570
ENDDO ! Over I ORH6F404.571
*IF DEF,MPP ORH6F404.572
! Ensure MLDSAV halos are populated ready for ORH6F404.573
! use in CALCESAV. ORH6F404.574
CALL SWAPBOUNDS(MLDSAV,IMT,JMT,O_EW_HALO,O_NS_HALO,1) ORH6F404.575
*ENDIF ORH6F404.576
ENDIF ORH1F305.3719
BLOKCALC.548
C BLOKCALC.549
C======================================================================= BLOKCALC.550
C END OF SECTION FOR INITIALIZATION ================================== BLOKCALC.551
C======================================================================= BLOKCALC.552
C BLOKCALC.553
CL Work out the number of rows per parallel block. BLOKCALC.554
CL (this will be made dynamically adjustable at some stage) BLOKCALC.555
C BLOKCALC.556
C BLOKCALC.557
IF (MOD(JMTM1,NBLOCK).EQ.0) THEN BLOKCALC.558
JROWS=3+((INT(JMTM1-(NBLOCK*3))/NBLOCK)) ORH2F305.21
ELSE BLOKCALC.560
JROWS=4+((INT(JMTM1-(NBLOCK*3))/NBLOCK)) ORH2F305.22
END IF BLOKCALC.562
C---------------------------------------------------------------------- BLOKCALC.563
C We must obtain certain information from southern/northern BLOKCALC.564
C boundaries before starting the main computation since BLOKCALC.565
C once computation has started this information may be BLOKCALC.566
C altered by another processor working on the adjacent BLOKCALC.567
C rows. BLOKCALC.568
C---------------------------------------------------------------------- BLOKCALC.569
CALL INITTRAC ( ORH9F402.40
*CALL ARGSIZE ORH9F402.41
*CALL ARGD1 ORH9F402.42
*CALL ARGDUMO ORH9F402.43
*CALL ARGPTRO ORH9F402.44
*CALL ARGOINDX ORH9F402.45
& LABS,NDISKB,NDISK,NDISKA,FKMP,FKMQ ORH9F402.46
& , T,TB,TM,TBM,TPZ,TBPZ ORH4F405.1
&, TPPZ, TBPPZ, L_OBIMOM, L_OBIHARMGM OOM3F405.279
& , NBLOCK,JROWS ORH9F402.48
& ) ORH9F402.49
*IF -DEF,MPP ORH9F402.50
C******************************************************************* BLOKCALC.648
CL P A R A L L E L P R O C E S S I N G B E G I N S BLOKCALC.649
C******************************************************************* BLOKCALC.650
C BLOKCALC.651
CL Split computation into blocks of size JROWS, except the 1st block BLOKCALC.652
CL which must have at least 3 rows and therefore contains JROWS+1 BLOKCALC.653
CL rows. BLOKCALC.654
CFPP$ SELECT (CONCUR) ORH2F305.28
CFPP$ CNCALL L ORH2F305.29
CFPP$ PRIVATEARRAY L ORH2F305.30
DO IBLOCK=1,NBLOCK+1 ORH2F305.31
! ORH2F305.32
! The number of loops executed in parrallel = loop count -1 ORH2F305.33
! WE NEED NBLOCK. TO ACHEIVE THIS, THE LOOP CONTROL ORH2F305.34
! VARIABLE IS SET TO NBLOCK + 1, but no action is taken ORH2F305.35
! on the last iteration. ORH2F305.36
! ORH2F305.37
IF (IBLOCK.LT.NBLOCK+1) THEN ORH2F305.38
! ORH2F305.39
JIND=3+((IBLOCK-1)*JROWS) ORH2F305.40
C BLOKCALC.657
C Set the starting value for control of the J loop BLOKCALC.658
C BLOKCALC.659
IF(JIND.EQ.3) THEN BLOKCALC.660
JST=1 BLOKCALC.661
ELSE BLOKCALC.662
JST=JIND BLOKCALC.663
ENDIF BLOKCALC.664
C BLOKCALC.665
JFIN=MIN(JIND+JROWS-1,JMTM1) BLOKCALC.666
C BLOKCALC.667
*ELSE ORH9F402.51
! For MPP configuration, JST and JFIN are computed during ORH9F402.52
! original domain decomposition. ORH9F402.53
IBLOCK=1 ORH9F402.54
*ENDIF ORH9F402.55
C BLOKCALC.669
N=IMT*2+IMT*KM BLOKCALC.670
BLOKCALC.671
DO I=1,N BLOKCALC.672
UDIF(I)=0.0 BLOKCALC.673
VDIF(I)=0.0 BLOKCALC.674
ENDDO ! Over I BLOKCALC.675
BLOKCALC.676
DO N = 1, NSLAB BLOKCALC.677
TA(N)=0.0 BLOKCALC.678
TBP(N)=0.0 BLOKCALC.679
TP(N)=0.0 BLOKCALC.680
TF(N)=0.0 BLOKCALC.681
ENDDO ! Over N BLOKCALC.688
IF (L_OBIMOM.or.L_OBIHARMGM) THEN OOM3F405.280
DO N = 1, NSLAB OOM3F405.281
TPP(N)= 0.0 OOM3F405.282
TBPP(N)= 0.0 OOM3F405.283
ENDDO OOM3F405.284
ENDIF ! L_OBIMOM.or.L_OBIHARMG OOM3F405.285
C BLOKCALC.689
C--------------------------------------------------------------------- BLOKCALC.690
C Call the main row by row calculations in BLOCKS OF ROWS BLOKCALC.691
C--------------------------------------------------------------------- BLOKCALC.692
C BLOKCALC.693
CALL BLOKCNTL ( ORH6F404.577
*CALL ARGSIZE BLOKCALC.695
*CALL ARGD1 BLOKCALC.696
*CALL ARGDUMO BLOKCALC.697
*CALL ARGPTRO BLOKCALC.698
*CALL ARGOCALL BLOKCALC.699
*CALL ARGOINDX ORH7F402.274
*CALL COCAROWS BLOKCALC.700
*CALL ARGOC2DG ORH0F400.16
*CALL ARGOC3DG ORH0F400.17
*CALL ARGOSTFL ORH3F405.23
&,SWNCOL,sw201_30,sw202_30,sw203_30,sw204_30,sw205_30 BLOKCALC.701
&,sw208_30 BLOKCALC.702
&,sw248_30,sw249_30,sw250_30,sw251_30 BLOKCALC.703
&,sw292_30,sw293_30 OJP0F404.909
&,sf201_30,sf202_30,sf203_30,sf204_30,sf205_30 BLOKCALC.704
&,sf208_30 BLOKCALC.705
&,sf248_30,sf249_30,sf250_30,sf251_30 BLOKCALC.706
&,sf292_30,sf293_30 OJP0F404.910
OJP0F404.911
&,sf285_30 OFRAF404.56
&,mead_diag,sirel_mead,sf_mead,Lpl_mead,tracer_xref BLOKCALC.708
&,SWZUN,SWZVN,SF_ZN BLOKCALC.713
&,utot,vtot,sfutot,sfvtot,Temperature,SFTemp OMB1F404.163
&,AICE, HICE, HSNOW, HICE_REF, CARYHEAT, ICY, FLXTOICE ORH5F401.6
&,CARYSALT, anomiceh, fluxcorh, fluxcorw ORH5F401.7
&,ISX, ISY, WSX_LEADS, WSY_LEADS ORH5F401.8
&,LL_ASS_BTRP, DU_ASS_BTRP, DV_ASS_BTRP ORH5F401.9
&,SURFTEMP, SURFSAL, NEWICE, UCURRENT, VCURRENT ORH5F401.10
&,TTN, ISTRESS, ISTRESS_UV, TMT ORH0F405.1
C BLOKCALC.764
C The following arguments are specific to the current block. BLOKCALC.765
C BLOKCALC.766
&,BLOCK_BUOY(IBLOCK), BLOCK_EKTOT(IBLOCK), BLOCK_ENGINT(1,IBLOCK) BLOKCALC.767
&,BLOCK_DTABS(1,IBLOCK),BLOCK_TVAR(1,IBLOCK) BLOKCALC.768
&,BLOCK_TTDTOT(1,1,IBLOCK), BLOCK_CO2_TOT(IBLOCK) ORH5F401.12
&,PCO2_ATM, c14to12_atm ORH5F401.13
&,TA(1),TA(index_u),TA(index_v),TBP(1),TBP(index_u),TBP(index_v) BLOKCALC.777
&,TP(1),TP(index_u),TP(index_v) BLOKCALC.778
&,TB (1),TB (index_u),TB (index_v) BLOKCALC.779
&,T (1),T (index_u),T (index_v) BLOKCALC.780
&,TBM(1),TBM(index_u),TBM(index_v) BLOKCALC.781
&,TM(1),TM(index_u),TM(index_v) BLOKCALC.782
&,TF(1),TF(index_u),TF(index_v) BLOKCALC.783
&,UDIF(index_over),UDIF(index_udif),UDIF(index_under) BLOKCALC.784
&,VDIF(index_over),VDIF(index_udif),VDIF(index_under) BLOKCALC.785
&,TPZ(1),TPZ(index_u),TPZ(index_v) BLOKCALC.786
&,TBPZ(1),TBPZ(index_u),TBPZ(index_v) BLOKCALC.787
&,TPP(1),TPP(index_u),TPP(index_v) OOM3F405.286
&,TBPP(1),TBPP(index_u),TBPP(index_v) OOM3F405.287
&,TPPZ(1),TPPZ(index_u),TPPZ(index_v) OOM3F405.288
&,TBPPZ(1),TBPPZ(index_u),TBPPZ(index_v) OOM3F405.289
&,mldsav,FTARR ORH1F405.463
&,IMT_IPD,KM_IPD,KMP1_IPD,NT_IPD ORH1F305.3721
&,IMT_GM,KM_GM OLA0F401.92
&,ATTEND,HUDTEND OOM2F405.132
OOM2F405.133
& ) ORH7F402.309
C BLOKCALC.792
*IF -DEF,MPP ORH9F402.56
ENDIF ! For IBLOCK > 0 ORH2F305.41
END DO ! Over IBLOCK ORH2F305.42
*ENDIF ORH9F402.57
C BLOKCALC.794
C******************************************************************* BLOKCALC.795
CL P A R A L L E L P R O C E S S I N G E N D S BLOKCALC.796
C******************************************************************* BLOKCALC.797
C BLOKCALC.798
C NOW PERFORM ZTD CALCULATIONS FORMERLY DONE AT A LOWER LEVEL BLOKCALC.799
C BLOKCALC.800
BLOKCALC.801
IF (.NOT.(L_OSYMM)) THEN ORH1F305.3722
JIND=J_JMTM2 ORH3F402.18
ELSE ORH1F305.3723
JIND=J_JMTM1 ORH3F402.19
ENDIF ORH1F305.3724
ORH4F402.40
*IF DEF,MPP ORH4F402.41
C ORH4F402.42
C===================================================================== ORH4F402.43
C CALL TO SWAPBOUNDS FOR HALO UPDATE IN MPP VERSION ORH4F402.44
C===================================================================== ORH4F402.45
ORH4F402.46
CALL SWAPBOUNDS(ZU,IMT,JMT,O_EW_HALO,O_NS_HALO,1) ORH4F402.47
ORH4F402.48
CALL SWAPBOUNDS(ZV,IMT,JMT,O_EW_HALO,O_NS_HALO,1) ORH4F402.49
ORH4F402.50
IF ( L_OZVRT ) THEN OMB2F404.8
CALL SWAPBOUNDS(ZCONU,IMT,JMT,O_EW_HALO,O_NS_HALO,N_ZVRT) OMB2F404.9
CALL SWAPBOUNDS(ZCONV,IMT,JMT,O_EW_HALO,O_NS_HALO,N_ZVRT) OMB2F404.10
END IF ! L_OZVRT OMB2F404.11
*ENDIF ORH4F402.51
ORH4F402.52
IF ((.NOT.L_ONOCLIN).AND.(.NOT.L_OFREESFC)) THEN ORL1F404.769
C--------------------------------------------------------------------- BLOKCALC.815
C FORM CURL OF TIME CHANGE IN VERTICALLY AVERAGED EQUATIONS BLOKCALC.816
C--------------------------------------------------------------------- BLOKCALC.817
C Initialise SWZVRT (it is awkward to do this in BLOKINIT OMB3F401.138
C where ZTD is initialised). OMB3F401.139
OMB3F401.140
IF ( L_OZVRT ) THEN ORH6F404.578
DO ID = 1, N_ZVRT ORH6F404.579
DO J=J_1,J_JMT ORH6F404.580
DO I=1,IMT ORH6F404.581
SWZVRT(I,J,ID)=0.0 ORH6F404.582
ENDDO ! I ORH6F404.583
ENDDO ! J ORH6F404.584
ENDDO ! ID ORH6F404.585
ENDIF ! L_OZVRT ORH6F404.586
OMB3F401.153
DO 621 J = J_2, JIND ORH6F404.587
C OMB3F401.155
IF (.NOT.L_OISLANDS) THEN ORH6F404.588
C NON-ACTIVE VORTICITY PTS. ARE KEPT AT ZERO FOR CONVENIENCE IN RELAX. BLOKCALC.821
C TO ACCOMPLISH THIS, ZTD IS COMPUTED ONLY BETWEEN GIVEN STARTING AND BLOKCALC.822
C ENDING INDICES. BLOKCALC.823
C BLOKCALC.824
DO 620 L=1,LSEG ORH6F404.589
IS=ISZ(J,L) ORH6F404.590
IF(IS.EQ.0) GO TO 621 ORH6F404.591
IE=IEZ(J,L) ORH6F404.592
DO 620 I=IS,IE ORH6F404.593
ZTD(I,J)=((ZU(I,J)*DXU(I)+ZU(I-1,J)*DXU(I-1))*CS(J ) ORH6F404.594
& -(ZU(I,J-1)*DXU(I)+ZU(I-1,J-1)*DXU(I-1))*CS(J-1)) BLOKCALC.841
ZTD(I,J)=(((ZV(I,J)-ZV(I-1,J))*DYU(J ) ORH6F404.595
& +(ZV(I,J-1)-ZV(I-1,J-1))*DYU(J-1) BLOKCALC.843
& -ZTD(I,J))*DXT2R(I)*DYTR(J))*CSTR(J) BLOKCALC.844
620 CONTINUE ORH6F404.596
ORH6F404.597
C calculate vorticity contributions for diagnostics OMB3F401.156
ORH6F404.598
IF ( L_OZVRT ) THEN ORH6F404.599
DO ID = 1, N_ZVRT ORH6F404.600
DO I=IS,IE ORH6F404.601
SWZVRT(I,J,ID)= ORH6F404.602
& ((ZCONU(I,J,ID)*DXU(I)+ZCONU(I-1,J,ID)*DXU(I-1))*CS(J ) OMB3F401.161
& -(ZCONU(I,J-1,ID)*DXU(I)+ZCONU(I-1,J-1,ID)*DXU(I-1))*CS(J-1)) OMB3F401.162
OMB3F401.163
SWZVRT(I,J,ID)=(((ZCONV(I,J,ID)-ZCONV(I-1,J,ID))*DYU(J ) OMB3F401.164
& +(ZCONV(I,J-1,ID)-ZCONV(I-1,J-1,ID))*DYU(J-1) OMB3F401.165
& -SWZVRT(I,J,ID))*DXT2R(I)*DYTR(J))*CSTR(J) OMB3F401.166
ENDDO ! IS ORH6F404.603
ENDDO ! ID ORH6F404.604
ENDIF ! L_OZVRT ORH6F404.605
ELSE ORH6F404.606
C ALL VORTICITY PTS. ARE COMPUTED SO THAT THOSE NEEDED FOR THE LINE ORH1F305.3728
C INTEGRAL OF HOLE RELAXATION (IMMEDIATELY ADJACENT TO ISLANDS) WILL ORH1F305.3729
C BE DEFINED. ORH1F305.3730
IS=2 ORH6F404.607
IE=IMTM1 ORH6F404.608
DO 622 I=IS,IE ORH6F404.609
ZTD(I,J)=((ZU(I,J)*DXU(I)+ZU(I-1,J)*DXU(I-1))*CS(J ) ORH6F404.610
& -(ZU(I,J-1)*DXU(I)+ZU(I-1,J-1)*DXU(I-1))*CS(J-1)) ORH1F305.3735
ZTD(I,J)=(((ZV(I,J)-ZV(I-1,J))*DYU(J ) ORH6F404.611
& +(ZV(I,J-1)-ZV(I-1,J-1))*DYU(J-1) ORH1F305.3737
& -ZTD(I,J))*DXT2R(I)*DYTR(J))*CSTR(J) ORH1F305.3738
622 CONTINUE ORH6F404.612
C calculate vorticity contributions for diagnostics OMB3F401.170
IF ( L_OZVRT ) THEN ORH6F404.613
DO ID = 1, N_ZVRT ORH6F404.614
DO I=IS,IE ORH6F404.615
SWZVRT(I,J,ID)= ORH6F404.616
& ((ZCONU(I,J,ID)*DXU(I)+ZCONU(I-1,J,ID)*DXU(I-1))*CS(J ) OMB3F401.175
& -(ZCONU(I,J-1,ID)*DXU(I)+ZCONU(I-1,J-1,ID)*DXU(I-1))*CS(J-1)) OMB3F401.176
OMB3F401.177
SWZVRT(I,J,ID)=(((ZCONV(I,J,ID)-ZCONV(I-1,J,ID))*DYU(J ) OMB3F401.178
& +(ZCONV(I,J-1,ID)-ZCONV(I-1,J-1,ID))*DYU(J-1) OMB3F401.179
& -SWZVRT(I,J,ID))*DXT2R(I)*DYTR(J))*CSTR(J) OMB3F401.180
ENDDO ! IS ORH6F404.617
ENDDO ! ID ORH6F404.618
ENDIF ! L_OZVRT ORH6F404.619
ENDIF ! L_OISLANDS = true ORH6F404.620
ORH6F404.621
621 CONTINUE ORH6F404.622
ORH6F404.623
C OMB3F401.186
C set vorticity diagnostics for cyclic and symmetric boundary conditions OMB3F401.187
C OMB3F401.188
IF ( L_OZVRT ) THEN ORH6F404.624
C Set cyclic boundary values for SWZVRT OMB3F401.190
IF ( L_OCYCLIC ) THEN ORH6F404.625
DO ID = 1,N_ZVRT ORH6F404.626
DO J=J_1,J_JMT ORH6F404.627
SWZVRT(1,J,ID) = SWZVRT(IMTM1,J,ID) ORH6F404.628
SWZVRT(IMT,J,ID) = SWZVRT(2,J,ID) ORH6F404.629
END DO ! J ORH6F404.630
END DO ! ID ORH6F404.631
END IF ! L_OCYCLIC ORH6F404.632
OMB3F401.199
C Set symmetric boundary conditions for SWZVRT OMB3F401.200
IF ( L_OSYMM ) THEN ORH6F404.633
DO ID = 1, N_ZVRT ORH6F404.634
DO I=1,IMT ORH6F404.635
SWZVRT(I,JMT,ID)= - SWZVRT(I,JMTM1,ID) ORH6F404.636
END DO ORH6F404.637
END DO ORH6F404.638
END IF ! L_OSYMM ORH6F404.639
*IF DEF,MPP OMB2F404.12
CALL SWAPBOUNDS(SWZVRT,IMT,JMT,O_EW_HALO,O_NS_HALO,N_ZVRT) OMB2F404.13
*ENDIF OMB2F404.14
OMB2F404.15
C BLOKCALC.847
END IF ! L_OZVRT ORH6F404.640
C--------------------------------------------------------------------- BLOKCALC.848
C DO ANALYSIS OF EXTERNAL MODE FORCING ON ENERGY TIMESTEP BLOKCALC.849
C--------------------------------------------------------------------- BLOKCALC.850
C BLOKCALC.851
DO J = J_2, JIND ORH6F404.641
IF(NERGY.EQ.1) THEN ORH6F404.642
DO 630 LL=2,8 ORH6F404.643
IF (L_OSYMM) THEN ORH6F404.644
IF(J + J_OFFSET.EQ.JMTM1_GLOBAL) THEN ORH6F404.645
DO I=1,IMT ORH6F404.646
ZVENG(I,LL,J)=0.0 ORH6F404.647
ENDDO ORH6F404.648
ENDIF ORH6F404.649
ENDIF ORH6F404.650
ORH6F404.651
DO 630 I=2,IMTM1 ORH6F404.652
ENGEXT(LL)=ENGEXT(LL) ORH6F404.653
& -P(I,J)*(((ZVENG(I,LL,J) -ZVENG(I-1,LL,J ))*DYU(J) BLOKCALC.866
& +(ZVENG(I,LL,J-1)-ZVENG(I-1,LL,J-1))*DYU(J-1)) BLOKCALC.867
& *DXT2R(I)*DYTR(J) BLOKCALC.868
& -((ZUENG(I,LL,J) *DXU(I)+ZUENG(I-1,LL,J) *DXU(I-1))*CS(J) BLOKCALC.869
& -(ZUENG(I,LL,J-1)*DXU(I)+ZUENG(I-1,LL,J-1)*DXU(I-1))*CS(J-1)) BLOKCALC.870
& *DYT2R(J)*DXTR(I))*DXT(I)*DYT(J) BLOKCALC.871
630 CONTINUE ORH6F404.654
ORH6F404.655
FX=CST(J)*DYT(J)/C2DTSF ORH6F404.656
ENGTMP=0. ORH6F404.657
ORH6F404.658
DO I=2,IMTM1 ORH6F404.659
ENGTMP =ENGTMP -P(I,J)*ZTD(I,J)*FX*DXT(I) ORH6F404.660
ENDDO ORH6F404.661
ENGEXT(1)=ENGEXT(1)+ENGTMP ORH6F404.662
ENDIF ORH6F404.663
C BLOKCALC.880
C======================================================================= BLOKCALC.881
C END COMPUTATION OF VORTICITY ======================================= BLOKCALC.882
C======================================================================= BLOKCALC.883
C BLOKCALC.884
IF (L_OFILTER) THEN ORH6F404.664
C--------------------------------------------------------------------- BLOKCALC.888
C FOURIER FILTER ZTD AT HIGH LATITUDES BLOKCALC.889
C--------------------------------------------------------------------- BLOKCALC.890
C BLOKCALC.891
IF(J+J_OFFSET.EQ.JFU2) GO TO 840 ORH6F404.665
ORH1F305.3749
IF ((J+J_OFFSET.GT.JFU1.AND.J+J_OFFSET.LT.JFU2) ORH6F404.666
& .OR.J+J_OFFSET.LT.JFRST) GO TO 840 ORH6F404.667
JJ=J+J_OFFSET-JFRST+1 ORH6F404.668
IF (J+J_OFFSET.GE.JFU2) JJ=JJ-JSKPU+1 ORH6F404.669
BLOKCALC.898
DO 830 L=1,LSEGF ORH6F404.670
IS=ISZF(JJ,L) ORH6F404.671
IF(IS.EQ.0) GO TO 840 ORH6F404.672
IE=IEZF(JJ,L) ORH6F404.673
DO II=IS,IE ORH6F404.674
I=MOD(II-2,IMTM2)+2 ORH6F404.675
UDIF(II+1-IS)=ZTD(I,J) ORH6F404.676
ENDDO ORH6F404.677
IM=IE-IS+1 ORH6F404.678
IF (.NOT.(L_OCYCLIC)) THEN ORH6F404.679
M=1 ORH6F404.680
N=NINT(IM*CST(J)*CSR_JFU0) ORH6F404.681
ELSE ORH6F404.682
IF(IM.NE.IMTM2) THEN ORH6F404.683
M=1 ORH6F404.684
N=NINT(IM*CST(J)*CSR_JFU0) ORH6F404.685
ELSE ORH6F404.686
M=3 ORH6F404.687
N=NINT(IM*CST(J)*CSR_JFU0*.5) ORH6F404.688
ENDIF ORH6F404.689
ENDIF ORH6F404.690
ORH1F305.3751
CALL FILTR ( ORH6F404.691
*CALL ARGSIZE BLOKCALC.929
*CALL ARGOCFIL BLOKCALC.930
& FTARR, BLOKCALC.931
& UDIF(1),IM,M,N,0) BLOKCALC.932
BLOKCALC.933
DO II=IS,IE ORH6F404.692
I=MOD(II-2,IMTM2)+2 ORH6F404.693
ZTD(I,J)=UDIF(II+1-IS) ORH6F404.694
ENDDO ORH6F404.695
830 CONTINUE ORH6F404.696
ENDIF ! L_OFILTER = true ORH6F404.697
ORH6F404.698
840 CONTINUE ORH6F404.699
C BLOKCALC.942
ENDDO ORH6F404.700
ORH6F404.701
ENDIF ! L_ONOCLIN and L_OFREESFC= false ORH6F404.702
C BLOKCALC.946
C--------------------------------------------------------------------- BLOKCALC.947
CL Now accumulate energy totals etc by adding block sub totals BLOKCALC.948
C--------------------------------------------------------------------- BLOKCALC.949
C BLOKCALC.950
CL First, set all cumulative values to zero BLOKCALC.952
C BLOKCALC.953
EKTOT= 0.0 BLOKCALC.954
BUOY = 0.0 ORH0F405.26
PLICIN = 0.0 ORH0F405.27
PLICEX = 0.0 ORH0F405.28
co2_tot = 0.0 BLOKCALC.957
C BLOKCALC.965
DO M=1,NT BLOKCALC.966
DTABS(M) = 0.0 BLOKCALC.967
TVAR(M) = 0.0 BLOKCALC.968
ENDDO ! Over M BLOKCALC.972
C BLOKCALC.973
CL Now add up all values over each block of rows BLOKCALC.974
C BLOKCALC.975
DO IBLOCK=1,NBLOCK BLOKCALC.976
EKTOT=EKTOT + BLOCK_EKTOT(IBLOCK) BLOKCALC.977
*IF DEF,MPP ORH9F402.307
! Global sums of EKTOT, BUOY, CO2_TOT, ENGINT, DTABS, TVAR ORH9F402.308
! and TTDTOT are not computed in a manner which is bit ORH9F402.309
! reproducible between runs with differing numbers of PEs. ORH9F402.310
! This is because these fields are single diagnostic values ORH9F402.311
! which do not affect model evolution. Mods to allow these ORH9F402.312
! fields to be reproducible would result in considerable ORH9F402.313
! extra memory use for very little gain. ORH9F402.314
CALL GC_RSUMR(1,O_NPROC,INFO,EKTOT) ORH9F402.315
*ENDIF ORH9F402.316
IF(NERGY.EQ.1) THEN ORH6F404.703
BUOY = BUOY + BLOCK_BUOY(IBLOCK) ORH6F404.704
DO LL = 1,8 ORH6F404.705
ENGINT(LL) = ENGINT(LL) + BLOCK_ENGINT(LL,IBLOCK) ORH6F404.706
ENDDO ! Over LL ORH6F404.707
*IF DEF,MPP ORH9F402.317
CALL GC_RSUMR(1,O_NPROC,INFO,BUOY) ORH6F404.708
CALL GC_RSUMR(8,O_NPROC,INFO,ENGINT) ORH6F404.709
*ENDIF ORH9F402.319
ENDIF ORH6F404.710
ORH6F404.711
IF (L_OCARBON) THEN ORH6F404.712
co2_tot = co2_tot + BLOCK_co2_tot(IBLOCK) ORH6F404.713
*IF DEF,MPP ORH9F402.320
CALL GC_RSUMR(1,O_NPROC,INFO,co2_tot) ORH6F404.714
*ENDIF ORH9F402.322
ENDIF ORH6F404.715
C BLOKCALC.982
DO M=1,NT BLOKCALC.990
DTABS(M) = DTABS(M) + BLOCK_DTABS(M,IBLOCK) BLOKCALC.991
TVAR(M) = TVAR(M) + BLOCK_TVAR(M,IBLOCK) BLOKCALC.992
IF(NERGY.EQ.1) THEN ORH6F404.716
DO LL = 1,6 ORH6F404.717
TTDTOT(LL,M)=TTDTOT(LL,M) + BLOCK_TTDTOT(LL,M,IBLOCK) ORH6F404.718
ENDDO ! Over LL ORH6F404.719
ENDIF ORH6F404.720
ENDDO ! Over M BLOKCALC.996
*IF DEF,MPP ORH9F402.326
CALL GC_RSUMR(NT,O_NPROC,INFO,DTABS) ORH9F402.327
CALL GC_RSUMR(NT,O_NPROC,INFO,TVAR) ORH9F402.328
IF (NERGY.EQ.1) THEN ORH9F402.329
CALL GC_RSUMR(6*NT,O_NPROC,INFO,TTDTOT) ORH9F402.330
ENDIF ORH9F402.331
*ENDIF ORH9F402.332
ENDDO ! Over IBLOCK BLOKCALC.997
C BLOKCALC.998
C BLOKCALC.999
C--------------------------------------------------------------------- BLOKCALC.1000
C PRINT ONE LINE OF TIMESTEP INFORMATION ON SPECIFIED TIMESTEPS BLOKCALC.1001
C--------------------------------------------------------------------- BLOKCALC.1002
C BLOKCALC.1003
IF(MOD(ITT,NTSI).EQ.0) THEN BLOKCALC.1004
EKTOT=EKTOT/VOLUME BLOKCALC.1005
DO M=1,NT BLOKCALC.1006
DTABS(M)=DTABS(M)/VOLUME BLOKCALC.1007
ENDDO BLOKCALC.1008
IF (LCAL360) THEN OFR8F404.16
DAYSYR=360 OFR8F404.17
ELSE OFR8F404.18
DAYSYR=365.25 OFR8F404.19
ENDIF OFR8F404.20
TTYEAR=TTSEC/(3600.*24.*DAYSYR) BLOKCALC.1010
TTDAY=TTSEC/(3600.*24.) BLOKCALC.1011
TTDAY=MOD(TTDAY,DAYSYR) BLOKCALC.1012
IF (O_MYPE.EQ.0) WRITE(6,910) ITT,TTYEAR,TTDAY,EKTOT, ORH4F404.1
& DTABS(1),DTABS(2),MSCAN ORH9F402.334
910 FORMAT(' TS=',I6,' YEAR=',F7.2,' DAY=',F5.1,' ENERGY=', BLOKCALC.1014
* 1PE13.6,' DTEMP=',1PE13.6,' DSALT=',1PE13.6,' SCANS=',I3) BLOKCALC.1015
IF (L_OCARBON) THEN ORH9F402.335
fx=12.0e-15*3600.*24.*360.*co2_tot ORH9F402.336
IF (O_MYPE.EQ.0) THEN ORH9F402.337
WRITE(6,*)' Global Net CO2 Flux into ocean (GtC/yr) ',fx GIE0F403.90
ENDIF ORH9F402.340
ENDIF ORH9F402.341
ENDIF BLOKCALC.1021
C BLOKCALC.1022
C--------------------------------------------------------------------- BLOKCALC.1023
C COMPLETE AND PRINT THE ON-LINE INTEGRALS ON ENERGY TIMESTEPS BLOKCALC.1024
C--------------------------------------------------------------------- BLOKCALC.1025
C BLOKCALC.1026
IF(NERGY.EQ.0) GO TO 390 BLOKCALC.1027
C BLOKCALC.1028
C 1ST, NORMALIZE PREVIOUSLY COMPUTED INTEGRALS BY VOLUME BLOKCALC.1029
C BLOKCALC.1030
DO LL=1,8 ORH6F404.721
ENGINT(LL)=ENGINT(LL)/VOLUME ORH6F404.722
ENGEXT(LL)=ENGEXT(LL)/VOLUME ORH6F404.723
ENDDO ! Over LL ORH6F404.724
DO M=1,NT ORH6F404.725
TVAR(M)=TVAR(M)/VOLUME ORH6F404.726
DO LL=1,6 ORH6F404.727
TTDTOT(LL,M)=TTDTOT(LL,M)/VOLUME ORH6F404.728
ENDDO ! Over LL ORH6F404.729
ENDDO ! Over M ORH6F404.730
BUOY=BUOY/VOLUME ORH6F404.731
C BLOKCALC.1042
C 2ND, COMPUTE RESIDUAL TERMS BLOKCALC.1043
C BLOKCALC.1044
PLICIN=ENGINT(1)-ENGINT(2)-ENGINT(3)-ENGINT(4) ORH6F404.732
& -ENGINT(5)-ENGINT(6)-ENGINT(7)-ENGINT(8) ORH6F404.733
PLICEX=ENGEXT(1)-ENGEXT(2)-ENGEXT(3)-ENGEXT(4) ORH6F404.734
& -ENGEXT(5)-ENGEXT(6)-ENGEXT(7)-ENGEXT(8) ORH6F404.735
DO M=1,NT ORH6F404.736
TTDTOT(6,M)=TTDTOT(1,M)-TTDTOT(2,M)-TTDTOT(3,M) ORH6F404.737
& -TTDTOT(4,M)-TTDTOT(5,M) ORH6F404.738
ENDDO ! Over M BLOKCALC.1052
C BLOKCALC.1053
C 3RD, PRINT THE INTEGRALS BLOKCALC.1054
C BLOKCALC.1055
IF (O_MYPE.EQ.0) THEN ORH9F402.342
WRITE(6,9100) ORH4F404.2
WRITE(6,9101) ENGINT(1),ENGEXT(1),TTDTOT(1,1),TTDTOT(1,2) ORH4F404.3
WRITE(6,9102) ENGINT(2),ENGEXT(2),TTDTOT(2,1),TTDTOT(2,2) ORH4F404.4
WRITE(6,9103) ENGINT(3),ENGEXT(3),TTDTOT(3,1),TTDTOT(3,2) ORH4F404.5
WRITE(6,9104) ENGINT(4),ENGEXT(4),TTDTOT(4,1),TTDTOT(4,2) ORH4F404.6
WRITE(6,9105) ENGINT(5),ENGEXT(5),TTDTOT(5,1),TTDTOT(5,2) ORH4F404.7
WRITE(6,9106) ENGINT(6),ENGEXT(6),TTDTOT(6,1),TTDTOT(6,2) ORH4F404.8
WRITE(6,9109) PLICIN,PLICEX,TVAR(1),TVAR(2) ORH4F404.9
WRITE(6,9107) ENGINT(7),ENGEXT(7) ORH4F404.10
WRITE(6,9108) ENGINT(8),ENGEXT(8) ORH4F404.11
ENDIF ORH9F402.353
9100 FORMAT( 1X,'WORK BY: INTERNAL MODE EXTERNAL MODE', BLOKCALC.1066
& 10X,' TEMPERATURE SALINITY ') BLOKCALC.1067
9101 FORMAT( 1X,'TIME RATE OF CHANGE ',2(1PE15.6), BLOKCALC.1068
& 10X,'TIME RATE OF CHANGE ',2(1PE15.6)) BLOKCALC.1069
9102 FORMAT( 1X,'HORIZONTAL ADVECTION',2(1PE15.6), BLOKCALC.1070
& 10X,'HORIZONTAL ADVECTION',2(1PE15.6)) BLOKCALC.1071
9103 FORMAT( 1X,'VERTICAL ADVECTION ',2(1PE15.6), BLOKCALC.1072
& 10X,'VERTICAL ADVECTION ',2(1PE15.6)) BLOKCALC.1073
9104 FORMAT( 1X,'HORIZONTAL FRICTION ',2(1PE15.6), BLOKCALC.1074
& 10X,'HORIZONTAL DIFFUSION',2(1PE15.6)) BLOKCALC.1075
9105 FORMAT( 1X,'VERTICAL FRICTION ',2(1PE15.6), BLOKCALC.1076
& 10X,'SURFACE FLUX ',2(1PE15.6)) BLOKCALC.1077
9106 FORMAT( 1X,'PRESSURE FORCES ',2(1PE15.6), BLOKCALC.1078
& 10X,'TRUNCATION ERROR ',2(1PE15.6)) BLOKCALC.1079
9107 FORMAT( 1X,'WORK BY WIND ',2(1PE15.6)) BLOKCALC.1080
9108 FORMAT( 1X,'BOTTOM DRAG ',2(1PE15.6)) BLOKCALC.1081
9109 FORMAT( 1X,'IMPLICIT EFFECTS ',2(1PE15.6), BLOKCALC.1082
& 10X,'CHANGE OF VARIANCE ',2(1PE15.6)) BLOKCALC.1083
TVAR(1)=BUOY-ENGINT(6)-ENGEXT(6) BLOKCALC.1084
DTABS(1)=ENGINT(2)+ENGINT(3)+ENGEXT(2)+ENGEXT(3) BLOKCALC.1085
IF (O_MYPE.EQ.0) WRITE(6,9110) BUOY,TVAR(1),DTABS(1) ORH4F404.12
9110 FORMAT( 1X,'WORK BY BUOYANCY FORCES ',1PE15.6, BLOKCALC.1087
& 5X,'ENERGY CONVERSION ERROR ',1PE15.6, BLOKCALC.1088
& 5X,'NONLINEAR EXCHANGE ERROR ',1PE15.6) BLOKCALC.1089
C BLOKCALC.1090
C--------------------------------------------------------------------- BLOKCALC.1091
C PRINT THE NORTHWARD TRANSPORT OF HEAT AND SALT BLOKCALC.1092
C--------------------------------------------------------------------- BLOKCALC.1093
C BLOKCALC.1094
IF (.NOT.(L_OHMEAD)) THEN ORH1F305.3761
IF (O_MYPE.EQ.0) WRITE(6,8195) ORH6F404.739
8195 FORMAT(/,' NORTHWARD TRANSPORT OF HEAT (X10**15 WATTS)',24X,'NORTH BLOKCALC.1097
&WARD TRANSPORT OF SALT (X10**10 CM**3/SEC)',/,6X,'X MEAN X EDDY BLOKCALC.1098
&Z MEAN Z EDDY EKMAN TOT ADV DIFFUS TOTAL X MEAN X EDDY Z BLOKCALC.1099
& MEAN Z EDDY EKMAN TOT ADV DIFFUS TOTAL') BLOKCALC.1100
C BLOKCALC.1101
C CONVERT HEAT TRANSPORT TO PETAWATTS, SALT TRNSPT TO 10**10 CM**3/SEC BLOKCALC.1102
C BLOKCALC.1103
DO J = J_1, J_JMT ORH6F404.740
DO LL=1,8 ORH6F404.741
TTN(LL,J,1)=TTN(LL,J,1)*4.186E-15 ORH6F404.742
TTN(LL,J,2)=TTN(LL,J,2)*1.E-10 ORH6F404.743
ENDDO ! Over LL ORH6F404.744
ENDDO ! Over J ORH6F404.745
DO JJ = J_2, J_JMTM2 ORH6F404.746
J=JMT-JJ ORH6F404.747
WRITE(6,8196)J+J_OFFSET,(TTN(I,J,1),I=1,8),(TTN(I,J,2),I=1,8) ORH6F404.748
8196 FORMAT(I4,8F8.3,1X,8F8.3) ORH6F404.749
ENDDO ! Over JJ ORH6F404.750
ENDIF ORH1F305.3762
WRITE(6,8194) ORH4F404.13
8194 FORMAT(/,' MERIDIONAL MASS TRANSPORT') BLOKCALC.1117
SCL=1.E12 BLOKCALC.1118
CALL MATRIX(TMT,JMT,J_1,J_JMT,0,KM,SCL,J_OFFSET,0) ORH4F404.81
390 CONTINUE BLOKCALC.1120
C BLOKCALC.1121
IF (L_OTIMER) CALL TIMER('BLOKCALC ',4) ORH1F305.3763
RETURN BLOKCALC.1125
END BLOKCALC.1126
*ENDIF BLOKCALC.1127