- 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/trabbl.F90 (modified) (17 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/trabbl.F90
r11536 r11949 89 89 90 90 91 SUBROUTINE tra_bbl( kt )91 SUBROUTINE tra_bbl( kt, Kbb, Kmm, pts, Krhs ) 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 103 INTEGER, INTENT(in ) :: kt ! ocean time-step 104 INTEGER, INTENT(in ) :: Kbb, Kmm, Krhs ! time level indices 105 REAL(wp), DIMENSION(jpi,jpj,jpk,jpts,jpt), INTENT(inout) :: pts ! active tracers and RHS of tracer equation 104 106 ! 105 107 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdt, ztrds … … 110 112 IF( l_trdtra ) THEN !* Save the T-S input trends 111 113 ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) ) 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)114 ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) 115 ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) 116 ENDIF 117 118 IF( l_bbl ) CALL bbl( kt, nit000, 'TRA', Kbb, Kmm ) !* bbl coef. and transport (only if not already done in trcbbl) 117 119 118 120 IF( nn_bbl_ldf == 1 ) THEN !* Diffusive bbl 119 121 ! 120 CALL tra_bbl_dif( tsb, tsa, jpts)122 CALL tra_bbl_dif( pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts, Kmm ) 121 123 IF( ln_ctl ) & 122 CALL prt_ctl( tab3d_1= tsa(:,:,:,jp_tem), clinfo1=' bbl_ldf - Ta: ', mask1=tmask, &123 & tab3d_2= tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )124 CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' bbl_ldf - Ta: ', mask1=tmask, & 125 & tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 124 126 ! lateral boundary conditions ; just need for outputs 125 127 CALL lbc_lnk_multi( 'trabbl', ahu_bbl, 'U', 1. , ahv_bbl, 'V', 1. ) … … 131 133 IF( nn_bbl_adv /= 0 ) THEN !* Advective bbl 132 134 ! 133 CALL tra_bbl_adv( tsb, tsa, jpts)135 CALL tra_bbl_adv( pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts, Kmm ) 134 136 IF(ln_ctl) & 135 CALL prt_ctl( tab3d_1= tsa(:,:,:,jp_tem), clinfo1=' bbl_adv - Ta: ', mask1=tmask, &136 & tab3d_2= tsa(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )137 CALL prt_ctl( tab3d_1=pts(:,:,:,jp_tem,Krhs), clinfo1=' bbl_adv - Ta: ', mask1=tmask, & 138 & tab3d_2=pts(:,:,:,jp_sal,Krhs), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 137 139 ! lateral boundary conditions ; just need for outputs 138 140 CALL lbc_lnk_multi( 'trabbl', utr_bbl, 'U', 1. , vtr_bbl, 'V', 1. ) … … 143 145 144 146 IF( l_trdtra ) THEN ! send the trends for further diagnostics 145 ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:)146 ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:)147 CALL trd_tra( kt, 'TRA', jp_tem, jptra_bbl, ztrdt )148 CALL trd_tra( kt, 'TRA', jp_sal, jptra_bbl, ztrds )147 ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:) 148 ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) - ztrds(:,:,:) 149 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_bbl, ztrdt ) 150 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_bbl, ztrds ) 149 151 DEALLOCATE( ztrdt, ztrds ) 150 152 ENDIF … … 155 157 156 158 157 SUBROUTINE tra_bbl_dif( pt b, pta, kjpt)159 SUBROUTINE tra_bbl_dif( pt, pt_rhs, kjpt, Kmm ) 158 160 !!---------------------------------------------------------------------- 159 161 !! *** ROUTINE tra_bbl_dif *** … … 171 173 !! convection is satified) 172 174 !! 173 !! ** Action : pt aincreased by the bbl diffusive trend175 !! ** Action : pt_rhs increased by the bbl diffusive trend 174 176 !! 175 177 !! References : Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591. … … 177 179 !!---------------------------------------------------------------------- 178 180 INTEGER , INTENT(in ) :: kjpt ! number of tracers 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 181 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pt ! before and now tracer fields 182 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pt_rhs ! tracer trend 183 INTEGER , INTENT(in ) :: Kmm ! time level indices 181 184 ! 182 185 INTEGER :: ji, jj, jn ! dummy loop indices … … 191 194 DO ji = 1, jpi 192 195 ik = mbkt(ji,jj) ! bottom T-level index 193 zptb(ji,jj) = pt b(ji,jj,ik,jn)! bottom before T and S196 zptb(ji,jj) = pt(ji,jj,ik,jn) ! bottom before T and S 194 197 END DO 195 198 END DO … … 198 201 DO ji = 2, jpim1 199 202 ik = mbkt(ji,jj) ! bottom T-level index 200 pt a(ji,jj,ik,jn) = pta(ji,jj,ik,jn) &201 & + ( ahu_bbl(ji ,jj ) * ( zptb(ji+1,jj ) - zptb(ji ,jj ) ) &202 & - ahu_bbl(ji-1,jj ) * ( zptb(ji ,jj ) - zptb(ji-1,jj ) ) &203 & + ahv_bbl(ji ,jj ) * ( zptb(ji ,jj+1) - zptb(ji ,jj ) ) &204 & - ahv_bbl(ji ,jj-1) * ( zptb(ji ,jj ) - zptb(ji ,jj-1) ) ) &205 & * r1_e1e2t(ji,jj) / e3t_n(ji,jj,ik)203 pt_rhs(ji,jj,ik,jn) = pt_rhs(ji,jj,ik,jn) & 204 & + ( ahu_bbl(ji ,jj ) * ( zptb(ji+1,jj ) - zptb(ji ,jj ) ) & 205 & - ahu_bbl(ji-1,jj ) * ( zptb(ji ,jj ) - zptb(ji-1,jj ) ) & 206 & + ahv_bbl(ji ,jj ) * ( zptb(ji ,jj+1) - zptb(ji ,jj ) ) & 207 & - ahv_bbl(ji ,jj-1) * ( zptb(ji ,jj ) - zptb(ji ,jj-1) ) ) & 208 & * r1_e1e2t(ji,jj) / e3t(ji,jj,ik,Kmm) 206 209 END DO 207 210 END DO … … 212 215 213 216 214 SUBROUTINE tra_bbl_adv( pt b, pta, kjpt)217 SUBROUTINE tra_bbl_adv( pt, pt_rhs, kjpt, Kmm ) 215 218 !!---------------------------------------------------------------------- 216 219 !! *** ROUTINE trc_bbl *** … … 228 231 !!---------------------------------------------------------------------- 229 232 INTEGER , INTENT(in ) :: kjpt ! number of tracers 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 233 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pt ! before and now tracer fields 234 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pt_rhs ! tracer trend 235 INTEGER , INTENT(in ) :: Kmm ! time level indices 232 236 ! 233 237 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 250 254 ! 251 255 ! ! up -slope T-point (shelf bottom point) 252 zbtr = r1_e1e2t(iis,jj) / e3t _n(iis,jj,ikus)253 ztra = zu_bbl * ( pt b(iid,jj,ikus,jn) - ptb(iis,jj,ikus,jn) ) * zbtr254 pt a(iis,jj,ikus,jn) = pta(iis,jj,ikus,jn) + ztra256 zbtr = r1_e1e2t(iis,jj) / e3t(iis,jj,ikus,Kmm) 257 ztra = zu_bbl * ( pt(iid,jj,ikus,jn) - pt(iis,jj,ikus,jn) ) * zbtr 258 pt_rhs(iis,jj,ikus,jn) = pt_rhs(iis,jj,ikus,jn) + ztra 255 259 ! 256 260 DO jk = ikus, ikud-1 ! down-slope upper to down T-point (deep column) 257 zbtr = r1_e1e2t(iid,jj) / e3t _n(iid,jj,jk)258 ztra = zu_bbl * ( pt b(iid,jj,jk+1,jn) - ptb(iid,jj,jk,jn) ) * zbtr259 pt a(iid,jj,jk,jn) = pta(iid,jj,jk,jn) + ztra261 zbtr = r1_e1e2t(iid,jj) / e3t(iid,jj,jk,Kmm) 262 ztra = zu_bbl * ( pt(iid,jj,jk+1,jn) - pt(iid,jj,jk,jn) ) * zbtr 263 pt_rhs(iid,jj,jk,jn) = pt_rhs(iid,jj,jk,jn) + ztra 260 264 END DO 261 265 ! 262 zbtr = r1_e1e2t(iid,jj) / e3t _n(iid,jj,ikud)263 ztra = zu_bbl * ( pt b(iis,jj,ikus,jn) - ptb(iid,jj,ikud,jn) ) * zbtr264 pt a(iid,jj,ikud,jn) = pta(iid,jj,ikud,jn) + ztra266 zbtr = r1_e1e2t(iid,jj) / e3t(iid,jj,ikud,Kmm) 267 ztra = zu_bbl * ( pt(iis,jj,ikus,jn) - pt(iid,jj,ikud,jn) ) * zbtr 268 pt_rhs(iid,jj,ikud,jn) = pt_rhs(iid,jj,ikud,jn) + ztra 265 269 ENDIF 266 270 ! … … 272 276 ! 273 277 ! up -slope T-point (shelf bottom point) 274 zbtr = r1_e1e2t(ji,ijs) / e3t _n(ji,ijs,ikvs)275 ztra = zv_bbl * ( pt b(ji,ijd,ikvs,jn) - ptb(ji,ijs,ikvs,jn) ) * zbtr276 pt a(ji,ijs,ikvs,jn) = pta(ji,ijs,ikvs,jn) + ztra278 zbtr = r1_e1e2t(ji,ijs) / e3t(ji,ijs,ikvs,Kmm) 279 ztra = zv_bbl * ( pt(ji,ijd,ikvs,jn) - pt(ji,ijs,ikvs,jn) ) * zbtr 280 pt_rhs(ji,ijs,ikvs,jn) = pt_rhs(ji,ijs,ikvs,jn) + ztra 277 281 ! 278 282 DO jk = ikvs, ikvd-1 ! down-slope upper to down T-point (deep column) 279 zbtr = r1_e1e2t(ji,ijd) / e3t _n(ji,ijd,jk)280 ztra = zv_bbl * ( pt b(ji,ijd,jk+1,jn) - ptb(ji,ijd,jk,jn) ) * zbtr281 pt a(ji,ijd,jk,jn) = pta(ji,ijd,jk,jn) + ztra283 zbtr = r1_e1e2t(ji,ijd) / e3t(ji,ijd,jk,Kmm) 284 ztra = zv_bbl * ( pt(ji,ijd,jk+1,jn) - pt(ji,ijd,jk,jn) ) * zbtr 285 pt_rhs(ji,ijd,jk,jn) = pt_rhs(ji,ijd,jk,jn) + ztra 282 286 END DO 283 287 ! ! down-slope T-point (deep bottom point) 284 zbtr = r1_e1e2t(ji,ijd) / e3t _n(ji,ijd,ikvd)285 ztra = zv_bbl * ( pt b(ji,ijs,ikvs,jn) - ptb(ji,ijd,ikvd,jn) ) * zbtr286 pt a(ji,ijd,ikvd,jn) = pta(ji,ijd,ikvd,jn) + ztra288 zbtr = r1_e1e2t(ji,ijd) / e3t(ji,ijd,ikvd,Kmm) 289 ztra = zv_bbl * ( pt(ji,ijs,ikvs,jn) - pt(ji,ijd,ikvd,jn) ) * zbtr 290 pt_rhs(ji,ijd,ikvd,jn) = pt_rhs(ji,ijd,ikvd,jn) + ztra 287 291 ENDIF 288 292 END DO … … 295 299 296 300 297 SUBROUTINE bbl( kt, kit000, cdtype )301 SUBROUTINE bbl( kt, kit000, cdtype, Kbb, Kmm ) 298 302 !!---------------------------------------------------------------------- 299 303 !! *** ROUTINE bbl *** … … 324 328 INTEGER , INTENT(in ) :: kit000 ! first time step index 325 329 CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 330 INTEGER , INTENT(in ) :: Kbb, Kmm ! ocean time level index 326 331 ! 327 332 INTEGER :: ji, jj ! dummy loop indices … … 344 349 DO ji = 1, jpi 345 350 ik = mbkt(ji,jj) ! bottom T-level index 346 zts (ji,jj,jp_tem) = ts b(ji,jj,ik,jp_tem)! bottom before T and S347 zts (ji,jj,jp_sal) = ts b(ji,jj,ik,jp_sal)351 zts (ji,jj,jp_tem) = ts(ji,jj,ik,jp_tem,Kbb) ! bottom before T and S 352 zts (ji,jj,jp_sal) = ts(ji,jj,ik,jp_sal,Kbb) 348 353 ! 349 zdep(ji,jj) = gdept _n(ji,jj,ik)! bottom T-level reference depth350 zub (ji,jj) = u n(ji,jj,mbku(ji,jj))! bottom velocity351 zvb (ji,jj) = v n(ji,jj,mbkv(ji,jj))354 zdep(ji,jj) = gdept(ji,jj,ik,Kmm) ! bottom T-level reference depth 355 zub (ji,jj) = uu(ji,jj,mbku(ji,jj),Kmm) ! bottom velocity 356 zvb (ji,jj) = vv(ji,jj,mbkv(ji,jj),Kmm) 352 357 END DO 353 358 END DO 354 359 ! 355 CALL eos_rab( zts, zdep, zab )360 CALL eos_rab( zts, zdep, zab, Kmm ) 356 361 ! 357 362 ! !-------------------!
Note: See TracChangeset
for help on using the changeset viewer.
