Changeset 10985 for NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/trabbl.F90
- Timestamp:
- 2019-05-15T21:19:35+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
r10954 r10985 89 89 90 90 91 SUBROUTINE tra_bbl( kt, Kbb, Kmm, Krhs )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 104 INTEGER, INTENT( in ) :: Kbb, Kmm, Krhs ! time level indices 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 105 106 ! 106 107 REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) :: ztrdt, ztrds … … 111 112 IF( l_trdtra ) THEN !* Save the T-S input trends 112 113 ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) ) 113 ztrdt(:,:,:) = ts(:,:,:,jp_tem,Krhs)114 ztrds(:,:,:) = ts(:,:,:,jp_sal,Krhs)114 ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) 115 ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) 115 116 ENDIF 116 117 … … 119 120 IF( nn_bbl_ldf == 1 ) THEN !* Diffusive bbl 120 121 ! 121 CALL tra_bbl_dif( ts(:,:,:,:,Kbb),ts(:,:,:,:,Krhs), jpts, Kmm )122 CALL tra_bbl_dif( pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts, Kmm ) 122 123 IF( ln_ctl ) & 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' )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' ) 125 126 ! lateral boundary conditions ; just need for outputs 126 127 CALL lbc_lnk_multi( 'trabbl', ahu_bbl, 'U', 1. , ahv_bbl, 'V', 1. ) … … 132 133 IF( nn_bbl_adv /= 0 ) THEN !* Advective bbl 133 134 ! 134 CALL tra_bbl_adv( ts(:,:,:,:,Kbb),ts(:,:,:,:,Krhs), jpts, Kmm )135 CALL tra_bbl_adv( pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts, Kmm ) 135 136 IF(ln_ctl) & 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' )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' ) 138 139 ! lateral boundary conditions ; just need for outputs 139 140 CALL lbc_lnk_multi( 'trabbl', utr_bbl, 'U', 1. , vtr_bbl, 'V', 1. ) … … 144 145 145 146 IF( l_trdtra ) THEN ! send the trends for further diagnostics 146 ztrdt(:,:,:) = ts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:)147 ztrds(:,:,:) = ts(:,:,:,jp_sal,Krhs) - ztrds(:,:,:)147 ztrdt(:,:,:) = pts(:,:,:,jp_tem,Krhs) - ztrdt(:,:,:) 148 ztrds(:,:,:) = pts(:,:,:,jp_sal,Krhs) - ztrds(:,:,:) 148 149 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_tem, jptra_bbl, ztrdt ) 149 150 CALL trd_tra( kt, Kmm, Krhs, 'TRA', jp_sal, jptra_bbl, ztrds ) … … 156 157 157 158 158 SUBROUTINE tra_bbl_dif( pt b, pta, kjpt, Kmm )159 SUBROUTINE tra_bbl_dif( pt, pt_rhs, kjpt, Kmm ) 159 160 !!---------------------------------------------------------------------- 160 161 !! *** ROUTINE tra_bbl_dif *** … … 172 173 !! convection is satified) 173 174 !! 174 !! ** Action : pt aincreased by the bbl diffusive trend175 !! ** Action : pt_rhs increased by the bbl diffusive trend 175 176 !! 176 177 !! References : Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591. … … 178 179 !!---------------------------------------------------------------------- 179 180 INTEGER , INTENT(in ) :: kjpt ! number of tracers 180 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pt b! before and now tracer fields181 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pt a! tracer trend181 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 182 183 INTEGER , INTENT(in ) :: Kmm ! time level indices 183 184 ! … … 193 194 DO ji = 1, jpi 194 195 ik = mbkt(ji,jj) ! bottom T-level index 195 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 196 197 END DO 197 198 END DO … … 200 201 DO ji = 2, jpim1 201 202 ik = mbkt(ji,jj) ! bottom T-level index 202 pt a(ji,jj,ik,jn) = pta(ji,jj,ik,jn) &203 & + ( ahu_bbl(ji ,jj ) * ( zptb(ji+1,jj ) - zptb(ji ,jj ) ) &204 & - ahu_bbl(ji-1,jj ) * ( zptb(ji ,jj ) - zptb(ji-1,jj ) ) &205 & + ahv_bbl(ji ,jj ) * ( zptb(ji ,jj+1) - zptb(ji ,jj ) ) &206 & - ahv_bbl(ji ,jj-1) * ( zptb(ji ,jj ) - zptb(ji ,jj-1) ) ) &207 & * r1_e1e2t(ji,jj) / e3t(ji,jj,ik,Kmm)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) 208 209 END DO 209 210 END DO … … 214 215 215 216 216 SUBROUTINE tra_bbl_adv( pt b, pta, kjpt, Kmm )217 SUBROUTINE tra_bbl_adv( pt, pt_rhs, kjpt, Kmm ) 217 218 !!---------------------------------------------------------------------- 218 219 !! *** ROUTINE trc_bbl *** … … 230 231 !!---------------------------------------------------------------------- 231 232 INTEGER , INTENT(in ) :: kjpt ! number of tracers 232 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pt b! before and now tracer fields233 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pt a! tracer trend233 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 234 235 INTEGER , INTENT(in ) :: Kmm ! time level indices 235 236 ! … … 254 255 ! ! up -slope T-point (shelf bottom point) 255 256 zbtr = r1_e1e2t(iis,jj) / e3t(iis,jj,ikus,Kmm) 256 ztra = zu_bbl * ( pt b(iid,jj,ikus,jn) - ptb(iis,jj,ikus,jn) ) * zbtr257 pt a(iis,jj,ikus,jn) = pta(iis,jj,ikus,jn) + ztra257 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 258 259 ! 259 260 DO jk = ikus, ikud-1 ! down-slope upper to down T-point (deep column) 260 261 zbtr = r1_e1e2t(iid,jj) / e3t(iid,jj,jk,Kmm) 261 ztra = zu_bbl * ( pt b(iid,jj,jk+1,jn) - ptb(iid,jj,jk,jn) ) * zbtr262 pt a(iid,jj,jk,jn) = pta(iid,jj,jk,jn) + ztra262 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 263 264 END DO 264 265 ! 265 266 zbtr = r1_e1e2t(iid,jj) / e3t(iid,jj,ikud,Kmm) 266 ztra = zu_bbl * ( pt b(iis,jj,ikus,jn) - ptb(iid,jj,ikud,jn) ) * zbtr267 pt a(iid,jj,ikud,jn) = pta(iid,jj,ikud,jn) + ztra267 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 268 269 ENDIF 269 270 ! … … 276 277 ! up -slope T-point (shelf bottom point) 277 278 zbtr = r1_e1e2t(ji,ijs) / e3t(ji,ijs,ikvs,Kmm) 278 ztra = zv_bbl * ( pt b(ji,ijd,ikvs,jn) - ptb(ji,ijs,ikvs,jn) ) * zbtr279 pt a(ji,ijs,ikvs,jn) = pta(ji,ijs,ikvs,jn) + ztra279 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 280 281 ! 281 282 DO jk = ikvs, ikvd-1 ! down-slope upper to down T-point (deep column) 282 283 zbtr = r1_e1e2t(ji,ijd) / e3t(ji,ijd,jk,Kmm) 283 ztra = zv_bbl * ( pt b(ji,ijd,jk+1,jn) - ptb(ji,ijd,jk,jn) ) * zbtr284 pt a(ji,ijd,jk,jn) = pta(ji,ijd,jk,jn) + ztra284 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 285 286 END DO 286 287 ! ! down-slope T-point (deep bottom point) 287 288 zbtr = r1_e1e2t(ji,ijd) / e3t(ji,ijd,ikvd,Kmm) 288 ztra = zv_bbl * ( pt b(ji,ijs,ikvs,jn) - ptb(ji,ijd,ikvd,jn) ) * zbtr289 pt a(ji,ijd,ikvd,jn) = pta(ji,ijd,ikvd,jn) + ztra289 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 290 291 ENDIF 291 292 END DO … … 348 349 DO ji = 1, jpi 349 350 ik = mbkt(ji,jj) ! bottom T-level index 350 zts (ji,jj,jp_tem) = ts(ji,jj,ik,jp_tem,Kbb) 351 zts (ji,jj,jp_tem) = ts(ji,jj,ik,jp_tem,Kbb) ! bottom before T and S 351 352 zts (ji,jj,jp_sal) = ts(ji,jj,ik,jp_sal,Kbb) 352 353 ! 353 zdep(ji,jj) = gdept(ji,jj,ik,Kmm) 354 zub (ji,jj) = uu(ji,jj,mbku(ji,jj),Kmm) 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 355 356 zvb (ji,jj) = vv(ji,jj,mbkv(ji,jj),Kmm) 356 357 END DO
Note: See TracChangeset
for help on using the changeset viewer.
