Changeset 5120 for trunk/NEMOGCM/NEMO/OPA_SRC/ZDF
- Timestamp:
- 2015-03-03T17:11:55+01:00 (9 years ago)
- Location:
- trunk/NEMOGCM/NEMO/OPA_SRC/ZDF
- Files:
-
- 5 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfbfr.F90
r4990 r5120 120 120 zbfrt(ji,jj) = MAX(bfrcoef2d(ji,jj), ztmp) 121 121 zbfrt(ji,jj) = MIN(zbfrt(ji,jj), rn_bfri2_max) 122 ! (ISF)123 ikbt = mikt(ji,jj)124 ! JC: possible WAD implementation should modify line below if layers vanish125 ztmp = tmask(ji,jj,ikbt) * ( vkarmn / LOG( 0.5_wp * fse3t_n(ji,jj,ikbt) / rn_bfrz0 ))**2._wp126 ztfrt(ji,jj) = MAX(tfrcoef2d(ji,jj), ztmp)127 ztfrt(ji,jj) = MIN(ztfrt(ji,jj), rn_tfri2_max)128 129 122 END DO 130 123 END DO 124 ! (ISF) 125 IF ( ln_isfcav ) THEN 126 DO jj = 1, jpj 127 DO ji = 1, jpi 128 ikbt = mikt(ji,jj) 129 ! JC: possible WAD implementation should modify line below if layers vanish 130 ztmp = (1-tmask(ji,jj,1)) * ( vkarmn / LOG( 0.5_wp * fse3t_n(ji,jj,ikbt) / rn_bfrz0 ))**2._wp 131 ztfrt(ji,jj) = MAX(tfrcoef2d(ji,jj), ztmp) 132 ztfrt(ji,jj) = MIN(ztfrt(ji,jj), rn_tfri2_max) 133 END DO 134 END DO 135 END IF 131 136 ! 132 137 ELSE … … 152 157 ! 153 158 ! in case of 2 cell water column, we assume each cell feels the top and bottom friction 154 IF ( miku(ji,jj) + 2 .GE. mbku(ji,jj) ) THEN 155 bfrua(ji,jj) = - 0.5_wp * ( ( zbfrt(ji,jj) + zbfrt(ji+1,jj ) ) & 156 & + ( ztfrt(ji,jj) + ztfrt(ji+1,jj ) ) ) & 157 & * zecu * (1._wp - umask(ji,jj,1)) 158 END IF 159 IF ( mikv(ji,jj) + 2 .GE. mbkv(ji,jj) ) THEN 160 bfrva(ji,jj) = - 0.5_wp * ( ( zbfrt(ji,jj) + zbfrt(ji ,jj+1) ) & 161 & + ( ztfrt(ji,jj) + ztfrt(ji ,jj+1) ) ) & 162 & * zecv * (1._wp - vmask(ji,jj,1)) 163 END IF 164 ! (ISF) ======================================================================== 165 ikbu = miku(ji,jj) ! ocean bottom level at u- and v-points 166 ikbv = mikv(ji,jj) ! (deepest ocean u- and v-points) 167 ! 168 zvu = 0.25 * ( vn(ji,jj ,ikbu) + vn(ji+1,jj ,ikbu) & 169 & + vn(ji,jj-1,ikbu) + vn(ji+1,jj-1,ikbu) ) 170 zuv = 0.25 * ( un(ji,jj ,ikbv) + un(ji-1,jj ,ikbv) & 171 & + un(ji,jj+1,ikbv) + un(ji-1,jj+1,ikbv) ) 172 ! 173 zecu = SQRT( un(ji,jj,ikbu) * un(ji,jj,ikbu) + zvu*zvu + rn_bfeb2 ) 174 zecv = SQRT( vn(ji,jj,ikbv) * vn(ji,jj,ikbv) + zuv*zuv + rn_bfeb2 ) 175 ! 176 tfrua(ji,jj) = - 0.5_wp * ( ztfrt(ji,jj) + ztfrt(ji+1,jj ) ) * zecu * (1._wp - umask(ji,jj,1)) 177 tfrva(ji,jj) = - 0.5_wp * ( ztfrt(ji,jj) + ztfrt(ji ,jj+1) ) * zecv * (1._wp - vmask(ji,jj,1)) 178 ! (ISF) END ==================================================================== 179 ! in case of 2 cell water column, we assume each cell feels the top and bottom friction 180 IF ( miku(ji,jj) + 2 .GE. mbku(ji,jj) ) THEN 181 tfrua(ji,jj) = - 0.5_wp * ( ( ztfrt(ji,jj) + ztfrt(ji+1,jj ) ) & 182 & + ( zbfrt(ji,jj) + zbfrt(ji+1,jj ) ) ) & 183 & * zecu * (1._wp - umask(ji,jj,1)) 184 END IF 185 IF ( mikv(ji,jj) + 2 .GE. mbkv(ji,jj) ) THEN 186 tfrva(ji,jj) = - 0.5_wp * ( ( ztfrt(ji,jj) + ztfrt(ji ,jj+1) ) & 187 & + ( zbfrt(ji,jj) + zbfrt(ji ,jj+1) ) ) & 188 & * zecv * (1._wp - vmask(ji,jj,1)) 159 IF ( ln_isfcav ) THEN 160 IF ( miku(ji,jj) + 1 .GE. mbku(ji,jj) ) THEN 161 bfrua(ji,jj) = - 0.5_wp * ( ( zbfrt(ji,jj) + zbfrt(ji+1,jj ) ) & 162 & + ( ztfrt(ji,jj) + ztfrt(ji+1,jj ) ) ) & 163 & * zecu * (1._wp - umask(ji,jj,1)) 164 END IF 165 IF ( mikv(ji,jj) + 1 .GE. mbkv(ji,jj) ) THEN 166 bfrva(ji,jj) = - 0.5_wp * ( ( zbfrt(ji,jj) + zbfrt(ji ,jj+1) ) & 167 & + ( ztfrt(ji,jj) + ztfrt(ji ,jj+1) ) ) & 168 & * zecv * (1._wp - vmask(ji,jj,1)) 169 END IF 189 170 END IF 190 171 END DO 191 172 END DO 173 IF ( ln_isfcav ) THEN 174 DO jj = 2, jpjm1 175 DO ji = 2, jpim1 176 ! (ISF) ======================================================================== 177 ikbu = miku(ji,jj) ! ocean bottom level at u- and v-points 178 ikbv = mikv(ji,jj) ! (deepest ocean u- and v-points) 179 ! 180 zvu = 0.25 * ( vn(ji,jj ,ikbu) + vn(ji+1,jj ,ikbu) & 181 & + vn(ji,jj-1,ikbu) + vn(ji+1,jj-1,ikbu) ) 182 zuv = 0.25 * ( un(ji,jj ,ikbv) + un(ji-1,jj ,ikbv) & 183 & + un(ji,jj+1,ikbv) + un(ji-1,jj+1,ikbv) ) 184 ! 185 zecu = SQRT( un(ji,jj,ikbu) * un(ji,jj,ikbu) + zvu*zvu + rn_bfeb2 ) 186 zecv = SQRT( vn(ji,jj,ikbv) * vn(ji,jj,ikbv) + zuv*zuv + rn_bfeb2 ) 187 ! 188 tfrua(ji,jj) = - 0.5_wp * ( ztfrt(ji,jj) + ztfrt(ji+1,jj ) ) * zecu * (1._wp - umask(ji,jj,1)) 189 tfrva(ji,jj) = - 0.5_wp * ( ztfrt(ji,jj) + ztfrt(ji ,jj+1) ) * zecv * (1._wp - vmask(ji,jj,1)) 190 ! (ISF) END ==================================================================== 191 ! in case of 2 cell water column, we assume each cell feels the top and bottom friction 192 IF ( miku(ji,jj) + 1 .GE. mbku(ji,jj) ) THEN 193 tfrua(ji,jj) = - 0.5_wp * ( ( ztfrt(ji,jj) + ztfrt(ji+1,jj ) ) & 194 & + ( zbfrt(ji,jj) + zbfrt(ji+1,jj ) ) ) & 195 & * zecu * (1._wp - umask(ji,jj,1)) 196 END IF 197 IF ( mikv(ji,jj) + 1 .GE. mbkv(ji,jj) ) THEN 198 tfrva(ji,jj) = - 0.5_wp * ( ( ztfrt(ji,jj) + ztfrt(ji ,jj+1) ) & 199 & + ( zbfrt(ji,jj) + zbfrt(ji ,jj+1) ) ) & 200 & * zecv * (1._wp - vmask(ji,jj,1)) 201 END IF 202 END DO 203 END DO 204 END IF 192 205 ! 193 206 CALL lbc_lnk( bfrua, 'U', 1. ) ; CALL lbc_lnk( bfrva, 'V', 1. ) ! Lateral boundary condition -
trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfddm.F90
r4990 r5120 156 156 END DO 157 157 ! mask zmsk in order to have avt and avs masked 158 zmsks(:,:) = zmsks(:,:) * tmask(:,:,jk)158 zmsks(:,:) = zmsks(:,:) * wmask(:,:,jk) 159 159 160 160 … … 191 191 avmu(ji,jj,jk) = MAX( avmu(ji,jj,jk), & 192 192 & avt(ji,jj,jk), avt(ji+1,jj,jk), & 193 & avs(ji,jj,jk), avs(ji+1,jj,jk) ) * umask(ji,jj,jk)193 & avs(ji,jj,jk), avs(ji+1,jj,jk) ) * wumask(ji,jj,jk) 194 194 avmv(ji,jj,jk) = MAX( avmv(ji,jj,jk), & 195 195 & avt(ji,jj,jk), avt(ji,jj+1,jk), & 196 & avs(ji,jj,jk), avs(ji,jj+1,jk) ) * vmask(ji,jj,jk)196 & avs(ji,jj,jk), avs(ji,jj+1,jk) ) * wvmask(ji,jj,jk) 197 197 END DO 198 198 END DO … … 255 255 IF( zdf_ddm_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'zdf_ddm_init : unable to allocate arrays' ) 256 256 ! ! initialization to masked Kz 257 avs(:,:,:) = rn_avt0 * tmask(:,:,:)257 avs(:,:,:) = rn_avt0 * wmask(:,:,:) 258 258 ! 259 259 END SUBROUTINE zdf_ddm_init -
trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdfini.F90
r4990 r5120 14 14 !!---------------------------------------------------------------------- 15 15 USE par_oce ! mesh and scale factors 16 USE sbc_oce ! surface module (only for nn_isf in the option compatibility test)17 16 USE ldftra_oce ! ocean active tracers: lateral physics 18 17 USE ldfdyn_oce ! ocean dynamics lateral physics … … 118 117 IF( ioptio == 0 .OR. ioptio > 1 .AND. .NOT. lk_esopa ) & 119 118 & CALL ctl_stop( ' one and only one vertical diffusion option has to be defined ' ) 120 IF( ( lk_zdfric .OR. lk_zdfgls .OR. lk_zdfkpp ) .AND. nn_isf .NE. 0) &119 IF( ( lk_zdfric .OR. lk_zdfgls .OR. lk_zdfkpp ) .AND. ln_isfcav ) & 121 120 & CALL ctl_stop( ' only zdfcst and zdftke were tested with ice shelves cavities ' ) 122 121 ! -
trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftke.F90
r5112 r5120 26 26 !! ! + cleaning of the parameters + bugs correction 27 27 !! 3.3 ! 2010-10 (C. Ethe, G. Madec) reorganisation of initialisation phase 28 !! 3.6 ! 2014-11 (P. Mathiot) add ice shelf capability 28 29 !!---------------------------------------------------------------------- 29 30 #if defined key_zdftke || defined key_esopa … … 236 237 zfact3 = 0.5_wp * rn_ediss 237 238 ! 239 ! 238 240 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 239 241 ! ! Surface boundary condition on tke 240 242 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 243 IF ( ln_isfcav ) THEN 244 DO jj = 2, jpjm1 ! en(mikt(ji,jj)) = rn_emin 245 DO ji = fs_2, fs_jpim1 ! vector opt. 246 en(ji,jj,mikt(ji,jj))=rn_emin * tmask(ji,jj,1) 247 END DO 248 END DO 249 END IF 241 250 DO jj = 2, jpjm1 ! en(1) = rn_ebb taum / rau0 (min value rn_emin0) 242 251 DO ji = fs_2, fs_jpim1 ! vector opt. 243 IF (mikt(ji,jj) .GT. 1) THEN 244 en(ji,jj,mikt(ji,jj))=rn_emin 245 ELSE 246 en(ji,jj,1) = MAX( rn_emin0, zbbrau * taum(ji,jj) ) * tmask(ji,jj,1) 247 END IF 252 en(ji,jj,1) = MAX( rn_emin0, zbbrau * taum(ji,jj) ) * tmask(ji,jj,1) 248 253 END DO 249 254 END DO … … 301 306 END DO 302 307 zcof = 0.016 / SQRT( zrhoa * zcdrag ) 308 !CDIR NOVERRCHK 303 309 DO jk = 2, jpkm1 !* TKE Langmuir circulation source term added to en 304 DO jj = 2, jpjm1 310 !CDIR NOVERRCHK 311 DO jj = 2, jpjm1 312 !CDIR NOVERRCHK 305 313 DO ji = fs_2, fs_jpim1 ! vector opt. 306 314 zus = zcof * SQRT( taum(ji,jj) ) ! Stokes drift … … 309 317 zwlc = zind * rn_lc * zus * SIN( rpi * fsdepw(ji,jj,jk) / zhlc(ji,jj) ) 310 318 ! ! TKE Langmuir circulation source term 311 en(ji,jj,jk) = en(ji,jj,jk) + rdt * ( zwlc * zwlc * zwlc ) / zhlc(ji,jj) * tmask(ji,jj,jk)319 en(ji,jj,jk) = en(ji,jj,jk) + rdt * ( zwlc * zwlc * zwlc ) / zhlc(ji,jj) * wmask(ji,jj,jk) * tmask(ji,jj,1) 312 320 END DO 313 321 END DO … … 328 336 avmu(ji,jj,jk) = avmu(ji,jj,jk) * ( un(ji,jj,jk-1) - un(ji,jj,jk) ) & 329 337 & * ( ub(ji,jj,jk-1) - ub(ji,jj,jk) ) & 330 & / ( fse3uw_n(ji,jj,jk)&331 & * fse3uw_b(ji,jj,jk))338 & / ( fse3uw_n(ji,jj,jk) & 339 & * fse3uw_b(ji,jj,jk) ) 332 340 avmv(ji,jj,jk) = avmv(ji,jj,jk) * ( vn(ji,jj,jk-1) - vn(ji,jj,jk) ) & 333 341 & * ( vb(ji,jj,jk-1) - vb(ji,jj,jk) ) & … … 338 346 END DO 339 347 ! 340 DO j j = 2, jpjm1341 DO j i = fs_2, fs_jpim1 ! vector opt.342 DO j k = mikt(ji,jj)+1, jpkm1 !* Matrix and right hand side in en348 DO jk = 2, jpkm1 !* Matrix and right hand side in en 349 DO jj = 2, jpjm1 350 DO ji = fs_2, fs_jpim1 ! vector opt. 343 351 zcof = zfact1 * tmask(ji,jj,jk) 344 352 zzd_up = zcof * ( avm (ji,jj,jk+1) + avm (ji,jj,jk ) ) & ! upper diagonal … … 357 365 en(ji,jj,jk) = en(ji,jj,jk) + rdt * ( zesh2 - avt(ji,jj,jk) * rn2(ji,jj,jk) & 358 366 & + zfact3 * dissl(ji,jj,jk) * en (ji,jj,jk) ) & 359 & * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) 360 END DO 361 ! !* Matrix inversion from level 2 (tke prescribed at level 1) 362 DO jk = mikt(ji,jj)+2, jpkm1 ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 367 & * wmask(ji,jj,jk) 368 END DO 369 END DO 370 END DO 371 ! !* Matrix inversion from level 2 (tke prescribed at level 1) 372 DO jk = 3, jpkm1 ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 373 DO jj = 2, jpjm1 374 DO ji = fs_2, fs_jpim1 ! vector opt. 363 375 zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1) 364 376 END DO 365 ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1 366 zd_lw(ji,jj,mikt(ji,jj)+1) = en(ji,jj,mikt(ji,jj)+1) - zd_lw(ji,jj,mikt(ji,jj)+1) * en(ji,jj,mikt(ji,jj)) ! Surface boudary conditions on tke 367 ! 368 DO jk = mikt(ji,jj)+2, jpkm1 377 END DO 378 END DO 379 ! 380 ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1 381 DO jj = 2, jpjm1 382 DO ji = fs_2, fs_jpim1 ! vector opt. 383 zd_lw(ji,jj,2) = en(ji,jj,2) - zd_lw(ji,jj,2) * en(ji,jj,1) ! Surface boudary conditions on tke 384 END DO 385 END DO 386 DO jk = 3, jpkm1 387 DO jj = 2, jpjm1 388 DO ji = fs_2, fs_jpim1 ! vector opt. 369 389 zd_lw(ji,jj,jk) = en(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) *zd_lw(ji,jj,jk-1) 370 390 END DO 371 ! 372 ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 391 END DO 392 END DO 393 ! 394 ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 395 DO jj = 2, jpjm1 396 DO ji = fs_2, fs_jpim1 ! vector opt. 373 397 en(ji,jj,jpkm1) = zd_lw(ji,jj,jpkm1) / zdiag(ji,jj,jpkm1) 374 ! 375 DO jk = jpk-2, mikt(ji,jj)+1, -1 398 END DO 399 END DO 400 DO jk = jpk-2, 2, -1 401 DO jj = 2, jpjm1 402 DO ji = fs_2, fs_jpim1 ! vector opt. 376 403 en(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * en(ji,jj,jk+1) ) / zdiag(ji,jj,jk) 377 404 END DO 378 ! 379 DO jk = mikt(ji,jj), jpkm1 ! set the minimum value of tke 380 en(ji,jj,jk) = MAX( en(ji,jj,jk), rn_emin ) * tmask(ji,jj,jk) 405 END DO 406 END DO 407 DO jk = 2, jpkm1 ! set the minimum value of tke 408 DO jj = 2, jpjm1 409 DO ji = fs_2, fs_jpim1 ! vector opt. 410 en(ji,jj,jk) = MAX( en(ji,jj,jk), rn_emin ) * wmask(ji,jj,jk) 381 411 END DO 382 412 END DO … … 391 421 DO ji = fs_2, fs_jpim1 ! vector opt. 392 422 en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -fsdepw(ji,jj,jk) / htau(ji,jj) ) & 393 & * ( 1._wp - fr_i(ji,jj) ) * tmask(ji,jj,jk) * tmask(ji,jj,1)423 & * ( 1._wp - fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 394 424 END DO 395 425 END DO … … 400 430 jk = nmln(ji,jj) 401 431 en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -fsdepw(ji,jj,jk) / htau(ji,jj) ) & 402 & * ( 1._wp - fr_i(ji,jj) ) * tmask(ji,jj,jk) * tmask(ji,jj,1)432 & * ( 1._wp - fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 403 433 END DO 404 434 END DO … … 416 446 zdif = rhftau_scl * MAX( 0._wp, zdif + rhftau_add ) ! apply some modifications... 417 447 en(ji,jj,jk) = en(ji,jj,jk) + zbbrau * zdif * EXP( -fsdepw(ji,jj,jk) / htau(ji,jj) ) & 418 & * ( 1._wp - fr_i(ji,jj) ) * tmask(ji,jj,jk) * tmask(ji,jj,jk-1) * tmask(ji,jj,1)448 & * ( 1._wp - fr_i(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 419 449 END DO 420 450 END DO … … 484 514 ! !* Buoyancy length scale: l=sqrt(2*e/n**2) 485 515 ! 516 ! initialisation of interior minimum value (avoid a 2d loop with mikt) 517 zmxlm(:,:,:) = rmxl_min 518 zmxld(:,:,:) = rmxl_min 519 ! 486 520 IF( ln_mxl0 ) THEN ! surface mixing length = F(stress) : l=vkarmn*2.e5*taum/(rau0*g) 487 521 DO jj = 2, jpjm1 488 522 DO ji = fs_2, fs_jpim1 489 IF (mikt(ji,jj) .GT. 1) THEN 490 zmxlm(ji,jj,mikt(ji,jj)) = rmxl_min 491 ELSE 492 zraug = vkarmn * 2.e5_wp / ( rau0 * grav ) 493 zmxlm(ji,jj,mikt(ji,jj)) = MAX( rn_mxl0, zraug * taum(ji,jj) ) 494 END IF 523 zraug = vkarmn * 2.e5_wp / ( rau0 * grav ) 524 zmxlm(ji,jj,1) = MAX( rn_mxl0, zraug * taum(ji,jj) * tmask(ji,jj,1) ) 495 525 END DO 496 526 END DO 497 527 ELSE 498 DO jj = 2, jpjm1 499 DO ji = fs_2, fs_jpim1 ! surface set to the minimum value 500 zmxlm(ji,jj,mikt(ji,jj)) = MAX( tmask(ji,jj,1) * rn_mxl0, rmxl_min) 501 END DO 502 END DO 528 zmxlm(:,:,1) = rn_mxl0 503 529 ENDIF 504 zmxlm(:,:,jpk) = rmxl_min ! last level set to the interior minium value 505 ! 506 !CDIR NOVERRCHK 507 DO jj = 2, jpjm1 508 !CDIR NOVERRCHK 509 DO ji = fs_2, fs_jpim1 ! vector opt. 510 !CDIR NOVERRCHK 511 DO jk = mikt(ji,jj)+1, jpkm1 ! interior value : l=sqrt(2*e/n^2) 530 ! 531 !CDIR NOVERRCHK 532 DO jk = 2, jpkm1 ! interior value : l=sqrt(2*e/n^2) 533 !CDIR NOVERRCHK 534 DO jj = 2, jpjm1 535 !CDIR NOVERRCHK 536 DO ji = fs_2, fs_jpim1 ! vector opt. 512 537 zrn2 = MAX( rn2(ji,jj,jk), rsmall ) 513 zmxlm(ji,jj,jk) = MAX( rmxl_min, SQRT( 2._wp * en(ji,jj,jk) / zrn2 ) ) 514 END DO 515 zmxld(ji,jj,mikt(ji,jj)) = zmxlm(ji,jj,mikt(ji,jj)) ! surface set to the minimum value 538 zmxlm(ji,jj,jk) = MAX( rmxl_min, SQRT( 2._wp * en(ji,jj,jk) / zrn2 ) ) 539 END DO 516 540 END DO 517 541 END DO … … 519 543 ! !* Physical limits for the mixing length 520 544 ! 521 zmxld(:,:, 1 ) = zmxlm(:,:,1) ! surface set to the zmxlm value545 zmxld(:,:,1 ) = zmxlm(:,:,1) ! surface set to the minimum value 522 546 zmxld(:,:,jpk) = rmxl_min ! last level set to the minimum value 523 547 ! 524 548 SELECT CASE ( nn_mxl ) 525 549 ! 550 ! where wmask = 0 set zmxlm == fse3w 526 551 CASE ( 0 ) ! bounded by the distance to surface and bottom 527 DO j j = 2, jpjm1528 DO j i = fs_2, fs_jpim1 ! vector opt.529 DO j k = mikt(ji,jj)+1, jpkm1552 DO jk = 2, jpkm1 553 DO jj = 2, jpjm1 554 DO ji = fs_2, fs_jpim1 ! vector opt. 530 555 zemxl = MIN( fsdepw(ji,jj,jk) - fsdepw(ji,jj,mikt(ji,jj)), zmxlm(ji,jj,jk), & 531 556 & fsdepw(ji,jj,mbkt(ji,jj)+1) - fsdepw(ji,jj,jk) ) 532 zmxlm(ji,jj,jk) = zemxl 533 zmxld(ji,jj,jk) = zemxl 557 ! wmask prevent zmxlm = 0 if jk = mikt(ji,jj) 558 zmxlm(ji,jj,jk) = zemxl * wmask(ji,jj,jk) + MIN(zmxlm(ji,jj,jk),fse3w(ji,jj,jk)) * (1 - wmask(ji,jj,jk)) 559 zmxld(ji,jj,jk) = zemxl * wmask(ji,jj,jk) + MIN(zmxlm(ji,jj,jk),fse3w(ji,jj,jk)) * (1 - wmask(ji,jj,jk)) 534 560 END DO 535 561 END DO … … 537 563 ! 538 564 CASE ( 1 ) ! bounded by the vertical scale factor 539 DO j j = 2, jpjm1540 DO j i = fs_2, fs_jpim1 ! vector opt.541 DO j k = mikt(ji,jj)+1, jpkm1565 DO jk = 2, jpkm1 566 DO jj = 2, jpjm1 567 DO ji = fs_2, fs_jpim1 ! vector opt. 542 568 zemxl = MIN( fse3w(ji,jj,jk), zmxlm(ji,jj,jk) ) 543 569 zmxlm(ji,jj,jk) = zemxl … … 548 574 ! 549 575 CASE ( 2 ) ! |dk[xml]| bounded by e3t : 550 DO j j = 2, jpjm1551 DO j i = fs_2, fs_jpim1 ! vector opt.552 DO j k = mikt(ji,jj)+1, jpkm1 ! from the surface to the bottom :576 DO jk = 2, jpkm1 ! from the surface to the bottom : 577 DO jj = 2, jpjm1 578 DO ji = fs_2, fs_jpim1 ! vector opt. 553 579 zmxlm(ji,jj,jk) = MIN( zmxlm(ji,jj,jk-1) + fse3t(ji,jj,jk-1), zmxlm(ji,jj,jk) ) 554 580 END DO 555 DO jk = jpkm1, mikt(ji,jj)+1, -1 ! from the bottom to the surface : 581 END DO 582 END DO 583 DO jk = jpkm1, 2, -1 ! from the bottom to the surface : 584 DO jj = 2, jpjm1 585 DO ji = fs_2, fs_jpim1 ! vector opt. 556 586 zemxl = MIN( zmxlm(ji,jj,jk+1) + fse3t(ji,jj,jk+1), zmxlm(ji,jj,jk) ) 557 587 zmxlm(ji,jj,jk) = zemxl … … 562 592 ! 563 593 CASE ( 3 ) ! lup and ldown, |dk[xml]| bounded by e3t : 564 DO j j = 2, jpjm1565 DO j i = fs_2, fs_jpim1 ! vector opt.566 DO j k = mikt(ji,jj)+1, jpkm1 ! from the surface to the bottom : lup594 DO jk = 2, jpkm1 ! from the surface to the bottom : lup 595 DO jj = 2, jpjm1 596 DO ji = fs_2, fs_jpim1 ! vector opt. 567 597 zmxld(ji,jj,jk) = MIN( zmxld(ji,jj,jk-1) + fse3t(ji,jj,jk-1), zmxlm(ji,jj,jk) ) 568 598 END DO 569 DO jk = jpkm1, mikt(ji,jj)+1, -1 ! from the bottom to the surface : ldown 599 END DO 600 END DO 601 DO jk = jpkm1, 2, -1 ! from the bottom to the surface : ldown 602 DO jj = 2, jpjm1 603 DO ji = fs_2, fs_jpim1 ! vector opt. 570 604 zmxlm(ji,jj,jk) = MIN( zmxlm(ji,jj,jk+1) + fse3t(ji,jj,jk+1), zmxlm(ji,jj,jk) ) 571 605 END DO … … 604 638 zsqen = SQRT( en(ji,jj,jk) ) 605 639 zav = rn_ediff * zmxlm(ji,jj,jk) * zsqen 606 avm (ji,jj,jk) = MAX( zav, avmb(jk) ) * tmask(ji,jj,jk)607 avt (ji,jj,jk) = MAX( zav, avtb_2d(ji,jj) * avtb(jk) ) * tmask(ji,jj,jk)640 avm (ji,jj,jk) = MAX( zav, avmb(jk) ) * wmask(ji,jj,jk) 641 avt (ji,jj,jk) = MAX( zav, avtb_2d(ji,jj) * avtb(jk) ) * wmask(ji,jj,jk) 608 642 dissl(ji,jj,jk) = zsqen / zmxld(ji,jj,jk) 609 643 END DO … … 612 646 CALL lbc_lnk( avm, 'W', 1. ) ! Lateral boundary conditions (sign unchanged) 613 647 ! 614 DO jj = 2, jpjm1 615 DO ji = fs_2, fs_jpim1 ! vector opt. 616 DO jk = miku(ji,jj)+1, jpkm1 !* vertical eddy viscosity at u- and v-points 617 avmu(ji,jj,jk) = 0.5 * ( avm(ji,jj,jk) + avm(ji+1,jj ,jk) ) * umask(ji,jj,jk) 618 END DO 619 DO jk = mikv(ji,jj)+1, jpkm1 620 avmv(ji,jj,jk) = 0.5 * ( avm(ji,jj,jk) + avm(ji ,jj+1,jk) ) * vmask(ji,jj,jk) 648 DO jk = 2, jpkm1 !* vertical eddy viscosity at wu- and wv-points 649 DO jj = 2, jpjm1 650 DO ji = fs_2, fs_jpim1 ! vector opt. 651 avmu(ji,jj,jk) = 0.5 * ( avm(ji,jj,jk) + avm(ji+1,jj ,jk) ) * wumask(ji,jj,jk) 652 avmv(ji,jj,jk) = 0.5 * ( avm(ji,jj,jk) + avm(ji ,jj+1,jk) ) * wvmask(ji,jj,jk) 621 653 END DO 622 654 END DO … … 625 657 ! 626 658 IF( nn_pdl == 1 ) THEN !* Prandtl number case: update avt 627 DO j j = 2, jpjm1628 DO j i = fs_2, fs_jpim1 ! vector opt.629 DO j k = mikt(ji,jj)+1, jpkm1659 DO jk = 2, jpkm1 660 DO jj = 2, jpjm1 661 DO ji = fs_2, fs_jpim1 ! vector opt. 630 662 zcoef = avm(ji,jj,jk) * 2._wp * fse3w(ji,jj,jk) * fse3w(ji,jj,jk) 631 663 ! ! shear … … 639 671 !!gm and even better with the use of the "true" ri_crit=0.22222... (this change the results!) 640 672 !!gm zpdlr = MAX( 0.1_wp, ri_crit / MAX( ri_crit , zri ) ) 641 avt(ji,jj,jk) = MAX( zpdlr * avt(ji,jj,jk), avtb_2d(ji,jj) * avtb(jk) ) * tmask(ji,jj,jk)673 avt(ji,jj,jk) = MAX( zpdlr * avt(ji,jj,jk), avtb_2d(ji,jj) * avtb(jk) ) * wmask(ji,jj,jk) 642 674 # if defined key_c1d 643 e_pdl(ji,jj,jk) = zpdlr * tmask(ji,jj,jk) ! c1d configuration : save masked Prandlt number644 e_ric(ji,jj,jk) = zri * tmask(ji,jj,jk) ! c1d config. : save Ri675 e_pdl(ji,jj,jk) = zpdlr * wmask(ji,jj,jk) ! c1d configuration : save masked Prandlt number 676 e_ric(ji,jj,jk) = zri * wmask(ji,jj,jk) ! c1d config. : save Ri 645 677 # endif 646 678 END DO … … 749 781 ! !* set vertical eddy coef. to the background value 750 782 DO jk = 1, jpk 751 avt (:,:,jk) = avtb(jk) * tmask(:,:,jk)752 avm (:,:,jk) = avmb(jk) * tmask(:,:,jk)753 avmu(:,:,jk) = avmb(jk) * umask(:,:,jk)754 avmv(:,:,jk) = avmb(jk) * vmask(:,:,jk)783 avt (:,:,jk) = avtb(jk) * wmask (:,:,jk) 784 avm (:,:,jk) = avmb(jk) * wmask (:,:,jk) 785 avmu(:,:,jk) = avmb(jk) * wumask(:,:,jk) 786 avmv(:,:,jk) = avmb(jk) * wvmask(:,:,jk) 755 787 END DO 756 788 dissl(:,:,:) = 1.e-12_wp … … 814 846 en(:,:,:) = rn_emin * tmask(:,:,:) 815 847 DO jk = 1, jpk ! set the Kz to the background value 816 avt (:,:,jk) = avtb(jk) * tmask(:,:,jk)817 avm (:,:,jk) = avmb(jk) * tmask(:,:,jk)818 avmu(:,:,jk) = avmb(jk) * umask(:,:,jk)819 avmv(:,:,jk) = avmb(jk) * vmask(:,:,jk)848 avt (:,:,jk) = avtb(jk) * wmask (:,:,jk) 849 avm (:,:,jk) = avmb(jk) * wmask (:,:,jk) 850 avmu(:,:,jk) = avmb(jk) * wumask(:,:,jk) 851 avmv(:,:,jk) = avmb(jk) * wvmask(:,:,jk) 820 852 END DO 821 853 ENDIF -
trunk/NEMOGCM/NEMO/OPA_SRC/ZDF/zdftmx.F90
r5021 r5120 126 126 zkz(:,:) = 0.e0 !* Associated potential energy consummed over the whole water column 127 127 DO jk = 2, jpkm1 128 zkz(:,:) = zkz(:,:) + fse3w(:,:,jk) * MAX( 0.e0, rn2(:,:,jk) ) * rau0 * zav_tide(:,:,jk) * tmask(:,:,jk) * tmask(:,:,jk-1)128 zkz(:,:) = zkz(:,:) + fse3w(:,:,jk) * MAX( 0.e0, rn2(:,:,jk) ) * rau0 * zav_tide(:,:,jk) * wmask(:,:,jk) 129 129 END DO 130 130 … … 135 135 END DO 136 136 137 DO j j = 1, jpj !* Here zkz should be equal to en_tmx ==> multiply by en_tmx/zkz to recover en_tmx138 DO j i = 1, jpi139 DO j k = mikt(ji,jj)+1, jpkm1 !* Mutiply by zkz to recover en_tmx, BUT bound by 30/6 ==> zav_tide bound by 300 cm2/s140 zav_tide(ji,jj,jk) = zav_tide(ji,jj,jk) * MIN( zkz(ji,jj), 30./6. ) !kz max = 300 cm2/s137 DO jk = 2, jpkm1 !* Mutiply by zkz to recover en_tmx, BUT bound by 30/6 ==> zav_tide bound by 300 cm2/s 138 DO jj = 1, jpj !* Here zkz should be equal to en_tmx ==> multiply by en_tmx/zkz to recover en_tmx 139 DO ji = 1, jpi 140 zav_tide(ji,jj,jk) = zav_tide(ji,jj,jk) * MIN( zkz(ji,jj), 30./6. ) * wmask(ji,jj,jk) !kz max = 300 cm2/s 141 141 END DO 142 142 END DO … … 166 166 ! ! Update mixing coefs ! 167 167 ! ! ----------------------- ! 168 DO j j = 1, jpj !* Here zkz should be equal to en_tmx ==> multiply by en_tmx/zkz to recover en_tmx169 DO j i = 1, jpi170 DO j k = mikt(ji,jj)+1, jpkm1 !* update momentum & tracer diffusivity with tidal mixing171 avt(ji,jj,jk) = avt(ji,jj,jk) + zav_tide(ji,jj,jk) 172 avm(ji,jj,jk) = avm(ji,jj,jk) + zav_tide(ji,jj,jk) 168 DO jk = 2, jpkm1 !* update momentum & tracer diffusivity with tidal mixing 169 DO jj = 1, jpj !* Here zkz should be equal to en_tmx ==> multiply by en_tmx/zkz to recover en_tmx 170 DO ji = 1, jpi 171 avt(ji,jj,jk) = avt(ji,jj,jk) + zav_tide(ji,jj,jk) * wmask(ji,jj,jk) 172 avm(ji,jj,jk) = avm(ji,jj,jk) + zav_tide(ji,jj,jk) * wmask(ji,jj,jk) 173 173 END DO 174 174 END DO 175 175 END DO 176 176 177 DO j j = 2, jpjm1178 DO j i = fs_2, fs_jpim1 ! vector opt.179 DO j k = mikt(ji,jj)+1, jpkm1 !* update momentum & tracer diffusivity with tidal mixing180 avmu(ji,jj,jk) = avmu(ji,jj,jk) + 0.5 * ( zav_tide(ji,jj,jk) + zav_tide(ji+1,jj ,jk) ) * umask(ji,jj,jk)181 avmv(ji,jj,jk) = avmv(ji,jj,jk) + 0.5 * ( zav_tide(ji,jj,jk) + zav_tide(ji ,jj+1,jk) ) * vmask(ji,jj,jk)177 DO jk = 2, jpkm1 !* update momentum & tracer diffusivity with tidal mixing 178 DO jj = 2, jpjm1 179 DO ji = fs_2, fs_jpim1 ! vector opt. 180 avmu(ji,jj,jk) = avmu(ji,jj,jk) + 0.5 * ( zav_tide(ji,jj,jk) + zav_tide(ji+1,jj ,jk) ) * wumask(ji,jj,jk) 181 avmv(ji,jj,jk) = avmv(ji,jj,jk) + 0.5 * ( zav_tide(ji,jj,jk) + zav_tide(ji ,jj+1,jk) ) * wvmask(ji,jj,jk) 182 182 END DO 183 183 END DO … … 457 457 ztpc = 0.e0 458 458 zpc(:,:,:) = MAX(rn_n2min,rn2(:,:,:)) * zav_tide(:,:,:) 459 DO j j = 1, jpj460 DO j i = 1, jpi461 DO j k= mikt(ji,jj)+1, jpkm1462 ztpc = ztpc + fse3w(ji,jj,jk) * e1t(ji,jj) * e2t(ji,jj) * zpc(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)459 DO jk= 2, jpkm1 460 DO jj = 1, jpj 461 DO ji = 1, jpi 462 ztpc = ztpc + fse3w(ji,jj,jk) * e1t(ji,jj) * e2t(ji,jj) * zpc(ji,jj,jk) * wmask(ji,jj,jk) * tmask_i(ji,jj) 463 463 END DO 464 464 END DO … … 473 473 zav_tide(:,:,:) = MIN( zav_tide(:,:,:), 60.e-4 ) 474 474 zkz(:,:) = 0.e0 475 DO j j = 1, jpj476 DO j i = 1, jpi477 DO j k = mikt(ji,jj)+1, jpkm1478 zkz(ji,jj) = zkz(ji,jj) + fse3w(ji,jj,jk) * MAX( 0.e0, rn2(ji,jj,jk) ) * rau0 * zav_tide(ji,jj,jk)* tmask(ji,jj,jk)475 DO jk = 2, jpkm1 476 DO jj = 1, jpj 477 DO ji = 1, jpi 478 zkz(ji,jj) = zkz(ji,jj) + fse3w(ji,jj,jk) * MAX( 0.e0, rn2(ji,jj,jk) ) * rau0 * zav_tide(ji,jj,jk)* wmask(ji,jj,jk) 479 479 END DO 480 480 END DO … … 498 498 WRITE(numout,*) ' Min de zkz ', ztpc, ' Max = ', maxval(zkz(:,:) ) 499 499 500 DO j j = 1, jpj501 DO j i = 1, jpi502 DO j k = mikt(ji,jj)+1, jpkm1503 zav_tide(ji,jj,jk) = zav_tide(ji,jj,jk) * MIN( zkz(ji,jj), 30./6. ) !kz max = 300 cm2/s500 DO jk = 2, jpkm1 501 DO jj = 1, jpj 502 DO ji = 1, jpi 503 zav_tide(ji,jj,jk) = zav_tide(ji,jj,jk) * MIN( zkz(ji,jj), 30./6. ) * wmask(ji,jj,jk) !kz max = 300 cm2/s 504 504 END DO 505 505 END DO … … 510 510 DO jj = 1, jpj 511 511 DO ji = 1, jpi 512 ztpc = ztpc + fse3w(ji,jj,jk) * e1t(ji,jj) * e2t(ji,jj) * zpc(ji,jj,jk) * tmask(ji,jj,jk) * tmask_i(ji,jj)512 ztpc = ztpc + fse3w(ji,jj,jk) * e1t(ji,jj) * e2t(ji,jj) * zpc(ji,jj,jk) * wmask(ji,jj,jk) * tmask_i(ji,jj) 513 513 END DO 514 514 END DO … … 519 519 DO jk = 1, jpk 520 520 ze_z = SUM( e1t(:,:) * e2t(:,:) * zav_tide(:,:,jk) * tmask_i(:,:) ) & 521 & / MAX( 1.e-20, SUM( e1t(:,:) * e2t(:,:) * tmask (:,:,jk) * tmask_i(:,:) ) )521 & / MAX( 1.e-20, SUM( e1t(:,:) * e2t(:,:) * wmask (:,:,jk) * tmask_i(:,:) ) ) 522 522 ztpc = 1.E50 523 523 DO jj = 1, jpj … … 540 540 END DO 541 541 ze_z = SUM( e1t(:,:) * e2t(:,:) * zkz(:,:) * tmask_i(:,:) ) & 542 & / MAX( 1.e-20, SUM( e1t(:,:) * e2t(:,:) * tmask (:,:,jk) * tmask_i(:,:) ) )542 & / MAX( 1.e-20, SUM( e1t(:,:) * e2t(:,:) * wmask (:,:,jk) * tmask_i(:,:) ) ) 543 543 WRITE(numout,*) ' jk= ', jk,' ', ze_z * 1.e4,' cm2/s' 544 544 END DO … … 546 546 zkz(:,:) = az_tmx(:,:,jk) /rn_n2min 547 547 ze_z = SUM( e1t(:,:) * e2t(:,:) * zkz(:,:) * tmask_i(:,:) ) & 548 & / MAX( 1.e-20, SUM( e1t(:,:) * e2t(:,:) * tmask (:,:,jk) * tmask_i(:,:) ) )548 & / MAX( 1.e-20, SUM( e1t(:,:) * e2t(:,:) * wmask (:,:,jk) * tmask_i(:,:) ) ) 549 549 WRITE(numout,*) 550 550 WRITE(numout,*) ' N2 min - jk= ', jk,' ', ze_z * 1.e4,' cm2/s min= ',MINVAL(zkz)*1.e4, &
Note: See TracChangeset
for help on using the changeset viewer.