Changeset 10874 for NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/trabbl.F90
- Timestamp:
- 2019-04-15T15:57:37+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/trabbl.F90
r10806 r10874 89 89 90 90 91 SUBROUTINE tra_bbl( kt , ktlev1, ktlev2, kt2lev, pts_rhs)91 SUBROUTINE tra_bbl( kt ) 92 92 !!---------------------------------------------------------------------- 93 93 !! *** ROUTINE bbl *** … … 101 101 !! is added to the general tracer trend 102 102 !!---------------------------------------------------------------------- 103 INTEGER, INTENT( in ) :: kt ! ocean time-step 104 INTEGER, INTENT( in ) :: ktlev1, ktlev2 ! time level indices for 3-time-level source terms 105 INTEGER, INTENT( in ) :: kt2lev ! time level index for 2-time-level source terms 106 REAL(wp), INTENT( inout), DIMENSION(jpi,jpj,jpk,jpts) :: pts_rhs ! temperature and salinity trends 103 INTEGER, INTENT( in ) :: kt ! ocean time-step 107 104 ! 108 105 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdt, ztrds … … 113 110 IF( l_trdtra ) THEN !* Save the T-S input trends 114 111 ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) ) 115 ztrdt(:,:,:) = pts_rhs(:,:,:,jp_tem)116 ztrds(:,:,:) = pts_rhs(:,:,:,jp_sal)117 ENDIF 118 119 IF( l_bbl ) CALL bbl( kt, nit000, ktlev1, ktlev2, kt2lev,'TRA' ) !* bbl coef. and transport (only if not already done in trcbbl)112 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 113 ztrds(:,:,:) = tsa(:,:,:,jp_sal) 114 ENDIF 115 116 IF( l_bbl ) CALL bbl( kt, nit000, 'TRA' ) !* bbl coef. and transport (only if not already done in trcbbl) 120 117 121 118 IF( nn_bbl_ldf == 1 ) THEN !* Diffusive bbl 122 119 ! 123 CALL tra_bbl_dif( ts (:,:,:,:,ktlev1), e3t(:,:,:,ktlev2), pts_rhs, jpts )120 CALL tra_bbl_dif( tsb, tsa, jpts ) 124 121 IF( ln_ctl ) & 125 122 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' bbl_ldf - Ta: ', mask1=tmask, & … … 134 131 IF( nn_bbl_adv /= 0 ) THEN !* Advective bbl 135 132 ! 136 CALL tra_bbl_adv( ts (:,:,:,:,ktlev1), e3t(:,:,:,ktlev2), pts_rhs, jpts )133 CALL tra_bbl_adv( tsb, tsa, jpts ) 137 134 IF(ln_ctl) & 138 135 CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' bbl_adv - Ta: ', mask1=tmask, & … … 146 143 147 144 IF( l_trdtra ) THEN ! send the trends for further diagnostics 148 ztrdt(:,:,:) = pts_rhs(:,:,:,jp_tem) - ztrdt(:,:,:)149 ztrds(:,:,:) = pts_rhs(:,:,:,jp_sal) - ztrds(:,:,:)145 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 146 ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:) 150 147 CALL trd_tra( kt, 'TRA', jp_tem, jptra_bbl, ztrdt ) 151 148 CALL trd_tra( kt, 'TRA', jp_sal, jptra_bbl, ztrds ) … … 158 155 159 156 160 SUBROUTINE tra_bbl_dif( pt , pe3t, pt_rhs, kjpt )157 SUBROUTINE tra_bbl_dif( ptb, pta, kjpt ) 161 158 !!---------------------------------------------------------------------- 162 159 !! *** ROUTINE tra_bbl_dif *** … … 174 171 !! convection is satified) 175 172 !! 176 !! ** Action : pt _rhsincreased by the bbl diffusive trend173 !! ** Action : pta increased by the bbl diffusive trend 177 174 !! 178 175 !! References : Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591. … … 180 177 !!---------------------------------------------------------------------- 181 178 INTEGER , INTENT(in ) :: kjpt ! number of tracers 182 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pt ! tracer fields 183 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: pe3t ! thickness fields 184 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pt_rhs ! tracer trend 179 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! before and now tracer fields 180 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 185 181 ! 186 182 INTEGER :: ji, jj, jn ! dummy loop indices … … 195 191 DO ji = 1, jpi 196 192 ik = mbkt(ji,jj) ! bottom T-level index 197 zptb(ji,jj) = pt (ji,jj,ik,jn) ! bottom before T and S193 zptb(ji,jj) = ptb(ji,jj,ik,jn) ! bottom before T and S 198 194 END DO 199 195 END DO … … 202 198 DO ji = 2, jpim1 203 199 ik = mbkt(ji,jj) ! bottom T-level index 204 pt _rhs(ji,jj,ik,jn) = pt_rhs(ji,jj,ik,jn) &200 pta(ji,jj,ik,jn) = pta(ji,jj,ik,jn) & 205 201 & + ( ahu_bbl(ji ,jj ) * ( zptb(ji+1,jj ) - zptb(ji ,jj ) ) & 206 202 & - ahu_bbl(ji-1,jj ) * ( zptb(ji ,jj ) - zptb(ji-1,jj ) ) & 207 203 & + ahv_bbl(ji ,jj ) * ( zptb(ji ,jj+1) - zptb(ji ,jj ) ) & 208 204 & - ahv_bbl(ji ,jj-1) * ( zptb(ji ,jj ) - zptb(ji ,jj-1) ) ) & 209 & * r1_e1e2t(ji,jj) / pe3t(ji,jj,ik)205 & * r1_e1e2t(ji,jj) / e3t_n(ji,jj,ik) 210 206 END DO 211 207 END DO … … 216 212 217 213 218 SUBROUTINE tra_bbl_adv( pt , pe3t, pt_rhs, kjpt )214 SUBROUTINE tra_bbl_adv( ptb, pta, kjpt ) 219 215 !!---------------------------------------------------------------------- 220 216 !! *** ROUTINE trc_bbl *** … … 232 228 !!---------------------------------------------------------------------- 233 229 INTEGER , INTENT(in ) :: kjpt ! number of tracers 234 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pt ! before and now tracer fields 235 REAL(wp), DIMENSION(jpi,jpj,jpk) , INTENT(in ) :: pe3t ! thickness fields 236 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pt_rhs ! tracer trend 230 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! before and now tracer fields 231 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 237 232 ! 238 233 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 255 250 ! 256 251 ! ! up -slope T-point (shelf bottom point) 257 zbtr = r1_e1e2t(iis,jj) / pe3t(iis,jj,ikus)258 ztra = zu_bbl * ( pt (iid,jj,ikus,jn) - pt(iis,jj,ikus,jn) ) * zbtr259 pt _rhs(iis,jj,ikus,jn) = pt_rhs(iis,jj,ikus,jn) + ztra252 zbtr = r1_e1e2t(iis,jj) / e3t_n(iis,jj,ikus) 253 ztra = zu_bbl * ( ptb(iid,jj,ikus,jn) - ptb(iis,jj,ikus,jn) ) * zbtr 254 pta(iis,jj,ikus,jn) = pta(iis,jj,ikus,jn) + ztra 260 255 ! 261 256 DO jk = ikus, ikud-1 ! down-slope upper to down T-point (deep column) 262 zbtr = r1_e1e2t(iid,jj) / pe3t(iid,jj,jk)263 ztra = zu_bbl * ( pt (iid,jj,jk+1,jn) - pt(iid,jj,jk,jn) ) * zbtr264 pt _rhs(iid,jj,jk,jn) = pt_rhs(iid,jj,jk,jn) + ztra257 zbtr = r1_e1e2t(iid,jj) / e3t_n(iid,jj,jk) 258 ztra = zu_bbl * ( ptb(iid,jj,jk+1,jn) - ptb(iid,jj,jk,jn) ) * zbtr 259 pta(iid,jj,jk,jn) = pta(iid,jj,jk,jn) + ztra 265 260 END DO 266 261 ! 267 zbtr = r1_e1e2t(iid,jj) / pe3t(iid,jj,ikud)268 ztra = zu_bbl * ( pt (iis,jj,ikus,jn) - pt(iid,jj,ikud,jn) ) * zbtr269 pt _rhs(iid,jj,ikud,jn) = pt_rhs(iid,jj,ikud,jn) + ztra262 zbtr = r1_e1e2t(iid,jj) / e3t_n(iid,jj,ikud) 263 ztra = zu_bbl * ( ptb(iis,jj,ikus,jn) - ptb(iid,jj,ikud,jn) ) * zbtr 264 pta(iid,jj,ikud,jn) = pta(iid,jj,ikud,jn) + ztra 270 265 ENDIF 271 266 ! … … 277 272 ! 278 273 ! up -slope T-point (shelf bottom point) 279 zbtr = r1_e1e2t(ji,ijs) / pe3t(ji,ijs,ikvs)280 ztra = zv_bbl * ( pt (ji,ijd,ikvs,jn) - pt(ji,ijs,ikvs,jn) ) * zbtr281 pt _rhs(ji,ijs,ikvs,jn) = pt_rhs(ji,ijs,ikvs,jn) + ztra274 zbtr = r1_e1e2t(ji,ijs) / e3t_n(ji,ijs,ikvs) 275 ztra = zv_bbl * ( ptb(ji,ijd,ikvs,jn) - ptb(ji,ijs,ikvs,jn) ) * zbtr 276 pta(ji,ijs,ikvs,jn) = pta(ji,ijs,ikvs,jn) + ztra 282 277 ! 283 278 DO jk = ikvs, ikvd-1 ! down-slope upper to down T-point (deep column) 284 zbtr = r1_e1e2t(ji,ijd) / pe3t(ji,ijd,jk)285 ztra = zv_bbl * ( pt (ji,ijd,jk+1,jn) - pt(ji,ijd,jk,jn) ) * zbtr286 pt _rhs(ji,ijd,jk,jn) = pt_rhs(ji,ijd,jk,jn) + ztra279 zbtr = r1_e1e2t(ji,ijd) / e3t_n(ji,ijd,jk) 280 ztra = zv_bbl * ( ptb(ji,ijd,jk+1,jn) - ptb(ji,ijd,jk,jn) ) * zbtr 281 pta(ji,ijd,jk,jn) = pta(ji,ijd,jk,jn) + ztra 287 282 END DO 288 283 ! ! down-slope T-point (deep bottom point) 289 zbtr = r1_e1e2t(ji,ijd) / pe3t(ji,ijd,ikvd)290 ztra = zv_bbl * ( pt (ji,ijs,ikvs,jn) - pt(ji,ijd,ikvd,jn) ) * zbtr291 pt _rhs(ji,ijd,ikvd,jn) = pt_rhs(ji,ijd,ikvd,jn) + ztra284 zbtr = r1_e1e2t(ji,ijd) / e3t_n(ji,ijd,ikvd) 285 ztra = zv_bbl * ( ptb(ji,ijs,ikvs,jn) - ptb(ji,ijd,ikvd,jn) ) * zbtr 286 pta(ji,ijd,ikvd,jn) = pta(ji,ijd,ikvd,jn) + ztra 292 287 ENDIF 293 288 END DO … … 300 295 301 296 302 SUBROUTINE bbl( kt, kit000, ktlev1, ktlev2, kt2lev,cdtype )297 SUBROUTINE bbl( kt, kit000, cdtype ) 303 298 !!---------------------------------------------------------------------- 304 299 !! *** ROUTINE bbl *** … … 328 323 INTEGER , INTENT(in ) :: kt ! ocean time-step index 329 324 INTEGER , INTENT(in ) :: kit000 ! first time step index 330 INTEGER , INTENT(in ) :: ktlev1, ktlev2 ! time level indices for 3-time-levelsource terms331 INTEGER , INTENT(in ) :: kt2lev ! time level index for 2-time-level source terms332 325 CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 333 326 ! … … 351 344 DO ji = 1, jpi 352 345 ik = mbkt(ji,jj) ! bottom T-level index 353 zts (ji,jj,jp_tem) = ts (ji,jj,ik,jp_tem,ktlev1) ! bottom before T and S354 zts (ji,jj,jp_sal) = ts (ji,jj,ik,jp_sal,ktlev1)346 zts (ji,jj,jp_tem) = tsb(ji,jj,ik,jp_tem) ! bottom before T and S 347 zts (ji,jj,jp_sal) = tsb(ji,jj,ik,jp_sal) 355 348 ! 356 zdep(ji,jj) = gdept (ji,jj,ik,kt2lev) ! bottom T-level reference depth357 zub (ji,jj) = u u(ji,jj,mbku(ji,jj),ktlev2) ! bottom velocity358 zvb (ji,jj) = v v(ji,jj,mbkv(ji,jj),ktlev2)349 zdep(ji,jj) = gdept_n(ji,jj,ik) ! bottom T-level reference depth 350 zub (ji,jj) = un(ji,jj,mbku(ji,jj)) ! bottom velocity 351 zvb (ji,jj) = vn(ji,jj,mbkv(ji,jj)) 359 352 END DO 360 353 END DO
Note: See TracChangeset
for help on using the changeset viewer.
