- 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/TRA/trabbl.F90 (modified) (21 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/TRA/trabbl.F90
r12178 r12928 67 67 68 68 !! * Substitutions 69 # include " vectopt_loop_substitute.h90"69 # include "do_loop_substitute.h90" 70 70 !!---------------------------------------------------------------------- 71 71 !! NEMO/OCE 4.0 , NEMO Consortium (2018) … … 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)121 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' )122 CALL tra_bbl_dif( pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts, Kmm ) 123 IF( sn_cfctl%l_prtctl ) & 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)134 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' )135 CALL tra_bbl_adv( pts(:,:,:,:,Kbb), pts(:,:,:,:,Krhs), jpts, Kmm ) 136 IF(sn_cfctl%l_prtctl) & 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 … … 188 191 DO jn = 1, kjpt ! tracer loop 189 192 ! ! =========== 190 DO jj = 1, jpj 191 DO ji = 1, jpi 192 ik = mbkt(ji,jj) ! bottom T-level index 193 zptb(ji,jj) = ptb(ji,jj,ik,jn) ! bottom before T and S 194 END DO 195 END DO 193 DO_2D_11_11 194 ik = mbkt(ji,jj) ! bottom T-level index 195 zptb(ji,jj) = pt(ji,jj,ik,jn) ! bottom before T and S 196 END_2D 196 197 ! 197 DO jj = 2, jpjm1 ! Compute the trend 198 DO ji = 2, jpim1 199 ik = mbkt(ji,jj) ! bottom T-level index 200 pta(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) 206 END DO 207 END DO 198 DO_2D_00_00 199 ik = mbkt(ji,jj) ! bottom T-level index 200 pt_rhs(ji,jj,ik,jn) = pt_rhs(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(ji,jj,ik,Kmm) 206 END_2D 208 207 ! ! =========== 209 208 END DO ! end tracer … … 212 211 213 212 214 SUBROUTINE tra_bbl_adv( pt b, pta, kjpt)213 SUBROUTINE tra_bbl_adv( pt, pt_rhs, kjpt, Kmm ) 215 214 !!---------------------------------------------------------------------- 216 215 !! *** ROUTINE trc_bbl *** … … 228 227 !!---------------------------------------------------------------------- 229 228 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 229 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: pt ! before and now tracer fields 230 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pt_rhs ! tracer trend 231 INTEGER , INTENT(in ) :: Kmm ! time level indices 232 232 ! 233 233 INTEGER :: ji, jj, jk, jn ! dummy loop indices … … 250 250 ! 251 251 ! ! 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) + ztra252 zbtr = r1_e1e2t(iis,jj) / e3t(iis,jj,ikus,Kmm) 253 ztra = zu_bbl * ( pt(iid,jj,ikus,jn) - pt(iis,jj,ikus,jn) ) * zbtr 254 pt_rhs(iis,jj,ikus,jn) = pt_rhs(iis,jj,ikus,jn) + ztra 255 255 ! 256 256 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) + ztra257 zbtr = r1_e1e2t(iid,jj) / e3t(iid,jj,jk,Kmm) 258 ztra = zu_bbl * ( pt(iid,jj,jk+1,jn) - pt(iid,jj,jk,jn) ) * zbtr 259 pt_rhs(iid,jj,jk,jn) = pt_rhs(iid,jj,jk,jn) + ztra 260 260 END DO 261 261 ! 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) + ztra262 zbtr = r1_e1e2t(iid,jj) / e3t(iid,jj,ikud,Kmm) 263 ztra = zu_bbl * ( pt(iis,jj,ikus,jn) - pt(iid,jj,ikud,jn) ) * zbtr 264 pt_rhs(iid,jj,ikud,jn) = pt_rhs(iid,jj,ikud,jn) + ztra 265 265 ENDIF 266 266 ! … … 272 272 ! 273 273 ! 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) + ztra274 zbtr = r1_e1e2t(ji,ijs) / e3t(ji,ijs,ikvs,Kmm) 275 ztra = zv_bbl * ( pt(ji,ijd,ikvs,jn) - pt(ji,ijs,ikvs,jn) ) * zbtr 276 pt_rhs(ji,ijs,ikvs,jn) = pt_rhs(ji,ijs,ikvs,jn) + ztra 277 277 ! 278 278 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) + ztra279 zbtr = r1_e1e2t(ji,ijd) / e3t(ji,ijd,jk,Kmm) 280 ztra = zv_bbl * ( pt(ji,ijd,jk+1,jn) - pt(ji,ijd,jk,jn) ) * zbtr 281 pt_rhs(ji,ijd,jk,jn) = pt_rhs(ji,ijd,jk,jn) + ztra 282 282 END DO 283 283 ! ! 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) + ztra284 zbtr = r1_e1e2t(ji,ijd) / e3t(ji,ijd,ikvd,Kmm) 285 ztra = zv_bbl * ( pt(ji,ijs,ikvs,jn) - pt(ji,ijd,ikvd,jn) ) * zbtr 286 pt_rhs(ji,ijd,ikvd,jn) = pt_rhs(ji,ijd,ikvd,jn) + ztra 287 287 ENDIF 288 288 END DO … … 295 295 296 296 297 SUBROUTINE bbl( kt, kit000, cdtype )297 SUBROUTINE bbl( kt, kit000, cdtype, Kbb, Kmm ) 298 298 !!---------------------------------------------------------------------- 299 299 !! *** ROUTINE bbl *** … … 324 324 INTEGER , INTENT(in ) :: kit000 ! first time step index 325 325 CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) 326 INTEGER , INTENT(in ) :: Kbb, Kmm ! ocean time level index 326 327 ! 327 328 INTEGER :: ji, jj ! dummy loop indices … … 341 342 ENDIF 342 343 ! !* bottom variables (T, S, alpha, beta, depth, velocity) 343 DO jj = 1, jpj 344 DO ji = 1, jpi 345 ik = mbkt(ji,jj) ! bottom T-level index 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) 348 ! 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)) 352 END DO 353 END DO 354 ! 355 CALL eos_rab( zts, zdep, zab ) 344 DO_2D_11_11 345 ik = mbkt(ji,jj) ! bottom T-level index 346 zts (ji,jj,jp_tem) = ts(ji,jj,ik,jp_tem,Kbb) ! bottom before T and S 347 zts (ji,jj,jp_sal) = ts(ji,jj,ik,jp_sal,Kbb) 348 ! 349 zdep(ji,jj) = gdept(ji,jj,ik,Kmm) ! bottom T-level reference depth 350 zub (ji,jj) = uu(ji,jj,mbku(ji,jj),Kmm) ! bottom velocity 351 zvb (ji,jj) = vv(ji,jj,mbkv(ji,jj),Kmm) 352 END_2D 353 ! 354 CALL eos_rab( zts, zdep, zab, Kmm ) 356 355 ! 357 356 ! !-------------------! 358 357 IF( nn_bbl_ldf == 1 ) THEN ! diffusive bbl ! 359 358 ! !-------------------! 360 DO jj = 1, jpjm1 ! (criteria for non zero flux: grad(rho).grad(h) < 0 ) 361 DO ji = 1, fs_jpim1 ! vector opt. 362 ! ! i-direction 363 za = zab(ji+1,jj,jp_tem) + zab(ji,jj,jp_tem) ! 2*(alpha,beta) at u-point 364 zb = zab(ji+1,jj,jp_sal) + zab(ji,jj,jp_sal) 365 ! ! 2*masked bottom density gradient 366 zgdrho = ( za * ( zts(ji+1,jj,jp_tem) - zts(ji,jj,jp_tem) ) & 367 & - zb * ( zts(ji+1,jj,jp_sal) - zts(ji,jj,jp_sal) ) ) * umask(ji,jj,1) 368 ! 369 zsign = SIGN( 0.5, -zgdrho * REAL( mgrhu(ji,jj) ) ) ! sign of ( i-gradient * i-slope ) 370 ahu_bbl(ji,jj) = ( 0.5 - zsign ) * ahu_bbl_0(ji,jj) ! masked diffusive flux coeff. 371 ! 372 ! ! j-direction 373 za = zab(ji,jj+1,jp_tem) + zab(ji,jj,jp_tem) ! 2*(alpha,beta) at v-point 374 zb = zab(ji,jj+1,jp_sal) + zab(ji,jj,jp_sal) 375 ! ! 2*masked bottom density gradient 376 zgdrho = ( za * ( zts(ji,jj+1,jp_tem) - zts(ji,jj,jp_tem) ) & 377 & - zb * ( zts(ji,jj+1,jp_sal) - zts(ji,jj,jp_sal) ) ) * vmask(ji,jj,1) 378 ! 379 zsign = SIGN( 0.5, -zgdrho * REAL( mgrhv(ji,jj) ) ) ! sign of ( j-gradient * j-slope ) 380 ahv_bbl(ji,jj) = ( 0.5 - zsign ) * ahv_bbl_0(ji,jj) 381 END DO 382 END DO 359 DO_2D_10_10 360 ! ! i-direction 361 za = zab(ji+1,jj,jp_tem) + zab(ji,jj,jp_tem) ! 2*(alpha,beta) at u-point 362 zb = zab(ji+1,jj,jp_sal) + zab(ji,jj,jp_sal) 363 ! ! 2*masked bottom density gradient 364 zgdrho = ( za * ( zts(ji+1,jj,jp_tem) - zts(ji,jj,jp_tem) ) & 365 & - zb * ( zts(ji+1,jj,jp_sal) - zts(ji,jj,jp_sal) ) ) * umask(ji,jj,1) 366 ! 367 zsign = SIGN( 0.5, -zgdrho * REAL( mgrhu(ji,jj) ) ) ! sign of ( i-gradient * i-slope ) 368 ahu_bbl(ji,jj) = ( 0.5 - zsign ) * ahu_bbl_0(ji,jj) ! masked diffusive flux coeff. 369 ! 370 ! ! j-direction 371 za = zab(ji,jj+1,jp_tem) + zab(ji,jj,jp_tem) ! 2*(alpha,beta) at v-point 372 zb = zab(ji,jj+1,jp_sal) + zab(ji,jj,jp_sal) 373 ! ! 2*masked bottom density gradient 374 zgdrho = ( za * ( zts(ji,jj+1,jp_tem) - zts(ji,jj,jp_tem) ) & 375 & - zb * ( zts(ji,jj+1,jp_sal) - zts(ji,jj,jp_sal) ) ) * vmask(ji,jj,1) 376 ! 377 zsign = SIGN( 0.5, -zgdrho * REAL( mgrhv(ji,jj) ) ) ! sign of ( j-gradient * j-slope ) 378 ahv_bbl(ji,jj) = ( 0.5 - zsign ) * ahv_bbl_0(ji,jj) 379 END_2D 383 380 ! 384 381 ENDIF … … 390 387 ! 391 388 CASE( 1 ) != use of upper velocity 392 DO jj = 1, jpjm1 ! criteria: grad(rho).grad(h)<0 and grad(rho).grad(h)<0 393 DO ji = 1, fs_jpim1 ! vector opt. 394 ! ! i-direction 395 za = zab(ji+1,jj,jp_tem) + zab(ji,jj,jp_tem) ! 2*(alpha,beta) at u-point 396 zb = zab(ji+1,jj,jp_sal) + zab(ji,jj,jp_sal) 397 ! ! 2*masked bottom density gradient 398 zgdrho = ( za * ( zts(ji+1,jj,jp_tem) - zts(ji,jj,jp_tem) ) & 399 - zb * ( zts(ji+1,jj,jp_sal) - zts(ji,jj,jp_sal) ) ) * umask(ji,jj,1) 400 ! 401 zsign = SIGN( 0.5, - zgdrho * REAL( mgrhu(ji,jj) ) ) ! sign of i-gradient * i-slope 402 zsigna= SIGN( 0.5, zub(ji,jj) * REAL( mgrhu(ji,jj) ) ) ! sign of u * i-slope 403 ! 404 ! ! bbl velocity 405 utr_bbl(ji,jj) = ( 0.5 + zsigna ) * ( 0.5 - zsign ) * e2u(ji,jj) * e3u_bbl_0(ji,jj) * zub(ji,jj) 406 ! 407 ! ! j-direction 408 za = zab(ji,jj+1,jp_tem) + zab(ji,jj,jp_tem) ! 2*(alpha,beta) at v-point 409 zb = zab(ji,jj+1,jp_sal) + zab(ji,jj,jp_sal) 410 ! ! 2*masked bottom density gradient 411 zgdrho = ( za * ( zts(ji,jj+1,jp_tem) - zts(ji,jj,jp_tem) ) & 412 & - zb * ( zts(ji,jj+1,jp_sal) - zts(ji,jj,jp_sal) ) ) * vmask(ji,jj,1) 413 zsign = SIGN( 0.5, - zgdrho * REAL( mgrhv(ji,jj) ) ) ! sign of j-gradient * j-slope 414 zsigna= SIGN( 0.5, zvb(ji,jj) * REAL( mgrhv(ji,jj) ) ) ! sign of u * i-slope 415 ! 416 ! ! bbl transport 417 vtr_bbl(ji,jj) = ( 0.5 + zsigna ) * ( 0.5 - zsign ) * e1v(ji,jj) * e3v_bbl_0(ji,jj) * zvb(ji,jj) 418 END DO 419 END DO 389 DO_2D_10_10 390 ! ! i-direction 391 za = zab(ji+1,jj,jp_tem) + zab(ji,jj,jp_tem) ! 2*(alpha,beta) at u-point 392 zb = zab(ji+1,jj,jp_sal) + zab(ji,jj,jp_sal) 393 ! ! 2*masked bottom density gradient 394 zgdrho = ( za * ( zts(ji+1,jj,jp_tem) - zts(ji,jj,jp_tem) ) & 395 - zb * ( zts(ji+1,jj,jp_sal) - zts(ji,jj,jp_sal) ) ) * umask(ji,jj,1) 396 ! 397 zsign = SIGN( 0.5, - zgdrho * REAL( mgrhu(ji,jj) ) ) ! sign of i-gradient * i-slope 398 zsigna= SIGN( 0.5, zub(ji,jj) * REAL( mgrhu(ji,jj) ) ) ! sign of u * i-slope 399 ! 400 ! ! bbl velocity 401 utr_bbl(ji,jj) = ( 0.5 + zsigna ) * ( 0.5 - zsign ) * e2u(ji,jj) * e3u_bbl_0(ji,jj) * zub(ji,jj) 402 ! 403 ! ! j-direction 404 za = zab(ji,jj+1,jp_tem) + zab(ji,jj,jp_tem) ! 2*(alpha,beta) at v-point 405 zb = zab(ji,jj+1,jp_sal) + zab(ji,jj,jp_sal) 406 ! ! 2*masked bottom density gradient 407 zgdrho = ( za * ( zts(ji,jj+1,jp_tem) - zts(ji,jj,jp_tem) ) & 408 & - zb * ( zts(ji,jj+1,jp_sal) - zts(ji,jj,jp_sal) ) ) * vmask(ji,jj,1) 409 zsign = SIGN( 0.5, - zgdrho * REAL( mgrhv(ji,jj) ) ) ! sign of j-gradient * j-slope 410 zsigna= SIGN( 0.5, zvb(ji,jj) * REAL( mgrhv(ji,jj) ) ) ! sign of u * i-slope 411 ! 412 ! ! bbl transport 413 vtr_bbl(ji,jj) = ( 0.5 + zsigna ) * ( 0.5 - zsign ) * e1v(ji,jj) * e3v_bbl_0(ji,jj) * zvb(ji,jj) 414 END_2D 420 415 ! 421 416 CASE( 2 ) != bbl velocity = F( delta rho ) 422 417 zgbbl = grav * rn_gambbl 423 DO jj = 1, jpjm1 ! criteria: rho_up > rho_down 424 DO ji = 1, fs_jpim1 ! vector opt. 425 ! ! i-direction 426 ! down-slope T-point i/k-index (deep) & up-slope T-point i/k-index (shelf) 427 iid = ji + MAX( 0, mgrhu(ji,jj) ) 428 iis = ji + 1 - MAX( 0, mgrhu(ji,jj) ) 429 ! 430 ikud = mbku_d(ji,jj) 431 ikus = mbku(ji,jj) 432 ! 433 za = zab(ji+1,jj,jp_tem) + zab(ji,jj,jp_tem) ! 2*(alpha,beta) at u-point 434 zb = zab(ji+1,jj,jp_sal) + zab(ji,jj,jp_sal) 435 ! ! masked bottom density gradient 436 zgdrho = 0.5 * ( za * ( zts(iid,jj,jp_tem) - zts(iis,jj,jp_tem) ) & 437 & - zb * ( zts(iid,jj,jp_sal) - zts(iis,jj,jp_sal) ) ) * umask(ji,jj,1) 438 zgdrho = MAX( 0.e0, zgdrho ) ! only if shelf is denser than deep 439 ! 440 ! ! bbl transport (down-slope direction) 441 utr_bbl(ji,jj) = e2u(ji,jj) * e3u_bbl_0(ji,jj) * zgbbl * zgdrho * REAL( mgrhu(ji,jj) ) 442 ! 443 ! ! j-direction 444 ! down-slope T-point j/k-index (deep) & of the up -slope T-point j/k-index (shelf) 445 ijd = jj + MAX( 0, mgrhv(ji,jj) ) 446 ijs = jj + 1 - MAX( 0, mgrhv(ji,jj) ) 447 ! 448 ikvd = mbkv_d(ji,jj) 449 ikvs = mbkv(ji,jj) 450 ! 451 za = zab(ji,jj+1,jp_tem) + zab(ji,jj,jp_tem) ! 2*(alpha,beta) at v-point 452 zb = zab(ji,jj+1,jp_sal) + zab(ji,jj,jp_sal) 453 ! ! masked bottom density gradient 454 zgdrho = 0.5 * ( za * ( zts(ji,ijd,jp_tem) - zts(ji,ijs,jp_tem) ) & 455 & - zb * ( zts(ji,ijd,jp_sal) - zts(ji,ijs,jp_sal) ) ) * vmask(ji,jj,1) 456 zgdrho = MAX( 0.e0, zgdrho ) ! only if shelf is denser than deep 457 ! 458 ! ! bbl transport (down-slope direction) 459 vtr_bbl(ji,jj) = e1v(ji,jj) * e3v_bbl_0(ji,jj) * zgbbl * zgdrho * REAL( mgrhv(ji,jj) ) 460 END DO 461 END DO 418 DO_2D_10_10 419 ! ! i-direction 420 ! down-slope T-point i/k-index (deep) & up-slope T-point i/k-index (shelf) 421 iid = ji + MAX( 0, mgrhu(ji,jj) ) 422 iis = ji + 1 - MAX( 0, mgrhu(ji,jj) ) 423 ! 424 ikud = mbku_d(ji,jj) 425 ikus = mbku(ji,jj) 426 ! 427 za = zab(ji+1,jj,jp_tem) + zab(ji,jj,jp_tem) ! 2*(alpha,beta) at u-point 428 zb = zab(ji+1,jj,jp_sal) + zab(ji,jj,jp_sal) 429 ! ! masked bottom density gradient 430 zgdrho = 0.5 * ( za * ( zts(iid,jj,jp_tem) - zts(iis,jj,jp_tem) ) & 431 & - zb * ( zts(iid,jj,jp_sal) - zts(iis,jj,jp_sal) ) ) * umask(ji,jj,1) 432 zgdrho = MAX( 0.e0, zgdrho ) ! only if shelf is denser than deep 433 ! 434 ! ! bbl transport (down-slope direction) 435 utr_bbl(ji,jj) = e2u(ji,jj) * e3u_bbl_0(ji,jj) * zgbbl * zgdrho * REAL( mgrhu(ji,jj) ) 436 ! 437 ! ! j-direction 438 ! down-slope T-point j/k-index (deep) & of the up -slope T-point j/k-index (shelf) 439 ijd = jj + MAX( 0, mgrhv(ji,jj) ) 440 ijs = jj + 1 - MAX( 0, mgrhv(ji,jj) ) 441 ! 442 ikvd = mbkv_d(ji,jj) 443 ikvs = mbkv(ji,jj) 444 ! 445 za = zab(ji,jj+1,jp_tem) + zab(ji,jj,jp_tem) ! 2*(alpha,beta) at v-point 446 zb = zab(ji,jj+1,jp_sal) + zab(ji,jj,jp_sal) 447 ! ! masked bottom density gradient 448 zgdrho = 0.5 * ( za * ( zts(ji,ijd,jp_tem) - zts(ji,ijs,jp_tem) ) & 449 & - zb * ( zts(ji,ijd,jp_sal) - zts(ji,ijs,jp_sal) ) ) * vmask(ji,jj,1) 450 zgdrho = MAX( 0.e0, zgdrho ) ! only if shelf is denser than deep 451 ! 452 ! ! bbl transport (down-slope direction) 453 vtr_bbl(ji,jj) = e1v(ji,jj) * e3v_bbl_0(ji,jj) * zgbbl * zgdrho * REAL( mgrhv(ji,jj) ) 454 END_2D 462 455 END SELECT 463 456 ! … … 483 476 !!---------------------------------------------------------------------- 484 477 ! 485 REWIND( numnam_ref ) ! Namelist nambbl in reference namelist : Bottom boundary layer scheme486 478 READ ( numnam_ref, nambbl, IOSTAT = ios, ERR = 901) 487 479 901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'nambbl in reference namelist' ) 488 480 ! 489 REWIND( numnam_cfg ) ! Namelist nambbl in configuration namelist : Bottom boundary layer scheme490 481 READ ( numnam_cfg, nambbl, IOSTAT = ios, ERR = 902 ) 491 482 902 IF( ios > 0 ) CALL ctl_nam ( ios , 'nambbl in configuration namelist' ) … … 517 508 ! 518 509 ! !* vertical index of "deep" bottom u- and v-points 519 DO jj = 1, jpjm1 ! (the "shelf" bottom k-indices are mbku and mbkv) 520 DO ji = 1, jpim1 521 mbku_d(ji,jj) = MAX( mbkt(ji+1,jj ) , mbkt(ji,jj) ) ! >= 1 as mbkt=1 over land 522 mbkv_d(ji,jj) = MAX( mbkt(ji ,jj+1) , mbkt(ji,jj) ) 523 END DO 524 END DO 510 DO_2D_10_10 511 mbku_d(ji,jj) = MAX( mbkt(ji+1,jj ) , mbkt(ji,jj) ) ! >= 1 as mbkt=1 over land 512 mbkv_d(ji,jj) = MAX( mbkt(ji ,jj+1) , mbkt(ji,jj) ) 513 END_2D 525 514 ! converte into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 526 515 zmbku(:,:) = REAL( mbku_d(:,:), wp ) ; zmbkv(:,:) = REAL( mbkv_d(:,:), wp ) … … 530 519 ! !* sign of grad(H) at u- and v-points; zero if grad(H) = 0 531 520 mgrhu(:,:) = 0 ; mgrhv(:,:) = 0 532 DO jj = 1, jpjm1 533 DO ji = 1, jpim1 534 IF( gdept_0(ji+1,jj,mbkt(ji+1,jj)) - gdept_0(ji,jj,mbkt(ji,jj)) /= 0._wp ) THEN 535 mgrhu(ji,jj) = INT( SIGN( 1.e0, gdept_0(ji+1,jj,mbkt(ji+1,jj)) - gdept_0(ji,jj,mbkt(ji,jj)) ) ) 536 ENDIF 537 ! 538 IF( gdept_0(ji,jj+1,mbkt(ji,jj+1)) - gdept_0(ji,jj,mbkt(ji,jj)) /= 0._wp ) THEN 539 mgrhv(ji,jj) = INT( SIGN( 1.e0, gdept_0(ji,jj+1,mbkt(ji,jj+1)) - gdept_0(ji,jj,mbkt(ji,jj)) ) ) 540 ENDIF 541 END DO 542 END DO 543 ! 544 DO jj = 1, jpjm1 !* bbl thickness at u- (v-) point 545 DO ji = 1, jpim1 ! minimum of top & bottom e3u_0 (e3v_0) 546 e3u_bbl_0(ji,jj) = MIN( e3u_0(ji,jj,mbkt(ji+1,jj )), e3u_0(ji,jj,mbkt(ji,jj)) ) 547 e3v_bbl_0(ji,jj) = MIN( e3v_0(ji,jj,mbkt(ji ,jj+1)), e3v_0(ji,jj,mbkt(ji,jj)) ) 548 END DO 549 END DO 521 DO_2D_10_10 522 IF( gdept_0(ji+1,jj,mbkt(ji+1,jj)) - gdept_0(ji,jj,mbkt(ji,jj)) /= 0._wp ) THEN 523 mgrhu(ji,jj) = INT( SIGN( 1.e0, gdept_0(ji+1,jj,mbkt(ji+1,jj)) - gdept_0(ji,jj,mbkt(ji,jj)) ) ) 524 ENDIF 525 ! 526 IF( gdept_0(ji,jj+1,mbkt(ji,jj+1)) - gdept_0(ji,jj,mbkt(ji,jj)) /= 0._wp ) THEN 527 mgrhv(ji,jj) = INT( SIGN( 1.e0, gdept_0(ji,jj+1,mbkt(ji,jj+1)) - gdept_0(ji,jj,mbkt(ji,jj)) ) ) 528 ENDIF 529 END_2D 530 ! 531 DO_2D_10_10 532 e3u_bbl_0(ji,jj) = MIN( e3u_0(ji,jj,mbkt(ji+1,jj )), e3u_0(ji,jj,mbkt(ji,jj)) ) 533 e3v_bbl_0(ji,jj) = MIN( e3v_0(ji,jj,mbkt(ji ,jj+1)), e3v_0(ji,jj,mbkt(ji,jj)) ) 534 END_2D 550 535 CALL lbc_lnk_multi( 'trabbl', e3u_bbl_0, 'U', 1. , e3v_bbl_0, 'V', 1. ) ! lateral boundary conditions 551 536 !
Note: See TracChangeset
for help on using the changeset viewer.
