Changeset 2715 for trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90
- Timestamp:
- 2011-03-30T17:58:35+02:00 (13 years ago)
- File:
-
- 1 edited
-
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90 (modified) (17 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90
r2528 r2715 17 17 !! 'key_trabbl' or bottom boundary layer 18 18 !!---------------------------------------------------------------------- 19 !! tra_bbl_alloc : allocate trabbl arrays 19 20 !! tra_bbl : update the tracer trends due to the bottom boundary layer (advective and/or diffusive) 20 21 !! tra_bbl_dif : generic routine to compute bbl diffusive trend … … 53 54 REAL(wp), PUBLIC :: rn_gambbl = 10.0_wp !: lateral coeff. for bottom boundary layer scheme [s] 54 55 55 REAL(wp), DIMENSION(jpi,jpj), PUBLIC :: utr_bbl , vtr_bbl ! u- (v-) transport in the bottom boundary layer 56 REAL(wp), DIMENSION(jpi,jpj), PUBLIC :: ahu_bbl , ahv_bbl ! masked diffusive bbl coefficients at u and v-points 57 58 INTEGER , DIMENSION(jpi,jpj) :: mbku_d , mbkv_d ! vertical index of the "lower" bottom ocean U/V-level 59 INTEGER , DIMENSION(jpi,jpj) :: mgrhu , mgrhv ! = +/-1, sign of grad(H) in u-(v-)direction 60 REAL(wp), DIMENSION(jpi,jpj) :: ahu_bbl_0, ahv_bbl_0 ! diffusive bbl flux coefficients at u and v-points 61 REAL(wp), DIMENSION(jpi,jpj) :: e3u_bbl_0, e3v_bbl_0 ! thichness of the bbl (e3) at u and v-points 62 REAL(wp), DIMENSION(jpi,jpj) :: e1e2t_r ! thichness of the bbl (e3) at u and v-points 63 LOGICAL, PUBLIC :: l_bbl !: flag to compute bbl diffu. flux coef and transport 56 LOGICAL , PUBLIC :: l_bbl !: flag to compute bbl diffu. flux coef and transport 57 58 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC :: utr_bbl , vtr_bbl ! u- (v-) transport in the bottom boundary layer 59 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC :: ahu_bbl , ahv_bbl ! masked diffusive bbl coeff. at u & v-pts 60 61 INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:) :: mbku_d , mbkv_d ! vertical index of the "lower" bottom ocean U/V-level 62 INTEGER , ALLOCATABLE, SAVE, DIMENSION(:,:) :: mgrhu , mgrhv ! = +/-1, sign of grad(H) in u-(v-)direction 63 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ahu_bbl_0, ahv_bbl_0 ! diffusive bbl flux coefficients at u and v-points 64 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: e3u_bbl_0, e3v_bbl_0 ! thichness of the bbl (e3) at u and v-points 65 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: r1_e1e2t ! inverse of the cell surface at t-point [1/m2] 64 66 65 67 !! * Substitutions … … 72 74 !!---------------------------------------------------------------------- 73 75 CONTAINS 76 77 INTEGER FUNCTION tra_bbl_alloc() 78 !!---------------------------------------------------------------------- 79 !! *** FUNCTION tra_bbl_alloc *** 80 !!---------------------------------------------------------------------- 81 ALLOCATE( utr_bbl (jpi,jpj) , ahu_bbl (jpi,jpj) , mbku_d (jpi,jpj) , mgrhu(jpi,jpj) , & 82 & vtr_bbl (jpi,jpj) , ahv_bbl (jpi,jpj) , mbkv_d (jpi,jpj) , mgrhv(jpi,jpj) , & 83 & ahu_bbl_0(jpi,jpj) , ahv_bbl_0(jpi,jpj) , & 84 & e3u_bbl_0(jpi,jpj) , e3v_bbl_0(jpi,jpj) , r1_e1e2t(jpi,jpj) , STAT= tra_bbl_alloc ) 85 ! 86 IF( lk_mpp ) CALL mpp_sum ( tra_bbl_alloc ) 87 IF( tra_bbl_alloc > 0 ) CALL ctl_warn('tra_bbl_alloc: allocation of arrays failed.') 88 END FUNCTION tra_bbl_alloc 89 74 90 75 91 SUBROUTINE tra_bbl( kt ) … … 153 169 !! Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430. 154 170 !!---------------------------------------------------------------------- 155 INTEGER , INTENT(in ) :: kjpt ! number of tracers 156 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! before and now tracer fields 157 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 158 !! 171 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 172 USE wrk_nemo, ONLY: zptb => wrk_2d_1 173 ! 174 INTEGER , INTENT(in ) :: kjpt ! number of tracers 175 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! before and now tracer fields 176 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 177 ! 159 178 INTEGER :: ji, jj, jn ! dummy loop indices 160 179 INTEGER :: ik ! local integers 161 180 REAL(wp) :: zbtr ! local scalars 162 REAL(wp), DIMENSION(jpi,jpj) :: zptb ! tracer trend 163 !!---------------------------------------------------------------------- 181 !!---------------------------------------------------------------------- 182 ! 183 IF( wrk_in_use(2,1) ) THEN 184 CALL ctl_stop('tra_bbl_dif: ERROR: requested workspace array unavailable') ; RETURN 185 ENDIF 164 186 ! 165 187 DO jn = 1, kjpt ! tracer loop … … 185 207 # endif 186 208 ik = mbkt(ji,jj) ! bottom T-level index 187 zbtr = e1e2t_r(ji,jj) / fse3t(ji,jj,ik)209 zbtr = r1_e1e2t(ji,jj) / fse3t(ji,jj,ik) 188 210 pta(ji,jj,ik,jn) = pta(ji,jj,ik,jn) & 189 211 & + ( ahu_bbl(ji ,jj ) * ( zptb(ji+1,jj ) - zptb(ji ,jj ) ) & … … 196 218 END DO ! end tracer 197 219 ! ! =========== 220 IF( wrk_not_released(2,1) ) CALL ctl_stop('tra_bbl_dif: failed to release workspace array') 221 ! 198 222 END SUBROUTINE tra_bbl_dif 199 223 … … 214 238 !! Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430. 215 239 !!---------------------------------------------------------------------- 216 INTEGER , INTENT(in ) :: kjpt 217 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! before and now tracer fields218 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend219 ! !240 INTEGER , INTENT(in ) :: kjpt ! number of tracers 241 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in ) :: ptb ! before and now tracer fields 242 REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) :: pta ! tracer trend 243 ! 220 244 INTEGER :: ji, jj, jk, jn ! dummy loop indices 221 245 INTEGER :: iis , iid , ijs , ijd ! local integers … … 242 266 ! 243 267 ! ! up -slope T-point (shelf bottom point) 244 zbtr = e1e2t_r(iis,jj) / fse3t(iis,jj,ikus)268 zbtr = r1_e1e2t(iis,jj) / fse3t(iis,jj,ikus) 245 269 ztra = zu_bbl * ( ptb(iid,jj,ikus,jn) - ptb(iis,jj,ikus,jn) ) * zbtr 246 270 pta(iis,jj,ikus,jn) = pta(iis,jj,ikus,jn) + ztra 247 271 ! 248 272 DO jk = ikus, ikud-1 ! down-slope upper to down T-point (deep column) 249 zbtr = e1e2t_r(iid,jj) / fse3t(iid,jj,jk)273 zbtr = r1_e1e2t(iid,jj) / fse3t(iid,jj,jk) 250 274 ztra = zu_bbl * ( ptb(iid,jj,jk+1,jn) - ptb(iid,jj,jk,jn) ) * zbtr 251 275 pta(iid,jj,jk,jn) = pta(iid,jj,jk,jn) + ztra 252 276 END DO 253 277 ! 254 zbtr = e1e2t_r(iid,jj) / fse3t(iid,jj,ikud)278 zbtr = r1_e1e2t(iid,jj) / fse3t(iid,jj,ikud) 255 279 ztra = zu_bbl * ( ptb(iis,jj,ikus,jn) - ptb(iid,jj,ikud,jn) ) * zbtr 256 280 pta(iid,jj,ikud,jn) = pta(iid,jj,ikud,jn) + ztra … … 264 288 ! 265 289 ! up -slope T-point (shelf bottom point) 266 zbtr = e1e2t_r(ji,ijs) / fse3t(ji,ijs,ikvs)290 zbtr = r1_e1e2t(ji,ijs) / fse3t(ji,ijs,ikvs) 267 291 ztra = zv_bbl * ( ptb(ji,ijd,ikvs,jn) - ptb(ji,ijs,ikvs,jn) ) * zbtr 268 292 pta(ji,ijs,ikvs,jn) = pta(ji,ijs,ikvs,jn) + ztra 269 293 ! 270 294 DO jk = ikvs, ikvd-1 ! down-slope upper to down T-point (deep column) 271 zbtr = e1e2t_r(ji,ijd) / fse3t(ji,ijd,jk)295 zbtr = r1_e1e2t(ji,ijd) / fse3t(ji,ijd,jk) 272 296 ztra = zv_bbl * ( ptb(ji,ijd,jk+1,jn) - ptb(ji,ijd,jk,jn) ) * zbtr 273 297 pta(ji,ijd,jk,jn) = pta(ji,ijd,jk,jn) + ztra 274 298 END DO 275 299 ! ! down-slope T-point (deep bottom point) 276 zbtr = e1e2t_r(ji,ijd) / fse3t(ji,ijd,ikvd)300 zbtr = r1_e1e2t(ji,ijd) / fse3t(ji,ijd,ikvd) 277 301 ztra = zv_bbl * ( ptb(ji,ijs,ikvs,jn) - ptb(ji,ijd,ikvd,jn) ) * zbtr 278 302 pta(ji,ijd,ikvd,jn) = pta(ji,ijd,ikvd,jn) + ztra … … 314 338 !! Campin, J.-M., and H. Goosse, 1999, Tellus, 412-430. 315 339 !!---------------------------------------------------------------------- 340 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 341 USE wrk_nemo, ONLY: zub => wrk_2d_1 , ztb => wrk_2d_2 ! 2D workspace 342 USE wrk_nemo, ONLY: zvb => wrk_2d_3 , zsb => wrk_2d_4 , zdep => wrk_2d_5 343 ! 316 344 INTEGER , INTENT(in ) :: kt ! ocean time-step index 317 345 CHARACTER(len=3), INTENT(in ) :: cdtype ! =TRA or TRC (tracer indicator) … … 323 351 REAL(wp) :: zsign, zsigna, zgbbl ! local scalars 324 352 REAL(wp) :: zgdrho, zt, zs, zh ! - - 325 REAL(wp), DIMENSION(jpi,jpj) :: zub, zvb, ztb, zsb, zdep ! 2D workspace326 353 !! 327 354 REAL(wp) :: fsalbt, fsbeta, pft, pfs, pfh ! statement function … … 357 384 - 0.121555e-07 ) * pfh 358 385 !!---------------------------------------------------------------------- 359 386 387 IF( wrk_in_use(2, 1,2,3,4,5) ) THEN 388 CALL ctl_stop('bbl: requested workspace arrays unavailable') ; RETURN 389 ENDIF 390 360 391 IF( kt == nit000 ) THEN 361 392 IF(lwp) WRITE(numout,*) … … 494 525 ENDIF 495 526 ! 527 IF( wrk_not_released(2, 1,2,3,4,5) ) CALL ctl_stop('bbl: failed to release workspace arrays') 528 ! 496 529 END SUBROUTINE bbl 497 530 … … 504 537 !! 505 538 !! ** Method : Read the nambbl namelist and check the parameters 506 !! called by tra_bbl at the first timestep (nit000) 507 !!---------------------------------------------------------------------- 539 !! called by nemo_init at the first timestep (nit000) 540 !!---------------------------------------------------------------------- 541 USE wrk_nemo, ONLY: wrk_in_use, wrk_not_released 542 USE wrk_nemo, ONLY: zmbk => wrk_2d_1 ! 2D workspace 508 543 INTEGER :: ji, jj ! dummy loop indices 509 544 INTEGER :: ii0, ii1, ij0, ij1 ! temporary integer 510 REAL(wp), DIMENSION(jpi,jpj) :: zmbk ! 2D workspace511 545 !! 512 546 NAMELIST/nambbl/ nn_bbl_ldf, nn_bbl_adv, rn_ahtbbl, rn_gambbl 513 547 !!---------------------------------------------------------------------- 548 549 IF( wrk_in_use(2,1) ) THEN 550 CALL ctl_stop('tra_bbl_init: requested workspace array unavailable') ; RETURN 551 ENDIF 514 552 515 553 REWIND ( numnam ) !* Read Namelist nambbl : bottom boundary layer scheme … … 528 566 WRITE(numout,*) ' advective bbl coefficient rn_gambbl = ', rn_gambbl, ' s' 529 567 ENDIF 530 568 569 ! ! allocate trabbl arrays 570 IF( tra_bbl_alloc() /= 0 ) CALL ctl_stop( 'STOP', 'tra_bbl_init : unable to allocate arrays' ) 571 531 572 IF( nn_bbl_adv == 1 ) WRITE(numout,*) ' * Advective BBL using upper velocity' 532 573 IF( nn_bbl_adv == 2 ) WRITE(numout,*) ' * Advective BBL using velocity = F( delta rho)' … … 536 577 537 578 ! !* inverse of surface of T-cells 538 e1e2t_r(:,:) = 1.0/ ( e1t(:,:) * e2t(:,:) )579 r1_e1e2t(:,:) = 1._wp / ( e1t(:,:) * e2t(:,:) ) 539 580 540 581 ! !* vertical index of "deep" bottom u- and v-points … … 594 635 ENDIF 595 636 ! 637 IF( wrk_not_released(2,1) ) CALL ctl_stop('tra_bbl_init: failed to release workspace array') 638 ! 596 639 END SUBROUTINE tra_bbl_init 597 640
Note: See TracChangeset
for help on using the changeset viewer.
