- Timestamp:
- 2014-04-06T17:28:25+02:00 (10 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2014/dev_CNRS0_NOC1_LDF/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90
r4292 r4616 37 37 USE timing ! Timing 38 38 39 40 39 IMPLICIT NONE 41 40 PRIVATE … … 47 46 PUBLIC bbl ! routine called by trcbbl.F90 and dtadyn.F90 48 47 49 LOGICAL, PUBLIC, PARAMETER :: lk_trabbl = .TRUE. !: bottom boundary layer flag 50 51 ! !!* Namelist nambbl * 52 INTEGER , PUBLIC :: nn_bbl_ldf !: =1 : diffusive bbl or not (=0) 53 INTEGER , PUBLIC :: nn_bbl_adv !: =1/2 : advective bbl or not (=0) 54 ! ! =1 : advective bbl using the bottom ocean velocity 55 ! ! =2 : - - using utr_bbl proportional to grad(rho) 56 REAL(wp), PUBLIC :: rn_ahtbbl !: along slope bbl diffusive coefficient [m2/s] 57 REAL(wp), PUBLIC :: rn_gambbl !: lateral coeff. for bottom boundary layer scheme [s] 58 59 LOGICAL , PUBLIC :: l_bbl !: flag to compute bbl diffu. flux coef and transport 48 ! !!* Namelist nambbl * 49 LOGICAL , PUBLIC :: ln_trabbl !: bottom boundary layer flag 50 INTEGER , PUBLIC :: nn_bbl_ldf !: =1 : diffusive bbl or not (=0) 51 INTEGER , PUBLIC :: nn_bbl_adv !: =1/2 : advective bbl or not (=0) 52 ! ! =1 : advective bbl using the bottom ocean velocity 53 ! ! =2 : - - using utr_bbl proportional to grad(rho) 54 REAL(wp), PUBLIC :: rn_ahtbbl !: along slope bbl diffusive coefficient [m2/s] 55 REAL(wp), PUBLIC :: rn_gambbl !: lateral coeff. for bottom boundary layer scheme [s] 56 57 LOGICAL , PUBLIC :: l_bbl !: flag to compute bbl diffu. flux coef and transport 60 58 61 59 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC :: utr_bbl , vtr_bbl ! u- (v-) transport in the bottom boundary layer … … 179 177 !! Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430. 180 178 !!---------------------------------------------------------------------- 181 !182 179 INTEGER , INTENT(in ) :: kjpt ! number of tracers 183 180 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! before and now tracer fields … … 186 183 INTEGER :: ji, jj, jn ! dummy loop indices 187 184 INTEGER :: ik ! local integers 188 REAL(wp) :: zbtr ! local scalars189 185 REAL(wp), POINTER, DIMENSION(:,:) :: zptb 190 186 !!---------------------------------------------------------------------- … … 196 192 DO jn = 1, kjpt ! tracer loop 197 193 ! ! =========== 198 # if defined key_vectopt_loop199 DO jj = 1, 1 ! vector opt. (forced unrolling)200 DO ji = 1, jpij201 #else202 194 DO jj = 1, jpj 203 195 DO ji = 1, jpi 204 #endif205 196 ik = mbkt(ji,jj) ! bottom T-level index 206 197 zptb(ji,jj) = ptb(ji,jj,ik,jn) ! bottom before T and S … … 208 199 END DO 209 200 ! ! Compute the trend 210 # if defined key_vectopt_loop211 DO jj = 1, 1 ! vector opt. (forced unrolling)212 DO ji = jpi+1, jpij-jpi-1213 # else214 201 DO jj = 2, jpjm1 215 202 DO ji = 2, jpim1 216 # endif217 203 ik = mbkt(ji,jj) ! bottom T-level index 218 zbtr = r1_e12t(ji,jj) / fse3t(ji,jj,ik)219 pta(ji,jj,ik,jn) = pta(ji,jj,ik,jn)&220 & + ( ahu_bbl(ji ,jj ) * ( zptb(ji+1,jj ) - zptb(ji ,jj ) )&221 & - ahu_bbl(ji-1,jj ) * ( zptb(ji ,jj ) - zptb(ji-1,jj ) )&222 & + ahv_bbl(ji ,jj ) * ( zptb(ji ,jj+1) - zptb(ji ,jj ) )&223 & - ahv_bbl(ji ,jj-1) * ( zptb(ji ,jj ) - zptb(ji ,jj-1) ) ) * zbtr204 pta(ji,jj,ik,jn) = pta(ji,jj,ik,jn) & 205 & + ( ahu_bbl(ji ,jj ) * ( zptb(ji+1,jj ) - zptb(ji ,jj ) ) & 206 & - ahu_bbl(ji-1,jj ) * ( zptb(ji ,jj ) - zptb(ji-1,jj ) ) & 207 & + ahv_bbl(ji ,jj ) * ( zptb(ji ,jj+1) - zptb(ji ,jj ) ) & 208 & - ahv_bbl(ji ,jj-1) * ( zptb(ji ,jj ) - zptb(ji ,jj-1) ) ) & 209 & / ( e1e2t(ji,jj) * fse3t(ji,jj,ik) ) 224 210 END DO 225 211 END DO … … 264 250 DO jn = 1, kjpt ! tracer loop 265 251 ! ! =========== 266 # if defined key_vectopt_loop267 DO jj = 1, 1268 DO ji = 1, jpij-jpi-1 ! vector opt. (forced unrolling)269 # else270 252 DO jj = 1, jpjm1 271 253 DO ji = 1, jpim1 ! CAUTION start from i=1 to update i=2 when cyclic east-west 272 # endif273 254 IF( utr_bbl(ji,jj) /= 0.e0 ) THEN ! non-zero i-direction bbl advection 274 255 ! down-slope i/k-indices (deep) & up-slope i/k indices (shelf) … … 278 259 ! 279 260 ! ! up -slope T-point (shelf bottom point) 280 zbtr = r1_e1 2t(iis,jj) / fse3t(iis,jj,ikus)261 zbtr = r1_e1e2t(iis,jj) / fse3t(iis,jj,ikus) 281 262 ztra = zu_bbl * ( ptb(iid,jj,ikus,jn) - ptb(iis,jj,ikus,jn) ) * zbtr 282 263 pta(iis,jj,ikus,jn) = pta(iis,jj,ikus,jn) + ztra 283 264 ! 284 265 DO jk = ikus, ikud-1 ! down-slope upper to down T-point (deep column) 285 zbtr = r1_e1 2t(iid,jj) / fse3t(iid,jj,jk)266 zbtr = r1_e1e2t(iid,jj) / fse3t(iid,jj,jk) 286 267 ztra = zu_bbl * ( ptb(iid,jj,jk+1,jn) - ptb(iid,jj,jk,jn) ) * zbtr 287 268 pta(iid,jj,jk,jn) = pta(iid,jj,jk,jn) + ztra 288 269 END DO 289 270 ! 290 zbtr = r1_e1 2t(iid,jj) / fse3t(iid,jj,ikud)271 zbtr = r1_e1e2t(iid,jj) / fse3t(iid,jj,ikud) 291 272 ztra = zu_bbl * ( ptb(iis,jj,ikus,jn) - ptb(iid,jj,ikud,jn) ) * zbtr 292 273 pta(iid,jj,ikud,jn) = pta(iid,jj,ikud,jn) + ztra … … 300 281 ! 301 282 ! up -slope T-point (shelf bottom point) 302 zbtr = r1_e1 2t(ji,ijs) / fse3t(ji,ijs,ikvs)283 zbtr = r1_e1e2t(ji,ijs) / fse3t(ji,ijs,ikvs) 303 284 ztra = zv_bbl * ( ptb(ji,ijd,ikvs,jn) - ptb(ji,ijs,ikvs,jn) ) * zbtr 304 285 pta(ji,ijs,ikvs,jn) = pta(ji,ijs,ikvs,jn) + ztra 305 286 ! 306 287 DO jk = ikvs, ikvd-1 ! down-slope upper to down T-point (deep column) 307 zbtr = r1_e1 2t(ji,ijd) / fse3t(ji,ijd,jk)288 zbtr = r1_e1e2t(ji,ijd) / fse3t(ji,ijd,jk) 308 289 ztra = zv_bbl * ( ptb(ji,ijd,jk+1,jn) - ptb(ji,ijd,jk,jn) ) * zbtr 309 290 pta(ji,ijd,jk,jn) = pta(ji,ijd,jk,jn) + ztra 310 291 END DO 311 292 ! ! down-slope T-point (deep bottom point) 312 zbtr = r1_e1 2t(ji,ijd) / fse3t(ji,ijd,ikvd)293 zbtr = r1_e1e2t(ji,ijd) / fse3t(ji,ijd,ikvd) 313 294 ztra = zv_bbl * ( ptb(ji,ijs,ikvs,jn) - ptb(ji,ijd,ikvd,jn) ) * zbtr 314 295 pta(ji,ijd,ikvd,jn) = pta(ji,ijd,ikvd,jn) + ztra … … 353 334 !! Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430. 354 335 !!---------------------------------------------------------------------- 355 !356 336 INTEGER , INTENT(in ) :: kt ! ocean time-step index 357 337 INTEGER , INTENT(in ) :: kit000 ! first time step index … … 412 392 413 393 ! !* bottom temperature, salinity, velocity and depth 414 #if defined key_vectopt_loop415 DO jj = 1, 1 ! vector opt. (forced unrolling)416 DO ji = 1, jpij417 #else418 394 DO jj = 1, jpj 419 395 DO ji = 1, jpi 420 #endif421 396 ik = mbkt(ji,jj) ! bottom T-level index 422 397 ztb (ji,jj) = tsb(ji,jj,ik,jp_tem) * tmask(ji,jj,1) ! bottom before T and S … … 629 604 630 605 ! !* masked diffusive flux coefficients 631 ahu_bbl_0(:,:) = rn_ahtbbl * e2 u(:,:) * e3u_bbl_0(:,:) / e1u(:,:)* umask(:,:,1)632 ahv_bbl_0(:,:) = rn_ahtbbl * e1 v(:,:) * e3v_bbl_0(:,:) / e2v(:,:)* vmask(:,:,1)606 ahu_bbl_0(:,:) = rn_ahtbbl * e2_e1u(:,:) * e3u_bbl_0(:,:) * umask(:,:,1) 607 ahv_bbl_0(:,:) = rn_ahtbbl * e1_e2v(:,:) * e3v_bbl_0(:,:) * vmask(:,:,1) 633 608 634 609
Note: See TracChangeset
for help on using the changeset viewer.
