- Timestamp:
- 2019-11-22T15:29:17+01:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11943_MERGE_2019/src
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
OCE/TRA/traadv_fct.F90 (modified) (23 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11943_MERGE_2019/src
- Property svn:mergeinfo deleted
-
NEMO/branches/2019/dev_r11943_MERGE_2019/src/OCE/TRA/traadv_fct.F90
r11411 r11949 53 53 CONTAINS 54 54 55 SUBROUTINE tra_adv_fct( kt, kit000, cdtype, p2dt, p un, pvn, pwn, &56 & ptb, ptn, pta, kjpt, kn_fct_h, kn_fct_v )55 SUBROUTINE tra_adv_fct( kt, kit000, cdtype, p2dt, pU, pV, pW, & 56 & Kbb, Kmm, pt, kjpt, Krhs, kn_fct_h, kn_fct_v ) 57 57 !!---------------------------------------------------------------------- 58 58 !! *** ROUTINE tra_adv_fct *** … … 66 66 !! - corrected flux (monotonic correction) 67 67 !! 68 !! ** Action : - update pt awith the now advective tracer trends68 !! ** Action : - update pt(:,:,:,:,Krhs) with the now advective tracer trends 69 69 !! - send trends to trdtra module for further diagnostics (l_trdtra=T) 70 70 !! - htr_adv, str_adv : poleward advective heat and salt transport (ln_diaptr=T) 71 71 !!---------------------------------------------------------------------- 72 INTEGER , INTENT(in ) :: kt ! ocean time-step index73 INTEGER , INTENT(in ) :: kit000 ! first time step index74 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator)75 INTEGER , INTENT(in ) :: kjpt ! number of tracers76 INTEGER , INTENT(in ) :: kn_fct_h ! order of the FCT scheme (=2 or 4)77 INTEGER , INTENT(in ) :: kn_fct_v! order of the FCT scheme (=2 or 4)78 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step79 REAL(wp) , DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pun, pvn, pwn ! 3 ocean velocity components80 REAL(wp), DIMENSION(jpi,jpj,jpk ,kjpt), INTENT(in ) :: ptb, ptn ! before and now tracer fields81 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt ), INTENT(inout) :: pta ! tracer trend72 INTEGER , INTENT(in ) :: kt ! ocean time-step index 73 INTEGER , INTENT(in ) :: Kbb, Kmm, Krhs ! ocean time level indices 74 INTEGER , INTENT(in ) :: kit000 ! first time step index 75 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 76 INTEGER , INTENT(in ) :: kjpt ! number of tracers 77 INTEGER , INTENT(in ) :: kn_fct_h ! order of the FCT scheme (=2 or 4) 78 INTEGER , INTENT(in ) :: kn_fct_v ! order of the FCT scheme (=2 or 4) 79 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 80 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pU, pV, pW ! 3 ocean volume flux components 81 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracers and RHS of tracer equation 82 82 ! 83 83 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 131 131 DO jj = 2, jpjm1 132 132 DO ji = fs_2, fs_jpim1 ! vector opt. (ensure same order of calculation as below if wi=0.) 133 zwdia(ji,jj,jk) = 1._wp + p2dt * ( MAX( wi(ji,jj,jk ) , 0._wp ) - MIN( wi(ji,jj,jk+1) , 0._wp ) ) / e3t _a(ji,jj,jk)134 zwinf(ji,jj,jk) = p2dt * MIN( wi(ji,jj,jk ) , 0._wp ) / e3t _a(ji,jj,jk)135 zwsup(ji,jj,jk) = -p2dt * MAX( wi(ji,jj,jk+1) , 0._wp ) / e3t _a(ji,jj,jk)133 zwdia(ji,jj,jk) = 1._wp + p2dt * ( MAX( wi(ji,jj,jk ) , 0._wp ) - MIN( wi(ji,jj,jk+1) , 0._wp ) ) / e3t(ji,jj,jk,Krhs) 134 zwinf(ji,jj,jk) = p2dt * MIN( wi(ji,jj,jk ) , 0._wp ) / e3t(ji,jj,jk,Krhs) 135 zwsup(ji,jj,jk) = -p2dt * MAX( wi(ji,jj,jk+1) , 0._wp ) / e3t(ji,jj,jk,Krhs) 136 136 END DO 137 137 END DO … … 147 147 DO ji = 1, fs_jpim1 ! vector opt. 148 148 ! upstream scheme 149 zfp_ui = p un(ji,jj,jk) + ABS( pun(ji,jj,jk) )150 zfm_ui = p un(ji,jj,jk) - ABS( pun(ji,jj,jk) )151 zfp_vj = p vn(ji,jj,jk) + ABS( pvn(ji,jj,jk) )152 zfm_vj = p vn(ji,jj,jk) - ABS( pvn(ji,jj,jk) )153 zwx(ji,jj,jk) = 0.5 * ( zfp_ui * pt b(ji,jj,jk,jn) + zfm_ui * ptb(ji+1,jj ,jk,jn) )154 zwy(ji,jj,jk) = 0.5 * ( zfp_vj * pt b(ji,jj,jk,jn) + zfm_vj * ptb(ji ,jj+1,jk,jn) )149 zfp_ui = pU(ji,jj,jk) + ABS( pU(ji,jj,jk) ) 150 zfm_ui = pU(ji,jj,jk) - ABS( pU(ji,jj,jk) ) 151 zfp_vj = pV(ji,jj,jk) + ABS( pV(ji,jj,jk) ) 152 zfm_vj = pV(ji,jj,jk) - ABS( pV(ji,jj,jk) ) 153 zwx(ji,jj,jk) = 0.5 * ( zfp_ui * pt(ji,jj,jk,jn,Kbb) + zfm_ui * pt(ji+1,jj ,jk,jn,Kbb) ) 154 zwy(ji,jj,jk) = 0.5 * ( zfp_vj * pt(ji,jj,jk,jn,Kbb) + zfm_vj * pt(ji ,jj+1,jk,jn,Kbb) ) 155 155 END DO 156 156 END DO … … 160 160 DO jj = 1, jpj 161 161 DO ji = 1, jpi 162 zfp_wk = p wn(ji,jj,jk) + ABS( pwn(ji,jj,jk) )163 zfm_wk = p wn(ji,jj,jk) - ABS( pwn(ji,jj,jk) )164 zwz(ji,jj,jk) = 0.5 * ( zfp_wk * pt b(ji,jj,jk,jn) + zfm_wk * ptb(ji,jj,jk-1,jn) ) * wmask(ji,jj,jk)162 zfp_wk = pW(ji,jj,jk) + ABS( pW(ji,jj,jk) ) 163 zfm_wk = pW(ji,jj,jk) - ABS( pW(ji,jj,jk) ) 164 zwz(ji,jj,jk) = 0.5 * ( zfp_wk * pt(ji,jj,jk,jn,Kbb) + zfm_wk * pt(ji,jj,jk-1,jn,Kbb) ) * wmask(ji,jj,jk) 165 165 END DO 166 166 END DO … … 170 170 DO jj = 1, jpj 171 171 DO ji = 1, jpi 172 zwz(ji,jj, mikt(ji,jj) ) = p wn(ji,jj,mikt(ji,jj)) * ptb(ji,jj,mikt(ji,jj),jn) ! linear free surface172 zwz(ji,jj, mikt(ji,jj) ) = pW(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kbb) ! linear free surface 173 173 END DO 174 174 END DO 175 175 ELSE ! no cavities: only at the ocean surface 176 zwz(:,:,1) = p wn(:,:,1) * ptb(:,:,1,jn)176 zwz(:,:,1) = pW(:,:,1) * pt(:,:,1,jn,Kbb) 177 177 ENDIF 178 178 ENDIF … … 186 186 & + zwz(ji,jj,jk) - zwz(ji ,jj ,jk+1) ) * r1_e1e2t(ji,jj) 187 187 ! ! update and guess with monotonic sheme 188 pt a(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra / e3t_n(ji,jj,jk) * tmask(ji,jj,jk)189 zwi(ji,jj,jk) = ( e3t _b(ji,jj,jk) * ptb(ji,jj,jk,jn) + p2dt * ztra ) / e3t_a(ji,jj,jk) * tmask(ji,jj,jk)188 pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) + ztra / e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) 189 zwi(ji,jj,jk) = ( e3t(ji,jj,jk,Kbb) * pt(ji,jj,jk,jn,Kbb) + p2dt * ztra ) / e3t(ji,jj,jk,Krhs) * tmask(ji,jj,jk) 190 190 END DO 191 191 END DO … … 209 209 DO jj = 2, jpjm1 210 210 DO ji = fs_2, fs_jpim1 ! vector opt. 211 pt a(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - ( ztw(ji,jj,jk) - ztw(ji ,jj ,jk+1) ) &212 & * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)211 pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( ztw(ji,jj,jk) - ztw(ji ,jj ,jk+1) ) & 212 & * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 213 213 END DO 214 214 END DO … … 231 231 DO jj = 1, jpjm1 232 232 DO ji = 1, fs_jpim1 ! vector opt. 233 zwx(ji,jj,jk) = 0.5_wp * p un(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj,jk,jn) ) - zwx(ji,jj,jk)234 zwy(ji,jj,jk) = 0.5_wp * p vn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj+1,jk,jn) ) - zwy(ji,jj,jk)233 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) 234 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) 235 235 END DO 236 236 END DO … … 243 243 DO jj = 1, jpjm1 ! 1st derivative (gradient) 244 244 DO ji = 1, fs_jpim1 ! vector opt. 245 ztu(ji,jj,jk) = ( pt n(ji+1,jj ,jk,jn) - ptn(ji,jj,jk,jn) ) * umask(ji,jj,jk)246 ztv(ji,jj,jk) = ( pt n(ji ,jj+1,jk,jn) - ptn(ji,jj,jk,jn) ) * vmask(ji,jj,jk)245 ztu(ji,jj,jk) = ( pt(ji+1,jj ,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * umask(ji,jj,jk) 246 ztv(ji,jj,jk) = ( pt(ji ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk) 247 247 END DO 248 248 END DO … … 259 259 DO jj = 1, jpjm1 260 260 DO ji = 1, fs_jpim1 ! vector opt. 261 zC2t_u = pt n(ji,jj,jk,jn) + ptn(ji+1,jj ,jk,jn) ! 2 x C2 interpolation of T at u- & v-points262 zC2t_v = pt n(ji,jj,jk,jn) + ptn(ji ,jj+1,jk,jn)261 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 262 zC2t_v = pt(ji,jj,jk,jn,Kmm) + pt(ji ,jj+1,jk,jn,Kmm) 263 263 ! ! C4 minus upstream advective fluxes 264 zwx(ji,jj,jk) = 0.5_wp * p un(ji,jj,jk) * ( zC2t_u + zltu(ji,jj,jk) - zltu(ji+1,jj,jk) ) - zwx(ji,jj,jk)265 zwy(ji,jj,jk) = 0.5_wp * p vn(ji,jj,jk) * ( zC2t_v + zltv(ji,jj,jk) - zltv(ji,jj+1,jk) ) - zwy(ji,jj,jk)264 zwx(ji,jj,jk) = 0.5_wp * pU(ji,jj,jk) * ( zC2t_u + zltu(ji,jj,jk) - zltu(ji+1,jj,jk) ) - zwx(ji,jj,jk) 265 zwy(ji,jj,jk) = 0.5_wp * pV(ji,jj,jk) * ( zC2t_v + zltv(ji,jj,jk) - zltv(ji,jj+1,jk) ) - zwy(ji,jj,jk) 266 266 END DO 267 267 END DO … … 274 274 DO jj = 1, jpjm1 275 275 DO ji = 1, fs_jpim1 ! vector opt. 276 ztu(ji,jj,jk) = ( pt n(ji+1,jj ,jk,jn) - ptn(ji,jj,jk,jn) ) * umask(ji,jj,jk)277 ztv(ji,jj,jk) = ( pt n(ji ,jj+1,jk,jn) - ptn(ji,jj,jk,jn) ) * vmask(ji,jj,jk)276 ztu(ji,jj,jk) = ( pt(ji+1,jj ,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * umask(ji,jj,jk) 277 ztv(ji,jj,jk) = ( pt(ji ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk) 278 278 END DO 279 279 END DO … … 284 284 DO jj = 2, jpjm1 285 285 DO ji = 2, fs_jpim1 ! vector opt. 286 zC2t_u = pt n(ji,jj,jk,jn) + ptn(ji+1,jj ,jk,jn) ! 2 x C2 interpolation of T at u- & v-points (x2)287 zC2t_v = pt n(ji,jj,jk,jn) + ptn(ji ,jj+1,jk,jn)286 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 (x2) 287 zC2t_v = pt(ji,jj,jk,jn,Kmm) + pt(ji ,jj+1,jk,jn,Kmm) 288 288 ! ! C4 interpolation of T at u- & v-points (x2) 289 289 zC4t_u = zC2t_u + r1_6 * ( ztu(ji-1,jj ,jk) - ztu(ji+1,jj ,jk) ) 290 290 zC4t_v = zC2t_v + r1_6 * ( ztv(ji ,jj-1,jk) - ztv(ji ,jj+1,jk) ) 291 291 ! ! C4 minus upstream advective fluxes 292 zwx(ji,jj,jk) = 0.5_wp * p un(ji,jj,jk) * zC4t_u - zwx(ji,jj,jk)293 zwy(ji,jj,jk) = 0.5_wp * p vn(ji,jj,jk) * zC4t_v - zwy(ji,jj,jk)292 zwx(ji,jj,jk) = 0.5_wp * pU(ji,jj,jk) * zC4t_u - zwx(ji,jj,jk) 293 zwy(ji,jj,jk) = 0.5_wp * pV(ji,jj,jk) * zC4t_v - zwy(ji,jj,jk) 294 294 END DO 295 295 END DO … … 304 304 DO jj = 2, jpjm1 305 305 DO ji = fs_2, fs_jpim1 306 zwz(ji,jj,jk) = ( p wn(ji,jj,jk) * 0.5_wp * ( ptn(ji,jj,jk,jn) + ptn(ji,jj,jk-1,jn) ) &306 zwz(ji,jj,jk) = ( pW(ji,jj,jk) * 0.5_wp * ( pt(ji,jj,jk,jn,Kmm) + pt(ji,jj,jk-1,jn,Kmm) ) & 307 307 & - zwz(ji,jj,jk) ) * wmask(ji,jj,jk) 308 308 END DO … … 311 311 ! 312 312 CASE( 4 ) !- 4th order COMPACT 313 CALL interp_4th_cpt( pt n(:,:,:,jn) , ztw ) ! zwt = COMPACT interpolation of T at w-point313 CALL interp_4th_cpt( pt(:,:,:,jn,Kmm) , ztw ) ! zwt = COMPACT interpolation of T at w-point 314 314 DO jk = 2, jpkm1 315 315 DO jj = 2, jpjm1 316 316 DO ji = fs_2, fs_jpim1 317 zwz(ji,jj,jk) = ( p wn(ji,jj,jk) * ztw(ji,jj,jk) - zwz(ji,jj,jk) ) * wmask(ji,jj,jk)317 zwz(ji,jj,jk) = ( pW(ji,jj,jk) * ztw(ji,jj,jk) - zwz(ji,jj,jk) ) * wmask(ji,jj,jk) 318 318 END DO 319 319 END DO … … 333 333 & + zwy(ji,jj,jk) - zwy(ji ,jj-1,jk ) & 334 334 & + zwz(ji,jj,jk) - zwz(ji ,jj ,jk+1) ) * r1_e1e2t(ji,jj) 335 ztw(ji,jj,jk) = zwi(ji,jj,jk) + p2dt * ztra / e3t _a(ji,jj,jk) * tmask(ji,jj,jk)335 ztw(ji,jj,jk) = zwi(ji,jj,jk) + p2dt * ztra / e3t(ji,jj,jk,Krhs) * tmask(ji,jj,jk) 336 336 END DO 337 337 END DO … … 355 355 ! !== monotonicity algorithm ==! 356 356 ! 357 CALL nonosc( ptb(:,:,:,jn), zwx, zwy, zwz, zwi, p2dt )357 CALL nonosc( Kmm, pt(:,:,:,jn,Kbb), zwx, zwy, zwz, zwi, p2dt ) 358 358 ! 359 359 ! !== final trend with corrected fluxes ==! … … 365 365 & + zwy(ji,jj,jk) - zwy(ji ,jj-1,jk ) & 366 366 & + zwz(ji,jj,jk) - zwz(ji ,jj ,jk+1) ) * r1_e1e2t(ji,jj) 367 pt a(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra / e3t_n(ji,jj,jk)368 zwi(ji,jj,jk) = zwi(ji,jj,jk) + p2dt * ztra / e3t _a(ji,jj,jk) * tmask(ji,jj,jk)367 pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) + ztra / e3t(ji,jj,jk,Kmm) 368 zwi(ji,jj,jk) = zwi(ji,jj,jk) + p2dt * ztra / e3t(ji,jj,jk,Krhs) * tmask(ji,jj,jk) 369 369 END DO 370 370 END DO … … 387 387 DO jj = 2, jpjm1 388 388 DO ji = fs_2, fs_jpim1 ! vector opt. 389 pt a(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - ( ztw(ji,jj,jk) - ztw(ji ,jj ,jk+1) ) &390 & * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)389 pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( ztw(ji,jj,jk) - ztw(ji ,jj ,jk+1) ) & 390 & * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 391 391 END DO 392 392 END DO … … 400 400 ! 401 401 IF( l_trd ) THEN ! trend diagnostics 402 CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) )403 CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) )404 CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) )402 CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, ztrdx, pU, pt(:,:,:,jn,Kmm) ) 403 CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, ztrdy, pV, pt(:,:,:,jn,Kmm) ) 404 CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, ztrdz, pW, pt(:,:,:,jn,Kmm) ) 405 405 ENDIF 406 406 ! ! heat/salt transport … … 428 428 429 429 430 SUBROUTINE nonosc( pbef, paa, pbb, pcc, paft, p2dt )430 SUBROUTINE nonosc( Kmm, pbef, paa, pbb, pcc, paft, p2dt ) 431 431 !!--------------------------------------------------------------------- 432 432 !! *** ROUTINE nonosc *** … … 441 441 !! in-space based differencing for fluid 442 442 !!---------------------------------------------------------------------- 443 INTEGER , INTENT(in ) :: Kmm ! time level index 443 444 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 444 445 REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in ) :: pbef, paft ! before & after field … … 492 493 493 494 ! up & down beta terms 494 zbt = e1e2t(ji,jj) * e3t _n(ji,jj,jk) / p2dt495 zbt = e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) / p2dt 495 496 zbetup(ji,jj,jk) = ( zup - paft(ji,jj,jk) ) / ( zpos + zrtrn ) * zbt 496 497 zbetdo(ji,jj,jk) = ( paft(ji,jj,jk) - zdo ) / ( zneg + zrtrn ) * zbt
Note: See TracChangeset
for help on using the changeset viewer.
