Changeset 13660 for NEMO/branches
- Timestamp:
- 2020-10-22T12:47:32+02:00 (4 years ago)
- Location:
- NEMO/branches/2020/dev_r13508_HPC-09_communications_cleanup/src
- Files:
-
- 11 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r13508_HPC-09_communications_cleanup/src/OCE/TRA/eosbn2.F90
r13497 r13660 563 563 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 564 564 ! 565 DO_3D( 1, 1, 1, 1, 1, jpkm1 )565 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 566 566 ! 567 567 zh = gdept(ji,jj,jk,Kmm) * r1_Z0 ! depth … … 616 616 CASE( np_seos ) !== simplified EOS ==! 617 617 ! 618 DO_3D( 1, 1, 1, 1, 1, jpkm1 )618 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 619 619 zt = pts (ji,jj,jk,jp_tem) - 10._wp ! pot. temperature anomaly (t-T0) 620 620 zs = pts (ji,jj,jk,jp_sal) - 35._wp ! abs. salinity anomaly (s-S0) … … 670 670 CASE( np_teos10, np_eos80 ) !== polynomial TEOS-10 / EOS-80 ==! 671 671 ! 672 DO_2D( 1, 1, 1, 1)672 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 673 673 ! 674 674 zh = pdep(ji,jj) * r1_Z0 ! depth … … 723 723 CASE( np_seos ) !== simplified EOS ==! 724 724 ! 725 DO_2D( 1, 1, 1, 1)725 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) 726 726 ! 727 727 zt = pts (ji,jj,jp_tem) - 10._wp ! pot. temperature anomaly (t-T0) … … 873 873 IF( ln_timing ) CALL timing_start('bn2') 874 874 ! 875 DO_3D( 1, 1, 1, 1, 2, jpkm1 ) ! interior points only (2=< jk =< jpkm1 ); surface and bottom value set to zero one for all in istate.F90875 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, jpkm1 ) ! interior points only (2=< jk =< jpkm1 ); surface and bottom value set to zero one for all in istate.F90 876 876 zrw = ( gdepw(ji,jj,jk ,Kmm) - gdept(ji,jj,jk,Kmm) ) & 877 877 & / ( gdept(ji,jj,jk-1,Kmm) - gdept(ji,jj,jk,Kmm) ) -
NEMO/branches/2020/dev_r13508_HPC-09_communications_cleanup/src/OCE/TRA/traadv.F90
r13237 r13660 146 146 ! 147 147 CASE ( np_CEN ) ! Centered scheme : 2nd / 4th order 148 IF (nn_hls.EQ.2) CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kmm), 'T', 1. ) 148 149 CALL tra_adv_cen ( kt, nit000, 'TRA', zuu, zvv, zww, Kmm, pts, jpts, Krhs, nn_cen_h, nn_cen_v ) 149 150 CASE ( np_FCT ) ! FCT scheme : 2nd / 4th order 151 IF (nn_hls.EQ.2) THEN ; CALL lbc_lnk_multi( 'traadv', pts(:,:,:,:,Kbb), 'T', 1., pts(:,:,:,:,Kmm), 'T', 1.) 152 CALL lbc_lnk_multi( 'traadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1.) ; END IF 150 153 CALL tra_adv_fct ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_fct_h, nn_fct_v ) 151 154 CASE ( np_MUS ) ! MUSCL 152 155 CALL tra_adv_mus ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, ln_mus_ups ) 153 156 CASE ( np_UBS ) ! UBS 157 IF (nn_hls.EQ.2) CALL lbc_lnk_multi( 'traadv', pts(:,:,:,:,Kbb), 'T', 1.) 154 158 CALL tra_adv_ubs ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs, nn_ubs_v ) 155 159 CASE ( np_QCK ) ! QUICKEST 160 IF (nn_hls.EQ.2) THEN ; CALL lbc_lnk_multi( 'traadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1.) 161 CALL lbc_lnk( 'traadv', pts(:,:,:,:,Kbb), 'T', 1.) ; END IF 156 162 CALL tra_adv_qck ( kt, nit000, 'TRA', rDt, zuu, zvv, zww, Kbb, Kmm, pts, jpts, Krhs ) 157 163 ! -
NEMO/branches/2020/dev_r13508_HPC-09_communications_cleanup/src/OCE/TRA/traadv_cen.F90
r13619 r13660 99 99 zwz(:,:,jpk) = 0._wp 100 100 ! 101 IF (nn_hls.EQ.2) CALL lbc_lnk( 'traadv_cen', pt(:,:,:,:,Kmm), 'T', 1. )102 101 DO jn = 1, kjpt !== loop over the tracers ==! 103 102 ! -
NEMO/branches/2020/dev_r13508_HPC-09_communications_cleanup/src/OCE/TRA/traadv_fct.F90
r13497 r13660 79 79 INTEGER , INTENT(in ) :: kn_fct_v ! order of the FCT scheme (=2 or 4) 80 80 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 81 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in 81 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(inout) :: pU, pV, pW ! 3 ocean volume flux components 82 82 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracers and RHS of tracer equation 83 83 ! … … 126 126 zptry(:,:,:) = 0._wp 127 127 ENDIF 128 ! ! surface & bottom value : flux set to zero one for all129 zwz(:,:, 1 ) = 0._wp130 zwx(:,:,jpk) = 0._wp ; zwy(:,:,jpk) = 0._wp ; zwz(:,:,jpk) = 0._wp131 !132 zwi(:,:,:) = 0._wp133 128 ! 134 129 ! If adaptive vertical advection, check if it is needed on this PE at this time … … 139 134 IF( ll_zAimp ) THEN 140 135 ALLOCATE(zwdia(jpi,jpj,jpk), zwinf(jpi,jpj,jpk),zwsup(jpi,jpj,jpk)) 141 DO_3D( 0, 0, 0, 0, 1, jpkm1 )136 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) 142 137 zwdia(ji,jj,jk) = 1._wp + p2dt * ( MAX( wi(ji,jj,jk) , 0._wp ) - MIN( wi(ji,jj,jk+1) , 0._wp ) ) & 143 138 & / e3t(ji,jj,jk,Krhs) … … 151 146 ! !== upstream advection with initial mass fluxes & intermediate update ==! 152 147 ! !* upstream tracer flux in the i and j direction 153 DO_3D( 1, 0, 1, 0, 1, jpkm1 )148 DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) 154 149 ! upstream scheme 155 150 zfp_ui = pU(ji,jj,jk) + ABS( pU(ji,jj,jk) ) … … 178 173 ENDIF 179 174 ! 180 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !* trend and after field with monotonic scheme175 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) !* trend and after field with monotonic scheme 181 176 ! ! total intermediate advective trends 182 177 ztra = - ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) & … … 194 189 ! 195 190 ztw(:,:,1) = 0._wp ; ztw(:,:,jpk) = 0._wp ; 196 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! Interior value ( multiplied by wmask)191 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! Interior value ( multiplied by wmask) 197 192 zfp_wk = wi(ji,jj,jk) + ABS( wi(ji,jj,jk) ) 198 193 zfm_wk = wi(ji,jj,jk) - ABS( wi(ji,jj,jk) ) … … 218 213 ! 219 214 CASE( 2 ) !- 2nd order centered 220 DO_3D( 1, 0, 1, 0, 1, jpkm1 )215 DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) 221 216 zwx(ji,jj,jk) = 0.5_wp * pU(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj,jk,jn,Kmm) ) - zwx(ji,jj,jk) 222 217 zwy(ji,jj,jk) = 0.5_wp * pV(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji,jj+1,jk,jn,Kmm) ) - zwy(ji,jj,jk) … … 238 233 CALL lbc_lnk_multi( 'traadv_fct', zltu, 'T', 1.0_wp , zltv, 'T', 1.0_wp ) ! Lateral boundary cond. (unchanged sgn) 239 234 ! 240 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) ! Horizontal advective fluxes235 DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 ) 241 236 zC2t_u = pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj ,jk,jn,Kmm) ! 2 x C2 interpolation of T at u- & v-points 242 237 zC2t_v = pt(ji,jj,jk,jn,Kmm) + pt(ji ,jj+1,jk,jn,Kmm) … … 253 248 ztv(ji,jj,jk) = ( pt(ji ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk) 254 249 END_3D 255 CALL lbc_lnk_multi( 'traadv_fct', ztu, 'U', -1.0_wp , ztv, 'V', -1.0_wp ) ! Lateral boundary cond. (unchanged sgn)256 250 ! 257 251 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) ! Horizontal advective fluxes … … 265 259 zwy(ji,jj,jk) = 0.5_wp * pV(ji,jj,jk) * zC4t_v - zwy(ji,jj,jk) 266 260 END_3D 261 CALL lbc_lnk_multi( 'traadv_fct', zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp ) ! Lateral boundary cond. (unchanged sgn) 267 262 ! 268 263 END SELECT … … 271 266 ! 272 267 CASE( 2 ) !- 2nd order centered 273 DO_3D( 0, 0, 0, 0, 2, jpkm1 )268 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 274 269 zwz(ji,jj,jk) = ( pW(ji,jj,jk) * 0.5_wp * ( pt(ji,jj,jk,jn,Kmm) + pt(ji,jj,jk-1,jn,Kmm) ) & 275 270 & - zwz(ji,jj,jk) ) * wmask(ji,jj,jk) … … 278 273 CASE( 4 ) !- 4th order COMPACT 279 274 CALL interp_4th_cpt( pt(:,:,:,jn,Kmm) , ztw ) ! zwt = COMPACT interpolation of T at w-point 280 DO_3D( 0, 0, 0, 0, 2, jpkm1 )275 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) 281 276 zwz(ji,jj,jk) = ( pW(ji,jj,jk) * ztw(ji,jj,jk) - zwz(ji,jj,jk) ) * wmask(ji,jj,jk) 282 277 END_3D … … 287 282 ENDIF 288 283 ! 284 IF (nn_hls.EQ.1) THEN 285 CALL lbc_lnk_multi( 'traadv_fct', zwi, 'T', 1.0_wp, zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp, zwz, 'T', 1.0_wp ) 286 ELSE 287 CALL lbc_lnk( 'traadv_fct', zwi, 'T', 1.0_wp) 288 END IF 289 ! 289 290 IF ( ll_zAimp ) THEN 290 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !* trend and after field with monotonic scheme291 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 1, jpkm1 ) !* trend and after field with monotonic scheme 291 292 ! ! total intermediate advective trends 292 293 ztra = - ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) & 293 294 & + zwy(ji,jj,jk) - zwy(ji ,jj-1,jk ) & 294 295 & + zwz(ji,jj,jk) - zwz(ji ,jj ,jk+1) ) * r1_e1e2t(ji,jj) 295 ztw(ji,jj,jk) 296 ztw(ji,jj,jk) = zwi(ji,jj,jk) + p2dt * ztra / e3t(ji,jj,jk,Krhs) * tmask(ji,jj,jk) 296 297 END_3D 297 298 ! 298 299 CALL tridia_solver( zwdia, zwsup, zwinf, ztw, ztw , 0 ) 299 300 ! 300 DO_3D( 0, 0, 0, 0, 2, jpkm1 ) ! Interior value ( multiplied by wmask)301 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 2, jpkm1 ) ! Interior value ( multiplied by wmask) 301 302 zfp_wk = wi(ji,jj,jk) + ABS( wi(ji,jj,jk) ) 302 303 zfm_wk = wi(ji,jj,jk) - ABS( wi(ji,jj,jk) ) 303 zwz(ji,jj,jk) = 304 zwz(ji,jj,jk) = zwz(ji,jj,jk) + 0.5 * e1e2t(ji,jj) * ( zfp_wk * ztw(ji,jj,jk) + zfm_wk * ztw(ji,jj,jk-1) ) * wmask(ji,jj,jk) 304 305 END_3D 305 306 END IF 306 !307 CALL lbc_lnk_multi( 'traadv_fct', zwi, 'T', 1.0_wp, zwx, 'U', -1.0_wp , zwy, 'V', -1.0_wp, zwz, 'W', 1.0_wp )308 307 ! 309 308 ! !== monotonicity algorithm ==! … … 335 334 END_3D 336 335 END IF 337 ! 336 ! NOT TESTED - NEED l_trd OR l_hst TRUE 338 337 IF( l_trd .OR. l_hst ) THEN ! trend diagnostics // heat/salt transport 339 338 ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:) ! <<< add anti-diffusive fluxes … … 350 349 ! 351 350 ENDIF 351 ! NOT TESTED - NEED l_ptr TRUE 352 352 IF( l_ptr ) THEN ! "Poleward" transports 353 353 zptry(:,:,:) = zptry(:,:,:) + zwy(:,:,:) ! <<< add anti-diffusive fluxes … … 409 409 DO jk = 1, jpkm1 410 410 ikm1 = MAX(jk-1,1) 411 DO_2D( 0, 0, 0, 0)411 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) 412 412 413 413 ! search maximum in neighbourhood … … 439 439 END_2D 440 440 END DO 441 CALL lbc_lnk_multi( 'traadv_fct', zbetup, 'T', 1.0_wp , zbetdo, 'T', 1.0_wp ) ! lateral boundary cond. (unchanged sign)441 IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'traadv_fct', zbetup, 'T', 1.0_wp , zbetdo, 'T', 1.0_wp ) ! lateral boundary cond. (unchanged sign) 442 442 443 443 ! 3. monotonic flux in the i & j direction (paa & pbb) 444 444 ! ---------------------------------------- 445 DO_3D( 0, 0, 0, 0, 1, jpkm1 )445 DO_3D( 1, 0, 1, 0, 1, jpkm1 ) 446 446 zau = MIN( 1._wp, zbetdo(ji,jj,jk), zbetup(ji+1,jj,jk) ) 447 447 zbu = MIN( 1._wp, zbetup(ji,jj,jk), zbetdo(ji+1,jj,jk) ) … … 461 461 pcc(ji,jj,jk+1) = pcc(ji,jj,jk+1) * ( zc * za + ( 1._wp - zc) * zb ) 462 462 END_3D 463 CALL lbc_lnk_multi( 'traadv_fct', paa, 'U', -1.0_wp , pbb, 'V', -1.0_wp ) ! lateral boundary condition (changed sign)464 463 ! 465 464 END SUBROUTINE nonosc … … 546 545 ! !== build the three diagonal matrix & the RHS ==! 547 546 ! 548 DO_3D( 0, 0, 0, 0, 3, jpkm1 ) ! interior (from jk=3 to jpk-1)547 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 3, jpkm1 ) ! interior (from jk=3 to jpk-1) 549 548 zwd (ji,jj,jk) = 3._wp * wmask(ji,jj,jk) + 1._wp ! diagonal 550 549 zwi (ji,jj,jk) = wmask(ji,jj,jk) ! lower diagonal … … 565 564 END IF 566 565 ! 567 DO_2D( 0, 0, 0, 0) ! 2nd order centered at top & bottom566 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) ! 2nd order centered at top & bottom 568 567 ikt = mikt(ji,jj) + 1 ! w-point below the 1st wet point 569 568 ikb = MAX(mbkt(ji,jj), 2) ! - above the last wet point … … 582 581 ! !== tridiagonal solver ==! 583 582 ! 584 DO_2D( 0, 0, 0, 0) !* 1st recurrence: Tk = Dk - Ik Sk-1 / Tk-1583 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) !* 1st recurrence: Tk = Dk - Ik Sk-1 / Tk-1 585 584 zwt(ji,jj,2) = zwd(ji,jj,2) 586 585 END_2D 587 DO_3D( 0, 0, 0, 0, 3, jpkm1 )586 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 3, jpkm1 ) 588 587 zwt(ji,jj,jk) = zwd(ji,jj,jk) - zwi(ji,jj,jk) * zws(ji,jj,jk-1) /zwt(ji,jj,jk-1) 589 588 END_3D 590 589 ! 591 DO_2D( 0, 0, 0, 0) !* 2nd recurrence: Zk = Yk - Ik / Tk-1 Zk-1590 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) !* 2nd recurrence: Zk = Yk - Ik / Tk-1 Zk-1 592 591 pt_out(ji,jj,2) = zwrm(ji,jj,2) 593 592 END_2D 594 DO_3D( 0, 0, 0, 0, 3, jpkm1 )593 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, 3, jpkm1 ) 595 594 pt_out(ji,jj,jk) = zwrm(ji,jj,jk) - zwi(ji,jj,jk) / zwt(ji,jj,jk-1) *pt_out(ji,jj,jk-1) 596 595 END_3D 597 596 598 DO_2D( 0, 0, 0, 0) !* 3d recurrence: Xk = (Zk - Sk Xk+1 ) / Tk597 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) !* 3d recurrence: Xk = (Zk - Sk Xk+1 ) / Tk 599 598 pt_out(ji,jj,jpkm1) = pt_out(ji,jj,jpkm1) / zwt(ji,jj,jpkm1) 600 599 END_2D 601 DO_3DS( 0, 0, 0, 0, jpk-2, 2, -1 )600 DO_3DS( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jpk-2, 2, -1 ) 602 601 pt_out(ji,jj,jk) = ( pt_out(ji,jj,jk) - zws(ji,jj,jk) * pt_out(ji,jj,jk+1) ) / zwt(ji,jj,jk) 603 602 END_3D … … 638 637 kstart = 1 + klev 639 638 ! 640 DO_2D( 0, 0, 0, 0) !* 1st recurrence: Tk = Dk - Ik Sk-1 / Tk-1639 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) !* 1st recurrence: Tk = Dk - Ik Sk-1 / Tk-1 641 640 zwt(ji,jj,kstart) = pD(ji,jj,kstart) 642 641 END_2D 643 DO_3D( 0, 0, 0, 0, kstart+1, jpkm1 )642 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, kstart+1, jpkm1 ) 644 643 zwt(ji,jj,jk) = pD(ji,jj,jk) - pL(ji,jj,jk) * pU(ji,jj,jk-1) /zwt(ji,jj,jk-1) 645 644 END_3D 646 645 ! 647 DO_2D( 0, 0, 0, 0) !* 2nd recurrence: Zk = Yk - Ik / Tk-1 Zk-1646 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) !* 2nd recurrence: Zk = Yk - Ik / Tk-1 Zk-1 648 647 pt_out(ji,jj,kstart) = pRHS(ji,jj,kstart) 649 648 END_2D 650 DO_3D( 0, 0, 0, 0, kstart+1, jpkm1 )649 DO_3D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, kstart+1, jpkm1 ) 651 650 pt_out(ji,jj,jk) = pRHS(ji,jj,jk) - pL(ji,jj,jk) / zwt(ji,jj,jk-1) *pt_out(ji,jj,jk-1) 652 651 END_3D 653 652 654 DO_2D( 0, 0, 0, 0) !* 3d recurrence: Xk = (Zk - Sk Xk+1 ) / Tk653 DO_2D( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1 ) !* 3d recurrence: Xk = (Zk - Sk Xk+1 ) / Tk 655 654 pt_out(ji,jj,jpkm1) = pt_out(ji,jj,jpkm1) / zwt(ji,jj,jpkm1) 656 655 END_2D 657 DO_3DS( 0, 0, 0, 0, jpk-2, kstart, -1 )656 DO_3DS( nn_hls-1, nn_hls-1, nn_hls-1, nn_hls-1, jpk-2, kstart, -1 ) 658 657 pt_out(ji,jj,jk) = ( pt_out(ji,jj,jk) - pU(ji,jj,jk) * pt_out(ji,jj,jk+1) ) / zwt(ji,jj,jk) 659 658 END_3D -
NEMO/branches/2020/dev_r13508_HPC-09_communications_cleanup/src/OCE/TRA/traadv_qck.F90
r13497 r13660 91 91 INTEGER , INTENT(in ) :: kjpt ! number of tracers 92 92 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 93 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in 93 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(inout) :: pU, pV, pW ! 3 ocean volume transport components 94 94 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracers and RHS of tracer equation 95 95 !!---------------------------------------------------------------------- … … 106 106 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype == 'TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 107 107 IF( cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) ) ) l_ptr = .TRUE. 108 !109 108 ! 110 109 ! ! horizontal fluxes are computed with the QUICKEST + ULTIMATE scheme … … 142 141 ! 143 142 !!gm why not using a SHIFT instruction... 144 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) !--- Computation of the ustream and downstream value of the tracer and the mask143 DO_3D( 0, 0, nn_hls-1, nn_hls-1, 1, jpkm1 ) !--- Computation of the ustream and downstream value of the tracer and the mask 145 144 zfc(ji,jj,jk) = pt(ji-1,jj,jk,jn,Kbb) ! Upstream in the x-direction for the tracer 146 145 zfd(ji,jj,jk) = pt(ji+1,jj,jk,jn,Kbb) ! Downstream in the x-direction for the tracer 147 146 END_3D 148 CALL lbc_lnk_multi( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp ) ! Lateral boundary conditions147 IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp ) ! Lateral boundary conditions 149 148 150 149 ! 151 150 ! Horizontal advective fluxes 152 151 ! --------------------------- 153 DO_3D( 0, 0, 0, 0, 1, jpkm1 )152 DO_3D( 0, 0, nn_hls-1, 0, 1, jpkm1 ) 154 153 zdir = 0.5 + SIGN( 0.5_wp, pU(ji,jj,jk) ) ! if pU > 0 : zdir = 1 otherwise zdir = 0 155 154 zfu(ji,jj,jk) = zdir * zfc(ji,jj,jk ) + ( 1. - zdir ) * zfd(ji+1,jj,jk) ! FU in the x-direction for T 156 155 END_3D 157 156 ! 158 DO_3D( 0, 0, 0, 0, 1, jpkm1 )157 DO_3D( 0, 0, nn_hls-1, 0, 1, jpkm1 ) 159 158 zdir = 0.5 + SIGN( 0.5_wp, pU(ji,jj,jk) ) ! if pU > 0 : zdir = 1 otherwise zdir = 0 160 159 zdx = ( zdir * e1t(ji,jj) + ( 1. - zdir ) * e1t(ji+1,jj) ) * e2u(ji,jj) * e3u(ji,jj,jk,Kmm) … … 164 163 END_3D 165 164 !--- Lateral boundary conditions 166 CALL lbc_lnk_multi( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, zfc(:,:,:), 'T', 1.0_wp, zwx(:,:,:), 'T', 1.0_wp )165 IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, zfc(:,:,:), 'T', 1.0_wp, zwx(:,:,:), 'T', 1.0_wp ) 167 166 168 167 !--- QUICKEST scheme … … 170 169 ! 171 170 ! Mask at the T-points in the x-direction (mask=0 or mask=1) 172 DO_3D( 0, 0, 0, 0, 1, jpkm1 )171 DO_3D( 0, 0, nn_hls-1, nn_hls-1, 1, jpkm1 ) 173 172 zfu(ji,jj,jk) = tmask(ji-1,jj,jk) + tmask(ji,jj,jk) + tmask(ji+1,jj,jk) - 2. 174 173 END_3D 175 CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp ) ! Lateral boundary conditions174 IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp ) ! Lateral boundary conditions 176 175 177 176 ! … … 179 178 DO jk = 1, jpkm1 180 179 ! 181 DO_2D( 0, 0, 0, 0 )180 DO_2D( 0, 0, 1, 0 ) 182 181 zdir = 0.5 + SIGN( 0.5_wp, pU(ji,jj,jk) ) ! if pU > 0 : zdir = 1 otherwise zdir = 0 183 182 !--- If the second ustream point is a land point … … 188 187 END_2D 189 188 END DO 190 !191 CALL lbc_lnk( 'traadv_qck', zwx(:,:,:), 'T', 1.0_wp ) ! Lateral boundary conditions192 189 ! 193 190 ! Computation of the trend … … 233 230 ! 234 231 !--- Computation of the ustream and downstream value of the tracer and the mask 235 DO_2D( 0, 0, 0, 0 )232 DO_2D( nn_hls-1, nn_hls-1, 0, 0 ) 236 233 ! Upstream in the x-direction for the tracer 237 234 zfc(ji,jj,jk) = pt(ji,jj-1,jk,jn,Kbb) … … 240 237 END_2D 241 238 END DO 242 CALL lbc_lnk_multi( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp ) ! Lateral boundary conditions239 IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'traadv_qck', zfc(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp ) ! Lateral boundary conditions 243 240 244 241 … … 247 244 ! --------------------------- 248 245 ! 249 DO_3D( 0, 0, 0, 0, 1, jpkm1 )246 DO_3D( nn_hls-1, 0, 0, 0, 1, jpkm1 ) 250 247 zdir = 0.5 + SIGN( 0.5_wp, pV(ji,jj,jk) ) ! if pU > 0 : zdir = 1 otherwise zdir = 0 251 248 zfu(ji,jj,jk) = zdir * zfc(ji,jj,jk ) + ( 1. - zdir ) * zfd(ji,jj+1,jk) ! FU in the x-direction for T 252 249 END_3D 253 250 ! 254 DO_3D( 0, 0, 0, 0, 1, jpkm1 )251 DO_3D( nn_hls-1, 0, 0, 0, 1, jpkm1 ) 255 252 zdir = 0.5 + SIGN( 0.5_wp, pV(ji,jj,jk) ) ! if pU > 0 : zdir = 1 otherwise zdir = 0 256 253 zdx = ( zdir * e2t(ji,jj) + ( 1. - zdir ) * e2t(ji,jj+1) ) * e1v(ji,jj) * e3v(ji,jj,jk,Kmm) … … 261 258 262 259 !--- Lateral boundary conditions 263 CALL lbc_lnk_multi( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, zfc(:,:,:), 'T', 1.0_wp, zwy(:,:,:), 'T', 1.0_wp )260 IF (nn_hls.EQ.1) CALL lbc_lnk_multi( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp , zfd(:,:,:), 'T', 1.0_wp, zfc(:,:,:), 'T', 1.0_wp, zwy(:,:,:), 'T', 1.0_wp ) 264 261 265 262 !--- QUICKEST scheme … … 267 264 ! 268 265 ! Mask at the T-points in the x-direction (mask=0 or mask=1) 269 DO_3D( 0, 0, 0, 0, 1, jpkm1 )266 DO_3D( nn_hls-1, nn_hls-1, 0, 0, 1, jpkm1 ) 270 267 zfu(ji,jj,jk) = tmask(ji,jj-1,jk) + tmask(ji,jj,jk) + tmask(ji,jj+1,jk) - 2. 271 268 END_3D 272 CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp ) !--- Lateral boundary conditions269 IF (nn_hls.EQ.1) CALL lbc_lnk( 'traadv_qck', zfu(:,:,:), 'T', 1.0_wp ) !--- Lateral boundary conditions 273 270 ! 274 271 ! Tracer flux on the x-direction 275 272 DO jk = 1, jpkm1 276 273 ! 277 DO_2D( 0, 0, 0, 0 )274 DO_2D( 1, 0, 0, 0 ) 278 275 zdir = 0.5 + SIGN( 0.5_wp, pV(ji,jj,jk) ) ! if pU > 0 : zdir = 1 otherwise zdir = 0 279 276 !--- If the second ustream point is a land point … … 285 282 END DO 286 283 ! 287 CALL lbc_lnk( 'traadv_qck', zwy(:,:,:), 'T', 1.0_wp ) ! Lateral boundary conditions288 !289 284 ! Computation of the trend 290 285 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) … … 332 327 IF( ln_linssh ) THEN !* top value (only in linear free surf. as zwz is multiplied by wmask) 333 328 IF( ln_isfcav ) THEN ! ice-shelf cavities (top of the ocean) 334 DO_2D( 1, 1, 1, 1)329 DO_2D( 0, 0, 0, 0 ) 335 330 zwz(ji,jj, mikt(ji,jj) ) = pW(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kmm) ! linear free surface 336 331 END_2D 337 332 ELSE ! no ocean cavities (only ocean surface) 338 zwz(:,:,1) = pW(:,:,1) * pt(:,:,1,jn,Kmm) 333 DO_2D( 0, 0, 0, 0 ) 334 zwz(ji,jj,1) = pW(ji,jj,1) * pt(ji,jj,1,jn,Kmm) 335 END_2D 339 336 ENDIF 340 337 ENDIF … … 369 366 !---------------------------------------------------------------------- 370 367 ! 371 DO_3D( 1, 1, 1, 1, 1, jpkm1 )368 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 372 369 zc = puc(ji,jj,jk) ! Courant number 373 370 zcurv = pfd(ji,jj,jk) + pfu(ji,jj,jk) - 2. * pfc(ji,jj,jk) -
NEMO/branches/2020/dev_r13508_HPC-09_communications_cleanup/src/OCE/TRA/traadv_ubs.F90
r13619 r13660 119 119 zltu(:,:,jpk) = 0._wp ; zltv(:,:,jpk) = 0._wp 120 120 ztw (:,:,jpk) = 0._wp ; zti (:,:,jpk) = 0._wp 121 !122 IF (nn_hls.EQ.2) CALL lbc_lnk_multi( 'traadv_ubs', pt(:,:,:,:,Kbb), 'T', 1.)123 121 ! ! =========== 124 122 DO jn = 1, kjpt ! tracer loop -
NEMO/branches/2020/dev_r13508_HPC-09_communications_cleanup/src/OCE/TRA/traatf.F90
r13295 r13660 156 156 ENDIF 157 157 ! 158 CALL lbc_lnk_multi( 'traatf', pts(:,:,:,jp_tem,Kbb) , 'T', 1.0_wp, pts(:,:,:,jp_sal,Kbb) , 'T', 1.0_wp, &159 & pts(:,:,:,jp_tem,Kmm) , 'T', 1.0_wp, pts(:,:,:,jp_sal,Kmm) , 'T', 1.0_wp, &160 & pts(:,:,:,jp_tem,Kaa), 'T', 1.0_wp, pts(:,:,:,jp_sal,Kaa), 'T', 1.0_wp )161 !162 158 ENDIF 163 159 ! … … 210 206 DO jn = 1, kjpt 211 207 ! 212 DO_3D( 0, 0, 0, 0, 1, jpkm1 )208 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 213 209 ztn = pt(ji,jj,jk,jn,Kmm) 214 210 ztd = pt(ji,jj,jk,jn,Kaa) - 2._wp * ztn + pt(ji,jj,jk,jn,Kbb) ! time laplacian on tracers … … 275 271 zfact2 = zfact1 * r1_rho0 276 272 DO jn = 1, kjpt 277 DO_3D( 0, 0, 0, 0, 1, jpkm1 )273 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 278 274 ze3t_b = e3t(ji,jj,jk,Kbb) 279 275 ze3t_n = e3t(ji,jj,jk,Kmm) -
NEMO/branches/2020/dev_r13508_HPC-09_communications_cleanup/src/OCE/TRA/traatf_qco.F90
r13295 r13660 149 149 ENDIF 150 150 ! 151 CALL lbc_lnk_multi( 'traatfqco', pts(:,:,:,jp_tem,Kbb) , 'T', 1., pts(:,:,:,jp_sal,Kbb) , 'T', 1., &152 & pts(:,:,:,jp_tem,Kmm) , 'T', 1., pts(:,:,:,jp_sal,Kmm) , 'T', 1., &153 & pts(:,:,:,jp_tem,Kaa), 'T', 1., pts(:,:,:,jp_sal,Kaa), 'T', 1. )154 !155 151 ENDIF 156 152 ! … … 203 199 DO jn = 1, kjpt 204 200 ! 205 DO_3D( 0, 0, 0, 0, 1, jpkm1 )201 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 206 202 ztn = pt(ji,jj,jk,jn,Kmm) 207 203 ztd = pt(ji,jj,jk,jn,Kaa) - 2._wp * ztn + pt(ji,jj,jk,jn,Kbb) ! time laplacian on tracers … … 268 264 zfact2 = zfact1 * r1_rho0 269 265 DO jn = 1, kjpt 270 DO_3D( 0, 0, 0, 0, 1, jpkm1 )266 DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 1, jpkm1 ) 271 267 ze3t_b = e3t(ji,jj,jk,Kbb) 272 268 ze3t_n = e3t(ji,jj,jk,Kmm) -
NEMO/branches/2020/dev_r13508_HPC-09_communications_cleanup/src/OCE/TRA/tranpc.F90
r13497 r13660 103 103 inpcc = 0 104 104 ! 105 DO_2D( 0, 0, 0, 0) ! interior column only105 DO_2D( nn_hls, nn_hls, nn_hls, nn_hls ) ! interior column only 106 106 ! 107 107 IF( tmask(ji,jj,2) == 1 ) THEN ! At least 2 ocean points … … 310 310 ENDIF 311 311 ! 312 CALL lbc_lnk_multi( 'tranpc', pts(:,:,:,jp_tem,Kaa), 'T', 1.0_wp, pts(:,:,:,jp_sal,Kaa), 'T', 1.0_wp )313 !314 312 IF( lwp .AND. l_LB_debug ) THEN 315 313 WRITE(numout,*) 'Exiting tra_npc , kt = ',kt,', => numb. of statically instable water-columns: ', inpcc -
NEMO/branches/2020/dev_r13508_HPC-09_communications_cleanup/src/OCE/TRA/trasbc.F90
r13497 r13660 124 124 ENDIF 125 125 ! !== Now sbc tracer content fields ==! 126 DO_2D( 0, 1, 0, 0)126 DO_2D( nn_hls-1, nn_hls, nn_hls-1, nn_hls-1 ) 127 127 sbc_tsc(ji,jj,jp_tem) = r1_rho0_rcp * qns(ji,jj) ! non solar heat flux 128 128 sbc_tsc(ji,jj,jp_sal) = r1_rho0 * sfx(ji,jj) ! salt flux due to freezing/melting 129 129 END_2D 130 130 IF( ln_linssh ) THEN !* linear free surface 131 DO_2D( 0, 1, 0, 0) !==>> add concentration/dilution effect due to constant volume cell131 DO_2D( nn_hls-1, nn_hls, nn_hls-1, nn_hls-1 ) !==>> add concentration/dilution effect due to constant volume cell 132 132 sbc_tsc(ji,jj,jp_tem) = sbc_tsc(ji,jj,jp_tem) + r1_rho0 * emp(ji,jj) * pts(ji,jj,1,jp_tem,Kmm) 133 133 sbc_tsc(ji,jj,jp_sal) = sbc_tsc(ji,jj,jp_sal) + r1_rho0 * emp(ji,jj) * pts(ji,jj,1,jp_sal,Kmm) … … 138 138 ! 139 139 DO jn = 1, jpts !== update tracer trend ==! 140 DO_2D( 0, 1, 0, 0)140 DO_2D( nn_hls-1, nn_hls, nn_hls-1, nn_hls-1 ) 141 141 pts(ji,jj,1,jn,Krhs) = pts(ji,jj,1,jn,Krhs) + zfact * ( sbc_tsc_b(ji,jj,jn) + sbc_tsc(ji,jj,jn) ) & 142 142 & / e3t(ji,jj,1,Kmm) -
NEMO/branches/2020/dev_r13508_HPC-09_communications_cleanup/src/TOP/TRP/trcadv.F90
r13286 r13660 124 124 ! 125 125 CASE ( np_CEN ) ! Centered : 2nd / 4th order 126 IF (nn_hls.EQ.2) CALL lbc_lnk_multi( 'trcadv', ptr(:,:,:,:,Kmm), 'T', 1.) 126 127 CALL tra_adv_cen( kt, nittrc000,'TRC', zuu, zvv, zww, Kmm, ptr, jptra, Krhs, nn_cen_h, nn_cen_v ) 127 128 CASE ( np_FCT ) ! FCT : 2nd / 4th order 129 IF (nn_hls.EQ.2) THEN ; CALL lbc_lnk_multi( 'trcadv', ptr(:,:,:,:,Kbb), 'T', 1., ptr(:,:,:,:,Kmm), 'T', 1.) 130 CALL lbc_lnk_multi( 'traadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1.) ; END IF 128 131 CALL tra_adv_fct( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_fct_h, nn_fct_v ) 129 132 CASE ( np_MUS ) ! MUSCL 130 133 CALL tra_adv_mus( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, ln_mus_ups ) 131 134 CASE ( np_UBS ) ! UBS 135 IF (nn_hls.EQ.2) CALL lbc_lnk_multi( 'trcadv', ptr(:,:,:,:,Kbb), 'T', 1.) 132 136 CALL tra_adv_ubs( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs, nn_ubs_v ) 133 137 CASE ( np_QCK ) ! QUICKEST 138 IF (nn_hls.EQ.2) THEN ; CALL lbc_lnk_multi( 'trcadv', zuu(:,:,:), 'U', -1., zvv(:,:,:), 'V', -1.) 139 CALL lbc_lnk( 'traadv', ptr(:,:,:,:,Kbb), 'T', 1.) ; END IF 134 140 CALL tra_adv_qck( kt, nittrc000,'TRC', rDt_trc, zuu, zvv, zww, Kbb, Kmm, ptr, jptra, Krhs ) 135 141 !
Note: See TracChangeset
for help on using the changeset viewer.