Changeset 10880 for NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/traadv_fct.F90
- Timestamp:
- 2019-04-17T12:02:14+02:00 (5 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/traadv_fct.F90
r10874 r10880 52 52 CONTAINS 53 53 54 SUBROUTINE tra_adv_fct( kt, kit000, cdtype, p2dt, pu n, pvn, pwn, &55 & ptb, ptn, pta, kjpt, kn_fct_h, kn_fct_v )54 SUBROUTINE tra_adv_fct( kt, kit000, cdtype, p2dt, pu_mm, pv_mm, pww, & 55 & Kbb, Kmm, pt, kjpt, Krhs, kn_fct_h, kn_fct_v ) 56 56 !!---------------------------------------------------------------------- 57 57 !! *** ROUTINE tra_adv_fct *** … … 65 65 !! - corrected flux (monotonic correction) 66 66 !! 67 !! ** Action : - update pt awith the now advective tracer trends67 !! ** Action : - update pt(:,:,:,:,Krhs) with the now advective tracer trends 68 68 !! - send trends to trdtra module for further diagnostics (l_trdtra=T) 69 69 !! - htr_adv, str_adv : poleward advective heat and salt transport (ln_diaptr=T) 70 70 !!---------------------------------------------------------------------- 71 INTEGER , INTENT(in ) :: kt ! ocean time-step index72 INTEGER , INTENT(in ) :: kit000 ! first time step index73 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator)74 INTEGER , INTENT(in ) :: kjpt ! number of tracers75 INTEGER , INTENT(in ) :: kn_fct_h ! order of the FCT scheme (=2 or 4)76 INTEGER , INTENT(in ) :: kn_fct_v! order of the FCT scheme (=2 or 4)77 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step78 REAL(wp) , DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pun, pvn, pwn ! 3 ocean velocity components79 REAL(wp), DIMENSION(jpi,jpj,jpk ,kjpt), INTENT(in ) :: ptb, ptn ! before and now tracer fields80 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt ), INTENT(inout) :: pta ! tracer trend71 INTEGER , INTENT(in ) :: kt ! ocean time-step index 72 INTEGER , INTENT(in ) :: Kbb, Kmm, Krhs ! ocean time level indices 73 INTEGER , INTENT(in ) :: kit000 ! first time step index 74 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 75 INTEGER , INTENT(in ) :: kjpt ! number of tracers 76 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-step 79 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pu_mm, pv_mm, pww ! 3 ocean velocity components 80 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! active tracers and RHS of tracer equation 81 81 ! 82 82 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 125 125 DO ji = 1, fs_jpim1 ! vector opt. 126 126 ! upstream scheme 127 zfp_ui = pu n(ji,jj,jk) + ABS( pun(ji,jj,jk) )128 zfm_ui = pu n(ji,jj,jk) - ABS( pun(ji,jj,jk) )129 zfp_vj = pv n(ji,jj,jk) + ABS( pvn(ji,jj,jk) )130 zfm_vj = pv n(ji,jj,jk) - ABS( pvn(ji,jj,jk) )131 zwx(ji,jj,jk) = 0.5 * ( zfp_ui * pt b(ji,jj,jk,jn) + zfm_ui * ptb(ji+1,jj ,jk,jn) )132 zwy(ji,jj,jk) = 0.5 * ( zfp_vj * pt b(ji,jj,jk,jn) + zfm_vj * ptb(ji ,jj+1,jk,jn) )127 zfp_ui = pu_mm(ji,jj,jk) + ABS( pu_mm(ji,jj,jk) ) 128 zfm_ui = pu_mm(ji,jj,jk) - ABS( pu_mm(ji,jj,jk) ) 129 zfp_vj = pv_mm(ji,jj,jk) + ABS( pv_mm(ji,jj,jk) ) 130 zfm_vj = pv_mm(ji,jj,jk) - ABS( pv_mm(ji,jj,jk) ) 131 zwx(ji,jj,jk) = 0.5 * ( zfp_ui * pt(ji,jj,jk,jn,Kbb) + zfm_ui * pt(ji+1,jj ,jk,jn,Kbb) ) 132 zwy(ji,jj,jk) = 0.5 * ( zfp_vj * pt(ji,jj,jk,jn,Kbb) + zfm_vj * pt(ji ,jj+1,jk,jn,Kbb) ) 133 133 END DO 134 134 END DO … … 138 138 DO jj = 1, jpj 139 139 DO ji = 1, jpi 140 zfp_wk = pw n(ji,jj,jk) + ABS( pwn(ji,jj,jk) )141 zfm_wk = pw n(ji,jj,jk) - ABS( pwn(ji,jj,jk) )142 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)140 zfp_wk = pww(ji,jj,jk) + ABS( pww(ji,jj,jk) ) 141 zfm_wk = pww(ji,jj,jk) - ABS( pww(ji,jj,jk) ) 142 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) 143 143 END DO 144 144 END DO … … 148 148 DO jj = 1, jpj 149 149 DO ji = 1, jpi 150 zwz(ji,jj, mikt(ji,jj) ) = pw n(ji,jj,mikt(ji,jj)) * ptb(ji,jj,mikt(ji,jj),jn) ! linear free surface150 zwz(ji,jj, mikt(ji,jj) ) = pww(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kbb) ! linear free surface 151 151 END DO 152 152 END DO 153 153 ELSE ! no cavities: only at the ocean surface 154 zwz(:,:,1) = pw n(:,:,1) * ptb(:,:,1,jn)154 zwz(:,:,1) = pww(:,:,1) * pt(:,:,1,jn,Kbb) 155 155 ENDIF 156 156 ENDIF … … 164 164 & + zwz(ji,jj,jk) - zwz(ji ,jj ,jk+1) ) * r1_e1e2t(ji,jj) 165 165 ! ! update and guess with monotonic sheme 166 pt a(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra / e3t_n(ji,jj,jk) * tmask(ji,jj,jk)167 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)166 pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) + ztra / e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) 167 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) 168 168 END DO 169 169 END DO … … 184 184 DO jj = 1, jpjm1 185 185 DO ji = 1, fs_jpim1 ! vector opt. 186 zwx(ji,jj,jk) = 0.5_wp * pu n(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj,jk,jn) ) - zwx(ji,jj,jk)187 zwy(ji,jj,jk) = 0.5_wp * pv n(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj+1,jk,jn) ) - zwy(ji,jj,jk)186 zwx(ji,jj,jk) = 0.5_wp * pu_mm(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj,jk,jn,Kmm) ) - zwx(ji,jj,jk) 187 zwy(ji,jj,jk) = 0.5_wp * pv_mm(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji,jj+1,jk,jn,Kmm) ) - zwy(ji,jj,jk) 188 188 END DO 189 189 END DO … … 196 196 DO jj = 1, jpjm1 ! 1st derivative (gradient) 197 197 DO ji = 1, fs_jpim1 ! vector opt. 198 ztu(ji,jj,jk) = ( pt n(ji+1,jj ,jk,jn) - ptn(ji,jj,jk,jn) ) * umask(ji,jj,jk)199 ztv(ji,jj,jk) = ( pt n(ji ,jj+1,jk,jn) - ptn(ji,jj,jk,jn) ) * vmask(ji,jj,jk)198 ztu(ji,jj,jk) = ( pt(ji+1,jj ,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * umask(ji,jj,jk) 199 ztv(ji,jj,jk) = ( pt(ji ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk) 200 200 END DO 201 201 END DO … … 212 212 DO jj = 1, jpjm1 213 213 DO ji = 1, fs_jpim1 ! vector opt. 214 zC2t_u = pt n(ji,jj,jk,jn) + ptn(ji+1,jj ,jk,jn) ! 2 x C2 interpolation of T at u- & v-points215 zC2t_v = pt n(ji,jj,jk,jn) + ptn(ji ,jj+1,jk,jn)214 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 215 zC2t_v = pt(ji,jj,jk,jn,Kmm) + pt(ji ,jj+1,jk,jn,Kmm) 216 216 ! ! C4 minus upstream advective fluxes 217 zwx(ji,jj,jk) = 0.5_wp * pu n(ji,jj,jk) * ( zC2t_u + zltu(ji,jj,jk) - zltu(ji+1,jj,jk) ) - zwx(ji,jj,jk)218 zwy(ji,jj,jk) = 0.5_wp * pv n(ji,jj,jk) * ( zC2t_v + zltv(ji,jj,jk) - zltv(ji,jj+1,jk) ) - zwy(ji,jj,jk)217 zwx(ji,jj,jk) = 0.5_wp * pu_mm(ji,jj,jk) * ( zC2t_u + zltu(ji,jj,jk) - zltu(ji+1,jj,jk) ) - zwx(ji,jj,jk) 218 zwy(ji,jj,jk) = 0.5_wp * pv_mm(ji,jj,jk) * ( zC2t_v + zltv(ji,jj,jk) - zltv(ji,jj+1,jk) ) - zwy(ji,jj,jk) 219 219 END DO 220 220 END DO … … 227 227 DO jj = 1, jpjm1 228 228 DO ji = 1, fs_jpim1 ! vector opt. 229 ztu(ji,jj,jk) = ( pt n(ji+1,jj ,jk,jn) - ptn(ji,jj,jk,jn) ) * umask(ji,jj,jk)230 ztv(ji,jj,jk) = ( pt n(ji ,jj+1,jk,jn) - ptn(ji,jj,jk,jn) ) * vmask(ji,jj,jk)229 ztu(ji,jj,jk) = ( pt(ji+1,jj ,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * umask(ji,jj,jk) 230 ztv(ji,jj,jk) = ( pt(ji ,jj+1,jk,jn,Kmm) - pt(ji,jj,jk,jn,Kmm) ) * vmask(ji,jj,jk) 231 231 END DO 232 232 END DO … … 237 237 DO jj = 2, jpjm1 238 238 DO ji = 2, fs_jpim1 ! vector opt. 239 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)240 zC2t_v = pt n(ji,jj,jk,jn) + ptn(ji ,jj+1,jk,jn)239 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) 240 zC2t_v = pt(ji,jj,jk,jn,Kmm) + pt(ji ,jj+1,jk,jn,Kmm) 241 241 ! ! C4 interpolation of T at u- & v-points (x2) 242 242 zC4t_u = zC2t_u + r1_6 * ( ztu(ji-1,jj ,jk) - ztu(ji+1,jj ,jk) ) 243 243 zC4t_v = zC2t_v + r1_6 * ( ztv(ji ,jj-1,jk) - ztv(ji ,jj+1,jk) ) 244 244 ! ! C4 minus upstream advective fluxes 245 zwx(ji,jj,jk) = 0.5_wp * pu n(ji,jj,jk) * zC4t_u - zwx(ji,jj,jk)246 zwy(ji,jj,jk) = 0.5_wp * pv n(ji,jj,jk) * zC4t_v - zwy(ji,jj,jk)245 zwx(ji,jj,jk) = 0.5_wp * pu_mm(ji,jj,jk) * zC4t_u - zwx(ji,jj,jk) 246 zwy(ji,jj,jk) = 0.5_wp * pv_mm(ji,jj,jk) * zC4t_v - zwy(ji,jj,jk) 247 247 END DO 248 248 END DO … … 257 257 DO jj = 2, jpjm1 258 258 DO ji = fs_2, fs_jpim1 259 zwz(ji,jj,jk) = ( pw n(ji,jj,jk) * 0.5_wp * ( ptn(ji,jj,jk,jn) + ptn(ji,jj,jk-1,jn) ) &259 zwz(ji,jj,jk) = ( pww(ji,jj,jk) * 0.5_wp * ( pt(ji,jj,jk,jn,Kmm) + pt(ji,jj,jk-1,jn,Kmm) ) & 260 260 & - zwz(ji,jj,jk) ) * wmask(ji,jj,jk) 261 261 END DO … … 264 264 ! 265 265 CASE( 4 ) !- 4th order COMPACT 266 CALL interp_4th_cpt( pt n(:,:,:,jn) , ztw ) ! zwt = COMPACT interpolation of T at w-point266 CALL interp_4th_cpt( pt(:,:,:,jn,Kmm) , ztw ) ! zwt = COMPACT interpolation of T at w-point 267 267 DO jk = 2, jpkm1 268 268 DO jj = 2, jpjm1 269 269 DO ji = fs_2, fs_jpim1 270 zwz(ji,jj,jk) = ( pw n(ji,jj,jk) * ztw(ji,jj,jk) - zwz(ji,jj,jk) ) * wmask(ji,jj,jk)270 zwz(ji,jj,jk) = ( pww(ji,jj,jk) * ztw(ji,jj,jk) - zwz(ji,jj,jk) ) * wmask(ji,jj,jk) 271 271 END DO 272 272 END DO … … 282 282 ! !== monotonicity algorithm ==! 283 283 ! 284 CALL nonosc( ptb(:,:,:,jn), zwx, zwy, zwz, zwi, p2dt )284 CALL nonosc( Kmm, pt(:,:,:,jn,Kbb), zwx, zwy, zwz, zwi, p2dt ) 285 285 ! 286 286 ! !== final trend with corrected fluxes ==! … … 289 289 DO jj = 2, jpjm1 290 290 DO ji = fs_2, fs_jpim1 ! vector opt. 291 pt a(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) &291 pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) & 292 292 & + zwy(ji,jj,jk) - zwy(ji ,jj-1,jk ) & 293 293 & + zwz(ji,jj,jk) - zwz(ji ,jj ,jk+1) ) & 294 & * r1_e1e2t(ji,jj) / e3t _n(ji,jj,jk)294 & * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 295 295 END DO 296 296 END DO … … 303 303 ! 304 304 IF( l_trd ) THEN ! trend diagnostics 305 CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pu n, ptn(:,:,:,jn) )306 CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pv n, ptn(:,:,:,jn) )307 CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pw n, ptn(:,:,:,jn) )305 CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pu_mm, pt(:,:,:,jn,Kmm) ) 306 CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pv_mm, pt(:,:,:,jn,Kmm) ) 307 CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pww, pt(:,:,:,jn,Kmm) ) 308 308 ENDIF 309 309 ! ! heat/salt transport … … 328 328 329 329 330 SUBROUTINE nonosc( pbef, paa, pbb, pcc, paft, p2dt )330 SUBROUTINE nonosc( Kmm, pbef, paa, pbb, pcc, paft, p2dt ) 331 331 !!--------------------------------------------------------------------- 332 332 !! *** ROUTINE nonosc *** … … 341 341 !! in-space based differencing for fluid 342 342 !!---------------------------------------------------------------------- 343 INTEGER , INTENT(in ) :: Kmm ! time level index 343 344 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 344 345 REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in ) :: pbef, paft ! before & after field … … 392 393 393 394 ! up & down beta terms 394 zbt = e1e2t(ji,jj) * e3t _n(ji,jj,jk) / p2dt395 zbt = e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) / p2dt 395 396 zbetup(ji,jj,jk) = ( zup - paft(ji,jj,jk) ) / ( zpos + zrtrn ) * zbt 396 397 zbetdo(ji,jj,jk) = ( paft(ji,jj,jk) - zdo ) / ( zneg + zrtrn ) * zbt
Note: See TracChangeset
for help on using the changeset viewer.