Ignore:
Timestamp:
2020-02-12T15:39:06+01:00 (9 months ago)
Author:
acc
Message:

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge —ignore-ancestry \

svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The —ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.

Location:
NEMO/trunk
Files:
1 deleted
18 edited
1 copied

Legend:

Unmodified
Added
Removed
  • NEMO/trunk

    • Property svn:externals
      •  

        old new  
        33^/utils/build/mk@HEAD         mk 
        44^/utils/tools@HEAD            tools 
        5 ^/vendors/AGRIF/dev@HEAD      ext/AGRIF 
         5^/vendors/AGRIF/dev_r11615_ENHANCE-04_namelists_as_internalfiles_agrif@HEAD      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 
  • NEMO/trunk/src/OCE/DYN/divhor.F90

    r12141 r12377  
    2020   USE oce             ! ocean dynamics and tracers 
    2121   USE dom_oce         ! ocean space and time domain 
    22    USE sbc_oce, ONLY : ln_rnf, ln_isf ! surface boundary condition: ocean 
    23    USE sbcrnf          ! river runoff  
    24    USE sbcisf          ! ice shelf 
    25    USE iscplhsb        ! ice sheet / ocean coupling 
    26    USE iscplini        ! ice sheet / ocean coupling 
     22   USE sbc_oce, ONLY : ln_rnf      ! river runoff 
     23   USE sbcrnf , ONLY : sbc_rnf_div ! river runoff  
     24   USE isf_oce, ONLY : ln_isf      ! ice shelf 
     25   USE isfhdiv, ONLY : isf_hdiv    ! ice shelf 
    2726#if defined key_asminc    
    2827   USE asminc          ! Assimilation increment 
     
    4039 
    4140   !! * Substitutions 
    42 #  include "vectopt_loop_substitute.h90" 
     41#  include "do_loop_substitute.h90" 
    4342   !!---------------------------------------------------------------------- 
    4443   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    4847CONTAINS 
    4948 
    50    SUBROUTINE div_hor( kt ) 
     49   SUBROUTINE div_hor( kt, Kbb, Kmm ) 
    5150      !!---------------------------------------------------------------------- 
    5251      !!                  ***  ROUTINE div_hor  *** 
     
    5554      !! 
    5655      !! ** Method  :   the now divergence is computed as : 
    57       !!         hdivn = 1/(e1e2t*e3t) ( di[e2u*e3u un] + dj[e1v*e3v vn] ) 
     56      !!         hdiv = 1/(e1e2t*e3t) ( di[e2u*e3u un] + dj[e1v*e3v vn] ) 
    5857      !!      and correct with runoff inflow (div_rnf) and cross land flow (div_cla)  
    5958      !! 
    60       !! ** Action  : - update hdivn, the now horizontal divergence 
     59      !! ** Action  : - update hdiv, the now horizontal divergence 
    6160      !!---------------------------------------------------------------------- 
    62       INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     61      INTEGER, INTENT(in) ::   kt        ! ocean time-step index 
     62      INTEGER, INTENT(in) ::   Kbb, Kmm  ! ocean time level indices 
    6363      ! 
    6464      INTEGER  ::   ji, jj, jk    ! dummy loop indices 
    6565      REAL(wp) ::   zraur, zdep   ! local scalars 
     66      REAL(wp), DIMENSION(jpi,jpj) :: ztmp 
    6667      !!---------------------------------------------------------------------- 
    6768      ! 
     
    7273         IF(lwp) WRITE(numout,*) 'div_hor : horizontal velocity divergence ' 
    7374         IF(lwp) WRITE(numout,*) '~~~~~~~   ' 
    74          hdivn(:,:,:) = 0._wp    ! initialize hdivn for the halos at the first time step 
     75         hdiv(:,:,:) = 0._wp    ! initialize hdiv for the halos at the first time step 
    7576      ENDIF 
    7677      ! 
    77       DO jk = 1, jpkm1                                      !==  Horizontal divergence  ==! 
    78          DO jj = 2, jpjm1 
    79             DO ji = fs_2, fs_jpim1   ! vector opt. 
    80                hdivn(ji,jj,jk) = (  e2u(ji  ,jj) * e3u_n(ji  ,jj,jk) * un(ji  ,jj,jk)      & 
    81                   &               - e2u(ji-1,jj) * e3u_n(ji-1,jj,jk) * un(ji-1,jj,jk)      & 
    82                   &               + e1v(ji,jj  ) * e3v_n(ji,jj  ,jk) * vn(ji,jj  ,jk)      & 
    83                   &               - e1v(ji,jj-1) * e3v_n(ji,jj-1,jk) * vn(ji,jj-1,jk)  )   & 
    84                   &            * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
    85             END DO   
    86          END DO   
    87       END DO 
     78      DO_3D_00_00( 1, jpkm1 ) 
     79         hdiv(ji,jj,jk) = (  e2u(ji  ,jj) * e3u(ji  ,jj,jk,Kmm) * uu(ji  ,jj,jk,Kmm)      & 
     80            &               - e2u(ji-1,jj) * e3u(ji-1,jj,jk,Kmm) * uu(ji-1,jj,jk,Kmm)      & 
     81            &               + e1v(ji,jj  ) * e3v(ji,jj  ,jk,Kmm) * vv(ji,jj  ,jk,Kmm)      & 
     82            &               - e1v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm) * vv(ji,jj-1,jk,Kmm)  )   & 
     83            &            * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 
     84      END_3D 
     85      ! 
    8886#if defined key_agrif 
    8987      IF( .NOT. Agrif_Root() ) THEN 
    90          IF( nbondi == -1 .OR. nbondi == 2 )   hdivn(   2   ,  :   ,:) = 0._wp      ! west 
    91          IF( nbondi ==  1 .OR. nbondi == 2 )   hdivn( nlci-1,  :   ,:) = 0._wp      ! east 
    92          IF( nbondj == -1 .OR. nbondj == 2 )   hdivn(   :   ,  2   ,:) = 0._wp      ! south 
    93          IF( nbondj ==  1 .OR. nbondj == 2 )   hdivn(   :   ,nlcj-1,:) = 0._wp      ! north 
     88         IF( nbondi == -1 .OR. nbondi == 2 )   hdiv(   2   ,  :   ,:) = 0._wp      ! west 
     89         IF( nbondi ==  1 .OR. nbondi == 2 )   hdiv( nlci-1,  :   ,:) = 0._wp      ! east 
     90         IF( nbondj == -1 .OR. nbondj == 2 )   hdiv(   :   ,  2   ,:) = 0._wp      ! south 
     91         IF( nbondj ==  1 .OR. nbondj == 2 )   hdiv(   :   ,nlcj-1,:) = 0._wp      ! north 
    9492      ENDIF 
    9593#endif 
    9694      ! 
    97       IF( ln_rnf )   CALL sbc_rnf_div( hdivn )              !==  runoffs    ==!   (update hdivn field) 
     95      IF( ln_rnf )   CALL sbc_rnf_div( hdiv, Kmm )                     !==  runoffs    ==!   (update hdiv field) 
    9896      ! 
    9997#if defined key_asminc  
    100       IF( ln_sshinc .AND. ln_asmiau )   CALL ssh_asm_div( kt, hdivn )   !==  SSH assimilation  ==!   (update hdivn field) 
     98      IF( ln_sshinc .AND. ln_asmiau )   CALL ssh_asm_div( kt, Kbb, Kmm, hdiv )   !==  SSH assimilation  ==!   (update hdiv field) 
    10199      !  
    102100#endif 
    103       IF( ln_isf )   CALL sbc_isf_div( hdivn )      !==  ice shelf  ==!   (update hdivn field) 
    104101      ! 
    105       IF( ln_iscpl .AND. ln_hsb )   CALL iscpl_div( hdivn ) !==  ice sheet  ==!   (update hdivn field) 
     102      IF( ln_isf )                      CALL isf_hdiv( kt, Kmm, hdiv )           !==  ice shelf         ==!   (update hdiv field) 
    106103      ! 
    107       CALL lbc_lnk( 'divhor', hdivn, 'T', 1. )   !   (no sign change) 
     104      CALL lbc_lnk( 'divhor', hdiv, 'T', 1. )   !   (no sign change) 
    108105      ! 
    109106      IF( ln_timing )   CALL timing_stop('div_hor') 
  • NEMO/trunk/src/OCE/DYN/dynadv.F90

    r11536 r12377  
    4444   INTEGER, PUBLIC, PARAMETER ::   np_FLX_ubs = 3   ! flux   form : 3rd order Upstream Biased Scheme 
    4545 
    46    !! * Substitutions 
    47 #  include "vectopt_loop_substitute.h90" 
    4846   !!---------------------------------------------------------------------- 
    4947   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    5351CONTAINS 
    5452 
    55    SUBROUTINE dyn_adv( kt ) 
     53   SUBROUTINE dyn_adv( kt, Kbb, Kmm, puu, pvv, Krhs ) 
    5654      !!--------------------------------------------------------------------- 
    5755      !!                  ***  ROUTINE dyn_adv  *** 
     
    5957      !! ** Purpose :   compute the ocean momentum advection trend. 
    6058      !! 
    61       !! ** Method  : - Update (ua,va) with the advection term following n_dynadv 
     59      !! ** Method  : - Update (puu(:,:,:,Krhs),pvv(:,:,:,Krhs)) with the advection term following n_dynadv 
    6260      !! 
    6361      !!      NB: in flux form advection (ln_dynadv_cen2 or ln_dynadv_ubs=T)  
     
    6664      !!      (see dynvor module). 
    6765      !!---------------------------------------------------------------------- 
    68       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
     66      INTEGER                             , INTENT( in )  ::  kt               ! ocean time-step index 
     67      INTEGER                             , INTENT( in )  ::  Kbb, Kmm, Krhs   ! ocean time level indices 
     68      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv         ! ocean velocities and RHS of momentum equation 
    6969      !!---------------------------------------------------------------------- 
    7070      ! 
     
    7373      SELECT CASE( n_dynadv )    !==  compute advection trend and add it to general trend  ==! 
    7474      CASE( np_VEC_c2  )      
    75          CALL dyn_keg     ( kt, nn_dynkeg )    ! vector form : horizontal gradient of kinetic energy 
    76          CALL dyn_zad     ( kt )               ! vector form : vertical advection 
     75         CALL dyn_keg     ( kt, nn_dynkeg,      Kmm, puu, pvv, Krhs )    ! vector form : horizontal gradient of kinetic energy 
     76         CALL dyn_zad     ( kt,                 Kmm, puu, pvv, Krhs )    ! vector form : vertical advection 
    7777      CASE( np_FLX_c2  )  
    78          CALL dyn_adv_cen2( kt )               ! 2nd order centered scheme 
     78         CALL dyn_adv_cen2( kt,                 Kmm, puu, pvv, Krhs )    ! 2nd order centered scheme 
    7979      CASE( np_FLX_ubs )    
    80          CALL dyn_adv_ubs ( kt )               ! 3rd order UBS      scheme (UP3) 
     80         CALL dyn_adv_ubs ( kt,            Kbb, Kmm, puu, pvv, Krhs )    ! 3rd order UBS      scheme (UP3) 
    8181      END SELECT 
    8282      ! 
     
    104104      ENDIF 
    105105      ! 
    106       REWIND( numnam_ref )              ! Namelist namdyn_adv in reference namelist : Momentum advection scheme 
    107106      READ  ( numnam_ref, namdyn_adv, IOSTAT = ios, ERR = 901) 
    108107901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_adv in reference namelist' ) 
    109       REWIND( numnam_cfg )              ! Namelist namdyn_adv in configuration namelist : Momentum advection scheme 
    110108      READ  ( numnam_cfg, namdyn_adv, IOSTAT = ios, ERR = 902 ) 
    111109902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdyn_adv in configuration namelist' ) 
  • NEMO/trunk/src/OCE/DYN/dynadv_cen2.F90

    r10068 r12377  
    2727 
    2828   !! * Substitutions 
    29 #  include "vectopt_loop_substitute.h90" 
     29#  include "do_loop_substitute.h90" 
    3030   !!---------------------------------------------------------------------- 
    3131   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    3535CONTAINS 
    3636 
    37    SUBROUTINE dyn_adv_cen2( kt ) 
     37   SUBROUTINE dyn_adv_cen2( kt, Kmm, puu, pvv, Krhs ) 
    3838      !!---------------------------------------------------------------------- 
    3939      !!                  ***  ROUTINE dyn_adv_cen2  *** 
     
    4444      !! ** Method  :   Trend evaluated using now fields (centered in time)  
    4545      !! 
    46       !! ** Action  :   (ua,va) updated with the now vorticity term trend 
     46      !! ** Action  :   (puu(:,:,:,Krhs),pvv(:,:,:,Krhs)) updated with the now vorticity term trend 
    4747      !!---------------------------------------------------------------------- 
    48       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
     48      INTEGER                             , INTENT( in )  ::  kt           ! ocean time-step index 
     49      INTEGER                             , INTENT( in )  ::  Kmm, Krhs    ! ocean time level indices 
     50      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv     ! ocean velocities and RHS of momentum equation 
    4951      ! 
    5052      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     
    6062      ! 
    6163      IF( l_trddyn ) THEN           ! trends: store the input trends 
    62          zfu_uw(:,:,:) = ua(:,:,:) 
    63          zfv_vw(:,:,:) = va(:,:,:) 
     64         zfu_uw(:,:,:) = puu(:,:,:,Krhs) 
     65         zfv_vw(:,:,:) = pvv(:,:,:,Krhs) 
    6466      ENDIF 
    6567      ! 
     
    6769      ! 
    6870      DO jk = 1, jpkm1                    ! horizontal transport 
    69          zfu(:,:,jk) = 0.25_wp * e2u(:,:) * e3u_n(:,:,jk) * un(:,:,jk) 
    70          zfv(:,:,jk) = 0.25_wp * e1v(:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 
    71          DO jj = 1, jpjm1                 ! horizontal momentum fluxes (at T- and F-point) 
    72             DO ji = 1, fs_jpim1   ! vector opt. 
    73                zfu_t(ji+1,jj  ,jk) = ( zfu(ji,jj,jk) + zfu(ji+1,jj,jk) ) * ( un(ji,jj,jk) + un(ji+1,jj  ,jk) ) 
    74                zfv_f(ji  ,jj  ,jk) = ( zfv(ji,jj,jk) + zfv(ji+1,jj,jk) ) * ( un(ji,jj,jk) + un(ji  ,jj+1,jk) ) 
    75                zfu_f(ji  ,jj  ,jk) = ( zfu(ji,jj,jk) + zfu(ji,jj+1,jk) ) * ( vn(ji,jj,jk) + vn(ji+1,jj  ,jk) ) 
    76                zfv_t(ji  ,jj+1,jk) = ( zfv(ji,jj,jk) + zfv(ji,jj+1,jk) ) * ( vn(ji,jj,jk) + vn(ji  ,jj+1,jk) ) 
    77             END DO 
    78          END DO 
    79          DO jj = 2, jpjm1                 ! divergence of horizontal momentum fluxes 
    80             DO ji = fs_2, fs_jpim1   ! vector opt. 
    81                ua(ji,jj,jk) = ua(ji,jj,jk) - (  zfu_t(ji+1,jj,jk) - zfu_t(ji,jj  ,jk)    & 
    82                   &                           + zfv_f(ji  ,jj,jk) - zfv_f(ji,jj-1,jk)  ) * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk) 
    83                va(ji,jj,jk) = va(ji,jj,jk) - (  zfu_f(ji,jj  ,jk) - zfu_f(ji-1,jj,jk)    & 
    84                   &                           + zfv_t(ji,jj+1,jk) - zfv_t(ji  ,jj,jk)  ) * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk) 
    85             END DO 
    86          END DO 
     71         zfu(:,:,jk) = 0.25_wp * e2u(:,:) * e3u(:,:,jk,Kmm) * puu(:,:,jk,Kmm) 
     72         zfv(:,:,jk) = 0.25_wp * e1v(:,:) * e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) 
     73         DO_2D_10_10 
     74            zfu_t(ji+1,jj  ,jk) = ( zfu(ji,jj,jk) + zfu(ji+1,jj,jk) ) * ( puu(ji,jj,jk,Kmm) + puu(ji+1,jj  ,jk,Kmm) ) 
     75            zfv_f(ji  ,jj  ,jk) = ( zfv(ji,jj,jk) + zfv(ji+1,jj,jk) ) * ( puu(ji,jj,jk,Kmm) + puu(ji  ,jj+1,jk,Kmm) ) 
     76            zfu_f(ji  ,jj  ,jk) = ( zfu(ji,jj,jk) + zfu(ji,jj+1,jk) ) * ( pvv(ji,jj,jk,Kmm) + pvv(ji+1,jj  ,jk,Kmm) ) 
     77            zfv_t(ji  ,jj+1,jk) = ( zfv(ji,jj,jk) + zfv(ji,jj+1,jk) ) * ( pvv(ji,jj,jk,Kmm) + pvv(ji  ,jj+1,jk,Kmm) ) 
     78         END_2D 
     79         DO_2D_00_00 
     80            puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - (  zfu_t(ji+1,jj,jk) - zfu_t(ji,jj  ,jk)    & 
     81               &                           + zfv_f(ji  ,jj,jk) - zfv_f(ji,jj-1,jk)  ) * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm) 
     82            pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - (  zfu_f(ji,jj  ,jk) - zfu_f(ji-1,jj,jk)    & 
     83               &                           + zfv_t(ji,jj+1,jk) - zfv_t(ji  ,jj,jk)  ) * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,Kmm) 
     84         END_2D 
    8785      END DO 
    8886      ! 
    8987      IF( l_trddyn ) THEN           ! trends: send trend to trddyn for diagnostic 
    90          zfu_uw(:,:,:) = ua(:,:,:) - zfu_uw(:,:,:) 
    91          zfv_vw(:,:,:) = va(:,:,:) - zfv_vw(:,:,:) 
    92          CALL trd_dyn( zfu_uw, zfv_vw, jpdyn_keg, kt ) 
    93          zfu_t(:,:,:) = ua(:,:,:) 
    94          zfv_t(:,:,:) = va(:,:,:) 
     88         zfu_uw(:,:,:) = puu(:,:,:,Krhs) - zfu_uw(:,:,:) 
     89         zfv_vw(:,:,:) = pvv(:,:,:,Krhs) - zfv_vw(:,:,:) 
     90         CALL trd_dyn( zfu_uw, zfv_vw, jpdyn_keg, kt, Kmm ) 
     91         zfu_t(:,:,:) = puu(:,:,:,Krhs) 
     92         zfv_t(:,:,:) = pvv(:,:,:,Krhs) 
    9593      ENDIF 
    9694      ! 
    9795      !                             !==  Vertical advection  ==! 
    9896      ! 
    99       DO jj = 2, jpjm1                    ! surface/bottom advective fluxes set to zero 
    100          DO ji = fs_2, fs_jpim1 
    101             zfu_uw(ji,jj,jpk) = 0._wp   ;   zfv_vw(ji,jj,jpk) = 0._wp 
    102             zfu_uw(ji,jj, 1 ) = 0._wp   ;   zfv_vw(ji,jj, 1 ) = 0._wp 
    103          END DO 
    104       END DO 
     97      DO_2D_00_00 
     98         zfu_uw(ji,jj,jpk) = 0._wp   ;   zfv_vw(ji,jj,jpk) = 0._wp 
     99         zfu_uw(ji,jj, 1 ) = 0._wp   ;   zfv_vw(ji,jj, 1 ) = 0._wp 
     100      END_2D 
    105101      IF( ln_linssh ) THEN                ! linear free surface: advection through the surface 
    106          DO jj = 2, jpjm1 
    107             DO ji = fs_2, fs_jpim1 
    108                zfu_uw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * wn(ji,jj,1) + e1e2t(ji+1,jj) * wn(ji+1,jj,1) ) * un(ji,jj,1) 
    109                zfv_vw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * wn(ji,jj,1) + e1e2t(ji,jj+1) * wn(ji,jj+1,1) ) * vn(ji,jj,1) 
    110             END DO 
    111          END DO 
     102         DO_2D_00_00 
     103            zfu_uw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * ww(ji,jj,1) + e1e2t(ji+1,jj) * ww(ji+1,jj,1) ) * puu(ji,jj,1,Kmm) 
     104            zfv_vw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * ww(ji,jj,1) + e1e2t(ji,jj+1) * ww(ji,jj+1,1) ) * pvv(ji,jj,1,Kmm) 
     105         END_2D 
    112106      ENDIF 
    113107      DO jk = 2, jpkm1                    ! interior advective fluxes 
    114          DO jj = 2, jpj                       ! 1/4 * Vertical transport 
    115             DO ji = 2, jpi 
    116                zfw(ji,jj,jk) = 0.25_wp * e1e2t(ji,jj) * wn(ji,jj,jk) 
    117             END DO 
    118          END DO 
    119          DO jj = 2, jpjm1 
    120             DO ji = fs_2, fs_jpim1   ! vector opt. 
    121                zfu_uw(ji,jj,jk) = ( zfw(ji,jj,jk) + zfw(ji+1,jj  ,jk) ) * ( un(ji,jj,jk) + un(ji,jj,jk-1) ) 
    122                zfv_vw(ji,jj,jk) = ( zfw(ji,jj,jk) + zfw(ji  ,jj+1,jk) ) * ( vn(ji,jj,jk) + vn(ji,jj,jk-1) ) 
    123             END DO 
    124          END DO 
     108         DO_2D_01_01 
     109            zfw(ji,jj,jk) = 0.25_wp * e1e2t(ji,jj) * ww(ji,jj,jk) 
     110         END_2D 
     111         DO_2D_00_00 
     112            zfu_uw(ji,jj,jk) = ( zfw(ji,jj,jk) + zfw(ji+1,jj  ,jk) ) * ( puu(ji,jj,jk,Kmm) + puu(ji,jj,jk-1,Kmm) ) 
     113            zfv_vw(ji,jj,jk) = ( zfw(ji,jj,jk) + zfw(ji  ,jj+1,jk) ) * ( pvv(ji,jj,jk,Kmm) + pvv(ji,jj,jk-1,Kmm) ) 
     114         END_2D 
    125115      END DO 
    126       DO jk = 1, jpkm1                    ! divergence of vertical momentum flux divergence 
    127          DO jj = 2, jpjm1  
    128             DO ji = fs_2, fs_jpim1   ! vector opt. 
    129                ua(ji,jj,jk) = ua(ji,jj,jk) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk) 
    130                va(ji,jj,jk) = va(ji,jj,jk) - ( zfv_vw(ji,jj,jk) - zfv_vw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk) 
    131             END DO 
    132          END DO 
    133       END DO 
     116      DO_3D_00_00( 1, jpkm1 ) 
     117         puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm) 
     118         pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - ( zfv_vw(ji,jj,jk) - zfv_vw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,Kmm) 
     119      END_3D 
    134120      ! 
    135121      IF( l_trddyn ) THEN                 ! trends: send trend to trddyn for diagnostic 
    136          zfu_t(:,:,:) = ua(:,:,:) - zfu_t(:,:,:) 
    137          zfv_t(:,:,:) = va(:,:,:) - zfv_t(:,:,:) 
    138          CALL trd_dyn( zfu_t, zfv_t, jpdyn_zad, kt ) 
     122         zfu_t(:,:,:) = puu(:,:,:,Krhs) - zfu_t(:,:,:) 
     123         zfv_t(:,:,:) = pvv(:,:,:,Krhs) - zfv_t(:,:,:) 
     124         CALL trd_dyn( zfu_t, zfv_t, jpdyn_zad, kt, Kmm ) 
    139125      ENDIF 
    140126      !                                   ! Control print 
    141       IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' cen2 adv - Ua: ', mask1=umask,   & 
    142          &                       tab3d_2=va, clinfo2=           ' Va: ', mask2=vmask, clinfo3='dyn' ) 
     127      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' cen2 adv - Ua: ', mask1=umask,   & 
     128         &                                  tab3d_2=pvv(:,:,:,Krhs), clinfo2=           ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    143129      ! 
    144130   END SUBROUTINE dyn_adv_cen2 
  • NEMO/trunk/src/OCE/DYN/dynadv_ubs.F90

    r10425 r12377  
    3333 
    3434   !! * Substitutions 
    35 #  include "vectopt_loop_substitute.h90" 
     35#  include "do_loop_substitute.h90" 
    3636   !!---------------------------------------------------------------------- 
    3737   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    4141CONTAINS 
    4242 
    43    SUBROUTINE dyn_adv_ubs( kt ) 
     43   SUBROUTINE dyn_adv_ubs( kt, Kbb, Kmm, puu, pvv, Krhs ) 
    4444      !!---------------------------------------------------------------------- 
    4545      !!                  ***  ROUTINE dyn_adv_ubs  *** 
     
    6464      !!      gamma1=1/3 and gamma2=1/32. 
    6565      !! 
    66       !! ** Action : - (ua,va) updated with the 3D advective momentum trends 
     66      !! ** Action : - (puu(:,:,:,Krhs),pvv(:,:,:,Krhs)) updated with the 3D advective momentum trends 
    6767      !! 
    6868      !! Reference : Shchepetkin & McWilliams, 2005, Ocean Modelling.  
    6969      !!---------------------------------------------------------------------- 
    70       INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     70      INTEGER                             , INTENT( in )  ::  kt              ! ocean time-step index 
     71      INTEGER                             , INTENT( in )  ::  Kbb, Kmm, Krhs  ! ocean time level indices 
     72      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv        ! ocean velocities and RHS of momentum equation 
    7173      ! 
    7274      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     
    9597      ! 
    9698      IF( l_trddyn ) THEN           ! trends: store the input trends 
    97          zfu_uw(:,:,:) = ua(:,:,:) 
    98          zfv_vw(:,:,:) = va(:,:,:) 
     99         zfu_uw(:,:,:) = puu(:,:,:,Krhs) 
     100         zfv_vw(:,:,:) = pvv(:,:,:,Krhs) 
    99101      ENDIF 
    100102      !                                      ! =========================== ! 
     
    102104         !                                   ! =========================== ! 
    103105         !                                         ! horizontal volume fluxes 
    104          zfu(:,:,jk) = e2u(:,:) * e3u_n(:,:,jk) * un(:,:,jk) 
    105          zfv(:,:,jk) = e1v(:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 
     106         zfu(:,:,jk) = e2u(:,:) * e3u(:,:,jk,Kmm) * puu(:,:,jk,Kmm) 
     107         zfv(:,:,jk) = e1v(:,:) * e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) 
    106108         !             
    107          DO jj = 2, jpjm1                          ! laplacian 
    108             DO ji = fs_2, fs_jpim1   ! vector opt. 
    109                zlu_uu(ji,jj,jk,1) = ( ub (ji+1,jj  ,jk) - 2.*ub (ji,jj,jk) + ub (ji-1,jj  ,jk) ) * umask(ji,jj,jk) 
    110                zlv_vv(ji,jj,jk,1) = ( vb (ji  ,jj+1,jk) - 2.*vb (ji,jj,jk) + vb (ji  ,jj-1,jk) ) * vmask(ji,jj,jk) 
    111                zlu_uv(ji,jj,jk,1) = ( ub (ji  ,jj+1,jk) - ub (ji  ,jj  ,jk) ) * fmask(ji  ,jj  ,jk)   & 
    112                   &               - ( ub (ji  ,jj  ,jk) - ub (ji  ,jj-1,jk) ) * fmask(ji  ,jj-1,jk) 
    113                zlv_vu(ji,jj,jk,1) = ( vb (ji+1,jj  ,jk) - vb (ji  ,jj  ,jk) ) * fmask(ji  ,jj  ,jk)   & 
    114                   &               - ( vb (ji  ,jj  ,jk) - vb (ji-1,jj  ,jk) ) * fmask(ji-1,jj  ,jk) 
    115                ! 
    116                zlu_uu(ji,jj,jk,2) = ( zfu(ji+1,jj  ,jk) - 2.*zfu(ji,jj,jk) + zfu(ji-1,jj  ,jk) ) * umask(ji,jj,jk) 
    117                zlv_vv(ji,jj,jk,2) = ( zfv(ji  ,jj+1,jk) - 2.*zfv(ji,jj,jk) + zfv(ji  ,jj-1,jk) ) * vmask(ji,jj,jk) 
    118                zlu_uv(ji,jj,jk,2) = ( zfu(ji  ,jj+1,jk) - zfu(ji  ,jj  ,jk) ) * fmask(ji  ,jj  ,jk)   & 
    119                   &               - ( zfu(ji  ,jj  ,jk) - zfu(ji  ,jj-1,jk) ) * fmask(ji  ,jj-1,jk) 
    120                zlv_vu(ji,jj,jk,2) = ( zfv(ji+1,jj  ,jk) - zfv(ji  ,jj  ,jk) ) * fmask(ji  ,jj  ,jk)   & 
    121                   &               - ( zfv(ji  ,jj  ,jk) - zfv(ji-1,jj  ,jk) ) * fmask(ji-1,jj  ,jk) 
    122             END DO 
    123          END DO 
     109         DO_2D_00_00 
     110            zlu_uu(ji,jj,jk,1) = ( puu (ji+1,jj  ,jk,Kbb) - 2.*puu (ji,jj,jk,Kbb) + puu (ji-1,jj  ,jk,Kbb) ) * umask(ji,jj,jk) 
     111            zlv_vv(ji,jj,jk,1) = ( pvv (ji  ,jj+1,jk,Kbb) - 2.*pvv (ji,jj,jk,Kbb) + pvv (ji  ,jj-1,jk,Kbb) ) * vmask(ji,jj,jk) 
     112            zlu_uv(ji,jj,jk,1) = ( puu (ji  ,jj+1,jk,Kbb) - puu (ji  ,jj  ,jk,Kbb) ) * fmask(ji  ,jj  ,jk)   & 
     113               &               - ( puu (ji  ,jj  ,jk,Kbb) - puu (ji  ,jj-1,jk,Kbb) ) * fmask(ji  ,jj-1,jk) 
     114            zlv_vu(ji,jj,jk,1) = ( pvv (ji+1,jj  ,jk,Kbb) - pvv (ji  ,jj  ,jk,Kbb) ) * fmask(ji  ,jj  ,jk)   & 
     115               &               - ( pvv (ji  ,jj  ,jk,Kbb) - pvv (ji-1,jj  ,jk,Kbb) ) * fmask(ji-1,jj  ,jk) 
     116            ! 
     117            zlu_uu(ji,jj,jk,2) = ( zfu(ji+1,jj  ,jk) - 2.*zfu(ji,jj,jk) + zfu(ji-1,jj  ,jk) ) * umask(ji,jj,jk) 
     118            zlv_vv(ji,jj,jk,2) = ( zfv(ji  ,jj+1,jk) - 2.*zfv(ji,jj,jk) + zfv(ji  ,jj-1,jk) ) * vmask(ji,jj,jk) 
     119            zlu_uv(ji,jj,jk,2) = ( zfu(ji  ,jj+1,jk) - zfu(ji  ,jj  ,jk) ) * fmask(ji  ,jj  ,jk)   & 
     120               &               - ( zfu(ji  ,jj  ,jk) - zfu(ji  ,jj-1,jk) ) * fmask(ji  ,jj-1,jk) 
     121            zlv_vu(ji,jj,jk,2) = ( zfv(ji+1,jj  ,jk) - zfv(ji  ,jj  ,jk) ) * fmask(ji  ,jj  ,jk)   & 
     122               &               - ( zfv(ji  ,jj  ,jk) - zfv(ji-1,jj  ,jk) ) * fmask(ji-1,jj  ,jk) 
     123         END_2D 
    124124      END DO 
    125125      CALL lbc_lnk_multi( 'dynadv_ubs', zlu_uu(:,:,:,1), 'U', 1. , zlu_uv(:,:,:,1), 'U', 1.,  & 
     
    132132      DO jk = 1, jpkm1                       ! ====================== ! 
    133133         !                                         ! horizontal volume fluxes 
    134          zfu(:,:,jk) = 0.25_wp * e2u(:,:) * e3u_n(:,:,jk) * un(:,:,jk) 
    135          zfv(:,:,jk) = 0.25_wp * e1v(:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 
     134         zfu(:,:,jk) = 0.25_wp * e2u(:,:) * e3u(:,:,jk,Kmm) * puu(:,:,jk,Kmm) 
     135         zfv(:,:,jk) = 0.25_wp * e1v(:,:) * e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) 
    136136         ! 
    137          DO jj = 1, jpjm1                          ! horizontal momentum fluxes at T- and F-point 
    138             DO ji = 1, fs_jpim1   ! vector opt. 
    139                zui = ( un(ji,jj,jk) + un(ji+1,jj  ,jk) ) 
    140                zvj = ( vn(ji,jj,jk) + vn(ji  ,jj+1,jk) ) 
    141                ! 
    142                IF( zui > 0 ) THEN   ;   zl_u = zlu_uu(ji  ,jj,jk,1) 
    143                ELSE                 ;   zl_u = zlu_uu(ji+1,jj,jk,1) 
    144                ENDIF 
    145                IF( zvj > 0 ) THEN   ;   zl_v = zlv_vv(ji,jj  ,jk,1) 
    146                ELSE                 ;   zl_v = zlv_vv(ji,jj+1,jk,1) 
    147                ENDIF 
    148                ! 
    149                zfu_t(ji+1,jj  ,jk) = ( zfu(ji,jj,jk) + zfu(ji+1,jj  ,jk)                               & 
    150                   &                    - gamma2 * ( zlu_uu(ji,jj,jk,2) + zlu_uu(ji+1,jj  ,jk,2) )  )   & 
    151                   &                * ( zui - gamma1 * zl_u) 
    152                zfv_t(ji  ,jj+1,jk) = ( zfv(ji,jj,jk) + zfv(ji  ,jj+1,jk)                               & 
    153                   &                    - gamma2 * ( zlv_vv(ji,jj,jk,2) + zlv_vv(ji  ,jj+1,jk,2) )  )   & 
    154                   &                * ( zvj - gamma1 * zl_v) 
    155                ! 
    156                zfuj = ( zfu(ji,jj,jk) + zfu(ji  ,jj+1,jk) ) 
    157                zfvi = ( zfv(ji,jj,jk) + zfv(ji+1,jj  ,jk) ) 
    158                IF( zfuj > 0 ) THEN   ;    zl_v = zlv_vu( ji  ,jj  ,jk,1) 
    159                ELSE                  ;    zl_v = zlv_vu( ji+1,jj,jk,1) 
    160                ENDIF 
    161                IF( zfvi > 0 ) THEN   ;    zl_u = zlu_uv( ji,jj  ,jk,1) 
    162                ELSE                  ;    zl_u = zlu_uv( ji,jj+1,jk,1) 
    163                ENDIF 
    164                ! 
    165                zfv_f(ji  ,jj  ,jk) = ( zfvi - gamma2 * ( zlv_vu(ji,jj,jk,2) + zlv_vu(ji+1,jj  ,jk,2) )  )   & 
    166                   &                * ( un(ji,jj,jk) + un(ji  ,jj+1,jk) - gamma1 * zl_u ) 
    167                zfu_f(ji  ,jj  ,jk) = ( zfuj - gamma2 * ( zlu_uv(ji,jj,jk,2) + zlu_uv(ji  ,jj+1,jk,2) )  )   & 
    168                   &                * ( vn(ji,jj,jk) + vn(ji+1,jj  ,jk) - gamma1 * zl_v ) 
    169             END DO 
    170          END DO 
    171          DO jj = 2, jpjm1                          ! divergence of horizontal momentum fluxes 
    172             DO ji = fs_2, fs_jpim1   ! vector opt. 
    173                ua(ji,jj,jk) = ua(ji,jj,jk) - (  zfu_t(ji+1,jj,jk) - zfu_t(ji,jj  ,jk)    & 
    174                   &                           + zfv_f(ji  ,jj,jk) - zfv_f(ji,jj-1,jk)  ) * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk) 
    175                va(ji,jj,jk) = va(ji,jj,jk) - (  zfu_f(ji,jj  ,jk) - zfu_f(ji-1,jj,jk)    & 
    176                   &                           + zfv_t(ji,jj+1,jk) - zfv_t(ji  ,jj,jk)  ) * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk) 
    177             END DO 
    178          END DO 
     137         DO_2D_10_10 
     138            zui = ( puu(ji,jj,jk,Kmm) + puu(ji+1,jj  ,jk,Kmm) ) 
     139            zvj = ( pvv(ji,jj,jk,Kmm) + pvv(ji  ,jj+1,jk,Kmm) ) 
     140            ! 
     141            IF( zui > 0 ) THEN   ;   zl_u = zlu_uu(ji  ,jj,jk,1) 
     142            ELSE                 ;   zl_u = zlu_uu(ji+1,jj,jk,1) 
     143            ENDIF 
     144            IF( zvj > 0 ) THEN   ;   zl_v = zlv_vv(ji,jj  ,jk,1) 
     145            ELSE                 ;   zl_v = zlv_vv(ji,jj+1,jk,1) 
     146            ENDIF 
     147            ! 
     148            zfu_t(ji+1,jj  ,jk) = ( zfu(ji,jj,jk) + zfu(ji+1,jj  ,jk)                               & 
     149               &                    - gamma2 * ( zlu_uu(ji,jj,jk,2) + zlu_uu(ji+1,jj  ,jk,2) )  )   & 
     150               &                * ( zui - gamma1 * zl_u) 
     151            zfv_t(ji  ,jj+1,jk) = ( zfv(ji,jj,jk) + zfv(ji  ,jj+1,jk)                               & 
     152               &                    - gamma2 * ( zlv_vv(ji,jj,jk,2) + zlv_vv(ji  ,jj+1,jk,2) )  )   & 
     153               &                * ( zvj - gamma1 * zl_v) 
     154            ! 
     155            zfuj = ( zfu(ji,jj,jk) + zfu(ji  ,jj+1,jk) ) 
     156            zfvi = ( zfv(ji,jj,jk) + zfv(ji+1,jj  ,jk) ) 
     157            IF( zfuj > 0 ) THEN   ;    zl_v = zlv_vu( ji  ,jj  ,jk,1) 
     158            ELSE                  ;    zl_v = zlv_vu( ji+1,jj,jk,1) 
     159            ENDIF 
     160            IF( zfvi > 0 ) THEN   ;    zl_u = zlu_uv( ji,jj  ,jk,1) 
     161            ELSE                  ;    zl_u = zlu_uv( ji,jj+1,jk,1) 
     162            ENDIF 
     163            ! 
     164            zfv_f(ji  ,jj  ,jk) = ( zfvi - gamma2 * ( zlv_vu(ji,jj,jk,2) + zlv_vu(ji+1,jj  ,jk,2) )  )   & 
     165               &                * ( puu(ji,jj,jk,Kmm) + puu(ji  ,jj+1,jk,Kmm) - gamma1 * zl_u ) 
     166            zfu_f(ji  ,jj  ,jk) = ( zfuj - gamma2 * ( zlu_uv(ji,jj,jk,2) + zlu_uv(ji  ,jj+1,jk,2) )  )   & 
     167               &                * ( pvv(ji,jj,jk,Kmm) + pvv(ji+1,jj  ,jk,Kmm) - gamma1 * zl_v ) 
     168         END_2D 
     169         DO_2D_00_00 
     170            puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - (  zfu_t(ji+1,jj,jk) - zfu_t(ji,jj  ,jk)    & 
     171               &                           + zfv_f(ji  ,jj,jk) - zfv_f(ji,jj-1,jk)  ) * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm) 
     172            pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - (  zfu_f(ji,jj  ,jk) - zfu_f(ji-1,jj,jk)    & 
     173               &                           + zfv_t(ji,jj+1,jk) - zfv_t(ji  ,jj,jk)  ) * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,Kmm) 
     174         END_2D 
    179175      END DO 
    180176      IF( l_trddyn ) THEN                          ! trends: send trends to trddyn for diagnostic 
    181          zfu_uw(:,:,:) = ua(:,:,:) - zfu_uw(:,:,:) 
    182          zfv_vw(:,:,:) = va(:,:,:) - zfv_vw(:,:,:) 
    183          CALL trd_dyn( zfu_uw, zfv_vw, jpdyn_keg, kt ) 
    184          zfu_t(:,:,:) = ua(:,:,:) 
    185          zfv_t(:,:,:) = va(:,:,:) 
     177         zfu_uw(:,:,:) = puu(:,:,:,Krhs) - zfu_uw(:,:,:) 
     178         zfv_vw(:,:,:) = pvv(:,:,:,Krhs) - zfv_vw(:,:,:) 
     179         CALL trd_dyn( zfu_uw, zfv_vw, jpdyn_keg, kt, Kmm ) 
     180         zfu_t(:,:,:) = puu(:,:,:,Krhs) 
     181         zfv_t(:,:,:) = pvv(:,:,:,Krhs) 
    186182      ENDIF 
    187183      !                                      ! ==================== ! 
    188184      !                                      !  Vertical advection  ! 
    189185      !                                      ! ==================== ! 
    190       DO jj = 2, jpjm1                             ! surface/bottom advective fluxes set to zero                   
    191          DO ji = fs_2, fs_jpim1 
    192             zfu_uw(ji,jj,jpk) = 0._wp 
    193             zfv_vw(ji,jj,jpk) = 0._wp 
    194             zfu_uw(ji,jj, 1 ) = 0._wp 
    195             zfv_vw(ji,jj, 1 ) = 0._wp 
    196          END DO 
     186      DO_2D_00_00 
     187         zfu_uw(ji,jj,jpk) = 0._wp 
     188         zfv_vw(ji,jj,jpk) = 0._wp 
     189         zfu_uw(ji,jj, 1 ) = 0._wp 
     190         zfv_vw(ji,jj, 1 ) = 0._wp 
     191      END_2D 
     192      IF( ln_linssh ) THEN                         ! constant volume : advection through the surface 
     193         DO_2D_00_00 
     194            zfu_uw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * ww(ji,jj,1) + e1e2t(ji+1,jj) * ww(ji+1,jj,1) ) * puu(ji,jj,1,Kmm) 
     195            zfv_vw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * ww(ji,jj,1) + e1e2t(ji,jj+1) * ww(ji,jj+1,1) ) * pvv(ji,jj,1,Kmm) 
     196         END_2D 
     197      ENDIF 
     198      DO jk = 2, jpkm1                          ! interior fluxes 
     199         DO_2D_01_01 
     200            zfw(ji,jj,jk) = 0.25_wp * e1e2t(ji,jj) * ww(ji,jj,jk) 
     201         END_2D 
     202         DO_2D_00_00 
     203            zfu_uw(ji,jj,jk) = ( zfw(ji,jj,jk)+ zfw(ji+1,jj,jk) ) * ( puu(ji,jj,jk,Kmm) + puu(ji,jj,jk-1,Kmm) ) 
     204            zfv_vw(ji,jj,jk) = ( zfw(ji,jj,jk)+ zfw(ji,jj+1,jk) ) * ( pvv(ji,jj,jk,Kmm) + pvv(ji,jj,jk-1,Kmm) ) 
     205         END_2D 
    197206      END DO 
    198       IF( ln_linssh ) THEN                         ! constant volume : advection through the surface 
    199          DO jj = 2, jpjm1 
    200             DO ji = fs_2, fs_jpim1 
    201                zfu_uw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * wn(ji,jj,1) + e1e2t(ji+1,jj) * wn(ji+1,jj,1) ) * un(ji,jj,1) 
    202                zfv_vw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * wn(ji,jj,1) + e1e2t(ji,jj+1) * wn(ji,jj+1,1) ) * vn(ji,jj,1) 
    203             END DO 
    204          END DO 
    205       ENDIF 
    206       DO jk = 2, jpkm1                          ! interior fluxes 
    207          DO jj = 2, jpj 
    208             DO ji = 2, jpi 
    209                zfw(ji,jj,jk) = 0.25_wp * e1e2t(ji,jj) * wn(ji,jj,jk) 
    210             END DO 
    211          END DO 
    212          DO jj = 2, jpjm1 
    213             DO ji = fs_2, fs_jpim1   ! vector opt. 
    214                zfu_uw(ji,jj,jk) = ( zfw(ji,jj,jk)+ zfw(ji+1,jj,jk) ) * ( un(ji,jj,jk) + un(ji,jj,jk-1) ) 
    215                zfv_vw(ji,jj,jk) = ( zfw(ji,jj,jk)+ zfw(ji,jj+1,jk) ) * ( vn(ji,jj,jk) + vn(ji,jj,jk-1) ) 
    216             END DO 
    217          END DO 
    218       END DO 
    219       DO jk = 1, jpkm1                          ! divergence of vertical momentum flux divergence 
    220          DO jj = 2, jpjm1 
    221             DO ji = fs_2, fs_jpim1   ! vector opt. 
    222                ua(ji,jj,jk) =  ua(ji,jj,jk) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk) 
    223                va(ji,jj,jk) =  va(ji,jj,jk) - ( zfv_vw(ji,jj,jk) - zfv_vw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk) 
    224             END DO 
    225          END DO 
    226       END DO 
     207      DO_3D_00_00( 1, jpkm1 ) 
     208         puu(ji,jj,jk,Krhs) =  puu(ji,jj,jk,Krhs) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm) 
     209         pvv(ji,jj,jk,Krhs) =  pvv(ji,jj,jk,Krhs) - ( zfv_vw(ji,jj,jk) - zfv_vw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,Kmm) 
     210      END_3D 
    227211      ! 
    228212      IF( l_trddyn ) THEN                       ! save the vertical advection trend for diagnostic 
    229          zfu_t(:,:,:) = ua(:,:,:) - zfu_t(:,:,:) 
    230          zfv_t(:,:,:) = va(:,:,:) - zfv_t(:,:,:) 
    231          CALL trd_dyn( zfu_t, zfv_t, jpdyn_zad, kt ) 
     213         zfu_t(:,:,:) = puu(:,:,:,Krhs) - zfu_t(:,:,:) 
     214         zfv_t(:,:,:) = pvv(:,:,:,Krhs) - zfv_t(:,:,:) 
     215         CALL trd_dyn( zfu_t, zfv_t, jpdyn_zad, kt, Kmm ) 
    232216      ENDIF 
    233217      !                                         ! Control print 
    234       IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' ubs2 adv - Ua: ', mask1=umask,   & 
    235          &                       tab3d_2=va, clinfo2=           ' Va: ', mask2=vmask, clinfo3='dyn' ) 
     218      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' ubs2 adv - Ua: ', mask1=umask,   & 
     219         &                                  tab3d_2=pvv(:,:,:,Krhs), clinfo2=           ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    236220      ! 
    237221   END SUBROUTINE dyn_adv_ubs 
  • NEMO/trunk/src/OCE/DYN/dynhpg.F90

    r11536 r12377  
    3131   !!---------------------------------------------------------------------- 
    3232   USE oce             ! ocean dynamics and tracers 
     33   USE isf_oce , ONLY : risfload  ! ice shelf  (risfload variable) 
     34   USE isfload , ONLY : isf_load  ! ice shelf  (isf_load routine ) 
    3335   USE sbc_oce         ! surface variable (only for the flag with ice shelf) 
    3436   USE dom_oce         ! ocean space and time domain 
     
    7375 
    7476   !! * Substitutions 
    75 #  include "vectopt_loop_substitute.h90" 
     77#  include "do_loop_substitute.h90" 
    7678   !!---------------------------------------------------------------------- 
    7779   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    8183CONTAINS 
    8284 
    83    SUBROUTINE dyn_hpg( kt ) 
     85   SUBROUTINE dyn_hpg( kt, Kmm, puu, pvv, Krhs ) 
    8486      !!--------------------------------------------------------------------- 
    8587      !!                  ***  ROUTINE dyn_hpg  *** 
     
    8890      !!              using the scheme defined in the namelist 
    8991      !! 
    90       !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend 
     92      !! ** Action : - Update (puu(:,:,:,Krhs),pvv(:,:,:,Krhs)) with the now hydrastatic pressure trend 
    9193      !!             - send trends to trd_dyn for futher diagnostics (l_trddyn=T) 
    9294      !!---------------------------------------------------------------------- 
    93       INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     95      INTEGER                             , INTENT( in )  ::  kt          ! ocean time-step index 
     96      INTEGER                             , INTENT( in )  ::  Kmm, Krhs   ! ocean time level indices 
     97      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation 
     98      ! 
    9499      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdu, ztrdv 
    95100      !!---------------------------------------------------------------------- 
     
    97102      IF( ln_timing )   CALL timing_start('dyn_hpg') 
    98103      ! 
    99       IF( l_trddyn ) THEN                    ! Temporary saving of ua and va trends (l_trddyn) 
     104      IF( l_trddyn ) THEN                    ! Temporary saving of puu(:,:,:,Krhs) and pvv(:,:,:,Krhs) trends (l_trddyn) 
    100105         ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) ) 
    101          ztrdu(:,:,:) = ua(:,:,:) 
    102          ztrdv(:,:,:) = va(:,:,:) 
     106         ztrdu(:,:,:) = puu(:,:,:,Krhs) 
     107         ztrdv(:,:,:) = pvv(:,:,:,Krhs) 
    103108      ENDIF 
    104109      ! 
    105110      SELECT CASE ( nhpg )      ! Hydrostatic pressure gradient computation 
    106       CASE ( np_zco )   ;   CALL hpg_zco    ( kt )      ! z-coordinate 
    107       CASE ( np_zps )   ;   CALL hpg_zps    ( kt )      ! z-coordinate plus partial steps (interpolation) 
    108       CASE ( np_sco )   ;   CALL hpg_sco    ( kt )      ! s-coordinate (standard jacobian formulation) 
    109       CASE ( np_djc )   ;   CALL hpg_djc    ( kt )      ! s-coordinate (Density Jacobian with Cubic polynomial) 
    110       CASE ( np_prj )   ;   CALL hpg_prj    ( kt )      ! s-coordinate (Pressure Jacobian scheme) 
    111       CASE ( np_isf )   ;   CALL hpg_isf    ( kt )      ! s-coordinate similar to sco modify for ice shelf 
     111      CASE ( np_zco )   ;   CALL hpg_zco    ( kt, Kmm, puu, pvv, Krhs )  ! z-coordinate 
     112      CASE ( np_zps )   ;   CALL hpg_zps    ( kt, Kmm, puu, pvv, Krhs )  ! z-coordinate plus partial steps (interpolation) 
     113      CASE ( np_sco )   ;   CALL hpg_sco    ( kt, Kmm, puu, pvv, Krhs )  ! s-coordinate (standard jacobian formulation) 
     114      CASE ( np_djc )   ;   CALL hpg_djc    ( kt, Kmm, puu, pvv, Krhs )  ! s-coordinate (Density Jacobian with Cubic polynomial) 
     115      CASE ( np_prj )   ;   CALL hpg_prj    ( kt, Kmm, puu, pvv, Krhs )  ! s-coordinate (Pressure Jacobian scheme) 
     116      CASE ( np_isf )   ;   CALL hpg_isf    ( kt, Kmm, puu, pvv, Krhs )  ! s-coordinate similar to sco modify for ice shelf 
    112117      END SELECT 
    113118      ! 
    114119      IF( l_trddyn ) THEN      ! save the hydrostatic pressure gradient trends for momentum trend diagnostics 
    115          ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    116          ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    117          CALL trd_dyn( ztrdu, ztrdv, jpdyn_hpg, kt ) 
     120         ztrdu(:,:,:) = puu(:,:,:,Krhs) - ztrdu(:,:,:) 
     121         ztrdv(:,:,:) = pvv(:,:,:,Krhs) - ztrdv(:,:,:) 
     122         CALL trd_dyn( ztrdu, ztrdv, jpdyn_hpg, kt, Kmm ) 
    118123         DEALLOCATE( ztrdu , ztrdv ) 
    119124      ENDIF 
    120125      ! 
    121       IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' hpg  - Ua: ', mask1=umask,   & 
    122          &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
     126      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' hpg  - Ua: ', mask1=umask,   & 
     127         &                                  tab3d_2=pvv(:,:,:,Krhs), clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    123128      ! 
    124129      IF( ln_timing )   CALL timing_stop('dyn_hpg') 
     
    127132 
    128133 
    129    SUBROUTINE dyn_hpg_init 
     134   SUBROUTINE dyn_hpg_init( Kmm ) 
    130135      !!---------------------------------------------------------------------- 
    131136      !!                 ***  ROUTINE dyn_hpg_init  *** 
     
    137142      !!      with the type of vertical coordinate used (zco, zps, sco) 
    138143      !!---------------------------------------------------------------------- 
     144      INTEGER, INTENT( in ) :: Kmm   ! ocean time level index 
     145      ! 
    139146      INTEGER ::   ioptio = 0      ! temporary integer 
    140147      INTEGER ::   ios             ! Local integer output status for namelist read 
     
    150157      !!---------------------------------------------------------------------- 
    151158      ! 
    152       REWIND( numnam_ref )              ! Namelist namdyn_hpg in reference namelist : Hydrostatic pressure gradient 
    153159      READ  ( numnam_ref, namdyn_hpg, IOSTAT = ios, ERR = 901) 
    154160901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_hpg in reference namelist' ) 
    155161      ! 
    156       REWIND( numnam_cfg )              ! Namelist namdyn_hpg in configuration namelist : Hydrostatic pressure gradient 
    157162      READ  ( numnam_cfg, namdyn_hpg, IOSTAT = ios, ERR = 902 ) 
    158163902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdyn_hpg in configuration namelist' ) 
     
    213218      ENDIF 
    214219      !                           
    215       IF ( .NOT. ln_isfcav ) THEN     !--- no ice shelf load 
    216          riceload(:,:) = 0._wp 
    217          ! 
    218       ELSE                            !--- set an ice shelf load 
    219          ! 
    220          IF(lwp) WRITE(numout,*) 
    221          IF(lwp) WRITE(numout,*) '   ice shelf case: set the ice-shelf load' 
    222          ALLOCATE( zts_top(jpi,jpj,jpts) , zrhd(jpi,jpj,jpk) , zrhdtop_isf(jpi,jpj) , ziceload(jpi,jpj) )  
    223          ! 
    224          znad = 1._wp                     !- To use density and not density anomaly 
    225          ! 
    226          !                                !- assume water displaced by the ice shelf is at T=-1.9 and S=34.4 (rude) 
    227          zts_top(:,:,jp_tem) = -1.9_wp   ;   zts_top(:,:,jp_sal) = 34.4_wp 
    228          ! 
    229          DO jk = 1, jpk                   !- compute density of the water displaced by the ice shelf  
    230             CALL eos( zts_top(:,:,:), gdept_n(:,:,jk), zrhd(:,:,jk) ) 
    231          END DO 
    232          ! 
    233          !                                !- compute rhd at the ice/oce interface (ice shelf side) 
    234          CALL eos( zts_top , risfdep, zrhdtop_isf ) 
    235          ! 
    236          !                                !- Surface value + ice shelf gradient 
    237          ziceload = 0._wp                       ! compute pressure due to ice shelf load  
    238          DO jj = 1, jpj                         ! (used to compute hpgi/j for all the level from 1 to miku/v) 
    239             DO ji = 1, jpi                      ! divided by 2 later 
    240                ikt = mikt(ji,jj) 
    241                ziceload(ji,jj) = ziceload(ji,jj) + (znad + zrhd(ji,jj,1) ) * e3w_n(ji,jj,1) * (1._wp - tmask(ji,jj,1)) 
    242                DO jk = 2, ikt-1 
    243                   ziceload(ji,jj) = ziceload(ji,jj) + (2._wp * znad + zrhd(ji,jj,jk-1) + zrhd(ji,jj,jk)) * e3w_n(ji,jj,jk) & 
    244                      &                              * (1._wp - tmask(ji,jj,jk)) 
    245                END DO 
    246                IF (ikt  >=  2) ziceload(ji,jj) = ziceload(ji,jj) + (2._wp * znad + zrhdtop_isf(ji,jj) + zrhd(ji,jj,ikt-1)) & 
    247                   &                                              * ( risfdep(ji,jj) - gdept_n(ji,jj,ikt-1) ) 
    248             END DO 
    249          END DO 
    250          riceload(:,:) = ziceload(:,:)  ! need to be saved for diaar5 
    251          ! 
    252          DEALLOCATE( zts_top , zrhd , zrhdtop_isf , ziceload )  
    253       ENDIF 
    254       ! 
    255220   END SUBROUTINE dyn_hpg_init 
    256221 
    257222 
    258    SUBROUTINE hpg_zco( kt ) 
     223   SUBROUTINE hpg_zco( kt, Kmm, puu, pvv, Krhs ) 
    259224      !!--------------------------------------------------------------------- 
    260225      !!                  ***  ROUTINE hpg_zco  *** 
     
    266231      !!      level:    zhpi = grav ..... 
    267232      !!                zhpj = grav ..... 
    268       !!      add it to the general momentum trend (ua,va). 
    269       !!            ua = ua - 1/e1u * zhpi 
    270       !!            va = va - 1/e2v * zhpj 
    271       !! 
    272       !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend 
    273       !!---------------------------------------------------------------------- 
    274       INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
     233      !!      add it to the general momentum trend (puu(:,:,:,Krhs),pvv(:,:,:,Krhs)). 
     234      !!            puu(:,:,:,Krhs) = puu(:,:,:,Krhs) - 1/e1u * zhpi 
     235      !!            pvv(:,:,:,Krhs) = pvv(:,:,:,Krhs) - 1/e2v * zhpj 
     236      !! 
     237      !! ** Action : - Update (puu(:,:,:,Krhs),pvv(:,:,:,Krhs)) with the now hydrastatic pressure trend 
     238      !!---------------------------------------------------------------------- 
     239      INTEGER                             , INTENT( in )  ::  kt          ! ocean time-step index 
     240      INTEGER                             , INTENT( in )  ::  Kmm, Krhs   ! ocean time level indices 
     241      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation 
    275242      ! 
    276243      INTEGER  ::   ji, jj, jk       ! dummy loop indices 
     
    288255 
    289256      ! Surface value 
    290       DO jj = 2, jpjm1 
    291          DO ji = fs_2, fs_jpim1   ! vector opt. 
    292             zcoef1 = zcoef0 * e3w_n(ji,jj,1) 
    293             ! hydrostatic pressure gradient 
    294             zhpi(ji,jj,1) = zcoef1 * ( rhd(ji+1,jj,1) - rhd(ji,jj,1) ) * r1_e1u(ji,jj) 
    295             zhpj(ji,jj,1) = zcoef1 * ( rhd(ji,jj+1,1) - rhd(ji,jj,1) ) * r1_e2v(ji,jj) 
    296             ! add to the general momentum trend 
    297             ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1) 
    298             va(ji,jj,1) = va(ji,jj,1) + zhpj(ji,jj,1) 
    299          END DO 
    300       END DO 
     257      DO_2D_00_00 
     258         zcoef1 = zcoef0 * e3w(ji,jj,1,Kmm) 
     259         ! hydrostatic pressure gradient 
     260         zhpi(ji,jj,1) = zcoef1 * ( rhd(ji+1,jj,1) - rhd(ji,jj,1) ) * r1_e1u(ji,jj) 
     261         zhpj(ji,jj,1) = zcoef1 * ( rhd(ji,jj+1,1) - rhd(ji,jj,1) ) * r1_e2v(ji,jj) 
     262         ! add to the general momentum trend 
     263         puu(ji,jj,1,Krhs) = puu(ji,jj,1,Krhs) + zhpi(ji,jj,1) 
     264         pvv(ji,jj,1,Krhs) = pvv(ji,jj,1,Krhs) + zhpj(ji,jj,1) 
     265      END_2D 
    301266 
    302267      ! 
    303268      ! interior value (2=<jk=<jpkm1) 
    304       DO jk = 2, jpkm1 
    305          DO jj = 2, jpjm1 
    306             DO ji = fs_2, fs_jpim1   ! vector opt. 
    307                zcoef1 = zcoef0 * e3w_n(ji,jj,jk) 
    308                ! hydrostatic pressure gradient 
    309                zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1)   & 
    310                   &           + zcoef1 * (  ( rhd(ji+1,jj,jk)+rhd(ji+1,jj,jk-1) )    & 
    311                   &                       - ( rhd(ji  ,jj,jk)+rhd(ji  ,jj,jk-1) )  ) * r1_e1u(ji,jj) 
    312  
    313                zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1)   & 
    314                   &           + zcoef1 * (  ( rhd(ji,jj+1,jk)+rhd(ji,jj+1,jk-1) )    & 
    315                   &                       - ( rhd(ji,jj,  jk)+rhd(ji,jj  ,jk-1) )  ) * r1_e2v(ji,jj) 
    316                ! add to the general momentum trend 
    317                ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk) 
    318                va(ji,jj,jk) = va(ji,jj,jk) + zhpj(ji,jj,jk) 
    319             END DO 
    320          END DO 
    321       END DO 
     269      DO_3D_00_00( 2, jpkm1 ) 
     270         zcoef1 = zcoef0 * e3w(ji,jj,jk,Kmm) 
     271         ! hydrostatic pressure gradient 
     272         zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1)   & 
     273            &           + zcoef1 * (  ( rhd(ji+1,jj,jk)+rhd(ji+1,jj,jk-1) )    & 
     274            &                       - ( rhd(ji  ,jj,jk)+rhd(ji  ,jj,jk-1) )  ) * r1_e1u(ji,jj) 
     275 
     276         zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1)   & 
     277            &           + zcoef1 * (  ( rhd(ji,jj+1,jk)+rhd(ji,jj+1,jk-1) )    & 
     278            &                       - ( rhd(ji,jj,  jk)+rhd(ji,jj  ,jk-1) )  ) * r1_e2v(ji,jj) 
     279         ! add to the general momentum trend 
     280         puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + zhpi(ji,jj,jk) 
     281         pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + zhpj(ji,jj,jk) 
     282      END_3D 
    322283      ! 
    323284   END SUBROUTINE hpg_zco 
    324285 
    325286 
    326    SUBROUTINE hpg_zps( kt ) 
     287   SUBROUTINE hpg_zps( kt, Kmm, puu, pvv, Krhs ) 
    327288      !!--------------------------------------------------------------------- 
    328289      !!                 ***  ROUTINE hpg_zps  *** 
     
    330291      !! ** Method  :   z-coordinate plus partial steps case.  blahblah... 
    331292      !! 
    332       !! ** Action  : - Update (ua,va) with the now hydrastatic pressure trend 
    333       !!---------------------------------------------------------------------- 
    334       INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
     293      !! ** Action  : - Update (puu(:,:,:,Krhs),pvv(:,:,:,Krhs)) with the now hydrastatic pressure trend 
     294      !!---------------------------------------------------------------------- 
     295      INTEGER                             , INTENT( in )  ::  kt          ! ocean time-step index 
     296      INTEGER                             , INTENT( in )  ::  Kmm, Krhs   ! ocean time level indices 
     297      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation 
    335298      !! 
    336299      INTEGER  ::   ji, jj, jk                       ! dummy loop indices 
     
    348311 
    349312      ! Partial steps: Compute NOW horizontal gradient of t, s, rd at the last ocean level 
    350       CALL zps_hde( kt, jpts, tsn, zgtsu, zgtsv, rhd, zgru , zgrv ) 
     313      CALL zps_hde( kt, Kmm, jpts, ts(:,:,:,:,Kmm), zgtsu, zgtsv, rhd, zgru , zgrv ) 
    351314 
    352315      ! Local constant initialization 
     
    354317 
    355318      !  Surface value (also valid in partial step case) 
    356       DO jj = 2, jpjm1 
    357          DO ji = fs_2, fs_jpim1   ! vector opt. 
    358             zcoef1 = zcoef0 * e3w_n(ji,jj,1) 
    359             ! hydrostatic pressure gradient 
    360             zhpi(ji,jj,1) = zcoef1 * ( rhd(ji+1,jj  ,1) - rhd(ji,jj,1) ) * r1_e1u(ji,jj) 
    361             zhpj(ji,jj,1) = zcoef1 * ( rhd(ji  ,jj+1,1) - rhd(ji,jj,1) ) * r1_e2v(ji,jj) 
    362             ! add to the general momentum trend 
    363             ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1) 
    364             va(ji,jj,1) = va(ji,jj,1) + zhpj(ji,jj,1) 
    365          END DO 
    366       END DO 
     319      DO_2D_00_00 
     320         zcoef1 = zcoef0 * e3w(ji,jj,1,Kmm) 
     321         ! hydrostatic pressure gradient 
     322         zhpi(ji,jj,1) = zcoef1 * ( rhd(ji+1,jj  ,1) - rhd(ji,jj,1) ) * r1_e1u(ji,jj) 
     323         zhpj(ji,jj,1) = zcoef1 * ( rhd(ji  ,jj+1,1) - rhd(ji,jj,1) ) * r1_e2v(ji,jj) 
     324         ! add to the general momentum trend 
     325         puu(ji,jj,1,Krhs) = puu(ji,jj,1,Krhs) + zhpi(ji,jj,1) 
     326         pvv(ji,jj,1,Krhs) = pvv(ji,jj,1,Krhs) + zhpj(ji,jj,1) 
     327      END_2D 
    367328 
    368329      ! interior value (2=<jk=<jpkm1) 
    369       DO jk = 2, jpkm1 
    370          DO jj = 2, jpjm1 
    371             DO ji = fs_2, fs_jpim1   ! vector opt. 
    372                zcoef1 = zcoef0 * e3w_n(ji,jj,jk) 
    373                ! hydrostatic pressure gradient 
    374                zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1)   & 
    375                   &           + zcoef1 * (  ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) )   & 
    376                   &                       - ( rhd(ji  ,jj,jk) + rhd(ji  ,jj,jk-1) )  ) * r1_e1u(ji,jj) 
    377  
    378                zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1)   & 
    379                   &           + zcoef1 * (  ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) )   & 
    380                   &                       - ( rhd(ji,jj,  jk) + rhd(ji,jj  ,jk-1) )  ) * r1_e2v(ji,jj) 
    381                ! add to the general momentum trend 
    382                ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk) 
    383                va(ji,jj,jk) = va(ji,jj,jk) + zhpj(ji,jj,jk) 
    384             END DO 
    385          END DO 
    386       END DO 
     330      DO_3D_00_00( 2, jpkm1 ) 
     331         zcoef1 = zcoef0 * e3w(ji,jj,jk,Kmm) 
     332         ! hydrostatic pressure gradient 
     333         zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1)   & 
     334            &           + zcoef1 * (  ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) )   & 
     335            &                       - ( rhd(ji  ,jj,jk) + rhd(ji  ,jj,jk-1) )  ) * r1_e1u(ji,jj) 
     336 
     337         zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1)   & 
     338            &           + zcoef1 * (  ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) )   & 
     339            &                       - ( rhd(ji,jj,  jk) + rhd(ji,jj  ,jk-1) )  ) * r1_e2v(ji,jj) 
     340         ! add to the general momentum trend 
     341         puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + zhpi(ji,jj,jk) 
     342         pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + zhpj(ji,jj,jk) 
     343      END_3D 
    387344 
    388345      ! partial steps correction at the last level  (use zgru & zgrv computed in zpshde.F90) 
    389       DO jj = 2, jpjm1 
    390          DO ji = 2, jpim1 
    391             iku = mbku(ji,jj) 
    392             ikv = mbkv(ji,jj) 
    393             zcoef2 = zcoef0 * MIN( e3w_n(ji,jj,iku), e3w_n(ji+1,jj  ,iku) ) 
    394             zcoef3 = zcoef0 * MIN( e3w_n(ji,jj,ikv), e3w_n(ji  ,jj+1,ikv) ) 
    395             IF( iku > 1 ) THEN            ! on i-direction (level 2 or more) 
    396                ua  (ji,jj,iku) = ua(ji,jj,iku) - zhpi(ji,jj,iku)         ! subtract old value 
    397                zhpi(ji,jj,iku) = zhpi(ji,jj,iku-1)                   &   ! compute the new one 
    398                   &            + zcoef2 * ( rhd(ji+1,jj,iku-1) - rhd(ji,jj,iku-1) + zgru(ji,jj) ) * r1_e1u(ji,jj) 
    399                ua  (ji,jj,iku) = ua(ji,jj,iku) + zhpi(ji,jj,iku)         ! add the new one to the general momentum trend 
    400             ENDIF 
    401             IF( ikv > 1 ) THEN            ! on j-direction (level 2 or more) 
    402                va  (ji,jj,ikv) = va(ji,jj,ikv) - zhpj(ji,jj,ikv)         ! subtract old value 
    403                zhpj(ji,jj,ikv) = zhpj(ji,jj,ikv-1)                   &   ! compute the new one 
    404                   &            + zcoef3 * ( rhd(ji,jj+1,ikv-1) - rhd(ji,jj,ikv-1) + zgrv(ji,jj) ) * r1_e2v(ji,jj) 
    405                va  (ji,jj,ikv) = va(ji,jj,ikv) + zhpj(ji,jj,ikv)         ! add the new one to the general momentum trend 
    406             ENDIF 
    407          END DO 
    408       END DO 
     346      DO_2D_00_00 
     347         iku = mbku(ji,jj) 
     348         ikv = mbkv(ji,jj) 
     349         zcoef2 = zcoef0 * MIN( e3w(ji,jj,iku,Kmm), e3w(ji+1,jj  ,iku,Kmm) ) 
     350         zcoef3 = zcoef0 * MIN( e3w(ji,jj,ikv,Kmm), e3w(ji  ,jj+1,ikv,Kmm) ) 
     351         IF( iku > 1 ) THEN            ! on i-direction (level 2 or more) 
     352            puu  (ji,jj,iku,Krhs) = puu(ji,jj,iku,Krhs) - zhpi(ji,jj,iku)         ! subtract old value 
     353            zhpi(ji,jj,iku) = zhpi(ji,jj,iku-1)                   &   ! compute the new one 
     354               &            + zcoef2 * ( rhd(ji+1,jj,iku-1) - rhd(ji,jj,iku-1) + zgru(ji,jj) ) * r1_e1u(ji,jj) 
     355            puu  (ji,jj,iku,Krhs) = puu(ji,jj,iku,Krhs) + zhpi(ji,jj,iku)         ! add the new one to the general momentum trend 
     356         ENDIF 
     357         IF( ikv > 1 ) THEN            ! on j-direction (level 2 or more) 
     358            pvv  (ji,jj,ikv,Krhs) = pvv(ji,jj,ikv,Krhs) - zhpj(ji,jj,ikv)         ! subtract old value 
     359            zhpj(ji,jj,ikv) = zhpj(ji,jj,ikv-1)                   &   ! compute the new one 
     360               &            + zcoef3 * ( rhd(ji,jj+1,ikv-1) - rhd(ji,jj,ikv-1) + zgrv(ji,jj) ) * r1_e2v(ji,jj) 
     361            pvv  (ji,jj,ikv,Krhs) = pvv(ji,jj,ikv,Krhs) + zhpj(ji,jj,ikv)         ! add the new one to the general momentum trend 
     362         ENDIF 
     363      END_2D 
    409364      ! 
    410365   END SUBROUTINE hpg_zps 
    411366 
    412367 
    413    SUBROUTINE hpg_sco( kt ) 
     368   SUBROUTINE hpg_sco( kt, Kmm, puu, pvv, Krhs ) 
    414369      !!--------------------------------------------------------------------- 
    415370      !!                  ***  ROUTINE hpg_sco  *** 
     
    423378      !!         zhpi = grav .....  + 1/e1u mi(rhd) di[ grav dep3w ] 
    424379      !!         zhpj = grav .....  + 1/e2v mj(rhd) dj[ grav dep3w ] 
    425       !!      add it to the general momentum trend (ua,va). 
    426       !!         ua = ua - 1/e1u * zhpi 
    427       !!         va = va - 1/e2v * zhpj 
    428       !! 
    429       !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend 
    430       !!---------------------------------------------------------------------- 
    431       INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
     380      !!      add it to the general momentum trend (puu(:,:,:,Krhs),pvv(:,:,:,Krhs)). 
     381      !!         puu(:,:,:,Krhs) = puu(:,:,:,Krhs) - 1/e1u * zhpi 
     382      !!         pvv(:,:,:,Krhs) = pvv(:,:,:,Krhs) - 1/e2v * zhpj 
     383      !! 
     384      !! ** Action : - Update (puu(:,:,:,Krhs),pvv(:,:,:,Krhs)) with the now hydrastatic pressure trend 
     385      !!---------------------------------------------------------------------- 
     386      INTEGER                             , INTENT( in )  ::  kt          ! ocean time-step index 
     387      INTEGER                             , INTENT( in )  ::  Kmm, Krhs   ! ocean time level indices 
     388      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation 
    432389      !! 
    433390      INTEGER  ::   ji, jj, jk, jii, jjj                 ! dummy loop indices 
     
    452409      ! 
    453410      IF( ln_wd_il ) THEN 
    454         DO jj = 2, jpjm1 
    455            DO ji = 2, jpim1  
    456              ll_tmp1 = MIN(  sshn(ji,jj)               ,  sshn(ji+1,jj) ) >                & 
    457                   &    MAX( -ht_0(ji,jj)               , -ht_0(ji+1,jj) ) .AND.            & 
    458                   &    MAX(  sshn(ji,jj) +  ht_0(ji,jj),  sshn(ji+1,jj) + ht_0(ji+1,jj) )  & 
    459                   &                                                       > rn_wdmin1 + rn_wdmin2 
    460              ll_tmp2 = ( ABS( sshn(ji,jj)              -  sshn(ji+1,jj) ) > 1.E-12 ) .AND. (       & 
    461                   &    MAX(   sshn(ji,jj)              ,  sshn(ji+1,jj) ) >                & 
    462                   &    MAX(  -ht_0(ji,jj)              , -ht_0(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 ) 
    463  
    464              IF(ll_tmp1) THEN 
    465                zcpx(ji,jj) = 1.0_wp 
    466              ELSE IF(ll_tmp2) THEN 
    467                ! no worries about  sshn(ji+1,jj) -  sshn(ji  ,jj) = 0, it won't happen ! here 
    468                zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + ht_0(ji+1,jj) - sshn(ji,jj) - ht_0(ji,jj)) & 
    469                            &    / (sshn(ji+1,jj) - sshn(ji  ,jj)) ) 
    470              ELSE 
    471                zcpx(ji,jj) = 0._wp 
    472              END IF 
    473        
    474              ll_tmp1 = MIN(  sshn(ji,jj)              ,  sshn(ji,jj+1) ) >                & 
    475                   &    MAX( -ht_0(ji,jj)              , -ht_0(ji,jj+1) ) .AND.            & 
    476                   &    MAX(  sshn(ji,jj) + ht_0(ji,jj),  sshn(ji,jj+1) + ht_0(ji,jj+1) )  & 
    477                   &                                                      > rn_wdmin1 + rn_wdmin2 
    478              ll_tmp2 = ( ABS( sshn(ji,jj)             -  sshn(ji,jj+1) ) > 1.E-12 ) .AND. (        & 
    479                   &    MAX(   sshn(ji,jj)             ,  sshn(ji,jj+1) ) >                & 
    480                   &    MAX(  -ht_0(ji,jj)             , -ht_0(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 ) 
    481  
    482              IF(ll_tmp1) THEN 
    483                zcpy(ji,jj) = 1.0_wp 
    484              ELSE IF(ll_tmp2) THEN 
    485                ! no worries about  sshn(ji,jj+1) -  sshn(ji,jj  ) = 0, it won't happen ! here 
    486                zcpy(ji,jj) = ABS( (sshn(ji,jj+1) + ht_0(ji,jj+1) - sshn(ji,jj) - ht_0(ji,jj)) & 
    487                            &    / (sshn(ji,jj+1) - sshn(ji,jj  )) ) 
    488              ELSE 
    489                zcpy(ji,jj) = 0._wp 
    490              END IF 
    491            END DO 
    492         END DO 
     411        DO_2D_00_00 
     412          ll_tmp1 = MIN(  ssh(ji,jj,Kmm)               ,  ssh(ji+1,jj,Kmm) ) >                & 
     413               &    MAX( -ht_0(ji,jj)               , -ht_0(ji+1,jj) ) .AND.            & 
     414               &    MAX(  ssh(ji,jj,Kmm) +  ht_0(ji,jj),  ssh(ji+1,jj,Kmm) + ht_0(ji+1,jj) )  & 
     415               &                                                       > rn_wdmin1 + rn_wdmin2 
     416          ll_tmp2 = ( ABS( ssh(ji,jj,Kmm)              -  ssh(ji+1,jj,Kmm) ) > 1.E-12 ) .AND. (       & 
     417               &    MAX(   ssh(ji,jj,Kmm)              ,  ssh(ji+1,jj,Kmm) ) >                & 
     418               &    MAX(  -ht_0(ji,jj)              , -ht_0(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 ) 
     419 
     420          IF(ll_tmp1) THEN 
     421            zcpx(ji,jj) = 1.0_wp 
     422          ELSE IF(ll_tmp2) THEN 
     423            ! no worries about  ssh(ji+1,jj,Kmm) -  ssh(ji  ,jj,Kmm) = 0, it won't happen ! here 
     424            zcpx(ji,jj) = ABS( (ssh(ji+1,jj,Kmm) + ht_0(ji+1,jj) - ssh(ji,jj,Kmm) - ht_0(ji,jj)) & 
     425                        &    / (ssh(ji+1,jj,Kmm) - ssh(ji  ,jj,Kmm)) ) 
     426          ELSE 
     427            zcpx(ji,jj) = 0._wp 
     428          END IF 
     429    
     430          ll_tmp1 = MIN(  ssh(ji,jj,Kmm)              ,  ssh(ji,jj+1,Kmm) ) >                & 
     431               &    MAX( -ht_0(ji,jj)              , -ht_0(ji,jj+1) ) .AND.            & 
     432               &    MAX(  ssh(ji,jj,Kmm) + ht_0(ji,jj),  ssh(ji,jj+1,Kmm) + ht_0(ji,jj+1) )  & 
     433               &                                                      > rn_wdmin1 + rn_wdmin2 
     434          ll_tmp2 = ( ABS( ssh(ji,jj,Kmm)             -  ssh(ji,jj+1,Kmm) ) > 1.E-12 ) .AND. (        & 
     435               &    MAX(   ssh(ji,jj,Kmm)             ,  ssh(ji,jj+1,Kmm) ) >                & 
     436               &    MAX(  -ht_0(ji,jj)             , -ht_0(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 ) 
     437 
     438          IF(ll_tmp1) THEN 
     439            zcpy(ji,jj) = 1.0_wp 
     440          ELSE IF(ll_tmp2) THEN 
     441            ! no worries about  ssh(ji,jj+1,Kmm) -  ssh(ji,jj  ,Kmm) = 0, it won't happen ! here 
     442            zcpy(ji,jj) = ABS( (ssh(ji,jj+1,Kmm) + ht_0(ji,jj+1) - ssh(ji,jj,Kmm) - ht_0(ji,jj)) & 
     443                        &    / (ssh(ji,jj+1,Kmm) - ssh(ji,jj  ,Kmm)) ) 
     444          ELSE 
     445            zcpy(ji,jj) = 0._wp 
     446          END IF 
     447        END_2D 
    493448        CALL lbc_lnk_multi( 'dynhpg', zcpx, 'U', 1., zcpy, 'V', 1. ) 
    494449      END IF 
    495450 
    496451      ! Surface value 
    497       DO jj = 2, jpjm1 
    498          DO ji = fs_2, fs_jpim1   ! vector opt. 
    499             ! hydrostatic pressure gradient along s-surfaces 
    500             zhpi(ji,jj,1) = zcoef0 * (  e3w_n(ji+1,jj  ,1) * ( znad + rhd(ji+1,jj  ,1) )    & 
    501                &                      - e3w_n(ji  ,jj  ,1) * ( znad + rhd(ji  ,jj  ,1) )  ) * r1_e1u(ji,jj) 
    502             zhpj(ji,jj,1) = zcoef0 * (  e3w_n(ji  ,jj+1,1) * ( znad + rhd(ji  ,jj+1,1) )    & 
    503                &                      - e3w_n(ji  ,jj  ,1) * ( znad + rhd(ji  ,jj  ,1) )  ) * r1_e2v(ji,jj) 
    504             ! s-coordinate pressure gradient correction 
    505             zuap = -zcoef0 * ( rhd    (ji+1,jj,1) + rhd    (ji,jj,1) + 2._wp * znad )   & 
    506                &           * ( gde3w_n(ji+1,jj,1) - gde3w_n(ji,jj,1) ) * r1_e1u(ji,jj) 
    507             zvap = -zcoef0 * ( rhd    (ji,jj+1,1) + rhd    (ji,jj,1) + 2._wp * znad )   & 
    508                &           * ( gde3w_n(ji,jj+1,1) - gde3w_n(ji,jj,1) ) * r1_e2v(ji,jj) 
    509             ! 
    510             IF( ln_wd_il ) THEN 
    511                zhpi(ji,jj,1) = zhpi(ji,jj,1) * zcpx(ji,jj) 
    512                zhpj(ji,jj,1) = zhpj(ji,jj,1) * zcpy(ji,jj)  
    513                zuap = zuap * zcpx(ji,jj) 
    514                zvap = zvap * zcpy(ji,jj) 
    515             ENDIF 
    516             ! 
    517             ! add to the general momentum trend 
    518             ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1) + zuap 
    519             va(ji,jj,1) = va(ji,jj,1) + zhpj(ji,jj,1) + zvap 
    520          END DO 
    521       END DO 
     452      DO_2D_00_00 
     453         ! hydrostatic pressure gradient along s-surfaces 
     454         zhpi(ji,jj,1) = zcoef0 * (  e3w(ji+1,jj  ,1,Kmm) * ( znad + rhd(ji+1,jj  ,1) )    & 
     455            &                      - e3w(ji  ,jj  ,1,Kmm) * ( znad + rhd(ji  ,jj  ,1) )  ) * r1_e1u(ji,jj) 
     456         zhpj(ji,jj,1) = zcoef0 * (  e3w(ji  ,jj+1,1,Kmm) * ( znad + rhd(ji  ,jj+1,1) )    & 
     457            &                      - e3w(ji  ,jj  ,1,Kmm) * ( znad + rhd(ji  ,jj  ,1) )  ) * r1_e2v(ji,jj) 
     458         ! s-coordinate pressure gradient correction 
     459         zuap = -zcoef0 * ( rhd    (ji+1,jj,1) + rhd    (ji,jj,1) + 2._wp * znad )   & 
     460            &           * ( gde3w(ji+1,jj,1) - gde3w(ji,jj,1) ) * r1_e1u(ji,jj) 
     461         zvap = -zcoef0 * ( rhd    (ji,jj+1,1) + rhd    (ji,jj,1) + 2._wp * znad )   & 
     462            &           * ( gde3w(ji,jj+1,1) - gde3w(ji,jj,1) ) * r1_e2v(ji,jj) 
     463         ! 
     464         IF( ln_wd_il ) THEN 
     465            zhpi(ji,jj,1) = zhpi(ji,jj,1) * zcpx(ji,jj) 
     466            zhpj(ji,jj,1) = zhpj(ji,jj,1) * zcpy(ji,jj)  
     467            zuap = zuap * zcpx(ji,jj) 
     468            zvap = zvap * zcpy(ji,jj) 
     469         ENDIF 
     470         ! 
     471         ! add to the general momentum trend 
     472         puu(ji,jj,1,Krhs) = puu(ji,jj,1,Krhs) + zhpi(ji,jj,1) + zuap 
     473         pvv(ji,jj,1,Krhs) = pvv(ji,jj,1,Krhs) + zhpj(ji,jj,1) + zvap 
     474      END_2D 
    522475 
    523476      ! interior value (2=<jk=<jpkm1) 
    524       DO jk = 2, jpkm1 
    525          DO jj = 2, jpjm1 
    526             DO ji = fs_2, fs_jpim1   ! vector opt. 
    527                ! hydrostatic pressure gradient along s-surfaces 
    528                zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + zcoef0 * r1_e1u(ji,jj)   & 
    529                   &           * (  e3w_n(ji+1,jj,jk) * ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) + 2*znad )   & 
    530                   &              - e3w_n(ji  ,jj,jk) * ( rhd(ji  ,jj,jk) + rhd(ji  ,jj,jk-1) + 2*znad )  ) 
    531                zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) + zcoef0 * r1_e2v(ji,jj)   & 
    532                   &           * (  e3w_n(ji,jj+1,jk) * ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) + 2*znad )   & 
    533                   &              - e3w_n(ji,jj  ,jk) * ( rhd(ji,jj,  jk) + rhd(ji,jj  ,jk-1) + 2*znad )  ) 
    534                ! s-coordinate pressure gradient correction 
    535                zuap = -zcoef0 * ( rhd    (ji+1,jj  ,jk) + rhd    (ji,jj,jk) + 2._wp * znad )   & 
    536                   &           * ( gde3w_n(ji+1,jj  ,jk) - gde3w_n(ji,jj,jk) ) * r1_e1u(ji,jj) 
    537                zvap = -zcoef0 * ( rhd    (ji  ,jj+1,jk) + rhd    (ji,jj,jk) + 2._wp * znad )   & 
    538                   &           * ( gde3w_n(ji  ,jj+1,jk) - gde3w_n(ji,jj,jk) ) * r1_e2v(ji,jj) 
    539                ! 
    540                IF( ln_wd_il ) THEN 
    541                   zhpi(ji,jj,jk) = zhpi(ji,jj,jk) * zcpx(ji,jj) 
    542                   zhpj(ji,jj,jk) = zhpj(ji,jj,jk) * zcpy(ji,jj)  
    543                   zuap = zuap * zcpx(ji,jj) 
    544                   zvap = zvap * zcpy(ji,jj) 
    545                ENDIF 
    546                ! 
    547                ! add to the general momentum trend 
    548                ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk) + zuap 
    549                va(ji,jj,jk) = va(ji,jj,jk) + zhpj(ji,jj,jk) + zvap 
    550             END DO 
    551          END DO 
    552       END DO 
     477      DO_3D_00_00( 2, jpkm1 ) 
     478         ! hydrostatic pressure gradient along s-surfaces 
     479         zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + zcoef0 * r1_e1u(ji,jj)   & 
     480            &           * (  e3w(ji+1,jj,jk,Kmm) * ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) + 2*znad )   & 
     481            &              - e3w(ji  ,jj,jk,Kmm) * ( rhd(ji  ,jj,jk) + rhd(ji  ,jj,jk-1) + 2*znad )  ) 
     482         zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) + zcoef0 * r1_e2v(ji,jj)   & 
     483            &           * (  e3w(ji,jj+1,jk,Kmm) * ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) + 2*znad )   & 
     484            &              - e3w(ji,jj  ,jk,Kmm) * ( rhd(ji,jj,  jk) + rhd(ji,jj  ,jk-1) + 2*znad )  ) 
     485         ! s-coordinate pressure gradient correction 
     486         zuap = -zcoef0 * ( rhd    (ji+1,jj  ,jk) + rhd    (ji,jj,jk) + 2._wp * znad )   & 
     487            &           * ( gde3w(ji+1,jj  ,jk) - gde3w(ji,jj,jk) ) * r1_e1u(ji,jj) 
     488         zvap = -zcoef0 * ( rhd    (ji  ,jj+1,jk) + rhd    (ji,jj,jk) + 2._wp * znad )   & 
     489            &           * ( gde3w(ji  ,jj+1,jk) - gde3w(ji,jj,jk) ) * r1_e2v(ji,jj) 
     490         ! 
     491         IF( ln_wd_il ) THEN 
     492            zhpi(ji,jj,jk) = zhpi(ji,jj,jk) * zcpx(ji,jj) 
     493            zhpj(ji,jj,jk) = zhpj(ji,jj,jk) * zcpy(ji,jj)  
     494            zuap = zuap * zcpx(ji,jj) 
     495            zvap = zvap * zcpy(ji,jj) 
     496         ENDIF 
     497         ! 
     498         ! add to the general momentum trend 
     499         puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + zhpi(ji,jj,jk) + zuap 
     500         pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + zhpj(ji,jj,jk) + zvap 
     501      END_3D 
    553502      ! 
    554503      IF( ln_wd_il )  DEALLOCATE( zcpx , zcpy ) 
     
    557506 
    558507 
    559    SUBROUTINE hpg_isf( kt ) 
     508   SUBROUTINE hpg_isf( kt, Kmm, puu, pvv, Krhs ) 
    560509      !!--------------------------------------------------------------------- 
    561510      !!                  ***  ROUTINE hpg_isf  *** 
     
    569518      !!         zhpi = grav .....  + 1/e1u mi(rhd) di[ grav dep3w ] 
    570519      !!         zhpj = grav .....  + 1/e2v mj(rhd) dj[ grav dep3w ] 
    571       !!      add it to the general momentum trend (ua,va). 
    572       !!         ua = ua - 1/e1u * zhpi 
    573       !!         va = va - 1/e2v * zhpj 
    574       !!      iceload is added and partial cell case are added to the top and bottom 
     520      !!      add it to the general momentum trend (puu(:,:,:,Krhs),pvv(:,:,:,Krhs)). 
     521      !!         puu(:,:,:,Krhs) = puu(:,:,:,Krhs) - 1/e1u * zhpi 
     522      !!         pvv(:,:,:,Krhs) = pvv(:,:,:,Krhs) - 1/e2v * zhpj 
     523      !!      iceload is added 
    575524      !!       
    576       !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend 
    577       !!---------------------------------------------------------------------- 
    578       INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
     525      !! ** Action : - Update (puu(:,:,:,Krhs),pvv(:,:,:,Krhs)) with the now hydrastatic pressure trend 
     526      !!---------------------------------------------------------------------- 
     527      INTEGER                             , INTENT( in )  ::  kt          ! ocean time-step index 
     528      INTEGER                             , INTENT( in )  ::  Kmm, Krhs   ! ocean time level indices 
     529      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation 
    579530      !! 
    580531      INTEGER  ::   ji, jj, jk, ikt, iktp1i, iktp1j   ! dummy loop indices 
     
    597548        DO jj = 1, jpj 
    598549          ikt = mikt(ji,jj) 
    599           zts_top(ji,jj,1) = tsn(ji,jj,ikt,1) 
    600           zts_top(ji,jj,2) = tsn(ji,jj,ikt,2) 
     550          zts_top(ji,jj,1) = ts(ji,jj,ikt,1,Kmm) 
     551          zts_top(ji,jj,2) = ts(ji,jj,ikt,2,Kmm) 
    601552        END DO 
    602553      END DO 
     
    606557!===== Compute surface value =====================================================  
    607558!================================================================================== 
    608       DO jj = 2, jpjm1 
    609          DO ji = fs_2, fs_jpim1   ! vector opt. 
    610             ikt    = mikt(ji,jj) 
    611             iktp1i = mikt(ji+1,jj) 
    612             iktp1j = mikt(ji,jj+1) 
    613             ! hydrostatic pressure gradient along s-surfaces and ice shelf pressure 
    614             ! we assume ISF is in isostatic equilibrium 
    615             zhpi(ji,jj,1) = zcoef0 / e1u(ji,jj) * ( 0.5_wp * e3w_n(ji+1,jj,iktp1i)                                    & 
    616                &                                    * ( 2._wp * znad + rhd(ji+1,jj,iktp1i) + zrhdtop_oce(ji+1,jj) )   & 
    617                &                                  - 0.5_wp * e3w_n(ji,jj,ikt)                                         & 
    618                &                                    * ( 2._wp * znad + rhd(ji,jj,ikt) + zrhdtop_oce(ji,jj) )          & 
    619                &                                  + ( riceload(ji+1,jj) - riceload(ji,jj))                            )  
    620             zhpj(ji,jj,1) = zcoef0 / e2v(ji,jj) * ( 0.5_wp * e3w_n(ji,jj+1,iktp1j)                                    & 
    621                &                                    * ( 2._wp * znad + rhd(ji,jj+1,iktp1j) + zrhdtop_oce(ji,jj+1) )   & 
    622                &                                  - 0.5_wp * e3w_n(ji,jj,ikt)                                         &  
    623                &                                    * ( 2._wp * znad + rhd(ji,jj,ikt) + zrhdtop_oce(ji,jj) )          & 
    624                &                                  + ( riceload(ji,jj+1) - riceload(ji,jj))                            )  
    625             ! s-coordinate pressure gradient correction (=0 if z coordinate) 
    626             zuap = -zcoef0 * ( rhd    (ji+1,jj,1) + rhd    (ji,jj,1) + 2._wp * znad )   & 
    627                &           * ( gde3w_n(ji+1,jj,1) - gde3w_n(ji,jj,1) ) * r1_e1u(ji,jj) 
    628             zvap = -zcoef0 * ( rhd    (ji,jj+1,1) + rhd    (ji,jj,1) + 2._wp * znad )   & 
    629                &           * ( gde3w_n(ji,jj+1,1) - gde3w_n(ji,jj,1) ) * r1_e2v(ji,jj) 
    630             ! add to the general momentum trend 
    631             ua(ji,jj,1) = ua(ji,jj,1) + (zhpi(ji,jj,1) + zuap) * umask(ji,jj,1) 
    632             va(ji,jj,1) = va(ji,jj,1) + (zhpj(ji,jj,1) + zvap) * vmask(ji,jj,1) 
    633          END DO 
    634       END DO 
     559      DO_2D_00_00 
     560         ikt    = mikt(ji,jj) 
     561         iktp1i = mikt(ji+1,jj) 
     562         iktp1j = mikt(ji,jj+1) 
     563         ! hydrostatic pressure gradient along s-surfaces and ice shelf pressure 
     564         ! we assume ISF is in isostatic equilibrium 
     565         zhpi(ji,jj,1) = zcoef0 / e1u(ji,jj) * ( 0.5_wp * e3w(ji+1,jj,iktp1i,Kmm)                                    & 
     566            &                                    * ( 2._wp * znad + rhd(ji+1,jj,iktp1i) + zrhdtop_oce(ji+1,jj) )   & 
     567            &                                  - 0.5_wp * e3w(ji,jj,ikt,Kmm)                                         & 
     568            &                                    * ( 2._wp * znad + rhd(ji,jj,ikt) + zrhdtop_oce(ji,jj) )          & 
     569            &                                  + ( risfload(ji+1,jj) - risfload(ji,jj))                            )  
     570         zhpj(ji,jj,1) = zcoef0 / e2v(ji,jj) * ( 0.5_wp * e3w(ji,jj+1,iktp1j,Kmm)                                    & 
     571            &                                    * ( 2._wp * znad + rhd(ji,jj+1,iktp1j) + zrhdtop_oce(ji,jj+1) )   & 
     572            &                                  - 0.5_wp * e3w(ji,jj,ikt,Kmm)                                         &  
     573            &                                    * ( 2._wp * znad + rhd(ji,jj,ikt) + zrhdtop_oce(ji,jj) )          & 
     574            &                                  + ( risfload(ji,jj+1) - risfload(ji,jj))                            )  
     575         ! s-coordinate pressure gradient correction (=0 if z coordinate) 
     576         zuap = -zcoef0 * ( rhd    (ji+1,jj,1) + rhd    (ji,jj,1) + 2._wp * znad )   & 
     577            &           * ( gde3w(ji+1,jj,1) - gde3w(ji,jj,1) ) * r1_e1u(ji,jj) 
     578         zvap = -zcoef0 * ( rhd    (ji,jj+1,1) + rhd    (ji,jj,1) + 2._wp * znad )   & 
     579            &           * ( gde3w(ji,jj+1,1) - gde3w(ji,jj,1) ) * r1_e2v(ji,jj) 
     580         ! add to the general momentum trend 
     581         puu(ji,jj,1,Krhs) = puu(ji,jj,1,Krhs) + (zhpi(ji,jj,1) + zuap) * umask(ji,jj,1) 
     582         pvv(ji,jj,1,Krhs) = pvv(ji,jj,1,Krhs) + (zhpj(ji,jj,1) + zvap) * vmask(ji,jj,1) 
     583      END_2D 
    635584!==================================================================================      
    636585!===== Compute interior value =====================================================  
    637586!================================================================================== 
    638587      ! interior value (2=<jk=<jpkm1) 
    639       DO jk = 2, jpkm1 
    640          DO jj = 2, jpjm1 
    641             DO ji = fs_2, fs_jpim1   ! vector opt. 
    642                ! hydrostatic pressure gradient along s-surfaces 
    643                zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + zcoef0 / e1u(ji,jj)   & 
    644                   &           * (  e3w_n(ji+1,jj,jk) * ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) + 2*znad ) * wmask(ji+1,jj,jk)   & 
    645                   &              - e3w_n(ji  ,jj,jk) * ( rhd(ji  ,jj,jk) + rhd(ji  ,jj,jk-1) + 2*znad ) * wmask(ji  ,jj,jk)   ) 
    646                zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) + zcoef0 / e2v(ji,jj)   & 
    647                   &           * (  e3w_n(ji,jj+1,jk) * ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) + 2*znad ) * wmask(ji,jj+1,jk)   & 
    648                   &              - e3w_n(ji,jj  ,jk) * ( rhd(ji,jj,  jk) + rhd(ji,jj  ,jk-1) + 2*znad ) * wmask(ji,jj  ,jk)   ) 
    649                ! s-coordinate pressure gradient correction 
    650                zuap = -zcoef0 * ( rhd   (ji+1,jj  ,jk) + rhd   (ji,jj,jk) + 2._wp * znad )   & 
    651                   &           * ( gde3w_n(ji+1,jj  ,jk) - gde3w_n(ji,jj,jk) ) / e1u(ji,jj) 
    652                zvap = -zcoef0 * ( rhd   (ji  ,jj+1,jk) + rhd   (ji,jj,jk) + 2._wp * znad )   & 
    653                   &           * ( gde3w_n(ji  ,jj+1,jk) - gde3w_n(ji,jj,jk) ) / e2v(ji,jj) 
    654                ! add to the general momentum trend 
    655                ua(ji,jj,jk) = ua(ji,jj,jk) + (zhpi(ji,jj,jk) + zuap) * umask(ji,jj,jk) 
    656                va(ji,jj,jk) = va(ji,jj,jk) + (zhpj(ji,jj,jk) + zvap) * vmask(ji,jj,jk) 
    657             END DO 
    658          END DO 
    659       END DO 
     588      DO_3D_00_00( 2, jpkm1 ) 
     589         ! hydrostatic pressure gradient along s-surfaces 
     590         zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) + zcoef0 / e1u(ji,jj)   & 
     591            &           * (  e3w(ji+1,jj,jk,Kmm) * ( rhd(ji+1,jj,jk) + rhd(ji+1,jj,jk-1) + 2*znad ) * wmask(ji+1,jj,jk)   & 
     592            &              - e3w(ji  ,jj,jk,Kmm) * ( rhd(ji  ,jj,jk) + rhd(ji  ,jj,jk-1) + 2*znad ) * wmask(ji  ,jj,jk)   ) 
     593         zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1) + zcoef0 / e2v(ji,jj)   & 
     594            &           * (  e3w(ji,jj+1,jk,Kmm) * ( rhd(ji,jj+1,jk) + rhd(ji,jj+1,jk-1) + 2*znad ) * wmask(ji,jj+1,jk)   & 
     595            &              - e3w(ji,jj  ,jk,Kmm) * ( rhd(ji,jj,  jk) + rhd(ji,jj  ,jk-1) + 2*znad ) * wmask(ji,jj  ,jk)   ) 
     596         ! s-coordinate pressure gradient correction 
     597         zuap = -zcoef0 * ( rhd   (ji+1,jj  ,jk) + rhd   (ji,jj,jk) + 2._wp * znad )   & 
     598            &           * ( gde3w(ji+1,jj  ,jk) - gde3w(ji,jj,jk) ) / e1u(ji,jj) 
     599         zvap = -zcoef0 * ( rhd   (ji  ,jj+1,jk) + rhd   (ji,jj,jk) + 2._wp * znad )   & 
     600            &           * ( gde3w(ji  ,jj+1,jk) - gde3w(ji,jj,jk) ) / e2v(ji,jj) 
     601         ! add to the general momentum trend 
     602         puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + (zhpi(ji,jj,jk) + zuap) * umask(ji,jj,jk) 
     603         pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + (zhpj(ji,jj,jk) + zvap) * vmask(ji,jj,jk) 
     604      END_3D 
    660605      ! 
    661606   END SUBROUTINE hpg_isf 
    662607 
    663608 
    664    SUBROUTINE hpg_djc( kt ) 
     609   SUBROUTINE hpg_djc( kt, Kmm, puu, pvv, Krhs ) 
    665610      !!--------------------------------------------------------------------- 
    666611      !!                  ***  ROUTINE hpg_djc  *** 
     
    670615      !! Reference: Shchepetkin and McWilliams, J. Geophys. Res., 108(C3), 3090, 2003 
    671616      !!---------------------------------------------------------------------- 
    672       INTEGER, INTENT(in) ::   kt    ! ocean time-step index 
     617      INTEGER                             , INTENT( in )  ::  kt          ! ocean time-step index 
     618      INTEGER                             , INTENT( in )  ::  Kmm, Krhs   ! ocean time level indices 
     619      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation 
    673620      !! 
    674621      INTEGER  ::   ji, jj, jk          ! dummy loop indices 
     
    686633      IF( ln_wd_il ) THEN 
    687634         ALLOCATE( zcpx(jpi,jpj) , zcpy(jpi,jpj) ) 
    688         DO jj = 2, jpjm1 
    689            DO ji = 2, jpim1  
    690              ll_tmp1 = MIN(  sshn(ji,jj)              ,  sshn(ji+1,jj) ) >                & 
    691                   &    MAX( -ht_0(ji,jj)              , -ht_0(ji+1,jj) ) .AND.            & 
    692                   &    MAX(  sshn(ji,jj) + ht_0(ji,jj),  sshn(ji+1,jj) + ht_0(ji+1,jj) )  & 
    693                   &                                                      > rn_wdmin1 + rn_wdmin2 
    694              ll_tmp2 = ( ABS( sshn(ji,jj)             -  sshn(ji+1,jj) ) > 1.E-12 ) .AND. (        & 
    695                   &    MAX(   sshn(ji,jj)             ,  sshn(ji+1,jj) ) >                & 
    696                   &    MAX(  -ht_0(ji,jj)             , -ht_0(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 ) 
    697              IF(ll_tmp1) THEN 
    698                zcpx(ji,jj) = 1.0_wp 
    699              ELSE IF(ll_tmp2) THEN 
    700                ! no worries about  sshn(ji+1,jj) -  sshn(ji  ,jj) = 0, it won't happen ! here 
    701                zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + ht_0(ji+1,jj) - sshn(ji,jj) - ht_0(ji,jj)) & 
    702                            &    / (sshn(ji+1,jj) - sshn(ji  ,jj)) ) 
    703              ELSE 
    704                zcpx(ji,jj) = 0._wp 
    705              END IF 
    706        
    707              ll_tmp1 = MIN(  sshn(ji,jj)              ,  sshn(ji,jj+1) ) >                & 
    708                   &    MAX( -ht_0(ji,jj)              , -ht_0(ji,jj+1) ) .AND.            & 
    709                   &    MAX(  sshn(ji,jj) + ht_0(ji,jj),  sshn(ji,jj+1) + ht_0(ji,jj+1) )  & 
    710                   &                                                      > rn_wdmin1 + rn_wdmin2 
    711              ll_tmp2 = ( ABS( sshn(ji,jj)             -  sshn(ji,jj+1) ) > 1.E-12 ) .AND. (        & 
    712                   &    MAX(   sshn(ji,jj)             ,  sshn(ji,jj+1) ) >                & 
    713                   &    MAX(  -ht_0(ji,jj)             , -ht_0(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 ) 
    714  
    715              IF(ll_tmp1) THEN 
    716                zcpy(ji,jj) = 1.0_wp 
    717              ELSE IF(ll_tmp2) THEN 
    718                ! no worries about  sshn(ji,jj+1) -  sshn(ji,jj  ) = 0, it won't happen ! here 
    719                zcpy(ji,jj) = ABS( (sshn(ji,jj+1) + ht_0(ji,jj+1) - sshn(ji,jj) - ht_0(ji,jj)) & 
    720                            &    / (sshn(ji,jj+1) - sshn(ji,jj  )) ) 
    721              ELSE 
    722                zcpy(ji,jj) = 0._wp 
    723              END IF 
    724            END DO 
    725         END DO 
     635        DO_2D_00_00 
     636          ll_tmp1 = MIN(  ssh(ji,jj,Kmm)              ,  ssh(ji+1,jj,Kmm) ) >                & 
     637               &    MAX( -ht_0(ji,jj)              , -ht_0(ji+1,jj) ) .AND.            & 
     638               &    MAX(  ssh(ji,jj,Kmm) + ht_0(ji,jj),  ssh(ji+1,jj,Kmm) + ht_0(ji+1,jj) )  & 
     639               &                                                      > rn_wdmin1 + rn_wdmin2 
     640          ll_tmp2 = ( ABS( ssh(ji,jj,Kmm)             -  ssh(ji+1,jj,Kmm) ) > 1.E-12 ) .AND. (        & 
     641               &    MAX(   ssh(ji,jj,Kmm)             ,  ssh(ji+1,jj,Kmm) ) >                & 
     642               &    MAX(  -ht_0(ji,jj)             , -ht_0(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 ) 
     643          IF(ll_tmp1) THEN 
     644            zcpx(ji,jj) = 1.0_wp 
     645          ELSE IF(ll_tmp2) THEN 
     646            ! no worries about  ssh(ji+1,jj,Kmm) -  ssh(ji  ,jj,Kmm) = 0, it won't happen ! here 
     647            zcpx(ji,jj) = ABS( (ssh(ji+1,jj,Kmm) + ht_0(ji+1,jj) - ssh(ji,jj,Kmm) - ht_0(ji,jj)) & 
     648                        &    / (ssh(ji+1,jj,Kmm) - ssh(ji  ,jj,Kmm)) ) 
     649          ELSE 
     650            zcpx(ji,jj) = 0._wp 
     651          END IF 
     652    
     653          ll_tmp1 = MIN(  ssh(ji,jj,Kmm)              ,  ssh(ji,jj+1,Kmm) ) >                & 
     654               &    MAX( -ht_0(ji,jj)              , -ht_0(ji,jj+1) ) .AND.            & 
     655               &    MAX(  ssh(ji,jj,Kmm) + ht_0(ji,jj),  ssh(ji,jj+1,Kmm) + ht_0(ji,jj+1) )  & 
     656               &                                                      > rn_wdmin1 + rn_wdmin2 
     657          ll_tmp2 = ( ABS( ssh(ji,jj,Kmm)             -  ssh(ji,jj+1,Kmm) ) > 1.E-12 ) .AND. (        & 
     658               &    MAX(   ssh(ji,jj,Kmm)             ,  ssh(ji,jj+1,Kmm) ) >                & 
     659               &    MAX(  -ht_0(ji,jj)             , -ht_0(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 ) 
     660 
     661          IF(ll_tmp1) THEN 
     662            zcpy(ji,jj) = 1.0_wp 
     663          ELSE IF(ll_tmp2) THEN 
     664            ! no worries about  ssh(ji,jj+1,Kmm) -  ssh(ji,jj  ,Kmm) = 0, it won't happen ! here 
     665            zcpy(ji,jj) = ABS( (ssh(ji,jj+1,Kmm) + ht_0(ji,jj+1) - ssh(ji,jj,Kmm) - ht_0(ji,jj)) & 
     666                        &    / (ssh(ji,jj+1,Kmm) - ssh(ji,jj  ,Kmm)) ) 
     667          ELSE 
     668            zcpy(ji,jj) = 0._wp 
     669          END IF 
     670        END_2D 
    726671        CALL lbc_lnk_multi( 'dynhpg', zcpx, 'U', 1., zcpy, 'V', 1. ) 
    727672      END IF 
     
    744689!!bug gm   Not a true bug, but... dzz=e3w  for dzx, dzy verify what it is really 
    745690 
    746       DO jk = 2, jpkm1 
    747          DO jj = 2, jpjm1 
    748             DO ji = fs_2, fs_jpim1   ! vector opt. 
    749                drhoz(ji,jj,jk) = rhd    (ji  ,jj  ,jk) - rhd    (ji,jj,jk-1) 
    750                dzz  (ji,jj,jk) = gde3w_n(ji  ,jj  ,jk) - gde3w_n(ji,jj,jk-1) 
    751                drhox(ji,jj,jk) = rhd    (ji+1,jj  ,jk) - rhd    (ji,jj,jk  ) 
    752                dzx  (ji,jj,jk) = gde3w_n(ji+1,jj  ,jk) - gde3w_n(ji,jj,jk  ) 
    753                drhoy(ji,jj,jk) = rhd    (ji  ,jj+1,jk) - rhd    (ji,jj,jk  ) 
    754                dzy  (ji,jj,jk) = gde3w_n(ji  ,jj+1,jk) - gde3w_n(ji,jj,jk  ) 
    755             END DO 
    756          END DO 
    757       END DO 
     691      DO_3D_00_00( 2, jpkm1 ) 
     692         drhoz(ji,jj,jk) = rhd    (ji  ,jj  ,jk) - rhd    (ji,jj,jk-1) 
     693         dzz  (ji,jj,jk) = gde3w(ji  ,jj  ,jk) - gde3w(ji,jj,jk-1) 
     694         drhox(ji,jj,jk) = rhd    (ji+1,jj  ,jk) - rhd    (ji,jj,jk  ) 
     695         dzx  (ji,jj,jk) = gde3w(ji+1,jj  ,jk) - gde3w(ji,jj,jk  ) 
     696         drhoy(ji,jj,jk) = rhd    (ji  ,jj+1,jk) - rhd    (ji,jj,jk  ) 
     697         dzy  (ji,jj,jk) = gde3w(ji  ,jj+1,jk) - gde3w(ji,jj,jk  ) 
     698      END_3D 
    758699 
    759700      !------------------------------------------------------------------------- 
     
    765706!!bug  gm  idem for drhox, drhoy et ji=jpi and jj=jpj 
    766707 
    767       DO jk = 2, jpkm1 
    768          DO jj = 2, jpjm1 
    769             DO ji = fs_2, fs_jpim1   ! vector opt. 
    770                cffw = 2._wp * drhoz(ji  ,jj  ,jk) * drhoz(ji,jj,jk-1) 
    771  
    772                cffu = 2._wp * drhox(ji+1,jj  ,jk) * drhox(ji,jj,jk  ) 
    773                cffx = 2._wp * dzx  (ji+1,jj  ,jk) * dzx  (ji,jj,jk  ) 
    774  
    775                cffv = 2._wp * drhoy(ji  ,jj+1,jk) * drhoy(ji,jj,jk  ) 
    776                cffy = 2._wp * dzy  (ji  ,jj+1,jk) * dzy  (ji,jj,jk  ) 
    777  
    778                IF( cffw > zep) THEN 
    779                   drhow(ji,jj,jk) = 2._wp *   drhoz(ji,jj,jk) * drhoz(ji,jj,jk-1)   & 
    780                      &                    / ( drhoz(ji,jj,jk) + drhoz(ji,jj,jk-1) ) 
    781                ELSE 
    782                   drhow(ji,jj,jk) = 0._wp 
    783                ENDIF 
    784  
    785                dzw(ji,jj,jk) = 2._wp *   dzz(ji,jj,jk) * dzz(ji,jj,jk-1)   & 
    786                   &                  / ( dzz(ji,jj,jk) + dzz(ji,jj,jk-1) ) 
    787  
    788                IF( cffu > zep ) THEN 
    789                   drhou(ji,jj,jk) = 2._wp *   drhox(ji+1,jj,jk) * drhox(ji,jj,jk)   & 
    790                      &                    / ( drhox(ji+1,jj,jk) + drhox(ji,jj,jk) ) 
    791                ELSE 
    792                   drhou(ji,jj,jk ) = 0._wp 
    793                ENDIF 
    794  
    795                IF( cffx > zep ) THEN 
    796                   dzu(ji,jj,jk) = 2._wp *   dzx(ji+1,jj,jk) * dzx(ji,jj,jk)   & 
    797                      &                  / ( dzx(ji+1,jj,jk) + dzx(ji,jj,jk) ) 
    798                ELSE 
    799                   dzu(ji,jj,jk) = 0._wp 
    800                ENDIF 
    801  
    802                IF( cffv > zep ) THEN 
    803                   drhov(ji,jj,jk) = 2._wp *   drhoy(ji,jj+1,jk) * drhoy(ji,jj,jk)   & 
    804                      &                    / ( drhoy(ji,jj+1,jk) + drhoy(ji,jj,jk) ) 
    805                ELSE 
    806                   drhov(ji,jj,jk) = 0._wp 
    807                ENDIF 
    808  
    809                IF( cffy > zep ) THEN 
    810                   dzv(ji,jj,jk) = 2._wp *   dzy(ji,jj+1,jk) * dzy(ji,jj,jk)   & 
    811                      &                  / ( dzy(ji,jj+1,jk) + dzy(ji,jj,jk) ) 
    812                ELSE 
    813                   dzv(ji,jj,jk) = 0._wp 
    814                ENDIF 
    815  
    816             END DO 
    817          END DO 
    818       END DO 
     708      DO_3D_00_00( 2, jpkm1 ) 
     709         cffw = 2._wp * drhoz(ji  ,jj  ,jk) * drhoz(ji,jj,jk-1) 
     710 
     711         cffu = 2._wp * drhox(ji+1,jj  ,jk) * drhox(ji,jj,jk  ) 
     712         cffx = 2._wp * dzx  (ji+1,jj  ,jk) * dzx  (ji,jj,jk  ) 
     713 
     714         cffv = 2._wp * drhoy(ji  ,jj+1,jk) * drhoy(ji,jj,jk  ) 
     715         cffy = 2._wp * dzy  (ji  ,jj+1,jk) * dzy  (ji,jj,jk  ) 
     716 
     717         IF( cffw > zep) THEN 
     718            drhow(ji,jj,jk) = 2._wp *   drhoz(ji,jj,jk) * drhoz(ji,jj,jk-1)   & 
     719               &                    / ( drhoz(ji,jj,jk) + drhoz(ji,jj,jk-1) ) 
     720         ELSE 
     721            drhow(ji,jj,jk) = 0._wp 
     722         ENDIF 
     723 
     724         dzw(ji,jj,jk) = 2._wp *   dzz(ji,jj,jk) * dzz(ji,jj,jk-1)   & 
     725            &                  / ( dzz(ji,jj,jk) + dzz(ji,jj,jk-1) ) 
     726 
     727         IF( cffu > zep ) THEN 
     728            drhou(ji,jj,jk) = 2._wp *   drhox(ji+1,jj,jk) * drhox(ji,jj,jk)   & 
     729               &                    / ( drhox(ji+1,jj,jk) + drhox(ji,jj,jk) ) 
     730         ELSE 
     731            drhou(ji,jj,jk ) = 0._wp 
     732         ENDIF 
     733 
     734         IF( cffx > zep ) THEN 
     735            dzu(ji,jj,jk) = 2._wp *   dzx(ji+1,jj,jk) * dzx(ji,jj,jk)   & 
     736               &                  / ( dzx(ji+1,jj,jk) + dzx(ji,jj,jk) ) 
     737         ELSE 
     738            dzu(ji,jj,jk) = 0._wp 
     739         ENDIF 
     740 
     741         IF( cffv > zep ) THEN 
     742            drhov(ji,jj,jk) = 2._wp *   drhoy(ji,jj+1,jk) * drhoy(ji,jj,jk)   & 
     743               &                    / ( drhoy(ji,jj+1,jk) + drhoy(ji,jj,jk) ) 
     744         ELSE 
     745            drhov(ji,jj,jk) = 0._wp 
     746         ENDIF 
     747 
     748         IF( cffy > zep ) THEN 
     749            dzv(ji,jj,jk) = 2._wp *   dzy(ji,jj+1,jk) * dzy(ji,jj,jk)   & 
     750               &                  / ( dzy(ji,jj+1,jk) + dzy(ji,jj,jk) ) 
     751         ELSE 
     752            dzv(ji,jj,jk) = 0._wp 
     753         ENDIF 
     754 
     755      END_3D 
    819756 
    820757      !---------------------------------------------------------------------------------- 
     
    837774!          true if gde3w is really defined as the sum of the e3w scale factors as, it seems to me, it should be 
    838775 
    839       DO jj = 2, jpjm1 
    840          DO ji = fs_2, fs_jpim1   ! vector opt. 
    841             rho_k(ji,jj,1) = -grav * ( e3w_n(ji,jj,1) - gde3w_n(ji,jj,1) )               & 
    842                &                   * (  rhd(ji,jj,1)                                     & 
    843                &                     + 0.5_wp * ( rhd    (ji,jj,2) - rhd    (ji,jj,1) )  & 
    844                &                              * ( e3w_n  (ji,jj,1) - gde3w_n(ji,jj,1) )  & 
    845                &                              / ( gde3w_n(ji,jj,2) - gde3w_n(ji,jj,1) )  ) 
    846          END DO 
    847       END DO 
     776      DO_2D_00_00 
     777         rho_k(ji,jj,1) = -grav * ( e3w(ji,jj,1,Kmm) - gde3w(ji,jj,1) )               & 
     778            &                   * (  rhd(ji,jj,1)                                     & 
     779            &                     + 0.5_wp * ( rhd    (ji,jj,2) - rhd    (ji,jj,1) )  & 
     780            &                              * ( e3w  (ji,jj,1,Kmm) - gde3w(ji,jj,1) )  & 
     781            &                              / ( gde3w(ji,jj,2) - gde3w(ji,jj,1) )  ) 
     782      END_2D 
    848783 
    849784!!bug gm    : here also, simplification is possible 
    850785!!bug gm    : optimisation: 1/10 and 1/12 the division should be done before the loop 
    851786 
    852       DO jk = 2, jpkm1 
    853          DO jj = 2, jpjm1 
    854             DO ji = fs_2, fs_jpim1   ! vector opt. 
    855  
    856                rho_k(ji,jj,jk) = zcoef0 * ( rhd    (ji,jj,jk) + rhd    (ji,jj,jk-1) )                                   & 
    857                   &                     * ( gde3w_n(ji,jj,jk) - gde3w_n(ji,jj,jk-1) )                                   & 
    858                   &            - grav * z1_10 * (                                                                   & 
    859                   &     ( drhow  (ji,jj,jk) - drhow  (ji,jj,jk-1) )                                                     & 
    860                   &   * ( gde3w_n(ji,jj,jk) - gde3w_n(ji,jj,jk-1) - z1_12 * ( dzw  (ji,jj,jk) + dzw  (ji,jj,jk-1) ) )   & 
    861                   &   - ( dzw    (ji,jj,jk) - dzw    (ji,jj,jk-1) )                                                     & 
    862                   &   * ( rhd    (ji,jj,jk) - rhd    (ji,jj,jk-1) - z1_12 * ( drhow(ji,jj,jk) + drhow(ji,jj,jk-1) ) )   & 
    863                   &                             ) 
    864  
    865                rho_i(ji,jj,jk) = zcoef0 * ( rhd    (ji+1,jj,jk) + rhd    (ji,jj,jk) )                                   & 
    866                   &                     * ( gde3w_n(ji+1,jj,jk) - gde3w_n(ji,jj,jk) )                                   & 
    867                   &            - grav* z1_10 * (                                                                    & 
    868                   &     ( drhou  (ji+1,jj,jk) - drhou  (ji,jj,jk) )                                                     & 
    869                   &   * ( gde3w_n(ji+1,jj,jk) - gde3w_n(ji,jj,jk) - z1_12 * ( dzu  (ji+1,jj,jk) + dzu  (ji,jj,jk) ) )   & 
    870                   &   - ( dzu    (ji+1,jj,jk) - dzu    (ji,jj,jk) )                                                     & 
    871                   &   * ( rhd    (ji+1,jj,jk) - rhd    (ji,jj,jk) - z1_12 * ( drhou(ji+1,jj,jk) + drhou(ji,jj,jk) ) )   & 
    872                   &                            ) 
    873  
    874                rho_j(ji,jj,jk) = zcoef0 * ( rhd    (ji,jj+1,jk) + rhd    (ji,jj,jk) )                                 & 
    875                   &                     * ( gde3w_n(ji,jj+1,jk) - gde3w_n(ji,jj,jk) )                                   & 
    876                   &            - grav* z1_10 * (                                                                    & 
    877                   &     ( drhov  (ji,jj+1,jk) - drhov  (ji,jj,jk) )                                                     & 
    878                   &   * ( gde3w_n(ji,jj+1,jk) - gde3w_n(ji,jj,jk) - z1_12 * ( dzv  (ji,jj+1,jk) + dzv  (ji,jj,jk) ) )   & 
    879                   &   - ( dzv    (ji,jj+1,jk) - dzv    (ji,jj,jk) )                                                     & 
    880                   &   * ( rhd    (ji,jj+1,jk) - rhd    (ji,jj,jk) - z1_12 * ( drhov(ji,jj+1,jk) + drhov(ji,jj,jk) ) )   & 
    881                   &                            ) 
    882  
    883             END DO 
    884          END DO 
    885       END DO 
     787      DO_3D_00_00( 2, jpkm1 ) 
     788 
     789         rho_k(ji,jj,jk) = zcoef0 * ( rhd    (ji,jj,jk) + rhd    (ji,jj,jk-1) )                                   & 
     790            &                     * ( gde3w(ji,jj,jk) - gde3w(ji,jj,jk-1) )                                   & 
     791            &            - grav * z1_10 * (                                                                   & 
     792            &     ( drhow  (ji,jj,jk) - drhow  (ji,jj,jk-1) )                                                     & 
     793            &   * ( gde3w(ji,jj,jk) - gde3w(ji,jj,jk-1) - z1_12 * ( dzw  (ji,jj,jk) + dzw  (ji,jj,jk-1) ) )   & 
     794            &   - ( dzw    (ji,jj,jk) - dzw    (ji,jj,jk-1) )                                                     & 
     795            &   * ( rhd    (ji,jj,jk) - rhd    (ji,jj,jk-1) - z1_12 * ( drhow(ji,jj,jk) + drhow(ji,jj,jk-1) ) )   & 
     796            &                             ) 
     797 
     798         rho_i(ji,jj,jk) = zcoef0 * ( rhd    (ji+1,jj,jk) + rhd    (ji,jj,jk) )                                   & 
     799            &                     * ( gde3w(ji+1,jj,jk) - gde3w(ji,jj,jk) )                                   & 
     800            &            - grav* z1_10 * (                                                                    & 
     801            &     ( drhou  (ji+1,jj,jk) - drhou  (ji,jj,jk) )                                                     & 
     802            &   * ( gde3w(ji+1,jj,jk) - gde3w(ji,jj,jk) - z1_12 * ( dzu  (ji+1,jj,jk) + dzu  (ji,jj,jk) ) )   & 
     803            &   - ( dzu    (ji+1,jj,jk) - dzu    (ji,jj,jk) )                                                     & 
     804            &   * ( rhd    (ji+1,jj,jk) - rhd    (ji,jj,jk) - z1_12 * ( drhou(ji+1,jj,jk) + drhou(ji,jj,jk) ) )   & 
     805            &                            ) 
     806 
     807         rho_j(ji,jj,jk) = zcoef0 * ( rhd    (ji,jj+1,jk) + rhd    (ji,jj,jk) )                                 & 
     808            &                     * ( gde3w(ji,jj+1,jk) - gde3w(ji,jj,jk) )                                   & 
     809            &            - grav* z1_10 * (                                                                    & 
     810            &     ( drhov  (ji,jj+1,jk) - drhov  (ji,jj,jk) )                                                     & 
     811            &   * ( gde3w(ji,jj+1,jk) - gde3w(ji,jj,jk) - z1_12 * ( dzv  (ji,jj+1,jk) + dzv  (ji,jj,jk) ) )   & 
     812            &   - ( dzv    (ji,jj+1,jk) - dzv    (ji,jj,jk) )                                                     & 
     813            &   * ( rhd    (ji,jj+1,jk) - rhd    (ji,jj,jk) - z1_12 * ( drhov(ji,jj+1,jk) + drhov(ji,jj,jk) ) )   & 
     814            &                            ) 
     815 
     816      END_3D 
    886817      CALL lbc_lnk_multi( 'dynhpg', rho_k, 'W', 1., rho_i, 'U', 1., rho_j, 'V', 1. ) 
    887818 
     
    889820      !  Surface value 
    890821      ! --------------- 
    891       DO jj = 2, jpjm1 
    892          DO ji = fs_2, fs_jpim1   ! vector opt. 
    893             zhpi(ji,jj,1) = ( rho_k(ji+1,jj  ,1) - rho_k(ji,jj,1) - rho_i(ji,jj,1) ) * r1_e1u(ji,jj) 
    894             zhpj(ji,jj,1) = ( rho_k(ji  ,jj+1,1) - rho_k(ji,jj,1) - rho_j(ji,jj,1) ) * r1_e2v(ji,jj) 
    895             IF( ln_wd_il ) THEN 
    896               zhpi(ji,jj,1) = zhpi(ji,jj,1) * zcpx(ji,jj) 
    897               zhpj(ji,jj,1) = zhpj(ji,jj,1) * zcpy(ji,jj)  
    898             ENDIF 
    899             ! add to the general momentum trend 
    900             ua(ji,jj,1) = ua(ji,jj,1) + zhpi(ji,jj,1) 
    901             va(ji,jj,1) = va(ji,jj,1) + zhpj(ji,jj,1) 
    902          END DO 
    903       END DO 
     822      DO_2D_00_00 
     823         zhpi(ji,jj,1) = ( rho_k(ji+1,jj  ,1) - rho_k(ji,jj,1) - rho_i(ji,jj,1) ) * r1_e1u(ji,jj) 
     824         zhpj(ji,jj,1) = ( rho_k(ji  ,jj+1,1) - rho_k(ji,jj,1) - rho_j(ji,jj,1) ) * r1_e2v(ji,jj) 
     825         IF( ln_wd_il ) THEN 
     826           zhpi(ji,jj,1) = zhpi(ji,jj,1) * zcpx(ji,jj) 
     827           zhpj(ji,jj,1) = zhpj(ji,jj,1) * zcpy(ji,jj)  
     828         ENDIF 
     829         ! add to the general momentum trend 
     830         puu(ji,jj,1,Krhs) = puu(ji,jj,1,Krhs) + zhpi(ji,jj,1) 
     831         pvv(ji,jj,1,Krhs) = pvv(ji,jj,1,Krhs) + zhpj(ji,jj,1) 
     832      END_2D 
    904833 
    905834      ! ---------------- 
    906835      !  interior value   (2=<jk=<jpkm1) 
    907836      ! ---------------- 
    908       DO jk = 2, jpkm1 
    909          DO jj = 2, jpjm1 
    910             DO ji = fs_2, fs_jpim1   ! vector opt. 
    911                ! hydrostatic pressure gradient along s-surfaces 
    912                zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1)                                & 
    913                   &           + (  ( rho_k(ji+1,jj,jk) - rho_k(ji,jj,jk  ) )    & 
    914                   &              - ( rho_i(ji  ,jj,jk) - rho_i(ji,jj,jk-1) )  ) * r1_e1u(ji,jj) 
    915                zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1)                                & 
    916                   &           + (  ( rho_k(ji,jj+1,jk) - rho_k(ji,jj,jk  ) )    & 
    917                   &               -( rho_j(ji,jj  ,jk) - rho_j(ji,jj,jk-1) )  ) * r1_e2v(ji,jj) 
    918                IF( ln_wd_il ) THEN 
    919                  zhpi(ji,jj,jk) = zhpi(ji,jj,jk) * zcpx(ji,jj) 
    920                  zhpj(ji,jj,jk) = zhpj(ji,jj,jk) * zcpy(ji,jj)  
    921                ENDIF 
    922                ! add to the general momentum trend 
    923                ua(ji,jj,jk) = ua(ji,jj,jk) + zhpi(ji,jj,jk) 
    924                va(ji,jj,jk) = va(ji,jj,jk) + zhpj(ji,jj,jk) 
    925             END DO 
    926          END DO 
    927       END DO 
     837      DO_3D_00_00( 2, jpkm1 ) 
     838         ! hydrostatic pressure gradient along s-surfaces 
     839         zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1)                                & 
     840            &           + (  ( rho_k(ji+1,jj,jk) - rho_k(ji,jj,jk  ) )    & 
     841            &              - ( rho_i(ji  ,jj,jk) - rho_i(ji,jj,jk-1) )  ) * r1_e1u(ji,jj) 
     842         zhpj(ji,jj,jk) = zhpj(ji,jj,jk-1)                                & 
     843            &           + (  ( rho_k(ji,jj+1,jk) - rho_k(ji,jj,jk  ) )    & 
     844            &               -( rho_j(ji,jj  ,jk) - rho_j(ji,jj,jk-1) )  ) * r1_e2v(ji,jj) 
     845         IF( ln_wd_il ) THEN 
     846           zhpi(ji,jj,jk) = zhpi(ji,jj,jk) * zcpx(ji,jj) 
     847           zhpj(ji,jj,jk) = zhpj(ji,jj,jk) * zcpy(ji,jj)  
     848         ENDIF 
     849         ! add to the general momentum trend 
     850         puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + zhpi(ji,jj,jk) 
     851         pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + zhpj(ji,jj,jk) 
     852      END_3D 
    928853      ! 
    929854      IF( ln_wd_il )   DEALLOCATE( zcpx, zcpy ) 
     
    932857 
    933858 
    934    SUBROUTINE hpg_prj( kt ) 
     859   SUBROUTINE hpg_prj( kt, Kmm, puu, pvv, Krhs ) 
    935860      !!--------------------------------------------------------------------- 
    936861      !!                  ***  ROUTINE hpg_prj  *** 
     
    941866      !!      all vertical coordinate systems 
    942867      !! 
    943       !! ** Action : - Update (ua,va) with the now hydrastatic pressure trend 
     868      !! ** Action : - Update (puu(:,:,:,Krhs),pvv(:,:,:,Krhs)) with the now hydrastatic pressure trend 
    944869      !!---------------------------------------------------------------------- 
    945870      INTEGER, PARAMETER  :: polynomial_type = 1    ! 1: cubic spline, 2: linear 
    946       INTEGER, INTENT(in) ::   kt                   ! ocean time-step index 
     871      INTEGER                             , INTENT( in )  ::  kt          ! ocean time-step index 
     872      INTEGER                             , INTENT( in )  ::  Kmm, Krhs   ! ocean time level indices 
     873      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv    ! ocean velocities and RHS of momentum equation 
    947874      !! 
    948875      INTEGER  ::   ji, jj, jk, jkk                 ! dummy loop indices 
     
    974901      IF( ln_wd_il ) THEN 
    975902         ALLOCATE( zcpx(jpi,jpj) , zcpy(jpi,jpj) ) 
    976          DO jj = 2, jpjm1 
    977            DO ji = 2, jpim1  
    978              ll_tmp1 = MIN(  sshn(ji,jj)              ,  sshn(ji+1,jj) ) >                & 
    979                   &    MAX( -ht_0(ji,jj)              , -ht_0(ji+1,jj) ) .AND.            & 
    980                   &    MAX(  sshn(ji,jj) + ht_0(ji,jj),  sshn(ji+1,jj) + ht_0(ji+1,jj) )  & 
    981                   &                                                      > rn_wdmin1 + rn_wdmin2 
    982              ll_tmp2 = ( ABS( sshn(ji,jj)             -  sshn(ji+1,jj) ) > 1.E-12 ) .AND. (         & 
    983                   &    MAX(   sshn(ji,jj)             ,  sshn(ji+1,jj) ) >                & 
    984                   &    MAX(  -ht_0(ji,jj)             , -ht_0(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 ) 
    985  
    986              IF(ll_tmp1) THEN 
    987                zcpx(ji,jj) = 1.0_wp 
    988              ELSE IF(ll_tmp2) THEN 
    989                ! no worries about  sshn(ji+1,jj) -  sshn(ji  ,jj) = 0, it won't happen ! here 
    990                zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + ht_0(ji+1,jj) - sshn(ji,jj) - ht_0(ji,jj)) & 
    991                            &    / (sshn(ji+1,jj) -  sshn(ji  ,jj)) ) 
    992                
    993                 zcpx(ji,jj) = max(min( zcpx(ji,jj) , 1.0_wp),0.0_wp) 
    994              ELSE 
    995                zcpx(ji,jj) = 0._wp 
    996              END IF 
    997        
    998              ll_tmp1 = MIN(  sshn(ji,jj)              ,  sshn(ji,jj+1) ) >                & 
    999                   &    MAX( -ht_0(ji,jj)              , -ht_0(ji,jj+1) ) .AND.            & 
    1000                   &    MAX(  sshn(ji,jj) + ht_0(ji,jj),  sshn(ji,jj+1) + ht_0(ji,jj+1) )  & 
    1001                   &                                                      > rn_wdmin1 + rn_wdmin2 
    1002              ll_tmp2 = ( ABS( sshn(ji,jj)             -  sshn(ji,jj+1) ) > 1.E-12 ) .AND. (      & 
    1003                   &    MAX(   sshn(ji,jj)             ,  sshn(ji,jj+1) ) >                & 
    1004                   &    MAX(  -ht_0(ji,jj)             , -ht_0(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 ) 
    1005  
    1006              IF(ll_tmp1) THEN 
    1007                zcpy(ji,jj) = 1.0_wp 
    1008              ELSE IF(ll_tmp2) THEN 
    1009                ! no worries about  sshn(ji,jj+1) -  sshn(ji,jj  ) = 0, it won't happen ! here 
    1010                zcpy(ji,jj) = ABS( (sshn(ji,jj+1) + ht_0(ji,jj+1) - sshn(ji,jj) - ht_0(ji,jj)) & 
    1011                            &    / (sshn(ji,jj+1) - sshn(ji,jj  )) ) 
    1012                 zcpy(ji,jj) = max(min( zcpy(ji,jj) , 1.0_wp),0.0_wp) 
    1013  
    1014                ELSE 
    1015                   zcpy(ji,jj) = 0._wp 
    1016                ENDIF 
    1017             END DO 
    1018          END DO 
     903         DO_2D_00_00 
     904          ll_tmp1 = MIN(  ssh(ji,jj,Kmm)              ,  ssh(ji+1,jj,Kmm) ) >                & 
     905               &    MAX( -ht_0(ji,jj)              , -ht_0(ji+1,jj) ) .AND.            & 
     906               &    MAX(  ssh(ji,jj,Kmm) + ht_0(ji,jj),  ssh(ji+1,jj,Kmm) + ht_0(ji+1,jj) )  & 
     907               &                                                      > rn_wdmin1 + rn_wdmin2 
     908          ll_tmp2 = ( ABS( ssh(ji,jj,Kmm)             -  ssh(ji+1,jj,Kmm) ) > 1.E-12 ) .AND. (         & 
     909               &    MAX(   ssh(ji,jj,Kmm)             ,  ssh(ji+1,jj,Kmm) ) >                & 
     910               &    MAX(  -ht_0(ji,jj)             , -ht_0(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 ) 
     911 
     912          IF(ll_tmp1) THEN 
     913            zcpx(ji,jj) = 1.0_wp 
     914          ELSE IF(ll_tmp2) THEN 
     915            ! no worries about  ssh(ji+1,jj,Kmm) -  ssh(ji  ,jj,Kmm) = 0, it won't happen ! here 
     916            zcpx(ji,jj) = ABS( (ssh(ji+1,jj,Kmm) + ht_0(ji+1,jj) - ssh(ji,jj,Kmm) - ht_0(ji,jj)) & 
     917                        &    / (ssh(ji+1,jj,Kmm) -  ssh(ji  ,jj,Kmm)) ) 
     918            
     919             zcpx(ji,jj) = max(min( zcpx(ji,jj) , 1.0_wp),0.0_wp) 
     920          ELSE 
     921            zcpx(ji,jj) = 0._wp 
     922          END IF 
     923    
     924          ll_tmp1 = MIN(  ssh(ji,jj,Kmm)              ,  ssh(ji,jj+1,Kmm) ) >                & 
     925               &    MAX( -ht_0(ji,jj)              , -ht_0(ji,jj+1) ) .AND.            & 
     926               &    MAX(  ssh(ji,jj,Kmm) + ht_0(ji,jj),  ssh(ji,jj+1,Kmm) + ht_0(ji,jj+1) )  & 
     927               &                                                      > rn_wdmin1 + rn_wdmin2 
     928          ll_tmp2 = ( ABS( ssh(ji,jj,Kmm)             -  ssh(ji,jj+1,Kmm) ) > 1.E-12 ) .AND. (      & 
     929               &    MAX(   ssh(ji,jj,Kmm)             ,  ssh(ji,jj+1,Kmm) ) >                & 
     930               &    MAX(  -ht_0(ji,jj)             , -ht_0(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 ) 
     931 
     932          IF(ll_tmp1) THEN 
     933            zcpy(ji,jj) = 1.0_wp 
     934          ELSE IF(ll_tmp2) THEN 
     935            ! no worries about  ssh(ji,jj+1,Kmm) -  ssh(ji,jj  ,Kmm) = 0, it won't happen ! here 
     936            zcpy(ji,jj) = ABS( (ssh(ji,jj+1,Kmm) + ht_0(ji,jj+1) - ssh(ji,jj,Kmm) - ht_0(ji,jj)) & 
     937                        &    / (ssh(ji,jj+1,Kmm) - ssh(ji,jj  ,Kmm)) ) 
     938             zcpy(ji,jj) = max(min( zcpy(ji,jj) , 1.0_wp),0.0_wp) 
     939 
     940            ELSE 
     941               zcpy(ji,jj) = 0._wp 
     942            ENDIF 
     943         END_2D 
    1019944         CALL lbc_lnk_multi( 'dynhpg', zcpx, 'U', 1., zcpy, 'V', 1. ) 
    1020945      ENDIF 
     
    1025950 
    1026951      ! Preparing vertical density profile "zrhh(:,:,:)" for hybrid-sco coordinate 
    1027       DO jj = 1, jpj 
    1028         DO ji = 1, jpi 
    1029           jk = mbkt(ji,jj)+1 
    1030           IF(     jk <=  0   ) THEN   ;   zrhh(ji,jj,    :   ) = 0._wp 
    1031           ELSEIF( jk ==  1   ) THEN   ;   zrhh(ji,jj,jk+1:jpk) = rhd(ji,jj,jk) 
    1032           ELSEIF( jk < jpkm1 ) THEN 
    1033              DO jkk = jk+1, jpk 
    1034                 zrhh(ji,jj,jkk) = interp1(gde3w_n(ji,jj,jkk  ), gde3w_n(ji,jj,jkk-1),   & 
    1035                    &                      gde3w_n(ji,jj,jkk-2), rhd    (ji,jj,jkk-1), rhd(ji,jj,jkk-2)) 
    1036              END DO 
    1037           ENDIF 
    1038         END DO 
    1039       END DO 
     952      DO_2D_11_11 
     953       jk = mbkt(ji,jj)+1 
     954       IF(     jk <=  0   ) THEN   ;   zrhh(ji,jj,    :   ) = 0._wp 
     955       ELSEIF( jk ==  1   ) THEN   ;   zrhh(ji,jj,jk+1:jpk) = rhd(ji,jj,jk) 
     956       ELSEIF( jk < jpkm1 ) THEN 
     957          DO jkk = jk+1, jpk 
     958             zrhh(ji,jj,jkk) = interp1(gde3w(ji,jj,jkk  ), gde3w(ji,jj,jkk-1),   & 
     959                &                      gde3w(ji,jj,jkk-2), rhd    (ji,jj,jkk-1), rhd(ji,jj,jkk-2)) 
     960          END DO 
     961       ENDIF 
     962      END_2D 
    1040963 
    1041964      ! Transfer the depth of "T(:,:,:)" to vertical coordinate "zdept(:,:,:)" 
    1042       DO jj = 1, jpj 
    1043          DO ji = 1, jpi 
    1044             zdept(ji,jj,1) = 0.5_wp * e3w_n(ji,jj,1) - sshn(ji,jj) * znad 
    1045          END DO 
    1046       END DO 
    1047  
    1048       DO jk = 2, jpk 
    1049          DO jj = 1, jpj 
    1050             DO ji = 1, jpi 
    1051                zdept(ji,jj,jk) = zdept(ji,jj,jk-1) + e3w_n(ji,jj,jk) 
    1052             END DO 
    1053          END DO 
    1054       END DO 
     965      DO_2D_11_11 
     966         zdept(ji,jj,1) = 0.5_wp * e3w(ji,jj,1,Kmm) - ssh(ji,jj,Kmm) * znad 
     967      END_2D 
     968 
     969      DO_3D_11_11( 2, jpk ) 
     970         zdept(ji,jj,jk) = zdept(ji,jj,jk-1) + e3w(ji,jj,jk,Kmm) 
     971      END_3D 
    1055972 
    1056973      fsp(:,:,:) = zrhh (:,:,:) 
     
    1063980 
    1064981      ! Integrate the hydrostatic pressure "zhpi(:,:,:)" at "T(ji,jj,1)" 
    1065       DO jj = 2, jpj 
    1066         DO ji = 2, jpi 
    1067           zrhdt1 = zrhh(ji,jj,1) - interp3( zdept(ji,jj,1), asp(ji,jj,1), bsp(ji,jj,1),  & 
    1068              &                                              csp(ji,jj,1), dsp(ji,jj,1) ) * 0.25_wp * e3w_n(ji,jj,1) 
    1069  
    1070           ! assuming linear profile across the top half surface layer 
    1071           zhpi(ji,jj,1) =  0.5_wp * e3w_n(ji,jj,1) * zrhdt1 
    1072         END DO 
    1073       END DO 
     982      DO_2D_01_01 
     983       zrhdt1 = zrhh(ji,jj,1) - interp3( zdept(ji,jj,1), asp(ji,jj,1), bsp(ji,jj,1),  & 
     984          &                                              csp(ji,jj,1), dsp(ji,jj,1) ) * 0.25_wp * e3w(ji,jj,1,Kmm) 
     985 
     986       ! assuming linear profile across the top half surface layer 
     987       zhpi(ji,jj,1) =  0.5_wp * e3w(ji,jj,1,Kmm) * zrhdt1 
     988      END_2D 
    1074989 
    1075990      ! Calculate the pressure "zhpi(:,:,:)" at "T(ji,jj,2:jpkm1)" 
    1076       DO jk = 2, jpkm1 
    1077         DO jj = 2, jpj 
    1078           DO ji = 2, jpi 
    1079             zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) +                                  & 
    1080                &             integ_spline( zdept(ji,jj,jk-1), zdept(ji,jj,jk),   & 
    1081                &                           asp  (ji,jj,jk-1), bsp  (ji,jj,jk-1), & 
    1082                &                           csp  (ji,jj,jk-1), dsp  (ji,jj,jk-1)  ) 
    1083           END DO 
    1084         END DO 
    1085       END DO 
     991      DO_3D_01_01( 2, jpkm1 ) 
     992      zhpi(ji,jj,jk) = zhpi(ji,jj,jk-1) +                                  & 
     993         &             integ_spline( zdept(ji,jj,jk-1), zdept(ji,jj,jk),   & 
     994         &                           asp  (ji,jj,jk-1), bsp  (ji,jj,jk-1), & 
     995         &                           csp  (ji,jj,jk-1), dsp  (ji,jj,jk-1)  ) 
     996      END_3D 
    1086997 
    1087998      ! Z coordinate of U(ji,jj,1:jpkm1) and V(ji,jj,1:jpkm1) 
    1088999 
    10891000      ! Prepare zsshu_n and zsshv_n 
    1090       DO jj = 2, jpjm1 
    1091         DO ji = 2, jpim1 
     1001      DO_2D_00_00 
    10921002!!gm BUG ?    if it is ssh at u- & v-point then it should be: 
    1093 !          zsshu_n(ji,jj) = (e1e2t(ji,jj) * sshn(ji,jj) + e1e2t(ji+1,jj) * sshn(ji+1,jj)) * & 
     1003!          zsshu_n(ji,jj) = (e1e2t(ji,jj) * ssh(ji,jj,Kmm) + e1e2t(ji+1,jj) * ssh(ji+1,jj,Kmm)) * & 
    10941004!                         & r1_e1e2u(ji,jj) * umask(ji,jj,1) * 0.5_wp  
    1095 !          zsshv_n(ji,jj) = (e1e2t(ji,jj) * sshn(ji,jj) + e1e2t(ji,jj+1) * sshn(ji,jj+1)) * & 
     1005!          zsshv_n(ji,jj) = (e1e2t(ji,jj) * ssh(ji,jj,Kmm) + e1e2t(ji,jj+1) * ssh(ji,jj+1,Kmm)) * & 
    10961006!                         & r1_e1e2v(ji,jj) * vmask(ji,jj,1) * 0.5_wp  
    10971007!!gm not this: 
    1098           zsshu_n(ji,jj) = (e1e2u(ji,jj) * sshn(ji,jj) + e1e2u(ji+1, jj) * sshn(ji+1,jj)) * & 
    1099                          & r1_e1e2u(ji,jj) * umask(ji,jj,1) * 0.5_wp  
    1100           zsshv_n(ji,jj) = (e1e2v(ji,jj) * sshn(ji,jj) + e1e2v(ji+1, jj) * sshn(ji,jj+1)) * & 
    1101                          & r1_e1e2v(ji,jj) * vmask(ji,jj,1) * 0.5_wp  
    1102         END DO 
    1103       END DO 
     1008       zsshu_n(ji,jj) = (e1e2u(ji,jj) * ssh(ji,jj,Kmm) + e1e2u(ji+1, jj) * ssh(ji+1,jj,Kmm)) * & 
     1009                      & r1_e1e2u(ji,jj) * umask(ji,jj,1) * 0.5_wp  
     1010       zsshv_n(ji,jj) = (e1e2v(ji,jj) * ssh(ji,jj,Kmm) + e1e2v(ji+1, jj) * ssh(ji,jj+1,Kmm)) * & 
     1011                      & r1_e1e2v(ji,jj) * vmask(ji,jj,1) * 0.5_wp  
     1012      END_2D 
    11041013 
    11051014      CALL lbc_lnk_multi ('dynhpg', zsshu_n, 'U', 1., zsshv_n, 'V', 1. ) 
    11061015 
    1107       DO jj = 2, jpjm1 
    1108         DO ji = 2, jpim1 
    1109           zu(ji,jj,1) = - ( e3u_n(ji,jj,1) - zsshu_n(ji,jj) * znad)  
    1110           zv(ji,jj,1) = - ( e3v_n(ji,jj,1) - zsshv_n(ji,jj) * znad) 
    1111         END DO 
    1112       END DO 
    1113  
    1114       DO jk = 2, jpkm1 
    1115         DO jj = 2, jpjm1 
    1116           DO ji = 2, jpim1 
    1117             zu(ji,jj,jk) = zu(ji,jj,jk-1) - e3u_n(ji,jj,jk) 
    1118             zv(ji,jj,jk) = zv(ji,jj,jk-1) - e3v_n(ji,jj,jk) 
    1119           END DO 
    1120         END DO 
    1121       END DO 
    1122  
    1123       DO jk = 1, jpkm1 
    1124         DO jj = 2, jpjm1 
    1125           DO ji = 2, jpim1 
    1126             zu(ji,jj,jk) = zu(ji,jj,jk) + 0.5_wp * e3u_n(ji,jj,jk) 
    1127             zv(ji,jj,jk) = zv(ji,jj,jk) + 0.5_wp * e3v_n(ji,jj,jk) 
    1128           END DO 
    1129         END DO 
    1130       END DO 
    1131  
    1132       DO jk = 1, jpkm1 
    1133         DO jj = 2, jpjm1 
    1134           DO ji = 2, jpim1 
    1135             zu(ji,jj,jk) = MIN(  zu(ji,jj,jk) , MAX( -zdept(ji,jj,jk) , -zdept(ji+1,jj,jk) )  ) 
    1136             zu(ji,jj,jk) = MAX(  zu(ji,jj,jk) , MIN( -zdept(ji,jj,jk) , -zdept(ji+1,jj,jk) )  ) 
    1137             zv(ji,jj,jk) = MIN(  zv(ji,jj,jk) , MAX( -zdept(ji,jj,jk) , -zdept(ji,jj+1,jk) )  ) 
    1138             zv(ji,jj,jk) = MAX(  zv(ji,jj,jk) , MIN( -zdept(ji,jj,jk) , -zdept(ji,jj+1,jk) )  ) 
    1139           END DO 
    1140         END DO 
    1141       END DO 
    1142  
    1143  
    1144       DO jk = 1, jpkm1 
    1145         DO jj = 2, jpjm1 
    1146           DO ji = 2, jpim1 
    1147             zpwes = 0._wp; zpwed = 0._wp 
    1148             zpnss = 0._wp; zpnsd = 0._wp 
    1149             zuijk = zu(ji,jj,jk) 
    1150             zvijk = zv(ji,jj,jk) 
    1151  
    1152             !!!!!     for u equation 
    1153             IF( jk <= mbku(ji,jj) ) THEN 
    1154                IF( -zdept(ji+1,jj,jk) >= -zdept(ji,jj,jk) ) THEN 
    1155                  jis = ji + 1; jid = ji 
    1156                ELSE 
    1157                  jis = ji;     jid = ji +1 
    1158                ENDIF 
    1159  
    1160                ! integrate the pressure on the shallow side 
    1161                jk1 = jk 
    1162                DO WHILE ( -zdept(jis,jj,jk1) > zuijk ) 
    1163                  IF( jk1 == mbku(ji,jj) ) THEN 
    1164                    zuijk = -zdept(jis,jj,jk1) 
    1165                    EXIT 
    1166                  ENDIF 
    1167                  zdeps = MIN(zdept(jis,jj,jk1+1), -zuijk) 
    1168                  zpwes = zpwes +                                    & 
    1169                       integ_spline(zdept(jis,jj,jk1), zdeps,            & 
    1170                              asp(jis,jj,jk1),    bsp(jis,jj,jk1), & 
    1171                              csp(jis,jj,jk1),    dsp(jis,jj,jk1)) 
    1172                  jk1 = jk1 + 1 
    1173                END DO 
    1174  
    1175                ! integrate the pressure on the deep side 
    1176                jk1 = jk 
    1177                DO WHILE ( -zdept(jid,jj,jk1) < zuijk ) 
    1178                  IF( jk1 == 1 ) THEN 
    1179                    zdeps = zdept(jid,jj,1) + MIN(zuijk, sshn(jid,jj)*znad) 
    1180                    zrhdt1 = zrhh(jid,jj,1) - interp3(zdept(jid,jj,1), asp(jid,jj,1), & 
    1181                                                      bsp(jid,jj,1),   csp(jid,jj,1), & 
    1182                                                      dsp(jid,jj,1)) * zdeps 
    1183                    zpwed  = zpwed + 0.5_wp * (zrhh(jid,jj,1) + zrhdt1) * zdeps 
    1184                    EXIT 
    1185                  ENDIF 
    1186                  zdeps = MAX(zdept(jid,jj,jk1-1), -zuijk) 
    1187                  zpwed = zpwed +                                        & 
    1188                         integ_spline(zdeps,              zdept(jid,jj,jk1), & 
    1189                                asp(jid,jj,jk1-1), bsp(jid,jj,jk1-1),  & 
    1190                                csp(jid,jj,jk1-1), dsp(jid,jj,jk1-1) ) 
    1191                  jk1 = jk1 - 1 
    1192                END DO 
    1193  
    1194                ! update the momentum trends in u direction 
    1195  
    1196                zdpdx1 = zcoef0 * r1_e1u(ji,jj) * ( zhpi(ji+1,jj,jk) - zhpi(ji,jj,jk) ) 
    1197                IF( .NOT.ln_linssh ) THEN 
    1198                  zdpdx2 = zcoef0 * r1_e1u(ji,jj) * & 
    1199                     &    ( REAL(jis-jid, wp) * (zpwes + zpwed) + (sshn(ji+1,jj)-sshn(ji,jj)) ) 
    1200                 ELSE 
    1201                  zdpdx2 = zcoef0 * r1_e1u(ji,jj) * REAL(jis-jid, wp) * (zpwes + zpwed) 
    1202                ENDIF 
    1203                IF( ln_wd_il ) THEN 
    1204                   zdpdx1 = zdpdx1 * zcpx(ji,jj) * wdrampu(ji,jj) 
    1205                   zdpdx2 = zdpdx2 * zcpx(ji,jj) * wdrampu(ji,jj) 
    1206                ENDIF 
    1207                ua(ji,jj,jk) = ua(ji,jj,jk) + (zdpdx1 + zdpdx2) * umask(ji,jj,jk)  
    1208             ENDIF 
    1209  
    1210             !!!!!     for v equation 
    1211             IF( jk <= mbkv(ji,jj) ) THEN 
    1212                IF( -zdept(ji,jj+1,jk) >= -zdept(ji,jj,jk) ) THEN 
    1213                  jjs = jj + 1; jjd = jj 
    1214                ELSE 
    1215                  jjs = jj    ; jjd = jj + 1 
    1216                ENDIF 
    1217  
    1218                ! integrate the pressure on the shallow side 
    1219                jk1 = jk 
    1220                DO WHILE ( -zdept(ji,jjs,jk1) > zvijk ) 
    1221                  IF( jk1 == mbkv(ji,jj) ) THEN 
    1222                    zvijk = -zdept(ji,jjs,jk1) 
    1223                    EXIT 
    1224                  ENDIF 
    1225                  zdeps = MIN(zdept(ji,jjs,jk1+1), -zvijk) 
    1226                  zpnss = zpnss +                                      & 
    1227                         integ_spline(zdept(ji,jjs,jk1), zdeps,            & 
    1228                                asp(ji,jjs,jk1),    bsp(ji,jjs,jk1), & 
    1229                                csp(ji,jjs,jk1),    dsp(ji,jjs,jk1) ) 
    1230                  jk1 = jk1 + 1 
    1231                END DO 
    1232  
    1233                ! integrate the pressure on the deep side 
    1234                jk1 = jk 
    1235                DO WHILE ( -zdept(ji,jjd,jk1) < zvijk ) 
    1236                  IF( jk1 == 1 ) THEN 
    1237                    zdeps = zdept(ji,jjd,1) + MIN(zvijk, sshn(ji,jjd)*znad) 
    1238                    zrhdt1 = zrhh(ji,jjd,1) - interp3(zdept(ji,jjd,1), asp(ji,jjd,1), & 
    1239                                                      bsp(ji,jjd,1),   csp(ji,jjd,1), & 
    1240                                                      dsp(ji,jjd,1) ) * zdeps 
    1241                    zpnsd  = zpnsd + 0.5_wp * (zrhh(ji,jjd,1) + zrhdt1) * zdeps 
    1242                    EXIT 
    1243                  ENDIF 
    1244                  zdeps = MAX(zdept(ji,jjd,jk1-1), -zvijk) 
    1245                  zpnsd = zpnsd +                                        & 
    1246                         integ_spline(zdeps,              zdept(ji,jjd,jk1), & 
    1247                                asp(ji,jjd,jk1-1), bsp(ji,jjd,jk1-1), & 
    1248                                csp(ji,jjd,jk1-1), dsp(ji,jjd,jk1-1) ) 
    1249                  jk1 = jk1 - 1 
    1250                END DO 
    1251  
    1252  
    1253                ! update the momentum trends in v direction 
    1254  
    1255                zdpdy1 = zcoef0 * r1_e2v(ji,jj) * ( zhpi(ji,jj+1,jk) - zhpi(ji,jj,jk) ) 
    1256                IF( .NOT.ln_linssh ) THEN 
    1257                   zdpdy2 = zcoef0 * r1_e2v(ji,jj) * & 
    1258                           ( REAL(jjs-jjd, wp) * (zpnss + zpnsd) + (sshn(ji,jj+1)-sshn(ji,jj)) ) 
    1259                ELSE 
    1260                   zdpdy2 = zcoef0 * r1_e2v(ji,jj) * REAL(jjs-jjd, wp) * (zpnss + zpnsd ) 
    1261                ENDIF 
    1262                IF( ln_wd_il ) THEN 
    1263                   zdpdy1 = zdpdy1 * zcpy(ji,jj) * wdrampv(ji,jj)  
    1264                   zdpdy2 = zdpdy2 * zcpy(ji,jj) * wdrampv(ji,jj)  
    1265                ENDIF 
    1266  
    1267                va(ji,jj,jk) = va(ji,jj,jk) + (zdpdy1 + zdpdy2) * vmask(ji,jj,jk) 
    1268             ENDIF 
    1269                ! 
    1270             END DO 
     1016      DO_2D_00_00 
     1017       zu(ji,jj,1) = - ( e3u(ji,jj,1,Kmm) - zsshu_n(ji,jj) * znad)  
     1018       zv(ji,jj,1) = - ( e3v(ji,jj,1,Kmm) - zsshv_n(ji,jj) * znad) 
     1019      END_2D 
     1020 
     1021      DO_3D_00_00( 2, jpkm1 ) 
     1022      zu(ji,jj,jk) = zu(ji,jj,jk-1) - e3u(ji,jj,jk,Kmm) 
     1023      zv(ji,jj,jk) = zv(ji,jj,jk-1) - e3v(ji,jj,jk,Kmm) 
     1024      END_3D 
     1025 
     1026      DO_3D_00_00( 1, jpkm1 ) 
     1027      zu(ji,jj,jk) = zu(ji,jj,jk) + 0.5_wp * e3u(ji,jj,jk,Kmm) 
     1028      zv(ji,jj,jk) = zv(ji,jj,jk) + 0.5_wp * e3v(ji,jj,jk,Kmm) 
     1029      END_3D 
     1030 
     1031      DO_3D_00_00( 1, jpkm1 ) 
     1032      zu(ji,jj,jk) = MIN(  zu(ji,jj,jk) , MAX( -zdept(ji,jj,jk) , -zdept(ji+1,jj,jk) )  ) 
     1033      zu(ji,jj,jk) = MAX(  zu(ji,jj,jk) , MIN( -zdept(ji,jj,jk) , -zdept(ji+1,jj,jk) )  ) 
     1034      zv(ji,jj,jk) = MIN(  zv(ji,jj,jk) , MAX( -zdept(ji,jj,jk) , -zdept(ji,jj+1,jk) )  ) 
     1035      zv(ji,jj,jk) = MAX(  zv(ji,jj,jk) , MIN( -zdept(ji,jj,jk) , -zdept(ji,jj+1,jk) )  ) 
     1036      END_3D 
     1037 
     1038 
     1039      DO_3D_00_00( 1, jpkm1 ) 
     1040      zpwes = 0._wp; zpwed = 0._wp 
     1041      zpnss = 0._wp; zpnsd = 0._wp 
     1042      zuijk = zu(ji,jj,jk) 
     1043      zvijk = zv(ji,jj,jk) 
     1044 
     1045      !!!!!     for u equation 
     1046      IF( jk <= mbku(ji,jj) ) THEN 
     1047         IF( -zdept(ji+1,jj,jk) >= -zdept(ji,jj,jk) ) THEN 
     1048           jis = ji + 1; jid = ji 
     1049         ELSE 
     1050           jis = ji;     jid = ji +1 
     1051         ENDIF 
     1052 
     1053         ! integrate the pressure on the shallow side 
     1054         jk1 = jk 
     1055         DO WHILE ( -zdept(jis,jj,jk1) > zuijk ) 
     1056           IF( jk1 == mbku(ji,jj) ) THEN 
     1057             zuijk = -zdept(jis,jj,jk1) 
     1058             EXIT 
     1059           ENDIF 
     1060           zdeps = MIN(zdept(jis,jj,jk1+1), -zuijk) 
     1061           zpwes = zpwes +                                    & 
     1062                integ_spline(zdept(jis,jj,jk1), zdeps,            & 
     1063                       asp(jis,jj,jk1),    bsp(jis,jj,jk1), & 
     1064                       csp(jis,jj,jk1),    dsp(jis,jj,jk1)) 
     1065           jk1 = jk1 + 1 
    12711066         END DO 
    1272       END DO 
     1067 
     1068         ! integrate the pressure on the deep side 
     1069         jk1 = jk 
     1070         DO WHILE ( -zdept(jid,jj,jk1) < zuijk ) 
     1071           IF( jk1 == 1 ) THEN 
     1072             zdeps = zdept(jid,jj,1) + MIN(zuijk, ssh(jid,jj,Kmm)*znad) 
     1073             zrhdt1 = zrhh(jid,jj,1) - interp3(zdept(jid,jj,1), asp(jid,jj,1), & 
     1074                                               bsp(jid,jj,1),   csp(jid,jj,1), & 
     1075                                               dsp(jid,jj,1)) * zdeps 
     1076             zpwed  = zpwed + 0.5_wp * (zrhh(jid,jj,1) + zrhdt1) * zdeps 
     1077             EXIT 
     1078           ENDIF 
     1079           zdeps = MAX(zdept(jid,jj,jk1-1), -zuijk) 
     1080           zpwed = zpwed +                                        & 
     1081                  integ_spline(zdeps,              zdept(jid,jj,jk1), & 
     1082                         asp(jid,jj,jk1-1), bsp(jid,jj,jk1-1),  & 
     1083                         csp(jid,jj,jk1-1), dsp(jid,jj,jk1-1) ) 
     1084           jk1 = jk1 - 1 
     1085         END DO 
     1086 
     1087         ! update the momentum trends in u direction 
     1088 
     1089         zdpdx1 = zcoef0 * r1_e1u(ji,jj) * ( zhpi(ji+1,jj,jk) - zhpi(ji,jj,jk) ) 
     1090         IF( .NOT.ln_linssh ) THEN 
     1091           zdpdx2 = zcoef0 * r1_e1u(ji,jj) * & 
     1092              &    ( REAL(jis-jid, wp) * (zpwes + zpwed) + (ssh(ji+1,jj,Kmm)-ssh(ji,jj,Kmm)) ) 
     1093          ELSE 
     1094           zdpdx2 = zcoef0 * r1_e1u(ji,jj) * REAL(jis-jid, wp) * (zpwes + zpwed) 
     1095         ENDIF 
     1096         IF( ln_wd_il ) THEN 
     1097            zdpdx1 = zdpdx1 * zcpx(ji,jj) * wdrampu(ji,jj) 
     1098            zdpdx2 = zdpdx2 * zcpx(ji,jj) * wdrampu(ji,jj) 
     1099         ENDIF 
     1100         puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + (zdpdx1 + zdpdx2) * umask(ji,jj,jk)  
     1101      ENDIF 
     1102 
     1103      !!!!!     for v equation 
     1104      IF( jk <= mbkv(ji,jj) ) THEN 
     1105         IF( -zdept(ji,jj+1,jk) >= -zdept(ji,jj,jk) ) THEN 
     1106           jjs = jj + 1; jjd = jj 
     1107         ELSE 
     1108           jjs = jj    ; jjd = jj + 1 
     1109         ENDIF 
     1110 
     1111         ! integrate the pressure on the shallow side 
     1112         jk1 = jk 
     1113         DO WHILE ( -zdept(ji,jjs,jk1) > zvijk ) 
     1114           IF( jk1 == mbkv(ji,jj) ) THEN 
     1115             zvijk = -zdept(ji,jjs,jk1) 
     1116             EXIT 
     1117           ENDIF 
     1118           zdeps = MIN(zdept(ji,jjs,jk1+1), -zvijk) 
     1119           zpnss = zpnss +                                      & 
     1120                  integ_spline(zdept(ji,jjs,jk1), zdeps,            & 
     1121                         asp(ji,jjs,jk1),    bsp(ji,jjs,jk1), & 
     1122                         csp(ji,jjs,jk1),    dsp(ji,jjs,jk1) ) 
     1123           jk1 = jk1 + 1 
     1124         END DO 
     1125 
     1126         ! integrate the pressure on the deep side 
     1127         jk1 = jk 
     1128         DO WHILE ( -zdept(ji,jjd,jk1) < zvijk ) 
     1129           IF( jk1 == 1 ) THEN 
     1130             zdeps = zdept(ji,jjd,1) + MIN(zvijk, ssh(ji,jjd,Kmm)*znad) 
     1131             zrhdt1 = zrhh(ji,jjd,1) - interp3(zdept(ji,jjd,1), asp(ji,jjd,1), & 
     1132                                               bsp(ji,jjd,1),   csp(ji,jjd,1), & 
     1133                                               dsp(ji,jjd,1) ) * zdeps 
     1134             zpnsd  = zpnsd + 0.5_wp * (zrhh(ji,jjd,1) + zrhdt1) * zdeps 
     1135             EXIT 
     1136           ENDIF 
     1137           zdeps = MAX(zdept(ji,jjd,jk1-1), -zvijk) 
     1138           zpnsd = zpnsd +                                        & 
     1139                  integ_spline(zdeps,              zdept(ji,jjd,jk1), & 
     1140                         asp(ji,jjd,jk1-1), bsp(ji,jjd,jk1-1), & 
     1141                         csp(ji,jjd,jk1-1), dsp(ji,jjd,jk1-1) ) 
     1142           jk1 = jk1 - 1 
     1143         END DO 
     1144 
     1145 
     1146         ! update the momentum trends in v direction 
     1147 
     1148         zdpdy1 = zcoef0 * r1_e2v(ji,jj) * ( zhpi(ji,jj+1,jk) - zhpi(ji,jj,jk) ) 
     1149         IF( .NOT.ln_linssh ) THEN 
     1150            zdpdy2 = zcoef0 * r1_e2v(ji,jj) * & 
     1151                    ( REAL(jjs-jjd, wp) * (zpnss + zpnsd) + (ssh(ji,jj+1,Kmm)-ssh(ji,jj,Kmm)) ) 
     1152         ELSE 
     1153            zdpdy2 = zcoef0 * r1_e2v(ji,jj) * REAL(jjs-jjd, wp) * (zpnss + zpnsd ) 
     1154         ENDIF 
     1155         IF( ln_wd_il ) THEN 
     1156            zdpdy1 = zdpdy1 * zcpy(ji,jj) * wdrampv(ji,jj)  
     1157            zdpdy2 = zdpdy2 * zcpy(ji,jj) * wdrampv(ji,jj)  
     1158         ENDIF 
     1159 
     1160         pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + (zdpdy1 + zdpdy2) * vmask(ji,jj,jk) 
     1161      ENDIF 
     1162         ! 
     1163      END_3D 
    12731164      ! 
    12741165      IF( ln_wd_il )   DEALLOCATE( zcpx, zcpy ) 
  • NEMO/trunk/src/OCE/DYN/dynkeg.F90

    r11536 r12377  
    3636    
    3737   !! * Substitutions 
    38 #  include "vectopt_loop_substitute.h90" 
     38#  include "do_loop_substitute.h90" 
    3939   !!---------------------------------------------------------------------- 
    4040   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    4444CONTAINS 
    4545 
    46    SUBROUTINE dyn_keg( kt, kscheme ) 
     46   SUBROUTINE dyn_keg( kt, kscheme, Kmm, puu, pvv, Krhs ) 
    4747      !!---------------------------------------------------------------------- 
    4848      !!                  ***  ROUTINE dyn_keg  *** 
     
    5757      !!              * kscheme = nkeg_HW : Hollingsworth correction following 
    5858      !!      Arakawa (2001). The now horizontal kinetic energy is given by: 
    59       !!         zhke = 1/6 [ mi-1(  2 * un^2 + ((un(j+1)+un(j-1))/2)^2  ) 
    60       !!                    + mj-1(  2 * vn^2 + ((vn(i+1)+vn(i-1))/2)^2  ) ] 
     59      !!         zhke = 1/6 [ mi-1(  2 * un^2 + ((u(j+1)+u(j-1))/2)^2  ) 
     60      !!                    + mj-1(  2 * vn^2 + ((v(i+1)+v(i-1))/2)^2  ) ] 
    6161      !!       
    6262      !!      Take its horizontal gradient and add it to the general momentum 
    63       !!      trend (ua,va). 
    64       !!         ua = ua - 1/e1u di[ zhke ] 
    65       !!         va = va - 1/e2v dj[ zhke ] 
     63      !!      trend. 
     64      !!         u(rhs) = u(rhs) - 1/e1u di[ zhke ] 
     65      !!         v(rhs) = v(rhs) - 1/e2v dj[ zhke ] 
    6666      !! 
    67       !! ** Action : - Update the (ua, va) with the hor. ke gradient trend 
     67      !! ** Action : - Update the (puu(:,:,:,Krhs), pvv(:,:,:,Krhs)) with the hor. ke gradient trend 
    6868      !!             - send this trends to trd_dyn (l_trddyn=T) for post-processing 
    6969      !! 
     
    7171      !!                 Hollingsworth et al., Quart. J. Roy. Meteor. Soc., 1983. 
    7272      !!---------------------------------------------------------------------- 
    73       INTEGER, INTENT( in ) ::   kt        ! ocean time-step index 
    74       INTEGER, INTENT( in ) ::   kscheme   ! =0/1   type of KEG scheme  
     73      INTEGER                             , INTENT( in )  ::  kt               ! ocean time-step index 
     74      INTEGER                             , INTENT( in )  ::  kscheme          ! =0/1   type of KEG scheme  
     75      INTEGER                             , INTENT( in )  ::  Kmm, Krhs        ! ocean time level indices 
     76      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv         ! ocean velocities and RHS of momentum equation 
    7577      ! 
    7678      INTEGER  ::   ji, jj, jk             ! dummy loop indices 
     
    9092      IF( l_trddyn ) THEN           ! Save the input trends 
    9193         ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) ) 
    92          ztrdu(:,:,:) = ua(:,:,:)  
    93          ztrdv(:,:,:) = va(:,:,:)  
     94         ztrdu(:,:,:) = puu(:,:,:,Krhs)  
     95         ztrdv(:,:,:) = pvv(:,:,:,Krhs)  
    9496      ENDIF 
    9597       
     
    99101      ! 
    100102      CASE ( nkeg_C2 )                          !--  Standard scheme  --! 
    101          DO jk = 1, jpkm1 
    102             DO jj = 2, jpj 
    103                DO ji = fs_2, jpi   ! vector opt. 
    104                   zu =    un(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)   & 
    105                      &  + un(ji  ,jj  ,jk) * un(ji  ,jj  ,jk) 
    106                   zv =    vn(ji  ,jj-1,jk) * vn(ji  ,jj-1,jk)   & 
    107                      &  + vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk) 
    108                   zhke(ji,jj,jk) = 0.25_wp * ( zv + zu ) 
    109                END DO   
    110             END DO 
    111          END DO 
     103         DO_3D_01_01( 1, jpkm1 ) 
     104            zu =    puu(ji-1,jj  ,jk,Kmm) * puu(ji-1,jj  ,jk,Kmm)   & 
     105               &  + puu(ji  ,jj  ,jk,Kmm) * puu(ji  ,jj  ,jk,Kmm) 
     106            zv =    pvv(ji  ,jj-1,jk,Kmm) * pvv(ji  ,jj-1,jk,Kmm)   & 
     107               &  + pvv(ji  ,jj  ,jk,Kmm) * pvv(ji  ,jj  ,jk,Kmm) 
     108            zhke(ji,jj,jk) = 0.25_wp * ( zv + zu ) 
     109         END_3D 
    112110      CASE ( nkeg_HW )                          !--  Hollingsworth scheme  --! 
    113          DO jk = 1, jpkm1 
    114             DO jj = 2, jpjm1        
    115                DO ji = fs_2, jpim1   ! vector opt. 
    116                   zu = 8._wp * ( un(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)    & 
    117                      &         + un(ji  ,jj  ,jk) * un(ji  ,jj  ,jk) )  & 
    118                      &   +     ( un(ji-1,jj-1,jk) + un(ji-1,jj+1,jk) ) * ( un(ji-1,jj-1,jk) + un(ji-1,jj+1,jk) )   & 
    119                      &   +     ( un(ji  ,jj-1,jk) + un(ji  ,jj+1,jk) ) * ( un(ji  ,jj-1,jk) + un(ji  ,jj+1,jk) ) 
    120                      ! 
    121                   zv = 8._wp * ( vn(ji  ,jj-1,jk) * vn(ji  ,jj-1,jk)    & 
    122                      &         + vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk) )  & 
    123                      &  +      ( vn(ji-1,jj-1,jk) + vn(ji+1,jj-1,jk) ) * ( vn(ji-1,jj-1,jk) + vn(ji+1,jj-1,jk) )   & 
    124                      &  +      ( vn(ji-1,jj  ,jk) + vn(ji+1,jj  ,jk) ) * ( vn(ji-1,jj  ,jk) + vn(ji+1,jj  ,jk) ) 
    125                   zhke(ji,jj,jk) = r1_48 * ( zv + zu ) 
    126                END DO   
    127             END DO 
    128          END DO 
     111         DO_3D_00_00( 1, jpkm1 ) 
     112            zu = 8._wp * ( puu(ji-1,jj  ,jk,Kmm) * puu(ji-1,jj  ,jk,Kmm)    & 
     113               &         + puu(ji  ,jj  ,jk,Kmm) * puu(ji  ,jj  ,jk,Kmm) )  & 
     114               &   +     ( puu(ji-1,jj-1,jk,Kmm) + puu(ji-1,jj+1,jk,Kmm) ) * ( puu(ji-1,jj-1,jk,Kmm) + puu(ji-1,jj+1,jk,Kmm) )   & 
     115               &   +     ( puu(ji  ,jj-1,jk,Kmm) + puu(ji  ,jj+1,jk,Kmm) ) * ( puu(ji  ,jj-1,jk,Kmm) + puu(ji  ,jj+1,jk,Kmm) ) 
     116               ! 
     117            zv = 8._wp * ( pvv(ji  ,jj-1,jk,Kmm) * pvv(ji  ,jj-1,jk,Kmm)    & 
     118               &         + pvv(ji  ,jj  ,jk,Kmm) * pvv(ji  ,jj  ,jk,Kmm) )  & 
     119               &  +      ( pvv(ji-1,jj-1,jk,Kmm) + pvv(ji+1,jj-1,jk,Kmm) ) * ( pvv(ji-1,jj-1,jk,Kmm) + pvv(ji+1,jj-1,jk,Kmm) )   & 
     120               &  +      ( pvv(ji-1,jj  ,jk,Kmm) + pvv(ji+1,jj  ,jk,Kmm) ) * ( pvv(ji-1,jj  ,jk,Kmm) + pvv(ji+1,jj  ,jk,Kmm) ) 
     121            zhke(ji,jj,jk) = r1_48 * ( zv + zu ) 
     122         END_3D 
    129123         CALL lbc_lnk( 'dynkeg', zhke, 'T', 1. ) 
    130124         ! 
    131125      END SELECT  
    132126      ! 
    133       DO jk = 1, jpkm1                    !==  grad( KE ) added to the general momentum trends  ==! 
    134          DO jj = 2, jpjm1 
    135             DO ji = fs_2, fs_jpim1   ! vector opt. 
    136                ua(ji,jj,jk) = ua(ji,jj,jk) - ( zhke(ji+1,jj  ,jk) - zhke(ji,jj,jk) ) / e1u(ji,jj) 
    137                va(ji,jj,jk) = va(ji,jj,jk) - ( zhke(ji  ,jj+1,jk) - zhke(ji,jj,jk) ) / e2v(ji,jj) 
    138             END DO  
    139          END DO 
    140       END DO 
     127      DO_3D_00_00( 1, jpkm1 ) 
     128         puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - ( zhke(ji+1,jj  ,jk) - zhke(ji,jj,jk) ) / e1u(ji,jj) 
     129         pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - ( zhke(ji  ,jj+1,jk) - zhke(ji,jj,jk) ) / e2v(ji,jj) 
     130      END_3D 
    141131      ! 
    142132      IF( l_trddyn ) THEN                 ! save the Kinetic Energy trends for diagnostic 
    143          ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    144          ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    145          CALL trd_dyn( ztrdu, ztrdv, jpdyn_keg, kt ) 
     133         ztrdu(:,:,:) = puu(:,:,:,Krhs) - ztrdu(:,:,:) 
     134         ztrdv(:,:,:) = pvv(:,:,:,Krhs) - ztrdv(:,:,:) 
     135         CALL trd_dyn( ztrdu, ztrdv, jpdyn_keg, kt, Kmm ) 
    146136         DEALLOCATE( ztrdu , ztrdv ) 
    147137      ENDIF 
    148138      ! 
    149       IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' keg  - Ua: ', mask1=umask,   & 
    150          &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
     139      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' keg  - Ua: ', mask1=umask,   & 
     140         &                                  tab3d_2=pvv(:,:,:,Krhs), clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    151141      ! 
    152142      IF( ln_timing )   CALL timing_stop('dyn_keg') 
  • NEMO/trunk/src/OCE/DYN/dynldf.F90

    r10068 r12377  
    3434   PUBLIC   dyn_ldf_init  ! called by opa  module  
    3535 
    36    !! * Substitutions 
    37 #  include "vectopt_loop_substitute.h90" 
    3836   !!---------------------------------------------------------------------- 
    3937   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    4341CONTAINS 
    4442 
    45    SUBROUTINE dyn_ldf( kt ) 
     43   SUBROUTINE dyn_ldf( kt, Kbb, Kmm, puu, pvv, Krhs ) 
    4644      !!---------------------------------------------------------------------- 
    4745      !!                  ***  ROUTINE dyn_ldf  *** 
     
    4947      !! ** Purpose :   compute the lateral ocean dynamics physics. 
    5048      !!---------------------------------------------------------------------- 
    51       INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     49      INTEGER                             , INTENT( in )  ::  kt               ! ocean time-step index 
     50      INTEGER                             , INTENT( in )  ::  Kbb, Kmm, Krhs   ! ocean time level indices 
     51      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv         ! ocean velocities and RHS of momentum equation 
    5252      ! 
    5353      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdu, ztrdv 
     
    5858      IF( l_trddyn )   THEN                      ! temporary save of momentum trends 
    5959         ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) ) 
    60          ztrdu(:,:,:) = ua(:,:,:)  
    61          ztrdv(:,:,:) = va(:,:,:)  
     60         ztrdu(:,:,:) = puu(:,:,:,Krhs)  
     61         ztrdv(:,:,:) = pvv(:,:,:,Krhs)  
    6262      ENDIF 
    6363 
    6464      SELECT CASE ( nldf_dyn )                   ! compute lateral mixing trend and add it to the general trend 
    6565      ! 
    66       CASE ( np_lap   )    ;   CALL dyn_ldf_lap( kt, ub, vb, ua, va, 1 )      ! iso-level    laplacian 
    67       CASE ( np_lap_i )    ;   CALL dyn_ldf_iso( kt )                         ! rotated      laplacian 
    68       CASE ( np_blp   )    ;   CALL dyn_ldf_blp( kt, ub, vb, ua, va    )      ! iso-level bi-laplacian 
     66      CASE ( np_lap   )   
     67         CALL dyn_ldf_lap( kt, Kbb, Kmm, puu(:,:,:,Kbb), pvv(:,:,:,Kbb), puu(:,:,:,Krhs), pvv(:,:,:,Krhs), 1 ) ! iso-level    laplacian 
     68      CASE ( np_lap_i )  
     69         CALL dyn_ldf_iso( kt, Kbb, Kmm, puu, pvv, Krhs    )                                                   ! rotated      laplacian 
     70      CASE ( np_blp   )   
     71         CALL dyn_ldf_blp( kt, Kbb, Kmm, puu(:,:,:,Kbb), pvv(:,:,:,Kbb), puu(:,:,:,Krhs), pvv(:,:,:,Krhs)    ) ! iso-level bi-laplacian 
    6972      ! 
    7073      END SELECT 
    7174 
    7275      IF( l_trddyn ) THEN                        ! save the horizontal diffusive trends for further diagnostics 
    73          ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    74          ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    75          CALL trd_dyn( ztrdu, ztrdv, jpdyn_ldf, kt ) 
     76         ztrdu(:,:,:) = puu(:,:,:,Krhs) - ztrdu(:,:,:) 
     77         ztrdv(:,:,:) = pvv(:,:,:,Krhs) - ztrdv(:,:,:) 
     78         CALL trd_dyn( ztrdu, ztrdv, jpdyn_ldf, kt, Kmm ) 
    7679         DEALLOCATE ( ztrdu , ztrdv ) 
    7780      ENDIF 
    7881      !                                          ! print sum trends (used for debugging) 
    79       IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' ldf  - Ua: ', mask1=umask,   & 
    80          &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
     82      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' ldf  - Ua: ', mask1=umask,   & 
     83         &                                  tab3d_2=pvv(:,:,:,Krhs), clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    8184      ! 
    8285      IF( ln_timing )   CALL timing_stop('dyn_ldf') 
  • NEMO/trunk/src/OCE/DYN/dynldf_iso.F90

    r10425 r12377  
    4141 
    4242   !! * Substitutions 
    43 #  include "vectopt_loop_substitute.h90" 
     43#  include "do_loop_substitute.h90" 
    4444   !!---------------------------------------------------------------------- 
    4545   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    6060 
    6161 
    62    SUBROUTINE dyn_ldf_iso( kt ) 
     62   SUBROUTINE dyn_ldf_iso( kt, Kbb, Kmm, puu, pvv, Krhs ) 
    6363      !!---------------------------------------------------------------------- 
    6464      !!                     ***  ROUTINE dyn_ldf_iso  *** 
     
    8181      !!      horizontal fluxes associated with the rotated lateral mixing: 
    8282      !!      u-component: 
    83       !!         ziut = ( ahmt + rn_ahm_b ) e2t * e3t / e1t  di[ ub ] 
    84       !!               -  ahmt              e2t * mi-1(uslp) dk[ mi(mk(ub)) ] 
    85       !!         zjuf = ( ahmf + rn_ahm_b ) e1f * e3f / e2f  dj[ ub ] 
    86       !!               -  ahmf              e1f * mi(vslp)   dk[ mj(mk(ub)) ] 
     83      !!         ziut = ( ahmt + rn_ahm_b ) e2t * e3t / e1t  di[ uu ] 
     84      !!               -  ahmt              e2t * mi-1(uslp) dk[ mi(mk(uu)) ] 
     85      !!         zjuf = ( ahmf + rn_ahm_b ) e1f * e3f / e2f  dj[ uu ] 
     86      !!               -  ahmf              e1f * mi(vslp)   dk[ mj(mk(uu)) ] 
    8787      !!      v-component: 
    88       !!         zivf = ( ahmf + rn_ahm_b ) e2t * e3t / e1t  di[ vb ] 
    89       !!               -  ahmf              e2t * mj(uslp)   dk[ mi(mk(vb)) ] 
    90       !!         zjvt = ( ahmt + rn_ahm_b ) e1f * e3f / e2f  dj[ ub ] 
    91       !!               -  ahmt              e1f * mj-1(vslp) dk[ mj(mk(vb)) ] 
     88      !!         zivf = ( ahmf + rn_ahm_b ) e2t * e3t / e1t  di[ vv ] 
     89      !!               -  ahmf              e2t * mj(uslp)   dk[ mi(mk(vv)) ] 
     90      !!         zjvt = ( ahmt + rn_ahm_b ) e1f * e3f / e2f  dj[ vv ] 
     91      !!               -  ahmt              e1f * mj-1(vslp) dk[ mj(mk(vv)) ] 
    9292      !!      take the horizontal divergence of the fluxes: 
    9393      !!         diffu = 1/(e1u*e2u*e3u) {  di  [ ziut ] + dj-1[ zjuf ]  } 
    9494      !!         diffv = 1/(e1v*e2v*e3v) {  di-1[ zivf ] + dj  [ zjvt ]  } 
    95       !!      Add this trend to the general trend (ua,va): 
    96       !!         ua = ua + diffu 
     95      !!      Add this trend to the general trend (uu(rhs),vv(rhs)): 
     96      !!         uu(rhs) = uu(rhs) + diffu 
    9797      !!      CAUTION: here the isopycnal part is with a coeff. of aht. This 
    9898      !!      should be modified for applications others than orca_r2 (!!bug) 
    9999      !! 
    100100      !! ** Action : 
    101       !!       -(ua,va) updated with the before geopotential harmonic mixing trend 
     101      !!       -(puu(:,:,:,Krhs),pvv(:,:,:,Krhs)) updated with the before geopotential harmonic mixing trend 
    102102      !!       -(akzu,akzv) to accompt for the diagonal vertical component 
    103103      !!                    of the rotated operator in dynzdf module 
    104104      !!---------------------------------------------------------------------- 
    105       INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
     105      INTEGER                             , INTENT( in )  ::  kt               ! ocean time-step index 
     106      INTEGER                             , INTENT( in )  ::  Kbb, Kmm, Krhs   ! ocean time level indices 
     107      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv         ! ocean velocities and RHS of momentum equation 
    106108      ! 
    107109      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     
    125127      IF( ln_dynldf_hor .AND. ln_traldf_iso ) THEN 
    126128         ! 
    127          DO jk = 1, jpk         ! set the slopes of iso-level 
    128             DO jj = 2, jpjm1 
    129                DO ji = 2, jpim1 
    130                   uslp (ji,jj,jk) = - ( gdept_b(ji+1,jj,jk) - gdept_b(ji ,jj ,jk) ) * r1_e1u(ji,jj) * umask(ji,jj,jk) 
    131                   vslp (ji,jj,jk) = - ( gdept_b(ji,jj+1,jk) - gdept_b(ji ,jj ,jk) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk) 
    132                   wslpi(ji,jj,jk) = - ( gdepw_b(ji+1,jj,jk) - gdepw_b(ji-1,jj,jk) ) * r1_e1t(ji,jj) * tmask(ji,jj,jk) * 0.5 
    133                   wslpj(ji,jj,jk) = - ( gdepw_b(ji,jj+1,jk) - gdepw_b(ji,jj-1,jk) ) * r1_e2t(ji,jj) * tmask(ji,jj,jk) * 0.5 
    134                END DO 
    135             END DO 
    136          END DO 
     129         DO_3D_00_00( 1, jpk ) 
     130            uslp (ji,jj,jk) = - ( gdept(ji+1,jj,jk,Kbb) - gdept(ji ,jj ,jk,Kbb) ) * r1_e1u(ji,jj) * umask(ji,jj,jk) 
     131            vslp (ji,jj,jk) = - ( gdept(ji,jj+1,jk,Kbb) - gdept(ji ,jj ,jk,Kbb) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk) 
     132            wslpi(ji,jj,jk) = - ( gdepw(ji+1,jj,jk,Kbb) - gdepw(ji-1,jj,jk,Kbb) ) * r1_e1t(ji,jj) * tmask(ji,jj,jk) * 0.5 
     133            wslpj(ji,jj,jk) = - ( gdepw(ji,jj+1,jk,Kbb) - gdepw(ji,jj-1,jk,Kbb) ) * r1_e2t(ji,jj) * tmask(ji,jj,jk) * 0.5 
     134         END_3D 
    137135         ! Lateral boundary conditions on the slopes 
    138136         CALL lbc_lnk_multi( 'dynldf_iso', uslp , 'U', -1., vslp , 'V', -1., wslpi, 'W', -1., wslpj, 'W', -1. ) 
     
    151149         !                             zdkv(jk=1)=zdkv(jk=2) 
    152150 
    153          zdk1u(:,:) = ( ub(:,:,jk) -ub(:,:,jk+1) ) * umask(:,:,jk+1) 
    154          zdk1v(:,:) = ( vb(:,:,jk) -vb(:,:,jk+1) ) * vmask(:,:,jk+1) 
     151         zdk1u(:,:) = ( puu(:,:,jk,Kbb) -puu(:,:,jk+1,Kbb) ) * umask(:,:,jk+1) 
     152         zdk1v(:,:) = ( pvv(:,:,jk,Kbb) -pvv(:,:,jk+1,Kbb) ) * vmask(:,:,jk+1) 
    155153 
    156154         IF( jk == 1 ) THEN 
     
    158156            zdkv(:,:) = zdk1v(:,:) 
    159157         ELSE 
    160             zdku(:,:) = ( ub(:,:,jk-1) - ub(:,:,jk) ) * umask(:,:,jk) 
    161             zdkv(:,:) = ( vb(:,:,jk-1) - vb(:,:,jk) ) * vmask(:,:,jk) 
     158            zdku(:,:) = ( puu(:,:,jk-1,Kbb) - puu(:,:,jk,Kbb) ) * umask(:,:,jk) 
     159            zdkv(:,:) = ( pvv(:,:,jk-1,Kbb) - pvv(:,:,jk,Kbb) ) * vmask(:,:,jk) 
    162160         ENDIF 
    163161 
     
    169167 
    170168         IF( ln_zps ) THEN      ! z-coordinate - partial steps : min(e3u) 
    171             DO jj = 2, jpjm1 
    172                DO ji = fs_2, jpi   ! vector opt. 
    173                   zabe1 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e2t(ji,jj) * MIN( e3u_n(ji,jj,jk), e3u_n(ji-1,jj,jk) ) * r1_e1t(ji,jj) 
    174  
    175                   zmskt = 1._wp / MAX(   umask(ji-1,jj,jk  )+umask(ji,jj,jk+1)     & 
    176                      &                 + umask(ji-1,jj,jk+1)+umask(ji,jj,jk  ) , 1._wp ) 
    177  
    178                   zcof1 = - zaht_0 * e2t(ji,jj) * zmskt * 0.5  * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) ) 
    179     
    180                   ziut(ji,jj) = (  zabe1 * ( ub(ji,jj,jk) - ub(ji-1,jj,jk) )    & 
    181                      &           + zcof1 * ( zdku (ji,jj) + zdk1u(ji-1,jj)      & 
    182                      &                      +zdk1u(ji,jj) + zdku (ji-1,jj) )  ) * tmask(ji,jj,jk) 
    183                END DO 
    184             END DO 
     169            DO_2D_00_01 
     170               zabe1 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e2t(ji,jj) * MIN( e3u(ji,jj,jk,Kmm), e3u(ji-1,jj,jk,Kmm) ) * r1_e1t(ji,jj) 
     171 
     172               zmskt = 1._wp / MAX(   umask(ji-1,jj,jk  )+umask(ji,jj,jk+1)     & 
     173                  &                 + umask(ji-1,jj,jk+1)+umask(ji,jj,jk  ) , 1._wp ) 
     174 
     175               zcof1 = - zaht_0 * e2t(ji,jj) * zmskt * 0.5  * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) ) 
     176 
     177               ziut(ji,jj) = (  zabe1 * ( puu(ji,jj,jk,Kbb) - puu(ji-1,jj,jk,Kbb) )    & 
     178                  &           + zcof1 * ( zdku (ji,jj) + zdk1u(ji-1,jj)      & 
     179                  &                      +zdk1u(ji,jj) + zdku (ji-1,jj) )  ) * tmask(ji,jj,jk) 
     180            END_2D 
    185181         ELSE                   ! other coordinate system (zco or sco) : e3t 
    186             DO jj = 2, jpjm1 
    187                DO ji = fs_2, jpi   ! vector opt. 
    188                   zabe1 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e2t(ji,jj) * e3t_n(ji,jj,jk) * r1_e1t(ji,jj) 
    189  
    190                   zmskt = 1._wp / MAX(   umask(ji-1,jj,jk  ) + umask(ji,jj,jk+1)     & 
    191                      &                 + umask(ji-1,jj,jk+1) + umask(ji,jj,jk  ) , 1._wp ) 
    192  
    193                   zcof1 = - zaht_0 * e2t(ji,jj) * zmskt * 0.5  * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) ) 
    194  
    195                   ziut(ji,jj) = (  zabe1 * ( ub(ji,jj,jk) - ub(ji-1,jj,jk) )   & 
    196                      &           + zcof1 * ( zdku (ji,jj) + zdk1u(ji-1,jj)     & 
    197                      &                      +zdk1u(ji,jj) + zdku (ji-1,jj) )  ) * tmask(ji,jj,jk) 
    198                END DO 
    199             END DO 
     182            DO_2D_00_01 
     183               zabe1 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e2t(ji,jj) * e3t(ji,jj,jk,Kmm) * r1_e1t(ji,jj) 
     184 
     185               zmskt = 1._wp / MAX(   umask(ji-1,jj,jk  ) + umask(ji,jj,jk+1)     & 
     186                  &                 + umask(ji-1,jj,jk+1) + umask(ji,jj,jk  ) , 1._wp ) 
     187 
     188               zcof1 = - zaht_0 * e2t(ji,jj) * zmskt * 0.5  * ( uslp(ji-1,jj,jk) + uslp(ji,jj,jk) ) 
     189 
     190               ziut(ji,jj) = (  zabe1 * ( puu(ji,jj,jk,Kbb) - puu(ji-1,jj,jk,Kbb) )   & 
     191                  &           + zcof1 * ( zdku (ji,jj) + zdk1u(ji-1,jj)     & 
     192                  &                      +zdk1u(ji,jj) + zdku (ji-1,jj) )  ) * tmask(ji,jj,jk) 
     193            END_2D 
    200194         ENDIF 
    201195 
    202196         ! j-flux at f-point 
    203          DO jj = 1, jpjm1 
    204             DO ji = 1, fs_jpim1   ! vector opt. 
    205                zabe2 = ( ahmf(ji,jj,jk) + rn_ahm_b ) * e1f(ji,jj) * e3f_n(ji,jj,jk) * r1_e2f(ji,jj) 
    206  
    207                zmskf = 1._wp / MAX(   umask(ji,jj+1,jk  )+umask(ji,jj,jk+1)     & 
    208                   &                 + umask(ji,jj+1,jk+1)+umask(ji,jj,jk  ) , 1._wp ) 
    209  
    210                zcof2 = - zaht_0 * e1f(ji,jj) * zmskf * 0.5  * ( vslp(ji+1,jj,jk) + vslp(ji,jj,jk) ) 
    211  
    212                zjuf(ji,jj) = (  zabe2 * ( ub(ji,jj+1,jk) - ub(ji,jj,jk) )   & 
    213                   &           + zcof2 * ( zdku (ji,jj+1) + zdk1u(ji,jj)     & 
    214                   &                      +zdk1u(ji,jj+1) + zdku (ji,jj) )  ) * fmask(ji,jj,jk) 
    215             END DO 
    216          END DO 
     197         DO_2D_10_10 
     198            zabe2 = ( ahmf(ji,jj,jk) + rn_ahm_b ) * e1f(ji,jj) * e3f(ji,jj,jk) * r1_e2f(ji,jj) 
     199 
     200            zmskf = 1._wp / MAX(   umask(ji,jj+1,jk  )+umask(ji,jj,jk+1)     & 
     201               &                 + umask(ji,jj+1,jk+1)+umask(ji,jj,jk  ) , 1._wp ) 
     202 
     203            zcof2 = - zaht_0 * e1f(ji,jj) * zmskf * 0.5  * ( vslp(ji+1,jj,jk) + vslp(ji,jj,jk) ) 
     204 
     205            zjuf(ji,jj) = (  zabe2 * ( puu(ji,jj+1,jk,Kbb) - puu(ji,jj,jk,Kbb) )   & 
     206               &           + zcof2 * ( zdku (ji,jj+1) + zdk1u(ji,jj)     & 
     207               &                      +zdk1u(ji,jj+1) + zdku (ji,jj) )  ) * fmask(ji,jj,jk) 
     208         END_2D 
    217209 
    218210         !                                |   t   | 
     
    222214         ! i-flux at f-point              |   t   | 
    223215 
    224          DO jj = 2, jpjm1 
    225             DO ji = 1, fs_jpim1   ! vector opt. 
    226                zabe1 = ( ahmf(ji,jj,jk) + rn_ahm_b ) * e2f(ji,jj) * e3f_n(ji,jj,jk) * r1_e1f(ji,jj) 
    227  
    228                zmskf = 1._wp / MAX(  vmask(ji+1,jj,jk  )+vmask(ji,jj,jk+1)     & 
    229                   &                + vmask(ji+1,jj,jk+1)+vmask(ji,jj,jk  ) , 1._wp ) 
    230  
    231                zcof1 = - zaht_0 * e2f(ji,jj) * zmskf * 0.5 * ( uslp(ji,jj+1,jk) + uslp(ji,jj,jk) ) 
    232  
    233                zivf(ji,jj) = (  zabe1 * ( vb(ji+1,jj,jk) - vb(ji,jj,jk) )    & 
    234                   &           + zcof1 * (  zdkv (ji,jj) + zdk1v(ji+1,jj)      & 
    235                   &                      + zdk1v(ji,jj) + zdkv (ji+1,jj) )  ) * fmask(ji,jj,jk) 
    236             END DO 
    237          END DO 
     216         DO_2D_00_10 
     217            zabe1 = ( ahmf(ji,jj,jk) + rn_ahm_b ) * e2f(ji,jj) * e3f(ji,jj,jk) * r1_e1f(ji,jj) 
     218 
     219            zmskf = 1._wp / MAX(  vmask(ji+1,jj,jk  )+vmask(ji,jj,jk+1)     & 
     220               &                + vmask(ji+1,jj,jk+1)+vmask(ji,jj,jk  ) , 1._wp ) 
     221 
     222            zcof1 = - zaht_0 * e2f(ji,jj) * zmskf * 0.5 * ( uslp(ji,jj+1,jk) + uslp(ji,jj,jk) ) 
     223 
     224            zivf(ji,jj) = (  zabe1 * ( pvv(ji+1,jj,jk,Kbb) - pvv(ji,jj,jk,Kbb) )    & 
     225               &           + zcof1 * (  zdkv (ji,jj) + zdk1v(ji+1,jj)      & 
     226               &                      + zdk1v(ji,jj) + zdkv (ji+1,jj) )  ) * fmask(ji,jj,jk) 
     227         END_2D 
    238228 
    239229         ! j-flux at t-point 
    240230         IF( ln_zps ) THEN      ! z-coordinate - partial steps : min(e3u) 
    241             DO jj = 2, jpj 
    242                DO ji = 1, fs_jpim1   ! vector opt. 
    243                   zabe2 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e1t(ji,jj) * MIN( e3v_n(ji,jj,jk), e3v_n(ji,jj-1,jk) ) * r1_e2t(ji,jj) 
    244  
    245                   zmskt = 1._wp / MAX(  vmask(ji,jj-1,jk  )+vmask(ji,jj,jk+1)     & 
    246                      &                + vmask(ji,jj-1,jk+1)+vmask(ji,jj,jk  ) , 1._wp ) 
    247  
    248                   zcof2 = - zaht_0 * e1t(ji,jj) * zmskt * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) ) 
    249  
    250                   zjvt(ji,jj) = (  zabe2 * ( vb(ji,jj,jk) - vb(ji,jj-1,jk) )    & 
    251                      &           + zcof2 * ( zdkv (ji,jj-1) + zdk1v(ji,jj)      & 
    252                      &                      +zdk1v(ji,jj-1) + zdkv (ji,jj) )  ) * tmask(ji,jj,jk) 
    253                END DO 
    254             END DO 
     231            DO_2D_01_10 
     232               zabe2 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e1t(ji,jj) * MIN( e3v(ji,jj,jk,Kmm), e3v(ji,jj-1,jk,Kmm) ) * r1_e2t(ji,jj) 
     233 
     234               zmskt = 1._wp / MAX(  vmask(ji,jj-1,jk  )+vmask(ji,jj,jk+1)     & 
     235                  &                + vmask(ji,jj-1,jk+1)+vmask(ji,jj,jk  ) , 1._wp ) 
     236 
     237               zcof2 = - zaht_0 * e1t(ji,jj) * zmskt * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) ) 
     238 
     239               zjvt(ji,jj) = (  zabe2 * ( pvv(ji,jj,jk,Kbb) - pvv(ji,jj-1,jk,Kbb) )    & 
     240                  &           + zcof2 * ( zdkv (ji,jj-1) + zdk1v(ji,jj)      & 
     241                  &                      +zdk1v(ji,jj-1) + zdkv (ji,jj) )  ) * tmask(ji,jj,jk) 
     242            END_2D 
    255243         ELSE                   ! other coordinate system (zco or sco) : e3t 
    256             DO jj = 2, jpj 
    257                DO ji = 1, fs_jpim1   ! vector opt. 
    258                   zabe2 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e1t(ji,jj) * e3t_n(ji,jj,jk) * r1_e2t(ji,jj) 
    259  
    260                   zmskt = 1./MAX(  vmask(ji,jj-1,jk  )+vmask(ji,jj,jk+1)   & 
    261                      &           + vmask(ji,jj-1,jk+1)+vmask(ji,jj,jk  ), 1. ) 
    262  
    263                   zcof2 = - zaht_0 * e1t(ji,jj) * zmskt * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) ) 
    264  
    265                   zjvt(ji,jj) = (  zabe2 * ( vb(ji,jj,jk) - vb(ji,jj-1,jk) )   & 
    266                      &           + zcof2 * ( zdkv (ji,jj-1) + zdk1v(ji,jj)     & 
    267                      &                      +zdk1v(ji,jj-1) + zdkv (ji,jj) )  ) * tmask(ji,jj,jk) 
    268                END DO 
    269             END DO 
     244            DO_2D_01_10 
     245               zabe2 = ( ahmt(ji,jj,jk)+rn_ahm_b ) * e1t(ji,jj) * e3t(ji,jj,jk,Kmm) * r1_e2t(ji,jj) 
     246 
     247               zmskt = 1./MAX(  vmask(ji,jj-1,jk  )+vmask(ji,jj,jk+1)   & 
     248                  &           + vmask(ji,jj-1,jk+1)+vmask(ji,jj,jk  ), 1. ) 
     249 
     250               zcof2 = - zaht_0 * e1t(ji,jj) * zmskt * 0.5 * ( vslp(ji,jj-1,jk) + vslp(ji,jj,jk) ) 
     251 
     252               zjvt(ji,jj) = (  zabe2 * ( pvv(ji,jj,jk,Kbb) - pvv(ji,jj-1,jk,Kbb) )   & 
     253                  &           + zcof2 * ( zdkv (ji,jj-1) + zdk1v(ji,jj)     & 
     254                  &                      +zdk1v(ji,jj-1) + zdkv (ji,jj) )  ) * tmask(ji,jj,jk) 
     255            END_2D 
    270256         ENDIF 
    271257 
     
    273259         ! Second derivative (divergence) and add to the general trend 
    274260         ! ----------------------------------------------------------- 
    275          DO jj = 2, jpjm1 
    276             DO ji = 2, jpim1          !!gm Question vectop possible??? !!bug 
    277                ua(ji,jj,jk) = ua(ji,jj,jk) + (  ziut(ji+1,jj) - ziut(ji,jj  )    & 
    278                   &                           + zjuf(ji  ,jj) - zjuf(ji,jj-1)  ) * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk) 
    279                va(ji,jj,jk) = va(ji,jj,jk) + (  zivf(ji,jj  ) - zivf(ji-1,jj)    & 
    280                   &                           + zjvt(ji,jj+1) - zjvt(ji,jj  )  ) * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk) 
    281             END DO 
    282          END DO 
     261         DO_2D_00_00 
     262            puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + (  ziut(ji+1,jj) - ziut(ji,jj  )    & 
     263               &                           + zjuf(ji  ,jj) - zjuf(ji,jj-1)  ) * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm) 
     264            pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + (  zivf(ji,jj  ) - zivf(ji-1,jj)    & 
     265               &                           + zjvt(ji,jj+1) - zjvt(ji,jj  )  ) * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,Kmm) 
     266         END_2D 
    283267         !                                             ! =============== 
    284268      END DO                                           !   End of slab 
     
    286270 
    287271      ! print sum trends (used for debugging) 
    288       IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' ldfh - Ua: ', mask1=umask, & 
    289          &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
     272      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' ldfh - Ua: ', mask1=umask, & 
     273         &                                  tab3d_2=pvv(:,:,:,Krhs), clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    290274 
    291275 
     
    306290            DO ji = 2, jpi 
    307291               ! i-gradient of u at jj 
    308                zdiu (ji,jk) = tmask(ji,jj  ,jk) * ( ub(ji,jj  ,jk) - ub(ji-1,jj  ,jk) ) 
     292               zdiu (ji,jk) = tmask(ji,jj  ,jk) * ( puu(ji,jj  ,jk,Kbb) - puu(ji-1,jj  ,jk,Kbb) ) 
    309293               ! j-gradient of u and v at jj 
    310                zdju (ji,jk) = fmask(ji,jj  ,jk) * ( ub(ji,jj+1,jk) - ub(ji  ,jj  ,jk) ) 
    311                zdjv (ji,jk) = tmask(ji,jj  ,jk) * ( vb(ji,jj  ,jk) - vb(ji  ,jj-1,jk) ) 
     294               zdju (ji,jk) = fmask(ji,jj  ,jk) * ( puu(ji,jj+1,jk,Kbb) - puu(ji  ,jj  ,jk,Kbb) ) 
     295               zdjv (ji,jk) = tmask(ji,jj  ,jk) * ( pvv(ji,jj  ,jk,Kbb) - pvv(ji  ,jj-1,jk,Kbb) ) 
    312296               ! j-gradient of u and v at jj+1 
    313                zdj1u(ji,jk) = fmask(ji,jj-1,jk) * ( ub(ji,jj  ,jk) - ub(ji  ,jj-1,jk) ) 
    314                zdj1v(ji,jk) = tmask(ji,jj+1,jk) * ( vb(ji,jj+1,jk) - vb(ji  ,jj  ,jk) ) 
     297               zdj1u(ji,jk) = fmask(ji,jj-1,jk) * ( puu(ji,jj  ,jk,Kbb) - puu(ji  ,jj-1,jk,Kbb) ) 
     298               zdj1v(ji,jk) = tmask(ji,jj+1,jk) * ( pvv(ji,jj+1,jk,Kbb) - pvv(ji  ,jj  ,jk,Kbb) ) 
    315299            END DO 
    316300         END DO 
     
    318302            DO ji = 1, jpim1 
    319303               ! i-gradient of v at jj 
    320                zdiv (ji,jk) = fmask(ji,jj  ,jk) * ( vb(ji+1,jj,jk) - vb(ji  ,jj  ,jk) ) 
     304               zdiv (ji,jk) = fmask(ji,jj  ,jk) * ( pvv(ji+1,jj,jk,Kbb) - pvv(ji  ,jj  ,jk,Kbb) ) 
    321305            END DO 
    322306         END DO 
     
    391375         DO jk = 1, jpkm1 
    392376            DO ji = 2, jpim1 
    393                ua(ji,jj,jk) = ua(ji,jj,jk) + ( zfuw(ji,jk) - zfuw(ji,jk+1) ) * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk) 
    394                va(ji,jj,jk) = va(ji,jj,jk) + ( zfvw(ji,jk) - zfvw(ji,jk+1) ) * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk) 
     377               puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + ( zfuw(ji,jk) - zfuw(ji,jk+1) ) * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,Kmm) 
     378               pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + ( zfvw(ji,jk) - zfvw(ji,jk+1) ) * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,Kmm) 
    395379            END DO 
    396380         END DO 
  • NEMO/trunk/src/OCE/DYN/dynldf_lap_blp.F90

    r10425 r12377  
    2727 
    2828   !! * Substitutions 
    29 #  include "vectopt_loop_substitute.h90" 
     29#  include "do_loop_substitute.h90" 
    3030   !!---------------------------------------------------------------------- 
    3131   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    3535CONTAINS 
    3636 
    37    SUBROUTINE dyn_ldf_lap( kt, pub, pvb, pua, pva, kpass ) 
     37   SUBROUTINE dyn_ldf_lap( kt, Kbb, Kmm, pu, pv, pu_rhs, pv_rhs, kpass ) 
    3838      !!---------------------------------------------------------------------- 
    3939      !!                     ***  ROUTINE dyn_ldf_lap  *** 
     
    4545      !!      writen as :   grad_h( ahmt div_h(U )) - curl_h( ahmf curl_z(U) )  
    4646      !! 
    47       !! ** Action : - pua, pva increased by the harmonic operator applied on pub, pvb. 
     47      !! ** Action : - pu_rhs, pv_rhs increased by the harmonic operator applied on pu, pv. 
    4848      !!---------------------------------------------------------------------- 
    4949      INTEGER                         , INTENT(in   ) ::   kt         ! ocean time-step index 
     50      INTEGER                         , INTENT(in   ) ::   Kbb, Kmm   ! ocean time level indices 
    5051      INTEGER                         , INTENT(in   ) ::   kpass      ! =1/2 first or second passage 
    51       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pub, pvb   ! before velocity  [m/s] 
    52       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pua, pva   ! velocity trend   [m/s2] 
     52      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pu, pv     ! before velocity  [m/s] 
     53      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu_rhs, pv_rhs   ! velocity trend   [m/s2] 
    5354      ! 
    5455      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
     
    7172      DO jk = 1, jpkm1                                 ! Horizontal slab 
    7273         !                                             ! =============== 
    73          DO jj = 2, jpj 
    74             DO ji = fs_2, jpi   ! vector opt. 
    75                !                                      ! ahm * e3 * curl  (computed from 1 to jpim1/jpjm1) 
     74         DO_2D_01_01 
     75            !                                      ! ahm * e3 * curl  (computed from 1 to jpim1/jpjm1) 
    7676!!gm open question here : e3f  at before or now ?    probably now... 
    7777!!gm note that ahmf has already been multiplied by fmask 
    78                zcur(ji-1,jj-1) = ahmf(ji-1,jj-1,jk) * e3f_n(ji-1,jj-1,jk) * r1_e1e2f(ji-1,jj-1)       & 
    79                   &     * (  e2v(ji  ,jj-1) * pvb(ji  ,jj-1,jk) - e2v(ji-1,jj-1) * pvb(ji-1,jj-1,jk)  & 
    80                   &        - e1u(ji-1,jj  ) * pub(ji-1,jj  ,jk) + e1u(ji-1,jj-1) * pub(ji-1,jj-1,jk)  ) 
    81                !                                      ! ahm * div        (computed from 2 to jpi/jpj) 
     78            zcur(ji-1,jj-1) = ahmf(ji-1,jj-1,jk) * e3f(ji-1,jj-1,jk) * r1_e1e2f(ji-1,jj-1)       & 
     79               &     * (  e2v(ji  ,jj-1) * pv(ji  ,jj-1,jk) - e2v(ji-1,jj-1) * pv(ji-1,jj-1,jk)  & 
     80               &        - e1u(ji-1,jj  ) * pu(ji-1,jj  ,jk) + e1u(ji-1,jj-1) * pu(ji-1,jj-1,jk)  ) 
     81            !                                      ! ahm * div        (computed from 2 to jpi/jpj) 
    8282!!gm note that ahmt has already been multiplied by tmask 
    83                zdiv(ji,jj)     = ahmt(ji,jj,jk) * r1_e1e2t(ji,jj) / e3t_b(ji,jj,jk)                                         & 
    84                   &     * (  e2u(ji,jj)*e3u_b(ji,jj,jk) * pub(ji,jj,jk) - e2u(ji-1,jj)*e3u_b(ji-1,jj,jk) * pub(ji-1,jj,jk)  & 
    85                   &        + e1v(ji,jj)*e3v_b(ji,jj,jk) * pvb(ji,jj,jk) - e1v(ji,jj-1)*e3v_b(ji,jj-1,jk) * pvb(ji,jj-1,jk)  ) 
    86             END DO   
    87          END DO   
     83            zdiv(ji,jj)     = ahmt(ji,jj,jk) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kbb)                                         & 
     84               &     * (  e2u(ji,jj)*e3u(ji,jj,jk,Kbb) * pu(ji,jj,jk) - e2u(ji-1,jj)*e3u(ji-1,jj,jk,Kbb) * pu(ji-1,jj,jk)  & 
     85               &        + e1v(ji,jj)*e3v(ji,jj,jk,Kbb) * pv(ji,jj,jk) - e1v(ji,jj-1)*e3v(ji,jj-1,jk,Kbb) * pv(ji,jj-1,jk)  ) 
     86         END_2D 
    8887         ! 
    89          DO jj = 2, jpjm1                             ! - curl( curl) + grad( div ) 
    90             DO ji = fs_2, fs_jpim1   ! vector opt. 
    91                pua(ji,jj,jk) = pua(ji,jj,jk) + zsign * (                                                 & 
    92                   &              - ( zcur(ji  ,jj) - zcur(ji,jj-1) ) * r1_e2u(ji,jj) / e3u_n(ji,jj,jk)   & 
    93                   &              + ( zdiv(ji+1,jj) - zdiv(ji,jj  ) ) * r1_e1u(ji,jj)                     ) 
    94                   ! 
    95                pva(ji,jj,jk) = pva(ji,jj,jk) + zsign * (                                                 & 
    96                   &                ( zcur(ji,jj  ) - zcur(ji-1,jj) ) * r1_e1v(ji,jj) / e3v_n(ji,jj,jk)   & 
    97                   &              + ( zdiv(ji,jj+1) - zdiv(ji  ,jj) ) * r1_e2v(ji,jj)                     ) 
    98             END DO 
    99          END DO 
     88         DO_2D_00_00 
     89            pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zsign * (                                                 & 
     90               &              - ( zcur(ji  ,jj) - zcur(ji,jj-1) ) * r1_e2u(ji,jj) / e3u(ji,jj,jk,Kmm)   & 
     91               &              + ( zdiv(ji+1,jj) - zdiv(ji,jj  ) ) * r1_e1u(ji,jj)                     ) 
     92               ! 
     93            pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) + zsign * (                                                 & 
     94               &                ( zcur(ji,jj  ) - zcur(ji-1,jj) ) * r1_e1v(ji,jj) / e3v(ji,jj,jk,Kmm)   & 
     95               &              + ( zdiv(ji,jj+1) - zdiv(ji  ,jj) ) * r1_e2v(ji,jj)                     ) 
     96         END_2D 
    10097         !                                             ! =============== 
    10198      END DO                                           !   End of slab 
     
    105102 
    106103 
    107    SUBROUTINE dyn_ldf_blp( kt, pub, pvb, pua, pva ) 
     104   SUBROUTINE dyn_ldf_blp( kt, Kbb, Kmm, pu, pv, pu_rhs, pv_rhs ) 
    108105      !!---------------------------------------------------------------------- 
    109106      !!                 ***  ROUTINE dyn_ldf_blp  *** 
     
    116113      !!      It is computed by two successive calls to dyn_ldf_lap routine 
    117114      !! 
    118       !! ** Action :   pta   updated with the before rotated bilaplacian diffusion 
     115      !! ** Action :   pt(:,:,:,:,Krhs)   updated with the before rotated bilaplacian diffusion 
    119116      !!---------------------------------------------------------------------- 
    120117      INTEGER                         , INTENT(in   ) ::   kt         ! ocean time-step index 
    121       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pub, pvb   ! before velocity fields 
    122       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pua, pva   ! momentum trend 
     118      INTEGER                         , INTENT(in   ) ::   Kbb, Kmm   ! ocean time level indices 
     119      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pu, pv     ! before velocity fields 
     120      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu_rhs, pv_rhs   ! momentum trend 
    123121      ! 
    124122      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zulap, zvlap   ! laplacian at u- and v-point 
     
    134132      zvlap(:,:,:) = 0._wp 
    135133      ! 
    136       CALL dyn_ldf_lap( kt, pub, pvb, zulap, zvlap, 1 )   ! rotated laplacian applied to ptb (output in zlap) 
     134      CALL dyn_ldf_lap( kt, Kbb, Kmm, pu, pv, zulap, zvlap, 1 )   ! rotated laplacian applied to pt (output in zlap,Kbb) 
    137135      ! 
    138136      CALL lbc_lnk_multi( 'dynldf_lap_blp', zulap, 'U', -1., zvlap, 'V', -1. )             ! Lateral boundary conditions 
    139137      ! 
    140       CALL dyn_ldf_lap( kt, zulap, zvlap, pua, pva, 2 )   ! rotated laplacian applied to zlap (output in pta) 
     138      CALL dyn_ldf_lap( kt, Kbb, Kmm, zulap, zvlap, pu_rhs, pv_rhs, 2 )   ! rotated laplacian applied to zlap (output in pt(:,:,:,:,Krhs)) 
    141139      ! 
    142140   END SUBROUTINE dyn_ldf_blp 
  • NEMO/trunk/src/OCE/DYN/dynspg.F90

    r11536 r12377  
    2121   USE dynspg_exp     ! surface pressure gradient     (dyn_spg_exp routine) 
    2222   USE dynspg_ts      ! surface pressure gradient     (dyn_spg_ts  routine) 
    23    USE sbctide        !  
    24    USE updtide        !  
     23   USE tide_mod       ! 
    2524   USE trd_oce        ! trends: ocean variables 
    2625   USE trddyn         ! trend manager: dynamics 
     
    4342   INTEGER, PARAMETER ::   np_EXP = 0   !       explicit time stepping 
    4443   INTEGER, PARAMETER ::   np_NO  =-1   ! no surface pressure gradient, no scheme 
     44   ! 
     45   REAL(wp) ::   zt0step !   Time of day at the beginning of the time step 
    4546 
    4647   !! * Substitutions 
    47 #  include "vectopt_loop_substitute.h90" 
     48#  include "do_loop_substitute.h90" 
    4849   !!---------------------------------------------------------------------- 
    4950   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    5354CONTAINS 
    5455 
    55    SUBROUTINE dyn_spg( kt ) 
     56   SUBROUTINE dyn_spg( kt, Kbb, Kmm, Krhs, puu, pvv, pssh, puu_b, pvv_b, Kaa ) 
    5657      !!---------------------------------------------------------------------- 
    5758      !!                  ***  ROUTINE dyn_spg  *** 
     
    7172      !!             period is used to prevent the divergence of odd and even time step. 
    7273      !!---------------------------------------------------------------------- 
    73       INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     74      INTEGER                             , INTENT( in )  ::  kt                  ! ocean time-step index 
     75      INTEGER                             , INTENT( in )  ::  Kbb, Kmm, Krhs, Kaa ! ocean time level indices 
     76      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv            ! ocean velocities and RHS of momentum equation 
     77      REAL(wp), DIMENSION(jpi,jpj,jpt)    , INTENT(inout) ::  pssh, puu_b, pvv_b  ! SSH and barotropic velocities at main time levels 
    7478      ! 
    7579      INTEGER  ::   ji, jj, jk                   ! dummy loop indices 
     
    8387      IF( l_trddyn )   THEN                      ! temporary save of ta and sa trends 
    8488         ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) )  
    85          ztrdu(:,:,:) = ua(:,:,:) 
    86          ztrdv(:,:,:) = va(:,:,:) 
     89         ztrdu(:,:,:) = puu(:,:,:,Krhs) 
     90         ztrdv(:,:,:) = pvv(:,:,:,Krhs) 
    8791      ENDIF 
    8892      ! 
     
    9195         .OR.  ln_ice_embd ) THEN                                            ! embedded sea-ice 
    9296         ! 
    93          DO jj = 2, jpjm1 
    94             DO ji = fs_2, fs_jpim1   ! vector opt. 
    95                spgu(ji,jj) = 0._wp 
    96                spgv(ji,jj) = 0._wp 
    97             END DO 
    98          END DO          
     97         DO_2D_00_00 
     98            spgu(ji,jj) = 0._wp 
     99            spgv(ji,jj) = 0._wp 
     100         END_2D 
    99101         ! 
    100102         IF( ln_apr_dyn .AND. .NOT.ln_dynspg_ts ) THEN   !==  Atmospheric pressure gradient (added later in time-split case) ==! 
    101103            zg_2 = grav * 0.5 
    102             DO jj = 2, jpjm1                          ! gradient of Patm using inverse barometer ssh 
    103                DO ji = fs_2, fs_jpim1   ! vector opt. 
    104                   spgu(ji,jj) = spgu(ji,jj) + zg_2 * (  ssh_ib (ji+1,jj) - ssh_ib (ji,jj)    & 
    105                      &                                + ssh_ibb(ji+1,jj) - ssh_ibb(ji,jj)  ) * r1_e1u(ji,jj) 
    106                   spgv(ji,jj) = spgv(ji,jj) + zg_2 * (  ssh_ib (ji,jj+1) - ssh_ib (ji,jj)    & 
    107                      &                                + ssh_ibb(ji,jj+1) - ssh_ibb(ji,jj)  ) * r1_e2v(ji,jj) 
    108                END DO 
    109             END DO 
     104            DO_2D_00_00 
     105               spgu(ji,jj) = spgu(ji,jj) + zg_2 * (  ssh_ib (ji+1,jj) - ssh_ib (ji,jj)    & 
     106                  &                                + ssh_ibb(ji+1,jj) - ssh_ibb(ji,jj)  ) * r1_e1u(ji,jj) 
     107               spgv(ji,jj) = spgv(ji,jj) + zg_2 * (  ssh_ib (ji,jj+1) - ssh_ib (ji,jj)    & 
     108                  &                                + ssh_ibb(ji,jj+1) - ssh_ibb(ji,jj)  ) * r1_e2v(ji,jj) 
     109            END_2D 
    110110         ENDIF 
    111111         ! 
     
    113113         IF( .NOT.ln_dynspg_ts .AND. ( ln_tide_pot .AND. ln_tide )  ) THEN   ! N.B. added directly at sub-time-step in ts-case 
    114114            ! 
    115             CALL upd_tide( kt )                      ! update tide potential 
     115            ! Update tide potential at the beginning of current time step 
     116            zt0step = REAL(nsec_day, wp)-0.5_wp*rdt 
     117            CALL upd_tide(zt0step, Kmm) 
    116118            ! 
    117             DO jj = 2, jpjm1                         ! add tide potential forcing 
    118                DO ji = fs_2, fs_jpim1   ! vector opt. 
    119                   spgu(ji,jj) = spgu(ji,jj) + grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) * r1_e1u(ji,jj) 
    120                   spgv(ji,jj) = spgv(ji,jj) + grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) * r1_e2v(ji,jj) 
    121                END DO  
    122             END DO 
     119            DO_2D_00_00 
     120               spgu(ji,jj) = spgu(ji,jj) + grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) * r1_e1u(ji,jj) 
     121               spgv(ji,jj) = spgv(ji,jj) + grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) * r1_e2v(ji,jj) 
     122            END_2D 
    123123            ! 
    124124            IF (ln_scal_load) THEN 
    125125               zld = rn_scal_load * grav 
    126                DO jj = 2, jpjm1                    ! add scalar approximation for load potential 
    127                   DO ji = fs_2, fs_jpim1   ! vector opt. 
    128                      spgu(ji,jj) = spgu(ji,jj) + zld * ( sshn(ji+1,jj) - sshn(ji,jj) ) * r1_e1u(ji,jj) 
    129                      spgv(ji,jj) = spgv(ji,jj) + zld * ( sshn(ji,jj+1) - sshn(ji,jj) ) * r1_e2v(ji,jj) 
    130                   END DO  
    131                END DO 
     126               DO_2D_00_00 
     127                  spgu(ji,jj) = spgu(ji,jj) + zld * ( pssh(ji+1,jj,Kmm) - pssh(ji,jj,Kmm) ) * r1_e1u(ji,jj) 
     128                  spgv(ji,jj) = spgv(ji,jj) + zld * ( pssh(ji,jj+1,Kmm) - pssh(ji,jj,Kmm) ) * r1_e2v(ji,jj) 
     129               END_2D 
    132130            ENDIF 
    133131         ENDIF 
     
    138136            zgrau0r     = - grav * r1_rau0 
    139137            zpice(:,:) = (  zintp * snwice_mass(:,:) + ( 1.- zintp ) * snwice_mass_b(:,:)  ) * zgrau0r 
    140             DO jj = 2, jpjm1 
    141                DO ji = fs_2, fs_jpim1   ! vector opt. 
    142                   spgu(ji,jj) = spgu(ji,jj) + ( zpice(ji+1,jj) - zpice(ji,jj) ) * r1_e1u(ji,jj) 
    143                   spgv(ji,jj) = spgv(ji,jj) + ( zpice(ji,jj+1) - zpice(ji,jj) ) * r1_e2v(ji,jj) 
    144                END DO 
    145             END DO 
     138            DO_2D_00_00 
     139               spgu(ji,jj) = spgu(ji,jj) + ( zpice(ji+1,jj) - zpice(ji,jj) ) * r1_e1u(ji,jj) 
     140               spgv(ji,jj) = spgv(ji,jj) + ( zpice(ji,jj+1) - zpice(ji,jj) ) * r1_e2v(ji,jj) 
     141            END_2D 
    146142            DEALLOCATE( zpice )          
    147143         ENDIF 
    148144         ! 
    149          DO jk = 1, jpkm1                    !== Add all terms to the general trend 
    150             DO jj = 2, jpjm1 
    151                DO ji = fs_2, fs_jpim1   ! vector opt. 
    152                   ua(ji,jj,jk) = ua(ji,jj,jk) + spgu(ji,jj) 
    153                   va(ji,jj,jk) = va(ji,jj,jk) + spgv(ji,jj) 
    154                END DO 
    155             END DO 
    156          END DO     
     145         DO_3D_00_00( 1, jpkm1 ) 
     146            puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + spgu(ji,jj) 
     147            pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + spgv(ji,jj) 
     148         END_3D 
    157149         ! 
    158150!!gm add here a call to dyn_trd for ice pressure gradient, the surf pressure trends ???? 
     
    161153      ! 
    162154      SELECT CASE ( nspg )                   !== surface pressure gradient computed and add to the general trend ==! 
    163       CASE ( np_EXP )   ;   CALL dyn_spg_exp( kt )              ! explicit 
    164       CASE ( np_TS  )   ;   CALL dyn_spg_ts ( kt )              ! time-splitting 
     155      CASE ( np_EXP )   ;   CALL dyn_spg_exp( kt,      Kmm,       puu, pvv, Krhs )                    ! explicit 
     156      CASE ( np_TS  )   ;   CALL dyn_spg_ts ( kt, Kbb, Kmm, Krhs, puu, pvv, pssh, puu_b, pvv_b, Kaa ) ! time-splitting 
    165157      END SELECT 
    166158      !                     
    167159      IF( l_trddyn )   THEN                  ! save the surface pressure gradient trends for further diagnostics 
    168          ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
    169          ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    170          CALL trd_dyn( ztrdu, ztrdv, jpdyn_spg, kt ) 
     160         ztrdu(:,:,:) = puu(:,:,:,Krhs) - ztrdu(:,:,:) 
     161         ztrdv(:,:,:) = pvv(:,:,:,Krhs) - ztrdv(:,:,:) 
     162         CALL trd_dyn( ztrdu, ztrdv, jpdyn_spg, kt, Kmm ) 
    171163         DEALLOCATE( ztrdu , ztrdv )  
    172164      ENDIF 
    173165      !                                      ! print mean trends (used for debugging) 
    174       IF(ln_ctl)   CALL prt_ctl( tab3d_1=ua, clinfo1=' spg  - Ua: ', mask1=umask, & 
    175          &                       tab3d_2=va, clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
     166      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' spg  - Ua: ', mask1=umask, & 
     167         &                                  tab3d_2=pvv(:,:,:,Krhs), clinfo2=       ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    176168      ! 
    177169      IF( ln_timing )   CALL timing_stop('dyn_spg') 
     
    200192      ENDIF 
    201193      ! 
    202       REWIND( numnam_ref )              ! Namelist namdyn_spg in reference namelist : Free surface 
    203194      READ  ( numnam_ref, namdyn_spg, IOSTAT = ios, ERR = 901) 
    204195901   IF( ios /= 0 )   CALL ctl_nam ( ios , 'namdyn_spg in reference namelist' ) 
    205196      ! 
    206       REWIND( numnam_cfg )              ! Namelist namdyn_spg in configuration namelist : Free surface 
    207197      READ  ( numnam_cfg, namdyn_spg, IOSTAT = ios, ERR = 902 ) 
    208198902   IF( ios >  0 )   CALL ctl_nam ( ios , 'namdyn_spg in configuration namelist' ) 
  • NEMO/trunk/src/OCE/DYN/dynspg_exp.F90

    r10068 r12377  
    3030 
    3131   !! * Substitutions 
    32 #  include "vectopt_loop_substitute.h90" 
     32#  include "do_loop_substitute.h90" 
    3333   !!---------------------------------------------------------------------- 
    3434   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    3838CONTAINS 
    3939 
    40    SUBROUTINE dyn_spg_exp( kt ) 
     40   SUBROUTINE dyn_spg_exp( kt, Kmm, puu, pvv, Krhs ) 
    4141      !!---------------------------------------------------------------------- 
    4242      !!                  ***  routine dyn_spg_exp  *** 
     
    4848      !! ** Method  :   Explicit free surface formulation. Add to the general 
    4949      !!              momentum trend the surface pressure gradient : 
    50       !!                      (ua,va) = (ua,va) + (spgu,spgv) 
    51       !!              where spgu = -1/rau0 d/dx(ps) = -g/e1u di( sshn ) 
    52       !!                    spgv = -1/rau0 d/dy(ps) = -g/e2v dj( sshn ) 
     50      !!                      (uu(rhs),vv(rhs)) = (uu(rhs),vv(rhs)) + (spgu,spgv) 
     51      !!              where spgu = -1/rau0 d/dx(ps) = -g/e1u di( ssh(now) ) 
     52      !!                    spgv = -1/rau0 d/dy(ps) = -g/e2v dj( ssh(now) ) 
    5353      !! 
    54       !! ** Action :   (ua,va)   trend of horizontal velocity increased by  
     54      !! ** Action :   (puu(:,:,:,Krhs),pvv(:,:,:,Krhs))   trend of horizontal velocity increased by  
    5555      !!                         the surf. pressure gradient trend 
    5656      !!--------------------------------------------------------------------- 
    57       INTEGER, INTENT(in)  ::   kt   ! ocean time-step index 
     57      INTEGER                             , INTENT( in )  ::  kt        ! ocean time-step index 
     58      INTEGER                             , INTENT( in )  ::  Kmm, Krhs ! ocean time level indices 
     59      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv  ! ocean velocities and RHS of momentum equation 
    5860      !! 
    5961      INTEGER ::   ji, jj, jk   ! dummy loop indices 
     
    7274      IF( ln_linssh ) THEN          !* linear free surface : add the surface pressure gradient trend 
    7375         ! 
    74          DO jj = 2, jpjm1                    ! now surface pressure gradient 
    75             DO ji = fs_2, fs_jpim1   ! vector opt. 
    76                spgu(ji,jj) = - grav * ( sshn(ji+1,jj) - sshn(ji,jj) ) * r1_e1u(ji,jj) 
    77                spgv(ji,jj) = - grav * ( sshn(ji,jj+1) - sshn(ji,jj) ) * r1_e2v(ji,jj) 
    78             END DO  
    79          END DO 
     76         DO_2D_00_00 
     77            spgu(ji,jj) = - grav * ( ssh(ji+1,jj,Kmm) - ssh(ji,jj,Kmm) ) * r1_e1u(ji,jj) 
     78            spgv(ji,jj) = - grav * ( ssh(ji,jj+1,Kmm) - ssh(ji,jj,Kmm) ) * r1_e2v(ji,jj) 
     79         END_2D 
    8080         ! 
    81          DO jk = 1, jpkm1                    ! Add it to the general trend 
    82             DO jj = 2, jpjm1 
    83                DO ji = fs_2, fs_jpim1   ! vector opt. 
    84                   ua(ji,jj,jk) = ua(ji,jj,jk) + spgu(ji,jj) 
    85                   va(ji,jj,jk) = va(ji,jj,jk) + spgv(ji,jj) 
    86                END DO 
    87             END DO 
    88          END DO 
     81         DO_3D_00_00( 1, jpkm1 ) 
     82            puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) + spgu(ji,jj) 
     83            pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) + spgv(ji,jj) 
     84         END_3D 
    8985         ! 
    9086      ENDIF 
  • NEMO/trunk/src/OCE/DYN/dynspg_ts.F90

    r12206 r12377  
    11MODULE dynspg_ts 
    22 
    3    !! Includes ROMS wd scheme with diagnostic outputs ; un and ua updates are commented out !  
     3   !! Includes ROMS wd scheme with diagnostic outputs ; puu(:,:,:,Kmm) and puu(:,:,:,Krhs) updates are commented out !  
    44 
    55   !!====================================================================== 
     
    3131   USE dom_oce         ! ocean space and time domain 
    3232   USE sbc_oce         ! surface boundary condition: ocean 
     33   USE isf_oce         ! ice shelf variable (fwfisf) 
    3334   USE zdf_oce         ! vertical physics: variables 
    3435   USE zdfdrg          ! vertical physics: top/bottom drag coef. 
    35    USE sbcisf          ! ice shelf variable (fwfisf) 
    3636   USE sbcapr          ! surface boundary condition: atmospheric pressure 
    3737   USE dynadv    , ONLY: ln_dynadv_vec 
     
    4444   USE bdytides        ! open boundary condition data 
    4545   USE bdydyn2d        ! open boundary conditions on barotropic variables 
    46    USE sbctide         ! tides 
    47    USE updtide         ! tide potential 
     46   USE tide_mod        ! 
    4847   USE sbcwave         ! surface wave 
    4948#if defined key_agrif 
     
    8786 
    8887   !! * Substitutions 
    89 #  include "vectopt_loop_substitute.h90" 
     88#  include "do_loop_substitute.h90" 
    9089   !!---------------------------------------------------------------------- 
    9190   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
     
    117116 
    118117 
    119    SUBROUTINE dyn_spg_ts( kt ) 
     118   SUBROUTINE dyn_spg_ts( kt, Kbb, Kmm, Krhs, puu, pvv, pssh, puu_b, pvv_b, Kaa ) 
    120119      !!---------------------------------------------------------------------- 
    121120      !! 
     
    132131      !! 
    133132      !! ** Action : 
    134       !!      -Update the filtered free surface at step "n+1"      : ssha 
    135       !!      -Update filtered barotropic velocities at step "n+1" : ua_b, va_b 
     133      !!      -Update the filtered free surface at step "n+1"      : pssh(:,:,Kaa) 
     134      !!      -Update filtered barotropic velocities at step "n+1" : puu_b(:,:,:,Kaa), vv_b(:,:,:,Kaa) 
    136135      !!      -Compute barotropic advective fluxes at step "n"     : un_adv, vn_adv 
    137136      !!      These are used to advect tracers and are compliant with discrete 
    138137      !!      continuity equation taken at the baroclinic time steps. This  
    139138      !!      ensures tracers conservation. 
    140       !!      - (ua, va) momentum trend updated with barotropic component. 
     139      !!      - (puu(:,:,:,Krhs), pvv(:,:,:,Krhs)) momentum trend updated with barotropic component. 
    141140      !! 
    142141      !! References : Shchepetkin and McWilliams, Ocean Modelling, 2005.  
    143142      !!--------------------------------------------------------------------- 
    144       INTEGER, INTENT(in)  ::   kt   ! ocean time-step index 
     143      INTEGER                             , INTENT( in )  ::  kt                  ! ocean time-step index 
     144      INTEGER                             , INTENT( in )  ::  Kbb, Kmm, Krhs, Kaa ! ocean time level indices 
     145      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv            ! ocean velocities and RHS of momentum equation 
     146      REAL(wp), DIMENSION(jpi,jpj,jpt)    , INTENT(inout) ::  pssh, puu_b, pvv_b  ! SSH and barotropic velocities at main time levels 
    145147      ! 
    146148      INTEGER  ::   ji, jj, jk, jn        ! dummy loop indices 
     
    168170      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: ztwdmask, zuwdmask, zvwdmask ! ROMS wetting and drying masks at t,u,v points 
    169171      REAL(wp), ALLOCATABLE, DIMENSION(:,:) :: zuwdav2, zvwdav2    ! averages over the sub-steps of zuwdmask and zvwdmask 
     172      REAL(wp) ::   zt0substep !   Time of day at the beginning of the time substep 
    170173      !!---------------------------------------------------------------------- 
    171174      ! 
     
    223226      !                                   !=  zu_frc =  1/H e3*d/dt(Ua)  =!  (Vertical mean of Ua, the 3D trends) 
    224227      !                                   !  ---------------------------  ! 
    225       zu_frc(:,:) = SUM( e3u_n(:,:,:) * ua(:,:,:) * umask(:,:,:) , DIM=3 ) * r1_hu_n(:,:) 
    226       zv_frc(:,:) = SUM( e3v_n(:,:,:) * va(:,:,:) * vmask(:,:,:) , DIM=3 ) * r1_hv_n(:,:) 
    227       ! 
    228       ! 
    229       !                                   !=  Ua => baroclinic trend  =!   (remove its vertical mean) 
    230       DO jk = 1, jpkm1                    !  ------------------------  ! 
    231          ua(:,:,jk) = ( ua(:,:,jk) - zu_frc(:,:) ) * umask(:,:,jk) 
    232          va(:,:,jk) = ( va(:,:,jk) - zv_frc(:,:) ) * vmask(:,:,jk) 
     228      zu_frc(:,:) = SUM( e3u(:,:,:,Kmm) * uu(:,:,:,Krhs) * umask(:,:,:) , DIM=3 ) * r1_hu(:,:,Kmm) 
     229      zv_frc(:,:) = SUM( e3v(:,:,:,Kmm) * vv(:,:,:,Krhs) * vmask(:,:,:) , DIM=3 ) * r1_hv(:,:,Kmm) 
     230      ! 
     231      ! 
     232      !                                   !=  U(Krhs) => baroclinic trend  =!   (remove its vertical mean) 
     233      DO jk = 1, jpkm1                    !  -----------------------------  ! 
     234         uu(:,:,jk,Krhs) = ( uu(:,:,jk,Krhs) - zu_frc(:,:) ) * umask(:,:,jk) 
     235         vv(:,:,jk,Krhs) = ( vv(:,:,jk,Krhs) - zv_frc(:,:) ) * vmask(:,:,jk) 
    233236      END DO 
    234237       
     
    239242      !                                   !  -------------------------------------------------  ! 
    240243      ! 
    241       IF( kt == nit000 .OR. .NOT. ln_linssh )   CALL dyn_cor_2D_init   ! Set zwz, the barotropic Coriolis force coefficient 
     244      IF( kt == nit000 .OR. .NOT. ln_linssh )   CALL dyn_cor_2D_init( Kmm )   ! Set zwz, the barotropic Coriolis force coefficient 
    242245      !       ! recompute zwz = f/depth  at every time step for (.NOT.ln_linssh) as the water colomn height changes 
    243246      ! 
    244247      !                                         !* 2D Coriolis trends 
    245       zhU(:,:) = un_b(:,:) * hu_n(:,:) * e2u(:,:)        ! now fluxes  
    246       zhV(:,:) = vn_b(:,:) * hv_n(:,:) * e1v(:,:)        ! NB: FULL domain : put a value in last row and column 
    247       ! 
    248       CALL dyn_cor_2d( hu_n, hv_n, un_b, vn_b, zhU, zhV,  &   ! <<== in 
    249          &                               zu_trd, zv_trd   )   ! ==>> out 
     248      zhU(:,:) = puu_b(:,:,Kmm) * hu(:,:,Kmm) * e2u(:,:)        ! now fluxes  
     249      zhV(:,:) = pvv_b(:,:,Kmm) * hv(:,:,Kmm) * e1v(:,:)        ! NB: FULL domain : put a value in last row and column 
     250      ! 
     251      CALL dyn_cor_2d( hu(:,:,Kmm), hv(:,:,Kmm), puu_b(:,:,Kmm), pvv_b(:,:,Kmm), zhU, zhV,  &   ! <<== in 
     252         &                                                                     zu_trd, zv_trd   )   ! ==>> out 
    250253      ! 
    251254      IF( .NOT.ln_linssh ) THEN                 !* surface pressure gradient   (variable volume only) 
    252255         ! 
    253256         IF( ln_wd_il ) THEN                       ! W/D : limiter applied to spgspg 
    254             CALL wad_spg( sshn, zcpx, zcpy )          ! Calculating W/D gravity filters, zcpx and zcpy 
    255             DO jj = 2, jpjm1 
    256                DO ji = 2, jpim1                ! SPG with the application of W/D gravity filters 
    257                   zu_trd(ji,jj) = zu_trd(ji,jj) - grav * ( sshn(ji+1,jj  ) - sshn(ji  ,jj ) )   & 
    258                      &                          * r1_e1u(ji,jj) * zcpx(ji,jj)  * wdrampu(ji,jj)  !jth 
    259                   zv_trd(ji,jj) = zv_trd(ji,jj) - grav * ( sshn(ji  ,jj+1) - sshn(ji  ,jj ) )   & 
    260                      &                          * r1_e2v(ji,jj) * zcpy(ji,jj)  * wdrampv(ji,jj)  !jth 
    261                END DO 
    262             END DO 
     257            CALL wad_spg( pssh(:,:,Kmm), zcpx, zcpy )          ! Calculating W/D gravity filters, zcpx and zcpy 
     258            DO_2D_00_00 
     259               zu_trd(ji,jj) = zu_trd(ji,jj) - grav * ( pssh(ji+1,jj  ,Kmm) - pssh(ji  ,jj ,Kmm) )   & 
     260                  &                          * r1_e1u(ji,jj) * zcpx(ji,jj)  * wdrampu(ji,jj)  !jth 
     261               zv_trd(ji,jj) = zv_trd(ji,jj) - grav * ( pssh(ji  ,jj+1,Kmm) - pssh(ji  ,jj ,Kmm) )   & 
     262                  &                          * r1_e2v(ji,jj) * zcpy(ji,jj)  * wdrampv(ji,jj)  !jth 
     263            END_2D 
    263264         ELSE                                      ! now suface pressure gradient 
    264             DO jj = 2, jpjm1 
    265                DO ji = fs_2, fs_jpim1   ! vector opt. 
    266                   zu_trd(ji,jj) = zu_trd(ji,jj) - grav * (  sshn(ji+1,jj  ) - sshn(ji  ,jj  )  ) * r1_e1u(ji,jj) 
    267                   zv_trd(ji,jj) = zv_trd(ji,jj) - grav * (  sshn(ji  ,jj+1) - sshn(ji  ,jj  )  ) * r1_e2v(ji,jj)  
    268                END DO 
    269             END DO 
    270          ENDIF 
    271          ! 
    272       ENDIF 
    273       ! 
    274       DO jj = 2, jpjm1                          ! Remove coriolis term (and possibly spg) from barotropic trend 
    275          DO ji = fs_2, fs_jpim1 
    276              zu_frc(ji,jj) = zu_frc(ji,jj) - zu_trd(ji,jj) * ssumask(ji,jj) 
    277              zv_frc(ji,jj) = zv_frc(ji,jj) - zv_trd(ji,jj) * ssvmask(ji,jj) 
    278           END DO 
    279       END DO  
     265            DO_2D_00_00 
     266               zu_trd(ji,jj) = zu_trd(ji,jj) - grav * (  pssh(ji+1,jj  ,Kmm) - pssh(ji  ,jj  ,Kmm)  ) * r1_e1u(ji,jj) 
     267               zv_trd(ji,jj) = zv_trd(ji,jj) - grav * (  pssh(ji  ,jj+1,Kmm) - pssh(ji  ,jj  ,Kmm)  ) * r1_e2v(ji,jj)  
     268            END_2D 
     269         ENDIF 
     270         ! 
     271      ENDIF 
     272      ! 
     273      DO_2D_00_00 
     274          zu_frc(ji,jj) = zu_frc(ji,jj) - zu_trd(ji,jj) * ssumask(ji,jj) 
     275          zv_frc(ji,jj) = zv_frc(ji,jj) - zv_trd(ji,jj) * ssvmask(ji,jj) 
     276      END_2D 
    280277      ! 
    281278      !                                   !=  Add bottom stress contribution from baroclinic velocities  =! 
    282279      !                                   !  -----------------------------------------------------------  ! 
    283       CALL dyn_drg_init( zu_frc, zv_frc,  zCdU_u, zCdU_v )      ! also provide the barotropic drag coefficients 
    284       ! 
     280      CALL dyn_drg_init( Kbb, Kmm, puu, pvv, puu_b ,pvv_b, zu_frc, zv_frc,  zCdU_u, zCdU_v )      ! also provide the barotropic drag coefficients 
    285281      !                                   !=  Add atmospheric pressure forcing  =! 
    286282      !                                   !  ----------------------------------  ! 
    287283      IF( ln_apr_dyn ) THEN 
    288284         IF( ln_bt_fw ) THEN                          ! FORWARD integration: use kt+1/2 pressure (NOW+1/2) 
    289             DO jj = 2, jpjm1               
    290                DO ji = fs_2, fs_jpim1   ! vector opt. 
    291                   zu_frc(ji,jj) = zu_frc(ji,jj) + grav * (  ssh_ib (ji+1,jj  ) - ssh_ib (ji,jj) ) * r1_e1u(ji,jj) 
    292                   zv_frc(ji,jj) = zv_frc(ji,jj) + grav * (  ssh_ib (ji  ,jj+1) - ssh_ib (ji,jj) ) * r1_e2v(ji,jj) 
    293                END DO 
    294             END DO 
     285            DO_2D_00_00 
     286               zu_frc(ji,jj) = zu_frc(ji,jj) + grav * (  ssh_ib (ji+1,jj  ) - ssh_ib (ji,jj) ) * r1_e1u(ji,jj) 
     287               zv_frc(ji,jj) = zv_frc(ji,jj) + grav * (  ssh_ib (ji  ,jj+1) - ssh_ib (ji,jj) ) * r1_e2v(ji,jj) 
     288            END_2D 
    295289         ELSE                                         ! CENTRED integration: use kt-1/2 + kt+1/2 pressure (NOW) 
    296290            zztmp = grav * r1_2 
    297             DO jj = 2, jpjm1               
    298                DO ji = fs_2, fs_jpim1   ! vector opt. 
    299                   zu_frc(ji,jj) = zu_frc(ji,jj) + zztmp * (  ssh_ib (ji+1,jj  ) - ssh_ib (ji,jj)  & 
    300                        &                                   + ssh_ibb(ji+1,jj  ) - ssh_ibb(ji,jj)  ) * r1_e1u(ji,jj) 
    301                   zv_frc(ji,jj) = zv_frc(ji,jj) + zztmp * (  ssh_ib (ji  ,jj+1) - ssh_ib (ji,jj)  & 
    302                        &                                   + ssh_ibb(ji  ,jj+1) - ssh_ibb(ji,jj)  ) * r1_e2v(ji,jj) 
    303                END DO 
    304             END DO 
    305          ENDIF  
     291            DO_2D_00_00 
     292               zu_frc(ji,jj) = zu_frc(ji,jj) + zztmp * (  ssh_ib (ji+1,jj  ) - ssh_ib (ji,jj)  & 
     293                    &                                   + ssh_ibb(ji+1,jj  ) - ssh_ibb(ji,jj)  ) * r1_e1u(ji,jj) 
     294               zv_frc(ji,jj) = zv_frc(ji,jj) + zztmp * (  ssh_ib (ji  ,jj+1) - ssh_ib (ji,jj)  & 
     295                    &                                   + ssh_ibb(ji  ,jj+1) - ssh_ibb(ji,jj)  ) * r1_e2v(ji,jj) 
     296            END_2D 
     297         ENDIF 
    306298      ENDIF 
    307299      ! 
     
    309301      !                                   !  ----------------------------------  ! 
    310302      IF( ln_bt_fw ) THEN                        ! Add wind forcing 
    311          DO jj = 2, jpjm1 
    312             DO ji = fs_2, fs_jpim1   ! vector opt. 
    313                zu_frc(ji,jj) =  zu_frc(ji,jj) + r1_rau0 * utau(ji,jj) * r1_hu_n(ji,jj) 
    314                zv_frc(ji,jj) =  zv_frc(ji,jj) + r1_rau0 * vtau(ji,jj) * r1_hv_n(ji,jj) 
    315             END DO 
    316          END DO 
     303         DO_2D_00_00 
     304            zu_frc(ji,jj) =  zu_frc(ji,jj) + r1_rau0 * utau(ji,jj) * r1_hu(ji,jj,Kmm) 
     305            zv_frc(ji,jj) =  zv_frc(ji,jj) + r1_rau0 * vtau(ji,jj) * r1_hv(ji,jj,Kmm) 
     306         END_2D 
    317307      ELSE 
    318308         zztmp = r1_rau0 * r1_2 
    319          DO jj = 2, jpjm1 
    320             DO ji = fs_2, fs_jpim1   ! vector opt. 
    321                zu_frc(ji,jj) =  zu_frc(ji,jj) + zztmp * ( utau_b(ji,jj) + utau(ji,jj) ) * r1_hu_n(ji,jj) 
    322                zv_frc(ji,jj) =  zv_frc(ji,jj) + zztmp * ( vtau_b(ji,jj) + vtau(ji,jj) ) * r1_hv_n(ji,jj) 
    323             END DO 
    324          END DO 
     309         DO_2D_00_00 
     310            zu_frc(ji,jj) =  zu_frc(ji,jj) + zztmp * ( utau_b(ji,jj) + utau(ji,jj) ) * r1_hu(ji,jj,Kmm) 
     311            zv_frc(ji,jj) =  zv_frc(ji,jj) + zztmp * ( vtau_b(ji,jj) + vtau(ji,jj) ) * r1_hv(ji,jj,Kmm) 
     312         END_2D 
    325313      ENDIF   
    326314      ! 
     
    331319      !                                   ! ---------------------------------------------------  ! 
    332320      IF (ln_bt_fw) THEN                          ! FORWARD integration: use kt+1/2 fluxes (NOW+1/2) 
    333          zssh_frc(:,:) = r1_rau0 * ( emp(:,:)             - rnf(:,:)              + fwfisf(:,:)                  ) 
     321         zssh_frc(:,:) = r1_rau0 * ( emp(:,:) - rnf(:,:) + fwfisf_cav(:,:) + fwfisf_par(:,:) ) 
    334322      ELSE                                        ! CENTRED integration: use kt-1/2 + kt+1/2 fluxes (NOW) 
    335323         zztmp = r1_rau0 * r1_2 
    336          zssh_frc(:,:) = zztmp * (  emp(:,:) + emp_b(:,:) - rnf(:,:) - rnf_b(:,:) + fwfisf(:,:) + fwfisf_b(:,:)  ) 
     324         zssh_frc(:,:) = zztmp * (  emp(:,:)        + emp_b(:,:)                    & 
     325                &                 - rnf(:,:)        - rnf_b(:,:)                    & 
     326                &                 + fwfisf_cav(:,:) + fwfisf_cav_b(:,:)             & 
     327                &                 + fwfisf_par(:,:) + fwfisf_par_b(:,:)             ) 
    337328      ENDIF 
    338329      !                                   !=  Add Stokes drift divergence  =!   (if exist) 
     
    340331         zssh_frc(:,:) = zssh_frc(:,:) + div_sd(:,:) 
    341332      ENDIF 
     333      ! 
     334      !                                         ! ice sheet coupling 
     335      IF ( ln_isf .AND. ln_isfcpl ) THEN 
     336         ! 
     337         ! ice sheet coupling 
     338         IF( ln_rstart .AND. kt == nit000 ) THEN 
     339            zssh_frc(:,:) = zssh_frc(:,:) + risfcpl_ssh(:,:) 
     340         END IF 
     341         ! 
     342         ! conservation option 
     343         IF( ln_isfcpl_cons ) THEN 
     344            zssh_frc(:,:) = zssh_frc(:,:) + risfcpl_cons_ssh(:,:) 
     345         END IF 
     346         ! 
     347      END IF 
    342348      ! 
    343349#if defined key_asminc 
     
    372378      ! 
    373379      IF( ln_linssh ) THEN    ! mid-step ocean depth is fixed (hup2_e=hu_n=hu_0) 
    374          zhup2_e(:,:) = hu_n(:,:) 
    375          zhvp2_e(:,:) = hv_n(:,:) 
    376          zhtp2_e(:,:) = ht_n(:,:) 
     380         zhup2_e(:,:) = hu(:,:,Kmm) 
     381         zhvp2_e(:,:) = hv(:,:,Kmm) 
     382         zhtp2_e(:,:) = ht(:,:) 
    377383      ENDIF 
    378384      ! 
    379385      IF (ln_bt_fw) THEN                  ! FORWARD integration: start from NOW fields                     
    380          sshn_e(:,:) =    sshn(:,:)             
    381          un_e  (:,:) =    un_b(:,:)             
    382          vn_e  (:,:) =    vn_b(:,:) 
    383          ! 
    384          hu_e  (:,:) =    hu_n(:,:)        
    385          hv_e  (:,:) =    hv_n(:,:)  
    386          hur_e (:,:) = r1_hu_n(:,:)     
    387          hvr_e (:,:) = r1_hv_n(:,:) 
     386         sshn_e(:,:) =    pssh(:,:,Kmm)             
     387         un_e  (:,:) =    puu_b(:,:,Kmm)             
     388         vn_e  (:,:) =    pvv_b(:,:,Kmm) 
     389         ! 
     390         hu_e  (:,:) =    hu(:,:,Kmm)        
     391         hv_e  (:,:) =    hv(:,:,Kmm)  
     392         hur_e (:,:) = r1_hu(:,:,Kmm)     
     393         hvr_e (:,:) = r1_hv(:,:,Kmm) 
    388394      ELSE                                ! CENTRED integration: start from BEFORE fields 
    389          sshn_e(:,:) =    sshb(:,:) 
    390          un_e  (:,:) =    ub_b(:,:)          
    391          vn_e  (:,:) =    vb_b(:,:) 
    392          ! 
    393          hu_e  (:,:) =    hu_b(:,:)        
    394          hv_e  (:,:) =    hv_b(:,:)  
    395          hur_e (:,:) = r1_hu_b(:,:)     
    396          hvr_e (:,:) = r1_hv_b(:,:) 
     395         sshn_e(:,:) =    pssh(:,:,Kbb) 
     396         un_e  (:,:) =    puu_b(:,:,Kbb)          
     397         vn_e  (:,:) =    pvv_b(:,:,Kbb) 
     398         ! 
     399         hu_e  (:,:) =    hu(:,:,Kbb)        
     400         hv_e  (:,:) =    hv(:,:,Kbb)  
     401         hur_e (:,:) = r1_hu(:,:,Kbb)     
     402         hvr_e (:,:) = r1_hv(:,:,Kbb) 
    397403      ENDIF 
    398404      ! 
    399405      ! Initialize sums: 
    400       ua_b  (:,:) = 0._wp       ! After barotropic velocities (or transport if flux form)           
    401       va_b  (:,:) = 0._wp 
    402       ssha  (:,:) = 0._wp       ! Sum for after averaged sea level 
     406      puu_b  (:,:,Kaa) = 0._wp       ! After barotropic velocities (or transport if flux form)           
     407      pvv_b  (:,:,Kaa) = 0._wp 
     408      pssh  (:,:,Kaa) = 0._wp       ! Sum for after averaged sea level 
    403409      un_adv(:,:) = 0._wp       ! Sum for now transport issued from ts loop 
    404410      vn_adv(:,:) = 0._wp 
     
    419425         !                    !==  Update the forcing ==! (BDY and tides) 
    420426         ! 
    421          IF( ln_bdy      .AND. ln_tide )   CALL bdy_dta_tides( kt, kit=jn, kt_offset= noffset+1 ) 
    422          IF( ln_tide_pot .AND. ln_tide )   CALL upd_tide     ( kt, kit=jn, kt_offset= noffset   ) 
     427         IF( ln_bdy      .AND. ln_tide )   CALL bdy_dta_tides( kt, kit=jn, pt_offset= REAL(noffset+1,wp) ) 
     428         ! Update tide potential at the beginning of current time substep 
     429         IF( ln_tide_pot .AND. ln_tide ) THEN 
     430            zt0substep = REAL(nsec_day, wp) - 0.5_wp*rdt + (jn + noffset - 1) * rdt / REAL(nn_baro, wp) 
     431            CALL upd_tide(zt0substep, Kmm) 
     432         END IF 
    423433         ! 
    424434         !                    !==  extrapolation at mid-step  ==!   (jn+1/2) 
     
    457467            ! 
    458468            !                          ! ocean u- and v-depth at mid-step   (separate DO-loops remove the need of a lbc_lnk) 
    459             DO jj = 1, jpj 
    460                DO ji = 1, jpim1   ! not jpi-column 
    461                   zhup2_e(ji,jj) = hu_0(ji,jj) + r1_2 * r1_e1e2u(ji,jj)                        & 
    462                        &                              * (  e1e2t(ji  ,jj) * zsshp2_e(ji  ,jj)  & 
    463                        &                                 + e1e2t(ji+1,jj) * zsshp2_e(ji+1,jj)  ) * ssumask(ji,jj) 
    464                END DO 
    465             END DO 
    466             DO jj = 1, jpjm1        ! not jpj-row 
    467                DO ji = 1, jpi 
    468                   zhvp2_e(ji,jj) = hv_0(ji,jj) + r1_2 * r1_e1e2v(ji,jj)                        & 
    469                        &                              * (  e1e2t(ji,jj  ) * zsshp2_e(ji,jj  )  & 
    470                        &                                 + e1e2t(ji,jj+1) * zsshp2_e(ji,jj+1)  ) * ssvmask(ji,jj) 
    471                END DO 
    472             END DO 
     469            DO_2D_11_10 
     470               zhup2_e(ji,jj) = hu_0(ji,jj) + r1_2 * r1_e1e2u(ji,jj)                        & 
     471                    &                              * (  e1e2t(ji  ,jj) * zsshp2_e(ji  ,jj)  & 
     472                    &                                 + e1e2t(ji+1,jj) * zsshp2_e(ji+1,jj)  ) * ssumask(ji,jj) 
     473            END_2D 
     474            DO_2D_10_11 
     475               zhvp2_e(ji,jj) = hv_0(ji,jj) + r1_2 * r1_e1e2v(ji,jj)                        & 
     476                    &                              * (  e1e2t(ji,jj  ) * zsshp2_e(ji,jj  )  & 
     477                    &                                 + e1e2t(ji,jj+1) * zsshp2_e(ji,jj+1)  ) * ssvmask(ji,jj) 
     478            END_2D 
    473479            ! 
    474480         ENDIF 
     
    479485         !                             ! values of zhup2_e and zhvp2_e on the halo are not needed in bdy_vol2d 
    480486         IF( ln_bdy .AND. ln_vol ) CALL bdy_vol2d( kt, jn, ua_e, va_e, zhup2_e, zhvp2_e ) 
    481          ! 
     487         !       
    482488         !                             ! resulting flux at mid-step (not over the full domain) 
    483489         zhU(1:jpim1,1:jpj  ) = e2u(1:jpim1,1:jpj  ) * ua_e(1:jpim1,1:jpj  ) * zhup2_e(1:jpim1,1:jpj  )   ! not jpi-column 
     
    486492#if defined key_agrif 
    487493         ! Set fluxes during predictor step to ensure volume conservation 
    488          IF( .NOT.Agrif_Root() .AND. ln_bt_fw ) THEN 
    489             IF((nbondi == -1).OR.(nbondi == 2)) THEN 
    490                DO jj = 1, jpj 
    491                   zhU(2:nbghostcells+1,jj) = ubdy_w(1:nbghostcells,jj) * e2u(2:nbghostcells+1,jj) 
    492                   zhV(2:nbghostcells+1,jj) = vbdy_w(1:nbghostcells,jj) * e1v(2:nbghostcells+1,jj) 
    493                END DO 
    494             ENDIF 
    495             IF((nbondi ==  1).OR.(nbondi == 2)) THEN 
    496                DO jj=1,jpj 
    497                   zhU(nlci-nbghostcells-1:nlci-2,jj) = ubdy_e(1:nbghostcells,jj) * e2u(nlci-nbghostcells-1:nlci-2,jj) 
    498                   zhV(nlci-nbghostcells  :nlci-1,jj) = vbdy_e(1:nbghostcells,jj) * e1v(nlci-nbghostcells  :nlci-1,jj) 
    499                END DO 
    500             ENDIF 
    501             IF((nbondj == -1).OR.(nbondj == 2)) THEN 
    502                DO ji=1,jpi 
    503                   zhV(ji,2:nbghostcells+1) = vbdy_s(ji,1:nbghostcells) * e1v(ji,2:nbghostcells+1) 
    504                   zhU(ji,2:nbghostcells+1) = ubdy_s(ji,1:nbghostcells) * e2u(ji,2:nbghostcells+1) 
    505                END DO 
    506             ENDIF 
    507             IF((nbondj ==  1).OR.(nbondj == 2)) THEN 
    508                DO ji=1,jpi 
    509                   zhV(ji,nlcj-nbghostcells-1:nlcj-2) = vbdy_n(ji,1:nbghostcells) * e1v(ji,nlcj-nbghostcells-1:nlcj-2) 
    510                   zhU(ji,nlcj-nbghostcells  :nlcj-1) = ubdy_n(ji,1:nbghostcells) * e2u(ji,nlcj-nbghostcells  :nlcj-1) 
    511                END DO 
    512             ENDIF 
    513          ENDIF 
     494         IF( .NOT.Agrif_Root() .AND. ln_bt_fw ) CALL agrif_dyn_ts_flux( jn, zhU, zhV ) 
    514495#endif 
    515496         IF( ln_wd_il )   CALL wad_lmt_bt(zhU, zhV, sshn_e, zssh_frc, rdtbt)    !!gm wad_lmt_bt use of lbc_lnk on zhU, zhV 
     
    526507         !--        ssh    =  ssh   - delta_t' * [ frc + div( flux      ) ]      --! 
    527508         !-------------------------------------------------------------------------! 
    528          DO jj = 2, jpjm1        ! INNER domain                              
    529             DO ji = 2, jpim1 
    530                zhdiv = (   zhU(ji,jj) - zhU(ji-1,jj) + zhV(ji,jj) - zhV(ji,jj-1)   ) * r1_e1e2t(ji,jj) 
    531                ssha_e(ji,jj) = (  sshn_e(ji,jj) - rdtbt * ( zssh_frc(ji,jj) + zhdiv )  ) * ssmask(ji,jj) 
    532             END DO 
    533          END DO 
     509         DO_2D_00_00 
     510            zhdiv = (   zhU(ji,jj) - zhU(ji-1,jj) + zhV(ji,jj) - zhV(ji,jj-1)   ) * r1_e1e2t(ji,jj) 
     511            ssha_e(ji,jj) = (  sshn_e(ji,jj) - rdtbt * ( zssh_frc(ji,jj) + zhdiv )  ) * ssmask(ji,jj) 
     512         END_2D 
    534513         ! 
    535514         CALL lbc_lnk_multi( 'dynspg_ts', ssha_e, 'T', 1._wp,  zhU, 'U', -1._wp,  zhV, 'V', -1._wp ) 
     
    553532         ! Sea Surface Height at u-,v-points (vvl case only) 
    554533         IF( .NOT.ln_linssh ) THEN                                 
    555             DO jj = 2, jpjm1   ! INNER domain, will be extended to whole domain later 
    556                DO ji = 2, jpim1      ! NO Vector Opt. 
    557                   zsshu_a(ji,jj) = r1_2 * ssumask(ji,jj) * r1_e1e2u(ji,jj)    & 
    558                      &              * ( e1e2t(ji  ,jj  )  * ssha_e(ji  ,jj  ) & 
    559                      &              +   e1e2t(ji+1,jj  )  * ssha_e(ji+1,jj  ) ) 
    560                   zsshv_a(ji,jj) = r1_2 * ssvmask(ji,jj) * r1_e1e2v(ji,jj)    & 
    561                      &              * ( e1e2t(ji  ,jj  )  * ssha_e(ji  ,jj  ) & 
    562                      &              +   e1e2t(ji  ,jj+1)  * ssha_e(ji  ,jj+1) ) 
    563                END DO 
    564             END DO 
     534            DO_2D_00_00 
     535               zsshu_a(ji,jj) = r1_2 * ssumask(ji,jj) * r1_e1e2u(ji,jj)    & 
     536                  &              * ( e1e2t(ji  ,jj  )  * ssha_e(ji  ,jj  ) & 
     537                  &              +   e1e2t(ji+1,jj  )  * ssha_e(ji+1,jj  ) ) 
     538               zsshv_a(ji,jj) = r1_2 * ssvmask(ji,jj) * r1_e1e2v(ji,jj)    & 
     539                  &              * ( e1e2t(ji  ,jj  )  * ssha_e(ji  ,jj  ) & 
     540                  &              +   e1e2t(ji  ,jj+1)  * ssha_e(ji  ,jj+1) ) 
     541            END_2D 
    565542         ENDIF    
    566543         !          
     
    575552         !                             ! Surface pressure gradient 
    576553         zldg = ( 1._wp - rn_scal_load ) * grav    ! local factor 
    577          DO jj = 2, jpjm1                             
    578             DO ji = 2, jpim1 
    579                zu_spg(ji,jj) = - zldg * ( zsshp2_e(ji+1,jj) - zsshp2_e(ji,jj) ) * r1_e1u(ji,jj) 
    580                zv_spg(ji,jj) = - zldg * ( zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj) ) * r1_e2v(ji,jj) 
    581             END DO 
    582          END DO 
     554         DO_2D_00_00 
     555            zu_spg(ji,jj) = - zldg * ( zsshp2_e(ji+1,jj) - zsshp2_e(ji,jj) ) * r1_e1u(ji,jj) 
     556            zv_spg(ji,jj) = - zldg * ( zsshp2_e(ji,jj+1) - zsshp2_e(ji,jj) ) * r1_e2v(ji,jj) 
     557         END_2D 
    583558         IF( ln_wd_il ) THEN        ! W/D : gravity filters applied on pressure gradient 
    584559            CALL wad_spg( zsshp2_e, zcpx, zcpy )   ! Calculating W/D gravity filters 
     
    595570         ! Add tidal astronomical forcing if defined 
    596571         IF ( ln_tide .AND. ln_tide_pot ) THEN 
    597             DO jj = 2, jpjm1 
    598                DO ji = fs_2, fs_jpim1   ! vector opt. 
    599                   zu_trd(ji,jj) = zu_trd(ji,jj) + grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) * r1_e1u(ji,jj) 
    600                   zv_trd(ji,jj) = zv_trd(ji,jj) + grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) * r1_e2v(ji,jj) 
    601                END DO 
    602             END DO 
     572            DO_2D_00_00 
     573               zu_trd(ji,jj) = zu_trd(ji,jj) + grav * ( pot_astro(ji+1,jj) - pot_astro(ji,jj) ) * r1_e1u(ji,jj) 
     574               zv_trd(ji,jj) = zv_trd(ji,jj) + grav * ( pot_astro(ji,jj+1) - pot_astro(ji,jj) ) * r1_e2v(ji,jj) 
     575            END_2D 
    603576         ENDIF 
    604577         ! 
     
    606579!jth do implicitly instead 
    607580         IF ( .NOT. ll_wd ) THEN ! Revert to explicit for bit comparison tests in non wad runs 
    608             DO jj = 2, jpjm1 
    609                DO ji = fs_2, fs_jpim1   ! vector opt. 
    610                   zu_trd(ji,jj) = zu_trd(ji,jj) + zCdU_u(ji,jj) * un_e(ji,jj) * hur_e(ji,jj) 
    611                   zv_trd(ji,jj) = zv_trd(ji,jj) + zCdU_v(ji,jj) * vn_e(ji,jj) * hvr_e(ji,jj) 
    612                END DO 
    613             END DO 
     581            DO_2D_00_00 
     582               zu_trd(ji,jj) = zu_trd(ji,jj) + zCdU_u(ji,jj) * un_e(ji,jj) * hur_e(ji,jj) 
     583               zv_trd(ji,jj) = zv_trd(ji,jj) + zCdU_v(ji,jj) * vn_e(ji,jj) * hvr_e(ji,jj) 
     584            END_2D 
    614585         ENDIF 
    615586         ! 
     
    626597         !------------------------------------------------------------------------------------------------------------------------! 
    627598         IF( ln_dynadv_vec .OR. ln_linssh ) THEN      !* Vector form 
    628             DO jj = 2, jpjm1 
    629                DO ji = fs_2, fs_jpim1   ! vector opt. 
    630                   ua_e(ji,jj) = (                                 un_e(ji,jj)   &  
    631                             &     + rdtbt * (                   zu_spg(ji,jj)   & 
    632                             &                                 + zu_trd(ji,jj)   & 
    633                             &                                 + zu_frc(ji,jj) ) &  
    634                             &   ) * ssumask(ji,jj) 
    635  
    636                   va_e(ji,jj) = (                                 vn_e(ji,jj)   & 
    637                             &     + rdtbt * (                   zv_spg(ji,jj)   & 
    638                             &                                 + zv_trd(ji,jj)   & 
    639                             &                                 + zv_frc(ji,jj) ) & 
    640                             &   ) * ssvmask(ji,jj) 
    641                END DO 
    642             END DO 
     599            DO_2D_00_00 
     600               ua_e(ji,jj) = (                                 un_e(ji,jj)   &  
     601                         &     + rdtbt * (                   zu_spg(ji,jj)   & 
     602                         &                                 + zu_trd(ji,jj)   & 
     603                         &                                 + zu_frc(ji,jj) ) &  
     604                         &   ) * ssumask(ji,jj) 
     605 
     606               va_e(ji,jj) = (                                 vn_e(ji,jj)   & 
     607                         &     + rdtbt * (                   zv_spg(ji,jj)   & 
     608                         &                                 + zv_trd(ji,jj)   & 
     609                         &                                 + zv_frc(ji,jj) ) & 
     610                         &   ) * ssvmask(ji,jj) 
     611            END_2D 
    643612            ! 
    644613         ELSE                           !* Flux form 
    645             DO jj = 2, jpjm1 
    646                DO ji = 2, jpim1 
    647                   !                    ! hu_e, hv_e hold depth at jn,  zhup2_e, zhvp2_e hold extrapolated depth at jn+1/2 
    648                   !                    ! backward interpolated depth used in spg terms at jn+1/2 
    649                   zhu_bck = hu_0(ji,jj) + r1_2*r1_e1e2u(ji,jj) * (  e1e2t(ji  ,jj) * zsshp2_e(ji  ,jj)    & 
    650                        &                                          + e1e2t(ji+1,jj) * zsshp2_e(ji+1,jj)  ) * ssumask(ji,jj) 
    651                   zhv_bck = hv_0(ji,jj) + r1_2*r1_e1e2v(ji,jj) * (  e1e2t(ji,jj  ) * zsshp2_e(ji,jj  )    & 
    652                        &                                          + e1e2t(ji,jj+1) * zsshp2_e(ji,jj+1)  ) * ssvmask(ji,jj) 
    653                   !                    ! inverse depth at jn+1 
    654                   z1_hu = ssumask(ji,jj) / ( hu_0(ji,jj) + zsshu_a(ji,jj) + 1._wp - ssumask(ji,jj) ) 
    655                   z1_hv = ssvmask(ji,jj) / ( hv_0(ji,jj) + zsshv_a(ji,jj) + 1._wp - ssvmask(ji,jj) ) 
    656                   ! 
    657                   ua_e(ji,jj) = (               hu_e  (ji,jj) *   un_e (ji,jj)      &  
    658                        &            + rdtbt * (  zhu_bck        * zu_spg (ji,jj)  &   ! 
    659                        &                       + zhup2_e(ji,jj) * zu_trd (ji,jj)  &   ! 
    660                        &                       +  hu_n  (ji,jj) * zu_frc (ji,jj)  )   ) * z1_hu 
    661                   ! 
    662                   va_e(ji,jj) = (               hv_e  (ji,jj) *   vn_e (ji,jj)      & 
    663                        &            + rdtbt * (  zhv_bck        * zv_spg (ji,jj)  &   ! 
    664                        &                       + zhvp2_e(ji,jj) * zv_trd (ji,jj)  &   ! 
    665                        &                       +  hv_n  (ji,jj) * zv_frc (ji,jj)  )   ) * z1_hv 
    666                END DO 
    667             END DO 
     614            DO_2D_00_00 
     615               !                    ! hu_e, hv_e hold depth at jn,  zhup2_e, zhvp2_e hold extrapolated depth at jn+1/2 
     616               !                    ! backward interpolated depth used in spg terms at jn+1/2 
     617               zhu_bck = hu_0(ji,jj) + r1_2*r1_e1e2u(ji,jj) * (  e1e2t(ji  ,jj) * zsshp2_e(ji  ,jj)    & 
     618                    &                                          + e1e2t(ji+1,jj) * zsshp2_e(ji+1,jj)  ) * ssumask(ji,jj) 
     619               zhv_bck = hv_0(ji,jj) + r1_2*r1_e1e2v(ji,jj) * (  e1e2t(ji,jj  ) * zsshp2_e(ji,jj  )    & 
     620                    &                                          + e1e2t(ji,jj+1) * zsshp2_e(ji,jj+1)  ) * ssvmask(ji,jj) 
     621               !                    ! inverse depth at jn+1 
     622               z1_hu = ssumask(ji,jj) / ( hu_0(ji,jj) + zsshu_a(ji,jj) + 1._wp - ssumask(ji,jj) ) 
     623               z1_hv = ssvmask(ji,jj) / ( hv_0(ji,jj) + zsshv_a(ji,jj) + 1._wp - ssvmask(ji,jj) ) 
     624               ! 
     625               ua_e(ji,jj) = (               hu_e  (ji,jj) *   un_e (ji,jj)      &  
     626                    &            + rdtbt * (  zhu_bck        * zu_spg (ji,jj)  &   ! 
     627                    &                       + zhup2_e(ji,jj) * zu_trd (ji,jj)  &   ! 
     628                    &                       +  hu(ji,jj,Kmm) * zu_frc (ji,jj)  )   ) * z1_hu 
     629               ! 
     630               va_e(ji,jj) = (               hv_e  (ji,jj) *   vn_e (ji,jj)      & 
     631                    &            + rdtbt * (  zhv_bck        * zv_spg (ji,jj)  &   ! 
     632                    &                       + zhvp2_e(ji,jj) * zv_trd (ji,jj)  &   ! 
     633                    &                       +  hv(ji,jj,Kmm) * zv_frc (ji,jj)  )   ) * z1_hv 
     634            END_2D 
    668635         ENDIF 
    669636!jth implicit bottom friction: 
    670637         IF ( ll_wd ) THEN ! revert to explicit for bit comparison tests in non wad runs 
    671             DO jj = 2, jpjm1 
    672                DO ji = fs_2, fs_jpim1   ! vector opt. 
    673                      ua_e(ji,jj) =  ua_e(ji,jj) /(1.0 -   rdtbt * zCdU_u(ji,jj) * hur_e(ji,jj)) 
    674                      va_e(ji,jj) =  va_e(ji,jj) /(1.0 -   rdtbt * zCdU_v(ji,jj) * hvr_e(ji,jj)) 
    675                END DO 
    676             END DO 
     638            DO_2D_00_00 
     639                  ua_e(ji,jj) =  ua_e(ji,jj) /(1.0 -   rdtbt * zCdU_u(ji,jj) * hur_e(ji,jj)) 
     640                  va_e(ji,jj) =  va_e(ji,jj) /(1.0 -   rdtbt * zCdU_v(ji,jj) * hvr_e(ji,jj)) 
     641            END_2D 
    677642         ENDIF 
    678643        
     
    713678         za1 = wgtbtp1(jn)                                     
    714679         IF( ln_dynadv_vec .OR. ln_linssh ) THEN    ! Sum velocities 
    715             ua_b  (:,:) = ua_b  (:,:) + za1 * ua_e  (:,:)  
    716             va_b  (:,:) = va_b  (:,:) + za1 * va_e  (:,:)  
     680            puu_b  (:,:,Kaa) = puu_b  (:,:,Kaa) + za1 * ua_e  (:,:)  
     681            pvv_b  (:,:,Kaa) = pvv_b  (:,:,Kaa) + za1 * va_e  (:,:)  
    717682         ELSE                                       ! Sum transports 
    718683            IF ( .NOT.ln_wd_dl ) THEN   
    719                ua_b  (:,:) = ua_b  (:,:) + za1 * ua_e  (:,:) * hu_e (:,:) 
    720                va_b  (:,:) = va_b  (:,:) + za1 * va_e  (:,:) * hv_e (:,:) 
     684               puu_b  (:,:,Kaa) = puu_b  (:,:,Kaa) + za1 * ua_e  (:,:) * hu_e (:,:) 
     685               pvv_b  (:,:,Kaa) = pvv_b  (:,:,Kaa) + za1 * va_e  (:,:) * hv_e (:,:) 
    721686            ELSE  
    722                ua_b  (:,:) = ua_b  (:,:) + za1 * ua_e  (:,:) * hu_e (:,:) * zuwdmask(:,:) 
    723                va_b  (:,:) = va_b  (:,:) + za1 * va_e  (:,:) * hv_e (:,:) * zvwdmask(:,:) 
     687               puu_b  (:,:,Kaa) = puu_b  (:,:,Kaa) + za1 * ua_e  (:,:) * hu_e (:,:) * zuwdmask(:,:) 
     688               pvv_b  (:,:,Kaa) = pvv_b  (:,:,Kaa) + za1 * va_e  (:,:) * hv_e (:,:) * zvwdmask(:,:) 
    724689            END IF  
    725690         ENDIF 
    726691         !                                          ! Sum sea level 
    727          ssha(:,:) = ssha(:,:) + za1 * ssha_e(:,:) 
     692         pssh(:,:,Kaa) = pssh(:,:,Kaa) + za1 * ssha_e(:,:) 
    728693 
    729694         !                                                 ! ==================== ! 
     
    737702      IF (ln_bt_fw) THEN 
    738703         IF( .NOT.( kt == nit000 .AND. neuler==0 ) ) THEN 
    739             DO jj = 1, jpj 
    740                DO ji = 1, jpi 
    741                   zun_save = un_adv(ji,jj) 
    742                   zvn_save = vn_adv(ji,jj) 
    743                   !                          ! apply the previously computed correction  
    744                   un_adv(ji,jj) = r1_2 * ( ub2_b(ji,jj) + zun_save - atfp * un_bf(ji,jj) ) 
    745                   vn_adv(ji,jj) = r1_2 * ( vb2_b(ji,jj) + zvn_save - atfp * vn_bf(ji,jj) ) 
    746                   !                          ! Update corrective fluxes for next time step 
    747                   un_bf(ji,jj)  = atfp * un_bf(ji,jj) + ( zun_save - ub2_b(ji,jj) ) 
    748                   vn_bf(ji,jj)  = atfp * vn_bf(ji,jj) + ( zvn_save - vb2_b(ji,jj) ) 
    749                   !                          ! Save integrated transport for next computation 
    750                   ub2_b(ji,jj) = zun_save 
    751                   vb2_b(ji,jj) = zvn_save 
    752                END DO 
    753             END DO 
     704            DO_2D_11_11 
     705               zun_save = un_adv(ji,jj) 
     706               zvn_save = vn_adv(ji,jj) 
     707               !                          ! apply the previously computed correction  
     708               un_adv(ji,jj) = r1_2 * ( ub2_b(ji,jj) + zun_save - atfp * un_bf(ji,jj) ) 
     709               vn_adv(ji,jj) = r1_2 * ( vb2_b(ji,jj) + zvn_save - atfp * vn_bf(ji,jj) ) 
     710               !                          ! Update corrective fluxes for next time step 
     711               un_bf(ji,jj)  = atfp * un_bf(ji,jj) + ( zun_save - ub2_b(ji,jj) ) 
     712               vn_bf(ji,jj)  = atfp * vn_bf(ji,jj) + ( zvn_save - vb2_b(ji,jj) ) 
     713               !                          ! Save integrated transport for next computation 
     714               ub2_b(ji,jj) = zun_save 
     715               vb2_b(ji,jj) = zvn_save 
     716            END_2D 
    754717         ELSE 
    755718            un_bf(:,:) = 0._wp            ! corrective fluxes for next time step set to zero 
     
    765728      IF( ln_dynadv_vec .OR. ln_linssh ) THEN 
    766729         DO jk=1,jpkm1 
    767             ua(:,:,jk) = ua(:,:,jk) + ( ua_b(:,:) - ub_b(:,:) ) * r1_2dt_b 
    768             va(:,:,jk) = va(:,:,jk) + ( va_b(:,:) - vb_b(:,:) ) * r1_2dt_b 
     730            puu(:,:,jk,Krhs) = puu(:,:,jk,Krhs) + ( puu_b(:,:,Kaa) - puu_b(:,:,Kbb) ) * r1_2dt_b 
     731            pvv(:,:,jk,Krhs) = pvv(:,:,jk,Krhs) + ( pvv_b(:,:,Kaa) - pvv_b(:,:,Kbb) ) * r1_2dt_b 
    769732         END DO 
    770733      ELSE 
    771          ! At this stage, ssha has been corrected: compute new depths at velocity points 
    772          DO jj = 1, jpjm1 
    773             DO ji = 1, jpim1      ! NO Vector Opt. 
    774                zsshu_a(ji,jj) = r1_2 * ssumask(ji,jj)  * r1_e1e2u(ji,jj) & 
    775                   &              * ( e1e2t(ji  ,jj) * ssha(ji  ,jj)      & 
    776                   &              +   e1e2t(ji+1,jj) * ssha(ji+1,jj) ) 
    777                zsshv_a(ji,jj) = r1_2 * ssvmask(ji,jj)  * r1_e1e2v(ji,jj) & 
    778                   &              * ( e1e2t(ji,jj  ) * ssha(ji,jj  )      & 
    779                   &              +   e1e2t(ji,jj+1) * ssha(ji,jj+1) ) 
    780             END DO 
    781          END DO 
     734         ! At this stage, pssh(:,:,:,Krhs) has been corrected: compute new depths at velocity points 
     735         DO_2D_10_10 
     736            zsshu_a(ji,jj) = r1_2 * ssumask(ji,jj)  * r1_e1e2u(ji,jj) & 
     737               &              * ( e1e2t(ji  ,jj) * pssh(ji  ,jj,Kaa)      & 
     738               &              +   e1e2t(ji+1,jj) * pssh(ji+1,jj,Kaa) ) 
     739            zsshv_a(ji,jj) = r1_2 * ssvmask(ji,jj)  * r1_e1e2v(ji,jj) & 
     740               &              * ( e1e2t(ji,jj  ) * pssh(ji,jj  ,Kaa)      & 
     741               &              +   e1e2t(ji,jj+1) * pssh(ji,jj+1,Kaa) ) 
     742         END_2D 
    782743         CALL lbc_lnk_multi( 'dynspg_ts', zsshu_a, 'U', 1._wp, zsshv_a, 'V', 1._wp ) ! Boundary conditions 
    783744         ! 
    784745         DO jk=1,jpkm1 
    785             ua(:,:,jk) = ua(:,:,jk) + r1_hu_n(:,:) * ( ua_b(:,:) - ub_b(:,:) * hu_b(:,:) ) * r1_2dt_b 
    786             va(:,:,jk) = va(:,:,jk) + r1_hv_n(:,:) * ( va_b(:,:) - vb_b(:,:) * hv_b(:,:) ) * r1_2dt_b 
     746            puu(:,:,jk,Krhs) = puu(:,:,jk,Krhs) + r1_hu(:,:,Kmm) * ( puu_b(:,:,Kaa) - puu_b(:,:,Kbb) * hu(:,:,Kbb) ) * r1_2dt_b 
     747            pvv(:,:,jk,Krhs) = pvv(:,:,jk,Krhs) + r1_hv(:,:,Kmm) * ( pvv_b(:,:,Kaa) - pvv_b(:,:,Kbb) * hv(:,:,Kbb) ) * r1_2dt_b 
    787748         END DO 
    788749         ! Save barotropic velocities not transport: 
    789          ua_b(:,:) =  ua_b(:,:) / ( hu_0(:,:) + zsshu_a(:,:) + 1._wp - ssumask(:,:) ) 
    790          va_b(:,:) =  va_b(:,:) / ( hv_0(:,:) + zsshv_a(:,:) + 1._wp - ssvmask(:,:) ) 
     750         puu_b(:,:,Kaa) =  puu_b(:,:,Kaa) / ( hu_0(:,:) + zsshu_a(:,:) + 1._wp - ssumask(:,:) ) 
     751         pvv_b(:,:,Kaa) =  pvv_b(:,:,Kaa) / ( hv_0(:,:) + zsshv_a(:,:) + 1._wp - ssvmask(:,:) ) 
    791752      ENDIF 
    792753 
     
    794755      ! Correct velocities so that the barotropic velocity equals (un_adv, vn_adv) (in all cases)   
    795756      DO jk = 1, jpkm1 
    796          un(:,:,jk) = ( un(:,:,jk) + un_adv(:,:)*r1_hu_n(:,:) - un_b(:,:) ) * umask(:,:,jk) 
    797          vn(:,:,jk) = ( vn(:,:,jk) + vn_adv(:,:)*r1_hv_n(:,:) - vn_b(:,:) ) * vmask(:,:,jk) 
     757         puu(:,:,jk,Kmm) = ( puu(:,:,jk,Kmm) + un_adv(:,:)*r1_hu(:,:,Kmm) - puu_b(:,:,Kmm) ) * umask(:,:,jk) 
     758         pvv(:,:,jk,Kmm) = ( pvv(:,:,jk,Kmm) + vn_adv(:,:)*r1_hv(:,:,Kmm) - pvv_b(:,:,Kmm) ) * vmask(:,:,jk) 
    798759      END DO 
    799760 
    800761      IF ( ln_wd_dl .and. ln_wd_dl_bc) THEN  
    801          ! need to set lbc here because not done prior time averaging 
    802          CALL lbc_lnk_multi( 'dynspg_ts', zuwdav2, 'U', 1._wp, zvwdav2, 'V', 1._wp) 
    803762         DO jk = 1, jpkm1 
    804             un(:,:,jk) = ( un_adv(:,:)*r1_hu_n(:,:) & 
    805                        & + zuwdav2(:,:)*(un(:,:,jk) - un_adv(:,:)*r1_hu_n(:,:)) ) * umask(:,:,jk)  
    806             vn(:,:,jk) = ( vn_adv(:,:)*r1_hv_n(:,:) &  
    807                        & + zvwdav2(:,:)*(vn(:,:,jk) - vn_adv(:,:)*r1_hv_n(:,:)) ) * vmask(:,:,jk)   
     763            puu(:,:,jk,Kmm) = ( un_adv(:,:)*r1_hu(:,:,Kmm) & 
     764                       & + zuwdav2(:,:)*(puu(:,:,jk,Kmm) - un_adv(:,:)*r1_hu(:,:,Kmm)) ) * umask(:,:,jk)  
     765            pvv(:,:,jk,Kmm) = ( vn_adv(:,:)*r1_hv(:,:,Kmm) &  
     766                       & + zvwdav2(:,:)*(pvv(:,:,jk,Kmm) - vn_adv(:,:)*r1_hv(:,:,Kmm)) ) * vmask(:,:,jk)   
    808767         END DO 
    809768      END IF  
    810769 
    811770       
    812       CALL iom_put(  "ubar", un_adv(:,:)*r1_hu_n(:,:) )    ! barotropic i-current 
    813       CALL iom_put(  "vbar", vn_adv(:,:)*r1_hv_n(:,:) )    ! barotropic i-current 
     771      CALL iom_put(  "ubar", un_adv(:,:)*r1_hu(:,:,Kmm) )    ! barotropic i-current 
     772      CALL iom_put(  "vbar", vn_adv(:,:)*r1_hv(:,:,Kmm) )    ! barotropic i-current 
    814773      ! 
    815774#if defined key_agrif 
     
    834793      IF( ln_wd_dl )   DEALLOCATE( ztwdmask, zuwdmask, zvwdmask, zuwdav2, zvwdav2 ) 
    835794      ! 
    836       CALL iom_put( "baro_u" , un_b )  ! Barotropic  U Velocity 
    837       CALL iom_put( "baro_v" , vn_b )  ! Barotropic  V Velocity 
     795      CALL iom_put( "baro_u" , puu_b(:,:,Kmm) )  ! Barotropic  U Velocity 
     796      CALL iom_put( "baro_v" , pvv_b(:,:,Kmm) )  ! Barotropic  V Velocity 
    838797      ! 
    839798   END SUBROUTINE dyn_spg_ts 
     
    1002961      REAL(wp) ::   zxr2, zyr2, zcmax   ! local scalar 
    1003962      REAL(wp), DIMENSION(jpi,jpj) ::   zcu 
    1004       INTEGER  :: inum 
    1005963      !!---------------------------------------------------------------------- 
    1006964      ! 
    1007965      ! Max courant number for ext. grav. waves 
    1008966      ! 
    1009       DO jj = 1, jpj 
    1010          DO ji =1, jpi 
    1011             zxr2 = r1_e1t(ji,jj) * r1_e1t(ji,jj) 
    1012             zyr2 = r1_e2t(ji,jj) * r1_e2t(ji,jj) 
    1013             zcu(ji,jj) = SQRT( grav * MAX(ht_0(ji,jj),0._wp) * (zxr2 + zyr2) ) 
    1014          END DO 
    1015       END DO 
     967      DO_2D_11_11 
     968         zxr2 = r1_e1t(ji,jj) * r1_e1t(ji,jj) 
     969         zyr2 = r1_e2t(ji,jj) * r1_e2t(ji,jj) 
     970         zcu(ji,jj) = SQRT( grav * MAX(ht_0(ji,jj),0._wp) * (zxr2 + zyr2) ) 
     971      END_2D 
    1016972      ! 
    1017973      zcmax = MAXVAL( zcu(:,:) ) 
     
    11101066 
    11111067    
    1112    SUBROUTINE dyn_cor_2d_init 
     1068   SUBROUTINE dyn_cor_2D_init( Kmm ) 
    11131069      !!--------------------------------------------------------------------- 
    1114       !!                   ***  ROUTINE dyn_cor_2d_init  *** 
     1070      !!                   ***  ROUTINE dyn_cor_2D_init  *** 
    11151071      !! 
    11161072      !! ** Purpose : Set time splitting options 
     
    11241080      !! Compute zwz = f / ( height of the water colomn ) 
    11251081      !!---------------------------------------------------------------------- 
     1082      INTEGER,  INTENT(in)         ::  Kmm  ! Time index 
    11261083      INTEGER  ::   ji ,jj, jk              ! dummy loop indices 
    11271084      REAL(wp) ::   z1_ht 
     
    11331090         SELECT CASE( nn_een_e3f )              !* ff_f/e3 at F-point 
    11341091         CASE ( 0 )                                   ! original formulation  (masked averaging of e3t divided by 4) 
    1135             DO jj = 1, jpjm1 
    1136                DO ji = 1, jpim1 
    1137                   zwz(ji,jj) =   ( ht_n(ji  ,jj+1) + ht_n(ji+1,jj+1) +                    & 
    1138                        &             ht_n(ji  ,jj  ) + ht_n(ji+1,jj  )   ) * 0.25_wp   
    1139                   IF( zwz(ji,jj) /= 0._wp )   zwz(ji,jj) = ff_f(ji,jj) / zwz(ji,jj) 
    1140                END DO 
    1141             END DO 
     1092            DO_2D_10_10 
     1093               zwz(ji,jj) =   ( ht(ji  ,jj+1) + ht(ji+1,jj+1) +                    & 
     1094                    &           ht(ji  ,jj  ) + ht(ji+1,jj  )   ) * 0.25_wp   
     1095               IF( zwz(ji,jj) /= 0._wp )   zwz(ji,jj) = ff_f(ji,jj) / zwz(ji,jj) 
     1096            END_2D 
    11421097         CASE ( 1 )                                   ! new formulation  (masked averaging of e3t divided by the sum of mask) 
    1143             DO jj = 1, jpjm1 
    1144                DO ji = 1, jpim1 
    1145                   zwz(ji,jj) =             (  ht_n  (ji  ,jj+1) + ht_n  (ji+1,jj+1)      & 
    1146                        &                      + ht_n  (ji  ,jj  ) + ht_n  (ji+1,jj  )  )   & 
    1147                        &       / ( MAX( 1._wp,  ssmask(ji  ,jj+1) + ssmask(ji+1,jj+1)      & 
    1148                        &                      + ssmask(ji  ,jj  ) + ssmask(ji+1,jj  )  )   ) 
    1149                   IF( zwz(ji,jj) /= 0._wp )   zwz(ji,jj) = ff_f(ji,jj) / zwz(ji,jj) 
    1150                END DO 
    1151             END DO 
     1098            DO_2D_10_10 
     1099               zwz(ji,jj) =             (  ht  (ji  ,jj+1) + ht  (ji+1,jj+1)      & 
     1100                    &                    + ht  (ji  ,jj  ) + ht  (ji+1,jj  )  )   & 
     1101                    &       / ( MAX( 1._wp,  ssmask(ji  ,jj+1) + ssmask(ji+1,jj+1)      & 
     1102                    &                      + ssmask(ji  ,jj  ) + ssmask(ji+1,jj  )  )   ) 
     1103               IF( zwz(ji,jj) /= 0._wp )   zwz(ji,jj) = ff_f(ji,jj) / zwz(ji,jj) 
     1104            END_2D 
    11521105         END SELECT 
    11531106         CALL lbc_lnk( 'dynspg_ts', zwz, 'F', 1._wp ) 
    11541107         ! 
    11551108         ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp 
    1156          DO jj = 2, jpj 
    1157             DO ji = 2, jpi 
    1158                ftne(ji,jj) = zwz(ji-1,jj  ) + zwz(ji  ,jj  ) + zwz(ji  ,jj-1) 
    1159                ftnw(ji,jj) = zwz(ji-1,jj-1) + zwz(ji-1,jj  ) + zwz(ji  ,jj  ) 
    1160                ftse(ji,jj) = zwz(ji  ,jj  ) + zwz(ji  ,jj-1) + zwz(ji-1,jj-1) 
    1161                ftsw(ji,jj) = zwz(ji  ,jj-1) + zwz(ji-1,jj-1) + zwz(ji-1,jj  ) 
    1162             END DO 
    1163          END DO 
     1109         DO_2D_01_01 
     1110            ftne(ji,jj) = zwz(ji-1,jj  ) + zwz(ji  ,jj  ) + zwz(ji  ,jj-1) 
     1111            ftnw(ji,jj) = zwz(ji-1,jj-1) + zwz(ji-1,jj  ) + zwz(ji  ,jj  ) 
     1112            ftse(ji,jj) = zwz(ji  ,jj  ) + zwz(ji  ,jj-1) + zwz(ji-1,jj-1) 
     1113            ftsw(ji,jj) = zwz(ji  ,jj-1) + zwz(ji-1,jj-1) + zwz(ji-1,jj  ) 
     1114         END_2D 
    11641115         ! 
    11651116      CASE( np_EET )                  != EEN scheme using e3t (energy conserving scheme) 
    11661117         ftne(1,:) = 0._wp ; ftnw(1,:) = 0._wp ; ftse(1,:) = 0._wp ; ftsw(1,:) = 0._wp 
    1167          DO jj = 2, jpj 
    1168             DO ji = 2, jpi 
    1169                z1_ht = ssmask(ji,jj) / ( ht_n(ji,jj) + 1._wp - ssmask(ji,jj) ) 
    1170                ftne(ji,jj) = ( ff_f(ji-1,jj  ) + ff_f(ji  ,jj  ) + ff_f(ji  ,jj-1) ) * z1_ht 
    1171                ftnw(ji,jj) = ( ff_f(ji-1,jj-1) + ff_f(ji-1,jj  ) + ff_f(ji  ,jj  ) ) * z1_ht 
    1172                ftse(ji,jj) = ( ff_f(ji  ,jj  ) + ff_f(ji  ,jj-1) + ff_f(ji-1,jj-1) ) * z1_ht 
    1173                ftsw(ji,jj) = ( ff_f(ji  ,jj-1) + ff_f(ji-1,jj-1) + ff_f(ji-1,jj  ) ) * z1_ht 
    1174             END DO 
    1175          END DO 
     1118         DO_2D_01_01 
     1119            z1_ht = ssmask(ji,jj) / ( ht(ji,jj) + 1._wp - ssmask(ji,jj) ) 
     1120            ftne(ji,jj) = ( ff_f(ji-1,jj  ) + ff_f(ji  ,jj  ) + ff_f(ji  ,jj-1) ) * z1_ht 
     1121            ftnw(ji,jj) = ( ff_f(ji-1,jj-1) + ff_f(ji-1,jj  ) + ff_f(ji  ,jj  ) ) * z1_ht 
     1122            ftse(ji,jj) = ( ff_f(ji  ,jj  ) + ff_f(ji  ,jj-1) + ff_f(ji-1,jj-1) ) * z1_ht 
     1123            ftsw(ji,jj) = ( ff_f(ji  ,jj-1) + ff_f(ji-1,jj-1) + ff_f(ji-1,jj  ) ) * z1_ht 
     1124         END_2D 
    11761125         ! 
    11771126      CASE( np_ENE, np_ENS , np_MIX )  != all other schemes (ENE, ENS, MIX) except ENT ! 
     
    12001149            ! 
    12011150            !zhf(:,:) = hbatf(:,:) 
    1202             DO jj = 1, jpjm1 
    1203                DO ji = 1, jpim1 
    1204                   zhf(ji,jj) =    (   ht_0  (ji,jj  ) + ht_0  (ji+1,jj  )          & 
    1205                        &            + ht_0  (ji,jj+1) + ht_0  (ji+1,jj+1)   )      & 
    1206                        &     / MAX(   ssmask(ji,jj  ) + ssmask(ji+1,jj  )          & 
    1207                        &            + ssmask(ji,jj+1) + ssmask(ji+1,jj+1) , 1._wp  ) 
    1208                END DO 
    1209             END DO 
     1151            DO_2D_10_10 
     1152               zhf(ji,jj) =    (   ht_0  (ji,jj  ) + ht_0  (ji+1,jj  )          & 
     1153                    &            + ht_0  (ji,jj+1) + ht_0  (ji+1,jj+1)   )      & 
     1154                    &     / MAX(   ssmask(ji,jj  ) + ssmask(ji+1,jj  )          & 
     1155                    &            + ssmask(ji,jj+1) + ssmask(ji+1,jj+1) , 1._wp  ) 
     1156            END_2D 
    12101157         ENDIF 
    12111158         ! 
     
    12161163         DO jk = 1, jpkm1 
    12171164            DO jj = 1, jpjm1 
    1218                zhf(:,jj) = zhf(:,jj) + e3f_n(:,jj,jk) * umask(:,jj,jk) * umask(:,jj+1,jk) 
     1165               zhf(:,jj) = zhf(:,jj) + e3f(:,jj,jk) * umask(:,jj,jk) * umask(:,jj+1,jk) 
    12191166            END DO 
    12201167         END DO 
    12211168         CALL lbc_lnk( 'dynspg_ts', zhf, 'F', 1._wp ) 
    12221169         ! JC: TBC. hf should be greater than 0  
    1223          DO jj = 1, jpj 
    1224             DO ji = 1, jpi 
    1225                IF( zhf(ji,jj) /= 0._wp )   zwz(ji,jj) = 1._wp / zhf(ji,jj) 
    1226             END DO 
    1227          END DO 
     1170         DO_2D_11_11 
     1171            IF( zhf(ji,jj) /= 0._wp )   zwz(ji,jj) = 1._wp / zhf(ji,jj) 
     1172         END_2D 
    12281173         zwz(:,:) = ff_f(:,:) * zwz(:,:) 
    12291174      END SELECT 
     
    12331178 
    12341179 
    1235    SUBROUTINE dyn_cor_2d( hu_n, hv_n, un_b, vn_b, zhU, zhV,    zu_trd, zv_trd   ) 
     1180   SUBROUTINE dyn_cor_2d( phu, phv, punb, pvnb, zhU, zhV,    zu_trd, zv_trd   ) 
    12361181      !!--------------------------------------------------------------------- 
    12371182      !!                   ***  ROUTINE dyn_cor_2d  *** 
     
    12411186      INTEGER  ::   ji ,jj                             ! dummy loop indices 
    12421187      REAL(wp) ::   zx1, zx2, zy1, zy2, z1_hu, z1_hv   !   -      - 
    1243       REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: hu_n, hv_n, un_b, vn_b, zhU, zhV 
     1188      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: phu, phv, punb, pvnb, zhU, zhV 
    12441189      REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) :: zu_trd, zv_trd 
    12451190      !!---------------------------------------------------------------------- 
    12461191      SELECT CASE( nvor_scheme ) 
    12471192      CASE( np_ENT )                ! enstrophy conserving scheme (f-point) 
    1248          DO jj = 2, jpjm1 
    1249             DO ji = 2, jpim1 
    1250                z1_hu = ssumask(ji,jj) / ( hu_n(ji,jj) + 1._wp - ssumask(ji,jj) ) 
    1251                z1_hv = ssvmask(ji,jj) / ( hv_n(ji,jj) + 1._wp - ssvmask(ji,jj) ) 
    1252                zu_trd(ji,jj) = + r1_4 * r1_e1e2u(ji,jj) * z1_hu                    & 
    1253                   &               * (  e1e2t(ji+1,jj)*ht_n(ji+1,jj)*ff_t(ji+1,jj) * ( vn_b(ji+1,jj) + vn_b(ji+1,jj-1) )   & 
    1254                   &                  + e1e2t(ji  ,jj)*ht_n(ji  ,jj)*ff_t(ji  ,jj) * ( vn_b(ji  ,jj) + vn_b(ji  ,jj-1) )   ) 
    1255                   ! 
    1256                zv_trd(ji,jj) = - r1_4 * r1_e1e2v(ji,jj) * z1_hv                    & 
    1257                   &               * (  e1e2t(ji,jj+1)*ht_n(ji,jj+1)*ff_t(ji,jj+1) * ( un_b(ji,jj+1) + un_b(ji-1,jj+1) )   &  
    1258                   &                  + e1e2t(ji,jj  )*ht_n(ji,jj  )*ff_t(ji,jj  ) * ( un_b(ji,jj  ) + un_b(ji-1,jj  ) )   )  
    1259             END DO   
    1260          END DO   
     1193         DO_2D_00_00 
     1194            z1_hu = ssumask(ji,jj) / ( phu(ji,jj) + 1._wp - ssumask(ji,jj) ) 
     1195            z1_hv = ssvmask(ji,jj) / ( phv(ji,jj) + 1._wp - ssvmask(ji,jj) ) 
     1196            zu_trd(ji,jj) = + r1_4 * r1_e1e2u(ji,jj) * z1_hu                    & 
     1197               &               * (  e1e2t(ji+1,jj)*ht(ji+1,jj)*ff_t(ji+1,jj) * ( pvnb(ji+1,jj) + pvnb(ji+1,jj-1) )   & 
     1198               &                  + e1e2t(ji  ,jj)*ht(ji  ,jj)*ff_t(ji  ,jj) * ( pvnb(ji  ,jj) + pvnb(ji  ,jj-1) )   ) 
     1199               ! 
     1200            zv_trd(ji,jj) = - r1_4 * r1_e1e2v(ji,jj) * z1_hv                    & 
     1201               &               * (  e1e2t(ji,jj+1)*ht(ji,jj+1)*ff_t(ji,jj+1) * ( punb(ji,jj+1) + punb(ji-1,jj+1) )   &  
     1202               &                  + e1e2t(ji,jj  )*ht(ji,jj  )*ff_t(ji,jj  ) * ( punb(ji,jj  ) + punb(ji-1,jj  ) )   )  
     1203         END_2D 
    12611204         !          
    12621205      CASE( np_ENE , np_MIX )        ! energy conserving scheme (t-point) ENE or MIX 
    1263          DO jj = 2, jpjm1 
    1264             DO ji = fs_2, fs_jpim1   ! vector opt. 
    1265                zy1 = ( zhV(ji,jj-1) + zhV(ji+1,jj-1) ) * r1_e1u(ji,jj) 
    1266                zy2 = ( zhV(ji,jj  ) + zhV(ji+1,jj  ) ) * r1_e1u(ji,jj) 
    1267                zx1 = ( zhU(ji-1,jj) + zhU(ji-1,jj+1) ) * r1_e2v(ji,jj) 
    1268                zx2 = ( zhU(ji  ,jj) + zhU(ji  ,jj+1) ) * r1_e2v(ji,jj) 
    1269                ! energy conserving formulation for planetary vorticity term 
    1270                zu_trd(ji,jj) =   r1_4 * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 ) 
    1271                zv_trd(ji,jj) = - r1_4 * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 ) 
    1272             END DO 
    1273          END DO 
     1206         DO_2D_00_00 
     1207            zy1 = ( zhV(ji,jj-1) + zhV(ji+1,jj-1) ) * r1_e1u(ji,jj) 
     1208            zy2 = ( zhV(ji,jj  ) + zhV(ji+1,jj  ) ) * r1_e1u(ji,jj) 
     1209            zx1 = ( zhU(ji-1,jj) + zhU(ji-1,jj+1) ) * r1_e2v(ji,jj) 
     1210            zx2 = ( zhU(ji  ,jj) + zhU(ji  ,jj+1) ) * r1_e2v(ji,jj) 
     1211            ! energy conserving formulation for planetary vorticity term 
     1212            zu_trd(ji,jj) =   r1_4 * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 ) 
     1213            zv_trd(ji,jj) = - r1_4 * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 ) 
     1214         END_2D 
    12741215         ! 
    12751216      CASE( np_ENS )                ! enstrophy conserving scheme (f-point) 
    1276          DO jj = 2, jpjm1 
    1277             DO ji = fs_2, fs_jpim1   ! vector opt. 
    1278                zy1 =   r1_8 * ( zhV(ji  ,jj-1) + zhV(ji+1,jj-1) & 
    1279                  &            + zhV(ji  ,jj  ) + zhV(ji+1,jj  ) ) * r1_e1u(ji,jj) 
    1280                zx1 = - r1_8 * ( zhU(ji-1,jj  ) + zhU(ji-1,jj+1) & 
    1281                  &            + zhU(ji  ,jj  ) + zhU(ji  ,jj+1) ) * r1_e2v(ji,jj) 
    1282                zu_trd(ji,jj)  = zy1 * ( zwz(ji  ,jj-1) + zwz(ji,jj) ) 
    1283                zv_trd(ji,jj)  = zx1 * ( zwz(ji-1,jj  ) + zwz(ji,jj) ) 
    1284             END DO 
    1285          END DO 
     1217         DO_2D_00_00 
     1218            zy1 =   r1_8 * ( zhV(ji  ,jj-1) + zhV(ji+1,jj-1) & 
     1219              &            + zhV(ji  ,jj  ) + zhV(ji+1,jj  ) ) * r1_e1u(ji,jj) 
     1220            zx1 = - r1_8 * ( zhU(ji-1,jj  ) + zhU(ji-1,jj+1) & 
     1221              &            + zhU(ji  ,jj  ) + zhU(ji  ,jj+1) ) * r1_e2v(ji,jj) 
     1222            zu_trd(ji,jj)  = zy1 * ( zwz(ji  ,jj-1) + zwz(ji,jj) ) 
     1223            zv_trd(ji,jj)  = zx1 * ( zwz(ji-1,jj  ) + zwz(ji,jj) ) 
     1224         END_2D 
    12861225         ! 
    12871226      CASE( np_EET , np_EEN )      ! energy & enstrophy scheme (using e3t or e3f)          
    1288          DO jj = 2, jpjm1 
    1289             DO ji = fs_2, fs_jpim1   ! vector opt. 
    1290                zu_trd(ji,jj) = + r1_12 * r1_e1u(ji,jj) * (  ftne(ji,jj  ) * zhV(ji  ,jj  ) & 
    1291                 &                                         + ftnw(ji+1,jj) * zhV(ji+1,jj  ) & 
    1292                 &                                         + ftse(ji,jj  ) * zhV(ji  ,jj-1) & 
    1293                 &                                         + ftsw(ji+1,jj) * zhV(ji+1,jj-1) ) 
    1294                zv_trd(ji,jj) = - r1_12 * r1_e2v(ji,jj) * (  ftsw(ji,jj+1) * zhU(ji-1,jj+1) & 
    1295                 &                                         + ftse(ji,jj+1) * zhU(ji  ,jj+1) & 
    1296                 &                                         + ftnw(ji,jj  ) * zhU(ji-1,jj  ) & 
    1297                 &                                         + ftne(ji,jj  ) * zhU(ji  ,jj  ) ) 
    1298             END DO 
    1299          END DO 
     1227         DO_2D_00_00 
     1228            zu_trd(ji,jj) = + r1_12 * r1_e1u(ji,jj) * (  ftne(ji,jj  ) * zhV(ji  ,jj  ) & 
     1229             &                                         + ftnw(ji+1,jj) * zhV(ji+1,jj  ) & 
     1230             &                                         + ftse(ji,jj  ) * zhV(ji  ,jj-1) & 
     1231             &                                         + ftsw(ji+1,jj) * zhV(ji+1,jj-1) ) 
     1232            zv_trd(ji,jj) = - r1_12 * r1_e2v(ji,jj) * (  ftsw(ji,jj+1) * zhU(ji-1,jj+1) & 
     1233             &                                         + ftse(ji,jj+1) * zhU(ji  ,jj+1) & 
     1234             &                                         + ftnw(ji,jj  ) * zhU(ji-1,jj  ) & 
     1235             &                                         + ftne(ji,jj  ) * zhU(ji  ,jj  ) ) 
     1236         END_2D 
    13001237         ! 
    13011238      END SELECT 
     
    13221259      ! 
    13231260      IF( ln_wd_dl_rmp ) THEN      
    1324          DO jj = 1, jpj 
    1325             DO ji = 1, jpi                     
    1326                IF    ( pssh(ji,jj) + ht_0(ji,jj) >  2._wp * rn_wdmin1 ) THEN  
    1327                   !           IF    ( pssh(ji,jj) + ht_0(ji,jj) >          rn_wdmin2 ) THEN  
    1328                   ptmsk(ji,jj) = 1._wp 
    1329                ELSEIF( pssh(ji,jj) + ht_0(ji,jj) >          rn_wdmin1 ) THEN 
    1330                   ptmsk(ji,jj) = TANH( 50._wp*( ( pssh(ji,jj) + ht_0(ji,jj) -  rn_wdmin1 )*r_rn_wdmin1) ) 
    1331                ELSE  
    1332                   ptmsk(ji,jj) = 0._wp 
    1333                ENDIF 
    1334             END DO 
    1335          END DO 
     1261         DO_2D_11_11 
     1262            IF    ( pssh(ji,jj) + ht_0(ji,jj) >  2._wp * rn_wdmin1 ) THEN  
     1263               !           IF    ( pssh(ji,jj) + ht_0(ji,jj) >          rn_wdmin2 ) THEN  
     1264               ptmsk(ji,jj) = 1._wp 
     1265            ELSEIF( pssh(ji,jj) + ht_0(ji,jj) >          rn_wdmin1 ) THEN 
     1266               ptmsk(ji,jj) = TANH( 50._wp*( ( pssh(ji,jj) + ht_0(ji,jj) -  rn_wdmin1 )*r_rn_wdmin1) ) 
     1267            ELSE  
     1268               ptmsk(ji,jj) = 0._wp 
     1269            ENDIF 
     1270         END_2D 
    13361271      ELSE   
    1337          DO jj = 1, jpj 
    1338             DO ji = 1, jpi                               
    1339                IF ( pssh(ji,jj) + ht_0(ji,jj) >  rn_wdmin1 ) THEN   ;   ptmsk(ji,jj) = 1._wp 
    1340                ELSE                                                 ;   ptmsk(ji,jj) = 0._wp 
    1341                ENDIF 
    1342             END DO 
    1343          END DO 
     1272         DO_2D_11_11 
     1273            IF ( pssh(ji,jj) + ht_0(ji,jj) >  rn_wdmin1 ) THEN   ;   ptmsk(ji,jj) = 1._wp 
     1274            ELSE                                                 ;   ptmsk(ji,jj) = 0._wp 
     1275            ENDIF 
     1276         END_2D 
    13441277      ENDIF 
    13451278      ! 
     
    13651298      !!---------------------------------------------------------------------- 
    13661299      ! 
    1367       DO jj = 1, jpj 
    1368          DO ji = 1, jpim1   ! not jpi-column 
    1369             IF ( phU(ji,jj) > 0._wp ) THEN   ;   pUmsk(ji,jj) = pTmsk(ji  ,jj)  
    1370             ELSE                             ;   pUmsk(ji,jj) = pTmsk(ji+1,jj)   
    1371             ENDIF 
    1372             phU(ji,jj) = pUmsk(ji,jj)*phU(ji,jj) 
    1373             pu (ji,jj) = pUmsk(ji,jj)*pu (ji,jj) 
    1374          END DO 
    1375       END DO 
    1376       ! 
    1377       DO jj = 1, jpjm1   ! not jpj-row 
    1378          DO ji = 1, jpi 
    1379             IF ( phV(ji,jj) > 0._wp ) THEN   ;   pVmsk(ji,jj) = pTmsk(ji,jj  ) 
    1380             ELSE                             ;   pVmsk(ji,jj) = pTmsk(ji,jj+1)   
    1381             ENDIF 
    1382             phV(ji,jj) = pVmsk(ji,jj)*phV(ji,jj)  
    1383             pv (ji,jj) = pVmsk(ji,jj)*pv (ji,jj) 
    1384          END DO 
    1385       END DO 
     1300      DO_2D_11_10 
     1301         IF ( phU(ji,jj) > 0._wp ) THEN   ;   pUmsk(ji,jj) = pTmsk(ji  ,jj)  
     1302         ELSE                             ;   pUmsk(ji,jj) = pTmsk(ji+1,jj)   
     1303         ENDIF 
     1304         phU(ji,jj) = pUmsk(ji,jj)*phU(ji,jj) 
     1305         pu (ji,jj) = pUmsk(ji,jj)*pu (ji,jj) 
     1306      END_2D 
     1307      ! 
     1308      DO_2D_10_11 
     1309         IF ( phV(ji,jj) > 0._wp ) THEN   ;   pVmsk(ji,jj) = pTmsk(ji,jj  ) 
     1310         ELSE                             ;   pVmsk(ji,jj) = pTmsk(ji,jj+1)   
     1311         ENDIF 
     1312         phV(ji,jj) = pVmsk(ji,jj)*phV(ji,jj)  
     1313         pv (ji,jj) = pVmsk(ji,jj)*pv (ji,jj) 
     1314      END_2D 
    13861315      ! 
    13871316   END SUBROUTINE wad_Umsk 
    13881317 
    13891318 
    1390    SUBROUTINE wad_spg( sshn, zcpx, zcpy ) 
     1319   SUBROUTINE wad_spg( pshn, zcpx, zcpy ) 
    13911320      !!--------------------------------------------------------------------- 
    13921321      !!                   ***  ROUTINE  wad_sp  *** 
     
    13961325      INTEGER  ::   ji ,jj               ! dummy loop indices 
    13971326      LOGICAL  ::   ll_tmp1, ll_tmp2 
    1398       REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: sshn 
     1327      REAL(wp), DIMENSION(jpi,jpj), INTENT(in   ) :: pshn 
    13991328      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) :: zcpx, zcpy 
    14001329      !!---------------------------------------------------------------------- 
    1401       DO jj = 2, jpjm1 
    1402          DO ji = 2, jpim1  
    1403             ll_tmp1 = MIN(  sshn(ji,jj)               ,  sshn(ji+1,jj) ) >                & 
    1404                  &      MAX( -ht_0(ji,jj)               , -ht_0(ji+1,jj) ) .AND.            & 
    1405                  &      MAX(  sshn(ji,jj) + ht_0(ji,jj) ,  sshn(ji+1,jj) + ht_0(ji+1,jj) )  & 
    1406                  &                                                         > rn_wdmin1 + rn_wdmin2 
    1407             ll_tmp2 = ( ABS( sshn(ji+1,jj)            -  sshn(ji  ,jj))  > 1.E-12 ).AND.( & 
    1408                  &      MAX(   sshn(ji,jj)              ,  sshn(ji+1,jj) ) >                & 
    1409                  &      MAX(  -ht_0(ji,jj)              , -ht_0(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 ) 
    1410             IF(ll_tmp1) THEN 
    1411                zcpx(ji,jj) = 1.0_wp 
    1412             ELSEIF(ll_tmp2) THEN 
    1413                ! no worries about  sshn(ji+1,jj) -  sshn(ji  ,jj) = 0, it won't happen ! here 
    1414                zcpx(ji,jj) = ABS( (sshn(ji+1,jj) + ht_0(ji+1,jj) - sshn(ji,jj) - ht_0(ji,jj)) & 
    1415                     &    / (sshn(ji+1,jj) - sshn(ji  ,jj)) ) 
    1416                zcpx(ji,jj) = max(min( zcpx(ji,jj) , 1.0_wp),0.0_wp) 
    1417             ELSE 
    1418                zcpx(ji,jj) = 0._wp 
    1419             ENDIF 
    1420             ! 
    1421             ll_tmp1 = MIN(  sshn(ji,jj)               ,  sshn(ji,jj+1) ) >                & 
    1422                  &      MAX( -ht_0(ji,jj)               , -ht_0(ji,jj+1) ) .AND.            & 
    1423                  &      MAX(  sshn(ji,jj) + ht_0(ji,jj) ,  sshn(ji,jj+1) + ht_0(ji,jj+1) )  & 
    1424                  &                                                       > rn_wdmin1 + rn_wdmin2 
    1425             ll_tmp2 = ( ABS( sshn(ji,jj)              -  sshn(ji,jj+1))  > 1.E-12 ).AND.( & 
    1426                  &      MAX(   sshn(ji,jj)              ,  sshn(ji,jj+1) ) >                & 
    1427                  &      MAX(  -ht_0(ji,jj)              , -ht_0(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 ) 
    1428              
    1429             IF(ll_tmp1) THEN 
    1430                zcpy(ji,jj) = 1.0_wp 
    1431             ELSE IF(ll_tmp2) THEN 
    1432                ! no worries about  sshn(ji,jj+1) -  sshn(ji,jj  ) = 0, it won't happen ! here 
    1433                zcpy(ji,jj) = ABS( (sshn(ji,jj+1) + ht_0(ji,jj+1) - sshn(ji,jj) - ht_0(ji,jj)) & 
    1434                     &             / (sshn(ji,jj+1) - sshn(ji,jj  )) ) 
    1435                zcpy(ji,jj) = MAX(  0._wp , MIN( zcpy(ji,jj) , 1.0_wp )  ) 
    1436             ELSE 
    1437                zcpy(ji,jj) = 0._wp 
    1438             ENDIF 
    1439          END DO 
    1440       END DO 
     1330      DO_2D_00_00 
     1331         ll_tmp1 = MIN(  pshn(ji,jj)               ,  pshn(ji+1,jj) ) >                & 
     1332              &      MAX( -ht_0(ji,jj)               , -ht_0(ji+1,jj) ) .AND.            & 
     1333              &      MAX(  pshn(ji,jj) + ht_0(ji,jj) ,  pshn(ji+1,jj) + ht_0(ji+1,jj) )  & 
     1334              &                                                         > rn_wdmin1 + rn_wdmin2 
     1335         ll_tmp2 = ( ABS( pshn(ji+1,jj)            -  pshn(ji  ,jj))  > 1.E-12 ).AND.( & 
     1336              &      MAX(   pshn(ji,jj)              ,  pshn(ji+1,jj) ) >                & 
     1337              &      MAX(  -ht_0(ji,jj)              , -ht_0(ji+1,jj) ) + rn_wdmin1 + rn_wdmin2 ) 
     1338         IF(ll_tmp1) THEN 
     1339            zcpx(ji,jj) = 1.0_wp 
     1340         ELSEIF(ll_tmp2) THEN 
     1341            ! no worries about  pshn(ji+1,jj) -  pshn(ji  ,jj) = 0, it won't happen ! here 
     1342            zcpx(ji,jj) = ABS( (pshn(ji+1,jj) + ht_0(ji+1,jj) - pshn(ji,jj) - ht_0(ji,jj)) & 
     1343                 &           / (pshn(ji+1,jj) - pshn(ji  ,jj)) ) 
     1344            zcpx(ji,jj) = max(min( zcpx(ji,jj) , 1.0_wp),0.0_wp) 
     1345         ELSE 
     1346            zcpx(ji,jj) = 0._wp 
     1347         ENDIF 
     1348         ! 
     1349         ll_tmp1 = MIN(  pshn(ji,jj)               ,  pshn(ji,jj+1) ) >                & 
     1350              &      MAX( -ht_0(ji,jj)               , -ht_0(ji,jj+1) ) .AND.            & 
     1351              &      MAX(  pshn(ji,jj) + ht_0(ji,jj) ,  pshn(ji,jj+1) + ht_0(ji,jj+1) )  & 
     1352              &                                                       > rn_wdmin1 + rn_wdmin2 
     1353         ll_tmp2 = ( ABS( pshn(ji,jj)              -  pshn(ji,jj+1))  > 1.E-12 ).AND.( & 
     1354              &      MAX(   pshn(ji,jj)              ,  pshn(ji,jj+1) ) >                & 
     1355              &      MAX(  -ht_0(ji,jj)              , -ht_0(ji,jj+1) ) + rn_wdmin1 + rn_wdmin2 ) 
     1356          
     1357         IF(ll_tmp1) THEN 
     1358            zcpy(ji,jj) = 1.0_wp 
     1359         ELSE IF(ll_tmp2) THEN 
     1360            ! no worries about  pshn(ji,jj+1) -  pshn(ji,jj  ) = 0, it won't happen ! here 
     1361            zcpy(ji,jj) = ABS( (pshn(ji,jj+1) + ht_0(ji,jj+1) - pshn(ji,jj) - ht_0(ji,jj)) & 
     1362                 &           / (pshn(ji,jj+1) - pshn(ji,jj  )) ) 
     1363            zcpy(ji,jj) = MAX(  0._wp , MIN( zcpy(ji,jj) , 1.0_wp )  ) 
     1364         ELSE 
     1365            zcpy(ji,jj) = 0._wp 
     1366         ENDIF 
     1367      END_2D 
    14411368             
    14421369   END SUBROUTINE wad_spg 
     
    14441371 
    14451372 
    1446    SUBROUTINE dyn_drg_init( pu_RHSi, pv_RHSi, pCdU_u, pCdU_v ) 
     1373   SUBROUTINE dyn_drg_init( Kbb, Kmm, puu, pvv, puu_b ,pvv_b, pu_RHSi, pv_RHSi, pCdU_u, pCdU_v ) 
    14471374      !!---------------------------------------------------------------------- 
    14481375      !!                  ***  ROUTINE dyn_drg_init  *** 
     
    14541381      !! ** Method  :   computation done over the INNER domain only  
    14551382      !!---------------------------------------------------------------------- 
    1456       REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   pu_RHSi, pv_RHSi   ! baroclinic part of the barotropic RHS 
    1457       REAL(wp), DIMENSION(jpi,jpj), INTENT(  out) ::   pCdU_u , pCdU_v    ! barotropic drag coefficients 
     1383      INTEGER                             , INTENT(in   ) ::  Kbb, Kmm           ! ocean time level indices 
     1384      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(in   ) ::  puu, pvv           ! ocean velocities and RHS of momentum equation 
     1385      REAL(wp), DIMENSION(jpi,jpj,jpt)    , INTENT(in   ) ::  puu_b, pvv_b       ! barotropic velocities at main time levels 
     1386      REAL(wp), DIMENSION(jpi,jpj)        , INTENT(inout) ::  pu_RHSi, pv_RHSi   ! baroclinic part of the barotropic RHS 
     1387      REAL(wp), DIMENSION(jpi,jpj)        , INTENT(  out) ::  pCdU_u , pCdU_v    ! barotropic drag coefficients 
    14581388      ! 
    14591389      INTEGER  ::   ji, jj   ! dummy loop indices 
     
    14671397      IF( ln_isfcav ) THEN          ! top+bottom friction (ocean cavities) 
    14681398          
    1469          DO jj = 2, jpjm1 
    1470             DO ji = 2, jpim1     ! INNER domain 
    1471                pCdU_u(ji,jj) = r1_2*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) + rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) 
    1472                pCdU_v(ji,jj) = r1_2*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) + rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) 
    1473             END DO 
    1474          END DO 
     1399         DO_2D_00_00 
     1400            pCdU_u(ji,jj) = r1_2*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) + rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) 
     1401            pCdU_v(ji,jj) = r1_2*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) + rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) 
     1402         END_2D 
    14751403      ELSE                          ! bottom friction only 
    1476          DO jj = 2, jpjm1 
    1477             DO ji = 2, jpim1  ! INNER domain 
    1478                pCdU_u(ji,jj) = r1_2*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) 
    1479                pCdU_v(ji,jj) = r1_2*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) 
    1480             END DO 
    1481          END DO 
     1404         DO_2D_00_00 
     1405            pCdU_u(ji,jj) = r1_2*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) 
     1406            pCdU_v(ji,jj) = r1_2*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) 
     1407         END_2D 
    14821408      ENDIF 
    14831409      ! 
     
    14861412      IF( ln_bt_fw ) THEN                 ! FORWARD integration: use NOW bottom baroclinic velocities 
    14871413          
    1488          DO jj = 2, jpjm1 
    1489             DO ji = 2, jpim1  ! INNER domain 
    1490                ikbu = mbku(ji,jj)        
    1491                ikbv = mbkv(ji,jj)     
    1492                zu_i(ji,jj) = un(ji,jj,ikbu) - un_b(ji,jj) 
    1493                zv_i(ji,jj) = vn(ji,jj,ikbv) - vn_b(ji,jj) 
    1494             END DO 
    1495          END DO 
     1414         DO_2D_00_00 
     1415            ikbu = mbku(ji,jj)        
     1416            ikbv = mbkv(ji,jj)     
     1417            zu_i(ji,jj) = puu(ji,jj,ikbu,Kmm) - puu_b(ji,jj,Kmm) 
     1418            zv_i(ji,jj) = pvv(ji,jj,ikbv,Kmm) - pvv_b(ji,jj,Kmm) 
     1419         END_2D 
    14961420      ELSE                                ! CENTRED integration: use BEFORE bottom baroclinic velocities 
    14971421          
    1498          DO jj = 2, jpjm1 
    1499             DO ji = 2, jpim1   ! INNER domain 
    1500                ikbu = mbku(ji,jj)        
    1501                ikbv = mbkv(ji,jj)     
    1502                zu_i(ji,jj) = ub(ji,jj,ikbu) - ub_b(ji,jj) 
    1503                zv_i(ji,jj) = vb(ji,jj,ikbv) - vb_b(ji,jj) 
    1504             END DO 
    1505          END DO 
     1422         DO_2D_00_00 
     1423            ikbu = mbku(ji,jj)        
     1424            ikbv = mbkv(ji,jj)     
     1425            zu_i(ji,jj) = puu(ji,jj,ikbu,Kbb) - puu_b(ji,jj,Kbb) 
     1426            zv_i(ji,jj) = pvv(ji,jj,ikbv,Kbb) - pvv_b(ji,jj,Kbb) 
     1427         END_2D 
    15061428      ENDIF 
    15071429      ! 
    15081430      IF( ln_wd_il ) THEN      ! W/D : use the "clipped" bottom friction   !!gm   explain WHY, please ! 
    15091431         zztmp = -1._wp / rdtbt 
    1510          DO jj = 2, jpjm1 
    1511             DO ji = 2, jpim1    ! INNER domain 
    1512                pu_RHSi(ji,jj) = pu_RHSi(ji,jj) + zu_i(ji,jj) *  wdrampu(ji,jj) * MAX(                                 &  
    1513                     &                              r1_hu_n(ji,jj) * r1_2*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) , zztmp  ) 
    1514                pv_RHSi(ji,jj) = pv_RHSi(ji,jj) + zv_i(ji,jj) *  wdrampv(ji,jj) * MAX(                                 &  
    1515                     &                              r1_hv_n(ji,jj) * r1_2*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) , zztmp  ) 
    1516             END DO 
    1517          END DO 
     1432         DO_2D_00_00 
     1433            pu_RHSi(ji,jj) = pu_RHSi(ji,jj) + zu_i(ji,jj) *  wdrampu(ji,jj) * MAX(        &