SUBROUTINE ROWCALC( 1,28ROWCALC.2
*CALL ARGSIZE 
@DYALLOC.4259
*CALL ARGD1 @DYALLOC.4260
*CALL ARGDUMO @DYALLOC.4261
*CALL ARGPTRO @DYALLOC.4262
*CALL ARGOCALL @DYALLOC.4263
*CALL ARGOINDX ORH7F402.283
*CALL COCAROWS ROWCALC.3
*CALL ARGOC2DG ORH0F400.24
*CALL ARGOC3DG ORH0F400.25
&,DTXADV,DTYADV,DTZADV,DTXDIFF,DTYDIFF,DTZDIFF ORH3F405.41
&,DTSFC,DTPEN,DTICE,DTMIX,DTCNVC,DTZ,DTFF,DTRF,DTMED,SF_DT ORH3F405.42
&,dsxadv,dsyadv,dszadv,dsxdiff,dsydiff,dszdiff ORH3F405.43
&,dssfc,dsice,dsmix,dscnvc,dsz,dsff,dsrf,dsmed,sf_ds ORH3F405.44
&,swrk_bio,si_bio,sf_bio ORH3F405.45
&,SWNCOL,sw201_30,sw202_30,sw203_30,sw204_30,sw205_30 JG170893.93
&,sw208_30 ROWCALC.5
&,sw248_30,sw249_30,sw250_30,sw251_30 NT071293.113
&,sw292_30,sw293_30 OJP0F404.920
&,sf201_30,sf202_30,sf203_30,sf204_30,sf205_30 ROWCALC.6
&,sf208_30 ROWCALC.7
&,sf248_30,sf249_30,sf250_30,sf251_30 NT071293.114
&,sf292_30,sf293_30 OJP0F404.921
&,sf285_30 OFRAF404.62
&,mead_diag,sirel_mead,sf_mead,Lpl_mead,tracer_xref ORH1F305.1978
&,SWZUN,SWZVN,SF_ZN ORH1F305.1979
&,utot,vtot,sfutot,sfvtot,Temperature,SFTemp OMB1F404.133
&,AICE, HICE, HSNOW, HICE_REF, CARYHEAT, ICY, FLXTOICE ORH5F401.32
&,CARYSALT, anomiceh, fluxcorh, fluxcorw ORH5F401.33
&,ISX, ISY, WSX_LEADS, WSY_LEADS ORH5F401.34
&,LL_ASS_BTRP, DU_ASS_BTRP, DV_ASS_BTRP ORH5F401.35
&,SURFTEMP, SURFSAL, NEWICE, UCURRENT, VCURRENT ORH5F401.36
&,TTN, TMT,L_OBULKRI,L_OWINDMIX,L_OBULKMAXMLD, OOM1F405.579
& LAMBDA_LARGE, OOM1F405.580
*CALL COCAWRKA ORH1F304.5
&,ISTRESS,ISTRESS_UV ORH1F304.7
&,co2_tot,PCO2_ATM ORH1F304.13
&,c14to12_atm, FTARR ORH1F405.473
&,rxp,ry,rrzp,esav,TPX,UPX,VPX,TBPX,UBPX,VBPX ORH7F402.318
&,TPPX,UPPX,VPPX,TBPPX,UBPPX,VBPPX OOM3F405.679
&,VISOPN,drhob1p,drhob2p,RHOSRN,RHOSRNA,RHOSRNB OOM1F405.578
&,IMT_GLN_ARG,KM_GLN_ARG ORH1F305.1983
&,ATTEND,HUDTEND OOM2F405.162
&) ROWCALC.36
C ROWCALC.48
CFPP$ NOCONCUR R ORH5F400.1
IMPLICIT NONE RH141293.1
C--------------------------------------------------------------------- ROWCALC.49
C DEFINE GLOBAL DATA ROWCALC.50
C--------------------------------------------------------------------- ROWCALC.51
C ROWCALC.52
C ROWCALC.53
*CALL OARRYSIZ ORH6F401.31
*CALL TYPSIZE @DYALLOC.4264
*CALL TYPD1 @DYALLOC.4265
*CALL TYPDUMO @DYALLOC.4266
*CALL TYPPTRO @DYALLOC.4267
*CALL TYPOINDX PXORDER.46
*CALL TYPOCALL @DYALLOC.4268
*CALL UMSCALAR ROWCALC.56
*CALL C_MDI @DYALLOC.4269
*CALL CNTLOCN ORH1F305.1984
*CALL OTIMER ORH1F305.1986
C ROWCALC.64
*CALL COCTROWS ROWCALC.65
*CALL COCTWRKA ROWCALC.66
*CALL TYPOC2DG ORH0F400.26
*CALL TYPOC3DG ORH0F400.27
*IF DEF,MPP OSI1F405.367
*CALL PARVARS OSI1F405.368
*ENDIF OSI1F405.369
REAL ROWCALC.68
& AICE(IMT_ICE,JMT_ICE) ! INOUT Fractional ice concentration. ORH1F305.1988
&,HICE(IMT_ICE,JMT_ICE) ! INOUT Ice depth averaged over ORH1F305.1989
! ! grid box. ORH1F305.1990
&,HSNOW(IMT_ICE,JMT_ICE) ! INOUT Snow depth over ice fraction ORH1F305.1991
! ! of grid box. ORH1F305.1992
&,HICE_REF(IMT_IHY,JMT_IHY) ! IN CLIMATOLOGICAL ice depth. ORH1F305.1993
&,anomiceh(IMT_IHY,JMT_IHY) ! OUT anomalous seaice heat flux ORH1F305.1994
ORH1F305.1995
REAL ROWCALC.76
& CARYHEAT(IMT_ICE,JMT_ICE) ORH1F305.1996
&,FLXTOICE(IMT_ICE,JMT_ICE) ORH1F305.1997
&,CARYSALT(IMT_ICE,JMT_ICE) ORH1F305.1998
&,SURFTEMP(IMT_ICE,JMT_ICE) ORH1F305.1999
&,SURFSAL(IMT_ICE,JMT_ICE) ORH1F305.2000
&,UCURRENT(IMT_drsa,JMTM1_drsa) ODC1F405.388
&,VCURRENT(IMT_drsa,JMTM1_drsa) ODC1F405.389
&,ISX(IMT_idr,JMTM1_idr) ODC1F405.390
&,ISY(IMT_idr,JMTM1_idr) ODC1F405.391
&,WSX_LEADS(IMT_idr,JMTM1_idr) ODC1F405.392
&,WSY_LEADS(IMT_idr,JMTM1_idr) ODC1F405.393
ORH1F305.2007
REAL ROWCALC.84
& fluxcorh(IMT_FLX,JMT_flx) ORH1F305.2008
&,fluxcorw(IMT_FLX,JMT_flx) ORH1F305.2009
ORH1F305.2010
LOGICAL ROWCALC.90
& NEWICE(IMT_ICE,JMT_ICE) ORH1F305.2011
&,ICY(IMT_ICE,JMT_ICE) ORH1F305.2012
ORH1F305.2013
REAL ROWCALC.95
& DU_ASS_BTRP(IMT_ASM,JMT_ASM) ! u_component data ORH1F305.2014
! !assimilation increment ORH1F305.2015
&,DV_ASS_BTRP(IMT_ASM,JMT_ASM) ! v_component data ORH1F305.2016
! !assimilation increment ORH1F305.2017
LOGICAL ROWCALC.98
& LL_ASS_BTRP ! logical selecting data assimilation ROWCALC.99
C ROWCALC.101
INTEGER SWNCOL ! first dimension of stash workspace JG170893.99
REAL ROWCALC.102
& sw201_30(SWNCOL,JMT,KMM1) ! stash workspace for vertical velocity JG170893.100
&,sw202_30(SWNCOL,JMT) ! mixed layer depth JG170893.101
&,sw203_30(SWNCOL,JMT) ! anomalous heat flux JG170893.102
&,sw204_30(SWNCOL,JMT) ! anomalous water flux JG170893.103
&,sw205_30(SWNCOL,JMT) ! anomalous sea ice heat flux JG170893.104
&,sw208_30(SWNCOL,JMT) ! caryheat heat flux (W/m2) JG170893.105
&,mead_diag(*) ! tracer transport (mead) diagnostics ROWCALC.140
&,sw248_30(ICOL_CYC,JMT) ! stash workspace for PCO2 ORH1F305.2018
&,sw249_30(ICOL_CYC,JMT) ! stash workspace for CO2 flux ORH1F305.2019
&,sw250_30(ICOL_CYC,JMT) ! stash workspace for invasion ORH1F305.2020
&,sw251_30(ICOL_CYC,JMT) ! stash workspace for evasion ORH1F305.2021
&,sw292_30(ICOL_CYC,JMT) ! stash workspace for virtual CO2 flux OJP0F404.922
&,sw293_30(ICOL_CYC,JMT) ! stash workspace for virtual ALK flux OJP0F404.923
ORH1F305.2022
LOGICAL ROWCALC.142
& sf201_30,sf202_30,sf203_30,sf204_30,sf205_30 ROWCALC.143
&,sf208_30 ROWCALC.144
&,sf248_30,sf249_30,sf250_30,sf251_30 NT071293.127
&,sf292_30,sf293_30 OJP0F404.924
&,sf285_30 OFRAF404.63
ORH1F305.2023
INTEGER ROWCALC.146
& sirel_mead(O_MAX_TRACERS_MEA) ORH1F305.2024
&,tracer_xref(O_MAX_TRACERS_MEA) ORH1F305.2025
LOGICAL ROWCALC.149
& sf_mead(O_MAX_TRACERS_MEA) ORH1F305.2026
&,Lpl_mead(LSEGC_MEA*4,O_MAX_TRACERS_MEA) ORH1F305.2027
ORH1F305.2028
C Full-field heating-rate diagnostics JG170893.106
C Only DTRF, the Robert time-filter, is calculated in ROWCALC. JG170893.107
C The others are passed on to TRACER without being referenced. JG170893.108
REAL DTXADV(*),DTYADV(*),DTZADV(*) JG170893.109
&,DTXDIFF(*),DTYDIFF(*),DTZDIFF(*) JG170893.110
&,DTSFC(*),DTPEN(*),DTICE(*),DTMIX(*),DTCNVC(*),DTZ(*),DTFF(*) JG170893.111
&,DTRF(SWNCOL,JMT,KM) JG170893.112
&,DTMED(*) JG170893.113
LOGICAL SF_DT(*) JG170893.114
C Rates of change of salinity OJG2F401.259
C Only DSRF, the Robert time-filter, is calculated in ROWCALC. OJG2F401.260
C The others are passed on to TRACER without being referenced. OJG2F401.261
REAL DSXADV(*),DSYADV(*),DSZADV(*) OJG2F401.262
&,DSXDIFF(*),DSYDIFF(*),DSZDIFF(*) OJG2F401.263
&,DSSFC(*),DSICE(*),DSMIX(*),DSCNVC(*),DSZ(*),DSFF(*) OJG2F401.264
&,DSRF(SWNCOL,JMT,KM) OJG2F401.265
&,DSMED(*) OJG2F401.266
LOGICAL SF_DS(*) OJG2F401.267
C Baroclinic acceleration diagnostics JG170893.116
REAL SWZUN(SWNCOL_CLN,JMT_CLN) ORH1F305.2030
&, SWZVN(SWNCOL_CLN,JMT_CLN) ORH1F305.2031
LOGICAL SF_ZN(2) JG170893.118
INTEGER SI_BIO(*) ORH3F405.46
ORH3F405.47
REAL swrk_bio(*) ORH3F405.48
ORH3F405.49
LOGICAL SF_BIO(*) ORH3F405.50
ORH3F405.51
real OJG5F401.3
*IF DEF,MPP ORH0F404.16
& utot(imt_stash,jmt,km) ! Total u-velocity diagnostic ORH0F404.17
&,vtot(imt_stash,jmt,km) ! Total v-velocity diagnostic ORH0F404.18
! Note: utot and vtot are overdimensioned in mpp case to cope ORH0F404.19
! with STASH expecting an extra row in these fields. This is not ORH0F404.20
! an ideal solution! ORH0F404.21
*ELSE ORH0F404.22
& utot(imt_stash,jmtm1,km) ! Total u-velocity diagnostic OJG5F401.4
&,vtot(imt_stash,jmtm1,km) ! Total v-velocity diagnostic OJG5F401.5
*ENDIF ORH0F404.23
&,Temperature(imt_stash,jmt,km) ! actual temperature diagnostic OMB1F404.134
logical OJG5F401.6
& sfutot,sfvtot ! Stash flags for 3D velocity diagnostics OJG5F401.7
&,SFTemp ! Stash flag for temperature diagnostic OMB1F404.135
ORH1F305.2073
C JG170893.120
ORH7F402.319
ORH7F402.320
ORH7F402.321
ORH7F402.322
ORH7F402.323
ORH7F402.324
ORH7F402.325
ORH7F402.326
ORH7F402.327
ORH7F402.328
ORH7F402.329
ORH7F402.330
ORH7F402.331
ORH7F402.332
ORH7F402.333
ORH7F402.334
ORH7F402.335
ORH7F402.336
C ORH1F304.28
! OCN1F405.7
! full surface CO2 field OCN1F405.8
REAL ATMPCO2_ROW(IMT_CAR) ! row of CO2 concentration (ppmv) OCN1F405.9
REAL TPX(IMT,KM,NT) ! TP for row JFIN +1 ORH1F304.29
&, UPX(IMT,KM) ! UP " " " " ORH1F304.30
&, VPX(IMT,KM) ! VP " " " " ORH1F304.31
&, TBPX(IMT,KM,NT) ! TBP " " " " ORH1F304.32
&, UBPX(IMT,KM) ! UBP " " " " ORH1F304.33
&, VBPX(IMT,KM) ! VBP " " " " ORH1F304.34
&, TPPX(IMT,KM,NT) OOM3F405.680
&, UPPX(IMT,KM) OOM3F405.681
&, VPPX(IMT,KM) OOM3F405.682
&, TBPPX(IMT,KM,NT) OOM3F405.683
&, UBPPX(IMT,KM) OOM3F405.684
&, VBPPX(IMT,KM) OOM3F405.685
C--------------------------------------------------------------------- ROWCALC.153
C DIMENSION AND EQUIVALENCE LOCAL DATA ROWCALC.154
C--------------------------------------------------------------------- ROWCALC.155
C ROWCALC.156
INTEGER I, ! Grid point index (Zonal) RH141293.2
& J, ! Grid point index (Meridional) RH141293.3
& K, ! Grid point index (Vertical) RH141293.4
& L, ! Ocean segment loop control RH141293.5
& M, ! Tracer indicator RH141293.6
& N, ! Control index RH141293.7
& KZ, ! Number of sea levels at point RH141293.12
& IKM ! Used to calculate KZ RH141293.15
&, J_FROM_COMP ! Start index for main J loop ORH9F402.118
&, J_TO_COMP ! End index for main J loop ORH9F402.119
&, J_IDR ! temporary value dependet on L_ICEFREEDR ODC1F405.394
&, J_idrM1 !temporary value dependent on L_ICEFREEDR ODC1F405.395
&, J_ICE ! " " " " L_SEAICE ORH1F305.2075
&, J_ICEP1 ! " " " " L_SEAICE OOM1F405.582
&, J_P1 ! Temporary pointer for J+1 OOM1F405.583
&, J_IHY ! " " " " L_IHANEY ORH1F305.2076
&, J_FLUX ! " " " " L_FLUXCORR ORH1F305.2077
&, IMT_GLN_ARG ! For dynamic allocation ORH1F305.2079
&, KM_GLN_ARG ! For dynamic allocation ORH1F305.2080
REAL ROWCALC.157
& VBR(KM) ! ZONAL SUMMATION OF MERIDIONAL VELOCITY ROWCALC.158
&,TMT(JMT,KM) ! MERIDIONAL MASS TRANSPORT ROWCALC.159
&, CCTJ ! Coeff used in horizontal mixing of T RH141293.16
&, FX ! Temporary value RH141293.20
&, SCL ! Scaling factor for printout RH141293.21
&, TBRZ ! Zonal/vertical tracer average RH141293.22
&, TOTDZ ! Vertical span of ocean boxes RH141293.26
&, TOTDX ! Total zonal span of ocean boxes RH141293.27
&, VBRZ ! Zonal/vertical meridional velocity sum RH141293.28
ORH1F305.2081
REAL TBRN(KM,NT) ORH1F305.2082
& ,TBRS(KM,NT) ORH1F305.2083
ORH1F305.2084
REAL ROWCALC.164
& TTN(8,JMT,NTMIN2) ! NORTHWARD TRANSPORT OF TRACERS ORH0F404.59
REAL ROWCALC.171
+ anom_heat (IMT_OHY) ! OUT Anomalous heat flux (W/m2) ORH1F305.2091
+ ,anom_salt (IMT_OHY) ! OUT Anomalous P-E (mm/day) ORH1F305.2092
ORH1F305.2093
REAL NT071293.129
+ PCO2 (IMT_car) ! OUT Partial pressure CO2 (ppm) ORH1F305.2094
+ ,CO2_FLUX (IMT_car) ! OUT Net air-sea flux of CO2 (Mole/m2/yr) ORH1F305.2095
+ ,INVADE (IMT_car) ! OUT Invasion rate of CO2 (Mole/m2/yr) ORH1F305.2096
+ ,EVADE (IMT_car) ! OUT Evasion rate of CO2 (Mole/m2/yr) ORH1F305.2097
+ ,co2_tot ! Total net air-sea flux of CO2 ORH1F305.2098
+ ,PCO2_ATM ! pp CO2 in atmosphere (ppm) ORH1F305.2099
& ,VTCO2_FLUX(IMT_car) ! OUT Virtual carbon flux OJP0F404.925
& ,VALK_FLUX(IMT_car) ! OUT Virtual alkalinity flux OJP0F404.926
ORH1F305.2100
REAL c14to12_atm ! Atmosphere C14/C12 ratio (standard =100) ORH1F305.2101
ORH1F305.2102
REAL DIAG_MLD(IMT_NOIPD_MIX) ! OUT Mixed layer depth (m) ORH1F305.2103
ORH1F305.2104
REAL rhosrn(IMT_RIC,KM_RIC) ! Density on TS row J, from STATED ORH1F305.2105
REAL RHOSRNA(IMT_RIC,KM_RIC+1),RHOSRNB(IMT_RIC,KM_RIC+1) !STATEC OOM1F405.581
ORH1F305.2106
ORH1F305.2107
REAL NT071293.137
+ esav(IMT_IPD,KM_IPD,NT_IPD) ! To save e(I,K,2) in IPDFLXCL ORH1F305.2108
+,rxp(IMT_IPD,KM_IPD) ! delta-rho in x dirn. ORH1F305.2109
+,ry(IMT_IPD,KM_IPD) ! delta-rho in y dirn. ORH1F305.2110
+,rrzp(IMT_IPD,KMP1_IPD) ! delta-rho in z dirn. ORH1F305.2111
&,VISOPN(IMT_GM,KM_GM) ! G&McW v* at north face of T gridbox OLA0F401.188
REAL UISOP(IMT_GM,KM_GM) ! u* isopycnal velocity OLA0F401.189
&, VISOPS(IMT_GM,KM_GM) ! v* at south face of T gridbox OLA0F401.190
&, WISOP(IMT_GM,KMP1_GM) ! w* at top face of T gridbox OLA0F401.191
&, DTGM(IMT,KM) ! Total dT/dt from GM OOM1F405.84
&, DSGM(IMT,KM) ! Total dsalinity/dt from GM OOM1F405.85
REAL OLA0F401.193
& drhob1p(IMT) ! extrapolated density gradient at the bottom of OLA0F401.194
! column i+1/2, row j+1 (relative to T grid) OLA0F401.195
REAL OLA0F401.196
& drhob2p(IMT,2) ! normalised density for row j+1, OLA0F401.197
C (*,1) at level one less than min(kmtp(i),kmtpp(i)) OLA0F401.198
C (*,2) at level min(kmtp(i),kmtpp(i)) OLA0F401.199
REAL OLA2F403.302
+ tmin2(IMT_VIS) ! Time scale ^2 for Visbeck scheme OLA2F403.303
ORH1F305.2112
C GM variables for Griffies implementation OOM1F405.86
REAL adv_vetiso(imt_gmm,km_gmm),adv_vbtiso(imt_gmm,0:km_gmm) OOM1F405.87
REAL times(imt),srho(imt,km) OOM1F405.88
OOM1F405.89
ORH1F305.2113
C Extra arrays for northern boundary calcs. ROWCALC.187
REAL UAM2(IMT_GLN_ARG,KM_GLN_ARG),VAM2(IMT_GLN_ARG,KM_GLN_ARG) ORH1F305.2114
ORH1F305.2115
REAL ZDUM(IMT) ! dummy variable passed to UMRANCIL ROWCALC.190
&, ZDUM_OR_WME(IMT) ! dummy variable or WME depends on L_OMIXLAY ORH1F305.2116
&, ZDUM_OR_SOL(IMT) ! dummy variable or SOL depends on L_OSOLAR ORH1F305.2117
! ! and L_OSOLARAL ORH1F305.2118
&, ZDUM_OR_SNOWRATE(IMT) ! dummy variable or SNOWRATE depending ORH1F305.2119
! ! on L_SEAICE ORH1F305.2120
&, ZDUM_OR_T_REF(IMT) ! dummy variable or T_REF depending on ORH1F305.2121
! ! L_OHANEY, L_OPSEUDIC ORH1F305.2122
&, ZDUM_OR_S_REF(IMT) ! dummy variable or S_REF depending on ORH1F305.2123
! ! L_OHANEY, L_OPSEUDIC ORH1F305.2124
&, ZDUM_OR_RIVER(IMT) ! dummy var or RIVERS depending on ORH1F305.2125
! L_RIVERS ORH1F305.2126
ORH1F305.2127
INTEGER ITEM ! Local index ORH0F404.60
REAL ROWCALC.194
& conv_mead(O_MAX_TRACERS) ! conversion factor for SI units ORH1F305.2128
LOGICAL ROWCALC.196
& meadtest ! true if mead diags selected for any tracer ROWCALC.197
ORH1F305.2129
REAL AICE_UV(IMT_idr,JMTM1_idr) ODC1F405.396
! ! ICE FRACTION INTERPOLATED TO UV POINTS. ORH1F305.2131
&,ISTRESS_UV(*) ! MAGNITUDE OF ICE-OCEAN BASAL STRESS. ORH1F305.2132
&,ISTRESS(IMT_idr_MIX,JMT_idr_MIX) ODC1F405.397
! ! ISTRESS_UV ON TRACER POINTS. ORH1F305.2134
&,WME_ICE(IMT_idr_MIX) ODC1F405.398
! ! WIND MIXING ENERGY UNDER SEA ICE. ORH1F305.2136
C OLA3F403.215
REAL OLA3F403.216
& WSXM(IMT),WSYM(IMT) ! wind stress on row j-1 OLA3F403.217
&,gnuT(imt_gnu,km_gnu-1) ! Vertical viscosity coeff at bottom of OLA3F403.218
&,gnum(imt_gnu,km_gnu-1) ! gridbox for tracers and momentum resp. OLA3F403.219
&,RiT(imt_gnu,km_gnu-1) ! Richardson number at half levels OLA3F403.220
&,Rim(imt_gnu,km_gnu-1) ! for tracers and momentum resp. OLA3F403.221
&,hT(imt_qlarge) ! Maximum depth for quadratic Large scheme OLA3F403.222
&,hm(imt_qlarge) ! for tracers and momentum resp. OLA3F403.223
& ,DXTK(IMT,KM) ! Intermediate value (for grid spacing) OMB2F401.3
& ,VBRPT(IMT,KM) ! Intermediate value for "Mead" diagnostics OMB2F401.4
& , Temp_row(IMT,KM) ! actual temperatures on a row for stash OMB1F404.136
& , TWork(IMT,KM), SWORK(IMT,KM) ! work space used by STATE_T OMB1F404.137
&, FTARR(IMTIMT_FLT) ! Big filtering work array ORH1F405.472
ORH1F305.2137
REAL OOM1F405.584
& HTNP(IMT) ! NON-PENETRATING HEAT FLUX (W/M2) ON ROW J+1 OOM1F405.585
&, PMEP(IMT) ! PRECIP MINUS EVAP (KG/M2/S) ON ROW J+1 OOM1F405.586
&, SOLP(IMT) ! SOLAR IRRADIANCE (W/M2) AT SURFACE ON ROW J+1 OOM1F405.587
&, WMEP(IMT) ! WIND MIXING POWER ON ROW J+1 (W M^-2) OOM1F405.588
&, MLD_LARGE(IMT) ! MIXED LAYER DEPTH ON T GRID, ROW J, (CM) OOM1F405.589
&, MLD_LARGEP(IMT) ! MIXED LAYER DEPTH ON T GRID, ROW J+1, (CM) OOM1F405.590
&, RHO(IMT,KM) ! DENSITY IN G/CM^3 , ROW J OOM1F405.591
&, RHOP(IMT,KM) ! DENSITY IN G/CM^3 , ROW J+1 OOM1F405.592
&, WORKA(IMT,KM),WORKB(IMT,KM) ! WORKSPACE OOM1F405.593
&, WATERFLUX_ICE(IMT) ! WATERFLUX FROM ICE (KG/M2/S) ROW J OOM1F405.594
&, WATERFLUX_ICEP(IMT) ! WATERFLUX FROM ICE (KG/M2/S) ROW J+1 OOM1F405.595
&, RIMLDCALC(IMT,KMM1) ! RICHARDSON NO FROM MLD CALC, ROW J OOM1F405.596
&, RIMLDCALCP(IMT,KMM1) ! RICHARDSON NO FROM MLD CALC, ROW J+1 OOM1F405.597
&, L_T(IMT) ! MONIN OBUKHOV LENGTH LARGE SCHEME (TRACER) OOM1F405.598
&, L_M(IMT) ! MONIN OBUKHOV LENGTH LARGE SCHEME (MOMENTUM) OOM1F405.599
&, LAMBDA_LARGE ! IN VALUE USED IN CALCULATING MINIMUM MLD OOM1F405.600
LOGICAL L_OBULKRI,L_OWINDMIX,L_OBULKMAXMLD OOM1F405.601
REAL OOM1F403.65
& ATTEND(KM,NT,4) ! Mixing tendencies caused by Med outflow OOM1F403.66
REAL HUDTEND(KM,NT,4) OOM2F405.163
OOM2F405.164
C ROWCALC.200
C--------------------------------------------------------------------- ROWCALC.201
INTEGER J_LOOP_FROM, J_LOOP_TO ORH1F403.31
C BEGIN EXECUTABLE CODE ROWCALC.202
C--------------------------------------------------------------------- ROWCALC.203
C ROWCALC.204
IF (L_OTIMER) CALL TIMER('ROWCALC ',3) ORH1F305.2138
ORH1F305.2139
C ROWCALC.208
C======================================================================= ROWCALC.209
C BEGIN SECTION FOR THE INITIALIZATION OF ============================ ROWCALC.210
C VARIOUS QUANTITIES ON EACH TIMESTEP ============================ ROWCALC.211
C======================================================================= ROWCALC.212
C ROWCALC.213
IF (L_OHMEAD) THEN ORH1F305.2140
C----------------------------------------------------------------------- SI061093.11
C Set switch for mead diagnostics and conversion factor for SI units. SI061093.12
C Temperature transport to heat transport in pettawatts,10**15W, and SI061093.13
C salt trnsport to 10**7kg/s SI061093.14
C----------------------------------------------------------------------- SI061093.15
meadtest=.false. ORH1F305.2141
DO item=1,O_MAX_TRACERS ORH1F305.2142
IF (sf_mead(item)) meadtest=.TRUE. ORH1F305.2143
END DO ORH1F305.2144
conv_mead(1)=SPECIFIC_HEAT_SI*RHO_WATER_SI*1.E-15/1000000. ORH1F305.2145
conv_mead(2)=RHO_WATER_SI*1.E-7/1000000. ORH1F305.2146
ORH1F305.2147
IF (L_OCARBON) THEN ORH1F305.2148
ORH1F305.2149
C Scale the Northward Transport diags for Tracer 3, which ONT4F304.3
C represents TCO2, so that output is in units of Giga-Tonnes-C/year ONT4F304.4
C The factor 3.73248E-19 is made up as follows: ONT4F304.5
C 12*(3600*24*360)*1.0e-6*1.0e-15*1.0e-6 ONT4F304.6
C 12 is weight in grams of 1 mole of carbon, (3600*24*360) converts ONT4F304.7
C from /s to /year, 10**-6 converts micro-moles to moles, ONT4F304.8
C 10**-15 converts from grams to giga-tonnes, 10**-6 converts ONT4F304.9
C cm**-3 to m**-3. ONT4F304.10
C RHO_WATER_SI converts micro-moles/kg to micro-moles/m3 ONT4F304.11
C ONT4F304.12
conv_mead(3)=RHO_WATER_SI*3.73248*1.E-19 ORH1F305.2150
ELSE ORH1F305.2151
conv_mead(3)=1./1000000. ORH1F305.2152
ENDIF ORH1F305.2153
ORH1F305.2154
DO item=4,O_MAX_TRACERS ORH1F305.2155
conv_mead(item)=1./1000000. ORH1F305.2156
END DO ORH1F305.2157
ORH1F305.2158
ELSE ORH5F403.288
DO M=1,NT ORH5F403.289
DO K=1,KM ORH5F403.290
TBRN(K,M)=0.0 ORH5F403.291
ENDDO ORH5F403.292
ENDDO ORH5F403.293
ENDIF ORH5F403.294
C ROWCALC.345
C======================================================================= ROWCALC.346
C END OF SECTION FOR INITIALIZATION ================================== ROWCALC.347
C======================================================================= ROWCALC.348
! Set up row-wise loop index controls for main part of ORH9F402.120
! the computation. ORH9F402.121
*IF -DEF,MPP ORH9F402.122
J_FROM_COMP = MAX(2,JST) ORH9F402.123
J_TO_COMP = JFIN ORH9F402.124
J_LOOP_FROM = J_2 ORH0F404.45
J_LOOP_TO = J_JMTM1 ORH0F404.46
*ELSE ORH9F402.125
! First block must contain at least rows 1 and 2. ORH9F402.126
! Computation always starts at global row 2. ORH9F402.127
! Computation always ends at global row JMTM1. ORH9F402.128
! We must therefore set up our start and end indices ORH9F402.129
! to reflect these as local values. ORH9F402.130
J_FROM_COMP = J_2 ORH9F402.131
J_TO_COMP = J_JMTM1 ORH9F402.132
IF (L_OFILTER) THEN ORH0F404.47
! Start and end indicies contain include rows 1 (globally ORH0F404.48
! speaking) and JMT and possibly other dummy rows which ORH0F404.49
! do not contain work in order to allow sychronisation ORH0F404.50
! and work distribution among all PEs during filtering. ORH0F404.51
J_LOOP_FROM = J_1 ORH0F404.52
J_LOOP_TO = MAX_ROW_INDEX ORH0F404.53
ELSE ORH0F404.54
J_LOOP_FROM = J_2 ORH0F404.55
J_LOOP_TO = J_JMTM1 ORH0F404.56
ENDIF ORH0F404.57
*ENDIF ORH9F402.133
C======================================================================= ROWCALC.563
C BEGIN ROW-BY-ROW COMPUTATION OF PROGNOSTIC VARIABLES =============== ROWCALC.564
C======================================================================= ROWCALC.565
C ROWCALC.566
DO 380 J=J_LOOP_FROM,J_LOOP_TO ! For each row in this block ORH0F404.58
ORH1F403.35
! We must ensure CLINIC can take a barrier. ORH1F403.36
IF (J.GE.J_FROM_COMP.AND.J.LE.J_TO_COMP) THEN ORH1F403.37
ORH1F403.38
C ROWCALC.568
IF (L_OBIMOM) THEN OOM3F405.686
C OOM3F405.687
C----------------------------------------------------------------------- OOM3F405.688
C Calculate diffusion coefficients for biharmonic momentum diffusion OOM3F405.689
C----------------------------------------------------------------------- OOM3F405.690
C OOM3F405.691
BBUB = BM * BBUD OOM3F405.692
DDUB = BM * DDUD OOM3F405.693
GGUB = BM * GGUD OOM3F405.694
HHUB = BM * HHUD OOM3F405.695
OOM3F405.696
BBUD = 8.0*(CSR(J+1)*CSR(J+1)) OOM3F405.697
DDUD = (CST(J+1)*DYTR(J+1))*(DYUR(J+1)*CSR(J+1)) OOM3F405.698
GGUD = (1.0-(TNG(J+1)*TNG(J+1)))/(RADIUS*RADIUS) OOM3F405.699
HHUD = 2.0*SINE(J+1)/(RADIUS*(CS(J+1)*CS(J+1))) OOM3F405.700
OOM3F405.701
C rearrange order for calc. these as don't want to calc OOM3F405.702
C at j=jmtm1 OOM3F405.703
IF (J+J_OFFSET.EQ.JMTM1_GLOBAL) THEN OOM3F405.704
CCUB = 0.0 OOM3F405.705
CCUD = 0.0 OOM3F405.706
ELSE IF (J.LT.J_JMT) THEN OOM3F405.707
CCUB = BM * CCUD OOM3F405.708
CCUD = (CST(J+2)*DYTR(J+2))*(DYUR(J+1)*CSR(J+1)) OOM3F405.709
ELSE OOM3F405.710
CCUB = BM * CCUD OOM3F405.711
CCUD = (CSTJP*DYTRJP)*(DYUR(J+1)*CSR(J+1)) OOM3F405.712
ENDIF OOM3F405.713
OOM3F405.714
ENDIF ! L_OBIMOM OOM3F405.715
OOM3F405.716
C--------------------------------------------------------------------- ROWCALC.569
C MOVE ALL SLAB DATA DOWN ONE ROW ROWCALC.570
C TOGETHER WITH QUANTITIES SAVED FOR TIME FILTER ROWCALC.571
C--------------------------------------------------------------------- ROWCALC.572
C ROWCALC.573
DO M=1,NT ROWCALC.574
DO K=1,KM ROWCALC.575
DO I=1,IMT ROWCALC.576
TBM(I,K,M)=TB(I,K,M) ROWCALC.577
TM(I,K,M)=T(I,K,M) ROWCALC.578
TB(I,K,M)=TBP(I,K,M) ROWCALC.579
T(I,K,M)=TP(I,K,M) ROWCALC.580
ENDDO ROWCALC.581
ENDDO ROWCALC.582
ENDDO ROWCALC.583
IF (L_OBIMOM.or.L_OBIHARMGM) THEN OOM3F405.717
DO M=1,NT OOM3F405.718
DO K=1,KM OOM3F405.719
DO I=1,IMT OOM3F405.720
TBP(I,K,M)=TBPP(I,K,M) OOM3F405.721
TP(I,K,M)=TPP(I,K,M) OOM3F405.722
ENDDO OOM3F405.723
ENDDO OOM3F405.724
ENDDO OOM3F405.725
ENDIF ! L_OBIMOM.or.L_OBIHARMGM OOM3F405.726
DO K=1,KM ROWCALC.584
DO I=1,IMT ROWCALC.585
UBM(I,K)=UB(I,K) ROWCALC.586
UM(I,K)=U(I,K) ROWCALC.587
UB(I,K)=UBP(I,K) ROWCALC.588
U(I,K)=UP(I,K) ROWCALC.589
VBM(I,K)=VB(I,K) ROWCALC.590
VM(I,K)=V(I,K) ROWCALC.591
VB(I,K)=VBP(I,K) ROWCALC.592
V(I,K)=VP(I,K) ROWCALC.593
ENDDO ROWCALC.594
ENDDO ROWCALC.595
IF (L_OBIMOM.or.L_OBIHARMGM) THEN OOM3F405.727
DO K=1,KM OOM3F405.728
DO I=1,IMT OOM3F405.729
UBP(I,K)=UBPP(I,K) OOM3F405.730
UP(I,K)=UPP(I,K) OOM3F405.731
VBP(I,K)=VBPP(I,K) OOM3F405.732
VP(I,K)=VPP(I,K) OOM3F405.733
ENDDO OOM3F405.734
ENDDO OOM3F405.735
ENDIF ! L_OBIMOM.or.L_OBIHARMGM OOM3F405.736
OOM3F405.737
IF (L_OBIMOM) THEN OOM3F405.738
DO K=1,KM OOM3F405.739
DO I=1,IMT OOM3F405.740
D2U(I,K,1)=D2U(I,K,2) OOM3F405.741
D2U(I,K,2)=D2U(I,K,3) OOM3F405.742
D2V(I,K,1)=D2V(I,K,2) OOM3F405.743
D2V(I,K,2)=D2V(I,K,3) OOM3F405.744
ENDDO OOM3F405.745
ENDDO OOM3F405.746
ENDIF OOM3F405.747
OOM3F405.748
IF (.NOT.(L_ONOCLIN)) THEN ORH1F305.2160
DO I=1,IMT ORH1F305.2161
SSFUB(I)=SSFUBP(I) ORH1F305.2162
SSFVB(I)=SSFVBP(I) ORH1F305.2163
ENDDO ORH1F305.2164
C move the external mode for j+2 down a row (saved for time filter) OOM3F405.749
IF (L_OBIMOM.or.L_OBIHARMGM) THEN OOM3F405.750
DO I=1,IMT OOM3F405.751
SSFUBP(I)=SSFUBPP(I) OOM3F405.752
SSFVBP(I)=SSFVBPP(I) OOM3F405.753
ENDDO OOM3F405.754
ENDIF OOM3F405.755
ENDIF ORH1F305.2165
C ROWCALC.602
C--------------------------------------------------------------------- ROWCALC.603
C COMPLETE READIN OF J+1 SLAB (EXCEPT LAST ROW) ROWCALC.604
C--------------------------------------------------------------------- ROWCALC.605
C ROWCALC.606
IF (.NOT.(L_OBIMOM.or.L_OBIHARMGM)) THEN OOM3F405.756
IF( J+J_OFFSET.NE.JMTM1_GLOBAL .AND. J+J_OFFSET.EQ.JFIN ) THEN OSI1F405.75
! If this is the last row of a block but not the ORH1F304.38
! last row of all, then TP etc must be populated ORH1F304.39
! with the value saved prior to the start of ORH1F304.40
! computation of the current block of rows. ORH1F304.41
DO M=1,NT ORH1F304.43
DO K=1,KM ORH1F304.44
DO I=1,IMT ORH1F304.45
TP (I,K,M)=TPX(I,K,M) ORH1F304.46
TBP(I,K,M)=TBPX(I,K,M) ORH1F304.47
ENDDO ORH1F304.48
ENDDO ORH1F304.49
ENDDO ORH1F304.50
DO K=1,KM ORH1F304.51
DO I=1,IMT ORH1F304.52
UP (I,K)=UPX(I,K) ORH1F304.53
VP (I,K)=VPX(I,K) ORH1F304.54
UBP(I,K)=UBPX(I,K) ORH1F304.55
VBP(I,K)=VBPX(I,K) ORH1F304.56
ENDDO ORH1F304.57
ENDDO ORH1F304.58
ELSE IF ( J+J_OFFSET.NE.JMTM1_GLOBAL .OR. L_OPENBC) THEN OSI1F405.76
CALL UMREAD( @DYALLOC.4294
*CALL ARGSIZE @DYALLOC.4295
*CALL ARGD1 @DYALLOC.4296
*CALL ARGDUMO @DYALLOC.4297
*CALL ARGPTRO @DYALLOC.4298
& LABS(NDISKB),J+1,TBP @DYALLOC.4299
&, NDISKB,NDISK,NDISKA,FKMP,FKMQ ) OSI0F402.128
CALL UMREAD( @DYALLOC.4300
*CALL ARGSIZE @DYALLOC.4301
*CALL ARGD1 @DYALLOC.4302
*CALL ARGDUMO @DYALLOC.4303
*CALL ARGPTRO @DYALLOC.4304
& LABS(NDISK),J+1,TP @DYALLOC.4305
&, NDISKB,NDISK,NDISKA,FKMP,FKMQ ) OSI0F402.129
ENDIF ROWCALC.612
ELSE OOM3F405.757
IF(J+J_OFFSET.NE.JMTM1_GLOBAL) THEN OOM3F405.758
IF (J+J_OFFSET.EQ.JFIN) THEN OOM3F405.759
DO M=1,NT OOM3F405.760
DO K=1,KM OOM3F405.761
DO I=1,IMT OOM3F405.762
TPP (I,K,M)=TPPX(I,K,M) OOM3F405.763
TBPP(I,K,M)=TBPPX(I,K,M) OOM3F405.764
ENDDO OOM3F405.765
ENDDO OOM3F405.766
ENDDO OOM3F405.767
DO K=1,KM OOM3F405.768
DO I=1,IMT OOM3F405.769
UPP (I,K)=UPPX(I,K) OOM3F405.770
VPP (I,K)=VPPX(I,K) OOM3F405.771
UBPP(I,K)=UBPPX(I,K) OOM3F405.772
VBPP(I,K)=VBPPX(I,K) OOM3F405.773
ENDDO OOM3F405.774
ENDDO OOM3F405.775
OOM3F405.776
ELSE IF (J+J_OFFSET.EQ.JFIN-1) THEN OOM3F405.777
DO M=1,NT OOM3F405.778
DO K=1,KM OOM3F405.779
DO I=1,IMT OOM3F405.780
TPP (I,K,M)=TPX(I,K,M) OOM3F405.781
TBPP(I,K,M)=TBPX(I,K,M) OOM3F405.782
ENDDO OOM3F405.783
ENDDO OOM3F405.784
ENDDO OOM3F405.785
DO K=1,KM OOM3F405.786
DO I=1,IMT OOM3F405.787
UPP (I,K)=UPX(I,K) OOM3F405.788
VPP (I,K)=VPX(I,K) OOM3F405.789
UBPP(I,K)=UBPX(I,K) OOM3F405.790
VBPP(I,K)=VBPX(I,K) OOM3F405.791
ENDDO OOM3F405.792
ENDDO OOM3F405.793
ELSE OOM3F405.794
CALL UMREAD( OOM3F405.795
*CALL ARGSIZE OOM3F405.796
*CALL ARGD1 OOM3F405.797
*CALL ARGDUMO OOM3F405.798
*CALL ARGPTRO OOM3F405.799
& LABS(NDISKB),J+2,TBPP ! J+2,T-1 OOM3F405.800
&, NDISKB,NDISK,NDISKA,FKMP,FKMQ ) OOM3F405.801
C OOM3F405.802
CALL UMREAD( OOM3F405.803
*CALL ARGSIZE OOM3F405.804
*CALL ARGD1 OOM3F405.805
*CALL ARGDUMO OOM3F405.806
*CALL ARGPTRO OOM3F405.807
& LABS(NDISK),J+2,TPP ! J+2,T OOM3F405.808
&, NDISKB,NDISK,NDISKA,FKMP,FKMQ ) OOM3F405.809
OOM3F405.810
ENDIF ! j+j_offset.eq.jfin OOM3F405.811
ENDIF ! J+J_OFFSET.NE.JMTM1_GLOBAL OOM3F405.812
ENDIF ! L_OBIMOM or L_OBIHARMGM OOM3F405.813
C OOM3F405.814
IF (L_OMEDADV) THEN OOM2F405.165
C Set the velocities so that med_vol Sverdrups is OOM2F405.166
C fluxed through the Gibraltar Strait. OOM2F405.167
IF (.NOT.(L_OBIMOM.OR.L_OBIHARMGM)) THEN OOM2F405.168
IF (J+J_OFFSET.eq.jmout(1)-1) then OOM2F405.169
C set the velocity on the land point in the Atlantic OOM2F405.170
C to the appropriate value OOM2F405.171
do k=1,med_topflow OOM2F405.172
UBP(imout(1),k)=UBP(imout(1),k)+med_in OOM2F405.173
UP(imout(1),k)=UP(imout(1),k)+med_in OOM2F405.174
enddo OOM2F405.175
do k=lev_med,lev_med OOM2F405.176
UBP(imout(1),k)=UBP(imout(1),k)+med_out OOM2F405.177
UP(imout(1),k)=UP(imout(1),k)+med_out OOM2F405.178
enddo OOM2F405.179
ENDIF OOM2F405.180
ELSE OOM2F405.181
IF (J+J_OFFSET.eq.jmout(1)-2) then OOM2F405.182
C set the velocity on the land point in the Atlantic OOM2F405.183
C to the appropriate value OOM2F405.184
do k=1,med_topflow OOM2F405.185
UBPP(imout(1),k)=UBPP(imout(1),k)+med_in OOM2F405.186
UPP(imout(1),k)=UPP(imout(1),k)+med_in OOM2F405.187
enddo OOM2F405.188
do k=lev_med,lev_med OOM2F405.189
UBPP(imout(1),k)=UBPP(imout(1),k)+med_out OOM2F405.190
UPP(imout(1),k)=UPP(imout(1),k)+med_out OOM2F405.191
enddo OOM2F405.192
ENDIF OOM2F405.193
OOM2F405.194
ENDIF OOM2F405.195
OOM2F405.196
IF (.NOT.(L_OBIMOM.OR.L_OBIHARMGM)) THEN OOM2F405.197
IF (J+J_OFFSET.eq.jmout(3)-1) then OOM2F405.198
C set the velocity on the land point in the Mediterranean OOM2F405.199
C to the appropriate value OOM2F405.200
do k=1,med_topflow OOM2F405.201
UBP(imout(3)-1,k)=UBP(imout(3)-1,k)+med_in OOM2F405.202
UP(imout(3)-1,k)=UP(imout(3)-1,k)+med_in OOM2F405.203
enddo OOM2F405.204
do k=lev_med,lev_med OOM2F405.205
UBP(imout(3)-1,k)=UBP(imout(3)-1,k)+med_out OOM2F405.206
UP(imout(3)-1,k)=UP(imout(3)-1,k)+med_out OOM2F405.207
enddo OOM2F405.208
ENDIF OOM2F405.209
ELSE OOM2F405.210
IF (J+J_OFFSET.eq.jmout(3)-2) then OOM2F405.211
C set the velocity on the land point in the Mediterranean OOM2F405.212
C to the appropriate value OOM2F405.213
do k=1,med_topflow OOM2F405.214
UBPP(imout(3)-1,k)=UBPP(imout(3)-1,k)+med_in OOM2F405.215
UPP(imout(3)-1,k)=UPP(imout(3)-1,k)+med_in OOM2F405.216
enddo OOM2F405.217
do k=lev_med,lev_med OOM2F405.218
UBPP(imout(3)-1,k)=UBPP(imout(3)-1,k)+med_out OOM2F405.219
UPP(imout(3)-1,k)=UPP(imout(3)-1,k)+med_out OOM2F405.220
enddo OOM2F405.221
ENDIF OOM2F405.222
ENDIF OOM2F405.223
OOM2F405.224
IF (L_OHUDOUT) THEN OOM2F405.225
C Set the velocities so that hud_vol Sv is OOM2F405.226
C fluxed through from Hudson Bay into the Atlantic. OOM2F405.227
IF (.NOT.(L_OBIMOM.OR.L_OBIHARMGM)) THEN OOM2F405.228
IF (J+J_OFFSET.eq.jmout_hud(1)-1) then OOM2F405.229
C set the velocity on the land point in the Atlantic OOM2F405.230
C to the appropriate value OOM2F405.231
do k=1,lev_hud-1 OOM2F405.232
UBP(imout_hud(1),k)=UBP(imout_hud(1),k)+hud_in OOM2F405.233
UP(imout_hud(1),k)=UP(imout_hud(1),k)+hud_in OOM2F405.234
enddo OOM2F405.235
do k=lev_hud,lev_hud OOM2F405.236
UBP(imout_hud(1),k)=UBP(imout_hud(1),k)+hud_out OOM2F405.237
UP(imout_hud(1),k)=UP(imout_hud(1),k)+hud_out OOM2F405.238
enddo OOM2F405.239
ENDIF OOM2F405.240
ELSE OOM2F405.241
IF (J+J_OFFSET.eq.jmout_hud(1)-2) then OOM2F405.242
C set the velocity on the land point in the Atlantic OOM2F405.243
C to the appropriate value OOM2F405.244
do k=1,lev_hud-1 OOM2F405.245
UBPP(imout_hud(1),k)=UBPP(imout_hud(1),k)+hud_in OOM2F405.246
UPP(imout_hud(1),k)=UPP(imout_hud(1),k)+hud_in OOM2F405.247
enddo OOM2F405.248
do k=lev_hud,lev_hud OOM2F405.249
UBPP(imout_hud(1),k)=UBPP(imout_hud(1),k)+hud_out OOM2F405.250
UPP(imout_hud(1),k)=UPP(imout_hud(1),k)+hud_out OOM2F405.251
enddo OOM2F405.252
ENDIF OOM2F405.253
ENDIF OOM2F405.254
OOM2F405.255
IF (.NOT.(L_OBIMOM.OR.L_OBIHARMGM)) THEN OOM2F405.256
IF (J+J_OFFSET.eq.jmout_hud(3)-1) then OOM2F405.257
C set the velocity on the land point in the Mediterranean OOM2F405.258
C to the appropriate value OOM2F405.259
do k=1,lev_hud-1 OOM2F405.260
UBP(imout_hud(3)-1,k)=UBP(imout_hud(3)-1,k)+hud_in OOM2F405.261
UP(imout_hud(3)-1,k)=UP(imout_hud(3)-1,k)+hud_in OOM2F405.262
enddo OOM2F405.263
do k=lev_hud,lev_hud OOM2F405.264
UBP(imout_hud(3)-1,k)=UBP(imout_hud(3)-1,k)+hud_out OOM2F405.265
UP(imout_hud(3)-1,k)=UP(imout_hud(3)-1,k)+hud_out OOM2F405.266
enddo OOM2F405.267
ENDIF OOM2F405.268
ELSE OOM2F405.269
IF (J+J_OFFSET.eq.jmout_hud(3)-2) then OOM2F405.270
C set the velocity on the land point in the Mediterranean OOM2F405.271
C to the appropriate value OOM2F405.272
do k=1,lev_hud-1 OOM2F405.273
UBPP(imout_hud(3)-1,k)=UBPP(imout_hud(3)-1,k)+hud_in OOM2F405.274
UPP(imout_hud(3)-1,k)=UPP(imout_hud(3)-1,k)+hud_in OOM2F405.275
enddo OOM2F405.276
do k=lev_hud,lev_hud OOM2F405.277
UBPP(imout_hud(3)-1,k)=UBPP(imout_hud(3)-1,k)+hud_out OOM2F405.278
UPP(imout_hud(3)-1,k)=UPP(imout_hud(3)-1,k)+hud_out OOM2F405.279
enddo OOM2F405.280
ENDIF OOM2F405.281
ENDIF OOM2F405.282
ENDIF ! L_OHUDOUT OOM2F405.283
ENDIF ! L_OMEDADV OOM2F405.284
OOM2F405.285
C ROWCALC.613
C--------------------------------------------------------------------- ROWCALC.614
C INITIATE WRITEOUT OF NEWLY COMPUTED DATA FROM PREVIOUS ROW ROWCALC.615
C--------------------------------------------------------------------- ROWCALC.616
C ROWCALC.617
IF (J.GT.J_FROM_COMP) CALL UMWRITE( ORH9F402.135
*CALL ARGSIZE @DYALLOC.4307
*CALL ARGD1 @DYALLOC.4308
*CALL ARGDUMO @DYALLOC.4309
*CALL ARGPTRO @DYALLOC.4310
& LABS(NDISKA),J-1,TA @DYALLOC.4311
&, NDISKB,NDISK,NDISKA,FKMP,FKMQ ) OSI0F402.130
C ROWCALC.620
C------------------------------------------------------------------- ROWCALC.621
C READ IN MAXIMUM LEVEL INDICATORS FOR ROWS J AND J+1 DIRECTLY ROWCALC.622
C AND CONVERT TO INTEGER ROWCALC.623
C------------------------------------------------------------------- ROWCALC.624
C ROWCALC.625
DO 333 I=1,IMT ROWCALC.626
KMT (I)=FKMP(I,J) ROWCALC.627
KMU (I)=FKMQ(I,J) ROWCALC.628
KMTP(I)=FKMP(I,J+1) ROWCALC.629
KMUP(I)=FKMQ(I,J+1) ROWCALC.630
C READ IN MAX LEVEL INDICATORS FOR ROW J+2 OLA0F401.200
IF (J+J_OFFSET.LT.JMTM1_GLOBAL) THEN ORH3F402.251
KMTPP(I)=FKMP_GLOBAL(I,J+J_OFFSET+2) ORH3F402.252
ELSE ORH3F402.253
KMTPP(I)=0 ORH3F402.254
ENDIF ORH3F402.255
333 CONTINUE ROWCALC.631
C SHIFT MAXIMUM LEVEL INDICATORS DOWN ONE ROW AND SET J+2 VALUES OOM3F405.815
c KMUP(I)=KMUPP(I) OOM3F405.816
IF (L_OBIMOM.or.L_OBIHARMGM) THEN OOM3F405.817
IF (J+J_OFFSET.LT.JMTM1_GLOBAL) THEN OOM3F405.818
IF (J.LT.J_JMT) THEN OOM3F405.819
DO I=1,IMT OOM3F405.820
KMUPP(I)=FKMQ(I,J+2) OOM3F405.821
ENDDO OOM3F405.822
ELSE OOM3F405.823
DO I=1,IMT OOM3F405.824
KMUPP(I)=FKMQJP(I) OOM3F405.825
ENDDO OOM3F405.826
ENDIF ! (J.LT.J_JMT) OOM3F405.827
ELSE OOM3F405.828
DO I=1,IMT OOM3F405.829
KMUPP(I)=0 OOM3F405.830
ENDDO OOM3F405.831
ENDIF OOM3F405.832
ENDIF ! L_OBIMOM or L_OBIHARMGM OOM3F405.833
OOM3F405.834
conditions as in vn4.3 code for T conditions OOM3F405.835
OOM3F405.836
C ROWCALC.632
C------------------------------------------------------------------- ROWCALC.633
C AT THIS STAGE READ IN THE OTHER INCIDENTAL QUANTITIES FROM THE ROWCALC.634
C BKOH STORES FOR ROW J ROWCALC.635
C------------------------------------------------------------------- ROWCALC.636
C ROWCALC.637
CALL UMRANCIL( @DYALLOC.4312
*CALL ARGSIZE @DYALLOC.4313
*CALL ARGD1 @DYALLOC.4314
*CALL ARGPTRO @DYALLOC.4316
& J,WSX,WSY,HTN,PME @DYALLOC.4317
&,ZDUM_OR_WME ORH1F305.2166
&,ZDUM_OR_SOL ORH1F305.2167
&,ZDUM_OR_SNOWRATE ORH1F305.2168
&,ZDUM_OR_T_REF,ZDUM_OR_S_REF ORH1F305.2169
&,ZDUM_OR_RIVER ORH1F305.2170
& ) ROWCALC.673
c Set up WSYM,WSXM - surface wind stress on row j-1 OLA3F403.224
DO I=1,IMT OLA3F403.225
WSXM(I)=D1(joc_taux+(J-2)*IMT+I-1) OLA3F403.226
WSYM(I)=D1(joc_tauy+(J-2)*IMT+I-1) OLA3F403.227
HTNP(I)=D1(JOC_HEAT+J*IMT+I-1) OOM1F405.602
PMEP(I)=D1(JOC_PLE+J*IMT+I-1) OOM1F405.603
SOLP(I)=D1(JOC_SOLAR+J*IMT+I-1) OOM1F405.604
WMEP(I)=D1(JOC_WME+J*IMT+I-1) OOM1F405.605
ENDDO OLA3F403.228
IF (L_SEAICE) THEN OOM1F405.606
DO I=1,IMT OOM1F405.607
WATERFLUX_ICE(I)=-1.*CARYSALT(I,J)*RHO_WATER_SI*DZ(1) OOM1F405.608
& /0.035 OOM1F405.609
WATERFLUX_ICEP(I)=-1.*CARYSALT(I,J+1) OOM1F405.610
& *RHO_WATER_SI*DZ(1)/0.035 OOM1F405.611
ENDDO OOM1F405.612
ELSE OOM1F405.613
DO I=1,IMT OOM1F405.614
WATERFLUX_ICE(I)=0.0 OOM1F405.615
WATERFLUX_ICEP(I)=0.0 OOM1F405.616
ENDDO OOM1F405.617
ENDIF OOM1F405.618
ORH1F305.2171
ORH1F305.2172
ORH1F305.2173
! Populate the appropriate arrays with data obtained from ORH1F305.2174
! UPANCIL ORH1F305.2175
IF (L_OMIXLAY) THEN ORH1F305.2176
DO I = 1, IMT ORH1F305.2177
WME(I) = ZDUM_OR_WME(I) ORH1F305.2178
ENDDO ORH1F305.2179
ENDIF ORH1F305.2180
ORH1F305.2181
IF (L_OSOLAR.OR.L_OSOLARAL) THEN ORH1F305.2182
DO I = 1, IMT ORH1F305.2183
SOL(I) = ZDUM_OR_SOL(I) ORH1F305.2184
ENDDO ORH1F305.2185
ENDIF ORH1F305.2186
ORH1F305.2187
IF (L_SEAICE) THEN ORH1F305.2188
DO I = 1, IMT ORH1F305.2189
SNOWRATE(I) = ZDUM_OR_SNOWRATE(I) ORH1F305.2190
ENDDO ORH1F305.2191
ENDIF ORH1F305.2192
ORH1F305.2193
IF (L_OMIXLAY) THEN ORH1F305.2194
DO I = 1, IMT ORH1F305.2195
WME(I) = ZDUM_OR_WME(I) ORH1F305.2196
ENDDO ORH1F305.2197
ENDIF ORH1F305.2198
ORH1F305.2199
IF (L_OHANEY.OR.L_OPSEUDIC) THEN ORH1F305.2200
DO I = 1, IMT ORH1F305.2201
T_REF(I) = ZDUM_OR_T_REF(I) ORH1F305.2202
S_REF(I) = ZDUM_OR_S_REF(I) ORH1F305.2203
ENDDO ORH1F305.2204
ENDIF ORH1F305.2205
ORH1F305.2206
IF (L_RIVERS) THEN ORH1F305.2207
DO I = 1, IMT ORH1F305.2208
RIVER(I) = ZDUM_OR_RIVER(I) ORH1F305.2209
ENDDO ORH1F305.2210
ENDIF ORH1F305.2211
ORH1F305.2212
IF (L_OSYMM) THEN ORH1F305.2213
C ROWCALC.675
C--------------------------------------------------------------------- ROWCALC.676
C SET SYMMETRY BOUNDARY CONDITIONS ON LAST ROW ROWCALC.677
C--------------------------------------------------------------------- ROWCALC.678
C ROWCALC.679
IF(J+J_OFFSET.EQ.JMTM1_GLOBAL) THEN ORH3F402.256
DO 335 I=1,IMT ORH1F305.2215
KMTP(I)=FKMP(I,J) ORH1F305.2216
KMUP(I)=FKMQ(I,J-1) ORH1F305.2217
335 CONTINUE ORH1F305.2218
IF (L_OBIMOM.or.L_OBIHARMGM) THEN OOM3F405.837
DO I=1,IMT OOM3F405.838
KMUPP(I)=FKMQ (I,J) OOM3F405.839
ENDDO OOM3F405.840
ENDIF ! L_OBIMOM or L_OBIHARMGM OOM3F405.841
DO 336 M=1,NT ORH1F305.2219
DO 336 K=1,KM ORH1F305.2220
DO 336 I=1,IMT ORH1F305.2221
TBP(I,K,M)=TB(I,K,M) ORH1F305.2222
T P(I,K,M)=T (I,K,M) ORH1F305.2223
336 CONTINUE ORH1F305.2224
ENDIF ORH1F305.2225
ENDIF ROWCALC.691
C ROWCALC.693
C--------------------------------------------------------------------- ROWCALC.694
C MOVE TAU-1 DATA TO TAU LEVEL ON A MIXING TIMESTEP ROWCALC.695
C--------------------------------------------------------------------- ROWCALC.696
C ROWCALC.697
IF(MIX.EQ.1) THEN ROWCALC.698
IF (.NOT.(L_OBIMOM.or.L_OBIHARMGM)) THEN OOM3F405.842
DO 337 M=1,NT ROWCALC.699
DO 337 K=1,KM ROWCALC.700
DO 337 I=1,IMT ROWCALC.701
TBP(I,K,M)=TP(I,K,M) ROWCALC.702
337 CONTINUE ROWCALC.703
DO 338 K=1,KM ROWCALC.704
DO 338 I=1,IMT ROWCALC.705
UBP(I,K)=UP(I,K) ROWCALC.706
VBP(I,K)=VP(I,K) ROWCALC.707
338 CONTINUE ROWCALC.708
ELSE OOM3F405.843
DO M=1,NT OOM3F405.844
DO K=1,KM OOM3F405.845
DO I=1,IMT OOM3F405.846
TBPP(I,K,M)=TPP(I,K,M) OOM3F405.847
ENDDO OOM3F405.848
ENDDO OOM3F405.849
ENDDO OOM3F405.850
DO K=1,KM OOM3F405.851
DO I=1,IMT OOM3F405.852
UBPP(I,K)=UPP(I,K) OOM3F405.853
VBPP(I,K)=VPP(I,K) OOM3F405.854
ENDDO OOM3F405.855
ENDDO OOM3F405.856
ENDIF ! not L_OBIMOM.or.L_OBIHARMGM OOM3F405.857
OOM3F405.858
ENDIF ROWCALC.709
C ROWCALC.710
C--------------------------------------------------------------------- ROWCALC.711
C SHIFT MASKS DOWN ONE ROW AND COMPUTE NEW MASKS ROWCALC.712
C--------------------------------------------------------------------- ROWCALC.713
C ROWCALC.714
DO 345 K=1,KM ROWCALC.715
DO 345 I=1,IMT ROWCALC.716
FMM(I,K)=FM (I,K) ROWCALC.717
FM (I,K)=FMP(I,K) ROWCALC.718
345 CONTINUE ROWCALC.719
ORH1F305.2231
DO 354 K=1,KM ROWCALC.730
DO 354 I=1,IMT ROWCALC.731
IF(KMTP(I).GE.KAR(K)) THEN ROWCALC.732
FMP(I,K)=1.0 ROWCALC.733
ELSE ROWCALC.734
FMP(I,K)=0.0 ROWCALC.735
ENDIF ROWCALC.736
IF(KMU(I).GE.KAR(K)) THEN ROWCALC.737
GM(I,K)=1.0 ROWCALC.738
ELSE ROWCALC.739
GM(I,K)=0.0 ROWCALC.740
ENDIF ROWCALC.741
354 CONTINUE ROWCALC.742
IF (L_OBIMOM.or.L_OBIHARMGM) THEN OOM3F405.859
DO K=1,KM OOM3F405.860
DO I=1,IMT OOM3F405.861
IF(KMTPP(I).GE.KAR(K)) THEN OOM3F405.862
FMPP(I,K)=1.0 OOM3F405.863
ELSE OOM3F405.864
FMPP(I,K)=0.0 OOM3F405.865
ENDIF OOM3F405.866
ENDDO OOM3F405.867
ENDDO OOM3F405.868
ENDIF ! L_OBIMOM.or.L_OBIHARMGM OOM3F405.869
OOM3F405.870
OOM3F405.871
C ROWCALC.743
IF (L_OBDY_NORTH) THEN OSI1F405.25
C ROWCALC.745
C "Row JMTM2" velocities are set equal to Row JMTM1 velocities ROWCALC.746
C before the calls to CLINIC and TRACER. ROWCALC.747
C ROWCALC.748
IF(J+J_OFFSET.EQ.JMTM2_GLOBAL)THEN ORH3F402.258
DO 355 K=1,KM ORH1F305.2234
DO 355 I=1,IMT ORH1F305.2235
UP(I,K)=U(I,K) ORH1F305.2236
VP(I,K)=V(I,K) ORH1F305.2237
UBP(I,K)=UB(I,K) ORH1F305.2238
VBP(I,K)=VB(I,K) ORH1F305.2239
355 CONTINUE ORH1F305.2240
ENDIF ORH1F305.2241
ENDIF ! L_OBDY_NORTH = true OSI1F405.26
IF (L_OBDY_NORTH.AND.(J+J_OFFSET.EQ.JMTM1_GLOBAL)) THEN OSI1F405.27
DO K = 1, KM OSI1F405.28
DO I = 1, IMT OSI1F405.29
FMP(I,K)=FM(I,K) OSI1F405.30
ENDDO OSI1F405.31
ENDDO OSI1F405.32
ENDIF OSI1F405.33
ORH1F305.2246
IF (L_SEAICE) THEN ORH1F305.2247
IF (L_ICEFREEDR.AND.L_OMIXLAY) THEN ODC1F405.399
C--------------------------------------------------------------------- JT161193.298
C Calculate wind mixing energy under sea ice for dynamic ice model JT161193.299
C - no longer contains keel stirring term ORH0F400.30
C--------------------------------------------------------------------- JT161193.300
C JT161193.301
do i=1,imt ORH1F305.2249
wme_ice(i) = wme(i) ORH1F305.2254
end do ORH1F305.2256
ORH1F305.2257
IF (L_OCYCLIC) THEN ORH1F305.2258
wme_ice(1) = wme_ice(imtm1) ORH1F305.2259
wme_ice(imt) = wme_ice(2) ORH1F305.2260
ENDIF ORH1F305.2261
C JT161193.314
ENDIF ORH1F305.2262
ENDIF ORH1F305.2263
C--------------------------------------------------------------------- ROWCALC.768
C CALL THE MAIN COMPUTATIONAL ROUTINES TO UPDATE THE ROW ROWCALC.769
C--------------------------------------------------------------------- ROWCALC.770
C ROWCALC.771
C OOM1F405.619
IF (L_OFULARGE) THEN OOM1F405.620
C CALCULATE MLD_LARGE, MLD_LARGEP ON TRACER GRID OOM1F405.621
C OOM1F405.622
CALL STATED(TB(1,1,1),TB(1,1,2),RHO,WORKA,WORKB,IMT,KM OOM1F405.623
& ,J,KM,JMT OOM1F405.624
& ) OOM1F405.625
CALL STATED(TBP(1,1,1),TBP(1,1,2),RHOP,WORKA,WORKB,IMT,KM OOM1F405.626
& ,J,KM,JMT OOM1F405.627
& ) OOM1F405.628
C OOM1F405.629
IF (L_OBULKRI) THEN OOM1F405.630
CALL CALC_MLD_LARGEB(J,KM,IMT,NT OOM1F405.631
&, RHO_WATER_SI,GRAV_SI,SPECIFIC_HEAT_SI,CRIT_RI_FL OOM1F405.632
&, ZDZ,DZ,ZDZZ,DZZ,L_OCYCLIC,L_SEAICE OOM1F405.633
&, UB,VB,UBM,VBM,TB,RHO,HTN OOM1F405.634
&, PME,WATERFLUX_ICE,SOL,WME OOM1F405.635
&, OCEANHEATFLUX(1,J),CARYHEAT(1,J),FLXTOICE(1,J) OOM1F405.636
&, FM,MLD_LARGE,RIMLDCALC OOM1F405.637
& ) OOM1F405.638
CALL CALC_MLD_LARGEB(J,KM,IMT,NT OOM1F405.639
&, RHO_WATER_SI,GRAV_SI,SPECIFIC_HEAT_SI,CRIT_RI_FL OOM1F405.640
&, ZDZ,DZ,ZDZZ,DZZ,L_OCYCLIC,L_SEAICE OOM1F405.641
&, UBP,VBP,UB,VB,TBP,RHOP,HTNP OOM1F405.642
&, PMEP,WATERFLUX_ICEP,SOLP,WMEP OOM1F405.643
&, OCEANHEATFLUX(1,J+1),CARYHEAT(1,J+1),FLXTOICE(1,J+1) OOM1F405.644
&, FMP,MLD_LARGEP,RIMLDCALCP OOM1F405.645
& ) OOM1F405.646
ELSE OOM1F405.647
CALL CALC_MLD_LARGEG(J,KM,IMT OOM1F405.648
&, RHO_WATER_SI,GRAV_SI,CRIT_RI_FL,NO_LAYERS_IN_LEV OOM1F405.649
&, ZDZ,DZ,DZZ,L_OCYCLIC OOM1F405.650
&, UB,VB,UBM,VBM OOM1F405.651
&, FM,RHO,MLD_LARGE,RIMLDCALC OOM1F405.652
& ) OOM1F405.653
CALL CALC_MLD_LARGEG(J,KM,IMT OOM1F405.654
&, RHO_WATER_SI,GRAV_SI,CRIT_RI_FL,NO_LAYERS_IN_LEV OOM1F405.655
&, ZDZ,DZ,DZZ,L_OCYCLIC OOM1F405.656
&, UBP,VBP,UB,VB OOM1F405.657
&, FMP,RHOP,MLD_LARGEP,RIMLDCALCP OOM1F405.658
& ) OOM1F405.659
ENDIF OOM1F405.660
ENDIF !L_OFULARGE OOM1F405.661
C OOM1F405.662
IF (L_ICEFREEDR.OR.L_ICESIMPLE) THEN ODC1F405.407
ORH3F403.44
!---------------------------------------------------------------------- ORH3F403.45
! STORE SURFACE CURRENTS FOR USE BY DYNAMIC SEA ICE MODEL ORH3F403.46
!---------------------------------------------------------------------- ORH3F403.47
! The following was previously coded as ORH3F403.48
! UCURRENT(I,J+1) = 1.0*UP(I,1)/100 etc immediately after call to ORH3F403.49
! CLINIC - changed J dependencies for parallelisation. ORH3F403.50
ORH3F403.51
IF (J+J_OFFSET.LT.JMT_GLOBAL) THEN ORH3F403.52
DO I=1,IMT ORH3F403.53
UCURRENT(I,J) = 1.0*U(I,1)/100. ORH3F403.54
VCURRENT(I,J) = 1.0*V(I,1)/100. ORH3F403.55
END DO ORH3F403.56
ENDIF ORH3F403.57
ENDIF ORH3F403.59
IF (SFRC) THEN OJC2F400.120
DO K=1,KM OJC2F400.121
DO I=1,IMT_STASH OJC2F400.122
DTRC(I,J,K)=TB(I,K,1) OJC2F400.123
ENDDO OJC2F400.124
ENDDO OJC2F400.125
ENDIF OJC2F400.126
C OJC2F400.127
IF (SFUTOT) THEN OJG5F401.8
DO K=1,KM OJG5F401.9
DO I=1,IMT_STASH OJG5F401.10
UTOT(I,J,K)=U(I,K) OJG5F401.11
ENDDO OJG5F401.12
ENDDO OJG5F401.13
ENDIF OJG5F401.14
IF (SFVTOT) THEN OJG5F401.15
DO K=1,KM OJG5F401.16
DO I=1,IMT_STASH OJG5F401.17
VTOT(I,J,K)=V(I,K) OJG5F401.18
ENDDO OJG5F401.19
ENDDO OJG5F401.20
ENDIF OJG5F401.21
IF (SFTemp) THEN OMB1F404.138
CALL STATE_T(T(1,1,1),T(1,1,2),Temp_row, OMB1F404.139
& TWORK,SWORK,IMT,KM OMB1F404.140
&, J,JMT OMB1F404.141
&) OMB1F404.142
OMB1F404.143
DO K=1,KM OMB1F404.144
DO I=1,IMT_STASH OMB1F404.145
Temperature(I,J,K)=Temp_row(I,K) OMB1F404.146
ENDDO OMB1F404.147
ENDDO OMB1F404.148
OMB1F404.149
ENDIF ! SFTemp OMB1F404.150
OMB1F404.151
ENDIF ! If we have something to do for this row ORH1F403.39
IF (L_SEAICE.AND.L_ICEFREEDR) THEN ODC1F405.400
J_idr = J ODC1F405.401
J_idrM1 = J-1 ODC1F405.402
ELSE ORH1F305.2266
J_idr = 1 ODC1F405.403
J_idrM1 = 1 ODC1F405.404
ENDIF ORH1F305.2268
ORH1F305.2269
ORH1F403.40
! Using MIN operations in setting pointers for J+1 OOM1F405.663
! elements ensures we never go out of bounds even OOM1F405.664
! when some PEs deal with irregular numbers of rows OOM1F405.665
! in MPP decompositions. OOM1F405.666
J_P1 = MIN(J+1,JMT) OOM1F405.667
OOM1F405.668
! Set up pointers for ice model related arrays OOM1F405.669
IF (L_SEAICE) THEN OOM1F405.670
J_ICE = MIN(J,JMT) OOM1F405.671
J_ICEP1 = MIN(J + 1,JMT) OOM1F405.672
IF (L_IHANEY) THEN OOM1F405.673
J_IHY = J OOM1F405.674
ELSE OOM1F405.675
J_IHY = 1 OOM1F405.676
ENDIF OOM1F405.677
ELSE OOM1F405.678
J_ICE = 1 OOM1F405.679
J_ICEP1 = 1 OOM1F405.680
J_IHY = 1 OOM1F405.681
ENDIF OOM1F405.682
OOM1F405.683
ORH1F305.2271
CALL CLINIC( ORH1F305.2272
*CALL ARGSIZE @DYALLOC.4319
*CALL ARGOCALL @DYALLOC.4320
*CALL ARGOINDX ORH7F402.285
& J, @DYALLOC.4321
*CALL COCAROWS ROWCALC.774
&, @DYALLOC.4322
*CALL COCAWRKA ROWCALC.775
+,RHOSRN,RHOSRNA,RHOSRNB OOM1F405.687
+,LL_ASS_BTRP,DU_ASS_BTRP,DV_ASS_BTRP ROWCALC.781
&,sf285_30 OFRAF404.64
&,ISX(1,J_idr),ISY(1,J_idr) ODC1F405.405
&,WSX_LEADS(1,J_idr),WSY_LEADS(1,J_idr) ODC1F405.406
&,IMT_GNU,KM_GNU,IMU_GNUZ,KM_GNUZ ORH1F305.2275
&,IMT_idr ORH1F405.474
&,gnum,Rim,hm,IMT_QLARGE OLA3F403.229
&,L_M,MLD_LARGE,MLD_LARGEP,WATERFLUX_ICE,LAMBDA_LARGE OOM1F405.684
&,HTNP,PMEP,WATERFLUX_ICEP,SOLP,WMEP OOM1F405.685
&,L_OWINDMIX,L_OBULKMAXMLD OOM1F405.686
&,OCEANHEATFLUX(1,J),OCEANHEATFLUX(1,J_P1) OOM1F405.688
&,CARYHEAT(1,J_ICE),CARYHEAT(1,J_ICEP1) OOM1F405.689
&,FLXTOICE(1,J_ICE),FLXTOICE(1,J_ICEP1) ) OOM1F405.690
C ROWCALC.785
IF (J.GE.J_FROM_COMP.AND.J.LE.J_TO_COMP) THEN ORH1F403.41
ORH1F403.42
ORH1F305.2278
ORH1F305.2289
IF ((.NOT.L_ONOCLIN).AND.(.NOT.L_OFREESFC)) THEN ORL1F404.851
C JG170893.122
C Save baroclinic acceleration diagnostics JG170893.123
C JG170893.124
IF (SF_ZN(1)) THEN JG170893.125
DO I=1,SWNCOL JG170893.126
SWZUN(I,J) = ZU(I,J)/C2DTSF OJG2F400.2
ENDDO JG170893.128
ENDIF JG170893.129
IF (SF_ZN(2)) THEN JG170893.130
DO I=1,SWNCOL JG170893.131
SWZVN(I,J) = ZV(I,J)/C2DTSF OJG2F400.3
ENDDO JG170893.133
ENDIF JG170893.134
ENDIF ORH1F305.2299
ENDIF ! If we have something to do for this row ORH1F403.43
ORH1F403.44
ORH1F305.2300
ORH1F305.2312
IF (L_FLUXCORR) THEN ORH1F305.2313
J_FLUX = J ORH1F305.2314
ELSE ORH1F305.2315
J_FLUX = 1 ORH1F305.2316
ENDIF ORH1F305.2317
IF (L_OCARBON) THEN OCN1F405.10
! set up row of CO2 data. Either get values of varying field OCN1F405.11
! from D1, or fill with constant value from PCO2_ATM OCN1F405.12
IF (L_CO2O_INTERACTIVE) THEN OCN1F405.13
DO I=1,IMT OCN1F405.14
ATMPCO2_ROW(I)=D1(joc_atmco2 + (J-1)*IMT + I-1) OCN1F405.15
ENDDO OCN1F405.16
ELSE OCN1F405.17
DO I=1,IMT OCN1F405.18
ATMPCO2_ROW(I)=PCO2_ATM OCN1F405.19
ENDDO OCN1F405.20
ENDIF OCN1F405.21
ENDIF ! If L_OCARBON OCN1F405.22
ORH1F305.2318
CALL TRACER( @DYALLOC.4328
*CALL ARGSIZE @DYALLOC.4329
*CALL ARGOCALL @DYALLOC.4330
*CALL ARGOINDX ORH7F402.286
& J, @DYALLOC.4331
& AICE(1,J_ICE),HICE(1,J_ICE),HSNOW(1,J_ICE), ORH1F305.2319
& HICE_REF(1,J_IHY), ORH1F305.2320
& CARYHEAT(1,J_ICE),CARYSALT(1,J_ICE), ORH1F305.2321
& ICY(1,J_ICE),FLXTOICE(1,J_ICE), ORH1F305.2322
& SURFTEMP(1,J_ICE),SURFSAL(1,J_ICE),NEWICE(1,J_ICE), ORH1F305.2323
& OCEANHEATFLUX(1,J_ICE),OCEANSNOWRATE(1,J_ICE), OJC2F400.128
& WME_ICE, JT161193.329
*CALL COCAROWS ROWCALC.823
&, @DYALLOC.4332
*CALL COCAWRKA ROWCALC.824
&,fluxcorh(1,J_FLUX),fluxcorw(1,J_FLUX) ORH1F305.2324
+,HEATSINK(1,J) OJG0F401.1
&,anom_heat,anom_salt ORH1F305.2325
&,anomiceh(1,j_IHY) ORH1F305.2326
+,DIAGSW OJG1F400.14
&,WSXM,WSYM OLA3F403.230
&,ISX(1,J_idr),ISY(1,J_idr),WSX_LEADS(1,J_idr) ODC1F405.409
&,WSY_LEADS(1,J_idr),ISX(1,J_idrM1),ISY(1,J_idrM1) ODC1F405.410
&,WSX_LEADS(1,J_idrM1),WSY_LEADS(1,J_idrM1) ODC1F405.411
&,gnuT,RiT,hT OLA3F403.231
&,L_T,MLD_LARGE,WATERFLUX_ICE,L_OWINDMIX OOM1F405.691
&,L_OBULKMAXMLD,LAMBDA_LARGE OOM1F405.692
&,SWNCOL,DTXADV,DTYADV,DTZADV,DTXDIFF,DTYDIFF,DTZDIFF JG170893.137
&,DTSFC,DTPEN,DTICE,DTMIX,DTCNVC,DTZ,DTFF,DTMED,SF_DT JG170893.138
&,dsxadv,dsyadv,dszadv,dsxdiff,dsydiff,dszdiff OJG2F401.268
&,dssfc,dsice,dsmix,dscnvc,dsz,dsff,dsmed,sf_ds OJG2F401.269
&,swrk_bio(si_bio(1)),swrk_bio(si_bio(2)),swrk_bio(si_bio(3)) ORH3F405.52
&,swrk_bio(si_bio(4)),swrk_bio(si_bio(5)),swrk_bio(si_bio(6)) ORH3F405.53
&,swrk_bio(si_bio(7)),swrk_bio(si_bio(8)),swrk_bio(si_bio(9)) ORH3F405.54
&,swrk_bio(si_bio(10)),swrk_bio(si_bio(11)),swrk_bio(si_bio(12)) ORH3F405.55
&,swrk_bio(si_bio(13)),swrk_bio(si_bio(14)),swrk_bio(si_bio(15)) ORH3F405.56
&,swrk_bio(si_bio(16)),swrk_bio(si_bio(17)),swrk_bio(si_bio(18)) ORH3F405.57
&,swrk_bio(si_bio(19)),swrk_bio(si_bio(20)),swrk_bio(si_bio(21)) ORH3F405.58
&,swrk_bio(si_bio(22)),swrk_bio(si_bio(23)),swrk_bio(si_bio(24)) ORH3F405.59
&,swrk_bio(si_bio(25)),swrk_bio(si_bio(26)),swrk_bio(si_bio(27)) ORH3F405.60
&,sf_bio ORH3F405.61
&,DIAG_MLD ORH1F305.2337
&,PCO2,CO2_FLUX,PCO2_ATM ! Required for carbon cycle model ORH1F305.2338
&,ATMPCO2_ROW OCN1F405.23
&,c14to12_atm !required for carbon-14 ORH1F305.2339
&,INVADE,EVADE ORH1F305.2340
&,VTCO2_FLUX,VALK_FLUX OJP0F404.927
&,RHOSRN,RHOSRNA,RHOSRNB OOM1F405.693
&,tmin2 OLA2F403.304
&,esav,rxp,ry,rrzp ORH1F305.2342
&,drhob1p,drhob2p OLA0F401.209
&,UISOP,VISOPN,VISOPS,WISOP,DTGM,DSGM OJG2F404.86
&,athkdftu,athkdftv,FTARR ORH1F405.508
&,IMT_IPD_NOMIX ! For dynamic allocation ORH1F405.509
ORH1F405.510
&,ATTEND,HUDTEND OOM2F405.286
OOM2F405.287
&,adv_vetiso,adv_vbtiso,times,srho OOM1F405.90
OOM1F405.91
& ) ROWCALC.843
C ROWCALC.844
IF (J.GE.J_FROM_COMP.AND.J.LE.J_TO_COMP) THEN ORH1F403.45
if ((L_OISOPYCGM.AND.L_OVISBECK).or.(L_OISOGM.AND.L_OVISBECK)) OOM1F405.92
& THEN OOM1F405.93
c Save time scale tmin1 so isopycnal thickness diffusion coeff. OLA2F403.307
c can be calculated for Visbeck scheme OLA2F403.308
if (.NOT.L_OVISHADCM4) then OOM1F405.94
do i=1,imt OLA2F403.309
tmin1(i,j)=sqrt(tmin2(i)) OLA2F403.310
enddo OLA2F403.311
else OOM1F405.95
do i=1,imt OOM1F405.96
tmin1(i,j)=times(i) OOM1F405.97
enddo OOM1F405.98
endif OOM1F405.99
endif OLA2F403.312
! Now resume the code as normal. ORH1F405.475
IF (J.GE.J_2.AND.J.LE.J_JMTM1) THEN ORH1F405.476
ORH1F405.477
IF (L_OSYMM.OR.(J+J_OFFSET.NE.JMTM1_GLOBAL)) THEN ORH1F405.478
ORH1F405.479
ORH1F405.480
IF (L_OCYCLIC) THEN ORH1F405.481
C--------------------------------------------------------------------- ORH1F405.482
C SET CYCLIC BOUNDARY CONDITIONS ON NEWLY COMPUTED INTERNAL MODE ORH1F405.483
C--------------------------------------------------------------------- ORH1F405.484
DO K=1,KM ORH1F405.485
UA(1,K)=UA(IMUM1,K) ORH1F405.486
VA(1,K)=VA(IMUM1,K) ORH1F405.487
UA(IMU,K)=UA(2,K) ORH1F405.488
VA(IMU,K)=VA(2,K) ORH1F405.489
ENDDO ORH1F405.490
ENDIF ORH1F405.491
ORH1F405.492
IF (L_OSYMM) THEN ORH1F405.493
C--------------------------------------------------------------------- ORH1F405.494
C SET MERIDIONAL COMPONENT OF INTERNAL MODE TO ZERO ON SYMMETRY ROW ORH1F405.495
C--------------------------------------------------------------------- ORH1F405.496
IF (J+J_OFFSET.EQ.JMTM1_GLOBAL) THEN ORH1F405.497
FX=0.0 ORH1F405.498
DO K=1,KM ORH1F405.499
DO I=1,IMT ORH1F405.500
VA(I,K)=FX ORH1F405.501
ENDDO ORH1F405.502
ENDDO ORH1F405.503
ENDIF ORH1F405.504
ENDIF ORH1F405.505
ENDIF ORH1F405.506
ENDIF ORH1F405.507
IF (L_OBDY_NORTH) THEN OSI1F405.34
C ROWCALC.846
C ORH1F405.511
C Save UA and VA for Row JMTM2 ORH1F405.512
C ORH1F405.513
IF (J+J_OFFSET.EQ.JMTM2_GLOBAL) THEN ORH1F405.514
DO K=1,KM ORH1F405.515
DO I=1,IMT ORH1F405.516
UAM2(I,K)=UA(I,K) ORH1F405.517
VAM2(I,K)=VA(I,K) ORH1F405.518
ENDDO ORH1F405.519
ENDDO ORH1F405.520
ENDIF ORH1F405.521
C Enter UA,VA at JMTM2 as UA,VA at JMTM1 ROWCALC.847
C ROWCALC.848
IF(J+J_OFFSET.EQ.JMTM1_GLOBAL) THEN ORH3F402.263
DO 357 K=1,KM ORH1F305.2346
DO 357 I=1,IMT ORH1F305.2347
UA(I,K)=UAM2(I,K) ORH1F305.2348
VA(I,K)=VAM2(I,K) ORH1F305.2349
357 CONTINUE ORH1F305.2350
ENDIF ORH1F305.2351
ENDIF ROWCALC.855
C ROWCALC.857
C----------------------------------------------------------------------- ROWCALC.858
C Copy velocities at base of model levels to STASH workspace ROWCALC.859
C----------------------------------------------------------------------- ROWCALC.860
C ROWCALC.861
IF (sf201_30) THEN ROWCALC.862
DO K=2,KM ROWCALC.863
DO I=IFROM_CYC,ICOL_CYC ORH1F305.2352
sw201_30(I,J,K-1)=W(I,K)*FM(I,K)+(1.0-FM(I,K))*RMDI ROWCALC.870
END DO ROWCALC.871
IF (L_OCYCLIC) THEN ORH1F305.2353
sw201_30(1,J,K-1)=W(IMTM1,K)*FM(IMTM1,K)+ ORH1F305.2354
* (1.0-FM(IMTM1,K))*RMDI ROWCALC.874
ENDIF ORH1F305.2355
END DO ROWCALC.876
END IF ROWCALC.877
C ROWCALC.878
OLA3F403.232
c put the 2d values from gnum,gnuT,Rim,RiT into the output OLA3F403.233
c (3d) variables gnum_OUT,gnuT_OUT,Rim_OUT,RiT_OUT OLA3F403.234
IF (SF_gnum) THEN OLA3F403.235
do k=1,kmm1 OLA3F403.236
do i=1,swncol OLA3F403.237
gnum_OUT(i,j,k)=gnum(i,k) OLA3F403.238
enddo OLA3F403.239
enddo OLA3F403.240
END IF OLA3F403.241
IF (SF_gnuT) THEN OLA3F403.242
do k=1,kmm1 OLA3F403.243
do i=1,swncol OLA3F403.244
gnuT_OUT(i,j,k)=gnuT(i,k) OLA3F403.245
enddo OLA3F403.246
enddo OLA3F403.247
END IF OLA3F403.248
IF (SF_Rim) THEN OLA3F403.249
do k=1,kmm1 OLA3F403.250
do i=1,swncol OLA3F403.251
Rim_OUT(i,j,k)=Rim(i,k) OLA3F403.252
enddo OLA3F403.253
enddo OLA3F403.254
END IF OLA3F403.255
IF (SF_RiT) THEN OLA3F403.256
do k=1,kmm1 OLA3F403.257
do i=1,swncol OLA3F403.258
RiT_OUT(i,j,k)=RiT(i,k) OLA3F403.259
enddo OLA3F403.260
enddo OLA3F403.261
END IF OLA3F403.262
OLA3F403.263
c For the quadratic Large scheme, put the 2d values from hm,hT into OLA3F403.264
c the output (3d) variables hm_OUT,hT_OUT OLA3F403.265
IF (SF_hm) THEN OLA3F403.266
do i=1,swncol OLA3F403.267
hm_OUT(i,j)=hm(i) OLA3F403.268
enddo OLA3F403.269
END IF OLA3F403.270
IF (SF_hT) THEN OLA3F403.271
do i=1,swncol OLA3F403.272
hT_OUT(i,j)=hT(i) OLA3F403.273
enddo OLA3F403.274
END IF OLA3F403.275
C PUT THE 2D VALUES FROM L_T,L_M,RIMLDCALC INTO THE OUTPUT OOM1F405.694
C (3D) VARIABLES LM_OUT,LT_OUT,RIMLDCALC_OUT OOM1F405.695
IF (SF_LM) THEN OOM1F405.696
DO I=1,IMT_STASH OOM1F405.697
LM_OUT(I,J)=L_M(I)*0.01 OOM1F405.698
ENDDO OOM1F405.699
END IF OOM1F405.700
IF (SF_LT) THEN OOM1F405.701
DO I=1,IMT_STASH OOM1F405.702
LT_OUT(I,J)=L_T(I)*0.01 OOM1F405.703
ENDDO OOM1F405.704
END IF OOM1F405.705
IF (SF_MLDCALC) THEN OOM1F405.706
DO K=1,KMM1 OOM1F405.707
DO I=1,IMT_STASH OOM1F405.708
RIMLDCALC_OUT(I,J,K)=RIMLDCALC(I,K) OOM1F405.709
ENDDO OOM1F405.710
ENDDO OOM1F405.711
ENDIF OOM1F405.712
C Put the 2d values from UISOP,VISOPN,WISOP,DTGM,DSGM into the output OJG2F404.87
C (3d) variables UISOP_OUT,VISOPN_OUT,WISOP_OUT,DTGM_OUT,DSGM_OUT OJG2F404.88
OLA0F401.213
IF (SF_UISOP) THEN OLA0F401.214
IF (L_OISOGM) THEN OOM1F405.100
do k=1,km OOM1F405.101
do i=1,swncol OOM1F405.102
UISOP_OUT(i,j,k)=adv_vetiso(i,k) OOM1F405.103
enddo OOM1F405.104
enddo OOM1F405.105
ELSE OOM1F405.106
do k=1,km OLA0F401.215
do i=1,swncol OLA0F401.216
UISOP_OUT(i,j,k)=UISOP(i,k) OLA0F401.217
enddo OLA0F401.218
enddo OLA0F401.219
ENDIF OOM1F405.107
END IF OLA0F401.220
OLA0F401.221
IF (SF_VISOP) THEN OLA0F401.222
IF (L_OISOGM) THEN OOM1F405.108
do k=1,km OOM1F405.109
do i=1,swncol OOM1F405.110
VISOPN_OUT(i,j,k)=adv_vntiso(i,k,1) OOM1F405.111
enddo OOM1F405.112
enddo OOM1F405.113
ELSE OOM1F405.114
do k=1,km OLA0F401.223
do i=1,swncol OLA0F401.224
VISOPN_OUT(i,j,k)=VISOPN(i,k) OLA0F401.225
enddo OLA0F401.226
enddo OLA0F401.227
ENDIF OOM1F405.115
END IF OLA0F401.228
OLA0F401.229
IF (SF_WISOP) THEN OLA0F401.230
IF (L_OISOGM) THEN OOM1F405.116
do k=1,km-1 OOM1F405.117
do i=1,swncol OOM1F405.118
WISOP_OUT(i,j,k)=adv_vbtiso(i,k) OOM1F405.119
enddo OOM1F405.120
enddo OOM1F405.121
ELSE OOM1F405.122
do k=1,km-1 OLA0F401.231
do i=1,swncol OLA0F401.232
WISOP_OUT(i,j,k)=WISOP(i,k+1) OLA0F401.233
enddo OLA0F401.234
enddo OLA0F401.235
ENDIF OOM1F405.123
END IF OLA0F401.236
OLA0F401.237
IF (SF_DTGM) THEN OLA0F401.238
do k=1,km OLA0F401.239
do i=1,swncol OLA0F401.240
DTGM_OUT(i,j,k)=DTGM(i,k) OLA0F401.241
enddo OLA0F401.242
enddo OLA0F401.243
END IF OLA0F401.244
OJG2F404.89
IF (SF_DSGM) THEN OJG2F404.90
do k=1,km OJG2F404.91
do i=1,swncol OJG2F404.92
DSGM_OUT(i,j,k)=DSGM(i,k) OJG2F404.93
enddo OJG2F404.94
enddo OJG2F404.95
END IF OJG2F404.96
IF (L_OMIXLAY.AND.(.NOT.(L_OISOPYC))) THEN ORH1F305.2356
C----------------------------------------------------------------------- ROWCALC.880
C Copy mixed layer depth to STASH workspace. If isopycnal diffusion ROWCALC.881
C scheme (option L) is called then mixed layer depth is a prognostic ROWCALC.882
C variable and should be diagnosed from section 00. ROWCALC.883
C----------------------------------------------------------------------- ROWCALC.884
C ROWCALC.885
IF (sf202_30) THEN ROWCALC.886
DO I=1,ICOL_CYC ORH1F305.2357
sw202_30(I,J)=diag_mld(I)*FM(I,1)+(1.0-FM(I,1))*RMDI ROWCALC.895
END DO ROWCALC.896
END IF ROWCALC.897
C ROWCALC.898
ENDIF ORH1F305.2358
ORH1F305.2359
IF (L_OHANEY) THEN ORH1F305.2360
C----------------------------------------------------------------------- ROWCALC.901
C Copy anomalous fluxes of heat and salinity to STASH workspace ROWCALC.902
C----------------------------------------------------------------------- ROWCALC.903
C ROWCALC.904
IF (sf203_30) THEN ORH1F305.2361
DO I=1,ICOL_CYC ORH1F305.2362
sw203_30(I,J)=anom_heat(I)*FM(I,1)+(1.0-FM(I,1))*RMDI ORH1F305.2363
END DO ORH1F305.2364
END IF ORH1F305.2365
C ROWCALC.917
IF (sf204_30) THEN ORH1F305.2366
DO I=1,ICOL_CYC ORH1F305.2367
sw204_30(I,J)=anom_salt(I)*FM(I,1)+(1.0-FM(I,1))*RMDI ORH1F305.2368
END DO ORH1F305.2369
END IF ORH1F305.2370
C ROWCALC.930
ENDIF ORH1F305.2371
IF (L_SEAICE.AND.L_IHANEY) THEN ORH1F305.2372
C----------------------------------------------------------------------- ROWCALC.933
C Copy anomalous flux of sea ice heat to STASH workspace ROWCALC.934
C workspace ROWCALC.935
C----------------------------------------------------------------------- ROWCALC.936
C ROWCALC.937
IF (sf205_30) THEN ORH1F305.2373
DO I=1,ICOL_CYC ORH1F305.2374
sw205_30(I,J)=anomiceh(I,J)*FM(I,1)+(1.0-FM(I,1))*RMDI ORH1F305.2375
END DO ORH1F305.2376
END IF ORH1F305.2377
ENDIF ORH1F305.2378
ORH1F305.2379
IF (L_SEAICE) THEN ORH1F305.2380
C ROWCALC.952
C--------------------------------------------------------------------- ROWCALC.953
C Copy caryheat, the heat flux from ice to ocean due to resetting of ROWCALC.954
C ocean level 1 temperatures to -1.8 C, to STASH workspace. ROWCALC.955
C--------------------------------------------------------------------- ROWCALC.956
C ROWCALC.957
IF (sf208_30) THEN ORH1F305.2381
DO I=1,ICOL_CYC ORH1F305.2382
sw208_30(I,J)= caryheat(I,J)*FM(I,1) + (1.0-FM(I,1))*RMDI ORH1F305.2383
END DO ORH1F305.2384
END IF ORH1F305.2385
ENDIF ORH1F305.2386
C ROWCALC.971
IF (L_OCARBON) THEN ORH1F305.2387
C Copy PCO2 into STASH workspace NT071293.167
C----------------------------------------------------------------------- NT071293.168
C NT071293.169
IF (sf248_30) THEN ORH1F305.2388
DO I=1,ICOL_CYC ORH1F305.2389
sw248_30(I,J)=PCO2(I)*FM(I,1)+(1.0-FM(I,1))*RMDI NT071293.177
END DO ORH1F305.2390
END IF ORH1F305.2391
C NT071293.180
C----------------------------------------------------------------------- NT071293.181
C Copy CO2_FLUX into STASH workspace NT071293.182
C----------------------------------------------------------------------- NT071293.183
C NT071293.184
IF (sf249_30) THEN ORH1F305.2392
DO I=1,ICOL_CYC ORH1F305.2393
sw249_30(I,J)=CO2_FLUX(I)*FM(I,1)+(1.0-FM(I,1))*RMDI NT071293.192
END DO ORH1F305.2394
END IF ORH1F305.2395
C NT071293.195
C----------------------------------------------------------------------- NT071293.196
C Copy invasion into STASH workspace NT071293.197
C----------------------------------------------------------------------- NT071293.198
C NT071293.199
IF (sf250_30) THEN ORH1F305.2396
DO I=1,ICOL_CYC ORH1F305.2397
sw250_30(I,J)=invade(I)*FM(I,1)+(1.0-FM(I,1))*RMDI NT071293.207
END DO ORH1F305.2398
END IF ORH1F305.2399
C NT071293.210
C----------------------------------------------------------------------- NT071293.211
C Copy evasion into STASH workspace NT071293.212
C----------------------------------------------------------------------- NT071293.213
C NT071293.214
IF (sf251_30) THEN ORH1F305.2400
DO I=1,ICOL_CYC ORH1F305.2401
sw251_30(I,J)=evade(I)*FM(I,1)+(1.0-FM(I,1))*RMDI NT071293.222
END DO ORH1F305.2402
END IF ORH1F305.2403
OJP0F404.928
!----------------------------------------------------------------------- OJP0F404.929
! Copy Virtual fluxes into STASH workspace OJP0F404.930
!----------------------------------------------------------------------- OJP0F404.931
OJP0F404.932
IF (sf292_30) THEN OJP0F404.933
DO I=1,ICOL_CYC OJP0F404.934
sw292_30(I,J)=VTCO2_FLUX(I)*FM(I,1)+(1.0-FM(I,1))*RMDI OJP0F404.935
END DO OJP0F404.936
END IF OJP0F404.937
IF (sf293_30) THEN OJP0F404.938
DO I=1,ICOL_CYC OJP0F404.939
sw293_30(I,J)=VALK_FLUX(I)*FM(I,1)+(1.0-FM(I,1))*RMDI OJP0F404.940
END DO OJP0F404.941
END IF OJP0F404.942
C NT071293.225
C----------------------------------------------------------------------- NT071293.226
C NT071293.227
C----------------------------------------------------------------------- NT071293.228
C ACCUMULATE GLOBAL NET FLUX OF CO2 INTO THE OCEAN NT071293.229
C----------------------------------------------------------------------- NT071293.230
C NT071293.231
FX=CS(J)*DYT(J)*1.E-4 /(360.0*24.0*3600.0) NT071293.232
ORH1F305.2404
DO I=1,ICOL_CYC ORH1F305.2405
co2_tot = co2_tot + FX*DXT(I)*CO2_FLUX(I)*FM(I,1) ORH1F305.2406
ENDDO ORH1F305.2407
ENDIF ORH1F305.2408
C NT071293.242
C----------------------------------------------------------------------- NT071293.243
C----------------------------------------------------------------------- ROWCALC.972
C TIME FILTER THE TRACERS AND BAROCLINIC VELOCITIES TO PRODUCE ROWCALC.973
C NEW VALUES AT TIME LEVEL TAU. THE UNFILTERED TIME LEVEL TAU ROWCALC.974
C VALUES ON 'DISK' ARE THEN OVERWRITTEN WITH THE NEW SLAB (TF) ROWCALC.975
C Calculate the effective rate of change from filtering temperature JG170893.139
C and store it in stash workspace DTRF if this diagnostic requested JG170893.140
C Similarly for DSRF. OJG2F401.270
C----------------------------------------------------------------------- ROWCALC.976
C ROWCALC.977
DO 346 M=1,NT ROWCALC.978
DO 346 K=1,KM ROWCALC.979
DO 346 I=1,IMT ROWCALC.980
TF(I,K,M)=PNU2M*T(I,K,M)+PNU*(TA(I,K,M)+TB(I,K,M)) ROWCALC.981
346 CONTINUE ROWCALC.982
IF (SF_DT(14)) THEN JG170893.141
DO K=1,KM JG170893.142
DO I=1,SWNCOL JG170893.143
DTRF(I,J,K)=(TF(I,K,1)-T(I,K,1))/C2DTTS*1e9 OJG2F404.97
ENDDO JG170893.145
ENDDO JG170893.146
ENDIF JG170893.147
ORH1F305.2409
IF (L_ONOCLIN) THEN ORH1F305.2410
DO K=1,KM ORH1F305.2411
DO I=1,IMT ORH1F305.2412
UF(I,K)=0.0 ORH1F305.2413
VF(I,K)=0.0 ORH1F305.2414
ENDDO ! over I ORH1F305.2415
ENDDO ! over K ORH1F305.2416
ELSE ORH1F305.2417
DO K=1,KM ORH1F305.2418
DO I=1,IMT ORH1F305.2419
UF(I,K)=GM(I,K)*SSFUB(I) ORH1F305.2420
VF(I,K)=GM(I,K)*SSFVB(I) ORH1F305.2421
ENDDO ! over I ORH1F305.2422
ENDDO ! over K ORH1F305.2423
ENDIF ORH1F305.2424
ORH1F305.2425
IF (SF_DS(13)) THEN OJG2F401.271
DO K=1,KM OJG2F401.272
DO I=1,SWNCOL OJG2F401.273
DSRF(I,J,K)=(TF(I,K,2)-T(I,K,2))/C2DTTS*1e9 OJG2F404.98
ENDDO OJG2F401.275
ENDDO OJG2F401.276
ENDIF OJG2F401.277
C OJG2F401.278
DO 350 K=1,KM ROWCALC.998
DO 350 I=1,IMT ROWCALC.999
UF(I,K)=PNU*(UB(I,K)-UF(I,K)+UA(I,K)) ROWCALC.1000
VF(I,K)=PNU*(VB(I,K)-VF(I,K)+VA(I,K)) ROWCALC.1001
350 CONTINUE ROWCALC.1002
DO 347 K=1,KM ROWCALC.1003
DO 347 I=1,IMT ROWCALC.1004
UF(I,K)=PNU2M*USAV(I,K)+UF(I,K) ROWCALC.1005
VF(I,K)=PNU2M*VSAV(I,K)+VF(I,K) ROWCALC.1006
347 CONTINUE ROWCALC.1007
CALL UMWRITE( @DYALLOC.4334
*CALL ARGSIZE @DYALLOC.4335
*CALL ARGD1 @DYALLOC.4336
*CALL ARGDUMO @DYALLOC.4337
*CALL ARGPTRO @DYALLOC.4338
& LABS(NDISK),J,TF @DYALLOC.4339
&, NDISKB,NDISK,NDISKA,FKMP,FKMQ ) OSI0F402.131
ORH1F305.2426
ORH1F305.2427
IF (L_SEAICE.AND.L_IHANEY) THEN ORH1F305.2428
C--------------------------------------------------------------------- ROWCALC.1014
C Following call to HNYCAL1 relaxes sea ice volume back to climatology ROWCALC.1015
C and stores resultant heat flux for the northernmost row only. ROWCALC.1016
C--------------------------------------------------------------------- ROWCALC.1017
IF (J+J_OFFSET.EQ.JMTM1_GLOBAL) THEN ORH3F402.264
CALL HNYCAL1(IMT ORH1F305.2430
&, HANEY_SI ROWCALC.1020
&, anomiceh(1,J_JMT) ORH3F403.361
&, HICE(1,J_JMT),HICE_REF(1,J_JMT) ORH3F403.362
&, QFUSION ROWCALC.1023
&, RHO_WATER_SI,SPECIFIC_HEAT_SI ROWCALC.1024
&, DZ(1) ROWCALC.1025
& ) ROWCALC.1027
C ROWCALC.1030
C----------------------------------------------------------------------- ROWCALC.1033
C Copy anomalous flux of sea ice heat to STASH workspace (N-most island) ROWCALC.1034
C----------------------------------------------------------------------- ROWCALC.1035
C ROWCALC.1036
IF (sf205_30) THEN ORH1F305.2431
DO I=1,ICOL_CYC ORH1F305.2432
sw205_30(I,J_JMT)=anomiceh(I,J_JMT) ORH3F403.363
END DO ORH1F305.2434
END IF ORH1F305.2435
ENDIF ORH1F305.2436
ENDIF ROWCALC.1049
C--------------------------------------------------------------------- ROWCALC.1051
C PRINT THE PROGRESSING SOLUTION AT SPECIFIED ROWS ON ENERGY TSTEP ROWCALC.1052
C--------------------------------------------------------------------- ROWCALC.1053
C ROWCALC.1054
IF(NERGY.EQ.0) GO TO 339 ROWCALC.1057
IF (.NOT.ROWPRT) GOTO 8090 ROWCALC.1058
IF (ALLROW) GO TO 425 ROWCALC.1059
DO 420 N=1,20 ROWCALC.1060
IF (J+J_OFFSET.EQ.JRPRT(N)) GOTO 425 ORH3F402.265
420 CONTINUE ROWCALC.1062
GOTO 8090 ROWCALC.1063
425 CONTINUE ROWCALC.1064
C ROWCALC.1065
C DETERMINE INDEX OF FIRST T OCEAN POINT ROWCALC.1066
C ROWCALC.1067
DO 8015 M=1,NT ROWCALC.1068
IF(M.EQ.1) WRITE(6,8001) J+J_OFFSET,ITT ORH4F404.14
IF(M.EQ.2) WRITE(6,8002) J+J_OFFSET,ITT ORH4F404.15
IF(M.EQ.3) WRITE(6,8003) J+J_OFFSET,ITT ORH4F404.16
IF(M.EQ.4) WRITE(6,8004) J+J_OFFSET,ITT ORH4F404.17
IF(M.EQ.5) WRITE(6,8005) J+J_OFFSET,ITT ORH4F404.18
IF(M.EQ.6) WRITE(6,8006) J+J_OFFSET,ITT ORH4F404.19
IF(M.EQ.7) WRITE(6,8007) J+J_OFFSET,ITT ORH4F404.20
IF(M.EQ.8) WRITE(6,8008) J+J_OFFSET,ITT ORH4F404.21
8001 FORMAT(20H TEMPERATURE FOR J =,I4,12H AT TIMESTEP,I7) ROWCALC.1073
8002 FORMAT(20H SALINITY FOR J =,I4,12H AT TIMESTEP,I7) ROWCALC.1074
8003 FORMAT('TRACER 1 (conv. TCO2) FOR J =',I4, NT080993.121
+' AT TIMESTEP',I7) NT080993.122
8004 FORMAT('TRACER 2 (conv. ALKALINITY) FOR J =',I4, NT080993.123
+' AT TIMESTEP',I7) NT080993.124
8005 FORMAT('TRACER 3 (conv. NUTRIENT) FOR J =',I4, NT080993.125
+' AT TIMESTEP',I7) NT080993.126
8006 FORMAT('TRACER 4 (conv. PHYTOPLKTN) FOR J =',I4, NT080993.127
+' AT TIMESTEP',I7) NT080993.128
8007 FORMAT('TRACER 5 (conv. ZOOPLANKTN) FOR J =',I4, NT080993.129
+' AT TIMESTEP',I7) NT080993.130
8008 FORMAT('TRACER 6 (conv. DETRITUS) FOR J =',I4, NT080993.131
+' AT TIMESTEP',I7) NT080993.132
SCL=1.0 ROWCALC.1077
IF(M.EQ.2) SCL=1.E-3 ROWCALC.1078
IF (L_OCARBON) THEN ORH1F305.2437
IF((M.EQ.3).OR.(M.EQ.4)) SCL=1.E2 ORH1F305.2438
ENDIF ORH1F305.2439
CALL MATRIX(T(1,1,M),IMT,ISTRT,ISTOP,0,KM,SCL,0,0) ORH4F404.82
8015 CONTINUE ROWCALC.1080
ORH1F305.2440
IF (L_OCARBON) THEN ORH1F305.2441
! Print out PCO2 and air to sea flux (invasion) of CO2 ORH1F305.2442
WRITE(6,8018) J+J_OFFSET,ITT ORH4F404.22
8018 FORMAT(' PCO2 (in ppm /10) FOR J =',I4,' AT TIMESTEP',I7) ORH1F305.2444
SCL=10.0 ORH1F305.2445
CALL MATRIX(PCO2(1),IMT,ISTRT,ISTOP,0,1,SCL,0,0) ORH4F404.83
C NT071293.253
WRITE(6,8019) J+J_OFFSET,ITT ORH4F404.23
8019 FORMAT(' Air-Sea CO2 flux (Mole/m2/yr), ORH1F305.2448
& J =',I4,' AT TIMESTEP',I7) ORH1F305.2449
CALL MATRIX(CO2_FLUX(1),IMT,ISTRT,ISTOP,0,1,SCL,0,0) ORH4F404.84
C NT071293.257
ENDIF ! L_OCARBON = true ORH1F305.2451
ORH1F305.2452
WRITE(6,8011) J+J_OFFSET,ITT ORH4F404.24
8011 FORMAT(20H W VELOCITY FOR J =,I4,12H AT TIMESTEP,I7) ROWCALC.1082
ORH1F305.2453
IF (L_OCYCLIC) THEN ORH1F305.2454
C ROWCALC.1084
C SET CYCLIC BOUNDARY CONDITION ON W BEFORE PRINTING ROWCALC.1085
C ROWCALC.1086
DO 433 K=1,KMP1 ORH1F305.2455
W(1 ,K)=W(IMTM1,K) ORH1F305.2456
W(IMT,K)=W(2 ,K) ORH1F305.2457
433 CONTINUE ORH1F305.2458
ENDIF ORH1F305.2459
ORH1F305.2460
SCL=1.E-3 ROWCALC.1092
CALL MATRIX(W,IMT,ISTRT,ISTOP,0,KMP1,SCL,0,0) ORH4F404.85
WRITE(6,8021) J+J_OFFSET,ITT ORH4F404.25
8021 FORMAT(20H U VELOCITY FOR J =,I4,12H AT TIMESTEP,I7) ROWCALC.1095
SCL=1.0 ROWCALC.1096
CALL MATRIX(U,IMT,ISTRT,ISTOP,0,KM,SCL,0,0) ORH4F404.86
WRITE(6,8022) J+J_OFFSET,ITT ORH4F404.26
ORH9F402.370
ORH9F402.371
8022 FORMAT(20H V VELOCITY FOR J =,I4,12H AT TIMESTEP,I7) ROWCALC.1099
CALL MATRIX(V,IMT,ISTRT,ISTOP,0,KM,SCL,0,0) ORH4F404.87
C ROWCALC.1101
C--------------------------------------------------------------------- ROWCALC.1102
C COMPUTE THE NORTHWARD TRANSPORT OF EACH TRACER QUANTITY ROWCALC.1103
C AS WELL AS THE ZONALLY INTEGRATED MERIDIONAL MASS TRANSPORT ROWCALC.1104
C--------------------------------------------------------------------- ROWCALC.1105
C ROWCALC.1106
8090 IF(J+J_OFFSET.EQ.JMTM1_GLOBAL) GO TO 8190 ORH3F402.266
ORH1F305.2461
IF (L_OHMEAD) THEN ORH1F305.2462
DO K=1,KM ORH1F305.2463
VBR(K)=0.0 ORH1F305.2464
ENDDO ORH1F305.2465
ELSE ORH1F305.2466
DO K=1,KM ORH1F305.2467
VBR(K)=0.0 ORH1F305.2468
ENDDO ! over K OMB2F401.6
DO M=1,NT OMB2F401.7
DO K=1,KM OMB2F401.8
TBRS(K,M)=TBRN(K,M) ORH1F305.2470
TBRN(K,M)=0.0 ORH1F305.2471
ENDDO ORH1F305.2472
ENDDO ORH1F305.2473
ORH1F305.2474
IF(J+J_OFFSET.GT.2) GO TO 8110 ORH3F402.267
DO 8094 M=1,NT ORH1F305.2476
DO 8094 K=1,KM ORH1F305.2477
TBRS(K,M)=0.0 ORH1F305.2478
8094 CONTINUE ORH1F305.2479
DO 8102 K=1,KM ORH1F305.2480
TOTDX=0.0 ORH1F305.2481
DO 8100 I=2,IMTM1 ORH1F305.2482
TOTDX=TOTDX+DXT(I)*(FM(I,K)) ORH1F305.2483
8100 CONTINUE ORH1F305.2486
DO M=1,NT OMB2F401.9
DO I=2,IMTM1 OMB2F401.10
TBRS(K,M)=TBRS(K,M)+T(I,K,M)*FM(I,K)*DXT(I) OMB2F401.11
END DO OMB2F401.12
END DO OMB2F401.13
ORH1F305.2487
IF(TOTDX.NE.0.0) THEN ORH1F305.2488
DO 8101 M=1,NT ORH1F305.2489
TBRS(K,M)=TBRS(K,M)/TOTDX ORH1F305.2490
8101 CONTINUE ORH1F305.2491
ENDIF ORH1F305.2492
8102 CONTINUE ORH1F305.2493
8110 CONTINUE ORH1F305.2494
ENDIF ORH1F305.2495
IF (.NOT.(L_OHMEAD.OR.L_OISOPYC)) THEN ORH1F305.2496
CCTJ=AH*DYUR(J) ORH1F305.2497
ENDIF ORH1F305.2498
DO K=1,KM ORH1F305.2499
IF (.NOT.(L_OHMEAD)) THEN ORH1F305.2500
TOTDX=0.0 ORH1F305.2501
ENDIF ROWCALC.1133
ORH1F305.2502
IF (L_OHMEAD) THEN ORH1F305.2503
DO I=2,IMTM1 ORH1F305.2504
VBR(K)=VBR(K)+V(I,K)*DXU(I)*CS(J) ORH1F305.2505
ENDDO ORH1F305.2506
ELSE ORH1F305.2507
DO I=2,IMTM1 ORH1F305.2508
TOTDX=TOTDX+DXT(I)*(FMP(I,K)) ORH1F305.2509
VBR(K)=VBR(K)+V(I,K)*DXU(I)*CS(J) ORH1F305.2510
END DO OMB2F401.14
DO M=1,NT OMB2F401.15
DO I=2,IMTM1 OMB2F401.16
TBRN(K,M)=TBRN(K,M)+TP(I,K,M)*FMP(I,K)*DXT(I) OMB2F401.17
END DO OMB2F401.18
END DO OMB2F401.19
ORH1F305.2515
IF(TOTDX.NE.0.0) THEN ORH1F305.2516
DO M=1,NT ORH1F305.2517
TBRN(K,M)=TBRN(K,M)/TOTDX ORH1F305.2518
ENDDO ORH1F305.2519
ENDIF ORH1F305.2520
ENDIF ! Not L_OHMEAD ORH1F305.2521
ORH1F305.2522
IF(K.EQ.1) TMT(J,1)=VBR(1)*DZ(1) ROWCALC.1161
IF(K.GT.1) TMT(J,K)=TMT(J,K-1)+VBR(K)*DZ(K) ROWCALC.1162
ORH1F305.2523
IF (.NOT.(L_OHMEAD))THEN ORH1F305.2524
ORH1F305.2525
DO M=1,NT ORH1F305.2526
TTN(1,J,M)=TTN(1,J,M)+VBR(K)* ORH1F305.2527
& (TBRN(K,M)+TBRS(K,M))*0.5*DZ(K) ORH1F305.2528
IF (.NOT.(L_OISOPYC)) THEN ORH1F305.2529
DO I=2,IMTM1 ORH1F305.2530
TTN(6,J,M)=TTN(6,J,M)+(V(I,K)* ORH1F305.2531
& DXU(I)+V(I-1,K)*DXU(I-1))* ORH1F305.2532
& (T(I,K,M)+TP(I,K,M))*CS(J)*0.25*DZ(K) ORH1F305.2533
TTN(7,J,M)=TTN(7,J,M)-CCTJ*FM(I,K)*FMP(I,K)* ORH1F305.2534
& (TP(I,K,M)-T(I,K,M))*DXT(I)*CS(J)*DZ(K) ORH1F305.2535
ENDDO ! over I ORH1F305.2536
ELSE ORH1F305.2537
IF (L_OISOMOM) THEN OOM1F405.124
DO I=2,IMTM1 OOM1F405.125
TTN(6,J,M)=TTN(6,J,M)+(V(I,K)* OOM1F405.126
& DXU(I)+V(I-1,K)*DXU(I-1))* OOM1F405.127
& (T(I,K,M)+TP(I,K,M))*CS(J)*0.25*DZ(K) OOM1F405.128
TTN(7,J,M)=TTN(7,J,M)-diff_fn(I,K,M,0)*FM(I,K)* OOM1F405.129
& DXT(I)*(CS(J)*DZ(K)) OOM1F405.130
ENDDO ! over I OOM1F405.131
ELSE OOM1F405.132
DO I=2,IMTM1 ORH1F305.2538
TTN(6,J,M)=TTN(6,J,M)+(V(I,K)* ORH1F305.2539
& DXU(I)+V(I-1,K)*DXU(I-1))* ORH1F305.2540
& (T(I,K,M)+TP(I,K,M))*CS(J)*0.25*DZ(K) ORH1F305.2541
TTN(7,J,M)=TTN(7,J,M)-esav(I,K,M)*FM(I,K)* ORH1F305.2542
& DXT(I)*(CS(J)*DZ(K)) ORH1F305.2543
ENDDO ! over I ORH1F305.2544
ENDIF ! L_OISOMOM OOM1F405.133
OOM1F405.134
ENDIF ORH1F305.2545
ENDDO ! over M ORH1F305.2546
ENDIF ORH1F305.2547
ENDDO ! over K ORH1F305.2548
ORH1F305.2549
IF (.NOT.L_OHMEAD) THEN ORH1F305.2550
DO M=1,NT ORH1F305.2551
DO I=2,IMTM1 ORH1F305.2552
TOTDZ=0.0 ORH1F305.2553
VBRZ=0.0 ORH1F305.2554
TBRZ=0.0 ORH1F305.2555
IKM=I ORH1F305.2556
IF(KMU(I-1).GT.KMU(I)) IKM=I-1 ORH1F305.2557
KZ=KMU(IKM) ORH1F305.2558
IF(.NOT.(KZ.EQ.0)) THEN ORH1F305.2559
DO K=1,KZ ORH1F305.2560
VBRZ=VBRZ+(V(I,K)*DXU(I)+V(I-1,K)* ORH1F305.2561
& DXU(I-1))*DZ(K) ORH1F305.2562
TBRZ=TBRZ+(T(I,K,M)+TP(I,K,M))*DZ(K) ORH1F305.2563
TOTDZ=TOTDZ+DZ(K) ORH1F305.2564
ENDDO ORH1F305.2565
TBRZ=TBRZ/TOTDZ ORH1F305.2566
TTN(3,J,M)=TTN(3,J,M)+VBRZ*TBRZ*CS(J)*0.25 ORH1F305.2567
IF (L_OROTATE) THEN ORH1F305.2568
TTN(5,J,M)=TTN(5,J,M)-(WSX(I)*DXU(I)+ ORH1F305.2569
& WSX(I-1)*DXU(I-1))* ORH1F305.2570
& (T(I,1,M)+TP(I,1,M)-TBRZ)*CS(J)/(4.0*CORIOLIS(I,J)) ORH1F305.2571
ELSE ORH1F305.2572
TTN(5,J,M)=TTN(5,J,M)-(WSX(I)*DXU(I)+ ORH1F305.2573
& WSX(I-1)*DXU(I-1))* ORH1F305.2574
& (T(I,1,M)+TP(I,1,M)-TBRZ)*CS(J)/(8.0*OMEGA*SINE(J)) ORH1F305.2575
ENDIF ORH1F305.2576
ORH1F305.2577
ENDIF ! KZ > 0 ORH1F305.2578
ENDDO ! over I ORH1F305.2579
ENDDO ! over M ORH1F305.2580
ENDIF ! Not L_OHMEAD ORH1F305.2581
ORH1F305.2582
IF (.NOT.(L_OHMEAD)) THEN ORH1F305.2583
DO M=1,NT ORH1F305.2584
TTN(2,J,M)=TTN(6,J,M)-TTN(1,J,M) ORH1F305.2585
TTN(4,J,M)=TTN(6,J,M)-TTN(3,J,M)-TTN(5,J,M) ORH1F305.2586
TTN(8,J,M)=TTN(6,J,M)+TTN(7,J,M) ORH1F305.2587
ENDDO ORH1F305.2588
ENDIF ORH1F305.2589
8190 CONTINUE ORH1F305.2590
339 CONTINUE ORH1F305.2591
C ROWCALC.1214
ORH0F404.61
IF (L_OHMEAD) THEN ORH0F404.62
CALL MEADCALC(L_OHMEAD,L_OISOPYC,MEADTEST,SF_MEAD ORH0F404.63
& ,L_OISOMOM,diff_fn OOM1F405.135
OOM1F405.136
& ,LPL_MEAD,J,JMMD ORH0F404.64
& ,IMT,IMT_IPD,KM_IPD,NT_IPD ORH0F404.65
& ,ITEM,JMT,KM ORH0F404.66
& ,KMU,LSEGC,LDIV,NT,O_MAX_TRACERS ORH0F404.67
& ,SIREL_MEAD,TRACER_XREF, ORH0F404.68
*CALL ARGOCMEA ORH0F404.69
& DYUR,CONV_MEAD ORH0F404.70
& ,ESAV,FM ORH0F404.71
& ,DXT,DZ,CS,DXU,DXTK ORH0F404.72
& ,TP,T,V ORH0F404.73
& ,MEAD_DIAG ORH0F404.74
&) ORH0F404.75
ENDIF ORH0F404.76
ORH0F404.77
IF (SFRC) THEN OJC2F400.129
DO K=1,KM OJC2F400.130
DO I=1,IMT_STASH OJC2F400.131
C Multiply by 1E9 for backward compatibility with the C90, where OJG2F403.17
C this was necessary to avoid loss of accuracy from dump packing. OJG2F403.18
DTRC(I,J,K)=1E9*(TA(I,K,1)-DTRC(I,J,K))/C2DTTS OJG2F403.19
ENDDO OJC2F400.133
ENDDO OJC2F400.134
ENDIF OJC2F400.135
ENDIF ! If we have something to do for this row ORH1F403.46
ORH1F403.47
380 CONTINUE ROWCALC.1334
*IF DEF,MPP ORH0F404.78
! In MPP mode we must cater for diagnostics whose halo ORH0F404.79
! regions need to be swapped. ORH0F404.80
CALL OSWAPDIAGS ( ORH0F404.81
& L_ICEFREEDR,L_ICESIMPLE,L_OHANEY,L_SEAICE,L_IHANEY,L_OBIOLOGY ODC1F405.408
&,L_OQLARGE,L_OFULARGE,IMT,SWNCOL,JMT,JMTM1,KM,KMM1 OOM1F405.713
&,O_EW_HALO,O_NS_HALO ORH0F404.84
*CALL ARGOC3DG ORH0F404.85
&,UCURRENT,VCURRENT,CARYSALT,OCEANHEATFLUX OOM1F405.714
&,SFUTOT,SFVTOT ORH0F404.87
&,UTOT,VTOT ORH0F404.88
&,SF_ZN,SWZUN,SWZVN ORH0F404.89
&,sf201_30,sf202_30,sf203_30,sf204_30,sf205_30,sf208_30,sf248_30 ORH0F404.90
&,sf249_30,sf250_30,sf251_30 ORH0F404.91
&,SW201_30,SW202_30,SW203_30,SW204_30,SW205_30,SW208_30,SW248_30 ORH0F404.92
&,SW249_30,SW250_30,SW251_30 ORH0F404.93
&,sf_dt ORH0F404.94
&,DTXADV,DTYADV,DTZADV,DTXDIFF,DTYDIFF,DTZDIFF,DTSFC,DTPEN ORH0F404.95
&,DTICE,DTMIX,DTCNVC,DTZ,DTFF,DTMED ORH0F404.96
&,sf_DS ORH0F404.97
&,DSXADV,DSYADV,DSZADV,DSXDIFF,DSYDIFF,DSZDIFF,DSSFC,DSICE ORH0F404.98
&,DSMIX,DSCNVC,DSZ,DSFF,DSMED ORH0F404.99
&,sf_bio ORH3F405.62
&,swrk_bio(si_bio(1)),swrk_bio(si_bio(2)),swrk_bio(si_bio(3)) ORH3F405.63
&,swrk_bio(si_bio(4)),swrk_bio(si_bio(5)),swrk_bio(si_bio(6)) ORH3F405.64
&,swrk_bio(si_bio(7)),swrk_bio(si_bio(8)),swrk_bio(si_bio(9)) ORH3F405.65
&,swrk_bio(si_bio(10)),swrk_bio(si_bio(11)),swrk_bio(si_bio(12)) ORH3F405.66
&,swrk_bio(si_bio(13)),swrk_bio(si_bio(14)),swrk_bio(si_bio(15)) ORH3F405.67
&,swrk_bio(si_bio(16)),swrk_bio(si_bio(17)),swrk_bio(si_bio(18)) ORH3F405.68
&,swrk_bio(si_bio(19)),swrk_bio(si_bio(20)),swrk_bio(si_bio(21)) ORH3F405.69
&,swrk_bio(si_bio(22)),swrk_bio(si_bio(23)),swrk_bio(si_bio(24)) ORH3F405.70
&,swrk_bio(si_bio(25)),swrk_bio(si_bio(26)),swrk_bio(si_bio(27)) ORH3F405.71
&) ORH0F404.106
*ENDIF ORH0F404.107
!======================================================================= ORH0F404.108
! HAVING COMPLETED THE ROW-BY-ROW COMPUTATION, WE MUST WRITE THE ORH0F404.109
! FINAL ROW TO D1 STORAGE VIA A FURTHER CALL TO UMWRITE.ORH4F402.53 ORH0F404.110
!======================================================================= ORH0F404.111
*IF DEF,MPP ORH0F404.112
! Make sure we only attempt to write something when ORH9F402.137
! J_TO_COMP > 0. (ie: if the decomposition were to ORH9F402.138
! result in a PE only being assigned row JMT_GLOBAL ORH9F402.139
! then we dont have anything to do here. ORH9F402.140
IF (J_TO_COMP.GT.0) THEN ORH9F402.141
*ENDIF ORH9F402.142
CALL UMWRITE( @DYALLOC.4340
*CALL ARGSIZE @DYALLOC.4341
*CALL ARGD1 @DYALLOC.4342
*CALL ARGDUMO @DYALLOC.4343
*CALL ARGPTRO @DYALLOC.4344
& LABS(NDISKA),J_TO_COMP,TA ORH9F402.143
&, NDISKB,NDISK,NDISKA,FKMP,FKMQ ) OSI0F402.132
C ROWCALC.1460
*IF DEF,MPP ORH9F402.144
ENDIF ORH9F402.145
*ENDIF ORH9F402.146
OSI1F405.370
IF (L_OGILL_LBCS) THEN OSI1F405.371
*IF DEF,MPP OSI1F405.372
IF (attop .AND. L_OBDY_SOUTH) THEN OSI1F405.373
*ELSE OSI1F405.374
IF (L_OBDY_SOUTH) THEN OSI1F405.375
*ENDIF OSI1F405.376
DO M = 1, NT OSI1F405.377
DO K = 1, KM OSI1F405.378
DO I = 1, IMT OSI1F405.379
D1(joc_tracer(M,2)-1+i+ OSI1F405.380
& O_NS_HALO*imt+(k-1)*imt*jmt) = RMDI OSI1F405.381
ENDDO OSI1F405.382
ENDDO OSI1F405.383
ENDDO OSI1F405.384
ENDIF OSI1F405.385
*IF DEF,MPP OSI1F405.386
IF (atbase .AND. L_OBDY_NORTH) THEN OSI1F405.387
*ELSE OSI1F405.388
IF (L_OBDY_NORTH) THEN OSI1F405.389
*ENDIF OSI1F405.390
DO M = 1, NT OSI1F405.391
DO K = 1, KM OSI1F405.392
DO I = 1, IMT OSI1F405.393
D1(joc_tracer(M,2)-1+i+ OSI1F405.394
& (jmt-1-O_NS_HALO)*imt+(k-1)*imt*jmt) = RMDI OSI1F405.395
ENDDO OSI1F405.396
ENDDO OSI1F405.397
ENDDO OSI1F405.398
ENDIF OSI1F405.399
ENDIF ! L_OGILL_LBCS OSI1F405.400
OSI1F405.401
IF (L_OTIMER) CALL TIMER ('ROWCALC ',4) ORH1F305.2628
RETURN ROWCALC.1464
END ROWCALC.1465
*ENDIF @DYALLOC.4346