- Timestamp:
- 2019-11-22T15:29:17+01:00 (5 years ago)
- Location:
- NEMO/branches/2019/dev_r11943_MERGE_2019/src
- Files:
-
- 2 edited
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_qck.F90
r10425 r11949 47 47 CONTAINS 48 48 49 SUBROUTINE tra_adv_qck ( kt, kit000, cdtype, p2dt, pun, pvn, pwn, & 50 & ptb, ptn, pta, kjpt ) 49 SUBROUTINE tra_adv_qck ( kt, kit000, cdtype, p2dt, pU, pV, pW, Kbb, Kmm, pt, kjpt, Krhs ) 51 50 !!---------------------------------------------------------------------- 52 51 !! *** ROUTINE tra_adv_qck *** … … 72 71 !! dt = 2*rdtra and the scalar values are tb and sb 73 72 !! 74 !! On the vertical, the simple centered scheme used pt n73 !! On the vertical, the simple centered scheme used pt(:,:,:,:,Kmm) 75 74 !! 76 75 !! The fluxes are bounded by the ULTIMATE limiter to … … 78 77 !! prevent the appearance of spurious numerical oscillations 79 78 !! 80 !! ** Action : - update pt awith the now advective tracer trends79 !! ** Action : - update pt(:,:,:,:,Krhs) with the now advective tracer trends 81 80 !! - send trends to trdtra module for further diagnostcs (l_trdtra=T) 82 81 !! - htr_adv, str_adv : poleward advective heat and salt transport (ln_diaptr=T) … … 84 83 !! ** Reference : Leonard (1979, 1991) 85 84 !!---------------------------------------------------------------------- 86 INTEGER , INTENT(in ) :: kt ! ocean time-step index87 INTEGER , INTENT(in ) :: kit000 ! first time step index88 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator)89 INTEGER , INTENT(in ) :: kjpt ! number of tracers90 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step91 REAL(wp) , DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pun, pvn, pwn ! 3 ocean velocity components92 REAL(wp), DIMENSION(jpi,jpj,jpk ,kjpt), INTENT(in ) :: ptb, ptn ! before and now tracer fields93 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt ), INTENT(inout) :: pta ! tracer trend85 INTEGER , INTENT(in ) :: kt ! ocean time-step index 86 INTEGER , INTENT(in ) :: Kbb, Kmm, Krhs ! ocean time level indices 87 INTEGER , INTENT(in ) :: kit000 ! first time step index 88 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 89 INTEGER , INTENT(in ) :: kjpt ! number of tracers 90 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 91 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pU, pV, pW ! 3 ocean volume transport components 92 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracers and RHS of tracer equation 94 93 !!---------------------------------------------------------------------- 95 94 ! … … 108 107 ! 109 108 ! ! horizontal fluxes are computed with the QUICKEST + ULTIMATE scheme 110 CALL tra_adv_qck_i( kt, cdtype, p2dt, p un, ptb, ptn, pta, kjpt)111 CALL tra_adv_qck_j( kt, cdtype, p2dt, p vn, ptb, ptn, pta, kjpt)109 CALL tra_adv_qck_i( kt, cdtype, p2dt, pU, Kbb, Kmm, pt, kjpt, Krhs ) 110 CALL tra_adv_qck_j( kt, cdtype, p2dt, pV, Kbb, Kmm, pt, kjpt, Krhs ) 112 111 113 112 ! ! vertical fluxes are computed with the 2nd order centered scheme 114 CALL tra_adv_cen2_k( kt, cdtype, p wn, ptn, pta, kjpt)113 CALL tra_adv_cen2_k( kt, cdtype, pW, Kmm, pt, kjpt, Krhs ) 115 114 ! 116 115 END SUBROUTINE tra_adv_qck 117 116 118 117 119 SUBROUTINE tra_adv_qck_i( kt, cdtype, p2dt, pun, & 120 & ptb, ptn, pta, kjpt ) 121 !!---------------------------------------------------------------------- 122 !! 123 !!---------------------------------------------------------------------- 124 INTEGER , INTENT(in ) :: kt ! ocean time-step index 125 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 126 INTEGER , INTENT(in ) :: kjpt ! number of tracers 127 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 128 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pun ! i-velocity components 129 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb, ptn ! before and now tracer fields 130 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 118 SUBROUTINE tra_adv_qck_i( kt, cdtype, p2dt, pU, Kbb, Kmm, pt, kjpt, Krhs ) 119 !!---------------------------------------------------------------------- 120 !! 121 !!---------------------------------------------------------------------- 122 INTEGER , INTENT(in ) :: kt ! ocean time-step index 123 INTEGER , INTENT(in ) :: Kbb, Kmm, Krhs ! ocean time level indices 124 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 125 INTEGER , INTENT(in ) :: kjpt ! number of tracers 126 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 127 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pU ! i-velocity components 128 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! active tracers and RHS of tracer equation 131 129 !! 132 130 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 145 143 DO jj = 2, jpjm1 146 144 DO ji = fs_2, fs_jpim1 ! vector opt. 147 zfc(ji,jj,jk) = pt b(ji-1,jj,jk,jn) ! Upstream in the x-direction for the tracer148 zfd(ji,jj,jk) = pt b(ji+1,jj,jk,jn) ! Downstream in the x-direction for the tracer145 zfc(ji,jj,jk) = pt(ji-1,jj,jk,jn,Kbb) ! Upstream in the x-direction for the tracer 146 zfd(ji,jj,jk) = pt(ji+1,jj,jk,jn,Kbb) ! Downstream in the x-direction for the tracer 149 147 END DO 150 148 END DO … … 158 156 DO jj = 2, jpjm1 159 157 DO ji = fs_2, fs_jpim1 ! vector opt. 160 zdir = 0.5 + SIGN( 0.5, p un(ji,jj,jk) ) ! if pun> 0 : zdir = 1 otherwise zdir = 0158 zdir = 0.5 + SIGN( 0.5, pU(ji,jj,jk) ) ! if pU > 0 : zdir = 1 otherwise zdir = 0 161 159 zfu(ji,jj,jk) = zdir * zfc(ji,jj,jk ) + ( 1. - zdir ) * zfd(ji+1,jj,jk) ! FU in the x-direction for T 162 160 END DO … … 167 165 DO jj = 2, jpjm1 168 166 DO ji = fs_2, fs_jpim1 ! vector opt. 169 zdir = 0.5 + SIGN( 0.5, p un(ji,jj,jk) ) ! if pun> 0 : zdir = 1 otherwise zdir = 0170 zdx = ( zdir * e1t(ji,jj) + ( 1. - zdir ) * e1t(ji+1,jj) ) * e2u(ji,jj) * e3u _n(ji,jj,jk)171 zwx(ji,jj,jk) = ABS( p un(ji,jj,jk) ) * p2dt / zdx ! (0<zc_cfl<1 : Courant number on x-direction)172 zfc(ji,jj,jk) = zdir * pt b(ji ,jj,jk,jn) + ( 1. - zdir ) * ptb(ji+1,jj,jk,jn) ! FC in the x-direction for T173 zfd(ji,jj,jk) = zdir * pt b(ji+1,jj,jk,jn) + ( 1. - zdir ) * ptb(ji ,jj,jk,jn) ! FD in the x-direction for T167 zdir = 0.5 + SIGN( 0.5, pU(ji,jj,jk) ) ! if pU > 0 : zdir = 1 otherwise zdir = 0 168 zdx = ( zdir * e1t(ji,jj) + ( 1. - zdir ) * e1t(ji+1,jj) ) * e2u(ji,jj) * e3u(ji,jj,jk,Kmm) 169 zwx(ji,jj,jk) = ABS( pU(ji,jj,jk) ) * p2dt / zdx ! (0<zc_cfl<1 : Courant number on x-direction) 170 zfc(ji,jj,jk) = zdir * pt(ji ,jj,jk,jn,Kbb) + ( 1. - zdir ) * pt(ji+1,jj,jk,jn,Kbb) ! FC in the x-direction for T 171 zfd(ji,jj,jk) = zdir * pt(ji+1,jj,jk,jn,Kbb) + ( 1. - zdir ) * pt(ji ,jj,jk,jn,Kbb) ! FD in the x-direction for T 174 172 END DO 175 173 END DO … … 197 195 DO jj = 2, jpjm1 198 196 DO ji = fs_2, fs_jpim1 ! vector opt. 199 zdir = 0.5 + SIGN( 0.5, p un(ji,jj,jk) ) ! if pun> 0 : zdir = 1 otherwise zdir = 0197 zdir = 0.5 + SIGN( 0.5, pU(ji,jj,jk) ) ! if pU > 0 : zdir = 1 otherwise zdir = 0 200 198 !--- If the second ustream point is a land point 201 199 !--- the flux is computed by the 1st order UPWIND scheme 202 200 zmsk = zdir * zfu(ji,jj,jk) + ( 1. - zdir ) * zfu(ji+1,jj,jk) 203 201 zwx(ji,jj,jk) = zmsk * zwx(ji,jj,jk) + ( 1. - zmsk ) * zfc(ji,jj,jk) 204 zwx(ji,jj,jk) = zwx(ji,jj,jk) * p un(ji,jj,jk)202 zwx(ji,jj,jk) = zwx(ji,jj,jk) * pU(ji,jj,jk) 205 203 END DO 206 204 END DO … … 213 211 DO jj = 2, jpjm1 214 212 DO ji = fs_2, fs_jpim1 ! vector opt. 215 zbtr = r1_e1e2t(ji,jj) / e3t _n(ji,jj,jk)213 zbtr = r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 216 214 ! horizontal advective trends 217 215 ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj,jk) ) 218 216 !--- add it to the general tracer trends 219 pt a(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra217 pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) + ztra 220 218 END DO 221 219 END DO 222 220 END DO 223 221 ! ! trend diagnostics 224 IF( l_trd ) CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pun, ptn(:,:,:,jn) )222 IF( l_trd ) CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, zwx, pU, pt(:,:,:,jn,Kmm) ) 225 223 ! 226 224 END DO … … 229 227 230 228 231 SUBROUTINE tra_adv_qck_j( kt, cdtype, p2dt, pvn, & 232 & ptb, ptn, pta, kjpt ) 233 !!---------------------------------------------------------------------- 234 !! 235 !!---------------------------------------------------------------------- 236 INTEGER , INTENT(in ) :: kt ! ocean time-step index 237 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 238 INTEGER , INTENT(in ) :: kjpt ! number of tracers 239 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 240 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pvn ! j-velocity components 241 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb, ptn ! before and now tracer fields 242 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 229 SUBROUTINE tra_adv_qck_j( kt, cdtype, p2dt, pV, Kbb, Kmm, pt, kjpt, Krhs ) 230 !!---------------------------------------------------------------------- 231 !! 232 !!---------------------------------------------------------------------- 233 INTEGER , INTENT(in ) :: kt ! ocean time-step index 234 INTEGER , INTENT(in ) :: Kbb, Kmm, Krhs ! ocean time level indices 235 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 236 INTEGER , INTENT(in ) :: kjpt ! number of tracers 237 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 238 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pV ! j-velocity components 239 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! active tracers and RHS of tracer equation 243 240 !! 244 241 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 259 256 DO ji = fs_2, fs_jpim1 ! vector opt. 260 257 ! Upstream in the x-direction for the tracer 261 zfc(ji,jj,jk) = pt b(ji,jj-1,jk,jn)258 zfc(ji,jj,jk) = pt(ji,jj-1,jk,jn,Kbb) 262 259 ! Downstream in the x-direction for the tracer 263 zfd(ji,jj,jk) = pt b(ji,jj+1,jk,jn)260 zfd(ji,jj,jk) = pt(ji,jj+1,jk,jn,Kbb) 264 261 END DO 265 262 END DO … … 275 272 DO jj = 2, jpjm1 276 273 DO ji = fs_2, fs_jpim1 ! vector opt. 277 zdir = 0.5 + SIGN( 0.5, p vn(ji,jj,jk) ) ! if pun> 0 : zdir = 1 otherwise zdir = 0274 zdir = 0.5 + SIGN( 0.5, pV(ji,jj,jk) ) ! if pU > 0 : zdir = 1 otherwise zdir = 0 278 275 zfu(ji,jj,jk) = zdir * zfc(ji,jj,jk ) + ( 1. - zdir ) * zfd(ji,jj+1,jk) ! FU in the x-direction for T 279 276 END DO … … 284 281 DO jj = 2, jpjm1 285 282 DO ji = fs_2, fs_jpim1 ! vector opt. 286 zdir = 0.5 + SIGN( 0.5, p vn(ji,jj,jk) ) ! if pun> 0 : zdir = 1 otherwise zdir = 0287 zdx = ( zdir * e2t(ji,jj) + ( 1. - zdir ) * e2t(ji,jj+1) ) * e1v(ji,jj) * e3v _n(ji,jj,jk)288 zwy(ji,jj,jk) = ABS( p vn(ji,jj,jk) ) * p2dt / zdx ! (0<zc_cfl<1 : Courant number on x-direction)289 zfc(ji,jj,jk) = zdir * pt b(ji,jj ,jk,jn) + ( 1. - zdir ) * ptb(ji,jj+1,jk,jn) ! FC in the x-direction for T290 zfd(ji,jj,jk) = zdir * pt b(ji,jj+1,jk,jn) + ( 1. - zdir ) * ptb(ji,jj ,jk,jn) ! FD in the x-direction for T283 zdir = 0.5 + SIGN( 0.5, pV(ji,jj,jk) ) ! if pU > 0 : zdir = 1 otherwise zdir = 0 284 zdx = ( zdir * e2t(ji,jj) + ( 1. - zdir ) * e2t(ji,jj+1) ) * e1v(ji,jj) * e3v(ji,jj,jk,Kmm) 285 zwy(ji,jj,jk) = ABS( pV(ji,jj,jk) ) * p2dt / zdx ! (0<zc_cfl<1 : Courant number on x-direction) 286 zfc(ji,jj,jk) = zdir * pt(ji,jj ,jk,jn,Kbb) + ( 1. - zdir ) * pt(ji,jj+1,jk,jn,Kbb) ! FC in the x-direction for T 287 zfd(ji,jj,jk) = zdir * pt(ji,jj+1,jk,jn,Kbb) + ( 1. - zdir ) * pt(ji,jj ,jk,jn,Kbb) ! FD in the x-direction for T 291 288 END DO 292 289 END DO … … 314 311 DO jj = 2, jpjm1 315 312 DO ji = fs_2, fs_jpim1 ! vector opt. 316 zdir = 0.5 + SIGN( 0.5, p vn(ji,jj,jk) ) ! if pun> 0 : zdir = 1 otherwise zdir = 0313 zdir = 0.5 + SIGN( 0.5, pV(ji,jj,jk) ) ! if pU > 0 : zdir = 1 otherwise zdir = 0 317 314 !--- If the second ustream point is a land point 318 315 !--- the flux is computed by the 1st order UPWIND scheme 319 316 zmsk = zdir * zfu(ji,jj,jk) + ( 1. - zdir ) * zfu(ji,jj+1,jk) 320 317 zwy(ji,jj,jk) = zmsk * zwy(ji,jj,jk) + ( 1. - zmsk ) * zfc(ji,jj,jk) 321 zwy(ji,jj,jk) = zwy(ji,jj,jk) * p vn(ji,jj,jk)318 zwy(ji,jj,jk) = zwy(ji,jj,jk) * pV(ji,jj,jk) 322 319 END DO 323 320 END DO … … 330 327 DO jj = 2, jpjm1 331 328 DO ji = fs_2, fs_jpim1 ! vector opt. 332 zbtr = r1_e1e2t(ji,jj) / e3t _n(ji,jj,jk)329 zbtr = r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 333 330 ! horizontal advective trends 334 331 ztra = - zbtr * ( zwy(ji,jj,jk) - zwy(ji,jj-1,jk) ) 335 332 !--- add it to the general tracer trends 336 pt a(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra333 pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) + ztra 337 334 END DO 338 335 END DO 339 336 END DO 340 337 ! ! trend diagnostics 341 IF( l_trd ) CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptn(:,:,:,jn) )338 IF( l_trd ) CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, zwy, pV, pt(:,:,:,jn,Kmm) ) 342 339 ! ! "Poleward" heat and salt transports (contribution of upstream fluxes) 343 340 IF( l_ptr ) CALL dia_ptr_hst( jn, 'adv', zwy(:,:,:) ) … … 348 345 349 346 350 SUBROUTINE tra_adv_cen2_k( kt, cdtype, pwn, & 351 & ptn, pta, kjpt ) 352 !!---------------------------------------------------------------------- 353 !! 354 !!---------------------------------------------------------------------- 355 INTEGER , INTENT(in ) :: kt ! ocean time-step index 356 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 357 INTEGER , INTENT(in ) :: kjpt ! number of tracers 358 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pwn ! vertical velocity 359 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptn ! before and now tracer fields 360 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 347 SUBROUTINE tra_adv_cen2_k( kt, cdtype, pW, Kmm, pt, kjpt, Krhs ) 348 !!---------------------------------------------------------------------- 349 !! 350 !!---------------------------------------------------------------------- 351 INTEGER , INTENT(in ) :: kt ! ocean time-step index 352 INTEGER , INTENT(in ) :: Kmm, Krhs ! ocean time level indices 353 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 354 INTEGER , INTENT(in ) :: kjpt ! number of tracers 355 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pW ! vertical velocity 356 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! active tracers and RHS of tracer equation 361 357 ! 362 358 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 374 370 DO jj = 2, jpjm1 375 371 DO ji = fs_2, fs_jpim1 ! vector opt. 376 zwz(ji,jj,jk) = 0.5 * p wn(ji,jj,jk) * ( ptn(ji,jj,jk-1,jn) + ptn(ji,jj,jk,jn) ) * wmask(ji,jj,jk)372 zwz(ji,jj,jk) = 0.5 * pW(ji,jj,jk) * ( pt(ji,jj,jk-1,jn,Kmm) + pt(ji,jj,jk,jn,Kmm) ) * wmask(ji,jj,jk) 377 373 END DO 378 374 END DO … … 382 378 DO jj = 1, jpj 383 379 DO ji = 1, jpi 384 zwz(ji,jj, mikt(ji,jj) ) = p wn(ji,jj,mikt(ji,jj)) * ptn(ji,jj,mikt(ji,jj),jn) ! linear free surface380 zwz(ji,jj, mikt(ji,jj) ) = pW(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kmm) ! linear free surface 385 381 END DO 386 382 END DO 387 383 ELSE ! no ocean cavities (only ocean surface) 388 zwz(:,:,1) = p wn(:,:,1) * ptn(:,:,1,jn)384 zwz(:,:,1) = pW(:,:,1) * pt(:,:,1,jn,Kmm) 389 385 ENDIF 390 386 ENDIF … … 393 389 DO jj = 2, jpjm1 394 390 DO ji = fs_2, fs_jpim1 ! vector opt. 395 pt a(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - ( zwz(ji,jj,jk) - zwz(ji,jj,jk+1) ) &396 & * r1_e1e2t(ji,jj) / e3t _n(ji,jj,jk)391 pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( zwz(ji,jj,jk) - zwz(ji,jj,jk+1) ) & 392 & * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 397 393 END DO 398 394 END DO 399 395 END DO 400 396 ! ! Send trends for diagnostic 401 IF( l_trd ) CALL trd_tra( kt, cdtype, jn, jptra_zad, zwz, pwn, ptn(:,:,:,jn) )397 IF( l_trd ) CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, zwz, pW, pt(:,:,:,jn,Kmm) ) 402 398 ! 403 399 END DO
Note: See TracChangeset
for help on using the changeset viewer.