Changeset 10802 for NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/traadv_mus.F90
- Timestamp:
- 2019-03-26T09:50:57+01: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_mus.F90
r10425 r10802 54 54 CONTAINS 55 55 56 SUBROUTINE tra_adv_mus( kt, kit000, cdtype, p2dt, pun, pvn, pwn, &57 & ptb, pta, kjpt, ld_msc_ups )56 SUBROUTINE tra_adv_mus( kt, kit000, ktlev, cdtype, p2dt, pu, pv, pwn, & 57 & pt, pt_rhs, kjpt, ld_msc_ups ) 58 58 !!---------------------------------------------------------------------- 59 59 !! *** ROUTINE tra_adv_mus *** … … 66 66 !! ld_msc_ups=T : 67 67 !! 68 !! ** Action : - update pt awith the now advective tracer trends68 !! ** Action : - update pt_rhs with the now advective tracer trends 69 69 !! - send trends to trdtra module for further diagnostcs (l_trdtra=T) 70 70 !! - htr_adv, str_adv : poleward advective heat and salt transport (ln_diaptr=T) … … 75 75 INTEGER , INTENT(in ) :: kt ! ocean time-step index 76 76 INTEGER , INTENT(in ) :: kit000 ! first time step index 77 INTEGER , INTENT(in ) :: ktlev ! time level index for source terms 77 78 CHARACTER(len=3) , INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 78 79 INTEGER , INTENT(in ) :: kjpt ! number of tracers 79 80 LOGICAL , INTENT(in ) :: ld_msc_ups ! use upstream scheme within muscl 80 81 REAL(wp) , INTENT(in ) :: p2dt ! tracer time-step 81 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pu n, pvn, pwn ! 3 ocean velocity components82 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pt b! before tracer field83 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pt a! tracer trend82 REAL(wp), DIMENSION(jpi,jpj,jpk ), INTENT(in ) :: pu, pv, pwn ! 3 ocean velocity components 83 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pt ! before tracer field 84 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pt_rhs ! tracer trend 84 85 ! 85 86 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 134 135 DO jj = 1, jpjm1 135 136 DO ji = 1, fs_jpim1 ! vector opt. 136 zwx(ji,jj,jk) = umask(ji,jj,jk) * ( pt b(ji+1,jj,jk,jn) - ptb(ji,jj,jk,jn) )137 zwy(ji,jj,jk) = vmask(ji,jj,jk) * ( pt b(ji,jj+1,jk,jn) - ptb(ji,jj,jk,jn) )137 zwx(ji,jj,jk) = umask(ji,jj,jk) * ( pt(ji+1,jj,jk,jn) - pt(ji,jj,jk,jn) ) 138 zwy(ji,jj,jk) = vmask(ji,jj,jk) * ( pt(ji,jj+1,jk,jn) - pt(ji,jj,jk,jn) ) 138 139 END DO 139 140 END DO … … 172 173 DO ji = fs_2, fs_jpim1 ! vector opt. 173 174 ! MUSCL fluxes 174 z0u = SIGN( 0.5, pu n(ji,jj,jk) )175 z0u = SIGN( 0.5, pu(ji,jj,jk) ) 175 176 zalpha = 0.5 - z0u 176 zu = z0u - 0.5 * pu n(ji,jj,jk) * p2dt * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk)177 zzwx = pt b(ji+1,jj,jk,jn) + xind(ji,jj,jk) * zu * zslpx(ji+1,jj,jk)178 zzwy = pt b(ji ,jj,jk,jn) + xind(ji,jj,jk) * zu * zslpx(ji ,jj,jk)179 zwx(ji,jj,jk) = pu n(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy )177 zu = z0u - 0.5 * pu(ji,jj,jk) * p2dt * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,ktlev) 178 zzwx = pt(ji+1,jj,jk,jn) + xind(ji,jj,jk) * zu * zslpx(ji+1,jj,jk) 179 zzwy = pt(ji ,jj,jk,jn) + xind(ji,jj,jk) * zu * zslpx(ji ,jj,jk) 180 zwx(ji,jj,jk) = pu(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) 180 181 ! 181 z0v = SIGN( 0.5, pv n(ji,jj,jk) )182 z0v = SIGN( 0.5, pv(ji,jj,jk) ) 182 183 zalpha = 0.5 - z0v 183 zv = z0v - 0.5 * pv n(ji,jj,jk) * p2dt * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk)184 zzwx = pt b(ji,jj+1,jk,jn) + xind(ji,jj,jk) * zv * zslpy(ji,jj+1,jk)185 zzwy = pt b(ji,jj ,jk,jn) + xind(ji,jj,jk) * zv * zslpy(ji,jj ,jk)186 zwy(ji,jj,jk) = pv n(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy )184 zv = z0v - 0.5 * pv(ji,jj,jk) * p2dt * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,ktlev) 185 zzwx = pt(ji,jj+1,jk,jn) + xind(ji,jj,jk) * zv * zslpy(ji,jj+1,jk) 186 zzwy = pt(ji,jj ,jk,jn) + xind(ji,jj,jk) * zv * zslpy(ji,jj ,jk) 187 zwy(ji,jj,jk) = pv(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) 187 188 END DO 188 189 END DO … … 193 194 DO jj = 2, jpjm1 194 195 DO ji = fs_2, fs_jpim1 ! vector opt. 195 pt a(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) &196 pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) - ( zwx(ji,jj,jk) - zwx(ji-1,jj ,jk ) & 196 197 & + zwy(ji,jj,jk) - zwy(ji ,jj-1,jk ) ) & 197 & * r1_e1e2t(ji,jj) / e3t _n(ji,jj,jk)198 & * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,ktlev) 198 199 END DO 199 200 END DO … … 201 202 ! ! trend diagnostics 202 203 IF( l_trd ) THEN 203 CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pu n, ptb(:,:,:,jn) )204 CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pv n, ptb(:,:,:,jn) )204 CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pu, pt(:,:,:,jn) ) 205 CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pv, pt(:,:,:,jn) ) 205 206 END IF 206 207 ! ! "Poleward" heat and salt transports … … 215 216 zwx(:,:,jpk) = 0._wp 216 217 DO jk = 2, jpkm1 ! interior values 217 zwx(:,:,jk) = tmask(:,:,jk) * ( pt b(:,:,jk-1,jn) - ptb(:,:,jk,jn) )218 zwx(:,:,jk) = tmask(:,:,jk) * ( pt(:,:,jk-1,jn) - pt(:,:,jk,jn) ) 218 219 END DO 219 220 ! !-- Slopes of tracer … … 242 243 zalpha = 0.5 + z0w 243 244 zw = z0w - 0.5 * pwn(ji,jj,jk+1) * p2dt * r1_e1e2t(ji,jj) / e3w_n(ji,jj,jk+1) 244 zzwx = pt b(ji,jj,jk+1,jn) + xind(ji,jj,jk) * zw * zslpx(ji,jj,jk+1)245 zzwy = pt b(ji,jj,jk ,jn) + xind(ji,jj,jk) * zw * zslpx(ji,jj,jk )245 zzwx = pt(ji,jj,jk+1,jn) + xind(ji,jj,jk) * zw * zslpx(ji,jj,jk+1) 246 zzwy = pt(ji,jj,jk ,jn) + xind(ji,jj,jk) * zw * zslpx(ji,jj,jk ) 246 247 zwx(ji,jj,jk+1) = pwn(ji,jj,jk+1) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) * wmask(ji,jj,jk) 247 248 END DO … … 252 253 DO jj = 1, jpj 253 254 DO ji = 1, jpi 254 zwx(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * pt b(ji,jj,mikt(ji,jj),jn)255 zwx(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn) 255 256 END DO 256 257 END DO 257 258 ELSE ! no cavities: only at the ocean surface 258 zwx(:,:,1) = pwn(:,:,1) * pt b(:,:,1,jn)259 zwx(:,:,1) = pwn(:,:,1) * pt(:,:,1,jn) 259 260 ENDIF 260 261 ENDIF … … 263 264 DO jj = 2, jpjm1 264 265 DO ji = fs_2, fs_jpim1 ! vector opt. 265 pt a(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk)266 pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) - ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,ktlev) 266 267 END DO 267 268 END DO 268 269 END DO 269 270 ! ! send trends for diagnostic 270 IF( l_trd ) CALL trd_tra( kt, cdtype, jn, jptra_zad, zwx, pwn, pt b(:,:,:,jn) )271 IF( l_trd ) CALL trd_tra( kt, cdtype, jn, jptra_zad, zwx, pwn, pt(:,:,:,jn) ) 271 272 ! 272 273 END DO ! end of tracer loop
Note: See TracChangeset
for help on using the changeset viewer.