- Timestamp:
- 2020-05-14T21:46:00+02:00 (4 years ago)
- Location:
- NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser
- Files:
-
- 2 edited
-
. (modified) (1 prop)
-
src/OCE/TRD/trdtra.F90 (modified) (16 diffs)
Legend:
- Unmodified
- Added
- Removed
-
NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser
- Property svn:externals
-
old new 6 6 ^/vendors/FCM@HEAD ext/FCM 7 7 ^/vendors/IOIPSL@HEAD ext/IOIPSL 8 9 # SETTE 10 ^/utils/CI/sette@HEAD sette
-
- Property svn:externals
-
NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/OCE/TRD/trdtra.F90
r12219 r12928 41 41 42 42 !! * Substitutions 43 # include " vectopt_loop_substitute.h90"43 # include "do_loop_substitute.h90" 44 44 !!---------------------------------------------------------------------- 45 45 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 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)136 ztrdt(:,:,jk) = ( zwt(:,:,jk) - zwt(:,:,jk+1) ) / e3t(:,:,jk,Kmm) 137 ztrds(:,:,jk) = ( zws(:,:,jk) - zws(:,:,jk+1) ) / e3t(:,:,jk,Kmm) 137 138 END DO 138 CALL trd_tra_mng( ztrdt, ztrds, jptra_zdfp, kt )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)150 ztrdt(:,:,jk) = ( zwt(:,:,jk) - zwt(:,:,jk+1) ) / e3t(:,:,jk,Kmm) 151 ztrds(:,:,jk) = ( zws(:,:,jk) - zws(:,:,jk+1) ) / e3t(:,:,jk,Kmm) 151 152 END DO 152 CALL trd_tra_mng( ztrdt, ztrds, jptra_evd, kt )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 … … 211 213 ptrd(:,:,jpk) = 0._wp 212 214 ! 213 DO jk = 1, jpkm1 ! advective trend 214 DO jj = 2, jpjm1 215 DO ji = fs_2, fs_jpim1 ! vector opt. 216 ptrd(ji,jj,jk) = - ( pf (ji,jj,jk) - pf (ji-ii,jj-ij,jk-ik) & 217 & - ( pun(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 END DO 220 END DO 221 END DO 215 DO_3D_00_00( 1, jpkm1 ) 216 ptrd(ji,jj,jk) = - ( pf (ji,jj,jk) - pf (ji-ii,jj-ij,jk-ik) & 217 & - ( pu(ji,jj,jk) - pu(ji-ii,jj-ij,jk-ik) ) * pt(ji,jj,jk) ) & 218 & * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) * tmask(ji,jj,jk) 219 END_3D 222 220 ! 223 221 END SUBROUTINE trd_tra_adv 224 222 225 223 226 SUBROUTINE trd_tra_mng( ptrdx, ptrdy, ktrd, kt )224 SUBROUTINE trd_tra_mng( ptrdx, ptrdy, ktrd, kt, Kmm ) 227 225 !!--------------------------------------------------------------------- 228 226 !! *** ROUTINE trd_tra_mng *** … … 236 234 INTEGER , INTENT(in ) :: ktrd ! tracer trend index 237 235 INTEGER , INTENT(in ) :: kt ! time step 238 !!---------------------------------------------------------------------- 239 240 IF( neuler == 0 .AND. kt == nit000 ) THEN ; r2dt = rdt ! = rdt (restart with Euler time stepping) 241 ELSEIF( kt <= nit000 + 1) THEN ; r2dt = 2. * rdt ! = 2 rdt (leapfrog) 242 ENDIF 236 INTEGER , INTENT(in ) :: Kmm ! time level index 237 !!---------------------------------------------------------------------- 243 238 244 239 ! ! 3D output of tracers trends using IOM interface 245 IF( ln_tra_trd ) CALL trd_tra_iom ( ptrdx, ptrdy, ktrd, kt )240 IF( ln_tra_trd ) CALL trd_tra_iom ( ptrdx, ptrdy, ktrd, kt, Kmm ) 246 241 247 242 ! ! Integral Constraints Properties for tracers trends !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 248 IF( ln_glo_trd ) CALL trd_glo( ptrdx, ptrdy, ktrd, 'TRA', kt )243 IF( ln_glo_trd ) CALL trd_glo( ptrdx, ptrdy, ktrd, 'TRA', kt, Kmm ) 249 244 250 245 ! ! Potential ENergy trends 251 IF( ln_PE_trd ) CALL trd_pen( ptrdx, ptrdy, ktrd, kt, r 2dt)246 IF( ln_PE_trd ) CALL trd_pen( ptrdx, ptrdy, ktrd, kt, rDt, Kmm ) 252 247 253 248 ! ! Mixed layer trends for active tracers … … 282 277 CASE ( jptra_atf ) ; CALL trd_mxl_zint( ptrdx, ptrdy, jpmxl_atf, '3D' ) ! asselin time filter (last trend) 283 278 ! 284 CALL trd_mxl( kt, r 2dt ) ! trends: Mixed-layer (output)279 CALL trd_mxl( kt, rDt ) ! trends: Mixed-layer (output) 285 280 END SELECT 286 281 ! … … 290 285 291 286 292 SUBROUTINE trd_tra_iom( ptrdx, ptrdy, ktrd, kt )287 SUBROUTINE trd_tra_iom( ptrdx, ptrdy, ktrd, kt, Kmm ) 293 288 !!--------------------------------------------------------------------- 294 289 !! *** ROUTINE trd_tra_iom *** … … 300 295 INTEGER , INTENT(in ) :: ktrd ! tracer trend index 301 296 INTEGER , INTENT(in ) :: kt ! time step 297 INTEGER , INTENT(in ) :: Kmm ! time level index 302 298 !! 303 299 INTEGER :: ji, jj, jk ! dummy loop indices … … 326 322 IF( ln_linssh ) THEN ! cst volume : adv flux through z=0 surface 327 323 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)324 z2dx(:,:) = ww(:,:,1) * ts(:,:,1,jp_tem,Kmm) / e3t(:,:,1,Kmm) 325 z2dy(:,:) = ww(:,:,1) * ts(:,:,1,jp_sal,Kmm) / e3t(:,:,1,Kmm) 330 326 CALL iom_put( "ttrd_sad", z2dx ) 331 327 CALL iom_put( "strd_sad", z2dy )
Note: See TracChangeset
for help on using the changeset viewer.
