Changeset 14601
- Timestamp:
- 2021-03-09T09:37:00+01:00 (3 years ago)
- Location:
- NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE
- Files:
-
- 15 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/ZDF/zdfddm.F90
r14053 r14601 95 95 !!gm and many acces in memory 96 96 97 DO_2D( 1, 1, 1, 1 ) !== R=zrau = (alpha / beta) (dk[t] / dk[s]) ==! 97 ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) !== R=zrau = (alpha / beta) (dk[t] / dk[s]) ==! 98 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) !== R=zrau = (alpha / beta) (dk[t] / dk[s]) ==! 98 99 zrw = ( gdepw(ji,jj,jk ,Kmm) - gdept(ji,jj,jk,Kmm) ) & 99 100 !!gm please, use e3w at Kmm below … … 111 112 END_2D 112 113 113 DO_2D( 1, 1, 1, 1 ) !== indicators ==! 114 ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) !== indicators ==! 115 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) !== indicators ==! 114 116 ! stability indicator: msks=1 if rn2>0; 0 elsewhere 115 117 IF( rn2(ji,jj,jk) + 1.e-12 <= 0. ) THEN ; zmsks(ji,jj) = 0._wp … … 141 143 ! ------------------ 142 144 ! Constant eddy coefficient: reset to the background value 143 DO_2D( 1, 1, 1, 1 ) 145 ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) 146 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 144 147 zinr = 1._wp / zrau(ji,jj) 145 148 ! salt fingering -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/ZDF/zdfdrg.F90
r13558 r14601 117 117 ! 118 118 IF( l_log_not_linssh ) THEN !== "log layer" ==! compute Cd and -Cd*|U| 119 DO_2D( 0, 0, 0, 0 ) 119 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 120 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 120 121 imk = k_mk(ji,jj) ! ocean bottom level at t-points 121 122 zut = uu(ji,jj,imk,Kmm) + uu(ji-1,jj,imk,Kmm) ! 2 x velocity at t-point … … 129 130 END_2D 130 131 ELSE !== standard Cd ==! 131 DO_2D( 0, 0, 0, 0 ) 132 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 133 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 132 134 imk = k_mk(ji,jj) ! ocean bottom level at t-points 133 135 zut = uu(ji,jj,imk,Kmm) + uu(ji-1,jj,imk,Kmm) ! 2 x velocity at t-point … … 176 178 ENDIF 177 179 178 DO_2D( 0, 0, 0, 0 ) 180 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 181 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 179 182 ikbu = mbku(ji,jj) ! deepest wet ocean u- & v-levels 180 183 ikbv = mbkv(ji,jj) … … 189 192 ! 190 193 IF( ln_isfcav ) THEN ! ocean cavities 191 DO_2D( 0, 0, 0, 0 ) 194 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 195 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 192 196 ikbu = miku(ji,jj) ! first wet ocean u- & v-levels 193 197 ikbv = mikv(ji,jj) … … 432 436 l_log_not_linssh = .FALSE. !- don't update Cd at each time step 433 437 ! 434 DO_2D( 1, 1, 1, 1 ) ! pCd0 = mask (and boosted) logarithmic drag coef. 438 ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) ! pCd0 = mask (and boosted) logarithmic drag coef. 439 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) ! pCd0 = mask (and boosted) logarithmic drag coef. 435 440 zzz = 0.5_wp * e3t_0(ji,jj,k_mk(ji,jj)) 436 441 zcd = ( vkarmn / LOG( zzz / rn_z0 ) )**2 -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/ZDF/zdfevd.F90
r13295 r14601 87 87 ! END WHERE 88 88 ! 89 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 89 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 90 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 90 91 IF( MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) THEN 91 92 p_avt(ji,jj,jk) = rn_evd * wmask(ji,jj,jk) … … 103 104 ! END WHERE 104 105 105 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 106 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 107 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 106 108 IF( MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) & 107 109 p_avt(ji,jj,jk) = rn_evd * wmask(ji,jj,jk) -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/ZDF/zdfgls.F90
r14156 r14601 179 179 180 180 ! Compute surface, top and bottom friction at T-points 181 DO_2D( 0, 0, 0, 0 ) !== surface ocean friction 181 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) !== surface ocean friction 182 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) !== surface ocean friction 182 183 ustar2_surf(ji,jj) = r1_rho0 * taum(ji,jj) * tmask(ji,jj,1) ! surface friction 183 184 END_2D … … 186 187 ! 187 188 IF( .NOT.ln_drg_OFF ) THEN !== top/bottom friction (explicit before friction) 188 DO_2D( 0, 0, 0, 0 ) ! bottom friction (explicit before friction) 189 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) ! bottom friction (explicit before friction) 190 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! bottom friction (explicit before friction) 189 191 zmsku = 0.5_wp * ( 2._wp - umask(ji-1,jj,mbkt(ji,jj)) * umask(ji,jj,mbkt(ji,jj)) ) 190 192 zmskv = 0.5_wp * ( 2._wp - vmask(ji,jj-1,mbkt(ji,jj)) * vmask(ji,jj,mbkt(ji,jj)) ) ! (CAUTION: CdU<0) … … 193 195 END_2D 194 196 IF( ln_isfcav ) THEN 195 DO_2D( 0, 0, 0, 0 ) ! top friction 197 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) ! top friction 198 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! top friction 196 199 zmsku = 0.5_wp * ( 2. - umask(ji-1,jj,mikt(ji,jj)) * umask(ji,jj,mikt(ji,jj)) ) 197 200 zmskv = 0.5_wp * ( 2. - vmask(ji,jj-1,mikt(ji,jj)) * vmask(ji,jj,mikt(ji,jj)) ) ! (CAUTION: CdU<0) … … 220 223 zhsro(:,:) = ( (1._wp-zice_fra(:,:)) * zhsro(:,:) + zice_fra(:,:) * rn_hsri )*tmask(:,:,1) + (1._wp - tmask(:,:,1))*rn_hsro 221 224 ! 222 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) !== Compute dissipation rate ==! 225 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) !== Compute dissipation rate ==! 226 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) !== Compute dissipation rate ==! 223 227 eps(ji,jj,jk) = rc03 * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / hmxl_n(ji,jj,jk) 224 228 END_3D … … 229 233 230 234 IF( nn_clos == 0 ) THEN ! Mellor-Yamada 231 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 235 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 236 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 232 237 zup = hmxl_n(ji,jj,jk) * gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) 233 238 zdown = vkarmn * gdepw(ji,jj,jk,Kmm) * ( -gdepw(ji,jj,jk,Kmm) + gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) ) … … 250 255 ! Warning : after this step, en : right hand side of the matrix 251 256 252 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 257 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 258 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 253 259 ! 254 260 buoy = - p_avt(ji,jj,jk) * rn2(ji,jj,jk) ! stratif. destruction … … 327 333 ! at k=2, set de/dz=Fw 328 334 !cbr 329 DO_2D( 0, 0, 0, 0 ) ! zdiag zd_lw not defined/used on the halo 335 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) ! zdiag zd_lw not defined/used on the halo 336 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! zdiag zd_lw not defined/used on the halo 330 337 zdiag(ji,jj,2) = zdiag(ji,jj,2) + zd_lw(ji,jj,2) ! Remove zd_lw from zdiag 331 338 zd_lw(ji,jj,2) = 0._wp … … 348 355 ! ! en(ibot) = u*^2 / Co2 and hmxl_n(ibot) = rn_lmin 349 356 ! ! Balance between the production and the dissipation terms 350 DO_2D( 0, 0, 0, 0 ) 357 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 358 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 351 359 !!gm This means that bottom and ocean w-level above have a specified "en" value. Sure ???? 352 360 !! With thick deep ocean level thickness, this may be quite large, no ??? … … 366 374 ! 367 375 IF( ln_isfcav) THEN ! top boundary (ocean cavity) 368 DO_2D( 0, 0, 0, 0 ) 376 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 377 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 369 378 itop = mikt(ji,jj) ! k top w-point 370 379 itopp1 = mikt(ji,jj) + 1 ! k+1 1st w-point below the top one … … 384 393 CASE ( 1 ) ! Neumman boundary condition 385 394 ! 386 DO_2D( 0, 0, 0, 0 ) 395 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 396 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 387 397 ibot = mbkt(ji,jj) + 1 ! k bottom level of w-point 388 398 ibotm1 = mbkt(ji,jj) ! k-1 bottom level of w-point but >=1 … … 399 409 END_2D 400 410 IF( ln_isfcav) THEN ! top boundary (ocean cavity) 401 DO_2D( 0, 0, 0, 0 ) 411 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 412 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 402 413 itop = mikt(ji,jj) ! k top w-point 403 414 itopp1 = mikt(ji,jj) + 1 ! k+1 1st w-point below the top one … … 420 431 ! ---------------------------------------------------------- 421 432 ! 422 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 433 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 434 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 423 435 zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1) 424 436 END_3D 425 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1 437 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1 438 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1 426 439 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) 427 440 END_3D 428 DO_3DS( 0, 0, 0, 0, jpkm1, 2, -1 ) ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 441 ! [comm_cleanup] ! DO_3DS( 0, 0, 0, 0, jpkm1, 2, -1 ) ! Third recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 442 DO_3DS( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jpkm1, 2, -1 ) ! Third recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 429 443 en(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * en(ji,jj,jk+1) ) / zdiag(ji,jj,jk) 430 444 END_3D … … 441 455 ! 442 456 CASE( 0 ) ! k-kl (Mellor-Yamada) 443 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 457 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 458 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 444 459 psi(ji,jj,jk) = eb(ji,jj,jk) * hmxl_b(ji,jj,jk) 445 460 END_3D 446 461 ! 447 462 CASE( 1 ) ! k-eps 448 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 463 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 464 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 449 465 psi(ji,jj,jk) = eps(ji,jj,jk) 450 466 END_3D 451 467 ! 452 468 CASE( 2 ) ! k-w 453 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 469 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 470 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 454 471 psi(ji,jj,jk) = SQRT( eb(ji,jj,jk) ) / ( rc0 * hmxl_b(ji,jj,jk) ) 455 472 END_3D 456 473 ! 457 474 CASE( 3 ) ! generic 458 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 475 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 476 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 459 477 psi(ji,jj,jk) = rc02 * eb(ji,jj,jk) * hmxl_b(ji,jj,jk)**rnn 460 478 END_3D … … 469 487 ! Warning : after this step, en : right hand side of the matrix 470 488 471 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 489 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 490 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 472 491 ! 473 492 ! psi / k … … 541 560 ! 542 561 ! Neumann condition at k=2 543 DO_2D( 0, 0, 0, 0 ) ! zdiag zd_lw not defined/used on the halo 562 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) ! zdiag zd_lw not defined/used on the halo 563 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! zdiag zd_lw not defined/used on the halo 544 564 zdiag(ji,jj,2) = zdiag(ji,jj,2) + zd_lw(ji,jj,2) ! Remove zd_lw from zdiag 545 565 zd_lw(ji,jj,2) = 0._wp … … 569 589 ! ! en(ibot) = u*^2 / Co2 and hmxl_n(ibot) = vkarmn * r_z0_bot 570 590 ! ! Balance between the production and the dissipation terms 571 DO_2D( 0, 0, 0, 0 ) 591 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 592 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 572 593 ibot = mbkt(ji,jj) + 1 ! k bottom level of w-point 573 594 ibotm1 = mbkt(ji,jj) ! k-1 bottom level of w-point but >=1 … … 588 609 CASE ( 1 ) ! Neumman boundary condition 589 610 ! 590 DO_2D( 0, 0, 0, 0 ) 611 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 612 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 591 613 ibot = mbkt(ji,jj) + 1 ! k bottom level of w-point 592 614 ibotm1 = mbkt(ji,jj) ! k-1 bottom level of w-point but >=1 … … 616 638 ! ---------------- 617 639 ! 618 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 640 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 641 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 619 642 zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1) 620 643 END_3D 621 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1 644 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1 645 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! Second recurrence : Lk = RHSk - Lk / Dk-1 * Lk-1 622 646 zd_lw(ji,jj,jk) = psi(ji,jj,jk) - zd_lw(ji,jj,jk) / zdiag(ji,jj,jk-1) * zd_lw(ji,jj,jk-1) 623 647 END_3D 624 DO_3DS( 0, 0, 0, 0, jpkm1, 2, -1 ) ! Third recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 648 ! [comm_cleanup] ! DO_3DS( 0, 0, 0, 0, jpkm1, 2, -1 ) ! Third recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 649 DO_3DS( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jpkm1, 2, -1 ) ! Third recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 625 650 psi(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * psi(ji,jj,jk+1) ) / zdiag(ji,jj,jk) 626 651 END_3D … … 632 657 ! 633 658 CASE( 0 ) ! k-kl (Mellor-Yamada) 634 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 659 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 660 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 635 661 eps(ji,jj,jk) = rc03 * en(ji,jj,jk) * en(ji,jj,jk) * SQRT( en(ji,jj,jk) ) / MAX( psi(ji,jj,jk), rn_epsmin) 636 662 END_3D 637 663 ! 638 664 CASE( 1 ) ! k-eps 639 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 665 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 666 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 640 667 eps(ji,jj,jk) = psi(ji,jj,jk) 641 668 END_3D 642 669 ! 643 670 CASE( 2 ) ! k-w 644 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 671 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 672 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 645 673 eps(ji,jj,jk) = rc04 * en(ji,jj,jk) * psi(ji,jj,jk) 646 674 END_3D … … 650 678 zex1 = ( 1.5_wp + rmm/rnn ) 651 679 zex2 = -1._wp / rnn 652 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 680 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 681 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 653 682 eps(ji,jj,jk) = zcoef * en(ji,jj,jk)**zex1 * psi(ji,jj,jk)**zex2 654 683 END_3D … … 658 687 ! Limit dissipation rate under stable stratification 659 688 ! -------------------------------------------------- 660 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! Note that this set boundary conditions on hmxl_n at the same time 689 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! Note that this set boundary conditions on hmxl_n at the same time 690 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) ! Note that this set boundary conditions on hmxl_n at the same time 661 691 ! limitation 662 692 eps (ji,jj,jk) = MAX( eps(ji,jj,jk), rn_epsmin ) … … 674 704 ! 675 705 CASE ( 0 , 1 ) ! Galperin or Kantha-Clayson stability functions 676 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 706 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 707 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 677 708 ! zcof = l²/q² 678 709 zcof = hmxl_b(ji,jj,jk) * hmxl_b(ji,jj,jk) / ( 2._wp*eb(ji,jj,jk) ) … … 691 722 ! 692 723 CASE ( 2, 3 ) ! Canuto stability functions 693 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 724 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 725 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 694 726 ! zcof = l²/q² 695 727 zcof = hmxl_b(ji,jj,jk)*hmxl_b(ji,jj,jk) / ( 2._wp * eb(ji,jj,jk) ) … … 723 755 ! default value, in case jpk > mbkt(ji,jj)+1. Not needed but avoid a bug when looking for undefined values (-fpe0) 724 756 zstm(:,:,jpk) = 0. 725 DO_2D( 0, 0, 0, 0 ) ! update bottom with good values 757 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) ! update bottom with good values 758 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! update bottom with good values 726 759 zstm(ji,jj,mbkt(ji,jj)+1) = zstm(ji,jj,mbkt(ji,jj)) 727 760 END_2D … … 738 771 ! later overwritten by surface/bottom boundaries conditions, so we don't really care of p_avm(:,:1) and p_avm(:,:jpk) 739 772 ! for zd_lw and zd_up but they have to be defined to avoid a bug when looking for undefined values (-fpe0) 740 DO_3D( 0, 0, 0, 0, 1, jpk ) 773 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpk ) 774 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpk ) 741 775 zsqen = SQRT( 2._wp * en(ji,jj,jk) ) * hmxl_n(ji,jj,jk) 742 776 zavt = zsqen * zstt(ji,jj,jk) -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/ZDF/zdfiwm.F90
r13497 r14601 143 143 ! Set to zero the 1st and last vertical levels of appropriate variables 144 144 IF( iom_use("emix_iwm") ) THEN 145 DO_2D( 0, 0, 0, 0 ) 145 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 146 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 146 147 zemx_iwm (ji,jj,1) = 0._wp ; zemx_iwm (ji,jj,jpk) = 0._wp 147 148 END_2D 148 149 ENDIF 149 150 IF( iom_use("av_ratio") ) THEN 150 DO_2D( 0, 0, 0, 0 ) 151 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 152 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 151 153 zav_ratio(ji,jj,1) = 0._wp ; zav_ratio(ji,jj,jpk) = 0._wp 152 154 END_2D 153 155 ENDIF 154 156 IF( iom_use("av_wave") .OR. sn_cfctl%l_prtctl ) THEN 155 DO_2D( 0, 0, 0, 0 ) 157 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 158 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 156 159 zav_wave (ji,jj,1) = 0._wp ; zav_wave (ji,jj,jpk) = 0._wp 157 160 END_2D … … 164 167 ! !* Critical slope mixing: distribute energy over the time-varying ocean depth, 165 168 ! using an exponential decay from the seafloor. 166 DO_2D( 0, 0, 0, 0 ) ! part independent of the level 169 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) ! part independent of the level 170 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! part independent of the level 167 171 zhdep(ji,jj) = gdepw_0(ji,jj,mbkt(ji,jj)+1) ! depth of the ocean 168 172 zfact(ji,jj) = rho0 * ( 1._wp - EXP( -zhdep(ji,jj) / hcri_iwm(ji,jj) ) ) … … 170 174 END_2D 171 175 !!gm gde3w ==>>> check for ssh taken into account.... seem OK gde3w_n=gdept(:,:,:,Kmm) - ssh(:,:,Kmm) 172 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! complete with the level-dependent part 176 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! complete with the level-dependent part 177 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! complete with the level-dependent part 173 178 IF ( zfact(ji,jj) == 0._wp .OR. wmask(ji,jj,jk) == 0._wp ) THEN ! optimization 174 179 zemx_iwm(ji,jj,jk) = 0._wp … … 190 195 CASE ( 1 ) ! Dissipation scales as N (recommended) 191 196 ! 192 DO_2D( 0, 0, 0, 0 ) 197 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 198 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 193 199 zfact(ji,jj) = 0._wp 194 200 END_2D 195 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! part independent of the level 201 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! part independent of the level 202 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! part independent of the level 196 203 zfact(ji,jj) = zfact(ji,jj) + e3w(ji,jj,jk,Kmm) * SQRT( MAX( 0._wp, rn2(ji,jj,jk) ) ) * wmask(ji,jj,jk) 197 204 END_3D 198 205 ! 199 DO_2D( 0, 0, 0, 0 ) 206 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 207 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 200 208 IF( zfact(ji,jj) /= 0 ) zfact(ji,jj) = epyc_iwm(ji,jj) / ( rho0 * zfact(ji,jj) ) 201 209 END_2D 202 210 ! 203 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! complete with the level-dependent part 211 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! complete with the level-dependent part 212 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! complete with the level-dependent part 204 213 zemx_iwm(ji,jj,jk) = zemx_iwm(ji,jj,jk) + zfact(ji,jj) * SQRT( MAX( 0._wp, rn2(ji,jj,jk) ) ) * wmask(ji,jj,jk) 205 214 END_3D … … 207 216 CASE ( 2 ) ! Dissipation scales as N^2 208 217 ! 209 DO_2D( 0, 0, 0, 0 ) 218 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 219 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 210 220 zfact(ji,jj) = 0._wp 211 221 END_2D 212 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! part independent of the level 222 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! part independent of the level 223 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! part independent of the level 213 224 zfact(ji,jj) = zfact(ji,jj) + e3w(ji,jj,jk,Kmm) * MAX( 0._wp, rn2(ji,jj,jk) ) * wmask(ji,jj,jk) 214 225 END_3D 215 226 ! 216 DO_2D( 0, 0, 0, 0 ) 227 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 228 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 217 229 IF( zfact(ji,jj) /= 0 ) zfact(ji,jj) = epyc_iwm(ji,jj) / ( rho0 * zfact(ji,jj) ) 218 230 END_2D 219 231 ! 220 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! complete with the level-dependent part 232 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 233 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 221 234 zemx_iwm(ji,jj,jk) = zemx_iwm(ji,jj,jk) + zfact(ji,jj) * MAX( 0._wp, rn2(ji,jj,jk) ) * wmask(ji,jj,jk) 222 235 END_3D … … 227 240 ! !* ocean depth as proportional to rn2 * exp(-z_wkb/rn_hbot) 228 241 ! 229 DO_2D( 0, 0, 0, 0 ) 242 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 243 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 230 244 zwkb(ji,jj,1) = 0._wp 231 245 END_2D 232 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 246 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 247 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 233 248 zwkb(ji,jj,jk) = zwkb(ji,jj,jk-1) + e3w(ji,jj,jk,Kmm) * SQRT( MAX( 0._wp, rn2(ji,jj,jk) ) ) * wmask(ji,jj,jk) 234 249 END_3D 235 DO_2D( 0, 0, 0, 0 ) 250 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 251 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 236 252 zfact(ji,jj) = zwkb(ji,jj,jpkm1) 237 253 END_2D 238 254 ! 239 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 255 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 256 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 240 257 IF( zfact(ji,jj) /= 0 ) zwkb(ji,jj,jk) = zhdep(ji,jj) * ( zfact(ji,jj) - zwkb(ji,jj,jk) ) & 241 258 & * wmask(ji,jj,jk) / zfact(ji,jj) 242 259 END_3D 243 DO_2D( 0, 0, 0, 0 ) 260 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 261 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 244 262 zwkb (ji,jj,1) = zhdep(ji,jj) * wmask(ji,jj,1) 245 263 END_2D 246 264 ! 247 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 265 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 266 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 248 267 IF ( rn2(ji,jj,jk) <= 0._wp .OR. wmask(ji,jj,jk) == 0._wp ) THEN ! optimization: EXP coast a lot 249 268 zweight(ji,jj,jk) = 0._wp … … 254 273 END_3D 255 274 ! 256 DO_2D( 0, 0, 0, 0 ) 275 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 276 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 257 277 zfact(ji,jj) = 0._wp 258 278 END_2D 259 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! part independent of the level 279 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! part independent of the level 280 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! part independent of the level 260 281 zfact(ji,jj) = zfact(ji,jj) + zweight(ji,jj,jk) 261 282 END_3D 262 283 ! 263 DO_2D( 0, 0, 0, 0 ) 284 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 285 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 264 286 IF( zfact(ji,jj) /= 0 ) zfact(ji,jj) = ebot_iwm(ji,jj) / ( rho0 * zfact(ji,jj) ) 265 287 END_2D 266 288 ! 267 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! complete with the level-dependent part 289 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! complete with the level-dependent part 290 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! complete with the level-dependent part 268 291 zemx_iwm(ji,jj,jk) = zemx_iwm(ji,jj,jk) + zweight(ji,jj,jk) * zfact(ji,jj) * wmask(ji,jj,jk) & 269 292 & / ( gde3w(ji,jj,jk) - gde3w(ji,jj,jk-1) ) … … 273 296 !!gm this is to be replaced by just a constant value znu=1.e-6 m2/s 274 297 ! Calculate molecular kinematic viscosity 275 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 298 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 299 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 276 300 znu_t(ji,jj,jk) = 1.e-4_wp * ( 17.91_wp - 0.53810_wp * ts(ji,jj,jk,jp_tem,Kmm) & 277 301 & + 0.00694_wp * ts(ji,jj,jk,jp_tem,Kmm) * ts(ji,jj,jk,jp_tem,Kmm) & 278 302 & + 0.02305_wp * ts(ji,jj,jk,jp_sal,Kmm) ) * tmask(ji,jj,jk) * r1_rho0 279 303 END_3D 280 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 304 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 305 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 281 306 znu_w(ji,jj,jk) = 0.5_wp * ( znu_t(ji,jj,jk-1) + znu_t(ji,jj,jk) ) * wmask(ji,jj,jk) 282 307 END_3D … … 284 309 ! 285 310 ! Calculate turbulence intensity parameter Reb 286 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 311 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 312 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 287 313 zReb(ji,jj,jk) = zemx_iwm(ji,jj,jk) / MAX( 1.e-20_wp, znu_w(ji,jj,jk) * rn2(ji,jj,jk) ) 288 314 END_3D 289 315 ! 290 316 ! Define internal wave-induced diffusivity 291 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 317 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 318 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 292 319 zav_wave(ji,jj,jk) = znu_w(ji,jj,jk) * zReb(ji,jj,jk) * r1_6 ! This corresponds to a constant mixing efficiency of 1/6 293 320 END_3D 294 321 ! 295 322 IF( ln_mevar ) THEN ! Variable mixing efficiency case : modify zav_wave in the 296 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! energetic (Reb > 480) and buoyancy-controlled (Reb <10.224 ) regimes 323 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! energetic (Reb > 480) and buoyancy-controlled (Reb <10.224 ) regimes 324 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! energetic (Reb > 480) and buoyancy-controlled (Reb <10.224 ) regimes 297 325 IF( zReb(ji,jj,jk) > 480.00_wp ) THEN 298 326 zav_wave(ji,jj,jk) = 3.6515_wp * znu_w(ji,jj,jk) * SQRT( zReb(ji,jj,jk) ) … … 303 331 ENDIF 304 332 ! 305 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! Bound diffusivity by molecular value and 100 cm2/s 333 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! Bound diffusivity by molecular value and 100 cm2/s 334 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! Bound diffusivity by molecular value and 100 cm2/s 306 335 zav_wave(ji,jj,jk) = MIN( MAX( 1.4e-7_wp, zav_wave(ji,jj,jk) ), 1.e-2_wp ) * wmask(ji,jj,jk) 307 336 END_3D … … 310 339 zztmp = 0._wp 311 340 !!gm used of glosum 3D.... 312 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 341 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 342 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 313 343 zztmp = zztmp + e3w(ji,jj,jk,Kmm) * e1e2t(ji,jj) & 314 344 & * MAX( 0._wp, rn2(ji,jj,jk) ) * zav_wave(ji,jj,jk) * wmask(ji,jj,jk) * tmask_i(ji,jj) … … 332 362 IF( ln_tsdiff ) THEN !* Option for differential mixing of salinity and temperature 333 363 ztmp1 = 0.505_wp + 0.495_wp * TANH( 0.92_wp * ( LOG10( 1.e-20_wp ) - 0.60_wp ) ) 334 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! Calculate S/T diffusivity ratio as a function of Reb 364 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! Calculate S/T diffusivity ratio as a function of Reb 365 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! Calculate S/T diffusivity ratio as a function of Reb 335 366 ztmp2 = zReb(ji,jj,jk) * 5._wp * r1_6 336 367 IF ( ztmp2 > 1.e-20_wp .AND. wmask(ji,jj,jk) == 1._wp ) THEN … … 341 372 END_3D 342 373 CALL iom_put( "av_ratio", zav_ratio ) 343 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) !* update momentum & tracer diffusivity with wave-driven mixing 374 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) !* update momentum & tracer diffusivity with wave-driven mixing 375 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) !* update momentum & tracer diffusivity with wave-driven mixing 344 376 p_avs(ji,jj,jk) = p_avs(ji,jj,jk) + zav_wave(ji,jj,jk) * zav_ratio(ji,jj,jk) 345 377 p_avt(ji,jj,jk) = p_avt(ji,jj,jk) + zav_wave(ji,jj,jk) … … 348 380 ! 349 381 ELSE !* update momentum & tracer diffusivity with wave-driven mixing 350 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 382 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 383 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 351 384 p_avs(ji,jj,jk) = p_avs(ji,jj,jk) + zav_wave(ji,jj,jk) 352 385 p_avt(ji,jj,jk) = p_avt(ji,jj,jk) + zav_wave(ji,jj,jk) -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/ZDF/zdfmfc.F90
r14511 r14601 218 218 WHERE(zrautbm1 .NE. 0.) zfbuo(:,:) = grav * (zraupl(:,:) - zrautbm1(:,:)) / zrautbm1(:,:) 219 219 220 DO_2D( 0, 0, 0, 0 ) 220 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 221 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 221 222 222 223 ! Compute Environment of Plume. Interpolation T/S (before time step) on W-points … … 376 377 ! 377 378 ! 378 CALL lbc_lnk( 'zdfmfc', edmfm,'T',1., edmfa,'T',1., edmfb,'T',1., edmfc,'T',1., edmftra(:,:,:,jp_tem),'T',1., edmftra(:,:,:,jp_sal),'T',1.) 379 ! [comm_cleanup] 380 IF (nn_hls.eq.1) CALL lbc_lnk( 'zdfmfc', edmfm,'T',1., edmfa,'T',1., edmfb,'T',1., edmfc,'T',1., edmftra(:,:,:,jp_tem),'T',1., edmftra(:,:,:,jp_sal),'T',1.) 379 381 ! 380 382 END SUBROUTINE tra_mfc -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/ZDF/zdfmxl.F90
r13497 r14601 99 99 hmlp(:,:) = 0._wp ! here hmlp used as a dummy variable, integrating vertically N^2 100 100 zN2_c = grav * rho_c * r1_rho0 ! convert density criteria into N^2 criteria 101 DO_3D( 1, 1, 1, 1, nlb10, jpkm1 ) ! Mixed layer level: w-level 101 ! [comm_cleanup] ! DO_3D( 1, 1, 1, 1, nlb10, jpkm1 ) ! Mixed layer level: w-level 102 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, nlb10, jpkm1 ) ! Mixed layer level: w-level 102 103 ikt = mbkt(ji,jj) 103 104 hmlp(ji,jj) = & … … 108 109 ! w-level of the turbocline and mixing layer (iom_use) 109 110 imld(:,:) = mbkt(:,:) + 1 ! Initialization to the number of w ocean point 110 DO_3DS( 1, 1, 1, 1, jpkm1, nlb10, -1 ) ! from the bottom to nlb10 111 ! [comm_cleanup] ! DO_3DS( 1, 1, 1, 1, jpkm1, nlb10, -1 ) ! from the bottom to nlb10 112 DO_3DS( nn_hls, nn_hls, nn_hls, nn_hls, jpkm1, nlb10, -1 ) ! from the bottom to nlb10 111 113 IF( avt (ji,jj,jk) < avt_c * wmask(ji,jj,jk) ) imld(ji,jj) = jk ! Turbocline 112 114 END_3D 113 115 ! depth of the mixing and mixed layers 114 DO_2D( 1, 1, 1, 1 ) 116 ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) 117 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 115 118 iiki = imld(ji,jj) 116 119 iikn = nmln(ji,jj) -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/ZDF/zdfosm.F90
r14511 r14601 400 400 zz0 = rn_abs ! surface equi-partition in 2-bands 401 401 zz1 = 1. - rn_abs 402 DO_2D( 0, 0, 0, 0 ) 402 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 403 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 403 404 ! Surface downward irradiance (so always +ve) 404 405 zrad0(ji,jj) = qsr(ji,jj) * r1_rho0_rcp … … 410 411 END_2D 411 412 ! Turbulent surface fluxes and fluxes averaged over depth of the OSBL 412 DO_2D( 0, 0, 0, 0 ) 413 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 414 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 413 415 zthermal = rab_n(ji,jj,1,jp_tem) 414 416 zbeta = rab_n(ji,jj,1,jp_sal) … … 437 439 ! Assume constant La#=0.3 438 440 CASE(0) 439 DO_2D( 0, 0, 0, 0 ) 441 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 442 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 440 443 zus_x = zcos_wind(ji,jj) * zustar(ji,jj) / 0.3**2 441 444 zus_y = zsin_wind(ji,jj) * zustar(ji,jj) / 0.3**2 … … 446 449 ! Assume Pierson-Moskovitz wind-wave spectrum 447 450 CASE(1) 448 DO_2D( 0, 0, 0, 0 ) 451 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 452 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 449 453 ! Use wind speed wndm included in sbc_oce module 450 454 zustke(ji,jj) = MAX ( 0.016 * wndm(ji,jj), 1.0e-8 ) … … 455 459 zfac = 2.0_wp * rpi / 16.0_wp 456 460 457 DO_2D( 0, 0, 0, 0 ) 461 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 462 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 458 463 IF (hsw(ji,jj) > 1.e-4) THEN 459 464 ! Use wave fields … … 472 477 IF (ln_zdfosm_ice_shelter) THEN 473 478 ! Reduce both Stokes drift and its depth scale by ocean fraction to represent sheltering by ice 474 DO_2D( 0, 0, 0, 0 ) 479 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 480 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 475 481 zustke(ji,jj) = zustke(ji,jj) * (1.0_wp - fr_i(ji,jj)) 476 482 dstokes(ji,jj) = dstokes(ji,jj) * (1.0_wp - fr_i(ji,jj)) … … 494 500 z_two_thirds = 2.0_wp / 3.0_wp 495 501 496 DO_2D( 0, 0, 0, 0 ) 502 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 503 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 497 504 zthickness = rn_osm_hblfrac*hbl(ji,jj) 498 505 z2k_times_thickness = zthickness * 2.0_wp / MAX( ABS( 5.97_wp * dstokes(ji,jj) ), 0.0000001_wp ) … … 509 516 zsqrtpi = SQRT(rpi) 510 517 511 DO_2D( 0, 0, 0, 0 ) 518 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 519 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 512 520 zthickness = rn_osm_hblfrac*hbl(ji,jj) 513 521 z2k_times_thickness = zthickness * 2.0_wp / MAX( ABS( 5.97_wp * dstokes(ji,jj) ), 0.0000001_wp ) … … 530 538 ! Langmuir velocity scale (zwstrl), La # (zla) 531 539 ! mixed scale (zvstr), convective velocity scale (zwstrc) 532 DO_2D( 0, 0, 0, 0 ) 540 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 541 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 533 542 ! Langmuir velocity scale (zwstrl), at T-point 534 543 zwstrl(ji,jj) = ( zustar(ji,jj) * zustar(ji,jj) * zustke(ji,jj) )**pthird … … 563 572 hbl(:,:) = MAX(hbl(:,:), gdepw(:,:,4,Kmm) ) 564 573 ibld(:,:) = 4 565 DO_3D( 1, 1, 1, 1, 5, jpkm1 ) 574 ! [comm_cleanup] ! DO_3D( 1, 1, 1, 1, 5, jpkm1 ) 575 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 5, jpkm1 ) 566 576 IF ( hbl(ji,jj) >= gdepw(ji,jj,jk,Kmm) ) THEN 567 577 ibld(ji,jj) = MIN(mbkt(ji,jj), jk) … … 570 580 ! ########################################################################## 571 581 572 DO_2D( 0, 0, 0, 0 ) 582 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 583 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 573 584 zhbl(ji,jj) = gdepw(ji,jj,ibld(ji,jj),Kmm) 574 585 imld(ji,jj) = MAX(3,ibld(ji,jj) - MAX( INT( dh(ji,jj) / e3t(ji, jj, ibld(ji,jj), Kmm )) , 1 )) … … 590 601 ! Fox-Kemper Scheme 591 602 mld_prof = 4 592 DO_3D( 0, 0, 0, 0, 5, jpkm1 ) 603 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 5, jpkm1 ) 604 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 5, jpkm1 ) 593 605 IF ( hmle(ji,jj) >= gdepw(ji,jj,jk,Kmm) ) mld_prof(ji,jj) = MIN(mbkt(ji,jj), jk) 594 606 END_3D … … 596 608 CALL zdf_osm_vertical_average(mld_prof, jp_ext_mle, zt_mle, zs_mle, zb_mle, zu_mle, zv_mle, zdt_mle, zds_mle, zdb_mle, zdu_mle, zdv_mle) 597 609 598 DO_2D( 0, 0, 0, 0 ) 610 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 611 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 599 612 zhmle(ji,jj) = gdepw(ji,jj,mld_prof(ji,jj),Kmm) 600 613 END_2D … … 611 624 lflux(:,:) = .FALSE. 612 625 lmle(:,:) = .FALSE. 613 DO_2D( 0, 0, 0, 0 ) 626 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 627 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 614 628 IF ( lconv(ji,jj) .AND. zdb_bl(ji,jj) < rn_osm_bl_thresh ) lpyc(ji,jj) = .FALSE. 615 629 END_2D … … 617 631 618 632 ! Test if pycnocline well resolved 619 DO_2D( 0, 0, 0, 0 ) 633 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 634 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 620 635 IF (lconv(ji,jj) ) THEN 621 636 ztmp = 0.2 * zhbl(ji,jj) / e3w(ji,jj,ibld(ji,jj),Kmm) … … 638 653 ! Rate of change of hbl 639 654 CALL zdf_osm_calculate_dhdt( zdhdt, zddhdt ) 640 DO_2D( 0, 0, 0, 0 ) 655 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 656 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 641 657 zhbl_t(ji,jj) = hbl(ji,jj) + (zdhdt(ji,jj) - ww(ji,jj,ibld(ji,jj)))* rn_Dt ! certainly need ww here, so subtract it 642 658 ! adjustment to represent limiting by ocean bottom … … 650 666 ibld(:,:) = 4 651 667 652 DO_3D( 0, 0, 0, 0, 4, jpkm1 ) 668 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 4, jpkm1 ) 669 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 4, jpkm1 ) 653 670 IF ( zhbl_t(ji,jj) >= gdepw(ji,jj,jk,Kmm) ) THEN 654 671 ibld(ji,jj) = jk … … 669 686 CALL zdf_osm_pycnocline_thickness( dh, zdh ) 670 687 671 DO_2D( 0, 0, 0, 0 ) 688 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 689 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 672 690 IF ( zdb_bl(ji,jj) < rn_osm_bl_thresh .or. ibld(ji,jj) + jp_ext(ji,jj) >= mbkt(ji,jj) .or. ibld(ji,jj)-imld(ji,jj) == 1 ) lpyc(ji,jj) = .FALSE. 673 691 END_2D … … 709 727 710 728 711 DO_2D( 0, 0, 0, 0 ) 729 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 730 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 712 731 IF ( lconv(ji,jj) ) THEN 713 732 DO jk = 2, imld(ji,jj) … … 744 763 IF ( iom_use("ghamv_00") ) CALL iom_put( "ghamv_00", wmask*ghamv ) 745 764 END IF 746 DO_2D( 0, 0, 0, 0 ) 765 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 766 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 747 767 IF ( lconv(ji,jj) ) THEN 748 768 DO jk = 2, imld(ji,jj) … … 776 796 ENDWHERE 777 797 778 DO_2D( 0, 0, 0, 0 ) 798 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 799 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 779 800 IF (lconv(ji,jj) ) THEN 780 801 DO jk = 2, imld(ji,jj) … … 838 859 ENDWHERE 839 860 840 DO_2D( 0, 0, 0, 0 ) 861 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 862 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 841 863 IF ( lconv(ji,jj) ) THEN 842 864 DO jk = 2 , imld(ji,jj) … … 856 878 END_2D 857 879 858 DO_2D( 0, 0, 0, 0 ) 880 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 881 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 859 882 IF ( lpyc(ji,jj) ) THEN 860 883 IF ( j_ddh(ji,jj) == 0 ) THEN … … 891 914 ! Transport term in flux-gradient relationship [note : includes ROI ratio (X0.3) ] 892 915 893 DO_2D( 1, 0, 1, 0 ) 916 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 917 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 894 918 895 919 IF ( lconv(ji,jj) ) THEN … … 907 931 END_2D 908 932 909 DO_2D( 0, 0, 0, 0 ) 933 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 934 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 910 935 IF ( lconv(ji,jj) ) THEN 911 936 DO jk = 2, imld(ji,jj) … … 954 979 ENDWHERE 955 980 956 DO_2D( 0, 0, 0, 0 ) 981 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 982 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 957 983 IF ( lconv(ji,jj) ) THEN 958 984 DO jk = 2, imld(ji,jj) … … 1001 1027 ! Make surface forced velocity non-gradient terms go to zero at the base of the boundary layer. 1002 1028 1003 DO_2D( 0, 0, 0, 0 ) 1029 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 1030 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 1004 1031 IF ( .not. lconv(ji,jj) ) THEN 1005 1032 DO jk = 2, ibld(ji,jj) … … 1017 1044 1018 1045 ! pynocline contributions 1019 DO_2D( 0, 0, 0, 0 ) 1046 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 1047 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 1020 1048 IF ( .not. lconv(ji,jj) ) THEN 1021 1049 IF ( ibld(ji,jj) + jp_ext(ji,jj) < mbkt(ji,jj) ) THEN … … 1035 1063 END IF 1036 1064 1037 DO_2D( 0, 0, 0, 0 ) 1065 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 1066 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 1038 1067 ghamt(ji,jj,ibld(ji,jj)+ibld_ext) = 0._wp 1039 1068 ghams(ji,jj,ibld(ji,jj)+ibld_ext) = 0._wp … … 1060 1089 ! rotate non-gradient velocity terms back to model reference frame 1061 1090 1062 DO_2D( 0, 0, 0, 0 ) 1091 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 1092 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 1063 1093 DO jk = 2, ibld(ji,jj) 1064 1094 ztemp = ghamu(ji,jj,jk) … … 1076 1106 ! KPP-style Ri# mixing 1077 1107 IF( ln_kpprimix) THEN 1078 DO_3D( 1, 0, 1, 0, 2, jpkm1 ) !* Shear production at uw- and vw-points (energy conserving form) 1108 1109 ! [comm_cleanup] ! DO_3D( 1, 0, 1, 0, 2, jpkm1 ) !* Shear production at uw- and vw-points (energy conserving form) 1110 DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 2, jpkm1 ) 1079 1111 z3du(ji,jj,jk) = 0.5 * ( uu(ji,jj,jk-1,Kmm) - uu(ji ,jj,jk,Kmm) ) & 1080 1112 & * ( uu(ji,jj,jk-1,Kbb) - uu(ji ,jj,jk,Kbb) ) * wumask(ji,jj,jk) & … … 1085 1117 END_3D 1086 1118 ! 1087 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 1119 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 1120 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 1088 1121 ! ! shear prod. at w-point weightened by mask 1089 1122 zesh2 = ( z3du(ji-1,jj,jk) + z3du(ji,jj,jk) ) / MAX( 1._wp , umask(ji-1,jj,jk) + umask(ji,jj,jk) ) & … … 1096 1129 END_3D 1097 1130 1098 DO_2D( 0, 0, 0, 0 ) 1131 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 1132 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 1099 1133 DO jk = ibld(ji,jj) + 1, jpkm1 1100 1134 zdiffut(ji,jj,jk) = zrimix(ji,jj,jk)*rn_difri … … 1107 1141 ! KPP-style set diffusivity large if unstable below BL 1108 1142 IF( ln_convmix) THEN 1109 DO_2D( 0, 0, 0, 0 ) 1143 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 1144 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 1110 1145 DO jk = ibld(ji,jj) + 1, jpkm1 1111 1146 IF( MIN( rn2(ji,jj,jk), rn2b(ji,jj,jk) ) <= -1.e-12 ) zdiffut(ji,jj,jk) = rn_difconv … … 1117 1152 1118 1153 IF ( ln_osm_mle ) THEN ! set up diffusivity and non-gradient mixing 1119 DO_2D( 0, 0, 0, 0 ) 1154 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 1155 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 1120 1156 IF ( lflux(ji,jj) ) THEN ! MLE mixing extends below boundary layer 1121 1157 ! Calculate MLE flux contribution from surface fluxes … … 1158 1194 ! GN 25/8: need to change tmask --> wmask 1159 1195 1160 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 1196 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 1197 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 1161 1198 p_avt(ji,jj,jk) = MAX( zdiffut(ji,jj,jk), avtb(jk) ) * tmask(ji,jj,jk) 1162 1199 p_avm(ji,jj,jk) = MAX( zviscos(ji,jj,jk), avmb(jk) ) * tmask(ji,jj,jk) 1163 1200 END_3D 1164 1201 ! Lateral boundary conditions on ghamu and ghamv, currently on W-grid (sign unchanged), needed to caclulate gham[uv] on u and v grids 1165 CALL lbc_lnk( 'zdfosm', p_avt, 'W', 1.0_wp , p_avm, 'W', 1.0_wp, &1166 & ghamu, 'W', 1.0_wp , ghamv, 'W', 1.0_wp )1202 IF (nn_hls.eq.1) CALL lbc_lnk( 'zdfosm', p_avt, 'W', 1.0_wp , p_avm, 'W', 1.0_wp, & 1203 & ghamu, 'W', 1.0_wp , ghamv, 'W', 1.0_wp ) 1167 1204 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 1168 1205 ghamu(ji,jj,jk) = ( ghamu(ji,jj,jk) + ghamu(ji+1,jj,jk) ) & … … 1176 1213 END_3D 1177 1214 ! Lateral boundary conditions on final outputs for hbl, on T-grid (sign unchanged) 1178 CALL lbc_lnk( 'zdfosm', hbl, 'T', 1., dh, 'T', 1., hmle, 'T', 1. ) 1215 ! [comm_cleanup] ! no need lbc_lnk for output 1216 ! CALL lbc_lnk( 'zdfosm', hbl, 'T', 1., dh, 'T', 1., hmle, 'T', 1. ) 1179 1217 ! Lateral boundary conditions on final outputs for gham[ts], on W-grid (sign unchanged) 1180 1218 ! Lateral boundary conditions on final outputs for gham[uv], on [UV]-grid (sign changed) 1181 CALL lbc_lnk( 'zdfosm', ghamt, 'W', 1.0_wp , ghams, 'W', 1.0_wp, & 1182 & ghamu, 'U', -1.0_wp , ghamv, 'V', -1.0_wp ) 1219 ! [comm_cleanup] ! no need lbc_lnk for output 1220 ! CALL lbc_lnk( 'zdfosm', ghamt, 'W', 1.0_wp , ghams, 'W', 1.0_wp, & 1221 ! & ghamu, 'U', -1.0_wp , ghamv, 'V', -1.0_wp ) 1183 1222 1184 1223 IF(ln_dia_osm) THEN … … 1280 1319 REAL(wp), PARAMETER :: rn_vispyc_shr = 0.15 1281 1320 1282 DO_2D( 0, 0, 0, 0 ) 1321 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 1322 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 1283 1323 IF ( lconv(ji,jj) ) THEN 1284 1324 … … 1323 1363 END_2D 1324 1364 ! 1325 DO_2D( 0, 0, 0, 0 ) 1365 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 1366 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 1326 1367 IF ( lconv(ji,jj) ) THEN 1327 1368 DO jk = 2, imld(ji,jj) ! mixed layer diffusivity … … 1422 1463 1423 1464 ! Determins stability and set flag lconv 1424 DO_2D( 0, 0, 0, 0 ) 1465 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 1466 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 1425 1467 IF ( zhol(ji,jj) < 0._wp ) THEN 1426 1468 lconv(ji,jj) = .TRUE. … … 1439 1481 j_ddh(:,:) = 1 1440 1482 1441 DO_2D( 0, 0, 0, 0 ) 1483 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 1484 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 1442 1485 IF ( lconv(ji,jj) ) THEN 1443 1486 IF ( zdb_bl(ji,jj) > 0._wp ) THEN … … 1476 1519 ! Calculate entrainment buoyancy flux due to surface fluxes. 1477 1520 1478 DO_2D( 0, 0, 0, 0 ) 1521 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 1522 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 1479 1523 IF ( lconv(ji,jj) ) THEN 1480 1524 zwcor = ABS(ff_t(ji,jj)) * zhbl(ji,jj) + epsln … … 1501 1545 zwb_min(:,:) = 0._wp 1502 1546 1503 DO_2D( 0, 0, 0, 0 ) 1547 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 1548 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 1504 1549 IF ( lshear(ji,jj) ) THEN 1505 1550 IF ( lconv(ji,jj) ) THEN … … 1562 1607 zu = 0._wp 1563 1608 zv = 0._wp 1564 DO_2D( 0, 0, 0, 0 ) 1609 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 1610 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 1565 1611 zthermal = rab_n(ji,jj,1,jp_tem) !ideally use ibld not 1?? 1566 1612 zbeta = rab_n(ji,jj,1,jp_sal) … … 1619 1665 REAL(wp) :: ztemp 1620 1666 1621 DO_2D( 0, 0, 0, 0 ) 1667 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 1668 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 1622 1669 ztemp = zu(ji,jj) 1623 1670 zu(ji,jj) = zu(ji,jj) * zcos_w(ji,jj) + zv(ji,jj) * zsin_w(ji,jj) … … 1653 1700 znd_param(:,:) = 0._wp 1654 1701 1655 DO_2D( 0, 0, 0, 0 ) 1702 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 1703 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 1656 1704 ztmp = r1_ft(ji,jj) * MIN( 111.e3_wp , e1u(ji,jj) ) / rn_osm_mle_lf 1657 1705 zwb_fk(ji,jj) = rn_osm_mle_ce * hmle(ji,jj) * hmle(ji,jj) * ztmp * zdbds_mle(ji,jj) * zdbds_mle(ji,jj) 1658 1706 END_2D 1659 DO_2D( 0, 0, 0, 0 ) 1707 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 1708 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 1660 1709 ! 1661 1710 IF ( lconv(ji,jj) ) THEN … … 1681 1730 1682 1731 ! Diagnosis 1683 DO_2D( 0, 0, 0, 0 ) 1732 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 1733 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 1684 1734 IF ( lconv(ji,jj) ) THEN 1685 1735 zwb_ent = - 2.0 * 0.2 * zwbav(ji,jj) & … … 1751 1801 1752 1802 1753 DO_2D( 0, 0, 0, 0 ) 1803 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 1804 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 1754 1805 IF ( jbase(ji,jj)+1 < mbkt(ji,jj) ) THEN 1755 1806 zthermal = rab_n(ji,jj,1,jp_tem) !ideally use ibld not 1?? … … 1781 1832 REAL(wp), PARAMETER :: zgamma_b = 2.25, zzeta_sh = 0.15 1782 1833 1783 DO_2D( 0, 0, 0, 0 ) 1834 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 1835 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 1784 1836 IF ( ibld(ji,jj) + jp_ext(ji,jj) < mbkt(ji,jj) ) THEN 1785 1837 IF ( lconv(ji,jj) ) THEN ! convective conditions … … 1866 1918 REAL(wp) :: zzeta_v = 0.45 1867 1919 ! 1868 DO_2D( 0, 0, 0, 0 ) 1920 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 1921 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 1869 1922 ! 1870 1923 IF ( ibld(ji,jj) + jp_ext(ji,jj) < mbkt(ji,jj) ) THEN … … 1929 1982 REAL, PARAMETER :: a_ddh = 2.5, a_ddh_2 = 3.5 ! also in pycnocline_depth 1930 1983 1931 DO_2D( 0, 0, 0, 0 ) 1984 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 1985 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 1932 1986 1933 1987 IF ( lshear(ji,jj) ) THEN … … 2072 2126 REAL(wp) :: zthermal, zbeta 2073 2127 2074 DO_2D( 0, 0, 0, 0 ) 2128 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 2129 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 2075 2130 IF ( ibld(ji,jj) - imld(ji,jj) > 1 ) THEN 2076 2131 ! … … 2176 2231 REAL, PARAMETER :: a_ddh_2 = 3.5 ! also in pycnocline_depth 2177 2232 2178 DO_2D( 0, 0, 0, 0 ) 2233 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 2234 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 2179 2235 2180 2236 IF ( lshear(ji,jj) ) THEN … … 2322 2378 zmld(:,:) = 0._wp ! here hmlp used as a dummy variable, integrating vertically N^2 2323 2379 zN2_c = grav * rn_osm_mle_rho_c * r1_rho0 ! convert density criteria into N^2 criteria 2324 DO_3D( 1, 1, 1, 1, nlb10, jpkm1 ) 2380 ! [comm_cleanup] ! DO_3D( 1, 1, 1, 1, nlb10, jpkm1 ) 2381 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, nlb10, jpkm1 ) 2325 2382 ikt = mbkt(ji,jj) 2326 2383 zmld(ji,jj) = zmld(ji,jj) + MAX( rn2b(ji,jj,jk) , 0._wp ) * e3w(ji,jj,jk,Kmm) 2327 2384 IF( zmld(ji,jj) < zN2_c ) mld_prof(ji,jj) = MIN( jk , ikt ) + 1 ! Mixed layer level 2328 2385 END_3D 2329 DO_2D( 1, 1, 1, 1 ) 2386 ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) 2387 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 2330 2388 mld_prof(ji,jj) = MAX(mld_prof(ji,jj),ibld(ji,jj)) 2331 2389 zmld(ji,jj) = gdepw(ji,jj,mld_prof(ji,jj),Kmm) … … 2337 2395 ztm(:,:) = 0._wp 2338 2396 zsm(:,:) = 0._wp 2339 DO_3D( 1, 1, 1, 1, 1, ikmax ) 2397 ! [comm_cleanup] ! DO_3D( 1, 1, 1, 1, 1, ikmax ) 2398 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, ikmax ) 2340 2399 zc = e3t(ji,jj,jk,Kmm) * REAL( MIN( MAX( 0, mld_prof(ji,jj)-jk ) , 1 ) ) ! zc being 0 outside the ML t-points 2341 2400 ztm(ji,jj) = ztm(ji,jj) + zc * ts(ji,jj,jk,jp_tem,Kmm) … … 2347 2406 ! calculate horizontal gradients at u & v points 2348 2407 2349 DO_2D( 1, 0, 0, 0 ) 2408 ! [comm_cleanup] ! DO_2D( 1, 0, 0, 0 ) 2409 DO_2D( nn_hls, nn_hls-1, nn_hls-1, nn_hls-1 ) 2350 2410 zdtdx(ji,jj) = ( ztm(ji+1,jj) - ztm( ji,jj) ) * umask(ji,jj,1) / e1u(ji,jj) 2351 2411 zdsdx(ji,jj) = ( zsm(ji+1,jj) - zsm( ji,jj) ) * umask(ji,jj,1) / e1u(ji,jj) … … 2355 2415 END_2D 2356 2416 2357 DO_2D( 0, 0, 1, 0 ) 2417 ! [comm_cleanup] ! DO_2D( 0, 0, 1, 0 ) 2418 DO_2D( nn_hls-1, nn_hls-1, nn_hls, nn_hls-1 ) 2358 2419 zdtdy(ji,jj) = ( ztm(ji,jj+1) - ztm( ji,jj) ) * vmask(ji,jj,1) / e1v(ji,jj) 2359 2420 zdsdy(ji,jj) = ( zsm(ji,jj+1) - zsm( ji,jj) ) * vmask(ji,jj,1) / e1v(ji,jj) … … 2366 2427 CALL eos_rab(ztsm_midv, zmld_midv, zabv, Kmm) 2367 2428 2368 DO_2D( 1, 0, 0, 0 ) 2429 ! [comm_cleanup] ! DO_2D( 1, 0, 0, 0 ) 2430 DO_2D( nn_hls, nn_hls-1, nn_hls-1, nn_hls-1 ) 2369 2431 dbdx_mle(ji,jj) = grav*(zdtdx(ji,jj)*zabu(ji,jj,jp_tem) - zdsdx(ji,jj)*zabu(ji,jj,jp_sal)) 2370 2432 END_2D 2371 DO_2D( 0, 0, 1, 0 ) 2433 ! [comm_cleanup] ! DO_2D( 0, 0, 1, 0 ) 2434 DO_2D( nn_hls-1, nn_hls-1, nn_hls, nn_hls-1 ) 2372 2435 dbdy_mle(ji,jj) = grav*(zdtdy(ji,jj)*zabv(ji,jj,jp_tem) - zdsdy(ji,jj)*zabv(ji,jj,jp_sal)) 2373 2436 END_2D 2374 2437 2375 DO_2D( 0, 0, 0, 0 ) 2438 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 2439 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 2376 2440 ztmp = r1_ft(ji,jj) * MIN( 111.e3_wp , e1u(ji,jj) ) / rn_osm_mle_lf 2377 2441 zdbds_mle(ji,jj) = SQRT( 0.5_wp * ( dbdx_mle(ji,jj) * dbdx_mle(ji,jj) + dbdy_mle(ji,jj) * dbdy_mle(ji,jj) & … … 2400 2464 ! Calculate vertical buoyancy, heat and salinity fluxes due to MLE. 2401 2465 2402 DO_2D( 0, 0, 0, 0 ) 2466 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 2467 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 2403 2468 IF ( lconv(ji,jj) ) THEN 2404 2469 ztmp = r1_ft(ji,jj) * MIN( 111.e3_wp , e1u(ji,jj) ) / rn_osm_mle_lf … … 2409 2474 END_2D 2410 2475 ! Timestep mixed layer eddy depth. 2411 DO_2D( 0, 0, 0, 0 ) 2476 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 2477 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 2412 2478 IF ( lmle(ji,jj) ) THEN ! MLE layer growing. 2413 2479 ! Buoyancy gradient at base of MLE layer. … … 2433 2499 2434 2500 mld_prof = 4 2435 DO_3D( 0, 0, 0, 0, 5, jpkm1 ) 2501 2502 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 5, jpkm1 ) 2503 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 5, jpkm1 ) 2436 2504 IF ( hmle(ji,jj) >= gdepw(ji,jj,jk,Kmm) ) mld_prof(ji,jj) = MIN(mbkt(ji,jj), jk) 2437 2505 END_3D 2438 DO_2D( 0, 0, 0, 0 ) 2506 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 2507 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 2439 2508 zhmle(ji,jj) = gdepw(ji,jj, mld_prof(ji,jj),Kmm) 2440 2509 END_2D … … 2585 2654 ! ! 1/(f^2+tau^2)^1/2 at t-point (needed in both nn_osm_mle case) 2586 2655 z1_t2 = 2.e-5 2587 DO_2D( 1, 1, 1, 1 ) 2656 ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) 2657 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 2588 2658 r1_ft(ji,jj) = MIN(1./( ABS(ff_t(ji,jj)) + epsln ), ABS(ff_t(ji,jj))/z1_t2**2) 2589 2659 END_2D … … 2630 2700 etmean(:,:,:) = 0.e0 2631 2701 2632 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 2702 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 2703 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 2633 2704 etmean(ji,jj,jk) = tmask(ji,jj,jk) & 2634 2705 & / MAX( 1., umask(ji-1,jj ,jk) + umask(ji,jj,jk) & … … 2644 2715 etmean(:,:,:) = 0.e0 2645 2716 2646 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 2717 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 2718 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 2647 2719 etmean(ji,jj,jk) = tmask(ji, jj,jk) & 2648 2720 & / MAX( 1., 2.* tmask(ji,jj,jk) & … … 2759 2831 ! 2760 2832 hbl(:,:) = 0._wp ! here hbl used as a dummy variable, integrating vertically N^2 2761 DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 2833 ! [comm_cleanup] ! DO_3D( 1, 1, 1, 1, 1, jpkm1 ) 2834 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 2762 2835 ikt = mbkt(ji,jj) 2763 2836 hbl(ji,jj) = hbl(ji,jj) + MAX( rn2(ji,jj,jk) , 0._wp ) * e3w(ji,jj,jk,Kmm) … … 2765 2838 END_3D 2766 2839 ! 2767 DO_2D( 1, 1, 1, 1 ) 2840 ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) 2841 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 2768 2842 iiki = MAX(4,imld_rst(ji,jj)) 2769 2843 hbl (ji,jj) = gdepw(ji,jj,iiki,Kmm ) ! Turbocline depth … … 2812 2886 ENDIF 2813 2887 2814 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 2888 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 2889 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 2815 2890 pts(ji,jj,jk,jp_tem,Krhs) = pts(ji,jj,jk,jp_tem,Krhs) & 2816 2891 & - ( ghamt(ji,jj,jk ) & … … 2879 2954 !code saving tracer trends removed, replace with trdmxl_oce 2880 2955 2881 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! add non-local u and v fluxes 2956 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! add non-local u and v fluxes 2957 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) ! add non-local u and v fluxes 2882 2958 puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) & 2883 2959 & - ( ghamu(ji,jj,jk ) & -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/ZDF/zdfphy.F90
r14511 r14601 54 54 INTEGER, PARAMETER :: np_OSM = 5 ! OSMOSIS-OBL closure scheme for Kz 55 55 56 LOGICAL :: l_zdfsh2 ! shear production term flag (=F for CST, =T otherwise (i.e. TKE, GLS, RIC))56 LOGICAL, PUBLIC :: l_zdfsh2 ! shear production term flag (=F for CST, =T otherwise (i.e. TKE, GLS, RIC)) 57 57 58 58 !!---------------------------------------------------------------------- … … 284 284 CASE( np_TKE ) ; CALL zdf_tke( kt, Kbb, Kmm, zsh2, avm_k, avt_k ) ! TKE closure scheme for Kz 285 285 CASE( np_GLS ) ; CALL zdf_gls( kt, Kbb, Kmm, zsh2, avm_k, avt_k ) ! GLS closure scheme for Kz 286 ! [comm_cleanup] ! modified but not tested - no ref config uses this scheme 286 287 CASE( np_OSM ) ; CALL zdf_osm( kt, Kbb, Kmm, Krhs, avm_k, avt_k ) ! OSMOSIS closure scheme for Kz 287 288 ! CASE( np_CST ) ! Constant Kz (reset avt, avm to the background value) … … 322 323 323 324 ! !* Lateral boundary conditions (sign unchanged) 324 IF( l_zdfsh2 ) THEN 325 CALL lbc_lnk( 'zdfphy', avm_k, 'W', 1.0_wp , avt_k, 'W', 1.0_wp, & 326 & avm , 'W', 1.0_wp , avt , 'W', 1.0_wp , avs , 'W', 1.0_wp ) 327 ELSE 328 CALL lbc_lnk( 'zdfphy', avm , 'W', 1.0_wp , avt , 'W', 1.0_wp , avs , 'W', 1.0_wp ) 329 ENDIF 330 ! 331 IF( l_zdfdrg ) THEN ! drag have been updated (non-linear cases) 332 IF( ln_isfcav ) THEN ; CALL lbc_lnk( 'zdfphy', rCdU_top, 'T', 1.0_wp , rCdU_bot, 'T', 1.0_wp ) ! top & bot drag 333 ELSE ; CALL lbc_lnk( 'zdfphy', rCdU_bot, 'T', 1.0_wp ) ! bottom drag only 325 ! [comm_cleanup] ! lbc_lnk shifted in stp 326 IF(nn_hls.eq.1) THEN 327 IF( l_zdfsh2 ) THEN 328 CALL lbc_lnk( 'zdfphy', avm_k, 'W', 1.0_wp , avt_k, 'W', 1.0_wp, & 329 & avm , 'W', 1.0_wp , avt , 'W', 1.0_wp , avs , 'W', 1.0_wp ) 330 ELSE 331 CALL lbc_lnk( 'zdfphy', avm , 'W', 1.0_wp , avt , 'W', 1.0_wp , avs , 'W', 1.0_wp ) 332 ENDIF 333 ! 334 IF( l_zdfdrg ) THEN ! drag have been updated (non-linear cases) 335 IF( ln_isfcav ) THEN ; CALL lbc_lnk( 'zdfphy', rCdU_top, 'T', 1.0_wp , rCdU_bot, 'T', 1.0_wp ) ! top & bot drag 336 ELSE ; CALL lbc_lnk( 'zdfphy', rCdU_bot, 'T', 1.0_wp ) ! bottom drag only 337 ENDIF 334 338 ENDIF 335 339 ENDIF -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/ZDF/zdfric.F90
r14072 r14601 156 156 ! 157 157 ! !== avm and avt = F(Richardson number) ==! 158 DO_3D( 1, 0, 1, 0, 2, jpkm1 ) ! coefficient = F(richardson number) (avm-weighted Ri) 158 ! [comm_cleanup] ! DO_3D( 1, 0, 1, 0, 2, jpkm1 ) ! coefficient = F(richardson number) (avm-weighted Ri) 159 DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 2, jpkm1 ) ! coefficient = F(richardson number) (avm-weighted Ri) 159 160 zcfRi = 1._wp / ( 1._wp + rn_alp * MAX( 0._wp , avm(ji,jj,jk) * rn2(ji,jj,jk) / ( p_sh2(ji,jj,jk) + 1.e-20 ) ) ) 160 161 zav = rn_avmri * zcfRi**nn_ric … … 169 170 IF( ln_mldw ) THEN !== set a minimum value in the Ekman layer ==! 170 171 ! 171 DO_2D( 0, 0, 0, 0 ) !* Ekman depth 172 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) !* Ekman depth 173 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 172 174 zustar = SQRT( taum(ji,jj) * r1_rho0 ) 173 175 zhek = rn_ekmfc * zustar / ( ABS( ff_t(ji,jj) ) + rsmall ) ! Ekman depth 174 176 zh_ekm(ji,jj) = MAX( rn_mldmin , MIN( zhek , rn_mldmax ) ) ! set allowed range 175 177 END_2D 176 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) !* minimum mixing coeff. within the Ekman layer 178 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) !* minimum mixing coeff. within the Ekman layer 179 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) !* minimum mixing coeff. within the Ekman layer 177 180 IF( gdept(ji,jj,jk,Kmm) < zh_ekm(ji,jj) ) THEN 178 181 p_avm(ji,jj,jk) = MAX( p_avm(ji,jj,jk), rn_wvmix ) * wmask(ji,jj,jk) -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/ZDF/zdfsh2.F90
r14072 r14601 65 65 DO jk = 2, jpkm1 !* Shear production at uw- and vw-points (energy conserving form) 66 66 IF ( cpl_sdrftx .AND. ln_stshear ) THEN ! Surface Stokes Drift available ===>>> shear + stokes drift contibution 67 DO_2D( 1, 0, 1, 0 ) 67 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) 68 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) 68 69 zsh2u(ji,jj) = ( p_avm(ji+1,jj,jk) + p_avm(ji,jj,jk) ) & 69 70 & * ( uu (ji,jj,jk-1,Kmm) - uu (ji,jj,jk,Kmm) & … … 78 79 END_2D 79 80 ELSE 80 DO_2D( 1, 0, 1, 0 ) !* 2 x shear production at uw- and vw-points (energy conserving form) 81 ! [comm_cleanup] ! DO_2D( 1, 0, 1, 0 ) !* 2 x shear production at uw- and vw-points (energy conserving form) 82 DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 ) !* 2 x shear production at uw- and vw-points (energy conserving form) 81 83 zsh2u(ji,jj) = ( p_avm(ji+1,jj,jk) + p_avm(ji,jj,jk) ) & 82 84 & * ( uu(ji,jj,jk-1,Kmm) - uu(ji,jj,jk,Kmm) ) & … … 91 93 END_2D 92 94 ENDIF 93 DO_2D( 0, 0, 0, 0 ) !* shear production at w-point ! coast mask: =2 at the coast ; =1 otherwise (NB: wmask useless as zsh2 are masked) 95 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) !* shear production at w-point ! coast mask: =2 at the coast ; =1 otherwise (NB: wmask useless as zsh2 are masked) 96 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) !* shear production at w-point ! coast mask: =2 at the coast ; =1 otherwise (NB: wmask useless as zsh2 are masked) 94 97 p_sh2(ji,jj,jk) = 0.25 * ( ( zsh2u(ji-1,jj) + zsh2u(ji,jj) ) * ( 2. - umask(ji-1,jj,jk) * umask(ji,jj,jk) ) & 95 98 & + ( zsh2v(ji,jj-1) + zsh2v(ji,jj) ) * ( 2. - vmask(ji,jj-1,jk) * vmask(ji,jj,jk) ) ) -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/ZDF/zdfswm.F90
r13295 r14601 63 63 ! 64 64 zcoef = 1._wp * 0.353553_wp 65 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 65 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 66 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 66 67 zqb = zcoef * hsw(ji,jj) * tsd2d(ji,jj) * EXP( -3. * wnum(ji,jj) * gdepw(ji,jj,jk,Kmm) ) * wmask(ji,jj,jk) 67 68 ! -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/ZDF/zdftke.F90
r14072 r14601 241 241 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 242 242 ! 243 DO_2D( 0, 0, 0, 0 ) 243 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 244 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 244 245 en(ji,jj,1) = MAX( rn_emin0, zbbrau * taum(ji,jj) ) 245 246 zdiag(ji,jj,1) = 1._wp/en(ji,jj,1) … … 258 259 IF( .NOT.ln_drg_OFF ) THEN !== friction used as top/bottom boundary condition on TKE 259 260 ! 260 DO_2D( 0, 0, 0, 0 ) ! bottom friction 261 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) ! bottom friction 262 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! bottom friction 261 263 zmsku = ( 2. - umask(ji-1,jj,mbkt(ji,jj)) * umask(ji,jj,mbkt(ji,jj)) ) 262 264 zmskv = ( 2. - vmask(ji,jj-1,mbkt(ji,jj)) * vmask(ji,jj,mbkt(ji,jj)) ) … … 267 269 END_2D 268 270 IF( ln_isfcav ) THEN 269 DO_2D( 0, 0, 0, 0 ) ! top friction 271 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) ! top friction 272 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! top friction 270 273 zmsku = ( 2. - umask(ji-1,jj,mikt(ji,jj)) * umask(ji,jj,mikt(ji,jj)) ) 271 274 zmskv = ( 2. - vmask(ji,jj-1,mikt(ji,jj)) * vmask(ji,jj,mikt(ji,jj)) ) … … 294 297 !!gm ! PS: currently we don't have neither the 2 stress components at t-point !nor the angle between u* and u_s 295 298 !!gm ! so we will overestimate the LC velocity.... !!gm I will do the work if !LC have an effect ! 296 DO_2D( 0, 0, 0, 0 ) 299 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 300 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 297 301 !!XC zWlc2(ji,jj) = 0.5_wp * SQRT( taum(ji,jj) * r1_rho0 * ( ut0sd(ji,jj)**2 +vt0sd(ji,jj)**2 ) ) 298 302 zWlc2(ji,jj) = 0.5_wp * ( ut0sd(ji,jj)**2 +vt0sd(ji,jj)**2 ) … … 301 305 ! Projection of Stokes drift in the wind stress direction 302 306 ! 303 DO_2D( 0, 0, 0, 0 ) 307 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 308 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 304 309 ztaui = 0.5_wp * ( utau(ji,jj) + utau(ji-1,jj) ) 305 310 ztauj = 0.5_wp * ( vtau(ji,jj) + vtau(ji,jj-1) ) … … 307 312 zWlc2(ji,jj) = 0.5_wp * z1_norm * ( MAX( ut0sd(ji,jj)*ztaui + vt0sd(ji,jj)*ztauj, 0._wp ) )**2 308 313 END_2D 309 CALL lbc_lnk ( 'zdftke', zWlc2, 'T', 1. ) 314 ! [comm_cleanup] 315 IF (nn_hls.eq.1) CALL lbc_lnk ( 'zdftke', zWlc2, 'T', 1. ) 310 316 ! 311 317 ELSE ! Surface Stokes drift deduced from surface stress … … 315 321 ! ! 1/2 Wlc^2 = 0.5 * 0.016 * 0.016 |tau| /( rho_air Cdrag ) 316 322 zcof = 0.5 * 0.016 * 0.016 / ( zrhoa * zcdrag ) ! to convert stress in 10m wind using a constant drag 317 DO_2D( 1, 1, 1, 1 ) 323 ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) 324 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 318 325 zWlc2(ji,jj) = zcof * taum(ji,jj) 319 326 END_2D … … 331 338 ! !- compare LHS to RHS of Eq.47 332 339 imlc(:,:) = mbkt(:,:) + 1 ! Initialization to the number of w ocean point (=2 over land) 333 DO_3DS( 1, 1, 1, 1, jpkm1, 2, -1 ) 340 ! [comm_cleanup] ! DO_3DS( 1, 1, 1, 1, jpkm1, 2, -1 ) 341 DO_3DS( nn_hls, nn_hls, nn_hls, nn_hls, jpkm1, 2, -1 ) 334 342 IF( zpelc(ji,jj,jk) > zWlc2(ji,jj) ) imlc(ji,jj) = jk 335 343 END_3D 336 344 ! ! finite LC depth 337 DO_2D( 1, 1, 1, 1 ) 345 ! [comm_cleanup] ! DO_2D( 1, 1, 1, 1 ) 346 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 338 347 zhlc(ji,jj) = gdepw(ji,jj,imlc(ji,jj),Kmm) 339 348 END_2D 340 349 ! 341 350 zcof = 0.016 / SQRT( zrhoa * zcdrag ) 342 DO_2D( 0, 0, 0, 0 ) 351 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 352 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 343 353 zus = SQRT( 2. * zWlc2(ji,jj) ) ! Stokes drift 344 354 zus3(ji,jj) = MAX( 0._wp, 1._wp - zice_fra(ji,jj) ) * zus * zus * zus * tmask(ji,jj,1) ! zus > 0. ok 345 355 END_2D 346 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) !* TKE Langmuir circulation source term added to en 356 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) !* TKE Langmuir circulation source term added to en 357 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) !* TKE Langmuir circulation source term added to en 347 358 IF ( zus3(ji,jj) /= 0._wp ) THEN 348 359 IF ( gdepw(ji,jj,jk,Kmm) - zhlc(ji,jj) < 0 .AND. wmask(ji,jj,jk) /= 0. ) THEN … … 365 376 ! 366 377 IF( nn_pdl == 1 ) THEN !* Prandtl number = F( Ri ) 367 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 378 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 379 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 368 380 ! ! local Richardson number 369 381 IF (rn2b(ji,jj,jk) <= 0.0_wp) then … … 377 389 ENDIF 378 390 ! 379 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) !* Matrix and right hand side in en 391 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) !* Matrix and right hand side in en 392 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) !* Matrix and right hand side in en 380 393 zcof = zfact1 * tmask(ji,jj,jk) 381 394 ! ! A minimum of 2.e-5 m2/s is imposed on TKE vertical … … 406 419 407 420 CASE ( 0 ) ! Dirichlet BC 408 DO_2D( 0, 0, 0, 0 ) ! en(1) = rn_ebb taum / rho0 (min value rn_emin0) 421 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) ! en(1) = rn_ebb taum / rho0 (min value rn_emin0) 422 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! en(1) = rn_ebb taum / rho0 (min value rn_emin0) 409 423 IF ( phioc(ji,jj) < 0 ) phioc(ji,jj) = 0._wp 410 424 en(ji,jj,1) = MAX( rn_emin0, .5 * ( 15.8 * phioc(ji,jj) / rho0 )**(2./3.) ) * tmask(ji,jj,1) … … 413 427 414 428 CASE ( 1 ) ! Neumann BC 415 DO_2D( 0, 0, 0, 0 ) 429 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 430 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 416 431 IF ( phioc(ji,jj) < 0 ) phioc(ji,jj) = 0._wp 417 432 en(ji,jj,2) = en(ji,jj,2) + ( rn_Dt * phioc(ji,jj) / rho0 ) /e3w(ji,jj,2,Kmm) … … 427 442 ! 428 443 ! !* Matrix inversion from level 2 (tke prescribed at level 1) 429 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 444 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 445 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! First recurrence : Dk = Dk - Lk * Uk-1 / Dk-1 430 446 zdiag(ji,jj,jk) = zdiag(ji,jj,jk) - zd_lw(ji,jj,jk) * zd_up(ji,jj,jk-1) / zdiag(ji,jj,jk-1) 431 447 END_3D … … 434 450 ! zd_lw(ji,jj,2) = en(ji,jj,2) - zd_lw(ji,jj,2) * en(ji,jj,1) ! Surface boudary conditions on tke 435 451 ! END_2D 436 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 452 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 453 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 437 454 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) 438 455 END_3D 439 DO_2D( 0, 0, 0, 0 ) ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 456 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 457 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! thrid recurrence : Ek = ( Lk - Uk * Ek+1 ) / Dk 440 458 en(ji,jj,jpkm1) = zd_lw(ji,jj,jpkm1) / zdiag(ji,jj,jpkm1) 441 459 END_2D 442 DO_3DS( 0, 0, 0, 0, jpk-2, 2, -1 ) 460 ! [comm_cleanup] ! DO_3DS( 0, 0, 0, 0, jpk-2, 2, -1 ) 461 DO_3DS( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jpk-2, 2, -1 ) 443 462 en(ji,jj,jk) = ( zd_lw(ji,jj,jk) - zd_up(ji,jj,jk) * en(ji,jj,jk+1) ) / zdiag(ji,jj,jk) 444 463 END_3D 445 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! set the minimum value of tke 464 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! set the minimum value of tke 465 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! set the minimum value of tke 446 466 en(ji,jj,jk) = MAX( en(ji,jj,jk), rn_emin ) * wmask(ji,jj,jk) 447 467 END_3D … … 456 476 ! 457 477 IF( nn_etau == 1 ) THEN !* penetration below the mixed layer (rn_efr fraction) 458 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 478 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 479 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 459 480 en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -gdepw(ji,jj,jk,Kmm) / htau(ji,jj) ) & 460 481 & * MAX( 0._wp, 1._wp - zice_fra(ji,jj) ) * wmask(ji,jj,jk) * tmask(ji,jj,1) 461 482 END_3D 462 483 ELSEIF( nn_etau == 2 ) THEN !* act only at the base of the mixed layer (jk=nmln) (rn_efr fraction) 463 DO_2D( 0, 0, 0, 0 ) 484 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 485 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 464 486 jk = nmln(ji,jj) 465 487 en(ji,jj,jk) = en(ji,jj,jk) + rn_efr * en(ji,jj,1) * EXP( -gdepw(ji,jj,jk,Kmm) / htau(ji,jj) ) & … … 467 489 END_2D 468 490 ELSEIF( nn_etau == 3 ) THEN !* penetration belox the mixed layer (HF variability) 469 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 491 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 492 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 470 493 ztx2 = utau(ji-1,jj ) + utau(ji,jj) 471 494 zty2 = vtau(ji ,jj-1) + vtau(ji,jj) … … 548 571 zraug = vkarmn * 2.e5_wp / ( rho0 * grav ) 549 572 #if ! defined key_si3 && ! defined key_cice 550 DO_2D( 0, 0, 0, 0 ) ! No sea-ice 573 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) ! No sea-ice 574 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! No sea-ice 551 575 zmxlm(ji,jj,1) = zraug * taum(ji,jj) * tmask(ji,jj,1) 552 576 END_2D … … 555 579 ! 556 580 CASE( 0 ) ! No scaling under sea-ice 557 DO_2D( 0, 0, 0, 0 ) 581 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 582 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 558 583 zmxlm(ji,jj,1) = zraug * taum(ji,jj) * tmask(ji,jj,1) 559 584 END_2D 560 585 ! 561 586 CASE( 1 ) ! scaling with constant sea-ice thickness 562 DO_2D( 0, 0, 0, 0 ) 587 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 588 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 563 589 zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + & 564 590 & fr_i(ji,jj) * rn_mxlice ) * tmask(ji,jj,1) … … 566 592 ! 567 593 CASE( 2 ) ! scaling with mean sea-ice thickness 568 DO_2D( 0, 0, 0, 0 ) 594 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 595 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 569 596 #if defined key_si3 570 597 zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + & … … 578 605 ! 579 606 CASE( 3 ) ! scaling with max sea-ice thickness 580 DO_2D( 0, 0, 0, 0 ) 607 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 608 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 581 609 zmaxice = MAXVAL( h_i(ji,jj,:) ) 582 610 zmxlm(ji,jj,1) = ( ( 1._wp - fr_i(ji,jj) ) * zraug * taum(ji,jj) + & … … 587 615 #endif 588 616 ! 589 DO_2D( 0, 0, 0, 0 ) 617 ! [comm_cleanup] ! DO_2D( 0, 0, 0, 0 ) 618 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 590 619 zmxlm(ji,jj,1) = MAX( rn_mxl0, zmxlm(ji,jj,1) ) 591 620 END_2D … … 596 625 ENDIF 597 626 ! 598 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 627 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 628 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 599 629 zrn2 = MAX( rn2(ji,jj,jk), rsmall ) 600 630 zmxlm(ji,jj,jk) = MAX( rmxl_min, SQRT( 2._wp * en(ji,jj,jk) / zrn2 ) ) … … 611 641 ! where wmask = 0 set zmxlm == e3w(:,:,:,Kmm) 612 642 CASE ( 0 ) ! bounded by the distance to surface and bottom 613 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 643 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 644 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 614 645 zemxl = MIN( gdepw(ji,jj,jk,Kmm) - gdepw(ji,jj,mikt(ji,jj),Kmm), zmxlm(ji,jj,jk), & 615 646 & gdepw(ji,jj,mbkt(ji,jj)+1,Kmm) - gdepw(ji,jj,jk,Kmm) ) … … 622 653 ! 623 654 CASE ( 1 ) ! bounded by the vertical scale factor 624 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 655 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 656 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 625 657 zemxl = MIN( e3w(ji,jj,jk,Kmm), zmxlm(ji,jj,jk) ) 626 658 zmxlm(ji,jj,jk) = zemxl … … 629 661 ! 630 662 CASE ( 2 ) ! |dk[xml]| bounded by e3t : 631 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! from the surface to the bottom : 663 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! from the surface to the bottom : 664 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! from the surface to the bottom : 632 665 zmxlm(ji,jj,jk) = & 633 666 & MIN( zmxlm(ji,jj,jk-1) + e3t(ji,jj,jk-1,Kmm), zmxlm(ji,jj,jk) ) 634 667 END_3D 635 DO_3DS( 0, 0, 0, 0, jpkm1, 2, -1 ) ! from the bottom to the surface : 668 ! [comm_cleanup] ! DO_3DS( 0, 0, 0, 0, jpkm1, 2, -1 ) ! from the bottom to the surface : 669 DO_3DS( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jpkm1, 2, -1 ) ! from the bottom to the surface : 636 670 zemxl = MIN( zmxlm(ji,jj,jk+1) + e3t(ji,jj,jk+1,Kmm), zmxlm(ji,jj,jk) ) 637 671 zmxlm(ji,jj,jk) = zemxl … … 640 674 ! 641 675 CASE ( 3 ) ! lup and ldown, |dk[xml]| bounded by e3t : 642 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! from the surface to the bottom : lup 676 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! from the surface to the bottom : lup 677 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! from the surface to the bottom : lup 643 678 zmxld(ji,jj,jk) = & 644 679 & MIN( zmxld(ji,jj,jk-1) + e3t(ji,jj,jk-1,Kmm), zmxlm(ji,jj,jk) ) 645 680 END_3D 646 DO_3DS( 0, 0, 0, 0, jpkm1, 2, -1 ) ! from the bottom to the surface : ldown 681 ! [comm_cleanup] ! DO_3DS( 0, 0, 0, 0, jpkm1, 2, -1 ) ! from the bottom to the surface : ldown 682 DO_3DS( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jpkm1, 2, -1 ) ! from the bottom to the surface : ldown 647 683 zmxlm(ji,jj,jk) = & 648 684 & MIN( zmxlm(ji,jj,jk+1) + e3t(ji,jj,jk+1,Kmm), zmxlm(ji,jj,jk) ) 649 685 END_3D 650 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 686 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 687 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 651 688 zemlm = MIN ( zmxld(ji,jj,jk), zmxlm(ji,jj,jk) ) 652 689 zemlp = SQRT( zmxld(ji,jj,jk) * zmxlm(ji,jj,jk) ) … … 660 697 ! ! Vertical eddy viscosity and diffusivity (avm and avt) 661 698 ! !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 662 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !* vertical eddy viscosity & diffivity at w-points 699 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !* vertical eddy viscosity & diffivity at w-points 700 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) !* vertical eddy viscosity & diffivity at w-points 663 701 zsqen = SQRT( en(ji,jj,jk) ) 664 702 zav = rn_ediff * zmxlm(ji,jj,jk) * zsqen … … 670 708 ! 671 709 IF( nn_pdl == 1 ) THEN !* Prandtl number case: update avt 672 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 710 ! [comm_cleanup] ! DO_3D( 0, 0, 0, 0, 2, jpkm1 ) 711 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 673 712 p_avt(ji,jj,jk) = MAX( apdlr(ji,jj,jk) * p_avt(ji,jj,jk), avtb_2d(ji,jj) * avtb(jk) ) * wmask(ji,jj,jk) 674 713 END_3D -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/step.F90
r14538 r14601 168 168 CALL bn2 ( ts(:,:,:,:,Nnn), rab_n, rn2, Nnn ) ! now Brunt-Vaisala frequency 169 169 170 ! [comm_cleanup] 171 IF (nn_hls.eq.2) THEN 172 IF( l_zdfsh2 ) THEN 173 CALL lbc_lnk( 'stp', avm_k, 'W', 1.0_wp , avt_k, 'W', 1.0_wp, & 174 & avm , 'W', 1.0_wp , avt , 'W', 1.0_wp , avs , 'W', 1.0_wp ) 175 ELSE 176 CALL lbc_lnk( 'stp', avm , 'W', 1.0_wp , avt , 'W', 1.0_wp , avs , 'W', 1.0_wp ) 177 ENDIF 178 ENDIF 170 179 ! VERTICAL PHYSICS 171 180 CALL zdf_phy( kstp, Nbb, Nnn, Nrhs ) ! vertical physics update (top/bot drag, avt, avs, avm + MLD) -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/stpmlf.F90
r14538 r14601 177 177 178 178 ! VERTICAL PHYSICS 179 ! [comm_cleanup] 180 IF (nn_hls.eq.2) THEN 181 IF( l_zdfsh2 ) THEN 182 CALL lbc_lnk( 'stp_MLF', avm_k, 'W', 1.0_wp , avt_k, 'W', 1.0_wp, & 183 & avm , 'W', 1.0_wp , avt , 'W', 1.0_wp , avs , 'W', 1.0_wp ) 184 ELSE 185 CALL lbc_lnk( 'stp_MLF', avm , 'W', 1.0_wp , avt , 'W', 1.0_wp , avs , 'W', 1.0_wp ) 186 ENDIF 187 ENDIF 179 188 CALL zdf_phy( kstp, Nbb, Nnn, Nrhs ) ! vertical physics update (top/bot drag, avt, avs, avm + MLD) 180 189 … … 309 318 #endif 310 319 311 ! [comm_cleanup]312 IF (nn_hls.EQ.2) THEN320 ! [comm_cleanup] 321 IF (nn_hls.EQ.2) THEN 313 322 SELECT CASE ( nadv ) 314 323 CASE ( np_FCT ) ! FCT scheme : 2nd / 4th order
Note: See TracChangeset
for help on using the changeset viewer.