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 10874 – NEMO

Changeset 10874


Ignore:
Timestamp:
2019-04-15T15:57:37+02:00 (4 years ago)
Author:
davestorkey
Message:

branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps : Revert all changes so far in preparation for implementation of new design.

Location:
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src
Files:
38 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/DOM/dom_oce.F90

    r10806 r10874  
    6464 
    6565   !!---------------------------------------------------------------------- 
    66    !! time level indices 
    67    !!---------------------------------------------------------------------- 
    68    INTEGER, PUBLIC :: Nm1, Nnn, Np1, Nrhs, Nm1_2lev, Nnn_2lev 
    69  
    70    !!---------------------------------------------------------------------- 
    7166   !! space domain parameters 
    7267   !!---------------------------------------------------------------------- 
    … …  
    134129   LOGICAL, PUBLIC ::   ln_sco       !: s-coordinate or hybrid z-s coordinate 
    135130   LOGICAL, PUBLIC ::   ln_isfcav    !: presence of ISF  
    136    !                                                        !  reference scale factors 
    137    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3t_0  !: t- vert. scale factor [m] 
    138    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3u_0  !: u- vert. scale factor [m] 
    139    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3v_0  !: v- vert. scale factor [m] 
    140    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3f_0  !: f- vert. scale factor [m] 
    141    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3w_0  !: w- vert. scale factor [m] 
    142    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::    e3uw_0  !: uw-vert. scale factor [m] 
    143    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::    e3vw_0  !: vw-vert. scale factor [m] 
    144    !                                                        !  time-dependent scale factors 
    145    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:,:,:) ::   e3t, e3u, e3v, e3w, e3uw, e3vw  !: vert. scale factor [m] 
    146    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:,:) ::     e3f                             !: F-point vert. scale factor [m] 
    147  
    148    !                                                        !  reference depths of cells 
    149    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdept_0   !: t- depth              [m] 
    150    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdepw_0   !: w- depth              [m] 
    151    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gde3w_0   !: w- depth (sum of e3w) [m] 
    152    !                                                        !  time-dependent depths of cells 
    153    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:,:,:) ::  gdept, gdepw   
    154    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:,:)   ::  gde3w   
     131   !                                                        !  ref.   ! before  !   now   ! after  ! 
     132   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3t_0 ,   e3t_b ,   e3t_n ,  e3t_a   !: t- vert. scale factor [m] 
     133   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3u_0 ,   e3u_b ,   e3u_n ,  e3u_a   !: u- vert. scale factor [m] 
     134   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3v_0 ,   e3v_b ,   e3v_n ,  e3v_a   !: v- vert. scale factor [m] 
     135   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3f_0           ,   e3f_n            !: f- vert. scale factor [m] 
     136   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::     e3w_0 ,   e3w_b ,   e3w_n            !: w- vert. scale factor [m] 
     137   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::    e3uw_0 ,  e3uw_b ,  e3uw_n            !: uw-vert. scale factor [m] 
     138   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::    e3vw_0 ,  e3vw_b ,  e3vw_n            !: vw-vert. scale factor [m] 
     139 
     140   !                                                        !  ref.   ! before  !   now   ! 
     141   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdept_0 , gdept_b , gdept_n   !: t- depth              [m] 
     142   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gdepw_0 , gdepw_b , gdepw_n   !: w- depth              [m] 
     143   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gde3w_0           , gde3w_n   !: w- depth (sum of e3w) [m] 
    155144    
    156145   !                                                      !  ref. ! before  !   now   !  after  ! 
    … …  
    160149   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::           r1_hu_b , r1_hu_n , r1_hu_a   !: inverse of u-depth [1/m] 
    161150   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::           r1_hv_b , r1_hv_n , r1_hv_a   !: inverse of v-depth [1/m] 
    162  
    163    !! TEMPORARY POINTERS FOR DEVELOPMENT ONLY 
    164    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:) ::     e3t_b ,   e3t_n ,  e3t_a   !: t- vert. scale factor [m] 
    165    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:) ::     e3u_b ,   e3u_n ,  e3u_a   !: u- vert. scale factor [m] 
    166    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:) ::     e3v_b ,   e3v_n ,  e3v_a   !: v- vert. scale factor [m] 
    167    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:) ::               e3f_n            !: f- vert. scale factor [m] 
    168    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:) ::     e3w_b ,   e3w_n            !: w- vert. scale factor [m] 
    169    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:) ::    e3uw_b ,  e3uw_n            !: uw-vert. scale factor [m] 
    170    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:) ::    e3vw_b ,  e3vw_n            !: vw-vert. scale factor [m] 
    171    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:) ::    gdept_b , gdept_n           !: t- depth              [m]     
    172    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:) ::    gdepw_b , gdepw_n           !: w- depth              [m] 
    173    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:) ::    gde3w_n                     !: w- depth (sum of e3w) [m] 
    174    !! TEMPORARY POINTERS FOR DEVELOPMENT ONLY 
    175151 
    176152   INTEGER, PUBLIC ::   nla10              !: deepest    W level Above  ~10m (nlb10 - 1) 
    … …  
    280256         &      ff_f (jpi,jpj) ,    ff_t (jpi,jpj)                                     , STAT=ierr(3) ) 
    281257         ! 
    282       ALLOCATE( gdept_0(jpi,jpj,jpk)       , gdepw_0(jpi,jpj,jpk)       , gde3w_0(jpi,jpj,jpk) ,              & 
    283          &      gdept  (jpi,jpj,jpk,jpt-1) , gdepw  (jpi,jpj,jpk,jpt-1) , gde3w  (jpi,jpj,jpk) , STAT=ierr(4) ) 
    284          ! 
    285       ALLOCATE( e3t_0(jpi,jpj,jpk)       , e3u_0(jpi,jpj,jpk)       , e3v_0(jpi,jpj,jpk)       , e3f_0(jpi,jpj,jpk) ,    & 
    286          &      e3w_0(jpi,jpj,jpk)       , e3uw_0(jpi,jpj,jpk)      , e3vw_0(jpi,jpj,jpk)      ,                         & 
    287          &      e3t  (jpi,jpj,jpk,jpt)   , e3u  (jpi,jpj,jpk,jpt)   , e3v  (jpi,jpj,jpk,jpt)   ,                         &  
    288          &      e3w  (jpi,jpj,jpk,jpt-1) , e3uw (jpi,jpj,jpk,jpt-1) , e3vw (jpi,jpj,jpk,jpt-1) ,                         &  
    289          &      e3f  (jpi,jpj,jpk),     STAT=ierr(5) )                        
     258      ALLOCATE( gdept_0(jpi,jpj,jpk) , gdepw_0(jpi,jpj,jpk) , gde3w_0(jpi,jpj,jpk) ,      & 
     259         &      gdept_b(jpi,jpj,jpk) , gdepw_b(jpi,jpj,jpk) ,                             & 
     260         &      gdept_n(jpi,jpj,jpk) , gdepw_n(jpi,jpj,jpk) , gde3w_n(jpi,jpj,jpk) , STAT=ierr(4) ) 
     261         ! 
     262      ALLOCATE( e3t_0(jpi,jpj,jpk) , e3u_0(jpi,jpj,jpk) , e3v_0(jpi,jpj,jpk) , e3f_0(jpi,jpj,jpk) , e3w_0(jpi,jpj,jpk) ,   & 
     263         &      e3t_b(jpi,jpj,jpk) , e3u_b(jpi,jpj,jpk) , e3v_b(jpi,jpj,jpk) ,                      e3w_b(jpi,jpj,jpk) ,   &  
     264         &      e3t_n(jpi,jpj,jpk) , e3u_n(jpi,jpj,jpk) , e3v_n(jpi,jpj,jpk) , e3f_n(jpi,jpj,jpk) , e3w_n(jpi,jpj,jpk) ,   &  
     265         &      e3t_a(jpi,jpj,jpk) , e3u_a(jpi,jpj,jpk) , e3v_a(jpi,jpj,jpk) ,                                             & 
     266         !                                                          ! 
     267         &      e3uw_0(jpi,jpj,jpk) , e3vw_0(jpi,jpj,jpk) ,         & 
     268         &      e3uw_b(jpi,jpj,jpk) , e3vw_b(jpi,jpj,jpk) ,         &                
     269         &      e3uw_n(jpi,jpj,jpk) , e3vw_n(jpi,jpj,jpk) ,     STAT=ierr(5) )                        
    290270         ! 
    291271      ALLOCATE( ht_0(jpi,jpj) , hu_0(jpi,jpj) , hv_0(jpi,jpj) ,                                           & 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/DYN/dynadv.F90

    r10789 r10874  
    5353CONTAINS 
    5454 
    55    SUBROUTINE dyn_adv( kt, ktlev1, ktlev2, pu_rhs, pv_rhs ) 
     55   SUBROUTINE dyn_adv( kt ) 
    5656      !!--------------------------------------------------------------------- 
    5757      !!                  ***  ROUTINE dyn_adv  *** 
    … …  
    6767      !!---------------------------------------------------------------------- 
    6868      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    69       INTEGER, INTENT( in ) ::   ktlev1, ktlev2   ! time level indices for source terms 
    70       REAL(wp), INTENT( inout), DIMENSION(jpi,jpj,jpk) :: pu_rhs, pv_rhs ! momentum trends 
    7169      !!---------------------------------------------------------------------- 
    7270      ! 
    … …  
    7573      SELECT CASE( n_dynadv )    !==  compute advection trend and add it to general trend  ==! 
    7674      CASE( np_VEC_c2  )      
    77          CALL dyn_keg     ( kt, ktlev2, nn_dynkeg, pu_rhs, pv_rhs )    ! vector form : horizontal gradient of kinetic energy 
    78          CALL dyn_zad     ( kt, ktlev2,            pu_rhs, pv_rhs )    ! vector form : vertical advection 
     75         CALL dyn_keg     ( kt, nn_dynkeg )    ! vector form : horizontal gradient of kinetic energy 
     76         CALL dyn_zad     ( kt )               ! vector form : vertical advection 
    7977      CASE( np_FLX_c2  )  
    80          CALL dyn_adv_cen2( kt, ktlev2,            pu_rhs, pv_rhs )    ! 2nd order centered scheme 
     78         CALL dyn_adv_cen2( kt )               ! 2nd order centered scheme 
    8179      CASE( np_FLX_ubs )    
    82          CALL dyn_adv_ubs ( kt, ktlev1, ktlev2,    pu_rhs, pv_rhs )               ! 3rd order UBS      scheme (UP3) 
     80         CALL dyn_adv_ubs ( kt )               ! 3rd order UBS      scheme (UP3) 
    8381      END SELECT 
    8482      ! 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/DYN/dynadv_cen2.F90

    r10789 r10874  
    3535CONTAINS 
    3636 
    37    SUBROUTINE dyn_adv_cen2( kt, ktlev, pu_rhs, pv_rhs ) 
     37   SUBROUTINE dyn_adv_cen2( kt ) 
    3838      !!---------------------------------------------------------------------- 
    3939      !!                  ***  ROUTINE dyn_adv_cen2  *** 
    … …  
    4444      !! ** Method  :   Trend evaluated using now fields (centered in time)  
    4545      !! 
    46       !! ** Action  :   (pu_rhs,pv_rhs) updated with the now vorticity term trend 
     46      !! ** Action  :   (ua,va) updated with the now vorticity term trend 
    4747      !!---------------------------------------------------------------------- 
    48       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
    49       INTEGER, INTENT( in ) ::   ktlev   ! time level index for source terms 
    50       REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) :: pu_rhs, pv_rhs ! momentum trends 
     48      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    5149      ! 
    5250      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    … …  
    6260      ! 
    6361      IF( l_trddyn ) THEN           ! trends: store the input trends 
    64          zfu_uw(:,:,:) = pu_rhs(:,:,:) 
    65          zfv_vw(:,:,:) = pv_rhs(:,:,:) 
     62         zfu_uw(:,:,:) = ua(:,:,:) 
     63         zfv_vw(:,:,:) = va(:,:,:) 
    6664      ENDIF 
    6765      ! 
    … …  
    6967      ! 
    7068      DO jk = 1, jpkm1                    ! horizontal transport 
    71          zfu(:,:,jk) = 0.25_wp * e2u(:,:) * e3u(:,:,jk,ktlev) * uu(:,:,jk,ktlev) 
    72          zfv(:,:,jk) = 0.25_wp * e1v(:,:) * e3v(:,:,jk,ktlev) * vv(:,:,jk,ktlev) 
     69         zfu(:,:,jk) = 0.25_wp * e2u(:,:) * e3u_n(:,:,jk) * un(:,:,jk) 
     70         zfv(:,:,jk) = 0.25_wp * e1v(:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 
    7371         DO jj = 1, jpjm1                 ! horizontal momentum fluxes (at T- and F-point) 
    7472            DO ji = 1, fs_jpim1   ! vector opt. 
    75                zfu_t(ji+1,jj  ,jk) = ( zfu(ji,jj,jk) + zfu(ji+1,jj,jk) ) * ( uu(ji,jj,jk,ktlev) + uu(ji+1,jj  ,jk,ktlev) ) 
    76                zfv_f(ji  ,jj  ,jk) = ( zfv(ji,jj,jk) + zfv(ji+1,jj,jk) ) * ( uu(ji,jj,jk,ktlev) + uu(ji  ,jj+1,jk,ktlev) ) 
    77                zfu_f(ji  ,jj  ,jk) = ( zfu(ji,jj,jk) + zfu(ji,jj+1,jk) ) * ( vv(ji,jj,jk,ktlev) + vv(ji+1,jj  ,jk,ktlev) ) 
    78                zfv_t(ji  ,jj+1,jk) = ( zfv(ji,jj,jk) + zfv(ji,jj+1,jk) ) * ( vv(ji,jj,jk,ktlev) + vv(ji  ,jj+1,jk,ktlev) ) 
     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) ) 
    7977            END DO 
    8078         END DO 
    8179         DO jj = 2, jpjm1                 ! divergence of horizontal momentum fluxes 
    8280            DO ji = fs_2, fs_jpim1   ! vector opt. 
    83                pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) - (  zfu_t(ji+1,jj,jk) - zfu_t(ji,jj  ,jk)    & 
    84                   &                           + zfv_f(ji  ,jj,jk) - zfv_f(ji,jj-1,jk)  ) * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,ktlev) 
    85                pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) - (  zfu_f(ji,jj  ,jk) - zfu_f(ji-1,jj,jk)    & 
    86                   &                           + zfv_t(ji,jj+1,jk) - zfv_t(ji  ,jj,jk)  ) * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,ktlev) 
     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) 
    8785            END DO 
    8886         END DO 
    … …  
    9088      ! 
    9189      IF( l_trddyn ) THEN           ! trends: send trend to trddyn for diagnostic 
    92          zfu_uw(:,:,:) = pu_rhs(:,:,:) - zfu_uw(:,:,:) 
    93          zfv_vw(:,:,:) = pv_rhs(:,:,:) - zfv_vw(:,:,:) 
     90         zfu_uw(:,:,:) = ua(:,:,:) - zfu_uw(:,:,:) 
     91         zfv_vw(:,:,:) = va(:,:,:) - zfv_vw(:,:,:) 
    9492         CALL trd_dyn( zfu_uw, zfv_vw, jpdyn_keg, kt ) 
    95          zfu_t(:,:,:) = pu_rhs(:,:,:) 
    96          zfv_t(:,:,:) = pv_rhs(:,:,:) 
     93         zfu_t(:,:,:) = ua(:,:,:) 
     94         zfv_t(:,:,:) = va(:,:,:) 
    9795      ENDIF 
    9896      ! 
    … …  
    108106         DO jj = 2, jpjm1 
    109107            DO ji = fs_2, fs_jpim1 
    110                zfu_uw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * ww(ji,jj,1) + e1e2t(ji+1,jj) * ww(ji+1,jj,1) ) * uu(ji,jj,1,ktlev) 
    111                zfv_vw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * ww(ji,jj,1) + e1e2t(ji,jj+1) * ww(ji,jj+1,1) ) * vv(ji,jj,1,ktlev) 
     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) 
    112110            END DO 
    113111         END DO 
    … …  
    116114         DO jj = 2, jpj                       ! 1/4 * Vertical transport 
    117115            DO ji = 2, jpi 
    118                zfw(ji,jj,jk) = 0.25_wp * e1e2t(ji,jj) * ww(ji,jj,jk) 
     116               zfw(ji,jj,jk) = 0.25_wp * e1e2t(ji,jj) * wn(ji,jj,jk) 
    119117            END DO 
    120118         END DO 
    121119         DO jj = 2, jpjm1 
    122120            DO ji = fs_2, fs_jpim1   ! vector opt. 
    123                zfu_uw(ji,jj,jk) = ( zfw(ji,jj,jk) + zfw(ji+1,jj  ,jk) ) * ( uu(ji,jj,jk,ktlev) + uu(ji,jj,jk-1,ktlev) ) 
    124                zfv_vw(ji,jj,jk) = ( zfw(ji,jj,jk) + zfw(ji  ,jj+1,jk) ) * ( vv(ji,jj,jk,ktlev) + vv(ji,jj,jk-1,ktlev) ) 
     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) ) 
    125123            END DO 
    126124         END DO 
    … …  
    129127         DO jj = 2, jpjm1  
    130128            DO ji = fs_2, fs_jpim1   ! vector opt. 
    131                pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,ktlev) 
    132                pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) - ( zfv_vw(ji,jj,jk) - zfv_vw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,ktlev) 
     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) 
    133131            END DO 
    134132         END DO 
    … …  
    136134      ! 
    137135      IF( l_trddyn ) THEN                 ! trends: send trend to trddyn for diagnostic 
    138          zfu_t(:,:,:) = pu_rhs(:,:,:) - zfu_t(:,:,:) 
    139          zfv_t(:,:,:) = pv_rhs(:,:,:) - zfv_t(:,:,:) 
     136         zfu_t(:,:,:) = ua(:,:,:) - zfu_t(:,:,:) 
     137         zfv_t(:,:,:) = va(:,:,:) - zfv_t(:,:,:) 
    140138         CALL trd_dyn( zfu_t, zfv_t, jpdyn_zad, kt ) 
    141139      ENDIF 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/DYN/dynadv_ubs.F90

    r10802 r10874  
    4141CONTAINS 
    4242 
    43    SUBROUTINE dyn_adv_ubs( kt, ktlev1, ktlev2, pu_rhs, pv_rhs ) 
     43   SUBROUTINE dyn_adv_ubs( kt ) 
    4444      !!---------------------------------------------------------------------- 
    4545      !!                  ***  ROUTINE dyn_adv_ubs  *** 
    … …  
    6464      !!      gamma1=1/3 and gamma2=1/32. 
    6565      !! 
    66       !! ** Action : - (pu_rhs,pv_rhs) updated with the 3D advective momentum trends 
     66      !! ** Action : - (ua,va) 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 
    71       INTEGER, INTENT(in) ::   ktlev1, ktlev2   ! time level indices for source terms 
    72       REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) :: pu_rhs, pv_rhs ! momentum trends 
     70      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    7371      ! 
    7472      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    … …  
    9795      ! 
    9896      IF( l_trddyn ) THEN           ! trends: store the input trends 
    99          zfu_uw(:,:,:) = pu_rhs(:,:,:) 
    100          zfv_vw(:,:,:) = pv_rhs(:,:,:) 
     97         zfu_uw(:,:,:) = ua(:,:,:) 
     98         zfv_vw(:,:,:) = va(:,:,:) 
    10199      ENDIF 
    102100      !                                      ! =========================== ! 
    … …  
    104102         !                                   ! =========================== ! 
    105103         !                                         ! horizontal volume fluxes 
    106          zfu(:,:,jk) = e2u(:,:) * e3u(:,:,jk,ktlev2) * uu(:,:,jk,ktlev2) 
    107          zfv(:,:,jk) = e1v(:,:) * e3v(:,:,jk,ktlev2) * vv(:,:,jk,ktlev2) 
     104         zfu(:,:,jk) = e2u(:,:) * e3u_n(:,:,jk) * un(:,:,jk) 
     105         zfv(:,:,jk) = e1v(:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 
    108106         !             
    109107         DO jj = 2, jpjm1                          ! laplacian 
    110108            DO ji = fs_2, fs_jpim1   ! vector opt. 
    111                zlu_uu(ji,jj,jk,1) = ( uu (ji+1,jj  ,jk,ktlev1) - 2.*uu (ji,jj,jk,ktlev1) + uu (ji-1,jj  ,jk,ktlev1) ) * umask(ji,jj,jk) 
    112                zlv_vv(ji,jj,jk,1) = ( vv (ji  ,jj+1,jk,ktlev1) - 2.*vv (ji,jj,jk,ktlev1) + vv (ji  ,jj-1,jk,ktlev1) ) * vmask(ji,jj,jk) 
    113                zlu_uv(ji,jj,jk,1) = ( uu (ji  ,jj+1,jk,ktlev1) - uu (ji  ,jj  ,jk,ktlev1) ) * fmask(ji  ,jj  ,jk)   & 
    114                   &               - ( uu (ji  ,jj  ,jk,ktlev1) - uu (ji  ,jj-1,jk,ktlev1) ) * fmask(ji  ,jj-1,jk) 
    115                zlv_vu(ji,jj,jk,1) = ( vv (ji+1,jj  ,jk,ktlev1) - vv (ji  ,jj  ,jk,ktlev1) ) * fmask(ji  ,jj  ,jk)   & 
    116                   &               - ( vv (ji  ,jj  ,jk,ktlev1) - vv (ji-1,jj  ,jk,ktlev1) ) * fmask(ji-1,jj  ,jk) 
     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) 
    117115               ! 
    118116               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) 
    … …  
    134132      DO jk = 1, jpkm1                       ! ====================== ! 
    135133         !                                         ! horizontal volume fluxes 
    136          zfu(:,:,jk) = 0.25_wp * e2u(:,:) * e3u(:,:,jk,ktlev2) * uu(:,:,jk,ktlev2) 
    137          zfv(:,:,jk) = 0.25_wp * e1v(:,:) * e3v(:,:,jk,ktlev2) * vv(:,:,jk,ktlev2) 
     134         zfu(:,:,jk) = 0.25_wp * e2u(:,:) * e3u_n(:,:,jk) * un(:,:,jk) 
     135         zfv(:,:,jk) = 0.25_wp * e1v(:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 
    138136         ! 
    139137         DO jj = 1, jpjm1                          ! horizontal momentum fluxes at T- and F-point 
    140138            DO ji = 1, fs_jpim1   ! vector opt. 
    141                zui = ( uu(ji,jj,jk,ktlev2) + uu(ji+1,jj  ,jk,ktlev2) ) 
    142                zvj = ( vv(ji,jj,jk,ktlev2) + vv(ji  ,jj+1,jk,ktlev2) ) 
     139               zui = ( un(ji,jj,jk) + un(ji+1,jj  ,jk) ) 
     140               zvj = ( vn(ji,jj,jk) + vn(ji  ,jj+1,jk) ) 
    143141               ! 
    144142               IF( zui > 0 ) THEN   ;   zl_u = zlu_uu(ji  ,jj,jk,1) 
    … …  
    166164               ! 
    167165               zfv_f(ji  ,jj  ,jk) = ( zfvi - gamma2 * ( zlv_vu(ji,jj,jk,2) + zlv_vu(ji+1,jj  ,jk,2) )  )   & 
    168                   &                * ( uu(ji,jj,jk,ktlev2) + uu(ji  ,jj+1,jk,ktlev2) - gamma1 * zl_u ) 
     166                  &                * ( un(ji,jj,jk) + un(ji  ,jj+1,jk) - gamma1 * zl_u ) 
    169167               zfu_f(ji  ,jj  ,jk) = ( zfuj - gamma2 * ( zlu_uv(ji,jj,jk,2) + zlu_uv(ji  ,jj+1,jk,2) )  )   & 
    170                   &                * ( vv(ji,jj,jk,ktlev2) + vv(ji+1,jj  ,jk,ktlev2) - gamma1 * zl_v ) 
     168                  &                * ( vn(ji,jj,jk) + vn(ji+1,jj  ,jk) - gamma1 * zl_v ) 
    171169            END DO 
    172170         END DO 
    173171         DO jj = 2, jpjm1                          ! divergence of horizontal momentum fluxes 
    174172            DO ji = fs_2, fs_jpim1   ! vector opt. 
    175                pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) - (  zfu_t(ji+1,jj,jk) - zfu_t(ji,jj  ,jk)    & 
    176                   &                           + zfv_f(ji  ,jj,jk) - zfv_f(ji,jj-1,jk)  ) * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,ktlev2) 
    177                pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) - (  zfu_f(ji,jj  ,jk) - zfu_f(ji-1,jj,jk)    & 
    178                   &                           + zfv_t(ji,jj+1,jk) - zfv_t(ji  ,jj,jk)  ) * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,ktlev2) 
     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) 
    179177            END DO 
    180178         END DO 
    181179      END DO 
    182180      IF( l_trddyn ) THEN                          ! trends: send trends to trddyn for diagnostic 
    183          zfu_uw(:,:,:) = pu_rhs(:,:,:) - zfu_uw(:,:,:) 
    184          zfv_vw(:,:,:) = pv_rhs(:,:,:) - zfv_vw(:,:,:) 
     181         zfu_uw(:,:,:) = ua(:,:,:) - zfu_uw(:,:,:) 
     182         zfv_vw(:,:,:) = va(:,:,:) - zfv_vw(:,:,:) 
    185183         CALL trd_dyn( zfu_uw, zfv_vw, jpdyn_keg, kt ) 
    186          zfu_t(:,:,:) = pu_rhs(:,:,:) 
    187          zfv_t(:,:,:) = pv_rhs(:,:,:) 
     184         zfu_t(:,:,:) = ua(:,:,:) 
     185         zfv_t(:,:,:) = va(:,:,:) 
    188186      ENDIF 
    189187      !                                      ! ==================== ! 
    … …  
    201199         DO jj = 2, jpjm1 
    202200            DO ji = fs_2, fs_jpim1 
    203                zfu_uw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * ww(ji,jj,1) + e1e2t(ji+1,jj) * ww(ji+1,jj,1) ) * uu(ji,jj,1,ktlev2) 
    204                zfv_vw(ji,jj,1) = 0.5_wp * ( e1e2t(ji,jj) * ww(ji,jj,1) + e1e2t(ji,jj+1) * ww(ji,jj+1,1) ) * vv(ji,jj,1,ktlev2) 
     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) 
    205203            END DO 
    206204         END DO 
    … …  
    209207         DO jj = 2, jpj 
    210208            DO ji = 2, jpi 
    211                zfw(ji,jj,jk) = 0.25_wp * e1e2t(ji,jj) * ww(ji,jj,jk) 
     209               zfw(ji,jj,jk) = 0.25_wp * e1e2t(ji,jj) * wn(ji,jj,jk) 
    212210            END DO 
    213211         END DO 
    214212         DO jj = 2, jpjm1 
    215213            DO ji = fs_2, fs_jpim1   ! vector opt. 
    216                zfu_uw(ji,jj,jk) = ( zfw(ji,jj,jk)+ zfw(ji+1,jj,jk) ) * ( uu(ji,jj,jk,ktlev2) + uu(ji,jj,jk-1,ktlev2) ) 
    217                zfv_vw(ji,jj,jk) = ( zfw(ji,jj,jk)+ zfw(ji,jj+1,jk) ) * ( vv(ji,jj,jk,ktlev2) + vv(ji,jj,jk-1,ktlev2) ) 
     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) ) 
    218216            END DO 
    219217         END DO 
    … …  
    222220         DO jj = 2, jpjm1 
    223221            DO ji = fs_2, fs_jpim1   ! vector opt. 
    224                pu_rhs(ji,jj,jk) =  pu_rhs(ji,jj,jk) - ( zfu_uw(ji,jj,jk) - zfu_uw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,ktlev2) 
    225                pv_rhs(ji,jj,jk) =  pv_rhs(ji,jj,jk) - ( zfv_vw(ji,jj,jk) - zfv_vw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,ktlev2) 
     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) 
    226224            END DO 
    227225         END DO 
    … …  
    229227      ! 
    230228      IF( l_trddyn ) THEN                       ! save the vertical advection trend for diagnostic 
    231          zfu_t(:,:,:) = pu_rhs(:,:,:) - zfu_t(:,:,:) 
    232          zfv_t(:,:,:) = pv_rhs(:,:,:) - zfv_t(:,:,:) 
     229         zfu_t(:,:,:) = ua(:,:,:) - zfu_t(:,:,:) 
     230         zfv_t(:,:,:) = va(:,:,:) - zfv_t(:,:,:) 
    233231         CALL trd_dyn( zfu_t, zfv_t, jpdyn_zad, kt ) 
    234232      ENDIF 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/DYN/dynkeg.F90

    r10789 r10874  
    4444CONTAINS 
    4545 
    46    SUBROUTINE dyn_keg( kt, ktlev, kscheme, pu_rhs, pv_rhs ) 
     46   SUBROUTINE dyn_keg( kt, kscheme ) 
    4747      !!---------------------------------------------------------------------- 
    4848      !!                  ***  ROUTINE dyn_keg  *** 
    … …  
    5454      !! ** Method  : * kscheme = nkeg_C2 : 2nd order centered scheme that  
    5555      !!      conserve kinetic energy. Compute the now horizontal kinetic energy  
    56       !!         zhke = 1/2 [ mi-1( uu(:,:,:,ktlev)^2 ) + mj-1( vv(:,:,:,ktlev)^2 ) ] 
     56      !!         zhke = 1/2 [ mi-1( un^2 ) + mj-1( vn^2 ) ] 
    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 * uu(:,:,:,ktlev)^2 + ((uu(j+1,ktlev)+uu(j-1,ktlev))/2)^2  ) 
    60       !!                    + mj-1(  2 * vv(:,:,:,ktlev)^2 + ((vv(i+1,ktlev)+vv(i-1,ktlev))/2)^2  ) ] 
     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  ) ] 
    6161      !!       
    6262      !!      Take its horizontal gradient and add it to the general momentum 
    63       !!      trend (pu_rhs,pv_rhs). 
    64       !!         pu_rhs = pu_rhs - 1/e1u di[ zhke ] 
    65       !!         pv_rhs = pv_rhs - 1/e2v dj[ zhke ] 
     63      !!      trend (ua,va). 
     64      !!         ua = ua - 1/e1u di[ zhke ] 
     65      !!         va = va - 1/e2v dj[ zhke ] 
    6666      !! 
    67       !! ** Action : - Update the (pu_rhs, pv_rhs) with the hor. ke gradient trend 
     67      !! ** Action : - Update the (ua, va) with the hor. ke gradient trend 
    6868      !!             - send this trends to trd_dyn (l_trddyn=T) for post-processing 
    6969      !! 
    … …  
    7272      !!---------------------------------------------------------------------- 
    7373      INTEGER, INTENT( in ) ::   kt        ! ocean time-step index 
    74       INTEGER, INTENT( in ) ::   ktlev     ! time level index for source terms 
    7574      INTEGER, INTENT( in ) ::   kscheme   ! =0/1   type of KEG scheme  
    76       REAL(wp), INTENT( inout), DIMENSION(jpi,jpj,jpk) :: pu_rhs, pv_rhs ! momentum trends 
    7775      ! 
    7876      INTEGER  ::   ji, jj, jk, jb    ! dummy loop indices 
    … …  
    9492      IF( l_trddyn ) THEN           ! Save the input trends 
    9593         ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) ) 
    96          ztrdu(:,:,:) = pu_rhs(:,:,:)  
    97          ztrdv(:,:,:) = pv_rhs(:,:,:)  
     94         ztrdu(:,:,:) = ua(:,:,:)  
     95         ztrdv(:,:,:) = va(:,:,:)  
    9896      ENDIF 
    9997       
    … …  
    111109                     ij   = idx_bdy(ib_bdy)%nbj(jb,igrd) 
    112110                     ifu   = NINT( idx_bdy(ib_bdy)%flagu(jb,igrd) ) 
    113                      uu(ii-ifu,ij,jk,ktlev) = uu(ii,ij,jk,ktlev) * umask(ii,ij,jk) 
     111                     un(ii-ifu,ij,jk) = un(ii,ij,jk) * umask(ii,ij,jk) 
    114112                  END DO 
    115113               END DO 
    … …  
    121119                     ij   = idx_bdy(ib_bdy)%nbj(jb,igrd) 
    122120                     ifv   = NINT( idx_bdy(ib_bdy)%flagv(jb,igrd) ) 
    123                      vv(ii,ij-ifv,jk,ktlev) = vv(ii,ij,jk,ktlev) * vmask(ii,ij,jk) 
     121                     vn(ii,ij-ifv,jk) = vn(ii,ij,jk) * vmask(ii,ij,jk) 
    124122                  END DO 
    125123               END DO 
    … …  
    134132            DO jj = 2, jpj 
    135133               DO ji = fs_2, jpi   ! vector opt. 
    136                   zu =    uu(ji-1,jj  ,jk,ktlev) * uu(ji-1,jj  ,jk,ktlev)   & 
    137                      &  + uu(ji  ,jj  ,jk,ktlev) * uu(ji  ,jj  ,jk,ktlev) 
    138                   zv =    vv(ji  ,jj-1,jk,ktlev) * vv(ji  ,jj-1,jk,ktlev)   & 
    139                      &  + vv(ji  ,jj  ,jk,ktlev) * vv(ji  ,jj  ,jk,ktlev) 
     134                  zu =    un(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)   & 
     135                     &  + un(ji  ,jj  ,jk) * un(ji  ,jj  ,jk) 
     136                  zv =    vn(ji  ,jj-1,jk) * vn(ji  ,jj-1,jk)   & 
     137                     &  + vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk) 
    140138                  zhke(ji,jj,jk) = 0.25_wp * ( zv + zu ) 
    141139               END DO   
    … …  
    147145            DO jj = 2, jpjm1        
    148146               DO ji = fs_2, jpim1   ! vector opt. 
    149                   zu = 8._wp * ( uu(ji-1,jj  ,jk,ktlev) * uu(ji-1,jj  ,jk,ktlev)    & 
    150                      &         + uu(ji  ,jj  ,jk,ktlev) * uu(ji  ,jj  ,jk,ktlev) )  & 
    151                      &   +     ( uu(ji-1,jj-1,jk,ktlev) + uu(ji-1,jj+1,jk,ktlev) ) * ( uu(ji-1,jj-1,jk,ktlev) + uu(ji-1,jj+1,jk,ktlev) )   & 
    152                      &   +     ( uu(ji  ,jj-1,jk,ktlev) + uu(ji  ,jj+1,jk,ktlev) ) * ( uu(ji  ,jj-1,jk,ktlev) + uu(ji  ,jj+1,jk,ktlev) ) 
     147                  zu = 8._wp * ( un(ji-1,jj  ,jk) * un(ji-1,jj  ,jk)    & 
     148                     &         + un(ji  ,jj  ,jk) * un(ji  ,jj  ,jk) )  & 
     149                     &   +     ( un(ji-1,jj-1,jk) + un(ji-1,jj+1,jk) ) * ( un(ji-1,jj-1,jk) + un(ji-1,jj+1,jk) )   & 
     150                     &   +     ( un(ji  ,jj-1,jk) + un(ji  ,jj+1,jk) ) * ( un(ji  ,jj-1,jk) + un(ji  ,jj+1,jk) ) 
    153151                     ! 
    154                   zv = 8._wp * ( vv(ji  ,jj-1,jk,ktlev) * vv(ji  ,jj-1,jk,ktlev)    & 
    155                      &         + vv(ji  ,jj  ,jk,ktlev) * vv(ji  ,jj  ,jk,ktlev) )  & 
    156                      &  +      ( vv(ji-1,jj-1,jk,ktlev) + vv(ji+1,jj-1,jk,ktlev) ) * ( vv(ji-1,jj-1,jk,ktlev) + vv(ji+1,jj-1,jk,ktlev) )   & 
    157                      &  +      ( vv(ji-1,jj  ,jk,ktlev) + vv(ji+1,jj  ,jk,ktlev) ) * ( vv(ji-1,jj  ,jk,ktlev) + vv(ji+1,jj  ,jk,ktlev) ) 
     152                  zv = 8._wp * ( vn(ji  ,jj-1,jk) * vn(ji  ,jj-1,jk)    & 
     153                     &         + vn(ji  ,jj  ,jk) * vn(ji  ,jj  ,jk) )  & 
     154                     &  +      ( vn(ji-1,jj-1,jk) + vn(ji+1,jj-1,jk) ) * ( vn(ji-1,jj-1,jk) + vn(ji+1,jj-1,jk) )   & 
     155                     &  +      ( vn(ji-1,jj  ,jk) + vn(ji+1,jj  ,jk) ) * ( vn(ji-1,jj  ,jk) + vn(ji+1,jj  ,jk) ) 
    158156                  zhke(ji,jj,jk) = r1_48 * ( zv + zu ) 
    159157               END DO   
    … …  
    166164      IF (ln_bdy) THEN 
    167165         ! restore velocity masks at points outside boundary 
    168          uu(:,:,:,ktlev) = uu(:,:,:,ktlev) * umask(:,:,:) 
    169          vv(:,:,:,ktlev) = vv(:,:,:,ktlev) * vmask(:,:,:) 
     166         un(:,:,:) = un(:,:,:) * umask(:,:,:) 
     167         vn(:,:,:) = vn(:,:,:) * vmask(:,:,:) 
    170168      ENDIF       
    171169 
    … …  
    174172         DO jj = 2, jpjm1 
    175173            DO ji = fs_2, fs_jpim1   ! vector opt. 
    176                pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) - ( zhke(ji+1,jj  ,jk) - zhke(ji,jj,jk) ) / e1u(ji,jj) 
    177                pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) - ( zhke(ji  ,jj+1,jk) - zhke(ji,jj,jk) ) / e2v(ji,jj) 
     174               ua(ji,jj,jk) = ua(ji,jj,jk) - ( zhke(ji+1,jj  ,jk) - zhke(ji,jj,jk) ) / e1u(ji,jj) 
     175               va(ji,jj,jk) = va(ji,jj,jk) - ( zhke(ji  ,jj+1,jk) - zhke(ji,jj,jk) ) / e2v(ji,jj) 
    178176            END DO  
    179177         END DO 
    … …  
    181179      ! 
    182180      IF( l_trddyn ) THEN                 ! save the Kinetic Energy trends for diagnostic 
    183          ztrdu(:,:,:) = pu_rhs(:,:,:) - ztrdu(:,:,:) 
    184          ztrdv(:,:,:) = pv_rhs(:,:,:) - ztrdv(:,:,:) 
     181         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
     182         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    185183         CALL trd_dyn( ztrdu, ztrdv, jpdyn_keg, kt ) 
    186184         DEALLOCATE( ztrdu , ztrdv ) 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/DYN/dynldf.F90

    r10806 r10874  
    4343CONTAINS 
    4444 
    45    SUBROUTINE dyn_ldf( kt, ktlev1, ktlev2, pu_rhs, pv_rhs ) 
     45   SUBROUTINE dyn_ldf( kt ) 
    4646      !!---------------------------------------------------------------------- 
    4747      !!                  ***  ROUTINE dyn_ldf  *** 
    … …  
    4949      !! ** Purpose :   compute the lateral ocean dynamics physics. 
    5050      !!---------------------------------------------------------------------- 
    51       INTEGER, INTENT(in) ::   kt               ! ocean time-step index 
    52       INTEGER, INTENT(in) ::   ktlev1, ktlev2   ! time level index for source terms 
    53       REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) :: pu_rhs, pv_rhs ! momentum trends 
     51      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    5452      ! 
    5553      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdu, ztrdv 
    … …  
    6058      IF( l_trddyn )   THEN                      ! temporary save of momentum trends 
    6159         ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) ) 
    62          ztrdu(:,:,:) = pu_rhs(:,:,:)  
    63          ztrdv(:,:,:) = pv_rhs(:,:,:)  
     60         ztrdu(:,:,:) = ua(:,:,:)  
     61         ztrdv(:,:,:) = va(:,:,:)  
    6462      ENDIF 
    6563 
    6664      SELECT CASE ( nldf_dyn )                   ! compute lateral mixing trend and add it to the general trend 
    6765      ! 
    68       CASE ( np_lap   )    ;   CALL dyn_ldf_lap( kt, ktlev1, ktlev2, uu(:,:,:,ktlev1), vv(:,:,:,ktlev1), pu_rhs, pv_rhs, 1 )      ! iso-level    laplacian 
     66      CASE ( np_lap   )    ;   CALL dyn_ldf_lap( kt, ub, vb, ua, va, 1 )      ! iso-level    laplacian 
    6967      CASE ( np_lap_i )    ;   CALL dyn_ldf_iso( kt )                         ! rotated      laplacian 
    70       CASE ( np_blp   )    ;   CALL dyn_ldf_blp( kt, ktlev1, ktlev2, uu(:,:,:,ktlev1), vv(:,:,:,ktlev1), pu_rhs, pv_rhs    )      ! iso-level bi-laplacian 
     68      CASE ( np_blp   )    ;   CALL dyn_ldf_blp( kt, ub, vb, ua, va    )      ! iso-level bi-laplacian 
    7169      ! 
    7270      END SELECT 
    7371 
    7472      IF( l_trddyn ) THEN                        ! save the horizontal diffusive trends for further diagnostics 
    75          ztrdu(:,:,:) = pu_rhs(:,:,:) - ztrdu(:,:,:) 
    76          ztrdv(:,:,:) = pv_rhs(:,:,:) - ztrdv(:,:,:) 
     73         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
     74         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    7775         CALL trd_dyn( ztrdu, ztrdv, jpdyn_ldf, kt ) 
    7876         DEALLOCATE ( ztrdu , ztrdv ) 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/DYN/dynldf_lap_blp.F90

    r10806 r10874  
    3535CONTAINS 
    3636 
    37    SUBROUTINE dyn_ldf_lap( kt, ktlev1, ktlev2, pu, pv, pu_rhs, pva_rhs, kpass ) 
     37   SUBROUTINE dyn_ldf_lap( kt, pub, pvb, pua, pva, 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 : - pu_rhs, pva_rhs increased by the harmonic operator applied on pu, pv. 
     47      !! ** Action : - pua, pva increased by the harmonic operator applied on pub, pvb. 
    4848      !!---------------------------------------------------------------------- 
    49       INTEGER                         , INTENT(in   ) ::   kt              ! ocean time-step index 
    50       INTEGER                         , INTENT(in   ) ::   ktlev1, ktlev2  ! time level index for scale factors 
     49      INTEGER                         , INTENT(in   ) ::   kt         ! ocean time-step index 
    5150      INTEGER                         , INTENT(in   ) ::   kpass      ! =1/2 first or second passage 
    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, pva_rhs   ! velocity trend   [m/s2] 
     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] 
    5453      ! 
    5554      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    … …  
    7776!!gm open question here : e3f  at before or now ?    probably now... 
    7877!!gm note that ahmf has already been multiplied by fmask 
    79                zcur(ji-1,jj-1) = ahmf(ji-1,jj-1,jk) * e3f(ji-1,jj-1,jk) * r1_e1e2f(ji-1,jj-1)       & 
    80                   &     * (  e2v(ji  ,jj-1) * pv(ji  ,jj-1,jk) - e2v(ji-1,jj-1) * pv(ji-1,jj-1,jk)  & 
    81                   &        - e1u(ji-1,jj  ) * pu(ji-1,jj  ,jk) + e1u(ji-1,jj-1) * pu(ji-1,jj-1,jk)  ) 
     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)  ) 
    8281               !                                      ! ahm * div        (computed from 2 to jpi/jpj) 
    8382!!gm note that ahmt has already been multiplied by tmask 
    84                zdiv(ji,jj)     = ahmt(ji,jj,jk) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,ktlev1)                                         & 
    85                   &     * (  e2u(ji,jj)*e3u(ji,jj,jk,ktlev1) * pu(ji,jj,jk) - e2u(ji-1,jj)*e3u(ji-1,jj,jk,ktlev1) * pu(ji-1,jj,jk)  & 
    86                   &        + e1v(ji,jj)*e3v(ji,jj,jk,ktlev1) * pv(ji,jj,jk) - e1v(ji,jj-1)*e3v(ji,jj-1,jk,ktlev1) * pv(ji,jj-1,jk)  ) 
     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)  ) 
    8786            END DO   
    8887         END DO   
    … …  
    9089         DO jj = 2, jpjm1                             ! - curl( curl) + grad( div ) 
    9190            DO ji = fs_2, fs_jpim1   ! vector opt. 
    92                pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zsign * (                                                 & 
    93                   &              - ( zcur(ji  ,jj) - zcur(ji,jj-1) ) * r1_e2u(ji,jj) / e3u(ji,jj,jk,ktlev2)   & 
     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)   & 
    9493                  &              + ( zdiv(ji+1,jj) - zdiv(ji,jj  ) ) * r1_e1u(ji,jj)                     ) 
    9594                  ! 
    96                pva_rhs(ji,jj,jk) = pva_rhs(ji,jj,jk) + zsign * (                                                 & 
    97                   &                ( zcur(ji,jj  ) - zcur(ji-1,jj) ) * r1_e1v(ji,jj) / e3v(ji,jj,jk,ktlev2)   & 
     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)   & 
    9897                  &              + ( zdiv(ji,jj+1) - zdiv(ji  ,jj) ) * r1_e2v(ji,jj)                     ) 
    9998            END DO 
    … …  
    106105 
    107106 
    108    SUBROUTINE dyn_ldf_blp( kt, ktlev1, ktlev2, pu, pv, pu_rhs, pva_rhs ) 
     107   SUBROUTINE dyn_ldf_blp( kt, pub, pvb, pua, pva ) 
    109108      !!---------------------------------------------------------------------- 
    110109      !!                 ***  ROUTINE dyn_ldf_blp  *** 
    … …  
    117116      !!      It is computed by two successive calls to dyn_ldf_lap routine 
    118117      !! 
    119       !! ** Action :   pt_rhs   updated with the before rotated bilaplacian diffusion 
     118      !! ** Action :   pta   updated with the before rotated bilaplacian diffusion 
    120119      !!---------------------------------------------------------------------- 
    121120      INTEGER                         , INTENT(in   ) ::   kt         ! ocean time-step index 
    122       INTEGER                         , INTENT(in   ) ::   ktlev1, ktlev2  ! time level index for scale factors 
    123       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(in   ) ::   pu, pv   ! before velocity fields 
    124       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu_rhs, pva_rhs   ! momentum trend 
     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 
    125123      ! 
    126124      REAL(wp), DIMENSION(jpi,jpj,jpk) ::   zulap, zvlap   ! laplacian at u- and v-point 
    … …  
    136134      zvlap(:,:,:) = 0._wp 
    137135      ! 
    138       CALL dyn_ldf_lap( kt, ktlev1, ktlev2, pu, pv, zulap, zvlap, 1 )   ! rotated laplacian applied to pt (output in zlap) 
     136      CALL dyn_ldf_lap( kt, pub, pvb, zulap, zvlap, 1 )   ! rotated laplacian applied to ptb (output in zlap) 
    139137      ! 
    140138      CALL lbc_lnk_multi( 'dynldf_lap_blp', zulap, 'U', -1., zvlap, 'V', -1. )             ! Lateral boundary conditions 
    141139      ! 
    142       CALL dyn_ldf_lap( kt, ktlev1, ktlev2, zulap, zvlap, pu_rhs, pva_rhs, 2 )   ! rotated laplacian applied to zlap (output in pt_rhs) 
     140      CALL dyn_ldf_lap( kt, zulap, zvlap, pua, pva, 2 )   ! rotated laplacian applied to zlap (output in pta) 
    143141      ! 
    144142   END SUBROUTINE dyn_ldf_blp 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/DYN/dynvor.F90

    r10806 r10874  
    9696CONTAINS 
    9797 
    98    SUBROUTINE dyn_vor( kt, ktlev, pu_rhs, pv_rhs ) 
     98   SUBROUTINE dyn_vor( kt ) 
    9999      !!---------------------------------------------------------------------- 
    100100      !! 
    101101      !! ** Purpose :   compute the lateral ocean tracer physics. 
    102102      !! 
    103       !! ** Action : - Update (pu_rhs,pv_rhs) with the now vorticity term trend 
     103      !! ** Action : - Update (ua,va) with the now vorticity term trend 
    104104      !!             - save the trends in (ztrdu,ztrdv) in 2 parts (relative 
    105105      !!               and planetary vorticity trends) and send them to trd_dyn  
    106106      !!               for futher diagnostics (l_trddyn=T) 
    107107      !!---------------------------------------------------------------------- 
    108       INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
    109       INTEGER, INTENT( in ) ::   ktlev   ! time level index for source terms 
    110       REAL(wp), INTENT( inout), DIMENSION(jpi,jpj,jpk) :: pu_rhs, pv_rhs ! momentum trends 
     108      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    111109      ! 
    112110      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::  ztrdu, ztrdv 
    … …  
    119117         ALLOCATE( ztrdu(jpi,jpj,jpk), ztrdv(jpi,jpj,jpk) ) 
    120118         ! 
    121          ztrdu(:,:,:) = pu_rhs(:,:,:)            !* planetary vorticity trend (including Stokes-Coriolis force) 
    122          ztrdv(:,:,:) = pv_rhs(:,:,:) 
     119         ztrdu(:,:,:) = ua(:,:,:)            !* planetary vorticity trend (including Stokes-Coriolis force) 
     120         ztrdv(:,:,:) = va(:,:,:) 
    123121         SELECT CASE( nvor_scheme ) 
    124          CASE( np_ENS )           ;   CALL vor_ens( kt, ktlev, ncor, uu(:,:,:,ktlev) , vv(:,:,:,ktlev) , pu_rhs, pv_rhs )   ! enstrophy conserving scheme 
    125             IF( ln_stcor )            CALL vor_ens( kt, ktlev, ncor, usd, vsd, pu_rhs, pv_rhs )   ! add the Stokes-Coriolis trend 
    126          CASE( np_ENE, np_MIX )   ;   CALL vor_ene( kt, ktlev, ncor, uu(:,:,:,ktlev) , vv(:,:,:,ktlev) , pu_rhs, pv_rhs )   ! energy conserving scheme 
    127             IF( ln_stcor )            CALL vor_ene( kt, ktlev, ncor, usd, vsd, pu_rhs, pv_rhs )   ! add the Stokes-Coriolis trend 
    128          CASE( np_ENT )           ;   CALL vor_enT( kt, ktlev, ncor, uu(:,:,:,ktlev) , vv(:,:,:,ktlev) , pu_rhs, pv_rhs )   ! energy conserving scheme (T-pts) 
    129             IF( ln_stcor )            CALL vor_enT( kt, ktlev, ncor, usd, vsd, pu_rhs, pv_rhs )   ! add the Stokes-Coriolis trend 
    130          CASE( np_EET )           ;   CALL vor_eeT( kt, ktlev, ncor, uu(:,:,:,ktlev) , vv(:,:,:,ktlev) , pu_rhs, pv_rhs )   ! energy conserving scheme (een with e3t) 
    131             IF( ln_stcor )            CALL vor_eeT( kt, ktlev, ncor, usd, vsd, pu_rhs, pv_rhs )   ! add the Stokes-Coriolis trend 
    132          CASE( np_EEN )           ;   CALL vor_een( kt, ktlev, ncor, uu(:,:,:,ktlev) , vv(:,:,:,ktlev) , pu_rhs, pv_rhs )   ! energy & enstrophy scheme 
    133             IF( ln_stcor )            CALL vor_een( kt, ktlev, ncor, usd, vsd, pu_rhs, pv_rhs )   ! add the Stokes-Coriolis trend 
     122         CASE( np_ENS )           ;   CALL vor_ens( kt, ncor, un , vn , ua, va )   ! enstrophy conserving scheme 
     123            IF( ln_stcor )            CALL vor_ens( kt, ncor, usd, vsd, ua, va )   ! add the Stokes-Coriolis trend 
     124         CASE( np_ENE, np_MIX )   ;   CALL vor_ene( kt, ncor, un , vn , ua, va )   ! energy conserving scheme 
     125            IF( ln_stcor )            CALL vor_ene( kt, ncor, usd, vsd, ua, va )   ! add the Stokes-Coriolis trend 
     126         CASE( np_ENT )           ;   CALL vor_enT( kt, ncor, un , vn , ua, va )   ! energy conserving scheme (T-pts) 
     127            IF( ln_stcor )            CALL vor_enT( kt, ncor, usd, vsd, ua, va )   ! add the Stokes-Coriolis trend 
     128         CASE( np_EET )           ;   CALL vor_eeT( kt, ncor, un , vn , ua, va )   ! energy conserving scheme (een with e3t) 
     129            IF( ln_stcor )            CALL vor_eeT( kt, ncor, usd, vsd, ua, va )   ! add the Stokes-Coriolis trend 
     130         CASE( np_EEN )           ;   CALL vor_een( kt, ncor, un , vn , ua, va )   ! energy & enstrophy scheme 
     131            IF( ln_stcor )            CALL vor_een( kt, ncor, usd, vsd, ua, va )   ! add the Stokes-Coriolis trend 
    134132         END SELECT 
    135          ztrdu(:,:,:) = pu_rhs(:,:,:) - ztrdu(:,:,:) 
    136          ztrdv(:,:,:) = pv_rhs(:,:,:) - ztrdv(:,:,:) 
     133         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
     134         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    137135         CALL trd_dyn( ztrdu, ztrdv, jpdyn_pvo, kt ) 
    138136         ! 
    139137         IF( n_dynadv /= np_LIN_dyn ) THEN   !* relative vorticity or metric trend (only in non-linear case) 
    140             ztrdu(:,:,:) = pu_rhs(:,:,:) 
    141             ztrdv(:,:,:) = pv_rhs(:,:,:) 
     138            ztrdu(:,:,:) = ua(:,:,:) 
     139            ztrdv(:,:,:) = va(:,:,:) 
    142140            SELECT CASE( nvor_scheme ) 
    143             CASE( np_ENT )           ;   CALL vor_enT( kt, ktlev, nrvm, uu(:,:,:,ktlev) , vv(:,:,:,ktlev) , pu_rhs, pv_rhs )  ! energy conserving scheme (T-pts) 
    144             CASE( np_EET )           ;   CALL vor_eeT( kt, ktlev, nrvm, uu(:,:,:,ktlev) , vv(:,:,:,ktlev) , pu_rhs, pv_rhs )  ! energy conserving scheme (een with e3t) 
    145             CASE( np_ENE )           ;   CALL vor_ene( kt, ktlev, nrvm, uu(:,:,:,ktlev) , vv(:,:,:,ktlev) , pu_rhs, pv_rhs )  ! energy conserving scheme 
    146             CASE( np_ENS, np_MIX )   ;   CALL vor_ens( kt, ktlev, nrvm, uu(:,:,:,ktlev) , vv(:,:,:,ktlev) , pu_rhs, pv_rhs )  ! enstrophy conserving scheme 
    147             CASE( np_EEN )           ;   CALL vor_een( kt, ktlev, nrvm, uu(:,:,:,ktlev) , vv(:,:,:,ktlev) , pu_rhs, pv_rhs )  ! energy & enstrophy scheme 
     141            CASE( np_ENT )           ;   CALL vor_enT( kt, nrvm, un , vn , ua, va )  ! energy conserving scheme (T-pts) 
     142            CASE( np_EET )           ;   CALL vor_eeT( kt, nrvm, un , vn , ua, va )  ! energy conserving scheme (een with e3t) 
     143            CASE( np_ENE )           ;   CALL vor_ene( kt, nrvm, un , vn , ua, va )  ! energy conserving scheme 
     144            CASE( np_ENS, np_MIX )   ;   CALL vor_ens( kt, nrvm, un , vn , ua, va )  ! enstrophy conserving scheme 
     145            CASE( np_EEN )           ;   CALL vor_een( kt, nrvm, un , vn , ua, va )  ! energy & enstrophy scheme 
    148146            END SELECT 
    149             ztrdu(:,:,:) = pu_rhs(:,:,:) - ztrdu(:,:,:) 
    150             ztrdv(:,:,:) = pv_rhs(:,:,:) - ztrdv(:,:,:) 
     147            ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
     148            ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    151149            CALL trd_dyn( ztrdu, ztrdv, jpdyn_rvo, kt ) 
    152150         ENDIF 
    … …  
    158156         SELECT CASE ( nvor_scheme )      !==  vorticity trend added to the general trend  ==! 
    159157         CASE( np_ENT )                        !* energy conserving scheme  (T-pts) 
    160                              CALL vor_enT( kt, ktlev, ntot, uu(:,:,:,ktlev) , vv(:,:,:,ktlev) , pu_rhs, pv_rhs )   ! total vorticity trend 
    161             IF( ln_stcor )   CALL vor_enT( kt, ktlev, ncor, usd, vsd, pu_rhs, pv_rhs )   ! add the Stokes-Coriolis trend 
     158                             CALL vor_enT( kt, ntot, un , vn , ua, va )   ! total vorticity trend 
     159            IF( ln_stcor )   CALL vor_enT( kt, ncor, usd, vsd, ua, va )   ! add the Stokes-Coriolis trend 
    162160         CASE( np_EET )                        !* energy conserving scheme (een scheme using e3t) 
    163                              CALL vor_eeT( kt, ktlev, ntot, uu(:,:,:,ktlev) , vv(:,:,:,ktlev) , pu_rhs, pv_rhs )   ! total vorticity trend 
    164             IF( ln_stcor )   CALL vor_eeT( kt, ktlev, ncor, usd, vsd, pu_rhs, pv_rhs )   ! add the Stokes-Coriolis trend 
     161                             CALL vor_eeT( kt, ntot, un , vn , ua, va )   ! total vorticity trend 
     162            IF( ln_stcor )   CALL vor_eeT( kt, ncor, usd, vsd, ua, va )   ! add the Stokes-Coriolis trend 
    165163         CASE( np_ENE )                        !* energy conserving scheme 
    166                              CALL vor_ene( kt, ktlev, ntot, uu(:,:,:,ktlev) , vv(:,:,:,ktlev) , pu_rhs, pv_rhs )   ! total vorticity trend 
    167             IF( ln_stcor )   CALL vor_ene( kt, ktlev, ncor, usd, vsd, pu_rhs, pv_rhs )   ! add the Stokes-Coriolis trend 
     164                             CALL vor_ene( kt, ntot, un , vn , ua, va )   ! total vorticity trend 
     165            IF( ln_stcor )   CALL vor_ene( kt, ncor, usd, vsd, ua, va )   ! add the Stokes-Coriolis trend 
    168166         CASE( np_ENS )                        !* enstrophy conserving scheme 
    169                              CALL vor_ens( kt, ktlev, ntot, uu(:,:,:,ktlev) , vv(:,:,:,ktlev) , pu_rhs, pv_rhs )  ! total vorticity trend 
    170             IF( ln_stcor )   CALL vor_ens( kt, ktlev, ncor, usd, vsd, pu_rhs, pv_rhs )  ! add the Stokes-Coriolis trend 
     167                             CALL vor_ens( kt, ntot, un , vn , ua, va )  ! total vorticity trend 
     168            IF( ln_stcor )   CALL vor_ens( kt, ncor, usd, vsd, ua, va )  ! add the Stokes-Coriolis trend 
    171169         CASE( np_MIX )                        !* mixed ene-ens scheme 
    172                              CALL vor_ens( kt, ktlev, nrvm, uu(:,:,:,ktlev) , vv(:,:,:,ktlev) , pu_rhs, pv_rhs )   ! relative vorticity or metric trend (ens) 
    173                              CALL vor_ene( kt, ktlev, ncor, uu(:,:,:,ktlev) , vv(:,:,:,ktlev) , pu_rhs, pv_rhs )   ! planetary vorticity trend (ene) 
    174             IF( ln_stcor )   CALL vor_ene( kt, ktlev, ncor, usd, vsd, pu_rhs, pv_rhs )   ! add the Stokes-Coriolis trend 
     170                             CALL vor_ens( kt, nrvm, un , vn , ua, va )   ! relative vorticity or metric trend (ens) 
     171                             CALL vor_ene( kt, ncor, un , vn , ua, va )   ! planetary vorticity trend (ene) 
     172            IF( ln_stcor )   CALL vor_ene( kt, ncor, usd, vsd, ua, va )   ! add the Stokes-Coriolis trend 
    175173         CASE( np_EEN )                        !* energy and enstrophy conserving scheme 
    176                              CALL vor_een( kt, ktlev, ntot, uu(:,:,:,ktlev) , vv(:,:,:,ktlev) , pu_rhs, pv_rhs )   ! total vorticity trend 
    177             IF( ln_stcor )   CALL vor_een( kt, ktlev, ncor, usd, vsd, pu_rhs, pv_rhs )   ! add the Stokes-Coriolis trend 
     174                             CALL vor_een( kt, ntot, un , vn , ua, va )   ! total vorticity trend 
     175            IF( ln_stcor )   CALL vor_een( kt, ncor, usd, vsd, ua, va )   ! add the Stokes-Coriolis trend 
    178176         END SELECT 
    179177         ! 
    … …  
    189187 
    190188 
    191    SUBROUTINE vor_enT( kt, ktlev, kvor, pu, pv, pu_rhs, pv_rhs ) 
     189   SUBROUTINE vor_enT( kt, kvor, pu, pv, pu_rhs, pv_rhs ) 
    192190      !!---------------------------------------------------------------------- 
    193191      !!                  ***  ROUTINE vor_enT  *** 
    … …  
    205203      !!       where rvor is the relative vorticity at f-point 
    206204      !! 
    207       !! ** Action : - Update (u_rhs,v_rhs) with the now vorticity term trend 
     205      !! ** Action : - Update (ua,va) with the now vorticity term trend 
    208206      !!---------------------------------------------------------------------- 
    209207      INTEGER                         , INTENT(in   ) ::   kt               ! ocean time-step index 
    210       INTEGER                         , INTENT( in )  ::   ktlev            ! time level index for source terms 
    211208      INTEGER                         , INTENT(in   ) ::   kvor             ! total, planetary, relative, or metric 
    212209      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu, pv           ! now velocities 
    … …  
    273270         SELECT CASE( kvor )                 !==  volume weighted vorticity considered  ==! 
    274271         CASE ( np_COR )                           !* Coriolis (planetary vorticity) 
    275             zwt(:,:) = ff_t(:,:) * e1e2t(:,:)*e3t(:,:,jk,ktlev) 
     272            zwt(:,:) = ff_t(:,:) * e1e2t(:,:)*e3t_n(:,:,jk) 
    276273         CASE ( np_RVO )                           !* relative vorticity 
    277274            DO jj = 2, jpj 
    278275               DO ji = 2, jpi   ! vector opt. 
    279276                  zwt(ji,jj) = r1_4 * (   zwz(ji-1,jj  ,jk) + zwz(ji,jj  ,jk)   & 
    280                      &                  + zwz(ji-1,jj-1,jk) + zwz(ji,jj-1,jk) ) * e1e2t(ji,jj)*e3t(ji,jj,jk,ktlev) 
     277                     &                  + zwz(ji-1,jj-1,jk) + zwz(ji,jj-1,jk) ) * e1e2t(ji,jj)*e3t_n(ji,jj,jk) 
    281278               END DO 
    282279            END DO 
    … …  
    285282               DO ji = 2, jpi 
    286283                  zwt(ji,jj) = (   ( pv(ji,jj,jk) + pv(ji,jj-1,jk) ) * di_e2u_2(ji,jj)   & 
    287                      &           - ( pu(ji,jj,jk) + pu(ji-1,jj,jk) ) * dj_e1v_2(ji,jj)   ) * e3t(ji,jj,jk,ktlev) 
     284                     &           - ( pu(ji,jj,jk) + pu(ji-1,jj,jk) ) * dj_e1v_2(ji,jj)   ) * e3t_n(ji,jj,jk) 
    288285               END DO 
    289286            END DO 
    … …  
    292289               DO ji = 2, jpi   ! vector opt. 
    293290                  zwt(ji,jj) = (  ff_t(ji,jj) + r1_4 * ( zwz(ji-1,jj  ,jk) + zwz(ji,jj  ,jk)    & 
    294                      &                                 + zwz(ji-1,jj-1,jk) + zwz(ji,jj-1,jk) )  ) * e1e2t(ji,jj)*e3t(ji,jj,jk,ktlev) 
     291                     &                                 + zwz(ji-1,jj-1,jk) + zwz(ji,jj-1,jk) )  ) * e1e2t(ji,jj)*e3t_n(ji,jj,jk) 
    295292               END DO 
    296293            END DO 
    … …  
    300297                  zwt(ji,jj) = (  ff_t(ji,jj) * e1e2t(ji,jj)                           & 
    301298                       &        + ( pv(ji,jj,jk) + pv(ji,jj-1,jk) ) * di_e2u_2(ji,jj)  & 
    302                        &        - ( pu(ji,jj,jk) + pu(ji-1,jj,jk) ) * dj_e1v_2(ji,jj)  ) * e3t(ji,jj,jk,ktlev) 
     299                       &        - ( pu(ji,jj,jk) + pu(ji-1,jj,jk) ) * dj_e1v_2(ji,jj)  ) * e3t_n(ji,jj,jk) 
    303300               END DO 
    304301            END DO 
    … …  
    310307         DO jj = 2, jpjm1 
    311308            DO ji = 2, jpim1   ! vector opt. 
    312                pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + r1_4 * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,ktlev)                    & 
     309               pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + r1_4 * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk)                    & 
    313310                  &                                * (  zwt(ji+1,jj) * ( pv(ji+1,jj,jk) + pv(ji+1,jj-1,jk) )   & 
    314311                  &                                   + zwt(ji  ,jj) * ( pv(ji  ,jj,jk) + pv(ji  ,jj-1,jk) )   ) 
    315312                  ! 
    316                pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) - r1_4 * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,ktlev)                    & 
     313               pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) - r1_4 * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk)                    & 
    317314                  &                                * (  zwt(ji,jj+1) * ( pu(ji,jj+1,jk) + pu(ji-1,jj+1,jk) )   &  
    318315                  &                                   + zwt(ji,jj  ) * ( pu(ji,jj  ,jk) + pu(ji-1,jj  ,jk) )   )  
    … …  
    325322 
    326323 
    327    SUBROUTINE vor_ene( kt, ktlev, kvor, pu, pv, pu_rhs, pva_rhs ) 
     324   SUBROUTINE vor_ene( kt, kvor, pun, pvn, pua, pva ) 
    328325      !!---------------------------------------------------------------------- 
    329326      !!                  ***  ROUTINE vor_ene  *** 
    … …  
    337334      !!         The general trend of momentum is increased due to the vorticity  
    338335      !!       term which is given by: 
    339       !!          voru = 1/e1u  mj-1[ (rvor+f)/e3f  mi(e1v*e3v vv(:,:,:,ktlev)) ] 
    340       !!          vorv = 1/e2v  mi-1[ (rvor+f)/e3f  mj(e2u*e3u uu(:,:,:,ktlev)) ] 
     336      !!          voru = 1/e1u  mj-1[ (rvor+f)/e3f  mi(e1v*e3v vn) ] 
     337      !!          vorv = 1/e2v  mi-1[ (rvor+f)/e3f  mj(e2u*e3u un) ] 
    341338      !!       where rvor is the relative vorticity 
    342339      !! 
    343       !! ** Action : - Update (u_rhs,v_rhs) with the now vorticity term trend 
     340      !! ** Action : - Update (ua,va) with the now vorticity term trend 
    344341      !! 
    345342      !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689. 
    346343      !!---------------------------------------------------------------------- 
    347344      INTEGER                         , INTENT(in   ) ::   kt          ! ocean time-step index 
    348       INTEGER                         , INTENT( in )  ::   ktlev            ! time level index for source terms 
    349345      INTEGER                         , INTENT(in   ) ::   kvor        ! total, planetary, relative, or metric 
    350       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu, pv    ! now velocities 
    351       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu_rhs, pva_rhs    ! total v-trend 
     346      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pun, pvn    ! now velocities 
     347      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pua, pva    ! total v-trend 
    352348      ! 
    353349      INTEGER  ::   ji, jj, jk           ! dummy loop indices 
    … …  
    372368            DO jj = 1, jpjm1 
    373369               DO ji = 1, fs_jpim1   ! vector opt. 
    374                   zwz(ji,jj) = (  e2v(ji+1,jj  ) * pv(ji+1,jj  ,jk) - e2v(ji,jj) * pv(ji,jj,jk)    & 
    375                      &          - e1u(ji  ,jj+1) * pu(ji  ,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) * r1_e1e2f(ji,jj) 
     370                  zwz(ji,jj) = (  e2v(ji+1,jj  ) * pvn(ji+1,jj  ,jk) - e2v(ji,jj) * pvn(ji,jj,jk)    & 
     371                     &          - e1u(ji  ,jj+1) * pun(ji  ,jj+1,jk) + e1u(ji,jj) * pun(ji,jj,jk)  ) * r1_e1e2f(ji,jj) 
    376372               END DO 
    377373            END DO 
    … …  
    379375            DO jj = 1, jpjm1 
    380376               DO ji = 1, fs_jpim1   ! vector opt. 
    381                   zwz(ji,jj) = ( pv(ji+1,jj  ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   & 
    382                      &       - ( pu(ji  ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj) 
     377                  zwz(ji,jj) = ( pvn(ji+1,jj  ,jk) + pvn(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   & 
     378                     &       - ( pun(ji  ,jj+1,jk) + pun(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj) 
    383379               END DO 
    384380            END DO 
    … …  
    386382            DO jj = 1, jpjm1 
    387383               DO ji = 1, fs_jpim1   ! vector opt. 
    388                   zwz(ji,jj) = ff_f(ji,jj) + (  e2v(ji+1,jj) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk)      & 
    389                      &                        - e1u(ji,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) * r1_e1e2f(ji,jj) 
     384                  zwz(ji,jj) = ff_f(ji,jj) + (  e2v(ji+1,jj) * pvn(ji+1,jj,jk) - e2v(ji,jj) * pvn(ji,jj,jk)      & 
     385                     &                        - e1u(ji,jj+1) * pun(ji,jj+1,jk) + e1u(ji,jj) * pun(ji,jj,jk)  ) * r1_e1e2f(ji,jj) 
    390386               END DO 
    391387            END DO 
    … …  
    393389            DO jj = 1, jpjm1 
    394390               DO ji = 1, fs_jpim1   ! vector opt. 
    395                   zwz(ji,jj) = ff_f(ji,jj) + ( pv(ji+1,jj  ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   & 
    396                      &                     - ( pu(ji  ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj) 
     391                  zwz(ji,jj) = ff_f(ji,jj) + ( pvn(ji+1,jj  ,jk) + pvn(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   & 
     392                     &                     - ( pun(ji  ,jj+1,jk) + pun(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj) 
    397393               END DO 
    398394            END DO 
    … …  
    410406 
    411407         IF( ln_sco ) THEN 
    412             zwz(:,:) = zwz(:,:) / e3f(:,:,jk) 
    413             zwx(:,:) = e2u(:,:) * e3u(:,:,jk,ktlev) * pu(:,:,jk) 
    414             zwy(:,:) = e1v(:,:) * e3v(:,:,jk,ktlev) * pv(:,:,jk) 
     408            zwz(:,:) = zwz(:,:) / e3f_n(:,:,jk) 
     409            zwx(:,:) = e2u(:,:) * e3u_n(:,:,jk) * pun(:,:,jk) 
     410            zwy(:,:) = e1v(:,:) * e3v_n(:,:,jk) * pvn(:,:,jk) 
    415411         ELSE 
    416             zwx(:,:) = e2u(:,:) * pu(:,:,jk) 
    417             zwy(:,:) = e1v(:,:) * pv(:,:,jk) 
     412            zwx(:,:) = e2u(:,:) * pun(:,:,jk) 
     413            zwy(:,:) = e1v(:,:) * pvn(:,:,jk) 
    418414         ENDIF 
    419415         !                                   !==  compute and add the vorticity term trend  =! 
    … …  
    424420               zx1 = zwx(ji-1,jj) + zwx(ji-1,jj+1) 
    425421               zx2 = zwx(ji  ,jj) + zwx(ji  ,jj+1) 
    426                pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + r1_4 * r1_e1u(ji,jj) * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 ) 
    427                pva_rhs(ji,jj,jk) = pva_rhs(ji,jj,jk) - r1_4 * r1_e2v(ji,jj) * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 )  
     422               pua(ji,jj,jk) = pua(ji,jj,jk) + r1_4 * r1_e1u(ji,jj) * ( zwz(ji  ,jj-1) * zy1 + zwz(ji,jj) * zy2 ) 
     423               pva(ji,jj,jk) = pva(ji,jj,jk) - r1_4 * r1_e2v(ji,jj) * ( zwz(ji-1,jj  ) * zx1 + zwz(ji,jj) * zx2 )  
    428424            END DO   
    429425         END DO   
    … …  
    434430 
    435431 
    436    SUBROUTINE vor_ens( kt, ktlev, kvor, pu, pv, pu_rhs, pva_rhs ) 
     432   SUBROUTINE vor_ens( kt, kvor, pun, pvn, pua, pva ) 
    437433      !!---------------------------------------------------------------------- 
    438434      !!                ***  ROUTINE vor_ens  *** 
    … …  
    445441      !!      potential enstrophy of a horizontally non-divergent flow. the 
    446442      !!      trend of the vorticity term is given by: 
    447       !!          voru = 1/e1u  mj-1[ (rvor+f)/e3f ]  mj-1[ mi(e1v*e3v vv(:,:,:,ktlev)) ] 
    448       !!          vorv = 1/e2v  mi-1[ (rvor+f)/e3f ]  mi-1[ mj(e2u*e3u uu(:,:,:,ktlev)) ] 
    449       !!      Add this trend to the general momentum trend (u_rhs,v_rhs): 
    450       !!          (u_rhs,v_rhs) = (u_rhs,v_rhs) + ( voru , vorv ) 
    451       !! 
    452       !! ** Action : - Update (u_rhs,v_rhs) arrays with the now vorticity term trend 
     443      !!          voru = 1/e1u  mj-1[ (rvor+f)/e3f ]  mj-1[ mi(e1v*e3v vn) ] 
     444      !!          vorv = 1/e2v  mi-1[ (rvor+f)/e3f ]  mi-1[ mj(e2u*e3u un) ] 
     445      !!      Add this trend to the general momentum trend (ua,va): 
     446      !!          (ua,va) = (ua,va) + ( voru , vorv ) 
     447      !! 
     448      !! ** Action : - Update (ua,va) arrays with the now vorticity term trend 
    453449      !! 
    454450      !! References : Sadourny, r., 1975, j. atmos. sciences, 32, 680-689. 
    455451      !!---------------------------------------------------------------------- 
    456452      INTEGER                         , INTENT(in   ) ::   kt          ! ocean time-step index 
    457       INTEGER                         , INTENT( in )  ::   ktlev            ! time level index for source terms 
    458453      INTEGER                         , INTENT(in   ) ::   kvor        ! total, planetary, relative, or metric 
    459       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu, pv    ! now velocities 
    460       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu_rhs, pva_rhs    ! total v-trend 
     454      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pun, pvn    ! now velocities 
     455      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pua, pva    ! total v-trend 
    461456      ! 
    462457      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    … …  
    480475            DO jj = 1, jpjm1 
    481476               DO ji = 1, fs_jpim1   ! vector opt. 
    482                   zwz(ji,jj) = (  e2v(ji+1,jj  ) * pv(ji+1,jj  ,jk) - e2v(ji,jj) * pv(ji,jj,jk)    & 
    483                      &          - e1u(ji  ,jj+1) * pu(ji  ,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) * r1_e1e2f(ji,jj) 
     477                  zwz(ji,jj) = (  e2v(ji+1,jj  ) * pvn(ji+1,jj  ,jk) - e2v(ji,jj) * pvn(ji,jj,jk)    & 
     478                     &          - e1u(ji  ,jj+1) * pun(ji  ,jj+1,jk) + e1u(ji,jj) * pun(ji,jj,jk)  ) * r1_e1e2f(ji,jj) 
    484479               END DO 
    485480            END DO 
    … …  
    487482            DO jj = 1, jpjm1 
    488483               DO ji = 1, fs_jpim1   ! vector opt. 
    489                   zwz(ji,jj) = ( pv(ji+1,jj  ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   & 
    490                      &       - ( pu(ji  ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj) 
     484                  zwz(ji,jj) = ( pvn(ji+1,jj  ,jk) + pvn(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   & 
     485                     &       - ( pun(ji  ,jj+1,jk) + pun(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj) 
    491486               END DO 
    492487            END DO 
    … …  
    494489            DO jj = 1, jpjm1 
    495490               DO ji = 1, fs_jpim1   ! vector opt. 
    496                   zwz(ji,jj) = ff_f(ji,jj) + (  e2v(ji+1,jj  ) * pv(ji+1,jj  ,jk) - e2v(ji,jj) * pv(ji,jj,jk)  & 
    497                      &                        - e1u(ji  ,jj+1) * pu(ji  ,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) * r1_e1e2f(ji,jj) 
     491                  zwz(ji,jj) = ff_f(ji,jj) + (  e2v(ji+1,jj  ) * pvn(ji+1,jj  ,jk) - e2v(ji,jj) * pvn(ji,jj,jk)  & 
     492                     &                        - e1u(ji  ,jj+1) * pun(ji  ,jj+1,jk) + e1u(ji,jj) * pun(ji,jj,jk)  ) * r1_e1e2f(ji,jj) 
    498493               END DO 
    499494            END DO 
    … …  
    501496            DO jj = 1, jpjm1 
    502497               DO ji = 1, fs_jpim1   ! vector opt. 
    503                   zwz(ji,jj) = ff_f(ji,jj) + ( pv(ji+1,jj  ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   & 
    504                      &                     - ( pu(ji  ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj) 
     498                  zwz(ji,jj) = ff_f(ji,jj) + ( pvn(ji+1,jj  ,jk) + pvn(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   & 
     499                     &                     - ( pun(ji  ,jj+1,jk) + pun(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj) 
    505500               END DO 
    506501            END DO 
    … …  
    518513         ! 
    519514         IF( ln_sco ) THEN                   !==  horizontal fluxes  ==! 
    520             zwz(:,:) = zwz(:,:) / e3f(:,:,jk) 
    521             zwx(:,:) = e2u(:,:) * e3u(:,:,jk,ktlev) * pu(:,:,jk) 
    522             zwy(:,:) = e1v(:,:) * e3v(:,:,jk,ktlev) * pv(:,:,jk) 
     515            zwz(:,:) = zwz(:,:) / e3f_n(:,:,jk) 
     516            zwx(:,:) = e2u(:,:) * e3u_n(:,:,jk) * pun(:,:,jk) 
     517            zwy(:,:) = e1v(:,:) * e3v_n(:,:,jk) * pvn(:,:,jk) 
    523518         ELSE 
    524             zwx(:,:) = e2u(:,:) * pu(:,:,jk) 
    525             zwy(:,:) = e1v(:,:) * pv(:,:,jk) 
     519            zwx(:,:) = e2u(:,:) * pun(:,:,jk) 
     520            zwy(:,:) = e1v(:,:) * pvn(:,:,jk) 
    526521         ENDIF 
    527522         !                                   !==  compute and add the vorticity term trend  =! 
    … …  
    532527               zvau =-r1_8 * r1_e2v(ji,jj) * (  zwx(ji-1,jj  ) + zwx(ji-1,jj+1)  & 
    533528                  &                           + zwx(ji  ,jj  ) + zwx(ji  ,jj+1)  ) 
    534                pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zuav * ( zwz(ji  ,jj-1) + zwz(ji,jj) ) 
    535                pva_rhs(ji,jj,jk) = pva_rhs(ji,jj,jk) + zvau * ( zwz(ji-1,jj  ) + zwz(ji,jj) ) 
     529               pua(ji,jj,jk) = pua(ji,jj,jk) + zuav * ( zwz(ji  ,jj-1) + zwz(ji,jj) ) 
     530               pva(ji,jj,jk) = pva(ji,jj,jk) + zvau * ( zwz(ji-1,jj  ) + zwz(ji,jj) ) 
    536531            END DO   
    537532         END DO   
    … …  
    542537 
    543538 
    544    SUBROUTINE vor_een( kt, ktlev, kvor, pu, pv, pu_rhs, pva_rhs ) 
     539   SUBROUTINE vor_een( kt, kvor, pun, pvn, pua, pva ) 
    545540      !!---------------------------------------------------------------------- 
    546541      !!                ***  ROUTINE vor_een  *** 
    … …  
    553548      !!      both the horizontal kinetic energy and the potential enstrophy 
    554549      !!      when horizontal divergence is zero (see the NEMO documentation) 
    555       !!      Add this trend to the general momentum trend (u_rhs,v_rhs). 
    556       !! 
    557       !! ** Action : - Update (u_rhs,v_rhs) with the now vorticity term trend 
     550      !!      Add this trend to the general momentum trend (ua,va). 
     551      !! 
     552      !! ** Action : - Update (ua,va) with the now vorticity term trend 
    558553      !! 
    559554      !! References : Arakawa and Lamb 1980, Mon. Wea. Rev., 109, 18-36 
    560555      !!---------------------------------------------------------------------- 
    561556      INTEGER                         , INTENT(in   ) ::   kt          ! ocean time-step index 
    562       INTEGER                         , INTENT( in )  ::   ktlev            ! time level index for source terms 
    563557      INTEGER                         , INTENT(in   ) ::   kvor        ! total, planetary, relative, or metric 
    564       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu, pv    ! now velocities 
    565       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu_rhs, pva_rhs    ! total v-trend 
     558      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pun, pvn    ! now velocities 
     559      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pua, pva    ! total v-trend 
    566560      ! 
    567561      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    … …  
    588582            DO jj = 1, jpjm1 
    589583               DO ji = 1, fs_jpim1   ! vector opt. 
    590                   ze3f = (  e3t(ji,jj+1,jk,ktlev)*tmask(ji,jj+1,jk) + e3t(ji+1,jj+1,jk,ktlev)*tmask(ji+1,jj+1,jk)   & 
    591                      &    + e3t(ji,jj  ,jk,ktlev)*tmask(ji,jj  ,jk) + e3t(ji+1,jj  ,jk,ktlev)*tmask(ji+1,jj  ,jk)  ) 
     584                  ze3f = (  e3t_n(ji,jj+1,jk)*tmask(ji,jj+1,jk) + e3t_n(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk)   & 
     585                     &    + e3t_n(ji,jj  ,jk)*tmask(ji,jj  ,jk) + e3t_n(ji+1,jj  ,jk)*tmask(ji+1,jj  ,jk)  ) 
    592586                  IF( ze3f /= 0._wp ) THEN   ;   z1_e3f(ji,jj) = 4._wp / ze3f 
    593587                  ELSE                       ;   z1_e3f(ji,jj) = 0._wp 
    … …  
    598592            DO jj = 1, jpjm1 
    599593               DO ji = 1, fs_jpim1   ! vector opt. 
    600                   ze3f = (  e3t(ji,jj+1,jk,ktlev)*tmask(ji,jj+1,jk) + e3t(ji+1,jj+1,jk,ktlev)*tmask(ji+1,jj+1,jk)   & 
    601                      &    + e3t(ji,jj  ,jk,ktlev)*tmask(ji,jj  ,jk) + e3t(ji+1,jj  ,jk,ktlev)*tmask(ji+1,jj  ,jk)  ) 
     594                  ze3f = (  e3t_n(ji,jj+1,jk)*tmask(ji,jj+1,jk) + e3t_n(ji+1,jj+1,jk)*tmask(ji+1,jj+1,jk)   & 
     595                     &    + e3t_n(ji,jj  ,jk)*tmask(ji,jj  ,jk) + e3t_n(ji+1,jj  ,jk)*tmask(ji+1,jj  ,jk)  ) 
    602596                  zmsk = (                    tmask(ji,jj+1,jk) +                     tmask(ji+1,jj+1,jk)   & 
    603597                     &                      + tmask(ji,jj  ,jk) +                     tmask(ji+1,jj  ,jk)  ) 
    … …  
    619613            DO jj = 1, jpjm1 
    620614               DO ji = 1, fs_jpim1   ! vector opt. 
    621                   zwz(ji,jj,jk) = ( e2v(ji+1,jj  ) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk)  & 
    622                      &            - e1u(ji  ,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) * r1_e1e2f(ji,jj)*z1_e3f(ji,jj) 
     615                  zwz(ji,jj,jk) = ( e2v(ji+1,jj  ) * pvn(ji+1,jj,jk) - e2v(ji,jj) * pvn(ji,jj,jk)  & 
     616                     &            - e1u(ji  ,jj+1) * pun(ji,jj+1,jk) + e1u(ji,jj) * pun(ji,jj,jk)  ) * r1_e1e2f(ji,jj)*z1_e3f(ji,jj) 
    623617               END DO 
    624618            END DO 
    … …  
    626620            DO jj = 1, jpjm1 
    627621               DO ji = 1, fs_jpim1   ! vector opt. 
    628                   zwz(ji,jj,jk) = (   ( pv(ji+1,jj,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   & 
    629                      &              - ( pu(ji,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj)   ) * z1_e3f(ji,jj) 
     622                  zwz(ji,jj,jk) = (   ( pvn(ji+1,jj,jk) + pvn(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   & 
     623                     &              - ( pun(ji,jj+1,jk) + pun(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj)   ) * z1_e3f(ji,jj) 
    630624               END DO 
    631625            END DO 
    … …  
    633627            DO jj = 1, jpjm1 
    634628               DO ji = 1, fs_jpim1   ! vector opt. 
    635                   zwz(ji,jj,jk) = (  ff_f(ji,jj) + (  e2v(ji+1,jj  ) * pv(ji+1,jj,jk) - e2v(ji,jj) * pv(ji,jj,jk)      & 
    636                      &                              - e1u(ji  ,jj+1) * pu(ji,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  )   & 
     629                  zwz(ji,jj,jk) = (  ff_f(ji,jj) + (  e2v(ji+1,jj  ) * pvn(ji+1,jj,jk) - e2v(ji,jj) * pvn(ji,jj,jk)      & 
     630                     &                              - e1u(ji  ,jj+1) * pun(ji,jj+1,jk) + e1u(ji,jj) * pun(ji,jj,jk)  )   & 
    637631                     &                           * r1_e1e2f(ji,jj)   ) * z1_e3f(ji,jj) 
    638632               END DO 
    … …  
    641635            DO jj = 1, jpjm1 
    642636               DO ji = 1, fs_jpim1   ! vector opt. 
    643                   zwz(ji,jj,jk) = (   ff_f(ji,jj) + ( pv(ji+1,jj  ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   & 
    644                      &                            - ( pu(ji  ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj)   ) * z1_e3f(ji,jj) 
     637                  zwz(ji,jj,jk) = (   ff_f(ji,jj) + ( pvn(ji+1,jj  ,jk) + pvn(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   & 
     638                     &                            - ( pun(ji  ,jj+1,jk) + pun(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj)   ) * z1_e3f(ji,jj) 
    645639               END DO 
    646640            END DO 
    … …  
    663657         ! 
    664658         !                                   !==  horizontal fluxes  ==! 
    665          zwx(:,:) = e2u(:,:) * e3u(:,:,jk,ktlev) * pu(:,:,jk) 
    666          zwy(:,:) = e1v(:,:) * e3v(:,:,jk,ktlev) * pv(:,:,jk) 
     659         zwx(:,:) = e2u(:,:) * e3u_n(:,:,jk) * pun(:,:,jk) 
     660         zwy(:,:) = e1v(:,:) * e3v_n(:,:,jk) * pvn(:,:,jk) 
    667661 
    668662         !                                   !==  compute and add the vorticity term trend  =! 
    … …  
    689683               zva = - r1_12 * r1_e2v(ji,jj) * (  ztsw(ji,jj+1) * zwx(ji-1,jj+1) + ztse(ji,jj+1) * zwx(ji  ,jj+1)   & 
    690684                  &                             + ztnw(ji,jj  ) * zwx(ji-1,jj  ) + ztne(ji,jj  ) * zwx(ji  ,jj  ) ) 
    691                pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zua 
    692                pva_rhs(ji,jj,jk) = pva_rhs(ji,jj,jk) + zva 
     685               pua(ji,jj,jk) = pua(ji,jj,jk) + zua 
     686               pva(ji,jj,jk) = pva(ji,jj,jk) + zva 
    693687            END DO   
    694688         END DO   
    … …  
    700694 
    701695 
    702    SUBROUTINE vor_eeT( kt, ktlev, kvor, pu, pv, pu_rhs, pva_rhs ) 
     696   SUBROUTINE vor_eeT( kt, kvor, pun, pvn, pua, pva ) 
    703697      !!---------------------------------------------------------------------- 
    704698      !!                ***  ROUTINE vor_eeT  *** 
    … …  
    711705      !!      a modified version of Arakawa and Lamb (1980) scheme (see vor_een). 
    712706      !!      The change consists in  
    713       !!      Add this trend to the general momentum trend (u_rhs,v_rhs). 
    714       !! 
    715       !! ** Action : - Update (u_rhs,v_rhs) with the now vorticity term trend 
     707      !!      Add this trend to the general momentum trend (ua,va). 
     708      !! 
     709      !! ** Action : - Update (ua,va) with the now vorticity term trend 
    716710      !! 
    717711      !! References : Arakawa and Lamb 1980, Mon. Wea. Rev., 109, 18-36 
    718712      !!---------------------------------------------------------------------- 
    719713      INTEGER                         , INTENT(in   ) ::   kt          ! ocean time-step index 
    720       INTEGER                         , INTENT( in )  ::   ktlev            ! time level index for source terms 
    721714      INTEGER                         , INTENT(in   ) ::   kvor        ! total, planetary, relative, or metric 
    722       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu, pv    ! now velocities 
    723       REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pu_rhs, pva_rhs    ! total v-trend 
     715      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pun, pvn    ! now velocities 
     716      REAL(wp), DIMENSION(jpi,jpj,jpk), INTENT(inout) ::   pua, pva    ! total v-trend 
    724717      ! 
    725718      INTEGER  ::   ji, jj, jk     ! dummy loop indices 
    … …  
    753746            DO jj = 1, jpjm1 
    754747               DO ji = 1, fs_jpim1   ! vector opt. 
    755                   zwz(ji,jj,jk) = (  e2v(ji+1,jj  ) * pv(ji+1,jj  ,jk) - e2v(ji,jj) * pv(ji,jj,jk)    & 
    756                      &             - e1u(ji  ,jj+1) * pu(ji  ,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) & 
     748                  zwz(ji,jj,jk) = (  e2v(ji+1,jj  ) * pvn(ji+1,jj  ,jk) - e2v(ji,jj) * pvn(ji,jj,jk)    & 
     749                     &             - e1u(ji  ,jj+1) * pun(ji  ,jj+1,jk) + e1u(ji,jj) * pun(ji,jj,jk)  ) & 
    757750                     &          * r1_e1e2f(ji,jj) 
    758751               END DO 
    … …  
    761754            DO jj = 1, jpjm1 
    762755               DO ji = 1, fs_jpim1   ! vector opt. 
    763                   zwz(ji,jj,jk) = ( pv(ji+1,jj  ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   & 
    764                      &          - ( pu(ji  ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj) 
     756                  zwz(ji,jj,jk) = ( pvn(ji+1,jj  ,jk) + pvn(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   & 
     757                     &          - ( pun(ji  ,jj+1,jk) + pun(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj) 
    765758               END DO 
    766759            END DO 
    … …  
    768761            DO jj = 1, jpjm1 
    769762               DO ji = 1, fs_jpim1   ! vector opt. 
    770                   zwz(ji,jj,jk) = (  ff_f(ji,jj) + (  e2v(ji+1,jj  ) * pv(ji+1,jj  ,jk) - e2v(ji,jj) * pv(ji,jj,jk)    & 
    771                      &                              - e1u(ji  ,jj+1) * pu(ji  ,jj+1,jk) + e1u(ji,jj) * pu(ji,jj,jk)  ) & 
     763                  zwz(ji,jj,jk) = (  ff_f(ji,jj) + (  e2v(ji+1,jj  ) * pvn(ji+1,jj  ,jk) - e2v(ji,jj) * pvn(ji,jj,jk)    & 
     764                     &                              - e1u(ji  ,jj+1) * pun(ji  ,jj+1,jk) + e1u(ji,jj) * pun(ji,jj,jk)  ) & 
    772765                     &                         * r1_e1e2f(ji,jj)    ) 
    773766               END DO 
    … …  
    776769            DO jj = 1, jpjm1 
    777770               DO ji = 1, fs_jpim1   ! vector opt. 
    778                   zwz(ji,jj,jk) = ff_f(ji,jj) + ( pv(ji+1,jj  ,jk) + pv(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   & 
    779                      &                        - ( pu(ji  ,jj+1,jk) + pu(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj) 
     771                  zwz(ji,jj,jk) = ff_f(ji,jj) + ( pvn(ji+1,jj  ,jk) + pvn(ji,jj,jk) ) * di_e2v_2e1e2f(ji,jj)   & 
     772                     &                        - ( pun(ji  ,jj+1,jk) + pun(ji,jj,jk) ) * dj_e1u_2e1e2f(ji,jj) 
    780773               END DO 
    781774            END DO 
    … …  
    798791 
    799792      !                                   !==  horizontal fluxes  ==! 
    800          zwx(:,:) = e2u(:,:) * e3u(:,:,jk,ktlev) * pu(:,:,jk) 
    801          zwy(:,:) = e1v(:,:) * e3v(:,:,jk,ktlev) * pv(:,:,jk) 
     793         zwx(:,:) = e2u(:,:) * e3u_n(:,:,jk) * pun(:,:,jk) 
     794         zwy(:,:) = e1v(:,:) * e3v_n(:,:,jk) * pvn(:,:,jk) 
    802795 
    803796         !                                   !==  compute and add the vorticity term trend  =! 
    … …  
    805798         ztne(1,:) = 0   ;   ztnw(1,:) = 0   ;   ztse(1,:) = 0   ;   ztsw(1,:) = 0 
    806799         DO ji = 2, jpi          ! split in 2 parts due to vector opt. 
    807                z1_e3t = 1._wp / e3t(ji,jj,jk,ktlev) 
     800               z1_e3t = 1._wp / e3t_n(ji,jj,jk) 
    808801               ztne(ji,jj) = ( zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk) + zwz(ji  ,jj-1,jk) ) * z1_e3t 
    809802               ztnw(ji,jj) = ( zwz(ji-1,jj-1,jk) + zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk) ) * z1_e3t 
    … …  
    813806         DO jj = 3, jpj 
    814807            DO ji = fs_2, jpi   ! vector opt. ok because we start at jj = 3 
    815                z1_e3t = 1._wp / e3t(ji,jj,jk,ktlev) 
     808               z1_e3t = 1._wp / e3t_n(ji,jj,jk) 
    816809               ztne(ji,jj) = ( zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk) + zwz(ji  ,jj-1,jk) ) * z1_e3t 
    817810               ztnw(ji,jj) = ( zwz(ji-1,jj-1,jk) + zwz(ji-1,jj  ,jk) + zwz(ji  ,jj  ,jk) ) * z1_e3t 
    … …  
    826819               zva = - r1_12 * r1_e2v(ji,jj) * (  ztsw(ji,jj+1) * zwx(ji-1,jj+1) + ztse(ji,jj+1) * zwx(ji  ,jj+1)   & 
    827820                  &                             + ztnw(ji,jj  ) * zwx(ji-1,jj  ) + ztne(ji,jj  ) * zwx(ji  ,jj  ) ) 
    828                pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) + zua 
    829                pva_rhs(ji,jj,jk) = pva_rhs(ji,jj,jk) + zva 
     821               pua(ji,jj,jk) = pua(ji,jj,jk) + zua 
     822               pva(ji,jj,jk) = pva(ji,jj,jk) + zva 
    830823            END DO   
    831824         END DO   
    … …  
    873866         WRITE(numout,*) '         e3f = averaging /4 (=0) or /sum(tmask) (=1)    nn_een_e3f = ', nn_een_e3f 
    874867         WRITE(numout,*) '      mixed enstrophy/energy conserving scheme       ln_dynvor_mix = ', ln_dynvor_mix 
    875          WRITE(numout,*) '      masked (=T) or uu(:,:,:,ktlev)masked(=F) vorticity          ln_dynvor_msk = ', ln_dynvor_msk 
     868         WRITE(numout,*) '      masked (=T) or unmasked(=F) vorticity          ln_dynvor_msk = ', ln_dynvor_msk 
    876869      ENDIF 
    877870 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/DYN/dynzad.F90

    r10789 r10874  
    3636CONTAINS 
    3737 
    38    SUBROUTINE dyn_zad ( kt, ktlev, pu_rhs, pv_rhs ) 
     38   SUBROUTINE dyn_zad ( kt ) 
    3939      !!---------------------------------------------------------------------- 
    4040      !!                  ***  ROUTINE dynzad  *** 
    … …  
    4444      !! 
    4545      !! ** Method  :   The now vertical advection of momentum is given by: 
    46       !!         w dz(u) = pu_rhs + 1/(e1e2u*e3u) mk+1[ mi(e1e2t*ww) dk(uu(:,:,:,ktlev)) ] 
    47       !!         w dz(v) = pv_rhs + 1/(e1e2v*e3v) mk+1[ mj(e1e2t*ww) dk(vv(:,:,:,ktlev)) ] 
    48       !!      Add this trend to the general trend (pu_rhs,pv_rhs): 
    49       !!         (pu_rhs,pv_rhs) = (pu_rhs,pv_rhs) + w dz(u,v) 
     46      !!         w dz(u) = ua + 1/(e1e2u*e3u) mk+1[ mi(e1e2t*wn) dk(un) ] 
     47      !!         w dz(v) = va + 1/(e1e2v*e3v) mk+1[ mj(e1e2t*wn) dk(vn) ] 
     48      !!      Add this trend to the general trend (ua,va): 
     49      !!         (ua,va) = (ua,va) + w dz(u,v) 
    5050      !! 
    51       !! ** Action  : - Update (pu_rhs,pv_rhs) with the vert. momentum adv. trends 
     51      !! ** Action  : - Update (ua,va) with the vert. momentum adv. trends 
    5252      !!              - Send the trends to trddyn for diagnostics (l_trddyn=T) 
    5353      !!---------------------------------------------------------------------- 
    54       INTEGER, INTENT(in) ::   kt             ! ocean time-step index 
    55       INTEGER, INTENT(in) ::   ktlev          ! time level index for source terms 
    56       REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) :: pu_rhs, pv_rhs ! momentum trends 
     54      INTEGER, INTENT(in) ::   kt   ! ocean time-step inedx 
    5755      ! 
    5856      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    … …  
    7068      ENDIF 
    7169 
    72       IF( l_trddyn )   THEN         ! Save pu_rhs and pv_rhs trends 
     70      IF( l_trddyn )   THEN         ! Save ua and va trends 
    7371         ALLOCATE( ztrdu(jpi,jpj,jpk) , ztrdv(jpi,jpj,jpk) )  
    74          ztrdu(:,:,:) = pu_rhs(:,:,:)  
    75          ztrdv(:,:,:) = pv_rhs(:,:,:)  
     72         ztrdu(:,:,:) = ua(:,:,:)  
     73         ztrdv(:,:,:) = va(:,:,:)  
    7674      ENDIF 
    7775       
    … …  
    7977         DO jj = 2, jpj                   ! vertical fluxes  
    8078            DO ji = fs_2, jpi             ! vector opt. 
    81                zww(ji,jj) = 0.25_wp * e1e2t(ji,jj) * ww(ji,jj,jk) 
     79               zww(ji,jj) = 0.25_wp * e1e2t(ji,jj) * wn(ji,jj,jk) 
    8280            END DO 
    8381         END DO 
    8482         DO jj = 2, jpjm1                 ! vertical momentum advection at w-point 
    8583            DO ji = fs_2, fs_jpim1        ! vector opt. 
    86                zwuw(ji,jj,jk) = ( zww(ji+1,jj  ) + zww(ji,jj) ) * ( uu(ji,jj,jk-1,ktlev) - uu(ji,jj,jk,ktlev) ) 
    87                zwvw(ji,jj,jk) = ( zww(ji  ,jj+1) + zww(ji,jj) ) * ( vv(ji,jj,jk-1,ktlev) - vv(ji,jj,jk,ktlev) ) 
     84               zwuw(ji,jj,jk) = ( zww(ji+1,jj  ) + zww(ji,jj) ) * ( un(ji,jj,jk-1) - un(ji,jj,jk) ) 
     85               zwvw(ji,jj,jk) = ( zww(ji  ,jj+1) + zww(ji,jj) ) * ( vn(ji,jj,jk-1) - vn(ji,jj,jk) ) 
    8886            END DO   
    8987         END DO    
    … …  
    103101         DO jj = 2, jpjm1 
    104102            DO ji = fs_2, fs_jpim1       ! vector opt. 
    105                pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,ktlev) 
    106                pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,ktlev) 
     103               ua(ji,jj,jk) = ua(ji,jj,jk) - ( zwuw(ji,jj,jk) + zwuw(ji,jj,jk+1) ) * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk) 
     104               va(ji,jj,jk) = va(ji,jj,jk) - ( zwvw(ji,jj,jk) + zwvw(ji,jj,jk+1) ) * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk) 
    107105            END DO   
    108106         END DO   
    … …  
    110108 
    111109      IF( l_trddyn ) THEN           ! save the vertical advection trends for diagnostic 
    112          ztrdu(:,:,:) = pu_rhs(:,:,:) - ztrdu(:,:,:) 
    113          ztrdv(:,:,:) = pv_rhs(:,:,:) - ztrdv(:,:,:) 
     110         ztrdu(:,:,:) = ua(:,:,:) - ztrdu(:,:,:) 
     111         ztrdv(:,:,:) = va(:,:,:) - ztrdv(:,:,:) 
    114112         CALL trd_dyn( ztrdu, ztrdv, jpdyn_zad, kt ) 
    115113         DEALLOCATE( ztrdu, ztrdv )  

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/DYN/dynzdf.F90

    r10825 r10874  
    4545CONTAINS 
    4646    
    47    SUBROUTINE dyn_zdf( kt, ktlev1, ktlev2, ktlev3, kt2lev, pu_rhs, pv_rhs ) 
     47   SUBROUTINE dyn_zdf( kt ) 
    4848      !!---------------------------------------------------------------------- 
    4949      !!                  ***  ROUTINE dyn_zdf  *** 
    … …  
    5454      !! 
    5555      !! ** Method  :  - Leap-Frog time stepping on all trends but the vertical mixing 
    56       !!         pu_rhs =         uu(:,:,:,ktlev1) + 2*dt *       pu_rhs             vector form or linear free surf. 
    57       !!         pu_rhs = ( e3u_b*uu(:,:,:,ktlev1) + 2*dt * e3u_n*pu_rhs ) / e3u(:,:,:,ktlev3)   otherwise 
     56      !!         ua =         ub + 2*dt *       ua             vector form or linear free surf. 
     57      !!         ua = ( e3u_b*ub + 2*dt * e3u_n*ua ) / e3u_a   otherwise 
    5858      !!               - update the after velocity with the implicit vertical mixing. 
    5959      !!      This requires to solver the following system:  
    60       !!         pu_rhs = pu_rhs + 1/e3u(:,:,:,ktlev3) dk+1[ mi(avm) / e3uw_a dk[ua] ] 
     60      !!         ua = ua + 1/e3u_a dk+1[ mi(avm) / e3uw_a dk[ua] ] 
    6161      !!      with the following surface/top/bottom boundary condition: 
    6262      !!      surface: wind stress input (averaged over kt-1/2 & kt+1/2) 
    6363      !!      top & bottom : top stress (iceshelf-ocean) & bottom stress (cf zdfdrg.F90) 
    6464      !! 
    65       !! ** Action :   (pu_rhs,pv_rhs)   after velocity  
     65      !! ** Action :   (ua,va)   after velocity  
    6666      !!--------------------------------------------------------------------- 
    67       INTEGER, INTENT(in) ::   kt                       ! ocean time-step index 
    68       INTEGER, INTENT(in) ::   ktlev1, ktlev2, ktlev3   ! time level indices for 3-time-level source terms 
    69       INTEGER, INTENT(in) ::   kt2lev                   ! time level index for 2-time-level source terms 
    70       REAL(wp), INTENT(inout), DIMENSION(jpi,jpj,jpk) :: pu_rhs, pv_rhs ! momentum trends -> momentum after fields 
     67      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    7168      ! 
    7269      INTEGER  ::   ji, jj, jk         ! dummy loop indices 
    … …  
    9996      ! 
    10097      !                             !* explicit top/bottom drag case 
    101       IF( .NOT.ln_drgimp )   CALL zdf_drg_exp( kt, uu(:,:,:,ktlev1), vv(:,:,:,ktlev1), pu_rhs, pv_rhs )  ! add top/bottom friction trend to (pu_rhs,pv_rhs) 
     98      IF( .NOT.ln_drgimp )   CALL zdf_drg_exp( kt, ub, vb, ua, va )  ! add top/bottom friction trend to (ua,va) 
    10299      ! 
    103100      ! 
    104101      IF( l_trddyn )   THEN         !* temporary save of ta and sa trends 
    105102         ALLOCATE( ztrdu(jpi,jpj,jpk), ztrdv(jpi,jpj,jpk) )  
    106          ztrdu(:,:,:) = pu_rhs(:,:,:) 
    107          ztrdv(:,:,:) = pv_rhs(:,:,:) 
    108       ENDIF 
    109       ! 
    110       !              !==  RHS: Leap-Frog time stepping on all trends but the vertical mixing  ==!   (put in pu_rhs,pv_rhs) 
     103         ztrdu(:,:,:) = ua(:,:,:) 
     104         ztrdv(:,:,:) = va(:,:,:) 
     105      ENDIF 
     106      ! 
     107      !              !==  RHS: Leap-Frog time stepping on all trends but the vertical mixing  ==!   (put in ua,va) 
    111108      ! 
    112109      !                    ! time stepping except vertical diffusion 
    113110      IF( ln_dynadv_vec .OR. ln_linssh ) THEN   ! applied on velocity 
    114111         DO jk = 1, jpkm1 
    115             pu_rhs(:,:,jk) = ( uu(:,:,jk,ktlev1) + r2dt * pu_rhs(:,:,jk) ) * umask(:,:,jk) 
    116             pv_rhs(:,:,jk) = ( vv(:,:,jk,ktlev1) + r2dt * pv_rhs(:,:,jk) ) * vmask(:,:,jk) 
     112            ua(:,:,jk) = ( ub(:,:,jk) + r2dt * ua(:,:,jk) ) * umask(:,:,jk) 
     113            va(:,:,jk) = ( vb(:,:,jk) + r2dt * va(:,:,jk) ) * vmask(:,:,jk) 
    117114         END DO 
    118115      ELSE                                      ! applied on thickness weighted velocity 
    119116         DO jk = 1, jpkm1 
    120             pu_rhs(:,:,jk) = (         e3u(:,:,jk,ktlev1) * uu(:,:,jk,ktlev1)  & 
    121                &          + r2dt * e3u(:,:,jk,ktlev2) * pu_rhs(:,:,jk)  ) / e3u(:,:,jk,ktlev3) * umask(:,:,jk) 
    122             pv_rhs(:,:,jk) = (         e3v(:,:,jk,ktlev1) * vv(:,:,jk,ktlev1)  & 
    123                &          + r2dt * e3v(:,:,jk,ktlev2) * pv_rhs(:,:,jk)  ) / e3v(:,:,jk,ktlev3) * vmask(:,:,jk) 
     117            ua(:,:,jk) = (         e3u_b(:,:,jk) * ub(:,:,jk)  & 
     118               &          + r2dt * e3u_n(:,:,jk) * ua(:,:,jk)  ) / e3u_a(:,:,jk) * umask(:,:,jk) 
     119            va(:,:,jk) = (         e3v_b(:,:,jk) * vb(:,:,jk)  & 
     120               &          + r2dt * e3v_n(:,:,jk) * va(:,:,jk)  ) / e3v_a(:,:,jk) * vmask(:,:,jk) 
    124121         END DO 
    125122      ENDIF 
    … …  
    128125      !     J. Chanut: The bottom stress is computed considering after barotropic velocities, which does  
    129126      !                not lead to the effective stress seen over the whole barotropic loop.  
    130       !     G. Madec : in linear free surface, e3u(:,:,:,ktlev3) = e3u(:,:,:,ktlev2) = e3u_0, so systematic use of e3u(:,:,:,ktlev3) 
     127      !     G. Madec : in linear free surface, e3u_a = e3u_n = e3u_0, so systematic use of e3u_a 
    131128      IF( ln_drgimp .AND. ln_dynspg_ts ) THEN 
    132129         DO jk = 1, jpkm1        ! remove barotropic velocities 
    133             pu_rhs(:,:,jk) = ( pu_rhs(:,:,jk) - ua_b(:,:) ) * umask(:,:,jk) 
    134             pv_rhs(:,:,jk) = ( pv_rhs(:,:,jk) - va_b(:,:) ) * vmask(:,:,jk) 
     130            ua(:,:,jk) = ( ua(:,:,jk) - ua_b(:,:) ) * umask(:,:,jk) 
     131            va(:,:,jk) = ( va(:,:,jk) - va_b(:,:) ) * vmask(:,:,jk) 
    135132         END DO 
    136133         DO jj = 2, jpjm1        ! Add bottom/top stress due to barotropic component only 
    … …  
    138135               iku = mbku(ji,jj)         ! ocean bottom level at u- and v-points  
    139136               ikv = mbkv(ji,jj)         ! (deepest ocean u- and v-points) 
    140                ze3ua =  ( 1._wp - r_vvl ) * e3u(ji,jj,iku,ktlev2) + r_vvl * e3u(ji,jj,iku,ktlev3) 
    141                ze3va =  ( 1._wp - r_vvl ) * e3v(ji,jj,ikv,ktlev2) + r_vvl * e3v(ji,jj,ikv,ktlev3) 
    142                pu_rhs(ji,jj,iku) = pu_rhs(ji,jj,iku) + r2dt * 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * ua_b(ji,jj) / ze3ua 
    143                pv_rhs(ji,jj,ikv) = pv_rhs(ji,jj,ikv) + r2dt * 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * va_b(ji,jj) / ze3va 
     137               ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,iku) + r_vvl * e3u_a(ji,jj,iku) 
     138               ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikv) + r_vvl * e3v_a(ji,jj,ikv) 
     139               ua(ji,jj,iku) = ua(ji,jj,iku) + r2dt * 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * ua_b(ji,jj) / ze3ua 
     140               va(ji,jj,ikv) = va(ji,jj,ikv) + r2dt * 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * va_b(ji,jj) / ze3va 
    144141            END DO 
    145142         END DO 
    … …  
    149146                  iku = miku(ji,jj)         ! top ocean level at u- and v-points  
    150147                  ikv = mikv(ji,jj)         ! (first wet ocean u- and v-points) 
    151                   ze3ua =  ( 1._wp - r_vvl ) * e3u(ji,jj,iku,ktlev2) + r_vvl * e3u(ji,jj,iku,ktlev3) 
    152                   ze3va =  ( 1._wp - r_vvl ) * e3v(ji,jj,ikv,ktlev2) + r_vvl * e3v(ji,jj,ikv,ktlev3) 
    153                   pu_rhs(ji,jj,iku) = pu_rhs(ji,jj,iku) + r2dt * 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * ua_b(ji,jj) / ze3ua 
    154                   pv_rhs(ji,jj,ikv) = pv_rhs(ji,jj,ikv) + r2dt * 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * va_b(ji,jj) / ze3va 
     148                  ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,iku) + r_vvl * e3u_a(ji,jj,iku) 
     149                  ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikv) + r_vvl * e3v_a(ji,jj,ikv) 
     150                  ua(ji,jj,iku) = ua(ji,jj,iku) + r2dt * 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * ua_b(ji,jj) / ze3ua 
     151                  va(ji,jj,ikv) = va(ji,jj,ikv) + r2dt * 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * va_b(ji,jj) / ze3va 
    155152               END DO 
    156153            END DO 
    … …  
    168165               DO jj = 2, jpjm1  
    169166                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    170                      ze3ua =  ( 1._wp - r_vvl ) * e3u(ji,jj,jk,ktlev2) + r_vvl * e3u(ji,jj,jk,ktlev3)   ! after scale factor at U-point 
     167                     ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,jk) + r_vvl * e3u_a(ji,jj,jk)   ! after scale factor at U-point 
    171168                     zzwi = - zdt * ( avm(ji+1,jj,jk  ) + avm(ji,jj,jk  ) + akzu(ji,jj,jk  ) )   & 
    172                         &         / ( ze3ua * e3uw(ji,jj,jk  ,kt2lev) ) * wumask(ji,jj,jk  ) 
     169                        &         / ( ze3ua * e3uw_n(ji,jj,jk  ) ) * wumask(ji,jj,jk  ) 
    173170                     zzws = - zdt * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) + akzu(ji,jj,jk+1) )   & 
    174                         &         / ( ze3ua * e3uw(ji,jj,jk+1,kt2lev) ) * wumask(ji,jj,jk+1) 
     171                        &         / ( ze3ua * e3uw_n(ji,jj,jk+1) ) * wumask(ji,jj,jk+1) 
    175172                     zWui = 0.5_wp * ( wi(ji,jj,jk  ) + wi(ji+1,jj,jk  ) ) 
    176173                     zWus = 0.5_wp * ( wi(ji,jj,jk+1) + wi(ji+1,jj,jk+1) ) 
    … …  
    185182               DO jj = 2, jpjm1  
    186183                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    187                      ze3ua =  ( 1._wp - r_vvl ) * e3u(ji,jj,jk,ktlev2) + r_vvl * e3u(ji,jj,jk,ktlev3)   ! after scale factor at U-point 
    188                      zzwi = - zdt * ( avm(ji+1,jj,jk  ) + avm(ji,jj,jk  ) ) / ( ze3ua * e3uw(ji,jj,jk  ,kt2lev) ) * wumask(ji,jj,jk  ) 
    189                      zzws = - zdt * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) ) / ( ze3ua * e3uw(ji,jj,jk+1,kt2lev) ) * wumask(ji,jj,jk+1) 
     184                     ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,jk) + r_vvl * e3u_a(ji,jj,jk)   ! after scale factor at U-point 
     185                     zzwi = - zdt * ( avm(ji+1,jj,jk  ) + avm(ji,jj,jk  ) ) / ( ze3ua * e3uw_n(ji,jj,jk  ) ) * wumask(ji,jj,jk  ) 
     186                     zzws = - zdt * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) ) / ( ze3ua * e3uw_n(ji,jj,jk+1) ) * wumask(ji,jj,jk+1) 
    190187                     zWui = 0.5_wp * ( wi(ji,jj,jk  ) + wi(ji+1,jj,jk  ) ) 
    191188                     zWus = 0.5_wp * ( wi(ji,jj,jk+1) + wi(ji+1,jj,jk+1) ) 
    … …  
    200197            DO ji = fs_2, fs_jpim1   ! vector opt. 
    201198               zwi(ji,jj,1) = 0._wp 
    202                ze3ua =  ( 1._wp - r_vvl ) * e3u(ji,jj,1,ktlev2) + r_vvl * e3u(ji,jj,1,ktlev3) 
    203                zzws = - zdt * ( avm(ji+1,jj,2) + avm(ji  ,jj,2) ) / ( ze3ua * e3uw(ji,jj,2,kt2lev) ) * wumask(ji,jj,2) 
     199               ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,1) + r_vvl * e3u_a(ji,jj,1) 
     200               zzws = - zdt * ( avm(ji+1,jj,2) + avm(ji  ,jj,2) ) / ( ze3ua * e3uw_n(ji,jj,2) ) * wumask(ji,jj,2) 
    204201               zWus = 0.5_wp * ( wi(ji  ,jj,2) +  wi(ji+1,jj,2) ) 
    205202               zws(ji,jj,1 ) = zzws - zdt * MAX( zWus, 0._wp ) 
    … …  
    213210               DO jj = 2, jpjm1  
    214211                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    215                      ze3ua =  ( 1._wp - r_vvl ) * e3u(ji,jj,jk,ktlev2) + r_vvl * e3u(ji,jj,jk,ktlev3)   ! after scale factor at U-point 
     212                     ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,jk) + r_vvl * e3u_a(ji,jj,jk)   ! after scale factor at U-point 
    216213                     zzwi = - zdt * ( avm(ji+1,jj,jk  ) + avm(ji,jj,jk  ) + akzu(ji,jj,jk  ) )   & 
    217                         &         / ( ze3ua * e3uw(ji,jj,jk  ,kt2lev) ) * wumask(ji,jj,jk  ) 
     214                        &         / ( ze3ua * e3uw_n(ji,jj,jk  ) ) * wumask(ji,jj,jk  ) 
    218215                     zzws = - zdt * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) + akzu(ji,jj,jk+1) )   & 
    219                         &         / ( ze3ua * e3uw(ji,jj,jk+1,kt2lev) ) * wumask(ji,jj,jk+1) 
     216                        &         / ( ze3ua * e3uw_n(ji,jj,jk+1) ) * wumask(ji,jj,jk+1) 
    220217                     zwi(ji,jj,jk) = zzwi 
    221218                     zws(ji,jj,jk) = zzws 
    … …  
    228225               DO jj = 2, jpjm1  
    229226                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    230                      ze3ua =  ( 1._wp - r_vvl ) * e3u(ji,jj,jk,ktlev2) + r_vvl * e3u(ji,jj,jk,ktlev3)   ! after scale factor at U-point 
    231                      zzwi = - zdt * ( avm(ji+1,jj,jk  ) + avm(ji,jj,jk  ) ) / ( ze3ua * e3uw(ji,jj,jk  ,kt2lev) ) * wumask(ji,jj,jk  ) 
    232                      zzws = - zdt * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) ) / ( ze3ua * e3uw(ji,jj,jk+1,kt2lev) ) * wumask(ji,jj,jk+1) 
     227                     ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,jk) + r_vvl * e3u_a(ji,jj,jk)   ! after scale factor at U-point 
     228                     zzwi = - zdt * ( avm(ji+1,jj,jk  ) + avm(ji,jj,jk  ) ) / ( ze3ua * e3uw_n(ji,jj,jk  ) ) * wumask(ji,jj,jk  ) 
     229                     zzws = - zdt * ( avm(ji+1,jj,jk+1) + avm(ji,jj,jk+1) ) / ( ze3ua * e3uw_n(ji,jj,jk+1) ) * wumask(ji,jj,jk+1) 
    233230                     zwi(ji,jj,jk) = zzwi 
    234231                     zws(ji,jj,jk) = zzws 
    … …  
    257254            DO ji = 2, jpim1 
    258255               iku = mbku(ji,jj)       ! ocean bottom level at u- and v-points 
    259                ze3ua =  ( 1._wp - r_vvl ) * e3u(ji,jj,iku,ktlev2) + r_vvl * e3u(ji,jj,iku,ktlev3)   ! after scale factor at T-point 
     256               ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,iku) + r_vvl * e3u_a(ji,jj,iku)   ! after scale factor at T-point 
    260257               zwd(ji,jj,iku) = zwd(ji,jj,iku) - r2dt * 0.5*( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) / ze3ua 
    261258            END DO 
    … …  
    266263                  !!gm   top Cd is masked (=0 outside cavities) no need of test on mik>=2  ==>> it has been suppressed 
    267264                  iku = miku(ji,jj)       ! ocean top level at u- and v-points  
    268                   ze3ua =  ( 1._wp - r_vvl ) * e3u(ji,jj,iku,ktlev2) + r_vvl * e3u(ji,jj,iku,ktlev3)   ! after scale factor at T-point 
     265                  ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,iku) + r_vvl * e3u_a(ji,jj,iku)   ! after scale factor at T-point 
    269266                  zwd(ji,jj,iku) = zwd(ji,jj,iku) - r2dt * 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) / ze3ua 
    270267               END DO 
    … …  
    285282      !   m is decomposed in the product of an upper and a lower triangular matrix 
    286283      !   The 3 diagonal terms are in 2d arrays: zwd, zws, zwi 
    287       !   The solution (the after velocity) is in pu_rhs 
     284      !   The solution (the after velocity) is in ua 
    288285      !----------------------------------------------------------------------- 
    289286      ! 
    … …  
    298295      DO jj = 2, jpjm1        !==  second recurrence:    SOLk = RHSk - Lk / Dk-1  Lk-1  ==! 
    299296         DO ji = fs_2, fs_jpim1   ! vector opt. 
    300             ze3ua =  ( 1._wp - r_vvl ) * e3u(ji,jj,1,ktlev2) + r_vvl * e3u(ji,jj,1,ktlev3)  
    301             pu_rhs(ji,jj,1) = pu_rhs(ji,jj,1) + r2dt * 0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) )   & 
     297            ze3ua =  ( 1._wp - r_vvl ) * e3u_n(ji,jj,1) + r_vvl * e3u_a(ji,jj,1)  
     298            ua(ji,jj,1) = ua(ji,jj,1) + r2dt * 0.5_wp * ( utau_b(ji,jj) + utau(ji,jj) )   & 
    302299               &                                      / ( ze3ua * rau0 ) * umask(ji,jj,1)  
    303300         END DO 
    … …  
    306303         DO jj = 2, jpjm1 
    307304            DO ji = fs_2, fs_jpim1 
    308                pu_rhs(ji,jj,jk) = pu_rhs(ji,jj,jk) - zwi(ji,jj,jk) / zwd(ji,jj,jk-1) * pu_rhs(ji,jj,jk-1) 
     305               ua(ji,jj,jk) = ua(ji,jj,jk) - zwi(ji,jj,jk) / zwd(ji,jj,jk-1) * ua(ji,jj,jk-1) 
    309306            END DO 
    310307         END DO 
    … …  
    313310      DO jj = 2, jpjm1        !==  thrid recurrence : SOLk = ( Lk - Uk * Ek+1 ) / Dk  ==! 
    314311         DO ji = fs_2, fs_jpim1   ! vector opt. 
    315             pu_rhs(ji,jj,jpkm1) = pu_rhs(ji,jj,jpkm1) / zwd(ji,jj,jpkm1) 
     312            ua(ji,jj,jpkm1) = ua(ji,jj,jpkm1) / zwd(ji,jj,jpkm1) 
    316313         END DO 
    317314      END DO 
    … …  
    319316         DO jj = 2, jpjm1 
    320317            DO ji = fs_2, fs_jpim1 
    321                pu_rhs(ji,jj,jk) = ( pu_rhs(ji,jj,jk) - zws(ji,jj,jk) * pu_rhs(ji,jj,jk+1) ) / zwd(ji,jj,jk) 
     318               ua(ji,jj,jk) = ( ua(ji,jj,jk) - zws(ji,jj,jk) * ua(ji,jj,jk+1) ) / zwd(ji,jj,jk) 
    322319            END DO 
    323320         END DO 
    … …  
    334331               DO jj = 2, jpjm1  
    335332                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    336                      ze3va =  ( 1._wp - r_vvl ) * e3v(ji,jj,jk,ktlev2) + r_vvl * e3v(ji,jj,jk,ktlev3)   ! after scale factor at V-point 
     333                     ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,jk) + r_vvl * e3v_a(ji,jj,jk)   ! after scale factor at V-point 
    337334                     zzwi = - zdt * ( avm(ji,jj+1,jk  ) + avm(ji,jj,jk  ) + akzv(ji,jj,jk  ) )   & 
    338                         &         / ( ze3va * e3vw(ji,jj,jk  ,kt2lev) ) * wvmask(ji,jj,jk  ) 
     335                        &         / ( ze3va * e3vw_n(ji,jj,jk  ) ) * wvmask(ji,jj,jk  ) 
    339336                     zzws = - zdt * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) + akzv(ji,jj,jk+1) )   & 
    340                         &         / ( ze3va * e3vw(ji,jj,jk+1,kt2lev) ) * wvmask(ji,jj,jk+1) 
     337                        &         / ( ze3va * e3vw_n(ji,jj,jk+1) ) * wvmask(ji,jj,jk+1) 
    341338                     zWvi = 0.5_wp * ( wi(ji,jj,jk  ) + wi(ji,jj+1,jk  ) ) * wvmask(ji,jj,jk  ) 
    342339                     zWvs = 0.5_wp * ( wi(ji,jj,jk+1) + wi(ji,jj+1,jk+1) ) * wvmask(ji,jj,jk+1) 
    … …  
    351348               DO jj = 2, jpjm1  
    352349                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    353                      ze3va =  ( 1._wp - r_vvl ) * e3v(ji,jj,jk,ktlev2) + r_vvl * e3v(ji,jj,jk,ktlev3)   ! after scale factor at V-point 
    354                      zzwi = - zdt * ( avm(ji,jj+1,jk  ) + avm(ji,jj,jk  ) ) / ( ze3va * e3vw(ji,jj,jk  ,kt2lev) ) * wvmask(ji,jj,jk  ) 
    355                      zzws = - zdt * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) ) / ( ze3va * e3vw(ji,jj,jk+1,kt2lev) ) * wvmask(ji,jj,jk+1) 
     350                     ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,jk) + r_vvl * e3v_a(ji,jj,jk)   ! after scale factor at V-point 
     351                     zzwi = - zdt * ( avm(ji,jj+1,jk  ) + avm(ji,jj,jk  ) ) / ( ze3va * e3vw_n(ji,jj,jk  ) ) * wvmask(ji,jj,jk  ) 
     352                     zzws = - zdt * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) ) / ( ze3va * e3vw_n(ji,jj,jk+1) ) * wvmask(ji,jj,jk+1) 
    356353                     zWvi = 0.5_wp * ( wi(ji,jj,jk  ) + wi(ji,jj+1,jk  ) ) * wvmask(ji,jj,jk  ) 
    357354                     zWvs = 0.5_wp * ( wi(ji,jj,jk+1) + wi(ji,jj+1,jk+1) ) * wvmask(ji,jj,jk+1) 
    … …  
    366363            DO ji = fs_2, fs_jpim1   ! vector opt. 
    367364               zwi(ji,jj,1) = 0._wp 
    368                ze3va =  ( 1._wp - r_vvl ) * e3v(ji,jj,1,ktlev2) + r_vvl * e3v(ji,jj,1,ktlev3) 
    369                zzws = - zdt * ( avm(ji,jj+1,2) + avm(ji,jj,2) ) / ( ze3va * e3vw(ji,jj,2,kt2lev) ) * wvmask(ji,jj,2) 
     365               ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,1) + r_vvl * e3v_a(ji,jj,1) 
     366               zzws = - zdt * ( avm(ji,jj+1,2) + avm(ji,jj,2) ) / ( ze3va * e3vw_n(ji,jj,2) ) * wvmask(ji,jj,2) 
    370367               zWvs = 0.5_wp * ( wi(ji,jj  ,2) +  wi(ji,jj+1,2) ) 
    371368               zws(ji,jj,1 ) = zzws - zdt * MAX( zWvs, 0._wp ) 
    … …  
    379376               DO jj = 2, jpjm1    
    380377                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    381                      ze3va =  ( 1._wp - r_vvl ) * e3v(ji,jj,jk,ktlev2) + r_vvl * e3v(ji,jj,jk,ktlev3)   ! after scale factor at V-point 
     378                     ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,jk) + r_vvl * e3v_a(ji,jj,jk)   ! after scale factor at V-point 
    382379                     zzwi = - zdt * ( avm(ji,jj+1,jk  ) + avm(ji,jj,jk  ) + akzv(ji,jj,jk  ) )   & 
    383                         &         / ( ze3va * e3vw(ji,jj,jk  ,kt2lev) ) * wvmask(ji,jj,jk  ) 
     380                        &         / ( ze3va * e3vw_n(ji,jj,jk  ) ) * wvmask(ji,jj,jk  ) 
    384381                     zzws = - zdt * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) + akzv(ji,jj,jk+1) )   & 
    385                         &         / ( ze3va * e3vw(ji,jj,jk+1,kt2lev) ) * wvmask(ji,jj,jk+1) 
     382                        &         / ( ze3va * e3vw_n(ji,jj,jk+1) ) * wvmask(ji,jj,jk+1) 
    386383                     zwi(ji,jj,jk) = zzwi 
    387384                     zws(ji,jj,jk) = zzws 
    … …  
    394391               DO jj = 2, jpjm1    
    395392                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    396                      ze3va =  ( 1._wp - r_vvl ) * e3v(ji,jj,jk,ktlev2) + r_vvl * e3v(ji,jj,jk,ktlev3)   ! after scale factor at V-point 
    397                      zzwi = - zdt * ( avm(ji,jj+1,jk  ) + avm(ji,jj,jk  ) ) / ( ze3va * e3vw(ji,jj,jk  ,kt2lev) ) * wvmask(ji,jj,jk  ) 
    398                      zzws = - zdt * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) ) / ( ze3va * e3vw(ji,jj,jk+1,kt2lev) ) * wvmask(ji,jj,jk+1) 
     393                     ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,jk) + r_vvl * e3v_a(ji,jj,jk)   ! after scale factor at V-point 
     394                     zzwi = - zdt * ( avm(ji,jj+1,jk  ) + avm(ji,jj,jk  ) ) / ( ze3va * e3vw_n(ji,jj,jk  ) ) * wvmask(ji,jj,jk  ) 
     395                     zzws = - zdt * ( avm(ji,jj+1,jk+1) + avm(ji,jj,jk+1) ) / ( ze3va * e3vw_n(ji,jj,jk+1) ) * wvmask(ji,jj,jk+1) 
    399396                     zwi(ji,jj,jk) = zzwi 
    400397                     zws(ji,jj,jk) = zzws 
    … …  
    422419            DO ji = 2, jpim1 
    423420               ikv = mbkv(ji,jj)       ! (deepest ocean u- and v-points) 
    424                ze3va =  ( 1._wp - r_vvl ) * e3v(ji,jj,ikv,ktlev2) + r_vvl * e3v(ji,jj,ikv,ktlev3)   ! after scale factor at T-point 
     421               ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikv) + r_vvl * e3v_a(ji,jj,ikv)   ! after scale factor at T-point 
    425422               zwd(ji,jj,ikv) = zwd(ji,jj,ikv) - r2dt * 0.5*( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) / ze3va            
    426423            END DO 
    … …  
    430427               DO ji = 2, jpim1 
    431428                  ikv = mikv(ji,jj)       ! (first wet ocean u- and v-points) 
    432                   ze3va =  ( 1._wp - r_vvl ) * e3v(ji,jj,ikv,ktlev2) + r_vvl * e3v(ji,jj,ikv,ktlev3)   ! after scale factor at T-point 
     429                  ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,ikv) + r_vvl * e3v_a(ji,jj,ikv)   ! after scale factor at T-point 
    433430                  zwd(ji,jj,iku) = zwd(ji,jj,iku) - r2dt * 0.5*( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) / ze3va 
    434431               END DO 
    … …  
    449446      !   m is decomposed in the product of an upper and lower triangular matrix 
    450447      !   The 3 diagonal terms are in 2d arrays: zwd, zws, zwi 
    451       !   The solution (after velocity) is in 2d array pv_rhs 
     448      !   The solution (after velocity) is in 2d array va 
    452449      !----------------------------------------------------------------------- 
    453450      ! 
    … …  
    462459      DO jj = 2, jpjm1        !==  second recurrence:    SOLk = RHSk - Lk / Dk-1  Lk-1  ==! 
    463460         DO ji = fs_2, fs_jpim1   ! vector opt.           
    464             ze3va =  ( 1._wp - r_vvl ) * e3v(ji,jj,1,ktlev2) + r_vvl * e3v(ji,jj,1,ktlev3)  
    465             pv_rhs(ji,jj,1) = pv_rhs(ji,jj,1) + r2dt * 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) )   & 
     461            ze3va =  ( 1._wp - r_vvl ) * e3v_n(ji,jj,1) + r_vvl * e3v_a(ji,jj,1)  
     462            va(ji,jj,1) = va(ji,jj,1) + r2dt * 0.5_wp * ( vtau_b(ji,jj) + vtau(ji,jj) )   & 
    466463               &                                      / ( ze3va * rau0 ) * vmask(ji,jj,1)  
    467464         END DO 
    … …  
    470467         DO jj = 2, jpjm1 
    471468            DO ji = fs_2, fs_jpim1   ! vector opt. 
    472                pv_rhs(ji,jj,jk) = pv_rhs(ji,jj,jk) - zwi(ji,jj,jk) / zwd(ji,jj,jk-1) * pv_rhs(ji,jj,jk-1) 
     469               va(ji,jj,jk) = va(ji,jj,jk) - zwi(ji,jj,jk) / zwd(ji,jj,jk-1) * va(ji,jj,jk-1) 
    473470            END DO 
    474471         END DO 
    … …  
    477474      DO jj = 2, jpjm1        !==  third recurrence : SOLk = ( Lk - Uk * SOLk+1 ) / Dk  ==! 
    478475         DO ji = fs_2, fs_jpim1   ! vector opt. 
    479             pv_rhs(ji,jj,jpkm1) = pv_rhs(ji,jj,jpkm1) / zwd(ji,jj,jpkm1) 
     476            va(ji,jj,jpkm1) = va(ji,jj,jpkm1) / zwd(ji,jj,jpkm1) 
    480477         END DO 
    481478      END DO 
    … …  
    483480         DO jj = 2, jpjm1 
    484481            DO ji = fs_2, fs_jpim1 
    485                pv_rhs(ji,jj,jk) = ( pv_rhs(ji,jj,jk) - zws(ji,jj,jk) * pv_rhs(ji,jj,jk+1) ) / zwd(ji,jj,jk) 
     482               va(ji,jj,jk) = ( va(ji,jj,jk) - zws(ji,jj,jk) * va(ji,jj,jk+1) ) / zwd(ji,jj,jk) 
    486483            END DO 
    487484         END DO 
    … …  
    489486      ! 
    490487      IF( l_trddyn )   THEN                      ! save the vertical diffusive trends for further diagnostics 
    491          ztrdu(:,:,:) = ( pu_rhs(:,:,:) - uu(:,:,:,ktlev1) ) / r2dt - ztrdu(:,:,:) 
    492          ztrdv(:,:,:) = ( pv_rhs(:,:,:) - vv(:,:,:,ktlev1) ) / r2dt - ztrdv(:,:,:) 
     488         ztrdu(:,:,:) = ( ua(:,:,:) - ub(:,:,:) ) / r2dt - ztrdu(:,:,:) 
     489         ztrdv(:,:,:) = ( va(:,:,:) - vb(:,:,:) ) / r2dt - ztrdv(:,:,:) 
    493490         CALL trd_dyn( ztrdu, ztrdv, jpdyn_zdf, kt ) 
    494491         DEALLOCATE( ztrdu, ztrdv )  

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/traadv.F90

    r10806 r10874  
    7575CONTAINS 
    7676 
    77    SUBROUTINE tra_adv( kt, ktlev1, ktlev2, ktlev3, kt2lev, pts_rhs ) 
     77   SUBROUTINE tra_adv( kt ) 
    7878      !!---------------------------------------------------------------------- 
    7979      !!                  ***  ROUTINE tra_adv  *** 
    … …  
    8181      !! ** Purpose :   compute the ocean tracer advection trend. 
    8282      !! 
    83       !! ** Method  : - Update (pu_rhs,pv_rhs) with the advection term following nadv 
    84       !!---------------------------------------------------------------------- 
    85       INTEGER, INTENT(in) ::   kt                       ! ocean time-step index 
    86       INTEGER, INTENT(in) ::   ktlev1, ktlev2, ktlev3   ! time level indices for 3-time-level source terms 
    87       INTEGER, INTENT(in) ::   kt2lev                   ! time level index for 2-time-level source terms 
    88       REAL(wp), INTENT( inout), DIMENSION(jpi,jpj,jpk,jpts) :: pts_rhs ! temperature and salinity trends 
     83      !! ** Method  : - Update (ua,va) with the advection term following nadv 
     84      !!---------------------------------------------------------------------- 
     85      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    8986      ! 
    9087      INTEGER ::   jk   ! dummy loop index 
    … …  
    106103      IF( ln_wave .AND. ln_sdw )  THEN 
    107104         DO jk = 1, jpkm1                                                       ! eulerian transport + Stokes Drift 
    108             zun(:,:,jk) = e2u  (:,:) * e3u(:,:,jk,ktlev2) * ( uu(:,:,jk,ktlev2) + usd(:,:,jk) ) 
    109             zvn(:,:,jk) = e1v  (:,:) * e3v(:,:,jk,ktlev2) * ( vv(:,:,jk,ktlev2) + vsd(:,:,jk) ) 
    110             zwn(:,:,jk) = e1e2t(:,:)                 * ( ww(:,:,jk) + wsd(:,:,jk) ) 
     105            zun(:,:,jk) = e2u  (:,:) * e3u_n(:,:,jk) * ( un(:,:,jk) + usd(:,:,jk) ) 
     106            zvn(:,:,jk) = e1v  (:,:) * e3v_n(:,:,jk) * ( vn(:,:,jk) + vsd(:,:,jk) ) 
     107            zwn(:,:,jk) = e1e2t(:,:)                 * ( wn(:,:,jk) + wsd(:,:,jk) ) 
    111108         END DO 
    112109      ELSE 
    113110         DO jk = 1, jpkm1 
    114             zun(:,:,jk) = e2u  (:,:) * e3u(:,:,jk,ktlev2) * uu(:,:,jk,ktlev2)               ! eulerian transport only 
    115             zvn(:,:,jk) = e1v  (:,:) * e3v(:,:,jk,ktlev2) * vv(:,:,jk,ktlev2) 
    116             zwn(:,:,jk) = e1e2t(:,:)                 * ww(:,:,jk) 
     111            zun(:,:,jk) = e2u  (:,:) * e3u_n(:,:,jk) * un(:,:,jk)               ! eulerian transport only 
     112            zvn(:,:,jk) = e1v  (:,:) * e3v_n(:,:,jk) * vn(:,:,jk) 
     113            zwn(:,:,jk) = e1e2t(:,:)                 * wn(:,:,jk) 
    117114         END DO 
    118115      ENDIF 
    … …  
    142139      IF( l_trdtra )   THEN                    !* Save ta and sa trends 
    143140         ALLOCATE( ztrdt(jpi,jpj,jpk), ztrds(jpi,jpj,jpk) ) 
    144          ztrdt(:,:,:) = pts_rhs(:,:,:,jp_tem) 
    145          ztrds(:,:,:) = pts_rhs(:,:,:,jp_sal) 
     141         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
     142         ztrds(:,:,:) = tsa(:,:,:,jp_sal) 
    146143      ENDIF 
    147144      ! 
    … …  
    149146      ! 
    150147      CASE ( np_CEN )                                 ! Centered scheme : 2nd / 4th order 
    151          CALL tra_adv_cen    ( kt, nit000, ktlev2, 'TRA',         zun, zvn, zwn     , ts(:,:,:,:,ktlev2), pts_rhs, jpts, nn_cen_h, nn_cen_v ) 
     148         CALL tra_adv_cen    ( kt, nit000, 'TRA',         zun, zvn, zwn     , tsn, tsa, jpts, nn_cen_h, nn_cen_v ) 
    152149      CASE ( np_FCT )                                 ! FCT scheme      : 2nd / 4th order 
    153          CALL tra_adv_fct    ( kt, nit000, ktlev1, ktlev2, ktlev3, 'TRA', r2dt, zun, zvn, zwn,                      & 
    154      &                         ts(:,:,:,:,ktlev1), ts(:,:,:,:,ktlev2), pts_rhs, jpts, nn_fct_h, nn_fct_v ) 
     150         CALL tra_adv_fct    ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts, nn_fct_h, nn_fct_v ) 
    155151      CASE ( np_MUS )                                 ! MUSCL 
    156          CALL tra_adv_mus    ( kt, nit000, ktlev2, kt2lev, 'TRA', r2dt, zun, zvn, zwn, ts(:,:,:,:,ktlev1),      pts_rhs, jpts        , ln_mus_ups )  
     152         CALL tra_adv_mus    ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb,      tsa, jpts        , ln_mus_ups )  
    157153      CASE ( np_UBS )                                 ! UBS 
    158          CALL tra_adv_ubs    ( kt, nit000, ktlev2, 'TRA', r2dt, zun, zvn, zwn, ts(:,:,:,:,ktlev1), ts(:,:,:,:,ktlev2), pts_rhs, jpts        , nn_ubs_v   ) 
     154         CALL tra_adv_ubs    ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts        , nn_ubs_v   ) 
    159155      CASE ( np_QCK )                                 ! QUICKEST 
    160          CALL tra_adv_qck    ( kt, nit000, ktlev2, 'TRA', r2dt, zun, zvn, zwn, ts(:,:,:,:,ktlev1), ts(:,:,:,:,ktlev2), pts_rhs, jpts                     ) 
     156         CALL tra_adv_qck    ( kt, nit000, 'TRA', r2dt, zun, zvn, zwn, tsb, tsn, tsa, jpts                     ) 
    161157      ! 
    162158      END SELECT 
    … …  
    164160      IF( l_trdtra )   THEN                      ! save the advective trends for further diagnostics 
    165161         DO jk = 1, jpkm1 
    166             ztrdt(:,:,jk) = pts_rhs(:,:,jk,jp_tem) - ztrdt(:,:,jk) 
    167             ztrds(:,:,jk) = pts_rhs(:,:,jk,jp_sal) - ztrds(:,:,jk) 
     162            ztrdt(:,:,jk) = tsa(:,:,jk,jp_tem) - ztrdt(:,:,jk) 
     163            ztrds(:,:,jk) = tsa(:,:,jk,jp_sal) - ztrds(:,:,jk) 
    168164         END DO 
    169165         CALL trd_tra( kt, 'TRA', jp_tem, jptra_totad, ztrdt ) 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/traadv_cen.F90

    r10806 r10874  
    4444CONTAINS 
    4545 
    46    SUBROUTINE tra_adv_cen( kt, kit000, ktlev, cdtype, pu, pv, pw,     & 
    47       &                                               pt, pt_rhs, kjpt, kn_cen_h, kn_cen_v )  
     46   SUBROUTINE tra_adv_cen( kt, kit000, cdtype, pun, pvn, pwn,     & 
     47      &                                        ptn, pta, kjpt, kn_cen_h, kn_cen_v )  
    4848      !!---------------------------------------------------------------------- 
    4949      !!                  ***  ROUTINE tra_adv_cen  *** 
    … …  
    5959      !!                = 4  ==>> 4th order COMPACT  scheme     -      - 
    6060      !! 
    61       !! ** Action : - update pt_rhs  with the now advective tracer trends 
     61      !! ** Action : - update pta  with the now advective tracer trends 
    6262      !!             - send trends to trdtra module for further diagnostcs (l_trdtra=T) 
    6363      !!             - htr_adv, str_adv : poleward advective heat and salt transport (ln_diaptr=T) 
    … …  
    6565      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
    6666      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index 
    67       INTEGER                              , INTENT(in   ) ::   ktlev           ! time level index for source terms 
    6867      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator) 
    6968      INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers 
    7069      INTEGER                              , INTENT(in   ) ::   kn_cen_h        ! =2/4 (2nd or 4th order scheme) 
    7170      INTEGER                              , INTENT(in   ) ::   kn_cen_v        ! =2/4 (2nd or 4th order scheme) 
    72       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pu, pv, pw   ! 3 ocean velocity components 
    73       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   pt             ! now tracer fields 
    74       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pt_rhs             ! tracer trend  
     71      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components 
     72      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptn             ! now tracer fields 
     73      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend  
    7574      ! 
    7675      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    … …  
    107106               DO jj = 1, jpjm1 
    108107                  DO ji = 1, fs_jpim1   ! vector opt. 
    109                      zwx(ji,jj,jk) = 0.5_wp * pu(ji,jj,jk) * ( pt(ji,jj,jk,jn) + pt(ji+1,jj  ,jk,jn) ) 
    110                      zwy(ji,jj,jk) = 0.5_wp * pv(ji,jj,jk) * ( pt(ji,jj,jk,jn) + pt(ji  ,jj+1,jk,jn) ) 
     108                     zwx(ji,jj,jk) = 0.5_wp * pun(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj  ,jk,jn) ) 
     109                     zwy(ji,jj,jk) = 0.5_wp * pvn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji  ,jj+1,jk,jn) ) 
    111110                  END DO 
    112111               END DO 
    … …  
    119118               DO jj = 2, jpjm1 
    120119                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    121                      ztu(ji,jj,jk) = ( pt(ji+1,jj  ,jk,jn) - pt(ji,jj,jk,jn) ) * umask(ji,jj,jk) 
    122                      ztv(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn) - pt(ji,jj,jk,jn) ) * vmask(ji,jj,jk) 
     120                     ztu(ji,jj,jk) = ( ptn(ji+1,jj  ,jk,jn) - ptn(ji,jj,jk,jn) ) * umask(ji,jj,jk) 
     121                     ztv(ji,jj,jk) = ( ptn(ji  ,jj+1,jk,jn) - ptn(ji,jj,jk,jn) ) * vmask(ji,jj,jk) 
    123122                  END DO 
    124123               END DO 
    … …  
    129128               DO jj = 2, jpjm1 
    130129                  DO ji = 1, fs_jpim1   ! vector opt. 
    131                      zC2t_u = pt(ji,jj,jk,jn) + pt(ji+1,jj  ,jk,jn)   ! C2 interpolation of T at u- & v-points (x2) 
    132                      zC2t_v = pt(ji,jj,jk,jn) + pt(ji  ,jj+1,jk,jn) 
     130                     zC2t_u = ptn(ji,jj,jk,jn) + ptn(ji+1,jj  ,jk,jn)   ! C2 interpolation of T at u- & v-points (x2) 
     131                     zC2t_v = ptn(ji,jj,jk,jn) + ptn(ji  ,jj+1,jk,jn) 
    133132                     !                                                  ! C4 interpolation of T at u- & v-points (x2) 
    134133                     zC4t_u =  zC2t_u + r1_6 * ( ztu(ji-1,jj,jk) - ztu(ji+1,jj,jk) ) 
    135134                     zC4t_v =  zC2t_v + r1_6 * ( ztv(ji,jj-1,jk) - ztv(ji,jj+1,jk) ) 
    136135                     !                                                  ! C4 fluxes 
    137                      zwx(ji,jj,jk) =  0.5_wp * pu(ji,jj,jk) * zC4t_u 
    138                      zwy(ji,jj,jk) =  0.5_wp * pv(ji,jj,jk) * zC4t_v 
     136                     zwx(ji,jj,jk) =  0.5_wp * pun(ji,jj,jk) * zC4t_u 
     137                     zwy(ji,jj,jk) =  0.5_wp * pvn(ji,jj,jk) * zC4t_v 
    139138                  END DO 
    140139               END DO 
    … …  
    151150               DO jj = 2, jpjm1 
    152151                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    153                      zwz(ji,jj,jk) = 0.5 * pw(ji,jj,jk) * ( pt(ji,jj,jk,jn) + pt(ji,jj,jk-1,jn) ) * wmask(ji,jj,jk) 
     152                     zwz(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj,jk-1,jn) ) * wmask(ji,jj,jk) 
    154153                  END DO 
    155154               END DO 
    … …  
    157156            ! 
    158157         CASE(  4  )                         !* 4th order compact 
    159             CALL interp_4th_cpt( pt(:,:,:,jn) , ztw )      ! ztw = interpolated value of T at w-point 
     158            CALL interp_4th_cpt( ptn(:,:,:,jn) , ztw )      ! ztw = interpolated value of T at w-point 
    160159            DO jk = 2, jpkm1 
    161160               DO jj = 2, jpjm1 
    162161                  DO ji = fs_2, fs_jpim1 
    163                      zwz(ji,jj,jk) = pw(ji,jj,jk) * ztw(ji,jj,jk) * wmask(ji,jj,jk) 
     162                     zwz(ji,jj,jk) = pwn(ji,jj,jk) * ztw(ji,jj,jk) * wmask(ji,jj,jk) 
    164163                  END DO 
    165164               END DO 
    … …  
    172171               DO jj = 1, jpj 
    173172                  DO ji = 1, jpi 
    174                      zwz(ji,jj, mikt(ji,jj) ) = pw(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn)  
     173                     zwz(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptn(ji,jj,mikt(ji,jj),jn)  
    175174                  END DO 
    176175               END DO    
    177176            ELSE                                   ! no ice-shelf cavities (only ocean surface) 
    178                zwz(:,:,1) = pw(:,:,1) * pt(:,:,1,jn) 
     177               zwz(:,:,1) = pwn(:,:,1) * ptn(:,:,1,jn) 
    179178            ENDIF 
    180179         ENDIF 
    … …  
    183182            DO jj = 2, jpjm1 
    184183               DO ji = fs_2, fs_jpim1   ! vector opt. 
    185                   pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn)    & 
     184                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn)    & 
    186185                     &             - (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )    & 
    187186                     &                + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )    & 
    188                      &                + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1)  ) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,ktlev) 
     187                     &                + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1)  ) * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
    189188               END DO 
    190189            END DO 
    … …  
    192191         !                             ! trend diagnostics 
    193192         IF( l_trd ) THEN 
    194             CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pu, pt(:,:,:,jn) ) 
    195             CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pv, pt(:,:,:,jn) ) 
    196             CALL trd_tra( kt, cdtype, jn, jptra_zad, zwz, pw, pt(:,:,:,jn) ) 
     193            CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pun, ptn(:,:,:,jn) ) 
     194            CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptn(:,:,:,jn) ) 
     195            CALL trd_tra( kt, cdtype, jn, jptra_zad, zwz, pwn, ptn(:,:,:,jn) ) 
    197196         END IF 
    198197         !                                 ! "Poleward" heat and salt transports  

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/traadv_fct.F90

    r10806 r10874  
    5252CONTAINS 
    5353 
    54    SUBROUTINE tra_adv_fct( kt, kit000, ktlev1, ktlev2, ktlev3, cdtype, p2dt, pu, pv, pw,       & 
    55       &                                                                pt_lev1, pt_lev2, pt_rhs, kjpt, kn_fct_h, kn_fct_v ) 
     54   SUBROUTINE tra_adv_fct( kt, kit000, cdtype, p2dt, pun, pvn, pwn,       & 
     55      &                                              ptb, ptn, pta, kjpt, kn_fct_h, kn_fct_v ) 
    5656      !!---------------------------------------------------------------------- 
    5757      !!                  ***  ROUTINE tra_adv_fct  *** 
    … …  
    6565      !!               - corrected flux (monotonic correction)  
    6666      !! 
    67       !! ** Action : - update pt_rhs  with the now advective tracer trends 
     67      !! ** Action : - update pta  with the now advective tracer trends 
    6868      !!             - send trends to trdtra module for further diagnostics (l_trdtra=T) 
    6969      !!             - htr_adv, str_adv : poleward advective heat and salt transport (ln_diaptr=T) 
    7070      !!---------------------------------------------------------------------- 
    7171      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
    72       INTEGER                              , INTENT(in   ) ::   ktlev1, ktlev2, ktlev3   ! time level indices for source terms 
    7372      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index 
    7473      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator) 
    … …  
    7776      INTEGER                              , INTENT(in   ) ::   kn_fct_v        ! order of the FCT scheme (=2 or 4) 
    7877      REAL(wp)                             , INTENT(in   ) ::   p2dt            ! tracer time-step 
    79       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pu, pv, pw   ! 3 ocean velocity components 
    80       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   pt_lev1, pt_lev2        ! before and now tracer fields 
    81       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pt_rhs             ! tracer trend  
     78      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components 
     79      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields 
     80      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend  
    8281      ! 
    8382      INTEGER  ::   ji, jj, jk, jn                           ! dummy loop indices   
    … …  
    126125               DO ji = 1, fs_jpim1   ! vector opt. 
    127126                  ! upstream scheme 
    128                   zfp_ui = pu(ji,jj,jk) + ABS( pu(ji,jj,jk) ) 
    129                   zfm_ui = pu(ji,jj,jk) - ABS( pu(ji,jj,jk) ) 
    130                   zfp_vj = pv(ji,jj,jk) + ABS( pv(ji,jj,jk) ) 
    131                   zfm_vj = pv(ji,jj,jk) - ABS( pv(ji,jj,jk) ) 
    132                   zwx(ji,jj,jk) = 0.5 * ( zfp_ui * pt_lev1(ji,jj,jk,jn) + zfm_ui * pt_lev1(ji+1,jj  ,jk,jn) ) 
    133                   zwy(ji,jj,jk) = 0.5 * ( zfp_vj * pt_lev1(ji,jj,jk,jn) + zfm_vj * pt_lev1(ji  ,jj+1,jk,jn) ) 
     127                  zfp_ui = pun(ji,jj,jk) + ABS( pun(ji,jj,jk) ) 
     128                  zfm_ui = pun(ji,jj,jk) - ABS( pun(ji,jj,jk) ) 
     129                  zfp_vj = pvn(ji,jj,jk) + ABS( pvn(ji,jj,jk) ) 
     130                  zfm_vj = pvn(ji,jj,jk) - ABS( pvn(ji,jj,jk) ) 
     131                  zwx(ji,jj,jk) = 0.5 * ( zfp_ui * ptb(ji,jj,jk,jn) + zfm_ui * ptb(ji+1,jj  ,jk,jn) ) 
     132                  zwy(ji,jj,jk) = 0.5 * ( zfp_vj * ptb(ji,jj,jk,jn) + zfm_vj * ptb(ji  ,jj+1,jk,jn) ) 
    134133               END DO 
    135134            END DO 
    … …  
    139138            DO jj = 1, jpj 
    140139               DO ji = 1, jpi 
    141                   zfp_wk = pw(ji,jj,jk) + ABS( pw(ji,jj,jk) ) 
    142                   zfm_wk = pw(ji,jj,jk) - ABS( pw(ji,jj,jk) ) 
    143                   zwz(ji,jj,jk) = 0.5 * ( zfp_wk * pt_lev1(ji,jj,jk,jn) + zfm_wk * pt_lev1(ji,jj,jk-1,jn) ) * wmask(ji,jj,jk) 
     140                  zfp_wk = pwn(ji,jj,jk) + ABS( pwn(ji,jj,jk) ) 
     141                  zfm_wk = pwn(ji,jj,jk) - ABS( pwn(ji,jj,jk) ) 
     142                  zwz(ji,jj,jk) = 0.5 * ( zfp_wk * ptb(ji,jj,jk,jn) + zfm_wk * ptb(ji,jj,jk-1,jn) ) * wmask(ji,jj,jk) 
    144143               END DO 
    145144            END DO 
    … …  
    149148               DO jj = 1, jpj 
    150149                  DO ji = 1, jpi 
    151                      zwz(ji,jj, mikt(ji,jj) ) = pw(ji,jj,mikt(ji,jj)) * pt_lev1(ji,jj,mikt(ji,jj),jn)   ! linear free surface  
     150                     zwz(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptb(ji,jj,mikt(ji,jj),jn)   ! linear free surface  
    152151                  END DO 
    153152               END DO    
    154153            ELSE                             ! no cavities: only at the ocean surface 
    155                zwz(:,:,1) = pw(:,:,1) * pt_lev1(:,:,1,jn) 
     154               zwz(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn) 
    156155            ENDIF 
    157156         ENDIF 
    … …  
    165164                     &      + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) ) * r1_e1e2t(ji,jj) 
    166165                  !                             ! update and guess with monotonic sheme 
    167                   pt_rhs(ji,jj,jk,jn) =                     pt_rhs(ji,jj,jk,jn) +        ztra   / e3t(ji,jj,jk,ktlev2) * tmask(ji,jj,jk) 
    168                   zwi(ji,jj,jk)    = ( e3t(ji,jj,jk,ktlev1) * pt_lev1(ji,jj,jk,jn) + p2dt * ztra ) / e3t(ji,jj,jk,ktlev3) * tmask(ji,jj,jk) 
     166                  pta(ji,jj,jk,jn) =                     pta(ji,jj,jk,jn) +        ztra   / e3t_n(ji,jj,jk) * tmask(ji,jj,jk) 
     167                  zwi(ji,jj,jk)    = ( e3t_b(ji,jj,jk) * ptb(ji,jj,jk,jn) + p2dt * ztra ) / e3t_a(ji,jj,jk) * tmask(ji,jj,jk) 
    169168               END DO 
    170169            END DO 
    … …  
    185184               DO jj = 1, jpjm1 
    186185                  DO ji = 1, fs_jpim1   ! vector opt. 
    187                      zwx(ji,jj,jk) = 0.5_wp * pu(ji,jj,jk) * ( pt_lev2(ji,jj,jk,jn) + pt_lev2(ji+1,jj,jk,jn) ) - zwx(ji,jj,jk) 
    188                      zwy(ji,jj,jk) = 0.5_wp * pv(ji,jj,jk) * ( pt_lev2(ji,jj,jk,jn) + pt_lev2(ji,jj+1,jk,jn) ) - zwy(ji,jj,jk) 
     186                     zwx(ji,jj,jk) = 0.5_wp * pun(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj,jk,jn) ) - zwx(ji,jj,jk) 
     187                     zwy(ji,jj,jk) = 0.5_wp * pvn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj+1,jk,jn) ) - zwy(ji,jj,jk) 
    189188                  END DO 
    190189               END DO 
    … …  
    197196               DO jj = 1, jpjm1                    ! 1st derivative (gradient) 
    198197                  DO ji = 1, fs_jpim1   ! vector opt. 
    199                      ztu(ji,jj,jk) = ( pt_lev2(ji+1,jj  ,jk,jn) - pt_lev2(ji,jj,jk,jn) ) * umask(ji,jj,jk) 
    200                      ztv(ji,jj,jk) = ( pt_lev2(ji  ,jj+1,jk,jn) - pt_lev2(ji,jj,jk,jn) ) * vmask(ji,jj,jk) 
     198                     ztu(ji,jj,jk) = ( ptn(ji+1,jj  ,jk,jn) - ptn(ji,jj,jk,jn) ) * umask(ji,jj,jk) 
     199                     ztv(ji,jj,jk) = ( ptn(ji  ,jj+1,jk,jn) - ptn(ji,jj,jk,jn) ) * vmask(ji,jj,jk) 
    201200                  END DO 
    202201               END DO 
    … …  
    213212               DO jj = 1, jpjm1 
    214213                  DO ji = 1, fs_jpim1   ! vector opt. 
    215                      zC2t_u = pt_lev2(ji,jj,jk,jn) + pt_lev2(ji+1,jj  ,jk,jn)   ! 2 x C2 interpolation of T at u- & v-points 
    216                      zC2t_v = pt_lev2(ji,jj,jk,jn) + pt_lev2(ji  ,jj+1,jk,jn) 
     214                     zC2t_u = ptn(ji,jj,jk,jn) + ptn(ji+1,jj  ,jk,jn)   ! 2 x C2 interpolation of T at u- & v-points 
     215                     zC2t_v = ptn(ji,jj,jk,jn) + ptn(ji  ,jj+1,jk,jn) 
    217216                     !                                                  ! C4 minus upstream advective fluxes  
    218                      zwx(ji,jj,jk) =  0.5_wp * pu(ji,jj,jk) * ( zC2t_u + zltu(ji,jj,jk) - zltu(ji+1,jj,jk) ) - zwx(ji,jj,jk) 
    219                      zwy(ji,jj,jk) =  0.5_wp * pv(ji,jj,jk) * ( zC2t_v + zltv(ji,jj,jk) - zltv(ji,jj+1,jk) ) - zwy(ji,jj,jk) 
     217                     zwx(ji,jj,jk) =  0.5_wp * pun(ji,jj,jk) * ( zC2t_u + zltu(ji,jj,jk) - zltu(ji+1,jj,jk) ) - zwx(ji,jj,jk) 
     218                     zwy(ji,jj,jk) =  0.5_wp * pvn(ji,jj,jk) * ( zC2t_v + zltv(ji,jj,jk) - zltv(ji,jj+1,jk) ) - zwy(ji,jj,jk) 
    220219                  END DO 
    221220               END DO 
    … …  
    228227               DO jj = 1, jpjm1 
    229228                  DO ji = 1, fs_jpim1   ! vector opt. 
    230                      ztu(ji,jj,jk) = ( pt_lev2(ji+1,jj  ,jk,jn) - pt_lev2(ji,jj,jk,jn) ) * umask(ji,jj,jk) 
    231                      ztv(ji,jj,jk) = ( pt_lev2(ji  ,jj+1,jk,jn) - pt_lev2(ji,jj,jk,jn) ) * vmask(ji,jj,jk) 
     229                     ztu(ji,jj,jk) = ( ptn(ji+1,jj  ,jk,jn) - ptn(ji,jj,jk,jn) ) * umask(ji,jj,jk) 
     230                     ztv(ji,jj,jk) = ( ptn(ji  ,jj+1,jk,jn) - ptn(ji,jj,jk,jn) ) * vmask(ji,jj,jk) 
    232231                  END DO 
    233232               END DO 
    … …  
    238237               DO jj = 2, jpjm1 
    239238                  DO ji = 2, fs_jpim1   ! vector opt. 
    240                      zC2t_u = pt_lev2(ji,jj,jk,jn) + pt_lev2(ji+1,jj  ,jk,jn)   ! 2 x C2 interpolation of T at u- & v-points (x2) 
    241                      zC2t_v = pt_lev2(ji,jj,jk,jn) + pt_lev2(ji  ,jj+1,jk,jn) 
     239                     zC2t_u = ptn(ji,jj,jk,jn) + ptn(ji+1,jj  ,jk,jn)   ! 2 x C2 interpolation of T at u- & v-points (x2) 
     240                     zC2t_v = ptn(ji,jj,jk,jn) + ptn(ji  ,jj+1,jk,jn) 
    242241                     !                                                  ! C4 interpolation of T at u- & v-points (x2) 
    243242                     zC4t_u =  zC2t_u + r1_6 * ( ztu(ji-1,jj  ,jk) - ztu(ji+1,jj  ,jk) ) 
    244243                     zC4t_v =  zC2t_v + r1_6 * ( ztv(ji  ,jj-1,jk) - ztv(ji  ,jj+1,jk) ) 
    245244                     !                                                  ! C4 minus upstream advective fluxes  
    246                      zwx(ji,jj,jk) =  0.5_wp * pu(ji,jj,jk) * zC4t_u - zwx(ji,jj,jk) 
    247                      zwy(ji,jj,jk) =  0.5_wp * pv(ji,jj,jk) * zC4t_v - zwy(ji,jj,jk) 
     245                     zwx(ji,jj,jk) =  0.5_wp * pun(ji,jj,jk) * zC4t_u - zwx(ji,jj,jk) 
     246                     zwy(ji,jj,jk) =  0.5_wp * pvn(ji,jj,jk) * zC4t_v - zwy(ji,jj,jk) 
    248247                  END DO 
    249248               END DO 
    … …  
    258257               DO jj = 2, jpjm1 
    259258                  DO ji = fs_2, fs_jpim1 
    260                      zwz(ji,jj,jk) =  (  pw(ji,jj,jk) * 0.5_wp * ( pt_lev2(ji,jj,jk,jn) + pt_lev2(ji,jj,jk-1,jn) )   & 
     259                     zwz(ji,jj,jk) =  (  pwn(ji,jj,jk) * 0.5_wp * ( ptn(ji,jj,jk,jn) + ptn(ji,jj,jk-1,jn) )   & 
    261260                        &              - zwz(ji,jj,jk)  ) * wmask(ji,jj,jk) 
    262261                  END DO 
    … …  
    265264            ! 
    266265         CASE(  4  )                   !- 4th order COMPACT 
    267             CALL interp_4th_cpt( pt_lev2(:,:,:,jn) , ztw )   ! zwt = COMPACT interpolation of T at w-point 
     266            CALL interp_4th_cpt( ptn(:,:,:,jn) , ztw )   ! zwt = COMPACT interpolation of T at w-point 
    268267            DO jk = 2, jpkm1 
    269268               DO jj = 2, jpjm1 
    270269                  DO ji = fs_2, fs_jpim1 
    271                      zwz(ji,jj,jk) = ( pw(ji,jj,jk) * ztw(ji,jj,jk) - zwz(ji,jj,jk) ) * wmask(ji,jj,jk) 
     270                     zwz(ji,jj,jk) = ( pwn(ji,jj,jk) * ztw(ji,jj,jk) - zwz(ji,jj,jk) ) * wmask(ji,jj,jk) 
    272271                  END DO 
    273272               END DO 
    … …  
    283282         !        !==  monotonicity algorithm  ==! 
    284283         ! 
    285          CALL nonosc( pt_lev1(:,:,:,jn), zwx, zwy, zwz, zwi, p2dt, e3t(:,:,:,ktlev2) ) 
     284         CALL nonosc( ptb(:,:,:,jn), zwx, zwy, zwz, zwi, p2dt ) 
    286285         ! 
    287286         !        !==  final trend with corrected fluxes  ==! 
    … …  
    290289            DO jj = 2, jpjm1 
    291290               DO ji = fs_2, fs_jpim1   ! vector opt.   
    292                   pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) - (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   & 
     291                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - (  zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )   & 
    293292                     &                                   + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  )   & 
    294293                     &                                   + zwz(ji,jj,jk) - zwz(ji  ,jj  ,jk+1) ) & 
    295                      &                                * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,ktlev2) 
     294                     &                                * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
    296295               END DO 
    297296            END DO 
    … …  
    304303            ! 
    305304            IF( l_trd ) THEN              ! trend diagnostics 
    306                CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pu, pt_lev2(:,:,:,jn) ) 
    307                CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pv, pt_lev2(:,:,:,jn) ) 
    308                CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pw, pt_lev2(:,:,:,jn) ) 
     305               CALL trd_tra( kt, cdtype, jn, jptra_xad, ztrdx, pun, ptn(:,:,:,jn) ) 
     306               CALL trd_tra( kt, cdtype, jn, jptra_yad, ztrdy, pvn, ptn(:,:,:,jn) ) 
     307               CALL trd_tra( kt, cdtype, jn, jptra_zad, ztrdz, pwn, ptn(:,:,:,jn) ) 
    309308            ENDIF 
    310309            !                             ! heat/salt transport 
    … …  
    329328 
    330329 
    331    SUBROUTINE nonosc( pbef, paa, pbb, pcc, paft, p2dt, pe3t ) 
     330   SUBROUTINE nonosc( pbef, paa, pbb, pcc, paft, p2dt ) 
    332331      !!--------------------------------------------------------------------- 
    333332      !!                    ***  ROUTINE nonosc  *** 
    … …  
    342341      !!       in-space based differencing for fluid 
    343342      !!---------------------------------------------------------------------- 
    344       REAL(wp)                         , INTENT(in   ) ::   p2dt             ! tracer time-step 
    345       REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   pbef, paft, pe3t ! before & after field, now e3t field 
    346       REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(inout) ::   paa, pbb, pcc    ! monotonic fluxes in the 3 directions 
     343      REAL(wp)                         , INTENT(in   ) ::   p2dt            ! tracer time-step 
     344      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(in   ) ::   pbef, paft      ! before & after field 
     345      REAL(wp), DIMENSION (jpi,jpj,jpk), INTENT(inout) ::   paa, pbb, pcc   ! monotonic fluxes in the 3 directions 
    347346      ! 
    348347      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    … …  
    393392 
    394393               ! up & down beta terms 
    395                zbt = e1e2t(ji,jj) * pe3t(ji,jj,jk) / p2dt 
     394               zbt = e1e2t(ji,jj) * e3t_n(ji,jj,jk) / p2dt 
    396395               zbetup(ji,jj,jk) = ( zup            - paft(ji,jj,jk) ) / ( zpos + zrtrn ) * zbt 
    397396               zbetdo(ji,jj,jk) = ( paft(ji,jj,jk) - zdo            ) / ( zneg + zrtrn ) * zbt 
    … …  
    635634      !!        The tri-diagonals matrix is given as input 3D arrays:   pD, pU, pL  
    636635      !!        (i.e. the Diagonal, the Upper diagonal, and the Lower diagonal). 
    637       !!        The solution is pt_rhs. 
     636      !!        The solution is pta. 
    638637      !!        The 3d array zwt is used as a work space array. 
    639638      !!---------------------------------------------------------------------- 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/traadv_mus.F90

    r10806 r10874  
    5454CONTAINS 
    5555 
    56    SUBROUTINE tra_adv_mus( kt, kit000, ktlev, kt2lev, cdtype, p2dt, pu, pv, pw,             & 
    57       &                                                             pt, pt_rhs, kjpt, ld_msc_ups ) 
     56   SUBROUTINE tra_adv_mus( kt, kit000, cdtype, p2dt, pun, pvn, pwn,             & 
     57      &                                              ptb, pta, kjpt, ld_msc_ups ) 
    5858      !!---------------------------------------------------------------------- 
    5959      !!                    ***  ROUTINE tra_adv_mus  *** 
    … …  
    6666      !!              ld_msc_ups=T :  
    6767      !! 
    68       !! ** Action : - update pt_rhs  with the now advective tracer trends 
     68      !! ** Action : - update pta  with the now advective tracer trends 
    6969      !!             - send trends to trdtra module for further diagnostcs (l_trdtra=T) 
    7070      !!             - htr_adv, str_adv : poleward advective heat and salt transport (ln_diaptr=T) 
    … …  
    7575      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
    7676      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index 
    77       INTEGER                              , INTENT(in   ) ::   ktlev           ! time level index for 3-time-level source terms 
    78       INTEGER                              , INTENT(in   ) ::   kt2lev          ! time level index for 2-time-level source terms 
    7977      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator) 
    8078      INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers 
    8179      LOGICAL                              , INTENT(in   ) ::   ld_msc_ups      ! use upstream scheme within muscl 
    8280      REAL(wp)                             , INTENT(in   ) ::   p2dt            ! tracer time-step 
    83       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pu, pv, pw   ! 3 ocean velocity components 
    84       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   pt             ! before tracer field 
    85       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pt_rhs             ! tracer trend  
     81      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components 
     82      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb             ! before tracer field 
     83      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend  
    8684      ! 
    8785      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    … …  
    136134            DO jj = 1, jpjm1       
    137135               DO ji = 1, fs_jpim1   ! vector opt. 
    138                   zwx(ji,jj,jk) = umask(ji,jj,jk) * ( pt(ji+1,jj,jk,jn) - pt(ji,jj,jk,jn) ) 
    139                   zwy(ji,jj,jk) = vmask(ji,jj,jk) * ( pt(ji,jj+1,jk,jn) - pt(ji,jj,jk,jn) ) 
     136                  zwx(ji,jj,jk) = umask(ji,jj,jk) * ( ptb(ji+1,jj,jk,jn) - ptb(ji,jj,jk,jn) ) 
     137                  zwy(ji,jj,jk) = vmask(ji,jj,jk) * ( ptb(ji,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) 
    140138               END DO 
    141139           END DO 
    … …  
    174172               DO ji = fs_2, fs_jpim1   ! vector opt. 
    175173                  ! MUSCL fluxes 
    176                   z0u = SIGN( 0.5, pu(ji,jj,jk) ) 
     174                  z0u = SIGN( 0.5, pun(ji,jj,jk) ) 
    177175                  zalpha = 0.5 - z0u 
    178                   zu  = z0u - 0.5 * pu(ji,jj,jk) * p2dt * r1_e1e2u(ji,jj) / e3u(ji,jj,jk,ktlev) 
    179                   zzwx = pt(ji+1,jj,jk,jn) + xind(ji,jj,jk) * zu * zslpx(ji+1,jj,jk) 
    180                   zzwy = pt(ji  ,jj,jk,jn) + xind(ji,jj,jk) * zu * zslpx(ji  ,jj,jk) 
    181                   zwx(ji,jj,jk) = pu(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) 
     176                  zu  = z0u - 0.5 * pun(ji,jj,jk) * p2dt * r1_e1e2u(ji,jj) / e3u_n(ji,jj,jk) 
     177                  zzwx = ptb(ji+1,jj,jk,jn) + xind(ji,jj,jk) * zu * zslpx(ji+1,jj,jk) 
     178                  zzwy = ptb(ji  ,jj,jk,jn) + xind(ji,jj,jk) * zu * zslpx(ji  ,jj,jk) 
     179                  zwx(ji,jj,jk) = pun(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) 
    182180                  ! 
    183                   z0v = SIGN( 0.5, pv(ji,jj,jk) ) 
     181                  z0v = SIGN( 0.5, pvn(ji,jj,jk) ) 
    184182                  zalpha = 0.5 - z0v 
    185                   zv  = z0v - 0.5 * pv(ji,jj,jk) * p2dt * r1_e1e2v(ji,jj) / e3v(ji,jj,jk,ktlev) 
    186                   zzwx = pt(ji,jj+1,jk,jn) + xind(ji,jj,jk) * zv * zslpy(ji,jj+1,jk) 
    187                   zzwy = pt(ji,jj  ,jk,jn) + xind(ji,jj,jk) * zv * zslpy(ji,jj  ,jk) 
    188                   zwy(ji,jj,jk) = pv(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) 
     183                  zv  = z0v - 0.5 * pvn(ji,jj,jk) * p2dt * r1_e1e2v(ji,jj) / e3v_n(ji,jj,jk) 
     184                  zzwx = ptb(ji,jj+1,jk,jn) + xind(ji,jj,jk) * zv * zslpy(ji,jj+1,jk) 
     185                  zzwy = ptb(ji,jj  ,jk,jn) + xind(ji,jj,jk) * zv * zslpy(ji,jj  ,jk) 
     186                  zwy(ji,jj,jk) = pvn(ji,jj,jk) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) 
    189187               END DO 
    190188            END DO 
    … …  
    195193            DO jj = 2, jpjm1       
    196194               DO ji = fs_2, fs_jpim1   ! vector opt. 
    197                   pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) - ( zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )       & 
     195                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - ( zwx(ji,jj,jk) - zwx(ji-1,jj  ,jk  )       & 
    198196                  &                                     + zwy(ji,jj,jk) - zwy(ji  ,jj-1,jk  ) )     & 
    199                   &                                   * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,ktlev) 
     197                  &                                   * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
    200198               END DO 
    201199           END DO 
    … …  
    203201         !                                ! trend diagnostics 
    204202         IF( l_trd )  THEN 
    205             CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pu, pt(:,:,:,jn) ) 
    206             CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pv, pt(:,:,:,jn) ) 
     203            CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pun, ptb(:,:,:,jn) ) 
     204            CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptb(:,:,:,jn) ) 
    207205         END IF 
    208206         !                                 ! "Poleward" heat and salt transports  
    … …  
    217215         zwx(:,:,jpk) = 0._wp 
    218216         DO jk = 2, jpkm1                       ! interior values 
    219             zwx(:,:,jk) = tmask(:,:,jk) * ( pt(:,:,jk-1,jn) - pt(:,:,jk,jn) ) 
     217            zwx(:,:,jk) = tmask(:,:,jk) * ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) ) 
    220218         END DO 
    221219         !                                !-- Slopes of tracer 
    … …  
    241239            DO jj = 2, jpjm1       
    242240               DO ji = fs_2, fs_jpim1   ! vector opt. 
    243                   z0w = SIGN( 0.5, pw(ji,jj,jk+1) ) 
     241                  z0w = SIGN( 0.5, pwn(ji,jj,jk+1) ) 
    244242                  zalpha = 0.5 + z0w 
    245                   zw  = z0w - 0.5 * pw(ji,jj,jk+1) * p2dt * r1_e1e2t(ji,jj) / e3w(ji,jj,jk+1,kt2lev) 
    246                   zzwx = pt(ji,jj,jk+1,jn) + xind(ji,jj,jk) * zw * zslpx(ji,jj,jk+1) 
    247                   zzwy = pt(ji,jj,jk  ,jn) + xind(ji,jj,jk) * zw * zslpx(ji,jj,jk  ) 
    248                   zwx(ji,jj,jk+1) = pw(ji,jj,jk+1) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) * wmask(ji,jj,jk) 
     243                  zw  = z0w - 0.5 * pwn(ji,jj,jk+1) * p2dt * r1_e1e2t(ji,jj) / e3w_n(ji,jj,jk+1) 
     244                  zzwx = ptb(ji,jj,jk+1,jn) + xind(ji,jj,jk) * zw * zslpx(ji,jj,jk+1) 
     245                  zzwy = ptb(ji,jj,jk  ,jn) + xind(ji,jj,jk) * zw * zslpx(ji,jj,jk  ) 
     246                  zwx(ji,jj,jk+1) = pwn(ji,jj,jk+1) * ( zalpha * zzwx + (1.-zalpha) * zzwy ) * wmask(ji,jj,jk) 
    249247               END DO  
    250248            END DO 
    … …  
    254252               DO jj = 1, jpj 
    255253                  DO ji = 1, jpi 
    256                      zwx(ji,jj, mikt(ji,jj) ) = pw(ji,jj,mikt(ji,jj)) * pt(ji,jj,mikt(ji,jj),jn) 
     254                     zwx(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptb(ji,jj,mikt(ji,jj),jn) 
    257255                  END DO 
    258256               END DO    
    259257            ELSE                                      ! no cavities: only at the ocean surface 
    260                zwx(:,:,1) = pw(:,:,1) * pt(:,:,1,jn) 
     258               zwx(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn) 
    261259            ENDIF 
    262260         ENDIF 
    … …  
    265263            DO jj = 2, jpjm1       
    266264               DO ji = fs_2, fs_jpim1   ! vector opt. 
    267                   pt_rhs(ji,jj,jk,jn) =  pt_rhs(ji,jj,jk,jn) - ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,ktlev) 
     265                  pta(ji,jj,jk,jn) =  pta(ji,jj,jk,jn) - ( zwx(ji,jj,jk) - zwx(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
    268266               END DO 
    269267            END DO 
    270268         END DO 
    271269         !                                ! send trends for diagnostic 
    272          IF( l_trd )  CALL trd_tra( kt, cdtype, jn, jptra_zad, zwx, pw, pt(:,:,:,jn) ) 
     270         IF( l_trd )  CALL trd_tra( kt, cdtype, jn, jptra_zad, zwx, pwn, ptb(:,:,:,jn) ) 
    273271         ! 
    274272      END DO                     ! end of tracer loop 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/traadv_qck.F90

    r10806 r10874  
    4747CONTAINS 
    4848 
    49    SUBROUTINE tra_adv_qck ( kt, kit000, ktlev, cdtype, p2dt, pu, pv, pw,      & 
    50       &                                                pt_lev1, pt_lev2, pt_rhs, kjpt ) 
     49   SUBROUTINE tra_adv_qck ( kt, kit000, cdtype, p2dt, pun, pvn, pwn,      & 
     50      &                                       ptb, ptn, pta, kjpt ) 
    5151      !!---------------------------------------------------------------------- 
    5252      !!                  ***  ROUTINE tra_adv_qck  *** 
    … …  
    7272      !!         dt = 2*rdtra and the scalar values are tb and sb 
    7373      !! 
    74       !!       On the vertical, the simple centered scheme used pt_lev2 
     74      !!       On the vertical, the simple centered scheme used ptn 
    7575      !! 
    7676      !!               The fluxes are bounded by the ULTIMATE limiter to 
    … …  
    7878      !!            prevent the appearance of spurious numerical oscillations 
    7979      !! 
    80       !! ** Action : - update pt_rhs  with the now advective tracer trends 
     80      !! ** Action : - update pta  with the now advective tracer trends 
    8181      !!             - send trends to trdtra module for further diagnostcs (l_trdtra=T) 
    8282      !!             - htr_adv, str_adv : poleward advective heat and salt transport (ln_diaptr=T) 
    … …  
    8686      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
    8787      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index 
    88       INTEGER                              , INTENT(in   ) ::   ktlev           ! time level index for source terms 
    8988      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator) 
    9089      INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers 
    9190      REAL(wp)                             , INTENT(in   ) ::   p2dt            ! tracer time-step 
    92       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pu, pv, pw   ! 3 ocean velocity components 
    93       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   pt_lev1, pt_lev2        ! before and now tracer fields 
    94       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pt_rhs             ! tracer trend  
     91      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean velocity components 
     92      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields 
     93      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend  
    9594      !!---------------------------------------------------------------------- 
    9695      ! 
    … …  
    109108      ! 
    110109      !        ! horizontal fluxes are computed with the QUICKEST + ULTIMATE scheme 
    111       CALL tra_adv_qck_i( kt, ktlev, cdtype, p2dt, pu, pt_lev1, pt_lev2, pt_rhs, kjpt )  
    112       CALL tra_adv_qck_j( kt, ktlev, cdtype, p2dt, pv, pt_lev1, pt_lev2, pt_rhs, kjpt )  
     110      CALL tra_adv_qck_i( kt, cdtype, p2dt, pun, ptb, ptn, pta, kjpt )  
     111      CALL tra_adv_qck_j( kt, cdtype, p2dt, pvn, ptb, ptn, pta, kjpt )  
    113112 
    114113      !        ! vertical fluxes are computed with the 2nd order centered scheme 
    115       CALL tra_adv_cen2_k( kt, ktlev, cdtype, pw,         pt_lev2, pt_rhs, kjpt ) 
     114      CALL tra_adv_cen2_k( kt, cdtype, pwn,         ptn, pta, kjpt ) 
    116115      ! 
    117116   END SUBROUTINE tra_adv_qck 
    118117 
    119118 
    120    SUBROUTINE tra_adv_qck_i( kt, ktlev, cdtype, p2dt, pu,                  & 
    121       &                                        pt_lev1, pt_lev2, pt_rhs, kjpt   ) 
     119   SUBROUTINE tra_adv_qck_i( kt, cdtype, p2dt, pun,                  & 
     120      &                                        ptb, ptn, pta, kjpt   ) 
    122121      !!---------------------------------------------------------------------- 
    123122      !! 
    124123      !!---------------------------------------------------------------------- 
    125124      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index 
    126       INTEGER                              , INTENT(in   ) ::   ktlev           ! time level index for source terms 
    127125      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator) 
    128126      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers 
    129127      REAL(wp)                             , INTENT(in   ) ::   p2dt       ! tracer time-step 
    130       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pu        ! i-velocity components 
    131       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   pt_lev1, pt_lev2   ! before and now tracer fields 
    132       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pt_rhs        ! tracer trend  
     128      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun        ! i-velocity components 
     129      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn   ! before and now tracer fields 
     130      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend  
    133131      !! 
    134132      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    … …  
    147145            DO jj = 2, jpjm1 
    148146               DO ji = fs_2, fs_jpim1   ! vector opt. 
    149                   zfc(ji,jj,jk) = pt_lev1(ji-1,jj,jk,jn)        ! Upstream   in the x-direction for the tracer 
    150                   zfd(ji,jj,jk) = pt_lev1(ji+1,jj,jk,jn)        ! Downstream in the x-direction for the tracer 
     147                  zfc(ji,jj,jk) = ptb(ji-1,jj,jk,jn)        ! Upstream   in the x-direction for the tracer 
     148                  zfd(ji,jj,jk) = ptb(ji+1,jj,jk,jn)        ! Downstream in the x-direction for the tracer 
    151149               END DO 
    152150            END DO 
    … …  
    160158            DO jj = 2, jpjm1 
    161159               DO ji = fs_2, fs_jpim1   ! vector opt.          
    162                   zdir = 0.5 + SIGN( 0.5, pu(ji,jj,jk) )   ! if pu > 0 : zdir = 1 otherwise zdir = 0  
     160                  zdir = 0.5 + SIGN( 0.5, pun(ji,jj,jk) )   ! if pun > 0 : zdir = 1 otherwise zdir = 0  
    163161                  zfu(ji,jj,jk) = zdir * zfc(ji,jj,jk ) + ( 1. - zdir ) * zfd(ji+1,jj,jk)  ! FU in the x-direction for T  
    164162               END DO 
    … …  
    169167            DO jj = 2, jpjm1 
    170168               DO ji = fs_2, fs_jpim1   ! vector opt.    
    171                   zdir = 0.5 + SIGN( 0.5, pu(ji,jj,jk) )   ! if pu > 0 : zdir = 1 otherwise zdir = 0  
    172                   zdx = ( zdir * e1t(ji,jj) + ( 1. - zdir ) * e1t(ji+1,jj) ) * e2u(ji,jj) * e3u(ji,jj,jk,ktlev) 
    173                   zwx(ji,jj,jk)  = ABS( pu(ji,jj,jk) ) * p2dt / zdx    ! (0<zc_cfl<1 : Courant number on x-direction) 
    174                   zfc(ji,jj,jk)  = zdir * pt_lev1(ji  ,jj,jk,jn) + ( 1. - zdir ) * pt_lev1(ji+1,jj,jk,jn)  ! FC in the x-direction for T 
    175                   zfd(ji,jj,jk)  = zdir * pt_lev1(ji+1,jj,jk,jn) + ( 1. - zdir ) * pt_lev1(ji  ,jj,jk,jn)  ! FD in the x-direction for T 
     169                  zdir = 0.5 + SIGN( 0.5, pun(ji,jj,jk) )   ! if pun > 0 : zdir = 1 otherwise zdir = 0  
     170                  zdx = ( zdir * e1t(ji,jj) + ( 1. - zdir ) * e1t(ji+1,jj) ) * e2u(ji,jj) * e3u_n(ji,jj,jk) 
     171                  zwx(ji,jj,jk)  = ABS( pun(ji,jj,jk) ) * p2dt / zdx    ! (0<zc_cfl<1 : Courant number on x-direction) 
     172                  zfc(ji,jj,jk)  = zdir * ptb(ji  ,jj,jk,jn) + ( 1. - zdir ) * ptb(ji+1,jj,jk,jn)  ! FC in the x-direction for T 
     173                  zfd(ji,jj,jk)  = zdir * ptb(ji+1,jj,jk,jn) + ( 1. - zdir ) * ptb(ji  ,jj,jk,jn)  ! FD in the x-direction for T 
    176174               END DO 
    177175            END DO 
    … …  
    199197            DO jj = 2, jpjm1 
    200198               DO ji = fs_2, fs_jpim1   ! vector opt.                
    201                   zdir = 0.5 + SIGN( 0.5, pu(ji,jj,jk) )   ! if pu > 0 : zdir = 1 otherwise zdir = 0  
     199                  zdir = 0.5 + SIGN( 0.5, pun(ji,jj,jk) )   ! if pun > 0 : zdir = 1 otherwise zdir = 0  
    202200                  !--- If the second ustream point is a land point 
    203201                  !--- the flux is computed by the 1st order UPWIND scheme 
    204202                  zmsk = zdir * zfu(ji,jj,jk) + ( 1. - zdir ) * zfu(ji+1,jj,jk) 
    205203                  zwx(ji,jj,jk) = zmsk * zwx(ji,jj,jk) + ( 1. - zmsk ) * zfc(ji,jj,jk) 
    206                   zwx(ji,jj,jk) = zwx(ji,jj,jk) * pu(ji,jj,jk) 
     204                  zwx(ji,jj,jk) = zwx(ji,jj,jk) * pun(ji,jj,jk) 
    207205               END DO 
    208206            END DO 
    … …  
    215213            DO jj = 2, jpjm1 
    216214               DO ji = fs_2, fs_jpim1   ! vector opt.   
    217                   zbtr = r1_e1e2t(ji,jj) / e3t(ji,jj,jk,ktlev) 
     215                  zbtr = r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
    218216                  ! horizontal advective trends 
    219217                  ztra = - zbtr * ( zwx(ji,jj,jk) - zwx(ji-1,jj,jk) ) 
    220218                  !--- add it to the general tracer trends 
    221                   pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) + ztra 
     219                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra 
    222220               END DO 
    223221            END DO 
    224222         END DO 
    225223         !                                 ! trend diagnostics 
    226          IF( l_trd )   CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pu, pt_lev2(:,:,:,jn) ) 
     224         IF( l_trd )   CALL trd_tra( kt, cdtype, jn, jptra_xad, zwx, pun, ptn(:,:,:,jn) ) 
    227225         ! 
    228226      END DO 
    … …  
    231229 
    232230 
    233    SUBROUTINE tra_adv_qck_j( kt, ktlev, cdtype, p2dt, pv,                & 
    234       &                                        pt_lev1, pt_lev2, pt_rhs, kjpt ) 
     231   SUBROUTINE tra_adv_qck_j( kt, cdtype, p2dt, pvn,                & 
     232      &                                        ptb, ptn, pta, kjpt ) 
    235233      !!---------------------------------------------------------------------- 
    236234      !! 
    237235      !!---------------------------------------------------------------------- 
    238236      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index 
    239       INTEGER                              , INTENT(in   ) ::   ktlev           ! time level index for source terms 
    240237      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator) 
    241238      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers 
    242239      REAL(wp)                             , INTENT(in   ) ::   p2dt       ! tracer time-step 
    243       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pv        ! j-velocity components 
    244       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   pt_lev1, pt_lev2   ! before and now tracer fields 
    245       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pt_rhs        ! tracer trend  
     240      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pvn        ! j-velocity components 
     241      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn   ! before and now tracer fields 
     242      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend  
    246243      !! 
    247244      INTEGER  :: ji, jj, jk, jn                ! dummy loop indices 
    … …  
    262259               DO ji = fs_2, fs_jpim1   ! vector opt. 
    263260                  ! Upstream in the x-direction for the tracer 
    264                   zfc(ji,jj,jk) = pt_lev1(ji,jj-1,jk,jn) 
     261                  zfc(ji,jj,jk) = ptb(ji,jj-1,jk,jn) 
    265262                  ! Downstream in the x-direction for the tracer 
    266                   zfd(ji,jj,jk) = pt_lev1(ji,jj+1,jk,jn) 
     263                  zfd(ji,jj,jk) = ptb(ji,jj+1,jk,jn) 
    267264               END DO 
    268265            END DO 
    … …  
    278275            DO jj = 2, jpjm1 
    279276               DO ji = fs_2, fs_jpim1   ! vector opt.          
    280                   zdir = 0.5 + SIGN( 0.5, pv(ji,jj,jk) )   ! if pu > 0 : zdir = 1 otherwise zdir = 0  
     277                  zdir = 0.5 + SIGN( 0.5, pvn(ji,jj,jk) )   ! if pun > 0 : zdir = 1 otherwise zdir = 0  
    281278                  zfu(ji,jj,jk) = zdir * zfc(ji,jj,jk ) + ( 1. - zdir ) * zfd(ji,jj+1,jk)  ! FU in the x-direction for T  
    282279               END DO 
    … …  
    287284            DO jj = 2, jpjm1 
    288285               DO ji = fs_2, fs_jpim1   ! vector opt.    
    289                   zdir = 0.5 + SIGN( 0.5, pv(ji,jj,jk) )   ! if pu > 0 : zdir = 1 otherwise zdir = 0  
    290                   zdx = ( zdir * e2t(ji,jj) + ( 1. - zdir ) * e2t(ji,jj+1) ) * e1v(ji,jj) * e3v(ji,jj,jk,ktlev) 
    291                   zwy(ji,jj,jk)  = ABS( pv(ji,jj,jk) ) * p2dt / zdx    ! (0<zc_cfl<1 : Courant number on x-direction) 
    292                   zfc(ji,jj,jk)  = zdir * pt_lev1(ji,jj  ,jk,jn) + ( 1. - zdir ) * pt_lev1(ji,jj+1,jk,jn)  ! FC in the x-direction for T 
    293                   zfd(ji,jj,jk)  = zdir * pt_lev1(ji,jj+1,jk,jn) + ( 1. - zdir ) * pt_lev1(ji,jj  ,jk,jn)  ! FD in the x-direction for T 
     286                  zdir = 0.5 + SIGN( 0.5, pvn(ji,jj,jk) )   ! if pun > 0 : zdir = 1 otherwise zdir = 0  
     287                  zdx = ( zdir * e2t(ji,jj) + ( 1. - zdir ) * e2t(ji,jj+1) ) * e1v(ji,jj) * e3v_n(ji,jj,jk) 
     288                  zwy(ji,jj,jk)  = ABS( pvn(ji,jj,jk) ) * p2dt / zdx    ! (0<zc_cfl<1 : Courant number on x-direction) 
     289                  zfc(ji,jj,jk)  = zdir * ptb(ji,jj  ,jk,jn) + ( 1. - zdir ) * ptb(ji,jj+1,jk,jn)  ! FC in the x-direction for T 
     290                  zfd(ji,jj,jk)  = zdir * ptb(ji,jj+1,jk,jn) + ( 1. - zdir ) * ptb(ji,jj  ,jk,jn)  ! FD in the x-direction for T 
    294291               END DO 
    295292            END DO 
    … …  
    317314            DO jj = 2, jpjm1 
    318315               DO ji = fs_2, fs_jpim1   ! vector opt.                
    319                   zdir = 0.5 + SIGN( 0.5, pv(ji,jj,jk) )   ! if pu > 0 : zdir = 1 otherwise zdir = 0  
     316                  zdir = 0.5 + SIGN( 0.5, pvn(ji,jj,jk) )   ! if pun > 0 : zdir = 1 otherwise zdir = 0  
    320317                  !--- If the second ustream point is a land point 
    321318                  !--- the flux is computed by the 1st order UPWIND scheme 
    322319                  zmsk = zdir * zfu(ji,jj,jk) + ( 1. - zdir ) * zfu(ji,jj+1,jk) 
    323320                  zwy(ji,jj,jk) = zmsk * zwy(ji,jj,jk) + ( 1. - zmsk ) * zfc(ji,jj,jk) 
    324                   zwy(ji,jj,jk) = zwy(ji,jj,jk) * pv(ji,jj,jk) 
     321                  zwy(ji,jj,jk) = zwy(ji,jj,jk) * pvn(ji,jj,jk) 
    325322               END DO 
    326323            END DO 
    … …  
    333330            DO jj = 2, jpjm1 
    334331               DO ji = fs_2, fs_jpim1   ! vector opt.   
    335                   zbtr = r1_e1e2t(ji,jj) / e3t(ji,jj,jk,ktlev) 
     332                  zbtr = r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
    336333                  ! horizontal advective trends 
    337334                  ztra = - zbtr * ( zwy(ji,jj,jk) - zwy(ji,jj-1,jk) ) 
    338335                  !--- add it to the general tracer trends 
    339                   pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) + ztra 
     336                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + ztra 
    340337               END DO 
    341338            END DO 
    342339         END DO 
    343340         !                                 ! trend diagnostics 
    344          IF( l_trd )   CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pv, pt_lev2(:,:,:,jn) ) 
     341         IF( l_trd )   CALL trd_tra( kt, cdtype, jn, jptra_yad, zwy, pvn, ptn(:,:,:,jn) ) 
    345342         !                                 ! "Poleward" heat and salt transports (contribution of upstream fluxes) 
    346343         IF( l_ptr )   CALL dia_ptr_hst( jn, 'adv', zwy(:,:,:) ) 
    … …  
    351348 
    352349 
    353    SUBROUTINE tra_adv_cen2_k( kt, ktlev, cdtype, pw,           & 
    354      &                                    pt_lev2, pt_rhs, kjpt ) 
     350   SUBROUTINE tra_adv_cen2_k( kt, cdtype, pwn,           & 
     351     &                                    ptn, pta, kjpt ) 
    355352      !!---------------------------------------------------------------------- 
    356353      !! 
    357354      !!---------------------------------------------------------------------- 
    358355      INTEGER                              , INTENT(in   ) ::   kt       ! ocean time-step index 
    359       INTEGER                              , INTENT(in   ) ::   ktlev    ! time level index for source terms 
    360356      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator) 
    361357      INTEGER                              , INTENT(in   ) ::   kjpt     ! number of tracers 
    362       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pw      ! vertical velocity  
    363       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   pt_lev2      ! before and now tracer fields 
    364       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pt_rhs      ! tracer trend  
     358      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pwn      ! vertical velocity  
     359      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptn      ! before and now tracer fields 
     360      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta      ! tracer trend  
    365361      ! 
    366362      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    … …  
    378374            DO jj = 2, jpjm1 
    379375               DO ji = fs_2, fs_jpim1   ! vector opt. 
    380                   zwz(ji,jj,jk) = 0.5 * pw(ji,jj,jk) * ( pt_lev2(ji,jj,jk-1,jn) + pt_lev2(ji,jj,jk,jn) ) * wmask(ji,jj,jk) 
     376                  zwz(ji,jj,jk) = 0.5 * pwn(ji,jj,jk) * ( ptn(ji,jj,jk-1,jn) + ptn(ji,jj,jk,jn) ) * wmask(ji,jj,jk) 
    381377               END DO 
    382378            END DO 
    … …  
    386382               DO jj = 1, jpj 
    387383                  DO ji = 1, jpi 
    388                      zwz(ji,jj, mikt(ji,jj) ) = pw(ji,jj,mikt(ji,jj)) * pt_lev2(ji,jj,mikt(ji,jj),jn)   ! linear free surface  
     384                     zwz(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptn(ji,jj,mikt(ji,jj),jn)   ! linear free surface  
    389385                  END DO 
    390386               END DO    
    391387            ELSE                                   ! no ocean cavities (only ocean surface) 
    392                zwz(:,:,1) = pw(:,:,1) * pt_lev2(:,:,1,jn) 
     388               zwz(:,:,1) = pwn(:,:,1) * ptn(:,:,1,jn) 
    393389            ENDIF 
    394390         ENDIF 
    … …  
    397393            DO jj = 2, jpjm1 
    398394               DO ji = fs_2, fs_jpim1   ! vector opt. 
    399                   pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) - ( zwz(ji,jj,jk) - zwz(ji,jj,jk+1) )   & 
    400                      &                                * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,ktlev) 
     395                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - ( zwz(ji,jj,jk) - zwz(ji,jj,jk+1) )   & 
     396                     &                                * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
    401397               END DO 
    402398            END DO 
    403399         END DO 
    404400         !                                 ! Send trends for diagnostic 
    405          IF( l_trd )  CALL trd_tra( kt, cdtype, jn, jptra_zad, zwz, pw, pt_lev2(:,:,:,jn) ) 
     401         IF( l_trd )  CALL trd_tra( kt, cdtype, jn, jptra_zad, zwz, pwn, ptn(:,:,:,jn) ) 
    406402         ! 
    407403      END DO 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/traadv_ubs.F90

    r10806 r10874  
    4646CONTAINS 
    4747 
    48    SUBROUTINE tra_adv_ubs( kt, kit000, ktlev, cdtype, p2dt, pu, pv, pw,          & 
    49       &                                                pt_lev1, pt_lev2, pt_rhs, kjpt, kn_ubs_v ) 
     48   SUBROUTINE tra_adv_ubs( kt, kit000, cdtype, p2dt, pun, pvn, pwn,          & 
     49      &                                                ptb, ptn, pta, kjpt, kn_ubs_v ) 
    5050      !!---------------------------------------------------------------------- 
    5151      !!                  ***  ROUTINE tra_adv_ubs  *** 
    … …  
    5858      !!      It is only used in the horizontal direction. 
    5959      !!      For example the i-component of the advective fluxes are given by : 
    60       !!                !  e2u e3u uu ( mi(Tn) - zltu(i  ) ,ktlev)   if uu(i,ktlev) >= 0 
     60      !!                !  e2u e3u un ( mi(Tn) - zltu(i  ) )   if un(i) >= 0 
    6161      !!          ztu = !  or  
    62       !!                !  e2u e3u uu ( mi(Tn) - zltu(i+1) ,ktlev)   if uu(i,ktlev) < 0 
     62      !!                !  e2u e3u un ( mi(Tn) - zltu(i+1) )   if un(i) < 0 
    6363      !!      where zltu is the second derivative of the before temperature field: 
    6464      !!          zltu = 1/e3t di[ e2u e3u / e1u di[Tb] ] 
    … …  
    7777      !!      scheme (kn_ubs_v=4). 
    7878      !! 
    79       !! ** Action : - update pt_rhs  with the now advective tracer trends 
     79      !! ** Action : - update pta  with the now advective tracer trends 
    8080      !!             - send trends to trdtra module for further diagnostcs (l_trdtra=T) 
    8181      !!             - htr_adv, str_adv : poleward advective heat and salt transport (ln_diaptr=T) 
    … …  
    8686      INTEGER                              , INTENT(in   ) ::   kt              ! ocean time-step index 
    8787      INTEGER                              , INTENT(in   ) ::   kit000          ! first time step index 
    88       INTEGER                              , INTENT(in   ) ::   ktlev           ! time level index for source terms 
    8988      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype          ! =TRA or TRC (tracer indicator) 
    9089      INTEGER                              , INTENT(in   ) ::   kjpt            ! number of tracers 
    9190      INTEGER                              , INTENT(in   ) ::   kn_ubs_v        ! number of tracers 
    9291      REAL(wp)                             , INTENT(in   ) ::   p2dt            ! tracer time-step 
    93       REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pu, pv, pw   ! 3 ocean transport components 
    94       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   pt_lev1, pt_lev2        ! before and now tracer fields 
    95       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pt_rhs             ! tracer trend  
     92      REAL(wp), DIMENSION(jpi,jpj,jpk     ), INTENT(in   ) ::   pun, pvn, pwn   ! 3 ocean transport components 
     93      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb, ptn        ! before and now tracer fields 
     94      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta             ! tracer trend  
    9695      ! 
    9796      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    … …  
    127126            DO jj = 1, jpjm1              ! First derivative (masked gradient) 
    128127               DO ji = 1, fs_jpim1   ! vector opt. 
    129                   zeeu = e2_e1u(ji,jj) * e3u(ji,jj,jk,ktlev) * umask(ji,jj,jk) 
    130                   zeev = e1_e2v(ji,jj) * e3v(ji,jj,jk,ktlev) * vmask(ji,jj,jk) 
    131                   ztu(ji,jj,jk) = zeeu * ( pt_lev1(ji+1,jj  ,jk,jn) - pt_lev1(ji,jj,jk,jn) ) 
    132                   ztv(ji,jj,jk) = zeev * ( pt_lev1(ji  ,jj+1,jk,jn) - pt_lev1(ji,jj,jk,jn) ) 
     128                  zeeu = e2_e1u(ji,jj) * e3u_n(ji,jj,jk) * umask(ji,jj,jk) 
     129                  zeev = e1_e2v(ji,jj) * e3v_n(ji,jj,jk) * vmask(ji,jj,jk) 
     130                  ztu(ji,jj,jk) = zeeu * ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) ) 
     131                  ztv(ji,jj,jk) = zeev * ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) 
    133132               END DO 
    134133            END DO 
    135134            DO jj = 2, jpjm1              ! Second derivative (divergence) 
    136135               DO ji = fs_2, fs_jpim1   ! vector opt. 
    137                   zcoef = 1._wp / ( 6._wp * e3t(ji,jj,jk,ktlev) ) 
     136                  zcoef = 1._wp / ( 6._wp * e3t_n(ji,jj,jk) ) 
    138137                  zltu(ji,jj,jk) = (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)  ) * zcoef 
    139138                  zltv(ji,jj,jk) = (  ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  ) * zcoef 
    … …  
    147146            DO jj = 1, jpjm1 
    148147               DO ji = 1, fs_jpim1   ! vector opt. 
    149                   zfp_ui = pu(ji,jj,jk) + ABS( pu(ji,jj,jk) )      ! upstream transport (x2) 
    150                   zfm_ui = pu(ji,jj,jk) - ABS( pu(ji,jj,jk) ) 
    151                   zfp_vj = pv(ji,jj,jk) + ABS( pv(ji,jj,jk) ) 
    152                   zfm_vj = pv(ji,jj,jk) - ABS( pv(ji,jj,jk) ) 
     148                  zfp_ui = pun(ji,jj,jk) + ABS( pun(ji,jj,jk) )      ! upstream transport (x2) 
     149                  zfm_ui = pun(ji,jj,jk) - ABS( pun(ji,jj,jk) ) 
     150                  zfp_vj = pvn(ji,jj,jk) + ABS( pvn(ji,jj,jk) ) 
     151                  zfm_vj = pvn(ji,jj,jk) - ABS( pvn(ji,jj,jk) ) 
    153152                  !                                                  ! 2nd order centered advective fluxes (x2) 
    154                   zcenut = pu(ji,jj,jk) * ( pt_lev2(ji,jj,jk,jn) + pt_lev2(ji+1,jj  ,jk,jn) ) 
    155                   zcenvt = pv(ji,jj,jk) * ( pt_lev2(ji,jj,jk,jn) + pt_lev2(ji  ,jj+1,jk,jn) ) 
     153                  zcenut = pun(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji+1,jj  ,jk,jn) ) 
     154                  zcenvt = pvn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji  ,jj+1,jk,jn) ) 
    156155                  !                                                  ! UBS advective fluxes 
    157156                  ztu(ji,jj,jk) = 0.5 * ( zcenut - zfp_ui * zltu(ji,jj,jk) - zfm_ui * zltu(ji+1,jj,jk) ) 
    … …  
    161160         END DO          
    162161         ! 
    163          zltu(:,:,:) = pt_rhs(:,:,:,jn)      ! store the initial trends before its update 
     162         zltu(:,:,:) = pta(:,:,:,jn)      ! store the initial trends before its update 
    164163         ! 
    165164         DO jk = 1, jpkm1        !==  add the horizontal advective trend  ==! 
    166165            DO jj = 2, jpjm1 
    167166               DO ji = fs_2, fs_jpim1   ! vector opt. 
    168                   pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn)                        & 
     167                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn)                        & 
    169168                     &             - (  ztu(ji,jj,jk) - ztu(ji-1,jj  ,jk)    & 
    170                      &                + ztv(ji,jj,jk) - ztv(ji  ,jj-1,jk)  ) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,ktlev) 
     169                     &                + ztv(ji,jj,jk) - ztv(ji  ,jj-1,jk)  ) * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
    171170               END DO 
    172171            END DO 
    … …  
    174173         END DO 
    175174         ! 
    176          zltu(:,:,:) = pt_rhs(:,:,:,jn) - zltu(:,:,:)    ! Horizontal advective trend used in vertical 2nd order FCT case 
     175         zltu(:,:,:) = pta(:,:,:,jn) - zltu(:,:,:)    ! Horizontal advective trend used in vertical 2nd order FCT case 
    177176         !                                            ! and/or in trend diagnostic (l_trd=T)  
    178177         !                 
    179178         IF( l_trd ) THEN                  ! trend diagnostics 
    180              CALL trd_tra( kt, cdtype, jn, jptra_xad, ztu, pu, pt_lev2(:,:,:,jn) ) 
    181              CALL trd_tra( kt, cdtype, jn, jptra_yad, ztv, pv, pt_lev2(:,:,:,jn) ) 
     179             CALL trd_tra( kt, cdtype, jn, jptra_xad, ztu, pun, ptn(:,:,:,jn) ) 
     180             CALL trd_tra( kt, cdtype, jn, jptra_yad, ztv, pvn, ptn(:,:,:,jn) ) 
    182181         END IF 
    183182         !      
    … …  
    194193         CASE(  2  )                   ! 2nd order FCT  
    195194            !          
    196             IF( l_trd )   zltv(:,:,:) = pt_rhs(:,:,:,jn)          ! store pt_rhs if trend diag. 
     195            IF( l_trd )   zltv(:,:,:) = pta(:,:,:,jn)          ! store pta if trend diag. 
    197196            ! 
    198197            !                          !*  upstream advection with initial mass fluxes & intermediate update  ==! 
    … …  
    200199               DO jj = 1, jpj 
    201200                  DO ji = 1, jpi 
    202                      zfp_wk = pw(ji,jj,jk) + ABS( pw(ji,jj,jk) ) 
    203                      zfm_wk = pw(ji,jj,jk) - ABS( pw(ji,jj,jk) ) 
    204                      ztw(ji,jj,jk) = 0.5_wp * (  zfp_wk * pt_lev1(ji,jj,jk,jn) + zfm_wk * pt_lev1(ji,jj,jk-1,jn)  ) * wmask(ji,jj,jk) 
     201                     zfp_wk = pwn(ji,jj,jk) + ABS( pwn(ji,jj,jk) ) 
     202                     zfm_wk = pwn(ji,jj,jk) - ABS( pwn(ji,jj,jk) ) 
     203                     ztw(ji,jj,jk) = 0.5_wp * (  zfp_wk * ptb(ji,jj,jk,jn) + zfm_wk * ptb(ji,jj,jk-1,jn)  ) * wmask(ji,jj,jk) 
    205204                  END DO 
    206205               END DO 
    … …  
    210209                  DO jj = 1, jpj 
    211210                     DO ji = 1, jpi 
    212                         ztw(ji,jj, mikt(ji,jj) ) = pw(ji,jj,mikt(ji,jj)) * pt_lev1(ji,jj,mikt(ji,jj),jn)   ! linear free surface  
     211                        ztw(ji,jj, mikt(ji,jj) ) = pwn(ji,jj,mikt(ji,jj)) * ptb(ji,jj,mikt(ji,jj),jn)   ! linear free surface  
    213212                     END DO 
    214213                  END DO    
    215214               ELSE                                ! no cavities: only at the ocean surface 
    216                   ztw(:,:,1) = pw(:,:,1) * pt_lev1(:,:,1,jn) 
     215                  ztw(:,:,1) = pwn(:,:,1) * ptb(:,:,1,jn) 
    217216               ENDIF 
    218217            ENDIF 
    … …  
    221220               DO jj = 2, jpjm1 
    222221                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    223                      ztak = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,ktlev) 
    224                      pt_rhs(ji,jj,jk,jn) =   pt_rhs(ji,jj,jk,jn) +  ztak  
    225                      zti(ji,jj,jk)    = ( pt_lev1(ji,jj,jk,jn) + p2dt * ( ztak + zltu(ji,jj,jk) ) ) * tmask(ji,jj,jk) 
     222                     ztak = - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
     223                     pta(ji,jj,jk,jn) =   pta(ji,jj,jk,jn) +  ztak  
     224                     zti(ji,jj,jk)    = ( ptb(ji,jj,jk,jn) + p2dt * ( ztak + zltu(ji,jj,jk) ) ) * tmask(ji,jj,jk) 
    226225                  END DO 
    227226               END DO 
    … …  
    233232               DO jj = 1, jpj 
    234233                  DO ji = 1, jpi 
    235                      ztw(ji,jj,jk) = (   0.5_wp * pw(ji,jj,jk) * ( pt_lev2(ji,jj,jk,jn) + pt_lev2(ji,jj,jk-1,jn) )   & 
     234                     ztw(ji,jj,jk) = (   0.5_wp * pwn(ji,jj,jk) * ( ptn(ji,jj,jk,jn) + ptn(ji,jj,jk-1,jn) )   & 
    236235                        &              - ztw(ji,jj,jk)   ) * wmask(ji,jj,jk) 
    237236                  END DO 
    … …  
    241240            IF( ln_linssh )   ztw(:,:, 1 ) = 0._wp       ! only ocean surface as interior zwz values have been w-masked 
    242241            ! 
    243             CALL nonosc_z( pt_lev1(:,:,:,jn), ztw, zti, p2dt, e3t(:,:,:,ktlev) )      !  monotonicity algorithm 
     242            CALL nonosc_z( ptb(:,:,:,jn), ztw, zti, p2dt )      !  monotonicity algorithm 
    244243            ! 
    245244         CASE(  4  )                               ! 4th order COMPACT 
    246             CALL interp_4th_cpt( pt_lev2(:,:,:,jn) , ztw )         ! 4th order compact interpolation of T at w-point 
     245            CALL interp_4th_cpt( ptn(:,:,:,jn) , ztw )         ! 4th order compact interpolation of T at w-point 
    247246            DO jk = 2, jpkm1 
    248247               DO jj = 2, jpjm1 
    249248                  DO ji = fs_2, fs_jpim1 
    250                      ztw(ji,jj,jk) = pw(ji,jj,jk) * ztw(ji,jj,jk) * wmask(ji,jj,jk) 
    251                   END DO 
    252                END DO 
    253             END DO 
    254             IF( ln_linssh )   ztw(:,:, 1 ) = pw(:,:,1) * pt_lev2(:,:,1,jn)     !!gm ISF & 4th COMPACT doesn't work 
     249                     ztw(ji,jj,jk) = pwn(ji,jj,jk) * ztw(ji,jj,jk) * wmask(ji,jj,jk) 
     250                  END DO 
     251               END DO 
     252            END DO 
     253            IF( ln_linssh )   ztw(:,:, 1 ) = pwn(:,:,1) * ptn(:,:,1,jn)     !!gm ISF & 4th COMPACT doesn't work 
    255254            ! 
    256255         END SELECT 
    … …  
    259258            DO jj = 2, jpjm1  
    260259               DO ji = fs_2, fs_jpim1   ! vector opt.    
    261                   pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,ktlev) 
     260                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) - ( ztw(ji,jj,jk) - ztw(ji,jj,jk+1) ) * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
    262261               END DO 
    263262            END DO 
    … …  
    265264         ! 
    266265         IF( l_trd )  THEN       ! vertical advective trend diagnostics 
    267             DO jk = 1, jpkm1                       ! (compute -w.dk[ptn]= -dk[w.ptn] + pt_lev2.dk[w]) 
     266            DO jk = 1, jpkm1                       ! (compute -w.dk[ptn]= -dk[w.ptn] + ptn.dk[w]) 
    268267               DO jj = 2, jpjm1 
    269268                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    270                      zltv(ji,jj,jk) = pt_rhs(ji,jj,jk,jn) - zltv(ji,jj,jk)                          & 
    271                         &           + pt_lev2(ji,jj,jk,jn) * (  pw(ji,jj,jk) - pw(ji,jj,jk+1)  )   & 
    272                         &                              * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,ktlev) 
     269                     zltv(ji,jj,jk) = pta(ji,jj,jk,jn) - zltv(ji,jj,jk)                          & 
     270                        &           + ptn(ji,jj,jk,jn) * (  pwn(ji,jj,jk) - pwn(ji,jj,jk+1)  )   & 
     271                        &                              * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
    273272                  END DO 
    274273               END DO 
    … …  
    282281 
    283282 
    284    SUBROUTINE nonosc_z( pbef, pcc, paft, p2dt, pe3t ) 
     283   SUBROUTINE nonosc_z( pbef, pcc, paft, p2dt ) 
    285284      !!--------------------------------------------------------------------- 
    286285      !!                    ***  ROUTINE nonosc_z  *** 
    … …  
    297296      REAL(wp), INTENT(in   )                          ::   p2dt   ! tracer time-step 
    298297      REAL(wp),                DIMENSION (jpi,jpj,jpk) ::   pbef   ! before field 
    299       REAL(wp), INTENT(in   ), DIMENSION (jpi,jpj,jpk) ::   pe3t   ! now cell thickness field 
    300298      REAL(wp), INTENT(inout), DIMENSION (jpi,jpj,jpk) ::   paft   ! after field 
    301299      REAL(wp), INTENT(inout), DIMENSION (jpi,jpj,jpk) ::   pcc    ! monotonic flux in the k direction 
    … …  
    354352               zneg = MAX( 0., pcc(ji  ,jj  ,jk  ) ) - MIN( 0., pcc(ji  ,jj  ,jk+1) ) 
    355353               ! up & down beta terms 
    356                zbt = e1e2t(ji,jj) * pe3t(ji,jj,jk) / p2dt 
     354               zbt = e1e2t(ji,jj) * e3t_n(ji,jj,jk) / p2dt 
    357355               zbetup(ji,jj,jk) = ( zbetup(ji,jj,jk) - paft(ji,jj,jk) ) / (zpos+zrtrn) * zbt 
    358356               zbetdo(ji,jj,jk) = ( paft(ji,jj,jk) - zbetdo(ji,jj,jk) ) / (zneg+zrtrn) * zbt 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/trabbc.F90

    r10806 r10874  
    5151CONTAINS 
    5252 
    53    SUBROUTINE tra_bbc( kt, ktlev, pts_rhs ) 
     53   SUBROUTINE tra_bbc( kt ) 
    5454      !!---------------------------------------------------------------------- 
    5555      !!                  ***  ROUTINE tra_bbc  *** 
    … …  
    7474      !!---------------------------------------------------------------------- 
    7575      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    76       INTEGER, INTENT(in) ::   ktlev  ! time level index for source terms 
    77       REAL(wp), INTENT( inout), DIMENSION(jpi,jpj,jpk,jpts) :: pts_rhs ! temperature and salinity trends 
    7876      ! 
    7977      INTEGER  ::   ji, jj    ! dummy loop indices 
    … …  
    8583      IF( l_trdtra )   THEN         ! Save the input temperature trend 
    8684         ALLOCATE( ztrdt(jpi,jpj,jpk) ) 
    87          ztrdt(:,:,:) = pts_rhs(:,:,:,jp_tem) 
     85         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
    8886      ENDIF 
    8987      !                             !  Add the geothermal trend on temperature 
    9088      DO jj = 2, jpjm1 
    9189         DO ji = 2, jpim1 
    92             pts_rhs(ji,jj,mbkt(ji,jj),jp_tem) = pts_rhs(ji,jj,mbkt(ji,jj),jp_tem) + qgh_trd0(ji,jj) / e3t(ji,jj,mbkt(ji,jj),ktlev) 
     90            tsa(ji,jj,mbkt(ji,jj),jp_tem) = tsa(ji,jj,mbkt(ji,jj),jp_tem) + qgh_trd0(ji,jj) / e3t_n(ji,jj,mbkt(ji,jj)) 
    9391         END DO 
    9492      END DO 
    9593      ! 
    96       CALL lbc_lnk( 'trabbc', pts_rhs(:,:,:,jp_tem) , 'T', 1. ) 
     94      CALL lbc_lnk( 'trabbc', tsa(:,:,:,jp_tem) , 'T', 1. ) 
    9795      ! 
    9896      IF( l_trdtra ) THEN        ! Send the trend for diagnostics 
    99          ztrdt(:,:,:) = pts_rhs(:,:,:,jp_tem) - ztrdt(:,:,:) 
     97         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 
    10098         CALL trd_tra( kt, 'TRA', jp_tem, jptra_bbc, ztrdt ) 
    10199         DEALLOCATE( ztrdt ) 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/trabbl.F90

    r10806 r10874  
    8989 
    9090 
    91    SUBROUTINE tra_bbl( kt, ktlev1, ktlev2, kt2lev, pts_rhs ) 
     91   SUBROUTINE tra_bbl( kt ) 
    9292      !!---------------------------------------------------------------------- 
    9393      !!                  ***  ROUTINE bbl  *** 
    … …  
    101101      !!              is added to the general tracer trend 
    102102      !!---------------------------------------------------------------------- 
    103       INTEGER, INTENT( in ) ::   kt              ! ocean time-step 
    104       INTEGER, INTENT( in ) ::   ktlev1, ktlev2  ! time level indices for 3-time-level source terms 
    105       INTEGER, INTENT( in ) ::   kt2lev          ! time level index for 2-time-level source terms 
    106       REAL(wp), INTENT( inout), DIMENSION(jpi,jpj,jpk,jpts) :: pts_rhs ! temperature and salinity trends 
     103      INTEGER, INTENT( in ) ::   kt   ! ocean time-step 
    107104      ! 
    108105      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdt, ztrds 
    … …  
    113110      IF( l_trdtra )   THEN                         !* Save the T-S input trends 
    114111         ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) ) 
    115          ztrdt(:,:,:) = pts_rhs(:,:,:,jp_tem) 
    116          ztrds(:,:,:) = pts_rhs(:,:,:,jp_sal) 
    117       ENDIF 
    118  
    119       IF( l_bbl )   CALL bbl( kt, nit000, ktlev1, ktlev2, kt2lev, 'TRA' )   !* bbl coef. and transport (only if not already done in trcbbl) 
     112         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) 
     113         ztrds(:,:,:) = tsa(:,:,:,jp_sal) 
     114      ENDIF 
     115 
     116      IF( l_bbl )   CALL bbl( kt, nit000, 'TRA' )   !* bbl coef. and transport (only if not already done in trcbbl) 
    120117 
    121118      IF( nn_bbl_ldf == 1 ) THEN                    !* Diffusive bbl 
    122119         ! 
    123          CALL tra_bbl_dif( ts(:,:,:,:,ktlev1), e3t(:,:,:,ktlev2), pts_rhs, jpts ) 
     120         CALL tra_bbl_dif( tsb, tsa, jpts ) 
    124121         IF( ln_ctl )  & 
    125122         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' bbl_ldf  - Ta: ', mask1=tmask, & 
    … …  
    134131      IF( nn_bbl_adv /= 0 ) THEN                    !* Advective bbl 
    135132         ! 
    136          CALL tra_bbl_adv( ts(:,:,:,:,ktlev1), e3t(:,:,:,ktlev2), pts_rhs, jpts ) 
     133         CALL tra_bbl_adv( tsb, tsa, jpts ) 
    137134         IF(ln_ctl)   & 
    138135         CALL prt_ctl( tab3d_1=tsa(:,:,:,jp_tem), clinfo1=' bbl_adv  - Ta: ', mask1=tmask,   & 
    … …  
    146143 
    147144      IF( l_trdtra )   THEN                      ! send the trends for further diagnostics 
    148          ztrdt(:,:,:) = pts_rhs(:,:,:,jp_tem) - ztrdt(:,:,:) 
    149          ztrds(:,:,:) = pts_rhs(:,:,:,jp_sal) - ztrds(:,:,:) 
     145         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 
     146         ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:) 
    150147         CALL trd_tra( kt, 'TRA', jp_tem, jptra_bbl, ztrdt ) 
    151148         CALL trd_tra( kt, 'TRA', jp_sal, jptra_bbl, ztrds ) 
    … …  
    158155 
    159156 
    160    SUBROUTINE tra_bbl_dif( pt, pe3t, pt_rhs, kjpt ) 
     157   SUBROUTINE tra_bbl_dif( ptb, pta, kjpt ) 
    161158      !!---------------------------------------------------------------------- 
    162159      !!                  ***  ROUTINE tra_bbl_dif  *** 
    … …  
    174171      !!      convection is satified) 
    175172      !! 
    176       !! ** Action  :   pt_rhs   increased by the bbl diffusive trend 
     173      !! ** Action  :   pta   increased by the bbl diffusive trend 
    177174      !! 
    178175      !! References : Beckmann, A., and R. Doscher, 1997, J. Phys.Oceanogr., 581-591. 
    … …  
    180177      !!---------------------------------------------------------------------- 
    181178      INTEGER                              , INTENT(in   ) ::   kjpt   ! number of tracers 
    182       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   pt     ! tracer fields 
    183       REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   pe3t   ! thickness fields 
    184       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pt_rhs ! tracer trend 
     179      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb    ! before and now tracer fields 
     180      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta    ! tracer trend 
    185181      ! 
    186182      INTEGER  ::   ji, jj, jn   ! dummy loop indices 
    … …  
    195191            DO ji = 1, jpi 
    196192               ik = mbkt(ji,jj)                             ! bottom T-level index 
    197                zptb(ji,jj) = pt(ji,jj,ik,jn)               ! bottom before T and S 
     193               zptb(ji,jj) = ptb(ji,jj,ik,jn)               ! bottom before T and S 
    198194            END DO 
    199195         END DO 
    … …  
    202198            DO ji = 2, jpim1 
    203199               ik = mbkt(ji,jj)                            ! bottom T-level index 
    204                pt_rhs(ji,jj,ik,jn) = pt_rhs(ji,jj,ik,jn)                                                  & 
     200               pta(ji,jj,ik,jn) = pta(ji,jj,ik,jn)                                                  & 
    205201                  &             + (  ahu_bbl(ji  ,jj  ) * ( zptb(ji+1,jj  ) - zptb(ji  ,jj  ) )     & 
    206202                  &                - ahu_bbl(ji-1,jj  ) * ( zptb(ji  ,jj  ) - zptb(ji-1,jj  ) )     & 
    207203                  &                + ahv_bbl(ji  ,jj  ) * ( zptb(ji  ,jj+1) - zptb(ji  ,jj  ) )     & 
    208204                  &                - ahv_bbl(ji  ,jj-1) * ( zptb(ji  ,jj  ) - zptb(ji  ,jj-1) )  )  & 
    209                   &             * r1_e1e2t(ji,jj) / pe3t(ji,jj,ik) 
     205                  &             * r1_e1e2t(ji,jj) / e3t_n(ji,jj,ik) 
    210206            END DO 
    211207         END DO 
    … …  
    216212 
    217213 
    218    SUBROUTINE tra_bbl_adv( pt, pe3t, pt_rhs, kjpt ) 
     214   SUBROUTINE tra_bbl_adv( ptb, pta, kjpt ) 
    219215      !!---------------------------------------------------------------------- 
    220216      !!                  ***  ROUTINE trc_bbl  *** 
    … …  
    232228      !!---------------------------------------------------------------------- 
    233229      INTEGER                              , INTENT(in   ) ::   kjpt   ! number of tracers 
    234       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   pt    ! before and now tracer fields 
    235       REAL(wp), DIMENSION(jpi,jpj,jpk)     , INTENT(in   ) ::   pe3t   ! thickness fields 
    236       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pt_rhs    ! tracer trend 
     230      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb    ! before and now tracer fields 
     231      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta    ! tracer trend 
    237232      ! 
    238233      INTEGER  ::   ji, jj, jk, jn           ! dummy loop indices 
    … …  
    255250                  ! 
    256251                  !                                               ! up  -slope T-point (shelf bottom point) 
    257                   zbtr = r1_e1e2t(iis,jj) / pe3t(iis,jj,ikus) 
    258                   ztra = zu_bbl * ( pt(iid,jj,ikus,jn) - pt(iis,jj,ikus,jn) ) * zbtr 
    259                   pt_rhs(iis,jj,ikus,jn) = pt_rhs(iis,jj,ikus,jn) + ztra 
     252                  zbtr = r1_e1e2t(iis,jj) / e3t_n(iis,jj,ikus) 
     253                  ztra = zu_bbl * ( ptb(iid,jj,ikus,jn) - ptb(iis,jj,ikus,jn) ) * zbtr 
     254                  pta(iis,jj,ikus,jn) = pta(iis,jj,ikus,jn) + ztra 
    260255                  ! 
    261256                  DO jk = ikus, ikud-1                            ! down-slope upper to down T-point (deep column) 
    262                      zbtr = r1_e1e2t(iid,jj) / pe3t(iid,jj,jk) 
    263                      ztra = zu_bbl * ( pt(iid,jj,jk+1,jn) - pt(iid,jj,jk,jn) ) * zbtr 
    264                      pt_rhs(iid,jj,jk,jn) = pt_rhs(iid,jj,jk,jn) + ztra 
     257                     zbtr = r1_e1e2t(iid,jj) / e3t_n(iid,jj,jk) 
     258                     ztra = zu_bbl * ( ptb(iid,jj,jk+1,jn) - ptb(iid,jj,jk,jn) ) * zbtr 
     259                     pta(iid,jj,jk,jn) = pta(iid,jj,jk,jn) + ztra 
    265260                  END DO 
    266261                  ! 
    267                   zbtr = r1_e1e2t(iid,jj) / pe3t(iid,jj,ikud) 
    268                   ztra = zu_bbl * ( pt(iis,jj,ikus,jn) - pt(iid,jj,ikud,jn) ) * zbtr 
    269                   pt_rhs(iid,jj,ikud,jn) = pt_rhs(iid,jj,ikud,jn) + ztra 
     262                  zbtr = r1_e1e2t(iid,jj) / e3t_n(iid,jj,ikud) 
     263                  ztra = zu_bbl * ( ptb(iis,jj,ikus,jn) - ptb(iid,jj,ikud,jn) ) * zbtr 
     264                  pta(iid,jj,ikud,jn) = pta(iid,jj,ikud,jn) + ztra 
    270265               ENDIF 
    271266               ! 
    … …  
    277272                  ! 
    278273                  ! up  -slope T-point (shelf bottom point) 
    279                   zbtr = r1_e1e2t(ji,ijs) / pe3t(ji,ijs,ikvs) 
    280                   ztra = zv_bbl * ( pt(ji,ijd,ikvs,jn) - pt(ji,ijs,ikvs,jn) ) * zbtr 
    281                   pt_rhs(ji,ijs,ikvs,jn) = pt_rhs(ji,ijs,ikvs,jn) + ztra 
     274                  zbtr = r1_e1e2t(ji,ijs) / e3t_n(ji,ijs,ikvs) 
     275                  ztra = zv_bbl * ( ptb(ji,ijd,ikvs,jn) - ptb(ji,ijs,ikvs,jn) ) * zbtr 
     276                  pta(ji,ijs,ikvs,jn) = pta(ji,ijs,ikvs,jn) + ztra 
    282277                  ! 
    283278                  DO jk = ikvs, ikvd-1                            ! down-slope upper to down T-point (deep column) 
    284                      zbtr = r1_e1e2t(ji,ijd) / pe3t(ji,ijd,jk) 
    285                      ztra = zv_bbl * ( pt(ji,ijd,jk+1,jn) - pt(ji,ijd,jk,jn) ) * zbtr 
    286                      pt_rhs(ji,ijd,jk,jn) = pt_rhs(ji,ijd,jk,jn)  + ztra 
     279                     zbtr = r1_e1e2t(ji,ijd) / e3t_n(ji,ijd,jk) 
     280                     ztra = zv_bbl * ( ptb(ji,ijd,jk+1,jn) - ptb(ji,ijd,jk,jn) ) * zbtr 
     281                     pta(ji,ijd,jk,jn) = pta(ji,ijd,jk,jn)  + ztra 
    287282                  END DO 
    288283                  !                                               ! down-slope T-point (deep bottom point) 
    289                   zbtr = r1_e1e2t(ji,ijd) / pe3t(ji,ijd,ikvd) 
    290                   ztra = zv_bbl * ( pt(ji,ijs,ikvs,jn) - pt(ji,ijd,ikvd,jn) ) * zbtr 
    291                   pt_rhs(ji,ijd,ikvd,jn) = pt_rhs(ji,ijd,ikvd,jn) + ztra 
     284                  zbtr = r1_e1e2t(ji,ijd) / e3t_n(ji,ijd,ikvd) 
     285                  ztra = zv_bbl * ( ptb(ji,ijs,ikvs,jn) - ptb(ji,ijd,ikvd,jn) ) * zbtr 
     286                  pta(ji,ijd,ikvd,jn) = pta(ji,ijd,ikvd,jn) + ztra 
    292287               ENDIF 
    293288            END DO 
    … …  
    300295 
    301296 
    302    SUBROUTINE bbl( kt, kit000, ktlev1, ktlev2, kt2lev, cdtype ) 
     297   SUBROUTINE bbl( kt, kit000, cdtype ) 
    303298      !!---------------------------------------------------------------------- 
    304299      !!                  ***  ROUTINE bbl  *** 
    … …  
    328323      INTEGER         , INTENT(in   ) ::   kt       ! ocean time-step index 
    329324      INTEGER         , INTENT(in   ) ::   kit000   ! first time step index 
    330       INTEGER         , INTENT(in   ) ::   ktlev1, ktlev2  ! time level indices for 3-time-levelsource terms 
    331       INTEGER         , INTENT(in   ) ::   kt2lev          ! time level index for 2-time-level source terms 
    332325      CHARACTER(len=3), INTENT(in   ) ::   cdtype   ! =TRA or TRC (tracer indicator) 
    333326      ! 
    … …  
    351344         DO ji = 1, jpi 
    352345            ik = mbkt(ji,jj)                             ! bottom T-level index 
    353             zts (ji,jj,jp_tem) = ts(ji,jj,ik,jp_tem,ktlev1)    ! bottom before T and S 
    354             zts (ji,jj,jp_sal) = ts(ji,jj,ik,jp_sal,ktlev1) 
     346            zts (ji,jj,jp_tem) = tsb(ji,jj,ik,jp_tem)    ! bottom before T and S 
     347            zts (ji,jj,jp_sal) = tsb(ji,jj,ik,jp_sal) 
    355348            ! 
    356             zdep(ji,jj) = gdept(ji,jj,ik,kt2lev)              ! bottom T-level reference depth 
    357             zub (ji,jj) = uu(ji,jj,mbku(ji,jj),ktlev2)          ! bottom velocity 
    358             zvb (ji,jj) = vv(ji,jj,mbkv(ji,jj),ktlev2) 
     349            zdep(ji,jj) = gdept_n(ji,jj,ik)              ! bottom T-level reference depth 
     350            zub (ji,jj) = un(ji,jj,mbku(ji,jj))          ! bottom velocity 
     351            zvb (ji,jj) = vn(ji,jj,mbkv(ji,jj)) 
    359352         END DO 
    360353      END DO 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/tradmp.F90

    r10806 r10874  
    7272 
    7373 
    74    SUBROUTINE tra_dmp( kt, ktlev, kt2lev, pts_rhs ) 
     74   SUBROUTINE tra_dmp( kt ) 
    7575      !!---------------------------------------------------------------------- 
    7676      !!                   ***  ROUTINE tra_dmp  *** 
    … …  
    9090      !! ** Action  : - tsa: tracer trends updated with the damping trend 
    9191      !!---------------------------------------------------------------------- 
    92       INTEGER, INTENT(in) ::   kt     ! ocean time-step index 
    93       INTEGER, INTENT(in) ::   ktlev  ! time level index for 3-time-level source terms 
    94       INTEGER, INTENT(in) ::   kt2lev ! time level index for 2-time-level source terms 
    95       REAL(wp), INTENT( inout), DIMENSION(jpi,jpj,jpk,jpts) :: pts_rhs ! temperature and salinity trends 
     92      INTEGER, INTENT(in) ::   kt   ! ocean time-step index 
    9693      ! 
    9794      INTEGER ::   ji, jj, jk, jn   ! dummy loop indices 
    … …  
    104101      IF( l_trdtra )   THEN                    !* Save ta and sa trends 
    105102         ALLOCATE( ztrdts(jpi,jpj,jpk,jpts) )  
    106          ztrdts(:,:,:,:) = pts_rhs(:,:,:,:)  
     103         ztrdts(:,:,:,:) = tsa(:,:,:,:)  
    107104      ENDIF 
    108105      !                           !==  input T-S data at kt  ==! 
    … …  
    116113               DO jj = 2, jpjm1 
    117114                  DO ji = fs_2, fs_jpim1   ! vector opt. 
    118                      pts_rhs(ji,jj,jk,jn) = pts_rhs(ji,jj,jk,jn) + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jn) - ts(ji,jj,jk,jn,ktlev) ) 
     115                     tsa(ji,jj,jk,jn) = tsa(ji,jj,jk,jn) + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jn) - tsb(ji,jj,jk,jn) ) 
    119116                  END DO 
    120117               END DO 
    … …  
    127124               DO ji = fs_2, fs_jpim1   ! vector opt. 
    128125                  IF( avt(ji,jj,jk) <= avt_c ) THEN 
    129                      pts_rhs(ji,jj,jk,jp_tem) = pts_rhs(ji,jj,jk,jp_tem)   & 
    130                         &                 + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - ts(ji,jj,jk,jp_tem,ktlev) ) 
    131                      pts_rhs(ji,jj,jk,jp_sal) = pts_rhs(ji,jj,jk,jp_sal)   & 
    132                         &                 + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - ts(ji,jj,jk,jp_sal,ktlev) ) 
     126                     tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem)   & 
     127                        &                 + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) ) 
     128                     tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal)   & 
     129                        &                 + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) ) 
    133130                  ENDIF 
    134131               END DO 
    … …  
    140137            DO jj = 2, jpjm1 
    141138               DO ji = fs_2, fs_jpim1   ! vector opt. 
    142                   IF( gdept(ji,jj,jk,kt2lev) >= hmlp (ji,jj) ) THEN 
    143                      pts_rhs(ji,jj,jk,jp_tem) = pts_rhs(ji,jj,jk,jp_tem)   & 
    144                         &                 + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - ts(ji,jj,jk,jp_tem,ktlev) ) 
    145                      pts_rhs(ji,jj,jk,jp_sal) = pts_rhs(ji,jj,jk,jp_sal)   & 
    146                         &                 + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - ts(ji,jj,jk,jp_sal,ktlev) ) 
     139                  IF( gdept_n(ji,jj,jk) >= hmlp (ji,jj) ) THEN 
     140                     tsa(ji,jj,jk,jp_tem) = tsa(ji,jj,jk,jp_tem)   & 
     141                        &                 + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_tem) - tsb(ji,jj,jk,jp_tem) ) 
     142                     tsa(ji,jj,jk,jp_sal) = tsa(ji,jj,jk,jp_sal)   & 
     143                        &                 + resto(ji,jj,jk) * ( zts_dta(ji,jj,jk,jp_sal) - tsb(ji,jj,jk,jp_sal) ) 
    147144                  ENDIF 
    148145               END DO 
    … …  
    153150      ! 
    154151      IF( l_trdtra )   THEN       ! trend diagnostic 
    155          ztrdts(:,:,:,:) = pts_rhs(:,:,:,:) - ztrdts(:,:,:,:) 
     152         ztrdts(:,:,:,:) = tsa(:,:,:,:) - ztrdts(:,:,:,:) 
    156153         CALL trd_tra( kt, 'TRA', jp_tem, jptra_dmp, ztrdts(:,:,:,jp_tem) ) 
    157154         CALL trd_tra( kt, 'TRA', jp_sal, jptra_dmp, ztrdts(:,:,:,jp_sal) ) 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/traldf.F90

    r10806 r10874  
    4747CONTAINS 
    4848 
    49    SUBROUTINE tra_ldf( kt, ktlev1, ktlev2, kt2lev, pts_rhs ) 
     49   SUBROUTINE tra_ldf( kt ) 
    5050      !!---------------------------------------------------------------------- 
    5151      !!                  ***  ROUTINE tra_ldf  *** 
    … …  
    5353      !! ** Purpose :   compute the lateral ocean tracer physics. 
    5454      !!---------------------------------------------------------------------- 
    55       INTEGER, INTENT( in ) ::   kt              ! ocean time-step index 
    56       INTEGER, INTENT( in ) ::   ktlev1, ktlev2  ! time level indices for 3-time-level source terms 
    57       INTEGER, INTENT( in ) ::   kt2lev          ! time level index for 2-time-level source terms 
    58       REAL(wp), INTENT( inout), DIMENSION(jpi,jpj,jpk,jpts) :: pts_rhs ! temperature and salinity trends 
     55      INTEGER, INTENT( in ) ::   kt   ! ocean time-step index 
    5956      !! 
    6057      REAL(wp), ALLOCATABLE, DIMENSION(:,:,:) ::   ztrdt, ztrds 
    … …  
    6562      IF( l_trdtra )   THEN                    !* Save ta and sa trends 
    6663         ALLOCATE( ztrdt(jpi,jpj,jpk) , ztrds(jpi,jpj,jpk) )  
    67          ztrdt(:,:,:) = pts_rhs(:,:,:,jp_tem)  
    68          ztrds(:,:,:) = pts_rhs(:,:,:,jp_sal) 
     64         ztrdt(:,:,:) = tsa(:,:,:,jp_tem)  
     65         ztrds(:,:,:) = tsa(:,:,:,jp_sal) 
    6966      ENDIF 
    7067      ! 
    7168      SELECT CASE ( nldf_tra )                 !* compute lateral mixing trend and add it to the general trend 
    7269      CASE ( np_lap   )                                  ! laplacian: iso-level operator 
    73          CALL tra_ldf_lap  ( kt, nit000, ktlev2, kt2lev, 'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, ts(:,:,:,:,ktlev1),      pts_rhs, jpts,  1   ) 
     70         CALL tra_ldf_lap  ( kt, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, tsb,      tsa, jpts,  1   ) 
    7471      CASE ( np_lap_i )                                  ! laplacian: standard iso-neutral operator (Madec) 
    75          CALL tra_ldf_iso  ( kt, nit000, ktlev2, kt2lev, 'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, ts(:,:,:,:,ktlev1), ts(:,:,:,:,ktlev1), pts_rhs, jpts,  1   ) 
     72         CALL tra_ldf_iso  ( kt, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, tsb, tsb, tsa, jpts,  1   ) 
    7673      CASE ( np_lap_it )                                 ! laplacian: triad iso-neutral operator (griffies) 
    77          CALL tra_ldf_triad( kt, nit000, ktlev2, kt2lev, 'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, ts(:,:,:,:,ktlev1), ts(:,:,:,:,ktlev1), pts_rhs, jpts,  1   ) 
     74         CALL tra_ldf_triad( kt, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, tsb, tsb, tsa, jpts,  1   ) 
    7875      CASE ( np_blp , np_blp_i , np_blp_it )             ! bilaplacian: iso-level & iso-neutral operators 
    79          CALL tra_ldf_blp  ( kt, nit000, ktlev2, kt2lev, 'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, ts(:,:,:,:,ktlev1)      , pts_rhs, jpts, nldf_tra ) 
     76         CALL tra_ldf_blp  ( kt, nit000,'TRA', ahtu, ahtv, gtsu, gtsv, gtui, gtvi, tsb      , tsa, jpts, nldf_tra ) 
    8077      END SELECT 
    8178      ! 
    8279      IF( l_trdtra )   THEN                    !* save the horizontal diffusive trends for further diagnostics 
    83          ztrdt(:,:,:) = pts_rhs(:,:,:,jp_tem) - ztrdt(:,:,:) 
    84          ztrds(:,:,:) = pts_rhs(:,:,:,jp_sal) - ztrds(:,:,:) 
     80         ztrdt(:,:,:) = tsa(:,:,:,jp_tem) - ztrdt(:,:,:) 
     81         ztrds(:,:,:) = tsa(:,:,:,jp_sal) - ztrds(:,:,:) 
    8582         CALL trd_tra( kt, 'TRA', jp_tem, jptra_ldf, ztrdt ) 
    8683         CALL trd_tra( kt, 'TRA', jp_sal, jptra_ldf, ztrds ) 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/traldf_iso.F90

    r10806 r10874  
    4848CONTAINS 
    4949 
    50   SUBROUTINE tra_ldf_iso( kt, kit000, ktlev, kt2lev, cdtype, pahu, pahv, pgu , pgv ,   & 
     50  SUBROUTINE tra_ldf_iso( kt, kit000, cdtype, pahu, pahv, pgu , pgv ,   & 
    5151      &                                                   pgui, pgvi,   & 
    52       &                                       pt , pt_lev0, pt_rhs , kjpt, kpass ) 
     52      &                                       ptb , ptbb, pta , kjpt, kpass ) 
    5353      !!---------------------------------------------------------------------- 
    5454      !!                  ***  ROUTINE tra_ldf_iso  *** 
    … …  
    8787      !!         difft = 1/(e1e2t*e3t) dk[ zftw ] 
    8888      !!      Add this trend to the general trend (ta,sa): 
    89       !!         pt_rhs = pt_rhs + difft 
    90       !! 
    91       !! ** Action :   Update pt_rhs arrays with the before rotated diffusion 
     89      !!         pta = pta + difft 
     90      !! 
     91      !! ** Action :   Update pta arrays with the before rotated diffusion 
    9292      !!---------------------------------------------------------------------- 
    9393      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index 
    9494      INTEGER                              , INTENT(in   ) ::   kit000     ! first time step index 
    95       INTEGER                              , INTENT(in   ) ::   ktlev      ! time level index for e3t 
    96       INTEGER                              , INTENT(in   ) ::   kt2lev     ! time level index for 2-time-level thicknesses 
    9795      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator) 
    9896      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers 
    … …  
    10199      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels 
    102100      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(in   ) ::   pgui, pgvi ! tracer gradient at top   levels 
    103       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   pt        ! tracer (kpass=1) or laplacian of tracer (kpass=2) 
    104       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   pt_lev0       ! tracer (only used in kpass=2) 
    105       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pt_rhs        ! tracer trend 
     101      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! tracer (kpass=1) or laplacian of tracer (kpass=2) 
     102      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptbb       ! tracer (only used in kpass=2) 
     103      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend 
    106104      ! 
    107105      INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices 
    … …  
    184182                     DO ji = 1, fs_jpim1 
    185183                        akz(ji,jj,jk) = 16._wp * ah_wslp2(ji,jj,jk)   & 
    186                            &          * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ( e3w(ji,jj,jk,kt2lev) * e3w(ji,jj,jk,kt2lev) )  ) 
     184                           &          * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ( e3w_n(ji,jj,jk) * e3w_n(ji,jj,jk) )  ) 
    187185                     END DO 
    188186                  END DO 
    … …  
    192190                  DO jj = 1, jpjm1 
    193191                     DO ji = 1, fs_jpim1 
    194                         ze3w_2 = e3w(ji,jj,jk,kt2lev) * e3w(ji,jj,jk,kt2lev) 
     192                        ze3w_2 = e3w_n(ji,jj,jk) * e3w_n(ji,jj,jk) 
    195193                        zcoef0 = z2dt * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ze3w_2  ) 
    196194                        akz(ji,jj,jk) = MAX( zcoef0 - 0.5_wp , 0._wp ) * ze3w_2 * z1_2dt 
    … …  
    221219            DO jj = 1, jpjm1 
    222220               DO ji = 1, fs_jpim1   ! vector opt. 
    223                   zdit(ji,jj,jk) = ( pt(ji+1,jj  ,jk,jn) - pt(ji,jj,jk,jn) ) * umask(ji,jj,jk) 
    224                   zdjt(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn) - pt(ji,jj,jk,jn) ) * vmask(ji,jj,jk) 
     221                  zdit(ji,jj,jk) = ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) ) * umask(ji,jj,jk) 
     222                  zdjt(ji,jj,jk) = ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) * vmask(ji,jj,jk) 
    225223               END DO 
    226224            END DO 
    … …  
    250248            ! 
    251249            !                             !== Vertical tracer gradient 
    252             zdk1t(:,:) = ( pt(:,:,jk,jn) - pt(:,:,jk+1,jn) ) * wmask(:,:,jk+1)     ! level jk+1 
     250            zdk1t(:,:) = ( ptb(:,:,jk,jn) - ptb(:,:,jk+1,jn) ) * wmask(:,:,jk+1)     ! level jk+1 
    253251            ! 
    254252            IF( jk == 1 ) THEN   ;   zdkt(:,:) = zdk1t(:,:)                          ! surface: zdkt(jk=1)=zdkt(jk=2) 
    255             ELSE                 ;   zdkt(:,:) = ( pt(:,:,jk-1,jn) - pt(:,:,jk,jn) ) * wmask(:,:,jk) 
     253            ELSE                 ;   zdkt(:,:) = ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) ) * wmask(:,:,jk) 
    256254            ENDIF 
    257255            DO jj = 1 , jpjm1            !==  Horizontal fluxes 
    258256               DO ji = 1, fs_jpim1   ! vector opt. 
    259                   zabe1 = pahu(ji,jj,jk) * e2_e1u(ji,jj) * e3u(ji,jj,jk,ktlev) 
    260                   zabe2 = pahv(ji,jj,jk) * e1_e2v(ji,jj) * e3v(ji,jj,jk,ktlev) 
     257                  zabe1 = pahu(ji,jj,jk) * e2_e1u(ji,jj) * e3u_n(ji,jj,jk) 
     258                  zabe2 = pahv(ji,jj,jk) * e1_e2v(ji,jj) * e3v_n(ji,jj,jk) 
    261259                  ! 
    262260                  zmsku = 1. / MAX(  wmask(ji+1,jj,jk  ) + wmask(ji,jj,jk+1)   & 
    … …  
    278276            END DO 
    279277            ! 
    280             DO jj = 2 , jpjm1          !== horizontal divergence and add to pt_rhs 
     278            DO jj = 2 , jpjm1          !== horizontal divergence and add to pta 
    281279               DO ji = fs_2, fs_jpim1   ! vector opt. 
    282                   pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) + zsign * (  zftu(ji,jj,jk) - zftu(ji-1,jj,jk)      & 
     280                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * (  zftu(ji,jj,jk) - zftu(ji-1,jj,jk)      & 
    283281                     &                                           + zftv(ji,jj,jk) - zftv(ji,jj-1,jk)  )   & 
    284                      &                                        * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,ktlev) 
     282                     &                                        * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
    285283               END DO 
    286284            END DO 
    … …  
    327325               DO jj = 1, jpjm1 
    328326                  DO ji = fs_2, fs_jpim1 
    329                      ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / e3w(ji,jj,jk,kt2lev) * wmask(ji,jj,jk)   & 
     327                     ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / e3w_n(ji,jj,jk) * wmask(ji,jj,jk)   & 
    330328                        &                            * ( ah_wslp2(ji,jj,jk) - akz(ji,jj,jk) )             & 
    331                         &                            * ( pt(ji,jj,jk-1,jn) - pt(ji,jj,jk,jn) ) 
     329                        &                            * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) 
    332330                  END DO 
    333331               END DO 
    … …  
    342340                        ztfw(ji,jj,jk) = ztfw(ji,jj,jk)    & 
    343341                           &           + ah_wslp2(ji,jj,jk) * e1e2t(ji,jj)   & 
    344                            &           * ( pt(ji,jj,jk-1,jn) - pt(ji,jj,jk,jn) ) / e3w(ji,jj,jk,kt2lev) * wmask(ji,jj,jk) 
     342                           &           * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) / e3w_n(ji,jj,jk) * wmask(ji,jj,jk) 
    345343                     END DO 
    346344                  END DO 
    347345               END DO  
    348             CASE(  2  )                         ! 2nd pass : eddy flux = ah_wslp2 and akz applied on pt  and pt_lev0 gradients, resp. 
     346            CASE(  2  )                         ! 2nd pass : eddy flux = ah_wslp2 and akz applied on ptb  and ptbb gradients, resp. 
    349347               DO jk = 2, jpkm1  
    350348                  DO jj = 1, jpjm1 
    351349                     DO ji = fs_2, fs_jpim1 
    352                         ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / e3w(ji,jj,jk,kt2lev) * wmask(ji,jj,jk)                      & 
    353                            &                            * (  ah_wslp2(ji,jj,jk) * ( pt (ji,jj,jk-1,jn) - pt (ji,jj,jk,jn) )   & 
    354                            &                               + akz     (ji,jj,jk) * ( pt_lev0(ji,jj,jk-1,jn) - pt_lev0(ji,jj,jk,jn) )   ) 
     350                        ztfw(ji,jj,jk) = ztfw(ji,jj,jk) + e1e2t(ji,jj) / e3w_n(ji,jj,jk) * wmask(ji,jj,jk)                      & 
     351                           &                            * (  ah_wslp2(ji,jj,jk) * ( ptb (ji,jj,jk-1,jn) - ptb (ji,jj,jk,jn) )   & 
     352                           &                               + akz     (ji,jj,jk) * ( ptbb(ji,jj,jk-1,jn) - ptbb(ji,jj,jk,jn) )   ) 
    355353                     END DO 
    356354                  END DO 
    … …  
    359357         ENDIF 
    360358         !          
    361          DO jk = 1, jpkm1                 !==  Divergence of vertical fluxes added to pt_rhs  ==! 
     359         DO jk = 1, jpkm1                 !==  Divergence of vertical fluxes added to pta  ==! 
    362360            DO jj = 2, jpjm1 
    363361               DO ji = fs_2, fs_jpim1   ! vector opt. 
    364                   pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) + zsign * (  ztfw (ji,jj,jk) - ztfw(ji,jj,jk+1)  )   & 
    365                      &                                        * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,ktlev) 
     362                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * (  ztfw (ji,jj,jk) - ztfw(ji,jj,jk+1)  )   & 
     363                     &                                        * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
    366364               END DO 
    367365            END DO 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/traldf_lap_blp.F90

    r10806 r10874  
    4545CONTAINS 
    4646 
    47    SUBROUTINE tra_ldf_lap( kt, kit000, ktlev, kt2lev, cdtype, pahu, pahv, pgu , pgv ,   & 
     47   SUBROUTINE tra_ldf_lap( kt, kit000, cdtype, pahu, pahv, pgu , pgv ,   & 
    4848      &                                                    pgui, pgvi,   & 
    49       &                                        pt , pt_rhs , kjpt, kpass )  
     49      &                                        ptb , pta , kjpt, kpass )  
    5050      !!---------------------------------------------------------------------- 
    5151      !!                  ***  ROUTINE tra_ldf_lap  *** 
    … …  
    5959      !!          difft = 1/(e1e2t*e3t) {  di-1[ pahu e2u*e3u/e1u di(tb) ] 
    6060      !!                                 + dj-1[ pahv e1v*e3v/e2v dj(tb) ] } 
    61       !!      Add this trend to the general tracer trend pt_rhs : 
    62       !!          pt_rhs = pt_rhs + difft 
    63       !! 
    64       !! ** Action  : - Update pt_rhs arrays with the before iso-level  
     61      !!      Add this trend to the general tracer trend pta : 
     62      !!          pta = pta + difft 
     63      !! 
     64      !! ** Action  : - Update pta arrays with the before iso-level  
    6565      !!                harmonic mixing trend. 
    6666      !!---------------------------------------------------------------------- 
    6767      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index 
    6868      INTEGER                              , INTENT(in   ) ::   kit000     ! first time step index 
    69       INTEGER                              , INTENT(in   ) ::   ktlev      ! time level index for e3t 
    70       INTEGER                              , INTENT(in   ) ::   kt2lev     ! time level index for 2-time-level thicknesses 
    7169      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator) 
    7270      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers 
    … …  
    7573      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels 
    7674      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(in   ) ::   pgui, pgvi ! tracer gradient at top   levels 
    77       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   pt        ! before and now tracer fields 
    78       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pt_rhs        ! tracer trend  
     75      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! before and now tracer fields 
     76      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend  
    7977      ! 
    8078      INTEGER  ::   ji, jj, jk, jn   ! dummy loop indices 
    … …  
    102100         DO jj = 1, jpjm1 
    103101            DO ji = 1, fs_jpim1   ! vector opt. 
    104                zaheeu(ji,jj,jk) = zsign * pahu(ji,jj,jk) * e2_e1u(ji,jj) * e3u(ji,jj,jk,ktlev)   !!gm   * umask(ji,jj,jk) pah masked! 
    105                zaheev(ji,jj,jk) = zsign * pahv(ji,jj,jk) * e1_e2v(ji,jj) * e3v(ji,jj,jk,ktlev)   !!gm   * vmask(ji,jj,jk) 
     102               zaheeu(ji,jj,jk) = zsign * pahu(ji,jj,jk) * e2_e1u(ji,jj) * e3u_n(ji,jj,jk)   !!gm   * umask(ji,jj,jk) pah masked! 
     103               zaheev(ji,jj,jk) = zsign * pahv(ji,jj,jk) * e1_e2v(ji,jj) * e3v_n(ji,jj,jk)   !!gm   * vmask(ji,jj,jk) 
    106104            END DO 
    107105         END DO 
    … …  
    115113            DO jj = 1, jpjm1 
    116114               DO ji = 1, fs_jpim1 
    117                   ztu(ji,jj,jk) = zaheeu(ji,jj,jk) * ( pt(ji+1,jj  ,jk,jn) - pt(ji,jj,jk,jn) ) 
    118                   ztv(ji,jj,jk) = zaheev(ji,jj,jk) * ( pt(ji  ,jj+1,jk,jn) - pt(ji,jj,jk,jn) ) 
     115                  ztu(ji,jj,jk) = zaheeu(ji,jj,jk) * ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) ) 
     116                  ztv(ji,jj,jk) = zaheev(ji,jj,jk) * ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) 
    119117               END DO 
    120118            END DO 
    … …  
    140138            DO jj = 2, jpjm1 
    141139               DO ji = fs_2, fs_jpim1 
    142                   pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) + (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)     & 
     140                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk)     & 
    143141                     &                                   + ztv(ji,jj,jk) - ztv(ji,jj-1,jk) )   & 
    144                      &                                / ( e1e2t(ji,jj) * e3t(ji,jj,jk,ktlev) ) 
     142                     &                                / ( e1e2t(ji,jj) * e3t_n(ji,jj,jk) ) 
    145143               END DO 
    146144            END DO 
    … …  
    161159    
    162160 
    163    SUBROUTINE tra_ldf_blp( kt, kit000, ktlev, kt2lev, cdtype, pahu, pahv, pgu , pgv ,   & 
     161   SUBROUTINE tra_ldf_blp( kt, kit000, cdtype, pahu, pahv, pgu , pgv ,   & 
    164162      &                                                    pgui, pgvi,   & 
    165       &                                                    pt , pt_rhs , kjpt, kldf ) 
     163      &                                                    ptb , pta , kjpt, kldf ) 
    166164      !!---------------------------------------------------------------------- 
    167165      !!                 ***  ROUTINE tra_ldf_blp  *** 
    … …  
    174172      !!      It is computed by two successive calls to laplacian routine 
    175173      !! 
    176       !! ** Action :   pt_rhs   updated with the before rotated bilaplacian diffusion 
     174      !! ** Action :   pta   updated with the before rotated bilaplacian diffusion 
    177175      !!---------------------------------------------------------------------- 
    178176      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index 
    179177      INTEGER                              , INTENT(in   ) ::   kit000     ! first time step index 
    180       INTEGER                              , INTENT(in   ) ::   ktlev      ! time level index for e3t 
    181       INTEGER                              , INTENT(in   ) ::   kt2lev     ! time level index for 2-time-level thicknesses 
    182178      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator) 
    183179      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers 
    … …  
    186182      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu, pgv   ! tracer gradient at pstep levels 
    187183      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(in   ) ::   pgui, pgvi ! tracer gradient at top levels 
    188       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   pt        ! before and now tracer fields 
    189       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pt_rhs        ! tracer trend 
     184      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! before and now tracer fields 
     185      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend 
    190186      ! 
    191187      INTEGER ::   ji, jj, jk, jn   ! dummy loop indices 
    … …  
    207203      zlap(:,:,:,:) = 0._wp 
    208204      ! 
    209       SELECT CASE ( kldf )       !==  1st laplacian applied to pt (output in zlap)  ==! 
     205      SELECT CASE ( kldf )       !==  1st laplacian applied to ptb (output in zlap)  ==! 
    210206      ! 
    211207      CASE ( np_blp    )               ! iso-level bilaplacian 
    212          CALL tra_ldf_lap  ( kt, kit000, ktlev, kt2lev, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, pt,      zlap, kjpt, 1 ) 
     208         CALL tra_ldf_lap  ( kt, kit000, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, ptb,      zlap, kjpt, 1 ) 
    213209      CASE ( np_blp_i  )               ! rotated   bilaplacian : standard operator (Madec) 
    214          CALL tra_ldf_iso  ( kt, kit000, ktlev, kt2lev, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, pt, pt, zlap, kjpt, 1 ) 
     210         CALL tra_ldf_iso  ( kt, kit000, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, ptb, ptb, zlap, kjpt, 1 ) 
    215211      CASE ( np_blp_it )               ! rotated  bilaplacian : triad operator (griffies) 
    216          CALL tra_ldf_triad( kt, kit000, ktlev, kt2lev, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, pt, pt, zlap, kjpt, 1 ) 
     212         CALL tra_ldf_triad( kt, kit000, cdtype, pahu, pahv, pgu, pgv, pgui, pgvi, ptb, ptb, zlap, kjpt, 1 ) 
    217213      END SELECT 
    218214      ! 
    … …  
    223219      ENDIF 
    224220      ! 
    225       SELECT CASE ( kldf )       !==  2nd laplacian applied to zlap (output in pt_rhs)  ==! 
     221      SELECT CASE ( kldf )       !==  2nd laplacian applied to zlap (output in pta)  ==! 
    226222      ! 
    227223      CASE ( np_blp    )               ! iso-level bilaplacian 
    228          CALL tra_ldf_lap  ( kt, kit000, ktlev, kt2lev, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, pt_rhs,      kjpt, 2 ) 
     224         CALL tra_ldf_lap  ( kt, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, pta,      kjpt, 2 ) 
    229225      CASE ( np_blp_i  )               ! rotated   bilaplacian : standard operator (Madec) 
    230          CALL tra_ldf_iso  ( kt, kit000, ktlev, kt2lev, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, pt, pt_rhs, kjpt, 2 ) 
     226         CALL tra_ldf_iso  ( kt, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, ptb, pta, kjpt, 2 ) 
    231227      CASE ( np_blp_it )               ! rotated  bilaplacian : triad operator (griffies) 
    232          CALL tra_ldf_triad( kt, kit000, ktlev, kt2lev, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, pt, pt_rhs, kjpt, 2 ) 
     228         CALL tra_ldf_triad( kt, kit000, cdtype, pahu, pahv, zglu, zglv, zgui, zgvi, zlap, ptb, pta, kjpt, 2 ) 
    233229      END SELECT 
    234230      ! 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/TRA/traldf_triad.F90

    r10806 r10874  
    4848CONTAINS 
    4949 
    50   SUBROUTINE tra_ldf_triad( kt, kit000, ktlev, kt2lev, cdtype, pahu, pahv, pgu , pgv ,   & 
     50  SUBROUTINE tra_ldf_triad( kt, kit000, cdtype, pahu, pahv, pgu , pgv ,   & 
    5151      &                                                     pgui, pgvi,   & 
    52       &                                         pt , pt_lev0, pt_rhs , kjpt, kpass ) 
     52      &                                         ptb , ptbb, pta , kjpt, kpass ) 
    5353      !!---------------------------------------------------------------------- 
    5454      !!                  ***  ROUTINE tra_ldf_triad  *** 
    … …  
    6666      !!      see documentation for the desciption 
    6767      !! 
    68       !! ** Action :   pt_rhs   updated with the before rotated diffusion 
     68      !! ** Action :   pta   updated with the before rotated diffusion 
    6969      !!               ah_wslp2 .... 
    7070      !!               akz   stabilizing vertical diffusivity coefficient (used in trazdf_imp) 
    … …  
    7272      INTEGER                              , INTENT(in   ) ::   kt         ! ocean time-step index 
    7373      INTEGER                              , INTENT(in   ) ::   kit000     ! first time step index 
    74       INTEGER                              , INTENT(in   ) ::   ktlev      ! time level index for e3t 
    75       INTEGER                              , INTENT(in   ) ::   kt2lev     ! time level index for 2-time-level thicknesses 
    7674      CHARACTER(len=3)                     , INTENT(in   ) ::   cdtype     ! =TRA or TRC (tracer indicator) 
    7775      INTEGER                              , INTENT(in   ) ::   kjpt       ! number of tracers 
    … …  
    8078      REAL(wp), DIMENSION(jpi,jpj    ,kjpt), INTENT(in   ) ::   pgu , pgv  ! tracer gradient at pstep levels 
    8179      REAL(wp), DIMENSION(jpi,jpj,    kjpt), INTENT(in   ) ::   pgui, pgvi ! tracer gradient at top   levels 
    82       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   pt        ! tracer (kpass=1) or laplacian of tracer (kpass=2) 
    83       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   pt_lev0       ! tracer (only used in kpass=2) 
    84       REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pt_rhs        ! tracer trend 
     80      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptb        ! tracer (kpass=1) or laplacian of tracer (kpass=2) 
     81      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(in   ) ::   ptbb       ! tracer (only used in kpass=2) 
     82      REAL(wp), DIMENSION(jpi,jpj,jpk,kjpt), INTENT(inout) ::   pta        ! tracer trend 
    8583      ! 
    8684      INTEGER  ::  ji, jj, jk, jn   ! dummy loop indices 
    … …  
    144142                  DO jj = 1, jpjm1 
    145143                     DO ji = 1, fs_jpim1 
    146                         ze3wr = 1._wp / e3w(ji+ip,jj,jk+kp,kt2lev) 
    147                         zbu   = e1e2u(ji,jj) * e3u(ji,jj,jk,ktlev) 
     144                        ze3wr = 1._wp / e3w_n(ji+ip,jj,jk+kp) 
     145                        zbu   = e1e2u(ji,jj) * e3u_n(ji,jj,jk) 
    148146                        zah   = 0.25_wp * pahu(ji,jj,jk) 
    149147                        zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp) 
    150148                        ! Subtract s-coordinate slope at t-points to give slope rel to s-surfaces (do this by *adding* gradient of depth) 
    151                         zslope2 = zslope_skew + ( gdept(ji+1,jj,jk,kt2lev) - gdept(ji,jj,jk,kt2lev) ) * r1_e1u(ji,jj) * umask(ji,jj,jk+kp) 
     149                        zslope2 = zslope_skew + ( gdept_n(ji+1,jj,jk) - gdept_n(ji,jj,jk) ) * r1_e1u(ji,jj) * umask(ji,jj,jk+kp) 
    152150                        zslope2 = zslope2 *zslope2 
    153151                        ah_wslp2(ji+ip,jj,jk+kp) = ah_wslp2(ji+ip,jj,jk+kp) + zah * zbu * ze3wr * r1_e1e2t(ji+ip,jj) * zslope2 
    … …  
    168166                  DO jj = 1, jpjm1 
    169167                     DO ji = 1, fs_jpim1 
    170                         ze3wr = 1.0_wp / e3w(ji,jj+jp,jk+kp,kt2lev) 
    171                         zbv   = e1e2v(ji,jj) * e3v(ji,jj,jk,ktlev) 
     168                        ze3wr = 1.0_wp / e3w_n(ji,jj+jp,jk+kp) 
     169                        zbv   = e1e2v(ji,jj) * e3v_n(ji,jj,jk) 
    172170                        zah   = 0.25_wp * pahv(ji,jj,jk) 
    173171                        zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp) 
    174172                        ! Subtract s-coordinate slope at t-points to give slope rel to s surfaces 
    175173                        !    (do this by *adding* gradient of depth) 
    176                         zslope2 = zslope_skew + ( gdept(ji,jj+1,jk,kt2lev) - gdept(ji,jj,jk,kt2lev) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk+kp) 
     174                        zslope2 = zslope_skew + ( gdept_n(ji,jj+1,jk) - gdept_n(ji,jj,jk) ) * r1_e2v(ji,jj) * vmask(ji,jj,jk+kp) 
    177175                        zslope2 = zslope2 * zslope2 
    178176                        ah_wslp2(ji,jj+jp,jk+kp) = ah_wslp2(ji,jj+jp,jk+kp) + zah * zbv * ze3wr * r1_e1e2t(ji,jj+jp) * zslope2 
    … …  
    195193                     DO ji = 1, fs_jpim1 
    196194                        akz(ji,jj,jk) = 16._wp * ah_wslp2(ji,jj,jk)   & 
    197                            &          * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ( e3w(ji,jj,jk,kt2lev) * e3w(ji,jj,jk,kt2lev) )  ) 
     195                           &          * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ( e3w_n(ji,jj,jk) * e3w_n(ji,jj,jk) )  ) 
    198196                     END DO 
    199197                  END DO 
    … …  
    203201                  DO jj = 1, jpjm1 
    204202                     DO ji = 1, fs_jpim1 
    205                         ze3w_2 = e3w(ji,jj,jk,kt2lev) * e3w(ji,jj,jk,kt2lev) 
     203                        ze3w_2 = e3w_n(ji,jj,jk) * e3w_n(ji,jj,jk) 
    206204                        zcoef0 = z2dt * (  akz(ji,jj,jk) + ah_wslp2(ji,jj,jk) / ze3w_2  ) 
    207205                        akz(ji,jj,jk) = MAX( zcoef0 - 0.5_wp , 0._wp ) * ze3w_2 * z1_2dt 
    … …  
    231229            DO jj = 1, jpjm1 
    232230               DO ji = 1, fs_jpim1   ! vector opt. 
    233                   zdit(ji,jj,jk) = ( pt(ji+1,jj  ,jk,jn) - pt(ji,jj,jk,jn) ) * umask(ji,jj,jk) 
    234                   zdjt(ji,jj,jk) = ( pt(ji  ,jj+1,jk,jn) - pt(ji,jj,jk,jn) ) * vmask(ji,jj,jk) 
     231                  zdit(ji,jj,jk) = ( ptb(ji+1,jj  ,jk,jn) - ptb(ji,jj,jk,jn) ) * umask(ji,jj,jk) 
     232                  zdjt(ji,jj,jk) = ( ptb(ji  ,jj+1,jk,jn) - ptb(ji,jj,jk,jn) ) * vmask(ji,jj,jk) 
    235233               END DO 
    236234            END DO 
    … …  
    259257         DO jk = 1, jpkm1 
    260258            !                    !==  Vertical tracer gradient at level jk and jk+1 
    261             zdkt3d(:,:,1) = ( pt(:,:,jk,jn) - pt(:,:,jk+1,jn) ) * tmask(:,:,jk+1) 
     259            zdkt3d(:,:,1) = ( ptb(:,:,jk,jn) - ptb(:,:,jk+1,jn) ) * tmask(:,:,jk+1) 
    262260            ! 
    263261            !                    ! surface boundary condition: zdkt3d(jk=0)=zdkt3d(jk=1) 
    264262            IF( jk == 1 ) THEN   ;   zdkt3d(:,:,0) = zdkt3d(:,:,1) 
    265             ELSE                 ;   zdkt3d(:,:,0) = ( pt(:,:,jk-1,jn) - pt(:,:,jk,jn) ) * tmask(:,:,jk) 
     263            ELSE                 ;   zdkt3d(:,:,0) = ( ptb(:,:,jk-1,jn) - ptb(:,:,jk,jn) ) * tmask(:,:,jk) 
    266264            ENDIF 
    267265            ! 
    … …  
    275273                           ze1ur = r1_e1u(ji,jj) 
    276274                           zdxt  = zdit(ji,jj,jk) * ze1ur 
    277                            ze3wr = 1._wp / e3w(ji+ip,jj,jk+kp,kt2lev) 
     275                           ze3wr = 1._wp / e3w_n(ji+ip,jj,jk+kp) 
    278276                           zdzt  = zdkt3d(ji+ip,jj,kp) * ze3wr 
    279277                           zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp) 
    280278                           zslope_iso  = triadi  (ji+ip,jj,jk,1-ip,kp) 
    281279                           ! 
    282                            zbu = 0.25_wp * e1e2u(ji,jj) * e3u(ji,jj,jk,ktlev) 
     280                           zbu = 0.25_wp * e1e2u(ji,jj) * e3u_n(ji,jj,jk) 
    283281                           ! ln_botmix_triad is .T. don't mask zah for bottom half cells    !!gm ?????   ahu is masked.... 
    284282                           zah = pahu(ji,jj,jk) 
    … …  
    298296                           ze2vr = r1_e2v(ji,jj) 
    299297                           zdyt  = zdjt(ji,jj,jk) * ze2vr 
    300                            ze3wr = 1._wp / e3w(ji,jj+jp,jk+kp,kt2lev) 
     298                           ze3wr = 1._wp / e3w_n(ji,jj+jp,jk+kp) 
    301299                           zdzt  = zdkt3d(ji,jj+jp,kp) * ze3wr 
    302300                           zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp) 
    303301                           zslope_iso  = triadj(ji,jj+jp,jk,1-jp,kp) 
    304                            zbv = 0.25_wp * e1e2v(ji,jj) * e3v(ji,jj,jk,ktlev) 
     302                           zbv = 0.25_wp * e1e2v(ji,jj) * e3v_n(ji,jj,jk) 
    305303                           ! ln_botmix_triad is .T. don't mask zah for bottom half cells    !!gm ?????  ahv is masked... 
    306304                           zah = pahv(ji,jj,jk) 
    … …  
    322320                           ze1ur = r1_e1u(ji,jj) 
    323321                           zdxt  = zdit(ji,jj,jk) * ze1ur 
    324                            ze3wr = 1._wp / e3w(ji+ip,jj,jk+kp,kt2lev) 
     322                           ze3wr = 1._wp / e3w_n(ji+ip,jj,jk+kp) 
    325323                           zdzt  = zdkt3d(ji+ip,jj,kp) * ze3wr 
    326324                           zslope_skew = triadi_g(ji+ip,jj,jk,1-ip,kp) 
    327325                           zslope_iso  = triadi(ji+ip,jj,jk,1-ip,kp) 
    328326                           ! 
    329                            zbu = 0.25_wp * e1e2u(ji,jj) * e3u(ji,jj,jk,ktlev) 
     327                           zbu = 0.25_wp * e1e2u(ji,jj) * e3u_n(ji,jj,jk) 
    330328                           ! ln_botmix_triad is .F. mask zah for bottom half cells 
    331329                           zah = pahu(ji,jj,jk) * umask(ji,jj,jk+kp)         ! pahu(ji+ip,jj,jk)   ===>>  ???? 
    … …  
    345343                           ze2vr = r1_e2v(ji,jj) 
    346344                           zdyt  = zdjt(ji,jj,jk) * ze2vr 
    347                            ze3wr = 1._wp / e3w(ji,jj+jp,jk+kp,kt2lev) 
     345                           ze3wr = 1._wp / e3w_n(ji,jj+jp,jk+kp) 
    348346                           zdzt  = zdkt3d(ji,jj+jp,kp) * ze3wr 
    349347                           zslope_skew = triadj_g(ji,jj+jp,jk,1-jp,kp) 
    350348                           zslope_iso  = triadj(ji,jj+jp,jk,1-jp,kp) 
    351                            zbv = 0.25_wp * e1e2v(ji,jj) * e3v(ji,jj,jk,ktlev) 
     349                           zbv = 0.25_wp * e1e2v(ji,jj) * e3v_n(ji,jj,jk) 
    352350                           ! ln_botmix_triad is .F. mask zah for bottom half cells 
    353351                           zah = pahv(ji,jj,jk) * vmask(ji,jj,jk+kp)         ! pahv(ji,jj+jp,jk)  ???? 
    … …  
    364362            DO jj = 2 , jpjm1 
    365363               DO ji = fs_2, fs_jpim1  ! vector opt. 
    366                   pt_rhs(ji,jj,jk,jn) = pt_rhs(ji,jj,jk,jn) + zsign * (  zftu(ji-1,jj,jk) - zftu(ji,jj,jk)       & 
     364                  pta(ji,jj,jk,jn) = pta(ji,jj,jk,jn) + zsign * (  zftu(ji-1,jj,jk) - zftu(ji,jj,jk)       & 
    367365                     &                                           + zftv(ji,jj-1,jk) - zftv(ji,jj,jk)   )   & 
    368                      &                                        / (  e1e2t(ji,jj) * e3t(ji,jj,jk,ktlev)  ) 
     366                     &                                        / (  e1e2t(ji,jj) * e3t_n(ji,jj,jk)  ) 
    369367               END DO 
    370368            END DO 
    … …  
    377375               DO jj = 1, jpjm1 
    378376                  DO ji = fs_2, fs_jpim1 
    379                      ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w(ji,jj,jk,kt2lev) * tmask(ji,jj,jk)   & 
     377                     ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w_n(ji,jj,jk) * tmask(ji,jj,jk)   & 
    380378                        &                            * ( ah_wslp2(ji,jj,jk) - akz(ji,jj,jk) )             & 
    381                         &                            * ( pt(ji,jj,jk-1,jn) - pt(ji,jj,jk,jn) ) 
     379                        &                            * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) 
    382380                  END DO 
    383381               END DO 
    … …  
    389387                  DO jj = 1, jpjm1 
    390388                     DO ji = fs_2, fs_jpim1 
    391                         ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w(ji,jj,jk,kt2lev) * tmask(ji,jj,jk)             & 
    392                            &                            * ah_wslp2(ji,jj,jk) * ( pt(ji,jj,jk-1,jn) - pt(ji,jj,jk,jn) ) 
     389                        ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w_n(ji,jj,jk) * tmask(ji,jj,jk)             & 
     390                           &                            * ah_wslp2(ji,jj,jk) * ( ptb(ji,jj,jk-1,jn) - ptb(ji,jj,jk,jn) ) 
    393391                     END DO 
    394392                  END DO 
    395393               END DO  
    396             CASE(  2  )                            ! 2nd pass : eddy flux = ah_wslp2 and akz applied on pt  and pt_lev0 gradients, resp. 
     394            CASE(  2  )                            ! 2nd pass : eddy flux = ah_wslp2 and akz applied on ptb  and ptbb gradients, resp. 
    397395               DO jk = 2, jpkm1  
    398396                  DO jj = 1, jpjm1 
    399397                     DO ji = fs_2, fs_jpim1 
    400                         ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w(ji,jj,jk,kt2lev) * tmask(ji,jj,jk)                      & 
    401                            &                            * (  ah_wslp2(ji,jj,jk) * ( pt (ji,jj,jk-1,jn) - pt (ji,jj,jk,jn) )   & 
    402                            &                               + akz     (ji,jj,jk) * ( pt_lev0(ji,jj,jk-1,jn) - pt_lev0(ji,jj,jk,jn) )   ) 
     398                        ztfw(ji,jj,jk) = ztfw(ji,jj,jk) - e1e2t(ji,jj) / e3w_n(ji,jj,jk) * tmask(ji,jj,jk)                      & 
     399                           &                            * (  ah_wslp2(ji,jj,jk) * ( ptb (ji,jj,jk-1,jn) - ptb (ji,jj,jk,jn) )   & 
     <