New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 15548 for NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/src/OCE/DOM/domvvl.F90 – NEMO

Ignore:
Timestamp:
2021-11-28T18:59:49+01:00 (3 years ago)
Author:
gsamson
Message:

update branch to the head of the trunk (r15547); ticket #2632

Location:
NEMO/branches/2021/ticket2632_r14588_theta_sbcblk
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2021/ticket2632_r14588_theta_sbcblk

    • Property svn:externals

      •  

        old new  
        99 
        1010# SETTE 
        11 ^/utils/CI/sette@14244        sette 
         11^/utils/CI/sette@HEAD        sette 
         12 

  • NEMO/branches/2021/ticket2632_r14588_theta_sbcblk/src/OCE/DOM/domvvl.F90

    r14433 r15548  
    204204      gdept(:,:,1,Kbb) = 0.5_wp * e3w(:,:,1,Kbb) 
    205205      gdepw(:,:,1,Kbb) = 0.0_wp 
    206       DO_3D( 1, 1, 1, 1, 2, jpk )                     ! vertical sum 
     206      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, jpk )                     ! vertical sum 
    207207         !    zcoef = tmask - wmask    ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt 
    208208         !                             ! 1 everywhere from mbkt to mikt + 1 or 1 (if no isf) 
    … …  
    404404         zwu(:,:) = 0._wp 
    405405         zwv(:,:) = 0._wp 
    406          DO_3D( 1, 0, 1, 0, 1, jpkm1 )   ! a - first derivative: diffusive fluxes 
     406         DO_3D( nn_hls, nn_hls-1, nn_hls, nn_hls-1, 1, jpkm1 )       ! a - first derivative: diffusive fluxes 
    407407            un_td(ji,jj,jk) = rn_ahe3 * umask(ji,jj,jk) * e2_e1u(ji,jj)           & 
    408408               &            * ( tilde_e3t_b(ji,jj,jk) - tilde_e3t_b(ji+1,jj  ,jk) ) 
    … …  
    412412            zwv(ji,jj) = zwv(ji,jj) + vn_td(ji,jj,jk) 
    413413         END_3D 
    414          DO_2D( 1, 1, 1, 1 )             ! b - correction for last oceanic u-v points 
     414         DO_2D( nn_hls, nn_hls-1, nn_hls, nn_hls-1 )                 ! b - correction for last oceanic u-v points 
    415415            un_td(ji,jj,mbku(ji,jj)) = un_td(ji,jj,mbku(ji,jj)) - zwu(ji,jj) 
    416416            vn_td(ji,jj,mbkv(ji,jj)) = vn_td(ji,jj,mbkv(ji,jj)) - zwv(ji,jj) 
    … …  
    423423         !                               ! d - thickness diffusion transport: boundary conditions 
    424424         !                             (stored for tracer advction and continuity equation) 
    425          CALL lbc_lnk( 'domvvl', un_td , 'U' , -1._wp, vn_td , 'V' , -1._wp) 
     425         IF( nn_hls == 1 ) CALL lbc_lnk( 'domvvl', un_td , 'U' , -1._wp, vn_td , 'V' , -1._wp) 
    426426         ! 4 - Time stepping of baroclinic scale factors 
    427427         ! --------------------------------------------- 
    … …  
    640640      gdepw(:,:,1,Kmm) = 0.0_wp 
    641641      gde3w(:,:,1) = gdept(:,:,1,Kmm) - ssh(:,:,Kmm) 
    642       DO_3D( 1, 1, 1, 1, 2, jpk ) 
     642      DO_3D( nn_hls, nn_hls, nn_hls, nn_hls, 2, jpk ) 
    643643        !    zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk))   ! 0 everywhere tmask = wmask, ie everywhere expect at jk = mikt 
    644644                                                           ! 1 for jk = mikt 
    … …  
    683683      ! 
    684684      INTEGER ::   ji, jj, jk                                       ! dummy loop indices 
     685      INTEGER ::   iku, ikum1, ikv, ikvm1, ikf, ikfm1 
    685686      REAL(wp) ::  zlnwd                                            ! =1./0. when ln_wd_il = T/F 
    686687      !!---------------------------------------------------------------------- 
    … …  
    700701               &                           + e1e2t(ji+1,jj) * ( pe3_in(ji+1,jj,jk) - e3t_0(ji+1,jj,jk) ) ) 
    701702         END_3D 
     703         ! 
     704         ! Bottom correction: 
     705         DO_2D( 1, 0, 1, 0 ) 
     706            iku    = mbku(ji  ,jj) 
     707            ikum1  = iku - 1 
     708            pe3_out(ji,jj,iku) = ( umask(ji,jj,iku) * (1.0_wp - zlnwd) + zlnwd )    &  
     709               &     * ( 0.5_wp *  r1_e1e2u(ji,jj)                                  & 
     710               &     * (    e1e2t(ji  ,jj) * ( SUM(tmask(ji  ,jj,:)*(pe3_in(ji  ,jj,:) - e3t_0(ji  ,jj,:))) )   &                
     711               &          + e1e2t(ji+1,jj) * ( SUM(tmask(ji+1,jj,:)*(pe3_in(ji+1,jj,:) - e3t_0(ji+1,jj,:))) ) ) & 
     712               &     - SUM(pe3_out(ji,jj,1:ikum1))) 
     713         END_2D 
     714          
    702715         CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'U', 1._wp ) 
    703716         pe3_out(:,:,:) = pe3_out(:,:,:) + e3u_0(:,:,:) 
    … …  
    709722               &                           + e1e2t(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3t_0(ji,jj+1,jk) ) ) 
    710723         END_3D 
     724         ! 
     725         ! Bottom correction: 
     726         DO_2D( 1, 0, 1, 0 ) 
     727            ikv    = mbkv(ji  ,jj) 
     728            ikvm1  = ikv - 1 
     729            pe3_out(ji,jj,ikv) = ( vmask(ji,jj,ikv) * (1.0_wp - zlnwd) + zlnwd )    &  
     730               &     * ( 0.5_wp *  r1_e1e2v(ji,jj)                                  & 
     731               &     * (    e1e2t(ji,jj  ) * ( SUM(tmask(ji,jj  ,:)*(pe3_in(ji,jj  ,:) - e3t_0(ji,jj  ,:))) )   &                
     732               &          + e1e2t(ji,jj+1) * ( SUM(tmask(ji,jj+1,:)*(pe3_in(ji,jj+1,:) - e3t_0(ji,jj+1,:))) ) ) & 
     733               &     - SUM(pe3_out(ji,jj,1:ikvm1))) 
     734         END_2D 
    711735         CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'V', 1._wp ) 
    712736         pe3_out(:,:,:) = pe3_out(:,:,:) + e3v_0(:,:,:) 
    713737         ! 
    714738      CASE( 'F' )                   !* from U-point to F-point : hor. surface weighted mean 
    715          DO_3D( 1, 0, 1, 0, 1, jpk ) 
     739         DO_3D( 0, 0, 0, 0, 1, jpk ) 
    716740            pe3_out(ji,jj,jk) = 0.5_wp * (  umask(ji,jj,jk) * umask(ji,jj+1,jk) * (1.0_wp - zlnwd) + zlnwd ) & 
    717741               &                       *    r1_e1e2f(ji,jj)                                                  & 
    … …  
    719743               &                           + e1e2u(ji,jj+1) * ( pe3_in(ji,jj+1,jk) - e3u_0(ji,jj+1,jk) ) ) 
    720744         END_3D 
     745         ! 
     746         ! Bottom correction: 
     747         DO_2D( 0, 0, 0, 0 ) 
     748            ikf    = MIN(mbku(ji  ,jj),mbku(ji,jj+1)) 
     749            ikfm1  = ikf - 1 
     750            pe3_out(ji,jj,ikf) = ( umask(ji,jj,ikf) * umask(ji,jj+1,ikf) * (1.0_wp - zlnwd) + zlnwd )           &  
     751               &     * ( 0.5_wp *  r1_e1e2f(ji,jj)                                                              & 
     752               &     * (    e1e2u(ji,jj  ) * ( SUM(umask(ji,jj  ,:)*(pe3_in(ji,jj  ,:) - e3u_0(ji,jj  ,:))) )   &                
     753               &          + e1e2u(ji,jj+1) * ( SUM(umask(ji,jj+1,:)*(pe3_in(ji,jj+1,:) - e3u_0(ji,jj+1,:))) ) ) & 
     754               &     - SUM(pe3_out(ji,jj,1:ikfm1))) 
     755         END_2D 
    721756         CALL lbc_lnk( 'domvvl', pe3_out(:,:,:), 'F', 1._wp ) 
    722757         pe3_out(:,:,:) = pe3_out(:,:,:) + e3f_0(:,:,:) 
Note: See TracChangeset for help on using the changeset viewer.