- 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/TRD/trdtra.F90 (modified) (16 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/TRD/trdtra.F90
r10425 r11949 60 60 61 61 62 SUBROUTINE trd_tra( kt, ctype, ktra, ktrd, ptrd, pun, ptra )62 SUBROUTINE trd_tra( kt, Kmm, Krhs, ctype, ktra, ktrd, ptrd, pu, ptra ) 63 63 !!--------------------------------------------------------------------- 64 64 !! *** ROUTINE trd_tra *** … … 77 77 INTEGER , INTENT(in) :: ktra ! tracer index 78 78 INTEGER , INTENT(in) :: ktrd ! tracer trend index 79 INTEGER , INTENT(in) :: Kmm, Krhs ! time level indices 79 80 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in) :: ptrd ! tracer trend or flux 80 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: pu n! now velocity81 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: pu ! now velocity 81 82 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in), OPTIONAL :: ptra ! now tracer variable 82 83 ! … … 94 95 SELECT CASE( ktrd ) 95 96 ! ! advection: transform the advective flux into a trend 96 CASE( jptra_xad ) ; CALL trd_tra_adv( ptrd, pu n, ptra, 'X', trdtx)97 CASE( jptra_yad ) ; CALL trd_tra_adv( ptrd, pu n, ptra, 'Y', trdty)98 CASE( jptra_zad ) ; CALL trd_tra_adv( ptrd, pu n, ptra, 'Z', trdt )97 CASE( jptra_xad ) ; CALL trd_tra_adv( ptrd, pu, ptra, 'X', trdtx, Kmm ) 98 CASE( jptra_yad ) ; CALL trd_tra_adv( ptrd, pu, ptra, 'Y', trdty, Kmm ) 99 CASE( jptra_zad ) ; CALL trd_tra_adv( ptrd, pu, ptra, 'Z', trdt, Kmm ) 99 100 CASE( jptra_bbc, & ! qsr, bbc: on temperature only, send to trd_tra_mng 100 101 & jptra_qsr ) ; trdt(:,:,:) = ptrd(:,:,:) * tmask(:,:,:) 101 102 ztrds(:,:,:) = 0._wp 102 CALL trd_tra_mng( trdt, ztrds, ktrd, kt )103 CALL trd_tra_mng( trdt, ztrds, ktrd, kt, Kmm ) 103 104 !!gm Gurvan, verify the jptra_evd trend please ! 104 105 CASE( jptra_evd ) ; avt_evd(:,:,:) = ptrd(:,:,:) * tmask(:,:,:) … … 114 115 ! ! advection: transform the advective flux into a trend 115 116 ! ! and send T & S trends to trd_tra_mng 116 CASE( jptra_xad ) ; CALL trd_tra_adv( ptrd , pu n , ptra, 'X' , ztrds)117 CALL trd_tra_mng( trdtx, ztrds, ktrd, kt )118 CASE( jptra_yad ) ; CALL trd_tra_adv( ptrd , pu n , ptra, 'Y' , ztrds)119 CALL trd_tra_mng( trdty, ztrds, ktrd, kt )120 CASE( jptra_zad ) ; CALL trd_tra_adv( ptrd , pu n , ptra, 'Z' , ztrds)121 CALL trd_tra_mng( trdt , ztrds, ktrd, kt )117 CASE( jptra_xad ) ; CALL trd_tra_adv( ptrd , pu , ptra, 'X' , ztrds, Kmm ) 118 CALL trd_tra_mng( trdtx, ztrds, ktrd, kt, Kmm ) 119 CASE( jptra_yad ) ; CALL trd_tra_adv( ptrd , pu , ptra, 'Y' , ztrds, Kmm ) 120 CALL trd_tra_mng( trdty, ztrds, ktrd, kt, Kmm ) 121 CASE( jptra_zad ) ; CALL trd_tra_adv( ptrd , pu , ptra, 'Z' , ztrds, Kmm ) 122 CALL trd_tra_mng( trdt , ztrds, ktrd, kt, Kmm ) 122 123 CASE( jptra_zdfp ) ! diagnose the "PURE" Kz trend (here: just before the swap) 123 124 ! ! iso-neutral diffusion case otherwise jptra_zdf is "PURE" … … 127 128 zwt(:,:,jpk) = 0._wp ; zws(:,:,jpk) = 0._wp 128 129 DO jk = 2, jpk 129 zwt(:,:,jk) = avt(:,:,jk) * ( ts a(:,:,jk-1,jp_tem) - tsa(:,:,jk,jp_tem) ) / e3w_n(:,:,jk) * tmask(:,:,jk)130 zws(:,:,jk) = avs(:,:,jk) * ( ts a(:,:,jk-1,jp_sal) - tsa(:,:,jk,jp_sal) ) / e3w_n(:,:,jk) * tmask(:,:,jk)130 zwt(:,:,jk) = avt(:,:,jk) * ( ts(:,:,jk-1,jp_tem,Krhs) - ts(:,:,jk,jp_tem,Krhs) ) / e3w(:,:,jk,Kmm) * tmask(:,:,jk) 131 zws(:,:,jk) = avs(:,:,jk) * ( ts(:,:,jk-1,jp_sal,Krhs) - ts(:,:,jk,jp_sal,Krhs) ) / e3w(:,:,jk,Kmm) * tmask(:,:,jk) 131 132 END DO 132 133 ! 133 134 ztrdt(:,:,jpk) = 0._wp ; ztrds(:,:,jpk) = 0._wp 134 135 DO jk = 1, jpkm1 135 ztrdt(:,:,jk) = ( zwt(:,:,jk) - zwt(:,:,jk+1) ) / e3t _n(:,:,jk)136 ztrds(:,:,jk) = ( zws(:,:,jk) - zws(:,:,jk+1) ) / e3t _n(:,:,jk)137 END DO 138 CALL trd_tra_mng( ztrdt, ztrds, jptra_zdfp, kt )136 ztrdt(:,:,jk) = ( zwt(:,:,jk) - zwt(:,:,jk+1) ) / e3t(:,:,jk,Kmm) 137 ztrds(:,:,jk) = ( zws(:,:,jk) - zws(:,:,jk+1) ) / e3t(:,:,jk,Kmm) 138 END DO 139 CALL trd_tra_mng( ztrdt, ztrds, jptra_zdfp, kt, Kmm ) 139 140 ! 140 141 ! ! Also calculate EVD trend at this point. 141 142 zwt(:,:,:) = 0._wp ; zws(:,:,:) = 0._wp ! vertical diffusive fluxes 142 143 DO jk = 2, jpk 143 zwt(:,:,jk) = avt_evd(:,:,jk) * ( ts a(:,:,jk-1,jp_tem) - tsa(:,:,jk,jp_tem) ) / e3w_n(:,:,jk) * tmask(:,:,jk)144 zws(:,:,jk) = avt_evd(:,:,jk) * ( ts a(:,:,jk-1,jp_sal) - tsa(:,:,jk,jp_sal) ) / e3w_n(:,:,jk) * tmask(:,:,jk)144 zwt(:,:,jk) = avt_evd(:,:,jk) * ( ts(:,:,jk-1,jp_tem,Krhs) - ts(:,:,jk,jp_tem,Krhs) ) / e3w(:,:,jk,Kmm) * tmask(:,:,jk) 145 zws(:,:,jk) = avt_evd(:,:,jk) * ( ts(:,:,jk-1,jp_sal,Krhs) - ts(:,:,jk,jp_sal,Krhs) ) / e3w(:,:,jk,Kmm) * tmask(:,:,jk) 145 146 END DO 146 147 ! 147 148 ztrdt(:,:,jpk) = 0._wp ; ztrds(:,:,jpk) = 0._wp 148 149 DO jk = 1, jpkm1 149 ztrdt(:,:,jk) = ( zwt(:,:,jk) - zwt(:,:,jk+1) ) / e3t _n(:,:,jk)150 ztrds(:,:,jk) = ( zws(:,:,jk) - zws(:,:,jk+1) ) / e3t _n(:,:,jk)151 END DO 152 CALL trd_tra_mng( ztrdt, ztrds, jptra_evd, kt )150 ztrdt(:,:,jk) = ( zwt(:,:,jk) - zwt(:,:,jk+1) ) / e3t(:,:,jk,Kmm) 151 ztrds(:,:,jk) = ( zws(:,:,jk) - zws(:,:,jk+1) ) / e3t(:,:,jk,Kmm) 152 END DO 153 CALL trd_tra_mng( ztrdt, ztrds, jptra_evd, kt, Kmm ) 153 154 ! 154 155 DEALLOCATE( zwt, zws, ztrdt ) … … 156 157 CASE DEFAULT ! other trends: mask and send T & S trends to trd_tra_mng 157 158 ztrds(:,:,:) = ptrd(:,:,:) * tmask(:,:,:) 158 CALL trd_tra_mng( trdt, ztrds, ktrd, kt )159 CALL trd_tra_mng( trdt, ztrds, ktrd, kt, Kmm ) 159 160 END SELECT 160 161 ENDIF … … 164 165 SELECT CASE( ktrd ) 165 166 ! ! advection: transform the advective flux into a masked trend 166 CASE( jptra_xad ) ; CALL trd_tra_adv( ptrd , pu n , ptra, 'X', ztrds)167 CASE( jptra_yad ) ; CALL trd_tra_adv( ptrd , pu n , ptra, 'Y', ztrds)168 CASE( jptra_zad ) ; CALL trd_tra_adv( ptrd , pu n , ptra, 'Z', ztrds)167 CASE( jptra_xad ) ; CALL trd_tra_adv( ptrd , pu , ptra, 'X', ztrds, Kmm ) 168 CASE( jptra_yad ) ; CALL trd_tra_adv( ptrd , pu , ptra, 'Y', ztrds, Kmm ) 169 CASE( jptra_zad ) ; CALL trd_tra_adv( ptrd , pu , ptra, 'Z', ztrds, Kmm ) 169 170 CASE DEFAULT ! other trends: just masked 170 171 ztrds(:,:,:) = ptrd(:,:,:) * tmask(:,:,:) 171 172 END SELECT 172 173 ! ! send trend to trd_trc 173 CALL trd_trc( ztrds, ktra, ktrd, kt )174 CALL trd_trc( ztrds, ktra, ktrd, kt, Kmm ) 174 175 ! 175 176 ENDIF … … 178 179 179 180 180 SUBROUTINE trd_tra_adv( pf, pu n, ptn, cdir, ptrd)181 SUBROUTINE trd_tra_adv( pf, pu, pt, cdir, ptrd, Kmm ) 181 182 !!--------------------------------------------------------------------- 182 183 !! *** ROUTINE trd_tra_adv *** … … 191 192 !!---------------------------------------------------------------------- 192 193 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pf ! advective flux in one direction 193 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pu n! now velocity in one direction194 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pt n! now or before tracer194 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pu ! now velocity in one direction 195 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in ) :: pt ! now or before tracer 195 196 CHARACTER(len=1) , INTENT(in ) :: cdir ! X/Y/Z direction 196 197 REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT( out) :: ptrd ! advective trend in one direction 198 INTEGER, INTENT(in) :: Kmm ! time level index 197 199 ! 198 200 INTEGER :: ji, jj, jk ! dummy loop indices … … 215 217 DO ji = fs_2, fs_jpim1 ! vector opt. 216 218 ptrd(ji,jj,jk) = - ( pf (ji,jj,jk) - pf (ji-ii,jj-ij,jk-ik) & 217 & - ( pu n(ji,jj,jk) - pun(ji-ii,jj-ij,jk-ik) ) * ptn(ji,jj,jk) ) &218 & * r1_e1e2t(ji,jj) / e3t _n(ji,jj,jk) * tmask(ji,jj,jk)219 & - ( pu(ji,jj,jk) - pu(ji-ii,jj-ij,jk-ik) ) * pt(ji,jj,jk) ) & 220 & * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) 219 221 END DO 220 222 END DO … … 224 226 225 227 226 SUBROUTINE trd_tra_mng( ptrdx, ptrdy, ktrd, kt )228 SUBROUTINE trd_tra_mng( ptrdx, ptrdy, ktrd, kt, Kmm ) 227 229 !!--------------------------------------------------------------------- 228 230 !! *** ROUTINE trd_tra_mng *** … … 236 238 INTEGER , INTENT(in ) :: ktrd ! tracer trend index 237 239 INTEGER , INTENT(in ) :: kt ! time step 240 INTEGER , INTENT(in ) :: Kmm ! time level index 238 241 !!---------------------------------------------------------------------- 239 242 … … 243 246 244 247 ! ! 3D output of tracers trends using IOM interface 245 IF( ln_tra_trd ) CALL trd_tra_iom ( ptrdx, ptrdy, ktrd, kt )248 IF( ln_tra_trd ) CALL trd_tra_iom ( ptrdx, ptrdy, ktrd, kt, Kmm ) 246 249 247 250 ! ! Integral Constraints Properties for tracers trends !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 248 IF( ln_glo_trd ) CALL trd_glo( ptrdx, ptrdy, ktrd, 'TRA', kt )251 IF( ln_glo_trd ) CALL trd_glo( ptrdx, ptrdy, ktrd, 'TRA', kt, Kmm ) 249 252 250 253 ! ! Potential ENergy trends 251 IF( ln_PE_trd ) CALL trd_pen( ptrdx, ptrdy, ktrd, kt, r2dt )254 IF( ln_PE_trd ) CALL trd_pen( ptrdx, ptrdy, ktrd, kt, r2dt, Kmm ) 252 255 253 256 ! ! Mixed layer trends for active tracers … … 290 293 291 294 292 SUBROUTINE trd_tra_iom( ptrdx, ptrdy, ktrd, kt )295 SUBROUTINE trd_tra_iom( ptrdx, ptrdy, ktrd, kt, Kmm ) 293 296 !!--------------------------------------------------------------------- 294 297 !! *** ROUTINE trd_tra_iom *** … … 300 303 INTEGER , INTENT(in ) :: ktrd ! tracer trend index 301 304 INTEGER , INTENT(in ) :: kt ! time step 305 INTEGER , INTENT(in ) :: Kmm ! time level index 302 306 !! 303 307 INTEGER :: ji, jj, jk ! dummy loop indices … … 326 330 IF( ln_linssh ) THEN ! cst volume : adv flux through z=0 surface 327 331 ALLOCATE( z2dx(jpi,jpj), z2dy(jpi,jpj) ) 328 z2dx(:,:) = w n(:,:,1) * tsn(:,:,1,jp_tem) / e3t_n(:,:,1)329 z2dy(:,:) = w n(:,:,1) * tsn(:,:,1,jp_sal) / e3t_n(:,:,1)332 z2dx(:,:) = ww(:,:,1) * ts(:,:,1,jp_tem,Kmm) / e3t(:,:,1,Kmm) 333 z2dy(:,:) = ww(:,:,1) * ts(:,:,1,jp_sal,Kmm) / e3t(:,:,1,Kmm) 330 334 CALL iom_put( "ttrd_sad", z2dx ) 331 335 CALL iom_put( "strd_sad", z2dy )
Note: See TracChangeset
for help on using the changeset viewer.
