Changeset 10954 for NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/trabbl.F90
- Timestamp:
- 2019-05-09T18:12:29+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
r10946 r10954 89 89 90 90 91 SUBROUTINE tra_bbl( kt, K mm, Krhs )91 SUBROUTINE tra_bbl( kt, Kbb, Kmm, Krhs ) 92 92 !!---------------------------------------------------------------------- 93 93 !! *** ROUTINE bbl *** … … 102 102 !!---------------------------------------------------------------------- 103 103 INTEGER, INTENT( in ) :: kt ! ocean time-step 104 INTEGER, INTENT( in ) :: K mm, Krhs ! time level indices104 INTEGER, INTENT( in ) :: Kbb, Kmm, Krhs ! time level indices 105 105 ! 106 106 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdt, ztrds … … 111 111 IF( l_trdtra ) THEN !* Save the T-S input trends 112 112 ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) ) 113 ztrdt(:,:,:) = ts a(:,:,:,jp_tem)114 ztrds(:,:,:) = ts a(:,:,:,jp_sal)115 ENDIF 116 117 IF( l_bbl ) CALL bbl( kt, nit000, 'TRA' ) !* bbl coef. and transport (only if not already done in trcbbl)113 ztrdt(:,:,:) = ts(:,:,:,jp_tem,Krhs) 114 ztrds(:,:,:) = ts(:,:,:,jp_sal,Krhs) 115 ENDIF 116 117 IF( l_bbl ) CALL bbl( kt, nit000, 'TRA', Kbb, Kmm ) !* bbl coef. and transport (only if not already done in trcbbl) 118 118 119 119 IF( nn_bbl_ldf == 1 ) THEN !* Diffusive bbl 120 120 ! 121 CALL tra_bbl_dif( ts b, tsa, jpts)121 CALL tra_bbl_dif( ts(:,:,:,:,Kbb), ts(:,:,:,:,Krhs), jpts, Kmm ) 122 122 IF( ln_ctl ) & 123 CALL prt_ctl( tab3d_1=ts a(:,:,:,jp_tem), clinfo1=' bbl_ldf - Ta: ', mask1=tmask, &124 & tab3d_2=ts a(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )123 CALL prt_ctl( tab3d_1=ts(:,:,:,jp_tem,Krhs), clinfo1=' bbl_ldf - Ta: ', mask1=tmask, & 124 & tab3d_2=ts(:,:,:,jp_sal,Krhs), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 125 125 ! lateral boundary conditions ; just need for outputs 126 126 CALL lbc_lnk_multi( 'trabbl', ahu_bbl, 'U', 1. , ahv_bbl, 'V', 1. ) … … 132 132 IF( nn_bbl_adv /= 0 ) THEN !* Advective bbl 133 133 ! 134 CALL tra_bbl_adv( ts b, tsa, jpts)134 CALL tra_bbl_adv( ts(:,:,:,:,Kbb), ts(:,:,:,:,Krhs), jpts, Kmm ) 135 135 IF(ln_ctl) & 136 CALL prt_ctl( tab3d_1=ts a(:,:,:,jp_tem), clinfo1=' bbl_adv - Ta: ', mask1=tmask, &137 & tab3d_2=ts a(:,:,:,jp_sal), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' )136 CALL prt_ctl( tab3d_1=ts(:,:,:,jp_tem,Krhs), clinfo1=' bbl_adv - Ta: ', mask1=tmask, & 137 & tab3d_2=ts(:,:,:,jp_sal,Krhs), clinfo2= ' Sa: ', mask2=tmask, clinfo3='tra' ) 138 138 ! lateral boundary conditions ; just need for outputs 139 139 CALL lbc_lnk_multi( 'trabbl', utr_bbl, 'U', 1. , vtr_bbl, 'V', 1. ) … … 144 144 145 145 IF( l_trdtra ) THEN ! send the trends for further diagnostics 146 ztrdt(:,:,:) = ts a(:,:,:,jp_tem) - ztrdt(:,:,:)147 ztrds(:,:,:) = ts a(:,:,:,jp_sal) - ztrds(:,:,:)146 ztrdt(:,:,:) = ts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:) 147 ztrds(:,:,:) = ts(:,:,:,jp_sal,Krhs) - ztrds(:,:,:) 148 148 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_bbl, ztrdt ) 149 149 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_bbl, ztrds ) … … 156 156 157 157 158 SUBROUTINE tra_bbl_dif( ptb, pta, kjpt )158 SUBROUTINE tra_bbl_dif( ptb, pta, kjpt, Kmm ) 159 159 !!---------------------------------------------------------------------- 160 160 !! *** ROUTINE tra_bbl_dif *** … … 180 180 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! before and now tracer fields 181 181 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 182 INTEGER , INTENT(in ) :: Kmm ! time level indices 182 183 ! 183 184 INTEGER :: ji, jj, jn ! dummy loop indices … … 204 205 & + ahv_bbl(ji ,jj ) * ( zptb(ji ,jj+1) - zptb(ji ,jj ) ) & 205 206 & - ahv_bbl(ji ,jj-1) * ( zptb(ji ,jj ) - zptb(ji ,jj-1) ) ) & 206 & * r1_e1e2t(ji,jj) / e3t _n(ji,jj,ik)207 & * r1_e1e2t(ji,jj) / e3t(ji,jj,ik,Kmm) 207 208 END DO 208 209 END DO … … 213 214 214 215 215 SUBROUTINE tra_bbl_adv( ptb, pta, kjpt )216 SUBROUTINE tra_bbl_adv( ptb, pta, kjpt, Kmm ) 216 217 !!---------------------------------------------------------------------- 217 218 !! *** ROUTINE trc_bbl *** … … 231 232 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! before and now tracer fields 232 233 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 234 INTEGER , INTENT(in ) :: Kmm ! time level indices 233 235 ! 234 236 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 251 253 ! 252 254 ! ! up -slope T-point (shelf bottom point) 253 zbtr = r1_e1e2t(iis,jj) / e3t _n(iis,jj,ikus)255 zbtr = r1_e1e2t(iis,jj) / e3t(iis,jj,ikus,Kmm) 254 256 ztra = zu_bbl * ( ptb(iid,jj,ikus,jn) - ptb(iis,jj,ikus,jn) ) * zbtr 255 257 pta(iis,jj,ikus,jn) = pta(iis,jj,ikus,jn) + ztra 256 258 ! 257 259 DO jk = ikus, ikud-1 ! down-slope upper to down T-point (deep column) 258 zbtr = r1_e1e2t(iid,jj) / e3t _n(iid,jj,jk)260 zbtr = r1_e1e2t(iid,jj) / e3t(iid,jj,jk,Kmm) 259 261 ztra = zu_bbl * ( ptb(iid,jj,jk+1,jn) - ptb(iid,jj,jk,jn) ) * zbtr 260 262 pta(iid,jj,jk,jn) = pta(iid,jj,jk,jn) + ztra 261 263 END DO 262 264 ! 263 zbtr = r1_e1e2t(iid,jj) / e3t _n(iid,jj,ikud)265 zbtr = r1_e1e2t(iid,jj) / e3t(iid,jj,ikud,Kmm) 264 266 ztra = zu_bbl * ( ptb(iis,jj,ikus,jn) - ptb(iid,jj,ikud,jn) ) * zbtr 265 267 pta(iid,jj,ikud,jn) = pta(iid,jj,ikud,jn) + ztra … … 273 275 ! 274 276 ! up -slope T-point (shelf bottom point) 275 zbtr = r1_e1e2t(ji,ijs) / e3t _n(ji,ijs,ikvs)277 zbtr = r1_e1e2t(ji,ijs) / e3t(ji,ijs,ikvs,Kmm) 276 278 ztra = zv_bbl * ( ptb(ji,ijd,ikvs,jn) - ptb(ji,ijs,ikvs,jn) ) * zbtr 277 279 pta(ji,ijs,ikvs,jn) = pta(ji,ijs,ikvs,jn) + ztra 278 280 ! 279 281 DO jk = ikvs, ikvd-1 ! down-slope upper to down T-point (deep column) 280 zbtr = r1_e1e2t(ji,ijd) / e3t _n(ji,ijd,jk)282 zbtr = r1_e1e2t(ji,ijd) / e3t(ji,ijd,jk,Kmm) 281 283 ztra = zv_bbl * ( ptb(ji,ijd,jk+1,jn) - ptb(ji,ijd,jk,jn) ) * zbtr 282 284 pta(ji,ijd,jk,jn) = pta(ji,ijd,jk,jn) + ztra 283 285 END DO 284 286 ! ! down-slope T-point (deep bottom point) 285 zbtr = r1_e1e2t(ji,ijd) / e3t _n(ji,ijd,ikvd)287 zbtr = r1_e1e2t(ji,ijd) / e3t(ji,ijd,ikvd,Kmm) 286 288 ztra = zv_bbl * ( ptb(ji,ijs,ikvs,jn) - ptb(ji,ijd,ikvd,jn) ) * zbtr 287 289 pta(ji,ijd,ikvd,jn) = pta(ji,ijd,ikvd,jn) + ztra … … 296 298 297 299 298 SUBROUTINE bbl( kt, kit000, cdtype )300 SUBROUTINE bbl( kt, kit000, cdtype, Kbb, Kmm ) 299 301 !!---------------------------------------------------------------------- 300 302 !! *** ROUTINE bbl *** … … 325 327 INTEGER , INTENT(in ) :: kit000 ! first time step index 326 328 CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 329 INTEGER , INTENT(in ) :: Kbb, Kmm ! ocean time level index 327 330 ! 328 331 INTEGER :: ji, jj ! dummy loop indices … … 345 348 DO ji = 1, jpi 346 349 ik = mbkt(ji,jj) ! bottom T-level index 347 zts (ji,jj,jp_tem) = ts b(ji,jj,ik,jp_tem) ! bottom before T and S348 zts (ji,jj,jp_sal) = ts b(ji,jj,ik,jp_sal)350 zts (ji,jj,jp_tem) = ts(ji,jj,ik,jp_tem,Kbb) ! bottom before T and S 351 zts (ji,jj,jp_sal) = ts(ji,jj,ik,jp_sal,Kbb) 349 352 ! 350 zdep(ji,jj) = gdept _n(ji,jj,ik) ! bottom T-level reference depth351 zub (ji,jj) = u n(ji,jj,mbku(ji,jj)) ! bottom velocity352 zvb (ji,jj) = v n(ji,jj,mbkv(ji,jj))353 zdep(ji,jj) = gdept(ji,jj,ik,Kmm) ! bottom T-level reference depth 354 zub (ji,jj) = uu(ji,jj,mbku(ji,jj),Kmm) ! bottom velocity 355 zvb (ji,jj) = vv(ji,jj,mbkv(ji,jj),Kmm) 353 356 END DO 354 357 END DO 355 358 ! 356 CALL eos_rab( zts, zdep, zab )359 CALL eos_rab( zts, zdep, zab, Kmm ) 357 360 ! 358 361 ! !-------------------!
Note: See TracChangeset
for help on using the changeset viewer.
