- Timestamp:
- 2013-04-09T18:34:38+02:00 (11 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
branches/2013/dev_r3858_NOC_ZTC/NEMOGCM/NEMO/OPA_SRC/TRA/trabbl.F90
r3764 r3865 66 66 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:) :: ahu_bbl_0, ahv_bbl_0 ! diffusive bbl flux coefficients at u and v-points 67 67 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC :: e3u_bbl_0, e3v_bbl_0 ! thichness of the bbl (e3) at u and v-points (PUBLIC for TAM) 68 REAL(wp), ALLOCATABLE, SAVE, DIMENSION(:,:), PUBLIC :: r1_e1e2t ! inverse of the cell surface at t-point [1/m2] (PUBLIC for TAM)69 68 70 69 !! * Substitutions … … 85 84 & vtr_bbl (jpi,jpj) , ahv_bbl (jpi,jpj) , mbkv_d (jpi,jpj) , mgrhv(jpi,jpj) , & 86 85 & ahu_bbl_0(jpi,jpj) , ahv_bbl_0(jpi,jpj) , & 87 & e3u_bbl_0(jpi,jpj) , e3v_bbl_0(jpi,jpj) , r1_e1e2t(jpi,jpj) , STAT= tra_bbl_alloc)86 & e3u_bbl_0(jpi,jpj) , e3v_bbl_0(jpi,jpj) , STAT= tra_bbl_alloc ) 88 87 ! 89 88 IF( lk_mpp ) CALL mpp_sum ( tra_bbl_alloc ) … … 217 216 # endif 218 217 ik = mbkt(ji,jj) ! bottom T-level index 219 zbtr = r1_e1 e2t(ji,jj) / fse3t(ji,jj,ik)218 zbtr = r1_e12t(ji,jj) / fse3t(ji,jj,ik) 220 219 pta(ji,jj,ik,jn) = pta(ji,jj,ik,jn) & 221 220 & + ( ahu_bbl(ji ,jj ) * ( zptb(ji+1,jj ) - zptb(ji ,jj ) ) & … … 279 278 ! 280 279 ! ! up -slope T-point (shelf bottom point) 281 zbtr = r1_e1 e2t(iis,jj) / fse3t(iis,jj,ikus)280 zbtr = r1_e12t(iis,jj) / fse3t(iis,jj,ikus) 282 281 ztra = zu_bbl * ( ptb(iid,jj,ikus,jn) - ptb(iis,jj,ikus,jn) ) * zbtr 283 282 pta(iis,jj,ikus,jn) = pta(iis,jj,ikus,jn) + ztra 284 283 ! 285 284 DO jk = ikus, ikud-1 ! down-slope upper to down T-point (deep column) 286 zbtr = r1_e1 e2t(iid,jj) / fse3t(iid,jj,jk)285 zbtr = r1_e12t(iid,jj) / fse3t(iid,jj,jk) 287 286 ztra = zu_bbl * ( ptb(iid,jj,jk+1,jn) - ptb(iid,jj,jk,jn) ) * zbtr 288 287 pta(iid,jj,jk,jn) = pta(iid,jj,jk,jn) + ztra 289 288 END DO 290 289 ! 291 zbtr = r1_e1 e2t(iid,jj) / fse3t(iid,jj,ikud)290 zbtr = r1_e12t(iid,jj) / fse3t(iid,jj,ikud) 292 291 ztra = zu_bbl * ( ptb(iis,jj,ikus,jn) - ptb(iid,jj,ikud,jn) ) * zbtr 293 292 pta(iid,jj,ikud,jn) = pta(iid,jj,ikud,jn) + ztra … … 301 300 ! 302 301 ! up -slope T-point (shelf bottom point) 303 zbtr = r1_e1 e2t(ji,ijs) / fse3t(ji,ijs,ikvs)302 zbtr = r1_e12t(ji,ijs) / fse3t(ji,ijs,ikvs) 304 303 ztra = zv_bbl * ( ptb(ji,ijd,ikvs,jn) - ptb(ji,ijs,ikvs,jn) ) * zbtr 305 304 pta(ji,ijs,ikvs,jn) = pta(ji,ijs,ikvs,jn) + ztra 306 305 ! 307 306 DO jk = ikvs, ikvd-1 ! down-slope upper to down T-point (deep column) 308 zbtr = r1_e1 e2t(ji,ijd) / fse3t(ji,ijd,jk)307 zbtr = r1_e12t(ji,ijd) / fse3t(ji,ijd,jk) 309 308 ztra = zv_bbl * ( ptb(ji,ijd,jk+1,jn) - ptb(ji,ijd,jk,jn) ) * zbtr 310 309 pta(ji,ijd,jk,jn) = pta(ji,ijd,jk,jn) + ztra 311 310 END DO 312 311 ! ! down-slope T-point (deep bottom point) 313 zbtr = r1_e1 e2t(ji,ijd) / fse3t(ji,ijd,ikvd)312 zbtr = r1_e12t(ji,ijd) / fse3t(ji,ijd,ikvd) 314 313 ztra = zv_bbl * ( ptb(ji,ijs,ikvs,jn) - ptb(ji,ijd,ikvd,jn) ) * zbtr 315 314 pta(ji,ijd,ikvd,jn) = pta(ji,ijd,ikvd,jn) + ztra … … 423 422 ztb (ji,jj) = tsb(ji,jj,ik,jp_tem) * tmask(ji,jj,1) ! bottom before T and S 424 423 zsb (ji,jj) = tsb(ji,jj,ik,jp_sal) * tmask(ji,jj,1) 425 zdep(ji,jj) = fsdept_0(ji,jj,ik)! bottom T-level reference depth424 zdep(ji,jj) = gdept_0(ji,jj,ik) ! bottom T-level reference depth 426 425 ! 427 426 zub(ji,jj) = un(ji,jj,mbku(ji,jj)) ! bottom velocity … … 594 593 IF( nn_eos /= 0 ) CALL ctl_stop ( ' bbl parameterisation requires eos = 0. We stop.' ) 595 594 596 597 ! !* inverse of surface of T-cells598 r1_e1e2t(:,:) = 1._wp / ( e1t(:,:) * e2t(:,:) )599 600 595 ! !* vertical index of "deep" bottom u- and v-points 601 596 DO jj = 1, jpjm1 ! (the "shelf" bottom k-indices are mbku and mbkv) … … 605 600 END DO 606 601 END DO 607 ! convert einto REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk602 ! convert into REAL to use lbc_lnk ; impose a min value of 1 as a zero can be set in lbclnk 608 603 zmbk(:,:) = REAL( mbku_d(:,:), wp ) ; CALL lbc_lnk(zmbk,'U',1.) ; mbku_d(:,:) = MAX( INT( zmbk(:,:) ), 1 ) 609 604 zmbk(:,:) = REAL( mbkv_d(:,:), wp ) ; CALL lbc_lnk(zmbk,'V',1.) ; mbkv_d(:,:) = MAX( INT( zmbk(:,:) ), 1 ) 610 605 611 606 !* sign of grad(H) at u- and v-points 612 607 mgrhu(jpi,:) = 0. ; mgrhu(:,jpj) = 0. ; mgrhv(jpi,:) = 0. ; mgrhv(:,jpj) = 0. 613 608 DO jj = 1, jpjm1 614 609 DO ji = 1, jpim1 615 mgrhu(ji,jj) = INT( SIGN( 1.e0, fsdept_0(ji+1,jj,mbkt(ji+1,jj)) - fsdept_0(ji,jj,mbkt(ji,jj)) ) )616 mgrhv(ji,jj) = INT( SIGN( 1.e0, fsdept_0(ji,jj+1,mbkt(ji,jj+1)) - fsdept_0(ji,jj,mbkt(ji,jj)) ) )610 mgrhu(ji,jj) = INT( SIGN( 1.e0, gdept_0(ji+1,jj,mbkt(ji+1,jj)) - gdept_0(ji,jj,mbkt(ji,jj)) ) ) 611 mgrhv(ji,jj) = INT( SIGN( 1.e0, gdept_0(ji,jj+1,mbkt(ji,jj+1)) - gdept_0(ji,jj,mbkt(ji,jj)) ) ) 617 612 END DO 618 613 END DO 619 614 620 615 DO jj = 1, jpjm1 !* bbl thickness at u- (v-) point 621 DO ji = 1, jpim1 622 e3u_bbl_0(ji,jj) = MIN( fse3u_0(ji,jj,mbkt(ji+1,jj )), fse3u_0(ji,jj,mbkt(ji,jj)) )623 e3v_bbl_0(ji,jj) = MIN( fse3v_0(ji,jj,mbkt(ji ,jj+1)), fse3v_0(ji,jj,mbkt(ji,jj)) )616 DO ji = 1, jpim1 ! minimum of top & bottom e3u_0 (e3v_0) 617 e3u_bbl_0(ji,jj) = MIN( e3u_0(ji,jj,mbkt(ji+1,jj )), e3u_0(ji,jj,mbkt(ji,jj)) ) 618 e3v_bbl_0(ji,jj) = MIN( e3v_0(ji,jj,mbkt(ji ,jj+1)), e3v_0(ji,jj,mbkt(ji,jj)) ) 624 619 END DO 625 620 END DO
Note: See TracChangeset
for help on using the changeset viewer.
