*IF DEF,OCEAN ORH1F305.261
C ******************************COPYRIGHT****************************** GTS2F400.667
C (c) CROWN COPYRIGHT 1995, METEOROLOGICAL OFFICE, All Rights Reserved. GTS2F400.668
C GTS2F400.669
C Use, duplication or disclosure of this code is subject to the GTS2F400.670
C restrictions as set forth in the contract. GTS2F400.671
C GTS2F400.672
C Meteorological Office GTS2F400.673
C London Road GTS2F400.674
C BRACKNELL GTS2F400.675
C Berkshire UK GTS2F400.676
C RG12 2SZ GTS2F400.677
C GTS2F400.678
C If no contract has been raised with this copy of the code, the use, GTS2F400.679
C duplication or disclosure of it is strictly prohibited. Permission GTS2F400.680
C to do so must first be obtained in writing from the Head of Numerical GTS2F400.681
C Modelling at the above address. GTS2F400.682
C ******************************COPYRIGHT****************************** GTS2F400.683
C GTS2F400.684
C*LL Subroutine CALCESAV CALCESAV.3
CLL CALCESAV.4
CLL Can run on any compiler accepting lower case variables. CALCESAV.5
CLL CALCESAV.6
CLL The code must be precompiled by the UPDOC system. CALCESAV.7
CLL Option L selects the code for Isopycnal Diffusion. CALCESAV.8
CLL Option X selects code necessary when I.P.D. is combined with CALCESAV.9
CLL Mixed Layer scheme CALCESAV.10
CLL CALCESAV.11
CLL Author: R.Hill CALCESAV.12
CLL Reviewer: CALCESAV.13
CLL Date: 01.09.94 CALCESAV.14
CLL Version: 3.4 CALCESAV.15
CLL CALCESAV.16
CLL External documentation: CALCESAV.17
CLL Unified Model Documentation Paper No. 51. CALCESAV.18
CLL CALCESAV.19
CLL Naming convention of variables: Cox naming convention is used, CALCESAV.20
CLL with the addition that lower-case variables are CALCESAV.21
CLL introduced by the Isopycnal Diffusion scheme. CALCESAV.22
CLL CALCESAV.23
CLL Purpose of Subroutine: CALCESAV.24
CLL Calculates isopycnal diffusion coefficients for 1st CALCESAV.25
CLL row in a block of rows when performing ocean computations CALCESAV.26
CLL over several "blocks of rows" in parallel. CALCESAV.27
CLL CALCESAV.28
! Modification History: ORH1F305.264
! Version Date Details ORH1F305.265
! ------- ------- ------------------------------------------ ORH1F305.266
! 3.5 16.01.95 Remove *IF dependency. R.Hill ORH1F305.267
! 4.1 03.04.96 Include arguments required by Gent & OLA0F401.121
! McWilliams eddy transport scheme. C. Roberts OLA0F401.122
CLL 4.3 18/03/97 4.3 Introduce the Visbeck scheme. C. Roberts OLA2F403.260
! 4.3 24.10.97 Modify visopn calculations for consistency OOM1F404.68
! with IPDGMVEL changes. R. Hill OOM1F404.69
! 4.4 15/08/97 Remove SKIPLAND code. R. Hill ORH7F404.73
! 4.5 26/01/98 Change logicals and arguments for use with ODC1F405.131
! the freedrift sea_ice advection scheme. D.Cresswell. ODC1F405.132
CLLEND------------------------------------------------------------------ CALCESAV.29
C* CALCESAV.30
C*L---- Arguments ------------------------------------------------------ CALCESAV.31
C CALCESAV.32
SUBROUTINE CALCESAV 1,12CALCESAV.33
& (J,JMT,IMT,IMTM1,KM,KMT,KMP,KMP1,KMP2,NT,NTMIN2,KMM1, CALCESAV.34
& T,TP,TDIF,TB,TBP,TBM, CALCESAV.35
& UB,VB,UBM,VBM, CALCESAV.36
& DXUR,DXU2RQ,DXT4RQ,DYUR,DYT4R,DZ2RQ,DZZ2RQ,ZDZ,DYTR, CALCESAV.37
& NERGY,CS,CSR,CSTR,ITT,FM,FMP,FMM, CALCESAV.38
& RHOS,RHON,ahi, CALCESAV.39
& WSX,WSY,WSXM,WSYM, OLA3F403.203
& ISX,ISY,WSX_LEADS,WSY_LEADS, OLA0F404.88
& ISXM,ISYM,WSX_LEADSM,WSY_LEADSM, OLA0F404.89
& ZDZZ,DZ,L_OBULKRI,L_OWINDMIX,L_OBULKMAXMLD, OOM1F405.491
& LAMBDA_LARGE,MAX_LARGE_LEVELS, OOM1F405.492
& NO_LAYERS_IN_LEV,HTN,PME,WATERFLUX_ICE,SOL,WME, OOM1F405.493
& PHIT,OCEANHEATFLUX,CARYHEAT,FLXTOICE, OOM1F405.494
& JFT0, CALCESAV.40
& rxp,ry,rrzp,esav CALCESAV.41
&,J_OFFSET ORH7F402.279
& ,drhob1p,drhob2p,DZZ,KMTP,KMTPP,VISOPN,ATHKDF,DZ2R OLA0F401.123
& ,ATHKDFTU,ATHKDFTV OLA2F403.261
& ,mld CALCESAV.46
& ,DIAG_MLD CALCESAV.48
& ,KAPPA_B_SI CALCESAV.50
& ) CALCESAV.51
C CALCESAV.52
IMPLICIT NONE CALCESAV.53
C CALCESAV.54
*CALL UMSCALAR 
CALCESAV.55
*CALL CNTLOCN ORH1F305.268
*CALL OARRYSIZ ORH1F305.269
C CALCESAV.56
INTEGER CALCESAV.57
& I,J,K,M,N,L, CALCESAV.58
& JMT,IMT,IMTM1,KM,KMP,KMP1,KMP2,NT,NTMIN2, OLA0F401.124
& KMM1, CALCESAV.60
& NERGY,ITT,KS,JFT0 CALCESAV.61
&,J_OFFSET ORH7F402.280
C CALCESAV.65
REAL CALCESAV.66
& TB(IMT,KM,NT),TBP(IMT,KM,NT),TBM(IMT,KM,NT),TA(IMT,KM,NT), CALCESAV.67
& UB(IMT,KM),VB(IMT,KM),UBM(IMT,KM),VBM(IMT,KM), CALCESAV.68
& DYTR(JMT), CALCESAV.69
& CS(JMT),FMM(IMT,KM), CALCESAV.70
& T(IMT,KM,NT),TP(IMT,KM,NT),TDIF(IMT,KMP2,NTMIN2), CALCESAV.71
& DXUR(IMT),DXU2RQ(IMT,KM),DXT4RQ(IMT,KM), CALCESAV.72
& DYUR(JMT),DYT4R(JMT),DZ2RQ(IMT,KM),DZZ2RQ(IMT,KM),ZDZ(KM), CALCESAV.73
& RHOS(IMT,KM),RHON(IMT,KM), CALCESAV.74
& FM(IMT,KM),FMP(IMT,KM),CSR(JMT),CSTR(JMT), CALCESAV.75
& ahi(KM), ! IN along-isopycnal coeff. of diffusion CALCESAV.76
C Ai in Eq.1.8 (cm2/s) CALCESAV.77
& gnu(IMT,KM), ! IN coeff. of vertical diffusion at TOP of CALCESAV.78
C box. Av in Eq.1.10 (cm2/s) CALCESAV.79
& fk1(IMT,KM,3), ! OUT } Rows 1,2,3 of diffusion matrix (Eq1.8) CALCESAV.80
& fk2(IMT,KM,3), ! OUT } fk1 is on EAST face, fk2 on NORTH face CALCESAV.81
& fk3(IMT,KM,3), ! OUT } & fk3 on TOP face of grid box (i,j,k) CALCESAV.82
& rxp(IMT,KM), ! INOUT delta-rho in x dirn, row J+1 (E face) CALCESAV.83
& ry(IMT,KM), ! INOUT delta-rho in y dirn, row J (N face) CALCESAV.84
& rrzp(IMT,KMP1), ! INOUT delta-rho in z dirn, row J+1 (top face CALCESAV.85
& esav(IMT,KM,NT) ! OUT used to save e(I,K,2) in CALCESAV.86
C subroutine IPDFLXCL CALCESAV.87
&, RHOSRN(IMT,KM),RHOSRNA(IMT,KM+1),RHOSRNB(IMT,KM+1) OOM1F405.495
&, KAPPA_B_SI(KM) ! IN Depth dependent backgnd vert diffusivity CALCESAV.89
&,MLD(IMT_IPD_MIX,JMT_IPD_MIX) ! IN Mixed layer depth (m) ORH1F305.274
&,DIAG_MLD(1,JMT_IPD_NOMIX) ORH1F305.275
C CALCESAV.98
REAL OLA0F404.91
& RiT(imt,kmm1) ! OUT Richardson number for tracer grid OLA0F404.92
&,hT(imt_qlarge) ! OUT Depth Large scheme applied to (T grid) OLA0F404.93
&,WSX(IMT),WSY(IMT) ! IN wind stress on row j OLA0F404.94
&,WSXM(IMT),WSYM(IMT) ! IN wind stress on row j-1 OLA0F404.95
&,ZDZZ(KM+1) ! IN DEPTH OF MIDDLE OF LAYER (CM) OOM1F405.496
&,DZ(KM) ! IN distance between half-levels (cm) OLA0F404.97
&,ISX(IMT_idr) ! IN Stress under sea ice fraction, row j ODC1F405.133
&,ISY(IMT_idr) ! IN Stress under sea ice fraction, row j ODC1F405.134
&,WSX_LEADS(IMT_idr) ! IN Stress under leads fraction, row j ODC1F405.135
&,WSY_LEADS(IMT_idr) ! IN Stress under leads fraction, row j ODC1F405.136
&,ISXM(IMT_idr) ! IN Stress under sea ice fraction, row j-1 ODC1F405.137
&,ISYM(IMT_idr) ! IN Stress under sea ice fraction, row j-1 ODC1F405.138
&,WSX_LEADSM(IMT_idr) ! IN Stress under leads fraction, row j-1 ODC1F405.139
&,WSY_LEADSM(IMT_idr) ! IN Stress under leads fraction, row j-1 ODC1F405.140
REAL OOM1F405.497
& OCEANHEATFLUX(IMT) !:NON-PEN SURFACE HEATFLUX INTO OCEAN BUDGET OOM1F405.498
&,CARYHEAT(IMT) !MISCELLANEOUS HEATFLUX FROM ICE OOM1F405.499
&,FLXTOICE(IMT) !OCEAN TO ICE HEATFLUX OOM1F405.500
REAL OOM1F405.501
& L_T(IMT) ! MONIN OBUKHOV LENGTH, LARGE SCHEME (TRACER) OOM1F405.502
&, HTN(IMT) ! IN NON-PENETRATING HEAT FLUX (W/M2) ON ROW J OOM1F405.503
&, PME(IMT) ! IN PRECIP MINUS EVAP (KG/M2/S) ON ROW J OOM1F405.504
&, RIMLDCALC(IMT,KMM1) ! RICHARDSON NO FROM MLD CALCULATION OOM1F405.505
&, SOL(IMT) ! IN SOLAR IRRADIANCE (W/M2) AT SURFACE ON ROW J OOM1F405.506
&, WME(IMT) ! IN WIND MIXING POWER ON ROW J (W M^-2) OOM1F405.507
&, MLD_LARGE(IMT) ! MIXED LAYER DEPTH ON T GRID, ROW J, (CM) OOM1F405.508
&, WATERFLUX_ICE(IMT) ! IN WATER FLUX FROM ICE (KG/M2/S) OOM1F405.509
! ON ROW J OOM1F405.510
&, LAMBDA_LARGE,CGFLUX(IMT,KM,NT) OOM1F405.511
&, PHIT ! IN LATITUDE OF ROW J ON TRACER GRID (RADIANS) OOM1F405.512
INTEGER OOM1F405.513
& MAX_LARGE_LEVELS ! IN MAX NO OF LEVS FOR LARGE SCHEME OOM1F405.514
&, NO_LAYERS_IN_LEV ! IN NO OF LAYERS IN A LEVEL TO CALC MLD_LARGE OOM1F405.515
LOGICAL L_OBULKRI,L_OWINDMIX,L_OBULKMAXMLD OOM1F405.516
REAL drhob1p(IMT_GM) OLA0F401.125
& ,drhob2p(IMT_GM,2) OLA0F401.126
& ,DZZ(KMP1) OLA0F401.127
& ,VISOPN(IMT_GM,KM_GM) ! G&McW v* at N face of T gridbox OLA0F401.128
& ,DZ2R(KM) OLA0F401.129
& ,ATHKDF(KM) OLA0F401.130
&,ATHKDFTU(IMT_VIS,JMT_VIS) ! thickness diffusion coeff (u* pts) OLA2F403.262
&,ATHKDFTV(IMT_VIS,JMT_VIS) ! thickness diffusion coeff (v* pts) OLA2F403.263
OLA0F401.131
REAL FXA OLA0F401.132
OLA0F401.133
INTEGER KMT(IMT),KMTP(IMT),KMTPP(IMT) OLA0F401.134
C CALCESAV.99
*IF DEF,OISOPYC ORH1F305.262
C Declare local variables CALCESAV.100
C CALCESAV.101
REAL CALCESAV.102
& worka(IMT,KM), ! workspace CALCESAV.103
& workb(IMT,KM), ! workspace CALCESAV.104
& workc(IMT,KM) ! workspace CALCESAV.105
REAL DUMMY_MLD(IMT) ORW1F400.73
REAL OLA0F404.106
& XSTRESS_ICE(IMT_idr) !IN Total stress under sea ice row j ODC1F405.141
&,YSTRESS_ICE(IMT_idr) ! (Wind stress at ice free points) ODC1F405.142
&,XSTRESS_ICEM(IMT_idr) !IN Total stress under sea ice row j-1 ODC1F405.143
&,YSTRESS_ICEM(IMT_idr) ! (Wind stress at ice free points) ODC1F405.144
C CALCESAV.106
C CALCESAV.107
C* CALCESAV.108
C*L---- External subroutines called ------------------------------------ CALCESAV.109
C VERTCOFT CALCESAV.110
C IPDCOFCL CALCESAV.111
C IPDCLXCL CALCESAV.112
C STATED CALCESAV.113
C ---------------------------------------------------------------- CALCESAV.114
C First we must calculate gnu CALCESAV.115
C ---------------------------------------------------------------- CALCESAV.116
C CALCESAV.117
IF (L_ORICHARD) THEN ORH1F305.276
C CALCESAV.119
C ---------------------------------------------------------------- CALCESAV.120
C Compute rhosrn in preparation for call to VERTCOFT CALCESAV.121
C ---------------------------------------------------------------- CALCESAV.122
C OOM1F405.517
IF(L_OSTATEC)THEN OOM1F405.518
C OOM1F405.519
C--------------- USE STATEC TO FIND VALUES FOR RHO OOM1F405.520
CALL STATEC(TB(1,1,1),TB(1,1,2),RHOSRNA,WORKA,WORKB,1, OOM1F405.521
& IMT,KM,J,JMT) OOM1F405.522
CALL STATEC(TB(1,1,1),TB(1,1,2),RHOSRNB,WORKA,WORKB,2, OOM1F405.523
& IMT,KM,J,JMT) OOM1F405.524
C OOM1F405.525
DO I=1,IMT OOM1F405.526
RHOSRNA(I,KM+1)=RHOSRNA(I,KM) OOM1F405.527
RHOSRNB(I,KM+1)=RHOSRNB(I,KM) OOM1F405.528
ENDDO OOM1F405.529
C OOM1F405.530
ELSE OOM1F405.531
C OOM1F405.532
C--------------- USE STATED TO FIND VALUES FOR RHO OOM1F405.533
CALL STATED(TB(1,1,1),TB(1,1,2),rhosrn,worka,workb,IMT,KM CALCESAV.123
& ,J,KM,JMT ORH7F404.74
& ) CALCESAV.127
C OOM1F405.534
ENDIF ! L_OSTATEC OOM1F405.535
C OOM1F405.536
C CALCESAV.128
C OOM1F405.537
C CALCULATE MIXED LAYER DEPTH OOM1F405.538
IF (L_OFULARGE) THEN OOM1F405.539
IF (L_OBULKRI) THEN OOM1F405.540
CALL CALC_MLD_LARGEB(J,KM,IMT,NT OOM1F405.541
&, RHO_WATER_SI,GRAV_SI,SPECIFIC_HEAT_SI,CRIT_RI_FL OOM1F405.542
&, ZDZ,DZ,ZDZZ,DZZ,L_OCYCLIC,L_SEAICE OOM1F405.543
&, UB,VB,UBM,VBM,TB,RHOSRN,HTN OOM1F405.544
&, PME,WATERFLUX_ICE,SOL,WME,OCEANHEATFLUX,CARYHEAT,FLXTOICE OOM1F405.545
&, FM,MLD_LARGE,RIMLDCALC OOM1F405.546
& ) OOM1F405.547
ELSE OOM1F405.548
CALL CALC_MLD_LARGEG(J,KM,IMT OOM1F405.549
&, RHO_WATER_SI,GRAV_SI,CRIT_RI_FL,NO_LAYERS_IN_LEV OOM1F405.550
&, ZDZ,DZ,DZZ,L_OCYCLIC OOM1F405.551
&, UB,VB,UBM,VBM OOM1F405.552
&, FM,RHOSRN,MLD_LARGE,RIMLDCALC OOM1F405.553
& ) OOM1F405.554
ENDIF OOM1F405.555
ENDIF ! L_OFULARGE OOM1F405.556
C OOM1F405.557
C ---------------------------------------------------------------- CALCESAV.129
C Call subroutine to calculate vertical coefficient of diffusion CALCESAV.130
C ---------------------------------------------------------------- CALCESAV.131
C CALCESAV.132
IF (L_SEAICE.AND.L_ICEFREEDR) THEN ODC1F405.145
do i=1,imt OLA0F404.112
XSTRESS_ICE(I) = WSX_LEADS(I)+ISX(I) OLA0F404.113
YSTRESS_ICE(I) = WSY_LEADS(I)+ISY(I) OLA0F404.114
XSTRESS_ICEM(I) = WSX_LEADSM(I)+ISXM(I) OLA0F404.115
YSTRESS_ICEM(I) = WSY_LEADSM(I)+ISYM(I) OLA0F404.116
enddo OLA0F404.117
CALL VERTCOFT OLA0F404.118
& ( J,IMT,KM,KMM1,NT, OLA0F404.119
& IMT_QLARGE,L_OQLARGE,L_OCYCLIC, OLA0F404.120
& IMT_FULARGE,L_OFULARGE,L_OUSTARWME,L_OWINDMIX,L_OBULKMAXMLD, OOM1F405.559
& L_OROTATE,L_OSTATEC,L_SEAICE,L_OPANDP,PHIT,TB, OOM1F405.560
& UB,VB,UBM,VBM, OLA0F404.121
& XSTRESS_ICE,YSTRESS_ICE,XSTRESS_ICEM,YSTRESS_ICEM, OLA0F404.122
& ZDZZ,ZDZ,DZ,DZZ, OOM1F405.561
& DZZ2RQ,DZ2RQ, OLA0F404.124
& NERGY,GRAV_SI,FM, OLA0F404.125
& RHOSRN,RHOSRNA,RHOSRNB, OOM1F405.558
& hT,RiT,max_qLarge_depth,crit_Ri, OLA0F404.127
& MLD_LARGE,MAX_LARGE_DEPTH,MAX_LARGE_LEVELS,RHO_WATER_SI, OOM1F405.562
& HTN,PME,WATERFLUX_ICE,SOL,WME,L_T,LAMBDA_LARGE, OOM1F405.563
& SPECIFIC_HEAT_SI, OOM1F405.564
& gnu(1,1),FNU0_SI,FNUB_SI,STABLM_SI,FKAPB_SI,GNUMINT_SI OLA0F404.128
& ,KAPPA_B_SI,OCEANHEATFLUX,CARYHEAT,FLXTOICE,CGFLUX ) OOM1F405.565
ELSE OLA0F404.130
CALL VERTCOFT CALCESAV.133
& (J,IMT,KM,KMM1,NT, CALCESAV.134
& IMT_QLARGE,L_OQLARGE,L_OCYCLIC, OLA3F403.212
& IMT_FULARGE,L_OFULARGE,L_OUSTARWME,L_OWINDMIX,L_OBULKMAXMLD, OOM1F405.567
& L_OROTATE,L_OSTATEC,L_SEAICE,L_OPANDP,PHIT,TB, OOM1F405.568
& UB,VB,UBM,VBM, CALCESAV.135
& WSX, WSY,WSXM,WSYM, OLA3F403.210
& ZDZZ,ZDZ,DZ,DZZ, OOM1F405.569
& DZZ2RQ,DZ2RQ, OLA3F403.213
& NERGY,GRAV_SI,FM, CALCESAV.137
& RHOSRN,RHOSRNA,RHOSRNB, OOM1F405.566
& hT,RiT,max_qLarge_depth,crit_Ri, OLA0F404.132
& MLD_LARGE,MAX_LARGE_DEPTH,MAX_LARGE_LEVELS,RHO_WATER_SI, OOM1F405.570
& HTN,PME,WATERFLUX_ICE,SOL,WME,L_T,LAMBDA_LARGE, OOM1F405.571
& SPECIFIC_HEAT_SI, OOM1F405.572
& gnu(1,1),FNU0_SI,FNUB_SI,STABLM_SI,FKAPB_SI,GNUMINT_SI, CALCESAV.139
& KAPPA_B_SI,OCEANHEATFLUX,CARYHEAT,FLXTOICE,CGFLUX ) OOM1F405.573
ENDIF OLA0F404.133
C CALCESAV.141
ELSE ORH1F305.277
DO K=1,KM CALCESAV.144
DO I=1,IMT CALCESAV.145
gnu(I,K)=FKPH CALCESAV.146
ENDDO ! Over I CALCESAV.147
ENDDO ! Over K CALCESAV.148
ENDIF ORH1F305.278
C ------------------------------------------------------------------ CALCESAV.150
C Having obtained required values of gnu, CALCESAV.151
C call subroutine to calculate isopycnal diffusion tensor CALCESAV.152
C ------------------------------------------------------------------ CALCESAV.153
C CALCESAV.154
C OJG0F403.67
IF (L_SLOPEMAX) THEN OJG0F403.68
C OJG0F403.69
C Old isopycnal diffusion scheme, with a maximum slope OJG0F403.70
C OJG0F403.71
IF (L_OMIXLAY) THEN OJG0F403.72
C OJG0F403.73
CALL IPDCOFCO OJG0F403.74
& ( J,JMT,IMT,IMTM1,KM,KMT,KMP,KMP1,KMP2,NT,NTMIN2, OJG0F403.75
& J_OFFSET, ORH7F404.75
& T,TP,TDIF, OJG0F403.78
& DXUR,DXU2RQ,DXT4RQ,DYUR,DYT4R,DZ2RQ,DZZ2RQ,ZDZ,DTTS, OJG0F403.79
& NERGY,CSR,CSTR,ITT,FM,FMP, OJG0F403.80
& RHOS,RHON,AH,ahi, OJG0F403.81
& gnu(1,1),JFT0,esav,fk1,fk2,fk3(1,1,1), OJG0F403.82
& rxp,ry,rrzp, OJG0F403.83
& MLD OJG0F403.84
& ,SLOPE_MAX OJG0F403.85
& ) OJG0F403.86
C OJG0F403.87
ELSE OJG0F403.88
C OJG0F403.89
CALL IPDCOFCO OJG0F403.90
& ( J,JMT,IMT,IMTM1,KM,KMT,KMP,KMP1,KMP2,NT,NTMIN2, OJG0F403.91
& J_OFFSET, ORH7F404.76
& T,TP,TDIF, OJG0F403.94
& DXUR,DXU2RQ,DXT4RQ,DYUR,DYT4R,DZ2RQ,DZZ2RQ,ZDZ,DTTS, OJG0F403.95
& NERGY,CSR,CSTR,ITT,FM,FMP, OJG0F403.96
& RHOS,RHON,AH,ahi, OJG0F403.97
& gnu(1,1),JFT0,esav,fk1,fk2,fk3(1,1,1), OJG0F403.98
& rxp,ry,rrzp, OJG0F403.99
& DIAG_MLD OJG0F403.100
& ,SLOPE_MAX OJG0F403.101
& ) OJG0F403.102
C OJG0F403.103
ENDIF OJG0F403.104
C OJG0F403.105
ELSE OJG0F403.106
IF (L_OMIXLAY) THEN ORH1F305.279
C ORW1F400.74
C IPD is switched off in top 50m, for numerical stability reasons. ORW1F400.75
C This is instead of switching it off throughout the mixed layer, ORW1F400.76
C as in previous (<4.0) versions of the code. ORW1F400.77
C ORW1F400.78
C To revert to switching off IPD throughout mixed layer, pass MLD ORW1F400.79
C instead of DUMMY_MLD into IPDCOFCL. ORW1F400.80
C ORW1F400.81
DO I=1,IMT ORW1F400.82
DUMMY_MLD(I)=50.0 ORW1F400.83
END DO ORW1F400.84
C ORW1F400.85
CALL IPDCOFCL ORH1F305.280
& ( J,JMT,IMT,IMTM1,KM,KMP,KMP1,KMP2,NT,NTMIN2, OLA0F401.135
& J_OFFSET, ORH7F402.281
& T,TP,TDIF, ORH1F305.283
& DZZ,KMT,KMTP,KMTPP, OLA0F401.136
& DXUR,DXU2RQ,DXT4RQ,DYUR,DYT4R,DZ2RQ,DZZ2RQ,ZDZ,DTTS, ORH1F305.284
& NERGY,CSR,CSTR,ITT,FM,FMP,FMM, OLA0F401.137
& RHOS,RHON,AH,ahi, ORH1F305.286
& gnu(1,1),JFT0,esav,fk1,fk2,fk3(1,1,1), ORH1F305.287
& rxp,ry,rrzp, ORH1F305.288
& drhob1p,drhob2p, OLA0F401.138
& DUMMY_MLD ORW1F400.86
& ,SLOPE_MAX ORH1F305.290
& ,dslope,slopec OLA0F401.139
& ) ORH1F305.291
ELSE ORH1F305.292
CALL IPDCOFCL ORH1F305.293
& ( J,JMT,IMT,IMTM1,KM,KMP,KMP1,KMP2,NT,NTMIN2, OLA0F401.140
& J_OFFSET, ORH7F402.282
& T,TP,TDIF, ORH1F305.296
& DZZ,KMT,KMTP,KMTPP, OLA0F401.141
& DXUR,DXU2RQ,DXT4RQ,DYUR,DYT4R,DZ2RQ,DZZ2RQ,ZDZ,DTTS, ORH1F305.297
& NERGY,CSR,CSTR,ITT,FM,FMP,FMM, OLA0F401.142
& RHOS,RHON,AH,ahi, ORH1F305.299
& gnu(1,1),JFT0,esav,fk1,fk2,fk3(1,1,1), ORH1F305.300
& rxp,ry,rrzp, ORH1F305.301
& drhob1p,drhob2p, OLA0F401.143
& DIAG_MLD ORH1F305.302
& ,SLOPE_MAX ORH1F305.303
& ,dslope,slopec OLA0F401.144
& ) ORH1F305.304
ENDIF ORH1F305.305
C OJG0F403.107
ENDIF OJG0F403.108
C CALCESAV.173
C -------------------------------------------------------------- CALCESAV.174
C Calculate esav ready for calculations involving the first CALCESAV.175
C row in this parallel block. CALCESAV.176
C (Tracer values are unavoidably populated with spurious figures CALCESAV.177
C here but since they are kept local to this subroutine, the CALCESAV.178
C only problem should be one of performance.) CALCESAV.179
C -------------------------------------------------------------- CALCESAV.180
! Initialise TA and ESAV ORH2F305.5
DO M = 1, NT ORH2F305.6
DO K = 1, KM ORH2F305.7
DO I = 1, IMT ORH2F305.8
TA(I,K,M) = 0.0 ORH2F305.9
ESAV(I,K,M) = 0.0 ORH2F305.10
ENDDO ! over I ORH2F305.11
ENDDO ! over K ORH2F305.12
ENDDO ! over M ORH2F305.13
C CALCESAV.181
DO M=1,NT CALCESAV.182
C CALCESAV.183
CALL IPDFLXCL CALCESAV.184
& (M,J,JMT,IMT,IMTM1,KM,KMP1,KMM1,NT, CALCESAV.185
& TB,TBP,TBM,TA, CALCESAV.186
& DXU2RQ,DXT4RQ,DYUR,DYTR,DYT4R,DZ2RQ, CALCESAV.187
& CS,CSR,CSTR,FM,FMP,FMM, CALCESAV.188
& esav,fk1,fk2,fk3,worka,workb,workc) CALCESAV.189
C CALCESAV.190
C CALCESAV.191
ENDDO CALCESAV.192
OLA0F401.145
IF (L_OISOPYCGM) THEN OLA0F401.146
OLA2F403.264
IF (L_OVISBECK) THEN OLA2F403.265
OLA2F403.266
c Compute the meridional component of the isopycnal mixing velocity OLA2F403.267
c at the centre of the northern face of the tracer grid box. OLA2F403.268
do k=2,kmm1 OLA2F403.269
DO I=1,IMT OOM1F404.70
visopn(i,k) = -dz2r(k)*fm(i,k)*fmp(i,k)*(fk2(i,k-1,3)* OOM1F404.71
& (ATHKDFTV(i,j)/ahi(k-1))-fk2(i,k+1,3)* OOM1F404.72
& (ATHKDFTV(i,j)/ahi(k+1))) OOM1F404.73
ENDDO OOM1F404.74
enddo OLA2F403.275
c Consider the top and bottom levels. "fk2" is assumed to be zero OLA2F403.276
c at the ocean top and bottom. OLA2F403.277
k = 1 OLA2F403.278
DO I=1,IMT OOM1F404.75
visopn(i,k) = dz2r(k)*fm(i,k)*fmp(i,k) OOM1F404.76
& *(fk2(i,k,3)*(ATHKDFTV(i,j)/ahi(k)) + OOM1F404.77
& fk2(i,k+1,3)*(ATHKDFTV(i,j)/ahi(k+1))) OOM1F404.78
ENDDO OOM1F404.79
do i=1,imt OLA2F403.284
visopn(i,km) = 0. OLA2F403.285
enddo OLA2F403.286
do i=1,imt OLA2F403.287
k = min(kmt(i),kmtp(i)) OLA2F403.288
if (k .ne. 0) then OLA2F403.289
visopn(i,k) = -dz2r(k)*fm(i,k)*fmp(i,k) OOM1F404.80
& *(fk2(i,k,3)*(ATHKDFTV(i,j)/ahi(k))+ OOM1F404.81
& fk2(i,k-1,3)*(ATHKDFTV(i,j)/ahi(k-1))) OOM1F404.82
endif OLA2F403.293
enddo OLA2F403.294
OLA2F403.295
ELSE OLA2F403.296
OLA2F403.297
c The following occurs if the Visbeck Scheme is not chosen OLA2F403.298
OLA0F401.147
c OLA0F401.148
c compute the meridional component of the isopycnal mixing velocity OLA0F401.149
c at the center of the northern face of the "t" grid box. OLA0F401.150
c OLA0F401.151
c the top and bottom levels will be considered later. OLA0F401.152
c OLA0F401.153
OLA0F401.154
DO k=2,kmm1 OLA0F401.155
DO I=1,IMT OOM1F404.83
visopn(i,k) = -dz2r(k)*fm(i,k)*fmp(i,k)*(fk2(i,k-1,3)* OOM1F404.84
& (athkdf(k-1)/ahi(k-1))-fk2(i,k+1,3)* OOM1F404.85
& (athkdf(k+1)/ahi(k+1))) OOM1F404.86
ENDDO OLA0F401.160
ENDDO OLA0F401.161
c consider the top and bottom levels. "fk2" is assumed to be zero OLA0F401.162
c at the ocean top and bottom. OLA0F401.163
c OLA0F401.164
K = 1 OLA0F401.165
DO I=1,IMT OOM1F404.87
visopn(i,k) = dz2r(k)*fm(i,k)*fmp(i,k) OOM1F404.88
& *(fk2(i,k,3)*(athkdf(k)/ahi(k))+fk2(i,k+1,3)* OOM1F404.89
& (athkdf(k+1)/ahi(k+1))) OOM1F404.90
ENDDO OLA0F401.170
OLA0F401.171
DO i=1,imt OLA0F401.172
visopn(i,km) = 0. OLA0F401.173
ENDDO OLA0F401.174
OLA0F401.175
OLA0F401.176
DO i=1,imt OLA0F401.177
k = min(kmt(i),kmtp(i)) OLA0F401.178
if (k .ne. 0) then OLA0F401.179
visopn(i,k) = -dz2r(k)*fm(i,k)*fmp(i,k) OOM1F404.91
& *(fk2(i,k,3)*(athkdf(k)/ahi(k))+fk2(i,k-1,3)* OOM1F404.92
& (athkdf(k-1)/ahi(k-1))) OOM1F404.93
endif OLA0F401.183
ENDDO OLA0F401.184
OLA0F401.185
OLA2F403.299
ENDIF ! if L_OVISBECK OLA2F403.300
OLA2F403.301
ENDIF ! if L_OISOPYCGM OLA0F401.186
*ENDIF OISOPYC ORH1F305.263
RETURN CALCESAV.193
END CALCESAV.194
*ENDIF CALCESAV.195