SUBROUTINE TRACER( 1,68@DYALLOC.4030
*CALL ARGSIZE 
@DYALLOC.4031
*CALL ARGOCALL @DYALLOC.4032
*CALL ARGOINDX ORH7F402.289
& J, ! ##################################################### @DYALLOC.4033
& AICE,HICE,HSNOW, JT161193.368
& HICE_REF, ORH1F305.576
& CARYHEAT,CARYSALT, TRACER.7
& ICY,FLXTOICE, TRACER.8
& SURFTEMP,SURFSAL,NEWICE, TRACER.9
& OCEANHEATFLUX,OCEANSNOWRATE, OJC2F400.136
& WME_ICE, ORH1F305.577
*CALL COCAROWS TRACER.11
&, @DYALLOC.4034
*CALL COCAWRKA TRACER.12
&,fluxcorh,fluxcorw OJT0F304.54
+,heatsink ! Heat/W m**-2 lost at the ocean floor OJG0F400.22
+,anom_heat,anom_salt TRACER.17
+,anomiceh ORH1F305.578
&,diagsw OJG1F400.16
&,WSXM,WSYM OLA3F403.276
&,ISX,ISY,WSX_LEADS,WSY_LEADS OLA0F404.43
&,ISXM,ISYM,WSX_LEADSM,WSY_LEADSM OLA0F404.44
&,gnuT,RiT,hT OLA3F403.277
&,L_T,MLD_LARGE,WATERFLUX_ICE,L_OWINDMIX OOM1F405.797
&,L_OBULKMAXMLD,LAMBDA_LARGE OOM1F405.798
&,SWNCOL,DTXADV,DTYADV,DTZADV,DTXDIFF,DTYDIFF,DTZDIFF JG170893.165
&,DTSFC,DTPEN,DTICE,DTMIX,DTCNVC,DTZ,DTFF,DTMED,SF_DT JG170893.166
&,dsxadv,dsyadv,dszadv,dsxdiff,dsydiff,dszdiff OJG2F401.1
&,dssfc,dsice,dsmix,dscnvc,dsz,dsff,dsmed,sf_ds OJG2F401.2
+,PRIM_PROD,ZOO_PROD,PHYTO_GROW,PHYTO_GRAZE,PHYTO_MORT ONT1F304.152
+,EXCRETE_NUT,GROW_NUT,PMORT_NUT,ZMORT_NUT ONT1F304.153
+,PRESP_NUT,REMIN_NUT ONT1F304.154
+,NUT_LIMIT,LIGHT_LIMIT,TEMP_LIMIT ONT1F304.155
+,DETRI_FLUX,NUT_FLUX ONT1F304.156
+,HADV_NUT,VADV_NUT,HDIF_NUT,VDIF_NUT,MIX_NUT,CNVC_NUT ONT1F304.157
+,BIO_NUT ONT1F304.158
+,FIX_NUT ONT1F304.159
+,HADV_PHY,HADV_ZOO,HADV_DET ONT1F304.160
+,SF_BIO ONT1F304.161
+,DIAG_MLD TRACER.23
+ ,PCO2,CO2_FLUX,PCO2_ATM NT071293.32
&,ATMPCO2_ROW OCN1F405.24
+ ,c14to12_atm NT071293.34
+ ,INVADE,EVADE NT071293.36
& ,VTCO2_FLUX,VALK_FLUX OJP0F404.943
+,RHOSRN,RHOSRNA,RHOSRNB OOM1F405.793
&,tmin2 OLA2F403.313
+,esav,rxp,ry,rrzp ORH1F305.579
&,drhob1p,drhob2p OLA0F401.247
&,uisop,visopn,visops,wisop,dtgm,dsgm OJG2F404.11
&,athkdftu, athkdftv, FTARR ORH1F405.468
&,IMT_IPD_NOMIX_ARG ORH1F405.469
&,ATTEND,HUDTEND OOM2F405.291
&,adv_vetiso,adv_vbtiso,times,srho OOM1F405.151
& ) TRACER.31
C TRACER.32
CFPP$ NOCONCUR R ORH5F400.2
C======================================================================= TRACER.33
C === TRACER.34
C TRACER COMPUTES, FOR ONE ROW, THE NT TRACERS, WHERE: === TRACER.35
C J=THE ROW NUMBER === TRACER.36
C === TRACER.37
C======================================================================= TRACER.38
CLL Modification history: SF020993.10
CLL 02/09/93: correct implicit advection/diffusion code: (FOREMAN) SF020993.11
CLL 01/09/94: (v3.4) Include comdeck TYPOCLWK keeping workspace ORH1F304.95
CLL arrays local to this routine. R. Hill ORH1F304.96
CLL 3.4 04/08/94 Split sea ice and SST/SSS Haney forcing and remove OJT0F304.56
CLL sea ice depth flux correction. (JFT) OJT0F304.57
! Vn3.4 31/8/94 Use upwind differences for tracer advection (Taylor) ONT2F304.1
! Vn3.4 31/8/94 Switch off Fourier Filtering for tracers (Taylor) ONT2F304.2
! Vn3.4 31/8/94 Simplify *DEF logic for implicit vertical advection ONT2F304.3
! and skipland (Taylor) ONT2F304.4
! Vn3.4 31/08/94 Added Biological Model diagnostics (Nick Taylor) ONT2F304.5
C TRACER.39
! Vn3.4 31/8/94 Weight solar radiation thru' ice by ONT3F304.1
! leads fraction. (Nick Taylor) ONT3F304.2
CLL 4.0 7.7.95 Add arguments to SFCADD, FREEZEUP and REFREEZE OJG0F400.21
CLL Record salinity * surface water flux as DIAGSW OJG0F401.3
! 3.5 01/02/95 Remove *IF DEF dependency. R. Hill ORH1F305.581
! 4.0 Change CARYSALT from increment to rate. J.F.Crossley ORH1F403.94
! 4.0 Correct treatment of non-pen. heatflux and snowfall OJC2F400.137
! for models with ice dynamics. J.F.Crossley OJC2F400.138
CLL 4.1 23.5.96 J.M.Gregory Diags for rate of change of salinity OJG2F401.3
CLL 4.1 22.5.96 J.M.Gregory If heat flux correction cannot be OJG0F401.4
CLL applied because it would freeze layer 1, record it in HEATSINK OJG0F401.5
CLL 4.3 8.11.96 J.M.Gregory Add alternative schemes IPDCOFCO OJG0F403.6
CLL and COXCNVC, as used in HADCM2 OJG0F403.7
! 4.3 17/03/97 Allow filtering to be assisted by all pes for mpp ORH1F403.95
! load balancing purposes. R. Hill ORH1F403.96
CLL 4.4 25.9.97 J.M.Gregory Multiply diagnostics for rates of OJG2F404.1
CLL change of temperature and salinity by 1e9 for backward OJG2F404.2
CLL compatibility with the C90, where this was necessary to avoid OJG2F404.3
CLL loss of accuracy from dump packing. Introduce a rate of OJG2F404.4
CLL change of salinity from the GM scheme. Provide rates of change OJG2F404.5
CLL from advection (x+y+z) for temperature and salinity, reusing OJG2F404.6
CLL the combined Z-ADV+Z-DIFF diags, which are now redundant. OJG2F404.7
CLL Correct the dtheta/dt and dS/dt diags for GM and the vertical OJG2F404.8
CLL diffusion of salinity. OJG2F404.9
C OJG2F404.10
! 4.4 10/09/97 Remove all references to SKIPLAND code. R.Hill ORH7F404.6
CLL 4.4 15/06/97 Add new vertical velocity calculation for use with ORL1F404.635
CLL the free surface solution R.Lenton ORL1F404.636
CLL 4.5 12/08/97 Changed the logical used to work out the flux OSI1F405.17
CLL across the southern boundary. Added the code for OSI1F405.18
CLL the eastern boundary C.G. Jones OSI1F405.19
CLL 4.5 3.11.98 Diagnostic calculations for Med/Hud outflow OOM2F405.288
CLL changed. CONVADJ called at Med outflow point OOM2F405.289
CLL M. Roberts OOM2F405.290
CLL 4.5 10/11/98 Enable alternative isopycnal diffusion routines OOM1F405.149
CLL (ISOPYC_M and ISOFLUX) to be called. M. Roberts OOM1F405.150
! 4.5 4/6/98 Replace calculation of advection source term with OSY1F405.74
! a call to new routine ADV_SOURCE to enable use of 3rd OSY1F405.75
! order QUICK scheme. Redefine variables FUW, FVN, FVST to OSY1F405.76
! be equal to cell face velocities with no grid-spacing OSY1F405.77
! factors etc. as previously. D.Storkey OSY1F405.78
! OSY1F405.79
IMPLICIT NONE RH011293.148
C--------------------------------------------------------------------- TRACER.40
C DEFINE GLOBAL DATA TRACER.41
C--------------------------------------------------------------------- TRACER.42
C TRACER.43
*CALL OARRYSIZ ORH6F401.28
*CALL TYPSIZE @DYALLOC.4036
*CALL TYPOINDX PXORDER.49
*CALL TYPOCALL @DYALLOC.4037
*CALL UMSCALAR TRACER.46
*CALL CNTLOCN ORH1F305.582
*CALL OTIMER ORH1F305.584
*CALL OTRACPNT OJP0F404.722
C----------------------------------------------------------------------- TRACER.50
C DEFINE ARGUMENT LIST TRACER.51
C----------------------------------------------------------------------- TRACER.52
C TRACER.53
*CALL COCTROWS TRACER.54
*CALL COCTWRKA TRACER.55
REAL TRACER.57
& TIMESTEP(KM) ! Depth dependent timestep OJP0F404.723
&, GAMMA_DZ(KM) ! Level thickness * gamma factor OJP0F404.724
REAL OJP0F404.725
+ fluxcorh (IMT_FLX) ! IN Heat flux correction -sea (W/m2) ORH1F305.585
+, fluxcorw (IMT_FLX) ! IN Water flux correction (kg/m2/s) ORH1F305.586
REAL TRACER.63
+ anom_heat (IMT_OHY) ! OUT Anomalous heat flux (W/m2) ORH1F305.587
+, anom_salt (IMT_OHY) ! OUT Anomalous P-E (kg/m2/s) ORH1F305.588
+, anomiceh (IMT_IHY) ! OUT Anomalous heat flux (w/m2) due ORH1F305.589
+ ! to relaxing sea ice to climatology. ORH1F305.590
+,anom_ice_salt(IMT_IHY)! OUT PME flux due to forcing sea ice back ORH1F305.591
+ ! to climatology. ORH1F305.592
C ORH1F305.593
REAL NT091293.40
& RTPIG(IMT,KM) ! Square root of phytoplankton OJP0F404.726
& ! pigment conc. ORH1F305.595
&, ETA_BIO(IMT,KM) ! Light extinction coefficient, biological OJP0F404.727
& ! light model in 1/m OJP0F404.728
INTEGER KFIX_BIO ! Depth index to which to do biological OJP0F404.729
! light model calculations OJP0F404.730
C Diagnostic of salinity * surface water flux / density OJG1F400.17
REAL diagsw(imt,jmt) OJG1F400.18
JG170893.167
C Full-field heating-rate diagnostics JG170893.168
INTEGER SWNCOL ! number of columns in a row JG170893.169
&,ISSW,IESW ! 1st and last stashwork columns JG170893.170
&, IMT_IPD_NOMIX_ARG ! Argument passed in for dynamic alloc ORH1F305.599
ORH1F305.601
REAL DTXADV(SWNCOL,JMT,KM) ! zonal heat divergence JG170893.171
&,DTYADV(SWNCOL,JMT,KM) ! meridional heat divergence JG170893.172
&,DTZADV(SWNCOL,JMT,KM) ! vertical heat divergence JG170893.173
&,DTXDIFF(SWNCOL,JMT,KM) ! zonal heat diffusion JG170893.174
&,DTYDIFF(SWNCOL,JMT,KM) ! meridional heat diffusion JG170893.175
&,DTZDIFF(SWNCOL,JMT,KM) ! vertical heat diffusion JG170893.176
&,DTSFC(SWNCOL,JMT,KM) ! non-penetrative surface heat, ex ice JG170893.177
&,DTPEN(SWNCOL,JMT,KM) ! penetrative surface heat JG170893.178
&,DTICE(SWNCOL,JMT,KM) ! heat fluxes associated with ice JG170893.179
&,DTMIX(SWNCOL,JMT,KM) ! mixed layer JG170893.180
&,DTCNVC(SWNCOL,JMT,KM) ! convection JG170893.181
&,DTZ(SWNCOL,JMT,KM) ! total heat divergence (x+y+z) OJG2F404.13
&,DTFF(SWNCOL,JMT,KM) ! Fourier filtering JG170893.183
&,DTMED(SWNCOL,JMT,KM) ! Mediterranean outflow JG170893.184
&,C2DTTSK ! 2 * timestep at this level JG170893.185
LOGICAL SF_DT(*) JG170893.186
C Each dtheta/dt diagnostic has a stash flag in SF_DT thus: OJG2F401.4
C 1 DTHETA/DT FROM X-ADVECTION OJG2F401.5
C 2 DTHETA/DT FROM Y-ADVECTION OJG2F401.6
C 3 DTHETA/DT FROM Z-ADVECTION OJG2F401.7
C 4 DTHETA/DT FROM X-DIFFUSION OJG2F401.8
C 5 DTHETA/DT FROM Y-DIFFUSION OJG2F401.9
C 6 DTHETA/DT FROM Z-DIFFUSION OJG2F401.10
C 7 DTHETA/DT FROM SFC. FLUXES OJG2F401.11
C 8 DTHETA/DT FROM PEN. SOLAR OJG2F401.12
C 9 DTHETA/DT FROM ICE PHYSICS OJG2F401.13
C 10 DTHETA/DT FROM ML PHYSICS OJG2F401.14
C 11 DTHETA/DT FROM CONVECTION OJG2F401.15
C 12 DTHETA/DT FROM ADVECTION OJG2F404.14
C 13 DTHETA/DT FROM FOURIER FILT OJG2F401.17
C 14 DTHETA/DT FROM ROBERT FILT OJG2F401.18
C 15 DTHETA/DT FROM MED. OUTFLOW OJG2F401.19
REAL OCEANHEATFLUX(IMT),OCEANSNOWRATE(IMT) OOM1F405.336
C Fields of rates of change of salinity OJG2F401.20
REAL DSXADV(SWNCOL,JMT,KM) ! zonal salinity divergence OJG2F401.21
&,DSYADV(SWNCOL,JMT,KM) ! meridional salinity divergence OJG2F401.22
&,DSZADV(SWNCOL,JMT,KM) ! vertical salinity divergence OJG2F401.23
&,DSXDIFF(SWNCOL,JMT,KM) ! zonal salinity diffusion OJG2F401.24
&,DSYDIFF(SWNCOL,JMT,KM) ! meridional salinity diffusion OJG2F401.25
&,DSZDIFF(SWNCOL,JMT,KM) ! vertical salinity diffusion OJG2F401.26
&,DSSFC(SWNCOL,JMT) ! non-pen surface salinity, ex ice OJG2F401.27
&,DSICE(SWNCOL,JMT) ! salinity fluxes associated with ice OJG2F401.28
&,DSMIX(SWNCOL,JMT,KM) ! mixed layer OJG2F401.29
&,DSCNVC(SWNCOL,JMT,KM) ! convection OJG2F401.30
&,DSZ(SWNCOL,JMT,KM) ! total salinity divergence (x+y+z) OJG2F404.15
&,DSFF(SWNCOL,JMT,KM) ! Fourier filtering OJG2F401.32
&,DSMED(SWNCOL,JMT,KM) ! Mediterranean outflow OJG2F401.33
LOGICAL SF_DS(*) OJG2F401.34
C Each ds/dt diagnostic has a stash flag in SF_DS thus: OJG2F401.35
C 1 DS/DT FROM X-ADVECTION OJG2F401.36
C 2 DS/DT FROM Y-ADVECTION OJG2F401.37
C 3 DS/DT FROM Z-ADVECTION OJG2F401.38
C 4 DS/DT FROM X-DIFFUSION OJG2F401.39
C 5 DS/DT FROM Y-DIFFUSION OJG2F401.40
C 6 DS/DT FROM Z-DIFFUSION OJG2F401.41
C 7 DS/DT FROM SFC. FLUXES OJG2F401.42
C 8 DS/DT FROM ICE PHYSICS OJG2F401.43
C 9 DS/DT FROM ML PHYSICS OJG2F401.44
C 10 DS/DT FROM CONVECTION OJG2F401.45
C 11 DS/DT FROM ADVECTION OJG2F404.16
C 12 DS/DT FROM FOURIER FILT OJG2F401.47
C 13 DS/DT FROM ROBERT FILT OJG2F401.48
C 14 DS/DT FROM MED. OUTFLOW OJG2F401.49
C ORH1F305.602
C ONT1F304.164
C DIAGNOSTICS ONT1F304.165
C ONT1F304.166
C Integrated production ONT1F304.167
REAL PRIM_PROD(SWNCOL_BIO,JMT_BIO) ORH1F305.603
! Primary production (gross) ORH1F305.604
C ! (gC/m2/day) -Integrated over top 200m ONT1F304.169
REAL ZOO_PROD(SWNCOL_BIO,JMT_BIO) ORH1F305.605
! Zooplankton production (gross) ORH1F305.606
C ! Totalled over top 200m (gC/m2/day) ONT1F304.171
C Growth limitation terms ONT1F304.172
REAL NUT_LIMIT(SWNCOL_BIO,JMT_BIO,KM_BIO) ! Phytoplankton growth ORH1F305.607
REAL LIGHT_LIMIT(SWNCOL_BIO,JMT_BIO,KM_BIO) ! limitation terms ORH1F305.608
REAL TEMP_LIMIT(SWNCOL_BIO,JMT_BIO,KM_BIO) ORH1F305.609
C ONT1F304.176
C Phyto specific rates ONT1F304.177
REAL PHYTO_GROW (SWNCOL_BIO,JMT_BIO,KM_BIO) ORH1F305.610
! Phyto growth specific rate ORH1F305.611
REAL PHYTO_GRAZE(SWNCOL_BIO,JMT_BIO,KM_BIO) ORH1F305.612
! Phyto grazing specific rate ORH1F305.613
REAL PHYTO_MORT (SWNCOL_BIO,JMT_BIO,KM_BIO) ORH1F305.614
! Phyto mortality spec. rate ORH1F305.615
C ! Specific rates in (day)-1 ORH1F305.616
C Detrital sinking ONT1F304.182
REAL DETRI_FLUX (SWNCOL_BIO,JMT_BIO,KM_BIO) ORH1F305.617
! Detrital sinking flux through ORH1F305.618
C ! base of layer (mMol-N/m2/day). ORH1F305.619
C ONT1F304.185
C Terms in Nitrate balance (all in units mMol-N/m3/day) ONT1F304.186
REAL EXCRETE_NUT(SWNCOL_BIO,JMT_BIO,KM_BIO) ORH1F305.620
& ! Nutrient excretion rate ORH1F305.621
& ,GROW_NUT(SWNCOL_BIO,JMT_BIO,KM_BIO) ORH1F305.622
& ! Loss rate of N due to phyto ORH1F305.623
& ,PMORT_NUT(SWNCOL_BIO,JMT_BIO,KM_BIO) ORH1F305.624
& ! Gain due to phyto death ORH1F305.625
& ,ZMORT_NUT(SWNCOL_BIO,JMT_BIO,KM_BIO) ORH1F305.626
& ! Gain due to zoo death ORH1F305.627
& ,PRESP_NUT(SWNCOL_BIO,JMT_BIO,KM_BIO) ORH1F305.628
& ! Gain due to phyto resp ORH1F305.629
& ,REMIN_NUT(SWNCOL_BIO,JMT_BIO,KM_BIO) ORH1F305.630
& ! Gain due to detrtus remin. ORH1F305.631
C ONT1F304.193
C Rate of change of Nitrate due to physical processes ONT1F304.194
C (units: mMols-N/m3/day) ONT1F304.195
REAL HADV_NUT(SWNCOL_BIO,JMT_BIO,KM_BIO) ! Horizontal advection ORH1F305.632
& ,VADV_NUT(SWNCOL_BIO,JMT_BIO,KM_BIO) ! Vertical advection ORH1F305.633
& ,HDIF_NUT(SWNCOL_BIO,JMT_BIO,KM_BIO) ! Horizontal diffusion ORH1F305.634
& ,VDIF_NUT(SWNCOL_BIO,JMT_BIO,KM_BIO) ! Vertical diffusion ORH1F305.635
& ,MIX_NUT(SWNCOL_BIO,JMT_BIO,KM_BIO) ! Mixed layer model ORH1F305.636
& ,CNVC_NUT(SWNCOL_BIO,JMT_BIO,KM_BIO) ! Convection ORH1F305.637
& ,BIO_NUT(SWNCOL_BIO,JMT_BIO,KM_BIO) ! BIOLOGICL MODEL (net) ORH1F305.638
& ,FIX_NUT(SWNCOL_BIO,JMT_BIO,KM_BIO) ORH1F305.639
! Reset of Nitrates from neg. values ORH1F305.640
C ONT1F304.204
C Rate of change of Phyto,Zoo & Detritus due to horiz advection ONT1F304.205
C (units: mMols-N/m3/day) ONT1F304.206
REAL HADV_PHY(SWNCOL_BIO,JMT_BIO,KM_BIO) ORH1F305.641
& ,HADV_ZOO(SWNCOL_BIO,JMT_BIO,KM_BIO) ORH1F305.642
& ,HADV_DET(SWNCOL_BIO,JMT_BIO,KM_BIO) ORH1F305.643
ONT1F304.210
REAL NUT_FLUX (SWNCOL_BIO,JMT_BIO,KM_BIO) ORH1F305.644
! Vertical flux of nutrient ORH1F305.645
C ! through base of layer (positive=flux into ONT1F304.212
C ! layer, negative=flux out). (mMol-N/m2/day). ONT1F304.213
C ONT1F304.214
LOGICAL SF_BIO(*) ONT1F304.215
C ONT1F304.218
C Workspace, intercepted for full-field diagnostics ONT1F304.219
C ONT1F304.220
REAL WNUT_FLUX(IMT_BIO,KM_BIO),WHADV_NUT(IMT_BIO,KM_BIO) ORH1F305.646
& ,DNWORK(IMT_BIO,KM_BIO) ORH1F305.647
+ ,WMIX_NUT(IMT_BIO,KM_BIO),WCNVC_NUT(IMT_BIO,KM_BIO) ORH1F305.648
& ,WBIO_NUT(IMT_BIO,KM_BIO) OJP0F404.948
C ORH1F305.650
C ONT1F304.225
C JG170893.187
C ORH1F305.651
REAL NT071293.39
+ PCO2 (IMT_CAR) ! OUT Partial pressure CO2 (ppm) ORH1F305.652
+ ,CO2_FLUX (IMT_CAR) ! OUT Air-sea flux of CO2 (Mole/m2/yr) ORH1F305.653
& ,VTCO2_FLUX (IMT_CAR) ! OUT Virtual carbon flux OJP0F404.944
& ,VALK_FLUX (IMT_CAR) ! OUT Virtual alkalinity flux OJP0F404.945
+ ,INVADE (IMT_CAR) ! OUT Invasion of CO2 (Mole/m2/yr) ORH1F305.654
+ ,EVADE(IMT_CAR) ! OUT Evasion of CO2 (Mole/m2/yr) ORH1F305.655
+ ,PCO2_ATM ! IN Atmosphere part. pres. CO2 (ppm) ORH1F305.656
+ ,c14to12_atm ! IN Atmosphere ratio of c14/c12 ORH1F305.657
& ,ATMPCO2_ROW(IMT_CAR) ! IN atmospheric CO2 conc (ppmv) OCN1F405.25
REAL TRACER.78
+ rhosrn(IMT_RIC,KM_RIC)! IN Density on row J as calculated by ORH1F305.658
+ ,RHOSRNA(IMT_RIC,KM_RIC+1),RHOSRNB(IMT_RIC,KM_RIC+1) OOM1F405.794
C ! IN DENSITY ON ROW J AS CALCULATED BY STATEC. OOM1F405.795
C ! PASSED FROM CLINIC TO SAVE REPEAT CALL TO STATEC. OOM1F405.796
C STATED. Passed from CLINIC to save TRACER.80
C repeat call to STATED. TRACER.81
+,esav(IMT_IPD,KM_IPD,NT_IPD) ORH1F305.659
! INOUT Used to save e(I,K,2) in IPDFLXCL ORH1F305.660
C TRACER.86
REAL OLA0F404.45
& WSXM(IMT),WSYM(IMT) ! IN wind stress on row j-1 OLA0F404.46
&,RiT(imt_gnu,km_gnu-1) ! OUT Richardson no on T grid OLA0F404.47
&,hT(imt_qlarge) ! OUT Depth Large scheme applied to (T grid) OLA0F404.48
&,gnuT(imt_gnu,km_gnu-1) ! OUT Vertical viscosity coeff, OLA0F404.49
! bottom of gridbox on T grid OLA0F404.50
C TRACER.88
C DECLARE VARIABLES REQUIRED FOR INTERACTIONS WITH SEA-ICE. TRACER.89
C TRACER.90
LOGICAL ICY(IMT_ICE), ! IN TRUE WHERE SEA-ICE EXISTS. ORH1F305.661
+ NEWICE(IMT_ICE) ! OUT TRUE WHERE ICE DOES NOT YET ORH1F305.662
+ ! EXIST BUT IS ABOUT TO FORM. ORH1F305.663
C TRACER.94
REAL TRACER.95
+ AICE(IMT_ICE), ! INOUT Fractional ice concentration. ORH1F305.664
+ HICE(IMT_ICE), ! INOUT Ice depth averaged over grid box. ORH1F305.665
+ HSNOW(IMT_ICE), ! INOUT Snow depth over ice frctn of grid box ORH1F305.666
+ HICE_REF(IMT_IHY), ! IN CLIMATOLOGICAL ice depth. ORH1F305.667
+ WMEALT(IMT_PIIC_MIX), ! WME WITH ZEROS INSERTED AT ICE POINTS ORH1F305.668
+ DRHO_ICE(IMT_ICE_MIX), ! DENSITY CHANGE AT THE SURFACE DUE TO ORH1F305.669
+ ! ICE-OCEAN FLUXES. FOR MIXED LAYER MODEL. RH011293.196
C ORH1F305.670
+ FLXTOICE(IMT_ICE), ORH1F305.671
+ ! IN PRIMARY HEAT FLUX FROM OCEAN TO ICE,IN W/M**2 ORH1F305.672
+ CARYHEAT(IMT_ICE), ORH1F305.673
+ ! INOUT ON ENTRY CONTAINS MINOR CONTRIBUTIONS TO ORH1F305.674
+ ! THE OCEAN-TO-ICE HEAT FLUX. THESE ARE POSITIVE TRACER.106
+ ! FOR HEAT ENTERING THE OCEAN IE SIGN CONVENTION TRACER.107
+ ! OPPOSITE TO FLXTOICE. ON EXIT CONTAINS THE -VE TRACER.108
+ ! HEAT FLUX IN W.M-2 DUE TO RESETTING OCEAN LEVEL TRACER.109
+ ! 1 TEMPERATURES WHICH FALL BELOW -1.8 CELSIUS. TRACER.110
+ CARYSALT(IMT_ICE), ORH1F305.675
+ ! IN Rate of salinity increase due to OJC0F400.17
+ ! ice-snow processes. OJC0F400.18
+ WME_ICE(IMT_IDR), ODC1F405.423
+ ! IN Mixing energy under sea ice including wind ORH1F305.678
+ ! and ice-ocean stress. JT161193.378
+ SURFTEMP(IMT_ICE), ! OUT TEMP OF THE TOP LAYER AT START OF STEP. ORH1F305.679
+ SURFSAL(IMT_ICE) ! OUT TRUE TOP LAYER SALIN AT START OF STEP ORH1F305.680
+,HEATSINK(IMT) ! OUT Heat 'lost' by setting T to TFREEZE OJG0F401.2
+ ! at ocean floor. OJG0F400.24
C TRACER.129
REAL OLA0F404.51
& ISX(IMT_idr) ! IN Stress under sea ice fraction, row j ODC1F405.424
&,ISY(IMT_idr) ! IN Stress under sea ice fraction, row j ODC1F405.425
&,WSX_LEADS(IMT_idr) ! IN Stress under leads fraction, row j ODC1F405.426
&,WSY_LEADS(IMT_idr) ! IN Stress under leads fraction, row j ODC1F405.427
&,ISXM(IMT_idr) ! IN Stress under sea ice fraction, row j-1 ODC1F405.428
&,ISYM(IMT_idr) ! IN Stress under sea ice fraction, row j-1 ODC1F405.429
&,WSX_LEADSM(IMT_idr) ! IN Stress under leads fraction, row j-1 ODC1F405.430
&,WSY_LEADSM(IMT_idr) ! IN Stress under leads fraction, row j-1 ODC1F405.431
C NT071293.50
C Declare variables required for the carbon cycle model NT071293.51
REAL NT071293.52
+ REK0 (IMT_CAR) ! Solubility of CO2 (Henrys Law const) ORH1F305.681
+, RG1 (IMT_CAR) ! Products etc of the Equilibrium ORH1F305.682
+, RG2 (IMT_CAR) ! constants, which are used for ORH1F305.683
+, RG3 (IMT_CAR) ! the calculation of PCO2 ORH1F305.684
+, REK (IMT_CAR) ORH1F305.685
C NT071293.58
REAL @DYALLOC.4039
+ rxp(IMT_IPD,KM_IPD) ! delta-rho in x dirn. } ORH1F305.686
+ ,ry (IMT_IPD,KM_IPD) ! delta-rho in y dirn. } ORH1F305.687
+ ,rrzp(IMT_IPD,KMP1_IPD) ! delta-rho in z dirn. } ORH1F305.688
C These variables are used to compute the extrapolated density at the OLA0F401.249
C surface and bottom OLA0F401.250
REAL drhob1p(IMT_GM),drhob2p(IMT_GM,2) OLA0F401.251
C Declare the 'eddy induced transport velocities' for GM OLA0F401.252
REAL UISOP(IMT_GM,KM_GM) ! u* isopycnal velocity OLA0F401.253
&, VISOPN(IMT_GM,KM_GM) ! v* at north face of T gridbox OLA0F401.254
&, VISOPS(IMT_GM,KM_GM) ! v* at south face of T gridbox OLA0F401.255
&, WISOP(IMT_GM,KMP1_GM) ! w* at top face of T gridbox OLA0F401.256
&, DTGM(IMT,KM) ! Total dT/dt from GM OOM1F405.152
&, DSGM(IMT,KM) ! Total dsalinity/dt from GM OOM1F405.153
c Declare thickness diffusion coeff for Visbeck scheme OLA2F403.315
REAL OLA2F403.316
& athkdftu(IMT_VIS,JMT_VIS) ! thickness diffusion coeff. (u* pts) OLA2F403.317
&,athkdftv(IMT_VIS,JMT_VIS) ! thickness diffusion coeff. (v* pts) OLA2F403.318
C ORH1F305.689
REAL DRHO_SOL(IMT_MIX) ORH1F305.690
& ,DRHO_NET(IMT_MIX) ! Surface density change (ML) ORH1F305.691
& ,WORKA(IMT_MIX) ORH1F305.692
& ,WORKB(IMT_MIX) ! Workspace for STATED (ML) ORH1F305.693
C ORH1F305.694
REAL QFLUX(IMT_OHY),SFLUX(IMT_OHY) ORH1F305.695
! Surface ht & sal flxes incl Haney ORH1F305.696
C ORH1F305.697
REAL BICE(IMT_PIC) ! Set to 0.0 if climatol. ice pt., 1.0 else ORH1F305.698
* ,QFLUXALT(IMT_PIIC) ORH1F305.699
& ! HTN masked out to zero at climat. ice pts. ORH1F305.700
* ,PMEALT(IMT_PIC) ! PME masked out to zero at climat. ice pts. ORH1F305.701
C ORH1F305.702
* ,SOLALT(IMT_PIIC) ! SOL masked out to zero at climat. ice pts ORH1F305.703
* ,DRHO_PSEU(IMT_PIC_MIX) ! Sfce. density change due to pseudo-ice ORH1F305.704
& ,SOL_PEN_LOC(IMT,0:KM) ! 2D array of SOL_PEN local to OJP0F404.731
& ! this routine. OJP0F404.732
& ,SOL_PEN_BIO(IMT,0:KM) ! 2D array of SOL_PEN, resulting OJP0F404.733
& ! from biological light model. OJP0F404.734
& ,DELPSL_LOC(IMT,0:KM) ! 2D array of DELPSL local to OJP0F404.735
& ! this routine. OJP0F404.736
C ORH1F305.711
REAL TRACER.151
+ gnu(IMT_GNU,KM_GNU) ! Vert diffusion coefficient (cm2/s) ORH1F305.712
+ ,fk1(IMT_IPD,KM_IPD,3) ! } 1st/2nd/3rd rows of diffusn tensor ORH1F305.713
+ ,fk2(IMT_IPD,KM_IPD,3) ! } for point (I,J,K) (cm2/s) ORH1F305.714
+ ,fk3(IMT_IPD,1:KM_IPD,3) ! } Eqn. 1.8 ORH1F305.715
ORH1F305.716
C Define arrays which are local to this subroutine and which ORH1F305.717
C contain values dependent on the model configuration in use. ORH1F305.718
REAL ORH1F305.719
& FK3_OR_GNU(IMT,KM) ! FK3 or GNU ORH1F305.720
&, HTN_OR_QFLALT(IMT) ! HTN or QFLUXALT ORH1F305.721
&, PME_OR_PMEALT(IMT) ! PME or PMEALT ORH1F305.722
&, SOL_OR_SOLALT(IMT) ! SOL or SOLALT ORH1F305.723
&, MLD_MIX(IMT) ORH1F305.724
&, WME_MIX(IMT) ORH1F305.725
C variables for Gent & McW 'eddy induced transport velocities' OLA0F401.258
REAL WISOPT(IMT_GM,KMP1_GM) OLA0F401.259
REAL UTxiso(IMT_GM,KM_GM),VTyiso(IMT_GM,KM_GM), OLA0F401.260
& WTziso(IMT_GM,KM_GM) ! Heating rates for GM scheme OLA0F401.261
C TRACER.191
C This sets the mixed layer depth to zero when using isopycnal TRACER.192
C diffusion without the mixed layer code (currently not allowed TRACER.193
C under the UM system). TRACER.194
C TRACER.195
REAL DIAG_MLD(IMT_NOIPD_MIX) ! OUT ORH1F305.729
ORH1F305.730
C ORW1F400.55
C Dummy mixed layer depth, currently set to 50m. Isopycnal ORW1F400.56
C diffusion is switched off down to this depth ORW1F400.57
C unless the old scheme is used (L_SLOPEMAX) OJG0F403.8
C ORW1F400.58
REAL DUMMY_MLD(IMT) ORW1F400.59
C ORH1F304.97
*CALL TYPOCLWK ORH1F304.98
C ORH1F304.99
C TRACER.199
C Workspace for full-field heating-rates and rates of change of OJG2F401.50
C salinity. These WD* variables have one row and correspond to OJG2F401.51
C the IMT,JMT[,KM] D* variables which contain the final OJG2F401.52
C diagnostic output. There are no WDS* variables for advection OJG2F401.53
C and diffusion because the WDT* variables can be used instead, OJG2F401.54
C as that portion of the computation takes place within a loop OJG2F401.55
C over tracers. OJG2F401.56
C JG170893.189
REAL WDTXADV(IMT,KM),WDTYADV(IMT,KM),WDTZADV(IMT,KM) JG170893.190
&,WDTXDIFF(IMT,KM),WDTYDIFF(IMT,KM) JG170893.191
&,WDTZDIFFV(IMT,KM),WDTZDIFFI(IMT,KM) JG170893.192
&,WDTSFC(IMT,KM),WDTPEN(IMT,KM),WDTICE(IMT,KM) JG170893.193
&,WDTMIX(IMT,KM),WDTCNVC(IMT,KM) JG170893.194
&,WDTZ(IMT,KM),WDTFF(IMT,KM),WDTMED(IMT,KM) JG170893.195
&,DTWORK(IMT,KM) JG170893.196
&,WDSSFC(IMT),WDSICE(IMT) OJG2F401.57
&,WDSMIX(IMT,KM),WDSCNVC(IMT,KM) OJG2F401.58
&,WDSZ(IMT,KM),WDSFF(IMT,KM),WDSMED(IMT,KM) OJG2F401.59
&,DSWORK(IMT,KM) OJG2F401.60
C RH011293.149
C DECLARE REAL NUMBER VARIABLES RH011293.150
C RH011293.151
REAL BOXVOL, ! Volume of a grid box RH011293.152
& BBTJ, ! Coeff used in horizontal mixing of T RH011293.153
& CCTJ, ! Coeff used in horizontal mixing of T RH011293.154
& DDTJ, ! Coeff used in horizontal mixing of T RH011293.155
& FX, ! Temporary value RH011293.156
& FXA, ! Temporary value RH011293.157
& FXB, ! Temporary value RH011293.158
& FACTOR ! Temporary intermetiate result RH011293.159
C RH011293.160
C DECLARE INTEGER VARIABLES RH011293.161
C RH011293.162
INTEGER I, ! Grid point index (Zonal) RH011293.163
& J, ! Grid point index (Meridional) RH011293.164
& K, ! Grid point index (Vertical TOP DOWN) RH011293.165
& KM1, ! K - 1 RH011293.175
& KMP, ! Tot no of vert levels at row J+1 RH011293.176
& KP1, ! K + 1 RH011293.177
& KP2, ! K + 2 RH011293.178
& KZ, ! Number of sea levels at point RH011293.181
& M, ! Tracer indicator RH011293.182
& N, ! Index used during grav instblty adjstmnt RH011293.183
& II, ! Loop control for U,V processing RH011293.187
& MXP ! Euler backward pass timestep flag RH011293.191
& ,KOFF ! offset used in divergence calculation ORL1F404.638
ORH1F304.89
REAL OLA2F403.319
& ri(imt_vis) ! depth averaged Richardson number for Visbeck OLA2F403.320
&, tmin2(imt_vis) ! Time scale ^-2 for Visbeck scheme OLA2F403.321
INTEGER OLA2F403.322
& bot ! used to calc ri,depth averaged Richardson number OLA2F403.323
C ORH1F305.731
REAL FTARR(IMTIMT_FLT) ! Coeffs used in filtering routine ORH1F405.470
ORH1F305.733
REAL DIAG_MLD_LOC(IMT_IPD_NOMIX_ARG) ! Local version of DIAG_MLD ORH1F305.734
! used when L_OISOPYC = t ORH1F305.735
! and L_OMIXLAY = f. ORH1F305.736
C diffusion coefficients used in the isopycnal diffusion OOM1F405.154
C of the MOM code - defined in subroutine ISOPYC_M OOM1F405.155
REAL Ai_ez(imt_iso,km_iso,0:1,0:1),Ai_bx(imt_iso,km_iso,0:1,0:1), OOM1F405.156
& Ai_by(imt_iso,km_iso,0:1,0:1),Ai_nz(imt_iso,km_iso,0:1,0:1), OOM1F405.157
& K11(imt_iso,km_iso),K22(imt_iso,km_iso),K33(imt_iso,km_iso) OOM1F405.158
OOM1F405.159
C GM variables for Griffies implementation OOM1F405.160
REAL adv_vetiso(imt_iso,km_iso), OOM1F405.161
& adv_vbtiso(imt_iso,0:km_iso),adv_fbiso(imt_iso,0:km_iso) OOM1F405.162
OOM1F405.163
C variables for Gent & McW MOM 'eddy induced transport velocities' OOM1F405.164
REAL UTxiso_mom(IMT_GMM,KM_GMM),VTyiso_mom(IMT_GMM,KM_GMM), OOM1F405.165
& WTziso_mom(IMT_GMM,KM_GMM) OOM1F405.166
REAL times(imt),rhoz,srho(imt,km) OOM1F405.167
OOM1F405.168
C OJG2F404.17
real giga OJG2F404.18
parameter(giga=1e9) ! Constant for multiplying diagnostics OJG2F404.19
LOGICAL L_BOOTSTRAP ! =.false. For call to ADV_SOURCE OSY1F405.80
C OJG2F404.20
REAL OOM1F405.799
& MLD_LARGE(IMT) ! IN MIXED LAYER DEPTH (CM) OOM1F405.800
&, WATERFLUX_ICE(IMT) ! IN WATER FLUX FROM ICE (KG/M2/S) ,ROW J OOM1F405.801
&, L_T(IMT) ! OUT MONIN OBUKHOV LENGTH LARGE SCHEME (TRACER) OOM1F405.802
&, LAMBDA_LARGE ! IN FOR CALCULATING MINIMUM MLD OOM1F405.803
&, CGFLUX(IMT,KM,NT) ! TRACER COUNTER GRADIENT FLUXES OOM1F405.804
LOGICAL L_OWINDMIX,L_OBULKMAXMLD OOM1F405.805
C OOM1F405.806
C ORH1F305.737
C OLA3F403.283
REAL OLA0F404.60
& XSTRESS_ICE(IMT_idr) ! Total stress under sea ice, row j ODC1F405.432
&,YSTRESS_ICE(IMT_idr) ! (Wind stress at ice free points) ODC1F405.433
&,XSTRESS_ICEM(IMT_idr) ! Total stress under sea ice, row j-1 ODC1F405.434
&,YSTRESS_ICEM(IMT_idr) ! (Wind stress at ice free points) ODC1F405.435
ORH1F304.93
REAL OOM1F403.69
& ATTEND(KM,NT,4) ! Mixing tendencies caused by Med outflow OOM1F403.70
REAL HUDTEND(KM,NT,4) OOM2F405.292
C---------------------------------------------------------------------- RH011293.192
C BEGIN EXECUTABLE CODE TRACER.201
C--------------------------------------------------------------------- TRACER.202
C ORH1F305.738
IF (L_OTIMER) CALL TIMER('TRACER ',103) GPB8F405.128
ORH1F403.99
DO I=1,IMT OOM1F405.169
DO K=1,KM OOM1F405.170
WDTZDIFFI(I,K)=0.0 OOM1F405.171
ENDDO OOM1F405.172
ENDDO OOM1F405.173
c OOM1F405.174
do i=1,imt OOM1F405.175
times(i)=0. OOM1F405.176
enddo OOM1F405.177
OOM1F405.178
! Only actually do main calculations for rows 2 to JMTM1_GLOBAL ORH1F403.100
IF (J.GE.J_2.AND.J.LE.J_JMTM1) THEN ORH1F403.101
ORH1F403.102
IF (L_OISOPYC.AND.(.NOT.(L_OMIXLAY)))THEN ORH1F305.740
DO I = 1, IMT ORH1F305.741
DIAG_MLD_LOC(I) = 0.0 ORH1F305.742
ENDDO ORH1F305.743
ENDIF ORH1F305.744
c Initialise ri OLA2F403.324
IF (L_OVISBECK) THEN OLA2F403.325
do i=1,imt OLA2F403.326
ri(i)=0.0 OLA2F403.327
enddo OLA2F403.328
ENDIF OLA2F403.329
C TRACER.206
C Set indices for copying working arrays for heating-rates JG170893.198
C to stash workspace JG170893.199
C JG170893.200
! Set MXP to zero - it is not actually used ORH1F305.745
! at present, but appears in the code giving warning ORH1F305.746
! messagees about being used before initialisation ORH1F305.747
MXP = 0 ORH1F305.748
ORH1F305.749
IF (L_OCYCLIC) THEN ORH1F305.750
ISSW=2 ORH1F305.751
IESW=IMTM1 ORH1F305.752
ELSE ORH1F305.753
ISSW=1 ORH1F305.754
IESW=IMT ORH1F305.755
ENDIF ORH1F305.756
C ORH1F305.757
C Initialise Heatsink OJG0F401.6
do I=1,IMT OJG0F401.7
HEATSINK(I)=0.0 OJG0F401.8
enddo OJG0F401.9
C OJG0F401.10
IF (L_SEAICE) THEN ORH1F305.758
C TRACER.208
C--------------------------------------------------------------------- TRACER.209
C THE FOLLOWING CALL TO KEEPTRAC STORES THE PRESENT VALUES OF THE TRACER.210
C SST AND THE TRUE SURFACE SALINITY IN THE ARRAYS SURFTEMP AND TRACER.211
C SURFSAL, FOR COMMUNICATION TO THE ICE MODEL. TRACER.212
C--------------------------------------------------------------------- TRACER.213
C TRACER.214
C ORH1F305.759
IF (L_OTIMER) CALL TIMER('KEEPTRAC ',103) GPB8F405.129
C ORH1F305.761
CALL KEEPTRAC(T,SURFTEMP,SURFSAL,FM,IMT,KM,NT) ORH1F305.762
C ORH1F305.763
IF (L_OTIMER) CALL TIMER('KEEPTRAC ',104) GPB8F405.130
C ORH1F305.765
ENDIF ! L_SEAICE = true ORH1F305.766
C ORH1F305.767
C======================================================================= TRACER.225
C BEGIN INTRODUCTORY SECTION, PREPARING VARIOUS ====================== TRACER.226
C ARRAYS FOR THE COMPUTATION OF THE TRACERS ====================== TRACER.227
C======================================================================= TRACER.228
OJP0F404.737
! ---------------------------------------------------------------- OJP0F404.738
! Set up timestep and level thickness variables fo use in calls OJP0F404.739
! whatever the value of switch L_OVARYT OJP0F404.740
! ---------------------------------------------------------------- OJP0F404.741
DO K=1,KM OJP0F404.742
IF (L_OVARYT) THEN OJP0F404.743
TIMESTEP(K)=DTTSA(K) OJP0F404.744
GAMMA_DZ(K)=RZ(K) OJP0F404.745
ELSE OJP0F404.746
TIMESTEP(K)=C2DTTS OJP0F404.747
GAMMA_DZ(K)=DZ(K) OJP0F404.748
ENDIF OJP0F404.749
ENDDO OJP0F404.750
OJP0F404.751
! ---------------------------------------------------------------- OJP0F404.752
OJP0F404.753
IF (L_ORICHARD) THEN ORH1F305.768
C TRACER.230
C ---------------------------------------------------------------- TRACER.231
C Call subroutine to calculate vertical coefficient of diffusion TRACER.232
C ---------------------------------------------------------------- TRACER.233
C TRACER.234
IF (L_SEAICE.AND.L_ICEFREEDR) THEN ODC1F405.436
do i=1,imt OLA0F404.66
XSTRESS_ICE(I) = WSX_LEADS(I)+ISX(I) OLA0F404.67
YSTRESS_ICE(I) = WSY_LEADS(I)+ISY(I) OLA0F404.68
XSTRESS_ICEM(I) = WSX_LEADSM(I)+ISXM(I) OLA0F404.69
YSTRESS_ICEM(I) = WSY_LEADSM(I)+ISYM(I) OLA0F404.70
enddo OLA0F404.71
CALL VERTCOFT OLA0F404.72
& ( J,IMT,KM,KMM1,NT, OLA0F404.73
& IMT_QLARGE,L_OQLARGE,L_OCYCLIC, OLA0F404.74
& IMT_FULARGE,L_OFULARGE,L_OUSTARWME,L_OWINDMIX,L_OBULKMAXMLD, OOM1F405.808
& L_OROTATE,L_OSTATEC,L_SEAICE,L_OPANDP,PHIT(J),TB, OOM1F405.809
& UB,VB,UBM,VBM, OLA0F404.75
& XSTRESS_ICE,YSTRESS_ICE,XSTRESS_ICEM,YSTRESS_ICEM, OLA0F404.76
& ZDZZ,ZDZ,DZ,DZZ, OOM1F405.810
& DZZ2RQ,DZ2RQ, OLA0F404.78
& NERGY,GRAV_SI,FM, OLA0F404.79
& RHOSRN,RHOSRNA,RHOSRNB, OOM1F405.807
& hT,RiT,max_qLarge_depth,crit_Ri, OLA0F404.81
& MLD_LARGE,MAX_LARGE_DEPTH,MAX_LARGE_LEVELS,RHO_WATER_SI, OOM1F405.811
& HTN,PME,WATERFLUX_ICE,SOL,WME,L_T,LAMBDA_LARGE, OOM1F405.812
& SPECIFIC_HEAT_SI, OOM1F405.813
& gnu(1,1),FNU0_SI,FNUB_SI,STABLM_SI,FKAPB_SI,GNUMINT_SI OLA0F404.82
& ,KAPPA_B_SI,OCEANHEATFLUX,CARYHEAT,FLXTOICE,CGFLUX ) OOM1F405.814
ELSE OLA0F404.84
CALL VERTCOFT TRACER.235
& ( J,IMT,KM,KMM1,NT, TRACER.236
& IMT_QLARGE,L_OQLARGE,L_OCYCLIC, OLA3F403.284
& IMT_FULARGE,L_OFULARGE,L_OUSTARWME,L_OWINDMIX,L_OBULKMAXMLD, OOM1F405.816
& L_OROTATE,L_OSTATEC,L_SEAICE,L_OPANDP,PHIT(J),TB, OOM1F405.817
& UB,VB,UBM,VBM, TRACER.237
& WSX,WSY,WSXM,WSYM, OLA3F403.285
& ZDZZ,ZDZ,DZ,DZZ, OOM1F405.818
& DZZ2RQ,DZ2RQ, OLA3F403.287
& NERGY,GRAV_SI,FM, TRACER.239
& RHOSRN,RHOSRNA,RHOSRNB, OOM1F405.815
& hT,RiT,max_qLarge_depth,crit_Ri, OLA0F404.86
& MLD_LARGE,MAX_LARGE_DEPTH,MAX_LARGE_LEVELS,RHO_WATER_SI, OOM1F405.819
& HTN,PME,WATERFLUX_ICE,SOL,WME,L_T,LAMBDA_LARGE, OOM1F405.820
& SPECIFIC_HEAT_SI, OOM1F405.821
& gnu(1,1),FNU0_SI,FNUB_SI,STABLM_SI,FKAPB_SI,GNUMINT_SI RW071293.1
& ,KAPPA_B_SI,OCEANHEATFLUX,CARYHEAT,FLXTOICE,CGFLUX ) OOM1F405.822
ENDIF OLA0F404.87
C TRACER.242
c put vertical viscosity coeff gnu into gnuT OLA3F403.289
do k=1,km_gnu-1 OLA3F403.290
do i=1,imt_gnu OLA3F403.291
gnuT(i,k)=gnu(i,k+1) OLA3F403.292
enddo OLA3F403.293
enddo OLA3F403.294
c Set cyclic boundary condtions for Richardson no. OLA2F403.330
if (L_OCYCLIC) then OLA2F403.331
do k=1,kmm1 OLA2F403.332
RiT(1,k) = RiT(imtm1,k) OLA2F403.333
RiT(imt,k) = RiT(2,k) OLA2F403.334
enddo OLA2F403.335
endif OLA2F403.336
IF (L_OVISBECK) THEN OLA2F403.337
c Calculate time scale for Visbeck scheme OLA2F403.338
c First, average Richardson no over correct depths. OLA2F403.339
do k=kri(1),kri(2) OLA2F403.340
do i=1,imt OLA2F403.341
ri(i)=ri(i)+RiT(i,k)*dzz(k)*fm(i,k) OLA2F403.342
enddo OLA2F403.343
enddo OLA2F403.344
c find f OLA2F403.345
IF (.NOT.(L_OROTATE)) FX=2.0*OMEGA*SINE(J) OLA2F403.346
c T^min2=f^2/Ri OLA2F403.347
do i=1,imt OLA2F403.348
if (ri(i).lt.1.e-20) ri(i)=1.e-20 OLA2F403.349
bot=min(kmt(i),kri(2)) OLA2F403.350
if (bot .lt. kri(1)) bot=kri(1) OLA2F403.351
ri(i)=ri(i)/(zdzz(bot)-zdzz(kri(1)-1)) OLA2F403.352
tmin2(i)=fx*fx/ri(i) OLA2F403.353
enddo OLA2F403.354
ENDIF OLA2F403.355
ENDIF ORH1F305.769
C ORH1F305.770
IF (L_OISOPYC) THEN ORH1F305.771
C ORH1F305.772
IF (.NOT.(L_ORICHARD)) THEN ORH1F305.773
DO K=1,KM ORH1F305.774
DO I=1,IMT ORH1F305.775
gnu(I,K)=FKPH TRACER.247
END DO ORH1F305.776
END DO ORH1F305.777
ENDIF ORH1F305.778
C ORH1F305.779
IF (.NOT.L_OISOMOM) THEN OOM1F405.179
OOM1F405.180
C ------------------------------------------------------------------ TRACER.252
C Call subroutine to calculate isopycnal diffusion tensor TRACER.253
C ------------------------------------------------------------------ TRACER.254
C TRACER.255
C OJG0F403.9
IF (L_SLOPEMAX) THEN OJG0F403.10
C OJG0F403.11
C Old isopycnal diffusion scheme, with a maximum slope OJG0F403.12
C OJG0F403.13
IF (L_OMIXLAY) THEN OJG0F403.14
C OJG0F403.15
CALL IPDCOFCO OJG0F403.16
& ( J,JMT,IMT,IMTM1,KM,KMT,KMP,KMP1,KMP2,NT,NTMIN2, OJG0F403.17
& J_OFFSET, ORH7F404.20
& T,TP,TDIF, OJG0F403.20
& DXUR,DXU2RQ,DXT4RQ,DYUR,DYT4R,DZ2RQ,DZZ2RQ,ZDZ,DTTS, OJG0F403.21
& NERGY,CSR,CSTR,ITT,FM,FMP, OJG0F403.22
& RHOS,RHON,AH,ahi, OJG0F403.23
& gnu(1,1),JFT0,esav,fk1,fk2,fk3(1,1,1), OJG0F403.24
& rxp,ry,rrzp, OJG0F403.25
& MLD(1,J) OJG0F403.26
& ,SLOPE_MAX OJG0F403.27
& ) OJG0F403.28
C OJG0F403.29
ELSE OJG0F403.30
C OJG0F403.31
CALL IPDCOFCO OJG0F403.32
& ( J,JMT,IMT,IMTM1,KM,KMT,KMP,KMP1,KMP2,NT,NTMIN2, OJG0F403.33
& J_OFFSET, ORH7F404.21
& T,TP,TDIF, OJG0F403.36
& DXUR,DXU2RQ,DXT4RQ,DYUR,DYT4R,DZ2RQ,DZZ2RQ,ZDZ,DTTS, OJG0F403.37
& NERGY,CSR,CSTR,ITT,FM,FMP, OJG0F403.38
& RHOS,RHON,AH,ahi, OJG0F403.39
& gnu(1,1),JFT0,esav,fk1,fk2,fk3(1,1,1), OJG0F403.40
& rxp,ry,rrzp, OJG0F403.41
& DIAG_MLD_LOC OJG0F403.42
& ,SLOPE_MAX OJG0F403.43
& ) OJG0F403.44
C OJG0F403.45
ENDIF OJG0F403.46
C OJG0F403.47
ELSE OJG0F403.48
C ORH1F305.780
IF (L_OMIXLAY) THEN ORH1F305.781
C ORH1F305.782
C ORW1F400.60
C IPD is switched off in top 50m, for numerical stability reasons. ORW1F400.61
C This is instead of switching it off throughout the mixed layer, ORW1F400.62
C as in previous (<4.0) versions of the code. ORW1F400.63
C ORW1F400.64
C To revert to switching off IPD throughout mixed layer, pass MLD ORW1F400.65
C instead of DUMMY_MLD into IPDCOFCL. ORW1F400.66
C ORW1F400.67
DO I=1,IMT ORW1F400.68
DUMMY_MLD(I)=50.0 ORW1F400.69
END DO ORW1F400.70
C ORW1F400.71
CALL IPDCOFCL TRACER.256
& ( J,JMT,IMT,IMTM1,KM,KMP,KMP1,KMP2,NT,NTMIN2, OLA0F401.262
& J_OFFSET, ORH3F402.393
& T,TP,TDIF, TRACER.258
& DZZ,KMT,KMTP,KMTPP, OLA0F401.263
& DXUR,DXU2RQ,DXT4RQ,DYUR,DYT4R,DZ2RQ,DZZ2RQ,ZDZ,DTTS, TRACER.259
& NERGY,CSR,CSTR,ITT,FM,FMP,FMM, OLA0F401.264
& RHOS,RHON,AH,ahi, TRACER.261
& gnu(1,1),JFT0,esav,fk1,fk2,fk3(1,1,1), TRACER.262
& rxp,ry,rrzp, TRACER.263
& drhob1p,drhob2p, OLA0F401.265
& DUMMY_MLD ORW1F400.72
& ,SLOPE_MAX TRACER.272
&,dslope,slopec OLA0F401.266
& ) TRACER.273
C ORH1F305.784
ELSE ORH1F305.785
C ORH1F305.786
CALL IPDCOFCL ORH1F305.787
& ( J,JMT,IMT,IMTM1,KM,KMP,KMP1,KMP2,NT,NTMIN2, OLA0F401.267
& J_OFFSET, ORH3F402.394
& T,TP,TDIF, ORH1F305.791
& DZZ,KMT,KMTP,KMTPP, OLA1F402.1
& DXUR,DXU2RQ,DXT4RQ,DYUR,DYT4R,DZ2RQ,DZZ2RQ,ZDZ,DTTS, ORH1F305.792
& NERGY,CSR,CSTR,ITT,FM,FMP,FMM, OLA0F401.269
& RHOS,RHON,AH,ahi, ORH1F305.794
& gnu(1,1),JFT0,esav,fk1,fk2,fk3(1,1,1), ORH1F305.795
& rxp,ry,rrzp, ORH1F305.796
& drhob1p,drhob2p, OLA0F401.270
& DIAG_MLD_LOC ORH1F305.797
& ,SLOPE_MAX ORH1F305.798
&,dslope,slopec OLA0F401.271
& ) ORH1F305.799
C ORH1F305.800
ENDIF ORH1F305.801
C OJG0F403.49
ENDIF ! L_SLOPEMAX = true OJG0F403.50
ORH1F305.802
ELSE OOM1F405.181
IF (L_OTIMER) CALL TIMER('ISOPYC_M',103) OOM1F405.182
OOM1F405.183
C isopyc_m is the equivalent of IPDCOFCL for the Griffies isopycnal OOM1F405.184
C diffusion, using the new method for calculating Redi isopycnal OOM1F405.185
C diffusion. It sets up the diffusion coefficients for the call OOM1F405.186
C to isoflux later in TRACER OOM1F405.187
OOM1F405.188
CALL ISOPYC_M( OOM1F405.189
*CALL ARGSIZE OOM1F405.190
*CALL COCAWRKA OOM1F405.191
& ,j,cstr,dyur,dxur,dz2r,dzz,dzz2r,athkdftu,athkdftv,ahi,athkdf, OOM1F405.192
& slope_max,dz,dyu,dxu,cs,dxt4r,dyt4r,slopec,dslope,dxtr,dytr, OOM1F405.193
& cst,csr,Ai_ez,Ai_nz,Ai_bx,Ai_by,K11,K22,K33,gnu(1,1), OOM1F405.194
& adv_vetiso,adv_vbtiso,adv_fbiso,J_OFFSET,athkdf_bi, OOM1F405.195
& csjm,dyurjm,j_1,srho) OOM1F405.196
OOM1F405.197
IF (L_OTIMER) CALL TIMER('ISOPYC_M',104) OOM1F405.198
OOM1F405.199
ENDIF OOM1F405.200
OOM1F405.201
C ORH1F305.803
ENDIF ! L_OISOPYC = true ORH1F305.804
C TRACER.275
IF (.NOT.L_OISOMOM) THEN OOM1F405.202
IF ((L_OISOPYC).and.(L_OISOPYCGM)) THEN OLA0F401.272
c calculate the GM velocities OLA0F401.273
c OLA0F401.274
IF (L_OTIMER) CALL TIMER('IPDGMVEL ',103) GPB8F405.131
CALL IPDGMVEL OLA0F401.276
& (J,JMT,IMT,IMTM1,KM,KMM1,KMP1,KMT,KMTP, OLA0F401.277
& DXTR,DYTR,DZ,DZ2R,DZZ2R, OLA0F401.278
& CSTR,CS,ITT,FM,FMP, OLA0F401.279
& J_OFFSET, ORH3F402.386
& ATHKDF,ATHKDFTU,ATHKDFTV,AHI, OLA2F403.356
& fk1,fk2,fk3, OLA0F401.281
& uisop,visopn,visops,wisop OLA0F401.282
& ,mld,zdz OLA0F401.283
& ) OLA0F401.284
IF (L_OTIMER) CALL TIMER('IPDGMVEL ',104) GPB8F405.132
OLA0F401.286
C initialise wisopt, which will be the vertical advection of tracer OLA0F401.287
do k=1,kmp1 OLA0F401.288
do i=1,imt OLA0F401.289
wisopt(i,k)=0. OLA0F401.290
enddo OLA0F401.291
enddo OLA0F401.292
OLA0F401.293
ENDIF OLA0F401.294
OLA0F401.295
ENDIF ! NOT L_OISOMOM OOM1F405.203
OOM1F405.204
C--------------------------------------------------------------------- TRACER.276
C FIND ADVECTIVE COEFFICIENT 'FUW' FOR WEST FACE OF T BOX TRACER.277
C & 'FVN' FOR NORTH FACE OF T BOX TRACER.278
C--------------------------------------------------------------------- TRACER.279
C TRACER.280
IF ( L_OBDY_SOUTH ) THEN OSI1F405.20
C TRACER.282
C Find advective coefficient FVST for south face of T box TRACER.283
C (in same way as FVN & FUW calculated in main code). TRACER.284
C Subsequently used in computation of vertical velocity. TRACER.285
C TRACER.286
C LOOP 670 IS ONLY PERFORMED FOR ONE ROW ORH7F404.7
IF (J+J_OFFSET.EQ.2) THEN ORH3F402.387
FXA=CSTR(J)*CS(J-1) OSY1F405.81
DO 670 K=1,KM TRACER.295
DO 671 I=2,IMT TRACER.296
FVST(I,K)=(V(I,K)*DXU(I)+ OSY1F405.82
& V(I-1,K)*DXU(I-1))*FXA*DXT2R(I) OSY1F405.83
671 CONTINUE TRACER.299
FVST(1,K)=0.0 TRACER.300
670 CONTINUE TRACER.301
ENDIF TRACER.302
C ORH1F305.807
ENDIF ! L_OBDY_SOUTH = true OSI1F405.21
C ORH1F305.809
FXA=DYT2R(J) OSY1F405.84
c FXB=(CSTR(J)*CS(J)) OSY1F405.85
C ORH1F305.810
C LOOP 690 INITIALIZES ARRAYS ORH7F404.8
C ORH1F305.812
DO 690 K=1,KM TRACER.309
DO 691 I=2,IMT TRACER.310
FUW(I,K)=(U(I-1,K)*DYU (J )+UM(I-1,K)*DYU (J-1 ))*FXA TRACER.311
c FVN(I,K)=(V(I ,K)*DXU(I)+V (I-1,K)*DXU(I-1))*FXB OSY1F405.86
c & *DXT2R(I) OSY1F405.87
691 CONTINUE TRACER.314
FUW(1,K)=0.0 TRACER.315
690 CONTINUE TRACER.317
FXB=(CSTR(J)*CS(J)) OSY1F405.88
DO K=1,KM OSY1F405.89
DO I=2,IMT OSY1F405.90
FVN(I,K)=((V(I,K)*DXU(I))+(V(I-1,K)*DXU(I-1)))*FXB OSY1F405.91
& *DXT2R(I) OSY1F405.92
ENDDO OSY1F405.93
FVN(1,K)=0.0 OSY1F405.94
ENDDO OSY1F405.95
C TRACER.318
C--------------------------------------------------------------------- TRACER.319
C COMPUTE VERTICAL VELOCITY IN T COLUMNS TRACER.320
C--------------------------------------------------------------------- TRACER.321
C ORL1F404.639
C 1ST, REARRANGE THE CALCULATION OF THE VERTICAL VELOCITY TO ALLOW FOR ORL1F404.640
C THE FREE SURFACE SOLUTION. THIS METHOD INTEGRATES UPWARDS FROM THE ORL1F404.641
C BOTTOM LEVEL TO CALCULATE THE FREE SURFACE VERTICAL VELOCITY RATHER ORL1F404.642
C THAN INTEGRATING DOWNWARDS FROM THE RIGID LID BOUNDARY CONDITION. ORL1F404.643
C ORL1F404.644
FX = 0.0 ORL1F404.645
DO I=1,IMT ORL1F404.646
IF (L_OFREESFC) THEN ORL1F404.647
W(I,KMP1) = FX ORL1F404.648
ELSE ORL1F404.649
ORL1F404.650
W(I,1) = FX ORL1F404.651
ENDIF ! L_OFREESFC ORL1F404.652
ENDDO ! over i ORL1F404.653
ORL1F404.654
C ORL1F404.655
C 2ND, CALCULATE THE DIVERGENCE (DEPTH WEIGHTED) AT EACH LEVEL ORL1F404.656
C ORL1F404.657
IF (L_OFREESFC) THEN ORL1F404.658
KOFF = 0 ORL1F404.659
ELSE ORL1F404.660
KOFF = 1 ORL1F404.661
ENDIF ORL1F404.662
ORL1F404.663
DO K=1,KM ORH1F305.813
DO I=1,IMTM1 ORH1F305.821
W(I,K+KOFF)=DZ(K)*((FUW(I+1,K)-FUW (I,K))*DXTR(I)*CSTR(J) OSY1F405.96
& +(FVN(I ,K)-FVST(I,K))*DYTR(J)) OSY1F405.97
ENDDO ! over I ORH1F305.824
C ORH1F305.826
W(IMT,K+KOFF)=0.0 ORL1F404.665
ENDDO ! over K ORH1F305.828
C ORL1F404.666
C 3RD, INTEGRATE DOWNWARDS (RIGID LID SOLUTION) ORL1F404.667
C UPWARDS (FREE SURFACE SOLUTION) ORL1F404.668
C ORL1F404.669
IF (L_OFREESFC) THEN ORL1F404.670
ORL1F404.671
DO K=KMP1,2,-1 ORL1F404.672
DO I=1,IMT ORL1F404.673
W(I,K-1)=W(I,K)-W(I,K-1) ORL1F404.674
ENDDO ! over i ORL1F404.675
ENDDO ! over K ORL1F404.676
ELSE ORL1F404.677
DO K=1,KM ORH1F305.829
DO I=1,IMT ORH1F305.837
W(I,K+1)=W(I,K)+W(I,K+1) ORH1F305.838
ENDDO ORH1F305.839
C ORH1F305.841
ENDDO ! over K ORH1F305.842
ORL1F404.678
ENDIF ! L_OFREESFC ORL1F404.679
C TRACER.363
C--------------------------------------------------------------------- TRACER.364
C SET BOUNDARY CONDITIONS FOR VERTICAL DIFFUSION OF TRACERS TRACER.365
C--------------------------------------------------------------------- TRACER.366
C ORH1F305.843
C TRACER.368
C THE ROUNDOFF ERROR IN W AT THE BOTTOM IS ELIMINATED HERE TRACER.369
C IF L_ORICHARD = true ORH1F305.844
C TRACER.370
IF (.NOT.(L_OIMPDIF.OR.L_OIMPADDF))THEN ORH1F305.845
C 1ST, TRANSFER INTERIOR POINTS INT DIFFUSION COMPUTATION ARRAY TRACER.374
C TRACER.375
DO 720 M=1,NT ORH1F305.846
DO 720 K=1,KM ORH1F305.847
DO 720 I=1,IMT ORH1F305.848
TDIF(I,K+1,M)=TB(I,K,M) ORH1F305.849
720 CONTINUE ORH1F305.850
C TRACER.381
C 2ND, SET TOP POINT OF THE COLUMN TO REFLECT SURFACE FLUX, TRACER.382
C BOTTOM POINT OF THE COLUMN TO REFLECT INSULATION. TRACER.383
C (THE ROUNDOFF ERROR IN W AT THE BOTTOM IS ALSO ELIMINATED HERE) TRACER.384
C TRACER.385
ENDIF ORH1F305.851
C ORH1F305.852
FX=0.0 TRACER.390
DO 730 I=1,IMT TRACER.391
KZ=KMT(I) TRACER.392
IF(KZ.EQ.0)GO TO 730 TRACER.393
W(I,KZ+1)=FX TRACER.394
IF (.NOT.(L_OIMPDIF.OR.L_OIMPADDF)) THEN ORH1F305.855
DO 731 M=1,NT ORH1F305.856
TDIF(I,1 ,M)=TB(I,1 ,M) ORH1F305.857
TDIF(I,KZ+2,M)=TB(I,KZ,M) ORH1F305.858
731 CONTINUE ORH1F305.859
ENDIF ORH1F305.860
730 CONTINUE TRACER.401
C TRACER.402
C======================================================================= TRACER.403
C END INTRODUCTORY SECTION =========================================== TRACER.404
C======================================================================= TRACER.405
C TRACER.406
C======================================================================= TRACER.407
C BEGIN COMPUTATION OF THE TRACERS. ===================== TRACER.408
C THE NEW VALUES "TA", WILL FIRST BE LOADED WITH ===================== TRACER.409
C THE TIME RATE OF CHANGE, AND THEN UPDATED. ===================== TRACER.410
C======================================================================= TRACER.411
C TRACER.412
C ORH1F305.881
DO 855 M=1,NT TRACER.413
IF (L_OISOPYCGM) THEN OLA0F401.296
OLA0F401.297
c compute "wisop"*(tracer) at the center of the top face of OLA0F401.298
c the t grid box OLA0F401.299
c OLA0F401.300
do k=2,km OLA0F401.301
do i=1,imt OLA0F401.302
wisopt(i,k) = wisop(i,k)*(tb(i,k-1,m)+tb(i,k,m)) OLA0F401.303
enddo OLA0F401.304
enddo OLA0F401.305
c OLA0F401.306
c now consider the top and bottom boundaries OLA0F401.307
c OLA0F401.308
do i=1,imt OLA0F401.309
wisopt(i,1) = 0. OLA0F401.310
wisopt(i,kmp1) = 0. OLA0F401.311
enddo OLA0F401.312
OLA0F401.313
ENDIF OLA0F401.314
C TRACER.414
C--------------------------------------------------------------------- TRACER.415
C COMPUTE TOTAL ADVECTION OF TRACERS TRACER.416
C--------------------------------------------------------------------- TRACER.417
C TRACER.418
OSY1F405.98
DO I=1,IMT OSY1F405.99
KMTJM(I)=FKMP(I,J-1) OSY1F405.100
ENDDO OSY1F405.101
OSY1F405.102
L_BOOTSTRAP=.FALSE. OSY1F405.103
CALL ADV_SOURCE( OSY1F405.104
& O_ADVECT_SCHEME(1,M), OSY1F405.105
& J, OSY1F405.106
& IMT,J_JMT,KM, OSY1F405.107
& TA(1,1,M), OSY1F405.108
& WDTXADV,WDTYADV,TEMPA,WDTZADV, OSY1F405.109
& T(1,1,M),TB(1,1,M), OSY1F405.110
& TM(1,1,M),TBM(1,1,M),TP(1,1,M),TBP(1,1,M), OSY1F405.111
& TPP(1,1,M),TBPP(1,1,M), OSY1F405.112
& FUW,FVN,FVST,W, OSY1F405.113
& FLUXST(1,1,M),FLUXNT(1,1,M),TEMPB, OSY1F405.114
& DXTR,DYTR,CSTR,DZ,DZZ, OSY1F405.115
& KMTJM,KMT,KMTP,KMTPP, OSY1F405.116
& L_OIMPADDF, OSY1F405.117
& L_OFREESFC, OSY1F405.118
& L_BOOTSTRAP, OSY1F405.119
& L_OCYCLIC, OSY1F405.120
& J_OFFSET,imout,jmout,imout_hud,jmout_hud,ATTEND,HUDTEND, OSY1F405.121
& NMEDLEV,m,NT,L_OMEDADV,L_OHUDOUT,SF_DT(15),SF_DS(14),WDTMED, OSY1F405.122
& WDSMED,CS OSY1F405.123
& ) OSY1F405.124
OSY1F405.125
IF (L_OBIOLOGY) THEN OSY1F405.126
DO K=1,KM OSY1F405.127
DO I=1,IMT OSY1F405.128
WHADV_NUT(I,K)=TEMPA(I,K) OSY1F405.129
ENDDO OSY1F405.130
ENDDO OSY1F405.131
ENDIF OSY1F405.132
OSY1F405.133
IF (L_OBIOLOGY.AND.M.EQ.NUTRIENT_TRACER) THEN OSY1F405.134
DO K=1,KM OSY1F405.135
DO I=1,IMT OSY1F405.136
WNUT_FLUX(I,K)=TEMPB(I,K) OSY1F405.137
ENDDO OSY1F405.138
ENDDO OSY1F405.139
ENDIF OSY1F405.140
C ORH1F305.1011
IF (.NOT.(L_OISOPYC)) THEN ORH1F305.1012
C TRACER.500
C--------------------------------------------------------------------- TRACER.501
C ADD IN HORIZONTAL DIFFUSION OF TRACERS (EVAL. AT TAU-1 TIMESTEP) TRACER.502
C--------------------------------------------------------------------- TRACER.503
C TRACER.504
C 1ST, COMPUTE SEVERAL COEFFICIENTS DEPENDENT ONLY ON LATITUDE TRACER.505
C TRACER.506
BBTJ=8.0*AH*CSTR(J)*CSTR(J) TRACER.507
CCTJ=AH*CS(J )*DYUR(J )*DYTR(J)*CSTR(J) TRACER.508
DDTJ=AH*CS(J-1)*DYUR(J-1)*DYTR(J)*CSTR(J) TRACER.509
C TRACER.510
C 2ND, COMPUTE GRADIENTS AT WEST FACE OF T BOX TRACER.511
C TRACER.512
ENDIF ORH1F305.1013
C ORH1F305.1014
IF (.NOT.(L_OISOPYC)) THEN ORH1F305.1015
C LOOP 838 INITIALIZES TEMPA ORH7F404.10
C ORH1F305.1017
C ORH1F305.1018
DO 838 K=1,KM TRACER.518
DO 839 I=2,IMT TRACER.519
TEMPA(I,K)=DXU2RQ(I-1,K)*(TB(I,K,M)-TB(I-1,K,M)) TRACER.520
839 CONTINUE TRACER.521
TEMPA(1,K)=0.0 TRACER.522
838 CONTINUE TRACER.523
C TRACER.524
C 3RD, ADD IN FINAL CONTRIBUTION FROM HOR. DIFF. OF TRACERS. TRACER.525
C (TO PROVIDE FOR INSULATED WALLS, EACH GRADIENT IS MULTIPLIED BY TRACER.526
C THE MASK OF THE POINT IN ITS RESPECTIVE DIRECTION, THUS TRACER.527
C CAUSING IT TO BE ZERO IF IT IS TAKEN ACROSS A WALL) TRACER.528
C TRACER.529
DO K=1,KM ORH1F305.1019
DO I=2,IMTM1 ORH1F305.1026
WDTXDIFF(I,K)=BBTJ*DXT4RQ(I,K)* ORH1F305.1027
* (FM(I+1,K)*TEMPA(I+1,K)-FM(I-1,K)*TEMPA(I,K)) ORH1F305.1028
WDTYDIFF(I,K)=CCTJ*FMP(I,K)*(TBP(I,K,M)-TB(I,K,M)) ORH1F305.1029
* +DDTJ*FMM(I,K)*(TBM(I,K,M)-TB(I,K,M)) ORH1F305.1030
TA(I,K,M)=TA(I,K,M)+WDTXDIFF(I,K)+WDTYDIFF(I,K) ORH1F305.1031
ENDDO ! over I ORH1F305.1032
TA(1,K,M)=0.0 ORH1F305.1033
TA(IMT,K,M)=0.0 ORH1F305.1034
C ORH1F305.1036
ENDDO ! over K ORH1F305.1037
C ORH1F305.1038
ENDIF ! L_OISOPYC = false ORH1F305.1039
ORH1F305.1040
IF ((.NOT.(L_OIMPDIF)).AND.(.NOT.(L_OIMPADDF))) THEN ORH1F305.1041
C TRACER.556
C--------------------------------------------------------------------- TRACER.557
C ADD IN VERTICAL DIFFUSION OF TRACERS TRACER.558
C--------------------------------------------------------------------- TRACER.559
C TRACER.560
C 1ST, COMPUTE GRADIENTS AT TOP OF T BOX TRACER.561
C TRACER.562
C LOOP 842 INITIALIZES TEMPB ORH7F404.11
C ORH1F305.1043
C ORH1F305.1044
DO 842 K=1,KMP1 TRACER.568
DO 842 I=1,IMT TRACER.569
TEMPB(I,K)=TDIF(I,K,M)-TDIF(I,K+1,M) TRACER.570
842 CONTINUE TRACER.571
C TRACER.572
C 2ND, ADD IN FINAL CONTRIBUTION FROM VERT. DIFF. OF TRACERS TRACER.573
C TRACER.574
DO K=1,KM ORH1F305.1045
DO I=1,IMT ORH1F305.1052
WDTZDIFFV(I,K)=EEHQ(I,K)*TEMPB(I,K)-FFHQ(I,K)*TEMPB(I,K+1) ORH1F305.1053
TA(I,K,M)=TA(I,K,M)+WDTZDIFFV(I,K) ORH1F305.1054
ENDDO ! over I ORH1F305.1055
ENDDO ! over K ORH1F305.1057
C ORH1F305.1058
ENDIF ! L_OIMPDIF and L_OIMPADDF = false ORH1F305.1059
C ORH1F305.1060
IF (L_OISOPYCGM) THEN OLA0F401.315
C calculate the advection terms for isopycnal mixing (GM90) OLA0F401.316
C OLA0F401.323
do k=1,km OLA0F401.324
do i=2,imtm1 OLA0F401.325
OLA0F401.326
UTxiso(i,k) = cstr(j)*dxt2r(i) OLA0F401.327
& *(uisop(i,k)*(t(i+1,k,m)+t(i,k,m)) OLA0F401.328
& -uisop(i-1,k)*(t(i,k,m)+t(i-1,k,m))) OLA0F401.329
c OLA0F401.330
enddo OLA0F401.331
if (l_ocyclic) then OJG2F404.21
UTxiso(1,k)=UTxiso(imtm1,k) OJG2F404.22
UTxiso(imt,k)=UTxiso(2,k) OJG2F404.23
endif OJG2F404.24
enddo OLA0F401.334
c OLA0F401.335
c meridional advection OLA0F401.336
c OLA0F401.337
do k=1,km OLA0F401.338
do i=1,imt OLA0F401.339
OLA0F401.340
VTyiso(i,k) = cstr(j)*dyt2r(j) OLA0F401.341
& *(visopn(i,k)*cs(j)*(tp(i,k,m)+t(i,k,m)) OLA0F401.342
& -visops(i,k)*cs(j-1)*(t(i,k,m) OLA0F401.343
& +tm(i,k,m))) OLA0F401.344
c OLA0F401.345
enddo OLA0F401.346
enddo OLA0F401.347
c OLA0F401.348
c vertical advection OLA0F401.349
c OLA0F401.350
do k=1,km OLA0F401.351
do i=1,imt OLA0F401.352
WTziso(i,k)=dz2r(k)*(wisopt(i,k)-wisopt(i,k+1)) OLA0F401.353
enddo OLA0F401.354
enddo OLA0F401.355
OLA0F401.356
c add the GM flux terms into the rate of change, TA OLA0F401.357
do k=1,km OLA0F401.358
do i=1,imt OLA0F401.359
DTWORK(I,K)=-(UTxiso(i,k)+VTyiso(i,k)+WTziso(i,k)) OJG2F404.25
TA(I,K,M)=TA(I,K,M)+DTWORK(I,K) OJG2F404.26
IF (M.EQ.1) THEN OJG2F404.27
DTGM(I,K)=DTWORK(I,K)*giga OJG2F404.28
ELSEIF (M.EQ.2) THEN OJG2F404.29
DSGM(I,K)=DTWORK(I,K)*giga OJG2F404.30
ENDIF OJG2F404.31
enddo OLA0F401.363
enddo OLA0F401.364
OLA0F401.365
ENDIF OLA0F401.366
IF (L_OISOPYC) THEN ORH1F305.1061
IF (.NOT.L_OISOMOM) THEN OOM1F405.205
C ORH1F305.1062
C TRACER.592
C -------------------------------------------------------------- TRACER.593
C Calculate the components of isopycnal diffusion and update tracers. TRACER.594
C Vertical diffusion is omitted, since it is treated separately TRACER.595
C in VDIFCALT below TRACER.596
C -------------------------------------------------------------- TRACER.597
C TRACER.598
CALL IPDFLXCL TRACER.599
& ( M,J,JMT,IMT,IMTM1,KM,KMP1,KMM1,NT, TRACER.600
& TB,TBP,TBM,TA, TRACER.601
& DXU2RQ,DXT4RQ,DYUR,DYTR,DYT4R,DZ2RQ, TRACER.602
& CS,CSR,CSTR,FM,FMP,FMM, TRACER.603
& esav,fk1,fk2,fk3,WDTXDIFF,WDTYDIFF,WDTZDIFFI) JG170893.242
ELSE OOM1F405.206
OOM1F405.207
IF (L_OTIMER) CALL TIMER('ISOFLUX',103) OOM1F405.208
OOM1F405.209
C isoflux is the equivalent to IPDFLXCL for the Griffies method OOM1F405.210
C of calculating the isopycnal diffusion OOM1F405.211
OOM1F405.212
CALL ISOFLUX( OOM1F405.213
*CALL ARGSIZE OOM1F405.214
*CALL COCAWRKA OOM1F405.215
& ,m,j,cstr,dyur,dxur,dz2r,cs,csjm, OOM1F405.216
& dytr,dxtr,cst,dxt4r,dyt4r,Ai_ez,Ai_nz,Ai_bx,Ai_by,K11,K22,K33, OOM1F405.217
& itt,adv_vbtiso,adv_fbiso,WDTXDIFF,WDTYDIFF,WDTZDIFFI,j_1) OOM1F405.218
OOM1F405.219
IF (L_OTIMER) CALL TIMER('ISOFLUX',104) OOM1F405.220
OOM1F405.221
IF (L_OISOGM) THEN OOM1F405.222
OOM1F405.223
C calculate the advection terms for isopycnal mixing (GM90) OOM1F405.224
C OOM1F405.225
C zonal advection, can set i=1, and i=imt to zero, since at OOM1F405.226
C end of TRACER OOM1F405.227
C TA(1) and TA(IMT) are set if cyclic bc's, and if not cyclic OOM1F405.228
C then these must be walls. OOM1F405.229
C OOM1F405.230
do k=1,km OOM1F405.231
do i=2,imtm1 OOM1F405.232
UTxiso_mom(i,k) = cstr(j)*dxt2r(i) OOM1F405.233
& *(adv_vetiso(i,k)*(tb(i+1,k,m)+tb(i,k,m)) OOM1F405.234
& -adv_vetiso(i-1,k)*(tb(i,k,m)+tb(i-1,k,m))) OOM1F405.235
enddo OOM1F405.236
IF (L_OCYCLIC) THEN OOM1F405.237
UTxiso_mom(1,k)=UTxiso_mom(imtm1,k) OOM1F405.238
UTxiso_mom(imt,k)= UTxiso_mom(2,k) OOM1F405.239
ELSE OOM1F405.240
UTxiso_mom(1,k)=0. OOM1F405.241
UTxiso_mom(imt,k)=0. OOM1F405.242
ENDIF OOM1F405.243
enddo OOM1F405.244
c OOM1F405.245
c meridional advection OOM1F405.246
c OOM1F405.247
do k=1,km OOM1F405.248
do i=1,imt OOM1F405.249
VTyiso_mom(i,k) = cstr(j)*dyt2r(j) OOM1F405.250
& *(adv_vntiso(i,k,1)*(tbp(i,k,m)+tb(i,k,m)) OOM1F405.251
& -adv_vntiso(i,k,0)*(tb(i,k,m) OOM1F405.252
& +tbm(i,k,m))) OOM1F405.253
enddo OOM1F405.254
enddo OOM1F405.255
c OOM1F405.256
c vertical advection OOM1F405.257
c OOM1F405.258
do k=1,km OOM1F405.259
do i=1,imt OOM1F405.260
WTziso_mom(i,k)=dz2r(k)*(adv_fbiso(i,k-1)-adv_fbiso(i,k)) OOM1F405.261
enddo OOM1F405.262
enddo OOM1F405.263
OOM1F405.264
c add the GM flux terms into the rate of change, TA OOM1F405.265
do k=1,km OOM1F405.266
do i=1,imt OOM1F405.267
DTWORK(I,K)=-(UTxiso_mom(i,k)+VTyiso_mom(i,k)+WTziso_mom(i,k)) OOM1F405.268
TA(I,K,M)=TA(I,K,M)+DTWORK(I,K) OOM1F405.269
IF (M.EQ.1) THEN OOM1F405.270
DTGM(I,K)=DTWORK(I,K)*giga OOM1F405.271
ELSEIF (M.EQ.2) THEN OOM1F405.272
DSGM(I,K)=DTWORK(I,K)*giga OOM1F405.273
ENDIF OOM1F405.274
enddo OOM1F405.275
enddo OOM1F405.276
OOM1F405.277
ENDIF ! L_OISOGM OOM1F405.278
C calculate the large scale richardson number, for the Visbeck scheme OOM1F405.279
IF (L_OVISHADCM4) THEN OOM1F405.280
do i=1,imt OOM1F405.281
do k=kri(1),kri(2) OOM1F405.282
times(i)=times(i)+(srho(i,k)*sqrt(grav) OOM1F405.283
& *dzz(k)*fm(i,k)) OOM1F405.284
enddo OOM1F405.285
enddo OOM1F405.286
do i=1,imt OOM1F405.287
bot=min(kmt(i),kri(2)) OOM1F405.288
if (bot .lt. kri(1)) bot=kri(1) OOM1F405.289
times(i)=times(i)/(zdzz(bot)-zdzz(kri(1)-1)) OOM1F405.290
enddo OOM1F405.291
ENDIF OOM1F405.292
OOM1F405.293
ENDIF ! NOT L_OISOMOM OOM1F405.294
OOM1F405.295
ENDIF ! L_OISOPYC = true ORH1F305.1063
C JG170893.243
IF (M.EQ.1) THEN JG170893.244
fx=giga ! multiplies rates by 1e9 OJG2F404.32
DO K=1,KM JG170893.245
CFPP$ NODEPCHK JG170893.246
DO I=ISSW,IESW JG170893.247
II=MOD(I-1,SWNCOL)+1 JG170893.248
IF (SF_DT(1)) DTXADV(II,J,K)=WDTXADV(I,K)*FX OJG2F404.33
IF (SF_DT(2)) DTYADV(II,J,K)=WDTYADV(I,K)*FX OJG2F404.34
C ORH1F305.1064
IF (L_OIMPADDF) THEN ORH1F305.1065
IF (SF_DT(3)) DTZADV(II,J,K)=0. ORH1F305.1066
IF (SF_DT(12)) DTZ(II,J,K)=0. OJG2F404.35
ELSE ORH1F305.1067
IF (SF_DT(3)) DTZADV(II,J,K)=WDTZADV(I,K)*FX OJG2F404.36
IF (SF_DT(12)) DTZ(II,J,K)= OJG2F404.37
& (WDTXADV(I,K)+WDTYADV(I,K)+WDTZADV(I,K))*FX OJG2F404.38
ENDIF ORH1F305.1069
C ORH1F305.1070
IF (SF_DT(4)) DTXDIFF(II,J,K)=WDTXDIFF(I,K)*FX OJG2F404.39
IF (SF_DT(5)) DTYDIFF(II,J,K)=WDTYDIFF(I,K)*FX OJG2F404.40
C ORH1F305.1071
IF ((.NOT.(L_OIMPDIF)).AND.(.NOT.(L_OIMPADDF))) THEN ORH1F305.1072
IF (.NOT.(L_OISOPYC))THEN ORH1F305.1073
IF (SF_DT(6)) DTZDIFF(II,J,K)=WDTZDIFFV(I,K)*FX OJG2F404.41
ELSE ORH1F305.1075
IF (SF_DT(6)) DTZDIFF(II,J,K)=(WDTZDIFFV(I,K)+ OJG2F404.42
& WDTZDIFFI(I,K))*FX OJG2F404.43
ENDIF ORH1F305.1078
ENDIF ORH1F305.1079
C ORH1F305.1080
IF (L_OIMPDIF.AND.L_OISOPYC) THEN ORH1F305.1081
IF (SF_DT(6)) DTZDIFF(II,J,K)=WDTZDIFFI(I,K)*FX OJG2F404.44
ENDIF ORH1F305.1083
C ORH1F305.1093
ENDDO JG170893.276
ENDDO JG170893.277
ENDIF JG170893.278
C OJG2F401.69
C Copy rates of change of salinity from workspace to diagnostic OJG2F401.70
C arrays as required by stash flags. OJG2F401.71
C OJG2F401.72
IF (M.EQ.2) THEN OJG2F401.73
fx=giga ! multiplies rates by 1e9 OJG2F404.45
DO K=1,KM OJG2F401.74
CFPP$ NODEPCHK OJG2F401.75
DO I=ISSW,IESW OJG2F401.76
II=MOD(I-1,SWNCOL)+1 OJG2F401.77
IF (SF_DS(1)) DSXADV(II,J,K)=WDTXADV(I,K)*FX OJG2F404.46
IF (SF_DS(2)) DSYADV(II,J,K)=WDTYADV(I,K)*FX OJG2F404.47
IF (L_OIMPADDF) THEN OJG2F401.80
IF (SF_DS(3)) DSZADV(II,J,K)=0. OJG2F401.81
IF (SF_DS(11)) DSZ(II,J,K)=0. OJG2F404.48
ELSE OJG2F401.82
IF (SF_DS(3)) DSZADV(II,J,K)=WDTZADV(I,K)*FX OJG2F404.49
IF (SF_DS(11)) DSZ(II,J,K)= OJG2F404.50
& (WDTXADV(I,K)+WDTYADV(I,K)+WDTZADV(I,K))*FX OJG2F404.51
ENDIF OJG2F401.84
IF (SF_DS(4)) DSXDIFF(II,J,K)=WDTXDIFF(I,K)*FX OJG2F404.52
IF (SF_DS(5)) DSYDIFF(II,J,K)=WDTYDIFF(I,K)*FX OJG2F404.53
IF ((.NOT.(L_OIMPDIF)).AND.(.NOT.(L_OIMPADDF))) THEN OJG2F401.87
IF (.NOT.(L_OISOPYC))THEN OJG2F401.88
IF (SF_DS(6)) DSZDIFF(II,J,K)=WDTZDIFFV(I,K)*FX OJG2F404.54
ELSE OJG2F401.90
IF (SF_DS(6)) DSZDIFF(II,J,K)=(WDTZDIFFV(I,K) OJG2F404.55
& +WDTZDIFFI(I,K))*FX OJG2F404.56
ENDIF OJG2F401.93
ENDIF OJG2F401.94
IF (L_OIMPDIF.AND.L_OISOPYC) THEN OJG2F401.95
IF (SF_DS(6)) DSZDIFF(II,J,K)=WDTZDIFFI(I,K)*FX OJG2F404.57
ENDIF OJG2F401.97
ENDDO OJG2F401.106
ENDDO OJG2F401.107
ENDIF OJG2F401.108
C OJG2F401.109
IF (L_OBIOLOGY) THEN ORH1F305.1095
IF (M.EQ.NUTRIENT_TRACER) THEN OJP0F404.775
C Factor fx converts rates from (1/s) to (1/day) ONT1F304.253
fx=3600.0*24.0 ONT1F304.254
DO K=1,KM ONT1F304.255
CFPP$ NODEPCHK ONT1F304.256
DO I=ISSW,IESW ONT1F304.257
II=MOD(I-1,SWNCOL)+1 ONT1F304.258
IF (SF_BIO(17)) HADV_NUT(II,J,K)=WHADV_NUT(I,K)*fx ONT1F304.259
IF (SF_BIO(18)) VADV_NUT(II,J,K)=WDTZADV(I,K)*fx ONT1F304.260
IF (SF_BIO(19)) HDIF_NUT(II,J,K)=(WDTXDIFF(I,K) ONT1F304.261
& + WDTYDIFF(I,K))*fx ONT1F304.262
C ORH1F305.1096
IF ((.NOT.(L_OIMPDIF)).AND.(.NOT.(L_OIMPADDF))) THEN ORH1F305.1097
IF (.NOT.(L_OISOPYC)) THEN ORH1F305.1098
IF (SF_BIO(20)) VDIF_NUT(II,J,K)=WDTZDIFFV(I,K)*fx ORH1F305.1099
ELSE ORH1F305.1100
IF (SF_BIO(20)) VDIF_NUT(II,J,K)=(WDTZDIFFV(I,K) ORH1F305.1101
& + WDTZDIFFI(I,K))*fx ONT1F304.268
ENDIF ORH1F305.1102
ENDIF ORH1F305.1103
C ORH1F305.1104
IF (L_OIMPDIF.AND.L_OISOPYC) THEN ORH1F305.1105
IF (SF_BIO(20)) VDIF_NUT(II,J,K)=WDTZDIFFI(I,K)*fx ORH1F305.1106
ENDIF ORH1F305.1107
IF (L_OIMPADDF) THEN ORH1F305.1108
IF (SF_BIO(20)) VDIF_NUT(II,J,K)=0. ORH1F305.1109
ENDIF ORH1F305.1110
ENDDO ONT1F304.277
ENDDO ONT1F304.278
ENDIF ONT1F304.279
ONT1F304.280
C Copy phyto, zoo & detrital advection diagnostics from workspace ONT1F304.281
IF (M.EQ.PHYTO_TRACER) THEN OJP0F404.776
C Factor fx converts rates from (1/s) to (1/day) ONT1F304.283
fx=3600.0*24.0 ONT1F304.284
DO K=1,KM ONT1F304.285
CFPP$ NODEPCHK ONT1F304.286
DO I=ISSW,IESW ONT1F304.287
II=MOD(I-1,SWNCOL)+1 ONT1F304.288
IF (SF_BIO(25)) HADV_PHY(II,J,K)=WHADV_NUT(I,K)*fx ONT1F304.289
ENDDO ONT1F304.290
ENDDO ONT1F304.291
ENDIF ONT1F304.292
ONT1F304.293
IF (M.EQ.ZOO_TRACER) THEN OJP0F404.777
C Factor fx converts rates from (1/s) to (1/day) ONT1F304.295
fx=3600.0*24.0 ONT1F304.296
DO K=1,KM ONT1F304.297
CFPP$ NODEPCHK ONT1F304.298
DO I=ISSW,IESW ONT1F304.299
II=MOD(I-1,SWNCOL)+1 ONT1F304.300
IF (SF_BIO(26)) HADV_ZOO(II,J,K)=WHADV_NUT(I,K)*fx ONT1F304.301
ENDDO ONT1F304.302
ENDDO ONT1F304.303
ENDIF ONT1F304.304
ONT1F304.305
IF (M.EQ.DETRITUS_TRACER) THEN OJP0F404.778
C Factor fx converts rates from (1/s) to (1/day) ONT1F304.307
fx=3600.0*24.0 ONT1F304.308
DO K=1,KM ONT1F304.309
CFPP$ NODEPCHK ONT1F304.310
DO I=ISSW,IESW ONT1F304.311
II=MOD(I-1,SWNCOL)+1 ONT1F304.312
IF (SF_BIO(27)) HADV_DET(II,J,K)=WHADV_NUT(I,K)*fx ONT1F304.313
ENDDO ONT1F304.314
ENDDO ONT1F304.315
ENDIF ONT1F304.316
C ORH1F305.1111
ENDIF ! L_OBIOLOGY = true ORH1F305.1112
C TRACER.606
C--------------------------------------------------------------------- TRACER.607
C COMPUTE NEW TRACERS, RESETTING LAND POINTS TO ZERO TRACER.608
C--------------------------------------------------------------------- TRACER.609
C TRACER.610
C NEXT LOOP ENSURES VALUES SET TO ZERO OVER LAND ORH1F305.1113
C ORH1F305.1115
DO K=1,KM ORH1F305.1118
DO I=1,IMT ORH1F305.1119
TA(I,K,M)=(TB(I,K,M)+TIMESTEP(K)*TA(I,K,M))*FM(I,K) OJP0F404.779
ENDDO ORH1F305.1121
ENDDO ORH1F305.1122
C ORH1F305.1123
855 CONTINUE TRACER.624
! -------------------------------------------------------------------- OJP0F404.780
! END of big loop over for M=1,NT OJP0F404.781
! -------------------------------------------------------------------- OJP0F404.782
C ORH1F305.1132
IF (L_OBIOLOGY) THEN ORH1F305.1133
C ONT1F304.319
C Copy Nutrient flux diagnostic from work array into full field. ONT1F304.320
C At the same time, multiply by 1.0E-2 to convert the earlier ONT1F304.321
C multiplication by vertical velocity from cm/s to m/s. Also ONT1F304.322
C convert from mMol/m2/s to mMol/m2/day (factor 3600*24). ONT1F304.323
C ONT1F304.324
fx=3600.0*24.0*1.0E-2 ONT1F304.325
DO K=1,KM ONT1F304.326
DO I=ISSW,IESW ONT1F304.327
II=MOD(I-1,SWNCOL)+1 ONT1F304.328
IF (SF_BIO(16)) NUT_FLUX(II,J,K)=WNUT_FLUX(I,K)*fx ONT1F304.329
ENDDO ONT1F304.330
ENDDO ONT1F304.331
ENDIF ORH1F305.1134
C ORH1F305.1135
IF (L_OIMPADDF) THEN ORH1F305.1136
C TRACER.626
C -------------------------------------------------------------- TRACER.627
C Treatment of vertical advection/diffusion using implicit TRACER.628
C finite difference equation. TRACER.629
C TRACER.630
C Set up arrays for calculation. TRACER.633
C -------------------------------------------------------------- TRACER.636
C TRACER.637
IF ((.NOT.(L_OISOPYC)).AND.(.NOT.(L_ORICHARD))) THEN ORH1F305.1143
DO K=1,KM ORH1F305.1144
DO I=1,IMT ORH1F305.1145
gnu(I,K)=FKPH ORH1F305.1146
END DO ORH1F305.1147
END DO TRACER.648
ENDIF ORH1F305.1148
C TRACER.659
C Now solve advection/diffusion equation TRACER.660
C TRACER.661
C Call to subroutine VERTSOLV removed. ORH1F305.1149
C ORH1F305.1150
C ORH1F305.1151
DO M=1,NT TRACER.689
DO K=1,KM TRACER.690
DO I=1,IMT TRACER.691
TA(I,K,M)=TF(I,K,M)*FM(I,K) SF020993.16
DTWORK(I,K)=(TF(I,K,M)-TA(I,K,M))*FM(I,K) JG170893.279
TA(I,K,M)=TA(I,K,M)+DTWORK(I,K) JG170893.280
END DO TRACER.693
END DO TRACER.694
END DO TRACER.695
C ORH1F305.1163
ENDIF ! L_OIMPADDF = false ORH1F305.1164
C ORH1F305.1165
IF (L_OIMPDIF) THEN ORH1F305.1166
C TRACER.698
C -------------------------------------------------------------- TRACER.699
C Treatment of vertical diffusion by solving implicitly the TRACER.700
C vertical diffusion equation. TRACER.701
C Because an implicit scheme is used, this is done after the TRACER.702
C new tracers have been computed. TRACER.703
C -------------------------------------------------------------- TRACER.704
C JG170893.299
DO K=1,KM JG170893.300
DO I=ISSW,IESW JG170893.301
DTWORK(I,K)=TA(I,K,1) JG170893.302
DSWORK(I,K)=TA(I,K,2) OJG2F401.132
ENDDO JG170893.303
ENDDO JG170893.304
C ORH1F305.1167
IF (L_OBIOLOGY) THEN ORH1F305.1168
DO K=1,KM ORH1F305.1169
DO I=ISSW,IESW ORH1F305.1170
DNWORK(I,K)=TA(I,K,NUTRIENT_TRACER) OJP0F404.783
ENDDO ORH1F305.1172
ENDDO ORH1F305.1173
ENDIF ORH1F305.1174
C TRACER.705
C ORH1F305.1175
! Populate arguments for subroutine calls - dependent on ORH1F305.1176
! ocean configuration being run. ORH1F305.1177
IF (L_OISOPYC) THEN ORH1F305.1178
IF (L_OISOMOM) THEN OOM1F405.296
DO K = 1, KM OOM1F405.297
DO I = 1, IMT OOM1F405.298
FK3_OR_GNU(I,K) = K33(I,K) OOM1F405.299
ENDDO OOM1F405.300
ENDDO OOM1F405.301
ELSE OOM1F405.302
DO K = 1, KM ORH1F305.1179
DO I = 1, IMT ORH1F305.1180
FK3_OR_GNU(I,K) = FK3(I,K,3) ORH1F305.1181
ENDDO ORH1F305.1182
ENDDO ORH1F305.1183
ENDIF ! OISOMOM OOM1F405.303
OOM1F405.304
ELSE ORH1F305.1184
DO K = 1, KM ORH1F305.1185
DO I = 1, IMT ORH1F305.1186
FK3_OR_GNU(I,K) = GNU(I,K) ORH1F305.1187
ENDDO ORH1F305.1188
ENDDO ORH1F305.1189
ENDIF ORH1F305.1190
C ORH1F305.1191
C OOM1F405.823
IF(.NOT.L_OFULARGE)THEN OOM1F405.824
DO M=1,NT OOM1F405.825
DO K=1,KM OOM1F405.826
DO I=1,IMT OOM1F405.827
CGFLUX(I,K,M)=0.0 OOM1F405.828
ENDDO OOM1F405.829
ENDDO OOM1F405.830
ENDDO OOM1F405.831
ENDIF OOM1F405.832
C OOM1F405.833
C ONLY CALL VDIFCALT HERE IF NOT USING THE FULL LARGE SCHEME OOM1F405.834
C OOM1F405.835
IF(.NOT.L_OFULARGE)THEN OOM1F405.836
C OOM1F405.837
CALL VDIFCALT TRACER.706
& ( J,IMT,IMTM1,KM,KMP1,KMM1,NT, TRACER.707
& TA, TRACER.708
& DZ2R,DZZ2RQ,DZ2RQ,C2DTTS, TRACER.709
& DTTSA, TRACER.712
& FM, TRACER.715
& fk3_or_gnu(1,1),CGFLUX OOM1F405.838
& ) TRACER.724
C ORH1F305.1193
ENDIF !.NOT.L_OFULARGE OOM1F405.839
C OOM1F405.840
IF (SF_DT(6)) THEN JG170893.305
DO K=1,KM JG170893.306
CFPP$ NODEPCHK JG170893.307
DO I=ISSW,IESW JG170893.308
II=MOD(I-1,SWNCOL)+1 JG170893.309
IF (.NOT.(L_OVARYT)) THEN ORH1F305.1194
DTWORK(I,K)=(TA(I,K,1)-DTWORK(I,K))/C2DTTS*giga OJG2F404.58
ELSE ORH1F305.1196
DTWORK(I,K)=(TA(I,K,1)-DTWORK(I,K))/DTTSA(K)*giga OJG2F404.59
ENDIF ORH1F305.1198
IF (.NOT.(L_OISOPYC)) THEN ORH1F305.1199
DTZDIFF(II,J,K)=DTWORK(I,K) ORH1F305.1200
ELSE ORH1F305.1201
DTZDIFF(II,J,K)=DTZDIFF(II,J,K)+DTWORK(I,K) ORH1F305.1202
ENDIF ORH1F305.1203
ENDDO JG170893.320
ENDDO JG170893.321
ENDIF JG170893.322
C OJG2F401.133
C Diagnose rate of change of salinity from vertical diffusion OJG2F401.134
C (non-isopycnal) OJG2F401.135
C OJG2F401.136
IF (SF_DS(6)) THEN OJG2F401.137
DO K=1,KM OJG2F401.138
CFPP$ NODEPCHK OJG2F401.139
DO I=ISSW,IESW OJG2F401.140
II=MOD(I-1,SWNCOL)+1 OJG2F401.141
IF (.NOT.(L_OVARYT)) THEN OJG2F401.142
DSWORK(I,K)=(TA(I,K,2)-DSWORK(I,K))/C2DTTS*giga OJG2F404.63
ELSE OJG2F401.144
DSWORK(I,K)=(TA(I,K,2)-DSWORK(I,K))/DTTSA(K)*giga OJG2F404.64
ENDIF OJG2F401.146
IF (.NOT.(L_OISOPYC)) THEN OJG2F401.147
DSZDIFF(II,J,K)=DSWORK(I,K) OJG2F401.148
ELSE OJG2F401.149
DSZDIFF(II,J,K)=DSZDIFF(II,J,K)+DSWORK(I,K) OJG2F401.150
ENDIF OJG2F401.151
ENDDO OJG2F401.152
ENDDO OJG2F401.153
ENDIF OJG2F401.154
C OJG2F404.60
IF (L_OBIOLOGY) THEN OJG2F404.61
C OJG2F404.62
IF (SF_BIO(20)) THEN ONT1F304.337
C Factor fx converts rates from (1/s) to (1/day) ONT1F304.338
fx=3600.0*24.0 ONT1F304.339
DO K=1,KM ONT1F304.340
CFPP$ NODEPCHK ONT1F304.341
DO I=ISSW,IESW ONT1F304.342
II=MOD(I-1,SWNCOL)+1 ONT1F304.343
DNWORK(I,K)=(TA(I,K,NUTRIENT_TRACER)-DNWORK(I,K))/TIMESTEP(K) OJP0F404.784
IF (.NOT.(L_OISOPYC)) THEN ORH1F305.1212
VDIF_NUT(II,J,K)=DNWORK(I,K) * fx ORH1F305.1213
ELSE ORH1F305.1214
VDIF_NUT(II,J,K)=VDIF_NUT(II,J,K) + fx*DNWORK(I,K) ORH1F305.1215
ENDIF ORH1F305.1216
ENDDO ONT1F304.354
ENDDO ONT1F304.355
ENDIF ONT1F304.356
C ORH1F305.1217
ENDIF ! L_OBIOLOGY = true ORH1F305.1218
ENDIF ! L_OIMPDIF = true ORH1F305.1219
C ORH1F305.1220
IF (L_RIVERS) THEN ORH1F305.1221
C TRACER.727
C ---------------------------------------------------------------------- TRACER.728
C Add in river outflow to pme to get total net fresh water TRACER.729
C ---------------------------------------------------------------------- TRACER.730
C TRACER.731
DO 8591 I=1,IMT TRACER.732
PME(I)=PME(I) + RIVER(I) TRACER.733
8591 CONTINUE TRACER.734
ENDIF ORH1F305.1222
C TRACER.736
IF (L_SEAICE) THEN ORH1F305.1223
C TRACER.738
C--------------------------------------------------------------------- TRACER.739
C THE FOLLOWING CALL TO FLXBLANK ALTERS THE SURFACE HEAT FLUXES OJC2F400.140
C WHERE SEA-ICE IS PRESENT. OJC2F400.141
C THIS DOES NOT AFFECT THE HANEY TERM WHEN L_IHANEY = true ORH1F305.1224
C--------------------------------------------------------------------- TRACER.747
C TRACER.748
IF (L_OTIMER) CALL TIMER('FLXBLANK ',103) GPB8F405.133
C ORH1F305.1226
CALL FLXBLANK(ICY,HTN,QFLUXALT,OCEANHEATFLUX OJC2F400.142
+,WME_ICE JT161193.382
+,SOL,SOLALT TRACER.757
+,WME,WMEALT ORH1F305.1227
+,AICE JT181193.2
+,IMT) TRACER.763
C ORH1F305.1228
IF (L_OTIMER) CALL TIMER('FLXBLANK ',104) GPB8F405.134
C ORH1F305.1230
ENDIF ! L_SEAICE = true ORH1F305.1231
C TRACER.769
C ORH1F305.1232
IF (L_OPSEUDIC) THEN ORH1F305.1233
C TRACER.772
C---------------------------------------------------------------------- TRACER.773
C Pseudo-ice model. Blank out surface fluxes at climatological TRACER.774
C ice points. TRACER.775
C---------------------------------------------------------------------- TRACER.781
C TRACER.782
DO 1855 I=1,IMT TRACER.783
BICE(I)=1. TRACER.784
IF(T_REF(I).LT.TCHECK) BICE(I)=0. TRACER.785
QFLUXALT(I)=HTN(I)*BICE(I) TRACER.786
PMEALT(I)=PME(I)*BICE(I) TRACER.787
IF (L_OSOLAR.OR.L_OSOLARAL) THEN OJP0F404.785
SOLALT(I)=SOL(I)*BICE(I) ORH1F305.1236
ENDIF ORH1F305.1240
C NT091293.56
IF (L_OMIXLAY) THEN ORH1F305.1242
WMEALT(I)=WME(I)*BICE(I) ORH1F305.1243
ENDIF ORH1F305.1244
1855 CONTINUE TRACER.796
C TRACER.797
ENDIF ! L_OPSEUDIC = true ORH1F305.1245
C ORH1F305.1246
IF (L_OHANEY) THEN ORH1F305.1247
C ORH1F305.1248
! Populate arguments for HNYCAL with required ORH1F305.1249
! values dependent on model configuration. ORH1F305.1250
IF (L_SEAICE) THEN ORH1F305.1251
DO I = 1, IMT ORH1F305.1252
HTN_OR_QFLALT(I) = QFLUXALT(I) ORH1F305.1253
PME_OR_PMEALT(I) = PME(I) ORH1F305.1254
ENDDO ORH1F305.1255
ELSE ORH1F305.1256
IF (L_OPSEUDIC) THEN ORH1F305.1257
DO I = 1, IMT ORH1F305.1258
HTN_OR_QFLALT(I) = QFLUXALT(I) ORH1F305.1259
PME_OR_PMEALT(I) = PMEALT(I) ORH1F305.1260
ENDDO ORH1F305.1261
ELSE ORH1F305.1262
! Neither L_SEAICE or L_OPSEUDIC ORH1F305.1263
DO I = 1, IMT ORH1F305.1264
HTN_OR_QFLALT(I) = HTN(I) ORH1F305.1265
PME_OR_PMEALT(I) = PME(I) ORH1F305.1266
ENDDO ORH1F305.1267
C ORH1F305.1268
ENDIF ORH1F305.1269
ENDIF ORH1F305.1270
C ORH1F305.1271
CALL HNYCAL (TB, TRACER.800
+ HTN_OR_QFLALT,PME_OR_PMEALT, ORH1F305.1272
+ QFLUX, SFLUX, TRACER.812
+ T_REF, S_REF, TRACER.813
+ IMT,KM,NT, TRACER.814
+ HANEY_SI, SPECIFIC_HEAT_SI, TRACER.815
+ HICE,HICE_REF, TRACER.818
+ QFUSION,RHO_WATER_SI,DZ(1), TRACER.819
+ anom_heat, anom_salt TRACER.822
+ ,anomiceh TRACER.825
+ ,salref) OJL1F405.18
JA121293.117
ENDIF ! L_OHANEY = true ORH1F305.1273
ORH1F305.1274
IF (L_OMIXLAY) THEN ORH1F305.1275
C ORH1F305.1279
CALL STATED(TA(1,1,1),TA(1,1,2),DRHO_SOL(1),WORKA,WORKB,IMT,1,J JA121293.126
&,KM JA121293.127
& ,JMT ORH7F404.22
&) JA121293.130
JA121293.131
ENDIF ! L_OMIXLAY = true ORH1F305.1280
JA121293.133
IF (SF_DT(7)) THEN JG170893.323
DO K=1,KM JG170893.324
DO I=1,IMT JG170893.325
DTWORK(I,K)=TA(I,K,1) JG170893.326
ENDDO JG170893.327
ENDDO JG170893.328
ENDIF JG170893.329
IF (SF_DS(7)) THEN OJG2F401.155
DO I=1,IMT OJG2F401.156
DSWORK(I,1)=TA(I,1,2) OJG2F401.157
ENDDO OJG2F401.158
ENDIF OJG2F401.159
DO I=1,imt OJG1F400.19
if (l_ohaney) then OJG1F400.20
diagsw(i,j)=sflux(i) OJG1F400.21
elseif (l_opseudic) then OJG1F400.22
diagsw(i,j)=pmealt(i) OJG1F400.23
else OJG1F400.24
diagsw(i,j)=pme(i) OJG1F400.25
endif OJG1F400.26
if (l_fluxcorr) then OJG1F400.27
diagsw(i,j)=diagsw(i,j)+fluxcorw(i) OJG1F400.28
endif OJG1F400.29
C Multiply by 1E9 for backward compatibility with the C90, where OJG2F403.20
C this was necessary to avoid loss of accuracy from dump packing. OJG2F403.21
if (L_REFSAL) then OJL1F405.21
diagsw(i,j)=1e9*(diagsw(i,j)*salref)/rho_water_si OJL1F405.22
else OJL1F405.23
diagsw(i,j)=1e9*(diagsw(i,j)*(tb(i,1,2)+0.035))/rho_water_si OJL1F405.24
endif OJL1F405.25
enddo OJG1F400.31
C ORH1F305.1281
IF (L_OHANEY) THEN ORH1F305.1282
DO I = 1, IMT ORH1F305.1283
HTN_OR_QFLALT(I) = QFLUX(I) ORH1F305.1284
PME_OR_PMEALT(I) = SFLUX(I) ORH1F305.1285
ENDDO ORH1F305.1286
ELSE ORH1F305.1287
! Populate arguments for HNYCAL with required ORH1F305.1288
! values dependent on model configuration. ORH1F305.1289
IF (L_SEAICE) THEN ORH1F305.1290
DO I = 1, IMT ORH1F305.1291
HTN_OR_QFLALT(I) = QFLUXALT(I) ORH1F305.1292
PME_OR_PMEALT(I) = PME(I) ORH1F305.1293
ENDDO ORH1F305.1294
ELSE ORH1F305.1295
IF (L_OPSEUDIC) THEN ORH1F305.1296
DO I = 1, IMT ORH1F305.1297
HTN_OR_QFLALT(I) = QFLUXALT(I) ORH1F305.1298
PME_OR_PMEALT(I) = PMEALT(I) ORH1F305.1299
ENDDO ORH1F305.1300
ELSE ORH1F305.1301
! Neither L_SEAICE or L_OPSEUDIC ORH1F305.1302
DO I = 1, IMT ORH1F305.1303
HTN_OR_QFLALT(I) = HTN(I) ORH1F305.1304
PME_OR_PMEALT(I) = PME(I) ORH1F305.1305
ENDDO ORH1F305.1306
C ORH1F305.1307
ENDIF ORH1F305.1308
ENDIF ORH1F305.1309
ENDIF ORH1F305.1310
C ORH1F305.1311
IF (L_OVARYT) THEN ORH1F305.1312
C ORH1F305.1313
CALL SFCADD (TA, ORH1F305.1314
+ HTN_OR_QFLALT,PME_OR_PMEALT, ORH1F305.1315
+ TB(1,1,2), TRACER.846
+ IMT, KM, NT, TRACER.847
+ RZ, ORH1F305.1316
+ C2DTTS, SPECIFIC_HEAT_SI,RHO_WATER_SI ORH1F305.1317
+, fluxcorh,fluxcorw ORH1F305.1318
& ,tfreeze,fm OJG0F400.25
+, anomiceh,icy ORH1F305.1319
&,VTCO2_FLUX,VALK_FLUX,TB OJP0F404.946
& ,heatsink OJG0F401.11
+ ,salref) OJL1F405.19
C ORH1F305.1321
ELSE ORH1F305.1322
CALL SFCADD (TA, ORH1F305.1323
+ HTN_OR_QFLALT,PME_OR_PMEALT, ORH1F305.1324
+ TB(1,1,2), ORH1F305.1325
+ IMT, KM, NT, ORH1F305.1326
+ DZ, TRACER.849
+ C2DTTS, SPECIFIC_HEAT_SI,RHO_WATER_SI TRACER.854
+, fluxcorh,fluxcorw OJT0F304.64
& ,tfreeze,fm OJG0F400.26
+, anomiceh,icy TRACER.859
&,VTCO2_FLUX,VALK_FLUX,TB OJP0F404.947
& ,heatsink OJG0F401.12
+ ,salref) OJL1F405.20
C ORH1F305.1327
C ORH1F305.1328
ENDIF ORH1F305.1329
if (L_INLANSEA) then OJL1F405.26
DO I=1,IMT OJL1F405.27
IF (FM(I,1).gt.0) THEN OJL1F405.28
if (ta(i,1,2).lt.sallow) then OJL1F405.29
diagsw(i,j)=diagsw(i,j) OJL1F405.30
& +1e9*dz(1)*(sallow-TA(I,1,2))/(C2DTTS*100.0) OJL1F405.31
TA(I,1,2)=sallow OJL1F405.32
endif OJL1F405.33
if (ta(i,1,2).gt.salup) then OJL1F405.34
diagsw(i,j)=diagsw(i,j) OJL1F405.35
& +1e9*dz(1)*(salup-TA(I,1,2))/(C2DTTS*100.0) OJL1F405.36
TA(I,1,2)=salup OJL1F405.37
endif OJL1F405.38
ENDIF OJL1F405.39
ENDDO OJL1F405.40
endif OJL1F405.41
C ORH1F305.1330
IF (SF_DT(7)) THEN JG170893.330
DO K=1,KM JG170893.331
DO I=1,IMT JG170893.332
WDTSFC(I,K)=TA(I,K,1)-DTWORK(I,K) JG170893.333
ENDDO JG170893.334
ENDDO JG170893.335
ENDIF JG170893.336
IF (SF_DS(7)) THEN OJG2F401.160
DO I=1,IMT OJG2F401.161
WDSSFC(I)=TA(I,1,2)-DSWORK(I,1) OJG2F401.162
ENDDO OJG2F401.163
ENDIF OJG2F401.164
C TRACER.862
IF (L_OMIXLAY) THEN ORH1F305.1332
C ORH1F305.1333
CALL STATED(TA(1,1,1),TA(1,1,2),TDIF(1,1,1),WORKA,WORKB,IMT,1,J JA121293.137
&,KM JA121293.138
& ,JMT ORH7F404.23
&) JA121293.141
C ORH1F305.1334
DO i = 1,IMT TRACER.868
DRHO_NET(i) = TDIF(i,1,1) - DRHO_SOL(i) TRACER.869
END DO TRACER.870
C ORH1F305.1335
ENDIF ! L_OMIXLAY = true ORH1F305.1336
C JG170893.337
IF (L_SEAICE) THEN ORH1F305.1337
C ORH1F305.1338
IF (SF_DT(9)) THEN JG170893.338
DO K=1,KM JG170893.339
DO I=1,IMT JG170893.340
DTWORK(I,K)=TA(I,K,1) JG170893.341
ENDDO JG170893.342
ENDDO JG170893.343
ENDIF JG170893.344
IF (SF_DS(8)) THEN OJG2F401.165
DO I=1,IMT OJG2F401.166
DSWORK(I,1)=TA(I,1,2) OJG2F401.167
ENDDO OJG2F401.168
ENDIF OJG2F401.169
C TRACER.873
C--------------------------------------------------------------------- TRACER.874
C THE FOLLOWING CALL TO ICEFLUX INCREMENTS THE SURFACE TEMPERATURE TRACER.875
C AND SALINITY FIELDS TO APPLY THE ICE-OCEAN FLUXES. TRACER.876
C IT ALSO COMPUTES THE RESULTING CHANGE IN SURFACE DENSITY ORH1F305.1339
C WHEN L_OMIXLAY = true. ORH1F305.1340
C--------------------------------------------------------------------- TRACER.882
C TRACER.883
IF (L_OTIMER) CALL TIMER('ICEFLUX ',103) GPB8F405.135
C ORH1F305.1342
IF (L_OVARYT) THEN ORH1F305.1343
C ORH1F305.1344
CALL ICEFLUX(TA,FLXTOICE,CARYHEAT,CARYSALT,OCEANSNOWRATE,ICY, OJC2F400.143
+ DRHO_ICE, TRACER.892
& J,JMT, ORH7F404.24
+ IMT,KM,NT,DZ, JG170893.346
+ DTTSA(1), ORH1F305.1346
+ SPECIFIC_HEAT_SI,RHO_WATER_SI,QFUSION) ORH1F305.1347
C ORH1F305.1348
ELSE ORH1F305.1349
C ORH1F305.1350
CALL ICEFLUX(TA,FLXTOICE,CARYHEAT,CARYSALT,OCEANSNOWRATE,ICY, OJC2F400.144
+ DRHO_ICE, ORH1F305.1352
& J,JMT, ORH7F404.25
+ IMT,KM,NT,DZ, ORH1F305.1355
+ C2DTTS, JG170893.348
+ SPECIFIC_HEAT_SI,RHO_WATER_SI,QFUSION) JG170893.351
C ORH1F305.1356
ENDIF ORH1F305.1357
C ORH1F305.1358
IF (L_OTIMER) CALL TIMER('ICEFLUX ',104) GPB8F405.136
ORH1F305.1360
ENDIF ! L_SEAICE = true ORH1F305.1361
C JG170893.352
IF (SF_DT(9)) THEN JG170893.353
C ORH1F305.1362
IF (L_SEAICE) THEN ORH1F305.1363
DO K=1,KM ORH1F305.1364
DO I=1,IMT ORH1F305.1365
WDTICE(I,K)=TA(I,K,1)-DTWORK(I,K) ORH1F305.1366
ENDDO ORH1F305.1367
ENDDO ORH1F305.1368
ELSE ORH1F305.1369
DO K=1,KM ORH1F305.1370
DO I=1,IMT ORH1F305.1371
WDTICE(I,K)=0. ORH1F305.1372
ENDDO ORH1F305.1373
ENDDO ORH1F305.1374
ENDIF ORH1F305.1375
ENDIF JG170893.363
IF (SF_DS(8)) THEN OJG2F401.170
DO I=1,IMT OJG2F401.171
IF (L_SEAICE) THEN OJG2F401.172
WDSICE(I)=TA(I,1,2)-DSWORK(I,1) OJG2F401.173
ELSE OJG2F401.174
WDSICE(I)=0. OJG2F401.175
ENDIF OJG2F401.176
ENDDO OJG2F401.177
ENDIF OJG2F401.178
C JG170893.364
C TRACER.907
IF (L_OMIXLAY) THEN ORH1F305.1376
C ORH1F305.1377
CALL STATED(TA(1,1,1),TA(1,1,2),TDIF(1,1,1),WORKA,WORKB,IMT,1,J JA121293.145
&,KM JA121293.146
&,JMT ORH7F404.26
&) JA121293.149
C ORH1F305.1378
ENDIF ORH1F305.1379
C ORH1F305.1380
IF (L_OSOLARAL) THEN ORH1F305.1381
ORH1F305.1382
IF (L_OBIOLOGY.AND.L_OCARBON) THEN ORH1F305.1383
C If single-waveband light model is used, call PIGSET to compute NT091293.58
C the square root of the pigment concentration (this is done before NT091293.59
C phytoplankton growth is been calculated) where biological model NT091293.60
C is in operation. NT091293.61
C NT091293.62
C NT091293.66
CALL PIGSET (T,RTPIG OJP0F404.786
& ,ISSW,IESW ORH1F305.1384
+ ,IMT,KM,NT) NT091293.79
ENDIF ORH1F305.1385
C ORH1F305.1386
IF (.NOT.L_OBIOLOGY) THEN ORH1F305.1387
C NT091293.82
C If biology has not been selected, then assume that NT091293.83
C pigment concentration is zero NT091293.84
C NT091293.85
DO K=1,KM NT091293.86
DO I=1,IMT NT091293.87
RTPIG(I,K)=0.0 NT091293.88
ENDDO NT091293.89
ENDDO NT091293.90
ENDIF ! L_OBIOLOGY = false ORH1F305.1388
! OJP0F404.787
CALL SOLSET2 (SOL_PEN_BIO, RTPIG, KFIX_BIO, ETA_BIO, OJP0F404.788
+ KM, IMT, NT091293.94
+ DZ, ZDZ NT091293.95
+ ) NT091293.96
C NT091293.97
IF (L_OMIXLAY.AND.(.NOT.L_OSOLAR)) THEN OJP0F404.789
CALL MIXSET2 ( DELPSF, DELPSL_LOC, DECAY, OJP0F404.790
+ GRAV_SI, DZ, ZDZ, ZDZZ, ORH1F305.1400
& GAMMA_DZ,IMT, OJP0F404.791
& KM, SOL_PEN_BIO, ETA_BIO, OJP0F404.792
& KFIX_BIO, DELTA_SI OJP0F404.793
+ ) ORH1F305.1404
ENDIF ! L_OMIXLAY.AND.(.NOT.L_OSOLAR) OJP0F404.794
ENDIF ! L_OSOLARAL= true ORH1F305.1410
C NT091293.114
IF (L_OSOLAR.OR.L_OSOLARAL) THEN ORH1F305.1411
C ORH1F305.1412
IF (L_SEAICE.OR.L_OPSEUDIC) THEN ORH1F305.1413
DO I = 1, IMT ORH1F305.1414
SOL_OR_SOLALT(I) = SOLALT(I) ORH1F305.1415
ENDDO ORH1F305.1416
ELSE ORH1F305.1417
DO I = 1, IMT ORH1F305.1418
SOL_OR_SOLALT(I) = SOL(I) ORH1F305.1419
ENDDO ORH1F305.1420
ENDIF ORH1F305.1421
ORH1F305.1422
IF (L_OSOLAR) THEN ORH1F305.1423
! If L_OSOLAR then use the standard light model OJP0F404.795
! values of SOL_PEN and DELPSL for the call to SOLADD. OJP0F404.796
! Note KFIX is already from standard light model. OJP0F404.797
DO K = 0, KM ORH1F305.1426
DO I = 1, IMT OJP0F404.798
SOL_PEN_LOC(I,K) = SOL_PEN(K) OJP0F404.799
DELPSL_LOC(I,K) = DELPSL(K) OJP0F404.800
ENDDO ORH1F305.1428
ENDDO OJP0F404.801
ELSE OJP0F404.802
! L_OSOLAR is false, so use bio light model results. OJP0F404.803
! Note DELPSL_LOC is already from bio light model. OJP0F404.804
DO K = 0, KM OJP0F404.805
DO I = 1, IMT OJP0F404.806
SOL_PEN_LOC(I,K) = SOL_PEN_BIO(I,K) OJP0F404.807
ENDDO OJP0F404.808
ENDDO OJP0F404.809
KFIX=KFIX_BIO OJP0F404.810
ENDIF ORH1F305.1429
IF ((.NOT.L_OSOLARAL).AND.L_OBIOLOGY) THEN OJP0F404.811
! Populate SOL_PEN_BIO with SOL_PEN_LOC for biology to use OJP0F404.812
! the standard light model. OJP0F404.813
DO K = 0, KM OJP0F404.814
DO I = 1, IMT OJP0F404.815
SOL_PEN_BIO(I,K) = SOL_PEN_LOC(I,K) OJP0F404.816
ENDDO OJP0F404.817
ENDDO OJP0F404.818
ENDIF OJP0F404.819
C ORH1F305.1430
IF (L_OVARYT) THEN ORH1F305.1431
C ORH1F305.1432
CALL SOLADD (TA,WDTPEN, ORH1F305.1433
+ SOL_OR_SOLALT, ORH1F305.1434
& C2DTTS, ORH1F305.1435
& SOL_PEN_LOC,KFIX, ORH1F305.1436
+ KM,IMT,NT, NT091293.128
+ KMT, NT091293.129
+ RZ, ORH1F305.1437
+ SPECIFIC_HEAT_SI,RHO_WATER_SI NT091293.136
+ ) NT091293.137
C ORH1F305.1438
ELSE ORH1F305.1439
CALL SOLADD (TA,WDTPEN, ORH1F305.1440
+ SOL_OR_SOLALT, ORH1F305.1441
+ C2DTTS, ORH1F305.1442
+ SOL_PEN_LOC, KFIX, ORH1F305.1443
+ KM,IMT,NT, ORH1F305.1444
+ KMT, ORH1F305.1445
+ DZ, ORH1F305.1446
+ SPECIFIC_HEAT_SI,RHO_WATER_SI ORH1F305.1447
+ ) ORH1F305.1448
C ORH1F305.1449
ENDIF ORH1F305.1450
C ORH1F305.1460
IF (L_OMIXLAY) THEN ORH1F305.1461
C ORH1F305.1462
CALL STATED(TA(1,1,1),TA(1,1,2),DRHO_SOL(1),WORKA,WORKB,IMT,1,J JA121293.153
&,KM JA121293.154
&,JMT ORH7F404.27
&) JA121293.157
ENDIF ! L_OMIXLAY = true ORH1F305.1463
ENDIF ! L_OSOLARAL or L_OSOLAR = true ORH1F305.1464
ORH1F305.1465
IF (L_OMIXLAY) THEN ORH1F305.1466
ORH1F305.1467
DO i = 1,IMT TRACER.947
DRHO_SOL(i) = DRHO_SOL(i) - TDIF(i,1,1) TRACER.948
END DO TRACER.949
C ORH1F305.1470
ENDIF ORH1F305.1471
C ORH1F305.1472
C TRACER.952
C--------------------------------------------------------------------- TRACER.953
C IF L_SEAICE = TRUE THEN ... ORH1F305.1473
C THE FOLLOWING CALL TO FREEZEUP IMPOSES A MINIMUM TEMPERATURE OF TRACER.954
C FREEZING AT ALL LEVELS, AND STORES NEGATIVE HEAT FLUXES RELEASED TRACER.955
C BY THIS FOR USE IN THE ICE MODEL. IT ALSO IDENTIFIES ICE-FREE TRACER.956
C PLACES WHERE ICE IS ABOUT TO FORM, AND SETS NEWICE TO TRUE AT TRACER.957
C SUCH PLACES. TRACER.958
C--------------------------------------------------------------------- TRACER.959
C TRACER.960
C JG170893.365
IF (SF_DT(9)) THEN JG170893.366
DO K=1,KM JG170893.367
DO I=1,IMT JG170893.368
DTWORK(I,K)=TA(I,K,1) JG170893.369
ENDDO JG170893.370
ENDDO JG170893.371
ENDIF JG170893.372
C ORH1F305.1474
C ORH1F305.1475
IF (L_SEAICE) THEN ORH1F305.1476
C ORH1F305.1477
IF (L_OTIMER) CALL TIMER('FREEZEUP ',103) GPB8F405.137
C ORH1F305.1479
IF (L_OVARYT) THEN ORH1F305.1480
C ORH1F305.1481
CALL FREEZEUP(TA,ICY,NEWICE,CARYHEAT,IMT,KM,NT,FM, ORH1F305.1482
& HEATSINK,J,JMT, ORH7F404.28
+ DRHO_ICE, TRACER.969
& IMT_MIX,KM_MIX, ORH1F305.1483
& RZ,C2DTTS,SPECIFIC_HEAT_SI,RHO_WATER_SI,TFREEZE) ORH1F305.1484
ELSE ORH1F305.1485
CALL FREEZEUP(TA,ICY,NEWICE,CARYHEAT,IMT,KM,NT,FM, ORH1F305.1486
& HEATSINK,J,JMT, ORH7F404.29
& DRHO_ICE, ORH1F305.1489
& IMT_MIX,KM_MIX, ORH1F305.1490
& DZ,C2DTTS,SPECIFIC_HEAT_SI,RHO_WATER_SI,TFREEZE) ORH1F305.1491
C ORH1F305.1492
ENDIF ORH1F305.1493
C ORH1F305.1494
C ORH1F305.1495
IF (L_OTIMER) CALL TIMER('FREEZEUP ',104) GPB8F405.138
ENDIF ORH1F305.1497
C ORH1F305.1498
IF (L_OPSEUDIC) THEN ORH1F305.1499
C TRACER.984
C----------------------------------------------------------------------- TRACER.985
C Pseudo-ice model. If T drops below TFREEZ, it is reset to TFREEZ. TRACER.986
C Climatological ice points are always reset to their climatological TRACER.987
C SST and SSS. Convection is disabled under both types of point. TRACER.988
C----------------------------------------------------------------------- TRACER.989
C TRACER.990
IF (L_OMIXLAY) THEN ORH1F305.1500
C ORH1F305.1501
CALL STATED(TA(1,1,1),TA(1,1,2),TDIF(1,1,1),WORKA,WORKB,IMT,1,J JA121293.161
&,KM JA121293.162
&,JMT ORH7F404.30
&) JA121293.165
C TRACER.994
ENDIF ORH1F305.1502
C ORH1F305.1503
C Account for temperature resetting in energy calculation. TRACER.997
C ********* NOTE: This code is omitted when isopycnal diffusion TRACER.998
C is present, since energy calculations TRACER.999
C have not yet been worked out. TRACER.1000
C TRACER.1001
C ORH1F305.1504
IF (.NOT.(L_OISOPYC)) THEN ORH1F305.1505
C ORH1F305.1506
IF(NERGY .EQ. 1 .AND. MXP .NE. 1) THEN ORH1F305.1507
DO K = 1,KM ORH1F305.1508
DO I=2,IMTM1 ORH1F305.1517
FACTOR = CST(J)*DXT(I)*DYT(J)*DZ(K)/C2DTTS ORH1F305.1518
IF(TA(I,K,1) .LT. TFREEZ ORH1F305.1519
%.OR.((BICE(I).LT.1.E-3).AND.K.EQ.1) ORH1F305.1520
%) TTDTOT(5,1) = TTDTOT(5,1) + (TFREEZ - TA(I,K,1))*FACTOR ORH1F305.1521
ENDDO ! over I ORH1F305.1522
ENDDO ! over K ORH1F305.1524
ENDIF ORH1F305.1525
ENDIF TRACER.1024
C ORH1F305.1526
C ORH1F305.1527
C ORH1F305.1528
C TRACER.1027
C Now reset temperatures. TRACER.1028
C TRACER.1029
DO K=1,KM ORH1F305.1529
DO I=1,IMT ORH1F305.1537
TA(I,K,1)=MAX(TA(I,K,1) , TFREEZ) ORH1F305.1538
ENDDO ! over I ORH1F305.1539
ENDDO ! over K ORH1F305.1541
C TRACER.1045
C Reset surface temperature and salinity to climatology at TRACER.1046
C climatological ice points. Temperature at such points is TFREEZ. TRACER.1047
C !!!!!!!!!!!!!THIS MAY CAUSE PROBLEMS!!!!!!!!!!!!!!!! TRACER.1048
C TRACER.1049
DO I=1,IMT ORH7F404.12
IF (BICE(I).LT.1.E-3) THEN ORH7F404.13
TA(I,1,1)=T_REF(I) ORH7F404.14
TA(I,1,2)=S_REF(I) ORH7F404.15
ENDIF ORH7F404.16
ENDDO ! over I ORH7F404.17
C ORH1F305.1559
IF (L_OMIXLAY) THEN ORH1F305.1560
C TRACER.1068
C ORH1F305.1563
CALL STATED(TA(1,1,1),TA(1,1,2),DRHO_PSEU(1),WORKA,WORKB,IMT,1,J JA121293.176
&,KM JA121293.177
&,JMT ORH7F404.31
&) JA121293.180
JA121293.181
JA121293.183
DO i=1,IMT TRACER.1075
DRHO_PSEU(i)=DRHO_PSEU(i)-TDIF(i,1,1) TRACER.1076
END DO TRACER.1077
C JG170893.373
ENDIF ! L_OMIXLAY = true ORH1F305.1565
ENDIF ! L_OPSUEDIC = true ORH1F305.1566
C ORH1F305.1567
IF (SF_DT(9)) THEN JG170893.374
DO K=1,KM JG170893.375
DO I=1,IMT JG170893.376
WDTICE(I,K)=TA(I,K,1)-DTWORK(I,K)+WDTICE(I,K) JG170893.377
ENDDO JG170893.378
ENDDO JG170893.379
ENDIF JG170893.380
IF ((L_OMEDOUT).AND.(.NOT.L_OMEDADV)) THEN OOM2F405.293
C Mediterranean outflow: JG170893.381
IF (SF_DT(15)) THEN JG170893.382
DO K=1,KM JG170893.383
DO I=1,IMT JG170893.384
DTWORK(I,K)=TA(I,K,1) JG170893.385
ENDDO JG170893.386
ENDDO JG170893.387
ENDIF JG170893.388
IF (SF_DS(14)) THEN OJG2F401.179
DO K=1,KM OJG2F401.180
DO I=1,IMT OJG2F401.181
DSWORK(I,K)=TA(I,K,2) OJG2F401.182
ENDDO OJG2F401.183
ENDDO OJG2F401.184
ENDIF OJG2F401.185
C OJG2F401.186
C OOM1F403.72
C Mediterranean outflow parameterization OOM1F403.73
C Update Tracers using the tendencies calculated in BLOKCALC OOM1F403.74
C and passed down. Mixing is assumed to be instantaneous. OOM1F403.75
C OOM1F403.76
*IF DEF,MPP OOM1F403.77
IF ((J + J_OFFSET) .EQ.jmout(1)) THEN OOM1F403.78
*ELSE OOM1F403.79
IF (J.EQ.jmout(1)) THEN OOM1F403.80
*ENDIF OOM1F403.81
DO M=1,NT OOM1F403.82
DO K=1,NMEDLEV OOM1F403.83
TA(imout(1),K,M)=TA(imout(1),K,M)+ATTEND(K,M,1) OOM1F403.84
ENDDO OOM1F403.85
ENDDO OOM1F403.86
ENDIF OOM1F403.87
OOM1F403.88
*IF DEF,MPP OOM1F403.89
IF ((J + J_OFFSET).EQ.jmout(2)) THEN OOM1F403.90
*ELSE OOM1F403.91
IF (J.EQ.jmout(2)) THEN OOM1F403.92
*ENDIF OOM1F403.93
DO M=1,NT OOM1F403.94
DO K=1,NMEDLEV OOM1F403.95
TA(imout(2),K,M)=TA(imout(2),K,M)+ATTEND(K,M,2) OOM1F403.96
ENDDO OOM1F403.97
ENDDO OOM1F403.98
ENDIF OOM1F403.99
OOM1F403.100
*IF DEF,MPP OOM1F403.101
IF ((J + J_OFFSET).EQ.jmout(3)) THEN OOM1F403.102
*ELSE OOM1F403.103
IF (J.EQ.jmout(3)) THEN OOM1F403.104
*ENDIF OOM1F403.105
DO M=1,NT OOM1F403.106
DO K=1,NMEDLEV OOM1F403.107
TA(imout(3),K,M)=TA(imout(3),K,M)+ATTEND(K,M,3) OOM1F403.108
ENDDO OOM1F403.109
ENDDO OOM1F403.110
ENDIF OOM1F403.111
OOM1F403.112
*IF DEF,MPP OOM1F403.113
IF ((J + J_OFFSET).EQ.jmout(4)) THEN OOM1F403.114
*ELSE OOM1F403.115
IF (J.EQ.jmout(4)) THEN OOM1F403.116
*ENDIF OOM1F403.117
DO M=1,NT OOM1F403.118
DO K=1,NMEDLEV OOM1F403.119
TA(imout(4),K,M)=TA(imout(4),K,M)+ATTEND(K,M,4) OOM1F403.120
ENDDO OOM1F403.121
ENDDO OOM1F403.122
ENDIF OOM1F403.123
OOM1F403.124
C OJG2F401.189
C Mediterranean outflow: JG170893.389
IF (SF_DT(15)) THEN JG170893.390
DO K=1,KM JG170893.391
DO I=1,IMT JG170893.392
WDTMED(I,K)=TA(I,K,1)-DTWORK(I,K) JG170893.393
ENDDO JG170893.394
ENDDO JG170893.395
ENDIF JG170893.396
IF (SF_DS(14)) THEN OJG2F401.190
DO K=1,KM OJG2F401.191
DO I=1,IMT OJG2F401.192
WDSMED(I,K)=TA(I,K,2)-DSWORK(I,K) OJG2F401.193
ENDDO OJG2F401.194
ENDDO OJG2F401.195
ENDIF OJG2F401.196
ENDIF ! (L_OMEDOUT).AND.(.NOT.L_OMEDADV) OOM2F405.294
OOM2F405.295
C JG170893.397
C SET SALINITY TO 45 PPT OVER LAND TO STOP CONVECTION THERE TRACER.1080
C (..NOTE THAT THIS IS .01 IN MODEL UNITS -- (PPT-35)/1000..) TRACER.1081
C--------------------------------------------------------------------- TRACER.1085
C TRACER.1086
IF(NT.GE.2) THEN TRACER.1087
FXA=0.01 TRACER.1088
FXB=1.0 TRACER.1089
DO 860 K=1,KM TRACER.1090
DO 860 I=1,IMT TRACER.1091
TA(I,K,2)=FM(I,K)*TA(I,K,2) + FXA*(FXB-FM(I,K)) TRACER.1092
860 CONTINUE TRACER.1093
ENDIF TRACER.1094
C ORH1F305.1569
IF (L_OCARBON) THEN ORH1F305.1605
C NT071293.61
C Calculate the dissociation constants for the inorganic NT071293.62
C carbon cycle NT071293.63
C NT071293.64
CALL EQUILIB_CONST (TB, REK0, REK, RG1, RG2, RG3, OJP0F404.820
+ IMT, KM, NT) NT071293.66
C NT071293.67
C Compute partial pressure of CO2 at the sea surface NT071293.68
C NT071293.69
CALL PPCO2 (TB, REK0, REK, RG1, RG2, RG3, OJP0F404.821
+ IMT, KM, NT, NT071293.71
+ FM, PCO2) NT071293.72
C NT071293.73
C Update TCO2 in the surface layer according to the difference NT071293.74
C in partial pressure between ocean and atmosphere NT071293.75
C NT071293.76
CALL FLUX_CO2(TA, REK0, PCO2, CO2_FLUX, ATMPCO2_ROW, OCN1F405.26
+ INVADE,EVADE, NT071293.78
+ c14to12_atm, NT071293.80
+ WME, NT071293.83
+ AICE, NT071293.86
+ BICE, NT071293.89
+ IMT, KM, NT, NT071293.91
& FM, DZ, TIMESTEP(1) ) OJP0F404.822
C ORH1F305.1609
IF (L_OCARB14) THEN ORH1F305.1622
C NT071293.99
C Compute radioactive decay of C-14, with half-life of NT071293.100
C 5730 years=> decay const=3.89e-12 s-1 NT071293.101
DO K=1,KM NT071293.102
fxa=3.88915e-12*TIMESTEP(K) OJP0F404.823
DO I=1,IMT NT071293.107
TA(I,K,C14_TRACER)=TA(I,K,C14_TRACER)-fxa*TB(I,K,C14_TRACER) OJP0F404.824
ENDDO NT071293.109
ENDDO NT071293.110
C ORH1F305.1629
ENDIF ! L_OCARB14 = true ORH1F305.1630
C ORH1F305.1631
ENDIF ! L_OCARBON = true ORH1F305.1632
C--------------------------------------------------------------------- TRACER.1096
C DO ANALYSIS OF TRACER FORCING ON ENERGY TIMESTEP TRACER.1097
C--------------------------------------------------------------------- TRACER.1098
C TRACER.1099
IF(NERGY.EQ.0) GO TO 920 TRACER.1100
C ORH1F305.1633
C ORH1F305.1635
DO 910 I=2,IMTM1 TRACER.1104
KZ=KMT(I) TRACER.1105
IF (KZ.EQ.0) GOTO 910 TRACER.1106
DO 900 M=1,NT TRACER.1107
DO 900 K=1,KZ TRACER.1108
KM1=MAX(1,K-1) TRACER.1109
KP1=MIN(KM,K+1) TRACER.1110
KP2=MIN(KM+1,K+2) TRACER.1111
BOXVOL = CST(J)*DXT(I)*DYT(J)*DZ(K) TRACER.1112
C TRACER.1113
C 1ST, COMPUTE TRACER CHANGE DUE TO ADVECTION TRACER.1114
C TRACER.1115
TTDTOT(2,M)=TTDTOT(2,M)+BOXVOL* TRACER.1116
* ((-FUW (I+1,K)*(T (I+1,K,M)+T (I ,K,M)) TRACER.1117
* +FUW (I ,K)*(T (I ,K,M)+T (I-1,K,M)))*DXT4R(I) TRACER.1118
* -FVN (I ,K)*(TP(I ,K,M)+T (I ,K,M)) TRACER.1119
* +FVST(I ,K)*(T (I ,K,M)+TM(I ,K,M))) TRACER.1120
IF (.NOT.(L_OIMPADDF)) THEN ORH1F305.1636
TTDTOT(3,M)=TTDTOT(3,M)+BOXVOL* ORH1F305.1637
* (W(I,K+1)*(T(I,K ,M)+T(I,KP1,M)) TRACER.1123
* -W(I,K )*(T(I,KM1,M)+T(I,K ,M)))*DZ2R(K) TRACER.1124
ELSE ORH1F305.1638
TTDTOT(3,M)=TTDTOT(3,M)+(BOXVOL*0.5)* ORH1F305.1639
* (W(I,K+1)*(TB(I,K ,M)+TB(I,KP1,M)+ TRACER.1128
* TF(I,K,M) + TF(I,KP1,M)) TRACER.1129
* -W(I,K )*(TB(I,KM1,M)+TB(I,K ,M)+ TRACER.1130
* TF(I,KM1,M) + TF(I,K,M)))*DZ2R(K) NB151293.1
ENDIF ORH1F305.1640
C ORH1F305.1641
IF (.NOT.(L_OISOPYC)) THEN ORH1F305.1642
C TRACER.1134
C 2ND, COMPUTE TRACER CHANGE DUE TO HORIZONTAL DIFFUSION TRACER.1135
C TRACER.1136
TTDTOT(4,M)=TTDTOT(4,M)+BOXVOL* TRACER.1137
* (BBTJ*DXU2R(I )*DXT4R(I)*FM(I+1,K)*(TB(I+1,K,M)-TB(I,K,M)) TRACER.1138
* +BBTJ*DXU2R(I-1)*DXT4R(I)*FM(I-1,K)*(TB(I-1,K,M)-TB(I,K,M)) TRACER.1139
* +CCTJ*FMP(I,K)*(TBP(I,K,M)-TB(I,K,M)) TRACER.1140
* +DDTJ*FMM(I,K)*(TBM(I,K,M)-TB(I,K,M))) TRACER.1141
ENDIF ORH1F305.1643
IF (.NOT.(L_OIMPDIF.OR.L_OIMPADDF)) THEN ORH1F305.1644
C TRACER.1144
C 3RD, COMPUTE TRACER CHANGE DUE TO VERTICAL DIFFUSION TRACER.1145
C TRACER.1146
TTDTOT(5,M)=TTDTOT(5,M)+BOXVOL* ORH1F305.1645
* (EEH(K)*(TDIF(I,K,M)-TDIF(I,K+1,M)) TRACER.1148
* -FFH(K)*(TDIF(I,K+1,M)-TDIF(I,K+2,M))) TRACER.1149
ENDIF ORH1F305.1646
C ORH1F305.1647
IF (L_OIMPADDF) THEN ORH1F305.1648
TTDTOT(5,M)=TTDTOT(5,M)+(BOXVOL*0.5)* ORH1F305.1649
* (gnu(I,KP1)*(2.0*DZ2R(K)*DZZ2R(K)) * NB151293.2
* (TF(I,K,M)-TF(I,KP1,M)+ TRACER.1154
* TB(I,K,M)-TB(I,KP1,M)) TRACER.1155
* -gnu(I,K)*(2.0*DZ2R(K)*DZZ2R(KM1))* NB151293.3
* (TF(I,KM1,M)-TF(I,K,M)+ TRACER.1157
* TB(I,KM1,M)-TB(I,K,M))) TRACER.1158
ENDIF ORH1F305.1650
900 CONTINUE TRACER.1160
C TRACER.1161
C 4TH, COMPUTE TOTAL ENERGY EXCHANGE BETWEEN POTENTIAL AND KINETIC TRACER.1162
C TRACER.1163
IF(KZ.LT.2) GO TO 910 TRACER.1164
FX=CST(J)*DXT(I)*DYT(J)*GRAV*0.5 TRACER.1165
DO 905 K=2,KZ TRACER.1166
BUOY=BUOY-FX*DZZ(K)*W(I,K)*(RHOS(I,K-1)+RHOS(I,K)) TRACER.1167
905 CONTINUE TRACER.1168
910 CONTINUE TRACER.1169
920 CONTINUE TRACER.1170
C ORH1F305.1651
IF (L_OMIXLAY) THEN ORH1F305.1652
C ORH1F305.1653
IF (SF_DT(10)) THEN JG170893.398
DO K=1,KM JG170893.399
DO I=1,IMT JG170893.400
DTWORK(I,K)=TA(I,K,1) JG170893.401
ENDDO JG170893.402
ENDDO JG170893.403
ENDIF JG170893.404
IF (SF_DS(9)) THEN OJG2F401.197
DO K=1,KM OJG2F401.198
DO I=1,IMT OJG2F401.199
DSWORK(I,K)=TA(I,K,2) OJG2F401.200
ENDDO OJG2F401.201
ENDDO OJG2F401.202
ENDIF OJG2F401.203
C ORH1F305.1654
IF (L_OBIOLOGY) THEN ORH1F305.1655
C ORH1F305.1656
IF (SF_BIO(21)) THEN ONT1F304.395
DO K=1,KM ONT1F304.396
DO I=1,IMT ONT1F304.397
DNWORK(I,K)=TA(I,K,NUTRIENT_TRACER) OJP0F404.825
ENDDO ONT1F304.399
ENDDO ONT1F304.400
ENDIF ONT1F304.401
C ORH1F305.1657
ENDIF ! L_OBIOLOGY = true ORH1F305.1658
C ORH1F305.1659
C ORH1F305.1660
IF (L_SEAICE.OR.L_OPSEUDIC) THEN ORH1F305.1661
DO I = 1, IMT ORH1F305.1662
WME_MIX(I) = WMEALT(I) ORH1F305.1663
ENDDO ORH1F305.1664
ELSE ORH1F305.1665
DO I = 1, IMT ORH1F305.1666
WME_MIX(I) = WME (I) ORH1F305.1667
ENDDO ORH1F305.1668
ENDIF ORH1F305.1669
IF (L_OISOPYC) THEN ORH1F305.1670
DO I = 1, IMT ORH1F305.1671
MLD_MIX(I) = MLD(I,J) ORH1F305.1672
ENDDO ORH1F305.1673
ELSE ORH1F305.1674
DO I = 1, IMT ORH1F305.1675
MLD_MIX(I) = DIAG_MLD(I) ORH1F305.1676
ENDDO ORH1F305.1677
ENDIF ORH1F305.1678
ORH1F305.1679
C ORH1F305.1689
C OOM1F405.841
C ONLY CALL MIXLAY (AKA KRAUS-TURNER) IF THE FULL LARGE SCHEME IS OOM1F405.842
C NOT REQUIRED. IF FULL LARGE SCHEME IS USED, THEN CALL VDIFCALT OOM1F405.843
C HERE INSTEAD AFTER THE APPLICATION OF SURFACE TERMS. OOM1F405.844
C OOM1F405.845
IF (L_OFULARGE) THEN OOM1F405.846
DO I=1,IMT OOM1F405.847
MLD_MIX(I) = MLD_LARGE(I)*0.01 ! 0.01 CONVERTS CM TO M OOM1F405.848
ENDDO OOM1F405.849
C OOM1F405.850
CALL VDIFCALT OOM1F405.851
& ( J,IMT,IMTM1,KM,KMP1,KMM1,NT, OOM1F405.852
& TA, OOM1F405.853
& DZ2R,DZZ2RQ,DZ2RQ,C2DTTS, OOM1F405.854
& DTTSA, OOM1F405.855
& FM, OOM1F405.856
& fk3_or_gnu(1,1),CGFLUX OOM1F405.857
& ) OOM1F405.858
C OOM1F405.859
ENDIF ! FOR L_OFULARGE OOM1F405.860
C OOM1F405.861
IF (.NOT.L_OFULARGE) THEN OOM1F405.862
IF (L_OVARYT) THEN ORH1F305.1690
CALL MIXLAY ( TA, WME_MIX, IMT, KM, NT ORH1F305.1691
& ,J,JMT ORH7F404.32
& ,C2DTTS, GRAV_SI ORH1F305.1694
& ,DZ, ZDZ ORH1F305.1695
& ,RZ ORH1F305.1696
& ,FM, KMT, LAMDA, EPSILON,DELPSF, DELPSL_LOC, DECAY OJP0F404.826
& ,DRHO_SOL, DRHO_NET ORH1F305.1698
& ,DRHO_ICE, DRHO_PSEU ORH1F305.1699
& ,MLD_MIX ORH1F305.1700
& ) ORH1F305.1701
ELSE ORH1F305.1702
CALL MIXLAY ( TA, WME_MIX, IMT, KM, NT ORH1F305.1703
& ,J,JMT ORH7F404.33
& ,C2DTTS, GRAV_SI ORH1F305.1706
& ,DZ, ZDZ ORH1F305.1707
& ,DZ ORH1F305.1708
& ,FM, KMT, LAMDA, EPSILON,DELPSF, DELPSL_LOC, DECAY OJP0F404.827
& ,DRHO_SOL, DRHO_NET ORH1F305.1710
& ,DRHO_ICE, DRHO_PSEU ORH1F305.1711
& ,MLD_MIX ORH1F305.1712
& ) ORH1F305.1713
ENDIF ORH1F305.1714
ENDIF ! FOR .NOT.L_OFULARGE OOM1F405.863
C ORH1F305.1715
IF (L_OISOPYC) THEN ORH1F305.1722
DO I = 1, IMT ORH1F305.1723
MLD(I,J) = MLD_MIX(I) ORH1F305.1724
ENDDO ORH1F305.1725
ELSE ORH1F305.1726
DO I = 1, IMT ORH1F305.1727
DIAG_MLD(I) = MLD_MIX(I) ORH1F305.1728
ENDDO ORH1F305.1729
ENDIF ORH1F305.1730
C ORH1F305.1731
C ORH1F305.1732
IF (SF_DT(10)) THEN JG170893.405
DO K=1,KM JG170893.406
DO I=1,IMT JG170893.407
WDTMIX(I,K)=TA(I,K,1)-DTWORK(I,K) JG170893.408
ENDDO JG170893.409
ENDDO JG170893.410
ENDIF JG170893.411
IF (SF_DS(9)) THEN OJG2F401.204
DO K=1,KM OJG2F401.205
DO I=1,IMT OJG2F401.206
WDSMIX(I,K)=TA(I,K,2)-DSWORK(I,K) OJG2F401.207
ENDDO OJG2F401.208
ENDDO OJG2F401.209
ENDIF OJG2F401.210
C ORH1F305.1733
IF (L_OBIOLOGY) THEN ORH1F305.1734
C ORH1F305.1735
IF (SF_BIO(21)) THEN ORH1F305.1736
DO K=1,KM ORH1F305.1737
DO I=1,IMT ORH1F305.1738
WMIX_NUT(I,K)=TA(I,K,NUTRIENT_TRACER)-DNWORK(I,K) OJP0F404.828
ENDDO ORH1F305.1740
ENDDO ORH1F305.1741
ENDIF ORH1F305.1742
ENDIF ONT1F304.410
ENDIF ! L_OMIXLAY = true ORH1F305.1743
C TRACER.1215
C--------------------------------------------------------------------- TRACER.1216
C CONVECTIVELY ADJUST WATER COLUMN IF GRAVITATIONALLY UNSTABLE TRACER.1217
C--------------------------------------------------------------------- TRACER.1218
C TRACER.1219
C TRACER.1223
IF (L_OBIOLOGY) THEN ORH1F305.1744
C ORH1F305.1745
IF (SF_BIO(22)) THEN ONT1F304.413
DO K=1,KM ONT1F304.414
DO I=1,IMT ONT1F304.415
DNWORK(I,K)=TA(I,K,NUTRIENT_TRACER) OJP0F404.829
ENDDO ONT1F304.417
ENDDO ONT1F304.418
ENDIF ONT1F304.419
C ORH1F305.1746
ENDIF ! L_OBIOLOGY ORH1F305.1747
C ORH1F305.1748
IF (SF_DT(11)) THEN JG170893.412
DO K=1,KM JG170893.413
DO I=1,IMT JG170893.414
DTWORK(I,K)=TA(I,K,1) JG170893.415
ENDDO JG170893.416
ENDDO JG170893.417
ENDIF JG170893.418
IF (SF_DS(10)) THEN OJG2F401.211
DO K=1,KM OJG2F401.212
DO I=1,IMT OJG2F401.213
DSWORK(I,K)=TA(I,K,2) OJG2F401.214
ENDDO OJG2F401.215
ENDDO OJG2F401.216
ENDIF OJG2F401.217
IF (L_OCONVROUS) THEN OOM2F403.17
C OOM2F403.18
C Call subroutine CONVADJ. OOM2F403.19
C This will perform the convective adjustment by mixing an unstable OOM2F403.20
C box with that box which it would be neutraly buoyant with. OOM2F403.21
C Intervening boxes are then shuffled up. Convfull should still be OOM2F403.22
C called after to ensure the column is stable (convadj does not OOM2F403.23
C guarantee a fully stable water column). OOM2F403.24
IF (L_OMEDADV) THEN OOM2F405.296
C do Roussenov convection at the points where the med outflow OOM2F405.297
C exits into the Atlantic. OOM2F405.298
OOM2F405.299
*IF DEF,MPP OOM2F405.300
IF (J+J_OFFSET .GE. jmout(1) .AND. OOM2F405.301
& J+J_OFFSET .LE. jmout(4)) THEN OOM2F405.302
*ELSE OOM2F405.303
IF (J .GE. jmout(1) .AND. J .LE. jmout(4)) THEN OOM2F405.304
*ENDIF OOM2F405.305
IF (L_OVARYT) THEN OOM2F405.306
CALL CONVADJ( OOM2F405.307
+ IMT,KM,NT, OOM2F405.308
+ KMT,RZ,TA, OOM2F405.309
+ ITT,imout(1)-1,imout(1)+1 OOM2F405.310
+ ) OOM2F405.311
ELSE OOM2F405.312
CALL CONVADJ( OOM2F405.313
+ IMT,KM,NT, OOM2F405.314
+ KMT,DZ,TA, OOM2F405.315
+ ITT,imout(1)-1,imout(1)+1 OOM2F405.316
+ ) OOM2F405.317
ENDIF OOM2F405.318
ENDIF ! end of applicable range of J's OOM2F405.319
C OOM2F405.320
ENDIF ! L_OMEDADV OOM2F405.321
OOM2F405.322
*IF DEF,MPP OOM2F403.25
IF (J+J_OFFSET .GE. JSROUS .AND. OOM2F403.26
& J+J_OFFSET .LE. JEROUS) THEN OOM2F403.27
*ELSE OOM2F403.28
IF (J .GE. JSROUS .AND. J .LE. JEROUS) THEN OOM2F403.29
*ENDIF OOM2F403.30
IF (L_OVARYT) THEN OOM2F403.31
CALL CONVADJ( OOM2F403.32
+ IMT,KM,NT, OOM2F403.33
+ KMT,RZ,TA, OOM2F403.34
+ ITT,ISROUS,IEROUS OOM2F403.35
+ ) OOM2F403.36
ELSE OOM2F403.37
CALL CONVADJ( OOM2F403.38
+ IMT,KM,NT, OOM2F403.39
+ KMT,DZ,TA, OOM2F403.40
+ ITT,ISROUS,IEROUS OOM2F403.41
+ ) OOM2F403.42
ENDIF OOM2F403.43
ENDIF ! end of applicable range of J's OOM2F403.44
ENDIF ! Roussenov convection OOM2F403.45
C OJG0F403.51
IF (L_COXCNVC) THEN OJG0F403.52
C OJG0F403.53
C Original Cox convection scheme OJG0F403.54
C OJG0F403.55
CALL COXCNVC( OJG0F403.56
& NT,NTMIN2,IMT,IMTM1,JMT,J,KM,KMM1,KMP1,KMP2 OJG0F403.57
& ,DZ,DZZ2R,RZ,RZZ2R OJG0F403.59
& ,TCHECK,TDIF,TA OJG0F403.60
& ) OJG0F403.61
C OJG0F403.62
ELSE OJG0F403.63
C OJG0F403.64
C Call CONVFULL to do complete convective adjustment using ORW2F400.1
C Rahmstorf's algorithm. N.B. does not suppress convection ORW2F400.2
C under pseudo-ice points (option PSEUDIC). Works with ORW2F400.3
C variable timestep with depth by passing RZ, rather than ORW2F400.4
C DZ, down into CONVFULL. ORW2F400.5
C ORW2F400.9
IF (L_OVARYT) THEN ORW2F400.10
CALL CONVFULL(IMT,KM,NT,KMT,RZ,TA ORW2F400.11
+ ) ORW2F400.12
ELSE ORW2F400.13
CALL CONVFULL(IMT,KM,NT,KMT,DZ,TA ORW2F400.14
+ ) ORW2F400.15
END IF ORW2F400.16
C OJG0F403.65
ENDIF OJG0F403.66
C ORH1F305.1794
IF (L_OBIOLOGY) THEN ORH1F305.1795
C ORH1F305.1796
IF (SF_BIO(22)) THEN ONT1F304.422
DO K=1,KM ONT1F304.423
DO I=1,IMT ONT1F304.424
WCNVC_NUT(I,K)=TA(I,K,NUTRIENT_TRACER)-DNWORK(I,K) OJP0F404.830
ENDDO ONT1F304.426
ENDDO ONT1F304.427
ENDIF ONT1F304.428
C ORH1F305.1797
ENDIF ! L_BIOLOGY ORH1F305.1798
C ORH1F305.1799
IF (SF_DT(11)) THEN JG170893.419
DO K=1,KM JG170893.420
DO I=1,IMT JG170893.421
WDTCNVC(I,K)=TA(I,K,1)-DTWORK(I,K) JG170893.422
ENDDO JG170893.423
ENDDO JG170893.424
ENDIF JG170893.425
IF (SF_DS(10)) THEN OJG2F401.218
DO K=1,KM OJG2F401.219
DO I=1,IMT OJG2F401.220
WDSCNVC(I,K)=TA(I,K,2)-DSWORK(I,K) OJG2F401.221
ENDDO OJG2F401.222
ENDDO OJG2F401.223
ENDIF OJG2F401.224
C TRACER.1266
OJP0F404.831
IF (L_OBIOLOGY.AND.L_OCARBON) THEN OJP0F404.832
OJP0F404.833
! Call BIOLOGY to update the biological tracers for this OJP0F404.834
! timestep. BIOLOGY determines the physics nutrient supply over OJP0F404.835
! the timestep from (TA minus TB) at this point in tracer. OJP0F404.836
OJP0F404.837
! This DNWORK is for the WBIO_NUT diagnostic which stores the OJP0F404.838
! timestep change in nutrient due to the biology. OJP0F404.839
IF (SF_BIO(23)) THEN OJP0F404.840
DO K=1,KM OJP0F404.841
DO I=1,IMT OJP0F404.842
DNWORK(I,K)=TA(I,K,NUTRIENT_TRACER) OJP0F404.843
ENDDO OJP0F404.844
ENDDO OJP0F404.845
ENDIF OJP0F404.846
OJP0F404.847
CALL BIOLOGY (T,TA,TB,SOL_PEN_BIO,KFIX_BIO,RTPIG,PI, OJP0F404.848
& TIMESTEP,ETA_BIO, OJP0F404.849
& DAYLEN,DLCO,SOL_OR_SOLALT, OJP0F404.850
& PRIM_PROD,ZOO_PROD,PHYTO_GROW, OJP0F404.851
& PHYTO_GRAZE,PHYTO_MORT, OJP0F404.852
& EXCRETE_NUT,GROW_NUT,PMORT_NUT,ZMORT_NUT, OJP0F404.853
& PRESP_NUT,REMIN_NUT, OJP0F404.854
& NUT_LIMIT,LIGHT_LIMIT,TEMP_LIMIT, OJP0F404.855
& DETRI_FLUX, OJP0F404.856
& SF_BIO, OJP0F404.857
& DZ,ZDZ,JMT,FM, OJP0F404.858
& SWNCOL, OJP0F404.859
& J,IMT,KM,KMP1,KMT,NT) OJP0F404.860
OJP0F404.861
CALL BIOMIX(TA, IMT, KM, NT, DZ, ZDZ, RZ, OJP0F404.862
& FM, KMT, MLD_MIX) OJP0F404.863
OJP0F404.864
IF (SF_BIO(23)) THEN OJP0F404.865
DO K=1,KM OJP0F404.866
DO I=1,IMT OJP0F404.867
WBIO_NUT(I,K)=TA(I,K,NUTRIENT_TRACER)-DNWORK(I,K) OJP0F404.868
ENDDO OJP0F404.869
ENDDO OJP0F404.870
ENDIF OJP0F404.871
OJP0F404.872
ENDIF ! L_OBIOLOGY and L_OCARBON OJP0F404.873
OJP0F404.874
C======================================================================= TRACER.1267
C END COMPUTATION OF THE TRACERS ===================================== TRACER.1268
C======================================================================= TRACER.1269
C TRACER.1270
C--------------------------------------------------------------------- TRACER.1271
C INTEGRATE TOTAL CHANGES IN T,S AND SQUARED T,S ON ENERGY TIMESTEP TRACER.1272
C--------------------------------------------------------------------- TRACER.1273
C TRACER.1274
IF(NERGY.EQ.1) THEN TRACER.1275
DO M=1,NT ORH1F305.1800
DO K=1,KM ORH1F305.1801
FX=CST(J)*DYT(J)*DZ(K)/C2DTTS TRACER.1278
DO I=2,IMTM1 ORH7F404.18
TTDTOT(1,M)=TTDTOT(1,M)+(TA(I,K,M) -TB(I,K,M) )*FX*DXT(I) ORH1F305.1811
TVAR(M) =TVAR(M) +(TA(I,K,M)**2-TB(I,K,M)**2)*FX*DXT(I) ORH1F305.1812
ENDDO ! over I ORH7F404.19
ENDDO ! over K ORH1F305.1815
ENDDO ! over M ORH1F305.1816
ENDIF TRACER.1294
C TRACER.1295
IF (L_OFILTER) THEN ORH1F305.1817
C--------------------------------------------------------------------- TRACER.1297
C FOURIER FILTER TRACERS AT HIGH LATITUDES ORH1F305.1818
C--------------------------------------------------------------------- TRACER.1304
C TRACER.1305
IF (SF_DT(13)) THEN JG170893.426
DO K=1,KM JG170893.427
DO I=1,IMT JG170893.428
DTWORK(I,K)=TA(I,K,1) JG170893.429
ENDDO JG170893.430
ENDDO JG170893.431
ENDIF JG170893.432
IF (SF_DS(12)) THEN OJG2F401.225
DO K=1,KM OJG2F401.226
DO I=1,IMT OJG2F401.227
DSWORK(I,K)=TA(I,K,2) OJG2F401.228
ENDDO OJG2F401.229
ENDDO OJG2F401.230
ENDIF OJG2F401.231
ORH1F403.103
ENDIF ! L_OFILTER = true ORH1F403.104
ORH1F403.105
ENDIF ! (J.GE.J_2.AND.J.LE.J_JMTM1) ORH1F403.106
ORH1F403.107
IF (L_OFILTER) THEN ORH1F403.108
ORH1F403.109
ORH1F403.112
CALL OFILTR_CNTL( ORH1F403.113
*CALL ARGSIZE ORH1F403.114
*CALL ARGOCALL ORH1F403.115
*CALL ARGOINDX ORH1F403.116
& J,FTARR, ORH1F405.471
*CALL COCAWRKA ORH1F403.118
& ) ORH1F403.119
ORH1F403.120
ENDIF ORH1F403.121
ORH1F403.122
ORH1F403.123
IF (J.GE.J_2.AND.J.LE.J_JMTM1) THEN ORH1F403.124
ORH1F403.125
IF (L_OFILTER) THEN ORH1F403.126
ORH1F403.127
IF (SF_DT(13)) THEN ORH1F403.128
DO K=1,KM ORH1F403.129
DO I=1,IMT ORH1F403.130
WDTFF(I,K)=TA(I,K,1)-DTWORK(I,K) ORH1F403.131
ENDDO ORH1F403.132
ENDDO ORH1F403.133
ENDIF ORH1F403.134
IF (SF_DS(12)) THEN ORH1F403.135
DO K=1,KM ORH1F403.136
DO I=1,IMT ORH1F403.137
WDSFF(I,K)=TA(I,K,2)-DSWORK(I,K) ORH1F403.138
ENDDO ORH1F403.139
ENDDO ORH1F403.140
ENDIF ORH1F403.141
ORH1F403.142
ENDIF ! L_OFILTER = true ORH1F403.143
C ORH1F305.1832
IF (SF_DT(9)) THEN JG170893.440
DO K=1,KM JG170893.441
DO I=1,IMT JG170893.442
DTWORK(I,K)=TA(I,K,1) JG170893.443
ENDDO JG170893.444
ENDDO JG170893.445
ENDIF JG170893.446
C ORH1F305.1833
IF (L_SEAICE) THEN ORH1F305.1834
C TRACER.1375
IF (L_OFILTER) THEN ORH1F305.1835
C--------------------------------------------------------------------- TRACER.1378
C THE FOLLOWING CALL TO REFREEZE REIMPOSES A MINIMUM TEMPERATURE TRACER.1379
C OF FREEZING AT ALL LEVELS, AND STORES NEGATIVE HEAT FLUXES TRACER.1380
C RELEASED BY THIS FOR USE IN THE ICE MODEL. TRACER.1381
C--------------------------------------------------------------------- TRACER.1382
C TRACER.1383
IF (L_OTIMER) CALL TIMER('REFREEZE ',103) GPB8F405.139
C ORH1F305.1837
IF (L_OVARYT) THEN ORH1F305.1838
CALL REFREEZE(TA,IMT,KM,NT,FM,HEATSINK, OJG0F400.29
+ RZ,C2DTTS,SPECIFIC_HEAT_SI,RHO_WATER_SI,TFREEZE) ORH1F305.1840
ELSE ORH1F305.1841
CALL REFREEZE(TA,IMT,KM,NT,FM,HEATSINK, OJG0F400.30
+ DZ,C2DTTS,SPECIFIC_HEAT_SI,RHO_WATER_SI,TFREEZE) TRACER.1392
ENDIF ORH1F305.1843
C ORH1F305.1844
IF (L_OTIMER) CALL TIMER('REFREEZE ',104) GPB8F405.140
C ORH1F305.1846
ENDIF ! L_OFILTER = true ORH1F305.1847
C ORH1F305.1848
ENDIF ! L_SEAICE = true ORH1F305.1849
C ORH1F305.1850
IF (L_OPSEUDIC) THEN ORH1F305.1851
C TRACER.1404
C----------------------------------------------------------------------- TRACER.1405
C The pseudo-ice calculation now has to be redone in case the TRACER.1406
C filtering has created some temperatures of < TFREEZ. TRACER.1407
C Also the mixed layer model may have changed the temperatures TRACER.1408
C at climatological ice points. This section of code may be TRACER.1409
C unnecessary in a model with options -X-F, but it is left in for TRACER.1410
C simplicity RAW 30/7/92 TRACER.1411
C----------------------------------------------------------------------- TRACER.1412
C TRACER.1413
DO K=1,KM ORH1F305.1852
DO I=1,IMT ORH1F305.1860
TA(I,K,1)=MAX(TA(I,K,1) , TFREEZ) ORH1F305.1861
ENDDO ! over I ORH1F305.1862
ENDDO ! over K ORH1F305.1864
C TRACER.1434
C TRACER.1456
DO I=1,IMT ORH1F305.1875
IF(BICE(I).LT.1.E-3) THEN ORH1F305.1876
TA(I,1,1)=T_REF(I) ORH1F305.1877
TA(I,1,2)=S_REF(I) ORH1F305.1878
END IF ORH1F305.1879
ENDDO ! over I ORH1F305.1880
C ORH1F305.1882
C ORH1F305.1883
ENDIF ! L_OPSEUDIC = true ORH1F305.1884
C ORH1F305.1885
IF (SF_DT(9)) THEN JG170893.447
DO K=1,KM JG170893.448
DO I=1,IMT JG170893.449
WDTICE(I,K)=TA(I,K,1)-DTWORK(I,K)+WDTICE(I,K) JG170893.450
ENDDO JG170893.451
ENDDO JG170893.452
ENDIF JG170893.453
C JG170893.454
DO K=1,KM JG170893.455
CFPP$ NODEPCHK JG170893.456
DO I=ISSW,IESW JG170893.457
C ORH1F305.1886
IF (.NOT.(L_OVARYT)) THEN ORH1F305.1887
fx=giga/C2DTTS OJG2F404.65
ELSE ORH1F305.1889
fx=giga/DTTSA(K) OJG2F404.66
ENDIF ORH1F305.1891
C ORH1F305.1892
II=MOD(I-1,SWNCOL)+1 JG170893.463
IF (SF_DT(7)) DTSFC(II,J,K)=WDTSFC(I,K)*fx OJG2F404.67
C ORH1F305.1893
IF (L_OSOLAR) THEN ORH1F305.1894
IF (SF_DT(8)) DTPEN(II,J,K)=WDTPEN(I,K)*fx OJG2F404.68
ELSE ORH1F305.1896
IF (SF_DT(8)) DTPEN(II,J,K)=0. ORH1F305.1897
ENDIF ORH1F305.1898
C ORH1F305.1899
IF (SF_DT(9)) DTICE(II,J,K)=WDTICE(I,K)*fx OJG2F404.69
IF (L_OMIXLAY) THEN ORH1F305.1900
IF (SF_DT(10)) DTMIX(II,J,K)=WDTMIX(I,K)*fx OJG2F404.70
ELSE ORH1F305.1902
IF (SF_DT(10)) DTMIX(II,J,K)=0. ORH1F305.1903
ENDIF ORH1F305.1904
C ORH1F305.1905
IF (SF_DT(11)) DTCNVC(II,J,K)=WDTCNVC(I,K)*fx OJG2F404.71
C ORH1F305.1906
IF (L_OFILTER) THEN ORH1F305.1907
IF (SF_DT(13)) DTFF(II,J,K)=WDTFF(I,K)*fx OJG2F404.72
ELSE ORH1F305.1909
IF (SF_DT(13)) DTFF(II,J,K)=0. ORH1F305.1910
ENDIF ORH1F305.1911
C ORH1F305.1912
IF (SF_DT(15)) DTMED(II,J,K)=WDTMED(I,K)*fx OJG2F404.73
C OJG2F401.239
C Convert salinity increments to rates and copy to diagnostics OJG2F401.240
C OJG2F401.241
IF (SF_DS(7)) DSSFC(II,J)=WDSSFC(I)*fx OJG2F404.74
IF (SF_DS(8)) DSICE(II,J)=WDSICE(I)*fx OJG2F404.75
IF (L_OMIXLAY) THEN OJG2F401.244
IF (SF_DS(9)) DSMIX(II,J,K)=WDSMIX(I,K)*fx OJG2F404.76
ELSE OJG2F401.246
IF (SF_DS(9)) DSMIX(II,J,K)=0. OJG2F401.247
ENDIF OJG2F401.248
IF (SF_DS(10)) DSCNVC(II,J,K)=WDSCNVC(I,K)*fx OJG2F404.77
IF (L_OFILTER) THEN OJG2F401.250
IF (SF_DS(12)) DSFF(II,J,K)=WDSFF(I,K)*fx OJG2F404.78
ELSE OJG2F401.252
IF (SF_DS(12)) DSFF(II,J,K)=0. OJG2F401.253
ENDIF OJG2F401.254
IF (SF_DS(14)) DSMED(II,J,K)=WDSMED(I,K)*fx OJG2F404.79
ENDDO JG170893.483
ENDDO JG170893.484
C ORH1F305.1913
IF (L_OBIOLOGY) THEN ORH1F305.1914
C Factor fx converts rates from (1/s) to (1/day) ONT1F304.431
fx=3600.0*24.0 ONT1F304.432
DO K=1,KM ONT1F304.433
CFPP$ NODEPCHK ORH5F401.4
DO I=ISSW,IESW ONT1F304.435
IF (.NOT.(L_OVARYT)) THEN ORH1F305.1915
C2DTTSK=C2DTTS ORH1F305.1916
ELSE ORH1F305.1917
C2DTTSK=DTTSA(K) ORH1F305.1918
ENDIF ORH1F305.1919
C ORH1F305.1920
II=MOD(I-1,SWNCOL)+1 ONT1F304.441
IF (L_OMIXLAY) THEN ORH1F305.1921
IF (SF_BIO(21)) MIX_NUT(II,J,K)=WMIX_NUT(I,K)*fx/C2DTTSK ORH1F305.1922
ELSE ORH1F305.1923
IF (SF_BIO(21)) MIX_NUT(II,J,K)=0.0 ORH1F305.1924
ENDIF ORH1F305.1925
IF (SF_BIO(22)) CNVC_NUT(II,J,K)=WCNVC_NUT(I,K)*fx/C2DTTSK ONT1F304.447
IF (SF_BIO(23)) BIO_NUT(II,J,K)=WBIO_NUT(I,K)*fx/C2DTTSK ONT1F304.448
ENDDO ONT1F304.450
ENDDO ONT1F304.451
ENDIF ! L_OBIOLOGY ORH1F305.1926
C TRACER.1458
C-------------------------------------------------------------------- TRACER.1459
C Mask out TA before calculating integrated T change. TRACER.1460
C 0.01 is the masked value of salinity (=45ppt). TRACER.1461
C ORH1F305.1928
C-------------------------------------------------------------------- TRACER.1465
DO 1500 K=1,KM TRACER.1466
DO 1510 I=1,IMT TRACER.1467
TA(I,K,1)=TA(I,K,1)*FM(I,K) TRACER.1468
IF(NT.GE.2) TA(I,K,2)=FM(I,K)*TA(I,K,2) + TRACER.1469
* (1.-FM(I,K))*0.01 TRACER.1470
1510 CONTINUE TRACER.1471
1500 CONTINUE TRACER.1472
C--------------------------------------------------------------------- TRACER.1473
C ACCUMULATE INTEGRATED ABSOLUTE CHANGES IN T EVERY NTSI TIMESTEPS TRACER.1474
C--------------------------------------------------------------------- TRACER.1475
C TRACER.1476
IF(MOD(ITT,NTSI).EQ.0) THEN TRACER.1477
FX=0.5*CST(J)*DYT(J)/C2DTTS TRACER.1478
DO 983 M=1,NT TRACER.1479
DO 983 K=1,KM TRACER.1480
DO 983 I=1,IMT TRACER.1481
TDIF(I,K,M)=ABS(TA(I,K,M)-TB(I,K,M))*C2DZQ(I,K)*FX*DXTQ(I,K) TRACER.1482
983 CONTINUE TRACER.1483
DO 985 M=1,NT TRACER.1484
IF (L_OFILTER) THEN ORH1F305.1929
! Allow concurrent execution ORH1F305.1930
DO 986 K=1,KM ORH1F305.1931
DO 986 I=2,IMTM1 ORH1F305.1932
DTABS(M)=DTABS(M)+TDIF(I,K,M) ORH1F305.1933
986 CONTINUE ORH1F305.1934
ELSE ORH1F305.1935
! No concurrent execution ORH1F305.1936
DO 987 K=1,KM ORH1F305.1937
DO 987 I=2,IMTM1 ORH1F305.1938
DTABS(M)=DTABS(M)+TDIF(I,K,M) ORH1F305.1939
987 CONTINUE ORH1F305.1940
ENDIF ORH1F305.1941
985 CONTINUE TRACER.1491
ENDIF TRACER.1492
C TRACER.1493
C--------------------------------------------------------------------- TRACER.1494
C TRANSFER QUANTITIES COMPUTED TO THE NORTH OF THE PRESENT ROW TRACER.1495
C TO BE DEFINED TO THE SOUTH IN THE COMPUTATION OF THE NEXT ROW TRACER.1496
C--------------------------------------------------------------------- TRACER.1500
C TRACER.1501
FX=(CST(J)*CSTR(J+1)) OSY1F405.141
DO 990 K=1,KM TRACER.1503
DO 990 I=1,IMT TRACER.1504
FVST(I,K)=FVN(I,K)*FX TRACER.1505
DO M=1,NT OSY1F405.142
FLUXST(I,K,M)=FLUXNT(I,K,M)*FX OSY1F405.143
ENDDO OSY1F405.144
RHOS(I,K)=RHON(I,K) TRACER.1506
990 CONTINUE TRACER.1507
C TRACER.1508
IF (L_OCYCLIC) THEN ORH1F305.1944
C--------------------------------------------------------------------- TRACER.1510
C SET CYCLIC BOUNDARY CONDITIONS ON NEWLY COMPUTED TRACERS TRACER.1511
C--------------------------------------------------------------------- TRACER.1512
C TRACER.1513
DO 992 M=1,NT TRACER.1514
DO 992 K=1,KM TRACER.1515
TA(1 ,K,M)=TA(IMTM1,K,M) TRACER.1516
TA(IMT,K,M)=TA(2 ,K,M) TRACER.1517
992 CONTINUE TRACER.1518
diagsw(1,j)=diagsw(imtm1,j) OJL1F405.42
diagsw(imt,j)=diagsw(2,j) OJL1F405.43
ENDIF ORH1F305.1945
C ORH1F305.1946
IF (.NOT.(L_OSYMM)) THEN ORH1F305.1947
C TRACER.1521
C--------------------------------------------------------------------- TRACER.1522
C SET NEW VELOCITIES AT NORTHERN WALL TO ZERO SINCE NO PASS THROUGH TRACER.1523
C CLINIC IS MADE FOR THIS ROW TRACER.1524
C--------------------------------------------------------------------- TRACER.1525
C TRACER.1526
IF (J+J_OFFSET.EQ.JMTM1_GLOBAL) THEN ORH3F402.392
FX=0.0 TRACER.1528
DO 680 K=1,KM TRACER.1529
DO 680 I=1,IMT TRACER.1530
UA(I,K)=FX TRACER.1531
VA(I,K)=FX TRACER.1532
680 CONTINUE TRACER.1533
ENDIF TRACER.1534
C ORH1F305.1948
ENDIF ORH1F305.1949
ORH1F403.144
ENDIF ! if (J.GE.J_2.AND.J.LE.J_JMTM1) ORH1F403.145
ORH1F403.146
IF (L_OTIMER) CALL TIMER('TRACER ',104) GPB8F405.141
C ORH1F305.1952
RETURN TRACER.1539
END TRACER.1540
*ENDIF @DYALLOC.4055