Changeset 2528 for trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfkpp.F90
- Timestamp:
- 2010-12-27T18:33:53+01:00 (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfkpp.F90
- Property svn:eol-style deleted
r1695 r2528 5 5 !! turbulent closure parameterization 6 6 !!===================================================================== 7 !! History : 8.1 ! 00-03 (W.G. Large, J. Chanut) Original code 8 !! 8.1 ! 02-06 (J.M. Molines) for real case CLIPPER 9 !! 8.2 ! 03-10 (Chanut J.) re-writting 10 !! 9.0 ! 05-01 (C. Ethe) Free form, F90 7 !! History : OPA ! 2000-03 (W.G. Large, J. Chanut) Original code 8 !! 8.1 ! 2002-06 (J.M. Molines) for real case CLIPPER 9 !! 8.2 ! 2003-10 (Chanut J.) re-writting 10 !! NEMO 1.0 ! 2005-01 (C. Ethe, G. Madec) Free form, F90 + creation of tra_kpp routine 11 !! 3.3 ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase + merge TRC-TRA 11 12 !!---------------------------------------------------------------------- 12 13 #if defined key_zdfkpp || defined key_esopa … … 14 15 !! 'key_zdfkpp' KPP scheme 15 16 !!---------------------------------------------------------------------- 16 !!----------------------------------------------------------------------17 17 !! zdf_kpp : update momentum and tracer Kz from a kpp scheme 18 18 !! zdf_kpp_init : initialization, namelist read, and parameters control 19 !! tra_kpp : compute and add to the T & S trend the non-local flux 20 !! trc_kpp : compute and add to the passive tracer trend the non-local flux (lk_top=T) 19 21 !!---------------------------------------------------------------------- 20 22 USE oce ! ocean dynamics and active tracers … … 28 30 USE lbclnk ! ocean lateral boundary conditions (or mpp link) 29 31 USE prtctl ! Print control 30 USE trdmod ! momentum/tracers trends 32 USE trdmod_oce ! ocean trends definition 33 USE trdtra ! tracers trends 31 34 32 35 IMPLICIT NONE 33 36 PRIVATE 34 37 35 PUBLIC zdf_kpp ! routine called by step.F90 36 PUBLIC tra_kpp ! routine called by step.F90 38 PUBLIC zdf_kpp ! routine called by step.F90 39 PUBLIC zdf_kpp_init ! routine called by opa.F90 40 PUBLIC tra_kpp ! routine called by step.F90 41 #if defined key_top 42 PUBLIC trc_kpp ! routine called by trcstp.F90 43 #endif 37 44 38 45 LOGICAL , PUBLIC, PARAMETER :: lk_zdfkpp = .TRUE. !: KPP vertical mixing flag … … 53 60 54 61 #if defined key_zdfddm 55 REAL(wp) :: &!!! ** Double diffusion Mixing56 difssf = 1.e-03_wp , &! maximum salt fingering mixing57 Rrho0 = 1.9_wp , &! limit for salt fingering mixing58 difsdc = 1.5e-06_wp! maximum diffusive convection mixing62 ! !!! ** Double diffusion Mixing 63 REAL(wp) :: difssf = 1.e-03_wp ! maximum salt fingering mixing 64 REAL(wp) :: Rrho0 = 1.9_wp ! limit for salt fingering mixing 65 REAL(wp) :: difsdc = 1.5e-06_wp ! maximum diffusive convection mixing 59 66 #endif 60 67 LOGICAL :: ln_kpprimix = .TRUE. ! Shear instability mixing 61 68 62 REAL(wp) :: & !!! ** General constants ** 63 epsln = 1.0e-20_wp , & ! a small positive number 64 pthird = 1._wp/3._wp , & ! 1/3 65 pfourth = 1._wp/4._wp ! 1/4 66 67 REAL(wp) :: & !!! ** Boundary Layer Turbulence Parameters ** 68 vonk = 0.4_wp , & ! von Karman's constant 69 epsilon = 0.1_wp , & ! nondimensional extent of the surface layer 70 rconc1 = 5.0_wp , & ! standard flux profile function parmaeters 71 rconc2 = 16.0_wp , & ! " " 72 rconcm = 8.38_wp , & ! momentum flux profile fit 73 rconam = 1.26_wp , & ! " " 74 rzetam = -.20_wp , & ! " " 75 rconcs = 98.96_wp , & ! scalar flux profile fit 76 rconas = -28.86_wp , & ! " " 77 rzetas = -1.0_wp ! " " 78 REAL(wp) :: & !!! ** Boundary Layer Depth Diagnostic ** 79 Ricr = 0.3_wp , & ! critical bulk Richardson Number 80 rcekman = 0.7_wp , & ! coefficient for ekman depth 81 rcmonob = 1.0_wp , & ! coefficient for Monin-Obukhov depth 82 rconcv = 1.7_wp , & ! ratio of interior buoyancy frequency to buoyancy frequency at entrainment depth 83 hbf = 1.0_wp , & ! fraction of bound. layer depth to which absorbed solar 84 ! ! rad. and contributes to surf. buo. forcing 85 Vtc ! function of rconcv,rconcs,epsilon,vonk,Ricr 86 REAL(wp) :: & !!! ** Nonlocal Boundary Layer Mixing ** 87 rcstar = 5.0_wp , & ! coefficient for convective nonlocal transport 88 rcs = 1.0e-3_wp , & ! conversion: mm/s ==> m/s 89 rcg ! non-dimensional coefficient for nonlocal transport 69 ! !!! ** General constants ** 70 REAL(wp) :: epsln = 1.0e-20_wp ! a small positive number 71 REAL(wp) :: pthird = 1._wp/3._wp ! 1/3 72 REAL(wp) :: pfourth = 1._wp/4._wp ! 1/4 73 74 ! !!! ** Boundary Layer Turbulence Parameters ** 75 REAL(wp) :: vonk = 0.4_wp ! von Karman's constant 76 REAL(wp) :: epsilon = 0.1_wp ! nondimensional extent of the surface layer 77 REAL(wp) :: rconc1 = 5.0_wp ! standard flux profile function parmaeters 78 REAL(wp) :: rconc2 = 16.0_wp ! " " 79 REAL(wp) :: rconcm = 8.38_wp ! momentum flux profile fit 80 REAL(wp) :: rconam = 1.26_wp ! " " 81 REAL(wp) :: rzetam = -.20_wp ! " " 82 REAL(wp) :: rconcs = 98.96_wp ! scalar flux profile fit 83 REAL(wp) :: rconas = -28.86_wp ! " " 84 REAL(wp) :: rzetas = -1.0_wp ! " " 85 86 ! !!! ** Boundary Layer Depth Diagnostic ** 87 REAL(wp) :: Ricr = 0.3_wp ! critical bulk Richardson Number 88 REAL(wp) :: rcekman = 0.7_wp ! coefficient for ekman depth 89 REAL(wp) :: rcmonob = 1.0_wp ! coefficient for Monin-Obukhov depth 90 REAL(wp) :: rconcv = 1.7_wp ! ratio of interior buoyancy frequency to its value at entrainment depth 91 REAL(wp) :: hbf = 1.0_wp ! fraction of bound. layer depth to which absorbed solar 92 ! ! rad. and contributes to surf. buo. forcing 93 REAL(wp) :: Vtc ! function of rconcv,rconcs,epsilon,vonk,Ricr 94 95 ! !!! ** Nonlocal Boundary Layer Mixing ** 96 REAL(wp) :: rcstar = 5.0_wp ! coefficient for convective nonlocal transport 97 REAL(wp) :: rcs = 1.0e-3_wp ! conversion: mm/s ==> m/s 98 REAL(wp) :: rcg ! non-dimensional coefficient for nonlocal transport 90 99 91 100 #if ! defined key_kppcustom 92 REAL(wp), DIMENSION(jpk,jpk) :: del ! array for reference mean values of vertical integration101 REAL(wp), DIMENSION(jpk,jpk) :: del ! array for reference mean values of vertical integration 93 102 #endif 94 103 95 104 #if defined key_kpplktb 96 INTEGER, PARAMETER :: & !!! ** Parameters for lookup table for turbulent velocity scales ** 97 nilktb = 892 , & ! number of values for zehat in KPP lookup table 98 njlktb = 482 , & ! number of values for ustar in KPP lookup table 99 nilktbm1 = nilktb - 1 , & ! 100 njlktbm1 = njlktb - 1 ! 101 102 REAL(wp), DIMENSION(nilktb,njlktb) :: wmlktb ! lookup table for the turbulent vertical velocity scale for momentum 103 REAL(wp), DIMENSION(nilktb,njlktb) :: wslktb ! lookup table for the turbulent vertical velocity scale for tracers 104 105 REAL(wp) :: & 106 dehatmin = -4.e-7_wp , & ! minimum limit for zhat in lookup table (m3/s3) 107 dehatmax = 0._wp , & ! maximum limit for zhat in lookup table (m3/s3) 108 ustmin = 0._wp , & ! minimum limit for ustar in lookup table (m/s) 109 ustmax = 0.04_wp , & ! maximum limit for ustar in lookup table (m/s) 110 dezehat , & ! delta zhat in lookup table 111 deustar ! delta ustar in lookup table 105 ! !!! ** Parameters for lookup table for turbulent velocity scales ** 106 INTEGER, PARAMETER :: nilktb = 892 ! number of values for zehat in KPP lookup table 107 INTEGER, PARAMETER :: njlktb = 482 ! number of values for ustar in KPP lookup table 108 INTEGER, PARAMETER :: nilktbm1 = nilktb-1 ! 109 INTEGER, PARAMETER :: njlktbm1 = njlktb-1 ! 110 111 REAL(wp), DIMENSION(nilktb,njlktb) :: wmlktb ! lookup table for the turbulent vertical velocity scale (momentum) 112 REAL(wp), DIMENSION(nilktb,njlktb) :: wslktb ! lookup table for the turbulent vertical velocity scale (tracers) 113 114 REAL(wp) :: dehatmin = -4.e-7_wp ! minimum limit for zhat in lookup table (m3/s3) 115 REAL(wp) :: dehatmax = 0._wp ! maximum limit for zhat in lookup table (m3/s3) 116 REAL(wp) :: ustmin = 0._wp ! minimum limit for ustar in lookup table (m/s) 117 REAL(wp) :: ustmax = 0.04_wp ! maximum limit for ustar in lookup table (m/s) 118 REAL(wp) :: dezehat ! delta zhat in lookup table 119 REAL(wp) :: deustar ! delta ustar in lookup table 112 120 #endif 113 121 REAL(wp), DIMENSION(jpk) :: ratt ! attenuation coef (already defines in module traqsr, 114 122 ! ! but only if the solar radiation penetration is considered) 115 REAL(wp) :: & !!! * penetrative solar radiation coefficient * 116 rabs = 0.58_wp , & ! fraction associated with xsi1 117 xsi1 = 0.35_wp , & ! first depth of extinction 118 xsi2 = 23.0_wp ! second depth of extinction 123 124 ! !!! * penetrative solar radiation coefficient * 125 REAL(wp) :: rabs = 0.58_wp ! fraction associated with xsi1 126 REAL(wp) :: xsi1 = 0.35_wp ! first depth of extinction 127 REAL(wp) :: xsi2 = 23.0_wp ! second depth of extinction 119 128 ! ! (default values: water type Ib) 120 129 121 REAL(wp), DIMENSION(jpi,jpj,jpk) :: & 122 etmean , & ! coefficient used for horizontal smoothing 123 eumean , & ! at t-, u- and v-points 124 evmean 130 REAL(wp), DIMENSION(jpi,jpj,jpk) :: etmean, eumean, evmean ! coeff. used for hor. smoothing at t-, u- & v-points 131 125 132 126 133 #if defined key_c1d 127 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: & 128 rig , & ! gradient Richardson number 129 rib , & ! bulk Richardson number 130 buof , & ! buoyancy forcing 131 mols ! moning-Obukhov length scale 132 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: ekdp ! Ekman depth 134 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: rig !: gradient Richardson number 135 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: rib !: bulk Richardson number 136 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: buof !: buoyancy forcing 137 REAL(wp), PUBLIC, DIMENSION(jpi,jpj,jpk) :: mols !: moning-Obukhov length scale 138 REAL(wp), PUBLIC, DIMENSION(jpi,jpj) :: ekdp !: Ekman depth 133 139 #endif 134 140 … … 140 146 # include "zdfddm_substitute.h90" 141 147 !!---------------------------------------------------------------------- 142 !! NEMO/OPA 3. 2 , LOCEAN-IPSL (2009)148 !! NEMO/OPA 3.3 , NEMO Consortium (2010) 143 149 !! $Id$ 144 !! Software governed by the CeCILL licence ( modipsl/doc/NEMO_CeCILL.txt)150 !! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt) 145 151 !!---------------------------------------------------------------------- 146 152 147 153 CONTAINS 148 154 149 SUBROUTINE zdf_kpp 155 SUBROUTINE zdf_kpp( kt ) 150 156 !!---------------------------------------------------------------------- 151 157 !! *** ROUTINE zdf_kpp *** … … 183 189 !!---------------------------------------------------------------------- 184 190 #if defined key_zdfddm 185 USE oce , zviscos => ua , &! temp. array for viscosities use ua as workspace186 & zdiffut => ta, &! temp. array for diffusivities use sa as workspace187 & zdiffus => sa! temp. array for diffusivities use sa as workspace191 USE oce , zviscos => ua ! temp. array for viscosities use ua as workspace 192 USE oce , zdiffut => ta ! temp. array for diffusivities use sa as workspace 193 USE oce , zdiffus => sa ! temp. array for diffusivities use sa as workspace 188 194 #else 189 USE oce , zviscos => ua , &! temp. array for viscosities use ua as workspace190 & zdiffut => ta! temp. array for diffusivities use sa as workspace195 USE oce , zviscos => ua ! temp. array for viscosities use ua as workspace 196 USE oce , zdiffut => ta ! temp. array for diffusivities use sa as workspace 191 197 #endif 192 198 !! … … 196 202 INTEGER :: ikbot, jkmax, jkm1, jkp2 ! 197 203 198 REAL(wp), DIMENSION(jpi,jpj) :: & !!! Surface buoyancy forcing, friction velocity 199 zBo, zBosol, zustar ! 200 ! 201 REAL(wp) :: & ! 202 ztx, zty, zflageos, & ! 203 zstabl, zbuofdep,zucube, & ! 204 zrhos, zalbet, zbeta, & ! 205 zthermal, zhalin, zatt1 ! 206 207 REAL(wp) :: & !!! Bulk richardson number 208 zref, zt, zs, zh, & ! 209 zu, zv, zrh, & ! 210 zrib, zrinum, & ! 211 zdVsq, zVtsq ! 212 213 REAL(wp) :: & !!! Velocity scales 214 zehat, zeta, zhrib, zsig, & ! 215 zscale, zwst, zws, zwm 216 204 REAL(wp), DIMENSION(jpi,jpj) :: zBo, zBosol, zustar ! Surface buoyancy forcing, friction velocity 205 REAL(wp) :: ztx, zty, zflageos, zstabl, zbuofdep,zucube ! 206 REAL(wp) :: zrhos, zalbet, zbeta, zthermal, zhalin, zatt1 ! 207 REAL(wp) :: zref, zt, zs, zh, zu, zv, zrh ! Bulk richardson number 208 REAL(wp) :: zrib, zrinum, zdVsq, zVtsq ! 209 REAL(wp) :: zehat, zeta, zhrib, zsig, zscale, zwst, zws, zwm ! Velocity scales 217 210 #if defined key_kpplktb 218 INTEGER :: & !!! Lookup table or Analytical functions 219 il, jl ! 220 REAL(wp) :: & ! 221 ud, zfrac, ufrac, & ! 222 zwam, zwbm, zwas, zwbs ! 211 INTEGER :: il, jl ! Lookup table or Analytical functions 212 REAL(wp) :: ud, zfrac, ufrac, zwam, zwbm, zwas, zwbs ! 223 213 #else 224 REAL(wp) :: & ! 225 zwsun, zwmun, & 226 zcons, zconm, zwcons, zwconm ! 227 #endif 228 229 REAL(wp) :: & !!! In situ density 230 zsr, zbw, ze, & ! 231 zb, zd, zc, zaw, za, & ! 232 zb1, za1, zkw, zk0, & ! 233 zcomp , zrhd, zrhdr,zbvzed ! 234 214 REAL(wp) :: zwsun, zwmun, zcons, zconm, zwcons, zwconm ! 215 #endif 216 REAL(wp) :: zsr, zbw, ze, zb, zd, zc, zaw, za, zb1, za1, zkw, zk0, zcomp , zrhd,zrhdr,zbvzed ! In situ density 235 217 #if ! defined key_kppcustom 236 !! * local declarations 237 INTEGER :: & 238 jm ! dummy loop indices 239 REAL(wp) :: & !!! Compression terms 240 zr1, zr2, zr3, zr4, & ! 241 zrhop ! 242 #endif 243 244 REAL(wp) :: & ! 245 zflag, ztemp, zrn2, & ! 246 zdep21, zdep32, zdep43 247 248 REAL(wp) :: & !!! Interior richardson mixing 249 zdku2, zdkv2, ze3sqr, & ! 250 zsh2, zri, zfri ! 251 252 REAL(wp), DIMENSION(jpi,0:2) :: & !!! Moning-Obukov limitation 253 zmoek 254 REAL(wp), DIMENSION(jpi) :: & 255 zmoa, zekman 256 REAL(wp) :: & 257 zmob, zek 258 259 REAL(wp), DIMENSION(jpi,4) :: & !!! The pipe 260 zdepw, zdift, zvisc 261 REAL(wp), DIMENSION(jpi,3) :: & 262 zdept 263 REAL(wp), DIMENSION(jpi,2) :: & 264 zriblk 265 REAL(wp), DIMENSION(jpi,jpk) :: & ! 266 zmask 267 REAL(wp), DIMENSION(jpi) :: & ! 268 zhmax, zria, zhbl 269 REAL(wp) :: & ! 270 zflagri, zflagek, & ! 271 zflagmo, zflagh, zflagkb ! 272 REAL(wp), DIMENSION(jpi) :: & !!! Shape function (G) 273 za2m, za3m, zkmpm, & 274 za2t, za3t, zkmpt 275 REAL(wp) :: & ! 276 zdelta, zdelta2, & ! 277 zdzup, zdzdn, zdzh, & ! 278 zvath, zgat1, zdat1, & ! 279 zkm1m, zkm1t 280 REAL(wp), DIMENSION(jpi,jpk) :: & !!! Boundary layer diffusivities/viscosities 281 zblcm, zblct 218 INTEGER :: jm ! dummy loop indices 219 REAL(wp) :: zr1, zr2, zr3, zr4, zrhop ! Compression terms 220 #endif 221 REAL(wp) :: zflag, ztemp, zrn2, zdep21, zdep32, zdep43 222 REAL(wp) :: zdku2, zdkv2, ze3sqr, zsh2, zri, zfri ! Interior richardson mixing 223 REAL(wp), DIMENSION(jpi,0:2) :: zmoek ! Moning-Obukov limitation 224 REAL(wp), DIMENSION(jpi) :: zmoa, zekman 225 REAL(wp) :: zmob, zek 226 REAL(wp), DIMENSION(jpi,4) :: zdepw, zdift, zvisc ! The pipe 227 REAL(wp), DIMENSION(jpi,3) :: zdept 228 REAL(wp), DIMENSION(jpi,2) :: zriblk 229 REAL(wp), DIMENSION(jpi,jpk) :: zmask 230 REAL(wp), DIMENSION(jpi) :: zhmax, zria, zhbl 231 REAL(wp) :: zflagri, zflagek, zflagmo, zflagh, zflagkb ! 232 REAL(wp), DIMENSION(jpi) :: za2m, za3m, zkmpm, za2t, za3t, zkmpt ! Shape function (G) 233 REAL(wp) :: zdelta, zdelta2, zdzup, zdzdn, zdzh, zvath, zgat1, zdat1, zkm1m, zkm1t 234 REAL(wp), DIMENSION(jpi,jpk) :: zblcm, zblct ! Boundary layer diffusivities/viscosities 282 235 #if defined key_zdfddm 283 REAL(wp) :: & !!! double diffusion mixing 284 zrrau, zds, & 285 zavdds, zavddt,zinr 286 REAL(wp), DIMENSION(jpi,4) :: & 287 zdifs 288 REAL(wp), DIMENSION(jpi) :: & 289 za2s, za3s, zkmps 290 REAL(wp) :: & 291 zkm1s 292 REAL(wp), DIMENSION(jpi,jpk) :: & 293 zblcs 236 REAL(wp) :: zrrau, zds, zavdds, zavddt,zinr ! double diffusion mixing 237 REAL(wp), DIMENSION(jpi,4) :: zdifs 238 REAL(wp), DIMENSION(jpi) :: za2s, za3s, zkmps 239 REAL(wp) :: zkm1s 240 REAL(wp), DIMENSION(jpi,jpk) :: zblcs 294 241 #endif 295 242 !!-------------------------------------------------------------------- 296 297 298 ! Initialization (first time-step only)299 ! --------------300 IF( kt == nit000 ) CALL zdf_kpp_init301 243 302 244 zviscos(:,:,:) = 0. … … 453 395 zBosol(ji,jj) = grav * zthermal * qsr(ji,jj) 454 396 ! Non radiative surface buoyancy force 455 zBo (ji,jj) = grav * zthermal * qns(ji,jj) - grav * zhalin * emps(ji,jj)397 zBo (ji,jj) = grav * zthermal * qns(ji,jj) - grav * zhalin * ( emps(ji,jj)-rnf(ji,jj) ) 456 398 ! Surface Temperature flux for non-local term 457 399 wt0(ji,jj) = - ( qsr(ji,jj) + qns(ji,jj) )* ro0cpr * tmask(ji,jj,1) 458 400 ! Surface salinity flux for non-local term 459 ws0(ji,jj) = - ( emps(ji,jj) * sn(ji,jj,1) * rcs ) * tmask(ji,jj,1)401 ws0(ji,jj) = - ( ( emps(ji,jj)-rnf(ji,jj) ) * sn(ji,jj,1) * rcs ) * tmask(ji,jj,1) 460 402 ENDDO 461 403 ENDDO … … 497 439 zria(ji ) = 0. 498 440 ! Maximum boundary layer depth 499 ikbot = mb athy(ji,jj) - 1! ikbot is the last T point in the water441 ikbot = mbkt(ji,jj) ! ikbot is the last T point in the water 500 442 zhmax(ji) = fsdept(ji,jj,ikbot) - 0.001 501 443 ! Compute Monin obukhov length scale at the surface and Ekman depth: … … 1236 1178 !! *** ROUTINE tra_kpp *** 1237 1179 !! 1238 !! ** Purpose : compute and add to the tracer trend the non-local 1239 !! tracer flux 1180 !! ** Purpose : compute and add to the tracer trend the non-local tracer flux 1240 1181 !! 1241 1182 !! ** Method : ??? 1242 !!1243 !! history :1244 !! 9.0 ! 05-11 (G. Madec) Original code1245 1183 !!---------------------------------------------------------------------- 1246 !! * Modules used 1247 USE oce, ONLY : ztrdt => ua, & ! use ua as 3D workspace 1248 ztrds => va ! use va as 3D workspace 1184 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdt, ztrds ! 3D workspace 1249 1185 !!---------------------------------------------------------------------- 1250 1186 INTEGER, INTENT(in) :: kt … … 1252 1188 1253 1189 IF( kt == nit000 ) THEN 1254 IF(lwp) WRITE(numout,*) 1190 IF(lwp) WRITE(numout,*) 1255 1191 IF(lwp) WRITE(numout,*) 'tra_kpp : KPP non-local tracer fluxes' 1256 1192 IF(lwp) WRITE(numout,*) '~~~~~~~ ' 1257 1193 ENDIF 1258 1194 1259 1260 ! Save ta and sa trends 1261 IF( l_trdtra ) THEN 1262 ztrdt(:,:,:) = ta(:,:,:) 1263 ztrds(:,:,:) = sa(:,:,:) 1195 IF( l_trdtra ) THEN !* Save ta and sa trends 1196 ALLOCATE( ztrdt(jpi,jpj,jpk) ) ; ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 1197 ALLOCATE( ztrds(jpi,jpj,jpk) ) ; ztrds(:,:,:) = tsa(:,:,:,jp_sal) 1264 1198 ENDIF 1265 1199 1266 1200 ! add non-local temperature and salinity flux ( in convective case only) 1267 1201 DO jk = 1, jpkm1 1268 DO jj = 2, jpjm1 1202 DO jj = 2, jpjm1 1269 1203 DO ji = fs_2, fs_jpim1 1270 t a(ji,jj,jk) = ta(ji,jj,jk)&1271 & - ( ghats(ji,jj,jk ) * avt(ji,jj,jk ) &1272 & - ghats(ji,jj,jk+1) * avt(ji,jj,jk+1) ) * wt0(ji,jj) / fse3t(ji,jj,jk)1273 sa(ji,jj,jk) = sa(ji,jj,jk)&1274 & - ( ghats(ji,jj,jk ) * fsavs(ji,jj,jk ) &1275 & - ghats(ji,jj,jk+1) * fsavs(ji,jj,jk+1) ) * ws0(ji,jj) / fse3t(ji,jj,jk)1204 tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem) & 1205 & - ( ghats(ji,jj,jk ) * avt (ji,jj,jk ) & 1206 & - ghats(ji,jj,jk+1) * avt (ji,jj,jk+1) ) * wt0(ji,jj) / fse3t(ji,jj,jk) 1207 tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal) & 1208 & - ( ghats(ji,jj,jk ) * fsavs(ji,jj,jk ) & 1209 & - ghats(ji,jj,jk+1) * fsavs(ji,jj,jk+1) ) * ws0(ji,jj) / fse3t(ji,jj,jk) 1276 1210 END DO 1277 1211 END DO … … 1280 1214 ! save the non-local tracer flux trends for diagnostic 1281 1215 IF( l_trdtra ) THEN 1282 ztrdt(:,:,:) = t a(:,:,:) - ztrdt(:,:,:)1283 ztrds(:,:,:) = sa(:,:,:) - ztrds(:,:,:)1216 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 1217 ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:) 1284 1218 !!bug gm jpttdzdf ==> jpttkpp 1285 CALL trd_mod(ztrdt, ztrds, jptra_trd_zdf, 'TRA', kt) 1219 CALL trd_tra( kt, 'TRA', jp_tem, jptra_trd_zdf, ztrdt ) 1220 CALL trd_tra( kt, 'TRA', jp_sal, jptra_trd_zdf, ztrds ) 1221 DEALLOCATE( ztrdt ) ; DEALLOCATE( ztrds ) 1286 1222 ENDIF 1287 1223 1288 IF(ln_ctl) THEN 1289 CALL prt_ctl( tab3d_1=t a, clinfo1=' kpp - Ta: ', mask1=tmask, &1290 & tab3d_2= sa, clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )1224 IF(ln_ctl) THEN 1225 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' kpp - Ta: ', mask1=tmask, & 1226 & tab3d_2=tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 1291 1227 ENDIF 1292 1228 1293 1229 END SUBROUTINE tra_kpp 1294 1230 1231 #if defined key_top 1232 !!---------------------------------------------------------------------- 1233 !! 'key_top' TOP models 1234 !!---------------------------------------------------------------------- 1235 SUBROUTINE trc_kpp( kt ) 1236 !!---------------------------------------------------------------------- 1237 !! *** ROUTINE trc_kpp *** 1238 !! 1239 !! ** Purpose : compute and add to the tracer trend the non-local 1240 !! tracer flux 1241 !! 1242 !! ** Method : ??? 1243 !! 1244 !! history : 1245 !! 9.0 ! 2005-11 (G. Madec) Original code 1246 !! NEMO 3.3 ! 2010-06 (C. Ethe ) Adapted to passive tracers 1247 !!---------------------------------------------------------------------- 1248 USE trc 1249 USE prtctl_trc ! Print control 1250 !! * Arguments 1251 INTEGER , INTENT( in ) :: kt ! ocean time-step index 1252 !! * Local declarations 1253 INTEGER :: ji, jj, jk, jn ! Dummy loop indices 1254 REAL(wp) :: ztra, zflx 1255 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrtrd 1256 !!---------------------------------------------------------------------- 1257 1258 IF( kt == nit000 ) THEN 1259 IF(lwp) WRITE(numout,*) 1260 IF(lwp) WRITE(numout,*) 'trc_kpp : KPP non-local tracer fluxes' 1261 IF(lwp) WRITE(numout,*) '~~~~~~~ ' 1262 ENDIF 1263 1264 IF( l_trdtrc ) ALLOCATE( ztrtrd(jpi,jpj,jpk) ) 1265 ! 1266 DO jn = 1, jptra 1267 ! 1268 IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn) 1269 ! add non-local on passive tracer flux ( in convective case only) 1270 DO jk = 1, jpkm1 1271 DO jj = 2, jpjm1 1272 DO ji = fs_2, fs_jpim1 1273 ! Surface tracer flux for non-local term 1274 zflx = - ( emps(ji,jj) * tra(ji,jj,1,jn) * rcs ) * tmask(ji,jj,1) 1275 ! compute the trend 1276 ztra = - ( ghats(ji,jj,jk ) * fsavs(ji,jj,jk ) & 1277 & - ghats(ji,jj,jk+1) * fsavs(ji,jj,jk+1) ) * zflx / fse3t(ji,jj,jk) 1278 ! add the trend to the general trend 1279 tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + ztra 1280 END DO 1281 END DO 1282 END DO 1283 ! save the non-local tracer flux trends for diagnostic 1284 IF( l_trdtrc ) ztrtrd(:,:,:) = tra(:,:,:,jn) - ztrtrd(:,:,:) 1285 CALL trd_tra( kt, 'TRC', jn, jptra_trd_zdf, ztrtrd(:,:,:,jn) ) 1286 ! 1287 END DO 1288 IF( l_trdtrc ) DEALLOCATE( ztrtrd ) 1289 IF( ln_ctl ) THEN 1290 WRITE(charout, FMT="(' kpp')") ; CALL prt_ctl_trc_info(charout) 1291 CALL prt_ctl_trc( tab4d=tra, mask=tmask, clinfo=clname, clinfo2='trd' ) 1292 ENDIF 1293 ! 1294 END SUBROUTINE trc_kpp 1295 #endif 1295 1296 1296 1297 SUBROUTINE zdf_kpp_init … … 1305 1306 !! 1306 1307 !! ** input : Namlist namkpp 1307 !!1308 !!1309 !! history :1310 !! 8.1 ! 00-02 (J. Chanut) KPP Mixing1311 !! 9.0 ! 05-01 (C. Ethe) F90 : free form1312 1308 !!---------------------------------------------------------------------- 1313 !! * local declarations 1314 1315 INTEGER :: & 1316 ji, jj, jk ! dummy loop indices 1317 1309 INTEGER :: ji, jj, jk ! dummy loop indices 1318 1310 #if ! defined key_kppcustom 1319 INTEGER :: & 1320 jm ! dummy loop indices 1321 REAL(wp) :: & !!! tempory scalars 1322 zref, zdist 1323 #endif 1324 1311 INTEGER :: jm ! dummy loop indices 1312 REAL(wp) :: zref, zdist ! tempory scalars 1313 #endif 1325 1314 #if defined key_kpplktb 1326 REAL(wp) :: & !!! tempory scalars 1327 zustar, & 1328 zucube, zustvk, & 1329 zeta, zehat 1330 #endif 1331 REAL(wp) :: & !!! tempory scalars 1332 zhbf 1333 LOGICAL :: & 1334 ll_kppcustom, & ! 1st ocean level taken as surface layer 1335 ll_kpplktb ! Lookup table for turbul. velocity scales 1315 REAL(wp) :: zustar, zucube, zustvk, zeta, zehat ! tempory scalars 1316 #endif 1317 REAL(wp) :: zhbf ! tempory scalars 1318 LOGICAL :: ll_kppcustom ! 1st ocean level taken as surface layer 1319 LOGICAL :: ll_kpplktb ! Lookup table for turbul. velocity scales 1336 1320 !! 1337 1321 NAMELIST/namzdf_kpp/ ln_kpprimix, rn_difmiw, rn_difsiw, rn_riinfty, rn_difri, rn_bvsqcon, rn_difcon, nn_ave … … 1540 1524 LOGICAL, PUBLIC, PARAMETER :: lk_zdfkpp = .FALSE. !: KPP flag 1541 1525 CONTAINS 1542 SUBROUTINE zdf_kpp( kt ) ! Empty routine 1526 SUBROUTINE zdf_kpp_init ! Dummy routine 1527 WRITE(*,*) 'zdf_kpp_init: You should not have seen this print! error?' 1528 END SUBROUTINE zdf_kpp_init 1529 SUBROUTINE zdf_kpp( kt ) ! Dummy routine 1543 1530 WRITE(*,*) 'zdf_kpp: You should not have seen this print! error?', kt 1544 1531 END SUBROUTINE zdf_kpp 1545 SUBROUTINE tra_kpp( kt ) ! Empty routine1532 SUBROUTINE tra_kpp( kt ) ! Dummy routine 1546 1533 WRITE(*,*) 'tra_kpp: You should not have seen this print! error?', kt 1547 1534 END SUBROUTINE tra_kpp 1535 #if defined key_top 1536 SUBROUTINE trc_kpp( kt ) ! Dummy routine 1537 WRITE(*,*) 'trc_kpp: You should not have seen this print! error?', kt 1538 END SUBROUTINE trc_kpp 1539 #endif 1548 1540 #endif 1549 1541
Note: See TracChangeset
for help on using the changeset viewer.
