Changeset 13660 for NEMO/branches/2020/dev_r13508_HPC-09_communications_cleanup/src/OCE/TRA/traadv_fct.F90
- Timestamp:
- 2020-10-22T12:47:32+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
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
Note: See TracChangeset
for help on using the changeset viewer.
