- 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_ubs.F90 (modified) (18 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_ubs.F90
r10425 r11949 46 46 CONTAINS 47 47 48 SUBROUTINE tra_adv_ubs( kt, kit000, cdtype, p2dt, p un, pvn, pwn, &49 & ptb, ptn, pta, kjpt, kn_ubs_v )48 SUBROUTINE tra_adv_ubs( kt, kit000, cdtype, p2dt, pU, pV, pW, & 49 & Kbb, Kmm, pt, kjpt, Krhs, kn_ubs_v ) 50 50 !!---------------------------------------------------------------------- 51 51 !! *** ROUTINE tra_adv_ubs *** … … 77 77 !! scheme (kn_ubs_v=4). 78 78 !! 79 !! ** Action : - update pt awith the now advective tracer trends79 !! ** Action : - update pt(:,:,:,:,Krhs) with the now advective tracer trends 80 80 !! - send trends to trdtra module for further diagnostcs (l_trdtra=T) 81 81 !! - htr_adv, str_adv : poleward advective heat and salt transport (ln_diaptr=T) … … 84 84 !! Farrow, D.E., Stevens, D.P., 1995, J. Phys. Ocean. 25, 1731Ð1741. 85 85 !!---------------------------------------------------------------------- 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 INTEGER , INTENT(in ) :: kn_ubs_v! number of tracers91 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step92 REAL(wp) , DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pun, pvn, pwn ! 3 ocean transport components93 REAL(wp), DIMENSION(jpi,jpj,jpk ,kjpt), INTENT(in ) :: ptb, ptn ! before and now tracer fields94 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt ), INTENT(inout) :: pta ! tracer trend86 INTEGER , INTENT(in ) :: kt ! ocean time-step index 87 INTEGER , INTENT(in ) :: Kbb, Kmm, Krhs ! ocean time level indices 88 INTEGER , INTENT(in ) :: kit000 ! first time step index 89 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 90 INTEGER , INTENT(in ) :: kjpt ! number of tracers 91 INTEGER , INTENT(in ) :: kn_ubs_v ! number of tracers 92 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 93 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pU, pV, pW ! 3 ocean volume transport components 94 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt,jpt), INTENT(inout) :: pt ! tracers and RHS of tracer equation 95 95 ! 96 96 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 126 126 DO jj = 1, jpjm1 ! First derivative (masked gradient) 127 127 DO ji = 1, fs_jpim1 ! vector opt. 128 zeeu = e2_e1u(ji,jj) * e3u _n(ji,jj,jk) * umask(ji,jj,jk)129 zeev = e1_e2v(ji,jj) * e3v _n(ji,jj,jk) * vmask(ji,jj,jk)130 ztu(ji,jj,jk) = zeeu * ( pt b(ji+1,jj ,jk,jn) - ptb(ji,jj,jk,jn) )131 ztv(ji,jj,jk) = zeev * ( pt b(ji ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) )128 zeeu = e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm) * umask(ji,jj,jk) 129 zeev = e1_e2v(ji,jj) * e3v(ji,jj,jk,Kmm) * vmask(ji,jj,jk) 130 ztu(ji,jj,jk) = zeeu * ( pt(ji+1,jj ,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) ) 131 ztv(ji,jj,jk) = zeev * ( pt(ji ,jj+1,jk,jn,Kbb) - pt(ji,jj,jk,jn,Kbb) ) 132 132 END DO 133 133 END DO 134 134 DO jj = 2, jpjm1 ! Second derivative (divergence) 135 135 DO ji = fs_2, fs_jpim1 ! vector opt. 136 zcoef = 1._wp / ( 6._wp * e3t _n(ji,jj,jk) )136 zcoef = 1._wp / ( 6._wp * e3t(ji,jj,jk,Kmm) ) 137 137 zltu(ji,jj,jk) = ( ztu(ji,jj,jk) - ztu(ji-1,jj,jk) ) * zcoef 138 138 zltv(ji,jj,jk) = ( ztv(ji,jj,jk) - ztv(ji,jj-1,jk) ) * zcoef … … 146 146 DO jj = 1, jpjm1 147 147 DO ji = 1, fs_jpim1 ! vector opt. 148 zfp_ui = p un(ji,jj,jk) + ABS( pun(ji,jj,jk) ) ! upstream transport (x2)149 zfm_ui = p un(ji,jj,jk) - ABS( pun(ji,jj,jk) )150 zfp_vj = p vn(ji,jj,jk) + ABS( pvn(ji,jj,jk) )151 zfm_vj = p vn(ji,jj,jk) - ABS( pvn(ji,jj,jk) )148 zfp_ui = pU(ji,jj,jk) + ABS( pU(ji,jj,jk) ) ! upstream transport (x2) 149 zfm_ui = pU(ji,jj,jk) - ABS( pU(ji,jj,jk) ) 150 zfp_vj = pV(ji,jj,jk) + ABS( pV(ji,jj,jk) ) 151 zfm_vj = pV(ji,jj,jk) - ABS( pV(ji,jj,jk) ) 152 152 ! ! 2nd order centered advective fluxes (x2) 153 zcenut = p un(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj ,jk,jn) )154 zcenvt = p vn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji ,jj+1,jk,jn) )153 zcenut = pU(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji+1,jj ,jk,jn,Kmm) ) 154 zcenvt = pV(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji ,jj+1,jk,jn,Kmm) ) 155 155 ! ! UBS advective fluxes 156 156 ztu(ji,jj,jk) = 0.5 * ( zcenut - zfp_ui * zltu(ji,jj,jk) - zfm_ui * zltu(ji+1,jj,jk) ) … … 160 160 END DO 161 161 ! 162 zltu(:,:,:) = pt a(:,:,:,jn) ! store the initial trends before its update162 zltu(:,:,:) = pt(:,:,:,jn,Krhs) ! store the initial trends before its update 163 163 ! 164 164 DO jk = 1, jpkm1 !== add the horizontal advective trend ==! 165 165 DO jj = 2, jpjm1 166 166 DO ji = fs_2, fs_jpim1 ! vector opt. 167 pt a(ji,jj,jk,jn) = pta(ji,jj,jk,jn) &167 pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) & 168 168 & - ( ztu(ji,jj,jk) - ztu(ji-1,jj ,jk) & 169 & + ztv(ji,jj,jk) - ztv(ji ,jj-1,jk) ) * r1_e1e2t(ji,jj) / e3t _n(ji,jj,jk)169 & + ztv(ji,jj,jk) - ztv(ji ,jj-1,jk) ) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 170 170 END DO 171 171 END DO … … 173 173 END DO 174 174 ! 175 zltu(:,:,:) = pt a(:,:,:,jn) - zltu(:,:,:) ! Horizontal advective trend used in vertical 2nd order FCT case175 zltu(:,:,:) = pt(:,:,:,jn,Krhs) - zltu(:,:,:) ! Horizontal advective trend used in vertical 2nd order FCT case 176 176 ! ! and/or in trend diagnostic (l_trd=T) 177 177 ! 178 178 IF( l_trd ) THEN ! trend diagnostics 179 CALL trd_tra( kt, cdtype, jn, jptra_xad, ztu, pun, ptn(:,:,:,jn) )180 CALL trd_tra( kt, cdtype, jn, jptra_yad, ztv, pvn, ptn(:,:,:,jn) )179 CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_xad, ztu, pU, pt(:,:,:,jn,Kmm) ) 180 CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_yad, ztv, pV, pt(:,:,:,jn,Kmm) ) 181 181 END IF 182 182 ! … … 193 193 CASE( 2 ) ! 2nd order FCT 194 194 ! 195 IF( l_trd ) zltv(:,:,:) = pt a(:,:,:,jn) ! store ptaif trend diag.195 IF( l_trd ) zltv(:,:,:) = pt(:,:,:,jn,Krhs) ! store pt(:,:,:,:,Krhs) if trend diag. 196 196 ! 197 197 ! !* upstream advection with initial mass fluxes & intermediate update ==! … … 199 199 DO jj = 1, jpj 200 200 DO ji = 1, jpi 201 zfp_wk = p wn(ji,jj,jk) + ABS( pwn(ji,jj,jk) )202 zfm_wk = p wn(ji,jj,jk) - ABS( pwn(ji,jj,jk) )203 ztw(ji,jj,jk) = 0.5_wp * ( zfp_wk * pt b(ji,jj,jk,jn) + zfm_wk * ptb(ji,jj,jk-1,jn) ) * wmask(ji,jj,jk)201 zfp_wk = pW(ji,jj,jk) + ABS( pW(ji,jj,jk) ) 202 zfm_wk = pW(ji,jj,jk) - ABS( pW(ji,jj,jk) ) 203 ztw(ji,jj,jk) = 0.5_wp * ( zfp_wk * pt(ji,jj,jk,jn,Kbb) + zfm_wk * pt(ji,jj,jk-1,jn,Kbb) ) * wmask(ji,jj,jk) 204 204 END DO 205 205 END DO … … 209 209 DO jj = 1, jpj 210 210 DO ji = 1, jpi 211 ztw(ji,jj, mikt(ji,jj) ) = p wn(ji,jj,mikt(ji,jj)) * ptb(ji,jj,mikt(ji,jj),jn) ! linear free surface211 ztw(ji,jj, mikt(ji,jj) ) = pW(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn,Kbb) ! linear free surface 212 212 END DO 213 213 END DO 214 214 ELSE ! no cavities: only at the ocean surface 215 ztw(:,:,1) = p wn(:,:,1) * ptb(:,:,1,jn)215 ztw(:,:,1) = pW(:,:,1) * pt(:,:,1,jn,Kbb) 216 216 ENDIF 217 217 ENDIF … … 220 220 DO jj = 2, jpjm1 221 221 DO ji = fs_2, fs_jpim1 ! vector opt. 222 ztak = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) / e3t _n(ji,jj,jk)223 pt a(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztak224 zti(ji,jj,jk) = ( pt b(ji,jj,jk,jn) + p2dt * ( ztak + zltu(ji,jj,jk) ) ) * tmask(ji,jj,jk)222 ztak = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 223 pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) + ztak 224 zti(ji,jj,jk) = ( pt(ji,jj,jk,jn,Kbb) + p2dt * ( ztak + zltu(ji,jj,jk) ) ) * tmask(ji,jj,jk) 225 225 END DO 226 226 END DO … … 232 232 DO jj = 1, jpj 233 233 DO ji = 1, jpi 234 ztw(ji,jj,jk) = ( 0.5_wp * p wn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj,jk-1,jn) ) &234 ztw(ji,jj,jk) = ( 0.5_wp * pW(ji,jj,jk) * ( pt(ji,jj,jk,jn,Kmm) + pt(ji,jj,jk-1,jn,Kmm) ) & 235 235 & - ztw(ji,jj,jk) ) * wmask(ji,jj,jk) 236 236 END DO … … 240 240 IF( ln_linssh ) ztw(:,:, 1 ) = 0._wp ! only ocean surface as interior zwz values have been w-masked 241 241 ! 242 CALL nonosc_z( ptb(:,:,:,jn), ztw, zti, p2dt ) ! monotonicity algorithm242 CALL nonosc_z( Kmm, pt(:,:,:,jn,Kbb), ztw, zti, p2dt ) ! monotonicity algorithm 243 243 ! 244 244 CASE( 4 ) ! 4th order COMPACT 245 CALL interp_4th_cpt( pt n(:,:,:,jn) , ztw ) ! 4th order compact interpolation of T at w-point245 CALL interp_4th_cpt( pt(:,:,:,jn,Kmm) , ztw ) ! 4th order compact interpolation of T at w-point 246 246 DO jk = 2, jpkm1 247 247 DO jj = 2, jpjm1 248 248 DO ji = fs_2, fs_jpim1 249 ztw(ji,jj,jk) = p wn(ji,jj,jk) * ztw(ji,jj,jk) * wmask(ji,jj,jk)250 END DO 251 END DO 252 END DO 253 IF( ln_linssh ) ztw(:,:, 1 ) = p wn(:,:,1) * ptn(:,:,1,jn) !!gm ISF & 4th COMPACT doesn't work249 ztw(ji,jj,jk) = pW(ji,jj,jk) * ztw(ji,jj,jk) * wmask(ji,jj,jk) 250 END DO 251 END DO 252 END DO 253 IF( ln_linssh ) ztw(:,:, 1 ) = pW(:,:,1) * pt(:,:,1,jn,Kmm) !!gm ISF & 4th COMPACT doesn't work 254 254 ! 255 255 END SELECT … … 258 258 DO jj = 2, jpjm1 259 259 DO ji = fs_2, fs_jpim1 ! vector opt. 260 pt a(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)260 pt(ji,jj,jk,jn,Krhs) = pt(ji,jj,jk,jn,Krhs) - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 261 261 END DO 262 262 END DO … … 267 267 DO jj = 2, jpjm1 268 268 DO ji = fs_2, fs_jpim1 ! vector opt. 269 zltv(ji,jj,jk) = pt a(ji,jj,jk,jn) - zltv(ji,jj,jk) &270 & + pt n(ji,jj,jk,jn) * ( pwn(ji,jj,jk) - pwn(ji,jj,jk+1) ) &271 & * r1_e1e2t(ji,jj) / e3t _n(ji,jj,jk)272 END DO 273 END DO 274 END DO 275 CALL trd_tra( kt, cdtype, jn, jptra_zad, zltv )269 zltv(ji,jj,jk) = pt(ji,jj,jk,jn,Krhs) - zltv(ji,jj,jk) & 270 & + pt(ji,jj,jk,jn,Kmm) * ( pW(ji,jj,jk) - pW(ji,jj,jk+1) ) & 271 & * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 272 END DO 273 END DO 274 END DO 275 CALL trd_tra( kt, Kmm, Krhs, cdtype, jn, jptra_zad, zltv ) 276 276 ENDIF 277 277 ! … … 281 281 282 282 283 SUBROUTINE nonosc_z( pbef, pcc, paft, p2dt )283 SUBROUTINE nonosc_z( Kmm, pbef, pcc, paft, p2dt ) 284 284 !!--------------------------------------------------------------------- 285 285 !! *** ROUTINE nonosc_z *** … … 294 294 !! in-space based differencing for fluid 295 295 !!---------------------------------------------------------------------- 296 INTEGER , INTENT(in ) :: Kmm ! time level index 296 297 REAL(wp), INTENT(in ) :: p2dt ! tracer time-step 297 298 REAL(wp), DIMENSION (jpi,jpj,jpk) :: pbef ! before field … … 352 353 zneg = MAX( 0., pcc(ji ,jj ,jk ) ) - MIN( 0., pcc(ji ,jj ,jk+1) ) 353 354 ! up & down beta terms 354 zbt = e1e2t(ji,jj) * e3t _n(ji,jj,jk) / p2dt355 zbt = e1e2t(ji,jj) * e3t(ji,jj,jk,Kmm) / p2dt 355 356 zbetup(ji,jj,jk) = ( zbetup(ji,jj,jk) - paft(ji,jj,jk) ) / (zpos+zrtrn) * zbt 356 357 zbetdo(ji,jj,jk) = ( paft(ji,jj,jk) - zbetdo(ji,jj,jk) ) / (zneg+zrtrn) * zbt
Note: See TracChangeset
for help on using the changeset viewer.
