Changeset 14730 for NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup
- Timestamp:
- 2021-04-19T17:31:10+02:00 (3 years ago)
- Location:
- NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src
- Files:
-
- 11 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/DOM/domqco.F90
r14667 r14730 96 96 #endif 97 97 ! 98 IF(nn_hls.eq.2.AND..NOT.lk_linssh) CALL lbc_lnk( 'stp_MLF', r3u(:,:,Kbb), 'U', 1.0_wp, r3v(:,:,Kbb), 'V', 1.0_wp, r3t(:,:,Kbb), 'T', 1.0_wp, & 99 & r3u(:,:,Kmm), 'U', 1.0_wp, r3v(:,:,Kmm), 'V', 1.0_wp, r3t(:,:,Kmm), 'T', 1.0_wp, r3f(:,:), 'F', 1.0_wp ) 98 100 END SUBROUTINE dom_qco_init 99 101 -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/DOM/istate.F90
r14139 r14730 152 152 ! 153 153 !!gm the use of umsak & vmask is not necessary below as uu(:,:,:,Kmm), vv(:,:,:,Kmm), uu(:,:,:,Kbb), vv(:,:,:,Kbb) are always masked 154 DO_3D( 1, 1, 1, 1, 1, jpkm1 )154 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 155 155 uu_b(ji,jj,Kmm) = uu_b(ji,jj,Kmm) + e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm) * umask(ji,jj,jk) 156 156 vv_b(ji,jj,Kmm) = vv_b(ji,jj,Kmm) + e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) * vmask(ji,jj,jk) -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/DYN/dynatf_qco.F90
r14511 r14730 139 139 IF( ln_linssh ) THEN ! Fixed volume ! 140 140 ! ! =============! 141 DO_3D( 1, 1, 1, 1, 1, jpkm1 )141 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 142 142 puu(ji,jj,jk,Kmm) = puu(ji,jj,jk,Kmm) + rn_atfp * ( puu(ji,jj,jk,Kbb) - 2._wp * puu(ji,jj,jk,Kmm) + puu(ji,jj,jk,Kaa) ) 143 143 pvv(ji,jj,jk,Kmm) = pvv(ji,jj,jk,Kmm) + rn_atfp * ( pvv(ji,jj,jk,Kbb) - 2._wp * pvv(ji,jj,jk,Kmm) + pvv(ji,jj,jk,Kaa) ) … … 149 149 IF( ln_dynadv_vec ) THEN ! Asselin filter applied on velocity 150 150 ! Before filtered scale factor at (u/v)-points 151 DO_3D( 1, 1, 1, 1, 1, jpkm1 )151 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 152 152 puu(ji,jj,jk,Kmm) = puu(ji,jj,jk,Kmm) + rn_atfp * ( puu(ji,jj,jk,Kbb) - 2._wp * puu(ji,jj,jk,Kmm) + puu(ji,jj,jk,Kaa) ) 153 153 pvv(ji,jj,jk,Kmm) = pvv(ji,jj,jk,Kmm) + rn_atfp * ( pvv(ji,jj,jk,Kbb) - 2._wp * pvv(ji,jj,jk,Kmm) + pvv(ji,jj,jk,Kaa) ) … … 156 156 ELSE ! Asselin filter applied on thickness weighted velocity 157 157 ! 158 DO_3D( 1, 1, 1, 1, 1, jpkm1 )158 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 159 159 zue3a = ( 1._wp + r3u(ji,jj,Kaa) * umask(ji,jj,jk) ) * puu(ji,jj,jk,Kaa) 160 160 zve3a = ( 1._wp + r3v(ji,jj,Kaa) * vmask(ji,jj,jk) ) * pvv(ji,jj,jk,Kaa) -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/DYN/dynspg_ts.F90
r14511 r14730 730 730 IF (ln_bt_fw) THEN 731 731 IF( .NOT.( kt == nit000 .AND. l_1st_euler ) ) THEN 732 DO_2D( 1, 1, 1, 1)732 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 733 733 zun_save = un_adv(ji,jj) 734 734 zvn_save = vn_adv(ji,jj) -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/IOM/restart.F90
r14239 r14730 410 410 ssh(:,:,Kbb) = -ssh_ref 411 411 ! 412 DO_2D( 1, 1, 1, 1)412 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 413 413 IF( ht_0(ji,jj)-ssh_ref < rn_wdmin1 ) THEN ! if total depth is less than min depth 414 414 ssh(ji,jj,Kbb) = rn_wdmin1 - ht_0(ji,jj) -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/TRA/traadv.F90
r14538 r14730 178 178 ! 179 179 CASE ( np_CEN ) ! Centered scheme : 2nd / 4th order 180 ! [comm_cleanup]181 ! IF (nn_hls.EQ.2) CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kmm), 'T', 1. )182 180 CALL tra_adv_cen ( kt, nit000, 'TRA', zuu, zvv, zww, Kmm, pts, jpts, Krhs, nn_cen_h, nn_cen_v ) 183 181 CASE ( np_FCT ) ! FCT scheme : 2nd / 4th order 184 182 IF (nn_hls.EQ.2) THEN 185 ! [comm_cleanup] - lbc_lnk shifted into step186 ! CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kbb), 'T', 1., pts(:,:,:,:,Kmm), 'T', 1.)187 ! CALL lbc_lnk( 'traadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1., zww(:,:,:), 'W', 1.)188 183 #if defined key_loop_fusion 189 184 CALL tra_adv_fct_lf ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_fct_h, nn_fct_v ) … … 196 191 CASE ( np_MUS ) ! MUSCL 197 192 IF (nn_hls.EQ.2) THEN 198 ! [comm_cleanup] - lbc_lnk shifted into step199 ! CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kbb), 'T', 1.)200 193 #if defined key_loop_fusion 201 194 CALL tra_adv_mus_lf ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, ln_mus_ups ) … … 207 200 END IF 208 201 CASE ( np_UBS ) ! UBS 209 ! [comm_cleanup] - lbc_lnk shifted into step210 ! IF (nn_hls.EQ.2) CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kbb), 'T', 1.)211 202 CALL tra_adv_ubs ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_ubs_v ) 212 203 CASE ( np_QCK ) ! QUICKEST 213 ! [comm_cleanup] - lbc_lnk shifted into step214 ! IF (nn_hls.EQ.2) THEN215 ! CALL lbc_lnk( 'traadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1.)216 ! CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kbb), 'T', 1.)217 ! END IF218 204 CALL tra_adv_qck ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs ) 219 205 ! -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/USR/usrdef_istate.F90
r14053 r14730 61 61 pv (:,:,:) = 0._wp 62 62 ! 63 DO_3D( 1, 1, 1, 1, 1, jpk ) ! horizontally uniform T & S profiles63 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpk ) ! horizontally uniform T & S profiles 64 64 pts(ji,jj,jk,jp_tem) = ( ( 16. - 12. * TANH( (pdept(ji,jj,jk) - 400) / 700 ) ) & 65 65 & * (-TANH( (500. - pdept(ji,jj,jk)) / 150. ) + 1.) / 2. & -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/OCE/stpmlf.F90
r14682 r14730 170 170 !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 171 171 ! THERMODYNAMICS 172 ! [ comm_cleanup ] ! lbc_lnk for AMM12 with blp / triad & for atf_qco with ln_iceberg .true.173 IF( nn_hls.eq.2) CALL lbc_lnk( 'stp_MLF', ts(:,:,:,:,Nbb), 'T', 1._wp)174 172 CALL eos_rab( ts(:,:,:,:,Nbb), rab_b, Nnn ) ! before local thermal/haline expension ratio at T-points 175 173 CALL eos_rab( ts(:,:,:,:,Nnn), rab_n, Nnn ) ! now local thermal/haline expension ratio at T-points … … 178 176 179 177 ! VERTICAL PHYSICS 180 ! [comm_cleanup] ! lbc_lnk from ZDF181 IF (nn_hls.eq.2) THEN182 IF( l_zdfsh2 ) THEN183 CALL lbc_lnk( 'stp_MLF', avm_k, 'W', 1.0_wp , avt_k, 'W', 1.0_wp, &184 & avm , 'W', 1.0_wp , avt , 'W', 1.0_wp , avs , 'W', 1.0_wp )185 ELSE186 CALL lbc_lnk( 'stp_MLF', avm , 'W', 1.0_wp , avt , 'W', 1.0_wp , avs , 'W', 1.0_wp )187 ENDIF188 ENDIF189 178 CALL zdf_phy( kstp, Nbb, Nnn, Nrhs ) ! vertical physics update (top/bot drag, avt, avs, avm + MLD) 190 179 … … 240 229 & CALL Agrif_Sponge_dyn ! momentum sponge 241 230 #endif 242 ! [comm_cleanup] ! lbc_lnk from DYN243 IF (nn_hls.eq.2) THEN244 CALL lbc_lnk( 'stp_MLF', uu(:,:,:,Nnn), 'U', -1., vv(:,:,:,Nnn), 'V', -1., ww(:,:,:), 'W', 1., &245 & uu(:,:,:,Nbb), 'U', -1., vv(:,:,:,Nbb), 'V', -1.)246 IF(.NOT.lk_linssh) CALL lbc_lnk( 'stp_MLF', r3u(:,:,Nnn), 'U', 1.0_wp, r3v(:,:,Nnn), 'V', 1.0_wp, &247 & r3u(:,:,Nbb), 'U', 1.0_wp, r3v(:,:,Nbb), 'V', 1.0_wp, &248 & r3t(:,:,Nbb), 'T', 1.0_wp )249 ENDIF250 231 CALL dyn_adv( kstp, Nbb, Nnn , uu, vv, Nrhs ) ! advection (VF or FF) ==> RHS 251 232 CALL dyn_vor( kstp, Nnn , uu, vv, Nrhs ) ! vorticity ==> RHS … … 267 248 ENDIF 268 249 250 IF(nn_hls.eq.2.AND..NOT.lk_linssh) CALL lbc_lnk( 'stp_MLF', r3u(:,:,Naa), 'U', 1.0_wp, r3v(:,:,Naa), 'V', 1.0_wp) 269 251 270 252 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> … … 292 274 CALL ssh_atf ( kstp, Nbb, Nnn, Naa, ssh ) ! time filtering of "now" sea surface height 293 275 IF(.NOT.lk_linssh) CALL dom_qco_r3c( ssh(:,:,Nnn), r3t_f, r3u_f, r3v_f ) ! "now" ssh/h_0 ratio from filtrered ssh 294 ! [comm_cleanup] this should not be needed295 IF(nn_hls.eq.2.AND..NOT.lk_linssh) CALL lbc_lnk( 'stp_MLF', r3u_f, 'U', 1.0_wp, r3v_f, 'V', 1.0_wp )276 ! 277 IF(nn_hls.eq.2.AND..NOT.lk_linssh) CALL lbc_lnk( 'stp_MLF', r3u_f, 'U', 1.0_wp, r3v_f, 'V', 1.0_wp, r3t_f, 'T', 1.0_wp ) 296 278 #if defined key_top 297 279 !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> … … 329 311 ENDIF 330 312 #endif 331 332 ! [comm_cleanup] ! lbc_lnk from tra_adv333 IF (nn_hls.EQ.2) THEN334 SELECT CASE ( nadv )335 CASE ( np_FCT ) ! FCT scheme : 2nd / 4th order336 CALL lbc_lnk( 'stp_MLF', ts(:,:,:,:,Nbb), 'T', 1., ts(:,:,:,:,Nnn), 'T', 1.)337 CALL lbc_lnk( 'stp_MLF', uu(:,:,:,Nnn), 'U', -1., vv(:,:,:,Nnn), 'V', -1., ww(:,:,:), 'W', 1.)338 CASE ( np_MUS ) ! MUSCL339 CALL lbc_lnk( 'stp_MLF', ts(:,:,:,:,Nbb), 'T', 1.)340 CASE ( np_UBS ) ! UBS341 CALL lbc_lnk( 'stp_MLF', ts(:,:,:,:,Nbb), 'T', 1.)342 CASE ( np_QCK ) ! QUICKEST343 CALL lbc_lnk( 'stp_MLF', uu(:,:,:,Nnn), 'U', -1., vv(:,:,:,Nnn), 'V', -1.)344 CALL lbc_lnk( 'stp_MLF', ts(:,:,:,:,Nbb), 'T', 1.)345 END SELECT346 ENDIF347 313 348 314 ! TEMP: [tiling] Separate loop over tile domains (due to tra_adv workarounds for tiling) … … 383 349 CALL tra_atf_qco ( kstp, Nbb, Nnn, Naa , ts ) ! time filtering of "now" tracer arrays 384 350 CALL dyn_atf_qco ( kstp, Nbb, Nnn, Naa, uu, vv ) ! time filtering of "now" velocities 351 352 IF( nn_hls.eq.2) CALL lbc_lnk( 'stp_MLF', ts(:,:,:,jp_tem,Nnn), 'T', 1._wp, ts(:,:,:,jp_sal,Nnn), 'T', 1._wp) 353 385 354 IF(.NOT.lk_linssh) THEN 386 355 r3t(:,:,Nnn) = r3t_f(:,:) ! update now ssh/h_0 with time filtered values … … 548 517 & , pts(:,:,:,jp_tem,Kaa), 'T', 1., pts(:,:,:,jp_sal,Kaa), 'T', 1. ) 549 518 ! 519 IF (nn_hls.eq.2) THEN 520 IF( l_zdfsh2 ) THEN 521 CALL lbc_lnk( 'stp_MLF', avm_k, 'W', 1.0_wp , avt_k, 'W', 1.0_wp, & 522 & avm , 'W', 1.0_wp , avt , 'W', 1.0_wp , avs , 'W', 1.0_wp ) 523 ELSE 524 CALL lbc_lnk( 'stp_MLF', avm , 'W', 1.0_wp , avt , 'W', 1.0_wp , avs , 'W', 1.0_wp ) 525 ENDIF 526 ENDIF 550 527 ! !* BDY open boundaries 551 528 IF( ln_bdy ) THEN -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/SWE/stprk3.F90
r14511 r14730 172 172 ! 173 173 CALL lbc_lnk( 'stp_RK3', uu(:,:,:,Naa), 'U', -1., vv(:,:,:,Naa), 'V', -1. ) 174 ! [ comm_cleanup ] ! lbc_lnk from DYN - needed for ssh_nxt 175 IF (nn_hls.eq.2) CALL lbc_lnk( 'stp_MLF', r3u(:,:,Naa), 'U', 1., r3v(:,:,Naa), 'U', 1.) 174 176 ! 175 177 ! !== Swap time levels ==! … … 237 239 ! 238 240 CALL lbc_lnk( 'stp_RK3', uu(:,:,:,Naa), 'U', -1., vv(:,:,:,Naa), 'V', -1. ) 241 ! [ comm_cleanup ] ! lbc_lnk from DYN - needed for ssh_nxt 242 IF (nn_hls.eq.2) CALL lbc_lnk( 'stp_MLF', r3u(:,:,Naa), 'U', 1., r3v(:,:,Naa), 'U', 1.) 239 243 ! 240 244 ! !== Swap time levels ==! … … 300 304 ! 301 305 CALL lbc_lnk( 'stp_RK3', uu(:,:,:,Naa), 'U', -1., vv(:,:,:,Naa), 'V', -1. ) 306 ! [ comm_cleanup ] ! lbc_lnk from DYN - needed for ssh_nxt 307 IF (nn_hls.eq.2) CALL lbc_lnk( 'stp_MLF', r3u(:,:,Naa), 'U', 1., r3v(:,:,Naa), 'U', 1.) 302 308 ! 303 309 ! !== Swap time levels ==! -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/TOP/TRP/trcadv.F90
r14511 r14730 127 127 ! 128 128 CASE ( np_CEN ) ! Centered : 2nd / 4th order 129 IF (nn_hls.EQ.2) CALL lbc_lnk( 'trcadv', ptr(:,:,:,:,Kmm), 'T', 1.)130 129 CALL tra_adv_cen( kt, nittrc000,'TRC', zuu, zvv, zww, Kmm, ptr, jptra, Krhs, nn_cen_h, nn_cen_v ) 131 130 CASE ( np_FCT ) ! FCT : 2nd / 4th order 132 131 IF (nn_hls.EQ.2) THEN 133 CALL lbc_lnk( 'trcadv', ptr(:,:,:,:,Kbb), 'T', 1., ptr(:,:,:,:,Kmm), 'T', 1.)134 CALL lbc_lnk( 'traadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1., zww(:,:,:), 'W', 1.)135 132 #if defined key_loop_fusion 136 133 CALL tra_adv_fct_lf( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_fct_h, nn_fct_v ) … … 143 140 CASE ( np_MUS ) ! MUSCL 144 141 IF (nn_hls.EQ.2) THEN 145 IF (nn_hls.EQ.2) CALL lbc_lnk( 'trcadv', ptr(:,:,:,:,Kbb), 'T', 1.)146 142 #if defined key_loop_fusion 147 143 CALL tra_adv_mus_lf( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, ln_mus_ups ) … … 153 149 END IF 154 150 CASE ( np_UBS ) ! UBS 155 IF (nn_hls.EQ.2) CALL lbc_lnk( 'trcadv', ptr(:,:,:,:,Kbb), 'T', 1.)156 151 CALL tra_adv_ubs( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_ubs_v ) 157 152 CASE ( np_QCK ) ! QUICKEST 158 IF (nn_hls.EQ.2) THEN159 CALL lbc_lnk( 'trcadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1.)160 CALL lbc_lnk( 'traadv', ptr(:,:,:,:,Kbb), 'T', 1.)161 END IF162 153 CALL tra_adv_qck( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs ) 163 154 ! -
NEMO/branches/2021/dev_r14393_HPC-03_Mele_Comm_Cleanup/src/TOP/trcdta.F90
r14086 r14730 195 195 WRITE(numout,*) 'trc_dta: interpolates passive tracer data onto the s- or mixed s-z-coordinate mesh' 196 196 ENDIF 197 DO_2D( 1, 1, 1, 1) ! vertical interpolation of T & S197 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) ! vertical interpolation of T & S 198 198 DO jk = 1, jpk ! determines the intepolated T-S profiles at each (i,j) points 199 199 zl = gdept_0(ji,jj,jk) … … 220 220 ! zps-coordinate (partial steps) interpolation at the last ocean level 221 221 IF( ln_zps ) THEN 222 DO_2D( 1, 1, 1, 1 )222 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 223 223 ik = mbkt(ji,jj) 224 224 IF( ik > 1 ) THEN
Note: See TracChangeset
for help on using the changeset viewer.