- Timestamp:
- 2020-09-24T20:38:10+02:00 (4 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2020/dev_r13383_HPC-02_Daley_Tiling/src/OCE/TRA/traadv_fct.F90
r13295 r13516 15 15 USE oce ! ocean dynamics and active tracers 16 16 USE dom_oce ! ocean space and time domain 17 ! TEMP: This change not necessary after trd_tra is tiled 18 USE domain, ONLY : dom_tile 17 19 USE trc_oce ! share passive tracers/Ocean variables 18 20 USE trd_oce ! trends: ocean variables … … 79 81 INTEGER , INTENT(in ) :: kn_fct_v ! order of the FCT scheme (=2 or 4) 80 82 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 83 ! TEMP: This can be ST_2D(nn_hls) after trd_tra is tiled 81 84 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pU, pV, pW ! 3 ocean volume flux components 82 85 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracers and RHS of tracer equation 83 86 ! 84 87 INTEGER :: ji, jj, jk, jn ! dummy loop indices 88 ! TEMP: This change not necessary after trd_tra is tiled 89 INTEGER :: itile 85 90 REAL(wp) :: ztra ! local scalar 86 91 REAL(wp) :: zfp_ui, zfp_vj, zfp_wk, zC2t_u, zC4t_u ! - - 87 92 REAL(wp) :: zfm_ui, zfm_vj, zfm_wk, zC2t_v, zC4t_v ! - - 88 REAL(wp), DIMENSION(jpi,jpj,jpk) :: zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw 89 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: ztrdx, ztrdy, ztrdz, zptry 90 REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zwinf, zwdia, zwsup 93 REAL(wp), DIMENSION(ST_2D(nn_hls),jpk) :: zwi, zwx, zwy, zwz, ztu, ztv, zltu, zltv, ztw 94 ! TEMP: This change not necessary after trd_tra is tiled 95 REAL(wp), DIMENSION(:,:,:), SAVE, ALLOCATABLE :: ztrdx, ztrdy, ztrdz 96 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE :: zptry 97 REAL(wp), DIMENSION(:,:,:) , ALLOCATABLE :: zwinf, zwdia, zwsup 91 98 LOGICAL :: ll_zAimp ! flag to apply adaptive implicit vertical advection 92 99 !!---------------------------------------------------------------------- 93 ! 94 IF( kt == kit000 ) THEN 95 IF(lwp) WRITE(numout,*) 96 IF(lwp) WRITE(numout,*) 'tra_adv_fct : FCT advection scheme on ', cdtype 97 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 98 ENDIF 100 ! TEMP: This change not necessary after trd_tra is tiled 101 itile = ntile 102 ! 103 IF( ntile == 0 .OR. ntile == 1 ) THEN ! Do only on the first tile 104 IF( kt == kit000 ) THEN 105 IF(lwp) WRITE(numout,*) 106 IF(lwp) WRITE(numout,*) 'tra_adv_fct : FCT advection scheme on ', cdtype 107 IF(lwp) WRITE(numout,*) '~~~~~~~~~~~' 108 ENDIF 99 109 !! -- init to 0 100 110 zwi(:,:,:) = 0._wp … … 107 117 zltv(:,:,:) = 0._wp 108 118 ztw(:,:,:) = 0._wp 109 ! 110 l_trd = .FALSE. ! set local switches 111 l_hst = .FALSE. 112 l_ptr = .FALSE. 113 ll_zAimp = .FALSE. 114 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype =='TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 115 IF( cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) ) ) l_ptr = .TRUE. 116 IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 117 & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE. 118 ! 119 IF( l_trd .OR. l_hst ) THEN 120 ALLOCATE( ztrdx(jpi,jpj,jpk), ztrdy(jpi,jpj,jpk), ztrdz(jpi,jpj,jpk) ) 121 ztrdx(:,:,:) = 0._wp ; ztrdy(:,:,:) = 0._wp ; ztrdz(:,:,:) = 0._wp 119 ! 120 l_trd = .FALSE. ! set local switches 121 l_hst = .FALSE. 122 l_ptr = .FALSE. 123 ll_zAimp = .FALSE. 124 IF( ( cdtype == 'TRA' .AND. l_trdtra ) .OR. ( cdtype =='TRC' .AND. l_trdtrc ) ) l_trd = .TRUE. 125 IF( cdtype == 'TRA' .AND. ( iom_use( 'sophtadv' ) .OR. iom_use( 'sophtadv' ) ) ) l_ptr = .TRUE. 126 IF( cdtype == 'TRA' .AND. ( iom_use("uadv_heattr") .OR. iom_use("vadv_heattr") .OR. & 127 & iom_use("uadv_salttr") .OR. iom_use("vadv_salttr") ) ) l_hst = .TRUE. 128 ! 129 ! TEMP: This can be ST_2D(nn_hls) after trd_tra is tiled 130 IF( kt == kit000 .AND. (l_trd .OR. l_hst) ) THEN 131 ALLOCATE( ztrdx(jpi,jpj,jpk), ztrdy(jpi,jpj,jpk), ztrdz(jpi,jpj,jpk) ) 132 ENDIF 122 133 ENDIF 123 134 ! 124 135 IF( l_ptr ) THEN 125 ALLOCATE( zptry( jpi,jpj,jpk) )136 ALLOCATE( zptry(ST_2D(nn_hls),jpk) ) 126 137 zptry(:,:,:) = 0._wp 127 138 ENDIF … … 134 145 ! If adaptive vertical advection, check if it is needed on this PE at this time 135 146 IF( ln_zad_Aimp ) THEN 136 IF( MAXVAL( ABS( wi( :,:,:) ) ) > 0._wp ) ll_zAimp = .TRUE.147 IF( MAXVAL( ABS( wi(ST_2D(nn_hls),:) ) ) > 0._wp ) ll_zAimp = .TRUE. 137 148 END IF 138 149 ! If active adaptive vertical advection, build tridiagonal matrix 139 150 IF( ll_zAimp ) THEN 140 ALLOCATE(zwdia( jpi,jpj,jpk), zwinf(jpi,jpj,jpk),zwsup(jpi,jpj,jpk))151 ALLOCATE(zwdia(ST_2D(nn_hls),jpk), zwinf(ST_2D(nn_hls),jpk), zwsup(ST_2D(nn_hls),jpk)) 141 152 DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 142 153 zwdia(ji,jj,jk) = 1._wp + p2dt * ( MAX( wi(ji,jj,jk) , 0._wp ) - MIN( wi(ji,jj,jk+1) , 0._wp ) ) & … … 167 178 END_3D 168 179 IF( ln_linssh ) THEN ! top ocean value (only in linear free surface as zwz has been w-masked) 180 ! TODO: NOT TESTED- requires isf 169 181 IF( ln_isfcav ) THEN ! top of the ice-shelf cavities and at the ocean surface 170 182 DO_2D( 1, 1, 1, 1 ) … … 207 219 END IF 208 220 ! 221 ! TEMP: This change not necessary after trd_tra is tiled 209 222 IF( l_trd .OR. l_hst ) THEN ! trend diagnostics (contribution of upstream fluxes) 210 ztrdx(:,:,:) = zwx(:,:,:) ; ztrdy(:,:,:) = zwy(:,:,:) ; ztrdz(:,:,:) = zwz(:,:,:) 223 DO_3D( 1, 0, 1, 0, 1, jpk ) 224 ztrdx(ji,jj,jk) = zwx(ji,jj,jk) ; ztrdy(ji,jj,jk) = zwy(ji,jj,jk) ; ztrdz(ji,jj,jk) = zwz(ji,jj,jk) 225 END_3D 211 226 END IF 212 227 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) … … 336 351 END IF 337 352 ! 353 ! TEMP: These changes not necessary after trd_tra is tiled 338 354 IF( l_trd .OR. l_hst ) THEN ! trend diagnostics // heat/salt transport 339 ztrdx(:,:,:) = ztrdx(:,:,:) + zwx(:,:,:) ! <<< add anti-diffusive fluxes 340 ztrdy(:,:,:) = ztrdy(:,:,:) + zwy(:,:,:) ! to upstream fluxes 341 ztrdz(:,:,:) = ztrdz(:,:,:) + zwz(:,:,:) ! 342 ! 343 IF( l_trd ) THEN ! trend diagnostics 344 CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, ztrdx, pU, pt(:,:,:,jn,Kmm) ) 345 CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, ztrdy, pV, pt(:,:,:,jn,Kmm) ) 346 CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, ztrdz, pW, pt(:,:,:,jn,Kmm) ) 355 DO_3D( 1, 0, 1, 0, 1, jpk ) 356 ztrdx(ji,jj,jk) = ztrdx(ji,jj,jk) + zwx(ji,jj,jk) ! <<< add anti-diffusive fluxes 357 ztrdy(ji,jj,jk) = ztrdy(ji,jj,jk) + zwy(ji,jj,jk) ! to upstream fluxes 358 ztrdz(ji,jj,jk) = ztrdz(ji,jj,jk) + zwz(ji,jj,jk) ! 359 END_3D 360 ! 361 IF( ntile == 0 .OR. ntile == nijtile ) THEN ! Do only for the full domain 362 IF( l_trd ) THEN ! trend diagnostics 363 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = 0 ) ! Use full domain 364 365 ! TODO: TO BE TILED- trd_tra 366 CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, ztrdx, pU, pt(:,:,:,jn,Kmm) ) 367 CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, ztrdy, pV, pt(:,:,:,jn,Kmm) ) 368 CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, ztrdz, pW, pt(:,:,:,jn,Kmm) ) 369 370 IF( ln_tile ) CALL dom_tile( ntsi, ntsj, ntei, ntej, ktile = itile ) ! Revert to tile domain 371 ENDIF 347 372 ENDIF 348 373 ! ! heat/salt transport 349 IF( l_hst ) CALL dia_ar5_hst( jn, 'adv', ztrdx( :,:,:), ztrdy(:,:,:) )374 IF( l_hst ) CALL dia_ar5_hst( jn, 'adv', ztrdx(ST_2D(nn_hls),:), ztrdy(ST_2D(nn_hls),:) ) 350 375 ! 351 376 ENDIF … … 360 385 DEALLOCATE( zwdia, zwinf, zwsup ) 361 386 ENDIF 362 IF( l_trd .OR. l_hst ) THEN 363 DEALLOCATE( ztrdx, ztrdy, ztrdz ) 364 ENDIF 387 ! TEMP: These changes not necessary after trd_tra is tiled 388 ! IF( l_trd .OR. l_hst ) THEN 389 ! DEALLOCATE( ztrdx, ztrdy, ztrdz ) 390 ! ENDIF 365 391 IF( l_ptr ) THEN 366 392 DEALLOCATE( zptry ) … … 383 409 !! in-space based differencing for fluid 384 410 !!---------------------------------------------------------------------- 385 INTEGER , INTENT(in ) :: Kmm ! time level index 386 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 387 REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in ) :: pbef, paft ! before & after field 388 REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(inout) :: paa, pbb, pcc ! monotonic fluxes in the 3 directions 411 INTEGER , INTENT(in ) :: Kmm ! time level index 412 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 413 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pbef ! before field 414 REAL(wp), DIMENSION(ST_2D(nn_hls) ,jpk), INTENT(in ) :: paft ! after field 415 REAL(wp), DIMENSION(ST_2D(nn_hls) ,jpk), INTENT(inout) :: paa, pbb, pcc ! monotonic fluxes in the 3 directions 389 416 ! 390 417 INTEGER :: ji, jj, jk ! dummy loop indices … … 392 419 REAL(dp) :: zpos, zneg, zbt, za, zb, zc, zbig, zrtrn ! local scalars 393 420 REAL(dp) :: zau, zbu, zcu, zav, zbv, zcv, zup, zdo ! - - 394 REAL(dp), DIMENSION( jpi,jpj,jpk) :: zbetup, zbetdo, zbup, zbdo421 REAL(dp), DIMENSION(ST_2D(nn_hls),jpk) :: zbetup, zbetdo, zbup, zbdo 395 422 !!---------------------------------------------------------------------- 396 423 ! … … 402 429 ! -------------------- 403 430 ! max/min of pbef & paft with large negative/positive value (-/+zbig) inside land 404 zbup = MAX( pbef * tmask - zbig * ( 1._wp - tmask ), & 405 & paft * tmask - zbig * ( 1._wp - tmask ) ) 406 zbdo = MIN( pbef * tmask + zbig * ( 1._wp - tmask ), & 407 & paft * tmask + zbig * ( 1._wp - tmask ) ) 431 DO_3D( 1, 1, 1, 1, 1, jpk ) 432 zbup(ji,jj,jk) = MAX( pbef(ji,jj,jk) * tmask(ji,jj,jk) - zbig * ( 1._wp - tmask(ji,jj,jk) ), & 433 & paft(ji,jj,jk) * tmask(ji,jj,jk) - zbig * ( 1._wp - tmask(ji,jj,jk) ) ) 434 zbdo(ji,jj,jk) = MIN( pbef(ji,jj,jk) * tmask(ji,jj,jk) + zbig * ( 1._wp - tmask(ji,jj,jk) ), & 435 & paft(ji,jj,jk) * tmask(ji,jj,jk) + zbig * ( 1._wp - tmask(ji,jj,jk) ) ) 436 END_3D 408 437 409 438 DO jk = 1, jpkm1 … … 537 566 !!---------------------------------------------------------------------- 538 567 REAL(wp),DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pt_in ! field at t-point 539 REAL(wp),DIMENSION( jpi,jpj,jpk), INTENT( out) :: pt_out ! field interpolated at w-point568 REAL(wp),DIMENSION(ST_2D(nn_hls) ,jpk), INTENT( out) :: pt_out ! field interpolated at w-point 540 569 ! 541 570 INTEGER :: ji, jj, jk ! dummy loop integers 542 571 INTEGER :: ikt, ikb ! local integers 543 REAL(wp),DIMENSION( jpi,jpj,jpk) :: zwd, zwi, zws, zwrm, zwt572 REAL(wp),DIMENSION(ST_2D(nn_hls),jpk) :: zwd, zwi, zws, zwrm, zwt 544 573 !!---------------------------------------------------------------------- 545 574 ! … … 561 590 !!gm 562 591 ! 592 ! TODO: NOT TESTED- requires isf 563 593 IF ( ln_isfcav ) THEN ! set level two values which may not be set in ISF case 564 594 zwd(:,:,2) = 1._wp ; zwi(:,:,2) = 0._wp ; zws(:,:,2) = 0._wp ; zwrm(:,:,2) = 0._wp … … 626 656 !! The 3d array zwt is used as a work space array. 627 657 !!---------------------------------------------------------------------- 628 REAL(wp),DIMENSION( :,:,:), INTENT(in ) :: pD, pU, PL ! 3-diagonal matrix629 REAL(wp),DIMENSION( :,:,:), INTENT(in ) :: pRHS ! Right-Hand-Side630 REAL(wp),DIMENSION( :,:,:), INTENT( out) :: pt_out !!gm field at level=F(klev)631 INTEGER , INTENT(in ) :: klev ! =1 pt_out at w-level632 ! ! =0 pt at t-level658 REAL(wp),DIMENSION(ST_2D(nn_hls),jpk), INTENT(in ) :: pD, pU, PL ! 3-diagonal matrix 659 REAL(wp),DIMENSION(ST_2D(nn_hls),jpk), INTENT(in ) :: pRHS ! Right-Hand-Side 660 REAL(wp),DIMENSION(ST_2D(nn_hls),jpk), INTENT( out) :: pt_out !!gm field at level=F(klev) 661 INTEGER , INTENT(in ) :: klev ! =1 pt_out at w-level 662 ! ! =0 pt at t-level 633 663 INTEGER :: ji, jj, jk ! dummy loop integers 634 664 INTEGER :: kstart ! local indices 635 REAL(wp),DIMENSION( jpi,jpj,jpk) :: zwt ! 3D work array665 REAL(wp),DIMENSION(ST_2D(nn_hls),jpk) :: zwt ! 3D work array 636 666 !!---------------------------------------------------------------------- 637 667 !
Note: See TracChangeset
for help on using the changeset viewer.
