Changeset 14533
- Timestamp:
- 2021-02-23T11:16:03+01:00 (3 years ago)
- Location:
- NEMO/branches/UKMO/NEMO_4.0.1_FKOSM_m11715
- Files:
-
- 1 edited
- 1 copied
-
cfgs/eORCA1_AGE_OSM_DEBUG (copied) (copied from NEMO/branches/NERC/dev_r11078_OSMOSIS_IMMERSE_Nurser_4.0/cfgs/eORCA1_AGE_OSM_DEBUG)
-
src/OCE/ZDF/zdfosm.F90 (modified) (14 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/UKMO/NEMO_4.0.1_FKOSM_m11715/src/OCE/ZDF/zdfosm.F90
r14532 r14533 1 1 MODULE zdfosm 2 !!====================================================================== 3 !! *** MODULE zdfosm *** 4 !! Ocean physics: vertical mixing coefficient compute from the OSMOSIS 5 !! turbulent closure parameterization 6 !!===================================================================== 7 !! History : NEMO 4.0 ! A. Grant, G. Nurser 8 !! 15/03/2017 Changed calculation of pycnocline thickness in unstable conditions and stable conditions AG 9 !! 15/03/2017 Calculation of pycnocline gradients for stable conditions changed. Pycnocline gradients now depend on stability of the OSBL. A.G 10 !! 06/06/2017 (1) Checks on sign of buoyancy jump in calculation of OSBL depth. A.G. 11 !! (2) Removed variable zbrad0, zbradh and zbradav since they are not used. 12 !! (3) Approximate treatment for shear turbulence. 13 !! Minimum values for zustar and zustke. 14 !! Add velocity scale, zvstr, that tends to zustar for large Langmuir numbers. 15 !! Limit maximum value for Langmuir number. 16 !! Use zvstr in definition of stability parameter zhol. 17 !! (4) Modified parametrization of entrainment flux, changing original coefficient 0.0485 for Langmuir contribution to 0.135 * zla 18 !! (5) For stable boundary layer add factor that depends on length of timestep to 'slow' collapse and growth. Make sure buoyancy jump not negative. 19 !! (6) For unstable conditions when growth is over multiple levels, limit change to maximum of one level per cycle through loop. 20 !! (7) Change lower limits for loops that calculate OSBL averages from 1 to 2. Large gradients between levels 1 and 2 can cause problems. 21 !! (8) Change upper limits from ibld-1 to ibld. 22 !! (9) Calculation of pycnocline thickness in unstable conditions. Check added to ensure that buoyancy jump is positive before calculating Ri. 23 !! (10) Thickness of interface layer at base of the stable OSBL set by Richardson number. Gives continuity in transition from unstable OSBL. 24 !! (11) Checks that buoyancy jump is poitive when calculating pycnocline profiles. 25 !! (12) Replace zwstrl with zvstr in calculation of eddy viscosity. 26 !! 27/09/2017 (13) Calculate Stokes drift and Stokes penetration depth from wave information 27 !! (14) Buoyancy flux due to entrainment changed to include contribution from shear turbulence. 28 !! 28/09/2017 (15) Calculation of Stokes drift moved into separate do-loops to allow for different options for the determining the Stokes drift to be added. 29 !! (16) Calculation of Stokes drift from windspeed for PM spectrum (for testing, commented out) 30 !! (17) Modification to Langmuir velocity scale to include effects due to the Stokes penetration depth (for testing, commented out) 31 !! ??/??/2018 (18) Revision to code structure, selected using key_osmldpth1. Inline code moved into subroutines. Changes to physics made, 32 !! (a) Pycnocline temperature and salinity profies changed for unstable layers 33 !! (b) The stable OSBL depth parametrization changed. 34 !! 16/05/2019 (19) Fox-Kemper parametrization of restratification through mixed layer eddies added to revised code. 35 !! 23/05/19 (20) Old code where key_osmldpth1` is *not* set removed, together with the key key_osmldpth1 36 !!---------------------------------------------------------------------- 37 38 !!---------------------------------------------------------------------- 39 !! 'ln_zdfosm' OSMOSIS scheme 40 !!---------------------------------------------------------------------- 41 !! zdf_osm : update momentum and tracer Kz from osm scheme 42 !! zdf_osm_init : initialization, namelist read, and parameters control 43 !! osm_rst : read (or initialize) and write osmosis restart fields 44 !! tra_osm : compute and add to the T & S trend the non-local flux 45 !! trc_osm : compute and add to the passive tracer trend the non-local flux (TBD) 46 !! dyn_osm : compute and add to u & v trensd the non-local flux 47 !! 48 !! Subroutines in revised code. 49 !!---------------------------------------------------------------------- 50 USE oce ! ocean dynamics and active tracers 51 ! uses wn from previous time step (which is now wb) to calculate hbl 52 USE dom_oce ! ocean space and time domain 53 USE zdf_oce ! ocean vertical physics 54 USE sbc_oce ! surface boundary condition: ocean 55 USE sbcwave ! surface wave parameters 56 USE phycst ! physical constants 57 USE eosbn2 ! equation of state 58 USE traqsr ! details of solar radiation absorption 59 USE zdfddm ! double diffusion mixing (avs array) 60 ! USE zdfmxl ! mixed layer depth 61 USE iom ! I/O library 62 USE lib_mpp ! MPP library 63 USE trd_oce ! ocean trends definition 64 USE trdtra ! tracers trends 65 ! 66 USE in_out_manager ! I/O manager 67 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 68 USE prtctl ! Print control 69 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 70 71 IMPLICIT NONE 72 PRIVATE 73 74 PUBLIC zdf_osm ! routine called by step.F90 75 PUBLIC zdf_osm_init ! routine called by nemogcm.F90 76 PUBLIC osm_rst ! routine called by step.F90 77 PUBLIC tra_osm ! routine called by step.F90 78 PUBLIC trc_osm ! routine called by trcstp.F90 79 PUBLIC dyn_osm ! routine called by step.F90 80 81 PUBLIC ln_osm_mle ! logical needed by tra_mle_init in tramle.F90 82 83 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ghamu !: non-local u-momentum flux 84 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ghamv !: non-local v-momentum flux 85 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ghamt !: non-local temperature flux (gamma/<ws>o) 86 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ghams !: non-local salinity flux (gamma/<ws>o) 87 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: etmean !: averaging operator for avt 88 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hbl !: boundary layer depth 89 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: dh ! depth of pycnocline 90 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hml ! ML depth 91 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: dstokes !: penetration depth of the Stokes drift. 92 93 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: r1_ft ! inverse of the modified Coriolis parameter at t-pts 94 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hmle ! Depth of layer affexted by mixed layer eddies in Fox-Kemper parametrization 95 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: dbdx_mle ! zonal buoyancy gradient in ML 96 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: dbdy_mle ! meridional buoyancy gradient in ML 97 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mld_prof ! level of base of MLE layer. 98 99 ! !!** Namelist namzdf_osm ** 100 LOGICAL :: ln_use_osm_la ! Use namelist rn_osm_la 101 102 LOGICAL :: ln_osm_mle !: flag to activate the Mixed Layer Eddy (MLE) parameterisation 103 104 REAL(wp) :: rn_osm_la ! Turbulent Langmuir number 105 REAL(wp) :: rn_osm_dstokes ! Depth scale of Stokes drift 106 REAL(wp) :: rn_zdfosm_adjust_sd = 1.0 ! factor to reduce Stokes drift by 107 REAL(wp) :: rn_osm_hblfrac = 0.1! for nn_osm_wave = 3/4 specify fraction in top of hbl 108 LOGICAL :: ln_zdfosm_ice_shelter ! flag to activate ice sheltering 109 REAL(wp) :: rn_osm_hbl0 = 10._wp ! Initial value of hbl for 1D runs 110 INTEGER :: nn_ave ! = 0/1 flag for horizontal average on avt 111 INTEGER :: nn_osm_wave = 0 ! = 0/1/2 flag for getting stokes drift from La# / PM wind-waves/Inputs into sbcwave 112 INTEGER :: nn_osm_SD_reduce ! = 0/1/2 flag for getting effective stokes drift from surface value 113 LOGICAL :: ln_dia_osm ! Use namelist rn_osm_la 114 115 LOGICAL :: ln_kpprimix = .true. ! Shear instability mixing 116 REAL(wp) :: rn_riinfty = 0.7 ! local Richardson Number limit for shear instability 117 REAL(wp) :: rn_difri = 0.005 ! maximum shear mixing at Rig = 0 (m2/s) 118 LOGICAL :: ln_convmix = .true. ! Convective instability mixing 119 REAL(wp) :: rn_difconv = 1._wp ! diffusivity when unstable below BL (m2/s) 120 121 ! OSMOSIS mixed layer eddy parametrization constants 122 INTEGER :: nn_osm_mle ! = 0/1 flag for horizontal average on avt 123 REAL(wp) :: rn_osm_mle_ce ! MLE coefficient 124 ! ! parameters used in nn_osm_mle = 0 case 125 REAL(wp) :: rn_osm_mle_lf ! typical scale of mixed layer front 126 REAL(wp) :: rn_osm_mle_time ! time scale for mixing momentum across the mixed layer 127 ! ! parameters used in nn_osm_mle = 1 case 128 REAL(wp) :: rn_osm_mle_lat ! reference latitude for a 5 km scale of ML front 129 LOGICAL :: ln_osm_hmle_limit ! If true arbitrarily restrict hmle to rn_osm_hmle_limit*zmld 130 REAL(wp) :: rn_osm_hmle_limit ! If ln_osm_hmle_limit true arbitrarily restrict hmle to rn_osm_hmle_limit*zmld 131 REAL(wp) :: rn_osm_mle_rho_c ! Density criterion for definition of MLD used by FK 132 REAL(wp) :: r5_21 = 5.e0 / 21.e0 ! factor used in mle streamfunction computation 133 REAL(wp) :: rb_c ! ML buoyancy criteria = g rho_c /rau0 where rho_c is defined in zdfmld 134 REAL(wp) :: rc_f ! MLE coefficient (= rn_ce / (5 km * fo) ) in nn_osm_mle=1 case 135 REAL(wp) :: rn_osm_mle_thresh ! Threshold buoyancy for deepening of MLE layer below OSBL base. 136 REAL(wp) :: rn_osm_bl_thresh ! Threshold buoyancy for deepening of OSBL base. 137 REAL(wp) :: rn_osm_mle_tau ! Adjustment timescale for MLE. 138 139 140 ! !!! ** General constants ** 141 REAL(wp) :: epsln = 1.0e-20_wp ! a small positive number to ensure no div by zero 142 REAL(wp) :: depth_tol = 1.0e-6_wp ! a small-ish positive number to give a hbl slightly shallower than gdepw 143 REAL(wp) :: pthird = 1._wp/3._wp ! 1/3 144 REAL(wp) :: p2third = 2._wp/3._wp ! 2/3 145 146 INTEGER :: idebug = 236 147 INTEGER :: jdebug = 228 148 !!---------------------------------------------------------------------- 149 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 150 !! $Id: zdfosm.F90 12317 2020-01-14 12:40:47Z agn $ 151 !! Software governed by the CeCILL license (see ./LICENSE) 152 !!---------------------------------------------------------------------- 2 !!====================================================================== 3 !! *** MODULE zdfosm *** 4 !! Ocean physics: vertical mixing coefficient compute from the OSMOSIS 5 !! turbulent closure parameterization 6 !!===================================================================== 7 !! History : NEMO 4.0 ! A. Grant, G. Nurser 8 !! 15/03/2017 Changed calculation of pycnocline thickness in unstable conditions and stable conditions AG 9 !! 15/03/2017 Calculation of pycnocline gradients for stable conditions changed. Pycnocline gradients now depend on stability of the OSBL. A.G 10 !! 06/06/2017 (1) Checks on sign of buoyancy jump in calculation of OSBL depth. A.G. 11 !! (2) Removed variable zbrad0, zbradh and zbradav since they are not used. 12 !! (3) Approximate treatment for shear turbulence. 13 !! Minimum values for zustar and zustke. 14 !! Add velocity scale, zvstr, that tends to zustar for large Langmuir numbers. 15 !! Limit maximum value for Langmuir number. 16 !! Use zvstr in definition of stability parameter zhol. 17 !! (4) Modified parametrization of entrainment flux, changing original coefficient 0.0485 for Langmuir contribution to 0.135 * zla 18 !! (5) For stable boundary layer add factor that depends on length of timestep to 'slow' collapse and growth. Make sure buoyancy jump not negative. 19 !! (6) For unstable conditions when growth is over multiple levels, limit change to maximum of one level per cycle through loop. 20 !! (7) Change lower limits for loops that calculate OSBL averages from 1 to 2. Large gradients between levels 1 and 2 can cause problems. 21 !! (8) Change upper limits from ibld-1 to ibld. 22 !! (9) Calculation of pycnocline thickness in unstable conditions. Check added to ensure that buoyancy jump is positive before calculating Ri. 23 !! (10) Thickness of interface layer at base of the stable OSBL set by Richardson number. Gives continuity in transition from unstable OSBL. 24 !! (11) Checks that buoyancy jump is poitive when calculating pycnocline profiles. 25 !! (12) Replace zwstrl with zvstr in calculation of eddy viscosity. 26 !! 27/09/2017 (13) Calculate Stokes drift and Stokes penetration depth from wave information 27 !! (14) Buoyancy flux due to entrainment changed to include contribution from shear turbulence. 28 !! 28/09/2017 (15) Calculation of Stokes drift moved into separate do-loops to allow for different options for the determining the Stokes drift to be added. 29 !! (16) Calculation of Stokes drift from windspeed for PM spectrum (for testing, commented out) 30 !! (17) Modification to Langmuir velocity scale to include effects due to the Stokes penetration depth (for testing, commented out) 31 !! ??/??/2018 (18) Revision to code structure, selected using key_osmldpth1. Inline code moved into subroutines. Changes to physics made, 32 !! (a) Pycnocline temperature and salinity profies changed for unstable layers 33 !! (b) The stable OSBL depth parametrization changed. 34 !! 16/05/2019 (19) Fox-Kemper parametrization of restratification through mixed layer eddies added to revised code. 35 !! 23/05/19 (20) Old code where key_osmldpth1` is *not* set removed, together with the key key_osmldpth1 36 !!---------------------------------------------------------------------- 37 38 !!---------------------------------------------------------------------- 39 !! 'ln_zdfosm' OSMOSIS scheme 40 !!---------------------------------------------------------------------- 41 !! zdf_osm : update momentum and tracer Kz from osm scheme 42 !! zdf_osm_init : initialization, namelist read, and parameters control 43 !! osm_rst : read (or initialize) and write osmosis restart fields 44 !! tra_osm : compute and add to the T & S trend the non-local flux 45 !! trc_osm : compute and add to the passive tracer trend the non-local flux (TBD) 46 !! dyn_osm : compute and add to u & v trensd the non-local flux 47 !! 48 !! Subroutines in revised code. 49 !!---------------------------------------------------------------------- 50 USE oce ! ocean dynamics and active tracers 51 ! uses wn from previous time step (which is now wb) to calculate hbl 52 USE dom_oce ! ocean space and time domain 53 USE zdf_oce ! ocean vertical physics 54 USE sbc_oce ! surface boundary condition: ocean 55 USE sbcwave ! surface wave parameters 56 USE phycst ! physical constants 57 USE eosbn2 ! equation of state 58 USE traqsr ! details of solar radiation absorption 59 USE zdfddm ! double diffusion mixing (avs array) 60 ! USE zdfmxl ! mixed layer depth 61 USE iom ! I/O library 62 USE lib_mpp ! MPP library 63 USE trd_oce ! ocean trends definition 64 USE trdtra ! tracers trends 65 ! 66 USE in_out_manager ! I/O manager 67 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 68 USE prtctl ! Print control 69 USE lib_fortran ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 70 71 IMPLICIT NONE 72 PRIVATE 73 74 PUBLIC zdf_osm ! routine called by step.F90 75 PUBLIC zdf_osm_init ! routine called by nemogcm.F90 76 PUBLIC osm_rst ! routine called by step.F90 77 PUBLIC tra_osm ! routine called by step.F90 78 PUBLIC trc_osm ! routine called by trcstp.F90 79 PUBLIC dyn_osm ! routine called by step.F90 80 81 PUBLIC ln_osm_mle ! logical needed by tra_mle_init in tramle.F90 82 83 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ghamu !: non-local u-momentum flux 84 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ghamv !: non-local v-momentum flux 85 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ghamt !: non-local temperature flux (gamma/<ws>o) 86 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: ghams !: non-local salinity flux (gamma/<ws>o) 87 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) :: etmean !: averaging operator for avt 88 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hbl !: boundary layer depth 89 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: dh ! depth of pycnocline 90 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hml ! ML depth 91 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: dstokes !: penetration depth of the Stokes drift. 92 93 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: r1_ft ! inverse of the modified Coriolis parameter at t-pts 94 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: hmle ! Depth of layer affexted by mixed layer eddies in Fox-Kemper parametrization 95 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: dbdx_mle ! zonal buoyancy gradient in ML 96 REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: dbdy_mle ! meridional buoyancy gradient in ML 97 INTEGER, PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mld_prof ! level of base of MLE layer. 98 99 ! !!** Namelist namzdf_osm ** 100 LOGICAL :: ln_use_osm_la ! Use namelist rn_osm_la 101 102 LOGICAL :: ln_osm_mle !: flag to activate the Mixed Layer Eddy (MLE) parameterisation 103 104 REAL(wp) :: rn_osm_la ! Turbulent Langmuir number 105 REAL(wp) :: rn_osm_dstokes ! Depth scale of Stokes drift 106 REAL(wp) :: rn_zdfosm_adjust_sd = 1.0 ! factor to reduce Stokes drift by 107 REAL(wp) :: rn_osm_hblfrac = 0.1! for nn_osm_wave = 3/4 specify fraction in top of hbl 108 LOGICAL :: ln_zdfosm_ice_shelter ! flag to activate ice sheltering 109 REAL(wp) :: rn_osm_hbl0 = 10._wp ! Initial value of hbl for 1D runs 110 INTEGER :: nn_ave ! = 0/1 flag for horizontal average on avt 111 INTEGER :: nn_osm_wave = 0 ! = 0/1/2 flag for getting stokes drift from La# / PM wind-waves/Inputs into sbcwave 112 INTEGER :: nn_osm_SD_reduce ! = 0/1/2 flag for getting effective stokes drift from surface value 113 LOGICAL :: ln_dia_osm ! Use namelist rn_osm_la 114 115 LOGICAL :: ln_kpprimix = .true. ! Shear instability mixing 116 REAL(wp) :: rn_riinfty = 0.7 ! local Richardson Number limit for shear instability 117 REAL(wp) :: rn_difri = 0.005 ! maximum shear mixing at Rig = 0 (m2/s) 118 LOGICAL :: ln_convmix = .true. ! Convective instability mixing 119 REAL(wp) :: rn_difconv = 1._wp ! diffusivity when unstable below BL (m2/s) 120 121 #ifdef key_osm_debug 122 INTEGER :: nn_idb = 297, nn_jdb = 193, nn_kdb = 35, nn_narea_db = 109 123 INTEGER :: iloc_db, jloc_db 124 #endif 125 ! 126 127 ! OSMOSIS mixed layer eddy parametrization constants 128 INTEGER :: nn_osm_mle ! = 0/1 flag for horizontal average on avt 129 REAL(wp) :: rn_osm_mle_ce ! MLE coefficient 130 ! ! parameters used in nn_osm_mle = 0 case 131 REAL(wp) :: rn_osm_mle_lf ! typical scale of mixed layer front 132 REAL(wp) :: rn_osm_mle_time ! time scale for mixing momentum across the mixed layer 133 ! ! parameters used in nn_osm_mle = 1 case 134 REAL(wp) :: rn_osm_mle_lat ! reference latitude for a 5 km scale of ML front 135 LOGICAL :: ln_osm_hmle_limit ! If true arbitrarily restrict hmle to rn_osm_hmle_limit*zmld 136 REAL(wp) :: rn_osm_hmle_limit ! If ln_osm_hmle_limit true arbitrarily restrict hmle to rn_osm_hmle_limit*zmld 137 REAL(wp) :: rn_osm_mle_rho_c ! Density criterion for definition of MLD used by FK 138 REAL(wp) :: r5_21 = 5.e0 / 21.e0 ! factor used in mle streamfunction computation 139 REAL(wp) :: rb_c ! ML buoyancy criteria = g rho_c /rau0 where rho_c is defined in zdfmld 140 REAL(wp) :: rc_f ! MLE coefficient (= rn_ce / (5 km * fo) ) in nn_osm_mle=1 case 141 REAL(wp) :: rn_osm_mle_thresh ! Threshold buoyancy for deepening of MLE layer below OSBL base. 142 REAL(wp) :: rn_osm_bl_thresh ! Threshold buoyancy for deepening of OSBL base. 143 REAL(wp) :: rn_osm_mle_tau ! Adjustment timescale for MLE. 144 145 146 ! !!! ** General constants ** 147 REAL(wp) :: epsln = 1.0e-20_wp ! a small positive number to ensure no div by zero 148 REAL(wp) :: depth_tol = 1.0e-6_wp ! a small-ish positive number to give a hbl slightly shallower than gdepw 149 REAL(wp) :: pthird = 1._wp/3._wp ! 1/3 150 REAL(wp) :: p2third = 2._wp/3._wp ! 2/3 151 152 INTEGER :: idebug = 236 153 INTEGER :: jdebug = 228 154 !!---------------------------------------------------------------------- 155 !! NEMO/OCE 4.0 , NEMO Consortium (2018) 156 !! $Id: zdfosm.F90 12317 2020-01-14 12:40:47Z agn $ 157 !! Software governed by the CeCILL license (see ./LICENSE) 158 !!---------------------------------------------------------------------- 153 159 CONTAINS 154 160 155 INTEGER FUNCTION zdf_osm_alloc() 156 !!---------------------------------------------------------------------- 157 !! *** FUNCTION zdf_osm_alloc *** 158 !!---------------------------------------------------------------------- 159 ALLOCATE( ghamu(jpi,jpj,jpk), ghamv(jpi,jpj,jpk), ghamt(jpi,jpj,jpk),ghams(jpi,jpj,jpk), & 160 & hbl(jpi,jpj), dh(jpi,jpj), hml(jpi,jpj), dstokes(jpi, jpj), & 161 & etmean(jpi,jpj,jpk), STAT= zdf_osm_alloc ) 162 163 ALLOCATE( hmle(jpi,jpj), r1_ft(jpi,jpj), dbdx_mle(jpi,jpj), dbdy_mle(jpi,jpj), & 164 & mld_prof(jpi,jpj), STAT= zdf_osm_alloc ) 165 166 ! ALLOCATE( ghamu(jpi,jpj,jpk), ghamv(jpi,jpj,jpk), ghamt(jpi,jpj,jpk),ghams(jpi,jpj,jpk), & ! would ths be better ? 167 ! & hbl(jpi,jpj), dh(jpi,jpj), hml(jpi,jpj), dstokes(jpi, jpj), & 168 ! & etmean(jpi,jpj,jpk), STAT= zdf_osm_alloc ) 169 ! IF( zdf_osm_alloc /= 0 ) CALL ctl_warn('zdf_osm_alloc: failed to allocate zdf_osm arrays') 170 ! IF ( ln_osm_mle ) THEN 171 ! Allocate( hmle(jpi,jpj), r1_ft(jpi,jpj), STAT= zdf_osm_alloc ) 172 ! IF( zdf_osm_alloc /= 0 ) CALL ctl_warn('zdf_osm_alloc: failed to allocate zdf_osm mle arrays') 173 ! ENDIF 174 175 IF( zdf_osm_alloc /= 0 ) CALL ctl_warn('zdf_osm_alloc: failed to allocate zdf_osm arrays') 176 CALL mpp_sum ( 'zdfosm', zdf_osm_alloc ) 177 END FUNCTION zdf_osm_alloc 178 179 180 SUBROUTINE zdf_osm( kt, p_avm, p_avt ) 181 !!---------------------------------------------------------------------- 182 !! *** ROUTINE zdf_osm *** 183 !! 184 !! ** Purpose : Compute the vertical eddy viscosity and diffusivity 185 !! coefficients and non local mixing using the OSMOSIS scheme 186 !! 187 !! ** Method : The boundary layer depth hosm is diagnosed at tracer points 188 !! from profiles of buoyancy, and shear, and the surface forcing. 189 !! Above hbl (sigma=-z/hbl <1) the mixing coefficients are computed from 190 !! 191 !! Kx = hosm Wx(sigma) G(sigma) 192 !! 193 !! and the non local term ghamt = Cs / Ws(sigma) / hosm 194 !! Below hosm the coefficients are the sum of mixing due to internal waves 195 !! shear instability and double diffusion. 196 !! 197 !! -1- Compute the now interior vertical mixing coefficients at all depths. 198 !! -2- Diagnose the boundary layer depth. 199 !! -3- Compute the now boundary layer vertical mixing coefficients. 200 !! -4- Compute the now vertical eddy vicosity and diffusivity. 201 !! -5- Smoothing 202 !! 203 !! N.B. The computation is done from jk=2 to jpkm1 204 !! Surface value of avt are set once a time to zero 205 !! in routine zdf_osm_init. 206 !! 207 !! ** Action : update the non-local terms ghamts 208 !! update avt (before vertical eddy coef.) 209 !! 210 !! References : Large W.G., Mc Williams J.C. and Doney S.C. 211 !! Reviews of Geophysics, 32, 4, November 1994 212 !! Comments in the code refer to this paper, particularly 213 !! the equation number. (LMD94, here after) 214 !!---------------------------------------------------------------------- 215 INTEGER , INTENT(in ) :: kt ! ocean time step 216 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: p_avm, p_avt ! momentum and tracer Kz (w-points) 217 !! 218 INTEGER :: ji, jj, jk ! dummy loop indices 219 220 INTEGER :: jl ! dummy loop indices 221 222 INTEGER :: ikbot, jkmax, jkm1, jkp2 ! 223 224 REAL(wp) :: ztx, zty, zflageos, zstabl, zbuofdep,zucube ! 225 REAL(wp) :: zbeta, zthermal ! 226 REAL(wp) :: zehat, zeta, zhrib, zsig, zscale, zwst, zws, zwm ! Velocity scales 227 REAL(wp) :: zwsun, zwmun, zcons, zconm, zwcons, zwconm ! 228 229 REAL(wp) :: zsr, zbw, ze, zb, zd, zc, zaw, za, zb1, za1, zkw, zk0, zcomp , zrhd,zrhdr,zbvzed ! In situ density 230 INTEGER :: jm ! dummy loop indices 231 REAL(wp) :: zr1, zr2, zr3, zr4, zrhop ! Compression terms 232 REAL(wp) :: zflag, zrn2, zdep21, zdep32, zdep43 233 REAL(wp) :: zesh2, zri, zfri ! Interior richardson mixing 234 REAL(wp) :: zdelta, zdelta2, zdzup, zdzdn, zdzh, zvath, zgat1, zdat1, zkm1m, zkm1t 235 REAL(wp) :: zt,zs,zu,zv,zrh ! variables used in constructing averages 236 ! Scales 237 REAL(wp), DIMENSION(jpi,jpj) :: zrad0 ! Surface solar temperature flux (deg m/s) 238 REAL(wp), DIMENSION(jpi,jpj) :: zradh ! Radiative flux at bl base (Buoyancy units) 239 REAL(wp), DIMENSION(jpi,jpj) :: zradav ! Radiative flux, bl average (Buoyancy Units) 240 REAL(wp), DIMENSION(jpi,jpj) :: zustar ! friction velocity 241 REAL(wp), DIMENSION(jpi,jpj) :: zwstrl ! Langmuir velocity scale 242 REAL(wp), DIMENSION(jpi,jpj) :: zvstr ! Velocity scale that ends to zustar for large Langmuir number. 243 REAL(wp), DIMENSION(jpi,jpj) :: zwstrc ! Convective velocity scale 244 REAL(wp), DIMENSION(jpi,jpj) :: zuw0 ! Surface u-momentum flux 245 REAL(wp), DIMENSION(jpi,jpj) :: zvw0 ! Surface v-momentum flux 246 REAL(wp), DIMENSION(jpi,jpj) :: zwth0 ! Surface heat flux (Kinematic) 247 REAL(wp), DIMENSION(jpi,jpj) :: zws0 ! Surface freshwater flux 248 REAL(wp), DIMENSION(jpi,jpj) :: zwb0 ! Surface buoyancy flux 249 REAL(wp), DIMENSION(jpi,jpj) :: zwb0tot ! Total surface buoyancy flux including insolation 250 REAL(wp), DIMENSION(jpi,jpj) :: zwthav ! Heat flux - bl average 251 REAL(wp), DIMENSION(jpi,jpj) :: zwsav ! freshwater flux - bl average 252 REAL(wp), DIMENSION(jpi,jpj) :: zwbav ! Buoyancy flux - bl average 253 REAL(wp), DIMENSION(jpi,jpj) :: zwb_ent ! Buoyancy entrainment flux 254 REAL(wp), DIMENSION(jpi,jpj) :: zwb_min 255 256 257 REAL(wp), DIMENSION(jpi,jpj) :: zwb_fk_b ! MLE buoyancy flux averaged over OSBL 258 REAL(wp), DIMENSION(jpi,jpj) :: zwb_fk ! max MLE buoyancy flux 259 REAL(wp), DIMENSION(jpi,jpj) :: zdiff_mle ! extra MLE vertical diff 260 REAL(wp), DIMENSION(jpi,jpj) :: zvel_mle ! velocity scale for dhdt with stable ML and FK 261 262 REAL(wp), DIMENSION(jpi,jpj) :: zustke ! Surface Stokes drift 263 REAL(wp), DIMENSION(jpi,jpj) :: zla ! Trubulent Langmuir number 264 REAL(wp), DIMENSION(jpi,jpj) :: zcos_wind ! Cos angle of surface stress 265 REAL(wp), DIMENSION(jpi,jpj) :: zsin_wind ! Sin angle of surface stress 266 REAL(wp), DIMENSION(jpi,jpj) :: zhol ! Stability parameter for boundary layer 267 LOGICAL, DIMENSION(jpi,jpj) :: lconv ! unstable/stable bl 268 LOGICAL, DIMENSION(jpi,jpj) :: lshear ! Shear layers 269 LOGICAL, DIMENSION(jpi,jpj) :: lpyc ! OSBL pycnocline present 270 LOGICAL, DIMENSION(jpi,jpj) :: lflux ! surface flux extends below OSBL into MLE layer. 271 LOGICAL, DIMENSION(jpi,jpj) :: lmle ! MLE layer increases in hickness. 272 273 ! mixed-layer variables 274 275 INTEGER, DIMENSION(jpi,jpj) :: ibld ! level of boundary layer base 276 INTEGER, DIMENSION(jpi,jpj) :: imld ! level of mixed-layer depth (pycnocline top) 277 INTEGER, DIMENSION(jpi,jpj) :: jp_ext, jp_ext_mle ! offset for external level 278 INTEGER, DIMENSION(jpi, jpj) :: j_ddh ! Type of shear layer 279 280 REAL(wp) :: ztgrad,zsgrad,zbgrad ! Temporary variables used to calculate pycnocline gradients 281 REAL(wp) :: zugrad,zvgrad ! temporary variables for calculating pycnocline shear 282 283 REAL(wp), DIMENSION(jpi,jpj) :: zhbl ! bl depth - grid 284 REAL(wp), DIMENSION(jpi,jpj) :: zhml ! ml depth - grid 285 286 REAL(wp), DIMENSION(jpi,jpj) :: zhmle ! MLE depth - grid 287 REAL(wp), DIMENSION(jpi,jpj) :: zmld ! ML depth on grid 288 289 REAL(wp), DIMENSION(jpi,jpj) :: zdh ! pycnocline depth - grid 290 REAL(wp), DIMENSION(jpi,jpj) :: zdhdt ! BL depth tendency 291 REAL(wp), DIMENSION(jpi,jpj) :: zdtdz_bl_ext,zdsdz_bl_ext,zdbdz_bl_ext ! external temperature/salinity and buoyancy gradients 292 REAL(wp), DIMENSION(jpi,jpj) :: zdtdz_mle_ext,zdsdz_mle_ext,zdbdz_mle_ext ! external temperature/salinity and buoyancy gradients 293 REAL(wp), DIMENSION(jpi,jpj) :: zdtdx, zdtdy, zdsdx, zdsdy ! horizontal gradients for Fox-Kemper parametrization. 294 295 REAL(wp), DIMENSION(jpi,jpj) :: zt_bl,zs_bl,zu_bl,zv_bl,zb_bl ! averages over the depth of the blayer 296 REAL(wp), DIMENSION(jpi,jpj) :: zt_ml,zs_ml,zu_ml,zv_ml,zb_ml ! averages over the depth of the mixed layer 297 REAL(wp), DIMENSION(jpi,jpj) :: zt_mle,zs_mle,zu_mle,zv_mle,zb_mle ! averages over the depth of the MLE layer 298 REAL(wp), DIMENSION(jpi,jpj) :: zdt_bl,zds_bl,zdu_bl,zdv_bl,zdb_bl ! difference between blayer average and parameter at base of blayer 299 REAL(wp), DIMENSION(jpi,jpj) :: zdt_ml,zds_ml,zdu_ml,zdv_ml,zdb_ml ! difference between mixed layer average and parameter at base of blayer 300 REAL(wp), DIMENSION(jpi,jpj) :: zdt_mle,zds_mle,zdu_mle,zdv_mle,zdb_mle ! difference between MLE layer average and parameter at base of blayer 301 ! REAL(wp), DIMENSION(jpi,jpj) :: zwth_ent,zws_ent ! heat and salinity fluxes at the top of the pycnocline 302 REAL(wp) :: zwth_ent,zws_ent ! heat and salinity fluxes at the top of the pycnocline 303 REAL(wp) :: zuw_bse,zvw_bse ! momentum fluxes at the top of the pycnocline 304 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdtdz_pyc ! parametrized gradient of temperature in pycnocline 305 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdsdz_pyc ! parametrised gradient of salinity in pycnocline 306 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdbdz_pyc ! parametrised gradient of buoyancy in the pycnocline 307 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdudz_pyc ! u-shear across the pycnocline 308 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdvdz_pyc ! v-shear across the pycnocline 309 REAL(wp), DIMENSION(jpi,jpj) :: zdbds_mle ! Magnitude of horizontal buoyancy gradient. 310 ! Flux-gradient relationship variables 311 REAL(wp), DIMENSION(jpi, jpj) :: zshear ! Shear production. 312 313 REAL(wp) :: zl_c,zl_l,zl_eps ! Used to calculate turbulence length scale. 314 315 REAL(wp) :: za_cubic, zb_cubic, zc_cubic, zd_cubic ! coefficients in cubic polynomial specifying diffusivity in pycnocline. 316 REAL(wp), DIMENSION(jpi,jpj) :: zsc_wth_1,zsc_ws_1 ! Temporary scales used to calculate scalar non-gradient terms. 317 REAL(wp), DIMENSION(jpi,jpj) :: zsc_wth_pyc, zsc_ws_pyc ! Scales for pycnocline transport term/ 318 REAL(wp), DIMENSION(jpi,jpj) :: zsc_uw_1,zsc_uw_2,zsc_vw_1,zsc_vw_2 ! Temporary scales for non-gradient momentum flux terms. 319 REAL(wp), DIMENSION(jpi,jpj) :: zhbl_t ! holds boundary layer depth updated by full timestep 320 321 ! For calculating Ri#-dependent mixing 322 REAL(wp), DIMENSION(jpi,jpj,jpk) :: z3du ! u-shear^2 323 REAL(wp), DIMENSION(jpi,jpj,jpk) :: z3dv ! v-shear^2 324 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zrimix ! spatial form of ri#-induced diffusion 325 326 ! Temporary variables 327 INTEGER :: inhml 328 REAL(wp) :: znd,znd_d,zznd_ml,zznd_pyc,zznd_d ! temporary non-dimensional depths used in various routines 329 REAL(wp) :: ztemp, zari, zpert, zzdhdt, zdb ! temporary variables 330 REAL(wp) :: zthick, zz0, zz1 ! temporary variables 331 REAL(wp) :: zvel_max, zhbl_s ! temporary variables 332 REAL(wp) :: zfac, ztmp ! temporary variable 333 REAL(wp) :: zus_x, zus_y ! temporary Stokes drift 334 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zviscos ! viscosity 335 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdiffut ! t-diffusivity 336 REAL(wp), DIMENSION(jpi,jpj) :: zalpha_pyc 337 REAL(wp), DIMENSION(jpi,jpj) :: ztau_sc_u ! dissipation timescale at baes of WML. 338 REAL(wp) :: zdelta_pyc, zwt_pyc_sc_1, zws_pyc_sc_1, zzeta_pyc 339 REAL(wp) :: zbuoy_pyc_sc, zomega, zvw_max 340 INTEGER :: ibld_ext=0 ! does not have to be zero for modified scheme 341 REAL(wp) :: zgamma_b_nd, zgamma_b, zdhoh, ztau 342 REAL(wp) :: zzeta_s = 0._wp 343 REAL(wp) :: zzeta_v = 0.46 344 REAL(wp) :: zabsstke 345 REAL(wp) :: zsqrtpi, z_two_thirds, zproportion, ztransp, zthickness 346 REAL(wp) :: z2k_times_thickness, zsqrt_depth, zexp_depth, zdstokes0, zf, zexperfc 347 348 ! For debugging 349 INTEGER :: ikt 350 !!-------------------------------------------------------------------- 351 ! 352 ibld(:,:) = 0 ; imld(:,:) = 0 353 zrad0(:,:) = 0._wp ; zradh(:,:) = 0._wp ; zradav(:,:) = 0._wp ; zustar(:,:) = 0._wp 354 zwstrl(:,:) = 0._wp ; zvstr(:,:) = 0._wp ; zwstrc(:,:) = 0._wp ; zuw0(:,:) = 0._wp 355 zvw0(:,:) = 0._wp ; zwth0(:,:) = 0._wp ; zws0(:,:) = 0._wp ; zwb0(:,:) = 0._wp 356 zwthav(:,:) = 0._wp ; zwsav(:,:) = 0._wp ; zwbav(:,:) = 0._wp ; zwb_ent(:,:) = 0._wp 357 zustke(:,:) = 0._wp ; zla(:,:) = 0._wp ; zcos_wind(:,:) = 0._wp ; zsin_wind(:,:) = 0._wp 358 zhol(:,:) = 0._wp ; zwb0tot(:,:) = 0._wp 359 lconv(:,:) = .FALSE.; lpyc(:,:) = .FALSE. ; lflux(:,:) = .FALSE. ; lmle(:,:) = .FALSE. 360 ! mixed layer 361 ! no initialization of zhbl or zhml (or zdh?) 362 zhbl(:,:) = 1._wp ; zhml(:,:) = 1._wp ; zdh(:,:) = 1._wp ; zdhdt(:,:) = 0._wp 363 zt_bl(:,:) = 0._wp ; zs_bl(:,:) = 0._wp ; zu_bl(:,:) = 0._wp 364 zv_bl(:,:) = 0._wp ; zb_bl(:,:) = 0._wp 365 zt_ml(:,:) = 0._wp ; zs_ml(:,:) = 0._wp ; zu_ml(:,:) = 0._wp 366 zt_mle(:,:) = 0._wp ; zs_mle(:,:) = 0._wp ; zu_mle(:,:) = 0._wp 367 zb_mle(:,:) = 0._wp 368 zv_ml(:,:) = 0._wp ; zdt_bl(:,:) = 0._wp ; zds_bl(:,:) = 0._wp 369 zdu_bl(:,:) = 0._wp ; zdv_bl(:,:) = 0._wp ; zdb_bl(:,:) = 0._wp 370 zdt_ml(:,:) = 0._wp ; zds_ml(:,:) = 0._wp ; zdu_ml(:,:) = 0._wp ; zdv_ml(:,:) = 0._wp 371 zdb_ml(:,:) = 0._wp 372 zdt_mle(:,:) = 0._wp ; zds_mle(:,:) = 0._wp ; zdu_mle(:,:) = 0._wp 373 zdv_mle(:,:) = 0._wp ; zdb_mle(:,:) = 0._wp 374 zwth_ent = 0._wp ; zws_ent = 0._wp 375 ! 376 zdtdz_pyc(:,:,:) = 0._wp ; zdsdz_pyc(:,:,:) = 0._wp ; zdbdz_pyc(:,:,:) = 0._wp 377 zdudz_pyc(:,:,:) = 0._wp ; zdvdz_pyc(:,:,:) = 0._wp 378 ! 379 zdtdz_bl_ext(:,:) = 0._wp ; zdsdz_bl_ext(:,:) = 0._wp ; zdbdz_bl_ext(:,:) = 0._wp 380 381 IF ( ln_osm_mle ) THEN ! only initialise arrays if needed 382 zdtdx(:,:) = 0._wp ; zdtdy(:,:) = 0._wp ; zdsdx(:,:) = 0._wp 383 zdsdy(:,:) = 0._wp ; dbdx_mle(:,:) = 0._wp ; dbdy_mle(:,:) = 0._wp 384 zwb_fk(:,:) = 0._wp ; zvel_mle(:,:) = 0._wp; zdiff_mle(:,:) = 0._wp 385 zhmle(:,:) = 0._wp ; zmld(:,:) = 0._wp 386 ENDIF 387 zwb_fk_b(:,:) = 0._wp ! must be initialised even with ln_osm_mle=F as used in zdf_osm_calculate_dhdt 388 389 ! Flux-Gradient arrays. 390 zsc_wth_1(:,:) = 0._wp ; zsc_ws_1(:,:) = 0._wp ; zsc_uw_1(:,:) = 0._wp 391 zsc_uw_2(:,:) = 0._wp ; zsc_vw_1(:,:) = 0._wp ; zsc_vw_2(:,:) = 0._wp 392 zhbl_t(:,:) = 0._wp ; zdhdt(:,:) = 0._wp 393 394 zdiffut(:,:,:) = 0._wp ; zviscos(:,:,:) = 0._wp ; ghamt(:,:,:) = 0._wp 395 ghams(:,:,:) = 0._wp ; ghamu(:,:,:) = 0._wp ; ghamv(:,:,:) = 0._wp 396 397 ! hbl = MAX(hbl,epsln) 398 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 399 ! Calculate boundary layer scales 400 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 401 402 ! Assume two-band radiation model for depth of OSBL 403 zz0 = rn_abs ! surface equi-partition in 2-bands 404 zz1 = 1. - rn_abs 405 DO jj = 2, jpjm1 406 DO ji = 2, jpim1 407 ! Surface downward irradiance (so always +ve) 408 zrad0(ji,jj) = qsr(ji,jj) * r1_rau0_rcp 409 ! Downwards irradiance at base of boundary layer 410 zradh(ji,jj) = zrad0(ji,jj) * ( zz0 * EXP( -hbl(ji,jj)/rn_si0 ) + zz1 * EXP( -hbl(ji,jj)/rn_si1) ) 411 ! Downwards irradiance averaged over depth of the OSBL 412 zradav(ji,jj) = zrad0(ji,jj) * ( zz0 * ( 1.0 - EXP( -hbl(ji,jj)/rn_si0 ) )*rn_si0 & 413 & + zz1 * ( 1.0 - EXP( -hbl(ji,jj)/rn_si1 ) )*rn_si1 ) / hbl(ji,jj) 414 END DO 415 END DO 416 ! Turbulent surface fluxes and fluxes averaged over depth of the OSBL 417 DO jj = 2, jpjm1 418 DO ji = 2, jpim1 419 zthermal = rab_n(ji,jj,1,jp_tem) 420 zbeta = rab_n(ji,jj,1,jp_sal) 421 ! Upwards surface Temperature flux for non-local term 422 zwth0(ji,jj) = - qns(ji,jj) * r1_rau0_rcp * tmask(ji,jj,1) 423 ! Upwards surface salinity flux for non-local term 424 zws0(ji,jj) = - ( ( emp(ji,jj)-rnf(ji,jj) ) * tsn(ji,jj,1,jp_sal) + sfx(ji,jj) ) * r1_rau0 * tmask(ji,jj,1) 425 ! Non radiative upwards surface buoyancy flux 426 zwb0(ji,jj) = grav * zthermal * zwth0(ji,jj) - grav * zbeta * zws0(ji,jj) 427 ! Total upwards surface buoyancy flux 428 zwb0tot(ji,jj) = zwb0(ji,jj) - grav * zthermal * zrad0(ji,jj) 429 ! turbulent heat flux averaged over depth of OSBL 430 zwthav(ji,jj) = 0.5 * zwth0(ji,jj) - ( 0.5*( zrad0(ji,jj) + zradh(ji,jj) ) - zradav(ji,jj) ) 431 ! turbulent salinity flux averaged over depth of the OBSL 432 zwsav(ji,jj) = 0.5 * zws0(ji,jj) 433 ! turbulent buoyancy flux averaged over the depth of the OBSBL 434 zwbav(ji,jj) = grav * zthermal * zwthav(ji,jj) - grav * zbeta * zwsav(ji,jj) 435 ! Surface upward velocity fluxes 436 zuw0(ji,jj) = - 0.5 * (utau(ji-1,jj) + utau(ji,jj)) * r1_rau0 * tmask(ji,jj,1) 437 zvw0(ji,jj) = - 0.5 * (vtau(ji,jj-1) + vtau(ji,jj)) * r1_rau0 * tmask(ji,jj,1) 438 ! Friction velocity (zustar), at T-point : LMD94 eq. 2 439 zustar(ji,jj) = MAX( SQRT( SQRT( zuw0(ji,jj) * zuw0(ji,jj) + zvw0(ji,jj) * zvw0(ji,jj) ) ), 1.0e-8 ) 440 zcos_wind(ji,jj) = -zuw0(ji,jj) / ( zustar(ji,jj) * zustar(ji,jj) ) 441 zsin_wind(ji,jj) = -zvw0(ji,jj) / ( zustar(ji,jj) * zustar(ji,jj) ) 442 END DO 443 END DO 444 ! Calculate Stokes drift in direction of wind (zustke) and Stokes penetration depth (dstokes) 445 SELECT CASE (nn_osm_wave) 446 ! Assume constant La#=0.3 447 CASE(0) 448 DO jj = 2, jpjm1 449 DO ji = 2, jpim1 450 zus_x = zcos_wind(ji,jj) * zustar(ji,jj) / 0.3**2 451 zus_y = zsin_wind(ji,jj) * zustar(ji,jj) / 0.3**2 452 ! Linearly 453 zustke(ji,jj) = MAX ( SQRT( zus_x*zus_x + zus_y*zus_y), 1.0e-8 ) 454 dstokes(ji,jj) = rn_osm_dstokes 455 END DO 456 END DO 457 ! Assume Pierson-Moskovitz wind-wave spectrum 458 CASE(1) 459 DO jj = 2, jpjm1 460 DO ji = 2, jpim1 461 ! Use wind speed wndm included in sbc_oce module 462 zustke(ji,jj) = MAX ( 0.016 * wndm(ji,jj), 1.0e-8 ) 463 dstokes(ji,jj) = MAX ( 0.12 * wndm(ji,jj)**2 / grav, 5.e-1) 464 END DO 465 END DO 466 ! Use ECMWF wave fields as output from SBCWAVE 467 CASE(2) 468 zfac = 2.0_wp * rpi / 16.0_wp 469 470 DO jj = 2, jpjm1 471 DO ji = 2, jpim1 472 IF (hsw(ji,jj) > 1.e-4) THEN 473 ! Use wave fields 474 zabsstke = SQRT(ut0sd(ji,jj)**2 + vt0sd(ji,jj)**2) 475 zustke(ji,jj) = MAX ( ( zcos_wind(ji,jj) * ut0sd(ji,jj) + zsin_wind(ji,jj) * vt0sd(ji,jj) ), 1.0e-8) 476 dstokes(ji,jj) = MAX (zfac * hsw(ji,jj)*hsw(ji,jj) / ( MAX(zabsstke * wmp(ji,jj), 1.0e-7 ) ), 5.0e-1) 477 ELSE 478 ! Assume masking issue (e.g. ice in ECMWF reanalysis but not in model run) 479 ! .. so default to Pierson-Moskowitz 480 zustke(ji,jj) = MAX ( 0.016 * wndm(ji,jj), 1.0e-8 ) 481 dstokes(ji,jj) = MAX ( 0.12 * wndm(ji,jj)**2 / grav, 5.e-1) 482 END IF 483 END DO 484 END DO 485 END SELECT 486 487 IF (ln_zdfosm_ice_shelter) THEN 488 ! Reduce both Stokes drift and its depth scale by ocean fraction to represent sheltering by ice 489 DO jj = 2, jpjm1 490 DO ji = 2, jpim1 491 zustke(ji,jj) = zustke(ji,jj) * (1.0_wp - fr_i(ji,jj)) 492 dstokes(ji,jj) = dstokes(ji,jj) * (1.0_wp - fr_i(ji,jj)) 493 END DO 494 END DO 495 END IF 496 497 SELECT CASE (nn_osm_SD_reduce) 498 ! Reduce surface Stokes drift by a constant factor or following Breivik (2016) + van Roekel (2012) or Grant (2020). 499 CASE(0) 500 ! The Langmur number from the ECMWF model (or from PM) appears to give La<0.3 for wind-driven seas. 501 ! The coefficient rn_zdfosm_adjust_sd = 0.8 gives La=0.3 in this situation. 502 ! It could represent the effects of the spread of wave directions 503 ! around the mean wind. The effect of this adjustment needs to be tested. 504 IF(nn_osm_wave > 0) THEN 505 zustke(2:jpim1,2:jpjm1) = rn_zdfosm_adjust_sd * zustke(2:jpim1,2:jpjm1) 506 END IF 507 CASE(1) 508 ! van Roekel (2012): consider average SD over top 10% of boundary layer 509 ! assumes approximate depth profile of SD from Breivik (2016) 510 zsqrtpi = SQRT(rpi) 511 z_two_thirds = 2.0_wp / 3.0_wp 512 513 DO jj = 2, jpjm1 514 DO ji = 2, jpim1 515 zthickness = rn_osm_hblfrac*hbl(ji,jj) 516 z2k_times_thickness = zthickness * 2.0_wp / MAX( ABS( 5.97_wp * dstokes(ji,jj) ), 0.0000001_wp ) 517 zsqrt_depth = SQRT(z2k_times_thickness) 518 zexp_depth = EXP(-z2k_times_thickness) 519 zustke(ji,jj) = zustke(ji,jj) * (1.0_wp - zexp_depth & 520 & - z_two_thirds * ( zsqrtpi*zsqrt_depth*z2k_times_thickness * ERFC(zsqrt_depth) & 521 & + 1.0_wp - (1.0_wp + z2k_times_thickness)*zexp_depth ) ) / z2k_times_thickness 522 523 END DO 524 END DO 525 CASE(2) 526 ! Grant (2020): Match to exponential with same SD and d/dz(Sd) at depth 10% of boundary layer 527 ! assumes approximate depth profile of SD from Breivik (2016) 528 zsqrtpi = SQRT(rpi) 529 530 DO jj = 2, jpjm1 531 DO ji = 2, jpim1 532 zthickness = rn_osm_hblfrac*hbl(ji,jj) 533 z2k_times_thickness = zthickness * 2.0_wp / MAX( ABS( 5.97_wp * dstokes(ji,jj) ), 0.0000001_wp ) 534 535 IF(z2k_times_thickness < 50._wp) THEN 536 zsqrt_depth = SQRT(z2k_times_thickness) 537 zexperfc = zsqrtpi * zsqrt_depth * ERFC(zsqrt_depth) * EXP(z2k_times_thickness) 538 ELSE 539 ! asymptotic expansion of sqrt(pi)*zsqrt_depth*EXP(z2k_times_thickness)*ERFC(zsqrt_depth) for large z2k_times_thickness 540 ! See Abramowitz and Stegun, Eq. 7.1.23 541 ! zexperfc = 1._wp - (1/2)/(z2k_times_thickness) + (3/4)/(z2k_times_thickness**2) - (15/8)/(z2k_times_thickness**3) 542 zexperfc = ((- 1.875_wp/z2k_times_thickness + 0.75_wp)/z2k_times_thickness - 0.5_wp)/z2k_times_thickness + 1.0_wp 543 END IF 544 zf = z2k_times_thickness*(1.0_wp/zexperfc - 1.0_wp) 545 dstokes(ji,jj) = 5.97 * zf * dstokes(ji,jj) 546 zustke(ji,jj) = zustke(ji,jj) * EXP(z2k_times_thickness * ( 1.0_wp / (2. * zf) - 1.0_wp )) * ( 1.0_wp - zexperfc) 547 END DO 548 END DO 549 END SELECT 550 551 ! Langmuir velocity scale (zwstrl), La # (zla) 552 ! mixed scale (zvstr), convective velocity scale (zwstrc) 553 DO jj = 2, jpjm1 554 DO ji = 2, jpim1 555 ! Langmuir velocity scale (zwstrl), at T-point 556 zwstrl(ji,jj) = ( zustar(ji,jj) * zustar(ji,jj) * zustke(ji,jj) )**pthird 557 zla(ji,jj) = MAX(MIN(SQRT ( zustar(ji,jj) / ( zwstrl(ji,jj) + epsln ) )**3, 4.0), 0.2) 558 IF(zla(ji,jj) > 0.45) dstokes(ji,jj) = MIN(dstokes(ji,jj), 0.5_wp*hbl(ji,jj)) 559 ! Velocity scale that tends to zustar for large Langmuir numbers 560 zvstr(ji,jj) = ( zwstrl(ji,jj)**3 + & 561 & ( 1.0 - EXP( -0.5 * zla(ji,jj)**2 ) ) * zustar(ji,jj) * zustar(ji,jj) * zustar(ji,jj) )**pthird 562 563 ! limit maximum value of Langmuir number as approximate treatment for shear turbulence. 564 ! Note zustke and zwstrl are not amended. 565 ! 566 ! get convective velocity (zwstrc), stabilty scale (zhol) and logical conection flag lconv 567 IF ( zwbav(ji,jj) > 0.0) THEN 568 zwstrc(ji,jj) = ( 2.0 * zwbav(ji,jj) * 0.9 * hbl(ji,jj) )**pthird 569 zhol(ji,jj) = -0.9 * hbl(ji,jj) * 2.0 * zwbav(ji,jj) / (zvstr(ji,jj)**3 + epsln ) 570 ELSE 571 zhol(ji,jj) = -hbl(ji,jj) * 2.0 * zwbav(ji,jj)/ (zvstr(ji,jj)**3 + epsln ) 572 ENDIF 573 END DO 574 END DO 575 576 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 577 ! Mixed-layer model - calculate averages over the boundary layer, and the change in the boundary layer depth 578 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 579 ! BL must be always 4 levels deep. 580 ! For calculation of lateral buoyancy gradients for FK in 581 ! zdf_osm_zmld_horizontal_gradients need halo values for ibld, so must 582 ! previously exist for hbl also. 583 584 ! agn 23/6/20: not clear all this is needed, as hbl checked after it is re-calculated anyway 585 ! ########################################################################## 586 hbl(:,:) = MAX(hbl(:,:), gdepw_n(:,:,4) ) 587 ibld(:,:) = 4 588 DO jk = 5, jpkm1 589 DO jj = 1, jpj 590 DO ji = 1, jpi 591 IF ( hbl(ji,jj) >= gdepw_n(ji,jj,jk) ) THEN 592 ibld(ji,jj) = MIN(mbkt(ji,jj), jk) 593 ENDIF 594 END DO 595 END DO 596 END DO 597 ! ########################################################################## 598 599 DO jj = 2, jpjm1 600 DO ji = 2, jpim1 601 zhbl(ji,jj) = gdepw_n(ji,jj,ibld(ji,jj)) 602 imld(ji,jj) = MAX(3,ibld(ji,jj) - MAX( INT( dh(ji,jj) / e3t_n(ji, jj, ibld(ji,jj) )) , 1 )) 603 zhml(ji,jj) = gdepw_n(ji,jj,imld(ji,jj)) 604 zdh(ji,jj) = zhbl(ji,jj) - zhml(ji,jj) 605 END DO 606 END DO 607 ! Averages over well-mixed and boundary layer 608 jp_ext(:,:) = 2 609 CALL zdf_osm_vertical_average(ibld, jp_ext, zt_bl, zs_bl, zb_bl, zu_bl, zv_bl, zdt_bl, zds_bl, zdb_bl, zdu_bl, zdv_bl) 610 ! jp_ext(:,:) = ibld(:,:) - imld(:,:) + 1 611 CALL zdf_osm_vertical_average(imld-1, ibld-imld+1, zt_ml, zs_ml, zb_ml, zu_ml, zv_ml, zdt_ml, zds_ml, zdb_ml, zdu_ml, zdv_ml) 612 ! Velocity components in frame aligned with surface stress. 613 CALL zdf_osm_velocity_rotation( zcos_wind, zsin_wind, zu_ml, zv_ml, zdu_ml, zdv_ml ) 614 CALL zdf_osm_velocity_rotation( zcos_wind, zsin_wind, zu_bl, zv_bl, zdu_bl, zdv_bl ) 615 ! Determine the state of the OSBL, stable/unstable, shear/no shear 616 CALL zdf_osm_osbl_state( lconv, lshear, j_ddh, zwb_ent, zwb_min, zshear ) 617 618 IF ( ln_osm_mle ) THEN 619 ! Fox-Kemper Scheme 620 mld_prof = 4 621 DO jk = 5, jpkm1 622 DO jj = 2, jpjm1 161 INTEGER FUNCTION zdf_osm_alloc() 162 !!---------------------------------------------------------------------- 163 !! *** FUNCTION zdf_osm_alloc *** 164 !!---------------------------------------------------------------------- 165 ALLOCATE( ghamu(jpi,jpj,jpk), ghamv(jpi,jpj,jpk), ghamt(jpi,jpj,jpk),ghams(jpi,jpj,jpk), & 166 & hbl(jpi,jpj), dh(jpi,jpj), hml(jpi,jpj), dstokes(jpi, jpj), & 167 & etmean(jpi,jpj,jpk), STAT= zdf_osm_alloc ) 168 169 ALLOCATE( hmle(jpi,jpj), r1_ft(jpi,jpj), dbdx_mle(jpi,jpj), dbdy_mle(jpi,jpj), & 170 & mld_prof(jpi,jpj), STAT= zdf_osm_alloc ) 171 172 ! ALLOCATE( ghamu(jpi,jpj,jpk), ghamv(jpi,jpj,jpk), ghamt(jpi,jpj,jpk),ghams(jpi,jpj,jpk), & ! would ths be better ? 173 ! & hbl(jpi,jpj), dh(jpi,jpj), hml(jpi,jpj), dstokes(jpi, jpj), & 174 ! & etmean(jpi,jpj,jpk), STAT= zdf_osm_alloc ) 175 ! IF( zdf_osm_alloc /= 0 ) CALL ctl_warn('zdf_osm_alloc: failed to allocate zdf_osm arrays') 176 ! IF ( ln_osm_mle ) THEN 177 ! Allocate( hmle(jpi,jpj), r1_ft(jpi,jpj), STAT= zdf_osm_alloc ) 178 ! IF( zdf_osm_alloc /= 0 ) CALL ctl_warn('zdf_osm_alloc: failed to allocate zdf_osm mle arrays') 179 ! ENDIF 180 181 IF( zdf_osm_alloc /= 0 ) CALL ctl_warn('zdf_osm_alloc: failed to allocate zdf_osm arrays') 182 CALL mpp_sum ( 'zdfosm', zdf_osm_alloc ) 183 END FUNCTION zdf_osm_alloc 184 185 186 SUBROUTINE zdf_osm( kt, p_avm, p_avt ) 187 !!---------------------------------------------------------------------- 188 !! *** ROUTINE zdf_osm *** 189 !! 190 !! ** Purpose : Compute the vertical eddy viscosity and diffusivity 191 !! coefficients and non local mixing using the OSMOSIS scheme 192 !! 193 !! ** Method : The boundary layer depth hosm is diagnosed at tracer points 194 !! from profiles of buoyancy, and shear, and the surface forcing. 195 !! Above hbl (sigma=-z/hbl <1) the mixing coefficients are computed from 196 !! 197 !! Kx = hosm Wx(sigma) G(sigma) 198 !! 199 !! and the non local term ghamt = Cs / Ws(sigma) / hosm 200 !! Below hosm the coefficients are the sum of mixing due to internal waves 201 !! shear instability and double diffusion. 202 !! 203 !! -1- Compute the now interior vertical mixing coefficients at all depths. 204 !! -2- Diagnose the boundary layer depth. 205 !! -3- Compute the now boundary layer vertical mixing coefficients. 206 !! -4- Compute the now vertical eddy vicosity and diffusivity. 207 !! -5- Smoothing 208 !! 209 !! N.B. The computation is done from jk=2 to jpkm1 210 !! Surface value of avt are set once a time to zero 211 !! in routine zdf_osm_init. 212 !! 213 !! ** Action : update the non-local terms ghamts 214 !! update avt (before vertical eddy coef.) 215 !! 216 !! References : Large W.G., Mc Williams J.C. and Doney S.C. 217 !! Reviews of Geophysics, 32, 4, November 1994 218 !! Comments in the code refer to this paper, particularly 219 !! the equation number. (LMD94, here after) 220 !!---------------------------------------------------------------------- 221 INTEGER , INTENT(in ) :: kt ! ocean time step 222 REAL(wp), DIMENSION(:,:,:), INTENT(inout) :: p_avm, p_avt ! momentum and tracer Kz (w-points) 223 !! 224 INTEGER :: ji, jj, jk ! dummy loop indices 225 226 INTEGER :: jl ! dummy loop indices 227 228 INTEGER :: ikbot, jkmax, jkm1, jkp2 ! 229 230 REAL(wp) :: ztx, zty, zflageos, zstabl, zbuofdep,zucube ! 231 REAL(wp) :: zbeta, zthermal ! 232 REAL(wp) :: zehat, zeta, zhrib, zsig, zscale, zwst, zws, zwm ! Velocity scales 233 REAL(wp) :: zwsun, zwmun, zcons, zconm, zwcons, zwconm ! 234 235 REAL(wp) :: zsr, zbw, ze, zb, zd, zc, zaw, za, zb1, za1, zkw, zk0, zcomp , zrhd,zrhdr,zbvzed ! In situ density 236 INTEGER :: jm ! dummy loop indices 237 REAL(wp) :: zr1, zr2, zr3, zr4, zrhop ! Compression terms 238 REAL(wp) :: zflag, zrn2, zdep21, zdep32, zdep43 239 REAL(wp) :: zesh2, zri, zfri ! Interior richardson mixing 240 REAL(wp) :: zdelta, zdelta2, zdzup, zdzdn, zdzh, zvath, zgat1, zdat1, zkm1m, zkm1t 241 REAL(wp) :: zt,zs,zu,zv,zrh ! variables used in constructing averages 242 ! Scales 243 REAL(wp), DIMENSION(jpi,jpj) :: zrad0 ! Surface solar temperature flux (deg m/s) 244 REAL(wp), DIMENSION(jpi,jpj) :: zradh ! Radiative flux at bl base (Buoyancy units) 245 REAL(wp), DIMENSION(jpi,jpj) :: zradav ! Radiative flux, bl average (Buoyancy Units) 246 REAL(wp), DIMENSION(jpi,jpj) :: zustar ! friction velocity 247 REAL(wp), DIMENSION(jpi,jpj) :: zwstrl ! Langmuir velocity scale 248 REAL(wp), DIMENSION(jpi,jpj) :: zvstr ! Velocity scale that ends to zustar for large Langmuir number. 249 REAL(wp), DIMENSION(jpi,jpj) :: zwstrc ! Convective velocity scale 250 REAL(wp), DIMENSION(jpi,jpj) :: zuw0 ! Surface u-momentum flux 251 REAL(wp), DIMENSION(jpi,jpj) :: zvw0 ! Surface v-momentum flux 252 REAL(wp), DIMENSION(jpi,jpj) :: zwth0 ! Surface heat flux (Kinematic) 253 REAL(wp), DIMENSION(jpi,jpj) :: zws0 ! Surface freshwater flux 254 REAL(wp), DIMENSION(jpi,jpj) :: zwb0 ! Surface buoyancy flux 255 REAL(wp), DIMENSION(jpi,jpj) :: zwb0tot ! Total surface buoyancy flux including insolation 256 REAL(wp), DIMENSION(jpi,jpj) :: zwthav ! Heat flux - bl average 257 REAL(wp), DIMENSION(jpi,jpj) :: zwsav ! freshwater flux - bl average 258 REAL(wp), DIMENSION(jpi,jpj) :: zwbav ! Buoyancy flux - bl average 259 REAL(wp), DIMENSION(jpi,jpj) :: zwb_ent ! Buoyancy entrainment flux 260 REAL(wp), DIMENSION(jpi,jpj) :: zwb_min 261 262 263 REAL(wp), DIMENSION(jpi,jpj) :: zwb_fk_b ! MLE buoyancy flux averaged over OSBL 264 REAL(wp), DIMENSION(jpi,jpj) :: zwb_fk ! max MLE buoyancy flux 265 REAL(wp), DIMENSION(jpi,jpj) :: zdiff_mle ! extra MLE vertical diff 266 REAL(wp), DIMENSION(jpi,jpj) :: zvel_mle ! velocity scale for dhdt with stable ML and FK 267 268 REAL(wp), DIMENSION(jpi,jpj) :: zustke ! Surface Stokes drift 269 REAL(wp), DIMENSION(jpi,jpj) :: zla ! Trubulent Langmuir number 270 REAL(wp), DIMENSION(jpi,jpj) :: zcos_wind ! Cos angle of surface stress 271 REAL(wp), DIMENSION(jpi,jpj) :: zsin_wind ! Sin angle of surface stress 272 REAL(wp), DIMENSION(jpi,jpj) :: zhol ! Stability parameter for boundary layer 273 LOGICAL, DIMENSION(jpi,jpj) :: lconv ! unstable/stable bl 274 LOGICAL, DIMENSION(jpi,jpj) :: lshear ! Shear layers 275 LOGICAL, DIMENSION(jpi,jpj) :: lpyc ! OSBL pycnocline present 276 LOGICAL, DIMENSION(jpi,jpj) :: lflux ! surface flux extends below OSBL into MLE layer. 277 LOGICAL, DIMENSION(jpi,jpj) :: lmle ! MLE layer increases in hickness. 278 279 ! mixed-layer variables 280 281 INTEGER, DIMENSION(jpi,jpj) :: ibld ! level of boundary layer base 282 INTEGER, DIMENSION(jpi,jpj) :: imld ! level of mixed-layer depth (pycnocline top) 283 INTEGER, DIMENSION(jpi,jpj) :: jp_ext, jp_ext_mle ! offset for external level 284 INTEGER, DIMENSION(jpi, jpj) :: j_ddh ! Type of shear layer 285 286 REAL(wp) :: ztgrad,zsgrad,zbgrad ! Temporary variables used to calculate pycnocline gradients 287 REAL(wp) :: zugrad,zvgrad ! temporary variables for calculating pycnocline shear 288 289 REAL(wp), DIMENSION(jpi,jpj) :: zhbl ! bl depth - grid 290 REAL(wp), DIMENSION(jpi,jpj) :: zhml ! ml depth - grid 291 292 REAL(wp), DIMENSION(jpi,jpj) :: zhmle ! MLE depth - grid 293 REAL(wp), DIMENSION(jpi,jpj) :: zmld ! ML depth on grid 294 295 REAL(wp), DIMENSION(jpi,jpj) :: zdh ! pycnocline depth - grid 296 REAL(wp), DIMENSION(jpi,jpj) :: zdhdt ! BL depth tendency 297 REAL(wp), DIMENSION(jpi,jpj) :: zdtdz_bl_ext,zdsdz_bl_ext,zdbdz_bl_ext ! external temperature/salinity and buoyancy gradients 298 REAL(wp), DIMENSION(jpi,jpj) :: zdtdz_mle_ext,zdsdz_mle_ext,zdbdz_mle_ext ! external temperature/salinity and buoyancy gradients 299 REAL(wp), DIMENSION(jpi,jpj) :: zdtdx, zdtdy, zdsdx, zdsdy ! horizontal gradients for Fox-Kemper parametrization. 300 301 REAL(wp), DIMENSION(jpi,jpj) :: zt_bl,zs_bl,zu_bl,zv_bl,zb_bl ! averages over the depth of the blayer 302 REAL(wp), DIMENSION(jpi,jpj) :: zt_ml,zs_ml,zu_ml,zv_ml,zb_ml ! averages over the depth of the mixed layer 303 REAL(wp), DIMENSION(jpi,jpj) :: zt_mle,zs_mle,zu_mle,zv_mle,zb_mle ! averages over the depth of the MLE layer 304 REAL(wp), DIMENSION(jpi,jpj) :: zdt_bl,zds_bl,zdu_bl,zdv_bl,zdb_bl ! difference between blayer average and parameter at base of blayer 305 REAL(wp), DIMENSION(jpi,jpj) :: zdt_ml,zds_ml,zdu_ml,zdv_ml,zdb_ml ! difference between mixed layer average and parameter at base of blayer 306 REAL(wp), DIMENSION(jpi,jpj) :: zdt_mle,zds_mle,zdu_mle,zdv_mle,zdb_mle ! difference between MLE layer average and parameter at base of blayer 307 ! REAL(wp), DIMENSION(jpi,jpj) :: zwth_ent,zws_ent ! heat and salinity fluxes at the top of the pycnocline 308 REAL(wp) :: zwth_ent,zws_ent ! heat and salinity fluxes at the top of the pycnocline 309 REAL(wp) :: zuw_bse,zvw_bse ! momentum fluxes at the top of the pycnocline 310 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdtdz_pyc ! parametrized gradient of temperature in pycnocline 311 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdsdz_pyc ! parametrised gradient of salinity in pycnocline 312 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdbdz_pyc ! parametrised gradient of buoyancy in the pycnocline 313 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdudz_pyc ! u-shear across the pycnocline 314 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdvdz_pyc ! v-shear across the pycnocline 315 REAL(wp), DIMENSION(jpi,jpj) :: zdbds_mle ! Magnitude of horizontal buoyancy gradient. 316 ! Flux-gradient relationship variables 317 REAL(wp), DIMENSION(jpi, jpj) :: zshear ! Shear production. 318 319 REAL(wp) :: zl_c,zl_l,zl_eps ! Used to calculate turbulence length scale. 320 321 REAL(wp) :: za_cubic, zb_cubic, zc_cubic, zd_cubic ! coefficients in cubic polynomial specifying diffusivity in pycnocline. 322 REAL(wp), DIMENSION(jpi,jpj) :: zsc_wth_1,zsc_ws_1 ! Temporary scales used to calculate scalar non-gradient terms. 323 REAL(wp), DIMENSION(jpi,jpj) :: zsc_wth_pyc, zsc_ws_pyc ! Scales for pycnocline transport term/ 324 REAL(wp), DIMENSION(jpi,jpj) :: zsc_uw_1,zsc_uw_2,zsc_vw_1,zsc_vw_2 ! Temporary scales for non-gradient momentum flux terms. 325 REAL(wp), DIMENSION(jpi,jpj) :: zhbl_t ! holds boundary layer depth updated by full timestep 326 327 ! For calculating Ri#-dependent mixing 328 REAL(wp), DIMENSION(jpi,jpj,jpk) :: z3du ! u-shear^2 329 REAL(wp), DIMENSION(jpi,jpj,jpk) :: z3dv ! v-shear^2 330 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zrimix ! spatial form of ri#-induced diffusion 331 332 ! Temporary variables 333 INTEGER :: inhml 334 REAL(wp) :: znd,znd_d,zznd_ml,zznd_pyc,zznd_d ! temporary non-dimensional depths used in various routines 335 REAL(wp) :: ztemp, zari, zpert, zzdhdt, zdb ! temporary variables 336 REAL(wp) :: zthick, zz0, zz1 ! temporary variables 337 REAL(wp) :: zvel_max, zhbl_s ! temporary variables 338 REAL(wp) :: zfac, ztmp ! temporary variable 339 REAL(wp) :: zus_x, zus_y ! temporary Stokes drift 340 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zviscos ! viscosity 341 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdiffut ! t-diffusivity 342 REAL(wp), DIMENSION(jpi,jpj) :: zalpha_pyc 343 REAL(wp), DIMENSION(jpi,jpj) :: ztau_sc_u ! dissipation timescale at baes of WML. 344 REAL(wp) :: zdelta_pyc, zwt_pyc_sc_1, zws_pyc_sc_1, zzeta_pyc 345 REAL(wp) :: zbuoy_pyc_sc, zomega, zvw_max 346 INTEGER :: ibld_ext=0 ! does not have to be zero for modified scheme 347 REAL(wp) :: zgamma_b_nd, zgamma_b, zdhoh, ztau 348 REAL(wp) :: zzeta_s = 0._wp 349 REAL(wp) :: zzeta_v = 0.46 350 REAL(wp) :: zabsstke 351 REAL(wp) :: zsqrtpi, z_two_thirds, zproportion, ztransp, zthickness 352 REAL(wp) :: z2k_times_thickness, zsqrt_depth, zexp_depth, zdstokes0, zf, zexperfc 353 354 ! For debugging 355 INTEGER :: ikt 356 !!-------------------------------------------------------------------- 357 ! 358 ibld(:,:) = 0 ; imld(:,:) = 0 359 zrad0(:,:) = 0._wp ; zradh(:,:) = 0._wp ; zradav(:,:) = 0._wp ; zustar(:,:) = 0._wp 360 zwstrl(:,:) = 0._wp ; zvstr(:,:) = 0._wp ; zwstrc(:,:) = 0._wp ; zuw0(:,:) = 0._wp 361 zvw0(:,:) = 0._wp ; zwth0(:,:) = 0._wp ; zws0(:,:) = 0._wp ; zwb0(:,:) = 0._wp 362 zwthav(:,:) = 0._wp ; zwsav(:,:) = 0._wp ; zwbav(:,:) = 0._wp ; zwb_ent(:,:) = 0._wp 363 zustke(:,:) = 0._wp ; zla(:,:) = 0._wp ; zcos_wind(:,:) = 0._wp ; zsin_wind(:,:) = 0._wp 364 zhol(:,:) = 0._wp ; zwb0tot(:,:) = 0._wp 365 lconv(:,:) = .FALSE.; lpyc(:,:) = .FALSE. ; lflux(:,:) = .FALSE. ; lmle(:,:) = .FALSE. 366 ! mixed layer 367 ! no initialization of zhbl or zhml (or zdh?) 368 zhbl(:,:) = 1._wp ; zhml(:,:) = 1._wp ; zdh(:,:) = 1._wp ; zdhdt(:,:) = 0._wp 369 zt_bl(:,:) = 0._wp ; zs_bl(:,:) = 0._wp ; zu_bl(:,:) = 0._wp 370 zv_bl(:,:) = 0._wp ; zb_bl(:,:) = 0._wp 371 zt_ml(:,:) = 0._wp ; zs_ml(:,:) = 0._wp ; zu_ml(:,:) = 0._wp 372 zt_mle(:,:) = 0._wp ; zs_mle(:,:) = 0._wp ; zu_mle(:,:) = 0._wp 373 zb_mle(:,:) = 0._wp 374 zv_ml(:,:) = 0._wp ; zdt_bl(:,:) = 0._wp ; zds_bl(:,:) = 0._wp 375 zdu_bl(:,:) = 0._wp ; zdv_bl(:,:) = 0._wp ; zdb_bl(:,:) = 0._wp 376 zdt_ml(:,:) = 0._wp ; zds_ml(:,:) = 0._wp ; zdu_ml(:,:) = 0._wp ; zdv_ml(:,:) = 0._wp 377 zdb_ml(:,:) = 0._wp 378 zdt_mle(:,:) = 0._wp ; zds_mle(:,:) = 0._wp ; zdu_mle(:,:) = 0._wp 379 zdv_mle(:,:) = 0._wp ; zdb_mle(:,:) = 0._wp 380 zwth_ent = 0._wp ; zws_ent = 0._wp 381 ! 382 zdtdz_pyc(:,:,:) = 0._wp ; zdsdz_pyc(:,:,:) = 0._wp ; zdbdz_pyc(:,:,:) = 0._wp 383 zdudz_pyc(:,:,:) = 0._wp ; zdvdz_pyc(:,:,:) = 0._wp 384 ! 385 zdtdz_bl_ext(:,:) = 0._wp ; zdsdz_bl_ext(:,:) = 0._wp ; zdbdz_bl_ext(:,:) = 0._wp 386 387 IF ( ln_osm_mle ) THEN ! only initialise arrays if needed 388 zdtdx(:,:) = 0._wp ; zdtdy(:,:) = 0._wp ; zdsdx(:,:) = 0._wp 389 zdsdy(:,:) = 0._wp ; dbdx_mle(:,:) = 0._wp ; dbdy_mle(:,:) = 0._wp 390 zwb_fk(:,:) = 0._wp ; zvel_mle(:,:) = 0._wp; zdiff_mle(:,:) = 0._wp 391 zhmle(:,:) = 0._wp ; zmld(:,:) = 0._wp 392 ENDIF 393 zwb_fk_b(:,:) = 0._wp ! must be initialised even with ln_osm_mle=F as used in zdf_osm_calculate_dhdt 394 395 ! Flux-Gradient arrays. 396 zsc_wth_1(:,:) = 0._wp ; zsc_ws_1(:,:) = 0._wp ; zsc_uw_1(:,:) = 0._wp 397 zsc_uw_2(:,:) = 0._wp ; zsc_vw_1(:,:) = 0._wp ; zsc_vw_2(:,:) = 0._wp 398 zhbl_t(:,:) = 0._wp ; zdhdt(:,:) = 0._wp 399 400 zdiffut(:,:,:) = 0._wp ; zviscos(:,:,:) = 0._wp ; ghamt(:,:,:) = 0._wp 401 ghams(:,:,:) = 0._wp ; ghamu(:,:,:) = 0._wp ; ghamv(:,:,:) = 0._wp 402 403 404 #ifdef key_osm_debug 405 IF(narea==nn_narea_db)THEN 406 iloc_db=mi0(nn_idb); jloc_db=mj0(nn_jdb) 407 408 WRITE(narea+100,*) 409 WRITE(narea+100,'(a,i7)')'timestep=',kt 410 WRITE(narea+100,'(3(a,i7))')'narea=',narea,' nn_idb',nn_idb,' nn_jdb=',nn_jdb 411 WRITE(narea+100,'(4(a,i7))')'iloc_db=',iloc_db,' jloc_db',jloc_db,' jpi=',jpi,' jpj=',jpj 412 ji=iloc_db; jj=jloc_db 413 WRITE(narea+100,'(a,i7,5(a,g10.2))')'mbkt=',mbkt(ji,jj),' ht_n',ht_n(ji,jj),& 414 &' hu_n-',hu_n(ji-1,jj),' hu_n+',hu_n(ji,jj), ' hv_n-',hv_n(ji,jj-1),' hv_n+',hv_n(ji,jj) 415 WRITE(narea+100,*) 416 FLUSH(narea+100) 417 END IF 418 #endif 419 420 ! hbl = MAX(hbl,epsln) 421 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 422 ! Calculate boundary layer scales 423 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 424 425 ! Assume two-band radiation model for depth of OSBL 426 zz0 = rn_abs ! surface equi-partition in 2-bands 427 zz1 = 1. - rn_abs 428 DO jj = 2, jpjm1 429 DO ji = 2, jpim1 430 ! Surface downward irradiance (so always +ve) 431 zrad0(ji,jj) = qsr(ji,jj) * r1_rau0_rcp 432 ! Downwards irradiance at base of boundary layer 433 zradh(ji,jj) = zrad0(ji,jj) * ( zz0 * EXP( -hbl(ji,jj)/rn_si0 ) + zz1 * EXP( -hbl(ji,jj)/rn_si1) ) 434 ! Downwards irradiance averaged over depth of the OSBL 435 zradav(ji,jj) = zrad0(ji,jj) * ( zz0 * ( 1.0 - EXP( -hbl(ji,jj)/rn_si0 ) )*rn_si0 & 436 & + zz1 * ( 1.0 - EXP( -hbl(ji,jj)/rn_si1 ) )*rn_si1 ) / hbl(ji,jj) 437 END DO 438 END DO 439 ! Turbulent surface fluxes and fluxes averaged over depth of the OSBL 440 DO jj = 2, jpjm1 441 DO ji = 2, jpim1 442 zthermal = rab_n(ji,jj,1,jp_tem) 443 zbeta = rab_n(ji,jj,1,jp_sal) 444 ! Upwards surface Temperature flux for non-local term 445 zwth0(ji,jj) = - qns(ji,jj) * r1_rau0_rcp * tmask(ji,jj,1) 446 ! Upwards surface salinity flux for non-local term 447 zws0(ji,jj) = - ( ( emp(ji,jj)-rnf(ji,jj) ) * tsn(ji,jj,1,jp_sal) + sfx(ji,jj) ) * r1_rau0 * tmask(ji,jj,1) 448 ! Non radiative upwards surface buoyancy flux 449 zwb0(ji,jj) = grav * zthermal * zwth0(ji,jj) - grav * zbeta * zws0(ji,jj) 450 ! Total upwards surface buoyancy flux 451 zwb0tot(ji,jj) = zwb0(ji,jj) - grav * zthermal * ( zrad0(ji,jj) - zradh(ji,jj) ) 452 ! turbulent heat flux averaged over depth of OSBL 453 zwthav(ji,jj) = 0.5 * zwth0(ji,jj) - ( 0.5*( zrad0(ji,jj) + zradh(ji,jj) ) - zradav(ji,jj) ) 454 ! turbulent salinity flux averaged over depth of the OBSL 455 zwsav(ji,jj) = 0.5 * zws0(ji,jj) 456 ! turbulent buoyancy flux averaged over the depth of the OBSBL 457 zwbav(ji,jj) = grav * zthermal * zwthav(ji,jj) - grav * zbeta * zwsav(ji,jj) 458 ! Surface upward velocity fluxes 459 zuw0(ji,jj) = - 0.5 * (utau(ji-1,jj) + utau(ji,jj)) * r1_rau0 * tmask(ji,jj,1) 460 zvw0(ji,jj) = - 0.5 * (vtau(ji,jj-1) + vtau(ji,jj)) * r1_rau0 * tmask(ji,jj,1) 461 ! Friction velocity (zustar), at T-point : LMD94 eq. 2 462 zustar(ji,jj) = MAX( SQRT( SQRT( zuw0(ji,jj) * zuw0(ji,jj) + zvw0(ji,jj) * zvw0(ji,jj) ) ), 1.0e-8 ) 463 zcos_wind(ji,jj) = -zuw0(ji,jj) / ( zustar(ji,jj) * zustar(ji,jj) ) 464 zsin_wind(ji,jj) = -zvw0(ji,jj) / ( zustar(ji,jj) * zustar(ji,jj) ) 465 #ifdef key_osm_debug 466 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 467 WRITE(narea+100,'(4(3(a,g11.3),/), 2(a,g11.3),/)') & 468 & 'after calculating fluxes: hbl=', hbl(ji,jj),' zthermal=',zthermal, ' zbeta=', zbeta,& 469 & ' zrad0=', zrad0(ji,jj),' zradh=', zradh(ji,jj), ' zradav=', zradav(ji,jj), & 470 & ' zwth0=', zwth0(ji,jj), ' zwthav=', zwthav(ji,jj), ' zws0=', zws0(ji,jj), & 471 & ' zwb0=', zwb0(ji,jj), ' zwb0tot=', zwb0tot(ji,jj), ' zwb0tot_in hbl=', zwb0tot(ji,jj) + grav * zthermal * zradh(ji,jj),& 472 & ' zwbav=', zwbav(ji,jj) 473 FLUSH(narea+100) 474 END IF 475 #endif 476 END DO 477 END DO 478 ! Calculate Stokes drift in direction of wind (zustke) and Stokes penetration depth (dstokes) 479 SELECT CASE (nn_osm_wave) 480 ! Assume constant La#=0.3 481 CASE(0) 482 DO jj = 2, jpjm1 483 DO ji = 2, jpim1 484 zus_x = zcos_wind(ji,jj) * zustar(ji,jj) / 0.3**2 485 zus_y = zsin_wind(ji,jj) * zustar(ji,jj) / 0.3**2 486 ! Linearly 487 zustke(ji,jj) = MAX ( SQRT( zus_x*zus_x + zus_y*zus_y), 1.0e-8 ) 488 dstokes(ji,jj) = rn_osm_dstokes 489 END DO 490 END DO 491 ! Assume Pierson-Moskovitz wind-wave spectrum 492 CASE(1) 493 DO jj = 2, jpjm1 494 DO ji = 2, jpim1 495 ! Use wind speed wndm included in sbc_oce module 496 zustke(ji,jj) = MAX ( 0.016 * wndm(ji,jj), 1.0e-8 ) 497 dstokes(ji,jj) = MAX ( 0.12 * wndm(ji,jj)**2 / grav, 5.e-1) 498 END DO 499 END DO 500 ! Use ECMWF wave fields as output from SBCWAVE 501 CASE(2) 502 zfac = 2.0_wp * rpi / 16.0_wp 503 504 DO jj = 2, jpjm1 505 DO ji = 2, jpim1 506 IF (hsw(ji,jj) > 1.e-4) THEN 507 ! Use wave fields 508 zabsstke = SQRT(ut0sd(ji,jj)**2 + vt0sd(ji,jj)**2) 509 zustke(ji,jj) = MAX ( ( zcos_wind(ji,jj) * ut0sd(ji,jj) + zsin_wind(ji,jj) * vt0sd(ji,jj) ), 1.0e-8) 510 dstokes(ji,jj) = MAX (zfac * hsw(ji,jj)*hsw(ji,jj) / ( MAX(zabsstke * wmp(ji,jj), 1.0e-7 ) ), 5.0e-1) 511 ELSE 512 ! Assume masking issue (e.g. ice in ECMWF reanalysis but not in model run) 513 ! .. so default to Pierson-Moskowitz 514 zustke(ji,jj) = MAX ( 0.016 * wndm(ji,jj), 1.0e-8 ) 515 dstokes(ji,jj) = MAX ( 0.12 * wndm(ji,jj)**2 / grav, 5.e-1) 516 END IF 517 END DO 518 END DO 519 END SELECT 520 #ifdef key_osm_debug 521 IF(narea==nn_narea_db)THEN 522 WRITE(narea+100,'(2(a,g11.3))') & 523 & 'Before reduction: zustke=', zustke(iloc_db,jloc_db),' dstokes =',dstokes(iloc_db,jloc_db) 524 FLUSH(narea+100) 525 END IF 526 #endif 527 528 IF (ln_zdfosm_ice_shelter) THEN 529 ! Reduce both Stokes drift and its depth scale by ocean fraction to represent sheltering by ice 530 DO jj = 2, jpjm1 531 DO ji = 2, jpim1 532 zustke(ji,jj) = zustke(ji,jj) * (1.0_wp - fr_i(ji,jj)) 533 dstokes(ji,jj) = dstokes(ji,jj) * (1.0_wp - fr_i(ji,jj)) 534 END DO 535 END DO 536 END IF 537 538 SELECT CASE (nn_osm_SD_reduce) 539 ! Reduce surface Stokes drift by a constant factor or following Breivik (2016) + van Roekel (2012) or Grant (2020). 540 CASE(0) 541 ! The Langmur number from the ECMWF model (or from PM) appears to give La<0.3 for wind-driven seas. 542 ! The coefficient rn_zdfosm_adjust_sd = 0.8 gives La=0.3 in this situation. 543 ! It could represent the effects of the spread of wave directions 544 ! around the mean wind. The effect of this adjustment needs to be tested. 545 IF(nn_osm_wave > 0) THEN 546 zustke(2:jpim1,2:jpjm1) = rn_zdfosm_adjust_sd * zustke(2:jpim1,2:jpjm1) 547 END IF 548 CASE(1) 549 ! van Roekel (2012): consider average SD over top 10% of boundary layer 550 ! assumes approximate depth profile of SD from Breivik (2016) 551 zsqrtpi = SQRT(rpi) 552 z_two_thirds = 2.0_wp / 3.0_wp 553 554 DO jj = 2, jpjm1 555 DO ji = 2, jpim1 556 zthickness = rn_osm_hblfrac*hbl(ji,jj) 557 z2k_times_thickness = zthickness * 2.0_wp / MAX( ABS( 5.97_wp * dstokes(ji,jj) ), 0.0000001_wp ) 558 zsqrt_depth = SQRT(z2k_times_thickness) 559 zexp_depth = EXP(-z2k_times_thickness) 560 zustke(ji,jj) = zustke(ji,jj) * (1.0_wp - zexp_depth & 561 & - z_two_thirds * ( zsqrtpi*zsqrt_depth*z2k_times_thickness * ERFC(zsqrt_depth) & 562 & + 1.0_wp - (1.0_wp + z2k_times_thickness)*zexp_depth ) ) / z2k_times_thickness 563 564 END DO 565 END DO 566 CASE(2) 567 ! Grant (2020): Match to exponential with same SD and d/dz(Sd) at depth 10% of boundary layer 568 ! assumes approximate depth profile of SD from Breivik (2016) 569 zsqrtpi = SQRT(rpi) 570 571 DO jj = 2, jpjm1 572 DO ji = 2, jpim1 573 zthickness = rn_osm_hblfrac*hbl(ji,jj) 574 z2k_times_thickness = zthickness * 2.0_wp / MAX( ABS( 5.97_wp * dstokes(ji,jj) ), 0.0000001_wp ) 575 576 IF(z2k_times_thickness < 50._wp) THEN 577 zsqrt_depth = SQRT(z2k_times_thickness) 578 zexperfc = zsqrtpi * zsqrt_depth * ERFC(zsqrt_depth) * EXP(z2k_times_thickness) 579 ELSE 580 ! asymptotic expansion of sqrt(pi)*zsqrt_depth*EXP(z2k_times_thickness)*ERFC(zsqrt_depth) for large z2k_times_thickness 581 ! See Abramowitz and Stegun, Eq. 7.1.23 582 ! zexperfc = 1._wp - (1/2)/(z2k_times_thickness) + (3/4)/(z2k_times_thickness**2) - (15/8)/(z2k_times_thickness**3) 583 zexperfc = ((- 1.875_wp/z2k_times_thickness + 0.75_wp)/z2k_times_thickness - 0.5_wp)/z2k_times_thickness + 1.0_wp 584 END IF 585 zf = z2k_times_thickness*(1.0_wp/zexperfc - 1.0_wp) 586 dstokes(ji,jj) = 5.97 * zf * dstokes(ji,jj) 587 zustke(ji,jj) = zustke(ji,jj) * EXP(z2k_times_thickness * ( 1.0_wp / (2. * zf) - 1.0_wp )) * ( 1.0_wp - zexperfc) 588 END DO 589 END DO 590 END SELECT 591 592 ! Langmuir velocity scale (zwstrl), La # (zla) 593 ! mixed scale (zvstr), convective velocity scale (zwstrc) 594 DO jj = 2, jpjm1 595 DO ji = 2, jpim1 596 ! Langmuir velocity scale (zwstrl), at T-point 597 zwstrl(ji,jj) = ( zustar(ji,jj) * zustar(ji,jj) * zustke(ji,jj) )**pthird 598 zla(ji,jj) = MAX(MIN(SQRT ( zustar(ji,jj) / ( zwstrl(ji,jj) + epsln ) )**3, 4.0), 0.2) 599 IF(zla(ji,jj) > 0.45) dstokes(ji,jj) = MIN(dstokes(ji,jj), 0.5_wp*hbl(ji,jj)) 600 ! Velocity scale that tends to zustar for large Langmuir numbers 601 zvstr(ji,jj) = ( zwstrl(ji,jj)**3 + & 602 & ( 1.0 - EXP( -0.5 * zla(ji,jj)**2 ) ) * zustar(ji,jj) * zustar(ji,jj) * zustar(ji,jj) )**pthird 603 604 ! limit maximum value of Langmuir number as approximate treatment for shear turbulence. 605 ! Note zustke and zwstrl are not amended. 606 ! 607 ! get convective velocity (zwstrc), stabilty scale (zhol) and logical conection flag lconv 608 IF ( zwbav(ji,jj) > 0.0) THEN 609 zwstrc(ji,jj) = ( 2.0 * zwbav(ji,jj) * 0.9 * hbl(ji,jj) )**pthird 610 zhol(ji,jj) = -0.9 * hbl(ji,jj) * 2.0 * zwbav(ji,jj) / (zvstr(ji,jj)**3 + epsln ) 611 ELSE 612 zhol(ji,jj) = -hbl(ji,jj) * 2.0 * zwbav(ji,jj)/ (zvstr(ji,jj)**3 + epsln ) 613 ENDIF 614 #ifdef key_osm_debug 615 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 616 WRITE(narea+100,'(2(a,g11.3),/,3(a,g11.3),/,2(a,g11.3),/)') & 617 & 'After reduction: zustke=', zustke(ji,jj), ' dstokes=', dstokes(ji,jj), & 618 & ' zustar =', zustar(ji,jj), ' zwstrl=', zwstrl(ji,jj), ' zwstrc=', zwstrc(ji,jj),& 619 & ' zhol=', zhol(ji,jj), ' zla=', zla(ji,jj) 620 FLUSH(narea+100) 621 END IF 622 #endif 623 END DO 624 END DO 625 626 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 627 ! Mixed-layer model - calculate averages over the boundary layer, and the change in the boundary layer depth 628 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 629 ! BL must be always 4 levels deep. 630 ! For calculation of lateral buoyancy gradients for FK in 631 ! zdf_osm_zmld_horizontal_gradients need halo values for ibld, so must 632 ! previously exist for hbl also. 633 634 ! agn 23/6/20: not clear all this is needed, as hbl checked after it is re-calculated anyway 635 ! ########################################################################## 636 hbl(:,:) = MAX(hbl(:,:), gdepw_n(:,:,4) ) 637 ibld(:,:) = 4 638 DO jk = 5, jpkm1 639 DO jj = 1, jpj 640 DO ji = 1, jpi 641 IF ( hbl(ji,jj) >= gdepw_n(ji,jj,jk) ) THEN 642 ibld(ji,jj) = MIN(mbkt(ji,jj), jk) 643 ENDIF 644 END DO 645 END DO 646 END DO 647 ! ########################################################################## 648 649 DO jj = 2, jpjm1 650 DO ji = 2, jpim1 651 zhbl(ji,jj) = gdepw_n(ji,jj,ibld(ji,jj)) 652 imld(ji,jj) = MAX(3,ibld(ji,jj) - MAX( INT( dh(ji,jj) / e3t_n(ji, jj, ibld(ji,jj) - 1 )) , 1 )) 653 zhml(ji,jj) = gdepw_n(ji,jj,imld(ji,jj)) 654 zdh(ji,jj) = zhbl(ji,jj) - zhml(ji,jj) 655 END DO 656 END DO 657 #ifdef key_osm_debug 658 IF(narea==nn_narea_db) THEN 659 ji=iloc_db; jj=jloc_db 660 WRITE(narea+100,'(2(a,g11.3),/,3(a,g11.3),/,2(a,i7),/)') & 661 & 'Before updating hbl: hbl=', hbl(ji,jj), ' dh=', dh(ji,jj), & 662 &' zhbl =',zhbl(ji,jj) , ' zhml=', zhml(ji,jj), ' zdh=', zdh(ji,jj),& 663 &' imld=', imld(ji,jj), ' ibld=', ibld(ji,jj) 664 665 WRITE(narea+100,'(a,g11.3,a,2g11.3)') 'Physics: ssh ',sshn(ji,jj),' T S surface=',tsn(ji,jj,1,jp_tem),tsn(ji,jj,1,jp_sal) 666 jl = imld(ji,jj) - 1; jm = MIN(ibld(ji,jj) + 2, mbkt(ji,jj) ) 667 WRITE(narea+100,'(a,*(g11.3))') ' T[imld-1..ibld+2] =', ( tsn(ji,jj,jk,jp_tem), jk=jl,jm ) 668 WRITE(narea+100,'(a,*(g11.3))') ' S[imld-1..ibld+2] =', ( tsn(ji,jj,jk,jp_sal), jk=jl,jm ) 669 WRITE(narea+100,'(a,*(g11.3))') ' U+[imld-1..ibld+2] =', ( un(ji,jj,jk), jk=jl,jm ) 670 WRITE(narea+100,'(a,*(g11.3))') ' U-[imld-1..ibld+2] =', ( un(ji-1,jj,jk), jk=jl,jm ) 671 WRITE(narea+100,'(a,*(g11.3))') ' V+[imld-1..ibld+2] =', ( vn(ji,jj,jk), jk=jl,jm ) 672 WRITE(narea+100,'(a,*(g11.3))') ' V-[imld-1..ibld+2] =', ( vn(ji,jj-1,jk), jk=jl,jm ) 673 WRITE(narea+100,'(a,*(g11.3))') ' W[imld-1..ibld+2] =', ( wn(ji,jj-1,jk), jk=jl,jm ) 674 WRITE(narea+100,*) 675 FLUSH(narea+100) 676 END IF 677 #endif 678 679 ! Averages over well-mixed and boundary layer, note BL averages use jp_ext=2 everywhere 680 jp_ext(:,:) = 2 681 CALL zdf_osm_vertical_average(ibld, jp_ext, zt_bl, zs_bl, zb_bl, zu_bl, zv_bl, zdt_bl, zds_bl, zdb_bl, zdu_bl, zdv_bl) 682 ! jp_ext(:,:) = ibld(:,:) - imld(:,:) + 1 683 CALL zdf_osm_vertical_average(imld-1, ibld-imld+1, zt_ml, zs_ml, zb_ml, zu_ml, zv_ml, zdt_ml, zds_ml, zdb_ml, zdu_ml, zdv_ml) 684 #ifdef key_osm_debug 685 IF(narea==nn_narea_db) THEN 686 ji=iloc_db; jj=jloc_db 687 WRITE(narea+100,'(4(3(a,g11.3),/), 2(4(a,g11.3),/))') & 688 & 'After averaging, with old hbl (& jp_ext==2), hml: zt_bl=', zt_bl(ji,jj),& 689 & ' zs_bl=', zs_bl(ji,jj), ' zb_bl=', zb_bl(ji,jj),& 690 & 'zdt_bl=', zdt_bl(ji,jj), ' zds_bl=', zds_bl(ji,jj), ' zdb_bl=', zdb_bl(ji,jj),& 691 & 'zt_ml=', zt_ml(ji,jj), ' zs_ml=', zs_ml(ji,jj), ' zb_ml=', zb_ml(ji,jj),& 692 & 'zdt_ml=', zdt_ml(ji,jj), ' zds_ml=', zds_ml(ji,jj), ' zdb_ml=', zdb_ml(ji,jj),& 693 & 'zu_bl =', zu_bl(ji,jj) , ' zv_bl=', zv_bl(ji,jj), ' zdu_bl=', zdu_bl(ji,jj), ' zdv_bl=', zdv_bl(ji,jj),& 694 & 'zu_ml =', zu_ml(ji,jj) , ' zv_ml=', zv_ml(ji,jj), ' zdu_ml=', zdu_ml(ji,jj), ' zdv_ml=', zdv_ml(ji,jj) 695 FLUSH(narea+100) 696 END IF 697 #endif 698 ! Velocity components in frame aligned with surface stress. 699 CALL zdf_osm_velocity_rotation( zcos_wind, zsin_wind, zu_ml, zv_ml, zdu_ml, zdv_ml ) 700 CALL zdf_osm_velocity_rotation( zcos_wind, zsin_wind, zu_bl, zv_bl, zdu_bl, zdv_bl ) 701 #ifdef key_osm_debug 702 IF(narea==nn_narea_db) THEN 703 ji=iloc_db; jj=jloc_db 704 WRITE(narea+100,'(a,/, 2(4(a,g11.3),/))') & 705 & 'After rotation, with old hbl (& jp_ext==2), hml:', & 706 & 'zu_bl =', zu_bl(ji,jj) , ' zv_bl=', zv_bl(ji,jj), ' zdu_bl=', zdu_bl(ji,jj), ' zdv_bl=', zdv_bl(ji,jj),& 707 & 'zu_ml =', zu_ml(ji,jj) , ' zv_ml=', zv_ml(ji,jj), ' zdu_ml=', zdu_ml(ji,jj), ' zdv_ml=', zdv_ml(ji,jj) 708 FLUSH(narea+100) 709 END IF 710 #endif 711 712 ! Determine the state of the OSBL, stable/unstable, shear/no shear 713 CALL zdf_osm_osbl_state( lconv, lshear, j_ddh, zwb_ent, zwb_min, zshear ) 714 715 #ifdef key_osm_debug 716 IF(narea==nn_narea_db) THEN 717 ji=iloc_db; jj=jloc_db 718 WRITE(narea+100,'(2(a,l7),a, i7,/,3(a,g11.3),/)') & 719 & 'After zdf_osm_osbl_state: lconv=', lconv(ji,jj), ' lshear=', lshear(ji,jj), ' j_ddh=', j_ddh(ji,jj),& 720 & 'zwb_ent=', zwb_ent(ji,jj), ' zwb_min=', zwb_min(ji,jj), ' zshear=', zshear(ji,jj) 721 FLUSH(narea+100) 722 END IF 723 #endif 724 IF ( ln_osm_mle ) THEN 725 ! Fox-Kemper Scheme 726 mld_prof = 4 727 DO jk = 5, jpkm1 728 DO jj = 2, jpjm1 623 729 DO ji = 2, jpim1 624 IF ( hmle(ji,jj) >= gdepw_n(ji,jj,jk) ) mld_prof(ji,jj) = MIN(mbkt(ji,jj), jk)730 IF ( hmle(ji,jj) >= gdepw_n(ji,jj,jk) ) mld_prof(ji,jj) = MIN(mbkt(ji,jj), jk) 625 731 END DO 626 END DO 627 END DO 628 jp_ext_mle(:,:) = 2 629 CALL zdf_osm_vertical_average(mld_prof, jp_ext_mle, zt_mle, zs_mle, zb_mle, zu_mle, zv_mle, zdt_mle, zds_mle, zdb_mle, zdu_mle, zdv_mle) 630 631 DO jj = 2, jpjm1 632 DO ji = 2, jpim1 633 zhmle(ji,jj) = gdepw_n(ji,jj,mld_prof(ji,jj)) 634 END DO 635 END DO 636 637 !! External gradient 638 CALL zdf_osm_external_gradients( ibld+2, zdtdz_bl_ext, zdsdz_bl_ext, zdbdz_bl_ext ) 639 CALL zdf_osm_zmld_horizontal_gradients( zmld, zdtdx, zdtdy, zdsdx, zdsdy, dbdx_mle, dbdy_mle, zdbds_mle ) 640 CALL zdf_osm_external_gradients( mld_prof, zdtdz_mle_ext, zdsdz_mle_ext, zdbdz_mle_ext ) 641 CALL zdf_osm_osbl_state_fk( lpyc, lflux, lmle, zwb_fk ) 642 CALL zdf_osm_mle_parameters( zmld, mld_prof, hmle, zhmle, zvel_mle, zdiff_mle ) 643 ELSE ! ln_osm_mle 644 ! FK not selected, Boundary Layer only. 645 lpyc(:,:) = .TRUE. 646 lflux(:,:) = .FALSE. 647 lmle(:,:) = .FALSE. 648 DO jj = 2, jpjm1 649 DO ji = 2, jpim1 732 END DO 733 END DO 734 jp_ext_mle(:,:) = 2 735 CALL zdf_osm_vertical_average(mld_prof, jp_ext_mle, zt_mle, zs_mle, zb_mle, zu_mle, zv_mle, zdt_mle, zds_mle, zdb_mle, zdu_mle, zdv_mle) 736 737 DO jj = 2, jpjm1 738 DO ji = 2, jpim1 739 zhmle(ji,jj) = gdepw_n(ji,jj,mld_prof(ji,jj)) 740 END DO 741 END DO 742 #ifdef key_osm_debug 743 IF(narea==nn_narea_db) THEN 744 ji=iloc_db; jj=jloc_db 745 WRITE(narea+100,'(2(a,g11.3), a, i7,/,2(3(a,g11.3),/),4(a,g11.3),/)') & 746 & 'Before updating hmle: hmle =',hmle(ji,jj) , ' zhmle=', zhmle(ji,jj), ' mld_prof=', mld_prof(ji,jj), & 747 & 'averaging over hmle: zt_mle=', zt_mle(ji,jj), ' zs_mle=', zs_mle(ji,jj), ' zb_mle=', zb_mle(ji,jj),& 748 & 'zdt_mle=', zdt_mle(ji,jj), ' zds_mle=', zds_mle(ji,jj), ' zdb_mle=', zdb_mle(ji,jj),& 749 & 'zu_mle =', zu_mle(ji,jj), ' zv_mle=', zv_mle(ji,jj), ' zdu_mle=', zdu_mle(ji,jj), ' zdv_mle=', zdv_mle(ji,jj) 750 FLUSH(narea+100) 751 END IF 752 #endif 753 754 !! Calculate fairly-well-mixed depth zmld & its index mld_prof + lateral zmld-averaged gradients 755 CALL zdf_osm_zmld_horizontal_gradients( zmld, zdtdx, zdtdy, zdsdx, zdsdy, dbdx_mle, dbdy_mle, zdbds_mle ) 756 !! Calculate vertical gradients immediately below zmld 757 CALL zdf_osm_external_gradients( mld_prof, zdtdz_mle_ext, zdsdz_mle_ext, zdbdz_mle_ext ) 758 !! calculate max vertical FK flux zwb_fk & set logical descriptors 759 CALL zdf_osm_osbl_state_fk( lpyc, lflux, lmle, zwb_fk ) 760 !! recalculate hmle, zmle, zvel_mle, zdiff_mle & redefine mld_proc to be index for new hmle 761 CALL zdf_osm_mle_parameters( zmld, mld_prof, hmle, zhmle, zvel_mle, zdiff_mle ) 762 #ifdef key_osm_debug 763 IF(narea==nn_narea_db) THEN 764 ji=iloc_db; jj=jloc_db 765 WRITE(narea+100,'(a,g11.3,a,i7,/, 2(4(a,g11.3),/),2(a,g11.3),/,2(3(a,g11.3),/),a,i7,2(a,g11.3),/,3(a,g11.3),/,/)') & 766 & 'Before updating hmle: zmld =',zmld(ji,jj),' mld_prof=', mld_prof(ji,jj), & 767 & 'zdtdx+=', zdtdx(ji,jj),' zdtdx-=', zdtdx(ji-1,jj),' zdsdx+=', zdsdx(ji,jj),' zdsdx-=',zdsdx(ji-1,jj), & 768 & 'zdtdy+=', zdtdy(ji,jj),' zdtdy-=', zdtdy(ji,jj-1),' zdsdy+=', zdsdy(ji,jj),' zdsdy-=',zdsdy(ji,jj-1), & 769 & 'dbdx_mle+=', dbdx_mle(ji,jj),' dbdx_mle-=', dbdx_mle(ji-1,jj),& 770 & 'dbdy_mle+=', dbdy_mle(ji,jj),' dbdy_mle-=',dbdy_mle(ji,jj-1),' zdbds_mle=',zdbds_mle(ji,jj), & 771 & 'zdtdz_mle_ext=', zdtdz_mle_ext(ji,jj), ' zdsdz_mle_ext=', zdsdz_mle_ext(ji,jj), & 772 & ' zdbdz_mle_ext=', zdbdz_mle_ext(ji,jj), & 773 & 'After updating hmle: mld_prof=', mld_prof(ji,jj),' hmle=', hmle(ji,jj), ' zhmle=', zhmle(ji,jj),& 774 & 'zvel_mle =', zvel_mle(ji,jj), ' zdiff_mle=', zdiff_mle(ji,jj), ' zwb_fk=', zwb_fk(ji,jj) 775 FLUSH(narea+100) 776 END IF 777 #endif 778 ELSE ! ln_osm_mle 779 ! FK not selected, Boundary Layer only. 780 lpyc(:,:) = .TRUE. 781 lflux(:,:) = .FALSE. 782 lmle(:,:) = .FALSE. 783 DO jj = 2, jpjm1 784 DO ji = 2, jpim1 650 785 IF ( lconv(ji,jj) .AND. zdb_bl(ji,jj) < rn_osm_bl_thresh ) lpyc(ji,jj) = .FALSE. 651 END DO 652 END DO 653 ENDIF ! ln_osm_mle 654 655 ! Test if pycnocline well resolved 656 DO jj = 2, jpjm1 657 DO ji = 2,jpim1 786 END DO 787 END DO 788 ENDIF ! ln_osm_mle 789 790 !! External gradient below BL needed both with and w/o FK 791 CALL zdf_osm_external_gradients( ibld+2, zdtdz_bl_ext, zdsdz_bl_ext, zdbdz_bl_ext ) 792 793 ! Test if pycnocline well resolved 794 DO jj = 2, jpjm1 795 DO ji = 2,jpim1 658 796 IF (lconv(ji,jj) ) THEN 659 797 ztmp = 0.2 * zhbl(ji,jj) / e3w_n(ji,jj,ibld(ji,jj)) 660 798 IF ( ztmp > 6 ) THEN 661 ! pycnocline well resolved662 jp_ext(ji,jj) = 1799 ! pycnocline well resolved 800 jp_ext(ji,jj) = 1 663 801 ELSE 664 ! pycnocline poorly resolved665 jp_ext(ji,jj) = 0802 ! pycnocline poorly resolved 803 jp_ext(ji,jj) = 0 666 804 ENDIF 667 805 ELSE 668 ! Stable conditions669 jp_ext(ji,jj) = 0806 ! Stable conditions 807 jp_ext(ji,jj) = 0 670 808 ENDIF 671 END DO 672 END DO 673 674 CALL zdf_osm_vertical_average(ibld, jp_ext, zt_bl, zs_bl, zb_bl, zu_bl, zv_bl, zdt_bl, zds_bl, zdb_bl, zdu_bl, zdv_bl ) 675 ! jp_ext = ibld-imld+1 676 CALL zdf_osm_vertical_average(imld-1, ibld-imld+1, zt_ml, zs_ml, zb_ml, zu_ml, zv_ml, zdt_ml, zds_ml, zdb_ml, zdu_ml, zdv_ml) 677 ! Rate of change of hbl 678 CALL zdf_osm_calculate_dhdt( zdhdt ) 679 DO jj = 2, jpjm1 680 DO ji = 2, jpim1 809 END DO 810 END DO 811 #ifdef key_osm_debug 812 IF(narea==nn_narea_db) THEN 813 ji=iloc_db; jj=jloc_db 814 WRITE(narea+100,'(4(a,l7),a,i7,/, 3(a,g11.3),/)') & 815 & 'BL logical descriptors: lconv =',lconv(ji,jj),' lpyc=', lpyc(ji,jj),' lflux=', lflux(ji,jj),' lmle=', lmle(ji,jj),& 816 & ' jp_ext=', jp_ext(ji,jj), & 817 & 'sub-BL strat: zdtdz_bl_ext=', zdtdz_bl_ext(ji,jj),' zdsdz_bl_ext=', zdsdz_bl_ext(ji,jj),' zdbdz_bl_ext=', zdbdz_bl_ext(ji,jj) 818 FLUSH(narea+100) 819 END IF 820 #endif 821 822 ! Recalculate bl averages using jp_ext & ml averages .... note no rotation of u & v here.. 823 CALL zdf_osm_vertical_average(ibld, jp_ext, zt_bl, zs_bl, zb_bl, zu_bl, zv_bl, zdt_bl, zds_bl, zdb_bl, zdu_bl, zdv_bl ) 824 ! jp_ext = ibld-imld+1 825 CALL zdf_osm_vertical_average(imld-1, ibld-imld+1, zt_ml, zs_ml, zb_ml, zu_ml, zv_ml, zdt_ml, zds_ml, zdb_ml, zdu_ml, zdv_ml) 826 #ifdef key_osm_debug 827 IF(narea==nn_narea_db) THEN 828 ji=iloc_db; jj=jloc_db 829 WRITE(narea+100,'(4(3(a,g11.3),/), 2(4(a,g11.3),/))') & 830 & 'After averaging, with old hbl (&correct jp_ext), hml: zt_bl=', zt_bl(ji,jj),& 831 & ' zs_bl=', zs_bl(ji,jj), ' zb_bl=', zb_bl(ji,jj),& 832 & 'zdt_bl=', zdt_bl(ji,jj), ' zds_bl=', zds_bl(ji,jj), ' zdb_bl=', zdb_bl(ji,jj),& 833 & 'zt_ml=', zt_ml(ji,jj), ' zs_ml=', zs_ml(ji,jj), ' zb_ml=', zb_ml(ji,jj),& 834 & 'zdt_ml=', zdt_ml(ji,jj), ' zds_ml=', zds_ml(ji,jj), ' zdb_ml=', zdb_ml(ji,jj),& 835 & 'zu_bl =', zu_bl(ji,jj) , ' zv_bl=', zv_bl(ji,jj), ' zdu_bl=', zdu_bl(ji,jj), ' zdv_bl=', zdv_bl(ji,jj),& 836 & 'zu_ml =', zu_ml(ji,jj) , ' zv_ml=', zv_ml(ji,jj), ' zdu_ml=', zdu_ml(ji,jj), ' zdv_ml=', zdv_ml(ji,jj) 837 FLUSH(narea+100) 838 END IF 839 #endif 840 841 842 ! Rate of change of hbl 843 CALL zdf_osm_calculate_dhdt( zdhdt ) 844 DO jj = 2, jpjm1 845 DO ji = 2, jpim1 681 846 zhbl_t(ji,jj) = hbl(ji,jj) + (zdhdt(ji,jj) - wn(ji,jj,ibld(ji,jj)))* rn_rdt ! certainly need wn here, so subtract it 682 847 ! adjustment to represent limiting by ocean bottom 683 848 IF ( zhbl_t(ji,jj) >= gdepw_n(ji, jj, mbkt(ji,jj) + 1 ) ) THEN 684 849 zhbl_t(ji,jj) = MIN(zhbl_t(ji,jj), gdepw_n(ji,jj, mbkt(ji,jj) + 1) - depth_tol)! ht_n(:,:)) 685 850 lpyc(ji,jj) = .FALSE. 686 851 ENDIF 687 END DO 852 #ifdef key_osm_debug 853 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 854 WRITE(narea+100,'(2(a,g11.3),/,2(a,g11.3))')'after zdf_osm_calculate_dhdt: zhbl_t=',zhbl_t(ji,jj), 'hbl=', hbl(ji,jj),& 855 & 'delta hbl from dzdhdt', zdhdt(ji,jj)*rn_rdt,' delta hbl from w ', wn(ji,jj,ibld(ji,jj))*rn_rdt 856 FLUSH(narea+100) 857 END IF 858 #endif 688 859 END DO 689 690 imld(:,:) = ibld(:,:) ! use imld to hold previous blayer index 691 ibld(:,:) = 4 692 693 DO jk = 4, jpkm1 694 DO jj = 2, jpjm1 695 DO ji = 2, jpim1 696 IF ( zhbl_t(ji,jj) >= gdepw_n(ji,jj,jk) ) THEN 697 ibld(ji,jj) = jk 698 ENDIF 699 END DO 700 END DO 701 END DO 702 703 ! 704 ! Step through model levels taking account of buoyancy change to determine the effect on dhdt 705 ! 706 CALL zdf_osm_timestep_hbl( zdhdt ) 707 ! is external level in bounds? 708 709 CALL zdf_osm_vertical_average( ibld, jp_ext, zt_bl, zs_bl, zb_bl, zu_bl, zv_bl, zdt_bl, zds_bl, zdb_bl, zdu_bl, zdv_bl ) 710 ! 711 ! 712 ! Check to see if lpyc needs to be changed 713 714 CALL zdf_osm_pycnocline_thickness( dh, zdh ) 715 716 DO jj = 2, jpjm1 717 DO ji = 2, jpim1 860 END DO 861 862 imld(:,:) = ibld(:,:) ! use imld to hold previous blayer index 863 ibld(:,:) = 4 864 865 DO jk = 4, jpkm1 866 DO jj = 2, jpjm1 867 DO ji = 2, jpim1 868 IF ( zhbl_t(ji,jj) >= gdepw_n(ji,jj,jk) ) THEN 869 ibld(ji,jj) = jk 870 ENDIF 871 END DO 872 END DO 873 END DO 874 875 ! 876 ! Step through model levels taking account of buoyancy change to determine the effect on dhdt 877 ! 878 CALL zdf_osm_timestep_hbl( zdhdt ) 879 ! is external level in bounds? 880 881 ! Recalculate BL averages and differences using new BL depth 882 CALL zdf_osm_vertical_average( ibld, jp_ext, zt_bl, zs_bl, zb_bl, zu_bl, zv_bl, zdt_bl, zds_bl, zdb_bl, zdu_bl, zdv_bl ) 883 ! 884 ! 885 ! Check to see if lpyc needs to be changed 886 887 CALL zdf_osm_pycnocline_thickness( dh, zdh ) 888 889 DO jj = 2, jpjm1 890 DO ji = 2, jpim1 718 891 IF ( zdb_bl(ji,jj) < rn_osm_bl_thresh .or. ibld(ji,jj) + jp_ext(ji,jj) >= mbkt(ji,jj) .or. ibld(ji,jj)-imld(ji,jj) == 1 ) lpyc(ji,jj) = .FALSE. 719 720 END DO721 722 723 !892 END DO 893 END DO 894 895 dstokes(:,:) = MIN ( dstokes(:,:), hbl(:,:)/3. ) ! Limit delta for shallow boundary layers for calculating flux-gradient terms. 896 ! 724 897 ! Average over the depth of the mixed layer in the convective boundary layer 725 ! jp_ext = ibld - imld +1 726 CALL zdf_osm_vertical_average( imld-1, ibld-imld+1, zt_ml, zs_ml, zb_ml, zu_ml, zv_ml, zdt_ml, zds_ml, zdb_ml, zdu_ml, zdv_ml ) 898 ! jp_ext = ibld - imld +1 899 ! Recalculate ML averages and differences using new ML depth 900 CALL zdf_osm_vertical_average( imld-1, ibld-imld+1, zt_ml, zs_ml, zb_ml, zu_ml, zv_ml, zdt_ml, zds_ml, zdb_ml, zdu_ml, zdv_ml ) 727 901 ! rotate mean currents and changes onto wind align co-ordinates 728 902 ! 729 CALL zdf_osm_velocity_rotation( zcos_wind, zsin_wind, zu_ml, zv_ml, zdu_ml, zdv_ml ) 730 CALL zdf_osm_velocity_rotation( zcos_wind, zsin_wind, zu_bl, zv_bl, zdu_bl, zdv_bl ) 731 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 732 ! Pycnocline gradients for scalars and velocity 733 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 734 735 CALL zdf_osm_external_gradients( ibld+2, zdtdz_bl_ext, zdsdz_bl_ext, zdbdz_bl_ext ) 736 CALL zdf_osm_pycnocline_scalar_profiles( zdtdz_pyc, zdsdz_pyc, zdbdz_pyc, zalpha_pyc ) 737 CALL zdf_osm_pycnocline_shear_profiles( zdudz_pyc, zdvdz_pyc ) 738 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 739 ! Eddy viscosity/diffusivity and non-gradient terms in the flux-gradient relationship 740 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 741 CALL zdf_osm_diffusivity_viscosity( zdiffut, zviscos ) 742 903 #ifdef key_osm_debug 904 IF(narea==nn_narea_db) THEN 905 ji=iloc_db; jj=jloc_db 906 WRITE(narea+100,'(4(3(a,g11.3),/), 2(4(a,g11.3),/))') & 907 & 'After averaging, with new hbl (&correct jp_ext), hml: zt_bl=', zt_bl(ji,jj),& 908 & ' zs_bl=', zs_bl(ji,jj), ' zb_bl=', zb_bl(ji,jj),& 909 & 'zdt_bl=', zdt_bl(ji,jj), ' zds_bl=', zds_bl(ji,jj), ' zdb_bl=', zdb_bl(ji,jj),& 910 & 'zt_ml=', zt_ml(ji,jj), ' zs_ml=', zs_ml(ji,jj), ' zb_ml=', zb_ml(ji,jj),& 911 & 'zdt_ml=', zdt_ml(ji,jj), ' zds_ml=', zds_ml(ji,jj), ' zdb_ml=', zdb_ml(ji,jj),& 912 & 'zu_bl =', zu_bl(ji,jj) , ' zv_bl=', zv_bl(ji,jj), ' zdu_bl=', zdu_bl(ji,jj), ' zdv_bl=', zdv_bl(ji,jj),& 913 & 'zu_ml =', zu_ml(ji,jj) , ' zv_ml=', zv_ml(ji,jj), ' zdu_ml=', zdu_ml(ji,jj), ' zdv_ml=', zdv_ml(ji,jj) 914 FLUSH(narea+100) 915 END IF 916 #endif 917 CALL zdf_osm_velocity_rotation( zcos_wind, zsin_wind, zu_ml, zv_ml, zdu_ml, zdv_ml ) 918 CALL zdf_osm_velocity_rotation( zcos_wind, zsin_wind, zu_bl, zv_bl, zdu_bl, zdv_bl ) 919 #ifdef key_osm_debug 920 IF(narea==nn_narea_db) THEN 921 ji=iloc_db; jj=jloc_db 922 WRITE(narea+100,'(a,/, 2(4(a,g11.3),/))') & 923 & 'After rotation, with new hbl (& correct jp_ext), hml:', & 924 & 'zu_bl =', zu_bl(ji,jj) , ' zv_bl=', zv_bl(ji,jj), ' zdu_bl=', zdu_bl(ji,jj), ' zdv_bl=', zdv_bl(ji,jj),& 925 & 'zu_ml =', zu_ml(ji,jj) , ' zv_ml=', zv_ml(ji,jj), ' zdu_ml=', zdu_ml(ji,jj), ' zdv_ml=', zdv_ml(ji,jj) 926 FLUSH(narea+100) 927 END IF 928 #endif 929 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 930 ! Pycnocline gradients for scalars and velocity 931 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 932 933 CALL zdf_osm_external_gradients( ibld+2, zdtdz_bl_ext, zdsdz_bl_ext, zdbdz_bl_ext ) 934 CALL zdf_osm_pycnocline_scalar_profiles( zdtdz_pyc, zdsdz_pyc, zdbdz_pyc, zalpha_pyc ) 935 CALL zdf_osm_pycnocline_shear_profiles( zdudz_pyc, zdvdz_pyc ) 936 #ifdef key_osm_debug 937 IF(narea==nn_narea_db) THEN 938 ji=iloc_db; jj=jloc_db 939 jl = imld(ji,jj) - 1; jm = MIN(ibld(ji,jj) + 2, mbkt(ji,jj) ) 940 WRITE(narea+100,'(a,l7,/,3(a,g11.3),/)') & 941 & 'After pycnocline profiles BL lpyc=', lpyc(ji,jj),& 942 & 'sub-BL strat: zdtdz_bl_ext=', zdtdz_bl_ext(ji,jj),' zdsdz_bl_ext=', zdsdz_bl_ext(ji,jj),' zdbdz_bl_ext=', zdbdz_bl_ext(ji,jj), & 943 & 'Pycnocline: zalpha_pyc=', zalpha_pyc(ji,jj) 944 WRITE(narea+100,'(a,*(g11.3))') ' zdtdz_pyc[imld-1..ibld+2] =', ( zdtdz_pyc(ji,jj,jk), jk=jl,jm ) 945 WRITE(narea+100,'(a,*(g11.3))') ' zdsdz_pyc[imld-1..ibld+2] =', ( zdsdz_pyc(ji,jj,jk), jk=jl,jm ) 946 WRITE(narea+100,'(a,*(g11.3))') ' zdbdz_pyc[imld-1..ibld+2] =', ( zdbdz_pyc(ji,jj,jk), jk=jl,jm ) 947 WRITE(narea+100,'(a,*(g11.3))') ' zdudz_pyc[imld-1..ibld+2] =', ( zdudz_pyc(ji,jj,jk), jk=jl,jm ) 948 WRITE(narea+100,'(a,*(g11.3))') ' zdvdz_pyc[imld-1..ibld+2] =', ( zdvdz_pyc(ji,jj,jk), jk=jl,jm ) 949 WRITE(narea+100,*) 950 FLUSH(narea+100) 951 END IF 952 #endif 953 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 954 ! Eddy viscosity/diffusivity and non-gradient terms in the flux-gradient relationship 955 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 956 CALL zdf_osm_diffusivity_viscosity( zdiffut, zviscos ) 957 #ifdef key_osm_debug 958 IF(narea==nn_narea_db) THEN 959 ji=iloc_db; jj=jloc_db 960 jl = imld(ji,jj) - 1; jm = MIN(ibld(ji,jj) + 2, mbkt(ji,jj) ) 961 WRITE(narea+100,'(a,*(g11.3))') ' zdiffut[imld-1..ibld+2] =', ( zdiffut(ji,jj,jk), jk=jl,jm ) 962 WRITE(narea+100,'(a,*(g11.3))') ' zviscos[imld-1..ibld+2] =', ( zviscos(ji,jj,jk), jk=jl,jm ) 963 WRITE(narea+100,*) 964 FLUSH(narea+100) 965 END IF 966 #endif 967 968 ! 969 ! calculate non-gradient components of the flux-gradient relationships 970 ! 971 ! Stokes term in scalar flux, flux-gradient relationship 972 WHERE ( lconv ) 973 zsc_wth_1 = zwstrl**3 * zwth0 / ( zvstr**3 + 0.5 * zwstrc**3 + epsln) 743 974 ! 744 ! calculate non-gradient components of the flux-gradient relationships 975 zsc_ws_1 = zwstrl**3 * zws0 / ( zvstr**3 + 0.5 * zwstrc**3 + epsln ) 976 ELSEWHERE 977 zsc_wth_1 = 2.0 * zwthav 745 978 ! 746 ! Stokes term in scalar flux, flux-gradient relationship 747 WHERE ( lconv ) 748 zsc_wth_1 = zwstrl**3 * zwth0 / ( zvstr**3 + 0.5 * zwstrc**3 + epsln) 749 ! 750 zsc_ws_1 = zwstrl**3 * zws0 / ( zvstr**3 + 0.5 * zwstrc**3 + epsln ) 751 ELSEWHERE 752 zsc_wth_1 = 2.0 * zwthav 753 ! 754 zsc_ws_1 = 2.0 * zwsav 755 ENDWHERE 756 757 758 DO jj = 2, jpjm1 759 DO ji = 2, jpim1 760 IF ( lconv(ji,jj) ) THEN 761 DO jk = 2, imld(ji,jj) 762 zznd_d = gdepw_n(ji,jj,jk) / dstokes(ji,jj) 763 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 1.35 * EXP ( -zznd_d ) * ( 1.0 - EXP ( -2.0 * zznd_d ) ) * zsc_wth_1(ji,jj) 764 ! 765 ghams(ji,jj,jk) = ghams(ji,jj,jk) + 1.35 * EXP ( -zznd_d ) * ( 1.0 - EXP ( -2.0 * zznd_d ) ) * zsc_ws_1(ji,jj) 766 END DO ! end jk loop 767 ELSE ! else for if (lconv) 768 ! Stable conditions 769 DO jk = 2, ibld(ji,jj) 770 zznd_d=gdepw_n(ji,jj,jk) / dstokes(ji,jj) 771 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 2.15 * EXP ( -0.85 * zznd_d ) & 772 & * ( 1.0 - EXP ( -4.0 * zznd_d ) ) * zsc_wth_1(ji,jj) 773 ! 774 ghams(ji,jj,jk) = ghams(ji,jj,jk) + 2.15 * EXP ( -0.85 * zznd_d ) & 775 & * ( 1.0 - EXP ( -4.0 * zznd_d ) ) * zsc_ws_1(ji,jj) 776 END DO 777 ENDIF ! endif for check on lconv 778 779 END DO ! end of ji loop 780 END DO ! end of jj loop 781 782 ! Stokes term in flux-gradient relationship (note in zsc_uw_n don't use zvstr since term needs to go to zero as zwstrl goes to zero) 783 WHERE ( lconv ) 784 zsc_uw_1 = ( zwstrl**3 + 0.5 * zwstrc**3 )**pthird * zustke / MAX( ( 1.0 - 1.0 * 6.5 * zla**(8.0/3.0) ), 0.2 ) 785 zsc_uw_2 = ( zwstrl**3 + 0.5 * zwstrc**3 )**pthird * zustke / MIN( zla**(8.0/3.0) + epsln, 0.12 ) 786 zsc_vw_1 = ff_t * zhml * zustke**3 * MIN( zla**(8.0/3.0), 0.12 ) / ( ( zvstr**3 + 0.5 * zwstrc**3 )**(2.0/3.0) + epsln ) 787 ELSEWHERE 788 zsc_uw_1 = zustar**2 789 zsc_vw_1 = ff_t * zhbl * zustke**3 * MIN( zla**(8.0/3.0), 0.12 ) / (zvstr**2 + epsln) 790 ENDWHERE 791 IF(ln_dia_osm) THEN 792 IF ( iom_use("ghamu_00") ) CALL iom_put( "ghamu_00", wmask*ghamu ) 793 IF ( iom_use("ghamv_00") ) CALL iom_put( "ghamv_00", wmask*ghamv ) 979 zsc_ws_1 = 2.0 * zwsav 980 ENDWHERE 981 982 983 DO jj = 2, jpjm1 984 DO ji = 2, jpim1 985 IF ( lconv(ji,jj) ) THEN 986 DO jk = 2, imld(ji,jj) 987 zznd_d = gdepw_n(ji,jj,jk) / dstokes(ji,jj) 988 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 1.35 * EXP ( -zznd_d ) * ( 1.0 - EXP ( -2.0 * zznd_d ) ) * zsc_wth_1(ji,jj) 989 ! 990 ghams(ji,jj,jk) = ghams(ji,jj,jk) + 1.35 * EXP ( -zznd_d ) * ( 1.0 - EXP ( -2.0 * zznd_d ) ) * zsc_ws_1(ji,jj) 991 END DO ! end jk loop 992 ELSE ! else for if (lconv) 993 ! Stable conditions 994 DO jk = 2, ibld(ji,jj) 995 zznd_d=gdepw_n(ji,jj,jk) / dstokes(ji,jj) 996 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 2.15 * EXP ( -0.85 * zznd_d ) & 997 & * ( 1.0 - EXP ( -4.0 * zznd_d ) ) * zsc_wth_1(ji,jj) 998 ! 999 ghams(ji,jj,jk) = ghams(ji,jj,jk) + 2.15 * EXP ( -0.85 * zznd_d ) & 1000 & * ( 1.0 - EXP ( -4.0 * zznd_d ) ) * zsc_ws_1(ji,jj) 1001 END DO 1002 ENDIF ! endif for check on lconv 1003 END DO ! end of ji loop 1004 END DO ! end of jj loop 1005 1006 ! Stokes term in flux-gradient relationship (note in zsc_uw_n don't use zvstr since term needs to go to zero as zwstrl goes to zero) 1007 WHERE ( lconv ) 1008 zsc_uw_1 = ( zwstrl**3 + 0.5 * zwstrc**3 )**pthird * zustke / MAX( ( 1.0 - 1.0 * 6.5 * zla**(8.0/3.0) ), 0.2 ) 1009 zsc_uw_2 = ( zwstrl**3 + 0.5 * zwstrc**3 )**pthird * zustke / MIN( zla**(8.0/3.0) + epsln, 0.12 ) 1010 zsc_vw_1 = ff_t * zhml * zustke**3 * MIN( zla**(8.0/3.0), 0.12 ) / ( ( zvstr**3 + 0.5 * zwstrc**3 )**(2.0/3.0) + epsln ) 1011 ELSEWHERE 1012 zsc_uw_1 = zustar**2 1013 zsc_vw_1 = ff_t * zhbl * zustke**3 * MIN( zla**(8.0/3.0), 0.12 ) / (zvstr**2 + epsln) 1014 ENDWHERE 1015 IF(ln_dia_osm) THEN 1016 IF ( iom_use("ghamu_00") ) CALL iom_put( "ghamu_00", wmask*ghamu ) 1017 IF ( iom_use("ghamv_00") ) CALL iom_put( "ghamv_00", wmask*ghamv ) 1018 END IF 1019 DO jj = 2, jpjm1 1020 DO ji = 2, jpim1 1021 IF ( lconv(ji,jj) ) THEN 1022 DO jk = 2, imld(ji,jj) 1023 zznd_d = gdepw_n(ji,jj,jk) / dstokes(ji,jj) 1024 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + ( -0.05 * EXP ( -0.4 * zznd_d ) * zsc_uw_1(ji,jj) & 1025 & + 0.00125 * EXP ( - zznd_d ) * zsc_uw_2(ji,jj) ) & 1026 & * ( 1.0 - EXP ( -2.0 * zznd_d ) ) 1027 ! 1028 ghamv(ji,jj,jk) = ghamv(ji,jj,jk) - 0.65 * 0.15 * EXP ( - zznd_d ) & 1029 & * ( 1.0 - EXP ( -2.0 * zznd_d ) ) * zsc_vw_1(ji,jj) 1030 END DO ! end jk loop 1031 ELSE 1032 ! Stable conditions 1033 DO jk = 2, ibld(ji,jj) ! corrected to ibld 1034 zznd_d = gdepw_n(ji,jj,jk) / dstokes(ji,jj) 1035 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) - 0.75 * 1.3 * EXP ( -0.5 * zznd_d ) & 1036 & * ( 1.0 - EXP ( -4.0 * zznd_d ) ) * zsc_uw_1(ji,jj) 1037 ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + 0._wp 1038 END DO ! end jk loop 1039 ENDIF 1040 END DO ! ji loop 1041 END DO ! jj loo 1042 #ifdef key_osm_debug 1043 IF(narea==nn_narea_db) THEN 1044 ji=iloc_db; jj=jloc_db 1045 jl = imld(ji,jj) - 1; jm = MIN(ibld(ji,jj) + 2, mbkt(ji,jj) ) 1046 WRITE(narea+100,'(a,g11.3)')'Stokes contrib to ghamt/s: zsc_wth_1=',zsc_wth_1(ji,jj), ' zsc_ws_1=',zsc_ws_1(ji,jj) 1047 WRITE(narea+100,'(a,*(g11.3))') ' ghamt[imld-1..ibld+2] =', ( ghamt(ji,jj,jk), jk=jl,jm ) 1048 WRITE(narea+100,'(a,*(g11.3))') ' ghams[imld-1..ibld+2] =', ( ghams(ji,jj,jk), jk=jl,jm ) 1049 IF( lconv(ji,jj) ) THEN 1050 WRITE(narea+100,'(3(a,g11.3))')'Stokes contrib to ghamu/v: zsc_uw_1=',zsc_uw_1(ji,jj), ' zsc_vw_1=',zsc_vw_1(ji,jj), & 1051 &' zsc_uw_2=',zsc_uw_2(ji,jj) 1052 ELSE 1053 WRITE(narea+100,'(2(a,g11.3))')'Stokes contrib to ghamu/v: zsc_uw_1=',zsc_uw_1(ji,jj), ' zsc_vw_1=',zsc_vw_1(ji,jj) 794 1054 END IF 795 DO jj = 2, jpjm1 796 DO ji = 2, jpim1 797 IF ( lconv(ji,jj) ) THEN 798 DO jk = 2, imld(ji,jj) 799 zznd_d = gdepw_n(ji,jj,jk) / dstokes(ji,jj) 800 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + ( -0.05 * EXP ( -0.4 * zznd_d ) * zsc_uw_1(ji,jj) & 801 & + 0.00125 * EXP ( - zznd_d ) * zsc_uw_2(ji,jj) ) & 802 & * ( 1.0 - EXP ( -2.0 * zznd_d ) ) 803 ! 804 ghamv(ji,jj,jk) = ghamv(ji,jj,jk) - 0.65 * 0.15 * EXP ( - zznd_d ) & 805 & * ( 1.0 - EXP ( -2.0 * zznd_d ) ) * zsc_vw_1(ji,jj) 806 END DO ! end jk loop 807 ELSE 808 ! Stable conditions 809 DO jk = 2, ibld(ji,jj) ! corrected to ibld 810 zznd_d = gdepw_n(ji,jj,jk) / dstokes(ji,jj) 811 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) - 0.75 * 1.3 * EXP ( -0.5 * zznd_d ) & 812 & * ( 1.0 - EXP ( -4.0 * zznd_d ) ) * zsc_uw_1(ji,jj) 813 ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + 0._wp 814 END DO ! end jk loop 1055 WRITE(narea+100,'(a,*(g11.3))') ' ghamu[imld-1..ibld+2] =', ( ghamu(ji,jj,jk), jk=jl,jm ) 1056 WRITE(narea+100,'(a,*(g11.3))') ' ghamv[imld-1..ibld+2] =', ( ghamv(ji,jj,jk), jk=jl,jm ) 1057 FLUSH(narea+100) 1058 END IF 1059 #endif 1060 1061 ! Buoyancy term in flux-gradient relationship [note : includes ROI ratio (X0.3) and pressure (X0.5)] 1062 1063 WHERE ( lconv ) 1064 zsc_wth_1 = zwbav * zwth0 * ( 1.0 + EXP ( 0.2 * zhol ) ) * zhml / ( zvstr**3 + 0.5 * zwstrc**3 + epsln ) 1065 zsc_ws_1 = zwbav * zws0 * ( 1.0 + EXP ( 0.2 * zhol ) ) * zhml / ( zvstr**3 + 0.5 * zwstrc**3 + epsln ) 1066 ELSEWHERE 1067 zsc_wth_1 = 0._wp 1068 zsc_ws_1 = 0._wp 1069 ENDWHERE 1070 1071 DO jj = 2, jpjm1 1072 DO ji = 2, jpim1 1073 IF (lconv(ji,jj) ) THEN 1074 DO jk = 2, imld(ji,jj) 1075 zznd_ml = gdepw_n(ji,jj,jk) / zhml(ji,jj) 1076 ! calculate turbulent time scale 1077 zl_c = 0.9 * ( 1.0 - EXP ( - 5.0 * ( zznd_ml + zznd_ml**3 / 3.0 ) ) ) & 1078 & * ( 1.0 - EXP ( -15.0 * ( 1.2 - zznd_ml ) ) ) 1079 zl_l = 2.0 * ( 1.0 - EXP ( - 2.0 * ( zznd_ml + zznd_ml**3 / 3.0 ) ) ) & 1080 & * ( 1.0 - EXP ( - 8.0 * ( 1.15 - zznd_ml ) ) ) * ( 1.0 + dstokes(ji,jj) / zhml (ji,jj) ) 1081 zl_eps = zl_l + ( zl_c - zl_l ) / ( 1.0 + EXP ( -3.0 * LOG10 ( - zhol(ji,jj) ) ) ) ** (3.0 / 2.0) 1082 ! non-gradient buoyancy terms 1083 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 0.3 * 0.4 * zsc_wth_1(ji,jj) * zl_eps / ( 0.15 + zznd_ml ) 1084 ghams(ji,jj,jk) = ghams(ji,jj,jk) + 0.3 * 0.4 * zsc_ws_1(ji,jj) * zl_eps / ( 0.15 + zznd_ml ) 1085 END DO 1086 1087 IF ( lpyc(ji,jj) ) THEN 1088 ztau_sc_u(ji,jj) = zhml(ji,jj) / ( zvstr(ji,jj)**3 + zwstrc(ji,jj)**3 )**pthird 1089 ztau_sc_u(ji,jj) = ztau_sc_u(ji,jj) * ( 1.4 -0.4 / ( 1.0 + EXP( -3.5 * LOG10( -zhol(ji,jj) ) ) )**1.5 ) 1090 zwth_ent = -0.003 * ( 0.15 * zvstr(ji,jj)**3 + zwstrc(ji,jj)**3 )**pthird * ( 1.0 - zdh(ji,jj) /zhbl(ji,jj) ) * zdt_ml(ji,jj) 1091 zws_ent = -0.003 * ( 0.15 * zvstr(ji,jj)**3 + zwstrc(ji,jj)**3 )**pthird * ( 1.0 - zdh(ji,jj) /zhbl(ji,jj) ) * zds_ml(ji,jj) 1092 ! Cubic profile used for buoyancy term 1093 DO jk = 2, ibld(ji,jj) 1094 zznd_pyc = -( gdepw_n(ji,jj,jk) - zhbl(ji,jj) ) / zdh(ji,jj) 1095 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) - 0.045 * ( ( zwth_ent * zdbdz_pyc(ji,jj,jk) ) * ztau_sc_u(ji,jj)**2 ) * MAX( ( 1.75 * zznd_pyc -0.15 * zznd_pyc**2 - 0.2 * zznd_pyc**3 ), 0.0 ) 1096 1097 ghams(ji,jj,jk) = ghams(ji,jj,jk) - 0.045 * ( ( zws_ent * zdbdz_pyc(ji,jj,jk) ) * ztau_sc_u(ji,jj)**2 ) * MAX( ( 1.75 * zznd_pyc -0.15 * zznd_pyc**2 - 0.2 * zznd_pyc**3 ), 0.0 ) 1098 END DO 1099 ! 1100 IF ( dh(ji,jj) < 0.2*hbl(ji,jj) ) THEN 1101 zbuoy_pyc_sc = zalpha_pyc(ji,jj) * zdb_ml(ji,jj) / zdh(ji,jj) + zdbdz_bl_ext(ji,jj) 1102 zdelta_pyc = ( zvstr(ji,jj)**3 + zwstrc(ji,jj)**3 )**pthird / SQRT( MAX( zbuoy_pyc_sc, ( zvstr(ji,jj)**3 + zwstrc(ji,jj)**3 )**p2third / zdh(ji,jj)**2 ) ) 1103 ! 1104 zwt_pyc_sc_1 = 0.325 * ( zalpha_pyc(ji,jj) * zdt_ml(ji,jj) / zdh(ji,jj) + zdtdz_bl_ext(ji,jj) ) * zdelta_pyc**2 / zdh(ji,jj) 1105 ! 1106 zws_pyc_sc_1 = 0.325 * ( zalpha_pyc(ji,jj) * zds_ml(ji,jj) / zdh(ji,jj) + zdsdz_bl_ext(ji,jj) ) * zdelta_pyc**2 / zdh(ji,jj) 1107 ! 1108 zzeta_pyc = 0.15 - 0.175 / ( 1.0 + EXP( -3.5 * LOG10( -zhol(ji,jj) ) ) ) 1109 DO jk = 2, ibld(ji,jj) 1110 zznd_pyc = -( gdepw_n(ji,jj,jk) - zhbl(ji,jj) ) / zdh(ji,jj) 1111 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 0.05 * zwt_pyc_sc_1 * EXP( -0.25 * ( zznd_pyc / zzeta_pyc )**2 ) * zdh(ji,jj) / ( zvstr(ji,jj)**3 + zwstrc(ji,jj)**3 )**pthird 1112 ! 1113 ghams(ji,jj,jk) = ghams(ji,jj,jk) + 0.05 * zws_pyc_sc_1 * EXP( -0.25 * ( zznd_pyc / zzeta_pyc )**2 ) * zdh(ji,jj) / ( zvstr(ji,jj)**3 + zwstrc(ji,jj)**3 )**pthird 1114 END DO 1115 END IF 1116 ENDIF ! End of pycnocline 1117 ELSE ! lconv test - stable conditions 1118 DO jk = 2, ibld(ji,jj) 1119 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + zsc_wth_1(ji,jj) 1120 ghams(ji,jj,jk) = ghams(ji,jj,jk) + zsc_ws_1(ji,jj) 1121 END DO 1122 ENDIF 1123 END DO ! ji loop 1124 END DO ! jj loop 1125 1126 WHERE ( lconv ) 1127 zsc_uw_1 = -zwb0 * zustar**2 * zhml / ( zvstr**3 + 0.5 * zwstrc**3 + epsln ) 1128 zsc_uw_2 = zwb0 * zustke * zhml / ( zvstr**3 + 0.5 * zwstrc**3 + epsln )**(2.0/3.0) 1129 zsc_vw_1 = 0._wp 1130 ELSEWHERE 1131 zsc_uw_1 = 0._wp 1132 zsc_vw_1 = 0._wp 1133 ENDWHERE 1134 1135 DO jj = 2, jpjm1 1136 DO ji = 2, jpim1 1137 IF ( lconv(ji,jj) ) THEN 1138 DO jk = 2 , imld(ji,jj) 1139 zznd_d = gdepw_n(ji,jj,jk) / dstokes(ji,jj) 1140 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + 0.3 * 0.5 * ( zsc_uw_1(ji,jj) + 0.125 * EXP( -0.5 * zznd_d ) & 1141 & * ( 1.0 - EXP( -0.5 * zznd_d ) ) & 1142 & * zsc_uw_2(ji,jj) ) 1143 ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + zsc_vw_1(ji,jj) 1144 END DO ! jk loop 1145 ELSE 1146 ! stable conditions 1147 DO jk = 2, ibld(ji,jj) 1148 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + zsc_uw_1(ji,jj) 1149 ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + zsc_vw_1(ji,jj) 1150 END DO 1151 ENDIF 1152 END DO ! ji loop 1153 END DO ! jj loop 1154 1155 DO jj = 2, jpjm1 1156 DO ji = 2, jpim1 1157 IF( lconv(ji,jj) ) THEN 1158 IF ( lpyc(ji,jj) ) THEN 1159 IF ( j_ddh(ji,jj) == 0 ) THEN 1160 ! Place holding code. Parametrization needs checking for these conditions. 1161 zomega = ( 0.15 * zwstrl(ji,jj)**3 + zwstrc(ji,jj)**3 + 4.75 * ( zshear(ji,jj)* zhbl(ji,jj) ))**pthird 1162 zuw_bse = -0.0035 * zomega * ( 1.0 - zdh(ji,jj) / zhbl(ji,jj) ) * zdu_ml(ji,jj) 1163 zvw_bse = -0.0075 * zomega * ( 1.0 - zdh(ji,jj) / zhbl(ji,jj) ) * zdv_ml(ji,jj) 1164 ELSE 1165 zomega = ( 0.15 * zwstrl(ji,jj)**3 + zwstrc(ji,jj)**3 + 4.75 * ( zshear(ji,jj)* zhbl(ji,jj) ))**pthird 1166 zuw_bse = -0.0035 * zomega * ( 1.0 - zdh(ji,jj) / zhbl(ji,jj) ) * zdu_ml(ji,jj) 1167 zvw_bse = -0.0075 * zomega * ( 1.0 - zdh(ji,jj) / zhbl(ji,jj) ) * zdv_ml(ji,jj) 1168 ENDIF 1169 zd_cubic = zdh(ji,jj) / zhbl(ji,jj) * zuw0(ji,jj) - ( 2.0 + zdh(ji,jj) /zhml(ji,jj) ) * zuw_bse 1170 zc_cubic = zuw_bse - zd_cubic 1171 ! need ztau_sc_u to be available. Change to array. 1172 DO jk = imld(ji,jj), ibld(ji,jj) 1173 zznd_pyc = - ( gdepw_n(ji,jj,jk) - zhbl(ji,jj) ) / zdh(ji,jj) 1174 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) - 0.045 * ( ztau_sc_u(ji,jj)**2 ) * zuw_bse * & 1175 & ( zc_cubic * zznd_pyc**2 + zd_cubic * zznd_pyc**3 ) * ( 0.75 + 0.25 * zznd_pyc )**2 * zdbdz_pyc(ji,jj,jk) 1176 END DO 1177 zvw_max = 0.7 * ff_t(ji,jj) * ( zustke(ji,jj) * dstokes(ji,jj) + 0.75 * zustar(ji,jj) * zhml(ji,jj) ) 1178 zd_cubic = zvw_max * zdh(ji,jj) / zhml(ji,jj) - ( 2.0 + zdh(ji,jj) /zhml(ji,jj) ) * zvw_bse 1179 zc_cubic = zvw_bse - zd_cubic 1180 DO jk = imld(ji,jj), ibld(ji,jj) 1181 zznd_pyc = -( gdepw_n(ji,jj,jk) -zhbl(ji,jj) ) / zdh(ji,jj) 1182 ghamv(ji,jj,jk) = ghamv(ji,jj,jk) - 0.045 * ( ztau_sc_u(ji,jj)**2 ) * zvw_bse * & 1183 & ( zc_cubic * zznd_pyc**2 + zd_cubic * zznd_pyc**3 ) * ( 0.75 + 0.25 * zznd_pyc )**2 * zdbdz_pyc(ji,jj,jk) 1184 END DO 1185 ENDIF ! lpyc 1186 ENDIF ! lconv 1187 END DO ! ji loop 1188 END DO ! jj loop 1189 1190 #ifdef key_osm_debug 1191 IF(narea==nn_narea_db) THEN 1192 ji=iloc_db; jj=jloc_db 1193 jl = imld(ji,jj) - 1; jm = MIN(ibld(ji,jj) + 2, mbkt(ji,jj) ) 1194 WRITE(narea+100,'(2(a,g11.3))')'Stokes + buoy + pyc contribs to ghamt/s: zsc_wth_1=',zsc_wth_1(ji,jj), ' zsc_ws_1=',zsc_ws_1(ji,jj) 1195 WRITE(narea+100,'(a,*(g11.3))') ' ghamt[imld-1..ibld+2] =', ( ghamt(ji,jj,jk), jk=jl,jm ) 1196 WRITE(narea+100,'(a,*(g11.3))') ' ghams[imld-1..ibld+2] =', ( ghams(ji,jj,jk), jk=jl,jm ) 1197 IF( lconv(ji,jj) ) THEN 1198 WRITE(narea+100,'(3(a,g11.3))')'Stokes + buoy + pyc contribs to ghamu/v: zsc_uw_1=',zsc_uw_1(ji,jj), ' zsc_vw_1=',zsc_vw_1(ji,jj), & 1199 &' zsc_uw_2=',zsc_uw_2(ji,jj) 1200 ELSE 1201 WRITE(narea+100,'(2(a,g11.3))')'Stokes + buoy + pyc contribs to ghamu/v: zsc_uw_1=',zsc_uw_1(ji,jj), ' zsc_vw_1=',zsc_vw_1(ji,jj) 1202 END IF 1203 WRITE(narea+100,'(a,*(g11.3))') ' ghamu[imld-1..ibld+2] =', ( ghamu(ji,jj,jk), jk=jl,jm ) 1204 WRITE(narea+100,'(a,*(g11.3))') ' ghamv[imld-1..ibld+2] =', ( ghamv(ji,jj,jk), jk=jl,jm ) 1205 FLUSH(narea+100) 1206 END IF 1207 #endif 1208 1209 IF(ln_dia_osm) THEN 1210 IF ( iom_use("ghamu_0") ) CALL iom_put( "ghamu_0", wmask*ghamu ) 1211 IF ( iom_use("zsc_uw_1_0") ) CALL iom_put( "zsc_uw_1_0", tmask(:,:,1)*zsc_uw_1 ) 1212 END IF 1213 ! Transport term in flux-gradient relationship [note : includes ROI ratio (X0.3) ] 1214 1215 DO jj = 1, jpjm1 1216 DO ji = 1, jpim1 1217 1218 IF ( lconv(ji,jj) ) THEN 1219 zsc_wth_1(ji,jj) = zwth0(ji,jj) / ( 1.0 - 0.56 * EXP( zhol(ji,jj) ) ) 1220 zsc_ws_1(ji,jj) = zws0(ji,jj) / (1.0 - 0.56 *EXP( zhol(ji,jj) ) ) 1221 IF ( lpyc(ji,jj) ) THEN 1222 ! Pycnocline scales 1223 zsc_wth_pyc(ji,jj) = -0.003 * zwstrc(ji,jj) * ( 1.0 - zdh(ji,jj) /zhbl(ji,jj) ) * zdt_ml(ji,jj) 1224 zsc_ws_pyc(ji,jj) = -0.003 * zwstrc(ji,jj) * ( 1.0 - zdh(ji,jj) /zhbl(ji,jj) ) * zds_ml(ji,jj) 815 1225 ENDIF 816 END DO ! ji loop 817 END DO ! jj loo 818 819 ! Buoyancy term in flux-gradient relationship [note : includes ROI ratio (X0.3) and pressure (X0.5)] 820 821 WHERE ( lconv ) 822 zsc_wth_1 = zwbav * zwth0 * ( 1.0 + EXP ( 0.2 * zhol ) ) * zhml / ( zvstr**3 + 0.5 * zwstrc**3 + epsln ) 823 zsc_ws_1 = zwbav * zws0 * ( 1.0 + EXP ( 0.2 * zhol ) ) * zhml / ( zvstr**3 + 0.5 * zwstrc**3 + epsln ) 824 ELSEWHERE 825 zsc_wth_1 = 0._wp 826 zsc_ws_1 = 0._wp 827 ENDWHERE 828 829 DO jj = 2, jpjm1 830 DO ji = 2, jpim1 831 IF (lconv(ji,jj) ) THEN 832 DO jk = 2, imld(ji,jj) 833 zznd_ml = gdepw_n(ji,jj,jk) / zhml(ji,jj) 834 ! calculate turbulent time scale 835 zl_c = 0.9 * ( 1.0 - EXP ( - 5.0 * ( zznd_ml + zznd_ml**3 / 3.0 ) ) ) & 836 & * ( 1.0 - EXP ( -15.0 * ( 1.2 - zznd_ml ) ) ) 837 zl_l = 2.0 * ( 1.0 - EXP ( - 2.0 * ( zznd_ml + zznd_ml**3 / 3.0 ) ) ) & 838 & * ( 1.0 - EXP ( - 8.0 * ( 1.15 - zznd_ml ) ) ) * ( 1.0 + dstokes(ji,jj) / zhml (ji,jj) ) 839 zl_eps = zl_l + ( zl_c - zl_l ) / ( 1.0 + EXP ( -3.0 * LOG10 ( - zhol(ji,jj) ) ) ) ** (3.0 / 2.0) 840 ! non-gradient buoyancy terms 841 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 0.3 * 0.4 * zsc_wth_1(ji,jj) * zl_eps / ( 0.15 + zznd_ml ) 842 ghams(ji,jj,jk) = ghams(ji,jj,jk) + 0.3 * 0.4 * zsc_ws_1(ji,jj) * zl_eps / ( 0.15 + zznd_ml ) 843 END DO 844 845 IF ( lpyc(ji,jj) ) THEN 846 ztau_sc_u(ji,jj) = zhml(ji,jj) / ( zvstr(ji,jj)**3 + zwstrc(ji,jj)**3 )**pthird 847 ztau_sc_u(ji,jj) = ztau_sc_u(ji,jj) * ( 1.4 -0.4 / ( 1.0 + EXP( -3.5 * LOG10( -zhol(ji,jj) ) ) )**1.5 ) 848 zwth_ent = -0.003 * ( 0.15 * zvstr(ji,jj)**3 + zwstrc(ji,jj)**3 )**pthird * ( 1.0 - zdh(ji,jj) /zhbl(ji,jj) ) * zdt_ml(ji,jj) 849 zws_ent = -0.003 * ( 0.15 * zvstr(ji,jj)**3 + zwstrc(ji,jj)**3 )**pthird * ( 1.0 - zdh(ji,jj) /zhbl(ji,jj) ) * zds_ml(ji,jj) 850 ! Cubic profile used for buoyancy term 851 DO jk = 2, ibld(ji,jj) 852 zznd_pyc = -( gdepw_n(ji,jj,jk) - zhbl(ji,jj) ) / zdh(ji,jj) 853 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) - 0.045 * ( ( zwth_ent * zdbdz_pyc(ji,jj,jk) ) * ztau_sc_u(ji,jj)**2 ) * MAX( ( 1.75 * zznd_pyc -0.15 * zznd_pyc**2 - 0.2 * zznd_pyc**3 ), 0.0 ) 854 855 ghams(ji,jj,jk) = ghams(ji,jj,jk) - 0.045 * ( ( zws_ent * zdbdz_pyc(ji,jj,jk) ) * ztau_sc_u(ji,jj)**2 ) * MAX( ( 1.75 * zznd_pyc -0.15 * zznd_pyc**2 - 0.2 * zznd_pyc**3 ), 0.0 ) 856 END DO 857 ! 858 IF ( dh(ji,jj) < 0.2*hbl(ji,jj) ) THEN 859 zbuoy_pyc_sc = zalpha_pyc(ji,jj) * zdb_ml(ji,jj) / zdh(ji,jj) + zdbdz_bl_ext(ji,jj) 860 zdelta_pyc = ( zvstr(ji,jj)**3 + zwstrc(ji,jj)**3 )**pthird / SQRT( MAX( zbuoy_pyc_sc, ( zvstr(ji,jj)**3 + zwstrc(ji,jj)**3 )**p2third / zdh(ji,jj)**2 ) ) 861 ! 862 zwt_pyc_sc_1 = 0.325 * ( zalpha_pyc(ji,jj) * zdt_ml(ji,jj) / zdh(ji,jj) + zdtdz_bl_ext(ji,jj) ) * zdelta_pyc**2 / zdh(ji,jj) 863 ! 864 zws_pyc_sc_1 = 0.325 * ( zalpha_pyc(ji,jj) * zds_ml(ji,jj) / zdh(ji,jj) + zdsdz_bl_ext(ji,jj) ) * zdelta_pyc**2 / zdh(ji,jj) 865 ! 866 zzeta_pyc = 0.15 - 0.175 / ( 1.0 + EXP( -3.5 * LOG10( -zhol(ji,jj) ) ) ) 867 DO jk = 2, ibld(ji,jj) 868 zznd_pyc = -( gdepw_n(ji,jj,jk) - zhbl(ji,jj) ) / zdh(ji,jj) 869 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 0.05 * zwt_pyc_sc_1 * EXP( -0.25 * ( zznd_pyc / zzeta_pyc )**2 ) * zdh(ji,jj) / ( zvstr(ji,jj)**3 + zwstrc(ji,jj)**3 )**pthird 870 ! 871 ghams(ji,jj,jk) = ghams(ji,jj,jk) + 0.05 * zws_pyc_sc_1 * EXP( -0.25 * ( zznd_pyc / zzeta_pyc )**2 ) * zdh(ji,jj) / ( zvstr(ji,jj)**3 + zwstrc(ji,jj)**3 )**pthird 872 END DO 873 END IF 874 ENDIF ! End of pycnocline 875 ELSE ! lconv test - stable conditions 876 DO jk = 2, ibld(ji,jj) 877 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + zsc_wth_1(ji,jj) 878 ghams(ji,jj,jk) = ghams(ji,jj,jk) + zsc_ws_1(ji,jj) 879 END DO 880 ENDIF 881 END DO ! ji loop 882 END DO ! jj loop 883 884 WHERE ( lconv ) 885 zsc_uw_1 = -zwb0 * zustar**2 * zhml / ( zvstr**3 + 0.5 * zwstrc**3 + epsln ) 886 zsc_uw_2 = zwb0 * zustke * zhml / ( zvstr**3 + 0.5 * zwstrc**3 + epsln )**(2.0/3.0) 887 zsc_vw_1 = 0._wp 888 ELSEWHERE 889 zsc_uw_1 = 0._wp 890 zsc_vw_1 = 0._wp 891 ENDWHERE 892 893 DO jj = 2, jpjm1 894 DO ji = 2, jpim1 895 IF ( lconv(ji,jj) ) THEN 896 DO jk = 2 , imld(ji,jj) 897 zznd_d = gdepw_n(ji,jj,jk) / dstokes(ji,jj) 898 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + 0.3 * 0.5 * ( zsc_uw_1(ji,jj) + 0.125 * EXP( -0.5 * zznd_d ) & 899 & * ( 1.0 - EXP( -0.5 * zznd_d ) ) & 900 & * zsc_uw_2(ji,jj) ) 901 ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + zsc_vw_1(ji,jj) 902 END DO ! jk loop 903 ELSE 904 ! stable conditions 905 DO jk = 2, ibld(ji,jj) 906 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + zsc_uw_1(ji,jj) 907 ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + zsc_vw_1(ji,jj) 908 END DO 909 ENDIF 910 END DO ! ji loop 911 END DO ! jj loop 912 913 DO jj = 2, jpjm1 914 DO ji = 2, jpim1 915 IF( lconv(ji,jj) ) THEN 1226 ELSE 1227 zsc_wth_1(ji,jj) = 2.0 * zwthav(ji,jj) 1228 zsc_ws_1(ji,jj) = zws0(ji,jj) 1229 ENDIF 1230 END DO 1231 END DO 1232 1233 DO jj = 2, jpjm1 1234 DO ji = 2, jpim1 1235 IF ( lconv(ji,jj) ) THEN 1236 DO jk = 2, imld(ji,jj) 1237 zznd_ml=gdepw_n(ji,jj,jk) / zhml(ji,jj) 1238 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 0.3 * zsc_wth_1(ji,jj) & 1239 & * ( -2.0 + 2.75 * ( ( 1.0 + 0.6 * zznd_ml**4 ) & 1240 & - EXP( - 6.0 * zznd_ml ) ) ) & 1241 & * ( 1.0 - EXP( - 15.0 * ( 1.0 - zznd_ml ) ) ) 1242 ! 1243 ghams(ji,jj,jk) = ghams(ji,jj,jk) + 0.3 * zsc_ws_1(ji,jj) & 1244 & * ( -2.0 + 2.75 * ( ( 1.0 + 0.6 * zznd_ml**4 ) & 1245 & - EXP( - 6.0 * zznd_ml ) ) ) & 1246 & * ( 1.0 - EXP ( -15.0 * ( 1.0 - zznd_ml ) ) ) 1247 END DO 1248 ! 1249 ! may need to comment out lpyc block 916 1250 IF ( lpyc(ji,jj) ) THEN 917 IF ( j_ddh(ji,jj) == 0 ) THEN 918 ! Place holding code. Parametrization needs checking for these conditions. 919 zomega = ( 0.15 * zwstrl(ji,jj)**3 + zwstrc(ji,jj)**3 + 4.75 * ( zshear(ji,jj)* zhbl(ji,jj) ))**pthird 920 zuw_bse = -0.0035 * zomega * ( 1.0 - zdh(ji,jj) / zhbl(ji,jj) ) * zdu_ml(ji,jj) 921 zvw_bse = -0.0075 * zomega * ( 1.0 - zdh(ji,jj) / zhbl(ji,jj) ) * zdv_ml(ji,jj) 922 ELSE 923 zomega = ( 0.15 * zwstrl(ji,jj)**3 + zwstrc(ji,jj)**3 + 4.75 * ( zshear(ji,jj)* zhbl(ji,jj) ))**pthird 924 zuw_bse = -0.0035 * zomega * ( 1.0 - zdh(ji,jj) / zhbl(ji,jj) ) * zdu_ml(ji,jj) 925 zvw_bse = -0.0075 * zomega * ( 1.0 - zdh(ji,jj) / zhbl(ji,jj) ) * zdv_ml(ji,jj) 926 ENDIF 927 zd_cubic = zdh(ji,jj) / zhbl(ji,jj) * zuw0(ji,jj) - ( 2.0 + zdh(ji,jj) /zhml(ji,jj) ) * zuw_bse 928 zc_cubic = zuw_bse - zd_cubic 929 ! need ztau_sc_u to be available. Change to array. 930 DO jk = imld(ji,jj), ibld(ji,jj) 931 zznd_pyc = - ( gdepw_n(ji,jj,jk) - zhbl(ji,jj) ) / zdh(ji,jj) 932 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) - 0.045 * ( ztau_sc_u(ji,jj)**2 ) * zuw_bse * & 933 & ( zc_cubic * zznd_pyc**2 + zd_cubic * zznd_pyc**3 ) * ( 0.75 + 0.25 * zznd_pyc )**2 * zdbdz_pyc(ji,jj,jk) 934 END DO 935 zvw_max = 0.7 * ff_t(ji,jj) * ( zustke(ji,jj) * dstokes(ji,jj) + 0.75 * zustar(ji,jj) * zhml(ji,jj) ) 936 zd_cubic = zvw_max * zdh(ji,jj) / zhml(ji,jj) - ( 2.0 + zdh(ji,jj) /zhml(ji,jj) ) * zvw_bse 937 zc_cubic = zvw_bse - zd_cubic 938 DO jk = imld(ji,jj), ibld(ji,jj) 939 zznd_pyc = -( gdepw_n(ji,jj,jk) -zhbl(ji,jj) ) / zdh(ji,jj) 940 ghamv(ji,jj,jk) = ghamv(ji,jj,jk) - 0.045 * ( ztau_sc_u(ji,jj)**2 ) * zvw_bse * & 941 & ( zc_cubic * zznd_pyc**2 + zd_cubic * zznd_pyc**3 ) * ( 0.75 + 0.25 * zznd_pyc )**2 * zdbdz_pyc(ji,jj,jk) 942 END DO 943 ENDIF ! lpyc 944 ENDIF ! lconv 945 END DO ! ji loop 946 END DO ! jj loop 947 948 IF(ln_dia_osm) THEN 949 IF ( iom_use("ghamu_0") ) CALL iom_put( "ghamu_0", wmask*ghamu ) 950 IF ( iom_use("zsc_uw_1_0") ) CALL iom_put( "zsc_uw_1_0", tmask(:,:,1)*zsc_uw_1 ) 951 END IF 952 ! Transport term in flux-gradient relationship [note : includes ROI ratio (X0.3) ] 953 954 DO jj = 1, jpjm1 955 DO ji = 1, jpim1 956 957 IF ( lconv(ji,jj) ) THEN 958 zsc_wth_1(ji,jj) = zwth0(ji,jj) / ( 1.0 - 0.56 * EXP( zhol(ji,jj) ) ) 959 zsc_ws_1(ji,jj) = zws0(ji,jj) / (1.0 - 0.56 *EXP( zhol(ji,jj) ) ) 960 IF ( lpyc(ji,jj) ) THEN 961 ! Pycnocline scales 962 zsc_wth_pyc(ji,jj) = -0.003 * zwstrc(ji,jj) * ( 1.0 - zdh(ji,jj) /zhbl(ji,jj) ) * zdt_ml(ji,jj) 963 zsc_ws_pyc(ji,jj) = -0.003 * zwstrc(ji,jj) * ( 1.0 - zdh(ji,jj) /zhbl(ji,jj) ) * zds_ml(ji,jj) 964 ENDIF 965 ELSE 966 zsc_wth_1(ji,jj) = 2.0 * zwthav(ji,jj) 967 zsc_ws_1(ji,jj) = zws0(ji,jj) 968 ENDIF 969 END DO 970 END DO 971 972 DO jj = 2, jpjm1 973 DO ji = 2, jpim1 974 IF ( lconv(ji,jj) ) THEN 975 DO jk = 2, imld(ji,jj) 976 zznd_ml=gdepw_n(ji,jj,jk) / zhml(ji,jj) 977 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 0.3 * zsc_wth_1(ji,jj) & 978 & * ( -2.0 + 2.75 * ( ( 1.0 + 0.6 * zznd_ml**4 ) & 979 & - EXP( - 6.0 * zznd_ml ) ) ) & 980 & * ( 1.0 - EXP( - 15.0 * ( 1.0 - zznd_ml ) ) ) 981 ! 982 ghams(ji,jj,jk) = ghams(ji,jj,jk) + 0.3 * zsc_ws_1(ji,jj) & 983 & * ( -2.0 + 2.75 * ( ( 1.0 + 0.6 * zznd_ml**4 ) & 984 & - EXP( - 6.0 * zznd_ml ) ) ) & 985 & * ( 1.0 - EXP ( -15.0 * ( 1.0 - zznd_ml ) ) ) 986 END DO 987 ! 988 ! may need to comment out lpyc block 989 IF ( lpyc(ji,jj) ) THEN 990 ! pycnocline 991 DO jk = imld(ji,jj), ibld(ji,jj) 1251 ! pycnocline 1252 DO jk = imld(ji,jj), ibld(ji,jj) 992 1253 zznd_pyc = - ( gdepw_n(ji,jj,jk) - zhbl(ji,jj) ) / zdh(ji,jj) 993 1254 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 4.0 * zsc_wth_pyc(ji,jj) * ( 0.48 - EXP( -1.5 * ( zznd_pyc -0.3)**2 ) ) 994 1255 ghams(ji,jj,jk) = ghams(ji,jj,jk) + 4.0 * zsc_ws_pyc(ji,jj) * ( 0.48 - EXP( -1.5 * ( zznd_pyc -0.3)**2 ) ) 995 END DO 996 ENDIF 997 ELSE 998 IF( zdhdt(ji,jj) > 0. ) THEN 999 DO jk = 2, ibld(ji,jj) 1000 zznd_d = gdepw_n(ji,jj,jk) / dstokes(ji,jj) 1001 znd = gdepw_n(ji,jj,jk) / zhbl(ji,jj) 1002 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 0.3 * ( -4.06 * EXP( -2.0 * zznd_d ) * (1.0 - EXP( -4.0 * zznd_d ) ) + & 1003 & 7.5 * EXP ( -10.0 * ( 0.95 - znd )**2 ) * ( 1.0 - znd ) ) * zsc_wth_1(ji,jj) 1004 ghams(ji,jj,jk) = ghams(ji,jj,jk) + 0.3 * ( -4.06 * EXP( -2.0 * zznd_d ) * (1.0 - EXP( -4.0 * zznd_d ) ) + & 1005 & 7.5 * EXP ( -10.0 * ( 0.95 - znd )**2 ) * ( 1.0 - znd ) ) * zsc_ws_1(ji,jj) 1006 END DO 1007 ENDIF 1008 ENDIF 1009 ENDDO ! ji loop 1010 END DO ! jj loop 1011 1012 WHERE ( lconv ) 1013 zsc_uw_1 = zustar**2 1014 zsc_vw_1 = ff_t * zustke * zhml 1015 ELSEWHERE 1016 zsc_uw_1 = zustar**2 1017 zsc_uw_2 = (2.25 - 3.0 * ( 1.0 - EXP( -1.25 * 2.0 ) ) ) * ( 1.0 - EXP( -4.0 * 2.0 ) ) * zsc_uw_1 1018 zsc_vw_1 = ff_t * zustke * zhbl 1019 zsc_vw_2 = -0.11 * SIN( 3.14159 * ( 2.0 + 0.4 ) ) * EXP(-( 1.5 + 2.0 )**2 ) * zsc_vw_1 1020 ENDWHERE 1021 1022 DO jj = 2, jpjm1 1023 DO ji = 2, jpim1 1024 IF ( lconv(ji,jj) ) THEN 1025 DO jk = 2, imld(ji,jj) 1026 zznd_ml = gdepw_n(ji,jj,jk) / zhml(ji,jj) 1027 zznd_d = gdepw_n(ji,jj,jk) / dstokes(ji,jj) 1028 ghamu(ji,jj,jk) = ghamu(ji,jj,jk)& 1029 & + 0.3 * ( -2.0 + 2.5 * ( 1.0 + 0.1 * zznd_ml**4 ) - EXP ( -8.0 * zznd_ml ) ) * zsc_uw_1(ji,jj) 1030 ! 1031 ghamv(ji,jj,jk) = ghamv(ji,jj,jk)& 1032 & + 0.3 * 0.1 * ( EXP( -zznd_d ) + EXP( -5.0 * ( 1.0 - zznd_ml ) ) ) * zsc_vw_1(ji,jj) 1033 END DO 1034 1035 ELSE 1036 DO jk = 2, ibld(ji,jj) 1037 znd = gdepw_n(ji,jj,jk) / zhbl(ji,jj) 1038 zznd_d = gdepw_n(ji,jj,jk) / dstokes(ji,jj) 1039 IF ( zznd_d <= 2.0 ) THEN 1040 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + 0.5 * 0.3 & 1041 &* ( 2.25 - 3.0 * ( 1.0 - EXP( - 1.25 * zznd_d ) ) * ( 1.0 - EXP( -2.0 * zznd_d ) ) ) * zsc_uw_1(ji,jj) 1042 ! 1043 ELSE 1044 ghamu(ji,jj,jk) = ghamu(ji,jj,jk)& 1045 & + 0.5 * 0.3 * ( 1.0 - EXP( -5.0 * ( 1.0 - znd ) ) ) * zsc_uw_2(ji,jj) 1046 ! 1047 ENDIF 1048 1049 ghamv(ji,jj,jk) = ghamv(ji,jj,jk)& 1050 & + 0.3 * 0.15 * SIN( 3.14159 * ( 0.65 * zznd_d ) ) * EXP( -0.25 * zznd_d**2 ) * zsc_vw_1(ji,jj) 1051 ghamv(ji,jj,jk) = ghamv(ji,jj,jk)& 1052 & + 0.3 * 0.15 * EXP( -5.0 * ( 1.0 - znd ) ) * ( 1.0 - EXP( -20.0 * ( 1.0 - znd ) ) ) * zsc_vw_2(ji,jj) 1053 END DO 1256 END DO 1054 1257 ENDIF 1055 END DO 1258 ELSE 1259 IF( zdhdt(ji,jj) > 0. ) THEN 1260 DO jk = 2, ibld(ji,jj) 1261 zznd_d = gdepw_n(ji,jj,jk) / dstokes(ji,jj) 1262 znd = gdepw_n(ji,jj,jk) / zhbl(ji,jj) 1263 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + 0.3 * ( -4.06 * EXP( -2.0 * zznd_d ) * (1.0 - EXP( -4.0 * zznd_d ) ) + & 1264 & 7.5 * EXP ( -10.0 * ( 0.95 - znd )**2 ) * ( 1.0 - znd ) ) * zsc_wth_1(ji,jj) 1265 ghams(ji,jj,jk) = ghams(ji,jj,jk) + 0.3 * ( -4.06 * EXP( -2.0 * zznd_d ) * (1.0 - EXP( -4.0 * zznd_d ) ) + & 1266 & 7.5 * EXP ( -10.0 * ( 0.95 - znd )**2 ) * ( 1.0 - znd ) ) * zsc_ws_1(ji,jj) 1267 END DO 1268 ENDIF 1269 ENDIF 1270 ENDDO ! ji loop 1271 END DO ! jj loop 1272 1273 WHERE ( lconv ) 1274 zsc_uw_1 = zustar**2 1275 zsc_vw_1 = ff_t * zustke * zhml 1276 ELSEWHERE 1277 zsc_uw_1 = zustar**2 1278 zsc_uw_2 = (2.25 - 3.0 * ( 1.0 - EXP( -1.25 * 2.0 ) ) ) * ( 1.0 - EXP( -4.0 * 2.0 ) ) * zsc_uw_1 1279 zsc_vw_1 = ff_t * zustke * zhbl 1280 zsc_vw_2 = -0.11 * SIN( 3.14159 * ( 2.0 + 0.4 ) ) * EXP(-( 1.5 + 2.0 )**2 ) * zsc_vw_1 1281 ENDWHERE 1282 1283 DO jj = 2, jpjm1 1284 DO ji = 2, jpim1 1285 IF ( lconv(ji,jj) ) THEN 1286 DO jk = 2, imld(ji,jj) 1287 zznd_ml = gdepw_n(ji,jj,jk) / zhml(ji,jj) 1288 zznd_d = gdepw_n(ji,jj,jk) / dstokes(ji,jj) 1289 ghamu(ji,jj,jk) = ghamu(ji,jj,jk)& 1290 & + 0.3 * ( -2.0 + 2.5 * ( 1.0 + 0.1 * zznd_ml**4 ) - EXP ( -8.0 * zznd_ml ) ) * zsc_uw_1(ji,jj) 1291 ! 1292 ghamv(ji,jj,jk) = ghamv(ji,jj,jk)& 1293 & + 0.3 * 0.1 * ( EXP( -zznd_d ) + EXP( -5.0 * ( 1.0 - zznd_ml ) ) ) * zsc_vw_1(ji,jj) 1294 END DO 1295 1296 ELSE 1297 DO jk = 2, ibld(ji,jj) 1298 znd = gdepw_n(ji,jj,jk) / zhbl(ji,jj) 1299 zznd_d = gdepw_n(ji,jj,jk) / dstokes(ji,jj) 1300 IF ( zznd_d <= 2.0 ) THEN 1301 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + 0.5 * 0.3 & 1302 &* ( 2.25 - 3.0 * ( 1.0 - EXP( - 1.25 * zznd_d ) ) * ( 1.0 - EXP( -2.0 * zznd_d ) ) ) * zsc_uw_1(ji,jj) 1303 ! 1304 ELSE 1305 ghamu(ji,jj,jk) = ghamu(ji,jj,jk)& 1306 & + 0.5 * 0.3 * ( 1.0 - EXP( -5.0 * ( 1.0 - znd ) ) ) * zsc_uw_2(ji,jj) 1307 ! 1308 ENDIF 1309 1310 ghamv(ji,jj,jk) = ghamv(ji,jj,jk)& 1311 & + 0.3 * 0.15 * SIN( 3.14159 * ( 0.65 * zznd_d ) ) * EXP( -0.25 * zznd_d**2 ) * zsc_vw_1(ji,jj) 1312 ghamv(ji,jj,jk) = ghamv(ji,jj,jk)& 1313 & + 0.3 * 0.15 * EXP( -5.0 * ( 1.0 - znd ) ) * ( 1.0 - EXP( -20.0 * ( 1.0 - znd ) ) ) * zsc_vw_2(ji,jj) 1314 END DO 1315 ENDIF 1056 1316 END DO 1057 1058 ! DO jj = 1, jpjm1 1059 ! DO ji = 1, jpim1 1060 ! IF ( lconv(ji,jj) ) THEN 1061 ! IF ( lpyc(ji,jj) ) THEN 1062 ! zd_cubic = ( 0.948 - 2.13 * zdh(ji,jj) / zhml(ji,jj) ) * zustar(ji,jj)**2 1063 ! zc_cubic = -0.474 * zustar(ji,jj)**2 - zd_cubic 1064 ! DO jk = imld(ji,jj), ibld(ji,jj) 1065 ! zznd_pyc = -( gdepw_n(ji,jj,jk) - zhbl(ji,jj) ) / zdh(ji,jj) 1066 ! ghamu(ji,jj,jk) = ghamu(ji,jj,jk) + 0.3 * ( zc_cubic * zznd_pyc**2 + zd_cubic * zznd_pyc**3 ) 1067 ! END DO 1068 ! zc_cubic= 3.0 * ff_t(ji,jj) * zustar(ji,jj) * zhml(ji,jj) 1069 ! zd_cubic = -2.0 * ff_t(ji,jj) * zustar(ji,jj) * zhml(ji,jj) 1070 ! DO jk = imld(ji,jj), ibld(ji,jj) 1071 ! zznd_pyc = -( gdepw_n(ji,jj,jk)-zhbl(ji,jj) ) / zdh(ji,jj) 1072 ! ghamv(ji,jj,jk) = ghamv(ji,jj,jk) + 0.3 * ( zc_cubic * zznd_pyc**2 + zd_cubic * zznd_pyc**3 ) 1073 ! END DO 1074 ! ENDIF 1075 ! ENDIF 1076 ! END DO 1077 ! END DO 1078 1079 IF(ln_dia_osm) THEN 1080 IF ( iom_use("ghamu_f") ) CALL iom_put( "ghamu_f", wmask*ghamu ) 1081 IF ( iom_use("ghamv_f") ) CALL iom_put( "ghamv_f", wmask*ghamv ) 1082 IF ( iom_use("zsc_uw_1_f") ) CALL iom_put( "zsc_uw_1_f", tmask(:,:,1)*zsc_uw_1 ) 1083 IF ( iom_use("zsc_vw_1_f") ) CALL iom_put( "zsc_vw_1_f", tmask(:,:,1)*zsc_vw_1 ) 1084 IF ( iom_use("zsc_uw_2_f") ) CALL iom_put( "zsc_uw_2_f", tmask(:,:,1)*zsc_uw_2 ) 1085 IF ( iom_use("zsc_vw_2_f") ) CALL iom_put( "zsc_vw_2_f", tmask(:,:,1)*zsc_vw_2 ) 1086 END IF 1087 ! 1088 ! Make surface forced velocity non-gradient terms go to zero at the base of the mixed layer. 1089 1090 1091 ! Make surface forced velocity non-gradient terms go to zero at the base of the boundary layer. 1092 1093 DO jj = 2, jpjm1 1094 DO ji = 2, jpim1 1095 IF ( .not. lconv(ji,jj) ) THEN 1096 DO jk = 2, ibld(ji,jj) 1097 znd = -( gdepw_n(ji,jj,jk) - zhbl(ji,jj) ) / zhbl(ji,jj) !ALMG to think about 1098 IF ( znd >= 0.0 ) THEN 1099 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) * ( 1.0 - EXP( -10.0 * znd**2 ) ) 1100 ghamv(ji,jj,jk) = ghamv(ji,jj,jk) * ( 1.0 - EXP( -10.0 * znd**2 ) ) 1101 ELSE 1102 ghamu(ji,jj,jk) = 0._wp 1103 ghamv(ji,jj,jk) = 0._wp 1104 ENDIF 1105 END DO 1106 ENDIF 1107 END DO 1108 END DO 1109 1110 ! pynocline contributions 1111 DO jj = 2, jpjm1 1112 DO ji = 2, jpim1 1113 IF ( .not. lconv(ji,jj) ) THEN 1317 END DO 1318 1319 IF(ln_dia_osm) THEN 1320 IF ( iom_use("ghamu_f") ) CALL iom_put( "ghamu_f", wmask*ghamu ) 1321 IF ( iom_use("ghamv_f") ) CALL iom_put( "ghamv_f", wmask*ghamv ) 1322 IF ( iom_use("zsc_uw_1_f") ) CALL iom_put( "zsc_uw_1_f", tmask(:,:,1)*zsc_uw_1 ) 1323 IF ( iom_use("zsc_vw_1_f") ) CALL iom_put( "zsc_vw_1_f", tmask(:,:,1)*zsc_vw_1 ) 1324 IF ( iom_use("zsc_uw_2_f") ) CALL iom_put( "zsc_uw_2_f", tmask(:,:,1)*zsc_uw_2 ) 1325 IF ( iom_use("zsc_vw_2_f") ) CALL iom_put( "zsc_vw_2_f", tmask(:,:,1)*zsc_vw_2 ) 1326 END IF 1327 ! 1328 ! Make surface forced velocity non-gradient terms go to zero at the base of the mixed layer. 1329 1330 1331 ! Make surface forced velocity non-gradient terms go to zero at the base of the boundary layer. 1332 1333 DO jj = 2, jpjm1 1334 DO ji = 2, jpim1 1335 IF ( .not. lconv(ji,jj) ) THEN 1336 DO jk = 2, ibld(ji,jj) 1337 znd = -( gdepw_n(ji,jj,jk) - zhbl(ji,jj) ) / zhbl(ji,jj) !ALMG to think about 1338 IF ( znd >= 0.0 ) THEN 1339 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) * ( 1.0 - EXP( -10.0 * znd**2 ) ) 1340 ghamv(ji,jj,jk) = ghamv(ji,jj,jk) * ( 1.0 - EXP( -10.0 * znd**2 ) ) 1341 ELSE 1342 ghamu(ji,jj,jk) = 0._wp 1343 ghamv(ji,jj,jk) = 0._wp 1344 ENDIF 1345 END DO 1346 ENDIF 1347 END DO 1348 END DO 1349 1350 ! pynocline contributions 1351 DO jj = 2, jpjm1 1352 DO ji = 2, jpim1 1353 IF ( .not. lconv(ji,jj) ) THEN 1114 1354 IF ( ibld(ji,jj) + jp_ext(ji,jj) < mbkt(ji,jj) ) THEN 1115 1355 DO jk= 2, ibld(ji,jj) … … 1120 1360 END DO 1121 1361 END IF 1122 END IF 1362 END IF 1363 END DO 1364 END DO 1365 IF(ln_dia_osm) THEN 1366 IF ( iom_use("ghamu_b") ) CALL iom_put( "ghamu_b", wmask*ghamu ) 1367 IF ( iom_use("ghamv_b") ) CALL iom_put( "ghamv_b", wmask*ghamv ) 1368 END IF 1369 1370 DO jj=2, jpjm1 1371 DO ji = 2, jpim1 1372 ghamt(ji,jj,ibld(ji,jj)) = 0._wp 1373 ghams(ji,jj,ibld(ji,jj)) = 0._wp 1374 ghamu(ji,jj,ibld(ji,jj)) = 0._wp 1375 ghamv(ji,jj,ibld(ji,jj)) = 0._wp 1376 END DO ! ji loop 1377 END DO ! jj loop 1378 1379 IF(ln_dia_osm) THEN 1380 IF ( iom_use("ghamu_1") ) CALL iom_put( "ghamu_1", wmask*ghamu ) 1381 IF ( iom_use("ghamv_1") ) CALL iom_put( "ghamv_1", wmask*ghamv ) 1382 IF ( iom_use("zdudz_pyc") ) CALL iom_put( "zdudz_pyc", wmask*zdudz_pyc ) 1383 IF ( iom_use("zdvdz_pyc") ) CALL iom_put( "zdvdz_pyc", wmask*zdvdz_pyc ) 1384 IF ( iom_use("zviscos") ) CALL iom_put( "zviscos", wmask*zviscos ) 1385 END IF 1386 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 1387 ! Need to put in code for contributions that are applied explicitly to 1388 ! the prognostic variables 1389 ! 1. Entrainment flux 1390 ! 1391 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 1392 1393 1394 1395 ! rotate non-gradient velocity terms back to model reference frame 1396 1397 DO jj = 2, jpjm1 1398 DO ji = 2, jpim1 1399 DO jk = 2, ibld(ji,jj) 1400 ztemp = ghamu(ji,jj,jk) 1401 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) * zcos_wind(ji,jj) - ghamv(ji,jj,jk) * zsin_wind(ji,jj) 1402 ghamv(ji,jj,jk) = ghamv(ji,jj,jk) * zcos_wind(ji,jj) + ztemp * zsin_wind(ji,jj) 1123 1403 END DO 1124 1404 END DO 1125 IF(ln_dia_osm) THEN 1126 IF ( iom_use("ghamu_b") ) CALL iom_put( "ghamu_b", wmask*ghamu ) 1127 IF ( iom_use("ghamv_b") ) CALL iom_put( "ghamv_b", wmask*ghamv ) 1128 END IF 1129 1130 DO jj=2, jpjm1 1131 DO ji = 2, jpim1 1132 ghamt(ji,jj,ibld(ji,jj)) = 0._wp 1133 ghams(ji,jj,ibld(ji,jj)) = 0._wp 1134 ghamu(ji,jj,ibld(ji,jj)) = 0._wp 1135 ghamv(ji,jj,ibld(ji,jj)) = 0._wp 1136 END DO ! ji loop 1137 END DO ! jj loop 1138 1139 IF(ln_dia_osm) THEN 1140 IF ( iom_use("ghamu_1") ) CALL iom_put( "ghamu_1", wmask*ghamu ) 1141 IF ( iom_use("ghamv_1") ) CALL iom_put( "ghamv_1", wmask*ghamv ) 1142 IF ( iom_use("zdudz_pyc") ) CALL iom_put( "zdudz_pyc", wmask*zdudz_pyc ) 1143 IF ( iom_use("zdvdz_pyc") ) CALL iom_put( "zdvdz_pyc", wmask*zdvdz_pyc ) 1144 IF ( iom_use("zviscos") ) CALL iom_put( "zviscos", wmask*zviscos ) 1145 END IF 1146 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 1147 ! Need to put in code for contributions that are applied explicitly to 1148 ! the prognostic variables 1149 ! 1. Entrainment flux 1150 ! 1151 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 1152 1153 1154 1155 ! rotate non-gradient velocity terms back to model reference frame 1156 1157 DO jj = 2, jpjm1 1158 DO ji = 2, jpim1 1159 DO jk = 2, ibld(ji,jj) 1160 ztemp = ghamu(ji,jj,jk) 1161 ghamu(ji,jj,jk) = ghamu(ji,jj,jk) * zcos_wind(ji,jj) - ghamv(ji,jj,jk) * zsin_wind(ji,jj) 1162 ghamv(ji,jj,jk) = ghamv(ji,jj,jk) * zcos_wind(ji,jj) + ztemp * zsin_wind(ji,jj) 1405 END DO 1406 1407 IF(ln_dia_osm) THEN 1408 IF ( iom_use("zdtdz_pyc") ) CALL iom_put( "zdtdz_pyc", wmask*zdtdz_pyc ) 1409 IF ( iom_use("zdsdz_pyc") ) CALL iom_put( "zdsdz_pyc", wmask*zdsdz_pyc ) 1410 IF ( iom_use("zdbdz_pyc") ) CALL iom_put( "zdbdz_pyc", wmask*zdbdz_pyc ) 1411 END IF 1412 1413 ! KPP-style Ri# mixing 1414 IF( ln_kpprimix) THEN 1415 DO jk = 2, jpkm1 !* Shear production at uw- and vw-points (energy conserving form) 1416 DO jj = 1, jpjm1 1417 DO ji = 1, jpim1 ! vector opt. 1418 z3du(ji,jj,jk) = 0.5 * ( un(ji,jj,jk-1) - un(ji ,jj,jk) ) & 1419 & * ( ub(ji,jj,jk-1) - ub(ji ,jj,jk) ) * wumask(ji,jj,jk) & 1420 & / ( e3uw_n(ji,jj,jk) * e3uw_b(ji,jj,jk) ) 1421 z3dv(ji,jj,jk) = 0.5 * ( vn(ji,jj,jk-1) - vn(ji,jj ,jk) ) & 1422 & * ( vb(ji,jj,jk-1) - vb(ji,jj ,jk) ) * wvmask(ji,jj,jk) & 1423 & / ( e3vw_n(ji,jj,jk) * e3vw_b(ji,jj,jk) ) 1163 1424 END DO 1164 1425 END DO 1165 1426 END DO 1166 1167 IF(ln_dia_osm) THEN 1168 IF ( iom_use("zdtdz_pyc") ) CALL iom_put( "zdtdz_pyc", wmask*zdtdz_pyc ) 1169 IF ( iom_use("zdsdz_pyc") ) CALL iom_put( "zdsdz_pyc", wmask*zdsdz_pyc ) 1170 IF ( iom_use("zdbdz_pyc") ) CALL iom_put( "zdbdz_pyc", wmask*zdbdz_pyc ) 1171 END IF 1172 1173 ! KPP-style Ri# mixing 1174 IF( ln_kpprimix) THEN 1175 DO jk = 2, jpkm1 !* Shear production at uw- and vw-points (energy conserving form) 1176 DO jj = 1, jpjm1 1177 DO ji = 1, jpim1 ! vector opt. 1178 z3du(ji,jj,jk) = 0.5 * ( un(ji,jj,jk-1) - un(ji ,jj,jk) ) & 1179 & * ( ub(ji,jj,jk-1) - ub(ji ,jj,jk) ) * wumask(ji,jj,jk) & 1180 & / ( e3uw_n(ji,jj,jk) * e3uw_b(ji,jj,jk) ) 1181 z3dv(ji,jj,jk) = 0.5 * ( vn(ji,jj,jk-1) - vn(ji,jj ,jk) ) & 1182 & * ( vb(ji,jj,jk-1) - vb(ji,jj ,jk) ) * wvmask(ji,jj,jk) & 1183 & / ( e3vw_n(ji,jj,jk) * e3vw_b(ji,jj,jk) ) 1184 END DO 1427 ! 1428 DO jk = 2, jpkm1 1429 DO jj = 2, jpjm1 1430 DO ji = 2, jpim1 ! vector opt. 1431 ! ! shear prod. at w-point weightened by mask 1432 zesh2 = ( z3du(ji-1,jj,jk) + z3du(ji,jj,jk) ) / MAX( 1._wp , umask(ji-1,jj,jk) + umask(ji,jj,jk) ) & 1433 & + ( z3dv(ji,jj-1,jk) + z3dv(ji,jj,jk) ) / MAX( 1._wp , vmask(ji,jj-1,jk) + vmask(ji,jj,jk) ) 1434 ! ! local Richardson number 1435 zri = MAX( rn2b(ji,jj,jk), 0._wp ) / MAX(zesh2, epsln) 1436 zfri = MIN( zri / rn_riinfty , 1.0_wp ) 1437 zfri = ( 1.0_wp - zfri * zfri ) 1438 zrimix(ji,jj,jk) = zfri * zfri * zfri * wmask(ji, jj, jk) 1185 1439 END DO 1186 1440 END DO 1187 ! 1188 DO jk = 2, jpkm1 1189 DO jj = 2, jpjm1 1190 DO ji = 2, jpim1 ! vector opt. 1191 ! ! shear prod. at w-point weightened by mask 1192 zesh2 = ( z3du(ji-1,jj,jk) + z3du(ji,jj,jk) ) / MAX( 1._wp , umask(ji-1,jj,jk) + umask(ji,jj,jk) ) & 1193 & + ( z3dv(ji,jj-1,jk) + z3dv(ji,jj,jk) ) / MAX( 1._wp , vmask(ji,jj-1,jk) + vmask(ji,jj,jk) ) 1194 ! ! local Richardson number 1195 zri = MAX( rn2b(ji,jj,jk), 0._wp ) / MAX(zesh2, epsln) 1196 zfri = MIN( zri / rn_riinfty , 1.0_wp ) 1197 zfri = ( 1.0_wp - zfri * zfri ) 1198 zrimix(ji,jj,jk) = zfri * zfri * zfri * wmask(ji, jj, jk) 1199 END DO 1441 END DO 1442 1443 DO jj = 2, jpjm1 1444 DO ji = 2, jpim1 1445 DO jk = ibld(ji,jj) + 1, jpkm1 1446 zdiffut(ji,jj,jk) = zrimix(ji,jj,jk)*rn_difri 1447 zviscos(ji,jj,jk) = zrimix(ji,jj,jk)*rn_difri 1200 1448 END DO 1201 1449 END DO 1202 1203 DO jj = 2, jpjm1 1204 DO ji = 2, jpim1 1205 DO jk = ibld(ji,jj) + 1, jpkm1 1206 zdiffut(ji,jj,jk) = zrimix(ji,jj,jk)*rn_difri 1207 zviscos(ji,jj,jk) = zrimix(ji,jj,jk)*rn_difri 1208 END DO 1450 END DO 1451 1452 END IF ! ln_kpprimix = .true. 1453 1454 ! KPP-style set diffusivity large if unstable below BL 1455 IF( ln_convmix) THEN 1456 DO jj = 2, jpjm1 1457 DO ji = 2, jpim1 1458 DO jk = ibld(ji,jj) + 1, jpkm1 1459 IF( MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) zdiffut(ji,jj,jk) = rn_difconv 1209 1460 END DO 1210 1461 END DO 1211 1212 END IF ! ln_kpprimix = .true. 1213 1214 ! KPP-style set diffusivity large if unstable below BL 1215 IF( ln_convmix) THEN 1216 DO jj = 2, jpjm1 1217 DO ji = 2, jpim1 1218 DO jk = ibld(ji,jj) + 1, jpkm1 1219 IF( MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) zdiffut(ji,jj,jk) = rn_difconv 1462 END DO 1463 END IF ! ln_convmix = .true. 1464 1465 1466 1467 IF ( ln_osm_mle ) THEN ! set up diffusivity and non-gradient mixing 1468 DO jj = 2 , jpjm1 1469 DO ji = 2, jpim1 1470 IF ( lflux(ji,jj) ) THEN ! MLE mixing extends below boundary layer 1471 ! Calculate MLE flux contribution from surface fluxes 1472 DO jk = 1, ibld(ji,jj) 1473 znd = gdepw_n(ji,jj,jk) / MAX(zhbl(ji,jj),epsln) 1474 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) - ( zwth0(ji,jj) - zrad0(ji,jj) + zradh(ji,jj) ) * ( 1.0 - znd ) 1475 ghams(ji,jj,jk) = ghams(ji,jj,jk) - zws0(ji,jj) * ( 1.0 - znd ) 1220 1476 END DO 1221 END DO 1477 DO jk = 1, mld_prof(ji,jj) 1478 znd = gdepw_n(ji,jj,jk) / MAX(zhmle(ji,jj),epsln) 1479 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + ( zwth0(ji,jj) - zrad0(ji,jj) + zradh(ji,jj) ) * ( 1.0 - znd ) 1480 ghams(ji,jj,jk) = ghams(ji,jj,jk) + zws0(ji,jj) * ( 1.0 -znd ) 1481 END DO 1482 ! Viscosity for MLEs 1483 DO jk = 1, mld_prof(ji,jj) 1484 znd = -gdepw_n(ji,jj,jk) / MAX(zhmle(ji,jj),epsln) 1485 zdiffut(ji,jj,jk) = zdiffut(ji,jj,jk) + zdiff_mle(ji,jj) * ( 1.0 - ( 2.0 * znd + 1.0 )**2 ) * ( 1.0 + 5.0 / 21.0 * ( 2.0 * znd + 1.0 )** 2 ) 1486 END DO 1487 ELSE 1488 ! Surface transports limited to OSBL. 1489 ! Viscosity for MLEs 1490 DO jk = 1, mld_prof(ji,jj) 1491 znd = -gdepw_n(ji,jj,jk) / MAX(zhmle(ji,jj),epsln) 1492 zdiffut(ji,jj,jk) = zdiffut(ji,jj,jk) + zdiff_mle(ji,jj) * ( 1.0 - ( 2.0 * znd + 1.0 )**2 ) * ( 1.0 + 5.0 / 21.0 * ( 2.0 * znd + 1.0 )** 2 ) 1493 END DO 1494 ENDIF 1222 1495 END DO 1223 END IF ! ln_convmix = .true. 1224 1225 1226 1227 IF ( ln_osm_mle ) THEN ! set up diffusivity and non-gradient mixing 1228 DO jj = 2 , jpjm1 1229 DO ji = 2, jpim1 1230 IF ( lflux(ji,jj) ) THEN ! MLE mixing extends below boundary layer 1231 ! Calculate MLE flux contribution from surface fluxes 1232 DO jk = 1, ibld(ji,jj) 1233 znd = gdepw_n(ji,jj,jk) / MAX(zhbl(ji,jj),epsln) 1234 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) - ( zwth0(ji,jj) - zrad0(ji,jj) ) * ( 1.0 - znd ) 1235 ghams(ji,jj,jk) = ghams(ji,jj,jk) - zws0(ji,jj) * ( 1.0 - znd ) 1236 END DO 1237 DO jk = 1, mld_prof(ji,jj) 1238 znd = gdepw_n(ji,jj,jk) / MAX(zhmle(ji,jj),epsln) 1239 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) + ( zwth0(ji,jj) - zrad0(ji,jj) ) * ( 1.0 - znd ) 1240 ghams(ji,jj,jk) = ghams(ji,jj,jk) + zws0(ji,jj) * ( 1.0 -znd ) 1241 END DO 1242 ! Viscosity for MLEs 1243 DO jk = 1, mld_prof(ji,jj) 1244 znd = -gdepw_n(ji,jj,jk) / MAX(zhmle(ji,jj),epsln) 1245 zdiffut(ji,jj,jk) = zdiffut(ji,jj,jk) + zdiff_mle(ji,jj) * ( 1.0 - ( 2.0 * znd + 1.0 )**2 ) * ( 1.0 + 5.0 / 21.0 * ( 2.0 * znd + 1.0 )** 2 ) 1246 END DO 1247 ELSE 1248 ! Surface transports limited to OSBL. 1249 ! Viscosity for MLEs 1250 DO jk = 1, mld_prof(ji,jj) 1251 znd = -gdepw_n(ji,jj,jk) / MAX(zhmle(ji,jj),epsln) 1252 zdiffut(ji,jj,jk) = zdiffut(ji,jj,jk) + zdiff_mle(ji,jj) * ( 1.0 - ( 2.0 * znd + 1.0 )**2 ) * ( 1.0 + 5.0 / 21.0 * ( 2.0 * znd + 1.0 )** 2 ) 1253 END DO 1254 ENDIF 1255 END DO 1496 END DO 1497 ENDIF 1498 1499 IF(ln_dia_osm) THEN 1500 IF ( iom_use("zdtdz_pyc") ) CALL iom_put( "zdtdz_pyc", wmask*zdtdz_pyc ) 1501 IF ( iom_use("zdsdz_pyc") ) CALL iom_put( "zdsdz_pyc", wmask*zdsdz_pyc ) 1502 IF ( iom_use("zdbdz_pyc") ) CALL iom_put( "zdbdz_pyc", wmask*zdbdz_pyc ) 1503 END IF 1504 1505 1506 ! Lateral boundary conditions on zvicos (sign unchanged), needed to caclulate viscosities on u and v grids 1507 !CALL lbc_lnk( zviscos(:,:,:), 'W', 1. ) 1508 1509 ! GN 25/8: need to change tmask --> wmask 1510 1511 DO jk = 2, jpkm1 1512 DO jj = 2, jpjm1 1513 DO ji = 2, jpim1 1514 p_avt(ji,jj,jk) = MAX( zdiffut(ji,jj,jk), avtb(jk) ) * tmask(ji,jj,jk) 1515 p_avm(ji,jj,jk) = MAX( zviscos(ji,jj,jk), avmb(jk) ) * tmask(ji,jj,jk) 1256 1516 END DO 1257 ENDIF 1258 1259 IF(ln_dia_osm) THEN 1260 IF ( iom_use("zdtdz_pyc") ) CALL iom_put( "zdtdz_pyc", wmask*zdtdz_pyc ) 1261 IF ( iom_use("zdsdz_pyc") ) CALL iom_put( "zdsdz_pyc", wmask*zdsdz_pyc ) 1262 IF ( iom_use("zdbdz_pyc") ) CALL iom_put( "zdbdz_pyc", wmask*zdbdz_pyc ) 1263 END IF 1264 1265 1266 ! Lateral boundary conditions on zvicos (sign unchanged), needed to caclulate viscosities on u and v grids 1267 !CALL lbc_lnk( zviscos(:,:,:), 'W', 1. ) 1268 1269 ! GN 25/8: need to change tmask --> wmask 1270 1271 DO jk = 2, jpkm1 1272 DO jj = 2, jpjm1 1273 DO ji = 2, jpim1 1274 p_avt(ji,jj,jk) = MAX( zdiffut(ji,jj,jk), avtb(jk) ) * tmask(ji,jj,jk) 1275 p_avm(ji,jj,jk) = MAX( zviscos(ji,jj,jk), avmb(jk) ) * tmask(ji,jj,jk) 1276 END DO 1277 END DO 1278 END DO 1279 ! Lateral boundary conditions on ghamu and ghamv, currently on W-grid (sign unchanged), needed to caclulate gham[uv] on u and v grids 1280 CALL lbc_lnk_multi( 'zdfosm', p_avt, 'W', 1. , p_avm, 'W', 1., & 1281 & ghamu, 'W', 1. , ghamv, 'W', 1. ) 1282 DO jk = 2, jpkm1 1283 DO jj = 2, jpjm1 1284 DO ji = 2, jpim1 1285 ghamu(ji,jj,jk) = ( ghamu(ji,jj,jk) + ghamu(ji+1,jj,jk) ) & 1286 & / MAX( 1., tmask(ji,jj,jk) + tmask (ji + 1,jj,jk) ) * umask(ji,jj,jk) 1287 1288 ghamv(ji,jj,jk) = ( ghamv(ji,jj,jk) + ghamv(ji,jj+1,jk) ) & 1289 & / MAX( 1., tmask(ji,jj,jk) + tmask (ji,jj+1,jk) ) * vmask(ji,jj,jk) 1290 1291 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) * tmask(ji,jj,jk) 1292 ghams(ji,jj,jk) = ghams(ji,jj,jk) * tmask(ji,jj,jk) 1293 END DO 1294 END DO 1295 END DO 1296 ! Lateral boundary conditions on final outputs for hbl, on T-grid (sign unchanged) 1297 CALL lbc_lnk_multi( 'zdfosm', hbl, 'T', 1., dh, 'T', 1., hmle, 'T', 1. ) 1298 ! Lateral boundary conditions on final outputs for gham[ts], on W-grid (sign unchanged) 1299 ! Lateral boundary conditions on final outputs for gham[uv], on [UV]-grid (sign unchanged) 1300 CALL lbc_lnk_multi( 'zdfosm', ghamt, 'W', 1. , ghams, 'W', 1., & 1517 END DO 1518 END DO 1519 ! Lateral boundary conditions on ghamu and ghamv, currently on W-grid (sign unchanged), needed to caclulate gham[uv] on u and v grids 1520 CALL lbc_lnk_multi( 'zdfosm', p_avt, 'W', 1. , p_avm, 'W', 1., & 1521 & ghamu, 'W', 1. , ghamv, 'W', 1. ) 1522 DO jk = 2, jpkm1 1523 DO jj = 2, jpjm1 1524 DO ji = 2, jpim1 1525 ghamu(ji,jj,jk) = ( ghamu(ji,jj,jk) + ghamu(ji+1,jj,jk) ) & 1526 & / MAX( 1., tmask(ji,jj,jk) + tmask (ji + 1,jj,jk) ) * umask(ji,jj,jk) 1527 1528 ghamv(ji,jj,jk) = ( ghamv(ji,jj,jk) + ghamv(ji,jj+1,jk) ) & 1529 & / MAX( 1., tmask(ji,jj,jk) + tmask (ji,jj+1,jk) ) * vmask(ji,jj,jk) 1530 1531 ghamt(ji,jj,jk) = ghamt(ji,jj,jk) * tmask(ji,jj,jk) 1532 ghams(ji,jj,jk) = ghams(ji,jj,jk) * tmask(ji,jj,jk) 1533 END DO 1534 END DO 1535 END DO 1536 ! Lateral boundary conditions on final outputs for hbl, on T-grid (sign unchanged) 1537 CALL lbc_lnk_multi( 'zdfosm', hbl, 'T', 1., dh, 'T', 1., hmle, 'T', 1. ) 1538 ! Lateral boundary conditions on final outputs for gham[ts], on W-grid (sign unchanged) 1539 ! Lateral boundary conditions on final outputs for gham[uv], on [UV]-grid (sign unchanged) 1540 CALL lbc_lnk_multi( 'zdfosm', ghamt, 'W', 1. , ghams, 'W', 1., & 1301 1541 & ghamu, 'U', -1. , ghamv, 'V', -1. ) 1302 1542 1303 1304 1305 ! Stokes drift set by assumimg onstant La#=0.3(=0) or Pierson-Moskovitz spectrum (=1).1306 1307 1308 1309 1310 ! Stokes drift read in from sbcwave (=2).1311 1312 1313 1314 1315 1316 1317 1318 1319 1320 1321 1322 1323 1324 1325 1326 1327 1328 1329 1330 1331 1332 1333 1334 1335 1336 1337 1338 1339 1340 1341 1342 1343 1344 1345 1346 1347 1348 1349 1350 1351 1352 1353 1354 1355 1356 1357 1358 1359 1360 1361 1362 1363 1364 1365 1366 1367 1368 1369 1370 1371 1372 1373 1374 1375 1376 1377 1378 1379 1380 CONTAINS1381 ! subroutine code changed, needs syntax checking.1382 SUBROUTINE zdf_osm_diffusivity_viscosity( zdiffut, zviscos )1383 1384 !!---------------------------------------------------------------------1385 !! *** ROUTINE zdf_osm_diffusivity_viscosity ***1386 !!1387 !! ** Purpose : Determines the eddy diffusivity and eddy viscosity profiles in the mixed layer and the pycnocline.1388 !!1389 !! ** Method :1390 !!1391 !! !!----------------------------------------------------------------------1392 REAL(wp), DIMENSION(:,:,:) :: zdiffut1393 REAL(wp), DIMENSION(:,:,:) :: zviscos1394 ! local1395 1396 ! Scales used to calculate eddy diffusivity and viscosity profiles1543 IF(ln_dia_osm) THEN 1544 SELECT CASE (nn_osm_wave) 1545 ! Stokes drift set by assumimg onstant La#=0.3(=0) or Pierson-Moskovitz spectrum (=1). 1546 CASE(0:1) 1547 IF ( iom_use("us_x") ) CALL iom_put( "us_x", tmask(:,:,1)*zustke*zcos_wind ) ! x surface Stokes drift 1548 IF ( iom_use("us_y") ) CALL iom_put( "us_y", tmask(:,:,1)*zustke*zsin_wind ) ! y surface Stokes drift 1549 IF ( iom_use("wind_wave_abs_power") ) CALL iom_put( "wind_wave_abs_power", 1000.*rau0*tmask(:,:,1)*zustar**2*zustke ) 1550 ! Stokes drift read in from sbcwave (=2). 1551 CASE(2:3) 1552 IF ( iom_use("us_x") ) CALL iom_put( "us_x", ut0sd*umask(:,:,1) ) ! x surface Stokes drift 1553 IF ( iom_use("us_y") ) CALL iom_put( "us_y", vt0sd*vmask(:,:,1) ) ! y surface Stokes drift 1554 IF ( iom_use("wmp") ) CALL iom_put( "wmp", wmp*tmask(:,:,1) ) ! wave mean period 1555 IF ( iom_use("hsw") ) CALL iom_put( "hsw", hsw*tmask(:,:,1) ) ! significant wave height 1556 IF ( iom_use("wmp_NP") ) CALL iom_put( "wmp_NP", (2.*rpi*1.026/(0.877*grav) )*wndm*tmask(:,:,1) ) ! wave mean period from NP spectrum 1557 IF ( iom_use("hsw_NP") ) CALL iom_put( "hsw_NP", (0.22/grav)*wndm**2*tmask(:,:,1) ) ! significant wave height from NP spectrum 1558 IF ( iom_use("wndm") ) CALL iom_put( "wndm", wndm*tmask(:,:,1) ) ! U_10 1559 IF ( iom_use("wind_wave_abs_power") ) CALL iom_put( "wind_wave_abs_power", 1000.*rau0*tmask(:,:,1)*zustar**2* & 1560 & SQRT(ut0sd**2 + vt0sd**2 ) ) 1561 END SELECT 1562 IF ( iom_use("ghamt") ) CALL iom_put( "ghamt", tmask*ghamt ) ! <Tw_NL> 1563 IF ( iom_use("ghams") ) CALL iom_put( "ghams", tmask*ghams ) ! <Sw_NL> 1564 IF ( iom_use("ghamu") ) CALL iom_put( "ghamu", umask*ghamu ) ! <uw_NL> 1565 IF ( iom_use("ghamv") ) CALL iom_put( "ghamv", vmask*ghamv ) ! <vw_NL> 1566 IF ( iom_use("zwth0") ) CALL iom_put( "zwth0", tmask(:,:,1)*zwth0 ) ! <Tw_0> 1567 IF ( iom_use("zws0") ) CALL iom_put( "zws0", tmask(:,:,1)*zws0 ) ! <Sw_0> 1568 IF ( iom_use("zwb0") ) CALL iom_put( "zwb0", tmask(:,:,1)*zwb0 ) ! <Sw_0> 1569 IF ( iom_use("zwbav") ) CALL iom_put( "zwbav", tmask(:,:,1)*zwthav ) ! upward BL-avged turb buoyancy flux 1570 IF ( iom_use("hbl") ) CALL iom_put( "hbl", tmask(:,:,1)*hbl ) ! boundary-layer depth 1571 IF ( iom_use("ibld") ) CALL iom_put( "ibld", tmask(:,:,1)*ibld ) ! boundary-layer max k 1572 IF ( iom_use("zdt_bl") ) CALL iom_put( "zdt_bl", tmask(:,:,1)*zdt_bl ) ! dt at ml base 1573 IF ( iom_use("zds_bl") ) CALL iom_put( "zds_bl", tmask(:,:,1)*zds_bl ) ! ds at ml base 1574 IF ( iom_use("zdb_bl") ) CALL iom_put( "zdb_bl", tmask(:,:,1)*zdb_bl ) ! db at ml base 1575 IF ( iom_use("zdu_bl") ) CALL iom_put( "zdu_bl", tmask(:,:,1)*zdu_bl ) ! du at ml base 1576 IF ( iom_use("zdv_bl") ) CALL iom_put( "zdv_bl", tmask(:,:,1)*zdv_bl ) ! dv at ml base 1577 IF ( iom_use("dh") ) CALL iom_put( "dh", tmask(:,:,1)*dh ) ! Initial boundary-layer depth 1578 IF ( iom_use("hml") ) CALL iom_put( "hml", tmask(:,:,1)*hml ) ! Initial boundary-layer depth 1579 IF ( iom_use("zdt_ml") ) CALL iom_put( "zdt_ml", tmask(:,:,1)*zdt_ml ) ! dt at ml base 1580 IF ( iom_use("zds_ml") ) CALL iom_put( "zds_ml", tmask(:,:,1)*zds_ml ) ! ds at ml base 1581 IF ( iom_use("zdb_ml") ) CALL iom_put( "zdb_ml", tmask(:,:,1)*zdb_ml ) ! db at ml base 1582 IF ( iom_use("dstokes") ) CALL iom_put( "dstokes", tmask(:,:,1)*dstokes ) ! Stokes drift penetration depth 1583 IF ( iom_use("zustke") ) CALL iom_put( "zustke", tmask(:,:,1)*zustke ) ! Stokes drift magnitude at T-points 1584 IF ( iom_use("zwstrc") ) CALL iom_put( "zwstrc", tmask(:,:,1)*zwstrc ) ! convective velocity scale 1585 IF ( iom_use("zwstrl") ) CALL iom_put( "zwstrl", tmask(:,:,1)*zwstrl ) ! Langmuir velocity scale 1586 IF ( iom_use("zustar") ) CALL iom_put( "zustar", tmask(:,:,1)*zustar ) ! friction velocity scale 1587 IF ( iom_use("zvstr") ) CALL iom_put( "zvstr", tmask(:,:,1)*zvstr ) ! mixed velocity scale 1588 IF ( iom_use("zla") ) CALL iom_put( "zla", tmask(:,:,1)*zla ) ! langmuir # 1589 IF ( iom_use("wind_power") ) CALL iom_put( "wind_power", 1000.*rau0*tmask(:,:,1)*zustar**3 ) ! BL depth internal to zdf_osm routine 1590 IF ( iom_use("wind_wave_power") ) CALL iom_put( "wind_wave_power", 1000.*rau0*tmask(:,:,1)*zustar**2*zustke ) 1591 IF ( iom_use("zhbl") ) CALL iom_put( "zhbl", tmask(:,:,1)*zhbl ) ! BL depth internal to zdf_osm routine 1592 IF ( iom_use("zhml") ) CALL iom_put( "zhml", tmask(:,:,1)*zhml ) ! ML depth internal to zdf_osm routine 1593 IF ( iom_use("imld") ) CALL iom_put( "imld", tmask(:,:,1)*imld ) ! index for ML depth internal to zdf_osm routine 1594 IF ( iom_use("jp_ext") ) CALL iom_put( "jp_ext", tmask(:,:,1)*jp_ext ) ! =1 if pycnocline resolved internal to zdf_osm routine 1595 IF ( iom_use("j_ddh") ) CALL iom_put( "j_ddh", tmask(:,:,1)*j_ddh ) ! index forpyc thicknessh internal to zdf_osm routine 1596 IF ( iom_use("zshear") ) CALL iom_put( "zshear", tmask(:,:,1)*zshear ) ! shear production of TKE internal to zdf_osm routine 1597 IF ( iom_use("zdh") ) CALL iom_put( "zdh", tmask(:,:,1)*zdh ) ! pyc thicknessh internal to zdf_osm routine 1598 IF ( iom_use("zhol") ) CALL iom_put( "zhol", tmask(:,:,1)*zhol ) ! ML depth internal to zdf_osm routine 1599 IF ( iom_use("zwth_ent") ) CALL iom_put( "zwth_ent", tmask(:,:,1)*zwth_ent ) ! upward turb temp entrainment flux 1600 IF ( iom_use("zwb_ent") ) CALL iom_put( "zwb_ent", tmask(:,:,1)*zwb_ent ) ! upward turb buoyancy entrainment flux 1601 IF ( iom_use("zws_ent") ) CALL iom_put( "zws_ent", tmask(:,:,1)*zws_ent ) ! upward turb salinity entrainment flux 1602 IF ( iom_use("zt_ml") ) CALL iom_put( "zt_ml", tmask(:,:,1)*zt_ml ) ! average T in ML 1603 1604 IF ( iom_use("hmle") ) CALL iom_put( "hmle", tmask(:,:,1)*hmle ) ! FK layer depth 1605 IF ( iom_use("zmld") ) CALL iom_put( "zmld", tmask(:,:,1)*zmld ) ! FK target layer depth 1606 IF ( iom_use("zwb_fk") ) CALL iom_put( "zwb_fk", tmask(:,:,1)*zwb_fk ) ! FK b flux 1607 IF ( iom_use("zwb_fk_b") ) CALL iom_put( "zwb_fk_b", tmask(:,:,1)*zwb_fk_b ) ! FK b flux averaged over ML 1608 IF ( iom_use("mld_prof") ) CALL iom_put( "mld_prof", tmask(:,:,1)*mld_prof )! FK layer max k 1609 IF ( iom_use("zdtdx") ) CALL iom_put( "zdtdx", umask(:,:,1)*zdtdx ) ! FK dtdx at u-pt 1610 IF ( iom_use("zdtdy") ) CALL iom_put( "zdtdy", vmask(:,:,1)*zdtdy ) ! FK dtdy at v-pt 1611 IF ( iom_use("zdsdx") ) CALL iom_put( "zdsdx", umask(:,:,1)*zdsdx ) ! FK dtdx at u-pt 1612 IF ( iom_use("zdsdy") ) CALL iom_put( "zdsdy", vmask(:,:,1)*zdsdy ) ! FK dsdy at v-pt 1613 IF ( iom_use("dbdx_mle") ) CALL iom_put( "dbdx_mle", umask(:,:,1)*dbdx_mle ) ! FK dbdx at u-pt 1614 IF ( iom_use("dbdy_mle") ) CALL iom_put( "dbdy_mle", vmask(:,:,1)*dbdy_mle ) ! FK dbdy at v-pt 1615 IF ( iom_use("zdiff_mle") ) CALL iom_put( "zdiff_mle", tmask(:,:,1)*zdiff_mle )! FK diff in MLE at t-pt 1616 IF ( iom_use("zvel_mle") ) CALL iom_put( "zvel_mle", tmask(:,:,1)*zdiff_mle )! FK diff in MLE at t-pt 1617 1618 END IF 1619 1620 CONTAINS 1621 ! subroutine code changed, needs syntax checking. 1622 SUBROUTINE zdf_osm_diffusivity_viscosity( zdiffut, zviscos ) 1623 1624 !!--------------------------------------------------------------------- 1625 !! *** ROUTINE zdf_osm_diffusivity_viscosity *** 1626 !! 1627 !! ** Purpose : Determines the eddy diffusivity and eddy viscosity profiles in the mixed layer and the pycnocline. 1628 !! 1629 !! ** Method : 1630 !! 1631 !! !!---------------------------------------------------------------------- 1632 REAL(wp), DIMENSION(:,:,:) :: zdiffut 1633 REAL(wp), DIMENSION(:,:,:) :: zviscos 1634 ! local 1635 1636 ! Scales used to calculate eddy diffusivity and viscosity profiles 1397 1637 REAL(wp), DIMENSION(jpi,jpj) :: zdifml_sc, zvisml_sc 1398 1638 REAL(wp), DIMENSION(jpi,jpj) :: zdifpyc_n_sc, zdifpyc_s_sc, zdifpyc_shr 1399 1639 REAL(wp), DIMENSION(jpi,jpj) :: zvispyc_n_sc, zvispyc_s_sc,zvispyc_shr 1400 1640 REAL(wp), DIMENSION(jpi,jpj) :: zbeta_d_sc, zbeta_v_sc 1401 !1641 ! 1402 1642 REAL(wp) :: zvel_sc_pyc, zvel_sc_ml, zstab_fac 1403 1643 1404 1644 REAL(wp), PARAMETER :: rn_dif_ml = 0.8, rn_vis_ml = 0.375 1405 1645 REAL(wp), PARAMETER :: rn_dif_pyc = 0.15, rn_vis_pyc = 0.142 1406 1646 REAL(wp), PARAMETER :: rn_vispyc_shr = 0.15 1407 1647 1408 1648 DO jj = 2, jpjm1 1409 1410 1411 1649 DO ji = 2, jpim1 1650 IF ( lconv(ji,jj) ) THEN 1651 1412 1652 zvel_sc_pyc = ( 0.15 * zvstr(ji,jj)**3 + zwstrc(ji,jj)**3 + 4.25 * zshear(ji,jj) * zhbl(ji,jj) )**pthird 1413 1653 zvel_sc_ml = ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird … … 1416 1656 zdifml_sc(ji,jj) = rn_dif_ml * zhml(ji,jj) * zvel_sc_ml 1417 1657 zvisml_sc(ji,jj) = rn_vis_ml * zdifml_sc(ji,jj) 1418 1658 #ifdef key_osm_debug 1659 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 1660 WRITE(narea+100,'(2(a,g11.3))')'Start of 1st major loop of osm_diffusivity_viscositys, lconv=T: zdifml_sc=',zdifml_sc(ji,jj),' zvisml_sc=',zvisml_sc(ji,jj) 1661 WRITE(narea+100,'(3(a,g11.3))')'zvel_sc_pyc=',zvel_sc_pyc,' zvel_sc_ml=',zvel_sc_ml,' zstab_fac=',zstab_fac 1662 FLUSH(narea+100) 1663 END IF 1664 #endif 1419 1665 IF ( lpyc(ji,jj) ) THEN 1420 zdifpyc_n_sc(ji,jj) = rn_dif_pyc * zvel_sc_ml * zdh(ji,jj) 1421 1422 IF ( lshear(ji,jj) .AND. j_ddh(ji,jj) /= 2 ) THEN 1423 zdifpyc_n_sc(ji,jj) = zdifpyc_n_sc(ji,jj) + rn_vispyc_shr * ( zshear(ji,jj) * zhbl(ji,jj) )**pthird * zhbl(ji,jj) 1424 ENDIF 1425 1426 zdifpyc_s_sc(ji,jj) = zwb_ent(ji,jj) + 0.0025 * zvel_sc_pyc * ( zhbl(ji,jj) / zdh(ji,jj) - 1.0 ) * ( zb_ml(ji,jj) - zb_bl(ji,jj) ) 1427 zdifpyc_s_sc(ji,jj) = 0.09 * zdifpyc_s_sc(ji,jj) * zstab_fac 1428 zdifpyc_s_sc(ji,jj) = MAX( zdifpyc_s_sc(ji,jj), -0.5 * zdifpyc_n_sc(ji,jj) ) 1429 1430 zvispyc_n_sc(ji,jj) = 0.09 * zvel_sc_pyc * ( 1.0 - zhbl(ji,jj) / zdh(ji,jj) )**2 * ( 0.005 * ( zu_ml(ji,jj)-zu_bl(ji,jj) )**2 + 0.0075 * ( zv_ml(ji,jj)-zv_bl(ji,jj) )**2 ) / zdh(ji,jj) 1431 zvispyc_n_sc(ji,jj) = rn_vis_pyc * zvel_sc_ml * zdh(ji,jj) + zvispyc_n_sc(ji,jj) * zstab_fac 1432 IF ( lshear(ji,jj) .AND. j_ddh(ji,jj) /= 2 ) THEN 1433 zvispyc_n_sc(ji,jj) = zvispyc_n_sc(ji,jj) + rn_vispyc_shr * ( zshear(ji,jj) * zhbl(ji,jj ) )**pthird * zhbl(ji,jj) 1434 ENDIF 1435 1436 zvispyc_s_sc(ji,jj) = 0.09 * ( zwb_min(ji,jj) + 0.0025 * zvel_sc_pyc * ( zhbl(ji,jj) / zdh(ji,jj) - 1.0 ) * ( zb_ml(ji,jj) - zb_bl(ji,jj) ) ) 1437 zvispyc_s_sc(ji,jj) = zvispyc_s_sc(ji,jj) * zstab_fac 1438 zvispyc_s_sc(ji,jj) = MAX( zvispyc_s_sc(ji,jj), -0.5 * zvispyc_n_sc(ji,jj) ) 1439 1440 zbeta_d_sc(ji,jj) = 1.0 - ( ( zdifpyc_n_sc(ji,jj) + 1.4 * zdifpyc_s_sc(ji,jj) ) / ( zdifml_sc(ji,jj) + epsln ) )**p2third 1441 zbeta_v_sc(ji,jj) = 1.0 - 2.0 * ( zvispyc_n_sc(ji,jj) + zvispyc_s_sc(ji,jj) ) / ( zvisml_sc(ji,jj) + epsln ) 1666 zdifpyc_n_sc(ji,jj) = rn_dif_pyc * zvel_sc_ml * zdh(ji,jj) 1667 zvispyc_n_sc(ji,jj) = 0.09 * zvel_sc_pyc * ( 1.0 - zhbl(ji,jj) / zdh(ji,jj) )**2 * ( 0.005 * ( zu_ml(ji,jj)-zu_bl(ji,jj) )**2 + 0.0075 * ( zv_ml(ji,jj)-zv_bl(ji,jj) )**2 ) / zdh(ji,jj) 1668 zvispyc_n_sc(ji,jj) = rn_vis_pyc * zvel_sc_ml * zdh(ji,jj) + zvispyc_n_sc(ji,jj) * zstab_fac 1669 #ifdef key_osm_debug 1670 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 1671 WRITE(narea+100,'(2(a,g11.3))')' lpyc=lconv=T, variables w/o shear contributions: zdifpyc_n_sc',zdifpyc_n_sc(ji,jj) ,' zvispyc_n_sc=',zvispyc_n_sc(ji,jj) 1672 FLUSH(narea+100) 1673 END IF 1674 #endif 1675 IF ( lshear(ji,jj) .AND. j_ddh(ji,jj) /= 2 ) THEN 1676 zdifpyc_n_sc(ji,jj) = zdifpyc_n_sc(ji,jj) + rn_vispyc_shr * ( zshear(ji,jj) * zhbl(ji,jj) )**pthird * zhbl(ji,jj) 1677 zvispyc_n_sc(ji,jj) = zvispyc_n_sc(ji,jj) + rn_vispyc_shr * ( zshear(ji,jj) * zhbl(ji,jj ) )**pthird * zhbl(ji,jj) 1678 ENDIF 1679 #ifdef key_osm_debug 1680 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 1681 WRITE(narea+100,'(2(a,g11.3))')' lpyc=lconv=T, variables w shear contributions: zdifpyc_n_sc',zdifpyc_n_sc(ji,jj) ,' zvispyc_n_sc=',zvispyc_n_sc(ji,jj) 1682 FLUSH(narea+100) 1683 END IF 1684 #endif 1685 zdifpyc_s_sc(ji,jj) = zwb_ent(ji,jj) + 0.0025 * zvel_sc_pyc * ( zhbl(ji,jj) / zdh(ji,jj) - 1.0 ) * ( zb_ml(ji,jj) - zb_bl(ji,jj) ) 1686 zvispyc_s_sc(ji,jj) = 0.09 * ( zwb_min(ji,jj) + 0.0025 * zvel_sc_pyc * ( zhbl(ji,jj) / zdh(ji,jj) - 1.0 ) * ( zb_ml(ji,jj) - zb_bl(ji,jj) ) ) 1687 #ifdef key_osm_debug 1688 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 1689 WRITE(narea+100,'(2(a,g11.3))')' 1st shot at: zdifpyc_s_sc',zdifpyc_s_sc(ji,jj) ,' zvispyc_s_sc=',zvispyc_s_sc(ji,jj) 1690 FLUSH(narea+100) 1691 END IF 1692 #endif 1693 zdifpyc_s_sc(ji,jj) = 0.09 * zdifpyc_s_sc(ji,jj) * zstab_fac 1694 zvispyc_s_sc(ji,jj) = zvispyc_s_sc(ji,jj) * zstab_fac 1695 #ifdef key_osm_debug 1696 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 1697 WRITE(narea+100,'(2(a,g11.3))')' 2nd shot at: zdifpyc_s_sc',zdifpyc_s_sc(ji,jj) ,' zvispyc_s_sc=',zvispyc_s_sc(ji,jj) 1698 FLUSH(narea+100) 1699 END IF 1700 #endif 1701 1702 zdifpyc_s_sc(ji,jj) = MAX( zdifpyc_s_sc(ji,jj), -0.5 * zdifpyc_n_sc(ji,jj) ) 1703 zvispyc_s_sc(ji,jj) = MAX( zvispyc_s_sc(ji,jj), -0.5 * zvispyc_n_sc(ji,jj) ) 1704 #ifdef key_osm_debug 1705 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 1706 WRITE(narea+100,'(2(a,g11.3))')' Final zdifpyc_s_sc',zdifpyc_s_sc(ji,jj) ,' zvispyc_s_sc=',zvispyc_s_sc(ji,jj) 1707 FLUSH(narea+100) 1708 END IF 1709 #endif 1710 1711 zbeta_d_sc(ji,jj) = 1.0 - ( ( zdifpyc_n_sc(ji,jj) + 1.4 * zdifpyc_s_sc(ji,jj) ) / ( zdifml_sc(ji,jj) + epsln ) )**p2third 1712 zbeta_v_sc(ji,jj) = 1.0 - 2.0 * ( zvispyc_n_sc(ji,jj) + zvispyc_s_sc(ji,jj) ) / ( zvisml_sc(ji,jj) + epsln ) 1442 1713 ELSE 1443 zbeta_d_sc(ji,jj) = 1.01444 zbeta_v_sc(ji,jj) = 1.01714 zbeta_d_sc(ji,jj) = 1.0 1715 zbeta_v_sc(ji,jj) = 1.0 1445 1716 ENDIF 1446 ELSE 1717 #ifdef key_osm_debug 1718 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 1719 WRITE(narea+100,'(2(a,g11.3))')'lconv=T: zbeta_d_sc',zbeta_d_sc(ji,jj) ,' zbeta_v_sc=',zbeta_v_sc(ji,jj) 1720 FLUSH(narea+100) 1721 END IF 1722 #endif 1723 ELSE ! conv, stable 1447 1724 zdifml_sc(ji,jj) = zvstr(ji,jj) * zhbl(ji,jj) * MAX( EXP ( -( zhol(ji,jj) / 0.6_wp )**2 ), 0.2_wp) 1448 1725 zvisml_sc(ji,jj) = zvstr(ji,jj) * zhbl(ji,jj) * MAX( EXP ( -( zhol(ji,jj) / 0.6_wp )**2 ), 0.2_wp) 1449 END IF 1450 END DO 1451 END DO 1452 ! 1453 DO jj = 2, jpjm1 1454 DO ji = 2, jpim1 1455 IF ( lconv(ji,jj) ) THEN 1456 DO jk = 2, imld(ji,jj) ! mixed layer diffusivity 1457 zznd_ml = gdepw_n(ji,jj,jk) / zhml(ji,jj) 1458 ! 1459 zdiffut(ji,jj,jk) = zdifml_sc(ji,jj) * zznd_ml * ( 1.0 - zbeta_d_sc(ji,jj) * zznd_ml )**1.5 1460 ! 1461 zviscos(ji,jj,jk) = zvisml_sc(ji,jj) * zznd_ml * ( 1.0 - zbeta_v_sc(ji,jj) * zznd_ml ) & 1462 & * ( 1.0 - 0.5 * zznd_ml**2 ) 1463 END DO 1464 ! pycnocline 1465 IF ( lpyc(ji,jj) ) THEN 1466 ! Diffusivity profile in the pycnocline given by cubic polynomial. 1467 za_cubic = 0.5 1468 zb_cubic = -1.75 * zdifpyc_s_sc(ji,jj) / zdifpyc_n_sc(ji,jj) 1469 zd_cubic = ( zdh(ji,jj) * zdifml_sc(ji,jj) / zhml(ji,jj) * SQRT( 1.0 - zbeta_d_sc(ji,jj) ) * ( 2.5 * zbeta_d_sc(ji,jj) - 1.0 ) & 1470 & - 0.85 * zdifpyc_s_sc(ji,jj) ) / MAX(zdifpyc_n_sc(ji,jj), 1.e-8) 1471 zd_cubic = zd_cubic - zb_cubic - 2.0 * ( 1.0 - za_cubic - zb_cubic ) 1472 zc_cubic = 1.0 - za_cubic - zb_cubic - zd_cubic 1473 DO jk = imld(ji,jj) , ibld(ji,jj) 1726 #ifdef key_osm_debug 1727 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 1728 WRITE(narea+100,'(a,g11.3)')'End of 1st major loop of osm_diffusivity_viscositys, lconv=F: zdifml_sc=',zdifml_sc(ji,jj),' zvisml_sc=',zvisml_sc(ji,jj) 1729 FLUSH(narea+100) 1730 END IF 1731 #endif 1732 END IF 1733 1734 END DO 1735 END DO 1736 ! 1737 DO jj = 2, jpjm1 1738 DO ji = 2, jpim1 1739 IF ( lconv(ji,jj) ) THEN 1740 DO jk = 2, imld(ji,jj) ! mixed layer diffusivity 1741 zznd_ml = gdepw_n(ji,jj,jk) / zhml(ji,jj) 1742 ! 1743 zdiffut(ji,jj,jk) = zdifml_sc(ji,jj) * zznd_ml * ( 1.0 - zbeta_d_sc(ji,jj) * zznd_ml )**1.5 1744 ! 1745 zviscos(ji,jj,jk) = zvisml_sc(ji,jj) * zznd_ml * ( 1.0 - zbeta_v_sc(ji,jj) * zznd_ml ) & 1746 & * ( 1.0 - 0.5 * zznd_ml**2 ) 1747 END DO 1748 ! pycnocline 1749 IF ( lpyc(ji,jj) ) THEN 1750 ! Diffusivity profile in the pycnocline given by cubic polynomial. 1751 za_cubic = 0.5 1752 zb_cubic = -1.75 * zdifpyc_s_sc(ji,jj) / zdifpyc_n_sc(ji,jj) 1753 zd_cubic = ( zdh(ji,jj) * zdifml_sc(ji,jj) / zhml(ji,jj) * SQRT( 1.0 - zbeta_d_sc(ji,jj) ) * ( 2.5 * zbeta_d_sc(ji,jj) - 1.0 ) & 1754 & - 0.85 * zdifpyc_s_sc(ji,jj) ) / MAX(zdifpyc_n_sc(ji,jj), 1.e-8) 1755 zd_cubic = zd_cubic - zb_cubic - 2.0 * ( 1.0 - za_cubic - zb_cubic ) 1756 zc_cubic = 1.0 - za_cubic - zb_cubic - zd_cubic 1757 DO jk = imld(ji,jj) , ibld(ji,jj) 1474 1758 zznd_pyc = -( gdepw_n(ji,jj,jk) - zhbl(ji,jj) ) / MAX(zdh(ji,jj), 1.e-6) 1475 1759 ! 1476 1760 zdiffut(ji,jj,jk) = zdifpyc_n_sc(ji,jj) * ( za_cubic + zb_cubic * zznd_pyc + zc_cubic * zznd_pyc**2 + zd_cubic * zznd_pyc**3 ) 1477 1761 1478 1762 zdiffut(ji,jj,jk) = zdiffut(ji,jj,jk) + zdifpyc_s_sc(ji,jj) * ( 1.75 * zznd_pyc - 0.15 * zznd_pyc**2 - 0.2 * zznd_pyc**3 ) 1479 1480 ! viscosity profiles.1481 1482 1483 1484 1485 1486 1487 1488 1489 1490 1491 1492 zdiffut(ji,jj,ibld(ji,jj)+1) = MAX( 0.5 * zdhdt(ji,jj) * e3w_n(ji,jj,ibld(ji,jj)+1), 1.0e-6 )1493 zviscos(ji,jj,ibld(ji,jj)+1) = MAX( 0.5 * zdhdt(ji,jj) * e3w_n(ji,jj,ibld(ji,jj)+1), 1.0e-6 )1494 1763 END DO 1764 ! viscosity profiles. 1765 za_cubic = 0.5 1766 zb_cubic = -1.75 * zvispyc_s_sc(ji,jj) / zvispyc_n_sc(ji,jj) 1767 zd_cubic = ( 0.5 * zvisml_sc(ji,jj) * zdh(ji,jj) / zhml(ji,jj) - 0.85 * zvispyc_s_sc(ji,jj) ) / MAX(zvispyc_n_sc(ji,jj), 1.e-8) 1768 zd_cubic = zd_cubic - zb_cubic - 2.0 * ( 1.0 - za_cubic - zb_cubic ) 1769 zc_cubic = 1.0 - za_cubic - zb_cubic - zd_cubic 1770 DO jk = imld(ji,jj) , ibld(ji,jj) 1771 zznd_pyc = -( gdepw_n(ji,jj,jk) - zhbl(ji,jj) ) / MAX(zdh(ji,jj), 1.e-6) 1772 zviscos(ji,jj,jk) = zvispyc_n_sc(ji,jj) * ( za_cubic + zb_cubic * zznd_pyc + zc_cubic * zznd_pyc**2 + zd_cubic * zznd_pyc**3 ) 1773 zviscos(ji,jj,jk) = zviscos(ji,jj,jk) + zvispyc_s_sc(ji,jj) * ( 1.75 * zznd_pyc - 0.15 * zznd_pyc**2 -0.2 * zznd_pyc**3 ) 1774 END DO 1775 IF ( zdhdt(ji,jj) > 0._wp ) THEN 1776 zdiffut(ji,jj,ibld(ji,jj)+1) = MAX( 0.5 * zdhdt(ji,jj) * e3w_n(ji,jj,ibld(ji,jj)+1), 1.0e-6 ) 1777 zviscos(ji,jj,ibld(ji,jj)+1) = MAX( 0.5 * zdhdt(ji,jj) * e3w_n(ji,jj,ibld(ji,jj)+1), 1.0e-6 ) 1778 ELSE 1495 1779 zdiffut(ji,jj,ibld(ji,jj)) = 0._wp 1496 1780 zviscos(ji,jj,ibld(ji,jj)) = 0._wp 1497 ENDIF 1498 ENDIF 1499 ELSE 1500 ! stable conditions 1501 DO jk = 2, ibld(ji,jj) 1502 zznd_ml = gdepw_n(ji,jj,jk) / zhbl(ji,jj) 1503 zdiffut(ji,jj,jk) = 0.75 * zdifml_sc(ji,jj) * zznd_ml * ( 1.0 - zznd_ml )**1.5 1504 zviscos(ji,jj,jk) = 0.375 * zvisml_sc(ji,jj) * zznd_ml * (1.0 - zznd_ml) * ( 1.0 - zznd_ml**2 ) 1505 END DO 1506 1507 IF ( zdhdt(ji,jj) > 0._wp ) THEN 1508 zdiffut(ji,jj,ibld(ji,jj)) = MAX(zdhdt(ji,jj), 1.0e-6) * e3w_n(ji, jj, ibld(ji,jj)) 1509 zviscos(ji,jj,ibld(ji,jj)) = MAX(zdhdt(ji,jj), 1.0e-6) * e3w_n(ji, jj, ibld(ji,jj)) 1510 ENDIF 1511 ENDIF ! end if ( lconv ) 1512 ! 1513 END DO ! end of ji loop 1514 END DO ! end of jj loop 1515 1516 END SUBROUTINE zdf_osm_diffusivity_viscosity 1517 1518 SUBROUTINE zdf_osm_osbl_state( lconv, lshear, j_ddh, zwb_ent, zwb_min, zshear ) 1519 1520 !!--------------------------------------------------------------------- 1521 !! *** ROUTINE zdf_osm_osbl_state *** 1522 !! 1523 !! ** Purpose : Determines the state of the OSBL, stable/unstable, shear/ noshear. Also determines shear production, entrainment buoyancy flux and interfacial Richardson number 1524 !! 1525 !! ** Method : 1526 !! 1527 !! !!---------------------------------------------------------------------- 1528 1529 INTEGER, DIMENSION(jpi,jpj) :: j_ddh ! j_ddh = 0, active shear layer; j_ddh=1, shear layer not active; j_ddh=2 shear production low. 1530 1531 LOGICAL, DIMENSION(jpi,jpj) :: lconv, lshear 1532 1533 REAL(wp), DIMENSION(jpi,jpj) :: zwb_ent, zwb_min ! Buoyancy fluxes at base of well-mixed layer. 1534 REAL(wp), DIMENSION(jpi,jpj) :: zshear ! production of TKE due to shear across the pycnocline 1535 1536 ! Local Variables 1537 1538 INTEGER :: jj, ji 1539 1540 REAL(wp), DIMENSION(jpi,jpj) :: zekman 1541 REAL(wp), DIMENSION(jpi,jpj) :: zri_p, zri_b ! Richardson numbers 1542 REAL(wp) :: zshear_u, zshear_v, zwb_shr 1543 REAL(wp) :: zwcor, zrf_conv, zrf_shear, zrf_langmuir, zr_stokes 1544 1545 REAL, PARAMETER :: za_shr = 0.4, zb_shr = 6.5, za_wb_s = 0.8 1546 REAL, PARAMETER :: zalpha_c = 0.2, zalpha_lc = 0.03 1547 REAL, PARAMETER :: zalpha_ls = 0.06, zalpha_s = 0.15 1548 REAL, PARAMETER :: rn_ri_p_thresh = 27.0 1549 REAL, PARAMETER :: zri_c = 0.25 1550 REAL, PARAMETER :: zek = 4.0 1551 REAL, PARAMETER :: zrot=0._wp ! dummy rotation rate of surface stress. 1552 1553 ! Determins stability and set flag lconv 1554 DO jj = 2, jpjm1 1555 DO ji = 2, jpim1 1556 IF ( zhol(ji,jj) < 0._wp ) THEN 1557 lconv(ji,jj) = .TRUE. 1558 ELSE 1559 lconv(ji,jj) = .FALSE. 1560 ENDIF 1561 END DO 1562 END DO 1563 1564 zekman(:,:) = EXP( - zek * ABS( ff_t(:,:) ) * zhbl(:,:) / MAX(zustar(:,:), 1.e-8 ) ) 1565 1566 zshear(:,:) = 0._wp 1567 j_ddh(:,:) = 1 1568 1569 DO jj = 2, jpjm1 1570 DO ji = 2, jpim1 1571 IF ( lconv(ji,jj) ) THEN 1572 IF ( zdb_bl(ji,jj) > 0._wp ) THEN 1573 zri_p(ji,jj) = MAX ( SQRT( zdb_bl(ji,jj) * zdh(ji,jj) / MAX( zdu_bl(ji,jj)**2 + zdv_bl(ji,jj)**2, 1.e-8) ) * ( zhbl(ji,jj) / zdh(ji,jj) ) * ( zvstr(ji,jj) / MAX( zustar(ji,jj), 1.e-6 ) )**2 & 1574 & / MAX( zekman(ji,jj), 1.e-6 ) , 5._wp ) 1575 1576 IF ( ff_t(ji,jj) >= 0._wp ) THEN 1577 ! Northern Hemisphere 1578 zri_b(ji,jj) = zdb_ml(ji,jj) * zdh(ji,jj) / ( MAX( zdu_ml(ji,jj), 1.e-5 )**2 + MAX( -zdv_ml(ji,jj), 1.e-5)**2 ) 1579 ELSE 1580 ! Southern Hemisphere 1581 zri_b(ji,jj) = zdb_ml(ji,jj) * zdh(ji,jj) / ( MAX( zdu_ml(ji,jj), 1.e-5 )**2 + MAX( zdv_ml(ji,jj), 1.e-5)**2 ) 1582 ENDIF 1583 zshear(ji,jj) = za_shr * zekman(ji,jj) * ( MAX( zustar(ji,jj)**2 * zdu_ml(ji,jj) / zhbl(ji,jj), 0._wp ) + zb_shr * MAX( -ff_t(ji,jj) * zustke(ji,jj) * dstokes(ji,jj) * zdv_ml(ji,jj) / zhbl(ji,jj), 0._wp ) ) 1584 ! Stability Dependence 1585 zshear(ji,jj) = zshear(ji,jj) * EXP( -0.75 * MAX(0._wp,( zri_b(ji,jj) - zri_c ) / zri_c ) ) 1781 ENDIF 1782 ENDIF 1783 ELSE 1784 ! stable conditions 1785 DO jk = 2, ibld(ji,jj) 1786 zznd_ml = gdepw_n(ji,jj,jk) / zhbl(ji,jj) 1787 zdiffut(ji,jj,jk) = 0.75 * zdifml_sc(ji,jj) * zznd_ml * ( 1.0 - zznd_ml )**1.5 1788 zviscos(ji,jj,jk) = 0.375 * zvisml_sc(ji,jj) * zznd_ml * (1.0 - zznd_ml) * ( 1.0 - zznd_ml**2 ) 1789 END DO 1790 1791 IF ( zdhdt(ji,jj) > 0._wp ) THEN 1792 zdiffut(ji,jj,ibld(ji,jj)) = MAX(zdhdt(ji,jj), 1.0e-6) * e3w_n(ji, jj, ibld(ji,jj)) 1793 zviscos(ji,jj,ibld(ji,jj)) = MAX(zdhdt(ji,jj), 1.0e-6) * e3w_n(ji, jj, ibld(ji,jj)) 1794 ENDIF 1795 ENDIF ! end if ( lconv ) 1796 ! 1797 END DO ! end of ji loop 1798 END DO ! end of jj loop 1799 1800 END SUBROUTINE zdf_osm_diffusivity_viscosity 1801 1802 SUBROUTINE zdf_osm_osbl_state( lconv, lshear, j_ddh, zwb_ent, zwb_min, zshear ) 1803 1804 !!--------------------------------------------------------------------- 1805 !! *** ROUTINE zdf_osm_osbl_state *** 1806 !! 1807 !! ** Purpose : Determines the state of the OSBL, stable/unstable, shear/ noshear. Also determines shear production, entrainment buoyancy flux and interfacial Richardson number 1808 !! 1809 !! ** Method : 1810 !! 1811 !! !!---------------------------------------------------------------------- 1812 1813 INTEGER, DIMENSION(jpi,jpj) :: j_ddh ! j_ddh = 0, active shear layer; j_ddh=1, shear layer not active; j_ddh=2 shear production low. 1814 1815 LOGICAL, DIMENSION(jpi,jpj) :: lconv, lshear 1816 1817 REAL(wp), DIMENSION(jpi,jpj) :: zwb_ent, zwb_min ! Buoyancy fluxes at base of well-mixed layer. 1818 REAL(wp), DIMENSION(jpi,jpj) :: zshear ! production of TKE due to shear across the pycnocline 1819 1820 ! Local Variables 1821 1822 INTEGER :: jj, ji 1823 1824 REAL(wp), DIMENSION(jpi,jpj) :: zekman 1825 REAL(wp), DIMENSION(jpi,jpj) :: zri_p, zri_b ! Richardson numbers 1826 REAL(wp) :: zshear_u, zshear_v, zwb_shr 1827 REAL(wp) :: zwcor, zrf_conv, zrf_shear, zrf_langmuir, zr_stokes 1828 1829 REAL, PARAMETER :: za_shr = 0.4, zb_shr = 6.5, za_wb_s = 0.8 1830 REAL, PARAMETER :: zalpha_c = 0.2, zalpha_lc = 0.03 1831 REAL, PARAMETER :: zalpha_ls = 0.06, zalpha_s = 0.15 1832 REAL, PARAMETER :: rn_ri_p_thresh = 27.0 1833 REAL, PARAMETER :: zri_c = 0.25 1834 REAL, PARAMETER :: zek = 4.0 1835 REAL, PARAMETER :: zrot=0._wp ! dummy rotation rate of surface stress. 1836 1837 ! Determins stability and set flag lconv 1838 DO jj = 2, jpjm1 1839 DO ji = 2, jpim1 1840 IF ( zhol(ji,jj) < 0._wp ) THEN 1841 lconv(ji,jj) = .TRUE. 1842 ELSE 1843 lconv(ji,jj) = .FALSE. 1844 ENDIF 1845 END DO 1846 END DO 1847 1848 zekman(:,:) = EXP( - zek * ABS( ff_t(:,:) ) * zhbl(:,:) / MAX(zustar(:,:), 1.e-8 ) ) 1849 1850 zshear(:,:) = 0._wp 1851 #ifdef key_osm_debug 1852 IF(narea==nn_narea_db) THEN 1853 ji=iloc_db; jj=jloc_db 1854 WRITE(narea+100,'(a,g11.3)') & 1855 & 'zdf_osm_osbl_state start: zekman=', zekman(ji,jj) 1856 FLUSH(narea+100) 1857 END IF 1858 #endif 1859 j_ddh(:,:) = 1 1860 1861 DO jj = 2, jpjm1 1862 DO ji = 2, jpim1 1863 IF ( lconv(ji,jj) ) THEN 1864 IF ( zdb_bl(ji,jj) > 0._wp ) THEN 1865 zri_p(ji,jj) = MAX ( SQRT( zdb_bl(ji,jj) * zdh(ji,jj) / MAX( zdu_bl(ji,jj)**2 + zdv_bl(ji,jj)**2, 1.e-8) ) * ( zhbl(ji,jj) / zdh(ji,jj) ) * ( zvstr(ji,jj) / MAX( zustar(ji,jj), 1.e-6 ) )**2 & 1866 & / MAX( zekman(ji,jj), 1.e-6 ) , 5._wp ) 1867 1868 IF ( ff_t(ji,jj) >= 0._wp ) THEN 1869 ! Northern Hemisphere 1870 zri_b(ji,jj) = zdb_ml(ji,jj) * zdh(ji,jj) / ( MAX( zdu_ml(ji,jj), 1.e-5 )**2 + MAX( -zdv_ml(ji,jj), 1.e-5)**2 ) 1871 ELSE 1872 ! Southern Hemisphere 1873 zri_b(ji,jj) = zdb_ml(ji,jj) * zdh(ji,jj) / ( MAX( zdu_ml(ji,jj), 1.e-5 )**2 + MAX( zdv_ml(ji,jj), 1.e-5)**2 ) 1874 ENDIF 1875 zshear(ji,jj) = za_shr * zekman(ji,jj) * ( MAX( zustar(ji,jj)**2 * zdu_ml(ji,jj) / zhbl(ji,jj), 0._wp ) + zb_shr * MAX( -ff_t(ji,jj) * zustke(ji,jj) * dstokes(ji,jj) * zdv_ml(ji,jj) / zhbl(ji,jj), 0._wp ) ) 1876 #ifdef key_osm_debug 1877 ! IF(narea==nn_narea_db)THEN 1878 ! WRITE(narea+100,'(2(a,i10.4))')'ji',ji,'jj',jj 1879 ! WRITE(narea+100,'(2(a,i10.4))')'iloc_db',iloc_db,'jloc_db',jloc_db 1880 ! WRITE(narea+100,'(2(a,i10.4))')'iloc_db+',mi0(nn_idb),'jloc_db+',mj0(nn_jdb) 1881 ! FLUSH(narea+100) 1882 ! END IF 1883 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 1884 WRITE(narea+100,'(a,g11.3)')'zdf_osm_osbl_state 1st zshear: zshear=',zshear(ji,jj) 1885 WRITE(narea+100,'(2(a,g11.3))')'zdf_osm_osbl_state 1st zshear: zri_b=',zri_b(ji,jj),' zri_p=',zri_p(ji,jj) 1886 FLUSH(narea+100) 1887 END IF 1888 #endif 1889 ! Stability Dependence 1890 zshear(ji,jj) = zshear(ji,jj) * EXP( -0.75 * MAX(0._wp,( zri_b(ji,jj) - zri_c ) / zri_c ) ) 1891 #ifdef key_osm_debug 1892 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 1893 WRITE(narea+100,'(a,g11.3)')'zdf_osm_osbl_state 1st zshear: zshear inc ri part=',zshear(ji,jj) 1894 FLUSH(narea+100) 1895 END IF 1896 #endif 1897 1586 1898 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1587 ! Test ensures j_ddh=0 is not selected. Change to zri_p<27 when !1588 ! full code available !1899 ! Test ensures j_ddh=0 is not selected. Change to zri_p<27 when ! 1900 ! full code available ! 1589 1901 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1590 IF ( zshear(ji,jj) > 1.e-10 .AND. MIN(hu_n(ji,jj), hu_n(ji-1,jj), hv_n(ji,jj), hv_n(ji,jj-1))>100._wp ) THEN 1591 IF ( zri_p(ji,jj) < rn_ri_p_thresh ) THEN 1592 ! Growing shear layer 1593 j_ddh(ji,jj) = 0 1594 lshear(ji,jj) = .TRUE. 1595 ELSE 1596 j_ddh(ji,jj) = 1 1597 ! IF ( zri_b <= 1.5 .and. zshear(ji,jj) > 0._wp ) THEN 1598 ! shear production large enough to determine layer charcteristics, but can't maintain a shear layer. 1599 lshear(ji,jj) = .TRUE. 1600 ! ELSE 1601 ENDIF 1602 ELSE 1603 j_ddh(ji,jj) = 2 1604 lshear(ji,jj) = .FALSE. 1902 IF ( zshear(ji,jj) > 1.e-10 .AND. MIN(hu_n(ji,jj), hu_n(ji-1,jj), hv_n(ji,jj), hv_n(ji,jj-1))>100._wp ) THEN 1903 IF ( zri_p(ji,jj) < rn_ri_p_thresh ) THEN 1904 ! Growing shear layer 1905 j_ddh(ji,jj) = 0 1906 lshear(ji,jj) = .TRUE. 1907 ELSE 1908 j_ddh(ji,jj) = 1 1909 ! IF ( zri_b <= 1.5 .and. zshear(ji,jj) > 0._wp ) THEN 1910 ! shear production large enough to determine layer charcteristics, but can't maintain a shear layer. 1911 lshear(ji,jj) = .TRUE. 1912 ! ELSE 1913 ENDIF 1914 ELSE 1915 j_ddh(ji,jj) = 2 1916 lshear(ji,jj) = .FALSE. 1917 ENDIF 1918 ! Shear production may not be zero, but is small and doesn't determine characteristics of pycnocline. 1919 ! zshear(ji,jj) = 0.5 * zshear(ji,jj) 1920 ! lshear(ji,jj) = .FALSE. 1921 ! ENDIF 1922 ELSE ! zdb_bl test, note zshear set to zero 1923 j_ddh(ji,jj) = 2 1924 lshear(ji,jj) = .FALSE. 1925 ENDIF 1605 1926 ENDIF 1606 ! Shear production may not be zero, but is small and doesn't determine characteristics of pycnocline. 1607 ! zshear(ji,jj) = 0.5 * zshear(ji,jj) 1608 ! lshear(ji,jj) = .FALSE. 1609 ! ENDIF 1610 ELSE ! zdb_bl test, note zshear set to zero 1611 j_ddh(ji,jj) = 2 1612 lshear(ji,jj) = .FALSE. 1927 END DO 1928 END DO 1929 1930 ! Calculate entrainment buoyancy flux due to surface fluxes. 1931 1932 DO jj = 2, jpjm1 1933 DO ji = 2, jpim1 1934 IF ( lconv(ji,jj) ) THEN 1935 zwcor = ABS(ff_t(ji,jj)) * zhbl(ji,jj) + epsln 1936 zrf_conv = TANH( ( zwstrc(ji,jj) / zwcor )**0.69 ) 1937 zrf_shear = TANH( ( zustar(ji,jj) / zwcor )**0.69 ) 1938 zrf_langmuir = TANH( ( zwstrl(ji,jj) / zwcor )**0.69 ) 1939 IF (nn_osm_SD_reduce > 0 ) THEN 1940 ! Effective Stokes drift already reduced from surface value 1941 zr_stokes = 1.0_wp 1942 ELSE 1943 ! Effective Stokes drift only reduced by factor rn_zdfodm_adjust_sd, 1944 ! requires further reduction where BL is deep 1945 zr_stokes = 1.0 - EXP( -25.0 * dstokes(ji,jj) / hbl(ji,jj) & 1946 & * ( 1.0 + 4.0 * dstokes(ji,jj) / hbl(ji,jj) ) ) 1947 END IF 1948 zwb_ent(ji,jj) = - 2.0 * zalpha_c * zrf_conv * zwbav(ji,jj) & 1949 & - zalpha_s * zrf_shear * zustar(ji,jj)**3 /zhml(ji,jj) & 1950 & + zr_stokes * ( zalpha_s * EXP( -1.5 * zla(ji,jj) ) * zrf_shear * zustar(ji,jj)**3 & 1951 & - zrf_langmuir * zalpha_lc * zwstrl(ji,jj)**3 ) / zhml(ji,jj) 1952 ! 1953 #ifdef key_osm_debug 1954 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 1955 WRITE(narea+100,'(a,g11.3)')'zdf_osm_osbl_state conv+shear0/lang: zwb_ent=',zwb_ent(ji,jj) 1956 FLUSH(narea+100) 1957 END IF 1958 #endif 1613 1959 ENDIF 1614 ENDIF 1615 END DO 1616 END DO 1617 1618 ! Calculate entrainment buoyancy flux due to surface fluxes. 1619 1620 DO jj = 2, jpjm1 1621 DO ji = 2, jpim1 1622 IF ( lconv(ji,jj) ) THEN 1623 zwcor = ABS(ff_t(ji,jj)) * zhbl(ji,jj) + epsln 1624 zrf_conv = TANH( ( zwstrc(ji,jj) / zwcor )**0.69 ) 1625 zrf_shear = TANH( ( zustar(ji,jj) / zwcor )**0.69 ) 1626 zrf_langmuir = TANH( ( zwstrl(ji,jj) / zwcor )**0.69 ) 1627 IF (nn_osm_SD_reduce > 0 ) THEN 1628 ! Effective Stokes drift already reduced from surface value 1629 zr_stokes = 1.0_wp 1630 ELSE 1631 ! Effective Stokes drift only reduced by factor rn_zdfodm_adjust_sd, 1632 ! requires further reduction where BL is deep 1633 zr_stokes = 1.0 - EXP( -25.0 * dstokes(ji,jj) / hbl(ji,jj) & 1634 & * ( 1.0 + 4.0 * dstokes(ji,jj) / hbl(ji,jj) ) ) 1635 END IF 1636 zwb_ent(ji,jj) = - 2.0 * zalpha_c * zrf_conv * zwbav(ji,jj) & 1637 & - zalpha_s * zrf_shear * zustar(ji,jj)**3 /zhml(ji,jj) & 1638 & + zr_stokes * ( zalpha_s * EXP( -1.5 * zla(ji,jj) ) * zrf_shear * zustar(ji,jj)**3 & 1639 & - zrf_langmuir * zalpha_lc * zwstrl(ji,jj)**3 ) / zhml(ji,jj) 1640 ! 1641 ENDIF 1642 END DO ! ji loop 1643 END DO ! jj loop 1644 1645 zwb_min(:,:) = 0._wp 1646 1647 DO jj = 2, jpjm1 1648 DO ji = 2, jpim1 1649 IF ( lshear(ji,jj) ) THEN 1650 IF ( lconv(ji,jj) ) THEN 1651 ! Unstable OSBL 1652 zwb_shr = -za_wb_s * zri_b(ji,jj) * zshear(ji,jj) 1653 IF ( j_ddh(ji,jj) == 0 ) THEN 1654 1655 ! ! Developing shear layer, additional shear production possible. 1656 1657 ! zshear_u = MAX( zustar(ji,jj)**2 * MAX( zdu_ml(ji,jj), 0._wp ) / zhbl(ji,jj), 0._wp ) 1658 ! zshear(ji,jj) = zshear(ji,jj) + zshear_u * ( 1.0 - MIN( zri_p(ji,jj) / rn_ri_p_thresh, 1.d0 )**2 ) 1659 ! zshear(ji,jj) = MIN( zshear(ji,jj), zshear_u ) 1660 1661 ! zwb_shr = zwb_shr - 0.25 * MAX ( zshear_u, 0._wp) * ( 1.0 - MIN( zri_p(ji,jj) / rn_ri_p_thresh, 1._wp )**2 ) 1662 ! zwb_shr = MAX( zwb_shr, -0.25 * zshear_u ) 1663 1664 ENDIF 1665 zwb_ent(ji,jj) = zwb_ent(ji,jj) + zwb_shr 1666 ! zwb_min(ji,jj) = zwb_ent(ji,jj) + zdh(ji,jj) / zhbl(ji,jj) * zwb0(ji,jj) 1667 ELSE ! IF ( lconv ) THEN - ENDIF 1668 ! Stable OSBL - shear production not coded for first attempt. 1669 ENDIF ! lconv 1670 ENDIF ! lshear 1671 IF ( lconv(ji,jj) ) THEN 1672 ! Unstable OSBL 1673 zwb_min(ji,jj) = zwb_ent(ji,jj) + zdh(ji,jj) / zhbl(ji,jj) * zwb0tot(ji,jj) 1674 ENDIF ! lconv 1675 END DO ! ji 1676 END DO ! jj 1677 END SUBROUTINE zdf_osm_osbl_state 1678 1679 1680 SUBROUTINE zdf_osm_vertical_average( jnlev_av, jp_ext, zt, zs, zb, zu, zv, zdt, zds, zdb, zdu, zdv ) 1681 !!--------------------------------------------------------------------- 1682 !! *** ROUTINE zdf_vertical_average *** 1683 !! 1684 !! ** Purpose : Determines vertical averages from surface to jnlev. 1685 !! 1686 !! ** Method : Averages are calculated from the surface to jnlev. 1687 !! The external level used to calculate differences is ibld+ibld_ext 1688 !! 1689 !!---------------------------------------------------------------------- 1690 1691 INTEGER, DIMENSION(jpi,jpj) :: jnlev_av ! Number of levels to average over. 1692 INTEGER, DIMENSION(jpi,jpj) :: jp_ext 1693 1694 ! Alan: do we need zb? 1695 REAL(wp), DIMENSION(jpi,jpj) :: zt, zs, zb ! Average temperature and salinity 1696 REAL(wp), DIMENSION(jpi,jpj) :: zu,zv ! Average current components 1697 REAL(wp), DIMENSION(jpi,jpj) :: zdt, zds, zdb ! Difference between average and value at base of OSBL 1698 REAL(wp), DIMENSION(jpi,jpj) :: zdu, zdv ! Difference for velocity components. 1699 1700 INTEGER :: jk, ji, jj, ibld_ext 1701 REAL(wp) :: zthick, zthermal, zbeta 1702 1703 1704 zt = 0._wp 1705 zs = 0._wp 1706 zu = 0._wp 1707 zv = 0._wp 1708 DO jj = 2, jpjm1 ! Vertical slab 1960 END DO ! ji loop 1961 END DO ! jj loop 1962 1963 zwb_min(:,:) = 0._wp 1964 1965 DO jj = 2, jpjm1 1966 DO ji = 2, jpim1 1967 IF ( lshear(ji,jj) ) THEN 1968 IF ( lconv(ji,jj) ) THEN 1969 ! Unstable OSBL 1970 zwb_shr = -za_wb_s * zri_b(ji,jj) * zshear(ji,jj) 1971 #ifdef key_osm_debug 1972 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 1973 WRITE(narea+100,'(a,g11.3)')'zdf_osm_osbl_state 1st zwb_shr: zwb_shr=',zwb_shr 1974 FLUSH(narea+100) 1975 END IF 1976 #endif 1977 IF ( j_ddh(ji,jj) == 0 ) THEN 1978 1979 ! ! Developing shear layer, additional shear production possible. 1980 1981 ! zshear_u = MAX( zustar(ji,jj)**2 * MAX( zdu_ml(ji,jj), 0._wp ) / zhbl(ji,jj), 0._wp ) 1982 ! zshear(ji,jj) = zshear(ji,jj) + zshear_u * ( 1.0 - MIN( zri_p(ji,jj) / rn_ri_p_thresh, 1.d0 )**2 ) 1983 ! zshear(ji,jj) = MIN( zshear(ji,jj), zshear_u ) 1984 1985 ! zwb_shr = zwb_shr - 0.25 * MAX ( zshear_u, 0._wp) * ( 1.0 - MIN( zri_p(ji,jj) / rn_ri_p_thresh, 1._wp )**2 ) 1986 ! zwb_shr = MAX( zwb_shr, -0.25 * zshear_u ) 1987 #ifdef key_osm_debug 1988 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 1989 WRITE(narea+100,'(3(a,g11.3))')'zdf_osm_osbl_state j_ddh(ji,jj) == 0:zwb_shr=',zwb_shr, & 1990 & ' zshear=',zshear(ji,jj),' zshear_u=', zshear_u 1991 FLUSH(narea+100) 1992 END IF 1993 #endif 1994 1995 ENDIF 1996 zwb_ent(ji,jj) = zwb_ent(ji,jj) + zwb_shr 1997 ! zwb_min(ji,jj) = zwb_ent(ji,jj) + zdh(ji,jj) / zhbl(ji,jj) * zwb0(ji,jj) 1998 ELSE ! IF ( lconv ) THEN - ENDIF 1999 ! Stable OSBL - shear production not coded for first attempt. 2000 ENDIF ! lconv 2001 ENDIF ! lshear 2002 IF ( lconv(ji,jj) ) THEN 2003 ! Unstable OSBL 2004 zwb_min(ji,jj) = zwb_ent(ji,jj) + zdh(ji,jj) / zhbl(ji,jj) * 2._wp * zwbav(ji,jj) 2005 ENDIF ! lconv 2006 #ifdef key_osm_debug 2007 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 2008 WRITE(narea+100,'(3(a,g11.3))')'end of zdf_osm_osbl_state:zwb_ent=',zwb_ent(ji,jj), & 2009 & ' zwb_min=',zwb_min(ji,jj), ' zwb0tot=', zwb0tot(ji,jj), ' zwbav= ', zwbav(ji,jj) 2010 FLUSH(narea+100) 2011 END IF 2012 #endif 2013 END DO ! ji 2014 END DO ! jj 2015 END SUBROUTINE zdf_osm_osbl_state 2016 2017 2018 SUBROUTINE zdf_osm_vertical_average( jnlev_av, jp_ext, zt, zs, zb, zu, zv, zdt, zds, zdb, zdu, zdv ) 2019 !!--------------------------------------------------------------------- 2020 !! *** ROUTINE zdf_vertical_average *** 2021 !! 2022 !! ** Purpose : Determines vertical averages from surface to jnlev. 2023 !! 2024 !! ** Method : Averages are calculated from the surface to jnlev. 2025 !! The external level used to calculate differences is ibld+ibld_ext 2026 !! 2027 !!---------------------------------------------------------------------- 2028 2029 INTEGER, DIMENSION(jpi,jpj) :: jnlev_av ! Number of levels to average over. 2030 INTEGER, DIMENSION(jpi,jpj) :: jp_ext 2031 2032 ! Alan: do we need zb? 2033 REAL(wp), DIMENSION(jpi,jpj) :: zt, zs, zb ! Average temperature and salinity 2034 REAL(wp), DIMENSION(jpi,jpj) :: zu,zv ! Average current components 2035 REAL(wp), DIMENSION(jpi,jpj) :: zdt, zds, zdb ! Difference between average and value at base of OSBL 2036 REAL(wp), DIMENSION(jpi,jpj) :: zdu, zdv ! Difference for velocity components. 2037 2038 INTEGER :: jk, ji, jj, ibld_ext 2039 REAL(wp) :: zthick, zthermal, zbeta 2040 2041 2042 zt = 0._wp 2043 zs = 0._wp 2044 zu = 0._wp 2045 zv = 0._wp 2046 DO jj = 2, jpjm1 ! Vertical slab 1709 2047 DO ji = 2, jpim1 1710 2048 zthermal = rab_n(ji,jj,1,jp_tem) !ideally use ibld not 1?? 1711 2049 zbeta = rab_n(ji,jj,1,jp_sal) 1712 2050 ! average over depth of boundary layer 1713 2051 zthick = epsln 1714 2052 DO jk = 2, jnlev_av(ji,jj) … … 1717 2055 zs(ji,jj) = zs(ji,jj) + e3t_n(ji,jj,jk) * tsn(ji,jj,jk,jp_sal) 1718 2056 zu(ji,jj) = zu(ji,jj) + e3t_n(ji,jj,jk) & 1719 1720 2057 & * ( ub(ji,jj,jk) + ub(ji - 1,jj,jk) ) & 2058 & / MAX( 1. , umask(ji,jj,jk) + umask(ji - 1,jj,jk) ) 1721 2059 zv(ji,jj) = zv(ji,jj) + e3t_n(ji,jj,jk) & 1722 1723 2060 & * ( vb(ji,jj,jk) + vb(ji,jj - 1,jk) ) & 2061 & / MAX( 1. , vmask(ji,jj,jk) + vmask(ji,jj - 1,jk) ) 1724 2062 END DO 1725 2063 zt(ji,jj) = zt(ji,jj) / zthick … … 1730 2068 ibld_ext = jnlev_av(ji,jj) + jp_ext(ji,jj) 1731 2069 IF ( ibld_ext < mbkt(ji,jj) ) THEN 1732 zdt(ji,jj) = zt(ji,jj) - tsn(ji,jj,ibld_ext,jp_tem)1733 zds(ji,jj) = zs(ji,jj) - tsn(ji,jj,ibld_ext,jp_sal)1734 zdu(ji,jj) = zu(ji,jj) - ( ub(ji,jj,ibld_ext) + ub(ji-1,jj,ibld_ext ) ) &1735 1736 zdv(ji,jj) = zv(ji,jj) - ( vb(ji,jj,ibld_ext) + vb(ji,jj-1,ibld_ext ) ) &1737 1738 zdb(ji,jj) = grav * zthermal * zdt(ji,jj) - grav * zbeta * zds(ji,jj)2070 zdt(ji,jj) = zt(ji,jj) - tsn(ji,jj,ibld_ext,jp_tem) 2071 zds(ji,jj) = zs(ji,jj) - tsn(ji,jj,ibld_ext,jp_sal) 2072 zdu(ji,jj) = zu(ji,jj) - ( ub(ji,jj,ibld_ext) + ub(ji-1,jj,ibld_ext ) ) & 2073 & / MAX(1. , umask(ji,jj,ibld_ext ) + umask(ji-1,jj,ibld_ext ) ) 2074 zdv(ji,jj) = zv(ji,jj) - ( vb(ji,jj,ibld_ext) + vb(ji,jj-1,ibld_ext ) ) & 2075 & / MAX(1. , vmask(ji,jj,ibld_ext ) + vmask(ji,jj-1,ibld_ext ) ) 2076 zdb(ji,jj) = grav * zthermal * zdt(ji,jj) - grav * zbeta * zds(ji,jj) 1739 2077 ELSE 1740 zdt(ji,jj) = 0._wp1741 zds(ji,jj) = 0._wp1742 zdu(ji,jj) = 0._wp1743 zdv(ji,jj) = 0._wp1744 zdb(ji,jj) = 0._wp2078 zdt(ji,jj) = 0._wp 2079 zds(ji,jj) = 0._wp 2080 zdu(ji,jj) = 0._wp 2081 zdv(ji,jj) = 0._wp 2082 zdb(ji,jj) = 0._wp 1745 2083 ENDIF 1746 2084 END DO 1747 1748 END SUBROUTINE zdf_osm_vertical_average1749 1750 SUBROUTINE zdf_osm_velocity_rotation( zcos_w, zsin_w, zu, zv, zdu, zdv )1751 !!---------------------------------------------------------------------1752 !! *** ROUTINE zdf_velocity_rotation ***1753 !!1754 !! ** Purpose : Rotates frame of reference of averaged velocity components.1755 !!1756 !! ** Method : The velocity components are rotated into frame specified by zcos_w and zsin_w1757 !!1758 !!----------------------------------------------------------------------1759 1760 1761 1762 1763 1764 1765 1766 1767 1768 1769 1770 1771 1772 1773 1774 1775 1776 2085 END DO 2086 END SUBROUTINE zdf_osm_vertical_average 2087 2088 SUBROUTINE zdf_osm_velocity_rotation( zcos_w, zsin_w, zu, zv, zdu, zdv ) 2089 !!--------------------------------------------------------------------- 2090 !! *** ROUTINE zdf_velocity_rotation *** 2091 !! 2092 !! ** Purpose : Rotates frame of reference of averaged velocity components. 2093 !! 2094 !! ** Method : The velocity components are rotated into frame specified by zcos_w and zsin_w 2095 !! 2096 !!---------------------------------------------------------------------- 2097 2098 REAL(wp), DIMENSION(jpi,jpj) :: zcos_w, zsin_w ! Cos and Sin of rotation angle 2099 REAL(wp), DIMENSION(jpi,jpj) :: zu, zv ! Components of current 2100 REAL(wp), DIMENSION(jpi,jpj) :: zdu, zdv ! Change in velocity components across pycnocline 2101 2102 INTEGER :: ji, jj 2103 REAL(wp) :: ztemp 2104 2105 DO jj = 2, jpjm1 2106 DO ji = 2, jpim1 2107 ztemp = zu(ji,jj) 2108 zu(ji,jj) = zu(ji,jj) * zcos_w(ji,jj) + zv(ji,jj) * zsin_w(ji,jj) 2109 zv(ji,jj) = zv(ji,jj) * zcos_w(ji,jj) - ztemp * zsin_w(ji,jj) 2110 ztemp = zdu(ji,jj) 2111 zdu(ji,jj) = zdu(ji,jj) * zcos_w(ji,jj) + zdv(ji,jj) * zsin_w(ji,jj) 2112 zdv(ji,jj) = zdv(ji,jj) * zcos_w(ji,jj) - ztemp * zsin_w(ji,jj) 2113 END DO 2114 END DO 1777 2115 END SUBROUTINE zdf_osm_velocity_rotation 1778 2116 1779 2117 SUBROUTINE zdf_osm_osbl_state_fk( lpyc, lflux, lmle, zwb_fk ) 1780 !!---------------------------------------------------------------------1781 !! *** ROUTINE zdf_osm_osbl_state_fk ***1782 !!1783 !! ** Purpose : Determines the state of the OSBL and MLE layer. Info is returned in the logicals lpyc,lflux and lmle. Used with Fox-Kemper scheme.1784 !! lpyc :: determines whether pycnocline flux-grad relationship needs to be determined1785 !! lflux :: determines whether effects of surface flux extend below the base of the OSBL1786 !! lmle :: determines whether the layer with MLE is increasing with time or if base is relaxing towards hbl.1787 !!1788 !! ** Method :1789 !!1790 !!1791 !!----------------------------------------------------------------------1792 1793 ! Outputs2118 !!--------------------------------------------------------------------- 2119 !! *** ROUTINE zdf_osm_osbl_state_fk *** 2120 !! 2121 !! ** Purpose : Determines the state of the OSBL and MLE layer. Info is returned in the logicals lpyc,lflux and lmle. Used with Fox-Kemper scheme. 2122 !! lpyc :: determines whether pycnocline flux-grad relationship needs to be determined 2123 !! lflux :: determines whether effects of surface flux extend below the base of the OSBL 2124 !! lmle :: determines whether the layer with MLE is increasing with time or if base is relaxing towards hbl. 2125 !! 2126 !! ** Method : 2127 !! 2128 !! 2129 !!---------------------------------------------------------------------- 2130 2131 ! Outputs 1794 2132 LOGICAL, DIMENSION(jpi,jpj) :: lpyc, lflux, lmle 1795 2133 REAL(wp), DIMENSION(jpi,jpj) :: zwb_fk 1796 !2134 ! 1797 2135 REAL(wp), DIMENSION(jpi,jpj) :: znd_param 1798 2136 REAL(wp) :: zbuoy, ztmp, zpe_mle_layer 1799 2137 REAL(wp) :: zpe_mle_ref, zdbdz_mle_int 1800 2138 1801 2139 znd_param(:,:) = 0._wp 1802 2140 1803 1804 1805 1806 1807 1808 END DO1809 1810 1811 2141 DO jj = 2, jpjm1 2142 DO ji = 2, jpim1 2143 ztmp = r1_ft(ji,jj) * MIN( 111.e3_wp , e1u(ji,jj) ) / rn_osm_mle_lf 2144 zwb_fk(ji,jj) = rn_osm_mle_ce * hmle(ji,jj) * hmle(ji,jj) * ztmp * zdbds_mle(ji,jj) * zdbds_mle(ji,jj) 2145 END DO 2146 END DO 2147 DO jj = 2, jpjm1 2148 DO ji = 2, jpim1 2149 ! 1812 2150 IF ( lconv(ji,jj) ) THEN 1813 IF ( zhmle(ji,jj) > 1.2 * zhbl(ji,jj) ) THEN1814 zt_mle(ji,jj) = ( zt_mle(ji,jj) * zhmle(ji,jj) - zt_bl(ji,jj) * zhbl(ji,jj) ) / ( zhmle(ji,jj) - zhbl(ji,jj) )1815 zs_mle(ji,jj) = ( zs_mle(ji,jj) * zhmle(ji,jj) - zs_bl(ji,jj) * zhbl(ji,jj) ) / ( zhmle(ji,jj) - zhbl(ji,jj) )1816 zb_mle(ji,jj) = ( zb_mle(ji,jj) * zhmle(ji,jj) - zb_bl(ji,jj) * zhbl(ji,jj) ) / ( zhmle(ji,jj) - zhbl(ji,jj) )1817 zdbdz_mle_int = ( zb_bl(ji,jj) - ( 2.0 * zb_mle(ji,jj) -zb_bl(ji,jj) ) ) / ( zhmle(ji,jj) - zhbl(ji,jj) )1818 ! Calculate potential energies of actual profile and reference profile.1819 zpe_mle_layer = 0._wp1820 zpe_mle_ref = 0._wp1821 zthermal = rab_n(ji,jj,1,jp_tem)1822 zbeta = rab_n(ji,jj,1,jp_sal)1823 1824 DO jk = ibld(ji,jj), mld_prof(ji,jj)1825 zbuoy = grav * ( zthermal * tsn(ji,jj,jk,jp_tem) - zbeta * tsn(ji,jj,jk,jp_sal) )1826 zpe_mle_layer = zpe_mle_layer + zbuoy * gdepw_n(ji,jj,jk) * e3w_n(ji,jj,jk)1827 zpe_mle_ref = zpe_mle_ref + ( zb_bl(ji,jj) - zdbdz_mle_int * ( gdepw_n(ji,jj,jk) - zhbl(ji,jj) ) ) * gdepw_n(ji,jj,jk) * e3w_n(ji,jj,jk)1828 END DO1829 ! Non-dimensional parameter to diagnose the presence of thermocline1830 1831 znd_param(ji,jj) = ( zpe_mle_layer - zpe_mle_ref ) * ABS( ff_t(ji,jj) ) / ( MAX( zwb_fk(ji,jj), 1.0e-10 ) * zhmle(ji,jj) )1832 ENDIF2151 IF ( zhmle(ji,jj) > 1.2 * zhbl(ji,jj) ) THEN 2152 zt_mle(ji,jj) = ( zt_mle(ji,jj) * zhmle(ji,jj) - zt_bl(ji,jj) * zhbl(ji,jj) ) / ( zhmle(ji,jj) - zhbl(ji,jj) ) 2153 zs_mle(ji,jj) = ( zs_mle(ji,jj) * zhmle(ji,jj) - zs_bl(ji,jj) * zhbl(ji,jj) ) / ( zhmle(ji,jj) - zhbl(ji,jj) ) 2154 zb_mle(ji,jj) = ( zb_mle(ji,jj) * zhmle(ji,jj) - zb_bl(ji,jj) * zhbl(ji,jj) ) / ( zhmle(ji,jj) - zhbl(ji,jj) ) 2155 zdbdz_mle_int = ( zb_bl(ji,jj) - ( 2.0 * zb_mle(ji,jj) -zb_bl(ji,jj) ) ) / ( zhmle(ji,jj) - zhbl(ji,jj) ) 2156 ! Calculate potential energies of actual profile and reference profile. 2157 zpe_mle_layer = 0._wp 2158 zpe_mle_ref = 0._wp 2159 zthermal = rab_n(ji,jj,1,jp_tem) 2160 zbeta = rab_n(ji,jj,1,jp_sal) 2161 2162 DO jk = ibld(ji,jj), mld_prof(ji,jj) 2163 zbuoy = grav * ( zthermal * tsn(ji,jj,jk,jp_tem) - zbeta * tsn(ji,jj,jk,jp_sal) ) 2164 zpe_mle_layer = zpe_mle_layer + zbuoy * gdepw_n(ji,jj,jk) * e3w_n(ji,jj,jk) 2165 zpe_mle_ref = zpe_mle_ref + ( zb_bl(ji,jj) - zdbdz_mle_int * ( gdepw_n(ji,jj,jk) - zhbl(ji,jj) ) ) * gdepw_n(ji,jj,jk) * e3w_n(ji,jj,jk) 2166 END DO 2167 ! Non-dimensional parameter to diagnose the presence of thermocline 2168 2169 znd_param(ji,jj) = ( zpe_mle_layer - zpe_mle_ref ) * ABS( ff_t(ji,jj) ) / ( MAX( zwb_fk(ji,jj), 1.0e-10 ) * zhmle(ji,jj) ) 2170 ENDIF 1833 2171 ENDIF 1834 END DO 1835 END DO 1836 1837 ! Diagnosis 1838 DO jj = 2, jpjm1 1839 DO ji = 2, jpim1 1840 IF ( lconv(ji,jj) ) THEN 2172 #ifdef key_osm_debug 2173 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 2174 WRITE(narea+100,'(4(a,g11.3))')'start of zdf_osm_osbl_state_fk: zwb_fk=',zwb_fk(ji,jj), & 2175 & ' znd_param=',znd_param(ji,jj), ' zpe_mle_ref=', zpe_mle_ref, ' zpe_mle_layer=', zpe_mle_layer 2176 FLUSH(narea+100) 2177 END IF 2178 #endif 2179 END DO 2180 END DO 2181 2182 ! Diagnosis 2183 DO jj = 2, jpjm1 2184 DO ji = 2, jpim1 2185 IF ( lconv(ji,jj) ) THEN 1841 2186 IF ( -2.0 * zwb_fk(ji,jj) / zwb_ent(ji,jj) > 0.5 ) THEN 1842 IF ( zhmle(ji,jj) > 1.2 * zhbl(ji,jj) ) THEN1843 ! MLE layer growing1844 IF ( znd_param (ji,jj) > 100. ) THEN1845 ! Thermocline present1846 lflux(ji,jj) = .FALSE.1847 lmle(ji,jj) =.FALSE.1848 ELSE1849 ! Thermocline not present1850 lflux(ji,jj) = .TRUE.1851 lmle(ji,jj) = .TRUE.1852 ENDIF ! znd_param > 1001853 !1854 IF ( zdb_bl(ji,jj) < rn_osm_bl_thresh ) THEN1855 lpyc(ji,jj) = .FALSE.1856 ELSE1857 lpyc(ji,jj) = .TRUE.1858 ENDIF1859 ELSE1860 ! MLE layer restricted to OSBL or just below.1861 IF ( zdb_bl(ji,jj) < rn_osm_bl_thresh ) THEN1862 ! Weak stratification MLE layer can grow.1863 lpyc(ji,jj) = .FALSE.1864 lflux(ji,jj) = .TRUE.1865 lmle(ji,jj) = .TRUE.1866 ELSE1867 ! Strong stratification1868 lpyc(ji,jj) = .TRUE.1869 lflux(ji,jj) = .FALSE.1870 lmle(ji,jj) = .FALSE.1871 ENDIF ! zdb_bl < rn_mle_thresh_bl and1872 ENDIF ! zhmle > 1.2 zhbl2187 IF ( zhmle(ji,jj) > 1.2 * zhbl(ji,jj) ) THEN 2188 ! MLE layer growing 2189 IF ( znd_param (ji,jj) > 100. ) THEN 2190 ! Thermocline present 2191 lflux(ji,jj) = .FALSE. 2192 lmle(ji,jj) =.FALSE. 2193 ELSE 2194 ! Thermocline not present 2195 lflux(ji,jj) = .TRUE. 2196 lmle(ji,jj) = .TRUE. 2197 ENDIF ! znd_param > 100 2198 ! 2199 IF ( zdb_bl(ji,jj) < rn_osm_bl_thresh ) THEN 2200 lpyc(ji,jj) = .FALSE. 2201 ELSE 2202 lpyc(ji,jj) = .TRUE. 2203 ENDIF 2204 ELSE 2205 ! MLE layer restricted to OSBL or just below. 2206 IF ( zdb_bl(ji,jj) < rn_osm_bl_thresh ) THEN 2207 ! Weak stratification MLE layer can grow. 2208 lpyc(ji,jj) = .FALSE. 2209 lflux(ji,jj) = .TRUE. 2210 lmle(ji,jj) = .TRUE. 2211 ELSE 2212 ! Strong stratification 2213 lpyc(ji,jj) = .TRUE. 2214 lflux(ji,jj) = .FALSE. 2215 lmle(ji,jj) = .FALSE. 2216 ENDIF ! zdb_bl < rn_mle_thresh_bl and 2217 ENDIF ! zhmle > 1.2 zhbl 1873 2218 ELSE 1874 lpyc(ji,jj) = .TRUE.1875 lflux(ji,jj) = .FALSE.1876 lmle(ji,jj) = .FALSE.1877 IF ( zdb_bl(ji,jj) < rn_osm_bl_thresh ) lpyc(ji,jj) = .FALSE.2219 lpyc(ji,jj) = .TRUE. 2220 lflux(ji,jj) = .FALSE. 2221 lmle(ji,jj) = .FALSE. 2222 IF ( zdb_bl(ji,jj) < rn_osm_bl_thresh ) lpyc(ji,jj) = .FALSE. 1878 2223 ENDIF ! -2.0 * zwb_fk(ji,jj) / zwb_ent > 0.5 1879 1880 ! Stable Boundary Layer2224 ELSE 2225 ! Stable Boundary Layer 1881 2226 lpyc(ji,jj) = .FALSE. 1882 2227 lflux(ji,jj) = .FALSE. 1883 2228 lmle(ji,jj) = .FALSE. 1884 ENDIF ! lconv 1885 END DO 1886 END DO 2229 ENDIF ! lconv 2230 #ifdef key_osm_debug 2231 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 2232 WRITE(narea+100,'(3(a,g11.3),/,4(a,l2))')'end of zdf_osm_osbl_state_fk:zwb_ent=',zwb_ent(ji,jj), & 2233 & ' zhmle=',zhmle(ji,jj), ' zhbl=', zhbl(ji,jj), & 2234 & ' lpyc= ', lpyc(ji,jj), ' lflux= ', lflux(ji,jj), ' lmle= ', lmle(ji,jj), ' lconv= ', lconv(ji,jj) 2235 FLUSH(narea+100) 2236 END IF 2237 #endif 2238 END DO 2239 END DO 1887 2240 END SUBROUTINE zdf_osm_osbl_state_fk 1888 2241 1889 2242 SUBROUTINE zdf_osm_external_gradients(jbase, zdtdz, zdsdz, zdbdz ) 1890 !!---------------------------------------------------------------------1891 !! *** ROUTINE zdf_osm_external_gradients ***1892 !!1893 !! ** Purpose : Calculates the gradients below the OSBL1894 !!1895 !! ** Method : Uses ibld and ibld_ext to determine levels to calculate the gradient.1896 !!1897 !!----------------------------------------------------------------------1898 1899 INTEGER, DIMENSION(jpi,jpj) :: jbase1900 REAL(wp), DIMENSION(jpi,jpj) :: zdtdz, zdsdz, zdbdz ! External gradients of temperature, salinity and buoyancy.1901 1902 INTEGER :: jj, ji, jkb, jkb11903 REAL(wp) :: zthermal, zbeta1904 1905 1906 DO jj = 2, jpjm11907 DO ji = 2, jpim11908 IF ( jbase(ji,jj)+1 < mbkt(ji,jj) ) THEN1909 zthermal = rab_n(ji,jj,1,jp_tem) !ideally use ibld not 1??1910 zbeta = rab_n(ji,jj,1,jp_sal)1911 jkb = jbase(ji,jj)1912 jkb1 = MIN(jkb + 1, mbkt(ji,jj))1913 zdtdz(ji,jj) = - ( tsn(ji,jj,jkb1,jp_tem) - tsn(ji,jj,jkb,jp_tem ) ) &1914 & / e3t_n(ji,jj,jkb)1915 zdsdz(ji,jj) = - ( tsn(ji,jj,jkb1,jp_sal) - tsn(ji,jj,jkb,jp_sal ) ) &1916 & / e3t_n(ji,jj,jkb)1917 zdbdz(ji,jj) = grav * zthermal * zdtdz(ji,jj) - grav * zbeta * zdsdz(ji,jj)1918 ELSE1919 zdtdz(ji,jj) = 0._wp1920 zdsdz(ji,jj) = 0._wp1921 zdbdz(ji,jj) = 0._wp1922 END IF1923 END DO1924 END DO2243 !!--------------------------------------------------------------------- 2244 !! *** ROUTINE zdf_osm_external_gradients *** 2245 !! 2246 !! ** Purpose : Calculates the gradients below the OSBL 2247 !! 2248 !! ** Method : Uses ibld and ibld_ext to determine levels to calculate the gradient. 2249 !! 2250 !!---------------------------------------------------------------------- 2251 2252 INTEGER, DIMENSION(jpi,jpj) :: jbase 2253 REAL(wp), DIMENSION(jpi,jpj) :: zdtdz, zdsdz, zdbdz ! External gradients of temperature, salinity and buoyancy. 2254 2255 INTEGER :: jj, ji, jkb, jkb1 2256 REAL(wp) :: zthermal, zbeta 2257 2258 2259 DO jj = 2, jpjm1 2260 DO ji = 2, jpim1 2261 IF ( jbase(ji,jj)+1 < mbkt(ji,jj) ) THEN 2262 zthermal = rab_n(ji,jj,1,jp_tem) !ideally use ibld not 1?? 2263 zbeta = rab_n(ji,jj,1,jp_sal) 2264 jkb = jbase(ji,jj) 2265 jkb1 = MIN(jkb + 1, mbkt(ji,jj)) 2266 zdtdz(ji,jj) = - ( tsn(ji,jj,jkb1,jp_tem) - tsn(ji,jj,jkb,jp_tem ) ) & 2267 & / e3w_n(ji,jj,jkb1) 2268 zdsdz(ji,jj) = - ( tsn(ji,jj,jkb1,jp_sal) - tsn(ji,jj,jkb,jp_sal ) ) & 2269 & / e3w_n(ji,jj,jkb1) 2270 zdbdz(ji,jj) = grav * zthermal * zdtdz(ji,jj) - grav * zbeta * zdsdz(ji,jj) 2271 ELSE 2272 zdtdz(ji,jj) = 0._wp 2273 zdsdz(ji,jj) = 0._wp 2274 zdbdz(ji,jj) = 0._wp 2275 END IF 2276 END DO 2277 END DO 1925 2278 END SUBROUTINE zdf_osm_external_gradients 1926 2279 1927 2280 SUBROUTINE zdf_osm_pycnocline_scalar_profiles( zdtdz, zdsdz, zdbdz, zalpha ) 1928 2281 1929 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdtdz, zdsdz, zdbdz ! gradients in the pycnocline1930 REAL(wp), DIMENSION(jpi,jpj) :: zalpha1931 1932 INTEGER :: jk, jj, ji1933 REAL(wp) :: ztgrad, zsgrad, zbgrad1934 REAL(wp) :: zgamma_b_nd, znd1935 REAL(wp) :: zzeta_m, zzeta_en, zbuoy_pyc_sc1936 REAL(wp), PARAMETER :: zgamma_b = 2.25, zzeta_sh = 0.151937 1938 DO jj = 2, jpjm11939 DO ji = 2, jpim11940 IF ( ibld(ji,jj) + jp_ext(ji,jj) < mbkt(ji,jj) ) THEN1941 IF ( lconv(ji,jj) ) THEN ! convective conditions1942 IF ( lpyc(ji,jj) ) THEN1943 zzeta_m = 0.1 + 0.3 / ( 1.0 + EXP( -3.5 * LOG10( -zhol(ji,jj) ) ) )1944 zalpha(ji,jj) = 2.0 * ( 1.0 - ( 0.80 * zzeta_m + 0.5 * SQRT( 3.14159 / zgamma_b ) ) * zdbdz_bl_ext(ji,jj) * zdh(ji,jj) / zdb_ml(ji,jj) ) / ( 0.723 + SQRT( 3.14159 / zgamma_b ) )1945 zalpha(ji,jj) = MAX( zalpha(ji,jj), 0._wp )1946 1947 ztmp = 1._wp/MAX(zdh(ji,jj), epsln)2282 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zdtdz, zdsdz, zdbdz ! gradients in the pycnocline 2283 REAL(wp), DIMENSION(jpi,jpj) :: zalpha 2284 2285 INTEGER :: jk, jj, ji 2286 REAL(wp) :: ztgrad, zsgrad, zbgrad 2287 REAL(wp) :: zgamma_b_nd, znd 2288 REAL(wp) :: zzeta_m, zzeta_en, zbuoy_pyc_sc 2289 REAL(wp), PARAMETER :: zgamma_b = 2.25, zzeta_sh = 0.15 2290 2291 DO jj = 2, jpjm1 2292 DO ji = 2, jpim1 2293 IF ( ibld(ji,jj) + jp_ext(ji,jj) < mbkt(ji,jj) ) THEN 2294 IF ( lconv(ji,jj) ) THEN ! convective conditions 2295 IF ( lpyc(ji,jj) ) THEN 2296 zzeta_m = 0.1 + 0.3 / ( 1.0 + EXP( -3.5 * LOG10( -zhol(ji,jj) ) ) ) 2297 zalpha(ji,jj) = 2.0 * ( 1.0 - ( 0.80 * zzeta_m + 0.5 * SQRT( 3.14159 / zgamma_b ) ) * zdbdz_bl_ext(ji,jj) * zdh(ji,jj) / zdb_ml(ji,jj) ) / ( 0.723 + SQRT( 3.14159 / zgamma_b ) ) 2298 zalpha(ji,jj) = MAX( zalpha(ji,jj), 0._wp ) 2299 2300 ztmp = 1._wp/MAX(zdh(ji,jj), epsln) 1948 2301 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1949 ! Commented lines in this section are not needed in new code, once tested !1950 ! can be removed !2302 ! Commented lines in this section are not needed in new code, once tested ! 2303 ! can be removed ! 1951 2304 !!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!! 1952 ! ztgrad = zalpha * zdt_ml(ji,jj) * ztmp + zdtdz_bl_ext(ji,jj) 1953 ! zsgrad = zalpha * zds_ml(ji,jj) * ztmp + zdsdz_bl_ext(ji,jj) 1954 zbgrad = zalpha(ji,jj) * zdb_ml(ji,jj) * ztmp + zdbdz_bl_ext(ji,jj) 1955 zgamma_b_nd = zdbdz_bl_ext(ji,jj) * zdh(ji,jj) / MAX(zdb_ml(ji,jj), epsln) 1956 DO jk = 2, ibld(ji,jj) 1957 znd = -( gdepw_n(ji,jj,jk) - zhbl(ji,jj) ) * ztmp 1958 IF ( znd <= zzeta_m ) THEN 1959 ! zdtdz(ji,jj,jk) = zdtdz_bl_ext(ji,jj) + zalpha * zdt_ml(ji,jj) * ztmp * & 1960 ! & EXP( -6.0 * ( znd -zzeta_m )**2 ) 1961 ! zdsdz(ji,jj,jk) = zdsdz_bl_ext(ji,jj) + zalpha * zds_ml(ji,jj) * ztmp * & 1962 ! & EXP( -6.0 * ( znd -zzeta_m )**2 ) 1963 zdbdz(ji,jj,jk) = zdbdz_bl_ext(ji,jj) + zalpha(ji,jj) * zdb_ml(ji,jj) * ztmp * & 1964 & EXP( -6.0 * ( znd -zzeta_m )**2 ) 1965 ELSE 1966 ! zdtdz(ji,jj,jk) = ztgrad * EXP( -zgamma_b * ( znd - zzeta_m )**2 ) 1967 ! zdsdz(ji,jj,jk) = zsgrad * EXP( -zgamma_b * ( znd - zzeta_m )**2 ) 1968 zdbdz(ji,jj,jk) = zbgrad * EXP( -zgamma_b * ( znd - zzeta_m )**2 ) 1969 ENDIF 1970 END DO 1971 ENDIF ! if no pycnocline pycnocline gradients set to zero 1972 ELSE 1973 ! stable conditions 1974 ! if pycnocline profile only defined when depth steady of increasing. 1975 IF ( zdhdt(ji,jj) > 0.0 ) THEN ! Depth increasing, or steady. 1976 IF ( zdb_bl(ji,jj) > 0._wp ) THEN 1977 IF ( zhol(ji,jj) >= 0.5 ) THEN ! Very stable - 'thick' pycnocline 1978 ztmp = 1._wp/MAX(zhbl(ji,jj), epsln) 1979 ztgrad = zdt_bl(ji,jj) * ztmp 1980 zsgrad = zds_bl(ji,jj) * ztmp 1981 zbgrad = zdb_bl(ji,jj) * ztmp 1982 DO jk = 2, ibld(ji,jj) 1983 znd = gdepw_n(ji,jj,jk) * ztmp 1984 zdtdz(ji,jj,jk) = ztgrad * EXP( -15.0 * ( znd - 0.9 )**2 ) 1985 zdbdz(ji,jj,jk) = zbgrad * EXP( -15.0 * ( znd - 0.9 )**2 ) 1986 zdsdz(ji,jj,jk) = zsgrad * EXP( -15.0 * ( znd - 0.9 )**2 ) 1987 END DO 1988 ELSE ! Slightly stable - 'thin' pycnoline - needed when stable layer begins to form. 1989 ztmp = 1._wp/MAX(zdh(ji,jj), epsln) 1990 ztgrad = zdt_bl(ji,jj) * ztmp 1991 zsgrad = zds_bl(ji,jj) * ztmp 1992 zbgrad = zdb_bl(ji,jj) * ztmp 1993 DO jk = 2, ibld(ji,jj) 1994 znd = -( gdepw_n(ji,jj,jk) - zhml(ji,jj) ) * ztmp 1995 zdtdz(ji,jj,jk) = ztgrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 1996 zdbdz(ji,jj,jk) = zbgrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 1997 zdsdz(ji,jj,jk) = zsgrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 1998 END DO 1999 ENDIF ! IF (zhol >=0.5) 2000 ENDIF ! IF (zdb_bl> 0.) 2001 ENDIF ! IF (zdhdt >= 0) zdhdt < 0 not considered since pycnocline profile is zero and profile arrays are intialized to zero 2002 ENDIF ! IF (lconv) 2003 ENDIF ! IF ( ibld(ji,jj) < mbkt(ji,jj) ) 2004 END DO 2005 END DO 2305 ! ztgrad = zalpha * zdt_ml(ji,jj) * ztmp + zdtdz_bl_ext(ji,jj) 2306 ! zsgrad = zalpha * zds_ml(ji,jj) * ztmp + zdsdz_bl_ext(ji,jj) 2307 zbgrad = zalpha(ji,jj) * zdb_ml(ji,jj) * ztmp + zdbdz_bl_ext(ji,jj) 2308 zgamma_b_nd = zdbdz_bl_ext(ji,jj) * zdh(ji,jj) / MAX(zdb_ml(ji,jj), epsln) 2309 DO jk = 2, ibld(ji,jj) 2310 znd = -( gdepw_n(ji,jj,jk) - zhbl(ji,jj) ) * ztmp 2311 IF ( znd <= zzeta_m ) THEN 2312 ! zdtdz(ji,jj,jk) = zdtdz_bl_ext(ji,jj) + zalpha * zdt_ml(ji,jj) * ztmp * & 2313 ! & EXP( -6.0 * ( znd -zzeta_m )**2 ) 2314 ! zdsdz(ji,jj,jk) = zdsdz_bl_ext(ji,jj) + zalpha * zds_ml(ji,jj) * ztmp * & 2315 ! & EXP( -6.0 * ( znd -zzeta_m )**2 ) 2316 zdbdz(ji,jj,jk) = zdbdz_bl_ext(ji,jj) + zalpha(ji,jj) * zdb_ml(ji,jj) * ztmp * & 2317 & EXP( -6.0 * ( znd -zzeta_m )**2 ) 2318 ELSE 2319 ! zdtdz(ji,jj,jk) = ztgrad * EXP( -zgamma_b * ( znd - zzeta_m )**2 ) 2320 ! zdsdz(ji,jj,jk) = zsgrad * EXP( -zgamma_b * ( znd - zzeta_m )**2 ) 2321 zdbdz(ji,jj,jk) = zbgrad * EXP( -zgamma_b * ( znd - zzeta_m )**2 ) 2322 ENDIF 2323 END DO 2324 #ifdef key_osm_debug 2325 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 2326 WRITE(narea+100,'(a,/,3(a,g11.3),/,2(a,g11.3),/)')'end of zdf_osm_pycnocline_scalar_profiles:lconv=lpyc=T',& 2327 & 'zzeta_m=', zzeta_m, ' zalpha=', zalpha(ji,jj), ' ztmp=', ztmp,& 2328 & ' zbgrad=', zbgrad, ' zgamma_b_nd=', zgamma_b_nd 2329 FLUSH(narea+100) 2330 END IF 2331 #endif 2332 ENDIF ! if no pycnocline pycnocline gradients set to zero 2333 ELSE 2334 ! stable conditions 2335 ! if pycnocline profile only defined when depth steady of increasing. 2336 IF ( zdhdt(ji,jj) > 0.0 ) THEN ! Depth increasing, or steady. 2337 IF ( zdb_bl(ji,jj) > 0._wp ) THEN 2338 IF ( zhol(ji,jj) >= 0.5 ) THEN ! Very stable - 'thick' pycnocline 2339 ztmp = 1._wp/MAX(zhbl(ji,jj), epsln) 2340 ztgrad = zdt_bl(ji,jj) * ztmp 2341 zsgrad = zds_bl(ji,jj) * ztmp 2342 zbgrad = zdb_bl(ji,jj) * ztmp 2343 DO jk = 2, ibld(ji,jj) 2344 znd = gdepw_n(ji,jj,jk) * ztmp 2345 zdtdz(ji,jj,jk) = ztgrad * EXP( -15.0 * ( znd - 0.9 )**2 ) 2346 zdbdz(ji,jj,jk) = zbgrad * EXP( -15.0 * ( znd - 0.9 )**2 ) 2347 zdsdz(ji,jj,jk) = zsgrad * EXP( -15.0 * ( znd - 0.9 )**2 ) 2348 END DO 2349 ELSE ! Slightly stable - 'thin' pycnoline - needed when stable layer begins to form. 2350 ztmp = 1._wp/MAX(zdh(ji,jj), epsln) 2351 ztgrad = zdt_bl(ji,jj) * ztmp 2352 zsgrad = zds_bl(ji,jj) * ztmp 2353 zbgrad = zdb_bl(ji,jj) * ztmp 2354 DO jk = 2, ibld(ji,jj) 2355 znd = -( gdepw_n(ji,jj,jk) - zhml(ji,jj) ) * ztmp 2356 zdtdz(ji,jj,jk) = ztgrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 2357 zdbdz(ji,jj,jk) = zbgrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 2358 zdsdz(ji,jj,jk) = zsgrad * EXP( -1.75 * ( znd + 0.75 )**2 ) 2359 END DO 2360 ENDIF ! IF (zhol >=0.5) 2361 #ifdef key_osm_debug 2362 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 2363 WRITE(narea+100,'(3(a,g11.3))')'end of zdf_osm_pycnocline_scalar_profiles:lconv=F ztgrad=',& 2364 & ztgrad, ' zsgrad=', zsgrad, ' zbgrad=', zbgrad 2365 FLUSH(narea+100) 2366 END IF 2367 #endif 2368 ENDIF ! IF (zdb_bl> 0.) 2369 ENDIF ! IF (zdhdt >= 0) zdhdt < 0 not considered since pycnocline profile is zero and profile arrays are intialized to zero 2370 ENDIF ! IF (lconv) 2371 ENDIF ! IF ( ibld(ji,jj) < mbkt(ji,jj) ) 2372 END DO 2373 END DO 2006 2374 2007 2375 END SUBROUTINE zdf_osm_pycnocline_scalar_profiles … … 2029 2397 IF ( lconv (ji,jj) ) THEN 2030 2398 ! Unstable conditions. Shouldn;t be needed with no pycnocline code. 2031 ! zugrad = 0.7 * zdu_ml(ji,jj) / zdh(ji,jj) + 0.3 * zustar(ji,jj)*zustar(ji,jj) / &2032 ! & ( ( ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * zhml(ji,jj) ) * &2033 ! & MIN(zla(ji,jj)**(8.0/3.0) + epsln, 0.12 ))2399 ! zugrad = 0.7 * zdu_ml(ji,jj) / zdh(ji,jj) + 0.3 * zustar(ji,jj)*zustar(ji,jj) / & 2400 ! & ( ( ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * zhml(ji,jj) ) * & 2401 ! & MIN(zla(ji,jj)**(8.0/3.0) + epsln, 0.12 )) 2034 2402 !Alan is this right? 2035 ! zvgrad = ( 0.7 * zdv_ml(ji,jj) + &2036 ! & 2.0 * ff_t(ji,jj) * zustke(ji,jj) * dstokes(ji,jj) / &2037 ! & ( ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird + epsln ) &2038 ! & )/ (zdh(ji,jj) + epsln )2039 ! DO jk = 2, ibld(ji,jj) - 1 + ibld_ext2040 ! znd = -( gdepw_n(ji,jj,jk) - zhbl(ji,jj) ) / (zdh(ji,jj) + epsln ) - zzeta_v2041 ! IF ( znd <= 0.0 ) THEN2042 ! zdudz(ji,jj,jk) = 1.25 * zugrad * EXP( 3.0 * znd )2043 ! zdvdz(ji,jj,jk) = 1.25 * zvgrad * EXP( 3.0 * znd )2044 ! ELSE2045 ! zdudz(ji,jj,jk) = 1.25 * zugrad * EXP( -2.0 * znd )2046 ! zdvdz(ji,jj,jk) = 1.25 * zvgrad * EXP( -2.0 * znd )2047 ! ENDIF2048 ! END DO2403 ! zvgrad = ( 0.7 * zdv_ml(ji,jj) + & 2404 ! & 2.0 * ff_t(ji,jj) * zustke(ji,jj) * dstokes(ji,jj) / & 2405 ! & ( ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird + epsln ) & 2406 ! & )/ (zdh(ji,jj) + epsln ) 2407 ! DO jk = 2, ibld(ji,jj) - 1 + ibld_ext 2408 ! znd = -( gdepw_n(ji,jj,jk) - zhbl(ji,jj) ) / (zdh(ji,jj) + epsln ) - zzeta_v 2409 ! IF ( znd <= 0.0 ) THEN 2410 ! zdudz(ji,jj,jk) = 1.25 * zugrad * EXP( 3.0 * znd ) 2411 ! zdvdz(ji,jj,jk) = 1.25 * zvgrad * EXP( 3.0 * znd ) 2412 ! ELSE 2413 ! zdudz(ji,jj,jk) = 1.25 * zugrad * EXP( -2.0 * znd ) 2414 ! zdvdz(ji,jj,jk) = 1.25 * zvgrad * EXP( -2.0 * znd ) 2415 ! ENDIF 2416 ! END DO 2049 2417 ELSE 2050 2418 ! stable conditions … … 2067 2435 END SUBROUTINE zdf_osm_pycnocline_shear_profiles 2068 2436 2069 SUBROUTINE zdf_osm_calculate_dhdt( zdhdt ) 2070 !!--------------------------------------------------------------------- 2071 !! *** ROUTINE zdf_osm_calculate_dhdt *** 2072 !! 2073 !! ** Purpose : Calculates the rate at which hbl changes. 2074 !! 2075 !! ** Method : 2076 !! 2077 !!---------------------------------------------------------------------- 2078 2079 REAL(wp), DIMENSION(jpi,jpj) :: zdhdt ! Rate of change of hbl 2080 2081 INTEGER :: jj, ji 2082 REAL(wp) :: zgamma_b_nd, zgamma_dh_nd, zpert, zpsi 2083 REAL(wp) :: zvel_max,zddhdt 2084 REAL(wp), PARAMETER :: zzeta_m = 0.3 2085 REAL(wp), PARAMETER :: zgamma_c = 2.0 2086 REAL(wp), PARAMETER :: zdhoh = 0.1 2087 REAL(wp), PARAMETER :: zalpha_b = 0.3 2088 REAL, PARAMETER :: a_ddh = 2.5, a_ddh_2 = 3.5 ! also in pycnocline_depth 2089 2090 DO jj = 2, jpjm1 2091 DO ji = 2, jpim1 2092 2093 IF ( lshear(ji,jj) ) THEN 2094 IF ( lconv(ji,jj) ) THEN ! Convective 2095 2096 IF ( ln_osm_mle ) THEN 2097 2098 IF ( hmle(ji,jj) > hbl(ji,jj) ) THEN 2099 ! Fox-Kemper buoyancy flux average over OSBL 2100 zwb_fk_b(ji,jj) = zwb_fk(ji,jj) * & 2101 (1.0 + hmle(ji,jj) / ( 6.0 * hbl(ji,jj) ) * (-1.0 + ( 1.0 - 2.0 * hbl(ji,jj) / hmle(ji,jj))**3) ) 2102 ELSE 2103 zwb_fk_b(ji,jj) = 0.5 * zwb_fk(ji,jj) * hmle(ji,jj) / hbl(ji,jj) 2104 ENDIF 2105 zvel_max = ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**p2third / hbl(ji,jj) 2106 IF ( ( zwb_ent(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ) < 0.0 ) THEN 2107 ! OSBL is deepening, entrainment > restratification 2108 IF ( zdb_bl(ji,jj) > 1.0e-15 ) THEN 2109 zgamma_b_nd = MAX( zdbdz_bl_ext(ji,jj), 0._wp ) * zdh(ji,jj) / zdb_ml(ji,jj) 2110 zpsi = ( 1.0 - 0.5 * zdh(ji,jj) / zhbl(ji,jj) ) * ( zwb0(ji,jj) - MIN( ( zwb_min(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ), 0._wp ) ) * zdh(ji,jj) / zhbl(ji,jj) 2111 zpsi = zpsi + 1.75 * ( 1.0 - 0.5 * zdh(ji,jj) / zhbl(ji,jj) )*( zdh(ji,jj) / zhbl(ji,jj) + zgamma_b_nd ) * MIN( ( zwb_min(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ), 0._wp ) 2112 zpsi = zalpha_b * MAX ( zpsi, 0._wp ) 2113 zdhdt(ji,jj) = -( zwb_ent(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ) / ( zvel_max + MAX(zdb_bl(ji,jj), 1.0e-15) ) + zpsi / ( zvel_max + MAX( zdb_bl(ji,jj), 1.e-15 ) ) 2114 IF ( j_ddh(ji,jj) == 1 ) THEN 2115 IF ( ( zwstrc(ji,jj) / zvstr(ji,jj) )**3 <= 0.5 ) THEN 2116 zari = MIN( 1.5 * zdb_bl(ji,jj) / ( zhbl(ji,jj) * ( MAX(zdbdz_bl_ext(ji,jj),0._wp) + zdb_bl(ji,jj)**2 / MAX(4.5 * zvstr(ji,jj)**2 , 1.e-12 )) ), 0.2d0 ) 2437 SUBROUTINE zdf_osm_calculate_dhdt( zdhdt ) 2438 !!--------------------------------------------------------------------- 2439 !! *** ROUTINE zdf_osm_calculate_dhdt *** 2440 !! 2441 !! ** Purpose : Calculates the rate at which hbl changes. 2442 !! 2443 !! ** Method : 2444 !! 2445 !!---------------------------------------------------------------------- 2446 2447 REAL(wp), DIMENSION(jpi,jpj) :: zdhdt ! Rate of change of hbl 2448 2449 INTEGER :: jj, ji 2450 REAL(wp) :: zgamma_b_nd, zgamma_dh_nd, zpert, zpsi 2451 REAL(wp) :: zvel_max,zddhdt 2452 REAL(wp), PARAMETER :: zzeta_m = 0.3 2453 REAL(wp), PARAMETER :: zgamma_c = 2.0 2454 REAL(wp), PARAMETER :: zdhoh = 0.1 2455 REAL(wp), PARAMETER :: zalpha_b = 0.3 2456 REAL, PARAMETER :: a_ddh = 2.5, a_ddh_2 = 3.5 ! also in pycnocline_depth 2457 2458 DO jj = 2, jpjm1 2459 DO ji = 2, jpim1 2460 2461 IF ( lshear(ji,jj) ) THEN 2462 IF ( lconv(ji,jj) ) THEN ! Convective 2463 2464 IF ( ln_osm_mle ) THEN 2465 2466 IF ( hmle(ji,jj) > hbl(ji,jj) ) THEN 2467 ! Fox-Kemper buoyancy flux average over OSBL 2468 zwb_fk_b(ji,jj) = zwb_fk(ji,jj) * & 2469 (1.0 + hmle(ji,jj) / ( 6.0 * hbl(ji,jj) ) * (-1.0 + ( 1.0 - 2.0 * hbl(ji,jj) / hmle(ji,jj))**3) ) 2470 ELSE 2471 zwb_fk_b(ji,jj) = 0.5 * zwb_fk(ji,jj) * hmle(ji,jj) / hbl(ji,jj) 2472 ENDIF 2473 zvel_max = ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**p2third / hbl(ji,jj) 2474 IF ( ( zwb_ent(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ) < 0.0 ) THEN 2475 ! OSBL is deepening, entrainment > restratification 2476 IF ( zdb_bl(ji,jj) > 1.0e-15 ) THEN 2477 zgamma_b_nd = MAX( zdbdz_bl_ext(ji,jj), 0._wp ) * zdh(ji,jj) / zdb_ml(ji,jj) 2478 zpsi = ( 1.0 - 0.5 * zdh(ji,jj) / zhbl(ji,jj) ) * ( zwb0(ji,jj) - MIN( ( zwb_min(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ), 0._wp ) ) * zdh(ji,jj) / zhbl(ji,jj) 2479 zpsi = zpsi + 1.75 * ( 1.0 - 0.5 * zdh(ji,jj) / zhbl(ji,jj) )*( zdh(ji,jj) / zhbl(ji,jj) + zgamma_b_nd ) * MIN( ( zwb_min(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ), 0._wp ) 2480 zpsi = zalpha_b * MAX ( zpsi, 0._wp ) 2481 zdhdt(ji,jj) = -( zwb_ent(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ) / ( zvel_max + MAX(zdb_bl(ji,jj), 1.0e-15) ) + zpsi / ( zvel_max + MAX( zdb_bl(ji,jj), 1.e-15 ) ) 2482 #ifdef key_osm_debug 2483 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 2484 WRITE(narea+100,'(a,g11.3)')'Inside 1st major loop of zdf_osm_calculate_dhdt, OSBL is deepening, entrainment > restratification: zdhdt=',zdhdt(ji,jj) 2485 WRITE(narea+100,'(3(a,g11.3))') ' zpsi=',zpsi, ' zgamma_b_nd=', zgamma_b_nd, ' zdh=', zdh(ji,jj) 2486 FLUSH(narea+100) 2487 END IF 2488 #endif 2489 IF ( j_ddh(ji,jj) == 1 ) THEN 2490 IF ( ( zwstrc(ji,jj) / zvstr(ji,jj) )**3 <= 0.5 ) THEN 2491 zari = MIN( 1.5 * zdb_bl(ji,jj) / ( zhbl(ji,jj) * ( MAX(zdbdz_bl_ext(ji,jj),0._wp) + zdb_bl(ji,jj)**2 / MAX(4.5 * zvstr(ji,jj)**2 , 1.e-12 )) ), 0.2d0 ) 2492 ELSE 2493 zari = MIN( 1.5 * zdb_bl(ji,jj) / ( zhbl(ji,jj) * ( MAX(zdbdz_bl_ext(ji,jj),0._wp) + zdb_bl(ji,jj)**2 / MAX(4.5 * zwstrc(ji,jj)**2 , 1.e-12 )) ), 0.2d0 ) 2494 ENDIF 2495 ! Relaxation to dh_ref = zari * hbl 2496 zddhdt = -a_ddh_2 * ( 1.0 - zdh(ji,jj) / ( zari * zhbl(ji,jj) ) ) * zwb_ent(ji,jj) / zdb_bl(ji,jj) 2497 #ifdef key_osm_debug 2498 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 2499 WRITE(narea+100,'(a,g11.3)')'Inside 1st major loop of zdf_osm_calculate_dhdt,j_ddh(ji,jj) == 1: zari=',zari 2500 FLUSH(narea+100) 2501 END IF 2502 #endif 2503 2504 ELSE IF ( j_ddh(ji,jj) == 0 ) THEN 2505 ! Growing shear layer 2506 zddhdt = -a_ddh * ( 1.0 - 1.6 * zdh(ji,jj) / zhbl(ji,jj) ) * zwb_ent(ji,jj) / zdb_bl(ji,jj) 2507 zddhdt = EXP( - 4.0 * ABS( ff_t(ji,jj) ) * zhbl(ji,jj) / MAX(zustar(ji,jj), 1.e-8 ) ) * zddhdt 2508 ELSE 2509 zddhdt = 0._wp 2510 ENDIF ! j_ddh 2511 zdhdt(ji,jj) = zdhdt(ji,jj) + zalpha_b * ( 1.0 -0.5 * zdh(ji,jj) / zhbl(ji,jj) ) * & 2512 & zdb_ml(ji,jj) * zddhdt / ( zvel_max + MAX( zdb_bl(ji,jj), 1.0e-15 ) ) 2513 ELSE ! zdb_bl >0 2514 zdhdt(ji,jj) = -( zwb_ent(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ) / MAX( zvel_max, 1.0e-15) 2515 ENDIF 2516 ELSE ! zwb_min + 2*zwb_fk_b < 0 2517 ! OSBL shoaling due to restratification flux. This is the velocity defined in Fox-Kemper et al (2008) 2518 zdhdt(ji,jj) = - MIN(zvel_mle(ji,jj), hbl(ji,jj)/10800.) 2519 2520 2521 ENDIF 2522 2523 ELSE 2524 ! Fox-Kemper not used. 2525 2526 zvel_max = - ( 1.0 + 1.0 * ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * rn_rdt / hbl(ji,jj) ) * zwb_ent(ji,jj) / & 2527 & MAX((zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird, epsln) 2528 zdhdt(ji,jj) = -zwb_ent(ji,jj) / ( zvel_max + MAX(zdb_bl(ji,jj), 1.0e-15) ) 2529 ! added ajgn 23 July as temporay fix 2530 2531 ENDIF ! ln_osm_mle 2532 2533 ELSE ! lconv - Stable 2534 zdhdt(ji,jj) = ( 0.06 + 0.52 * zhol(ji,jj) / 2.0 ) * zvstr(ji,jj)**3 / hbl(ji,jj) + zwbav(ji,jj) 2535 IF ( zdhdt(ji,jj) < 0._wp ) THEN 2536 ! For long timsteps factor in brackets slows the rapid collapse of the OSBL 2537 zpert = 2.0 * ( 1.0 + 0.0 * 2.0 * zvstr(ji,jj) * rn_rdt / hbl(ji,jj) ) * zvstr(ji,jj)**2 / hbl(ji,jj) 2538 ELSE 2539 zpert = MAX( zvstr(ji,jj)**2 / hbl(ji,jj), zdb_bl(ji,jj) ) 2540 ENDIF 2541 zdhdt(ji,jj) = 2.0 * zdhdt(ji,jj) / MAX(zpert, epsln) 2542 zdhdt(ji,jj) = MAX(zdhdt(ji,jj), -hbl(ji,jj)/5400.) 2543 ENDIF ! lconv 2544 ELSE ! lshear 2545 IF ( lconv(ji,jj) ) THEN ! Convective 2546 2547 IF ( ln_osm_mle ) THEN 2548 2549 IF ( hmle(ji,jj) > hbl(ji,jj) ) THEN 2550 ! Fox-Kemper buoyancy flux average over OSBL 2551 zwb_fk_b(ji,jj) = zwb_fk(ji,jj) * & 2552 (1.0 + hmle(ji,jj) / ( 6.0 * hbl(ji,jj) ) * (-1.0 + ( 1.0 - 2.0 * hbl(ji,jj) / hmle(ji,jj))**3) ) 2553 ELSE 2554 zwb_fk_b(ji,jj) = 0.5 * zwb_fk(ji,jj) * hmle(ji,jj) / hbl(ji,jj) 2555 ENDIF 2556 zvel_max = ( zwstrl(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**p2third / hbl(ji,jj) 2557 IF ( ( zwb_ent(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ) < 0.0 ) THEN 2558 ! OSBL is deepening, entrainment > restratification 2559 IF ( zdb_bl(ji,jj) > 0.0 .and. zdbdz_bl_ext(ji,jj) > 0.0 ) THEN 2560 zdhdt(ji,jj) = -( zwb_ent(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ) / ( zvel_max + MAX(zdb_bl(ji,jj), 1.0e-15) ) 2117 2561 ELSE 2118 z ari = MIN( 1.5 * zdb_bl(ji,jj) / ( zhbl(ji,jj) * ( MAX(zdbdz_bl_ext(ji,jj),0._wp) + zdb_bl(ji,jj)**2 / MAX(4.5 * zwstrc(ji,jj)**2 , 1.e-12 )) ), 0.2d0)2562 zdhdt(ji,jj) = -( zwb_ent(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ) / MAX( zvel_max, 1.0e-15) 2119 2563 ENDIF 2120 ! Relaxation to dh_ref = zari * hbl 2121 zddhdt = -a_ddh_2 * ( 1.0 - zdh(ji,jj) / ( zari * zhbl(ji,jj) ) ) * zwb_ent(ji,jj) / zdb_bl(ji,jj) 2122 2123 ELSE IF ( j_ddh(ji,jj) == 0 ) THEN 2124 ! Growing shear layer 2125 zddhdt = -a_ddh * ( 1.0 - 1.6 * zdh(ji,jj) / zhbl(ji,jj) ) * zwb_ent(ji,jj) / zdb_bl(ji,jj) 2126 zddhdt = EXP( - 4.0 * ABS( ff_t(ji,jj) ) * zhbl(ji,jj) / MAX(zustar(ji,jj), 1.e-8 ) ) * zddhdt 2127 ELSE 2128 zddhdt = 0._wp 2129 ENDIF ! j_ddh 2130 zdhdt(ji,jj) = zdhdt(ji,jj) + zalpha_b * ( 1.0 -0.5 * zdh(ji,jj) / zhbl(ji,jj) ) * zddhdt / ( zvel_max + MAX( zdb_bl(ji,jj), 1.0e-15 ) ) 2131 ELSE ! zdb_bl >0 2132 zdhdt(ji,jj) = -( zwb_ent(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ) / MAX( zvel_max, 1.0e-15) 2133 ENDIF 2134 ELSE ! zwb_min + 2*zwb_fk_b < 0 2135 ! OSBL shoaling due to restratification flux. This is the velocity defined in Fox-Kemper et al (2008) 2136 zdhdt(ji,jj) = - zvel_mle(ji,jj) 2137 2138 2139 ENDIF 2140 2141 ELSE 2142 ! Fox-Kemper not used. 2143 2144 zvel_max = - ( 1.0 + 1.0 * ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * rn_rdt / hbl(ji,jj) ) * zwb_ent(ji,jj) / & 2145 & MAX((zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird, epsln) 2146 zdhdt(ji,jj) = -zwb_ent(ji,jj) / ( zvel_max + MAX(zdb_bl(ji,jj), 1.0e-15) ) 2147 ! added ajgn 23 July as temporay fix 2148 2149 ENDIF ! ln_osm_mle 2150 2151 ELSE ! lconv - Stable 2152 zdhdt(ji,jj) = ( 0.06 + 0.52 * zhol(ji,jj) / 2.0 ) * zvstr(ji,jj)**3 / hbl(ji,jj) + zwbav(ji,jj) 2153 IF ( zdhdt(ji,jj) < 0._wp ) THEN 2154 ! For long timsteps factor in brackets slows the rapid collapse of the OSBL 2155 zpert = 2.0 * ( 1.0 + 0.0 * 2.0 * zvstr(ji,jj) * rn_rdt / hbl(ji,jj) ) * zvstr(ji,jj)**2 / hbl(ji,jj) 2156 ELSE 2157 zpert = MAX( zvstr(ji,jj)**2 / hbl(ji,jj), zdb_bl(ji,jj) ) 2158 ENDIF 2159 zdhdt(ji,jj) = 2.0 * zdhdt(ji,jj) / MAX(zpert, epsln) 2160 ENDIF ! lconv 2161 ELSE ! lshear 2162 IF ( lconv(ji,jj) ) THEN ! Convective 2163 2164 IF ( ln_osm_mle ) THEN 2165 2166 IF ( hmle(ji,jj) > hbl(ji,jj) ) THEN 2167 ! Fox-Kemper buoyancy flux average over OSBL 2168 zwb_fk_b(ji,jj) = zwb_fk(ji,jj) * & 2169 (1.0 + hmle(ji,jj) / ( 6.0 * hbl(ji,jj) ) * (-1.0 + ( 1.0 - 2.0 * hbl(ji,jj) / hmle(ji,jj))**3) ) 2170 ELSE 2171 zwb_fk_b(ji,jj) = 0.5 * zwb_fk(ji,jj) * hmle(ji,jj) / hbl(ji,jj) 2172 ENDIF 2173 zvel_max = ( zwstrl(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**p2third / hbl(ji,jj) 2174 IF ( ( zwb_ent(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ) < 0.0 ) THEN 2175 ! OSBL is deepening, entrainment > restratification 2176 IF ( zdb_bl(ji,jj) > 0.0 .and. zdbdz_bl_ext(ji,jj) > 0.0 ) THEN 2177 zdhdt(ji,jj) = -( zwb_ent(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ) / ( zvel_max + MAX(zdb_bl(ji,jj), 1.0e-15) ) 2178 ELSE 2179 zdhdt(ji,jj) = -( zwb_ent(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ) / MAX( zvel_max, 1.0e-15) 2180 ENDIF 2181 ELSE 2182 ! OSBL shoaling due to restratification flux. This is the velocity defined in Fox-Kemper et al (2008) 2183 zdhdt(ji,jj) = - zvel_mle(ji,jj) 2184 2185 2186 ENDIF 2187 2188 ELSE 2189 ! Fox-Kemper not used. 2190 2191 zvel_max = -zwb_ent(ji,jj) / & 2192 & MAX((zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird, epsln) 2193 zdhdt(ji,jj) = -zwb_ent(ji,jj) / ( zvel_max + MAX(zdb_bl(ji,jj), 1.0e-15) ) 2194 ! added ajgn 23 July as temporay fix 2195 2196 ENDIF ! ln_osm_mle 2197 2198 ELSE ! Stable 2199 zdhdt(ji,jj) = ( 0.06 + 0.52 * zhol(ji,jj) / 2.0 ) * zvstr(ji,jj)**3 / hbl(ji,jj) + zwbav(ji,jj) 2200 IF ( zdhdt(ji,jj) < 0._wp ) THEN 2201 ! For long timsteps factor in brackets slows the rapid collapse of the OSBL 2202 zpert = 2.0 * zvstr(ji,jj)**2 / hbl(ji,jj) 2203 ELSE 2204 zpert = MAX( zvstr(ji,jj)**2 / hbl(ji,jj), zdb_bl(ji,jj) ) 2205 ENDIF 2206 zdhdt(ji,jj) = 2.0 * zdhdt(ji,jj) / MAX(zpert, epsln) 2207 ENDIF ! lconv 2208 ENDIF ! lshear 2209 END DO 2210 END DO 2564 ELSE 2565 ! OSBL shoaling due to restratification flux. This is the velocity defined in Fox-Kemper et al (2008) 2566 zdhdt(ji,jj) = - MIN(zvel_mle(ji,jj), hbl(ji,jj)/10800.) 2567 2568 2569 ENDIF 2570 2571 ELSE 2572 ! Fox-Kemper not used. 2573 2574 zvel_max = -zwb_ent(ji,jj) / & 2575 & MAX((zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird, epsln) 2576 zdhdt(ji,jj) = -zwb_ent(ji,jj) / ( zvel_max + MAX(zdb_bl(ji,jj), 1.0e-15) ) 2577 ! added ajgn 23 July as temporay fix 2578 2579 ENDIF ! ln_osm_mle 2580 2581 ELSE ! Stable 2582 zdhdt(ji,jj) = ( 0.06 + 0.52 * zhol(ji,jj) / 2.0 ) * zvstr(ji,jj)**3 / hbl(ji,jj) + zwbav(ji,jj) 2583 IF ( zdhdt(ji,jj) < 0._wp ) THEN 2584 ! For long timsteps factor in brackets slows the rapid collapse of the OSBL 2585 zpert = 2.0 * zvstr(ji,jj)**2 / hbl(ji,jj) 2586 ELSE 2587 zpert = MAX( zvstr(ji,jj)**2 / hbl(ji,jj), zdb_bl(ji,jj) ) 2588 ENDIF 2589 zdhdt(ji,jj) = 2.0 * zdhdt(ji,jj) / MAX(zpert, epsln) 2590 zdhdt(ji,jj) = MAX(zdhdt(ji,jj), -hbl(ji,jj)/5400.) 2591 ENDIF ! lconv 2592 ENDIF ! lshear 2593 #ifdef key_osm_debug 2594 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 2595 WRITE(narea+100,'(4(a,g11.3))')'end of 1st major loop of zdf_osm_calculate_dhdt: zdhdt=',zdhdt(ji,jj), & 2596 & ' zpert=', zpert, ' zddhdt=', zddhdt, ' zvel_max=', zvel_max 2597 2598 IF ( ln_osm_mle ) THEN 2599 WRITE(narea+100,'(3(a,g11.3),/)') 'zvel_mle=',zvel_mle(ji,jj), ' zwb_fk_b=', zwb_fk_b(ji,jj), & 2600 & ' zwb_ent + 2*zwb_fk_b =', zwb_ent(ji,jj) + 2.0 * zwb_fk_b(ji,jj) 2601 FLUSH(narea+100) 2602 END IF 2603 END IF 2604 #endif 2605 END DO 2606 END DO 2211 2607 END SUBROUTINE zdf_osm_calculate_dhdt 2212 2608 2213 2609 SUBROUTINE zdf_osm_timestep_hbl( zdhdt ) 2214 !!---------------------------------------------------------------------2215 !! *** ROUTINE zdf_osm_timestep_hbl ***2216 !!2217 !! ** Purpose : Increments hbl.2218 !!2219 !! ** Method : If thechange in hbl exceeds one model level the change is2220 !! is calculated by moving down the grid, changing the buoyancy2221 !! jump. This is to ensure that the change in hbl does not2222 !! overshoot a stable layer.2223 !!2224 !!----------------------------------------------------------------------2225 2226 2227 REAL(wp), DIMENSION(jpi,jpj) :: zdhdt ! rates of change of hbl.2228 2229 INTEGER :: jk, jj, ji, jm2230 REAL(wp) :: zhbl_s, zvel_max, zdb2231 REAL(wp) :: zthermal, zbeta2232 2233 DO jj = 2, jpjm12610 !!--------------------------------------------------------------------- 2611 !! *** ROUTINE zdf_osm_timestep_hbl *** 2612 !! 2613 !! ** Purpose : Increments hbl. 2614 !! 2615 !! ** Method : If thechange in hbl exceeds one model level the change is 2616 !! is calculated by moving down the grid, changing the buoyancy 2617 !! jump. This is to ensure that the change in hbl does not 2618 !! overshoot a stable layer. 2619 !! 2620 !!---------------------------------------------------------------------- 2621 2622 2623 REAL(wp), DIMENSION(jpi,jpj) :: zdhdt ! rates of change of hbl. 2624 2625 INTEGER :: jk, jj, ji, jm 2626 REAL(wp) :: zhbl_s, zvel_max, zdb 2627 REAL(wp) :: zthermal, zbeta 2628 2629 DO jj = 2, jpjm1 2234 2630 DO ji = 2, jpim1 2235 IF ( ibld(ji,jj) - imld(ji,jj) > 1 ) THEN 2236 ! 2237 ! If boundary layer changes by more than one level, need to check for stable layers between initial and final depths. 2238 ! 2239 zhbl_s = hbl(ji,jj) 2240 jm = imld(ji,jj) 2241 zthermal = rab_n(ji,jj,1,jp_tem) 2242 zbeta = rab_n(ji,jj,1,jp_sal) 2243 2244 2245 IF ( lconv(ji,jj) ) THEN 2246 !unstable 2247 2248 IF( ln_osm_mle ) THEN 2249 zvel_max = ( zwstrl(ji,jj)**3 + zwstrc(ji,jj)**3 )**p2third / hbl(ji,jj) 2250 ELSE 2251 2252 zvel_max = -( 1.0 + 1.0 * ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * rn_rdt / hbl(ji,jj) ) * zwb_ent(ji,jj) / & 2253 & ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird 2254 2255 ENDIF 2256 2257 DO jk = imld(ji,jj), ibld(ji,jj) 2258 zdb = MAX( grav * ( zthermal * ( zt_bl(ji,jj) - tsn(ji,jj,jm,jp_tem) ) & 2259 & - zbeta * ( zs_bl(ji,jj) - tsn(ji,jj,jm,jp_sal) ) ), & 2260 & 0.0 ) + zvel_max 2261 2262 2263 IF ( ln_osm_mle ) THEN 2264 zhbl_s = zhbl_s + MIN( & 2265 & rn_rdt * ( ( -zwb_ent(ji,jj) - 2.0 * zwb_fk_b(ji,jj) )/ zdb ) / FLOAT(ibld(ji,jj) - imld(ji,jj) ), & 2266 & e3w_n(ji,jj,jm) ) 2267 ELSE 2268 zhbl_s = zhbl_s + MIN( & 2269 & rn_rdt * ( -zwb_ent(ji,jj) / zdb ) / FLOAT(ibld(ji,jj) - imld(ji,jj) ), & 2270 & e3w_n(ji,jj,jm) ) 2271 ENDIF 2272 2273 ! zhbl_s = MIN(zhbl_s, gdepw_n(ji,jj, mbkt(ji,jj) + 1) - depth_tol) 2274 IF ( zhbl_s >= gdepw_n(ji,jj,mbkt(ji,jj) + 1) ) THEN 2275 zhbl_s = MIN(zhbl_s, gdepw_n(ji,jj, mbkt(ji,jj) + 1) - depth_tol) 2276 lpyc(ji,jj) = .FALSE. 2277 ENDIF 2278 IF ( zhbl_s >= gdepw_n(ji,jj,jm+1) ) jm = jm + 1 2279 END DO 2280 hbl(ji,jj) = zhbl_s 2281 ibld(ji,jj) = jm 2282 ELSE 2283 ! stable 2284 DO jk = imld(ji,jj), ibld(ji,jj) 2285 zdb = MAX( & 2286 & grav * ( zthermal * ( zt_bl(ji,jj) - tsn(ji,jj,jm,jp_tem) )& 2287 & - zbeta * ( zs_bl(ji,jj) - tsn(ji,jj,jm,jp_sal) ) ),& 2288 & 0.0 ) + & 2289 & 2.0 * zvstr(ji,jj)**2 / zhbl_s 2290 2291 ! Alan is thuis right? I have simply changed hbli to hbl 2292 zhol(ji,jj) = -zhbl_s / ( ( zvstr(ji,jj)**3 + epsln )/ zwbav(ji,jj) ) 2293 zdhdt(ji,jj) = -( zwbav(ji,jj) - 0.04 / 2.0 * zwstrl(ji,jj)**3 / zhbl_s - 0.15 / 2.0 * ( 1.0 - EXP( -1.5 * zla(ji,jj) ) ) * & 2294 & zustar(ji,jj)**3 / zhbl_s ) * ( 0.725 + 0.225 * EXP( -7.5 * zhol(ji,jj) ) ) 2295 zdhdt(ji,jj) = zdhdt(ji,jj) + zwbav(ji,jj) 2296 zhbl_s = zhbl_s + MIN( zdhdt(ji,jj) / zdb * rn_rdt / FLOAT( ibld(ji,jj) - imld(ji,jj) ), e3w_n(ji,jj,jm) ) 2297 2298 ! zhbl_s = MIN(zhbl_s, gdepw_n(ji,jj, mbkt(ji,jj) + 1) - depth_tol) 2299 IF ( zhbl_s >= mbkt(ji,jj) + 1 ) THEN 2300 zhbl_s = MIN(zhbl_s, gdepw_n(ji,jj, mbkt(ji,jj) + 1) - depth_tol) 2301 lpyc(ji,jj) = .FALSE. 2302 ENDIF 2303 IF ( zhbl_s >= gdepw_n(ji,jj,jm) ) jm = jm + 1 2304 END DO 2305 ENDIF ! IF ( lconv ) 2306 hbl(ji,jj) = MAX(zhbl_s, gdepw_n(ji,jj,4) ) 2307 ibld(ji,jj) = MAX(jm, 4 ) 2308 ELSE 2309 ! change zero or one model level. 2310 hbl(ji,jj) = MAX(zhbl_t(ji,jj), gdepw_n(ji,jj,4) ) 2311 ENDIF 2312 zhbl(ji,jj) = gdepw_n(ji,jj,ibld(ji,jj)) 2631 #ifdef key_osm_debug 2632 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 2633 WRITE(narea+100,'(2(a,i7))')'start of zdf_osm_timestep_hbl: old ibld=',imld(ji,jj),' trial ibld=', ibld(ji,jj) 2634 FLUSH(narea+100) 2635 END IF 2636 #endif 2637 IF ( ibld(ji,jj) - imld(ji,jj) > 1 ) THEN 2638 ! 2639 ! If boundary layer changes by more than one level, need to check for stable layers between initial and final depths. 2640 ! 2641 zhbl_s = hbl(ji,jj) 2642 jm = imld(ji,jj) 2643 zthermal = rab_n(ji,jj,1,jp_tem) 2644 zbeta = rab_n(ji,jj,1,jp_sal) 2645 2646 2647 IF ( lconv(ji,jj) ) THEN 2648 !unstable 2649 2650 IF( ln_osm_mle ) THEN 2651 zvel_max = ( zwstrl(ji,jj)**3 + zwstrc(ji,jj)**3 )**p2third / hbl(ji,jj) 2652 ELSE 2653 2654 zvel_max = -( 1.0 + 1.0 * ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird * rn_rdt / hbl(ji,jj) ) * zwb_ent(ji,jj) / & 2655 & ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird 2656 2657 ENDIF 2658 #ifdef key_osm_debug 2659 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 2660 WRITE(narea+100,'(a,g11.3)')'In zdf_osm_timestep_hbl, ibld - imld > 1, lconv=T: zvel_max=',zvel_max 2661 FLUSH(narea+100) 2662 END IF 2663 #endif 2664 2665 DO jk = imld(ji,jj), ibld(ji,jj) 2666 zdb = MAX( grav * ( zthermal * ( zt_bl(ji,jj) - tsn(ji,jj,jm,jp_tem) ) & 2667 & - zbeta * ( zs_bl(ji,jj) - tsn(ji,jj,jm,jp_sal) ) ), & 2668 & 0.0 ) + zvel_max 2669 2670 2671 IF ( ln_osm_mle ) THEN 2672 zhbl_s = zhbl_s + MIN( & 2673 & rn_rdt * ( ( -zwb_ent(ji,jj) - 2.0 * zwb_fk_b(ji,jj) )/ zdb ) / FLOAT(ibld(ji,jj) - imld(ji,jj) ), & 2674 & e3w_n(ji,jj,jm) ) 2675 ELSE 2676 zhbl_s = zhbl_s + MIN( & 2677 & rn_rdt * ( -zwb_ent(ji,jj) / zdb ) / FLOAT(ibld(ji,jj) - imld(ji,jj) ), & 2678 & e3w_n(ji,jj,jm) ) 2679 ENDIF 2680 2681 ! zhbl_s = MIN(zhbl_s, gdepw_n(ji,jj, mbkt(ji,jj) + 1) - depth_tol) 2682 IF ( zhbl_s >= gdepw_n(ji,jj,mbkt(ji,jj) + 1) ) THEN 2683 zhbl_s = MIN(zhbl_s, gdepw_n(ji,jj, mbkt(ji,jj) + 1) - depth_tol) 2684 lpyc(ji,jj) = .FALSE. 2685 ENDIF 2686 IF ( zhbl_s >= gdepw_n(ji,jj,jm+1) ) jm = jm + 1 2687 #ifdef key_osm_debug 2688 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 2689 WRITE(narea+100,'(2(a,i7))')' jk=',jk,' jm=', jm 2690 WRITE(narea+100,'(2(a,g11.3),a,l7)')'zdb=',zdb,' zhbl_s=', zhbl_s,' lpyc=',lpyc(ji,jj) 2691 FLUSH(narea+100) 2692 END IF 2693 #endif 2694 END DO 2695 hbl(ji,jj) = zhbl_s 2696 ibld(ji,jj) = jm 2697 ELSE 2698 ! stable 2699 #ifdef key_osm_debug 2700 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 2701 WRITE(narea+100,'(a)')'In zdf_osm_timestep_hbl, ibld - imld > 1, lconv=F' 2702 FLUSH(narea+100) 2703 END IF 2704 #endif 2705 DO jk = imld(ji,jj), ibld(ji,jj) 2706 zdb = MAX( & 2707 & grav * ( zthermal * ( zt_bl(ji,jj) - tsn(ji,jj,jm,jp_tem) )& 2708 & - zbeta * ( zs_bl(ji,jj) - tsn(ji,jj,jm,jp_sal) ) ),& 2709 & 0.0 ) + & 2710 & 2.0 * zvstr(ji,jj)**2 / zhbl_s 2711 2712 ! Alan is thuis right? I have simply changed hbli to hbl 2713 zhol(ji,jj) = -zhbl_s / ( ( zvstr(ji,jj)**3 + epsln )/ zwbav(ji,jj) ) 2714 zdhdt(ji,jj) = -( zwbav(ji,jj) - 0.04 / 2.0 * zwstrl(ji,jj)**3 / zhbl_s - 0.15 / 2.0 * ( 1.0 - EXP( -1.5 * zla(ji,jj) ) ) * & 2715 & zustar(ji,jj)**3 / zhbl_s ) * ( 0.725 + 0.225 * EXP( -7.5 * zhol(ji,jj) ) ) 2716 zdhdt(ji,jj) = zdhdt(ji,jj) + zwbav(ji,jj) 2717 zhbl_s = zhbl_s + MIN( zdhdt(ji,jj) / zdb * rn_rdt / FLOAT( ibld(ji,jj) - imld(ji,jj) ), e3w_n(ji,jj,jm) ) 2718 2719 ! zhbl_s = MIN(zhbl_s, gdepw_n(ji,jj, mbkt(ji,jj) + 1) - depth_tol) 2720 IF ( zhbl_s >= mbkt(ji,jj) + 1 ) THEN 2721 zhbl_s = MIN(zhbl_s, gdepw_n(ji,jj, mbkt(ji,jj) + 1) - depth_tol) 2722 lpyc(ji,jj) = .FALSE. 2723 ENDIF 2724 IF ( zhbl_s >= gdepw_n(ji,jj,jm) ) jm = jm + 1 2725 #ifdef key_osm_debug 2726 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 2727 WRITE(narea+100,'(2(a,i7))')' jk=',jk,' jm=', jm 2728 WRITE(narea+100,'(4(a,g11.3),a,l7)')'zdb=',zdb,' zhol',zhol(ji,jj),' zdhdt',zdhdt(ji,jj),' zhbl_s=', zhbl_s,' lpyc=',lpyc(ji,jj) 2729 FLUSH(narea+100) 2730 END IF 2731 #endif 2732 END DO 2733 ENDIF ! IF ( lconv ) 2734 hbl(ji,jj) = MAX(zhbl_s, gdepw_n(ji,jj,4) ) 2735 ibld(ji,jj) = MAX(jm, 4 ) 2736 ELSE 2737 ! change zero or one model level. 2738 hbl(ji,jj) = MAX(zhbl_t(ji,jj), gdepw_n(ji,jj,4) ) 2739 ENDIF 2740 zhbl(ji,jj) = gdepw_n(ji,jj,ibld(ji,jj)) 2741 #ifdef key_osm_debug 2742 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 2743 WRITE(narea+100,'(2(a,g11.3),a,i7,/)')'end of zdf_osm_timestep_hbl: hbl=', hbl(ji,jj),' zhbl=', zhbl(ji,jj),' ibld=', ibld(ji,jj) 2744 FLUSH(narea+100) 2745 END IF 2746 #endif 2313 2747 END DO 2314 2748 END DO … … 2331 2765 2332 2766 REAL(wp), DIMENSION(jpi,jpj) :: dh, zdh ! pycnocline thickness. 2333 2767 ! 2334 2768 INTEGER :: jj, ji 2335 2769 INTEGER :: inhml … … 2337 2771 REAL, PARAMETER :: a_ddh = 2.5, a_ddh_2 = 3.5 ! also in pycnocline_depth 2338 2772 2339 DO jj = 2, jpjm1 2340 DO ji = 2, jpim1 2341 2342 IF ( lshear(ji,jj) ) THEN 2343 IF ( lconv(ji,jj) ) THEN 2344 IF ( zdb_bl(ji,jj) > 1.0e-15) THEN 2345 IF ( j_ddh(ji,jj) == 0 ) THEN 2346 zvel_max = ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**p2third / hbl(ji,jj) 2347 ! ddhdt for pycnocline determined in osm_calculate_dhdt 2348 zddhdt = -a_ddh * ( 1.0 - 1.6 * zdh(ji,jj) / zhbl(ji,jj) ) * zwb_ent(ji,jj) / ( zvel_max + MAX( zdb_bl(ji,jj), 1.0e-15 ) ) 2349 zddhdt = EXP( - 4.0 * ABS( ff_t(ji,jj) ) * zhbl(ji,jj) / MAX(zustar(ji,jj), 1.e-8 ) ) * zddhdt 2350 ! maximum limit for how thick the shear layer can grow relative to the thickness of the boundary kayer 2351 dh(ji,jj) = MIN( dh(ji,jj) + zddhdt * rn_rdt, 0.625 * hbl(ji,jj) ) 2352 ELSE 2353 ! Need to recalculate because hbl has been updated. 2354 IF ( ( zwstrc(ji,jj) / zvstr(ji,jj) )**3 <= 0.5 ) THEN 2355 zari = MIN( 1.5 * zdb_bl(ji,jj) / ( zhbl(ji,jj) * ( MAX(zdbdz_bl_ext(ji,jj),0._wp) + zdb_bl(ji,jj)**2 / MAX(4.5 * zvstr(ji,jj)**2 , 1.e-12 )) ), 0.2d0 ) 2356 ELSE 2357 zari = MIN( 1.5 * zdb_bl(ji,jj) / ( zhbl(ji,jj) * ( MAX(zdbdz_bl_ext(ji,jj),0._wp) + zdb_bl(ji,jj)**2 / MAX(4.5 * zwstrc(ji,jj)**2 , 1.e-12 )) ), 0.2d0 ) 2358 ENDIF 2359 ztau = MAX( zdb_bl(ji,jj) * ( zari * hbl(ji,jj) ) / ( a_ddh_2 * MAX(-zwb_ent(ji,jj), 1.e-12) ), 2.0 * rn_rdt ) 2360 dh(ji,jj) = dh(ji,jj) * EXP( -rn_rdt / ztau ) + zari * zhbl(ji,jj) * ( 1.0 - EXP( -rn_rdt / ztau ) ) 2361 IF ( dh(ji,jj) >= hbl(ji,jj) ) dh(ji,jj) = zari * zhbl(ji,jj) 2362 ENDIF 2363 ELSE 2364 ztau = MAX( MAX( hbl(ji,jj) / ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird, epsln), 2.0 * rn_rdt ) 2365 dh(ji,jj) = dh(ji,jj) * EXP( -rn_rdt / ztau ) + 0.2 * zhbl(ji,jj) * ( 1.0 - EXP( -rn_rdt / ztau ) ) 2366 IF ( dh(ji,jj) > hbl(ji,jj) ) dh(ji,jj) = 0.2 * hbl(ji,jj) 2367 ENDIF 2368 ELSE ! lconv 2369 ! Initially shear only for entraining OSBL. Stable code will be needed if extended to stable OSBL 2370 2371 ztau = hbl(ji,jj) / MAX(zvstr(ji,jj), epsln) 2372 IF ( zdhdt(ji,jj) >= 0.0 ) THEN ! probably shouldn't include wm here 2373 ! boundary layer deepening 2374 IF ( zdb_bl(ji,jj) > 0._wp ) THEN 2375 ! pycnocline thickness set by stratification - use same relationship as for neutral conditions. 2376 zari = MIN( 4.5 * ( zvstr(ji,jj)**2 ) & 2377 & / MAX(zdb_bl(ji,jj) * zhbl(ji,jj), epsln ) + 0.01 , 0.2 ) 2378 zdh_ref = MIN( zari, 0.2 ) * hbl(ji,jj) 2773 DO jj = 2, jpjm1 2774 DO ji = 2, jpim1 2775 2776 IF ( lshear(ji,jj) ) THEN 2777 IF ( lconv(ji,jj) ) THEN 2778 IF ( zdb_bl(ji,jj) > 1.0e-15) THEN 2779 IF ( j_ddh(ji,jj) == 0 ) THEN 2780 zvel_max = ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**p2third / hbl(ji,jj) 2781 ! ddhdt for pycnocline determined in osm_calculate_dhdt 2782 zddhdt = -a_ddh * ( 1.0 - 1.6 * zdh(ji,jj) / zhbl(ji,jj) ) * zwb_ent(ji,jj) / ( zvel_max + MAX( zdb_bl(ji,jj), 1.0e-15 ) ) 2783 zddhdt = EXP( - 4.0 * ABS( ff_t(ji,jj) ) * zhbl(ji,jj) / MAX(zustar(ji,jj), 1.e-8 ) ) * zddhdt 2784 ! maximum limit for how thick the shear layer can grow relative to the thickness of the boundary kayer 2785 dh(ji,jj) = MIN( dh(ji,jj) + zddhdt * rn_rdt, 0.625 * hbl(ji,jj) ) 2786 ELSE 2787 ! Need to recalculate because hbl has been updated. 2788 IF ( ( zwstrc(ji,jj) / zvstr(ji,jj) )**3 <= 0.5 ) THEN 2789 zari = MIN( 1.5 * zdb_bl(ji,jj) / ( zhbl(ji,jj) * ( MAX(zdbdz_bl_ext(ji,jj),0._wp) + zdb_bl(ji,jj)**2 / MAX(4.5 * zvstr(ji,jj)**2 , 1.e-12 )) ), 0.2d0 ) 2790 ELSE 2791 zari = MIN( 1.5 * zdb_bl(ji,jj) / ( zhbl(ji,jj) * ( MAX(zdbdz_bl_ext(ji,jj),0._wp) + zdb_bl(ji,jj)**2 / MAX(4.5 * zwstrc(ji,jj)**2 , 1.e-12 )) ), 0.2d0 ) 2792 ENDIF 2793 ztau = MAX( zdb_bl(ji,jj) * ( zari * hbl(ji,jj) ) / ( a_ddh_2 * MAX(-zwb_ent(ji,jj), 1.e-12) ), 2.0 * rn_rdt ) 2794 dh(ji,jj) = dh(ji,jj) * EXP( -rn_rdt / ztau ) + zari * zhbl(ji,jj) * ( 1.0 - EXP( -rn_rdt / ztau ) ) 2795 IF ( dh(ji,jj) >= hbl(ji,jj) ) dh(ji,jj) = zari * zhbl(ji,jj) 2796 ENDIF 2379 2797 ELSE 2798 ztau = MAX( MAX( hbl(ji,jj) / ( zvstr(ji,jj)**3 + 0.5 * zwstrc(ji,jj)**3 )**pthird, epsln), 2.0 * rn_rdt ) 2799 dh(ji,jj) = dh(ji,jj) * EXP( -rn_rdt / ztau ) + 0.2 * zhbl(ji,jj) * ( 1.0 - EXP( -rn_rdt / ztau ) ) 2800 IF ( dh(ji,jj) > hbl(ji,jj) ) dh(ji,jj) = 0.2 * hbl(ji,jj) 2801 ENDIF 2802 ELSE ! lconv 2803 ! Initially shear only for entraining OSBL. Stable code will be needed if extended to stable OSBL 2804 2805 ztau = hbl(ji,jj) / MAX(zvstr(ji,jj), epsln) 2806 IF ( zdhdt(ji,jj) >= 0.0 ) THEN ! probably shouldn't include wm here 2807 ! boundary layer deepening 2808 IF ( zdb_bl(ji,jj) > 0._wp ) THEN 2809 ! pycnocline thickness set by stratification - use same relationship as for neutral conditions. 2810 zari = MIN( 4.5 * ( zvstr(ji,jj)**2 ) & 2811 & / MAX(zdb_bl(ji,jj) * zhbl(ji,jj), epsln ) + 0.01 , 0.2 ) 2812 zdh_ref = MIN( zari, 0.2 ) * hbl(ji,jj) 2813 ELSE 2814 zdh_ref = 0.2 * hbl(ji,jj) 2815 ENDIF 2816 ELSE ! IF(dhdt < 0) 2380 2817 zdh_ref = 0.2 * hbl(ji,jj) 2381 ENDIF 2382 ELSE ! IF(dhdt < 0) 2383 zdh_ref = 0.2 * hbl(ji,jj) 2384 ENDIF ! IF (dhdt >= 0) 2385 dh(ji,jj) = dh(ji,jj) * EXP( -rn_rdt / ztau )+ zdh_ref * ( 1.0 - EXP( -rn_rdt / ztau ) ) 2386 IF ( zdhdt(ji,jj) < 0._wp .and. dh(ji,jj) >= hbl(ji,jj) ) dh(ji,jj) = zdh_ref ! can be a problem with dh>hbl for rapid collapse 2387 ! Alan: this hml is never defined or used -- do we need it? 2388 ENDIF 2389 2390 ELSE ! lshear 2391 ! for lshear = .FALSE. calculate ddhdt here 2392 2393 IF ( lconv(ji,jj) ) THEN 2394 2395 IF( ln_osm_mle ) THEN 2396 IF ( ( zwb_ent(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ) < 0._wp ) THEN 2397 ! OSBL is deepening. Note wb_fk_b is zero if ln_osm_mle=F 2818 ENDIF ! IF (dhdt >= 0) 2819 dh(ji,jj) = dh(ji,jj) * EXP( -rn_rdt / ztau ) + zdh_ref * ( 1.0 - EXP( -rn_rdt / ztau ) ) 2820 IF ( zdhdt(ji,jj) < 0._wp .and. dh(ji,jj) >= hbl(ji,jj) ) dh(ji,jj) = zdh_ref ! can be a problem with dh>hbl for rapid collapse 2821 ENDIF 2822 2823 ELSE ! lshear 2824 ! for lshear = .FALSE. calculate ddhdt here 2825 2826 IF ( lconv(ji,jj) ) THEN 2827 2828 IF( ln_osm_mle ) THEN 2829 IF ( ( zwb_ent(ji,jj) + 2.0 * zwb_fk_b(ji,jj) ) < 0._wp ) THEN 2830 ! OSBL is deepening. Note wb_fk_b is zero if ln_osm_mle=F 2831 IF ( zdb_bl(ji,jj) > 0._wp .and. zdbdz_bl_ext(ji,jj) > 0._wp)THEN 2832 IF ( ( zwstrc(ji,jj) / MAX(zvstr(ji,jj), epsln) )**3 <= 0.5 ) THEN ! near neutral stability 2833 zari = MIN( 1.5 * zdb_bl(ji,jj) / ( zhbl(ji,jj) * ( MAX(zdbdz_bl_ext(ji,jj),0._wp) + zdb_bl(ji,jj)**2 / MAX(4.5 * zvstr(ji,jj)**2 , 1.e-12 )) ), 0.2d0 ) 2834 ELSE ! unstable 2835 zari = MIN( 1.5 * zdb_bl(ji,jj) / ( zhbl(ji,jj) * ( MAX(zdbdz_bl_ext(ji,jj),0._wp) + zdb_bl(ji,jj)**2 / MAX(4.5 * zwstrc(ji,jj)**2 , 1.e-12 )) ), 0.2d0 ) 2836 ENDIF 2837 ztau = 0.2 * hbl(ji,jj) / MAX(epsln, (zvstr(ji,jj)**3 + 0.5 *zwstrc(ji,jj)**3)**pthird) 2838 zdh_ref = zari * hbl(ji,jj) 2839 ELSE 2840 ztau = 0.2 * hbl(ji,jj) / MAX(epsln, (zvstr(ji,jj)**3 + 0.5 *zwstrc(ji,jj)**3)**pthird) 2841 zdh_ref = 0.2 * hbl(ji,jj) 2842 ENDIF 2843 ELSE 2844 ztau = 0.2 * hbl(ji,jj) / MAX(epsln, (zvstr(ji,jj)**3 + 0.5 *zwstrc(ji,jj)**3)**pthird) 2845 zdh_ref = 0.2 * hbl(ji,jj) 2846 ENDIF 2847 ELSE ! ln_osm_mle 2398 2848 IF ( zdb_bl(ji,jj) > 0._wp .and. zdbdz_bl_ext(ji,jj) > 0._wp)THEN 2399 2849 IF ( ( zwstrc(ji,jj) / MAX(zvstr(ji,jj), epsln) )**3 <= 0.5 ) THEN ! near neutral stability … … 2402 2852 zari = MIN( 1.5 * zdb_bl(ji,jj) / ( zhbl(ji,jj) * ( MAX(zdbdz_bl_ext(ji,jj),0._wp) + zdb_bl(ji,jj)**2 / MAX(4.5 * zwstrc(ji,jj)**2 , 1.e-12 )) ), 0.2d0 ) 2403 2853 ENDIF 2404 ztau = 0.2 *hbl(ji,jj) / MAX(epsln, (zvstr(ji,jj)**3 + 0.5 *zwstrc(ji,jj)**3)**pthird)2854 ztau = hbl(ji,jj) / MAX(epsln, (zvstr(ji,jj)**3 + 0.5 *zwstrc(ji,jj)**3)**pthird) 2405 2855 zdh_ref = zari * hbl(ji,jj) 2406 2856 ELSE 2407 ztau = 0.2 *hbl(ji,jj) / MAX(epsln, (zvstr(ji,jj)**3 + 0.5 *zwstrc(ji,jj)**3)**pthird)2857 ztau = hbl(ji,jj) / MAX(epsln, (zvstr(ji,jj)**3 + 0.5 *zwstrc(ji,jj)**3)**pthird) 2408 2858 zdh_ref = 0.2 * hbl(ji,jj) 2409 2859 ENDIF 2410 ELSE 2411 ztau = 0.2 * hbl(ji,jj) / MAX(epsln, (zvstr(ji,jj)**3 + 0.5 *zwstrc(ji,jj)**3)**pthird) 2860 2861 END IF ! ln_osm_mle 2862 2863 dh(ji,jj) = dh(ji,jj) * EXP( -rn_rdt / ztau ) + zdh_ref * ( 1.0 - EXP( -rn_rdt / ztau ) ) 2864 ! IF ( zdhdt(ji,jj) < 0._wp .and. dh(ji,jj) >= hbl(ji,jj) ) dh(ji,jj) = zdh_ref 2865 IF ( dh(ji,jj) >= hbl(ji,jj) ) dh(ji,jj) = zdh_ref 2866 ! Alan: this hml is never defined or used 2867 ELSE ! IF (lconv) 2868 ztau = hbl(ji,jj) / MAX(zvstr(ji,jj), epsln) 2869 IF ( zdhdt(ji,jj) >= 0.0 ) THEN ! probably shouldn't include wm here 2870 ! boundary layer deepening 2871 IF ( zdb_bl(ji,jj) > 0._wp ) THEN 2872 ! pycnocline thickness set by stratification - use same relationship as for neutral conditions. 2873 zari = MIN( 4.5 * ( zvstr(ji,jj)**2 ) & 2874 & / MAX(zdb_bl(ji,jj) * zhbl(ji,jj), epsln ) + 0.01 , 0.2 ) 2875 zdh_ref = MIN( zari, 0.2 ) * hbl(ji,jj) 2876 ELSE 2877 zdh_ref = 0.2 * hbl(ji,jj) 2878 ENDIF 2879 ELSE ! IF(dhdt < 0) 2412 2880 zdh_ref = 0.2 * hbl(ji,jj) 2413 ENDIF 2414 ELSE ! ln_osm_mle 2415 IF ( zdb_bl(ji,jj) > 0._wp .and. zdbdz_bl_ext(ji,jj) > 0._wp)THEN 2416 IF ( ( zwstrc(ji,jj) / MAX(zvstr(ji,jj), epsln) )**3 <= 0.5 ) THEN ! near neutral stability 2417 zari = MIN( 1.5 * zdb_bl(ji,jj) / ( zhbl(ji,jj) * ( MAX(zdbdz_bl_ext(ji,jj),0._wp) + zdb_bl(ji,jj)**2 / MAX(4.5 * zvstr(ji,jj)**2 , 1.e-12 )) ), 0.2d0 ) 2418 ELSE ! unstable 2419 zari = MIN( 1.5 * zdb_bl(ji,jj) / ( zhbl(ji,jj) * ( MAX(zdbdz_bl_ext(ji,jj),0._wp) + zdb_bl(ji,jj)**2 / MAX(4.5 * zwstrc(ji,jj)**2 , 1.e-12 )) ), 0.2d0 ) 2420 ENDIF 2421 ztau = hbl(ji,jj) / MAX(epsln, (zvstr(ji,jj)**3 + 0.5 *zwstrc(ji,jj)**3)**pthird) 2422 zdh_ref = zari * hbl(ji,jj) 2423 ELSE 2424 ztau = hbl(ji,jj) / MAX(epsln, (zvstr(ji,jj)**3 + 0.5 *zwstrc(ji,jj)**3)**pthird) 2425 zdh_ref = 0.2 * hbl(ji,jj) 2426 ENDIF 2427 2428 END IF ! ln_osm_mle 2429 2430 dh(ji,jj) = dh(ji,jj) * EXP( -rn_rdt / ztau ) + zdh_ref * ( 1.0 - EXP( -rn_rdt / ztau ) ) 2431 ! IF ( zdhdt(ji,jj) < 0._wp .and. dh(ji,jj) >= hbl(ji,jj) ) dh(ji,jj) = zdh_ref 2432 IF ( dh(ji,jj) >= hbl(ji,jj) ) dh(ji,jj) = zdh_ref 2433 ! Alan: this hml is never defined or used 2434 ELSE ! IF (lconv) 2435 ztau = hbl(ji,jj) / MAX(zvstr(ji,jj), epsln) 2436 IF ( zdhdt(ji,jj) >= 0.0 ) THEN ! probably shouldn't include wm here 2437 ! boundary layer deepening 2438 IF ( zdb_bl(ji,jj) > 0._wp ) THEN 2439 ! pycnocline thickness set by stratification - use same relationship as for neutral conditions. 2440 zari = MIN( 4.5 * ( zvstr(ji,jj)**2 ) & 2441 & / MAX(zdb_bl(ji,jj) * zhbl(ji,jj), epsln ) + 0.01 , 0.2 ) 2442 zdh_ref = MIN( zari, 0.2 ) * hbl(ji,jj) 2443 ELSE 2444 zdh_ref = 0.2 * hbl(ji,jj) 2445 ENDIF 2446 ELSE ! IF(dhdt < 0) 2447 zdh_ref = 0.2 * hbl(ji,jj) 2448 ENDIF ! IF (dhdt >= 0) 2449 dh(ji,jj) = dh(ji,jj) * EXP( -rn_rdt / ztau )+ zdh_ref * ( 1.0 - EXP( -rn_rdt / ztau ) ) 2450 IF ( zdhdt(ji,jj) < 0._wp .and. dh(ji,jj) >= hbl(ji,jj) ) dh(ji,jj) = zdh_ref ! can be a problem with dh>hbl for rapid collapse 2451 ENDIF ! IF (lconv) 2452 ENDIF ! lshear 2453 2454 hml(ji,jj) = hbl(ji,jj) - dh(ji,jj) 2455 inhml = MAX( INT( dh(ji,jj) / MAX(e3t_n(ji,jj,ibld(ji,jj)), 1.e-3) ) , 1 ) 2456 imld(ji,jj) = MAX( ibld(ji,jj) - inhml, 3) 2457 zhml(ji,jj) = gdepw_n(ji,jj,imld(ji,jj)) 2458 zdh(ji,jj) = zhbl(ji,jj) - zhml(ji,jj) 2459 END DO 2460 END DO 2881 ENDIF ! IF (dhdt >= 0) 2882 dh(ji,jj) = dh(ji,jj) * EXP( -rn_rdt / ztau )+ zdh_ref * ( 1.0 - EXP( -rn_rdt / ztau ) ) 2883 IF ( zdhdt(ji,jj) < 0._wp .and. dh(ji,jj) >= hbl(ji,jj) ) dh(ji,jj) = zdh_ref ! can be a problem with dh>hbl for rapid collapse 2884 ENDIF ! IF (lconv) 2885 ENDIF ! lshear 2886 2887 hml(ji,jj) = hbl(ji,jj) - dh(ji,jj) 2888 inhml = MAX( INT( dh(ji,jj) / MAX(e3t_n(ji,jj,ibld(ji,jj)-1), 1.e-3) ) , 1 ) 2889 imld(ji,jj) = MAX( ibld(ji,jj) - inhml, 3) 2890 zhml(ji,jj) = gdepw_n(ji,jj,imld(ji,jj)) 2891 zdh(ji,jj) = zhbl(ji,jj) - zhml(ji,jj) 2892 #ifdef key_osm_debug 2893 IF(narea==nn_narea_db.and.ji==iloc_db.and.jj==jloc_db)THEN 2894 WRITE(narea+100,'(4(a,g11.3),2(a,i7),/,5(a,g11.3),/)') 'end of zdf_osm_pycnocline_thickness:hml=',hml(ji,jj), & 2895 & ' zhml=',zhml(ji,jj),' zdh=', zdh(ji,jj), ' dh=', dh(ji,jj), ' imld=', imld(ji,jj), ' inhml=', inhml, & 2896 & 'zvel_max=', zvel_max, ' ztau=', ztau,' zdh_ref=', zdh_ref, ' zar=', zari, ' zddhdt=', zddhdt 2897 FLUSH(narea+100) 2898 END IF 2899 #endif 2900 2901 END DO 2902 END DO 2461 2903 2462 2904 END SUBROUTINE zdf_osm_pycnocline_thickness 2463 2905 2464 2906 2465 SUBROUTINE zdf_osm_zmld_horizontal_gradients( zmld, zdtdx, zdtdy, zdsdx, zdsdy, dbdx_mle, dbdy_mle, zdbds_mle )2907 SUBROUTINE zdf_osm_zmld_horizontal_gradients( zmld, zdtdx, zdtdy, zdsdx, zdsdy, dbdx_mle, dbdy_mle, zdbds_mle ) 2466 2908 !!---------------------------------------------------------------------- 2467 2909 !! *** ROUTINE zdf_osm_horizontal_gradients *** … … 2487 2929 REAL(wp), DIMENSION(jpi,jpj,jpts):: ztsm_midu, ztsm_midv, zabu, zabv 2488 2930 REAL(wp), DIMENSION(jpi,jpj) :: zmld_midu, zmld_midv 2489 !!----------------------------------------------------------------------2931 !!---------------------------------------------------------------------- 2490 2932 ! 2491 2933 ! !== MLD used for MLE ==! … … 2568 3010 2569 3011 DO jj = 2, jpjm1 2570 DO ji = 2, jpim12571 ztmp = r1_ft(ji,jj) * MIN( 111.e3_wp , e1u(ji,jj) ) / rn_osm_mle_lf2572 zdbds_mle(ji,jj) = SQRT( 0.5_wp * ( dbdx_mle(ji,jj) * dbdx_mle(ji,jj) + dbdy_mle(ji,jj) * dbdy_mle(ji,jj) &2573 & + dbdx_mle(ji-1,jj) * dbdx_mle(ji-1,jj) + dbdy_mle(ji,jj-1) * dbdy_mle(ji,jj-1) ) )2574 END DO3012 DO ji = 2, jpim1 3013 ztmp = r1_ft(ji,jj) * MIN( 111.e3_wp , e1u(ji,jj) ) / rn_osm_mle_lf 3014 zdbds_mle(ji,jj) = SQRT( 0.5_wp * ( dbdx_mle(ji,jj) * dbdx_mle(ji,jj) + dbdy_mle(ji,jj) * dbdy_mle(ji,jj) & 3015 & + dbdx_mle(ji-1,jj) * dbdx_mle(ji-1,jj) + dbdy_mle(ji,jj-1) * dbdy_mle(ji,jj-1) ) ) 3016 END DO 2575 3017 END DO 2576 2577 END SUBROUTINE zdf_osm_zmld_horizontal_gradients2578 SUBROUTINE zdf_osm_mle_parameters( zmld, mld_prof, hmle, zhmle, zvel_mle, zdiff_mle )3018 3019 END SUBROUTINE zdf_osm_zmld_horizontal_gradients 3020 SUBROUTINE zdf_osm_mle_parameters( zmld, mld_prof, hmle, zhmle, zvel_mle, zdiff_mle ) 2579 3021 !!---------------------------------------------------------------------- 2580 3022 !! *** ROUTINE zdf_osm_mle_parameters *** … … 2595 3037 REAL(wp) :: ztmp, zdbdz, zdtdz, zdsdz, zthermal,zbeta, zbuoy, zdb_mle 2596 3038 2597 ! Calculate vertical buoyancy, heat and salinity fluxes due to MLE.3039 ! Calculate vertical buoyancy, heat and salinity fluxes due to MLE. 2598 3040 2599 3041 DO jj = 2, jpjm1 2600 DO ji = 2, jpim12601 IF ( lconv(ji,jj) ) THEN2602 ztmp = r1_ft(ji,jj) * MIN( 111.e3_wp , e1u(ji,jj) ) / rn_osm_mle_lf2603 ! This velocity scale, defined in Fox-Kemper et al (2008), is needed for calculating dhdt.2604 zvel_mle(ji,jj) = zdbds_mle(ji,jj) * ztmp * hmle(ji,jj) * tmask(ji,jj,1)2605 zdiff_mle(ji,jj) = 5.e-4_wp * rn_osm_mle_ce * ztmp * zdbds_mle(ji,jj) * zhmle(ji,jj)**22606 ENDIF2607 END DO3042 DO ji = 2, jpim1 3043 IF ( lconv(ji,jj) ) THEN 3044 ztmp = r1_ft(ji,jj) * MIN( 111.e3_wp , e1u(ji,jj) ) / rn_osm_mle_lf 3045 ! This velocity scale, defined in Fox-Kemper et al (2008), is needed for calculating dhdt. 3046 zvel_mle(ji,jj) = zdbds_mle(ji,jj) * ztmp * hmle(ji,jj) * tmask(ji,jj,1) 3047 zdiff_mle(ji,jj) = 5.e-4_wp * rn_osm_mle_ce * ztmp * zdbds_mle(ji,jj) * zhmle(ji,jj)**2 3048 ENDIF 3049 END DO 2608 3050 END DO 2609 ! Timestep mixed layer eddy depth.3051 ! Timestep mixed layer eddy depth. 2610 3052 DO jj = 2, jpjm1 2611 DO ji = 2, jpim1 2612 IF ( lmle(ji,jj) ) THEN ! MLE layer growing. 2613 ! Buoyancy gradient at base of MLE layer. 2614 zthermal = rab_n(ji,jj,1,jp_tem) 2615 zbeta = rab_n(ji,jj,1,jp_sal) 2616 jkb = mld_prof(ji,jj) 2617 jkb1 = MIN(jkb + 1, mbkt(ji,jj)) 2618 ! 2619 zbuoy = grav * ( zthermal * tsn(ji,jj,mld_prof(ji,jj)+2,jp_tem) - zbeta * tsn(ji,jj,mld_prof(ji,jj)+2,jp_sal) ) 2620 zdb_mle = zb_bl(ji,jj) - zbuoy 2621 ! Timestep hmle. 2622 hmle(ji,jj) = hmle(ji,jj) + zwb0tot(ji,jj) * rn_rdt / zdb_mle 2623 ELSE 2624 IF ( zhmle(ji,jj) > zhbl(ji,jj) ) THEN 2625 hmle(ji,jj) = hmle(ji,jj) - ( hmle(ji,jj) - hbl(ji,jj) ) * rn_rdt / rn_osm_mle_tau 2626 ELSE 2627 hmle(ji,jj) = hmle(ji,jj) - 10.0 * ( hmle(ji,jj) - hbl(ji,jj) ) * rn_rdt /rn_osm_mle_tau 2628 ENDIF 2629 ENDIF 2630 hmle(ji,jj) = MAX(MIN(hmle(ji,jj), ht_n(ji,jj)), gdepw_n(ji,jj,4)) 2631 IF(ln_osm_hmle_limit) hmle(ji,jj) = MIN(hmle(ji,jj), rn_osm_hmle_limit*hbl(ji,jj) ) 2632 hmle(ji,jj) = zmld(ji,jj) 2633 END DO 3053 DO ji = 2, jpim1 3054 IF ( lmle(ji,jj) ) THEN ! MLE layer growing. 3055 ! Buoyancy gradient at base of MLE layer. 3056 zthermal = rab_n(ji,jj,1,jp_tem) 3057 zbeta = rab_n(ji,jj,1,jp_sal) 3058 jkb = mld_prof(ji,jj) 3059 jkb1 = MIN(jkb + 1, mbkt(ji,jj)) 3060 ! 3061 zbuoy = grav * ( zthermal * tsn(ji,jj,mld_prof(ji,jj)+2,jp_tem) - zbeta * tsn(ji,jj,mld_prof(ji,jj)+2,jp_sal) ) 3062 zdb_mle = zb_bl(ji,jj) - zbuoy 3063 ! Timestep hmle. 3064 hmle(ji,jj) = hmle(ji,jj) + zwb0tot(ji,jj) * rn_rdt / zdb_mle 3065 ELSE 3066 IF ( zhmle(ji,jj) > zhbl(ji,jj) ) THEN 3067 hmle(ji,jj) = hmle(ji,jj) - ( hmle(ji,jj) - hbl(ji,jj) ) * rn_rdt / rn_osm_mle_tau 3068 ELSE 3069 hmle(ji,jj) = hmle(ji,jj) - 10.0 * ( hmle(ji,jj) - hbl(ji,jj) ) * rn_rdt /rn_osm_mle_tau 3070 ENDIF 3071 ENDIF 3072 hmle(ji,jj) = MAX(MIN(hmle(ji,jj), ht_n(ji,jj)), gdepw_n(ji,jj,4)) 3073 IF(ln_osm_hmle_limit) hmle(ji,jj) = MIN(hmle(ji,jj), rn_osm_hmle_limit*hbl(ji,jj) ) 3074 ! For now try just set hmle to zmld 3075 hmle(ji,jj) = zmld(ji,jj) 3076 END DO 2634 3077 END DO 2635 3078 2636 3079 mld_prof = 4 2637 3080 DO jk = 5, jpkm1 2638 DO jj = 2, jpjm12639 DO ji = 2, jpim12640 IF ( hmle(ji,jj) >= gdepw_n(ji,jj,jk) ) mld_prof(ji,jj) = MIN(mbkt(ji,jj), jk)2641 END DO2642 END DO3081 DO jj = 2, jpjm1 3082 DO ji = 2, jpim1 3083 IF ( hmle(ji,jj) >= gdepw_n(ji,jj,jk) ) mld_prof(ji,jj) = MIN(mbkt(ji,jj), jk) 3084 END DO 3085 END DO 2643 3086 END DO 2644 3087 DO jj = 2, jpjm1 … … 2646 3089 zhmle(ji,jj) = gdepw_n(ji,jj, mld_prof(ji,jj)) 2647 3090 END DO 3091 END DO 3092 END SUBROUTINE zdf_osm_mle_parameters 3093 3094 END SUBROUTINE zdf_osm 3095 3096 3097 SUBROUTINE zdf_osm_init 3098 !!---------------------------------------------------------------------- 3099 !! *** ROUTINE zdf_osm_init *** 3100 !! 3101 !! ** Purpose : Initialization of the vertical eddy diffivity and 3102 !! viscosity when using a osm turbulent closure scheme 3103 !! 3104 !! ** Method : Read the namosm namelist and check the parameters 3105 !! called at the first timestep (nit000) 3106 !! 3107 !! ** input : Namlist namosm 3108 !!---------------------------------------------------------------------- 3109 INTEGER :: ios ! local integer 3110 INTEGER :: ji, jj, jk ! dummy loop indices 3111 REAL z1_t2 3112 !! 3113 #ifdef key_osm_debug 3114 NAMELIST/namzdf_osm/ ln_use_osm_la, rn_osm_la, rn_osm_dstokes, nn_ave & 3115 & ,nn_osm_wave, ln_dia_osm, rn_osm_hbl0, rn_zdfosm_adjust_sd & 3116 & ,ln_kpprimix, rn_riinfty, rn_difri, ln_convmix, rn_difconv, nn_osm_wave & 3117 & ,nn_osm_SD_reduce, ln_osm_mle, rn_osm_hblfrac, rn_osm_bl_thresh, ln_zdfosm_ice_shelter & 3118 & ,nn_idb, nn_jdb, nn_kdb, nn_narea_db 3119 #else 3120 NAMELIST/namzdf_osm/ ln_use_osm_la, rn_osm_la, rn_osm_dstokes, nn_ave & 3121 & ,nn_osm_wave, ln_dia_osm, rn_osm_hbl0, rn_zdfosm_adjust_sd & 3122 & ,ln_kpprimix, rn_riinfty, rn_difri, ln_convmix, rn_difconv, nn_osm_wave & 3123 & ,nn_osm_SD_reduce, ln_osm_mle, rn_osm_hblfrac, rn_osm_bl_thresh, ln_zdfosm_ice_shelter 3124 #endif 3125 ! Namelist for Fox-Kemper parametrization. 3126 NAMELIST/namosm_mle/ nn_osm_mle, rn_osm_mle_ce, rn_osm_mle_lf, rn_osm_mle_time, rn_osm_mle_lat,& 3127 & rn_osm_mle_rho_c, rn_osm_mle_thresh, rn_osm_mle_tau, ln_osm_hmle_limit, rn_osm_hmle_limit 3128 3129 !!---------------------------------------------------------------------- 3130 ! 3131 REWIND( numnam_ref ) ! Namelist namzdf_osm in reference namelist : Osmosis ML model 3132 READ ( numnam_ref, namzdf_osm, IOSTAT = ios, ERR = 901) 3133 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_osm in reference namelist' ) 3134 3135 REWIND( numnam_cfg ) ! Namelist namzdf_tke in configuration namelist : Turbulent Kinetic Energy 3136 READ ( numnam_cfg, namzdf_osm, IOSTAT = ios, ERR = 902 ) 3137 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namzdf_osm in configuration namelist' ) 3138 IF(lwm) WRITE ( numond, namzdf_osm ) 3139 3140 IF(lwp) THEN ! Control print 3141 WRITE(numout,*) 3142 WRITE(numout,*) 'zdf_osm_init : OSMOSIS Parameterisation' 3143 WRITE(numout,*) '~~~~~~~~~~~~' 3144 WRITE(numout,*) ' Namelist namzdf_osm : set osm mixing parameters' 3145 WRITE(numout,*) ' Use rn_osm_la ln_use_osm_la = ', ln_use_osm_la 3146 WRITE(numout,*) ' Use MLE in OBL, i.e. Fox-Kemper param ln_osm_mle = ', ln_osm_mle 3147 WRITE(numout,*) ' Turbulent Langmuir number rn_osm_la = ', rn_osm_la 3148 WRITE(numout,*) ' Stokes drift reduction factor rn_zdfosm_adjust_sd = ', rn_zdfosm_adjust_sd 3149 WRITE(numout,*) ' Initial hbl for 1D runs rn_osm_hbl0 = ', rn_osm_hbl0 3150 WRITE(numout,*) ' Depth scale of Stokes drift rn_osm_dstokes = ', rn_osm_dstokes 3151 WRITE(numout,*) ' horizontal average flag nn_ave = ', nn_ave 3152 WRITE(numout,*) ' Stokes drift nn_osm_wave = ', nn_osm_wave 3153 SELECT CASE (nn_osm_wave) 3154 CASE(0) 3155 WRITE(numout,*) ' calculated assuming constant La#=0.3' 3156 CASE(1) 3157 WRITE(numout,*) ' calculated from Pierson Moskowitz wind-waves' 3158 CASE(2) 3159 WRITE(numout,*) ' calculated from ECMWF wave fields' 3160 END SELECT 3161 WRITE(numout,*) ' Stokes drift reduction nn_osm_SD_reduce', nn_osm_SD_reduce 3162 WRITE(numout,*) ' fraction of hbl to average SD over/fit' 3163 WRITE(numout,*) ' exponential with nn_osm_SD_reduce = 1 or 2 rn_osm_hblfrac = ', rn_osm_hblfrac 3164 SELECT CASE (nn_osm_SD_reduce) 3165 CASE(0) 3166 WRITE(numout,*) ' No reduction' 3167 CASE(1) 3168 WRITE(numout,*) ' Average SD over upper rn_osm_hblfrac of BL' 3169 CASE(2) 3170 WRITE(numout,*) ' Fit exponential to slope rn_osm_hblfrac of BL' 3171 END SELECT 3172 WRITE(numout,*) ' reduce surface SD and depth scale under ice ln_zdfosm_ice_shelter=', ln_zdfosm_ice_shelter 3173 WRITE(numout,*) ' Output osm diagnostics ln_dia_osm = ', ln_dia_osm 3174 WRITE(numout,*) ' Threshold used to define BL rn_osm_bl_thresh = ', rn_osm_bl_thresh, 'm^2/s' 3175 WRITE(numout,*) ' Use KPP-style shear instability mixing ln_kpprimix = ', ln_kpprimix 3176 WRITE(numout,*) ' local Richardson Number limit for shear instability rn_riinfty = ', rn_riinfty 3177 WRITE(numout,*) ' maximum shear diffusivity at Rig = 0 (m2/s) rn_difri = ', rn_difri 3178 WRITE(numout,*) ' Use large mixing below BL when unstable ln_convmix = ', ln_convmix 3179 WRITE(numout,*) ' diffusivity when unstable below BL (m2/s) rn_difconv = ', rn_difconv 3180 #ifdef key_osm_debug 3181 WRITE(numout,*) 'nn_idb', nn_idb, 'nn_jdb', nn_jdb, 'nn_kdb', nn_kdb, 'nn_narea_db', nn_narea_db 3182 3183 iloc_db = mi0(nn_idb) 3184 jloc_db = mj0(nn_jdb) 3185 WRITE(numout,*) 'iloc_db ', iloc_db , 'jloc_db', jloc_db 3186 #endif 3187 ENDIF 3188 3189 3190 ! ! Check wave coupling settings ! 3191 ! ! Further work needed - see ticket #2447 ! 3192 IF( nn_osm_wave == 2 ) THEN 3193 IF (.NOT. ( ln_wave .AND. ln_sdw )) & 3194 & CALL ctl_stop( 'zdf_osm_init : ln_zdfosm and nn_osm_wave=2, ln_wave and ln_sdw must be true' ) 3195 END IF 3196 3197 ! ! allocate zdfosm arrays 3198 IF( zdf_osm_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'zdf_osm_init : unable to allocate arrays' ) 3199 3200 3201 IF( ln_osm_mle ) THEN 3202 ! Initialise Fox-Kemper parametrization 3203 REWIND( numnam_ref ) ! Namelist namosm_mle in reference namelist : Tracer advection scheme 3204 READ ( numnam_ref, namosm_mle, IOSTAT = ios, ERR = 903) 3205 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namosm_mle in reference namelist') 3206 3207 REWIND( numnam_cfg ) ! Namelist namosm_mle in configuration namelist : Tracer advection scheme 3208 READ ( numnam_cfg, namosm_mle, IOSTAT = ios, ERR = 904 ) 3209 904 IF( ios > 0 ) CALL ctl_nam ( ios , 'namosm_mle in configuration namelist') 3210 IF(lwm) WRITE ( numond, namosm_mle ) 3211 3212 IF(lwp) THEN ! Namelist print 3213 WRITE(numout,*) 3214 WRITE(numout,*) 'zdf_osm_init : initialise mixed layer eddy (MLE)' 3215 WRITE(numout,*) '~~~~~~~~~~~~~' 3216 WRITE(numout,*) ' Namelist namosm_mle : ' 3217 WRITE(numout,*) ' MLE type: =0 standard Fox-Kemper ; =1 new formulation nn_osm_mle = ', nn_osm_mle 3218 WRITE(numout,*) ' magnitude of the MLE (typical value: 0.06 to 0.08) rn_osm_mle_ce = ', rn_osm_mle_ce 3219 WRITE(numout,*) ' scale of ML front (ML radius of deformation) (nn_osm_mle=0) rn_osm_mle_lf = ', rn_osm_mle_lf, 'm' 3220 WRITE(numout,*) ' maximum time scale of MLE (nn_osm_mle=0) rn_osm_mle_time = ', rn_osm_mle_time, 's' 3221 WRITE(numout,*) ' reference latitude (degrees) of MLE coef. (nn_osm_mle=1) rn_osm_mle_lat = ', rn_osm_mle_lat, 'deg' 3222 WRITE(numout,*) ' Density difference used to define ML for FK rn_osm_mle_rho_c = ', rn_osm_mle_rho_c 3223 WRITE(numout,*) ' Threshold used to define MLE for FK rn_osm_mle_thresh = ', rn_osm_mle_thresh, 'm^2/s' 3224 WRITE(numout,*) ' Timescale for OSM-FK rn_osm_mle_tau = ', rn_osm_mle_tau, 's' 3225 WRITE(numout,*) ' switch to limit hmle ln_osm_hmle_limit = ', ln_osm_hmle_limit 3226 WRITE(numout,*) ' fraction of zmld to limit hmle to if ln_osm_hmle_limit =.T. rn_osm_hmle_limit = ', rn_osm_hmle_limit 3227 ENDIF ! 3228 ENDIF 3229 ! 3230 IF(lwp) THEN 3231 WRITE(numout,*) 3232 IF( ln_osm_mle ) THEN 3233 WRITE(numout,*) ' ==>>> Mixed Layer Eddy induced transport added to OSMOSIS BL calculation' 3234 IF( nn_osm_mle == 0 ) WRITE(numout,*) ' Fox-Kemper et al 2010 formulation' 3235 IF( nn_osm_mle == 1 ) WRITE(numout,*) ' New formulation' 3236 ELSE 3237 WRITE(numout,*) ' ==>>> Mixed Layer induced transport NOT added to OSMOSIS BL calculation' 3238 ENDIF 3239 ENDIF 3240 ! 3241 IF( ln_osm_mle ) THEN ! MLE initialisation 3242 ! 3243 rb_c = grav * rn_osm_mle_rho_c /rau0 ! Mixed Layer buoyancy criteria 3244 IF(lwp) WRITE(numout,*) 3245 IF(lwp) WRITE(numout,*) ' ML buoyancy criteria = ', rb_c, ' m/s2 ' 3246 IF(lwp) WRITE(numout,*) ' associated ML density criteria defined in zdfmxl = ', rn_osm_mle_rho_c, 'kg/m3' 3247 ! 3248 IF( nn_osm_mle == 0 ) THEN ! MLE array allocation & initialisation ! 3249 ! 3250 ELSEIF( nn_osm_mle == 1 ) THEN ! MLE array allocation & initialisation 3251 rc_f = rn_osm_mle_ce/ ( 5.e3_wp * 2._wp * omega * SIN( rad * rn_osm_mle_lat ) ) 3252 ! 3253 ENDIF 3254 ! ! 1/(f^2+tau^2)^1/2 at t-point (needed in both nn_osm_mle case) 3255 z1_t2 = 2.e-5 3256 do jj=1,jpj 3257 do ji = 1,jpi 3258 r1_ft(ji,jj) = MIN(1./( ABS(ff_t(ji,jj)) + epsln ), ABS(ff_t(ji,jj))/z1_t2**2) 3259 end do 3260 end do 3261 ! z1_t2 = 1._wp / ( rn_osm_mle_time * rn_osm_mle_timeji,jj ) 3262 ! r1_ft(:,:) = 1._wp / SQRT( ff_t(:,:) * ff_t(:,:) + z1_t2 ) 3263 ! 3264 ENDIF 3265 3266 call osm_rst( nit000, 'READ' ) !* read or initialize hbl, dh, hmle 3267 3268 3269 IF( ln_zdfddm) THEN 3270 IF(lwp) THEN 3271 WRITE(numout,*) 3272 WRITE(numout,*) ' Double diffusion mixing on temperature and salinity ' 3273 WRITE(numout,*) ' CAUTION : done in routine zdfosm, not in routine zdfddm ' 3274 ENDIF 3275 ENDIF 3276 3277 3278 !set constants not in namelist 3279 !----------------------------- 3280 3281 IF(lwp) THEN 3282 WRITE(numout,*) 3283 ENDIF 3284 3285 IF (nn_osm_wave == 0) THEN 3286 dstokes(:,:) = rn_osm_dstokes 3287 END IF 3288 3289 ! Horizontal average : initialization of weighting arrays 3290 ! ------------------- 3291 3292 SELECT CASE ( nn_ave ) 3293 3294 CASE ( 0 ) ! no horizontal average 3295 IF(lwp) WRITE(numout,*) ' no horizontal average on avt' 3296 IF(lwp) WRITE(numout,*) ' only in very high horizontal resolution !' 3297 ! weighting mean arrays etmean 3298 ! ( 1 1 ) 3299 ! avt = 1/4 ( 1 1 ) 3300 ! 3301 etmean(:,:,:) = 0.e0 3302 3303 DO jk = 1, jpkm1 3304 DO jj = 2, jpjm1 3305 DO ji = 2, jpim1 ! vector opt. 3306 etmean(ji,jj,jk) = tmask(ji,jj,jk) & 3307 & / MAX( 1., umask(ji-1,jj ,jk) + umask(ji,jj,jk) & 3308 & + vmask(ji ,jj-1,jk) + vmask(ji,jj,jk) ) 3309 END DO 3310 END DO 2648 3311 END DO 2649 END SUBROUTINE zdf_osm_mle_parameters 2650 2651 END SUBROUTINE zdf_osm 2652 2653 2654 SUBROUTINE zdf_osm_init 2655 !!---------------------------------------------------------------------- 2656 !! *** ROUTINE zdf_osm_init *** 2657 !! 2658 !! ** Purpose : Initialization of the vertical eddy diffivity and 2659 !! viscosity when using a osm turbulent closure scheme 2660 !! 2661 !! ** Method : Read the namosm namelist and check the parameters 2662 !! called at the first timestep (nit000) 2663 !! 2664 !! ** input : Namlist namosm 2665 !!---------------------------------------------------------------------- 2666 INTEGER :: ios ! local integer 2667 INTEGER :: ji, jj, jk ! dummy loop indices 2668 REAL z1_t2 2669 !! 2670 NAMELIST/namzdf_osm/ ln_use_osm_la, rn_osm_la, rn_osm_dstokes, nn_ave & 2671 & ,nn_osm_wave, ln_dia_osm, rn_osm_hbl0, rn_zdfosm_adjust_sd & 2672 & ,ln_kpprimix, rn_riinfty, rn_difri, ln_convmix, rn_difconv, nn_osm_wave & 2673 & ,nn_osm_SD_reduce, ln_osm_mle, rn_osm_hblfrac, rn_osm_bl_thresh, ln_zdfosm_ice_shelter 2674 ! Namelist for Fox-Kemper parametrization. 2675 NAMELIST/namosm_mle/ nn_osm_mle, rn_osm_mle_ce, rn_osm_mle_lf, rn_osm_mle_time, rn_osm_mle_lat,& 2676 & rn_osm_mle_rho_c, rn_osm_mle_thresh, rn_osm_mle_tau, ln_osm_hmle_limit, rn_osm_hmle_limit 2677 2678 !!---------------------------------------------------------------------- 2679 ! 2680 REWIND( numnam_ref ) ! Namelist namzdf_osm in reference namelist : Osmosis ML model 2681 READ ( numnam_ref, namzdf_osm, IOSTAT = ios, ERR = 901) 2682 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namzdf_osm in reference namelist' ) 2683 2684 REWIND( numnam_cfg ) ! Namelist namzdf_tke in configuration namelist : Turbulent Kinetic Energy 2685 READ ( numnam_cfg, namzdf_osm, IOSTAT = ios, ERR = 902 ) 2686 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namzdf_osm in configuration namelist' ) 2687 IF(lwm) WRITE ( numond, namzdf_osm ) 2688 2689 IF(lwp) THEN ! Control print 2690 WRITE(numout,*) 2691 WRITE(numout,*) 'zdf_osm_init : OSMOSIS Parameterisation' 2692 WRITE(numout,*) '~~~~~~~~~~~~' 2693 WRITE(numout,*) ' Namelist namzdf_osm : set osm mixing parameters' 2694 WRITE(numout,*) ' Use rn_osm_la ln_use_osm_la = ', ln_use_osm_la 2695 WRITE(numout,*) ' Use MLE in OBL, i.e. Fox-Kemper param ln_osm_mle = ', ln_osm_mle 2696 WRITE(numout,*) ' Turbulent Langmuir number rn_osm_la = ', rn_osm_la 2697 WRITE(numout,*) ' Stokes drift reduction factor rn_zdfosm_adjust_sd = ', rn_zdfosm_adjust_sd 2698 WRITE(numout,*) ' Initial hbl for 1D runs rn_osm_hbl0 = ', rn_osm_hbl0 2699 WRITE(numout,*) ' Depth scale of Stokes drift rn_osm_dstokes = ', rn_osm_dstokes 2700 WRITE(numout,*) ' horizontal average flag nn_ave = ', nn_ave 2701 WRITE(numout,*) ' Stokes drift nn_osm_wave = ', nn_osm_wave 2702 SELECT CASE (nn_osm_wave) 2703 CASE(0) 2704 WRITE(numout,*) ' calculated assuming constant La#=0.3' 2705 CASE(1) 2706 WRITE(numout,*) ' calculated from Pierson Moskowitz wind-waves' 2707 CASE(2) 2708 WRITE(numout,*) ' calculated from ECMWF wave fields' 2709 END SELECT 2710 WRITE(numout,*) ' Stokes drift reduction nn_osm_SD_reduce', nn_osm_SD_reduce 2711 WRITE(numout,*) ' fraction of hbl to average SD over/fit' 2712 WRITE(numout,*) ' exponential with nn_osm_SD_reduce = 1 or 2 rn_osm_hblfrac = ', rn_osm_hblfrac 2713 SELECT CASE (nn_osm_SD_reduce) 2714 CASE(0) 2715 WRITE(numout,*) ' No reduction' 2716 CASE(1) 2717 WRITE(numout,*) ' Average SD over upper rn_osm_hblfrac of BL' 2718 CASE(2) 2719 WRITE(numout,*) ' Fit exponential to slope rn_osm_hblfrac of BL' 2720 END SELECT 2721 WRITE(numout,*) ' reduce surface SD and depth scale under ice ln_zdfosm_ice_shelter=', ln_zdfosm_ice_shelter 2722 WRITE(numout,*) ' Output osm diagnostics ln_dia_osm = ', ln_dia_osm 2723 WRITE(numout,*) ' Threshold used to define BL rn_osm_bl_thresh = ', rn_osm_bl_thresh, 'm^2/s' 2724 WRITE(numout,*) ' Use KPP-style shear instability mixing ln_kpprimix = ', ln_kpprimix 2725 WRITE(numout,*) ' local Richardson Number limit for shear instability rn_riinfty = ', rn_riinfty 2726 WRITE(numout,*) ' maximum shear diffusivity at Rig = 0 (m2/s) rn_difri = ', rn_difri 2727 WRITE(numout,*) ' Use large mixing below BL when unstable ln_convmix = ', ln_convmix 2728 WRITE(numout,*) ' diffusivity when unstable below BL (m2/s) rn_difconv = ', rn_difconv 2729 ENDIF 2730 2731 2732 ! ! Check wave coupling settings ! 2733 ! ! Further work needed - see ticket #2447 ! 2734 IF( nn_osm_wave == 2 ) THEN 2735 IF (.NOT. ( ln_wave .AND. ln_sdw )) & 2736 & CALL ctl_stop( 'zdf_osm_init : ln_zdfosm and nn_osm_wave=2, ln_wave and ln_sdw must be true' ) 2737 END IF 2738 2739 ! ! allocate zdfosm arrays 2740 IF( zdf_osm_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'zdf_osm_init : unable to allocate arrays' ) 2741 2742 2743 IF( ln_osm_mle ) THEN 2744 ! Initialise Fox-Kemper parametrization 2745 REWIND( numnam_ref ) ! Namelist namosm_mle in reference namelist : Tracer advection scheme 2746 READ ( numnam_ref, namosm_mle, IOSTAT = ios, ERR = 903) 2747 903 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namosm_mle in reference namelist') 2748 2749 REWIND( numnam_cfg ) ! Namelist namosm_mle in configuration namelist : Tracer advection scheme 2750 READ ( numnam_cfg, namosm_mle, IOSTAT = ios, ERR = 904 ) 2751 904 IF( ios > 0 ) CALL ctl_nam ( ios , 'namosm_mle in configuration namelist') 2752 IF(lwm) WRITE ( numond, namosm_mle ) 2753 2754 IF(lwp) THEN ! Namelist print 2755 WRITE(numout,*) 2756 WRITE(numout,*) 'zdf_osm_init : initialise mixed layer eddy (MLE)' 2757 WRITE(numout,*) '~~~~~~~~~~~~~' 2758 WRITE(numout,*) ' Namelist namosm_mle : ' 2759 WRITE(numout,*) ' MLE type: =0 standard Fox-Kemper ; =1 new formulation nn_osm_mle = ', nn_osm_mle 2760 WRITE(numout,*) ' magnitude of the MLE (typical value: 0.06 to 0.08) rn_osm_mle_ce = ', rn_osm_mle_ce 2761 WRITE(numout,*) ' scale of ML front (ML radius of deformation) (nn_osm_mle=0) rn_osm_mle_lf = ', rn_osm_mle_lf, 'm' 2762 WRITE(numout,*) ' maximum time scale of MLE (nn_osm_mle=0) rn_osm_mle_time = ', rn_osm_mle_time, 's' 2763 WRITE(numout,*) ' reference latitude (degrees) of MLE coef. (nn_osm_mle=1) rn_osm_mle_lat = ', rn_osm_mle_lat, 'deg' 2764 WRITE(numout,*) ' Density difference used to define ML for FK rn_osm_mle_rho_c = ', rn_osm_mle_rho_c 2765 WRITE(numout,*) ' Threshold used to define MLE for FK rn_osm_mle_thresh = ', rn_osm_mle_thresh, 'm^2/s' 2766 WRITE(numout,*) ' Timescale for OSM-FK rn_osm_mle_tau = ', rn_osm_mle_tau, 's' 2767 WRITE(numout,*) ' switch to limit hmle ln_osm_hmle_limit = ', ln_osm_hmle_limit 2768 WRITE(numout,*) ' fraction of zmld to limit hmle to if ln_osm_hmle_limit =.T. rn_osm_hmle_limit = ', rn_osm_hmle_limit 2769 ENDIF ! 2770 ENDIF 2771 ! 2772 IF(lwp) THEN 2773 WRITE(numout,*) 2774 IF( ln_osm_mle ) THEN 2775 WRITE(numout,*) ' ==>>> Mixed Layer Eddy induced transport added to OSMOSIS BL calculation' 2776 IF( nn_osm_mle == 0 ) WRITE(numout,*) ' Fox-Kemper et al 2010 formulation' 2777 IF( nn_osm_mle == 1 ) WRITE(numout,*) ' New formulation' 2778 ELSE 2779 WRITE(numout,*) ' ==>>> Mixed Layer induced transport NOT added to OSMOSIS BL calculation' 2780 ENDIF 2781 ENDIF 2782 ! 2783 IF( ln_osm_mle ) THEN ! MLE initialisation 2784 ! 2785 rb_c = grav * rn_osm_mle_rho_c /rau0 ! Mixed Layer buoyancy criteria 2786 IF(lwp) WRITE(numout,*) 2787 IF(lwp) WRITE(numout,*) ' ML buoyancy criteria = ', rb_c, ' m/s2 ' 2788 IF(lwp) WRITE(numout,*) ' associated ML density criteria defined in zdfmxl = ', rn_osm_mle_rho_c, 'kg/m3' 2789 ! 2790 IF( nn_osm_mle == 0 ) THEN ! MLE array allocation & initialisation ! 2791 ! 2792 ELSEIF( nn_osm_mle == 1 ) THEN ! MLE array allocation & initialisation 2793 rc_f = rn_osm_mle_ce/ ( 5.e3_wp * 2._wp * omega * SIN( rad * rn_osm_mle_lat ) ) 2794 ! 2795 ENDIF 2796 ! ! 1/(f^2+tau^2)^1/2 at t-point (needed in both nn_osm_mle case) 2797 z1_t2 = 2.e-5 2798 do jj=1,jpj 2799 do ji = 1,jpi 2800 r1_ft(ji,jj) = MIN(1./( ABS(ff_t(ji,jj)) + epsln ), ABS(ff_t(ji,jj))/z1_t2**2) 2801 end do 2802 end do 2803 ! z1_t2 = 1._wp / ( rn_osm_mle_time * rn_osm_mle_timeji,jj ) 2804 ! r1_ft(:,:) = 1._wp / SQRT( ff_t(:,:) * ff_t(:,:) + z1_t2 ) 2805 ! 2806 ENDIF 2807 2808 call osm_rst( nit000, 'READ' ) !* read or initialize hbl, dh, hmle 2809 2810 2811 IF( ln_zdfddm) THEN 2812 IF(lwp) THEN 2813 WRITE(numout,*) 2814 WRITE(numout,*) ' Double diffusion mixing on temperature and salinity ' 2815 WRITE(numout,*) ' CAUTION : done in routine zdfosm, not in routine zdfddm ' 2816 ENDIF 2817 ENDIF 2818 2819 2820 !set constants not in namelist 2821 !----------------------------- 2822 2823 IF(lwp) THEN 2824 WRITE(numout,*) 2825 ENDIF 2826 2827 IF (nn_osm_wave == 0) THEN 2828 dstokes(:,:) = rn_osm_dstokes 2829 END IF 2830 2831 ! Horizontal average : initialization of weighting arrays 2832 ! ------------------- 2833 2834 SELECT CASE ( nn_ave ) 2835 2836 CASE ( 0 ) ! no horizontal average 2837 IF(lwp) WRITE(numout,*) ' no horizontal average on avt' 2838 IF(lwp) WRITE(numout,*) ' only in very high horizontal resolution !' 2839 ! weighting mean arrays etmean 2840 ! ( 1 1 ) 2841 ! avt = 1/4 ( 1 1 ) 2842 ! 2843 etmean(:,:,:) = 0.e0 2844 2845 DO jk = 1, jpkm1 2846 DO jj = 2, jpjm1 2847 DO ji = 2, jpim1 ! vector opt. 2848 etmean(ji,jj,jk) = tmask(ji,jj,jk) & 2849 & / MAX( 1., umask(ji-1,jj ,jk) + umask(ji,jj,jk) & 2850 & + vmask(ji ,jj-1,jk) + vmask(ji,jj,jk) ) 2851 END DO 2852 END DO 2853 END DO 2854 2855 CASE ( 1 ) ! horizontal average 2856 IF(lwp) WRITE(numout,*) ' horizontal average on avt' 2857 ! weighting mean arrays etmean 2858 ! ( 1/2 1 1/2 ) 2859 ! avt = 1/8 ( 1 2 1 ) 2860 ! ( 1/2 1 1/2 ) 2861 etmean(:,:,:) = 0.e0 2862 2863 DO jk = 1, jpkm1 2864 DO jj = 2, jpjm1 2865 DO ji = 2, jpim1 ! vector opt. 2866 etmean(ji,jj,jk) = tmask(ji, jj,jk) & 2867 & / MAX( 1., 2.* tmask(ji,jj,jk) & 2868 & +.5 * ( tmask(ji-1,jj+1,jk) + tmask(ji-1,jj-1,jk) & 2869 & +tmask(ji+1,jj+1,jk) + tmask(ji+1,jj-1,jk) ) & 2870 & +1. * ( tmask(ji-1,jj ,jk) + tmask(ji ,jj+1,jk) & 2871 & +tmask(ji ,jj-1,jk) + tmask(ji+1,jj ,jk) ) ) 2872 END DO 2873 END DO 2874 END DO 2875 2876 CASE DEFAULT 2877 WRITE(ctmp1,*) ' bad flag value for nn_ave = ', nn_ave 2878 CALL ctl_stop( ctmp1 ) 2879 2880 END SELECT 2881 2882 ! Initialization of vertical eddy coef. to the background value 2883 ! ------------------------------------------------------------- 2884 DO jk = 1, jpk 2885 avt (:,:,jk) = avtb(jk) * tmask(:,:,jk) 2886 END DO 2887 2888 ! zero the surface flux for non local term and osm mixed layer depth 2889 ! ------------------------------------------------------------------ 2890 ghamt(:,:,:) = 0. 2891 ghams(:,:,:) = 0. 2892 ghamu(:,:,:) = 0. 2893 ghamv(:,:,:) = 0. 2894 ! 2895 IF( lwxios ) THEN 2896 CALL iom_set_rstw_var_active('wn') 2897 CALL iom_set_rstw_var_active('hbl') 2898 CALL iom_set_rstw_var_active('dh') 2899 IF( ln_osm_mle ) THEN 2900 CALL iom_set_rstw_var_active('hmle') 2901 END IF 2902 ENDIF 2903 END SUBROUTINE zdf_osm_init 2904 2905 2906 SUBROUTINE osm_rst( kt, cdrw ) 2907 !!--------------------------------------------------------------------- 2908 !! *** ROUTINE osm_rst *** 2909 !! 2910 !! ** Purpose : Read or write BL fields in restart file 2911 !! 2912 !! ** Method : use of IOM library. If the restart does not contain 2913 !! required fields, they are recomputed from stratification 2914 !!---------------------------------------------------------------------- 2915 2916 INTEGER, INTENT(in) :: kt 2917 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag 2918 2919 INTEGER :: id1, id2, id3 ! iom enquiry index 2920 INTEGER :: ji, jj, jk ! dummy loop indices 2921 INTEGER :: iiki, ikt ! local integer 2922 REAL(wp) :: zhbf ! tempory scalars 2923 REAL(wp) :: zN2_c ! local scalar 2924 REAL(wp) :: rho_c = 0.01_wp !: density criterion for mixed layer depth 2925 INTEGER, DIMENSION(jpi,jpj) :: imld_rst ! level of mixed-layer depth (pycnocline top) 2926 !!---------------------------------------------------------------------- 2927 ! 2928 !!----------------------------------------------------------------------------- 2929 ! If READ/WRITE Flag is 'READ', try to get hbl from restart file. If successful then return 2930 !!----------------------------------------------------------------------------- 2931 IF( TRIM(cdrw) == 'READ'.AND. ln_rstart) THEN 2932 id1 = iom_varid( numror, 'wn' , ldstop = .FALSE. ) 2933 IF( id1 > 0 ) THEN ! 'wn' exists; read 2934 CALL iom_get( numror, jpdom_autoglo, 'wn', wn, ldxios = lrxios ) 2935 WRITE(numout,*) ' ===>>>> : wn read from restart file' 2936 ELSE 2937 wn(:,:,:) = 0._wp 2938 WRITE(numout,*) ' ===>>>> : wn not in restart file, set to zero initially' 2939 END IF 2940 2941 id1 = iom_varid( numror, 'hbl' , ldstop = .FALSE. ) 2942 id2 = iom_varid( numror, 'dh' , ldstop = .FALSE. ) 2943 IF( id1 > 0 .AND. id2 > 0) THEN ! 'hbl' exists; read and return 2944 CALL iom_get( numror, jpdom_autoglo, 'hbl' , hbl , ldxios = lrxios ) 2945 CALL iom_get( numror, jpdom_autoglo, 'dh', dh, ldxios = lrxios ) 2946 WRITE(numout,*) ' ===>>>> : hbl & dh read from restart file' 2947 IF( ln_osm_mle ) THEN 2948 id3 = iom_varid( numror, 'hmle' , ldstop = .FALSE. ) 2949 IF( id3 > 0) THEN 2950 CALL iom_get( numror, jpdom_autoglo, 'hmle' , hmle , ldxios = lrxios ) 2951 WRITE(numout,*) ' ===>>>> : hmle read from restart file' 2952 ELSE 2953 WRITE(numout,*) ' ===>>>> : hmle not found, set to hbl' 2954 hmle(:,:) = hbl(:,:) ! Initialise MLE depth. 2955 END IF 2956 END IF 2957 RETURN 2958 ELSE ! 'hbl' & 'dh' not in restart file, recalculate 2959 WRITE(numout,*) ' ===>>>> : previous run without osmosis scheme, hbl computed from stratification' 2960 END IF 2961 END IF 2962 2963 !!----------------------------------------------------------------------------- 2964 ! If READ/WRITE Flag is 'WRITE', write hbl into the restart file, then return 2965 !!----------------------------------------------------------------------------- 2966 IF( TRIM(cdrw) == 'WRITE') THEN !* Write hbli into the restart file, then return 2967 IF(lwp) WRITE(numout,*) '---- osm-rst ----' 2968 CALL iom_rstput( kt, nitrst, numrow, 'wn' , wn, ldxios = lwxios ) 2969 CALL iom_rstput( kt, nitrst, numrow, 'hbl' , hbl, ldxios = lwxios ) 2970 CALL iom_rstput( kt, nitrst, numrow, 'dh' , dh, ldxios = lwxios ) 2971 IF( ln_osm_mle ) THEN 2972 CALL iom_rstput( kt, nitrst, numrow, 'hmle', hmle, ldxios = lwxios ) 2973 END IF 2974 RETURN 2975 END IF 2976 2977 !!----------------------------------------------------------------------------- 2978 ! Getting hbl, no restart file with hbl, so calculate from surface stratification 2979 !!----------------------------------------------------------------------------- 2980 IF( lwp ) WRITE(numout,*) ' ===>>>> : calculating hbl computed from stratification' 2981 ! w-level of the mixing and mixed layers 2982 CALL eos_rab( tsn, rab_n ) 2983 CALL bn2(tsn, rab_n, rn2) 2984 imld_rst(:,:) = nlb10 ! Initialization to the number of w ocean point 2985 hbl(:,:) = 0._wp ! here hbl used as a dummy variable, integrating vertically N^2 2986 zN2_c = grav * rho_c * r1_rau0 ! convert density criteria into N^2 criteria 2987 ! 2988 hbl(:,:) = 0._wp ! here hbl used as a dummy variable, integrating vertically N^2 2989 DO jk = 1, jpkm1 2990 DO jj = 1, jpj ! Mixed layer level: w-level 2991 DO ji = 1, jpi 2992 ikt = mbkt(ji,jj) 2993 hbl(ji,jj) = hbl(ji,jj) + MAX( rn2(ji,jj,jk) , 0._wp ) * e3w_n(ji,jj,jk) 2994 IF( hbl(ji,jj) < zN2_c ) imld_rst(ji,jj) = MIN( jk , ikt ) + 1 ! Mixed layer level 2995 END DO 2996 END DO 2997 END DO 2998 ! 2999 DO jj = 1, jpj 3000 DO ji = 1, jpi 3001 iiki = MAX(4,imld_rst(ji,jj)) 3002 hbl (ji,jj) = gdepw_n(ji,jj,iiki ) ! Turbocline depth 3003 dh (ji,jj) = e3t_n(ji,jj,iiki-1 ) ! Turbocline depth 3004 END DO 3005 END DO 3006 3007 WRITE(numout,*) ' ===>>>> : hbl computed from stratification' 3008 3009 IF( ln_osm_mle ) THEN 3010 hmle(:,:) = hbl(:,:) ! Initialise MLE depth. 3011 WRITE(numout,*) ' ===>>>> : hmle set = to hbl' 3012 END IF 3013 3014 wn(:,:,:) = 0._wp 3015 WRITE(numout,*) ' ===>>>> : wn not in restart file, set to zero initially' 3016 END SUBROUTINE osm_rst 3017 3018 3019 SUBROUTINE tra_osm( kt ) 3020 !!---------------------------------------------------------------------- 3021 !! *** ROUTINE tra_osm *** 3022 !! 3023 !! ** Purpose : compute and add to the tracer trend the non-local tracer flux 3024 !! 3025 !! ** Method : ??? 3026 !!---------------------------------------------------------------------- 3027 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdt, ztrds ! 3D workspace 3028 !!---------------------------------------------------------------------- 3029 INTEGER, INTENT(in) :: kt 3030 INTEGER :: ji, jj, jk 3031 ! 3032 IF( kt == nit000 ) THEN 3033 IF(lwp) WRITE(numout,*) 3034 IF(lwp) WRITE(numout,*) 'tra_osm : OSM non-local tracer fluxes' 3035 IF(lwp) WRITE(numout,*) '~~~~~~~ ' 3036 ENDIF 3037 3038 IF( l_trdtra ) THEN !* Save ta and sa trends 3039 ALLOCATE( ztrdt(jpi,jpj,jpk) ) ; ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 3040 ALLOCATE( ztrds(jpi,jpj,jpk) ) ; ztrds(:,:,:) = tsa(:,:,:,jp_sal) 3041 ENDIF 3042 3043 DO jk = 1, jpkm1 3044 DO jj = 2, jpjm1 3045 DO ji = 2, jpim1 3046 tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) & 3312 3313 CASE ( 1 ) ! horizontal average 3314 IF(lwp) WRITE(numout,*) ' horizontal average on avt' 3315 ! weighting mean arrays etmean 3316 ! ( 1/2 1 1/2 ) 3317 ! avt = 1/8 ( 1 2 1 ) 3318 ! ( 1/2 1 1/2 ) 3319 etmean(:,:,:) = 0.e0 3320 3321 DO jk = 1, jpkm1 3322 DO jj = 2, jpjm1 3323 DO ji = 2, jpim1 ! vector opt. 3324 etmean(ji,jj,jk) = tmask(ji, jj,jk) & 3325 & / MAX( 1., 2.* tmask(ji,jj,jk) & 3326 & +.5 * ( tmask(ji-1,jj+1,jk) + tmask(ji-1,jj-1,jk) & 3327 & +tmask(ji+1,jj+1,jk) + tmask(ji+1,jj-1,jk) ) & 3328 & +1. * ( tmask(ji-1,jj ,jk) + tmask(ji ,jj+1,jk) & 3329 & +tmask(ji ,jj-1,jk) + tmask(ji+1,jj ,jk) ) ) 3330 END DO 3331 END DO 3332 END DO 3333 3334 CASE DEFAULT 3335 WRITE(ctmp1,*) ' bad flag value for nn_ave = ', nn_ave 3336 CALL ctl_stop( ctmp1 ) 3337 3338 END SELECT 3339 3340 ! Initialization of vertical eddy coef. to the background value 3341 ! ------------------------------------------------------------- 3342 DO jk = 1, jpk 3343 avt (:,:,jk) = avtb(jk) * tmask(:,:,jk) 3344 END DO 3345 3346 ! zero the surface flux for non local term and osm mixed layer depth 3347 ! ------------------------------------------------------------------ 3348 ghamt(:,:,:) = 0. 3349 ghams(:,:,:) = 0. 3350 ghamu(:,:,:) = 0. 3351 ghamv(:,:,:) = 0. 3352 ! 3353 IF( lwxios ) THEN 3354 CALL iom_set_rstw_var_active('wn') 3355 CALL iom_set_rstw_var_active('hbl') 3356 CALL iom_set_rstw_var_active('dh') 3357 IF( ln_osm_mle ) THEN 3358 CALL iom_set_rstw_var_active('hmle') 3359 END IF 3360 ENDIF 3361 END SUBROUTINE zdf_osm_init 3362 3363 3364 SUBROUTINE osm_rst( kt, cdrw ) 3365 !!--------------------------------------------------------------------- 3366 !! *** ROUTINE osm_rst *** 3367 !! 3368 !! ** Purpose : Read or write BL fields in restart file 3369 !! 3370 !! ** Method : use of IOM library. If the restart does not contain 3371 !! required fields, they are recomputed from stratification 3372 !!---------------------------------------------------------------------- 3373 3374 INTEGER, INTENT(in) :: kt 3375 CHARACTER(len=*), INTENT(in) :: cdrw ! "READ"/"WRITE" flag 3376 3377 INTEGER :: id1, id2, id3 ! iom enquiry index 3378 INTEGER :: ji, jj, jk ! dummy loop indices 3379 INTEGER :: iiki, ikt ! local integer 3380 REAL(wp) :: zhbf ! tempory scalars 3381 REAL(wp) :: zN2_c ! local scalar 3382 REAL(wp) :: rho_c = 0.01_wp !: density criterion for mixed layer depth 3383 INTEGER, DIMENSION(jpi,jpj) :: imld_rst ! level of mixed-layer depth (pycnocline top) 3384 !!---------------------------------------------------------------------- 3385 ! 3386 !!----------------------------------------------------------------------------- 3387 ! If READ/WRITE Flag is 'READ', try to get hbl from restart file. If successful then return 3388 !!----------------------------------------------------------------------------- 3389 IF( TRIM(cdrw) == 'READ'.AND. ln_rstart) THEN 3390 id1 = iom_varid( numror, 'wn' , ldstop = .FALSE. ) 3391 IF( id1 > 0 ) THEN ! 'wn' exists; read 3392 CALL iom_get( numror, jpdom_autoglo, 'wn', wn, ldxios = lrxios ) 3393 WRITE(numout,*) ' ===>>>> : wn read from restart file' 3394 ELSE 3395 wn(:,:,:) = 0._wp 3396 WRITE(numout,*) ' ===>>>> : wn not in restart file, set to zero initially' 3397 END IF 3398 3399 id1 = iom_varid( numror, 'hbl' , ldstop = .FALSE. ) 3400 id2 = iom_varid( numror, 'dh' , ldstop = .FALSE. ) 3401 IF( id1 > 0 .AND. id2 > 0) THEN ! 'hbl' exists; read and return 3402 CALL iom_get( numror, jpdom_autoglo, 'hbl' , hbl , ldxios = lrxios ) 3403 CALL iom_get( numror, jpdom_autoglo, 'dh', dh, ldxios = lrxios ) 3404 WRITE(numout,*) ' ===>>>> : hbl & dh read from restart file' 3405 IF( ln_osm_mle ) THEN 3406 id3 = iom_varid( numror, 'hmle' , ldstop = .FALSE. ) 3407 IF( id3 > 0) THEN 3408 CALL iom_get( numror, jpdom_autoglo, 'hmle' , hmle , ldxios = lrxios ) 3409 WRITE(numout,*) ' ===>>>> : hmle read from restart file' 3410 ELSE 3411 WRITE(numout,*) ' ===>>>> : hmle not found, set to hbl' 3412 hmle(:,:) = hbl(:,:) ! Initialise MLE depth. 3413 END IF 3414 END IF 3415 RETURN 3416 ELSE ! 'hbl' & 'dh' not in restart file, recalculate 3417 WRITE(numout,*) ' ===>>>> : previous run without osmosis scheme, hbl computed from stratification' 3418 END IF 3419 END IF 3420 3421 !!----------------------------------------------------------------------------- 3422 ! If READ/WRITE Flag is 'WRITE', write hbl into the restart file, then return 3423 !!----------------------------------------------------------------------------- 3424 IF( TRIM(cdrw) == 'WRITE') THEN !* Write hbli into the restart file, then return 3425 IF(lwp) WRITE(numout,*) '---- osm-rst ----' 3426 CALL iom_rstput( kt, nitrst, numrow, 'wn' , wn, ldxios = lwxios ) 3427 CALL iom_rstput( kt, nitrst, numrow, 'hbl' , hbl, ldxios = lwxios ) 3428 CALL iom_rstput( kt, nitrst, numrow, 'dh' , dh, ldxios = lwxios ) 3429 IF( ln_osm_mle ) THEN 3430 CALL iom_rstput( kt, nitrst, numrow, 'hmle', hmle, ldxios = lwxios ) 3431 END IF 3432 RETURN 3433 END IF 3434 3435 !!----------------------------------------------------------------------------- 3436 ! Getting hbl, no restart file with hbl, so calculate from surface stratification 3437 !!----------------------------------------------------------------------------- 3438 IF( lwp ) WRITE(numout,*) ' ===>>>> : calculating hbl computed from stratification' 3439 ! w-level of the mixing and mixed layers 3440 CALL eos_rab( tsn, rab_n ) 3441 CALL bn2(tsn, rab_n, rn2) 3442 imld_rst(:,:) = nlb10 ! Initialization to the number of w ocean point 3443 hbl(:,:) = 0._wp ! here hbl used as a dummy variable, integrating vertically N^2 3444 zN2_c = grav * rho_c * r1_rau0 ! convert density criteria into N^2 criteria 3445 ! 3446 hbl(:,:) = 0._wp ! here hbl used as a dummy variable, integrating vertically N^2 3447 DO jk = 1, jpkm1 3448 DO jj = 1, jpj ! Mixed layer level: w-level 3449 DO ji = 1, jpi 3450 ikt = mbkt(ji,jj) 3451 hbl(ji,jj) = hbl(ji,jj) + MAX( rn2(ji,jj,jk) , 0._wp ) * e3w_n(ji,jj,jk) 3452 IF( hbl(ji,jj) < zN2_c ) imld_rst(ji,jj) = MIN( jk , ikt ) + 1 ! Mixed layer level 3453 END DO 3454 END DO 3455 END DO 3456 ! 3457 DO jj = 1, jpj 3458 DO ji = 1, jpi 3459 iiki = MAX(4,imld_rst(ji,jj)) 3460 hbl (ji,jj) = gdepw_n(ji,jj,iiki ) ! Turbocline depth 3461 dh (ji,jj) = e3t_n(ji,jj,iiki-1 ) ! Turbocline depth 3462 END DO 3463 END DO 3464 3465 WRITE(numout,*) ' ===>>>> : hbl computed from stratification' 3466 3467 IF( ln_osm_mle ) THEN 3468 hmle(:,:) = hbl(:,:) ! Initialise MLE depth. 3469 WRITE(numout,*) ' ===>>>> : hmle set = to hbl' 3470 END IF 3471 3472 wn(:,:,:) = 0._wp 3473 WRITE(numout,*) ' ===>>>> : wn not in restart file, set to zero initially' 3474 END SUBROUTINE osm_rst 3475 3476 3477 SUBROUTINE tra_osm( kt ) 3478 !!---------------------------------------------------------------------- 3479 !! *** ROUTINE tra_osm *** 3480 !! 3481 !! ** Purpose : compute and add to the tracer trend the non-local tracer flux 3482 !! 3483 !! ** Method : ??? 3484 !!---------------------------------------------------------------------- 3485 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdt, ztrds ! 3D workspace 3486 !!---------------------------------------------------------------------- 3487 INTEGER, INTENT(in) :: kt 3488 INTEGER :: ji, jj, jk 3489 ! 3490 IF( kt == nit000 ) THEN 3491 IF(lwp) WRITE(numout,*) 3492 IF(lwp) WRITE(numout,*) 'tra_osm : OSM non-local tracer fluxes' 3493 IF(lwp) WRITE(numout,*) '~~~~~~~ ' 3494 ENDIF 3495 3496 IF( l_trdtra ) THEN !* Save ta and sa trends 3497 ALLOCATE( ztrdt(jpi,jpj,jpk) ) ; ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 3498 ALLOCATE( ztrds(jpi,jpj,jpk) ) ; ztrds(:,:,:) = tsa(:,:,:,jp_sal) 3499 ENDIF 3500 3501 DO jk = 1, jpkm1 3502 DO jj = 2, jpjm1 3503 DO ji = 2, jpim1 3504 tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) & 3047 3505 & - ( ghamt(ji,jj,jk ) & 3048 3506 & - ghamt(ji,jj,jk+1) ) /e3t_n(ji,jj,jk) 3049 3507 tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) & 3050 3508 & - ( ghams(ji,jj,jk ) & 3051 3509 & - ghams(ji,jj,jk+1) ) / e3t_n(ji,jj,jk) 3052 3053 3054 3055 3056 3057 3058 3059 3060 3061 3062 3063 3064 3065 3066 3067 3068 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )3069 3070 3071 3072 3073 3074 3075 3076 3077 3078 3079 3080 3081 3082 3083 3084 3085 3086 3087 3088 3089 3090 3091 3092 3093 3094 3095 3096 3097 3098 3099 3100 3101 3102 3103 3104 3105 3106 3107 3108 3109 3110 3111 3112 3113 3114 3115 3510 END DO 3511 END DO 3512 END DO 3513 3514 ! save the non-local tracer flux trends for diagnostics 3515 IF( l_trdtra ) THEN 3516 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 3517 ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:) 3518 3519 CALL trd_tra( kt, 'TRA', jp_tem, jptra_osm, ztrdt ) 3520 CALL trd_tra( kt, 'TRA', jp_sal, jptra_osm, ztrds ) 3521 DEALLOCATE( ztrdt ) ; DEALLOCATE( ztrds ) 3522 ENDIF 3523 3524 IF(ln_ctl) THEN 3525 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' osm - Ta: ', mask1=tmask, & 3526 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 3527 ENDIF 3528 ! 3529 END SUBROUTINE tra_osm 3530 3531 3532 SUBROUTINE trc_osm( kt ) ! Dummy routine 3533 !!---------------------------------------------------------------------- 3534 !! *** ROUTINE trc_osm *** 3535 !! 3536 !! ** Purpose : compute and add to the passive tracer trend the non-local 3537 !! passive tracer flux 3538 !! 3539 !! 3540 !! ** Method : ??? 3541 !!---------------------------------------------------------------------- 3542 ! 3543 !!---------------------------------------------------------------------- 3544 INTEGER, INTENT(in) :: kt 3545 WRITE(*,*) 'trc_osm: Not written yet', kt 3546 END SUBROUTINE trc_osm 3547 3548 3549 SUBROUTINE dyn_osm( kt ) 3550 !!---------------------------------------------------------------------- 3551 !! *** ROUTINE dyn_osm *** 3552 !! 3553 !! ** Purpose : compute and add to the velocity trend the non-local flux 3554 !! copied/modified from tra_osm 3555 !! 3556 !! ** Method : ??? 3557 !!---------------------------------------------------------------------- 3558 INTEGER, INTENT(in) :: kt ! 3559 ! 3560 INTEGER :: ji, jj, jk ! dummy loop indices 3561 !!---------------------------------------------------------------------- 3562 ! 3563 IF( kt == nit000 ) THEN 3564 IF(lwp) WRITE(numout,*) 3565 IF(lwp) WRITE(numout,*) 'dyn_osm : OSM non-local velocity' 3566 IF(lwp) WRITE(numout,*) '~~~~~~~ ' 3567 ENDIF 3568 !code saving tracer trends removed, replace with trdmxl_oce 3569 3570 DO jk = 1, jpkm1 ! add non-local u and v fluxes 3571 DO jj = 2, jpjm1 3572 DO ji = 2, jpim1 3573 ua(ji,jj,jk) = ua(ji,jj,jk) & 3116 3574 & - ( ghamu(ji,jj,jk ) & 3117 3575 & - ghamu(ji,jj,jk+1) ) / e3u_n(ji,jj,jk) 3118 3576 va(ji,jj,jk) = va(ji,jj,jk) & 3119 3577 & - ( ghamv(ji,jj,jk ) & 3120 3578 & - ghamv(ji,jj,jk+1) ) / e3v_n(ji,jj,jk) 3121 3122 3123 3124 3125 3126 3127 3128 3129 3579 END DO 3580 END DO 3581 END DO 3582 ! 3583 ! code for saving tracer trends removed 3584 ! 3585 END SUBROUTINE dyn_osm 3586 3587 !!====================================================================== 3130 3588 3131 3589 END MODULE zdfosm
Note: See TracChangeset
for help on using the changeset viewer.
