- Timestamp:
- 2020-03-26T19:24:53+01:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE
- Files:
-
- 27 edited
-
ASM/asminc.F90 (modified) (3 diffs)
-
BDY/bdydta.F90 (modified) (3 diffs)
-
BDY/bdydyn.F90 (modified) (1 diff)
-
CRS/crsfld.F90 (modified) (2 diffs)
-
CRS/crsini.F90 (modified) (2 diffs)
-
DOM/domzgr_substitute.h90 (modified) (2 diffs)
-
DYN/dynadv_cen2.F90 (modified) (3 diffs)
-
DYN/dynadv_ubs.F90 (modified) (3 diffs)
-
DYN/dynhpg.F90 (modified) (26 diffs)
-
DYN/dynspg_ts.F90 (modified) (5 diffs)
-
DYN/dynzdf.F90 (modified) (21 diffs)
-
ISF/isfcpl.F90 (modified) (8 diffs)
-
ISF/isfdiags.F90 (modified) (1 diff)
-
ISF/isfdynatf.F90 (modified) (3 diffs)
-
ISF/isfhdiv.F90 (modified) (2 diffs)
-
ISF/isfstp.F90 (modified) (5 diffs)
-
ISF/isftbl.F90 (modified) (6 diffs)
-
SBC/sbcice_cice.F90 (modified) (1 diff)
-
TRD/trdglo.F90 (modified) (6 diffs)
-
TRD/trdken.F90 (modified) (1 diff)
-
TRD/trdmxl.F90 (modified) (2 diffs)
-
TRD/trdpen.F90 (modified) (1 diff)
-
TRD/trdtra.F90 (modified) (3 diffs)
-
ZDF/zdfdrg.F90 (modified) (1 diff)
-
ZDF/zdfgls.F90 (modified) (3 diffs)
-
ZDF/zdfosm.F90 (modified) (4 diffs)
-
ZDF/zdftke.F90 (modified) (2 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/ASM/asminc.F90
r12377 r12616 95 95 !! * Substitutions 96 96 # include "do_loop_substitute.h90" 97 # include "domzgr_substitute.h90" 97 98 !!---------------------------------------------------------------------- 98 99 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 417 418 & - e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm) * u_bkginc(ji-1,jj,jk) & 418 419 & + e1v(ji,jj ) * e3v(ji,jj ,jk,Kmm) * v_bkginc(ji,jj ,jk) & 419 & - e1v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm) * v_bkginc(ji,jj-1,jk) ) / e3t(ji,jj,jk,Kmm) 420 & - e1v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm) * v_bkginc(ji,jj-1,jk) ) & 421 & / e3t(ji,jj,jk,Kmm) 420 422 END_2D 421 423 CALL lbc_lnk( 'asminc', zhdiv, 'T', 1. ) ! lateral boundary cond. (no sign change) … … 758 760 ! 759 761 ssh(:,:,Kbb) = ssh(:,:,Kmm) ! Update before fields 762 #if ! defined key_LF 760 763 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 764 #endif 761 765 !!gm why not e3u(:,:,:,Kbb), e3v(:,:,:,Kbb), gdept(:,:,:,Kbb) ???? 762 766 ! -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/BDY/bdydta.F90
r12377 r12616 70 70 !! * Substitutions 71 71 # include "do_loop_substitute.h90" 72 # include "domzgr_substitute.h90" 72 73 !!---------------------------------------------------------------------- 73 74 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 250 251 ij = idx_bdy(jbdy)%nbj(ib,igrd) 251 252 DO ik = 1, jpkm1 252 dta_alias%u2d(ib) = dta_alias%u2d(ib) + e3u(ii,ij,ik,Kmm) * umask(ii,ij,ik) * dta_alias%u3d(ib,ik) 253 dta_alias%u2d(ib) = & 254 & dta_alias%u2d(ib) + e3u(ii,ij,ik,Kmm) * umask(ii,ij,ik) * dta_alias%u3d(ib,ik) 253 255 END DO 254 256 dta_alias%u2d(ib) = dta_alias%u2d(ib) * r1_hu(ii,ij,Kmm) … … 263 265 ij = idx_bdy(jbdy)%nbj(ib,igrd) 264 266 DO ik = 1, jpkm1 265 dta_alias%v2d(ib) = dta_alias%v2d(ib) + e3v(ii,ij,ik,Kmm) * vmask(ii,ij,ik) * dta_alias%v3d(ib,ik) 267 dta_alias%v2d(ib) = & 268 & dta_alias%v2d(ib) + e3v(ii,ij,ik,Kmm) * vmask(ii,ij,ik) * dta_alias%v3d(ib,ik) 266 269 END DO 267 270 dta_alias%v2d(ib) = dta_alias%v2d(ib) * r1_hv(ii,ij,Kmm) -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/BDY/bdydyn.F90
r12377 r12616 35 35 !! Software governed by the CeCILL license (see ./LICENSE) 36 36 !!---------------------------------------------------------------------- 37 # include "domzgr_substitute.h90" 38 37 39 CONTAINS 38 40 -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/CRS/crsfld.F90
r12377 r12616 33 33 !! * Substitutions 34 34 # include "do_loop_substitute.h90" 35 # include "domzgr_substitute.h90" 35 36 !!---------------------------------------------------------------------- 36 37 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 68 69 69 70 ! Depth work arrrays 70 ze3t(:,:,:) = e3t(:,:,:,Kmm) 71 ze3u(:,:,:) = e3u(:,:,:,Kmm) 72 ze3v(:,:,:) = e3v(:,:,:,Kmm) 73 ze3w(:,:,:) = e3w(:,:,:,Kmm) 71 DO jk = 1 , jpk 72 ze3t(:,:,jk) = e3t(:,:,jk,Kmm) 73 ze3u(:,:,jk) = e3u(:,:,jk,Kmm) 74 ze3v(:,:,jk) = e3v(:,:,jk,Kmm) 75 ze3w(:,:,jk) = e3w(:,:,jk,Kmm) 76 END DO 74 77 75 78 IF( kt == nit000 ) THEN -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/CRS/crsini.F90
r12377 r12616 33 33 !! Software governed by the CeCILL license (see ./LICENSE) 34 34 !!---------------------------------------------------------------------- 35 # include "domzgr_substitute.h90" 36 35 37 CONTAINS 36 38 … … 174 176 175 177 ! 178 #if ! defined key_LF 176 179 ze3t(:,:,:) = e3t(:,:,:,Kmm) 177 180 ze3u(:,:,:) = e3u(:,:,:,Kmm) 178 181 ze3v(:,:,:) = e3v(:,:,:,Kmm) 179 182 ze3w(:,:,:) = e3w(:,:,:,Kmm) 183 #else 184 DO jk = 1, jpk 185 ze3t(:,:,jk) = e3t(:,:,jk,Kmm) 186 ze3u(:,:,jk) = e3u(:,:,jk,Kmm) 187 ze3v(:,:,jk) = e3v(:,:,jk,Kmm) 188 ze3w(:,:,jk) = e3w(:,:,jk,Kmm) 189 END DO 190 #endif 180 191 181 192 ! 3.d.2 Surfaces -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DOM/domzgr_substitute.h90
r12590 r12616 11 11 !! Software governed by the CeCILL license (see ./LICENSE) 12 12 !!---------------------------------------------------------------------- 13 !#if defined key_lf 13 #if defined key_LF 14 14 # define e3t(i,j,k,t) (e3t_0(i,j,k)*(1.+r3t(i,j,t)*tmask(i,j,k))) 15 15 # define e3u(i,j,k,t) (e3u_0(i,j,k)*(1.+r3u(i,j,t)*umask(i,j,k))) … … 19 19 # define e3uw(i,j,k,t) (e3uw_0(i,j,k)*(1.+r3u(i,j,t))) 20 20 # define e3vw(i,j,k,t) (e3vw_0(i,j,k)*(1.+r3v(i,j,t))) 21 !#endif21 #endif 22 22 !!---------------------------------------------------------------------- -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DYN/dynadv_cen2.F90
r12377 r12616 28 28 !! * Substitutions 29 29 # include "do_loop_substitute.h90" 30 # include "domzgr_substitute.h90" 30 31 !!---------------------------------------------------------------------- 31 32 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 79 80 DO_2D_00_00 80 81 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zfu_t(ji+1,jj,jk) - zfu_t(ji,jj ,jk) & 81 & + zfv_f(ji ,jj,jk) - zfv_f(ji,jj-1,jk) ) * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm) 82 & + zfv_f(ji ,jj,jk) - zfv_f(ji,jj-1,jk) ) * r1_e1e2u(ji,jj) & 83 & / e3u(ji,jj,jk,Kmm) 82 84 pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - ( zfu_f(ji,jj ,jk) - zfu_f(ji-1,jj,jk) & 83 & + zfv_t(ji,jj+1,jk) - zfv_t(ji ,jj,jk) ) * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,Kmm) 85 & + zfv_t(ji,jj+1,jk) - zfv_t(ji ,jj,jk) ) * r1_e1e2v(ji,jj) & 86 & / e3v(ji,jj,jk,Kmm) 84 87 END_2D 85 88 END DO … … 115 118 END DO 116 119 DO_3D_00_00( 1, jpkm1 ) 117 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm) 118 pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - ( zfv_vw(ji,jj,jk) - zfv_vw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,Kmm) 120 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) & 121 & / e3u(ji,jj,jk,Kmm) 122 pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - ( zfv_vw(ji,jj,jk) - zfv_vw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj) & 123 & / e3v(ji,jj,jk,Kmm) 119 124 END_3D 120 125 ! -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DYN/dynadv_ubs.F90
r12377 r12616 34 34 !! * Substitutions 35 35 # include "do_loop_substitute.h90" 36 # include "domzgr_substitute.h90" 36 37 !!---------------------------------------------------------------------- 37 38 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 169 170 DO_2D_00_00 170 171 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zfu_t(ji+1,jj,jk) - zfu_t(ji,jj ,jk) & 171 & + zfv_f(ji ,jj,jk) - zfv_f(ji,jj-1,jk) ) * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm) 172 & + zfv_f(ji ,jj,jk) - zfv_f(ji,jj-1,jk) ) * r1_e1e2u(ji,jj) & 173 & / e3u(ji,jj,jk,Kmm) 172 174 pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - ( zfu_f(ji,jj ,jk) - zfu_f(ji-1,jj,jk) & 173 & + zfv_t(ji,jj+1,jk) - zfv_t(ji ,jj,jk) ) * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,Kmm) 175 & + zfv_t(ji,jj+1,jk) - zfv_t(ji ,jj,jk) ) * r1_e1e2v(ji,jj) & 176 & / e3v(ji,jj,jk,Kmm) 174 177 END_2D 175 178 END DO … … 206 209 END DO 207 210 DO_3D_00_00( 1, jpkm1 ) 208 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm) 209 pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - ( zfv_vw(ji,jj,jk) - zfv_vw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,Kmm) 211 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) & 212 & / e3u(ji,jj,jk,Kmm) 213 pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - ( zfv_vw(ji,jj,jk) - zfv_vw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj) & 214 & / e3v(ji,jj,jk,Kmm) 210 215 END_3D 211 216 ! -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DYN/dynhpg.F90
r12377 r12616 43 43 USE in_out_manager ! I/O manager 44 44 USE prtctl ! Print control 45 USE lbclnk ! lateral boundary condition 45 USE lbclnk ! lateral boundary condition 46 46 USE lib_mpp ! MPP library 47 47 USE eosbn2 ! compute density … … 76 76 !! * Substitutions 77 77 # include "do_loop_substitute.h90" 78 # include "domzgr_substitute.h90" 79 78 80 !!---------------------------------------------------------------------- 79 81 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 204 206 ! 205 207 IF( ioptio /= 1 ) CALL ctl_stop( 'NO or several hydrostatic pressure gradient options used' ) 206 ! 208 ! 207 209 IF(lwp) THEN 208 210 WRITE(numout,*) … … 217 219 WRITE(numout,*) 218 220 ENDIF 219 ! 221 ! 220 222 END SUBROUTINE dyn_hpg_init 221 223 … … 427 429 zcpx(ji,jj) = 0._wp 428 430 END IF 429 431 430 432 ll_tmp1 = MIN( ssh(ji,jj,Kmm) , ssh(ji,jj+1,Kmm) ) > & 431 433 & MAX( -ht_0(ji,jj) , -ht_0(ji,jj+1) ) .AND. & … … 452 454 DO_2D_00_00 453 455 ! hydrostatic pressure gradient along s-surfaces 454 zhpi(ji,jj,1) = zcoef0 * ( e3w(ji+1,jj ,1,Kmm) * ( znad + rhd(ji+1,jj ,1) ) & 455 & - e3w(ji ,jj ,1,Kmm) * ( znad + rhd(ji ,jj ,1) ) ) * r1_e1u(ji,jj) 456 zhpj(ji,jj,1) = zcoef0 * ( e3w(ji ,jj+1,1,Kmm) * ( znad + rhd(ji ,jj+1,1) ) & 457 & - e3w(ji ,jj ,1,Kmm) * ( znad + rhd(ji ,jj ,1) ) ) * r1_e2v(ji,jj) 456 zhpi(ji,jj,1) = & 457 & zcoef0 * ( e3w(ji+1,jj ,1,Kmm) * ( znad + rhd(ji+1,jj ,1) ) & 458 & - e3w(ji ,jj ,1,Kmm) * ( znad + rhd(ji ,jj ,1) ) ) & 459 & * r1_e1u(ji,jj) 460 zhpj(ji,jj,1) = & 461 & zcoef0 * ( e3w(ji ,jj+1,1,Kmm) * ( znad + rhd(ji ,jj+1,1) ) & 462 & - e3w(ji ,jj ,1,Kmm) * ( znad + rhd(ji ,jj ,1) ) ) & 463 & * r1_e2v(ji,jj) 458 464 ! s-coordinate pressure gradient correction 459 465 zuap = -zcoef0 * ( rhd (ji+1,jj,1) + rhd (ji,jj,1) + 2._wp * znad ) & … … 464 470 IF( ln_wd_il ) THEN 465 471 zhpi(ji,jj,1) = zhpi(ji,jj,1) * zcpx(ji,jj) 466 zhpj(ji,jj,1) = zhpj(ji,jj,1) * zcpy(ji,jj) 472 zhpj(ji,jj,1) = zhpj(ji,jj,1) * zcpy(ji,jj) 467 473 zuap = zuap * zcpx(ji,jj) 468 474 zvap = zvap * zcpy(ji,jj) … … 478 484 ! hydrostatic pressure gradient along s-surfaces 479 485 zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + zcoef0 * r1_e1u(ji,jj) & 480 & * ( e3w(ji+1,jj,jk,Kmm) * ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) + 2*znad )&481 & 486 & * ( e3w(ji+1,jj,jk,Kmm) * ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) + 2*znad ) & 487 & - e3w(ji ,jj,jk,Kmm) * ( rhd(ji ,jj,jk) + rhd(ji ,jj,jk-1) + 2*znad ) ) 482 488 zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) + zcoef0 * r1_e2v(ji,jj) & 483 & 484 & 489 & * ( e3w(ji,jj+1,jk,Kmm) * ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) + 2*znad ) & 490 & - e3w(ji,jj ,jk,Kmm) * ( rhd(ji,jj, jk) + rhd(ji,jj ,jk-1) + 2*znad ) ) 485 491 ! s-coordinate pressure gradient correction 486 492 zuap = -zcoef0 * ( rhd (ji+1,jj ,jk) + rhd (ji,jj,jk) + 2._wp * znad ) & … … 491 497 IF( ln_wd_il ) THEN 492 498 zhpi(ji,jj,jk) = zhpi(ji,jj,jk) * zcpx(ji,jj) 493 zhpj(ji,jj,jk) = zhpj(ji,jj,jk) * zcpy(ji,jj) 499 zhpj(ji,jj,jk) = zhpj(ji,jj,jk) * zcpy(ji,jj) 494 500 zuap = zuap * zcpx(ji,jj) 495 501 zvap = zvap * zcpy(ji,jj) … … 522 528 !! pvv(:,:,:,Krhs) = pvv(:,:,:,Krhs) - 1/e2v * zhpj 523 529 !! iceload is added 524 !! 530 !! 525 531 !! ** Action : - Update (puu(:,:,:,Krhs),pvv(:,:,:,Krhs)) with the now hydrastatic pressure trend 526 532 !!---------------------------------------------------------------------- … … 540 546 znad=1._wp ! To use density and not density anomaly 541 547 ! 542 ! ! iniitialised to 0. zhpi zhpi 548 ! ! iniitialised to 0. zhpi zhpi 543 549 zhpi(:,:,:) = 0._wp ; zhpj(:,:,:) = 0._wp 544 550 … … 554 560 CALL eos( zts_top, risfdep, zrhdtop_oce ) 555 561 556 !================================================================================== 557 !===== Compute surface value ===================================================== 562 !================================================================================== 563 !===== Compute surface value ===================================================== 558 564 !================================================================================== 559 565 DO_2D_00_00 … … 567 573 & - 0.5_wp * e3w(ji,jj,ikt,Kmm) & 568 574 & * ( 2._wp * znad + rhd(ji,jj,ikt) + zrhdtop_oce(ji,jj) ) & 569 & + ( risfload(ji+1,jj) - risfload(ji,jj)) ) 575 & + ( risfload(ji+1,jj) - risfload(ji,jj)) ) 570 576 zhpj(ji,jj,1) = zcoef0 / e2v(ji,jj) * ( 0.5_wp * e3w(ji,jj+1,iktp1j,Kmm) & 571 577 & * ( 2._wp * znad + rhd(ji,jj+1,iktp1j) + zrhdtop_oce(ji,jj+1) ) & 572 & - 0.5_wp * e3w(ji,jj,ikt,Kmm) & 578 & - 0.5_wp * e3w(ji,jj,ikt,Kmm) & 573 579 & * ( 2._wp * znad + rhd(ji,jj,ikt) + zrhdtop_oce(ji,jj) ) & 574 & + ( risfload(ji,jj+1) - risfload(ji,jj)) ) 580 & + ( risfload(ji,jj+1) - risfload(ji,jj)) ) 575 581 ! s-coordinate pressure gradient correction (=0 if z coordinate) 576 582 zuap = -zcoef0 * ( rhd (ji+1,jj,1) + rhd (ji,jj,1) + 2._wp * znad ) & … … 582 588 pvv(ji,jj,1,Krhs) = pvv(ji,jj,1,Krhs) + (zhpj(ji,jj,1) + zvap) * vmask(ji,jj,1) 583 589 END_2D 584 !================================================================================== 585 !===== Compute interior value ===================================================== 590 !================================================================================== 591 !===== Compute interior value ===================================================== 586 592 !================================================================================== 587 593 ! interior value (2=<jk=<jpkm1) … … 589 595 ! hydrostatic pressure gradient along s-surfaces 590 596 zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + zcoef0 / e1u(ji,jj) & 591 & * ( e3w(ji+1,jj,jk,Kmm) * ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) + 2*znad ) * wmask(ji+1,jj,jk) & 592 & - e3w(ji ,jj,jk,Kmm) * ( rhd(ji ,jj,jk) + rhd(ji ,jj,jk-1) + 2*znad ) * wmask(ji ,jj,jk) ) 597 & * ( e3w(ji+1,jj,jk,Kmm) & 598 & * ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) + 2*znad ) * wmask(ji+1,jj,jk) & 599 & - e3w(ji ,jj,jk,Kmm) & 600 & * ( rhd(ji ,jj,jk) + rhd(ji ,jj,jk-1) + 2*znad ) * wmask(ji ,jj,jk) ) 593 601 zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) + zcoef0 / e2v(ji,jj) & 594 & * ( e3w(ji,jj+1,jk,Kmm) * ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) + 2*znad ) * wmask(ji,jj+1,jk) & 595 & - e3w(ji,jj ,jk,Kmm) * ( rhd(ji,jj, jk) + rhd(ji,jj ,jk-1) + 2*znad ) * wmask(ji,jj ,jk) ) 602 & * ( e3w(ji,jj+1,jk,Kmm) & 603 & * ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) + 2*znad ) * wmask(ji,jj+1,jk) & 604 & - e3w(ji,jj ,jk,Kmm) & 605 & * ( rhd(ji,jj, jk) + rhd(ji,jj ,jk-1) + 2*znad ) * wmask(ji,jj ,jk) ) 596 606 ! s-coordinate pressure gradient correction 597 607 zuap = -zcoef0 * ( rhd (ji+1,jj ,jk) + rhd (ji,jj,jk) + 2._wp * znad ) & … … 650 660 zcpx(ji,jj) = 0._wp 651 661 END IF 652 662 653 663 ll_tmp1 = MIN( ssh(ji,jj,Kmm) , ssh(ji,jj+1,Kmm) ) > & 654 664 & MAX( -ht_0(ji,jj) , -ht_0(ji,jj+1) ) .AND. & … … 771 781 !------------------------------------------------------------- 772 782 773 !!bug gm : e3w-gde3w = 0.5*e3w .... and gde3w(2)-gde3w(1)=e3w( 2) .... to be verified783 !!bug gm : e3w-gde3w = 0.5*e3w .... and gde3w(2)-gde3w(1)=e3w(:,:,2,:) .... to be verified 774 784 ! true if gde3w is really defined as the sum of the e3w scale factors as, it seems to me, it should be 775 785 … … 825 835 IF( ln_wd_il ) THEN 826 836 zhpi(ji,jj,1) = zhpi(ji,jj,1) * zcpx(ji,jj) 827 zhpj(ji,jj,1) = zhpj(ji,jj,1) * zcpy(ji,jj) 837 zhpj(ji,jj,1) = zhpj(ji,jj,1) * zcpy(ji,jj) 828 838 ENDIF 829 839 ! add to the general momentum trend … … 845 855 IF( ln_wd_il ) THEN 846 856 zhpi(ji,jj,jk) = zhpi(ji,jj,jk) * zcpx(ji,jj) 847 zhpj(ji,jj,jk) = zhpj(ji,jj,jk) * zcpy(ji,jj) 857 zhpj(ji,jj,jk) = zhpj(ji,jj,jk) * zcpy(ji,jj) 848 858 ENDIF 849 859 ! add to the general momentum trend … … 916 926 zcpx(ji,jj) = ABS( (ssh(ji+1,jj,Kmm) + ht_0(ji+1,jj) - ssh(ji,jj,Kmm) - ht_0(ji,jj)) & 917 927 & / (ssh(ji+1,jj,Kmm) - ssh(ji ,jj,Kmm)) ) 918 928 919 929 zcpx(ji,jj) = max(min( zcpx(ji,jj) , 1.0_wp),0.0_wp) 920 930 ELSE 921 931 zcpx(ji,jj) = 0._wp 922 932 END IF 923 933 924 934 ll_tmp1 = MIN( ssh(ji,jj,Kmm) , ssh(ji,jj+1,Kmm) ) > & 925 935 & MAX( -ht_0(ji,jj) , -ht_0(ji,jj+1) ) .AND. & … … 1002 1012 !!gm BUG ? if it is ssh at u- & v-point then it should be: 1003 1013 ! zsshu_n(ji,jj) = (e1e2t(ji,jj) * ssh(ji,jj,Kmm) + e1e2t(ji+1,jj) * ssh(ji+1,jj,Kmm)) * & 1004 ! & r1_e1e2u(ji,jj) * umask(ji,jj,1) * 0.5_wp 1014 ! & r1_e1e2u(ji,jj) * umask(ji,jj,1) * 0.5_wp 1005 1015 ! zsshv_n(ji,jj) = (e1e2t(ji,jj) * ssh(ji,jj,Kmm) + e1e2t(ji,jj+1) * ssh(ji,jj+1,Kmm)) * & 1006 ! & r1_e1e2v(ji,jj) * vmask(ji,jj,1) * 0.5_wp 1016 ! & r1_e1e2v(ji,jj) * vmask(ji,jj,1) * 0.5_wp 1007 1017 !!gm not this: 1008 1018 zsshu_n(ji,jj) = (e1e2u(ji,jj) * ssh(ji,jj,Kmm) + e1e2u(ji+1, jj) * ssh(ji+1,jj,Kmm)) * & 1009 & r1_e1e2u(ji,jj) * umask(ji,jj,1) * 0.5_wp 1019 & r1_e1e2u(ji,jj) * umask(ji,jj,1) * 0.5_wp 1010 1020 zsshv_n(ji,jj) = (e1e2v(ji,jj) * ssh(ji,jj,Kmm) + e1e2v(ji+1, jj) * ssh(ji,jj+1,Kmm)) * & 1011 & r1_e1e2v(ji,jj) * vmask(ji,jj,1) * 0.5_wp 1021 & r1_e1e2v(ji,jj) * vmask(ji,jj,1) * 0.5_wp 1012 1022 END_2D 1013 1023 … … 1015 1025 1016 1026 DO_2D_00_00 1017 zu(ji,jj,1) = - ( e3u(ji,jj,1,Kmm) - zsshu_n(ji,jj) * znad) 1027 zu(ji,jj,1) = - ( e3u(ji,jj,1,Kmm) - zsshu_n(ji,jj) * znad) 1018 1028 zv(ji,jj,1) = - ( e3v(ji,jj,1,Kmm) - zsshv_n(ji,jj) * znad) 1019 1029 END_2D … … 1098 1108 zdpdx2 = zdpdx2 * zcpx(ji,jj) * wdrampu(ji,jj) 1099 1109 ENDIF 1100 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + (zdpdx1 + zdpdx2) * umask(ji,jj,jk) 1110 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + (zdpdx1 + zdpdx2) * umask(ji,jj,jk) 1101 1111 ENDIF 1102 1112 … … 1154 1164 ENDIF 1155 1165 IF( ln_wd_il ) THEN 1156 zdpdy1 = zdpdy1 * zcpy(ji,jj) * wdrampv(ji,jj) 1157 zdpdy2 = zdpdy2 * zcpy(ji,jj) * wdrampv(ji,jj) 1166 zdpdy1 = zdpdy1 * zcpy(ji,jj) * wdrampv(ji,jj) 1167 zdpdy2 = zdpdy2 * zcpy(ji,jj) * wdrampv(ji,jj) 1158 1168 ENDIF 1159 1169 … … 1189 1199 !!---------------------------------------------------------------------- 1190 1200 ! 1191 !!gm WHAT !!!!! THIS IS VERY DANGEROUS !!!!! 1201 !!gm WHAT !!!!! THIS IS VERY DANGEROUS !!!!! 1192 1202 jpi = size(fsp,1) 1193 1203 jpj = size(fsp,2) … … 1359 1369 !!====================================================================== 1360 1370 END MODULE dynhpg 1361 -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DYN/dynspg_ts.F90
r12377 r12616 87 87 !! * Substitutions 88 88 # include "do_loop_substitute.h90" 89 # include "domzgr_substitute.h90" 89 90 !!---------------------------------------------------------------------- 90 91 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 161 162 REAL(wp), DIMENSION(jpi,jpj) :: zCdU_u, zCdU_v ! top/bottom stress at u- & v-points 162 163 REAL(wp), DIMENSION(jpi,jpj) :: zhU, zhV ! fluxes 164 REAL(wp), DIMENSION(jpi, jpj, jpk) :: ze3u, ze3v 163 165 ! 164 166 REAL(wp) :: zwdramp ! local scalar - only used if ln_wd_dl = .True. … … 226 228 ! != zu_frc = 1/H e3*d/dt(Ua) =! (Vertical mean of Ua, the 3D trends) 227 229 ! ! --------------------------- ! 228 zu_frc(:,:) = SUM( e3u(:,:,:,Kmm) * uu(:,:,:,Krhs) * umask(:,:,:) , DIM=3 ) * r1_hu(:,:,Kmm) 229 zv_frc(:,:) = SUM( e3v(:,:,:,Kmm) * vv(:,:,:,Krhs) * vmask(:,:,:) , DIM=3 ) * r1_hv(:,:,Kmm) 230 DO jk = 1 , jpk 231 ze3u(:,:,jk) = e3u(:,:,jk,Kmm) 232 ze3v(:,:,jk) = e3v(:,:,jk,Kmm) 233 END DO 234 ! 235 zu_frc(:,:) = SUM( ze3u(:,:,:) * uu(:,:,:,Krhs) * umask(:,:,:) , DIM=3 ) * r1_hu(:,:,Kmm) 236 zv_frc(:,:) = SUM( ze3v(:,:,:) * vv(:,:,:,Krhs) * vmask(:,:,:) , DIM=3 ) * r1_hv(:,:,Kmm) 230 237 ! 231 238 ! … … 1087 1094 ! 1088 1095 SELECT CASE( nvor_scheme ) 1089 CASE( np_EEN ) != EEN scheme using e3f (energy & enstrophy scheme)1096 CASE( np_EEN ) != EEN scheme using e3f energy & enstrophy scheme 1090 1097 SELECT CASE( nn_een_e3f ) !* ff_f/e3 at F-point 1091 1098 CASE ( 0 ) ! original formulation (masked averaging of e3t divided by 4) … … 1114 1121 END_2D 1115 1122 ! 1116 CASE( np_EET ) != EEN scheme using e3t (energy conserving scheme)1123 CASE( np_EET ) != EEN scheme using e3t energy conserving scheme 1117 1124 ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp 1118 1125 DO_2D_01_01 -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/DYN/dynzdf.F90
r12377 r12616 38 38 !! * Substitutions 39 39 # include "do_loop_substitute.h90" 40 # include "domzgr_substitute.h90" 40 41 !!---------------------------------------------------------------------- 41 42 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 55 56 !! ** Method : - Leap-Frog time stepping on all trends but the vertical mixing 56 57 !! u(after) = u(before) + 2*dt * u(rhs) vector form or linear free surf. 57 !! u(after) = ( e3u_b*u(before) + 2*dt * e3u_n*u(rhs) ) / e3u (after)otherwise58 !! u(after) = ( e3u_b*u(before) + 2*dt * e3u_n*u(rhs) ) / e3u_after otherwise 58 59 !! - update the after velocity with the implicit vertical mixing. 59 60 !! This requires to solver the following system: 60 !! u(after) = u(after) + 1/e3u (after) dk+1[ mi(avm) / e3uw(after)dk[ua] ]61 !! u(after) = u(after) + 1/e3u_after dk+1[ mi(avm) / e3uw_after dk[ua] ] 61 62 !! with the following surface/top/bottom boundary condition: 62 63 !! surface: wind stress input (averaged over kt-1/2 & kt+1/2) … … 117 118 ELSE ! applied on thickness weighted velocity 118 119 DO jk = 1, jpkm1 119 puu(:,:,jk,Kaa) = ( e3u(:,:,jk,Kbb) * puu(:,:,jk,Kbb) & 120 & + r2dt * e3u(:,:,jk,Kmm) * puu(:,:,jk,Krhs) ) / e3u(:,:,jk,Kaa) * umask(:,:,jk) 121 pvv(:,:,jk,Kaa) = ( e3v(:,:,jk,Kbb) * pvv(:,:,jk,Kbb) & 122 & + r2dt * e3v(:,:,jk,Kmm) * pvv(:,:,jk,Krhs) ) / e3v(:,:,jk,Kaa) * vmask(:,:,jk) 120 puu(:,:,jk,Kaa) = ( e3u(:,:,jk,Kbb) * puu(:,:,jk,Kbb) & 121 & + r2dt * e3u(:,:,jk,Kmm) * puu(:,:,jk,Krhs) ) & 122 & / e3u(:,:,jk,Kaa) * umask(:,:,jk) 123 pvv(:,:,jk,Kaa) = ( e3v(:,:,jk,Kbb) * pvv(:,:,jk,Kbb) & 124 & + r2dt * e3v(:,:,jk,Kmm) * pvv(:,:,jk,Krhs) ) & 125 & / e3v(:,:,jk,Kaa) * vmask(:,:,jk) 123 126 END DO 124 127 ENDIF … … 136 139 iku = mbku(ji,jj) ! ocean bottom level at u- and v-points 137 140 ikv = mbkv(ji,jj) ! (deepest ocean u- and v-points) 138 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,iku,Kmm) + r_vvl * e3u(ji,jj,iku,Kaa) 139 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,ikv,Kmm) + r_vvl * e3v(ji,jj,ikv,Kaa) 141 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,iku,Kmm) & 142 & + r_vvl * e3u(ji,jj,iku,Kaa) 143 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,ikv,Kmm) & 144 & + r_vvl * e3v(ji,jj,ikv,Kaa) 140 145 puu(ji,jj,iku,Kaa) = puu(ji,jj,iku,Kaa) + r2dt * 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * uu_b(ji,jj,Kaa) / ze3ua 141 146 pvv(ji,jj,ikv,Kaa) = pvv(ji,jj,ikv,Kaa) + r2dt * 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * vv_b(ji,jj,Kaa) / ze3va … … 145 150 iku = miku(ji,jj) ! top ocean level at u- and v-points 146 151 ikv = mikv(ji,jj) ! (first wet ocean u- and v-points) 147 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,iku,Kmm) + r_vvl * e3u(ji,jj,iku,Kaa) 148 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,ikv,Kmm) + r_vvl * e3v(ji,jj,ikv,Kaa) 152 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,iku,Kmm) & 153 & + r_vvl * e3u(ji,jj,iku,Kaa) 154 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,ikv,Kmm) & 155 & + r_vvl * e3v(ji,jj,ikv,Kaa) 149 156 puu(ji,jj,iku,Kaa) = puu(ji,jj,iku,Kaa) + r2dt * 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * uu_b(ji,jj,Kaa) / ze3ua 150 157 pvv(ji,jj,ikv,Kaa) = pvv(ji,jj,ikv,Kaa) + r2dt * 0.5*( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) * vv_b(ji,jj,Kaa) / ze3va … … 161 168 CASE( np_lap_i ) ! rotated lateral mixing: add its vertical mixing (akzu) 162 169 DO_3D_00_00( 1, jpkm1 ) 163 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,jk,Kmm) + r_vvl * e3u(ji,jj,jk,Kaa) ! after scale factor at U-point 170 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,jk,Kmm) & 171 & + r_vvl * e3u(ji,jj,jk,Kaa) ! after scale factor at U-point 164 172 zzwi = - zdt * ( avm(ji+1,jj,jk ) + avm(ji,jj,jk ) + akzu(ji,jj,jk ) ) & 165 173 & / ( ze3ua * e3uw(ji,jj,jk ,Kmm) ) * wumask(ji,jj,jk ) … … 174 182 CASE DEFAULT ! iso-level lateral mixing 175 183 DO_3D_00_00( 1, jpkm1 ) 176 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,jk,Kmm) + r_vvl * e3u(ji,jj,jk,Kaa) ! after scale factor at U-point 177 zzwi = - zdt * ( avm(ji+1,jj,jk ) + avm(ji,jj,jk ) ) / ( ze3ua * e3uw(ji,jj,jk ,Kmm) ) * wumask(ji,jj,jk ) 178 zzws = - zdt * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) ) / ( ze3ua * e3uw(ji,jj,jk+1,Kmm) ) * wumask(ji,jj,jk+1) 184 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,jk,Kmm) & ! after scale factor at U-point 185 & + r_vvl * e3u(ji,jj,jk,Kaa) 186 zzwi = - zdt * ( avm(ji+1,jj,jk ) + avm(ji,jj,jk ) ) & 187 & / ( ze3ua * e3uw(ji,jj,jk ,Kmm) ) * wumask(ji,jj,jk ) 188 zzws = - zdt * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) ) & 189 & / ( ze3ua * e3uw(ji,jj,jk+1,Kmm) ) * wumask(ji,jj,jk+1) 179 190 zWui = ( wi(ji,jj,jk ) + wi(ji+1,jj,jk ) ) / ze3ua 180 191 zWus = ( wi(ji,jj,jk+1) + wi(ji+1,jj,jk+1) ) / ze3ua … … 186 197 DO_2D_00_00 187 198 zwi(ji,jj,1) = 0._wp 188 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,1,Kmm) + r_vvl * e3u(ji,jj,1,Kaa) 189 zzws = - zdt * ( avm(ji+1,jj,2) + avm(ji ,jj,2) ) / ( ze3ua * e3uw(ji,jj,2,Kmm) ) * wumask(ji,jj,2) 199 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,1,Kmm) & 200 & + r_vvl * e3u(ji,jj,1,Kaa) 201 zzws = - zdt * ( avm(ji+1,jj,2) + avm(ji ,jj,2) ) & 202 & / ( ze3ua * e3uw(ji,jj,2,Kmm) ) * wumask(ji,jj,2) 190 203 zWus = ( wi(ji ,jj,2) + wi(ji+1,jj,2) ) / ze3ua 191 204 zws(ji,jj,1 ) = zzws - zdt * MAX( zWus, 0._wp ) … … 196 209 CASE( np_lap_i ) ! rotated lateral mixing: add its vertical mixing (akzu) 197 210 DO_3D_00_00( 1, jpkm1 ) 198 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,jk,Kmm) + r_vvl * e3u(ji,jj,jk,Kaa) ! after scale factor at U-point 211 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,jk,Kmm) & 212 & + r_vvl * e3u(ji,jj,jk,Kaa) ! after scale factor at U-point 199 213 zzwi = - zdt * ( avm(ji+1,jj,jk ) + avm(ji,jj,jk ) + akzu(ji,jj,jk ) ) & 200 214 & / ( ze3ua * e3uw(ji,jj,jk ,Kmm) ) * wumask(ji,jj,jk ) … … 207 221 CASE DEFAULT ! iso-level lateral mixing 208 222 DO_3D_00_00( 1, jpkm1 ) 209 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,jk,Kmm) + r_vvl * e3u(ji,jj,jk,Kaa) ! after scale factor at U-point 210 zzwi = - zdt * ( avm(ji+1,jj,jk ) + avm(ji,jj,jk ) ) / ( ze3ua * e3uw(ji,jj,jk ,Kmm) ) * wumask(ji,jj,jk ) 211 zzws = - zdt * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) ) / ( ze3ua * e3uw(ji,jj,jk+1,Kmm) ) * wumask(ji,jj,jk+1) 223 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,jk,Kmm) & 224 & + r_vvl * e3u(ji,jj,jk,Kaa) ! after scale factor at U-point 225 zzwi = - zdt * ( avm(ji+1,jj,jk ) + avm(ji,jj,jk ) ) & 226 & / ( ze3ua * e3uw(ji,jj,jk ,Kmm) ) * wumask(ji,jj,jk ) 227 zzws = - zdt * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) ) & 228 & / ( ze3ua * e3uw(ji,jj,jk+1,Kmm) ) * wumask(ji,jj,jk+1) 212 229 zwi(ji,jj,jk) = zzwi 213 230 zws(ji,jj,jk) = zzws … … 231 248 DO_2D_00_00 232 249 iku = mbku(ji,jj) ! ocean bottom level at u- and v-points 233 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,iku,Kmm) + r_vvl * e3u(ji,jj,iku,Kaa) ! after scale factor at T-point 250 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,iku,Kmm) & 251 & + r_vvl * e3u(ji,jj,iku,Kaa) ! after scale factor at T-point 234 252 zwd(ji,jj,iku) = zwd(ji,jj,iku) - r2dt * 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) / ze3ua 235 253 END_2D … … 238 256 !!gm top Cd is masked (=0 outside cavities) no need of test on mik>=2 ==>> it has been suppressed 239 257 iku = miku(ji,jj) ! ocean top level at u- and v-points 240 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,iku,Kmm) + r_vvl * e3u(ji,jj,iku,Kaa) ! after scale factor at T-point 258 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,iku,Kmm) & 259 & + r_vvl * e3u(ji,jj,iku,Kaa) ! after scale factor at T-point 241 260 zwd(ji,jj,iku) = zwd(ji,jj,iku) - r2dt * 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) / ze3ua 242 261 END_2D … … 264 283 ! 265 284 DO_2D_00_00 266 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,1,Kmm) + r_vvl * e3u(ji,jj,1,Kaa) 285 ze3ua = ( 1._wp - r_vvl ) * e3u(ji,jj,1,Kmm) & 286 & + r_vvl * e3u(ji,jj,1,Kaa) 267 287 puu(ji,jj,1,Kaa) = puu(ji,jj,1,Kaa) + r2dt * 0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) ) & 268 288 & / ( ze3ua * rau0 ) * umask(ji,jj,1) … … 287 307 CASE( np_lap_i ) ! rotated lateral mixing: add its vertical mixing (akzv) 288 308 DO_3D_00_00( 1, jpkm1 ) 289 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,jk,Kmm) + r_vvl * e3v(ji,jj,jk,Kaa) ! after scale factor at V-point 309 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,jk,Kmm) & 310 & + r_vvl * e3v(ji,jj,jk,Kaa) ! after scale factor at V-point 290 311 zzwi = - zdt * ( avm(ji,jj+1,jk ) + avm(ji,jj,jk ) + akzv(ji,jj,jk ) ) & 291 312 & / ( ze3va * e3vw(ji,jj,jk ,Kmm) ) * wvmask(ji,jj,jk ) … … 300 321 CASE DEFAULT ! iso-level lateral mixing 301 322 DO_3D_00_00( 1, jpkm1 ) 302 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,jk,Kmm) + r_vvl * e3v(ji,jj,jk,Kaa) ! after scale factor at V-point 303 zzwi = - zdt * ( avm(ji,jj+1,jk ) + avm(ji,jj,jk ) ) / ( ze3va * e3vw(ji,jj,jk ,Kmm) ) * wvmask(ji,jj,jk ) 304 zzws = - zdt * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) ) / ( ze3va * e3vw(ji,jj,jk+1,Kmm) ) * wvmask(ji,jj,jk+1) 323 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,jk,Kmm) & 324 & + r_vvl * e3v(ji,jj,jk,Kaa) ! after scale factor at V-point 325 zzwi = - zdt * ( avm(ji,jj+1,jk ) + avm(ji,jj,jk ) ) & 326 & / ( ze3va * e3vw(ji,jj,jk ,Kmm) ) * wvmask(ji,jj,jk ) 327 zzws = - zdt * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) ) & 328 & / ( ze3va * e3vw(ji,jj,jk+1,Kmm) ) * wvmask(ji,jj,jk+1) 305 329 zWvi = ( wi(ji,jj,jk ) + wi(ji,jj+1,jk ) ) / ze3va 306 330 zWvs = ( wi(ji,jj,jk+1) + wi(ji,jj+1,jk+1) ) / ze3va … … 312 336 DO_2D_00_00 313 337 zwi(ji,jj,1) = 0._wp 314 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,1,Kmm) + r_vvl * e3v(ji,jj,1,Kaa) 315 zzws = - zdt * ( avm(ji,jj+1,2) + avm(ji,jj,2) ) / ( ze3va * e3vw(ji,jj,2,Kmm) ) * wvmask(ji,jj,2) 338 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,1,Kmm) & 339 & + r_vvl * e3v(ji,jj,1,Kaa) 340 zzws = - zdt * ( avm(ji,jj+1,2) + avm(ji,jj,2) ) & 341 & / ( ze3va * e3vw(ji,jj,2,Kmm) ) * wvmask(ji,jj,2) 316 342 zWvs = ( wi(ji,jj ,2) + wi(ji,jj+1,2) ) / ze3va 317 343 zws(ji,jj,1 ) = zzws - zdt * MAX( zWvs, 0._wp ) … … 322 348 CASE( np_lap_i ) ! rotated lateral mixing: add its vertical mixing (akzu) 323 349 DO_3D_00_00( 1, jpkm1 ) 324 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,jk,Kmm) + r_vvl * e3v(ji,jj,jk,Kaa) ! after scale factor at V-point 350 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,jk,Kmm) & 351 & + r_vvl * e3v(ji,jj,jk,Kaa) ! after scale factor at V-point 325 352 zzwi = - zdt * ( avm(ji,jj+1,jk ) + avm(ji,jj,jk ) + akzv(ji,jj,jk ) ) & 326 353 & / ( ze3va * e3vw(ji,jj,jk ,Kmm) ) * wvmask(ji,jj,jk ) … … 333 360 CASE DEFAULT ! iso-level lateral mixing 334 361 DO_3D_00_00( 1, jpkm1 ) 335 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,jk,Kmm) + r_vvl * e3v(ji,jj,jk,Kaa) ! after scale factor at V-point 336 zzwi = - zdt * ( avm(ji,jj+1,jk ) + avm(ji,jj,jk ) ) / ( ze3va * e3vw(ji,jj,jk ,Kmm) ) * wvmask(ji,jj,jk ) 337 zzws = - zdt * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) ) / ( ze3va * e3vw(ji,jj,jk+1,Kmm) ) * wvmask(ji,jj,jk+1) 362 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,jk,Kmm) & 363 & + r_vvl * e3v(ji,jj,jk,Kaa) ! after scale factor at V-point 364 zzwi = - zdt * ( avm(ji,jj+1,jk ) + avm(ji,jj,jk ) ) & 365 & / ( ze3va * e3vw(ji,jj,jk ,Kmm) ) * wvmask(ji,jj,jk ) 366 zzws = - zdt * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) ) & 367 & / ( ze3va * e3vw(ji,jj,jk+1,Kmm) ) * wvmask(ji,jj,jk+1) 338 368 zwi(ji,jj,jk) = zzwi 339 369 zws(ji,jj,jk) = zzws … … 356 386 DO_2D_00_00 357 387 ikv = mbkv(ji,jj) ! (deepest ocean u- and v-points) 358 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,ikv,Kmm) + r_vvl * e3v(ji,jj,ikv,Kaa) ! after scale factor at T-point 388 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,ikv,Kmm) & 389 & + r_vvl * e3v(ji,jj,ikv,Kaa) ! after scale factor at T-point 359 390 zwd(ji,jj,ikv) = zwd(ji,jj,ikv) - r2dt * 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) / ze3va 360 391 END_2D … … 362 393 DO_2D_00_00 363 394 ikv = mikv(ji,jj) ! (first wet ocean u- and v-points) 364 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,ikv,Kmm) + r_vvl * e3v(ji,jj,ikv,Kaa) ! after scale factor at T-point 395 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,ikv,Kmm) & 396 & + r_vvl * e3v(ji,jj,ikv,Kaa) ! after scale factor at T-point 365 397 zwd(ji,jj,ikv) = zwd(ji,jj,ikv) - r2dt * 0.5*( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) / ze3va 366 398 END_2D … … 388 420 ! 389 421 DO_2D_00_00 390 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,1,Kmm) + r_vvl * e3v(ji,jj,1,Kaa) 422 ze3va = ( 1._wp - r_vvl ) * e3v(ji,jj,1,Kmm) & 423 & + r_vvl * e3v(ji,jj,1,Kaa) 391 424 pvv(ji,jj,1,Kaa) = pvv(ji,jj,1,Kaa) + r2dt * 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) ) & 392 425 & / ( ze3va * rau0 ) * vmask(ji,jj,1) -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/ISF/isfcpl.F90
r12353 r12616 15 15 USE isfutils, ONLY : debug 16 16 USE lib_mpp , ONLY: mpp_sum, mpp_max ! mpp routine 17 #if ! defined key_LF 17 18 USE domvvl , ONLY: dom_vvl_zgr ! vertical scale factor interpolation 19 #else 20 USE domqe , ONLY: dom_qe_zgr ! vertical scale factor interpolation 21 #endif 18 22 USE domngb , ONLY: dom_ngb ! find the closest grid point from a given lon/lat position 19 23 ! … … 43 47 !! * Substitutions 44 48 # include "do_loop_substitute.h90" 49 # include "domzgr_substitute.h90" 45 50 !!---------------------------------------------------------------------- 46 51 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 112 117 vv (:,:,:,Kbb) = vv (:,:,:,Kmm) 113 118 ssh (:,:,Kbb) = ssh (:,:,Kmm) 119 #if ! defined key_LF 114 120 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 115 121 #endif 116 122 ! prepare writing restart 117 123 IF( lwxios ) THEN … … 135 141 INTEGER, INTENT(in) :: Kmm ! ocean time level index 136 142 !!---------------------------------------------------------------------- 143 INTEGER :: jk ! loop index 144 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t, ze3u, ze3v ! e3t , e3u, e3v 145 !!---------------------------------------------------------------------- 146 ! 147 DO jk = 1, jpkm1 148 ze3t(:,:,jk) = e3t(:,:,jk,Kmm) 149 ze3u(:,:,jk) = e3u(:,:,jk,Kmm) 150 ze3v(:,:,jk) = e3v(:,:,jk,Kmm) 151 END DO 137 152 ! 138 153 IF( lwxios ) CALL iom_swap( cwxios_context ) 139 154 CALL iom_rstput( kt, nitrst, numrow, 'tmask' , tmask , ldxios = lwxios ) 140 155 CALL iom_rstput( kt, nitrst, numrow, 'ssmask' , ssmask, ldxios = lwxios ) 141 CALL iom_rstput( kt, nitrst, numrow, 'e3t_n' , e3t(:,:,:,Kmm), ldxios = lwxios )142 CALL iom_rstput( kt, nitrst, numrow, 'e3u_n' , e3u(:,:,:,Kmm), ldxios = lwxios )143 CALL iom_rstput( kt, nitrst, numrow, 'e3v_n' , e3v(:,:,:,Kmm), ldxios = lwxios )156 CALL iom_rstput( kt, nitrst, numrow, 'e3t_n' , ze3t , ldxios = lwxios ) 157 CALL iom_rstput( kt, nitrst, numrow, 'e3u_n' , ze3u , ldxios = lwxios ) 158 CALL iom_rstput( kt, nitrst, numrow, 'e3v_n' , ze3v , ldxios = lwxios ) 144 159 CALL iom_rstput( kt, nitrst, numrow, 'gdepw_n', gdepw(:,:,:,Kmm) , ldxios = lwxios ) 145 160 IF( lwxios ) CALL iom_swap( cxios_context ) … … 209 224 IF(lwp) write(numout,*) 'isfcpl_ssh : recompute scale factor from ssh (new wet cell,Kmm)' 210 225 IF(lwp) write(numout,*) '~~~~~~~~~~~' 226 #if ! defined key_LF 211 227 DO jk = 1, jpk 212 228 e3t(:,:,jk,Kmm) = e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kmm) ) & … … 216 232 e3t(:,:,:,Kbb) = e3t(:,:,:,Kmm) 217 233 CALL dom_vvl_zgr(Kbb, Kmm, Kaa) 234 #else 235 CALL dom_qe_zgr(Kbb, Kmm, Kaa) 236 #endif 218 237 ! 219 238 END SUBROUTINE isfcpl_ssh … … 412 431 ! compute volume flux divergence after coupling 413 432 DO_2D_00_00 414 zqvoln(ji,jj,jk) = ( e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm) - e2u(ji-1,jj ) * e3u(ji-1,jj ,jk,Kmm) * uu(ji-1,jj ,jk,Kmm) & 415 & + e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) - e1v(ji ,jj-1) * e3v(ji ,jj-1,jk,Kmm) * vv(ji ,jj-1,jk,Kmm) ) & 433 zqvoln(ji,jj,jk) = ( e2u(ji ,jj ) * e3u(ji ,jj ,jk,Kmm) * uu(ji ,jj ,jk,Kmm) & 434 & - e2u(ji-1,jj ) * e3u(ji-1,jj ,jk,Kmm) * uu(ji-1,jj ,jk,Kmm) & 435 & + e1v(ji ,jj ) * e3v(ji ,jj ,jk,Kmm) * vv(ji ,jj ,jk,Kmm) & 436 & - e1v(ji ,jj-1) * e3v(ji ,jj-1,jk,Kmm) * vv(ji ,jj-1,jk,Kmm) ) & 416 437 & * tmask(ji,jj,jk) 417 438 END_2D … … 555 576 DO ji = nldi,nlei 556 577 jip1=MIN(ji+1,jpi) ; jim1=MAX(ji-1,1) ; jjp1=MIN(jj+1,jpj) ; jjm1=MAX(jj-1,1) ; 557 IF ( tmask(ji,jj,jk) == 0._wp .AND. ztmask_b(ji,jj,jk) == 1._wp ) nisfl(narea) = nisfl(narea) + MAX(SUM(tmask(jim1:jip1,jjm1:jjp1,jk)),1._wp) 578 IF ( tmask(ji,jj,jk) == 0._wp .AND. ztmask_b(ji,jj,jk) == 1._wp ) THEN 579 nisfl(narea) = nisfl(narea) + MAX(SUM(tmask(jim1:jip1,jjm1:jjp1,jk)),1._wp) 580 ENDIF 558 581 ENDDO 559 582 ENDDO -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/ISF/isfdiags.F90
r12340 r12616 26 26 !! * Substitutions 27 27 # include "do_loop_substitute.h90" 28 # include "domzgr_substitute.h90" 28 29 !!---------------------------------------------------------------------- 29 30 !! NEMO/OCE 4.0 , NEMO Consortium (2018) -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/ISF/isfdynatf.F90
r12372 r12616 14 14 15 15 USE phycst , ONLY: r1_rau0 ! physical constant 16 USE dom_oce , ONLY: tmask, ssmask, ht, e3t, r1_e1e2t! time and space domain16 USE dom_oce ! time and space domain 17 17 18 18 USE in_out_manager … … 25 25 !! * Substitutions 26 26 # include "do_loop_substitute.h90" 27 # include "domzgr_substitute.h90" 27 28 28 29 CONTAINS … … 81 82 ! add the increment 82 83 DO jk = 1, jpkm1 83 pe3t_f(:,:,jk) = pe3t_f(:,:,jk) - tmask(:,:,jk) * zfwfinc(:,:) * e3t(:,:,jk,Kmm) 84 pe3t_f(:,:,jk) = pe3t_f(:,:,jk) - tmask(:,:,jk) * zfwfinc(:,:) & 85 & * e3t(:,:,jk,Kmm) 84 86 END DO 85 87 ! -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/ISF/isfhdiv.F90
r12340 r12616 26 26 !! * Substitutions 27 27 # include "do_loop_substitute.h90" 28 # include "domzgr_substitute.h90" 28 29 29 30 CONTAINS … … 134 135 ! 135 136 DO jk=1,jpk 136 phdiv(:,:,jk) = phdiv(:,:,jk) + pqvol(:,:,jk) * r1_e1e2t(:,:) / e3t(:,:,jk,Kmm) 137 phdiv(:,:,jk) = phdiv(:,:,jk) + pqvol(:,:,jk) * r1_e1e2t(:,:) & 138 & / e3t(:,:,jk,Kmm) 137 139 END DO 138 140 ! -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/ISF/isfstp.F90
r12242 r12616 21 21 USE isfcpl , ONLY: isfcpl_rst_write, isfcpl_init ! isf variables 22 22 23 USE dom_oce , ONLY: ht, e3t, ln_isfcav, ln_linssh! ocean space and time domain23 USE dom_oce ! ocean space and time domain 24 24 USE domvvl, ONLY: ln_vvl_zstar ! zstar logical 25 25 USE zdfdrg, ONLY: r_Cdmin_top, r_ke0_top ! vertical physics: top/bottom drag coef. … … 41 41 !! Software governed by the CeCILL license (see ./LICENSE) 42 42 !!---------------------------------------------------------------------- 43 # include "domzgr_substitute.h90" 44 43 45 CONTAINS 44 46 … … 60 62 INTEGER, INTENT(in) :: kt ! ocean time step 61 63 INTEGER, INTENT(in) :: Kmm ! ocean time level index 64 !!---------------------------------------------------------------------- 65 INTEGER :: jk ! loop index 66 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t ! e3t 62 67 !!--------------------------------------------------------------------- 63 68 ! … … 78 83 ! 1.2: compute misfkb, rhisf_tbl, rfrac (deepest level, thickness, fraction of deepest cell affected by tbl) 79 84 rhisf_tbl_cav(:,:) = rn_htbl * mskisf_cav(:,:) 80 CALL isf_tbl_lvl(ht, e3t(:,:,:,Kmm), misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav) 85 DO jk = 1, jpkm1 86 ze3t(:,:,jk) = e3t(:,:,jk,Kmm) 87 END DO 88 CALL isf_tbl_lvl(ht, ze3t, misfkt_cav, misfkb_cav, rhisf_tbl_cav, rfrac_tbl_cav) 81 89 ! 82 90 ! 1.3: compute ice shelf melt … … 100 108 ! by simplicity, we assume the top level where param applied do not change with time (done in init part) 101 109 rhisf_tbl_par(:,:) = rhisf0_tbl_par(:,:) 102 CALL isf_tbl_lvl(ht, e3t(:,:,:,Kmm), misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par) 110 DO jk = 1, jpkm1 111 ze3t(:,:,jk) = e3t(:,:,jk,Kmm) 112 END DO 113 CALL isf_tbl_lvl(ht, ze3t, misfkt_par, misfkb_par, rhisf_tbl_par, rfrac_tbl_par) 103 114 ! 104 115 ! 2.3: compute ice shelf melt -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/ISF/isftbl.F90
r12340 r12616 25 25 !! * Substitutions 26 26 # include "do_loop_substitute.h90" 27 # include "domzgr_substitute.h90" 27 28 28 29 CONTAINS … … 56 57 REAL(wp), DIMENSION(jpi,jpj) :: zhtbl ! thickness of the tbl 57 58 REAL(wp), DIMENSION(jpi,jpj) :: zfrac ! thickness of the tbl 59 INTEGER :: jk ! loop index 60 REAL(wp), DIMENSION(jpi,jpj,jpk) :: ze3t,ze3u,ze3v ! e3 58 61 !!-------------------------------------------------------------------- 59 62 ! … … 64 67 zhtbl = phtbl 65 68 ! 69 DO jk = 1, jpkm1 70 ze3u(:,:,jk) = e3u(:,:,jk,Kmm) 71 END DO 66 72 ! compute tbl lvl and thickness 67 CALL isf_tbl_lvl( hu(:,:,Kmm), e3u(:,:,:,Kmm), ktop, ikbot, zhtbl, zfrac )73 CALL isf_tbl_lvl( hu(:,:,Kmm), ze3u, ktop, ikbot, zhtbl, zfrac ) 68 74 ! 69 75 ! compute tbl property at U point 70 CALL isf_tbl_avg( miku, ikbot, zhtbl, zfrac, e3u(:,:,:,Kmm), pvarin, zvarout )76 CALL isf_tbl_avg( miku, ikbot, zhtbl, zfrac, ze3u, pvarin, zvarout ) 71 77 ! 72 78 ! compute tbl property at T point … … 82 88 zhtbl = phtbl 83 89 ! 90 DO jk = 1, jpkm1 91 ze3v(:,:,jk) = e3v(:,:,jk,Kmm) 92 END DO 84 93 ! compute tbl lvl and thickness 85 CALL isf_tbl_lvl( hv(:,:,Kmm), e3v(:,:,:,Kmm), ktop, ikbot, zhtbl, zfrac )94 CALL isf_tbl_lvl( hv(:,:,Kmm), ze3v, ktop, ikbot, zhtbl, zfrac ) 86 95 ! 87 96 ! compute tbl property at V point 88 CALL isf_tbl_avg( mikv, ikbot, zhtbl, zfrac, e3v(:,:,:,Kmm), pvarin, zvarout )97 CALL isf_tbl_avg( mikv, ikbot, zhtbl, zfrac, ze3v, pvarin, zvarout ) 89 98 ! 90 99 ! pvarout is an averaging of wet point … … 98 107 ! 99 108 ! compute tbl property at T point 100 CALL isf_tbl_avg( ktop, kbot, phtbl, pfrac, e3t(:,:,:,Kmm), pvarin, pvarout ) 109 DO jk = 1, jpkm1 110 ze3t(:,:,jk) = e3t(:,:,jk,Kmm) 111 END DO 112 CALL isf_tbl_avg( ktop, kbot, phtbl, pfrac, ze3t, pvarin, pvarout ) 101 113 ! 102 114 END SELECT … … 212 224 ! phtbl need to be bounded by water column thickness before 213 225 ! test: if htbl = water column thickness, should return mbathy 214 ! test: if htbl = 0 should return ktop (phtbl cap to e3t(ji,jj,1))226 ! test: if htbl = 0 should return ktop (phtbl cap to pe3t(ji,jj,1)) 215 227 ! 216 228 ! get ktbl -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/SBC/sbcice_cice.F90
r12583 r12616 233 233 !!gm This should be put elsewhere.... (same remark for limsbc) 234 234 !!gm especially here it is assumed zstar coordinate, but it can be ztilde.... 235 IF( .NOT.ln_linssh ) CALL dom_vvl_zgr( Kbb, Kmm, Kaa ) ! interpolation scale factor, depth and water column 236 ! IF( .NOT.ln_linssh ) THEN 237 ! ! 238 ! DO jk = 1,jpkm1 ! adjust initial vertical scale factors 239 ! e3t(:,:,jk,Kmm) = e3t_0(:,:,jk)*( 1._wp + ssh(:,:,Kmm)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 240 ! e3t(:,:,jk,Kbb) = e3t_0(:,:,jk)*( 1._wp + ssh(:,:,Kbb)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 241 ! ENDDO 242 ! e3t(:,:,:,Krhs) = e3t(:,:,:,Kbb) 243 ! ! Reconstruction of all vertical scale factors at now and before time-steps 244 ! ! ============================================================================= 245 ! ! Horizontal scale factor interpolations 246 ! ! -------------------------------------- 247 ! CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3u(:,:,:,Kbb), 'U' ) 248 ! CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3v(:,:,:,Kbb), 'V' ) 249 ! CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3u(:,:,:,Kmm), 'U' ) 250 ! CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3v(:,:,:,Kmm), 'V' ) 251 ! CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3f(:,:,:), 'F' ) 252 ! ! Vertical scale factor interpolations 253 ! ! ------------------------------------ 254 ! CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3w (:,:,:,Kmm), 'W' ) 255 ! CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3uw(:,:,:,Kmm), 'UW' ) 256 ! CALL dom_vvl_interpol( e3v(:,:,:,Kmm), e3vw(:,:,:,Kmm), 'VW' ) 257 ! CALL dom_vvl_interpol( e3u(:,:,:,Kbb), e3uw(:,:,:,Kbb), 'UW' ) 258 ! CALL dom_vvl_interpol( e3v(:,:,:,Kbb), e3vw(:,:,:,Kbb), 'VW' ) 259 ! ! t- and w- points depth 260 ! ! ---------------------- 261 ! gdept(:,:,1,Kmm) = 0.5_wp * e3w(:,:,1,Kmm) 262 ! gdepw(:,:,1,Kmm) = 0.0_wp 263 ! gde3w(:,:,1) = gdept(:,:,1,Kmm) - ssh(:,:,Kmm) 264 ! DO jk = 2, jpk 265 ! gdept(:,:,jk,Kmm) = gdept(:,:,jk-1,Kmm) + e3w(:,:,jk,Kmm) 266 ! gdepw(:,:,jk,Kmm) = gdepw(:,:,jk-1,Kmm) + e3t(:,:,jk-1,Kmm) 267 ! gde3w(:,:,jk) = gdept(:,:,jk ,Kmm) - sshn (:,:) 268 ! END DO 269 ! ENDIF 235 #if defined key_LF 236 IF( .NOT.ln_linssh ) CALL dom_qe_zgr( Kbb, Kmm, Kaa ) ! interpolation scale factor, depth and water column 237 #else 238 IF( .NOT.ln_linssh ) THEN 239 ! 240 DO jk = 1,jpkm1 ! adjust initial vertical scale factors 241 e3t(:,:,jk,Kmm) = e3t_0(:,:,jk)*( 1._wp + ssh(:,:,Kmm)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 242 e3t(:,:,jk,Kbb) = e3t_0(:,:,jk)*( 1._wp + ssh(:,:,Kbb)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 243 ENDDO 244 e3t(:,:,:,Krhs) = e3t(:,:,:,Kbb) 245 ! Reconstruction of all vertical scale factors at now and before time-steps 246 ! ============================================================================= 247 ! Horizontal scale factor interpolations 248 ! -------------------------------------- 249 CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3u(:,:,:,Kbb), 'U' ) 250 CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3v(:,:,:,Kbb), 'V' ) 251 CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3u(:,:,:,Kmm), 'U' ) 252 CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3v(:,:,:,Kmm), 'V' ) 253 CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3f(:,:,:), 'F' ) 254 ! Vertical scale factor interpolations 255 ! ------------------------------------ 256 CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3w (:,:,:,Kmm), 'W' ) 257 CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3uw(:,:,:,Kmm), 'UW' ) 258 CALL dom_vvl_interpol( e3v(:,:,:,Kmm), e3vw(:,:,:,Kmm), 'VW' ) 259 CALL dom_vvl_interpol( e3u(:,:,:,Kbb), e3uw(:,:,:,Kbb), 'UW' ) 260 CALL dom_vvl_interpol( e3v(:,:,:,Kbb), e3vw(:,:,:,Kbb), 'VW' ) 261 ! t- and w- points depth 262 ! ---------------------- 263 gdept(:,:,1,Kmm) = 0.5_wp * e3w(:,:,1,Kmm) 264 gdepw(:,:,1,Kmm) = 0.0_wp 265 gde3w(:,:,1) = gdept(:,:,1,Kmm) - ssh(:,:,Kmm) 266 DO jk = 2, jpk 267 gdept(:,:,jk,Kmm) = gdept(:,:,jk-1,Kmm) + e3w(:,:,jk,Kmm) 268 gdepw(:,:,jk,Kmm) = gdepw(:,:,jk-1,Kmm) + e3t(:,:,jk-1,Kmm) 269 gde3w(:,:,jk) = gdept(:,:,jk ,Kmm) - sshn (:,:) 270 END DO 271 ENDIF 272 #endif 270 273 ENDIF 271 274 ENDIF -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/TRD/trdglo.F90
r12377 r12616 52 52 !! * Substitutions 53 53 # include "do_loop_substitute.h90" 54 # include "domzgr_substitute.h90" 54 55 !!---------------------------------------------------------------------- 55 56 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 116 117 DO_3D_10_10( 1, jpkm1 ) 117 118 zvt = ptrdx(ji,jj,jk) * tmask_i(ji+1,jj) * tmask_i(ji,jj) * umask(ji,jj,jk) & 118 & * e1e2u (ji,jj) * e3u(ji,jj,jk,Kmm)119 & * e1e2u (ji ,jj) * e3u(ji,jj,jk,Kmm) 119 120 zvs = ptrdy(ji,jj,jk) * tmask_i(ji,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk) & 120 & * e1e2v (ji,jj) * e3u(ji,jj,jk,Kmm)121 & * e1e2v (ji,jj ) * e3u(ji,jj,jk,Kmm) 121 122 umo(ktrd) = umo(ktrd) + zvt 122 123 vmo(ktrd) = vmo(ktrd) + zvs … … 211 212 zcof = 0.5_wp / rau0 ! Density flux at u and v-points 212 213 DO_3D_10_10( 1, jpkm1 ) 213 zkx(ji,jj,jk) = zcof * e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm) * ( rhop(ji,jj,jk) + rhop(ji+1,jj,jk) ) 214 zky(ji,jj,jk) = zcof * e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) * ( rhop(ji,jj,jk) + rhop(ji,jj+1,jk) ) 214 zkx(ji,jj,jk) = zcof * e2u(ji,jj) * e3u(ji,jj,jk,Kmm) & 215 & * uu(ji,jj,jk,Kmm) * ( rhop(ji,jj,jk) + rhop(ji+1,jj,jk) ) 216 zky(ji,jj,jk) = zcof * e1v(ji,jj) * e3v(ji,jj,jk,Kmm) & 217 & * vv(ji,jj,jk,Kmm) * ( rhop(ji,jj,jk) + rhop(ji,jj+1,jk) ) 215 218 END_3D 216 219 … … 219 222 & + zkx(ji,jj,jk) - zkx(ji-1,jj ,jk ) & 220 223 & + zky(ji,jj,jk) - zky(ji ,jj-1,jk ) ) & 221 & 224 & / ( e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) ) * tmask(ji,jj,jk) * tmask_i(ji,jj) 222 225 END_3D 223 226 … … 226 229 peke = 0._wp 227 230 DO jk = 1, jpkm1 228 peke = peke + SUM( zkepe(:,:,jk) * gdept(:,:,jk,Kmm) * e1e2t(:,:) * e3t(:,:,jk,Kmm) ) 231 peke = peke + SUM( zkepe(:,:,jk) * gdept(:,:,jk,Kmm) * e1e2t(:,:) & 232 & * e3t(:,:,jk,Kmm) ) 229 233 END DO 230 234 peke = grav * peke … … 524 528 525 529 DO_3D_00_00( 1, jpk ) 526 tvolu = tvolu + e1u(ji,jj) * e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * tmask_i(ji+1,jj ) * tmask_i(ji,jj) * umask(ji,jj,jk) 527 tvolv = tvolv + e1v(ji,jj) * e2v(ji,jj) * e3v(ji,jj,jk,Kmm) * tmask_i(ji ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk) 530 tvolu = tvolu + e1u(ji,jj) * e2u(ji,jj) * e3u(ji,jj,jk,Kmm) & 531 & * tmask_i(ji+1,jj ) * tmask_i(ji,jj) * umask(ji,jj,jk) 532 tvolv = tvolv + e1v(ji,jj) * e2v(ji,jj) * e3v(ji,jj,jk,Kmm) & 533 & * tmask_i(ji ,jj+1) * tmask_i(ji,jj) * vmask(ji,jj,jk) 528 534 END_3D 529 535 CALL mpp_sum( 'trdglo', tvolu ) ! sums over the global domain -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/TRD/trdken.F90
r12377 r12616 41 41 !! * Substitutions 42 42 # include "do_loop_substitute.h90" 43 # include "domzgr_substitute.h90" 43 44 !!---------------------------------------------------------------------- 44 45 !! NEMO/OCE 4.0 , NEMO Consortium (2018) -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/TRD/trdmxl.F90
r12377 r12616 70 70 !! * Substitutions 71 71 # include "do_loop_substitute.h90" 72 # include "domzgr_substitute.h90" 72 73 !!---------------------------------------------------------------------- 73 74 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 120 121 wkx(:,:,:) = 0._wp !== now ML weights for vertical averaging ==! 121 122 DO_3D_11_11( 1, jpktrd ) 122 IF( jk - kmxln(ji,jj) < 0 ) wkx(ji,jj,jk) = e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) 123 IF( jk - kmxln(ji,jj) < 0 ) THEN 124 wkx(ji,jj,jk) = e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) 125 ENDIF 123 126 END_3D 124 127 hmxl(:,:) = 0._wp ! NOW mixed-layer depth -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/TRD/trdpen.F90
r12377 r12616 40 40 !! Software governed by the CeCILL license (see ./LICENSE) 41 41 !!---------------------------------------------------------------------- 42 # include "domzgr_substitute.h90" 43 42 44 CONTAINS 43 45 -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/TRD/trdtra.F90
r12377 r12616 42 42 !! * Substitutions 43 43 # include "do_loop_substitute.h90" 44 # include "domzgr_substitute.h90" 44 45 !!---------------------------------------------------------------------- 45 46 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 128 129 zwt(:,:,jpk) = 0._wp ; zws(:,:,jpk) = 0._wp 129 130 DO jk = 2, jpk 130 zwt(:,:,jk) = avt(:,:,jk) * ( ts(:,:,jk-1,jp_tem,Krhs) - ts(:,:,jk,jp_tem,Krhs) ) / e3w(:,:,jk,Kmm) * tmask(:,:,jk) 131 zws(:,:,jk) = avs(:,:,jk) * ( ts(:,:,jk-1,jp_sal,Krhs) - ts(:,:,jk,jp_sal,Krhs) ) / e3w(:,:,jk,Kmm) * tmask(:,:,jk) 131 zwt(:,:,jk) = avt(:,:,jk) * ( ts(:,:,jk-1,jp_tem,Krhs) - ts(:,:,jk,jp_tem,Krhs) ) & 132 & / e3w(:,:,jk,Kmm) * tmask(:,:,jk) 133 zws(:,:,jk) = avs(:,:,jk) * ( ts(:,:,jk-1,jp_sal,Krhs) - ts(:,:,jk,jp_sal,Krhs) ) & 134 & / e3w(:,:,jk,Kmm) * tmask(:,:,jk) 132 135 END DO 133 136 ! … … 142 145 zwt(:,:,:) = 0._wp ; zws(:,:,:) = 0._wp ! vertical diffusive fluxes 143 146 DO jk = 2, jpk 144 zwt(:,:,jk) = avt_evd(:,:,jk) * ( ts(:,:,jk-1,jp_tem,Krhs) - ts(:,:,jk,jp_tem,Krhs) ) / e3w(:,:,jk,Kmm) * tmask(:,:,jk) 145 zws(:,:,jk) = avt_evd(:,:,jk) * ( ts(:,:,jk-1,jp_sal,Krhs) - ts(:,:,jk,jp_sal,Krhs) ) / e3w(:,:,jk,Kmm) * tmask(:,:,jk) 147 zwt(:,:,jk) = avt_evd(:,:,jk) * ( ts(:,:,jk-1,jp_tem,Krhs) - ts(:,:,jk,jp_tem,Krhs) ) & 148 & / e3w(:,:,jk,Kmm) * tmask(:,:,jk) 149 zws(:,:,jk) = avt_evd(:,:,jk) * ( ts(:,:,jk-1,jp_sal,Krhs) - ts(:,:,jk,jp_sal,Krhs) ) & 150 & / e3w(:,:,jk,Kmm) * tmask(:,:,jk) 146 151 END DO 147 152 ! -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/ZDF/zdfdrg.F90
r12377 r12616 74 74 !! * Substitutions 75 75 # include "do_loop_substitute.h90" 76 # include "domzgr_substitute.h90" 76 77 !!---------------------------------------------------------------------- 77 78 !! NEMO/OCE 4.0 , NEMO Consortium (2018) -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/ZDF/zdfgls.F90
r12377 r12616 263 263 zcof = rfact_tke * tmask(ji,jj,jk) 264 264 ! ! lower diagonal, in fact not used for jk = 2 (see surface conditions) 265 zd_lw(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk ) + p_avm(ji,jj,jk-1) ) / ( e3t(ji,jj,jk-1,Kmm) * e3w(ji,jj,jk,Kmm) ) 265 zd_lw(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk ) + p_avm(ji,jj,jk-1) ) & 266 & / ( e3t(ji,jj,jk-1,Kmm) * e3w(ji,jj,jk,Kmm) ) 266 267 ! ! upper diagonal, in fact not used for jk = ibotm1 (see bottom conditions) 267 zd_up(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk+1) + p_avm(ji,jj,jk ) ) / ( e3t(ji,jj,jk ,Kmm) * e3w(ji,jj,jk,Kmm) ) 268 zd_up(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk+1) + p_avm(ji,jj,jk ) ) & 269 & / ( e3t(ji,jj,jk ,Kmm) * e3w(ji,jj,jk,Kmm) ) 268 270 ! ! diagonal 269 271 zdiag(ji,jj,jk) = 1._wp - zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) + rdt * zdiss * wmask(ji,jj,jk) … … 473 475 zcof = rfact_psi * zwall_psi(ji,jj,jk) * tmask(ji,jj,jk) 474 476 ! ! lower diagonal 475 zd_lw(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk ) + p_avm(ji,jj,jk-1) ) / ( e3t(ji,jj,jk-1,Kmm) * e3w(ji,jj,jk,Kmm) ) 477 zd_lw(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk ) + p_avm(ji,jj,jk-1) ) & 478 & / ( e3t(ji,jj,jk-1,Kmm) * e3w(ji,jj,jk,Kmm) ) 476 479 ! ! upper diagonal 477 zd_up(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk+1) + p_avm(ji,jj,jk ) ) / ( e3t(ji,jj,jk ,Kmm) * e3w(ji,jj,jk,Kmm) ) 480 zd_up(ji,jj,jk) = zcof * ( p_avm(ji,jj,jk+1) + p_avm(ji,jj,jk ) ) & 481 & / ( e3t(ji,jj,jk ,Kmm) * e3w(ji,jj,jk,Kmm) ) 478 482 ! ! diagonal 479 483 zdiag(ji,jj,jk) = 1._wp - zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) + rdt * zdiss * wmask(ji,jj,jk) … … 1100 1104 !!====================================================================== 1101 1105 END MODULE zdfgls 1102 -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/ZDF/zdfosm.F90
r12377 r12616 105 105 !! * Substitutions 106 106 # include "do_loop_substitute.h90" 107 # include "domzgr_substitute.h90" 107 108 !!---------------------------------------------------------------------- 108 109 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 503 504 & - zbeta * ( zs_bl(ji,jj) - ts(ji,jj,jm,jp_sal,Kmm) ) ), 0.0 ) + zvel_max 504 505 505 zhbl_s = zhbl_s + MIN( - zwb_ent(ji,jj) / zdb * rn_rdt / FLOAT(ibld(ji,jj)-imld(ji,jj) ), e3w(ji,jj,jk,Kmm) ) 506 zhbl_s = zhbl_s + MIN( - zwb_ent(ji,jj) / zdb * rn_rdt / FLOAT(ibld(ji,jj)-imld(ji,jj) ), & 507 & e3w(ji,jj,jk,Kmm) ) 506 508 zhbl_s = MIN(zhbl_s, ht(ji,jj)) 507 509 … … 594 596 zwb_ent(ji,jj) = 0._wp 595 597 ENDIF 596 inhml = MAX( INT( zari * zhbl(ji,jj) / e3t(ji,jj,ibld(ji,jj),Kmm) ) , 1 ) 598 inhml = & 599 & MAX( INT( zari * zhbl(ji,jj) / e3t(ji,jj,ibld(ji,jj),Kmm) ), & 600 & 1 ) 597 601 imld(ji,jj) = MAX( ibld(ji,jj) - inhml, 1) 598 602 zhml(ji,jj) = gdepw(ji,jj,imld(ji,jj),Kmm) … … 610 614 zari = MIN( 4.5 * ( zvstr(ji,jj)**2 ) & 611 615 & / ( zdb_bl(ji,jj) * zhbl(ji,jj) ) + 0.01 , 0.2 ) 612 inhml = MAX( INT( zari * zhbl(ji,jj) / e3t(ji,jj,ibld(ji,jj),Kmm) ) , 1 ) 616 inhml = & 617 & MAX( INT( zari * zhbl(ji,jj) / e3t(ji,jj,ibld(ji,jj),Kmm) ), & 618 & 1 ) 613 619 imld(ji,jj) = MAX( ibld(ji,jj) - inhml, 1) 614 620 zhml(ji,jj) = gdepw(ji,jj,imld(ji,jj),Kmm) -
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/OCE/ZDF/zdftke.F90
r12377 r12616 90 90 !! * Substitutions 91 91 # include "do_loop_substitute.h90" 92 # include "domzgr_substitute.h90" 92 93 !!---------------------------------------------------------------------- 93 94 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 467 468 & gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) - gdepw(ji,jj,jk,Kmm) ) 468 469 ! wmask prevent zmxlm = 0 if jk = mikt(ji,jj) 469 zmxlm(ji,jj,jk) = zemxl * wmask(ji,jj,jk) + MIN( zmxlm(ji,jj,jk) , e3w(ji,jj,jk,Kmm) ) * (1 - wmask(ji,jj,jk)) 470 zmxld(ji,jj,jk) = zemxl * wmask(ji,jj,jk) + MIN( zmxlm(ji,jj,jk) , e3w(ji,jj,jk,Kmm) ) * (1 - wmask(ji,jj,jk)) 470 zmxlm(ji,jj,jk) = zemxl * wmask(ji,jj,jk) & 471 & + MIN( zmxlm(ji,jj,jk) , e3w(ji,jj,jk,Kmm) ) * (1 - wmask(ji,jj,jk)) 472 zmxld(ji,jj,jk) = zemxl * wmask(ji,jj,jk) & 473 & + MIN( zmxlm(ji,jj,jk) , e3w(ji,jj,jk,Kmm) ) * (1 - wmask(ji,jj,jk)) 471 474 END_3D 472 475 !
Note: See TracChangeset
for help on using the changeset viewer.
