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

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 13463 for NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/DYN/dynadv_ubs.F90 – NEMO

Ignore:
Timestamp:
2020-09-14T17:40:34+02:00 (4 years ago)
Author:
andmirek
Message:

Ticket #2195:update to trunk 13461

Location:
NEMO/branches/2019/dev_r11351_fldread_with_XIOS
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS

    • 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_r12970_AGRIF_CMEMS      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 
         8 
         9# SETTE 
         10^/utils/CI/sette@13382        sette 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/OCE/DYN/dynadv_ubs.F90

    r10425 r13463  
    3333 
    3434   !! * Substitutions 
    35 #  include "vectopt_loop_substitute.h90" 
     35#  include "do_loop_substitute.h90" 
     36#  include "domzgr_substitute.h90" 
    3637   !!---------------------------------------------------------------------- 
    3738   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 
    … …  
    4142CONTAINS 
    4243 
    43    SUBROUTINE dyn_adv_ubs( kt ) 
     44   SUBROUTINE dyn_adv_ubs( kt, Kbb, Kmm, puu, pvv, Krhs ) 
    4445      !!---------------------------------------------------------------------- 
    4546      !!                  ***  ROUTINE dyn_adv_ubs  *** 
    … …  
    6465      !!      gamma1=1/3 and gamma2=1/32. 
    6566      !! 
    66       !! ** Action : - (ua,va) updated with the 3D advective momentum trends 
     67      !! ** Action : - (puu(:,:,:,Krhs),pvv(:,:,:,Krhs)) updated with the 3D advective momentum trends 
    6768      !! 
    6869      !! Reference : Shchepetkin & McWilliams, 2005, Ocean Modelling.  
    6970      !!---------------------------------------------------------------------- 
    70       INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
     71      INTEGER                             , INTENT( in )  ::  kt              ! ocean time-step index 
     72      INTEGER                             , INTENT( in )  ::  Kbb, Kmm, Krhs  ! ocean time level indices 
     73      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::  puu, pvv        ! ocean velocities and RHS of momentum equation 
    7174      ! 
    7275      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    … …  
    9598      ! 
    9699      IF( l_trddyn ) THEN           ! trends: store the input trends 
    97          zfu_uw(:,:,:) = ua(:,:,:) 
    98          zfv_vw(:,:,:) = va(:,:,:) 
     100         zfu_uw(:,:,:) = puu(:,:,:,Krhs) 
     101         zfv_vw(:,:,:) = pvv(:,:,:,Krhs) 
    99102      ENDIF 
    100103      !                                      ! =========================== ! 
    … …  
    102105         !                                   ! =========================== ! 
    103106         !                                         ! horizontal volume fluxes 
    104          zfu(:,:,jk) = e2u(:,:) * e3u_n(:,:,jk) * un(:,:,jk) 
    105          zfv(:,:,jk) = e1v(:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 
     107         zfu(:,:,jk) = e2u(:,:) * e3u(:,:,jk,Kmm) * puu(:,:,jk,Kmm) 
     108         zfv(:,:,jk) = e1v(:,:) * e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) 
    106109         !             
    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 
     110         DO_2D( 0, 0, 0, 0 ) 
     111            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) 
     112            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) 
     113            zlu_uv(ji,jj,jk,1) = ( puu (ji  ,jj+1,jk,Kbb) - puu (ji  ,jj  ,jk,Kbb) ) * fmask(ji  ,jj  ,jk)   & 
     114               &               - ( puu (ji  ,jj  ,jk,Kbb) - puu (ji  ,jj-1,jk,Kbb) ) * fmask(ji  ,jj-1,jk) 
     115            zlv_vu(ji,jj,jk,1) = ( pvv (ji+1,jj  ,jk,Kbb) - pvv (ji  ,jj  ,jk,Kbb) ) * fmask(ji  ,jj  ,jk)   & 
     116               &               - ( pvv (ji  ,jj  ,jk,Kbb) - pvv (ji-1,jj  ,jk,Kbb) ) * fmask(ji-1,jj  ,jk) 
     117            ! 
     118            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) 
     119            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) 
     120            zlu_uv(ji,jj,jk,2) = ( zfu(ji  ,jj+1,jk) - zfu(ji  ,jj  ,jk) ) * fmask(ji  ,jj  ,jk)   & 
     121               &               - ( zfu(ji  ,jj  ,jk) - zfu(ji  ,jj-1,jk) ) * fmask(ji  ,jj-1,jk) 
     122            zlv_vu(ji,jj,jk,2) = ( zfv(ji+1,jj  ,jk) - zfv(ji  ,jj  ,jk) ) * fmask(ji  ,jj  ,jk)   & 
     123               &               - ( zfv(ji  ,jj  ,jk) - zfv(ji-1,jj  ,jk) ) * fmask(ji-1,jj  ,jk) 
     124         END_2D 
    124125      END DO 
    125       CALL lbc_lnk_multi( 'dynadv_ubs', zlu_uu(:,:,:,1), 'U', 1. , zlu_uv(:,:,:,1), 'U', 1.,  & 
    126                       &   zlu_uu(:,:,:,2), 'U', 1. , zlu_uv(:,:,:,2), 'U', 1.,  &  
    127                       &   zlv_vv(:,:,:,1), 'V', 1. , zlv_vu(:,:,:,1), 'V', 1.,  & 
    128                       &   zlv_vv(:,:,:,2), 'V', 1. , zlv_vu(:,:,:,2), 'V', 1.   ) 
     126      CALL lbc_lnk_multi( 'dynadv_ubs', zlu_uu(:,:,:,1), 'U', 1.0_wp , zlu_uv(:,:,:,1), 'U', 1.0_wp,  & 
     127                      &   zlu_uu(:,:,:,2), 'U', 1.0_wp , zlu_uv(:,:,:,2), 'U', 1.0_wp,  &  
     128                      &   zlv_vv(:,:,:,1), 'V', 1.0_wp , zlv_vu(:,:,:,1), 'V', 1.0_wp,  & 
     129                      &   zlv_vv(:,:,:,2), 'V', 1.0_wp , zlv_vu(:,:,:,2), 'V', 1.0_wp   ) 
    129130      ! 
    130131      !                                      ! ====================== ! 
    … …  
    132133      DO jk = 1, jpkm1                       ! ====================== ! 
    133134         !                                         ! 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) 
     135         zfu(:,:,jk) = 0.25_wp * e2u(:,:) * e3u(:,:,jk,Kmm) * puu(:,:,jk,Kmm) 
     136         zfv(:,:,jk) = 0.25_wp * e1v(:,:) * e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) 
    136137         ! 
    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 
     138         DO_2D( 1, 0, 1, 0 ) 
     139            zui = ( puu(ji,jj,jk,Kmm) + puu(ji+1,jj  ,jk,Kmm) ) 
     140            zvj = ( pvv(ji,jj,jk,Kmm) + pvv(ji  ,jj+1,jk,Kmm) ) 
     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               &                * ( puu(ji,jj,jk,Kmm) + puu(ji  ,jj+1,jk,Kmm) - 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               &                * ( pvv(ji,jj,jk,Kmm) + pvv(ji+1,jj  ,jk,Kmm) - gamma1 * zl_v ) 
     169         END_2D 
     170         DO_2D( 0, 0, 0, 0 ) 
     171            puu(ji,jj,jk,Krhs) = puu(ji,jj,jk,Krhs) - (  zfu_t(ji+1,jj,jk) - zfu_t(ji,jj  ,jk)    & 
     172               &                           + zfv_f(ji  ,jj,jk) - zfv_f(ji,jj-1,jk)  ) * r1_e1e2u(ji,jj)   & 
     173               &                           / e3u(ji,jj,jk,Kmm) 
     174            pvv(ji,jj,jk,Krhs) = pvv(ji,jj,jk,Krhs) - (  zfu_f(ji,jj  ,jk) - zfu_f(ji-1,jj,jk)    & 
     175               &                           + zfv_t(ji,jj+1,jk) - zfv_t(ji  ,jj,jk)  ) * r1_e1e2v(ji,jj)   & 
     176               &                           / e3v(ji,jj,jk,Kmm) 
     177         END_2D 
    179178      END DO 
    180179      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(:,:,:) 
     180         zfu_uw(:,:,:) = puu(:,:,:,Krhs) - zfu_uw(:,:,:) 
     181         zfv_vw(:,:,:) = pvv(:,:,:,Krhs) - zfv_vw(:,:,:) 
     182         CALL trd_dyn( zfu_uw, zfv_vw, jpdyn_keg, kt, Kmm ) 
     183         zfu_t(:,:,:) = puu(:,:,:,Krhs) 
     184         zfv_t(:,:,:) = pvv(:,:,:,Krhs) 
    186185      ENDIF 
    187186      !                                      ! ==================== ! 
    188187      !                                      !  Vertical advection  ! 
    189188      !                                      ! ==================== ! 
    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 
     189      DO_2D( 0, 0, 0, 0 ) 
     190         zfu_uw(ji,jj,jpk) = 0._wp 
     191         zfv_vw(ji,jj,jpk) = 0._wp 
     192         zfu_uw(ji,jj, 1 ) = 0._wp 
     193         zfv_vw(ji,jj, 1 ) = 0._wp 
     194      END_2D 
     195      IF( ln_linssh ) THEN                         ! constant volume : advection through the surface 
     196         DO_2D( 0, 0, 0, 0 ) 
     197            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) 
     198            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) 
     199         END_2D 
     200      ENDIF 
     201      DO jk = 2, jpkm1                          ! interior fluxes 
     202         DO_2D( 0, 1, 0, 1 ) 
     203            zfw(ji,jj,jk) = 0.25_wp * e1e2t(ji,jj) * ww(ji,jj,jk) 
     204         END_2D 
     205         DO_2D( 0, 0, 0, 0 ) 
     206            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) ) 
     207            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) ) 
     208         END_2D 
    197209      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 
     210      DO_3D( 0, 0, 0, 0, 1, jpkm1 ) 
     211         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)   & 
     212            &                                       / e3u(ji,jj,jk,Kmm) 
     213         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)   & 
     214            &                                       / e3v(ji,jj,jk,Kmm) 
     215      END_3D 
    227216      ! 
    228217      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 ) 
     218         zfu_t(:,:,:) = puu(:,:,:,Krhs) - zfu_t(:,:,:) 
     219         zfv_t(:,:,:) = pvv(:,:,:,Krhs) - zfv_t(:,:,:) 
     220         CALL trd_dyn( zfu_t, zfv_t, jpdyn_zad, kt, Kmm ) 
    232221      ENDIF 
    233222      !                                         ! 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' ) 
     223      IF(sn_cfctl%l_prtctl)   CALL prt_ctl( tab3d_1=puu(:,:,:,Krhs), clinfo1=' ubs2 adv - Ua: ', mask1=umask,   & 
     224         &                                  tab3d_2=pvv(:,:,:,Krhs), clinfo2=           ' Va: ', mask2=vmask, clinfo3='dyn' ) 
    236225      ! 
    237226   END SUBROUTINE dyn_adv_ubs 
Note: See TracChangeset for help on using the changeset viewer.