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

Changeset 11053


Ignore:
Timestamp:
2019-05-24T12:53:06+02:00 (6 years ago)
Author:
davestorkey
Message:

2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap : Merge in latest changes from main branch and finish conversion of "h" variables. NB. This version still doesn't work!

Location:
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src
Files:
49 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/ICE/icedyn.F90

    r10564 r11053  
    6060CONTAINS 
    6161 
    62    SUBROUTINE ice_dyn( kt ) 
     62   SUBROUTINE ice_dyn( kt, Kmm ) 
    6363      !!------------------------------------------------------------------- 
    6464      !!               ***  ROUTINE ice_dyn  *** 
    … …  
    7373      !!-------------------------------------------------------------------- 
    7474      INTEGER, INTENT(in) ::   kt     ! ice time step 
     75      INTEGER, INTENT(in) ::   Kmm    ! ocean time level index 
    7576      !! 
    7677      INTEGER  ::   ji, jj, jl        ! dummy loop indices 
    … …  
    9293         tau_icebfr(:,:) = 0._wp 
    9394         DO jl = 1, jpl 
    94             WHERE( h_i_b(:,:,jl) > ht_n(:,:) * rn_depfra )   tau_icebfr(:,:) = tau_icebfr(:,:) + a_i(:,:,jl) * rn_icebfr 
     95            WHERE( h_i_b(:,:,jl) > ht(:,:) * rn_depfra )   tau_icebfr(:,:) = tau_icebfr(:,:) + a_i(:,:,jl) * rn_icebfr 
    9596         END DO 
    9697      ENDIF 
    … …  
    121122 
    122123      CASE ( np_dynALL )           !==  all dynamical processes  ==! 
    123          CALL ice_dyn_rhg   ( kt )                                                 ! -- rheology   
     124         CALL ice_dyn_rhg   ( kt, Kmm )                                            ! -- rheology   
    124125         CALL ice_dyn_adv   ( kt )   ;   CALL Hbig( zhi_max, zhs_max, zhip_max )   ! -- advection of ice + correction on ice thickness 
    125126         CALL ice_dyn_rdgrft( kt )                                                 ! -- ridging/rafting  
    … …  
    127128 
    128129      CASE ( np_dynRHGADV  )       !==  no ridge/raft & no corrections ==! 
    129          CALL ice_dyn_rhg   ( kt )                                                 ! -- rheology   
     130         CALL ice_dyn_rhg   ( kt, Kmm )                                            ! -- rheology   
    130131         CALL ice_dyn_adv   ( kt )   ;   CALL Hbig( zhi_max, zhs_max, zhip_max )   ! -- advection of ice + correction on ice thickness 
    131132         CALL Hpiling                                                              ! -- simple pile-up (replaces ridging/rafting) 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/ICE/icedyn_rhg.F90

    r10413 r11053  
    4747CONTAINS 
    4848 
    49    SUBROUTINE ice_dyn_rhg( kt ) 
     49   SUBROUTINE ice_dyn_rhg( kt, Kmm ) 
    5050      !!------------------------------------------------------------------- 
    5151      !!               ***  ROUTINE ice_dyn_rhg  *** 
    … …  
    5858      !!-------------------------------------------------------------------- 
    5959      INTEGER, INTENT(in) ::   kt     ! ice time step 
     60      INTEGER, INTENT(in) ::   Kmm    ! ocean time level index 
    6061      !!-------------------------------------------------------------------- 
    6162      ! controls 
    … …  
    7677      CASE( np_rhgEVP )                ! Elasto-Viscous-Plastic ! 
    7778         !                             !------------------------! 
    78          CALL ice_dyn_rhg_evp( kt, stress1_i, stress2_i, stress12_i, shear_i, divu_i, delta_i ) 
     79         CALL ice_dyn_rhg_evp( kt, Kmm, stress1_i, stress2_i, stress12_i, shear_i, divu_i, delta_i ) 
    7980         !          
    8081      END SELECT 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/ICE/icedyn_rhg_evp.F90

    r10555 r11053  
    5656CONTAINS 
    5757 
    58    SUBROUTINE ice_dyn_rhg_evp( kt, pstress1_i, pstress2_i, pstress12_i, pshear_i, pdivu_i, pdelta_i ) 
     58   SUBROUTINE ice_dyn_rhg_evp( kt, Kmm, pstress1_i, pstress2_i, pstress12_i, pshear_i, pdivu_i, pdelta_i ) 
    5959      !!------------------------------------------------------------------- 
    6060      !!                 ***  SUBROUTINE ice_dyn_rhg_evp  *** 
    … …  
    109109      !!------------------------------------------------------------------- 
    110110      INTEGER                 , INTENT(in   ) ::   kt                                    ! time step 
     111      INTEGER                 , INTENT(in   ) ::   Kmm                                   ! ocean time level index 
    111112      REAL(wp), DIMENSION(:,:), INTENT(inout) ::   pstress1_i, pstress2_i, pstress12_i   ! 
    112113      REAL(wp), DIMENSION(:,:), INTENT(  out) ::   pshear_i  , pdivu_i   , pdelta_i      ! 
    … …  
    335336               zvV = 0.5_wp * ( vt_i(ji,jj) * e1e2t(ji,jj) + vt_i(ji,jj+1) * e1e2t(ji,jj+1) ) * r1_e1e2v(ji,jj) * vmask(ji,jj,1) 
    336337               ! ice-bottom stress at U points 
    337                zvCr = zaU(ji,jj) * rn_depfra * hu_n(ji,jj) 
     338               zvCr = zaU(ji,jj) * rn_depfra * hu(ji,jj,Kmm) 
    338339               zTauU_ib(ji,jj)   = rn_icebfr * MAX( 0._wp, zvU - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaU(ji,jj) ) ) 
    339340               ! ice-bottom stress at V points 
    340                zvCr = zaV(ji,jj) * rn_depfra * hv_n(ji,jj) 
     341               zvCr = zaV(ji,jj) * rn_depfra * hv(ji,jj,Kmm) 
    341342               zTauV_ib(ji,jj)   = rn_icebfr * MAX( 0._wp, zvV - zvCr ) * EXP( -rn_crhg * ( 1._wp - zaV(ji,jj) ) ) 
    342343               ! ice_bottom stress at T points 
    343                zvCr = at_i(ji,jj) * rn_depfra * ht_n(ji,jj) 
     344               zvCr = at_i(ji,jj) * rn_depfra * ht(ji,jj) 
    344345               tau_icebfr(ji,jj) = rn_icebfr * MAX( 0._wp, vt_i(ji,jj) - zvCr ) * EXP( -rn_crhg * ( 1._wp - at_i(ji,jj) ) ) 
    345346            END DO 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/ICE/icestp.F90

    r10998 r11053  
    9595CONTAINS 
    9696 
    97    SUBROUTINE ice_stp( kt, Kbb, ksbc ) 
     97   SUBROUTINE ice_stp( kt, Kbb, Kmm, ksbc ) 
    9898      !!--------------------------------------------------------------------- 
    9999      !!                  ***  ROUTINE ice_stp  *** 
    … …  
    115115      !!                utau, vtau, taum, wndm, qns , qsr, emp , sfx 
    116116      !!--------------------------------------------------------------------- 
    117       INTEGER, INTENT(in) ::   kt     ! ocean time step 
    118       INTEGER, INTENT(in) ::   Kbb    ! ocean time level index 
    119       INTEGER, INTENT(in) ::   ksbc   ! flux formulation (user defined, bulk, or Pure Coupled) 
     117      INTEGER, INTENT(in) ::   kt       ! ocean time step 
     118      INTEGER, INTENT(in) ::   Kbb, Kmm ! ocean time level indices 
     119      INTEGER, INTENT(in) ::   ksbc     ! flux formulation (user defined, bulk, or Pure Coupled) 
    120120      ! 
    121121      INTEGER ::   jl   ! dummy loop index 
    … …  
    161161         ! 
    162162         IF( ln_icedyn .AND. .NOT.lk_c1d )   & 
    163             &                           CALL ice_dyn( kt )            ! -- Ice dynamics 
     163            &                           CALL ice_dyn( kt, Kmm )       ! -- Ice dynamics 
    164164         ! 
    165165         !                          !==  lateral boundary conditions  ==! 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/NST/agrif_oce.F90

    r10425 r11053  
    5050   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  ubdy_n, vbdy_n, hbdy_n 
    5151   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::  ubdy_s, vbdy_s, hbdy_s 
     52   INTEGER , PUBLIC,              SAVE                 ::  Kbb_a, Kmm_a, Krhs_a   !: AGRIF module-specific copies of time-level indices 
    5253 
    5354 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/NST/agrif_oce_interp.F90

    r10989 r11053  
    107107         ! 
    108108         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
    109             uu_b(ibdy1:ibdy2,:,Krhs) = 0._wp 
     109            uu_b(ibdy1:ibdy2,:,Krhs_a) = 0._wp 
    110110            DO jk = 1, jpkm1 
    111111               DO jj = 1, jpj 
    112                   uu_b(ibdy1:ibdy2,jj,Krhs) = uu_b(ibdy1:ibdy2,jj,Krhs) &  
    113                       & + e3u(ibdy1:ibdy2,jj,jk,Krhs) * uu(ibdy1:ibdy2,jj,jk,Krhs) * umask(ibdy1:ibdy2,jj,jk) 
     112                  uu_b(ibdy1:ibdy2,jj,Krhs_a) = uu_b(ibdy1:ibdy2,jj,Krhs_a) &  
     113                      & + e3u(ibdy1:ibdy2,jj,jk,Krhs_a) * uu(ibdy1:ibdy2,jj,jk,Krhs_a) * umask(ibdy1:ibdy2,jj,jk) 
    114114               END DO 
    115115            END DO 
    116116            DO jj = 1, jpj 
    117                uu_b(ibdy1:ibdy2,jj,Krhs) = uu_b(ibdy1:ibdy2,jj,Krhs) * r1_hu_a(ibdy1:ibdy2,jj) 
     117               uu_b(ibdy1:ibdy2,jj,Krhs_a) = uu_b(ibdy1:ibdy2,jj,Krhs_a) * r1_hu_a(ibdy1:ibdy2,jj) 
    118118            END DO 
    119119         ENDIF 
    … …  
    122122            DO jk=1,jpkm1              ! Smooth 
    123123               DO jj=j1,j2 
    124                   uu(ibdy2,jj,jk,Krhs) = 0.25_wp*(uu(ibdy2-1,jj,jk,Krhs)+2._wp*uu(ibdy2,jj,jk,Krhs)+uu(ibdy2+1,jj,jk,Krhs)) 
     124                  uu(ibdy2,jj,jk,Krhs_a) = 0.25_wp*(uu(ibdy2-1,jj,jk,Krhs_a)+2._wp*uu(ibdy2,jj,jk,Krhs_a)+uu(ibdy2+1,jj,jk,Krhs_a)) 
    125125               END DO 
    126126            END DO 
    … …  
    131131            DO jj = 1, jpj 
    132132               zub(ibdy1:ibdy2,jj) = zub(ibdy1:ibdy2,jj) &  
    133                   & + e3u(ibdy1:ibdy2,jj,jk,Krhs)  * uu(ibdy1:ibdy2,jj,jk,Krhs)*umask(ibdy1:ibdy2,jj,jk) 
     133                  & + e3u(ibdy1:ibdy2,jj,jk,Krhs_a)  * uu(ibdy1:ibdy2,jj,jk,Krhs_a)*umask(ibdy1:ibdy2,jj,jk) 
    134134            END DO 
    135135         END DO 
    … …  
    140140         DO jk = 1, jpkm1 
    141141            DO jj = 1, jpj 
    142                uu(ibdy1:ibdy2,jj,jk,Krhs) = ( uu(ibdy1:ibdy2,jj,jk,Krhs) & 
    143                  & + uu_b(ibdy1:ibdy2,jj,Krhs)-zub(ibdy1:ibdy2,jj)) * umask(ibdy1:ibdy2,jj,jk) 
     142               uu(ibdy1:ibdy2,jj,jk,Krhs_a) = ( uu(ibdy1:ibdy2,jj,jk,Krhs_a) & 
     143                 & + uu_b(ibdy1:ibdy2,jj,Krhs_a)-zub(ibdy1:ibdy2,jj)) * umask(ibdy1:ibdy2,jj,jk) 
    144144            END DO 
    145145         END DO 
    … …  
    150150               DO jj = 1, jpj 
    151151                  zvb(ibdy1:ibdy2,jj) = zvb(ibdy1:ibdy2,jj) &  
    152                      & + e3v(ibdy1:ibdy2,jj,jk,Krhs) * vv(ibdy1:ibdy2,jj,jk,Krhs) * vmask(ibdy1:ibdy2,jj,jk) 
     152                     & + e3v(ibdy1:ibdy2,jj,jk,Krhs_a) * vv(ibdy1:ibdy2,jj,jk,Krhs_a) * vmask(ibdy1:ibdy2,jj,jk) 
    153153               END DO 
    154154            END DO 
    … …  
    158158            DO jk = 1, jpkm1 
    159159               DO jj = 1, jpj 
    160                   vv(ibdy1:ibdy2,jj,jk,Krhs) = ( vv(ibdy1:ibdy2,jj,jk,Krhs) &  
    161                     & + vv_b(ibdy1:ibdy2,jj,Krhs)-zvb(ibdy1:ibdy2,jj))*vmask(ibdy1:ibdy2,jj,jk) 
     160                  vv(ibdy1:ibdy2,jj,jk,Krhs_a) = ( vv(ibdy1:ibdy2,jj,jk,Krhs_a) &  
     161                    & + vv_b(ibdy1:ibdy2,jj,Krhs_a)-zvb(ibdy1:ibdy2,jj))*vmask(ibdy1:ibdy2,jj,jk) 
    162162               END DO 
    163163            END DO 
    … …  
    166166         DO jk = 1, jpkm1              ! Mask domain edges 
    167167            DO jj = 1, jpj 
    168                uu(1,jj,jk,Krhs) = 0._wp 
    169                vv(1,jj,jk,Krhs) = 0._wp 
     168               uu(1,jj,jk,Krhs_a) = 0._wp 
     169               vv(1,jj,jk,Krhs_a) = 0._wp 
    170170            END DO 
    171171         END DO  
    … …  
    178178         ! 
    179179         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
    180             uu_b(ibdy1:ibdy2,:,Krhs) = 0._wp 
     180            uu_b(ibdy1:ibdy2,:,Krhs_a) = 0._wp 
    181181            DO jk = 1, jpkm1 
    182182               DO jj = 1, jpj 
    183                   uu_b(ibdy1:ibdy2,jj,Krhs) = uu_b(ibdy1:ibdy2,jj,Krhs) &  
    184                       & + e3u(ibdy1:ibdy2,jj,jk,Krhs) * uu(ibdy1:ibdy2,jj,jk,Krhs) * umask(ibdy1:ibdy2,jj,jk) 
     183                  uu_b(ibdy1:ibdy2,jj,Krhs_a) = uu_b(ibdy1:ibdy2,jj,Krhs_a) &  
     184                      & + e3u(ibdy1:ibdy2,jj,jk,Krhs_a) * uu(ibdy1:ibdy2,jj,jk,Krhs_a) * umask(ibdy1:ibdy2,jj,jk) 
    185185               END DO 
    186186            END DO 
    187187            DO jj = 1, jpj 
    188                uu_b(ibdy1:ibdy2,jj,Krhs) = uu_b(ibdy1:ibdy2,jj,Krhs) * r1_hu_a(ibdy1:ibdy2,jj) 
     188               uu_b(ibdy1:ibdy2,jj,Krhs_a) = uu_b(ibdy1:ibdy2,jj,Krhs_a) * r1_hu_a(ibdy1:ibdy2,jj) 
    189189            END DO 
    190190         ENDIF 
    … …  
    193193            DO jk=1,jpkm1              ! Smooth 
    194194               DO jj=j1,j2 
    195                   uu(ibdy1,jj,jk,Krhs) = 0.25_wp*(uu(ibdy1-1,jj,jk,Krhs)+2._wp*uu(ibdy1,jj,jk,Krhs)+uu(ibdy1+1,jj,jk,Krhs)) 
     195                  uu(ibdy1,jj,jk,Krhs_a) = 0.25_wp*(uu(ibdy1-1,jj,jk,Krhs_a)+2._wp*uu(ibdy1,jj,jk,Krhs_a)+uu(ibdy1+1,jj,jk,Krhs_a)) 
    196196               END DO 
    197197            END DO 
    … …  
    202202            DO jj = 1, jpj 
    203203               zub(ibdy1:ibdy2,jj) = zub(ibdy1:ibdy2,jj) &  
    204                   & + e3u(ibdy1:ibdy2,jj,jk,Krhs)  * uu(ibdy1:ibdy2,jj,jk,Krhs) * umask(ibdy1:ibdy2,jj,jk) 
     204                  & + e3u(ibdy1:ibdy2,jj,jk,Krhs_a)  * uu(ibdy1:ibdy2,jj,jk,Krhs_a) * umask(ibdy1:ibdy2,jj,jk) 
    205205            END DO 
    206206         END DO 
    … …  
    211211         DO jk = 1, jpkm1 
    212212            DO jj = 1, jpj 
    213                uu(ibdy1:ibdy2,jj,jk,Krhs) = ( uu(ibdy1:ibdy2,jj,jk,Krhs) &  
    214                  & + uu_b(ibdy1:ibdy2,jj,Krhs)-zub(ibdy1:ibdy2,jj))*umask(ibdy1:ibdy2,jj,jk) 
     213               uu(ibdy1:ibdy2,jj,jk,Krhs_a) = ( uu(ibdy1:ibdy2,jj,jk,Krhs_a) &  
     214                 & + uu_b(ibdy1:ibdy2,jj,Krhs_a)-zub(ibdy1:ibdy2,jj))*umask(ibdy1:ibdy2,jj,jk) 
    215215            END DO 
    216216         END DO 
    … …  
    223223               DO jj = 1, jpj 
    224224                  zvb(ibdy1:ibdy2,jj) = zvb(ibdy1:ibdy2,jj) & 
    225                      & + e3v(ibdy1:ibdy2,jj,jk,Krhs) * vv(ibdy1:ibdy2,jj,jk,Krhs) * vmask(ibdy1:ibdy2,jj,jk) 
     225                     & + e3v(ibdy1:ibdy2,jj,jk,Krhs_a) * vv(ibdy1:ibdy2,jj,jk,Krhs_a) * vmask(ibdy1:ibdy2,jj,jk) 
    226226               END DO 
    227227            END DO 
    … …  
    231231            DO jk = 1, jpkm1 
    232232               DO jj = 1, jpj 
    233                   vv(ibdy1:ibdy2,jj,jk,Krhs) = ( vv(ibdy1:ibdy2,jj,jk,Krhs) &  
    234                       & + vv_b(ibdy1:ibdy2,jj,Krhs)-zvb(ibdy1:ibdy2,jj)) * vmask(ibdy1:ibdy2,jj,jk) 
     233                  vv(ibdy1:ibdy2,jj,jk,Krhs_a) = ( vv(ibdy1:ibdy2,jj,jk,Krhs_a) &  
     234                      & + vv_b(ibdy1:ibdy2,jj,Krhs_a)-zvb(ibdy1:ibdy2,jj)) * vmask(ibdy1:ibdy2,jj,jk) 
    235235               END DO 
    236236            END DO 
    … …  
    239239         DO jk = 1, jpkm1              ! Mask domain edges 
    240240            DO jj = 1, jpj 
    241                uu(nlci-1,jj,jk,Krhs) = 0._wp 
    242                vv(nlci  ,jj,jk,Krhs) = 0._wp 
     241               uu(nlci-1,jj,jk,Krhs_a) = 0._wp 
     242               vv(nlci  ,jj,jk,Krhs_a) = 0._wp 
    243243            END DO 
    244244         END DO  
    … …  
    251251         ! 
    252252         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
    253             vv_b(:,jbdy1:jbdy2,Krhs) = 0._wp 
     253            vv_b(:,jbdy1:jbdy2,Krhs_a) = 0._wp 
    254254            DO jk = 1, jpkm1 
    255255               DO ji = 1, jpi 
    256                   vv_b(ji,jbdy1:jbdy2,Krhs) = vv_b(ji,jbdy1:jbdy2,Krhs) &  
    257                       & + e3v(ji,jbdy1:jbdy2,jk,Krhs) * vv(ji,jbdy1:jbdy2,jk,Krhs) * vmask(ji,jbdy1:jbdy2,jk) 
     256                  vv_b(ji,jbdy1:jbdy2,Krhs_a) = vv_b(ji,jbdy1:jbdy2,Krhs_a) &  
     257                      & + e3v(ji,jbdy1:jbdy2,jk,Krhs_a) * vv(ji,jbdy1:jbdy2,jk,Krhs_a) * vmask(ji,jbdy1:jbdy2,jk) 
    258258               END DO 
    259259            END DO 
    260260            DO ji=1,jpi 
    261                vv_b(ji,jbdy1:jbdy2,Krhs) = vv_b(ji,jbdy1:jbdy2,Krhs) * r1_hv_a(ji,jbdy1:jbdy2) 
     261               vv_b(ji,jbdy1:jbdy2,Krhs_a) = vv_b(ji,jbdy1:jbdy2,Krhs_a) * r1_hv_a(ji,jbdy1:jbdy2) 
    262262            END DO 
    263263         ENDIF 
    … …  
    266266            DO jk = 1, jpkm1           ! Smooth 
    267267               DO ji = i1, i2 
    268                   vv(ji,jbdy2,jk,Krhs) = 0.25_wp*(vv(ji,jbdy2-1,jk,Krhs)+2._wp*vv(ji,jbdy2,jk,Krhs)+vv(ji,jbdy2+1,jk,Krhs)) 
     268                  vv(ji,jbdy2,jk,Krhs_a) = 0.25_wp*(vv(ji,jbdy2-1,jk,Krhs_a)+2._wp*vv(ji,jbdy2,jk,Krhs_a)+vv(ji,jbdy2+1,jk,Krhs_a)) 
    269269               END DO 
    270270            END DO 
    … …  
    275275            DO ji=1,jpi 
    276276               zvb(ji,jbdy1:jbdy2) = zvb(ji,jbdy1:jbdy2) &  
    277                   & + e3v(ji,jbdy1:jbdy2,jk,Krhs) * vv(ji,jbdy1:jbdy2,jk,Krhs) * vmask(ji,jbdy1:jbdy2,jk) 
     277                  & + e3v(ji,jbdy1:jbdy2,jk,Krhs_a) * vv(ji,jbdy1:jbdy2,jk,Krhs_a) * vmask(ji,jbdy1:jbdy2,jk) 
    278278            END DO 
    279279         END DO 
    … …  
    284284         DO jk = 1, jpkm1 
    285285            DO ji = 1, jpi 
    286                vv(ji,jbdy1:jbdy2,jk,Krhs) = ( vv(ji,jbdy1:jbdy2,jk,Krhs) &  
    287                  & + vv_b(ji,jbdy1:jbdy2,Krhs) - zvb(ji,jbdy1:jbdy2) ) * vmask(ji,jbdy1:jbdy2,jk) 
     286               vv(ji,jbdy1:jbdy2,jk,Krhs_a) = ( vv(ji,jbdy1:jbdy2,jk,Krhs_a) &  
     287                 & + vv_b(ji,jbdy1:jbdy2,Krhs_a) - zvb(ji,jbdy1:jbdy2) ) * vmask(ji,jbdy1:jbdy2,jk) 
    288288            END DO 
    289289         END DO 
    … …  
    294294               DO ji = 1, jpi 
    295295                  zub(ji,jbdy1:jbdy2) = zub(ji,jbdy1:jbdy2) &  
    296                      & + e3u(ji,jbdy1:jbdy2,jk,Krhs) * uu(ji,jbdy1:jbdy2,jk,Krhs) * umask(ji,jbdy1:jbdy2,jk) 
     296                     & + e3u(ji,jbdy1:jbdy2,jk,Krhs_a) * uu(ji,jbdy1:jbdy2,jk,Krhs_a) * umask(ji,jbdy1:jbdy2,jk) 
    297297               END DO 
    298298            END DO 
    … …  
    303303            DO jk = 1, jpkm1 
    304304               DO ji = 1, jpi 
    305                   uu(ji,jbdy1:jbdy2,jk,Krhs) = ( uu(ji,jbdy1:jbdy2,jk,Krhs) &  
    306                     & + uu_b(ji,jbdy1:jbdy2,Krhs) - zub(ji,jbdy1:jbdy2) ) * umask(ji,jbdy1:jbdy2,jk) 
     305                  uu(ji,jbdy1:jbdy2,jk,Krhs_a) = ( uu(ji,jbdy1:jbdy2,jk,Krhs_a) &  
     306                    & + uu_b(ji,jbdy1:jbdy2,Krhs_a) - zub(ji,jbdy1:jbdy2) ) * umask(ji,jbdy1:jbdy2,jk) 
    307307               END DO 
    308308            END DO 
    … …  
    311311         DO jk = 1, jpkm1              ! Mask domain edges 
    312312            DO ji = 1, jpi 
    313                uu(ji,1,jk,Krhs) = 0._wp 
    314                vv(ji,1,jk,Krhs) = 0._wp 
     313               uu(ji,1,jk,Krhs_a) = 0._wp 
     314               vv(ji,1,jk,Krhs_a) = 0._wp 
    315315            END DO 
    316316         END DO  
    … …  
    323323         ! 
    324324         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
    325             vv_b(:,jbdy1:jbdy2,Krhs) = 0._wp 
     325            vv_b(:,jbdy1:jbdy2,Krhs_a) = 0._wp 
    326326            DO jk = 1, jpkm1 
    327327               DO ji = 1, jpi 
    328                   vv_b(ji,jbdy1:jbdy2,Krhs) = vv_b(ji,jbdy1:jbdy2,Krhs) &  
    329                       & + e3v(ji,jbdy1:jbdy2,jk,Krhs) * vv(ji,jbdy1:jbdy2,jk,Krhs) * vmask(ji,jbdy1:jbdy2,jk) 
     328                  vv_b(ji,jbdy1:jbdy2,Krhs_a) = vv_b(ji,jbdy1:jbdy2,Krhs_a) &  
     329                      & + e3v(ji,jbdy1:jbdy2,jk,Krhs_a) * vv(ji,jbdy1:jbdy2,jk,Krhs_a) * vmask(ji,jbdy1:jbdy2,jk) 
    330330               END DO 
    331331            END DO 
    332332            DO ji=1,jpi 
    333                vv_b(ji,jbdy1:jbdy2,Krhs) = vv_b(ji,jbdy1:jbdy2,Krhs) * r1_hv_a(ji,jbdy1:jbdy2) 
     333               vv_b(ji,jbdy1:jbdy2,Krhs_a) = vv_b(ji,jbdy1:jbdy2,Krhs_a) * r1_hv_a(ji,jbdy1:jbdy2) 
    334334            END DO 
    335335         ENDIF 
    … …  
    338338            DO jk = 1, jpkm1           ! Smooth 
    339339               DO ji = i1, i2 
    340                   vv(ji,jbdy1,jk,Krhs) = 0.25_wp*(vv(ji,jbdy1-1,jk,Krhs)+2._wp*vv(ji,jbdy1,jk,Krhs)+vv(ji,jbdy1+1,jk,Krhs)) 
     340                  vv(ji,jbdy1,jk,Krhs_a) = 0.25_wp*(vv(ji,jbdy1-1,jk,Krhs_a)+2._wp*vv(ji,jbdy1,jk,Krhs_a)+vv(ji,jbdy1+1,jk,Krhs_a)) 
    341341               END DO 
    342342            END DO 
    … …  
    347347            DO ji=1,jpi 
    348348               zvb(ji,jbdy1:jbdy2) = zvb(ji,jbdy1:jbdy2) &  
    349                   & + e3v(ji,jbdy1:jbdy2,jk,Krhs) * vv(ji,jbdy1:jbdy2,jk,Krhs) * vmask(ji,jbdy1:jbdy2,jk) 
     349                  & + e3v(ji,jbdy1:jbdy2,jk,Krhs_a) * vv(ji,jbdy1:jbdy2,jk,Krhs_a) * vmask(ji,jbdy1:jbdy2,jk) 
    350350            END DO 
    351351         END DO 
    … …  
    356356         DO jk = 1, jpkm1 
    357357            DO ji = 1, jpi 
    358                vv(ji,jbdy1:jbdy2,jk,Krhs) = ( vv(ji,jbdy1:jbdy2,jk,Krhs) &  
    359                  & + vv_b(ji,jbdy1:jbdy2,Krhs) - zvb(ji,jbdy1:jbdy2) ) * vmask(ji,jbdy1:jbdy2,jk) 
     358               vv(ji,jbdy1:jbdy2,jk,Krhs_a) = ( vv(ji,jbdy1:jbdy2,jk,Krhs_a) &  
     359                 & + vv_b(ji,jbdy1:jbdy2,Krhs_a) - zvb(ji,jbdy1:jbdy2) ) * vmask(ji,jbdy1:jbdy2,jk) 
    360360            END DO 
    361361         END DO 
    … …  
    368368               DO ji = 1, jpi 
    369369                  zub(ji,jbdy1:jbdy2) = zub(ji,jbdy1:jbdy2) &  
    370                      & + e3u(ji,jbdy1:jbdy2,jk,Krhs) * uu(ji,jbdy1:jbdy2,jk,Krhs) * umask(ji,jbdy1:jbdy2,jk) 
     370                     & + e3u(ji,jbdy1:jbdy2,jk,Krhs_a) * uu(ji,jbdy1:jbdy2,jk,Krhs_a) * umask(ji,jbdy1:jbdy2,jk) 
    371371               END DO 
    372372            END DO 
    … …  
    377377            DO jk = 1, jpkm1 
    378378               DO ji = 1, jpi 
    379                   uu(ji,jbdy1:jbdy2,jk,Krhs) = ( uu(ji,jbdy1:jbdy2,jk,Krhs) &  
    380                     & + uu_b(ji,jbdy1:jbdy2,Krhs) - zub(ji,jbdy1:jbdy2) ) * umask(ji,jbdy1:jbdy2,jk) 
     379                  uu(ji,jbdy1:jbdy2,jk,Krhs_a) = ( uu(ji,jbdy1:jbdy2,jk,Krhs_a) &  
     380                    & + uu_b(ji,jbdy1:jbdy2,Krhs_a) - zub(ji,jbdy1:jbdy2) ) * umask(ji,jbdy1:jbdy2,jk) 
    381381               END DO 
    382382            END DO 
    … …  
    385385         DO jk = 1, jpkm1              ! Mask domain edges 
    386386            DO ji = 1, jpi 
    387                uu(ji,nlcj  ,jk,Krhs) = 0._wp 
    388                vv(ji,nlcj-1,jk,Krhs) = 0._wp 
     387               uu(ji,nlcj  ,jk,Krhs_a) = 0._wp 
     388               vv(ji,nlcj-1,jk,Krhs_a) = 0._wp 
    389389            END DO 
    390390         END DO  
    … …  
    520520         DO jj = 1, jpj 
    521521            DO ji = 2, indx 
    522                ssh(ji,jj,Krhs) = hbdy_w(ji-1,jj) 
     522               ssh(ji,jj,Krhs_a) = hbdy_w(ji-1,jj) 
    523523            ENDDO 
    524524         ENDDO 
    … …  
    530530         DO jj = 1, jpj 
    531531            DO ji = indx, nlci-1 
    532                ssh(ji,jj,Krhs) = hbdy_e(ji-indx+1,jj) 
     532               ssh(ji,jj,Krhs_a) = hbdy_e(ji-indx+1,jj) 
    533533            ENDDO 
    534534         ENDDO 
    … …  
    540540         DO jj = 2, indy 
    541541            DO ji = 1, jpi 
    542                ssh(ji,jj,Krhs) = hbdy_s(ji,jj-1) 
     542               ssh(ji,jj,Krhs_a) = hbdy_s(ji,jj-1) 
    543543            ENDDO 
    544544         ENDDO 
    … …  
    550550         DO jj = indy, nlcj-1 
    551551            DO ji = 1, jpi 
    552                ssh(ji,jj,Krhs) = hbdy_n(ji,jj-indy+1) 
     552               ssh(ji,jj,Krhs_a) = hbdy_n(ji,jj-indy+1) 
    553553            ENDDO 
    554554         ENDDO 
    … …  
    659659               DO jj=j1,j2 
    660660                 DO ji=i1,i2 
    661                        ptab(ji,jj,jk,jn) = ts(ji,jj,jk,jn,Kmm) 
     661                       ptab(ji,jj,jk,jn) = ts(ji,jj,jk,jn,Kmm_a) 
    662662                 END DO 
    663663              END DO 
    … …  
    669669           DO jj=j1,j2 
    670670              DO ji=i1,i2 
    671                  ptab(ji,jj,jk,jpts+1) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kmm)  
     671                 ptab(ji,jj,jk,jpts+1) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kmm_a)  
    672672              END DO 
    673673           END DO 
    … …  
    699699                  IF (tmask(iref,jref,jk) == 0) EXIT  
    700700                  N_out = N_out + 1 
    701                   h_out(jk) = e3t(iref,jref,jk,Kmm) 
     701                  h_out(jk) = e3t(iref,jref,jk,Kmm_a) 
    702702               ENDDO 
    703703               IF (N_in > 0) THEN 
    … …  
    713713         ! 
    714714         DO jn=1, jpts 
    715             ts(i1:i2,j1:j2,1:jpk,jn,Krhs)=ptab_child(i1:i2,j1:j2,1:jpk,jn)*tmask(i1:i2,j1:j2,1:jpk)  
     715            ts(i1:i2,j1:j2,1:jpk,jn,Krhs_a)=ptab_child(i1:i2,j1:j2,1:jpk,jn)*tmask(i1:i2,j1:j2,1:jpk)  
    716716         END DO 
    717717 
    … …  
    737737               ibdy = nlci-nbghostcells 
    738738               DO jn = 1, jpts 
    739                   ts(ibdy+1,jmin:jmax,1:jpkm1,jn,Krhs) = z1 * ptab_child(ibdy+1,jmin:jmax,1:jpkm1,jn) + z2 * ptab_child(ibdy,jmin:jmax,1:jpkm1,jn) 
     739                  ts(ibdy+1,jmin:jmax,1:jpkm1,jn,Krhs_a) = z1 * ptab_child(ibdy+1,jmin:jmax,1:jpkm1,jn) + z2 * ptab_child(ibdy,jmin:jmax,1:jpkm1,jn) 
    740740                  DO jk = 1, jpkm1 
    741741                     DO jj = jmin,jmax 
    742742                        IF( umask(ibdy-1,jj,jk) == 0._wp ) THEN 
    743                            ts(ibdy,jj,jk,jn,Krhs) = ts(ibdy+1,jj,jk,jn,Krhs) * tmask(ibdy,jj,jk) 
     743                           ts(ibdy,jj,jk,jn,Krhs_a) = ts(ibdy+1,jj,jk,jn,Krhs_a) * tmask(ibdy,jj,jk) 
    744744                        ELSE 
    745                            ts(ibdy,jj,jk,jn,Krhs)=(z4*ts(ibdy+1,jj,jk,jn,Krhs)+z3*ts(ibdy-1,jj,jk,jn,Krhs))*tmask(ibdy,jj,jk) 
    746                            IF( uu(ibdy-1,jj,jk,Kmm) > 0._wp ) THEN 
    747                               ts(ibdy,jj,jk,jn,Krhs)=( z6*ts(ibdy-1,jj,jk,jn,Krhs)+z5*ts(ibdy+1,jj,jk,jn,Krhs) &  
    748                                                  + z7*ts(ibdy-2,jj,jk,jn,Krhs) ) * tmask(ibdy,jj,jk) 
     745                           ts(ibdy,jj,jk,jn,Krhs_a)=(z4*ts(ibdy+1,jj,jk,jn,Krhs_a)+z3*ts(ibdy-1,jj,jk,jn,Krhs_a))*tmask(ibdy,jj,jk) 
     746                           IF( uu(ibdy-1,jj,jk,Kmm_a) > 0._wp ) THEN 
     747                              ts(ibdy,jj,jk,jn,Krhs_a)=( z6*ts(ibdy-1,jj,jk,jn,Krhs_a)+z5*ts(ibdy+1,jj,jk,jn,Krhs_a) &  
     748                                                 + z7*ts(ibdy-2,jj,jk,jn,Krhs_a) ) * tmask(ibdy,jj,jk) 
    749749                           ENDIF 
    750750                        ENDIF 
    … …  
    752752                  END DO 
    753753                  ! Restore ghost points: 
    754                   ts(ibdy+1,jmin:jmax,1:jpkm1,jn,Krhs) = ptab_child(ibdy+1,jmin:jmax,1:jpkm1,jn) * tmask(ibdy+1,jmin:jmax,1:jpkm1) 
     754                  ts(ibdy+1,jmin:jmax,1:jpkm1,jn,Krhs_a) = ptab_child(ibdy+1,jmin:jmax,1:jpkm1,jn) * tmask(ibdy+1,jmin:jmax,1:jpkm1) 
    755755               END DO 
    756756            ENDIF 
    … …  
    766766               jbdy = nlcj-nbghostcells          
    767767               DO jn = 1, jpts 
    768                   ts(imin:imax,jbdy+1,1:jpkm1,jn,Krhs) = z1 * ptab_child(imin:imax,jbdy+1,1:jpkm1,jn) + z2 * ptab_child(imin:imax,jbdy,1:jpkm1,jn) 
     768                  ts(imin:imax,jbdy+1,1:jpkm1,jn,Krhs_a) = z1 * ptab_child(imin:imax,jbdy+1,1:jpkm1,jn) + z2 * ptab_child(imin:imax,jbdy,1:jpkm1,jn) 
    769769                  DO jk = 1, jpkm1 
    770770                     DO ji = imin,imax 
    771771                        IF( vmask(ji,jbdy-1,jk) == 0._wp ) THEN 
    772                            ts(ji,jbdy,jk,jn,Krhs) = ts(ji,jbdy+1,jk,jn,Krhs) * tmask(ji,jbdy,jk) 
     772                           ts(ji,jbdy,jk,jn,Krhs_a) = ts(ji,jbdy+1,jk,jn,Krhs_a) * tmask(ji,jbdy,jk) 
    773773                        ELSE 
    774                            ts(ji,jbdy,jk,jn,Krhs)=(z4*ts(ji,jbdy+1,jk,jn,Krhs)+z3*ts(ji,jbdy-1,jk,jn,Krhs))*tmask(ji,jbdy,jk)         
    775                            IF (vv(ji,jbdy-1,jk,Kmm) > 0._wp ) THEN 
    776                               ts(ji,jbdy,jk,jn,Krhs)=( z6*ts(ji,jbdy-1,jk,jn,Krhs)+z5*ts(ji,jbdy+1,jk,jn,Krhs)  & 
    777                                                  + z7*ts(ji,jbdy-2,jk,jn,Krhs) ) * tmask(ji,jbdy,jk) 
     774                           ts(ji,jbdy,jk,jn,Krhs_a)=(z4*ts(ji,jbdy+1,jk,jn,Krhs_a)+z3*ts(ji,jbdy-1,jk,jn,Krhs_a))*tmask(ji,jbdy,jk)         
     775                           IF (vv(ji,jbdy-1,jk,Kmm_a) > 0._wp ) THEN 
     776                              ts(ji,jbdy,jk,jn,Krhs_a)=( z6*ts(ji,jbdy-1,jk,jn,Krhs_a)+z5*ts(ji,jbdy+1,jk,jn,Krhs_a)  & 
     777                                                 + z7*ts(ji,jbdy-2,jk,jn,Krhs_a) ) * tmask(ji,jbdy,jk) 
    778778                           ENDIF 
    779779                        ENDIF 
    … …  
    781781                  END DO 
    782782                  ! Restore ghost points: 
    783                   ts(imin:imax,jbdy+1,1:jpkm1,jn,Krhs) = ptab_child(imin:imax,jbdy+1,1:jpkm1,jn) * tmask(imin:imax,jbdy+1,1:jpkm1) 
     783                  ts(imin:imax,jbdy+1,1:jpkm1,jn,Krhs_a) = ptab_child(imin:imax,jbdy+1,1:jpkm1,jn) * tmask(imin:imax,jbdy+1,1:jpkm1) 
    784784               END DO 
    785785            ENDIF 
    … …  
    795795               ibdy = 1+nbghostcells        
    796796               DO jn = 1, jpts 
    797                   ts(ibdy-1,jmin:jmax,1:jpkm1,jn,Krhs) = z1 * ptab_child(ibdy-1,jmin:jmax,1:jpkm1,jn) + z2 * ptab_child(ibdy,jmin:jmax,1:jpkm1,jn) 
     797                  ts(ibdy-1,jmin:jmax,1:jpkm1,jn,Krhs_a) = z1 * ptab_child(ibdy-1,jmin:jmax,1:jpkm1,jn) + z2 * ptab_child(ibdy,jmin:jmax,1:jpkm1,jn) 
    798798                  DO jk = 1, jpkm1 
    799799                     DO jj = jmin,jmax 
    800800                        IF( umask(ibdy,jj,jk) == 0._wp ) THEN 
    801                            ts(ibdy,jj,jk,jn,Krhs) = ts(ibdy-1,jj,jk,jn,Krhs) * tmask(ibdy,jj,jk) 
     801                           ts(ibdy,jj,jk,jn,Krhs_a) = ts(ibdy-1,jj,jk,jn,Krhs_a) * tmask(ibdy,jj,jk) 
    802802                        ELSE 
    803                            ts(ibdy,jj,jk,jn,Krhs)=(z4*ts(ibdy-1,jj,jk,jn,Krhs)+z3*ts(ibdy+1,jj,jk,jn,Krhs))*tmask(ibdy,jj,jk)         
    804                            IF( uu(ibdy,jj,jk,Kmm) < 0._wp ) THEN 
    805                               ts(ibdy,jj,jk,jn,Krhs)=( z6*ts(ibdy+1,jj,jk,jn,Krhs)+z5*ts(ibdy-1,jj,jk,jn,Krhs) & 
    806                                                  + z7*ts(ibdy+2,jj,jk,jn,Krhs) ) * tmask(ibdy,jj,jk) 
     803                           ts(ibdy,jj,jk,jn,Krhs_a)=(z4*ts(ibdy-1,jj,jk,jn,Krhs_a)+z3*ts(ibdy+1,jj,jk,jn,Krhs_a))*tmask(ibdy,jj,jk)         
     804                           IF( uu(ibdy,jj,jk,Kmm_a) < 0._wp ) THEN 
     805                              ts(ibdy,jj,jk,jn,Krhs_a)=( z6*ts(ibdy+1,jj,jk,jn,Krhs_a)+z5*ts(ibdy-1,jj,jk,jn,Krhs_a) & 
     806                                                 + z7*ts(ibdy+2,jj,jk,jn,Krhs_a) ) * tmask(ibdy,jj,jk) 
    807807                           ENDIF 
    808808                        ENDIF 
    … …  
    810810                  END DO 
    811811                  ! Restore ghost points: 
    812                   ts(ibdy-1,jmin:jmax,1:jpkm1,jn,Krhs) = ptab_child(ibdy-1,jmin:jmax,1:jpkm1,jn) * tmask(ibdy-1,jmin:jmax,1:jpkm1) 
     812                  ts(ibdy-1,jmin:jmax,1:jpkm1,jn,Krhs_a) = ptab_child(ibdy-1,jmin:jmax,1:jpkm1,jn) * tmask(ibdy-1,jmin:jmax,1:jpkm1) 
    813813               END DO 
    814814            ENDIF 
    … …  
    824824               jbdy=1+nbghostcells         
    825825               DO jn = 1, jpts 
    826                   ts(imin:imax,jbdy-1,1:jpkm1,jn,Krhs) = z1 * ptab_child(imin:imax,jbdy-1,1:jpkm1,jn) + z2 * ptab_child(imin:imax,jbdy,1:jpkm1,jn) 
     826                  ts(imin:imax,jbdy-1,1:jpkm1,jn,Krhs_a) = z1 * ptab_child(imin:imax,jbdy-1,1:jpkm1,jn) + z2 * ptab_child(imin:imax,jbdy,1:jpkm1,jn) 
    827827                  DO jk = 1, jpkm1       
    828828                     DO ji = imin,imax 
    829829                        IF( vmask(ji,jbdy,jk) == 0._wp ) THEN 
    830                            ts(ji,jbdy,jk,jn,Krhs)=ts(ji,jbdy-1,jk,jn,Krhs) * tmask(ji,jbdy,jk) 
     830                           ts(ji,jbdy,jk,jn,Krhs_a)=ts(ji,jbdy-1,jk,jn,Krhs_a) * tmask(ji,jbdy,jk) 
    831831                        ELSE 
    832                            ts(ji,jbdy,jk,jn,Krhs)=(z4*ts(ji,jbdy-1,jk,jn,Krhs)+z3*ts(ji,jbdy+1,jk,jn,Krhs))*tmask(ji,jbdy,jk) 
    833                            IF( vv(ji,jbdy,jk,Kmm) < 0._wp ) THEN 
    834                               ts(ji,jbdy,jk,jn,Krhs)=( z6*ts(ji,jbdy+1,jk,jn,Krhs)+z5*ts(ji,jbdy-1,jk,jn,Krhs) &  
    835                                                  + z7*ts(ji,jbdy+2,jk,jn,Krhs) ) * tmask(ji,jbdy,jk) 
     832                           ts(ji,jbdy,jk,jn,Krhs_a)=(z4*ts(ji,jbdy-1,jk,jn,Krhs_a)+z3*ts(ji,jbdy+1,jk,jn,Krhs_a))*tmask(ji,jbdy,jk) 
     833                           IF( vv(ji,jbdy,jk,Kmm_a) < 0._wp ) THEN 
     834                              ts(ji,jbdy,jk,jn,Krhs_a)=( z6*ts(ji,jbdy+1,jk,jn,Krhs_a)+z5*ts(ji,jbdy-1,jk,jn,Krhs_a) &  
     835                                                 + z7*ts(ji,jbdy+2,jk,jn,Krhs_a) ) * tmask(ji,jbdy,jk) 
    836836                           ENDIF 
    837837                        ENDIF 
    … …  
    839839                  END DO 
    840840                  ! Restore ghost points: 
    841                   ts(imin:imax,jbdy-1,1:jpkm1,jn,Krhs) = ptab_child(imin:imax,jbdy-1,1:jpkm1,jn) * tmask(imin:imax,jbdy-1,1:jpkm1) 
     841                  ts(imin:imax,jbdy-1,1:jpkm1,jn,Krhs_a) = ptab_child(imin:imax,jbdy-1,1:jpkm1,jn) * tmask(imin:imax,jbdy-1,1:jpkm1) 
    842842               END DO 
    843843            ENDIF 
    … …  
    861861      ! 
    862862      IF( before) THEN 
    863          ptab(i1:i2,j1:j2) = ssh(i1:i2,j1:j2,Kmm) 
     863         ptab(i1:i2,j1:j2) = ssh(i1:i2,j1:j2,Kmm_a) 
    864864      ELSE 
    865865         western_side  = (nb == 1).AND.(ndir == 1) 
    … …  
    900900            DO jj=j1,j2 
    901901               DO ji=i1,i2 
    902                   ptab(ji,jj,jk,1) = (e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm)*umask(ji,jj,jk))  
     902                  ptab(ji,jj,jk,1) = (e2u(ji,jj) * e3u(ji,jj,jk,Kmm_a) * uu(ji,jj,jk,Kmm_a)*umask(ji,jj,jk))  
    903903# if defined key_vertical 
    904                   ptab(ji,jj,jk,2) = (umask(ji,jj,jk) * e2u(ji,jj) * e3u(ji,jj,jk,Kmm)) 
     904                  ptab(ji,jj,jk,2) = (umask(ji,jj,jk) * e2u(ji,jj) * e3u(ji,jj,jk,Kmm_a)) 
    905905# endif 
    906906               END DO 
    … …  
    928928          
    929929              IF (N_in == 0) THEN 
    930                  uu(ji,jj,:,Krhs) = 0._wp 
     930                 uu(ji,jj,:,Krhs_a) = 0._wp 
    931931                 CYCLE 
    932932              ENDIF 
    … …  
    936936                 if (umask(iref,jj,jk) == 0) EXIT 
    937937                 N_out = N_out + 1 
    938                  h_out(N_out) = e3u(iref,jj,jk,Krhs) 
     938                 h_out(N_out) = e3u(iref,jj,jk,Krhs_a) 
    939939              ENDDO 
    940940          
    941941              IF (N_out == 0) THEN 
    942                  uu(ji,jj,:,Krhs) = 0._wp 
     942                 uu(ji,jj,:,Krhs_a) = 0._wp 
    943943                 CYCLE 
    944944              ENDIF 
    … …  
    952952                 endif 
    953953              ENDIF 
    954               call reconstructandremap(tabin(1:N_in),h_in(1:N_in),uu(ji,jj,1:N_out,Krhs),h_out(1:N_out),N_in,N_out) 
     954              call reconstructandremap(tabin(1:N_in),h_in(1:N_in),uu(ji,jj,1:N_out,Krhs_a),h_out(1:N_out),N_in,N_out) 
    955955            ENDDO 
    956956         ENDDO 
    … …  
    959959         DO jk = 1, jpkm1 
    960960            DO jj=j1,j2 
    961                uu(i1:i2,jj,jk,Krhs) = ptab(i1:i2,jj,jk,1) / ( zrhoy * e2u(i1:i2,jj) * e3u(i1:i2,jj,jk,Krhs) ) 
     961               uu(i1:i2,jj,jk,Krhs_a) = ptab(i1:i2,jj,jk,1) / ( zrhoy * e2u(i1:i2,jj) * e3u(i1:i2,jj,jk,Krhs_a) ) 
    962962            END DO 
    963963         END DO 
    … …  
    992992            DO jj=j1,j2 
    993993               DO ji=i1,i2 
    994                   ptab(ji,jj,jk,1) = (e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm)*vmask(ji,jj,jk)) 
     994                  ptab(ji,jj,jk,1) = (e1v(ji,jj) * e3v(ji,jj,jk,Kmm_a) * vv(ji,jj,jk,Kmm_a)*vmask(ji,jj,jk)) 
    995995# if defined key_vertical 
    996                   ptab(ji,jj,jk,2) = vmask(ji,jj,jk) * e1v(ji,jj) * e3v(ji,jj,jk,Kmm) 
     996                  ptab(ji,jj,jk,2) = vmask(ji,jj,jk) * e1v(ji,jj) * e3v(ji,jj,jk,Kmm_a) 
    997997# endif 
    998998               END DO 
    … …  
    10191019               END DO 
    10201020               IF (N_in == 0) THEN 
    1021                   vv(ji,jj,:,Krhs) = 0._wp 
     1021                  vv(ji,jj,:,Krhs_a) = 0._wp 
    10221022                  CYCLE 
    10231023               ENDIF 
    … …  
    10271027                  if (vmask(ji,jref,jk) == 0) EXIT 
    10281028                  N_out = N_out + 1 
    1029                   h_out(N_out) = e3v(ji,jref,jk,Krhs) 
     1029                  h_out(N_out) = e3v(ji,jref,jk,Krhs_a) 
    10301030               END DO 
    10311031               IF (N_out == 0) THEN 
    1032                  vv(ji,jj,:,Krhs) = 0._wp 
     1032                 vv(ji,jj,:,Krhs_a) = 0._wp 
    10331033                 CYCLE 
    10341034               ENDIF 
    1035                call reconstructandremap(tabin(1:N_in),h_in(1:N_in),vv(ji,jj,1:N_out,Krhs),h_out(1:N_out),N_in,N_out) 
     1035               call reconstructandremap(tabin(1:N_in),h_in(1:N_in),vv(ji,jj,1:N_out,Krhs_a),h_out(1:N_out),N_in,N_out) 
    10361036            END DO 
    10371037         END DO 
    10381038# else 
    10391039         DO jk = 1, jpkm1 
    1040             vv(i1:i2,j1:j2,jk,Krhs) = ptab(i1:i2,j1:j2,jk,1) / ( zrhox * e1v(i1:i2,j1:j2) * e3v(i1:i2,j1:j2,jk,Krhs) ) 
     1040            vv(i1:i2,j1:j2,jk,Krhs_a) = ptab(i1:i2,j1:j2,jk,1) / ( zrhox * e1v(i1:i2,j1:j2) * e3v(i1:i2,j1:j2,jk,Krhs_a) ) 
    10411041         END DO 
    10421042# endif 
    … …  
    10601060      ! 
    10611061      IF( before ) THEN  
    1062          ptab(i1:i2,j1:j2) = e2u(i1:i2,j1:j2) * hu_n(i1:i2,j1:j2) * uu_b(i1:i2,j1:j2,Kmm) 
     1062         ptab(i1:i2,j1:j2) = e2u(i1:i2,j1:j2) * hu_n(i1:i2,j1:j2) * uu_b(i1:i2,j1:j2,Kmm_a) 
    10631063      ELSE 
    10641064         western_side  = (nb == 1).AND.(ndir == 1) 
    … …  
    11131113      !  
    11141114      IF( before ) THEN  
    1115          ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * hv_n(i1:i2,j1:j2) * vv_b(i1:i2,j1:j2,Kmm) 
     1115         ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * hv_n(i1:i2,j1:j2) * vv_b(i1:i2,j1:j2,Kmm_a) 
    11161116      ELSE 
    11171117         western_side  = (nb == 1).AND.(ndir == 1) 
    … …  
    13941394           DO jj=j1,j2 
    13951395              DO ji=i1,i2 
    1396                  ptab(ji,jj,jk,2) = wmask(ji,jj,jk) * e3w(ji,jj,jk,Kmm)  
     1396                 ptab(ji,jj,jk,2) = wmask(ji,jj,jk) * e3w(ji,jj,jk,Kmm_a)  
    13971397              END DO 
    13981398           END DO 
    … …  
    14151415                  IF (wmask(ji,jj,jk) == 0) EXIT  
    14161416                  N_out = N_out + 1 
    1417                   h_out(jk) = e3t(ji,jj,jk,Kmm) 
     1417                  h_out(jk) = e3t(ji,jj,jk,Kmm_a) 
    14181418               ENDDO 
    14191419               IF (N_in > 0) THEN 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/NST/agrif_oce_sponge.F90

    r10989 r11053  
    191191   END SUBROUTINE Agrif_Sponge 
    192192 
    193    SUBROUTINE interptsn_sponge( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before ) 
     193   SUBROUTINE interptsn_sponge( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before) 
    194194      !!---------------------------------------------------------------------- 
    195195      !!                 *** ROUTINE interptsn_sponge *** 
    … …  
    218218               DO jj=j1,j2 
    219219                  DO ji=i1,i2 
    220                      tabres(ji,jj,jk,jn) = ts(ji,jj,jk,jn,Kbb) 
     220                     tabres(ji,jj,jk,jn) = ts(ji,jj,jk,jn,Kbb_a) 
    221221                  END DO 
    222222               END DO 
    … …  
    228228            DO jj=j1,j2 
    229229               DO ji=i1,i2 
    230                   tabres(ji,jj,jk,jpts+1) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kmm)  
     230                  tabres(ji,jj,jk,jpts+1) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kmm_a)  
    231231               END DO 
    232232            END DO 
    … …  
    251251                  IF (tmask(ji,jj,jk) == 0) EXIT  
    252252                  N_out = N_out + 1 
    253                   h_out(jk) = e3t(ji,jj,jk,Kmm) !Child grid scale factors. Could multiply by e1e2t here instead of division above 
     253                  h_out(jk) = e3t(ji,jj,jk,Kmm_a) !Child grid scale factors. Could multiply by e1e2t here instead of division above 
    254254               ENDDO 
    255255               IF (N_in > 0) THEN 
    … …  
    268268               DO jk=1,jpkm1 
    269269# if defined key_vertical 
    270                   tsbdiff(ji,jj,jk,1:jpts) = ts(ji,jj,jk,1:jpts,Kbb) - tabres_child(ji,jj,jk,1:jpts) 
     270                  tsbdiff(ji,jj,jk,1:jpts) = ts(ji,jj,jk,1:jpts,Kbb_a) - tabres_child(ji,jj,jk,1:jpts) 
    271271# else 
    272                   tsbdiff(ji,jj,jk,1:jpts) = ts(ji,jj,jk,1:jpts,Kbb) - tabres(ji,jj,jk,1:jpts) 
     272                  tsbdiff(ji,jj,jk,1:jpts) = ts(ji,jj,jk,1:jpts,Kbb_a) - tabres(ji,jj,jk,1:jpts) 
    273273# endif 
    274274               ENDDO 
    … …  
    281281               DO jj = j1,j2 
    282282                  DO ji = i1,i2-1 
    283                      zabe1 = fsaht_spu(ji,jj) * umask(ji,jj,jk) * e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm) 
     283                     zabe1 = fsaht_spu(ji,jj) * umask(ji,jj,jk) * e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm_a) 
    284284                     ztu(ji,jj,jk) = zabe1 * ( tsbdiff(ji+1,jj  ,jk,jn) - tsbdiff(ji,jj,jk,jn) )  
    285285                  END DO 
    … …  
    288288               DO ji = i1,i2 
    289289                  DO jj = j1,j2-1 
    290                      zabe2 = fsaht_spv(ji,jj) * vmask(ji,jj,jk) * e1_e2v(ji,jj) * e3v(ji,jj,jk,Kmm) 
     290                     zabe2 = fsaht_spv(ji,jj) * vmask(ji,jj,jk) * e1_e2v(ji,jj) * e3v(ji,jj,jk,Kmm_a) 
    291291                     ztv(ji,jj,jk) = zabe2 * ( tsbdiff(ji  ,jj+1,jk,jn) - tsbdiff(ji,jj,jk,jn) ) 
    292292                  END DO 
    … …  
    310310                  DO ji = i1+1,i2-1 
    311311                     IF (.NOT. tabspongedone_tsn(ji,jj)) THEN  
    312                         zbtr = r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 
     312                        zbtr = r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm_a) 
    313313                        ! horizontal diffusive trends 
    314314                        ztsa = zbtr * (  ztu(ji,jj,jk) - ztu(ji-1,jj,jk) + ztv(ji,jj,jk) - ztv(ji,jj-1,jk)  ) 
    315315                        ! add it to the general tracer trends 
    316                         ts(ji,jj,jk,jn,Krhs) = ts(ji,jj,jk,jn,Krhs) + ztsa 
     316                        ts(ji,jj,jk,jn,Krhs_a) = ts(ji,jj,jk,jn,Krhs_a) + ztsa 
    317317                     ENDIF 
    318318                  END DO 
    … …  
    353353            DO jj=j1,j2 
    354354               DO ji=i1,i2 
    355                   tabres(ji,jj,jk,m1) = uu(ji,jj,jk,Kbb) 
     355                  tabres(ji,jj,jk,m1) = uu(ji,jj,jk,Kbb_a) 
    356356# if defined key_vertical 
    357                   tabres(ji,jj,jk,m2) = e3u(ji,jj,jk,Kmm)*umask(ji,jj,jk) 
     357                  tabres(ji,jj,jk,m2) = e3u(ji,jj,jk,Kmm_a)*umask(ji,jj,jk) 
    358358# endif 
    359359               END DO 
    … …  
    384384                 if (umask(ji,jj,jk) == 0) EXIT 
    385385                 N_out = N_out + 1 
    386                  h_out(N_out) = e3u(ji,jj,jk,Kmm) 
     386                 h_out(N_out) = e3u(ji,jj,jk,Kmm_a) 
    387387              ENDDO 
    388388          
    … …  
    403403         ENDDO 
    404404 
    405          ubdiff(i1:i2,j1:j2,:) = (uu(i1:i2,j1:j2,:,Kbb) - tabres_child(i1:i2,j1:j2,:))*umask(i1:i2,j1:j2,:) 
     405         ubdiff(i1:i2,j1:j2,:) = (uu(i1:i2,j1:j2,:,Kbb_a) - tabres_child(i1:i2,j1:j2,:))*umask(i1:i2,j1:j2,:) 
    406406#else 
    407          ubdiff(i1:i2,j1:j2,:) = (uu(i1:i2,j1:j2,:,Kbb) - tabres(i1:i2,j1:j2,:,1))*umask(i1:i2,j1:j2,:) 
     407         ubdiff(i1:i2,j1:j2,:) = (uu(i1:i2,j1:j2,:,Kbb_a) - tabres(i1:i2,j1:j2,:,1))*umask(i1:i2,j1:j2,:) 
    408408#endif 
    409409         ! 
    … …  
    416416            DO jj = j1,j2 
    417417               DO ji = i1+1,i2   ! vector opt. 
    418                   zbtr = r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) * fsahm_spt(ji,jj) 
    419                   hdivdiff(ji,jj,jk) = (  e2u(ji  ,jj)*e3u(ji  ,jj,jk,Kmm) * ubdiff(ji  ,jj,jk) & 
    420                                      &   -e2u(ji-1,jj)*e3u(ji-1,jj,jk,Kmm) * ubdiff(ji-1,jj,jk) ) * zbtr 
     418                  zbtr = r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm_a) * fsahm_spt(ji,jj) 
     419                  hdivdiff(ji,jj,jk) = (  e2u(ji  ,jj)*e3u(ji  ,jj,jk,Kmm_a) * ubdiff(ji  ,jj,jk) & 
     420                                     &   -e2u(ji-1,jj)*e3u(ji-1,jj,jk,Kmm_a) * ubdiff(ji-1,jj,jk) ) * zbtr 
    421421               END DO 
    422422            END DO 
    … …  
    439439                     ze1v = hdivdiff(ji,jj,jk) 
    440440                     ! horizontal diffusive trends 
    441                      zua = - ( ze2u - rotdiff (ji,jj-1,jk) ) / ( e2u(ji,jj) * e3u(ji,jj,jk,Kmm) )   & 
     441                     zua = - ( ze2u - rotdiff (ji,jj-1,jk) ) / ( e2u(ji,jj) * e3u(ji,jj,jk,Kmm_a) )   & 
    442442                           + ( hdivdiff(ji+1,jj,jk) - ze1v ) * r1_e1u(ji,jj) 
    443443 
    444444                     ! add it to the general momentum trends 
    445                      uu(ji,jj,jk,Krhs) = uu(ji,jj,jk,Krhs) + zua 
     445                     uu(ji,jj,jk,Krhs_a) = uu(ji,jj,jk,Krhs_a) + zua 
    446446 
    447447                  END DO 
    … …  
    465465 
    466466                     ! horizontal diffusive trends 
    467                      zva = + ( ze2u - rotdiff (ji-1,jj,jk) ) / ( e1v(ji,jj) * e3v(ji,jj,jk,Kmm) )   & 
     467                     zva = + ( ze2u - rotdiff (ji-1,jj,jk) ) / ( e1v(ji,jj) * e3v(ji,jj,jk,Kmm_a) )   & 
    468468                           + ( hdivdiff(ji,jj+1,jk) - ze1v ) * r1_e2v(ji,jj) 
    469469 
    470470                     ! add it to the general momentum trends 
    471                      vv(ji,jj,jk,Krhs) = vv(ji,jj,jk,Krhs) + zva 
     471                     vv(ji,jj,jk,Krhs_a) = vv(ji,jj,jk,Krhs_a) + zva 
    472472                  END DO 
    473473               ENDIF 
    … …  
    506506            DO jj=j1,j2 
    507507               DO ji=i1,i2 
    508                   tabres(ji,jj,jk,m1) = vv(ji,jj,jk,Kbb) 
     508                  tabres(ji,jj,jk,m1) = vv(ji,jj,jk,Kbb_a) 
    509509# if defined key_vertical 
    510                   tabres(ji,jj,jk,m2) = vmask(ji,jj,jk) * e3v(ji,jj,jk,Kmm) 
     510                  tabres(ji,jj,jk,m2) = vmask(ji,jj,jk) * e3v(ji,jj,jk,Kmm_a) 
    511511# endif 
    512512               END DO 
    … …  
    536536                 if (vmask(ji,jj,jk) == 0) EXIT 
    537537                 N_out = N_out + 1 
    538                  h_out(N_out) = e3v(ji,jj,jk,Kmm) 
     538                 h_out(N_out) = e3v(ji,jj,jk,Kmm_a) 
    539539              ENDDO 
    540540          
    … …  
    549549         ENDDO 
    550550 
    551          vbdiff(i1:i2,j1:j2,:) = (vv(i1:i2,j1:j2,:,Kbb) - tabres_child(i1:i2,j1:j2,:))*vmask(i1:i2,j1:j2,:)   
     551         vbdiff(i1:i2,j1:j2,:) = (vv(i1:i2,j1:j2,:,Kbb_a) - tabres_child(i1:i2,j1:j2,:))*vmask(i1:i2,j1:j2,:)   
    552552# else 
    553          vbdiff(i1:i2,j1:j2,:) = (vv(i1:i2,j1:j2,:,Kbb) - tabres(i1:i2,j1:j2,:,1))*vmask(i1:i2,j1:j2,:) 
     553         vbdiff(i1:i2,j1:j2,:) = (vv(i1:i2,j1:j2,:,Kbb_a) - tabres(i1:i2,j1:j2,:,1))*vmask(i1:i2,j1:j2,:) 
    554554# endif 
    555555         ! 
    … …  
    562562            DO jj = j1+1,j2 
    563563               DO ji = i1,i2   ! vector opt. 
    564                   zbtr = r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) * fsahm_spt(ji,jj) 
    565                   hdivdiff(ji,jj,jk) = ( e1v(ji,jj  ) * e3v(ji,jj  ,jk,Kmm) * vbdiff(ji,jj  ,jk)  & 
    566                                      &  -e1v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm) * vbdiff(ji,jj-1,jk)  ) * zbtr 
     564                  zbtr = r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm_a) * fsahm_spt(ji,jj) 
     565                  hdivdiff(ji,jj,jk) = ( e1v(ji,jj  ) * e3v(ji,jj  ,jk,Kmm_a) * vbdiff(ji,jj  ,jk)  & 
     566                                     &  -e1v(ji,jj-1) * e3v(ji,jj-1,jk,Kmm_a) * vbdiff(ji,jj-1,jk)  ) * zbtr 
    567567               END DO 
    568568            END DO 
    … …  
    586586               IF( .NOT. tabspongedone_u(ji,jj) ) THEN 
    587587                  DO jk = 1, jpkm1 
    588                      uu(ji,jj,jk,Krhs) = uu(ji,jj,jk,Krhs)                                                               & 
    589                         & - ( rotdiff (ji  ,jj,jk) - rotdiff (ji,jj-1,jk)) / ( e2u(ji,jj) * e3u(ji,jj,jk,Kmm) )  & 
     588                     uu(ji,jj,jk,Krhs_a) = uu(ji,jj,jk,Krhs_a)                                                               & 
     589                        & - ( rotdiff (ji  ,jj,jk) - rotdiff (ji,jj-1,jk)) / ( e2u(ji,jj) * e3u(ji,jj,jk,Kmm_a) )  & 
    590590                        & + ( hdivdiff(ji+1,jj,jk) - hdivdiff(ji,jj  ,jk)) * r1_e1u(ji,jj) 
    591591                  END DO 
    … …  
    600600               IF( .NOT. tabspongedone_v(ji,jj) ) THEN 
    601601                  DO jk = 1, jpkm1 
    602                      vv(ji,jj,jk,Krhs) = vv(ji,jj,jk,Krhs)                                                                  & 
    603                         &  + ( rotdiff (ji,jj  ,jk) - rotdiff (ji-1,jj,jk) ) / ( e1v(ji,jj) * e3v(ji,jj,jk,Kmm) )   & 
     602                     vv(ji,jj,jk,Krhs_a) = vv(ji,jj,jk,Krhs_a)                                                                  & 
     603                        &  + ( rotdiff (ji,jj  ,jk) - rotdiff (ji-1,jj,jk) ) / ( e1v(ji,jj) * e3v(ji,jj,jk,Kmm_a) )   & 
    604604                        &  + ( hdivdiff(ji,jj+1,jk) - hdivdiff(ji  ,jj,jk) ) * r1_e2v(ji,jj) 
    605605                  END DO 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/NST/agrif_oce_update.F90

    r10989 r11053  
    230230      ! ----------------------- 
    231231      ! 
    232       e3u(:,:,:,Krhs) = e3u(:,:,:,Kmm) 
    233       e3v(:,:,:,Krhs) = e3v(:,:,:,Kmm) 
    234 !      uu(:,:,:,Krhs) = e3u(:,:,:,Kbb) 
    235 !      vv(:,:,:,Krhs) = e3v(:,:,:,Kbb) 
     232      e3u(:,:,:,Krhs_a) = e3u(:,:,:,Kmm_a) 
     233      e3v(:,:,:,Krhs_a) = e3v(:,:,:,Kmm_a) 
     234!      uu(:,:,:,Krhs_a) = e3u(:,:,:,Kbb_a) 
     235!      vv(:,:,:,Krhs_a) = e3v(:,:,:,Kbb_a) 
    236236      hu_a(:,:) = hu_n(:,:) 
    237237      hv_a(:,:) = hv_n(:,:) 
    … …  
    242242         ! Vertical scale factor interpolations 
    243243         ! ------------------------------------ 
    244       CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3u(:,:,:,Kmm) ,  'U' ) 
    245       CALL dom_vvl_interpol( e3t(:,:,:,Kmm), e3v(:,:,:,Kmm) ,  'V' ) 
    246       CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3f(:,:,:) ,  'F' ) 
    247  
    248       CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3uw(:,:,:,Kmm), 'UW' ) 
    249       CALL dom_vvl_interpol( e3v(:,:,:,Kmm), e3vw(:,:,:,Kmm), 'VW' ) 
     244      CALL dom_vvl_interpol( e3t(:,:,:,Kmm_a), e3u(:,:,:,Kmm_a) ,  'U' ) 
     245      CALL dom_vvl_interpol( e3t(:,:,:,Kmm_a), e3v(:,:,:,Kmm_a) ,  'V' ) 
     246      CALL dom_vvl_interpol( e3u(:,:,:,Kmm_a), e3f(:,:,:) ,  'F' ) 
     247 
     248      CALL dom_vvl_interpol( e3u(:,:,:,Kmm_a), e3uw(:,:,:,Kmm_a), 'UW' ) 
     249      CALL dom_vvl_interpol( e3v(:,:,:,Kmm_a), e3vw(:,:,:,Kmm_a), 'VW' ) 
    250250 
    251251         ! Update total depths: 
    … …  
    254254      hv_n(:,:) = 0._wp                        ! Ocean depth at V-points 
    255255      DO jk = 1, jpkm1 
    256          hu_n(:,:) = hu_n(:,:) + e3u(:,:,jk,Kmm) * umask(:,:,jk) 
    257          hv_n(:,:) = hv_n(:,:) + e3v(:,:,jk,Kmm) * vmask(:,:,jk) 
     256         hu_n(:,:) = hu_n(:,:) + e3u(:,:,jk,Kmm_a) * umask(:,:,jk) 
     257         hv_n(:,:) = hv_n(:,:) + e3v(:,:,jk,Kmm_a) * vmask(:,:,jk) 
    258258      END DO 
    259259      !                                        ! Inverse of the local depth 
    … …  
    268268         ! Vertical scale factor interpolations 
    269269         ! ------------------------------------ 
    270          CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3u(:,:,:,Kbb),  'U'  ) 
    271          CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3v(:,:,:,Kbb),  'V'  ) 
    272  
    273          CALL dom_vvl_interpol( e3u(:,:,:,Kbb), e3uw(:,:,:,Kbb), 'UW' ) 
    274          CALL dom_vvl_interpol( e3v(:,:,:,Kbb), e3vw(:,:,:,Kbb), 'VW' ) 
     270         CALL dom_vvl_interpol( e3t(:,:,:,Kbb_a), e3u(:,:,:,Kbb_a),  'U'  ) 
     271         CALL dom_vvl_interpol( e3t(:,:,:,Kbb_a), e3v(:,:,:,Kbb_a),  'V'  ) 
     272 
     273         CALL dom_vvl_interpol( e3u(:,:,:,Kbb_a), e3uw(:,:,:,Kbb_a), 'UW' ) 
     274         CALL dom_vvl_interpol( e3v(:,:,:,Kbb_a), e3vw(:,:,:,Kbb_a), 'VW' ) 
    275275 
    276276         ! Update total depths: 
    … …  
    279279         hv_b(:,:) = 0._wp                     ! Ocean depth at V-points 
    280280         DO jk = 1, jpkm1 
    281             hu_b(:,:) = hu_b(:,:) + e3u(:,:,jk,Kbb) * umask(:,:,jk) 
    282             hv_b(:,:) = hv_b(:,:) + e3v(:,:,jk,Kbb) * vmask(:,:,jk) 
     281            hu_b(:,:) = hu_b(:,:) + e3u(:,:,jk,Kbb_a) * umask(:,:,jk) 
     282            hv_b(:,:) = hv_b(:,:) + e3v(:,:,jk,Kbb_a) * vmask(:,:,jk) 
    283283         END DO 
    284284         !                                     ! Inverse of the local depth 
    … …  
    315315               DO jj=j1,j2 
    316316                  DO ji=i1,i2 
    317                      tabres(ji,jj,jk,jn) = (ts(ji,jj,jk,jn,Kmm) * e3t(ji,jj,jk,Kmm) ) & 
     317                     tabres(ji,jj,jk,jn) = (ts(ji,jj,jk,jn,Kmm_a) * e3t(ji,jj,jk,Kmm_a) ) & 
    318318                                           * tmask(ji,jj,jk) + (tmask(ji,jj,jk)-1)*999._wp 
    319319                  END DO 
    … …  
    324324            DO jj=j1,j2 
    325325               DO ji=i1,i2 
    326                   tabres(ji,jj,jk,n2) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kmm) & 
     326                  tabres(ji,jj,jk,n2) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kmm_a) & 
    327327                                           + (tmask(ji,jj,jk)-1)*999._wp 
    328328               END DO 
    … …  
    345345                  IF (tmask(ji,jj,jk) < -900) EXIT ! TODO: Will not work with ISF 
    346346                  N_out = N_out + 1 
    347                   h_out(N_out) = e3t(ji,jj,jk,Kmm)  
     347                  h_out(N_out) = e3t(ji,jj,jk,Kmm_a)  
    348348               ENDDO 
    349349               IF (N_in > 0) THEN !Remove this? 
    … …  
    369369                     DO ji=i1,i2 
    370370                        IF( tabres_child(ji,jj,jk,jn) .NE. 0. ) THEN 
    371                            ts(ji,jj,jk,jn,Kbb) = ts(ji,jj,jk,jn,Kbb) &  
     371                           ts(ji,jj,jk,jn,Kbb_a) = ts(ji,jj,jk,jn,Kbb_a) &  
    372372                                 & + atfp * ( tabres_child(ji,jj,jk,jn) & 
    373                                  &          - ts(ji,jj,jk,jn,Kmm) ) * tmask(ji,jj,jk) 
     373                                 &          - ts(ji,jj,jk,jn,Kmm_a) ) * tmask(ji,jj,jk) 
    374374                        ENDIF 
    375375                     ENDDO 
    … …  
    383383                  DO ji=i1,i2 
    384384                     IF( tabres_child(ji,jj,jk,jn) .NE. 0. ) THEN  
    385                         ts(ji,jj,jk,jn,Kmm) = tabres_child(ji,jj,jk,jn) * tmask(ji,jj,jk) 
     385                        ts(ji,jj,jk,jn,Kmm_a) = tabres_child(ji,jj,jk,jn) * tmask(ji,jj,jk) 
    386386                     END IF 
    387387                  END DO 
    … …  
    413413                  DO ji=i1,i2 
    414414!> jc tmp 
    415                      tabres(ji,jj,jk,jn) = ts(ji,jj,jk,jn,Kmm)  * e3t(ji,jj,jk,Kmm) / e3t_0(ji,jj,jk) 
    416 !                     tabres(ji,jj,jk,jn) = ts(ji,jj,jk,jn,Kmm)  * e3t(ji,jj,jk,Kmm) 
     415                     tabres(ji,jj,jk,jn) = ts(ji,jj,jk,jn,Kmm_a)  * e3t(ji,jj,jk,Kmm_a) / e3t_0(ji,jj,jk) 
     416!                     tabres(ji,jj,jk,jn) = ts(ji,jj,jk,jn,Kmm_a)  * e3t(ji,jj,jk,Kmm_a) 
    417417!< jc tmp 
    418418                  END DO 
    … …  
    434434                     DO ji = i1, i2 
    435435                        IF( tabres(ji,jj,jk,jn) /= 0._wp ) THEN 
    436                            ztb  = ts(ji,jj,jk,jn,Kbb) * e3t(ji,jj,jk,Kbb) ! fse3t_b prior update should be used 
     436                           ztb  = ts(ji,jj,jk,jn,Kbb_a) * e3t(ji,jj,jk,Kbb_a) ! fse3t_b prior update should be used 
    437437                           ztnu = tabres(ji,jj,jk,jn) 
    438                            ztno = ts(ji,jj,jk,jn,Kmm) * e3t(ji,jj,jk,Krhs) 
    439                            ts(ji,jj,jk,jn,Kbb) = ( ztb + atfp * ( ztnu - ztno) )  &  
    440                                      &        * tmask(ji,jj,jk) / e3t(ji,jj,jk,Kbb) 
     438                           ztno = ts(ji,jj,jk,jn,Kmm_a) * e3t(ji,jj,jk,Krhs_a) 
     439                           ts(ji,jj,jk,jn,Kbb_a) = ( ztb + atfp * ( ztnu - ztno) )  &  
     440                                     &        * tmask(ji,jj,jk) / e3t(ji,jj,jk,Kbb_a) 
    441441                        ENDIF 
    442442                     END DO 
    … …  
    450450                  DO ji=i1,i2 
    451451                     IF( tabres(ji,jj,jk,jn) /= 0._wp ) THEN  
    452                         ts(ji,jj,jk,jn,Kmm) = tabres(ji,jj,jk,jn) / e3t(ji,jj,jk,Kmm) 
     452                        ts(ji,jj,jk,jn,Kmm_a) = tabres(ji,jj,jk,jn) / e3t(ji,jj,jk,Kmm_a) 
    453453                     END IF 
    454454                  END DO 
    … …  
    458458         ! 
    459459         IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 
    460             ts(i1:i2,j1:j2,k1:k2,1:jpts,Kbb)  = ts(i1:i2,j1:j2,k1:k2,1:jpts,Kmm) 
     460            ts(i1:i2,j1:j2,k1:k2,1:jpts,Kbb_a)  = ts(i1:i2,j1:j2,k1:k2,1:jpts,Kmm_a) 
    461461         ENDIF 
    462462         ! 
    … …  
    495495            DO jj=j1,j2 
    496496               DO ji=i1,i2 
    497                   tabres(ji,jj,jk,1) = zrhoy * e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * umask(ji,jj,jk) * uu(ji,jj,jk,Kmm)  & 
     497                  tabres(ji,jj,jk,1) = zrhoy * e2u(ji,jj) * e3u(ji,jj,jk,Kmm_a) * umask(ji,jj,jk) * uu(ji,jj,jk,Kmm_a)  & 
    498498                                       + (umask(ji,jj,jk)-1)*999._wp 
    499                   tabres(ji,jj,jk,2) = zrhoy * umask(ji,jj,jk) * e2u(ji,jj) * e3u(ji,jj,jk,Kmm)  & 
     499                  tabres(ji,jj,jk,2) = zrhoy * umask(ji,jj,jk) * e2u(ji,jj) * e3u(ji,jj,jk,Kmm_a)  & 
    500500                                       + (umask(ji,jj,jk)-1)*999._wp 
    501501               END DO 
    … …  
    520520                  IF (umask(ji,jj,jk) == 0) EXIT 
    521521                  N_out = N_out + 1 
    522                   h_out(N_out) = e3u(ji,jj,jk,Kmm) 
     522                  h_out(N_out) = e3u(ji,jj,jk,Kmm_a) 
    523523               ENDDO 
    524524               IF (N_in * N_out > 0) THEN 
    … …  
    550550               DO ji=i1,i2 
    551551                  IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 
    552                      uu(ji,jj,jk,Kbb) = uu(ji,jj,jk,Kbb) &  
    553                            & + atfp * ( tabres_child(ji,jj,jk) - uu(ji,jj,jk,Kmm) ) * umask(ji,jj,jk) 
     552                     uu(ji,jj,jk,Kbb_a) = uu(ji,jj,jk,Kbb_a) &  
     553                           & + atfp * ( tabres_child(ji,jj,jk) - uu(ji,jj,jk,Kmm_a) ) * umask(ji,jj,jk) 
    554554                  ENDIF 
    555555                  ! 
    556                   uu(ji,jj,jk,Kmm) = tabres_child(ji,jj,jk) * umask(ji,jj,jk) 
     556                  uu(ji,jj,jk,Kmm_a) = tabres_child(ji,jj,jk) * umask(ji,jj,jk) 
    557557               END DO 
    558558            END DO 
    … …  
    579579         zrhoy = Agrif_Rhoy() 
    580580         DO jk = k1, k2 
    581             tabres(i1:i2,j1:j2,jk,1) = zrhoy * e2u(i1:i2,j1:j2) * e3u(i1:i2,j1:j2,jk,Kmm) * uu(i1:i2,j1:j2,jk,Kmm) 
     581            tabres(i1:i2,j1:j2,jk,1) = zrhoy * e2u(i1:i2,j1:j2) * e3u(i1:i2,j1:j2,jk,Kmm_a) * uu(i1:i2,j1:j2,jk,Kmm_a) 
    582582         END DO 
    583583      ELSE 
    … …  
    588588                  ! 
    589589                  IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 
    590                      zub  = uu(ji,jj,jk,Kbb) * e3u(ji,jj,jk,Kbb)  ! fse3t_b prior update should be used 
    591                      zuno = uu(ji,jj,jk,Kmm) * e3u(ji,jj,jk,Krhs) 
     590                     zub  = uu(ji,jj,jk,Kbb_a) * e3u(ji,jj,jk,Kbb_a)  ! fse3t_b prior update should be used 
     591                     zuno = uu(ji,jj,jk,Kmm_a) * e3u(ji,jj,jk,Krhs_a) 
    592592                     zunu = tabres(ji,jj,jk,1) 
    593                      uu(ji,jj,jk,Kbb) = ( zub + atfp * ( zunu - zuno) ) &       
    594                                     & * umask(ji,jj,jk) / e3u(ji,jj,jk,Kbb) 
     593                     uu(ji,jj,jk,Kbb_a) = ( zub + atfp * ( zunu - zuno) ) &       
     594                                    & * umask(ji,jj,jk) / e3u(ji,jj,jk,Kbb_a) 
    595595                  ENDIF 
    596596                  ! 
    597                   uu(ji,jj,jk,Kmm) = tabres(ji,jj,jk,1) * umask(ji,jj,jk) / e3u(ji,jj,jk,Kmm) 
     597                  uu(ji,jj,jk,Kmm_a) = tabres(ji,jj,jk,1) * umask(ji,jj,jk) / e3u(ji,jj,jk,Kmm_a) 
    598598               END DO 
    599599            END DO 
    … …  
    601601         ! 
    602602         IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 
    603             uu(i1:i2,j1:j2,k1:k2,Kbb)  = uu(i1:i2,j1:j2,k1:k2,Kmm) 
     603            uu(i1:i2,j1:j2,k1:k2,Kbb_a)  = uu(i1:i2,j1:j2,k1:k2,Kmm_a) 
    604604         ENDIF 
    605605         ! 
    … …  
    632632         IF (western_side) THEN 
    633633            DO jj=j1,j2 
    634                zcor = uu_b(i1-1,jj,Kmm) * hu_a(i1-1,jj) * r1_hu_n(i1-1,jj) - uu_b(i1-1,jj,Kmm) 
    635                uu_b(i1-1,jj,Kmm) = uu_b(i1-1,jj,Kmm) + zcor 
     634               zcor = uu_b(i1-1,jj,Kmm_a) * hu_a(i1-1,jj) * r1_hu_n(i1-1,jj) - uu_b(i1-1,jj,Kmm_a) 
     635               uu_b(i1-1,jj,Kmm_a) = uu_b(i1-1,jj,Kmm_a) + zcor 
    636636               DO jk=1,jpkm1 
    637                   uu(i1-1,jj,jk,Kmm) = uu(i1-1,jj,jk,Kmm) + zcor * umask(i1-1,jj,jk) 
     637                  uu(i1-1,jj,jk,Kmm_a) = uu(i1-1,jj,jk,Kmm_a) + zcor * umask(i1-1,jj,jk) 
    638638               END DO  
    639639            END DO 
    … …  
    642642         IF (eastern_side) THEN 
    643643            DO jj=j1,j2 
    644                zcor = uu_b(i2+1,jj,Kmm) * hu_a(i2+1,jj) * r1_hu_n(i2+1,jj) - uu_b(i2+1,jj,Kmm) 
    645                uu_b(i2+1,jj,Kmm) = uu_b(i2+1,jj,Kmm) + zcor 
     644               zcor = uu_b(i2+1,jj,Kmm_a) * hu_a(i2+1,jj) * r1_hu_n(i2+1,jj) - uu_b(i2+1,jj,Kmm_a) 
     645               uu_b(i2+1,jj,Kmm_a) = uu_b(i2+1,jj,Kmm_a) + zcor 
    646646               DO jk=1,jpkm1 
    647                   uu(i2+1,jj,jk,Kmm) = uu(i2+1,jj,jk,Kmm) + zcor * umask(i2+1,jj,jk) 
     647                  uu(i2+1,jj,jk,Kmm_a) = uu(i2+1,jj,jk,Kmm_a) + zcor * umask(i2+1,jj,jk) 
    648648               END DO  
    649649            END DO 
    … …  
    682682            DO jj=j1,j2 
    683683               DO ji=i1,i2 
    684                   tabres(ji,jj,jk,1) = zrhox * e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * vmask(ji,jj,jk) * vv(ji,jj,jk,Kmm) & 
     684                  tabres(ji,jj,jk,1) = zrhox * e1v(ji,jj) * e3v(ji,jj,jk,Kmm_a) * vmask(ji,jj,jk) * vv(ji,jj,jk,Kmm_a) & 
    685685                                       + (vmask(ji,jj,jk)-1)*999._wp 
    686                   tabres(ji,jj,jk,2) = vmask(ji,jj,jk) * zrhox * e1v(ji,jj) * e3v(ji,jj,jk,Kmm) & 
     686                  tabres(ji,jj,jk,2) = vmask(ji,jj,jk) * zrhox * e1v(ji,jj) * e3v(ji,jj,jk,Kmm_a) & 
    687687                                       + (vmask(ji,jj,jk)-1)*999._wp 
    688688               END DO 
    … …  
    705705                  IF (vmask(ji,jj,jk) == 0) EXIT 
    706706                  N_out = N_out + 1 
    707                   h_out(N_out) = e3v(ji,jj,jk,Kmm) 
     707                  h_out(N_out) = e3v(ji,jj,jk,Kmm_a) 
    708708               ENDDO 
    709709               IF (N_in * N_out > 0) THEN 
    … …  
    736736                  ! 
    737737                  IF( .NOT.(lk_agrif_fstep.AND.(neuler==0)) ) THEN ! Add asselin part 
    738                      vv(ji,jj,jk,Kbb) = vv(ji,jj,jk,Kbb) &  
    739                            & + atfp * ( tabres_child(ji,jj,jk) - vv(ji,jj,jk,Kmm) ) * vmask(ji,jj,jk) 
     738                     vv(ji,jj,jk,Kbb_a) = vv(ji,jj,jk,Kbb_a) &  
     739                           & + atfp * ( tabres_child(ji,jj,jk) - vv(ji,jj,jk,Kmm_a) ) * vmask(ji,jj,jk) 
    740740                  ENDIF 
    741741                  ! 
    742                   vv(ji,jj,jk,Kmm) = tabres_child(ji,jj,jk) * vmask(ji,jj,jk) 
     742                  vv(ji,jj,jk,Kmm_a) = tabres_child(ji,jj,jk) * vmask(ji,jj,jk) 
    743743               END DO 
    744744            END DO 
    … …  
    767767            DO jj=j1,j2 
    768768               DO ji=i1,i2 
    769                   tabres(ji,jj,jk,1) = zrhox * e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) 
     769                  tabres(ji,jj,jk,1) = zrhox * e1v(ji,jj) * e3v(ji,jj,jk,Kmm_a) * vv(ji,jj,jk,Kmm_a) 
    770770               END DO 
    771771            END DO 
    … …  
    778778                  ! 
    779779                  IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 
    780                      zvb  = vv(ji,jj,jk,Kbb) * e3v(ji,jj,jk,Kbb) ! fse3t_b prior update should be used 
    781                      zvno = vv(ji,jj,jk,Kmm) * e3v(ji,jj,jk,Krhs) 
     780                     zvb  = vv(ji,jj,jk,Kbb_a) * e3v(ji,jj,jk,Kbb_a) ! fse3t_b prior update should be used 
     781                     zvno = vv(ji,jj,jk,Kmm_a) * e3v(ji,jj,jk,Krhs_a) 
    782782                     zvnu = tabres(ji,jj,jk,1) 
    783                      vv(ji,jj,jk,Kbb) = ( zvb + atfp * ( zvnu - zvno) ) &       
    784                                     & * vmask(ji,jj,jk) / e3v(ji,jj,jk,Kbb) 
     783                     vv(ji,jj,jk,Kbb_a) = ( zvb + atfp * ( zvnu - zvno) ) &       
     784                                    & * vmask(ji,jj,jk) / e3v(ji,jj,jk,Kbb_a) 
    785785                  ENDIF 
    786786                  ! 
    787                   vv(ji,jj,jk,Kmm) = tabres(ji,jj,jk,1) * vmask(ji,jj,jk) / e3v(ji,jj,jk,Kmm) 
     787                  vv(ji,jj,jk,Kmm_a) = tabres(ji,jj,jk,1) * vmask(ji,jj,jk) / e3v(ji,jj,jk,Kmm_a) 
    788788               END DO 
    789789            END DO 
    … …  
    791791         ! 
    792792         IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 
    793             vv(i1:i2,j1:j2,k1:k2,Kbb)  = vv(i1:i2,j1:j2,k1:k2,Kmm) 
     793            vv(i1:i2,j1:j2,k1:k2,Kbb_a)  = vv(i1:i2,j1:j2,k1:k2,Kmm_a) 
    794794         ENDIF 
    795795         ! 
    … …  
    822822         IF (southern_side) THEN 
    823823            DO ji=i1,i2 
    824                zcor = vv_b(ji,j1-1,Kmm) * hv_a(ji,j1-1) * r1_hv_n(ji,j1-1) - vv_b(ji,j1-1,Kmm) 
    825                vv_b(ji,j1-1,Kmm) = vv_b(ji,j1-1,Kmm) + zcor 
     824               zcor = vv_b(ji,j1-1,Kmm_a) * hv_a(ji,j1-1) * r1_hv_n(ji,j1-1) - vv_b(ji,j1-1,Kmm_a) 
     825               vv_b(ji,j1-1,Kmm_a) = vv_b(ji,j1-1,Kmm_a) + zcor 
    826826               DO jk=1,jpkm1 
    827                   vv(ji,j1-1,jk,Kmm) = vv(ji,j1-1,jk,Kmm) + zcor * vmask(ji,j1-1,jk) 
     827                  vv(ji,j1-1,jk,Kmm_a) = vv(ji,j1-1,jk,Kmm_a) + zcor * vmask(ji,j1-1,jk) 
    828828               END DO  
    829829            END DO 
    … …  
    832832         IF (northern_side) THEN 
    833833            DO ji=i1,i2 
    834                zcor = vv_b(ji,j2+1,Kmm) * hv_a(ji,j2+1) * r1_hv_n(ji,j2+1) - vv_b(ji,j2+1,Kmm) 
    835                vv_b(ji,j2+1,Kmm) = vv_b(ji,j2+1,Kmm) + zcor 
     834               zcor = vv_b(ji,j2+1,Kmm_a) * hv_a(ji,j2+1) * r1_hv_n(ji,j2+1) - vv_b(ji,j2+1,Kmm_a) 
     835               vv_b(ji,j2+1,Kmm_a) = vv_b(ji,j2+1,Kmm_a) + zcor 
    836836               DO jk=1,jpkm1 
    837                   vv(ji,j2+1,jk,Kmm) = vv(ji,j2+1,jk,Kmm) + zcor * vmask(ji,j2+1,jk) 
     837                  vv(ji,j2+1,jk,Kmm_a) = vv(ji,j2+1,jk,Kmm_a) + zcor * vmask(ji,j2+1,jk) 
    838838               END DO  
    839839            END DO 
    … …  
    862862         DO jj=j1,j2 
    863863            DO ji=i1,i2 
    864                tabres(ji,jj) = zrhoy * uu_b(ji,jj,Kmm) * hu_n(ji,jj) * e2u(ji,jj) 
     864               tabres(ji,jj) = zrhoy * uu_b(ji,jj,Kmm_a) * hu_n(ji,jj) * e2u(ji,jj) 
    865865            END DO 
    866866         END DO 
    … …  
    873873               spgu(ji,jj) = 0._wp 
    874874               DO jk=1,jpkm1 
    875                   spgu(ji,jj) = spgu(ji,jj) + e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm) 
     875                  spgu(ji,jj) = spgu(ji,jj) + e3u(ji,jj,jk,Kmm_a) * uu(ji,jj,jk,Kmm_a) 
    876876               END DO 
    877877               ! 
    878878               zcorr = (tabres(ji,jj) - spgu(ji,jj)) * r1_hu_n(ji,jj) 
    879879               DO jk=1,jpkm1               
    880                   uu(ji,jj,jk,Kmm) = uu(ji,jj,jk,Kmm) + zcorr * umask(ji,jj,jk)            
     880                  uu(ji,jj,jk,Kmm_a) = uu(ji,jj,jk,Kmm_a) + zcorr * umask(ji,jj,jk)            
    881881               END DO 
    882882               ! 
    … …  
    884884               IF ( .NOT.ln_dynspg_ts .OR. (ln_dynspg_ts.AND.(.NOT.ln_bt_fw)) ) THEN 
    885885                  IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 
    886                      zcorr = (tabres(ji,jj) - uu_b(ji,jj,Kmm) * hu_a(ji,jj)) * r1_hu_b(ji,jj) 
    887                      uu_b(ji,jj,Kbb) = uu_b(ji,jj,Kbb) + atfp * zcorr * umask(ji,jj,1) 
     886                     zcorr = (tabres(ji,jj) - uu_b(ji,jj,Kmm_a) * hu_a(ji,jj)) * r1_hu_b(ji,jj) 
     887                     uu_b(ji,jj,Kbb_a) = uu_b(ji,jj,Kbb_a) + atfp * zcorr * umask(ji,jj,1) 
    888888                  END IF 
    889889               ENDIF     
    890                uu_b(ji,jj,Kmm) = tabres(ji,jj) * r1_hu_n(ji,jj) * umask(ji,jj,1) 
     890               uu_b(ji,jj,Kmm_a) = tabres(ji,jj) * r1_hu_n(ji,jj) * umask(ji,jj,1) 
    891891               !        
    892892               ! Correct "before" velocities to hold correct bt component: 
    893893               spgu(ji,jj) = 0.e0 
    894894               DO jk=1,jpkm1 
    895                   spgu(ji,jj) = spgu(ji,jj) + e3u(ji,jj,jk,Kbb) * uu(ji,jj,jk,Kbb) 
     895                  spgu(ji,jj) = spgu(ji,jj) + e3u(ji,jj,jk,Kbb_a) * uu(ji,jj,jk,Kbb_a) 
    896896               END DO 
    897897               ! 
    898                zcorr = uu_b(ji,jj,Kbb) - spgu(ji,jj) * r1_hu_b(ji,jj) 
     898               zcorr = uu_b(ji,jj,Kbb_a) - spgu(ji,jj) * r1_hu_b(ji,jj) 
    899899               DO jk=1,jpkm1               
    900                   uu(ji,jj,jk,Kbb) = uu(ji,jj,jk,Kbb) + zcorr * umask(ji,jj,jk)            
     900                  uu(ji,jj,jk,Kbb_a) = uu(ji,jj,jk,Kbb_a) + zcorr * umask(ji,jj,jk)            
    901901               END DO 
    902902               ! 
    … …  
    905905         ! 
    906906         IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 
    907             uu_b(i1:i2,j1:j2,Kbb)  = uu_b(i1:i2,j1:j2,Kmm) 
     907            uu_b(i1:i2,j1:j2,Kbb_a)  = uu_b(i1:i2,j1:j2,Kmm_a) 
    908908         ENDIF 
    909909      ENDIF 
    … …  
    928928         DO jj=j1,j2 
    929929            DO ji=i1,i2 
    930                tabres(ji,jj) = zrhox * vv_b(ji,jj,Kmm) * hv_n(ji,jj) * e1v(ji,jj)  
     930               tabres(ji,jj) = zrhox * vv_b(ji,jj,Kmm_a) * hv_n(ji,jj) * e1v(ji,jj)  
    931931            END DO 
    932932         END DO 
    … …  
    939939               spgv(ji,jj) = 0.e0 
    940940               DO jk=1,jpkm1 
    941                   spgv(ji,jj) = spgv(ji,jj) + e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) 
     941                  spgv(ji,jj) = spgv(ji,jj) + e3v(ji,jj,jk,Kmm_a) * vv(ji,jj,jk,Kmm_a) 
    942942               END DO 
    943943               ! 
    944944               zcorr = (tabres(ji,jj) - spgv(ji,jj)) * r1_hv_n(ji,jj) 
    945945               DO jk=1,jpkm1               
    946                   vv(ji,jj,jk,Kmm) = vv(ji,jj,jk,Kmm) + zcorr * vmask(ji,jj,jk)            
     946                  vv(ji,jj,jk,Kmm_a) = vv(ji,jj,jk,Kmm_a) + zcorr * vmask(ji,jj,jk)            
    947947               END DO 
    948948               ! 
    … …  
    950950               IF ( .NOT.ln_dynspg_ts .OR. (ln_dynspg_ts.AND.(.NOT.ln_bt_fw)) ) THEN 
    951951                  IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 
    952                      zcorr = (tabres(ji,jj) - vv_b(ji,jj,Kmm) * hv_a(ji,jj)) * r1_hv_b(ji,jj) 
    953                      vv_b(ji,jj,Kbb) = vv_b(ji,jj,Kbb) + atfp * zcorr * vmask(ji,jj,1) 
     952                     zcorr = (tabres(ji,jj) - vv_b(ji,jj,Kmm_a) * hv_a(ji,jj)) * r1_hv_b(ji,jj) 
     953                     vv_b(ji,jj,Kbb_a) = vv_b(ji,jj,Kbb_a) + atfp * zcorr * vmask(ji,jj,1) 
    954954                  END IF 
    955955               ENDIF               
    956                vv_b(ji,jj,Kmm) = tabres(ji,jj) * r1_hv_n(ji,jj) * vmask(ji,jj,1) 
     956               vv_b(ji,jj,Kmm_a) = tabres(ji,jj) * r1_hv_n(ji,jj) * vmask(ji,jj,1) 
    957957               !        
    958958               ! Correct "before" velocities to hold correct bt component: 
    959959               spgv(ji,jj) = 0.e0 
    960960               DO jk=1,jpkm1 
    961                   spgv(ji,jj) = spgv(ji,jj) + e3v(ji,jj,jk,Kbb) * vv(ji,jj,jk,Kbb) 
     961                  spgv(ji,jj) = spgv(ji,jj) + e3v(ji,jj,jk,Kbb_a) * vv(ji,jj,jk,Kbb_a) 
    962962               END DO 
    963963               ! 
    964                zcorr = vv_b(ji,jj,Kbb) - spgv(ji,jj) * r1_hv_b(ji,jj) 
     964               zcorr = vv_b(ji,jj,Kbb_a) - spgv(ji,jj) * r1_hv_b(ji,jj) 
    965965               DO jk=1,jpkm1               
    966                   vv(ji,jj,jk,Kbb) = vv(ji,jj,jk,Kbb) + zcorr * vmask(ji,jj,jk)            
     966                  vv(ji,jj,jk,Kbb_a) = vv(ji,jj,jk,Kbb_a) + zcorr * vmask(ji,jj,jk)            
    967967               END DO 
    968968               ! 
    … …  
    971971         ! 
    972972         IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 
    973             vv_b(i1:i2,j1:j2,Kbb)  = vv_b(i1:i2,j1:j2,Kmm) 
     973            vv_b(i1:i2,j1:j2,Kbb_a)  = vv_b(i1:i2,j1:j2,Kmm_a) 
    974974         ENDIF 
    975975         ! 
    … …  
    993993         DO jj=j1,j2 
    994994            DO ji=i1,i2 
    995                tabres(ji,jj) = ssh(ji,jj,Kmm) 
     995               tabres(ji,jj) = ssh(ji,jj,Kmm_a) 
    996996            END DO 
    997997         END DO 
    … …  
    10001000            DO jj=j1,j2 
    10011001               DO ji=i1,i2 
    1002                   ssh(ji,jj,Kbb) =   ssh(ji,jj,Kbb) & 
    1003                         & + atfp * ( tabres(ji,jj) - ssh(ji,jj,Kmm) ) * tmask(ji,jj,1) 
     1002                  ssh(ji,jj,Kbb_a) =   ssh(ji,jj,Kbb_a) & 
     1003                        & + atfp * ( tabres(ji,jj) - ssh(ji,jj,Kmm_a) ) * tmask(ji,jj,1) 
    10041004               END DO 
    10051005            END DO 
    … …  
    10081008         DO jj=j1,j2 
    10091009            DO ji=i1,i2 
    1010                ssh(ji,jj,Kmm) = tabres(ji,jj) * tmask(ji,jj,1) 
     1010               ssh(ji,jj,Kmm_a) = tabres(ji,jj) * tmask(ji,jj,1) 
    10111011            END DO 
    10121012         END DO 
    10131013         ! 
    10141014         IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 
    1015             ssh(i1:i2,j1:j2,Kbb)  = ssh(i1:i2,j1:j2,Kmm) 
     1015            ssh(i1:i2,j1:j2,Kbb_a)  = ssh(i1:i2,j1:j2,Kmm_a) 
    10161016         ENDIF 
    10171017         ! 
    … …  
    10941094            DO jj=j1,j2 
    10951095               zcor = rdt * r1_e1e2t(i1  ,jj) * e2u(i1,jj) * (ub2_b(i1,jj)-tabres(i1,jj))  
    1096                ssh(i1  ,jj,Kmm) = ssh(i1  ,jj,Kmm) + zcor 
    1097                IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) ssh(i1  ,jj,Kbb) = ssh(i1  ,jj,Kbb) + atfp * zcor 
     1096               ssh(i1  ,jj,Kmm_a) = ssh(i1  ,jj,Kmm_a) + zcor 
     1097               IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) ssh(i1  ,jj,Kbb_a) = ssh(i1  ,jj,Kbb_a) + atfp * zcor 
    10981098            END DO 
    10991099         ENDIF 
    … …  
    11011101            DO jj=j1,j2 
    11021102               zcor = - rdt * r1_e1e2t(i2+1,jj) * e2u(i2,jj) * (ub2_b(i2,jj)-tabres(i2,jj)) 
    1103                ssh(i2+1,jj,Kmm) = ssh(i2+1,jj,Kmm) + zcor 
    1104                IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) ssh(i2+1,jj,Kbb) = ssh(i2+1,jj,Kbb) + atfp * zcor 
     1103               ssh(i2+1,jj,Kmm_a) = ssh(i2+1,jj,Kmm_a) + zcor 
     1104               IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) ssh(i2+1,jj,Kbb_a) = ssh(i2+1,jj,Kbb_a) + atfp * zcor 
    11051105            END DO 
    11061106         ENDIF 
    … …  
    11821182            DO ji=i1,i2 
    11831183               zcor = rdt * r1_e1e2t(ji,j1  ) * e1v(ji,j1  ) * (vb2_b(ji,j1)-tabres(ji,j1)) 
    1184                ssh(ji,j1  ,Kmm) = ssh(ji,j1  ,Kmm) + zcor 
    1185                IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) ssh(ji,j1  ,Kbb) = ssh(ji,j1,Kbb) + atfp * zcor 
     1184               ssh(ji,j1  ,Kmm_a) = ssh(ji,j1  ,Kmm_a) + zcor 
     1185               IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) ssh(ji,j1  ,Kbb_a) = ssh(ji,j1,Kbb_a) + atfp * zcor 
    11861186            END DO 
    11871187         ENDIF 
    … …  
    11891189            DO ji=i1,i2 
    11901190               zcor = - rdt * r1_e1e2t(ji,j2+1) * e1v(ji,j2  ) * (vb2_b(ji,j2)-tabres(ji,j2)) 
    1191                ssh(ji,j2+1,Kmm) = ssh(ji,j2+1,Kmm) + zcor 
    1192                IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) ssh(ji,j2+1,Kbb) = ssh(ji,j2+1,Kbb) + atfp * zcor 
     1191               ssh(ji,j2+1,Kmm_a) = ssh(ji,j2+1,Kmm_a) + zcor 
     1192               IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) ssh(ji,j2+1,Kbb_a) = ssh(ji,j2+1,Kbb_a) + atfp * zcor 
    11931193            END DO 
    11941194         ENDIF 
    … …  
    13191319            DO jj=j1,j2 
    13201320               DO ji=i1,i2 
    1321                   ptab(ji,jj,jk) = e3t_0(ji,jj,jk) * (1._wp + ssh(ji,jj,Kmm) & 
     1321                  ptab(ji,jj,jk) = e3t_0(ji,jj,jk) * (1._wp + ssh(ji,jj,Kmm_a) & 
    13221322                                     & *ssmask(ji,jj)/(ht_0(ji,jj)-1._wp + ssmask(ji,jj))) 
    13231323               END DO 
    … …  
    13301330         ! Save "old" scale factor (prior update) for subsequent asselin correction 
    13311331         ! of prognostic variables 
    1332          e3t(i1:i2,j1:j2,1:jpkm1,Krhs) = e3t(i1:i2,j1:j2,1:jpkm1,Kmm) 
    1333  
    1334          ! One should also save e3t(:,:,:,Kbb), but lacking of workspace... 
    1335 !         hdiv(i1:i2,j1:j2,1:jpkm1)   = e3t(i1:i2,j1:j2,1:jpkm1,Kbb) 
     1332         e3t(i1:i2,j1:j2,1:jpkm1,Krhs_a) = e3t(i1:i2,j1:j2,1:jpkm1,Kmm_a) 
     1333 
     1334         ! One should also save e3t(:,:,:,Kbb_a), but lacking of workspace... 
     1335!         hdiv(i1:i2,j1:j2,1:jpkm1)   = e3t(i1:i2,j1:j2,1:jpkm1,Kbb_a) 
    13361336 
    13371337         IF (.NOT.(lk_agrif_fstep.AND.(neuler==0) )) THEN 
    … …  
    13391339               DO jj=j1,j2 
    13401340                  DO ji=i1,i2 
    1341                      e3t(ji,jj,jk,Kbb) =  e3t(ji,jj,jk,Kbb) & 
    1342                            & + atfp * ( ptab(ji,jj,jk) - e3t(ji,jj,jk,Kmm) ) 
     1341                     e3t(ji,jj,jk,Kbb_a) =  e3t(ji,jj,jk,Kbb_a) & 
     1342                           & + atfp * ( ptab(ji,jj,jk) - e3t(ji,jj,jk,Kmm_a) ) 
    13431343                  END DO 
    13441344               END DO 
    13451345            END DO 
    13461346            ! 
    1347             e3w  (i1:i2,j1:j2,1,Kbb) = e3w_0(i1:i2,j1:j2,1) + e3t(i1:i2,j1:j2,1,Kbb) - e3t_0(i1:i2,j1:j2,1) 
    1348             gdepw(i1:i2,j1:j2,1,Kbb) = 0.0_wp 
    1349             gdept(i1:i2,j1:j2,1,Kbb) = 0.5_wp * e3w(i1:i2,j1:j2,1,Kbb) 
     1347            e3w  (i1:i2,j1:j2,1,Kbb_a) = e3w_0(i1:i2,j1:j2,1) + e3t(i1:i2,j1:j2,1,Kbb_a) - e3t_0(i1:i2,j1:j2,1) 
     1348            gdepw(i1:i2,j1:j2,1,Kbb_a) = 0.0_wp 
     1349            gdept(i1:i2,j1:j2,1,Kbb_a) = 0.5_wp * e3w(i1:i2,j1:j2,1,Kbb_a) 
    13501350            ! 
    13511351            DO jk = 2, jpk 
    … …  
    13531353                  DO ji = i1,i2             
    13541354                     zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) 
    1355                      e3w(ji,jj,jk,Kbb)  = e3w_0(ji,jj,jk) + ( 1.0_wp - 0.5_wp * tmask(ji,jj,jk) ) *        &  
    1356                      &                                        ( e3t(ji,jj,jk-1,Kbb) - e3t_0(ji,jj,jk-1) )  & 
     1355                     e3w(ji,jj,jk,Kbb_a)  = e3w_0(ji,jj,jk) + ( 1.0_wp - 0.5_wp * tmask(ji,jj,jk) ) *        &  
     1356                     &                                        ( e3t(ji,jj,jk-1,Kbb_a) - e3t_0(ji,jj,jk-1) )  & 
    13571357                     &                                  +            0.5_wp * tmask(ji,jj,jk)   *        & 
    1358                      &                                        ( e3t(ji,jj,jk  ,Kbb) - e3t_0(ji,jj,jk  ) ) 
    1359                      gdepw(ji,jj,jk,Kbb) = gdepw(ji,jj,jk-1,Kbb) + e3t(ji,jj,jk-1,Kbb) 
    1360                      gdept(ji,jj,jk,Kbb) =      zcoef  * ( gdepw(ji,jj,jk  ,Kbb) + 0.5 * e3w(ji,jj,jk,Kbb))  & 
    1361                          &               + (1-zcoef) * ( gdept(ji,jj,jk-1,Kbb) +       e3w(ji,jj,jk,Kbb))  
     1358                     &                                        ( e3t(ji,jj,jk  ,Kbb_a) - e3t_0(ji,jj,jk  ) ) 
     1359                     gdepw(ji,jj,jk,Kbb_a) = gdepw(ji,jj,jk-1,Kbb_a) + e3t(ji,jj,jk-1,Kbb_a) 
     1360                     gdept(ji,jj,jk,Kbb_a) =      zcoef  * ( gdepw(ji,jj,jk  ,Kbb_a) + 0.5 * e3w(ji,jj,jk,Kbb_a))  & 
     1361                         &               + (1-zcoef) * ( gdept(ji,jj,jk-1,Kbb_a) +       e3w(ji,jj,jk,Kbb_a))  
    13621362                  END DO 
    13631363               END DO 
    … …  
    13701370         ! 
    13711371         ! Update vertical scale factor at T-points: 
    1372          e3t(i1:i2,j1:j2,1:jpkm1,Kmm) = ptab(i1:i2,j1:j2,1:jpkm1) 
     1372         e3t(i1:i2,j1:j2,1:jpkm1,Kmm_a) = ptab(i1:i2,j1:j2,1:jpkm1) 
    13731373         ! 
    13741374         ! Update total depth: 
    13751375         ht_n(i1:i2,j1:j2) = 0._wp 
    13761376         DO jk = 1, jpkm1 
    1377             ht_n(i1:i2,j1:j2) = ht_n(i1:i2,j1:j2) + e3t(i1:i2,j1:j2,jk,Kmm) * tmask(i1:i2,j1:j2,jk) 
     1377            ht_n(i1:i2,j1:j2) = ht_n(i1:i2,j1:j2) + e3t(i1:i2,j1:j2,jk,Kmm_a) * tmask(i1:i2,j1:j2,jk) 
    13781378         END DO 
    13791379         ! 
    13801380         ! Update vertical scale factor at W-points and depths: 
    1381          e3w (i1:i2,j1:j2,1,Kmm) = e3w_0(i1:i2,j1:j2,1) + e3t(i1:i2,j1:j2,1,Kmm) - e3t_0(i1:i2,j1:j2,1) 
    1382          gdept(i1:i2,j1:j2,1,Kmm) = 0.5_wp * e3w(i1:i2,j1:j2,1,Kmm) 
    1383          gdepw(i1:i2,j1:j2,1,Kmm) = 0.0_wp 
    1384          gde3w(i1:i2,j1:j2,1) = gdept(i1:i2,j1:j2,1,Kmm) - (ht_n(i1:i2,j1:j2)-ht_0(i1:i2,j1:j2)) ! Last term in the rhs is ssh 
     1381         e3w (i1:i2,j1:j2,1,Kmm_a) = e3w_0(i1:i2,j1:j2,1) + e3t(i1:i2,j1:j2,1,Kmm_a) - e3t_0(i1:i2,j1:j2,1) 
     1382         gdept(i1:i2,j1:j2,1,Kmm_a) = 0.5_wp * e3w(i1:i2,j1:j2,1,Kmm_a) 
     1383         gdepw(i1:i2,j1:j2,1,Kmm_a) = 0.0_wp 
     1384         gde3w(i1:i2,j1:j2,1) = gdept(i1:i2,j1:j2,1,Kmm_a) - (ht_n(i1:i2,j1:j2)-ht_0(i1:i2,j1:j2)) ! Last term in the rhs is ssh 
    13851385         ! 
    13861386         DO jk = 2, jpk 
    … …  
    13881388               DO ji = i1,i2             
    13891389               zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) 
    1390                e3w(ji,jj,jk,Kmm)  = e3w_0(ji,jj,jk) + ( 1.0_wp - 0.5_wp * tmask(ji,jj,jk) ) * ( e3t(ji,jj,jk-1,Kmm) - e3t_0(ji,jj,jk-1) )   & 
    1391                &                                  +            0.5_wp * tmask(ji,jj,jk)   * ( e3t(ji,jj,jk  ,Kmm) - e3t_0(ji,jj,jk  ) ) 
    1392                gdepw(ji,jj,jk,Kmm) = gdepw(ji,jj,jk-1,Kmm) + e3t(ji,jj,jk-1,Kmm) 
    1393                gdept(ji,jj,jk,Kmm) =      zcoef  * ( gdepw(ji,jj,jk  ,Kmm) + 0.5 * e3w(ji,jj,jk,Kmm))  & 
    1394                    &               + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm) +       e3w(ji,jj,jk,Kmm))  
    1395                gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm) - (ht_n(ji,jj)-ht_0(ji,jj)) ! Last term in the rhs is ssh 
     1390               e3w(ji,jj,jk,Kmm_a)  = e3w_0(ji,jj,jk) + ( 1.0_wp - 0.5_wp * tmask(ji,jj,jk) ) * ( e3t(ji,jj,jk-1,Kmm_a) - e3t_0(ji,jj,jk-1) )   & 
     1391               &                                  +            0.5_wp * tmask(ji,jj,jk)   * ( e3t(ji,jj,jk  ,Kmm_a) - e3t_0(ji,jj,jk  ) ) 
     1392               gdepw(ji,jj,jk,Kmm_a) = gdepw(ji,jj,jk-1,Kmm_a) + e3t(ji,jj,jk-1,Kmm_a) 
     1393               gdept(ji,jj,jk,Kmm_a) =      zcoef  * ( gdepw(ji,jj,jk  ,Kmm_a) + 0.5 * e3w(ji,jj,jk,Kmm_a))  & 
     1394                   &               + (1-zcoef) * ( gdept(ji,jj,jk-1,Kmm_a) +       e3w(ji,jj,jk,Kmm_a))  
     1395               gde3w(ji,jj,jk) = gdept(ji,jj,jk,Kmm_a) - (ht_n(ji,jj)-ht_0(ji,jj)) ! Last term in the rhs is ssh 
    13961396               END DO 
    13971397            END DO 
    … …  
    13991399         ! 
    14001400         IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 
    1401             e3t (i1:i2,j1:j2,1:jpk,Kbb)  = e3t (i1:i2,j1:j2,1:jpk,Kmm) 
    1402             e3w (i1:i2,j1:j2,1:jpk,Kbb)  = e3w (i1:i2,j1:j2,1:jpk,Kmm) 
    1403             gdepw(i1:i2,j1:j2,1:jpk,Kbb) = gdepw(i1:i2,j1:j2,1:jpk,Kmm) 
    1404             gdept(i1:i2,j1:j2,1:jpk,Kbb) = gdept(i1:i2,j1:j2,1:jpk,Kmm) 
     1401            e3t (i1:i2,j1:j2,1:jpk,Kbb_a)  = e3t (i1:i2,j1:j2,1:jpk,Kmm_a) 
     1402            e3w (i1:i2,j1:j2,1:jpk,Kbb_a)  = e3w (i1:i2,j1:j2,1:jpk,Kmm_a) 
     1403            gdepw(i1:i2,j1:j2,1:jpk,Kbb_a) = gdepw(i1:i2,j1:j2,1:jpk,Kmm_a) 
     1404            gdept(i1:i2,j1:j2,1:jpk,Kbb_a) = gdept(i1:i2,j1:j2,1:jpk,Kmm_a) 
    14051405         ENDIF 
    14061406         ! 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/NST/agrif_top_interp.F90

    r10989 r11053  
    7373               DO jj=j1,j2 
    7474                 DO ji=i1,i2 
    75                        ptab(ji,jj,jk,jn) = tr(ji,jj,jk,jn,Kmm) 
     75                       ptab(ji,jj,jk,jn) = tr(ji,jj,jk,jn,Kmm_a) 
    7676                 END DO 
    7777              END DO 
    … …  
    8383           DO jj=j1,j2 
    8484              DO ji=i1,i2 
    85                  ptab(ji,jj,jk,jptra+1) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kmm)  
     85                 ptab(ji,jj,jk,jptra+1) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kmm_a)  
    8686              END DO 
    8787           END DO 
    … …  
    113113                  IF (tmask(iref,jref,jk) == 0) EXIT  
    114114                  N_out = N_out + 1 
    115                   h_out(jk) = e3t(iref,jref,jk,Kmm) 
     115                  h_out(jk) = e3t(iref,jref,jk,Kmm_a) 
    116116               ENDDO 
    117117               IF (N_in > 0) THEN 
    … …  
    127127         ! 
    128128         DO jn=1, jptra 
    129             tr(i1:i2,j1:j2,1:jpk,jn,Krhs)=ptab_child(i1:i2,j1:j2,1:jpk,jn)*tmask(i1:i2,j1:j2,1:jpk)  
     129            tr(i1:i2,j1:j2,1:jpk,jn,Krhs_a)=ptab_child(i1:i2,j1:j2,1:jpk,jn)*tmask(i1:i2,j1:j2,1:jpk)  
    130130         END DO 
    131131 
    … …  
    151151               ibdy = nlci-nbghostcells 
    152152               DO jn = 1, jptra 
    153                   tr(ibdy+1,jmin:jmax,1:jpkm1,jn,Krhs) = z1 * ptab_child(ibdy+1,jmin:jmax,1:jpkm1,jn) + z2 * ptab_child(ibdy,jmin:jmax,1:jpkm1,jn) 
     153                  tr(ibdy+1,jmin:jmax,1:jpkm1,jn,Krhs_a) = z1 * ptab_child(ibdy+1,jmin:jmax,1:jpkm1,jn) + z2 * ptab_child(ibdy,jmin:jmax,1:jpkm1,jn) 
    154154                  DO jk = 1, jpkm1 
    155155                     DO jj = jmin,jmax 
    156156                        IF( umask(ibdy-1,jj,jk) == 0._wp ) THEN 
    157                            tr(ibdy,jj,jk,jn,Krhs) = tr(ibdy+1,jj,jk,jn,Krhs) * tmask(ibdy,jj,jk) 
    158                         ELSE 
    159                            tr(ibdy,jj,jk,jn,Krhs)=(z4*tr(ibdy+1,jj,jk,jn,Krhs)+z3*tr(ibdy-1,jj,jk,jn,Krhs))*tmask(ibdy,jj,jk) 
    160                            IF( uu(ibdy-1,jj,jk,Kmm) > 0._wp ) THEN 
    161                               tr(ibdy,jj,jk,jn,Krhs)=( z6*tr(ibdy-1,jj,jk,jn,Krhs)+z5*tr(ibdy+1,jj,jk,jn,Krhs) &  
    162                                                  + z7*tr(ibdy-2,jj,jk,jn,Krhs) ) * tmask(ibdy,jj,jk) 
    163                            ENDIF 
    164                         ENDIF 
    165                      END DO 
    166                   END DO 
    167                   ! Restore ghost points: 
    168                   tr(ibdy+1,jmin:jmax,1:jpkm1,jn,Krhs) = ptab_child(ibdy+1,jmin:jmax,1:jpkm1,jn) * tmask(ibdy+1,jmin:jmax,1:jpkm1) 
     157                           tr(ibdy,jj,jk,jn,Krhs_a) = tr(ibdy+1,jj,jk,jn,Krhs_a) * tmask(ibdy,jj,jk) 
     158                        ELSE 
     159                           tr(ibdy,jj,jk,jn,Krhs_a)=(z4*tr(ibdy+1,jj,jk,jn,Krhs_a)+z3*tr(ibdy-1,jj,jk,jn,Krhs_a))*tmask(ibdy,jj,jk) 
     160                           IF( uu(ibdy-1,jj,jk,Kmm_a) > 0._wp ) THEN 
     161                              tr(ibdy,jj,jk,jn,Krhs_a)=( z6*tr(ibdy-1,jj,jk,jn,Krhs_a)+z5*tr(ibdy+1,jj,jk,jn,Krhs_a) &  
     162                                                 + z7*tr(ibdy-2,jj,jk,jn,Krhs_a) ) * tmask(ibdy,jj,jk) 
     163                           ENDIF 
     164                        ENDIF 
     165                     END DO 
     166                  END DO 
     167                  ! Restore ghost points: 
     168                  tr(ibdy+1,jmin:jmax,1:jpkm1,jn,Krhs_a) = ptab_child(ibdy+1,jmin:jmax,1:jpkm1,jn) * tmask(ibdy+1,jmin:jmax,1:jpkm1) 
    169169               END DO 
    170170            ENDIF 
    … …  
    180180               jbdy = nlcj-nbghostcells          
    181181               DO jn = 1, jptra 
    182                   tr(imin:imax,jbdy+1,1:jpkm1,jn,Krhs) = z1 * ptab_child(imin:imax,jbdy+1,1:jpkm1,jn) + z2 * ptab_child(imin:imax,jbdy,1:jpkm1,jn) 
     182                  tr(imin:imax,jbdy+1,1:jpkm1,jn,Krhs_a) = z1 * ptab_child(imin:imax,jbdy+1,1:jpkm1,jn) + z2 * ptab_child(imin:imax,jbdy,1:jpkm1,jn) 
    183183                  DO jk = 1, jpkm1 
    184184                     DO ji = imin,imax 
    185185                        IF( vmask(ji,jbdy-1,jk) == 0._wp ) THEN 
    186                            tr(ji,jbdy,jk,jn,Krhs) = tr(ji,jbdy+1,jk,jn,Krhs) * tmask(ji,jbdy,jk) 
    187                         ELSE 
    188                            tr(ji,jbdy,jk,jn,Krhs)=(z4*tr(ji,jbdy+1,jk,jn,Krhs)+z3*tr(ji,jbdy-1,jk,jn,Krhs))*tmask(ji,jbdy,jk)         
    189                            IF (vv(ji,jbdy-1,jk,Kmm) > 0._wp ) THEN 
    190                               tr(ji,jbdy,jk,jn,Krhs)=( z6*tr(ji,jbdy-1,jk,jn,Krhs)+z5*tr(ji,jbdy+1,jk,jn,Krhs)  & 
    191                                                  + z7*tr(ji,jbdy-2,jk,jn,Krhs) ) * tmask(ji,jbdy,jk) 
    192                            ENDIF 
    193                         ENDIF 
    194                      END DO 
    195                   END DO 
    196                   ! Restore ghost points: 
    197                   tr(imin:imax,jbdy+1,1:jpkm1,jn,Krhs) = ptab_child(imin:imax,jbdy+1,1:jpkm1,jn) * tmask(imin:imax,jbdy+1,1:jpkm1) 
     186                           tr(ji,jbdy,jk,jn,Krhs_a) = tr(ji,jbdy+1,jk,jn,Krhs_a) * tmask(ji,jbdy,jk) 
     187                        ELSE 
     188                           tr(ji,jbdy,jk,jn,Krhs_a)=(z4*tr(ji,jbdy+1,jk,jn,Krhs_a)+z3*tr(ji,jbdy-1,jk,jn,Krhs_a))*tmask(ji,jbdy,jk)         
     189                           IF (vv(ji,jbdy-1,jk,Kmm_a) > 0._wp ) THEN 
     190                              tr(ji,jbdy,jk,jn,Krhs_a)=( z6*tr(ji,jbdy-1,jk,jn,Krhs_a)+z5*tr(ji,jbdy+1,jk,jn,Krhs_a)  & 
     191                                                 + z7*tr(ji,jbdy-2,jk,jn,Krhs_a) ) * tmask(ji,jbdy,jk) 
     192                           ENDIF 
     193                        ENDIF 
     194                     END DO 
     195                  END DO 
     196                  ! Restore ghost points: 
     197                  tr(imin:imax,jbdy+1,1:jpkm1,jn,Krhs_a) = ptab_child(imin:imax,jbdy+1,1:jpkm1,jn) * tmask(imin:imax,jbdy+1,1:jpkm1) 
    198198               END DO 
    199199            ENDIF 
    … …  
    209209               ibdy = 1+nbghostcells        
    210210               DO jn = 1, jptra 
    211                   tr(ibdy-1,jmin:jmax,1:jpkm1,jn,Krhs) = z1 * ptab_child(ibdy-1,jmin:jmax,1:jpkm1,jn) + z2 * ptab_child(ibdy,jmin:jmax,1:jpkm1,jn) 
     211                  tr(ibdy-1,jmin:jmax,1:jpkm1,jn,Krhs_a) = z1 * ptab_child(ibdy-1,jmin:jmax,1:jpkm1,jn) + z2 * ptab_child(ibdy,jmin:jmax,1:jpkm1,jn) 
    212212                  DO jk = 1, jpkm1 
    213213                     DO jj = jmin,jmax 
    214214                        IF( umask(ibdy,jj,jk) == 0._wp ) THEN 
    215                            tr(ibdy,jj,jk,jn,Krhs) = tr(ibdy-1,jj,jk,jn,Krhs) * tmask(ibdy,jj,jk) 
    216                         ELSE 
    217                            tr(ibdy,jj,jk,jn,Krhs)=(z4*tr(ibdy-1,jj,jk,jn,Krhs)+z3*tr(ibdy+1,jj,jk,jn,Krhs))*tmask(ibdy,jj,jk)         
    218                            IF( uu(ibdy,jj,jk,Kmm) < 0._wp ) THEN 
    219                               tr(ibdy,jj,jk,jn,Krhs)=( z6*tr(ibdy+1,jj,jk,jn,Krhs)+z5*tr(ibdy-1,jj,jk,jn,Krhs) & 
    220                                                  + z7*tr(ibdy+2,jj,jk,jn,Krhs) ) * tmask(ibdy,jj,jk) 
    221                            ENDIF 
    222                         ENDIF 
    223                      END DO 
    224                   END DO 
    225                   ! Restore ghost points: 
    226                   tr(ibdy-1,jmin:jmax,1:jpkm1,jn,Krhs) = ptab_child(ibdy-1,jmin:jmax,1:jpkm1,jn) * tmask(ibdy-1,jmin:jmax,1:jpkm1) 
     215                           tr(ibdy,jj,jk,jn,Krhs_a) = tr(ibdy-1,jj,jk,jn,Krhs_a) * tmask(ibdy,jj,jk) 
     216                        ELSE 
     217                           tr(ibdy,jj,jk,jn,Krhs_a)=(z4*tr(ibdy-1,jj,jk,jn,Krhs_a)+z3*tr(ibdy+1,jj,jk,jn,Krhs_a))*tmask(ibdy,jj,jk)         
     218                           IF( uu(ibdy,jj,jk,Kmm_a) < 0._wp ) THEN 
     219                              tr(ibdy,jj,jk,jn,Krhs_a)=( z6*tr(ibdy+1,jj,jk,jn,Krhs_a)+z5*tr(ibdy-1,jj,jk,jn,Krhs_a) & 
     220                                                 + z7*tr(ibdy+2,jj,jk,jn,Krhs_a) ) * tmask(ibdy,jj,jk) 
     221                           ENDIF 
     222                        ENDIF 
     223                     END DO 
     224                  END DO 
     225                  ! Restore ghost points: 
     226                  tr(ibdy-1,jmin:jmax,1:jpkm1,jn,Krhs_a) = ptab_child(ibdy-1,jmin:jmax,1:jpkm1,jn) * tmask(ibdy-1,jmin:jmax,1:jpkm1) 
    227227               END DO 
    228228            ENDIF 
    … …  
    238238               jbdy=1+nbghostcells         
    239239               DO jn = 1, jptra 
    240                   tr(imin:imax,jbdy-1,1:jpkm1,jn,Krhs) = z1 * ptab_child(imin:imax,jbdy-1,1:jpkm1,jn) + z2 * ptab_child(imin:imax,jbdy,1:jpkm1,jn) 
     240                  tr(imin:imax,jbdy-1,1:jpkm1,jn,Krhs_a) = z1 * ptab_child(imin:imax,jbdy-1,1:jpkm1,jn) + z2 * ptab_child(imin:imax,jbdy,1:jpkm1,jn) 
    241241                  DO jk = 1, jpkm1       
    242242                     DO ji = imin,imax 
    243243                        IF( vmask(ji,jbdy,jk) == 0._wp ) THEN 
    244                            tr(ji,jbdy,jk,jn,Krhs)=tr(ji,jbdy-1,jk,jn,Krhs) * tmask(ji,jbdy,jk) 
    245                         ELSE 
    246                            tr(ji,jbdy,jk,jn,Krhs)=(z4*tr(ji,jbdy-1,jk,jn,Krhs)+z3*tr(ji,jbdy+1,jk,jn,Krhs))*tmask(ji,jbdy,jk) 
    247                            IF( vv(ji,jbdy,jk,Kmm) < 0._wp ) THEN 
    248                               tr(ji,jbdy,jk,jn,Krhs)=( z6*tr(ji,jbdy+1,jk,jn,Krhs)+z5*tr(ji,jbdy-1,jk,jn,Krhs) &  
    249                                                  + z7*tr(ji,jbdy+2,jk,jn,Krhs) ) * tmask(ji,jbdy,jk) 
    250                            ENDIF 
    251                         ENDIF 
    252                      END DO 
    253                   END DO 
    254                   ! Restore ghost points: 
    255                   tr(imin:imax,jbdy-1,1:jpkm1,jn,Krhs) = ptab_child(imin:imax,jbdy-1,1:jpkm1,jn) * tmask(imin:imax,jbdy-1,1:jpkm1) 
     244                           tr(ji,jbdy,jk,jn,Krhs_a)=tr(ji,jbdy-1,jk,jn,Krhs_a) * tmask(ji,jbdy,jk) 
     245                        ELSE 
     246                           tr(ji,jbdy,jk,jn,Krhs_a)=(z4*tr(ji,jbdy-1,jk,jn,Krhs_a)+z3*tr(ji,jbdy+1,jk,jn,Krhs_a))*tmask(ji,jbdy,jk) 
     247                           IF( vv(ji,jbdy,jk,Kmm_a) < 0._wp ) THEN 
     248                              tr(ji,jbdy,jk,jn,Krhs_a)=( z6*tr(ji,jbdy+1,jk,jn,Krhs_a)+z5*tr(ji,jbdy-1,jk,jn,Krhs_a) &  
     249                                                 + z7*tr(ji,jbdy+2,jk,jn,Krhs_a) ) * tmask(ji,jbdy,jk) 
     250                           ENDIF 
     251                        ENDIF 
     252                     END DO 
     253                  END DO 
     254                  ! Restore ghost points: 
     255                  tr(imin:imax,jbdy-1,1:jpkm1,jn,Krhs_a) = ptab_child(imin:imax,jbdy-1,1:jpkm1,jn) * tmask(imin:imax,jbdy-1,1:jpkm1) 
    256256               END DO 
    257257            ENDIF 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/NST/agrif_user.F90

    r10989 r11053  
    5353   ! 
    5454   CALL nemo_init       !* Initializations of each fine grid 
     55   Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs   ! agrif_oce module copies of time level indices 
    5556 
    5657   !                    !* Agrif initialization 
    … …  
    175176   tabspongedone_tsn = .FALSE. 
    176177   CALL Agrif_Bc_variable(tsn_sponge_id,calledweight=1.,procname=interptsn_sponge) 
    177    ! reset ts(:,:,:,:,Krhs) to zero 
    178    ts(:,:,:,:,Krhs) = 0. 
     178   ! reset ts(:,:,:,:,Krhs_a) to zero 
     179   ts(:,:,:,:,Krhs_a) = 0. 
    179180 
    180181   Agrif_UseSpecialValue = ln_spc_dyn 
    … …  
    191192   CALL Agrif_Bc_variable(sshn_id,calledweight=1., procname=interpsshn ) 
    192193   hbdy_w(:,:) = 0.e0 ; hbdy_e(:,:) = 0.e0 ; hbdy_n(:,:) = 0.e0 ; hbdy_s(:,:) = 0.e0 
    193    ssh(:,:,Krhs) = 0.e0 
     194   ssh(:,:,Krhs_a) = 0.e0 
    194195 
    195196   IF ( ln_dynspg_ts ) THEN 
    … …  
    207208   Agrif_UseSpecialValue = .FALSE.  
    208209   ! reset velocities to zero 
    209    uu(:,:,:,Krhs) = 0. 
    210    vv(:,:,:,Krhs) = 0. 
     210   uu(:,:,:,Krhs_a) = 0. 
     211   vv(:,:,:,Krhs_a) = 0. 
    211212 
    212213   ! 3. Some controls 
    … …  
    591592   tabspongedone_trn = .FALSE. 
    592593   CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge) 
    593    ! reset ts(:,:,:,:,Krhs) to zero 
    594    tr(:,:,:,:,Krhs) = 0. 
     594   ! reset ts(:,:,:,:,Krhs_a) to zero 
     595   tr(:,:,:,:,Krhs_a) = 0. 
    595596 
    596597 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/BDY/bdydta.F90

    r10957 r11053  
    255255                  CALL fld_read( kt=kt, kn_fsbc=1, sd=bf(jstart:jend), & 
    256256                       & map=nbmap_ptr(jstart:jend), kt_offset=time_offset, jpk_bdy=nb_jpk_bdy,   & 
    257                        & fvl=ln_full_vel_array(jbdy) ) 
     257                       & fvl=ln_full_vel_array(jbdy), Kmm=Kmm ) 
    258258               ENDIF 
    259259               ! If full velocities in boundary data then split into barotropic and baroclinic data 
    … …  
    270270                             &                       + e3u(ii,ij,ik,Kmm) * umask(ii,ij,ik) * dta%u3d(ib,ik) 
    271271                     END DO 
    272                      dta%u2d(ib) =  dta%u2d(ib) * r1_hu_n(ii,ij) 
     272                     dta%u2d(ib) =  dta%u2d(ib) * r1_hu(ii,ij,Kmm) 
    273273                     DO ik = 1, jpkm1 
    274274                        dta%u3d(ib,ik) = dta%u3d(ib,ik) - dta%u2d(ib) 
    … …  
    284284                             &                       + e3v(ii,ij,ik,Kmm) * vmask(ii,ij,ik) * dta%v3d(ib,ik) 
    285285                     END DO 
    286                      dta%v2d(ib) =  dta%v2d(ib) * r1_hv_n(ii,ij) 
     286                     dta%v2d(ib) =  dta%v2d(ib) * r1_hv(ii,ij,Kmm) 
    287287                     DO ik = 1, jpkm1 
    288288                        dta%v3d(ib,ik) = dta%v3d(ib,ik) - dta%v2d(ib) 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/BDY/bdydyn.F90

    r10957 r11053  
    7878         zva2d(:,:) = zva2d(:,:) + e3v(:,:,jk,Kaa) * pvv(:,:,jk,Kaa) * vmask(:,:,jk) 
    7979      END DO 
    80       zua2d(:,:) = zua2d(:,:) * r1_hu_a(:,:) 
    81       zva2d(:,:) = zva2d(:,:) * r1_hv_a(:,:) 
     80      zua2d(:,:) = zua2d(:,:) * r1_hu(:,:,Kaa) 
     81      zva2d(:,:) = zva2d(:,:) * r1_hv(:,:,Kaa) 
    8282 
    8383      DO jk = 1 , jpkm1 
    … …  
    9999      !------------------------------------------------------- 
    100100 
    101       IF( ll_dyn2d )   CALL bdy_dyn2d( kt, zua2d, zva2d, uu_b(:,:,Kbb), vv_b(:,:,Kbb), r1_hu_a(:,:), r1_hv_a(:,:), ssh(:,:,Kaa) ) 
     101      IF( ll_dyn2d )   CALL bdy_dyn2d( kt, zua2d, zva2d, uu_b(:,:,Kbb), vv_b(:,:,Kbb), r1_hu(:,:,Kaa), r1_hv(:,:,Kaa), ssh(:,:,Kaa) ) 
    102102 
    103103      IF( ll_dyn3d )   CALL bdy_dyn3d( kt, Kbb, puu, pvv, Kaa ) 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/DIA/diawri.F90

    r10989 r11053  
    138138 
    139139      IF( ll_wd ) THEN 
    140          CALL iom_put( "ssh" , (sshn+ssh_ref)*tmask(:,:,1) )   ! sea surface height (brought back to the reference used for wetting and drying) 
     140         CALL iom_put( "ssh" , (ssh(:,:,Kmm)+ssh_ref)*tmask(:,:,1) )   ! sea surface height (brought back to the reference used for wetting and drying) 
    141141      ELSE 
    142142         CALL iom_put( "ssh" , ssh(:,:,Kmm) )              ! sea surface height 

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

    r11050 r11053  
    121121   REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   e1e2f , r1_e1e2f                !: associated metrics at f-point 
    122122   ! 
    123    REAL(wp), PUBLIC, ALLOCATABLE, SAVE        , DIMENSION(:,:) ::   ff_f  , ff_t                    !: Coriolis factor at f- & t-points  [1/s] 
     123   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   ff_f  , ff_t                    !: Coriolis factor at f- & t-points  [1/s] 
    124124   !!---------------------------------------------------------------------- 
    125125   !! vertical coordinate and scale factors 
    … …  
    138138   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::    e3vw_0   !: vw-vert. scale factor [m] 
    139139   !                                                        !  time-dependent scale factors 
    140    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:,:,:) ::   e3t, e3u, e3v, e3w, e3uw, e3vw  !: vert. scale factor [m] 
    141    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:,:) ::     e3f                             !: F-point vert. scale factor [m] 
     140   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   e3t, e3u, e3v, e3w, e3uw, e3vw  !: vert. scale factor [m] 
     141   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   e3f                             !: F-point vert. scale factor [m] 
    142142 
    143143   !                                                        !  reference depths of cells 
    … …  
    146146   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   gde3w_0  !: w- depth (sum of e3w) [m] 
    147147   !                                                        !  time-dependent depths of cells 
    148    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:,:,:) ::  gdept, gdepw   
    149    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:,:)   ::  gde3w   
     148   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::  gdept, gdepw   
     149   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::  gde3w   
    150150    
    151151   !                                                      !  reference heights of water column 
    … …  
    154154   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::   hv_0  !: v-depth              [m] 
    155155                                                          ! time-dependent heights of water column 
    156    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:)   ::   ht                     !: height of water column at T-points [m] 
    157    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, TARGET, DIMENSION(:,:,:) ::   hu, hv, r1_hu, r1_hv   !: height of water column [m] and reciprocal [1/m] 
    158  
    159    !! TEMPORARY POINTERS FOR DEVELOPMENT ONLY 
    160    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:) ::     e3t_b ,   e3t_n ,  e3t_a   !: t- vert. scale factor [m] 
    161    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:) ::     e3u_b ,   e3u_n ,  e3u_a   !: u- vert. scale factor [m] 
    162    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:) ::     e3v_b ,   e3v_n ,  e3v_a   !: v- vert. scale factor [m] 
    163    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:) ::               e3f_n            !: f- vert. scale factor [m] 
    164    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:) ::     e3w_b ,   e3w_n            !: w- vert. scale factor [m] 
    165    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:) ::    e3uw_b ,  e3uw_n            !: uw-vert. scale factor [m] 
    166    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:) ::    e3vw_b ,  e3vw_n            !: vw-vert. scale factor [m] 
    167    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:) ::    gdept_b , gdept_n           !: t- depth              [m]     
    168    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:) ::    gdepw_b , gdepw_n           !: w- depth              [m] 
    169    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:) ::    gde3w_n                     !: w- depth (sum of e3w) [m] 
    170    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:)   ::              ht_n              !: t-depth              [m] 
    171    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:)   ::    hu_b ,    hu_n ,    hu_a    !: u-depth              [m] 
    172    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:)   ::    hv_b ,    hv_n ,    hv_a    !: v-depth              [m] 
    173    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:)   :: r1_hu_b , r1_hu_n , r1_hu_a    !: inverse of u-depth [1/m] 
    174    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:)   :: r1_hv_b , r1_hv_n , r1_hv_a    !: inverse of v-depth [1/m] 
    175    !! TEMPORARY POINTERS FOR DEVELOPMENT ONLY 
     156   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   ht                     !: height of water column at T-points [m] 
     157   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   hu, hv, r1_hu, r1_hv   !: height of water column [m] and reciprocal [1/m] 
    176158 
    177159   INTEGER, PUBLIC ::   nla10              !: deepest    W level Above  ~10m (nlb10 - 1) 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/DOM/domain.F90

    r10978 r11053  
    179179         ! 
    180180         !        before       !          now          !       after         ! 
    181                                       ht_n =    ht_0   !                     ! water column thickness 
    182                hu_b =    hu_0  ;      hu_n =    hu_0   ;    hu_a =    hu_0   !  
    183                hv_b =    hv_0  ;      hv_n =    hv_0   ;    hv_a =    hv_0   ! 
    184             r1_hu_b = z1_hu_0  ;   r1_hu_n = z1_hu_0   ; r1_hu_a = z1_hu_0   ! inverse of water column thickness 
    185             r1_hv_b = z1_hv_0  ;   r1_hv_n = z1_hv_0   ; r1_hv_a = z1_hv_0   ! 
     181                                      ht =    ht_0   !                     ! water column thickness 
     182               hu(:,:,Kbb) =    hu_0  ;      hu(:,:,Kmm) =    hu_0   ;    hu(:,:,Kaa) =    hu_0   !  
     183               hv(:,:,Kbb) =    hv_0  ;      hv(:,:,Kmm) =    hv_0   ;    hv(:,:,Kaa) =    hv_0   ! 
     184            r1_hu(:,:,Kbb) = z1_hu_0  ;   r1_hu(:,:,Kmm) = z1_hu_0   ; r1_hu(:,:,Kaa) = z1_hu_0   ! inverse of water column thickness 
     185            r1_hv(:,:,Kbb) = z1_hv_0  ;   r1_hv(:,:,Kmm) = z1_hv_0   ; r1_hv(:,:,Kaa) = z1_hv_0   ! 
    186186         ! 
    187187         ! 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/DOM/domvvl.F90

    r11050 r11053  
    181181      ! 
    182182      !                    !==  thickness of the water column  !!   (ocean portion only) 
    183       ht_n(:,:) = e3t(:,:,1,Kmm) * tmask(:,:,1)   !!gm  BUG  :  this should be 1/2 * e3w(k=1) .... 
    184       hu_b(:,:) = e3u(:,:,1,Kbb) * umask(:,:,1) 
    185       hu_n(:,:) = e3u(:,:,1,Kmm) * umask(:,:,1) 
    186       hv_b(:,:) = e3v(:,:,1,Kbb) * vmask(:,:,1) 
    187       hv_n(:,:) = e3v(:,:,1,Kmm) * vmask(:,:,1) 
     183      ht(:,:) = e3t(:,:,1,Kmm) * tmask(:,:,1)   !!gm  BUG  :  this should be 1/2 * e3w(k=1) .... 
     184      hu(:,:,Kbb) = e3u(:,:,1,Kbb) * umask(:,:,1) 
     185      hu(:,:,Kmm) = e3u(:,:,1,Kmm) * umask(:,:,1) 
     186      hv(:,:,Kbb) = e3v(:,:,1,Kbb) * vmask(:,:,1) 
     187      hv(:,:,Kmm) = e3v(:,:,1,Kmm) * vmask(:,:,1) 
    188188      DO jk = 2, jpkm1 
    189          ht_n(:,:) = ht_n(:,:) + e3t(:,:,jk,Kmm) * tmask(:,:,jk) 
    190          hu_b(:,:) = hu_b(:,:) + e3u(:,:,jk,Kbb) * umask(:,:,jk) 
    191          hu_n(:,:) = hu_n(:,:) + e3u(:,:,jk,Kmm) * umask(:,:,jk) 
    192          hv_b(:,:) = hv_b(:,:) + e3v(:,:,jk,Kbb) * vmask(:,:,jk) 
    193          hv_n(:,:) = hv_n(:,:) + e3v(:,:,jk,Kmm) * vmask(:,:,jk) 
     189         ht(:,:) = ht(:,:) + e3t(:,:,jk,Kmm) * tmask(:,:,jk) 
     190         hu(:,:,Kbb) = hu(:,:,Kbb) + e3u(:,:,jk,Kbb) * umask(:,:,jk) 
     191         hu(:,:,Kmm) = hu(:,:,Kmm) + e3u(:,:,jk,Kmm) * umask(:,:,jk) 
     192         hv(:,:,Kbb) = hv(:,:,Kbb) + e3v(:,:,jk,Kbb) * vmask(:,:,jk) 
     193         hv(:,:,Kmm) = hv(:,:,Kmm) + e3v(:,:,jk,Kmm) * vmask(:,:,jk) 
    194194      END DO 
    195195      ! 
    196196      !                    !==  inverse of water column thickness   ==!   (u- and v- points) 
    197       r1_hu_b(:,:) = ssumask(:,:) / ( hu_b(:,:) + 1._wp - ssumask(:,:) )    ! _i mask due to ISF 
    198       r1_hu_n(:,:) = ssumask(:,:) / ( hu_n(:,:) + 1._wp - ssumask(:,:) ) 
    199       r1_hv_b(:,:) = ssvmask(:,:) / ( hv_b(:,:) + 1._wp - ssvmask(:,:) ) 
    200       r1_hv_n(:,:) = ssvmask(:,:) / ( hv_n(:,:) + 1._wp - ssvmask(:,:) ) 
     197      r1_hu(:,:,Kbb) = ssumask(:,:) / ( hu(:,:,Kbb) + 1._wp - ssumask(:,:) )    ! _i mask due to ISF 
     198      r1_hu(:,:,Kmm) = ssumask(:,:) / ( hu(:,:,Kmm) + 1._wp - ssumask(:,:) ) 
     199      r1_hv(:,:,Kbb) = ssvmask(:,:) / ( hv(:,:,Kbb) + 1._wp - ssvmask(:,:) ) 
     200      r1_hv(:,:,Kmm) = ssvmask(:,:) / ( hv(:,:,Kmm) + 1._wp - ssvmask(:,:) ) 
    201201 
    202202      !                    !==   z_tilde coordinate case  ==!   (Restoring frequencies) 
    … …  
    550550      ! *********************************** ! 
    551551 
    552       hu_a(:,:) = e3u(:,:,1,Kaa) * umask(:,:,1) 
    553       hv_a(:,:) = e3v(:,:,1,Kaa) * vmask(:,:,1) 
     552      hu(:,:,Kaa) = e3u(:,:,1,Kaa) * umask(:,:,1) 
     553      hv(:,:,Kaa) = e3v(:,:,1,Kaa) * vmask(:,:,1) 
    554554      DO jk = 2, jpkm1 
    555          hu_a(:,:) = hu_a(:,:) + e3u(:,:,jk,Kaa) * umask(:,:,jk) 
    556          hv_a(:,:) = hv_a(:,:) + e3v(:,:,jk,Kaa) * vmask(:,:,jk) 
     555         hu(:,:,Kaa) = hu(:,:,Kaa) + e3u(:,:,jk,Kaa) * umask(:,:,jk) 
     556         hv(:,:,Kaa) = hv(:,:,Kaa) + e3v(:,:,jk,Kaa) * vmask(:,:,jk) 
    557557      END DO 
    558558      !                                        ! Inverse of the local depth 
    559559!!gm BUG ?  don't understand the use of umask_i here ..... 
    560       r1_hu_a(:,:) = ssumask(:,:) / ( hu_a(:,:) + 1._wp - ssumask(:,:) ) 
    561       r1_hv_a(:,:) = ssvmask(:,:) / ( hv_a(:,:) + 1._wp - ssvmask(:,:) ) 
     560      r1_hu(:,:,Kaa) = ssumask(:,:) / ( hu(:,:,Kaa) + 1._wp - ssumask(:,:) ) 
     561      r1_hv(:,:,Kaa) = ssvmask(:,:) / ( hv(:,:,Kaa) + 1._wp - ssvmask(:,:) ) 
    562562      ! 
    563563      IF( ln_timing )   CALL timing_stop('dom_vvl_sf_nxt') 
    … …  
    625625      ! -------------------------------------- 
    626626      ! - ML - e3u(:,:,:,Kbb) and e3v(:,:,:,Kbb) are allready computed in dynnxt 
    627       ! - JC - hu_b, hv_b, hur_b, hvr_b also 
     627      ! - JC - hu(:,:,:,Kbb), hv(:,:,:,:,Kbb), hur_b, hvr_b also 
    628628       
    629629      CALL dom_vvl_interpol( e3u(:,:,:,Kmm), e3f(:,:,:), 'F'  ) 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/DOM/iscplrst.F90

    r10978 r11053  
    108108      gdept(:,:,:,Kbb) = gdept(:,:,:,Kmm) 
    109109      gdepw(:,:,:,Kbb) = gdepw(:,:,:,Kmm) 
    110       hu_b   (:,:)   = hu_n   (:,:) 
    111       hv_b   (:,:)   = hv_n   (:,:) 
    112       r1_hu_b(:,:)   = r1_hu_n(:,:) 
    113       r1_hv_b(:,:)   = r1_hv_n(:,:) 
     110      hu   (:,:,Kbb)   = hu   (:,:,Kmm) 
     111      hv   (:,:,Kbb)   = hv   (:,:,Kmm) 
     112      r1_hu(:,:,Kbb)   = r1_hu(:,:,Kmm) 
     113      r1_hv(:,:,Kbb)   = r1_hv(:,:,Kmm) 
    114114      ! 
    115115   END SUBROUTINE iscpl_stp 
    … …  
    240240      ! t-, u- and v- water column thickness 
    241241      ! ------------------------------------ 
    242          ht_n(:,:) = 0._wp ; hu_n(:,:) = 0._wp ; hv_n(:,:) = 0._wp 
     242         ht(:,:) = 0._wp ; hu(:,:,Kmm) = 0._wp ; hv(:,:,Kmm) = 0._wp 
    243243         DO jk = 1, jpkm1 
    244             hu_n(:,:) = hu_n(:,:) + e3u(:,:,jk,Kmm) * umask(:,:,jk) 
    245             hv_n(:,:) = hv_n(:,:) + e3v(:,:,jk,Kmm) * vmask(:,:,jk) 
    246             ht_n(:,:) = ht_n(:,:) + e3t(:,:,jk,Kmm) * tmask(:,:,jk) 
     244            hu(:,:,Kmm) = hu(:,:,Kmm) + e3u(:,:,jk,Kmm) * umask(:,:,jk) 
     245            hv(:,:,Kmm) = hv(:,:,Kmm) + e3v(:,:,jk,Kmm) * vmask(:,:,jk) 
     246            ht(:,:) = ht(:,:) + e3t(:,:,jk,Kmm) * tmask(:,:,jk) 
    247247         END DO 
    248248         !                                        ! Inverse of the local depth 
    249          r1_hu_n(:,:) = 1._wp / ( hu_n(:,:) + 1._wp - ssumask(:,:) ) * ssumask(:,:) 
    250          r1_hv_n(:,:) = 1._wp / ( hv_n(:,:) + 1._wp - ssvmask(:,:) ) * ssvmask(:,:) 
     249         r1_hu(:,:,Kmm) = 1._wp / ( hu(:,:,Kmm) + 1._wp - ssumask(:,:) ) * ssumask(:,:) 
     250         r1_hv(:,:,Kmm) = 1._wp / ( hv(:,:,Kmm) + 1._wp - ssvmask(:,:) ) * ssvmask(:,:) 
    251251 
    252252      END IF 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/DOM/istate.F90

    r10978 r11053  
    175175      END DO 
    176176      ! 
    177       uu_b(:,:,Kmm) = uu_b(:,:,Kmm) * r1_hu_n(:,:) 
    178       vv_b(:,:,Kmm) = vv_b(:,:,Kmm) * r1_hv_n(:,:) 
     177      uu_b(:,:,Kmm) = uu_b(:,:,Kmm) * r1_hu(:,:,Kmm) 
     178      vv_b(:,:,Kmm) = vv_b(:,:,Kmm) * r1_hv(:,:,Kmm) 
    179179      ! 
    180       uu_b(:,:,Kbb) = uu_b(:,:,Kbb) * r1_hu_b(:,:) 
    181       vv_b(:,:,Kbb) = vv_b(:,:,Kbb) * r1_hv_b(:,:) 
     180      uu_b(:,:,Kbb) = uu_b(:,:,Kbb) * r1_hu(:,:,Kbb) 
     181      vv_b(:,:,Kbb) = vv_b(:,:,Kbb) * r1_hv(:,:,Kbb) 
    182182      ! 
    183183   END SUBROUTINE istate_init 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/DYN/dynspg_ts.F90

    r10919 r11053  
    250250               DO jj = 1, jpjm1 
    251251                  DO ji = 1, jpim1 
    252                      zwz(ji,jj) =   ( ht_n(ji  ,jj+1) + ht_n(ji+1,jj+1) +                    & 
    253                         &             ht_n(ji  ,jj  ) + ht_n(ji+1,jj  )   ) * 0.25_wp   
     252                     zwz(ji,jj) =   ( ht(ji  ,jj+1) + ht(ji+1,jj+1) +                    & 
     253                        &             ht(ji  ,jj  ) + ht(ji+1,jj  )   ) * 0.25_wp   
    254254                     IF( zwz(ji,jj) /= 0._wp )   zwz(ji,jj) = ff_f(ji,jj) / zwz(ji,jj) 
    255255                  END DO 
    … …  
    258258               DO jj = 1, jpjm1 
    259259                  DO ji = 1, jpim1 
    260                      zwz(ji,jj) =             (  ht_n  (ji  ,jj+1) + ht_n  (ji+1,jj+1)      & 
    261                         &                      + ht_n  (ji  ,jj  ) + ht_n  (ji+1,jj  )  )   & 
     260                     zwz(ji,jj) =             (  ht  (ji  ,jj+1) + ht  (ji+1,jj+1)      & 
     261                        &                      + ht  (ji  ,jj  ) + ht  (ji+1,jj  )  )   & 
    262262                        &       / ( MAX( 1._wp,  ssmask(ji  ,jj+1) + ssmask(ji+1,jj+1)      & 
    263263                        &                      + ssmask(ji  ,jj  ) + ssmask(ji+1,jj  )  )   ) 
    … …  
    282282            DO jj = 2, jpj 
    283283               DO ji = 2, jpi 
    284                   z1_ht = ssmask(ji,jj) / ( ht_n(ji,jj) + 1._wp - ssmask(ji,jj) ) 
     284                  z1_ht = ssmask(ji,jj) / ( ht(ji,jj) + 1._wp - ssmask(ji,jj) ) 
    285285                  ftne(ji,jj) = ( ff_f(ji-1,jj  ) + ff_f(ji  ,jj  ) + ff_f(ji  ,jj-1) ) * z1_ht 
    286286                  ftnw(ji,jj) = ( ff_f(ji-1,jj-1) + ff_f(ji-1,jj  ) + ff_f(ji  ,jj  ) ) * z1_ht 
    … …  
    367367      END DO 
    368368      ! 
    369       zu_frc(:,:) = zu_frc(:,:) * r1_hu_n(:,:) 
    370       zv_frc(:,:) = zv_frc(:,:) * r1_hv_n(:,:) 
     369      zu_frc(:,:) = zu_frc(:,:) * r1_hu(:,:,Kmm) 
     370      zv_frc(:,:) = zv_frc(:,:) * r1_hv(:,:,Kmm) 
    371371      ! 
    372372      ! 
    … …  
    388388      !                                   ! -------------------------------------------------------- 
    389389      ! 
    390       zwx(:,:) = puu_b(:,:,Kmm) * hu_n(:,:) * e2u(:,:)        ! now fluxes  
    391       zwy(:,:) = pvv_b(:,:,Kmm) * hv_n(:,:) * e1v(:,:) 
     390      zwx(:,:) = puu_b(:,:,Kmm) * hu(:,:,Kmm) * e2u(:,:)        ! now fluxes  
     391      zwy(:,:) = pvv_b(:,:,Kmm) * hv(:,:,Kmm) * e1v(:,:) 
    392392      ! 
    393393      SELECT CASE( nvor_scheme ) 
    … …  
    395395         DO jj = 2, jpjm1 
    396396            DO ji = 2, jpim1   ! vector opt. 
    397                zu_trd(ji,jj) = + r1_4 * r1_e1e2u(ji,jj) * r1_hu_n(ji,jj)                    & 
    398                   &               * (  e1e2t(ji+1,jj)*ht_n(ji+1,jj)*ff_t(ji+1,jj) * ( pvv_b(ji+1,jj,Kmm) + pvv_b(ji+1,jj-1,Kmm) )   & 
    399                   &                  + e1e2t(ji  ,jj)*ht_n(ji  ,jj)*ff_t(ji  ,jj) * ( pvv_b(ji  ,jj,Kmm) + pvv_b(ji  ,jj-1,Kmm) )   ) 
     397               zu_trd(ji,jj) = + r1_4 * r1_e1e2u(ji,jj) * r1_hu(ji,jj,Kmm)                    & 
     398                  &               * (  e1e2t(ji+1,jj)*ht(ji+1,jj)*ff_t(ji+1,jj) * ( pvv_b(ji+1,jj,Kmm) + pvv_b(ji+1,jj-1,Kmm) )   & 
     399                  &                  + e1e2t(ji  ,jj)*ht(ji  ,jj)*ff_t(ji  ,jj) * ( pvv_b(ji  ,jj,Kmm) + pvv_b(ji  ,jj-1,Kmm) )   ) 
    400400                  ! 
    401                zv_trd(ji,jj) = - r1_4 * r1_e1e2v(ji,jj) * r1_hv_n(ji,jj)                    & 
    402                   &               * (  e1e2t(ji,jj+1)*ht_n(ji,jj+1)*ff_t(ji,jj+1) * ( puu_b(ji,jj+1,Kmm) + puu_b(ji-1,jj+1,Kmm) )   &  
    403                   &                  + e1e2t(ji,jj  )*ht_n(ji,jj  )*ff_t(ji,jj  ) * ( puu_b(ji,jj  ,Kmm) + puu_b(ji-1,jj  ,Kmm) )   )  
     401               zv_trd(ji,jj) = - r1_4 * r1_e1e2v(ji,jj) * r1_hv(ji,jj,Kmm)                    & 
     402                  &               * (  e1e2t(ji,jj+1)*ht(ji,jj+1)*ff_t(ji,jj+1) * ( puu_b(ji,jj+1,Kmm) + puu_b(ji-1,jj+1,Kmm) )   &  
     403                  &                  + e1e2t(ji,jj  )*ht(ji,jj  )*ff_t(ji,jj  ) * ( puu_b(ji,jj  ,Kmm) + puu_b(ji-1,jj  ,Kmm) )   )  
    404404            END DO   
    405405         END DO   
    … …  
    546546            DO ji = fs_2, fs_jpim1   ! vector opt. 
    547547               zu_frc(ji,jj) = zu_frc(ji,jj) + &  
    548                & MAX(r1_hu_n(ji,jj) * r1_2 * ( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ), zztmp ) * zwx(ji,jj) *  wdrampu(ji,jj) 
     548               & MAX(r1_hu(ji,jj,Kmm) * r1_2 * ( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ), zztmp ) * zwx(ji,jj) *  wdrampu(ji,jj) 
    549549               zv_frc(ji,jj) = zv_frc(ji,jj) + &  
    550                & MAX(r1_hv_n(ji,jj) * r1_2 * ( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ), zztmp ) * zwy(ji,jj) *  wdrampv(ji,jj) 
     550               & MAX(r1_hv(ji,jj,Kmm) * r1_2 * ( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ), zztmp ) * zwy(ji,jj) *  wdrampv(ji,jj) 
    551551            END DO 
    552552         END DO 
    … …  
    554554         DO jj = 2, jpjm1 
    555555            DO ji = fs_2, fs_jpim1   ! vector opt. 
    556                zu_frc(ji,jj) = zu_frc(ji,jj) + r1_hu_n(ji,jj) * r1_2 * ( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * zwx(ji,jj) 
    557                zv_frc(ji,jj) = zv_frc(ji,jj) + r1_hv_n(ji,jj) * r1_2 * ( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * zwy(ji,jj) 
     556               zu_frc(ji,jj) = zu_frc(ji,jj) + r1_hu(ji,jj,Kmm) * r1_2 * ( rCdU_bot(ji+1,jj)+rCdU_bot(ji,jj) ) * zwx(ji,jj) 
     557               zv_frc(ji,jj) = zv_frc(ji,jj) + r1_hv(ji,jj,Kmm) * r1_2 * ( rCdU_bot(ji,jj+1)+rCdU_bot(ji,jj) ) * zwy(ji,jj) 
    558558            END DO 
    559559         END DO 
    … …  
    584584         DO jj = 2, jpjm1               
    585585            DO ji = fs_2, fs_jpim1   ! vector opt. 
    586                zu_frc(ji,jj) = zu_frc(ji,jj) + r1_hu_n(ji,jj) * r1_2 * ( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * zwx(ji,jj) 
    587                zv_frc(ji,jj) = zv_frc(ji,jj) + r1_hv_n(ji,jj) * r1_2 * ( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) * zwy(ji,jj) 
     586               zu_frc(ji,jj) = zu_frc(ji,jj) + r1_hu(ji,jj,Kmm) * r1_2 * ( rCdU_top(ji+1,jj)+rCdU_top(ji,jj) ) * zwx(ji,jj) 
     587               zv_frc(ji,jj) = zv_frc(ji,jj) + r1_hv(ji,jj,Kmm) * r1_2 * ( rCdU_top(ji,jj+1)+rCdU_top(ji,jj) ) * zwy(ji,jj) 
    588588            END DO 
    589589         END DO 
    … …  
    593593         DO jj = 2, jpjm1 
    594594            DO ji = fs_2, fs_jpim1   ! vector opt. 
    595                zu_frc(ji,jj) =  zu_frc(ji,jj) + r1_rau0 * utau(ji,jj) * r1_hu_n(ji,jj) 
    596                zv_frc(ji,jj) =  zv_frc(ji,jj) + r1_rau0 * vtau(ji,jj) * r1_hv_n(ji,jj) 
     595               zu_frc(ji,jj) =  zu_frc(ji,jj) + r1_rau0 * utau(ji,jj) * r1_hu(ji,jj,Kmm) 
     596               zv_frc(ji,jj) =  zv_frc(ji,jj) + r1_rau0 * vtau(ji,jj) * r1_hv(ji,jj,Kmm) 
    597597            END DO 
    598598         END DO 
    … …  
    601601         DO jj = 2, jpjm1 
    602602            DO ji = fs_2, fs_jpim1   ! vector opt. 
    603                zu_frc(ji,jj) =  zu_frc(ji,jj) + zztmp * ( utau_b(ji,jj) + utau(ji,jj) ) * r1_hu_n(ji,jj) 
    604                zv_frc(ji,jj) =  zv_frc(ji,jj) + zztmp * ( vtau_b(ji,jj) + vtau(ji,jj) ) * r1_hv_n(ji,jj) 
     603               zu_frc(ji,jj) =  zu_frc(ji,jj) + zztmp * ( utau_b(ji,jj) + utau(ji,jj) ) * r1_hu(ji,jj,Kmm) 
     604               zv_frc(ji,jj) =  zv_frc(ji,jj) + zztmp * ( vtau_b(ji,jj) + vtau(ji,jj) ) * r1_hv(ji,jj,Kmm) 
    605605            END DO 
    606606         END DO 
    … …  
    681681         vn_e  (:,:) =    pvv_b(:,:,Kmm) 
    682682         ! 
    683          hu_e  (:,:) =    hu_n(:,:)        
    684          hv_e  (:,:) =    hv_n(:,:)  
    685          hur_e (:,:) = r1_hu_n(:,:)     
    686          hvr_e (:,:) = r1_hv_n(:,:) 
     683         hu_e  (:,:) =    hu(:,:,Kmm)        
     684         hv_e  (:,:) =    hv(:,:,Kmm)  
     685         hur_e (:,:) = r1_hu(:,:,Kmm)     
     686         hvr_e (:,:) = r1_hv(:,:,Kmm) 
    687687      ELSE                                ! CENTRED integration: start from BEFORE fields 
    688688         sshn_e(:,:) =    pssh(:,:,Kbb) 
    … …  
    690690         vn_e  (:,:) =    pvv_b(:,:,Kbb) 
    691691         ! 
    692          hu_e  (:,:) =    hu_b(:,:)        
    693          hv_e  (:,:) =    hv_b(:,:)  
    694          hur_e (:,:) = r1_hu_b(:,:)     
    695          hvr_e (:,:) = r1_hv_b(:,:) 
     692         hu_e  (:,:) =    hu(:,:,Kbb)        
     693         hv_e  (:,:) =    hv(:,:,Kbb)  
     694         hur_e (:,:) = r1_hu(:,:,Kbb)     
     695         hvr_e (:,:) = r1_hv(:,:,Kbb) 
    696696      ENDIF 
    697697      ! 
    … …  
    790790            zhtp2_e(:,:) = ht_0(:,:) + zsshp2_e(:,:) 
    791791         ELSE 
    792             zhup2_e(:,:) = hu_n(:,:) 
    793             zhvp2_e(:,:) = hv_n(:,:) 
    794             zhtp2_e(:,:) = ht_n(:,:) 
     792            zhup2_e(:,:) = hu(:,:,Kmm) 
     793            zhvp2_e(:,:) = hv(:,:,Kmm) 
     794            zhtp2_e(:,:) = ht(:,:) 
    795795         ENDIF 
    796796         !                                                !* after ssh 
    … …  
    11381138                            &     + rdtbt * ( zhust_e(ji,jj)  *    zwx(ji,jj)   &  
    11391139                            &               + zhup2_e(ji,jj)  * zu_trd(ji,jj)   & 
    1140                             &               +    hu_n(ji,jj)  * zu_frc(ji,jj) ) & 
     1140                            &               +    hu(ji,jj,Kmm)  * zu_frc(ji,jj) ) & 
    11411141                            &   ) * zhura 
    11421142 
    … …  
    11441144                            &     + rdtbt * ( zhvst_e(ji,jj)  *    zwy(ji,jj)   & 
    11451145                            &               + zhvp2_e(ji,jj)  * zv_trd(ji,jj)   & 
    1146                             &               +    hv_n(ji,jj)  * zv_frc(ji,jj) ) & 
     1146                            &               +    hv(ji,jj,Kmm)  * zv_frc(ji,jj) ) & 
    11471147                            &   ) * zhvra 
    11481148               END DO 
    … …  
    12571257         ! 
    12581258         DO jk=1,jpkm1 
    1259             puu(:,:,jk,Krhs) = puu(:,:,jk,Krhs) + r1_hu_n(:,:) * ( puu_b(:,:,Kaa) - puu_b(:,:,Kbb) * hu_b(:,:) ) * r1_2dt_b 
    1260             pvv(:,:,jk,Krhs) = pvv(:,:,jk,Krhs) + r1_hv_n(:,:) * ( pvv_b(:,:,Kaa) - pvv_b(:,:,Kbb) * hv_b(:,:) ) * r1_2dt_b 
     1259            puu(:,:,jk,Krhs) = puu(:,:,jk,Krhs) + r1_hu(:,:,Kmm) * ( puu_b(:,:,Kaa) - puu_b(:,:,Kbb) * hu(:,:,Kbb) ) * r1_2dt_b 
     1260            pvv(:,:,jk,Krhs) = pvv(:,:,jk,Krhs) + r1_hv(:,:,Kmm) * ( pvv_b(:,:,Kaa) - pvv_b(:,:,Kbb) * hv(:,:,Kbb) ) * r1_2dt_b 
    12611261         END DO 
    12621262         ! Save barotropic velocities not transport: 
    … …  
    12681268      ! Correct velocities so that the barotropic velocity equals (un_adv, vn_adv) (in all cases)   
    12691269      DO jk = 1, jpkm1 
    1270          puu(:,:,jk,Kmm) = ( puu(:,:,jk,Kmm) + un_adv(:,:)*r1_hu_n(:,:) - puu_b(:,:,Kmm) ) * umask(:,:,jk) 
    1271          pvv(:,:,jk,Kmm) = ( pvv(:,:,jk,Kmm) + vn_adv(:,:)*r1_hv_n(:,:) - pvv_b(:,:,Kmm) ) * vmask(:,:,jk) 
     1270         puu(:,:,jk,Kmm) = ( puu(:,:,jk,Kmm) + un_adv(:,:)*r1_hu(:,:,Kmm) - puu_b(:,:,Kmm) ) * umask(:,:,jk) 
     1271         pvv(:,:,jk,Kmm) = ( pvv(:,:,jk,Kmm) + vn_adv(:,:)*r1_hv(:,:,Kmm) - pvv_b(:,:,Kmm) ) * vmask(:,:,jk) 
    12721272      END DO 
    12731273 
    12741274      IF ( ln_wd_dl .and. ln_wd_dl_bc) THEN  
    12751275         DO jk = 1, jpkm1 
    1276             puu(:,:,jk,Kmm) = ( un_adv(:,:)*r1_hu_n(:,:) & 
    1277                        & + zuwdav2(:,:)*(puu(:,:,jk,Kmm) - un_adv(:,:)*r1_hu_n(:,:)) ) * umask(:,:,jk)  
    1278             pvv(:,:,jk,Kmm) = ( vn_adv(:,:)*r1_hv_n(:,:) &  
    1279                        & + zvwdav2(:,:)*(pvv(:,:,jk,Kmm) - vn_adv(:,:)*r1_hv_n(:,:)) ) * vmask(:,:,jk)   
     1276            puu(:,:,jk,Kmm) = ( un_adv(:,:)*r1_hu(:,:,Kmm) & 
     1277                       & + zuwdav2(:,:)*(puu(:,:,jk,Kmm) - un_adv(:,:)*r1_hu(:,:,Kmm)) ) * umask(:,:,jk)  
     1278            pvv(:,:,jk,Kmm) = ( vn_adv(:,:)*r1_hv(:,:,Kmm) &  
     1279                       & + zvwdav2(:,:)*(pvv(:,:,jk,Kmm) - vn_adv(:,:)*r1_hv(:,:,Kmm)) ) * vmask(:,:,jk)   
    12801280         END DO 
    12811281      END IF  
    12821282 
    12831283       
    1284       CALL iom_put(  "ubar", un_adv(:,:)*r1_hu_n(:,:) )    ! barotropic i-current 
    1285       CALL iom_put(  "vbar", vn_adv(:,:)*r1_hv_n(:,:) )    ! barotropic i-current 
     1284      CALL iom_put(  "ubar", un_adv(:,:)*r1_hu(:,:,Kmm) )    ! barotropic i-current 
     1285      CALL iom_put(  "vbar", vn_adv(:,:)*r1_hv(:,:,Kmm) )    ! barotropic i-current 
    12861286      ! 
    12871287#if defined key_agrif 
    … …  
    13071307      ! 
    13081308      IF( ln_diatmb ) THEN 
    1309          CALL iom_put( "baro_u" , un_b*ssumask(:,:)+zmdi*(1.-ssumask(:,:) ) )  ! Barotropic  U Velocity 
    1310          CALL iom_put( "baro_v" , vn_b*ssvmask(:,:)+zmdi*(1.-ssvmask(:,:) ) )  ! Barotropic  V Velocity 
     1309         CALL iom_put( "baro_u" , uu_b(:,:,Kmm)*ssumask(:,:)+zmdi*(1.-ssumask(:,:) ) )  ! Barotropic  U Velocity 
     1310         CALL iom_put( "baro_v" , vv_b(:,:,Kmm)*ssvmask(:,:)+zmdi*(1.-ssvmask(:,:) ) )  ! Barotropic  V Velocity 
    13111311      ENDIF 
    13121312      ! 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/DYN/sshwzv.F90

    r10978 r11053  
    9393      !                                           !------------------------------! 
    9494      IF(ln_wd_il) THEN 
    95          CALL wad_lmt(pssh(:,:,Kbb), zcoef * (emp_b(:,:) + emp(:,:)), z2dt) 
     95         CALL wad_lmt(pssh(:,:,Kbb), zcoef * (emp_b(:,:) + emp(:,:)), z2dt, Kmm, uu, vv ) 
    9696      ENDIF 
    9797 
    … …  
    109109      ! 
    110110#if defined key_agrif 
    111       CALL agrif_ssh( kt ) 
     111      Krhs_a = Kaa ; CALL agrif_ssh( kt ) 
    112112#endif 
    113113      ! 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/DYN/wet_dry.F90

    r10499 r11053  
    122122 
    123123 
    124    SUBROUTINE wad_lmt( sshb1, sshemp, z2dt ) 
     124   SUBROUTINE wad_lmt( psshb1, psshemp, z2dt, Kmm, puu, pvv ) 
    125125      !!---------------------------------------------------------------------- 
    126126      !!                  ***  ROUTINE wad_lmt  *** 
    … …  
    132132      !! ** Action  : - calculate flux limiter and W/D flag 
    133133      !!---------------------------------------------------------------------- 
    134       REAL(wp), DIMENSION(:,:), INTENT(inout) ::   sshb1        !!gm DOCTOR names: should start with p ! 
    135       REAL(wp), DIMENSION(:,:), INTENT(in   ) ::   sshemp 
    136       REAL(wp)                , INTENT(in   ) ::   z2dt 
     134      REAL(wp), DIMENSION(:,:)            , INTENT(inout) ::   psshb1 
     135      REAL(wp), DIMENSION(:,:)            , INTENT(in   ) ::   psshemp 
     136      REAL(wp)                            , INTENT(in   ) ::   z2dt 
     137      INTEGER                             , INTENT(in   ) ::   Kmm       ! time level index 
     138      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) ::   puu, pvv  ! velocity arrays 
    137139      ! 
    138140      INTEGER  ::   ji, jj, jk, jk1     ! dummy loop indices 
    … …  
    150152      ! 
    151153      DO jk = 1, jpkm1 
    152          un(:,:,jk) = un(:,:,jk) * zwdlmtu(:,:)  
    153          vn(:,:,jk) = vn(:,:,jk) * zwdlmtv(:,:)  
     154         puu(:,:,jk,Kmm) = puu(:,:,jk,Kmm) * zwdlmtu(:,:)  
     155         pvv(:,:,jk,Kmm) = pvv(:,:,jk,Kmm) * zwdlmtv(:,:)  
    154156      END DO 
    155157      jflag  = 0 
    … …  
    165167      ! 
    166168      DO jk = 1, jpkm1     ! Horizontal Flux in u and v direction 
    167          zflxu(:,:) = zflxu(:,:) + e3u_n(:,:,jk) * un(:,:,jk) * umask(:,:,jk) 
    168          zflxv(:,:) = zflxv(:,:) + e3v_n(:,:,jk) * vn(:,:,jk) * vmask(:,:,jk) 
     169         zflxu(:,:) = zflxu(:,:) + e3u(:,:,jk,Kmm) * puu(:,:,jk,Kmm) * umask(:,:,jk) 
     170         zflxv(:,:) = zflxv(:,:) + e3v(:,:,jk,Kmm) * pvv(:,:,jk,Kmm) * vmask(:,:,jk) 
    169171      END DO 
    170172      zflxu(:,:) = zflxu(:,:) * e2u(:,:) 
    … …  
    183185               &         + MIN( zflxv(ji,jj) , 0._wp ) - MAX( zflxv(ji,  jj-1) , 0._wp )  
    184186            ! 
    185             zdep2 = ht_0(ji,jj) + sshb1(ji,jj) - rn_wdmin1 
     187            zdep2 = ht_0(ji,jj) + psshb1(ji,jj) - rn_wdmin1 
    186188            IF( zdep2 <= 0._wp ) THEN     ! add more safty, but not necessary 
    187                sshb1(ji,jj) = rn_wdmin1 - ht_0(ji,jj) 
     189               psshb1(ji,jj) = rn_wdmin1 - ht_0(ji,jj) 
    188190               IF(zflxu(ji,  jj) > 0._wp) zwdlmtu(ji  ,jj) = 0._wp 
    189191               IF(zflxu(ji-1,jj) < 0._wp) zwdlmtu(ji-1,jj) = 0._wp 
    … …  
    196198      ! 
    197199      !           ! HPG limiter from jholt 
    198       wdramp(:,:) = min((ht_0(:,:) + sshb1(:,:) - rn_wdmin1)/(rn_wdmin0 - rn_wdmin1),1.0_wp) 
     200      wdramp(:,:) = min((ht_0(:,:) + psshb1(:,:) - rn_wdmin1)/(rn_wdmin0 - rn_wdmin1),1.0_wp) 
    199201      !jth assume don't need a lbc_lnk here 
    200202      DO jj = 1, jpjm1 
    … …  
    226228               ! 
    227229               zdep1 = (zzflxp + zzflxn) * z2dt / ztmp 
    228                zdep2 = ht_0(ji,jj) + sshb1(ji,jj) - rn_wdmin1 - z2dt * sshemp(ji,jj) 
     230               zdep2 = ht_0(ji,jj) + psshb1(ji,jj) - rn_wdmin1 - z2dt * psshemp(ji,jj) 
    229231               ! 
    230232               IF( zdep1 > zdep2 ) THEN 
    … …  
    255257      ! 
    256258      DO jk = 1, jpkm1 
    257          un(:,:,jk) = un(:,:,jk) * zwdlmtu(:,:)  
    258          vn(:,:,jk) = vn(:,:,jk) * zwdlmtv(:,:)  
    259       END DO 
    260       un_b(:,:) = un_b(:,:) * zwdlmtu(:, :) 
    261       vn_b(:,:) = vn_b(:,:) * zwdlmtv(:, :) 
     259         puu(:,:,jk,Kmm) = puu(:,:,jk,Kmm) * zwdlmtu(:,:)  
     260         pvv(:,:,jk,Kmm) = pvv(:,:,jk,Kmm) * zwdlmtv(:,:)  
     261      END DO 
     262      uu_b(:,:,Kmm) = uu_b(:,:,Kmm) * zwdlmtu(:, :) 
     263      vv_b(:,:,Kmm) = vv_b(:,:,Kmm) * zwdlmtv(:, :) 
    262264      ! 
    263265!!gm TO BE SUPPRESSED ?  these lbc_lnk are useless since zwdlmtu and zwdlmtv are defined everywhere ! 
    264       CALL lbc_lnk_multi( 'wet_dry', un  , 'U', -1., vn  , 'V', -1. ) 
    265       CALL lbc_lnk_multi( 'wet_dry', un_b, 'U', -1., vn_b, 'V', -1. ) 
     266      CALL lbc_lnk_multi( 'wet_dry', puu(:,:,:,Kmm)  , 'U', -1., pvv(:,:,:,Kmm)  , 'V', -1. ) 
     267      CALL lbc_lnk_multi( 'wet_dry', uu_b(:,:,Kmm), 'U', -1., vv_b(:,:,Kmm), 'V', -1. ) 
    266268!!gm 
    267269      ! 
    268270      IF(jflag == 1 .AND. lwp)   WRITE(numout,*) 'Need more iterations in wad_lmt!!!' 
    269271      ! 
    270       !IF( ln_rnf      )   CALL sbc_rnf_div( hdivn )          ! runoffs (update hdivn field) 
     272      !IF( ln_rnf      )   CALL sbc_rnf_div( hdiv )          ! runoffs (update hdiv field) 
    271273      ! 
    272274      IF( ln_timing )   CALL timing_stop('wad_lmt')      ! 
    … …  
    392394      IF( jflag == 1 .AND. lwp )   WRITE(numout,*) 'Need more iterations in wad_lmt_bt!!!' 
    393395      ! 
    394       !IF( ln_rnf      )   CALL sbc_rnf_div( hdivn )          ! runoffs (update hdivn field) 
     396      !IF( ln_rnf      )   CALL sbc_rnf_div( hdiv )          ! runoffs (update hdiv field) 
    395397      ! 
    396398      IF( ln_timing )   CALL timing_stop('wad_lmt_bt')      ! 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/IOM/restart.F90

    r10989 r11053  
    148148 
    149149      IF ( .NOT. ln_diurnal_only ) THEN 
    150                      CALL iom_rstput( kt, nitrst, numrow, 'ub'     , uu(:,:,:,Kbb), ldxios = lwxios        )     ! before fields 
    151                      CALL iom_rstput( kt, nitrst, numrow, 'vb'     , vv(:,:,:,Kbb), ldxios = lwxios        ) 
     150                     CALL iom_rstput( kt, nitrst, numrow, 'ub'     , uu(:,:,:       ,Kbb), ldxios = lwxios        )     ! before fields 
     151                     CALL iom_rstput( kt, nitrst, numrow, 'vb'     , vv(:,:,:       ,Kbb), ldxios = lwxios        ) 
    152152                     CALL iom_rstput( kt, nitrst, numrow, 'tb'     , ts(:,:,:,jp_tem,Kbb), ldxios = lwxios ) 
    153153                     CALL iom_rstput( kt, nitrst, numrow, 'sb'     , ts(:,:,:,jp_sal,Kbb), ldxios = lwxios ) 
    154                      CALL iom_rstput( kt, nitrst, numrow, 'sshb'   , sshb, ldxios = lwxios      ) 
     154                     CALL iom_rstput( kt, nitrst, numrow, 'sshb'   ,ssh(:,:         ,Kbb), ldxios = lwxios      ) 
    155155                     ! 
    156                      CALL iom_rstput( kt, nitrst, numrow, 'un'     , uu(:,:,:,Kmm), ldxios = lwxios        )     ! now fields 
    157                      CALL iom_rstput( kt, nitrst, numrow, 'vn'     , vv(:,:,:,Kmm), ldxios = lwxios        ) 
     156                     CALL iom_rstput( kt, nitrst, numrow, 'un'     , uu(:,:,:       ,Kmm), ldxios = lwxios        )     ! now fields 
     157                     CALL iom_rstput( kt, nitrst, numrow, 'vn'     , vv(:,:,:       ,Kmm), ldxios = lwxios        ) 
    158158                     CALL iom_rstput( kt, nitrst, numrow, 'tn'     , ts(:,:,:,jp_tem,Kmm), ldxios = lwxios ) 
    159159                     CALL iom_rstput( kt, nitrst, numrow, 'sn'     , ts(:,:,:,jp_sal,Kmm), ldxios = lwxios ) 
    160                      CALL iom_rstput( kt, nitrst, numrow, 'sshn'   , sshn, ldxios = lwxios      ) 
     160                     CALL iom_rstput( kt, nitrst, numrow, 'sshn'   ,ssh(:,:         ,Kmm), ldxios = lwxios      ) 
    161161                     CALL iom_rstput( kt, nitrst, numrow, 'rhop'   , rhop, ldxios = lwxios      ) 
    162162                  ! extra variable needed for the ice sheet coupling 
    … …  
    275275       
    276276      IF( iom_varid( numror, 'ub', ldstop = .FALSE. ) > 0 ) THEN 
    277          CALL iom_get( numror, jpdom_autoglo, 'ub'     , uu(:,:,:,Kbb), ldxios = lrxios        )   ! before fields 
    278          CALL iom_get( numror, jpdom_autoglo, 'vb'     , vv(:,:,:,Kbb), ldxios = lrxios        ) 
     277         CALL iom_get( numror, jpdom_autoglo, 'ub'     , uu(:,:,:       ,Kbb), ldxios = lrxios )   ! before fields 
     278         CALL iom_get( numror, jpdom_autoglo, 'vb'     , vv(:,:,:       ,Kbb), ldxios = lrxios ) 
    279279         CALL iom_get( numror, jpdom_autoglo, 'tb'     , ts(:,:,:,jp_tem,Kbb), ldxios = lrxios ) 
    280280         CALL iom_get( numror, jpdom_autoglo, 'sb'     , ts(:,:,:,jp_sal,Kbb), ldxios = lrxios ) 
    281          CALL iom_get( numror, jpdom_autoglo, 'sshb'   , sshb, ldxios = lrxios                ) 
     281         CALL iom_get( numror, jpdom_autoglo, 'sshb'   ,ssh(:,:         ,Kbb), ldxios = lrxios ) 
    282282      ELSE 
    283283         neuler = 0 
    284284      ENDIF 
    285285      ! 
    286       CALL iom_get( numror, jpdom_autoglo, 'un'     , uu(:,:,:,Kmm), ldxios = lrxios        )   ! now    fields 
    287       CALL iom_get( numror, jpdom_autoglo, 'vn'     , vv(:,:,:,Kmm), ldxios = lrxios        ) 
     286      CALL iom_get( numror, jpdom_autoglo, 'un'     , uu(:,:,:       ,Kmm), ldxios = lrxios )       ! now    fields 
     287      CALL iom_get( numror, jpdom_autoglo, 'vn'     , vv(:,:,:       ,Kmm), ldxios = lrxios ) 
    288288      CALL iom_get( numror, jpdom_autoglo, 'tn'     , ts(:,:,:,jp_tem,Kmm), ldxios = lrxios ) 
    289289      CALL iom_get( numror, jpdom_autoglo, 'sn'     , ts(:,:,:,jp_sal,Kmm), ldxios = lrxios ) 
    290       CALL iom_get( numror, jpdom_autoglo, 'sshn'   , sshn, ldxios = lrxios ) 
     290      CALL iom_get( numror, jpdom_autoglo, 'sshn'   ,ssh(:,:         ,Kmm), ldxios = lrxios ) 
    291291      IF( iom_varid( numror, 'rhop', ldstop = .FALSE. ) > 0 ) THEN 
    292292         CALL iom_get( numror, jpdom_autoglo, 'rhop'   , rhop, ldxios = lrxios )   ! now    potential density 
    … …  
    297297      IF( neuler == 0 ) THEN                                  ! Euler restart (neuler=0) 
    298298         ts   (:,:,:,:,Kbb) = ts   (:,:,:,:,Kmm)              ! all before fields set to now values 
    299          uu   (:,:,:,Kbb)   = uu   (:,:,:,Kmm) 
    300          vv   (:,:,:,Kbb)   = vv   (:,:,:,Kmm) 
    301          sshb (:,:)         = sshn (:,:) 
     299         uu   (:,:,:  ,Kbb) = uu   (:,:,:  ,Kmm) 
     300         vv   (:,:,:  ,Kbb) = vv   (:,:,:  ,Kmm) 
     301         ssh  (:,:    ,Kbb) = ssh  (:,:    ,Kmm) 
    302302         ! 
    303303         IF( .NOT.ln_linssh ) THEN 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/OBS/diaobs.F90

    r10922 r11053  
    460460            ! 
    461461            IF( TRIM(cobstypessurf(jtype)) == 'sla' ) THEN 
    462                CALL obs_rea_mdt( surfdataqc(jtype), n2dintsurf(jtype) ) 
     462               CALL obs_rea_mdt( surfdataqc(jtype), n2dintsurf(jtype), Kmm ) 
    463463               IF( ln_altbias )   & 
    464464                  & CALL obs_rea_altbias ( surfdataqc(jtype), n2dintsurf(jtype), cn_altbiasfile ) 
    … …  
    499499      USE dom_oce, ONLY : gdept, gdept_1d     ! Ocean space domain variables (Kmm time-level only) 
    500500      USE phycst , ONLY : rday                ! Physical constants 
    501       USE oce    , ONLY : ts, uu, vv, sshn    ! Ocean dynamics and tracers variables (Kmm time-level only) 
     501      USE oce    , ONLY : ts, uu, vv, ssh     ! Ocean dynamics and tracers variables (Kmm time-level only) 
    502502      USE phycst , ONLY : rday                ! Physical constants 
    503503#if defined  key_si3 
    … …  
    598598               zsurfvar(:,:) = ts(:,:,1,jp_tem,Kmm) 
    599599            CASE('sla') 
    600                zsurfvar(:,:) = sshn(:,:) 
     600               zsurfvar(:,:) = ssh(:,:,Kmm) 
    601601            CASE('sss') 
    602602               zsurfvar(:,:) = ts(:,:,1,jp_sal,Kmm) 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/OBS/obs_read_altbias.F90

    r10068 r11053  
    2929      & gphit 
    3030   USE oce, ONLY : &           ! Model variables 
    31       & sshn 
     31      & ssh 
    3232   USE obs_inter_h2d 
    3333   USE obs_utils               ! Various observation tools 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/OBS/obs_readmdt.F90

    r10425 r11053  
    2525      &                    tmask, tmask_i, e1e2t, gphit, glamt 
    2626   USE obs_const, ONLY :   obfillflt      ! Fillvalue 
    27    USE oce      , ONLY :   sshn           ! Model variables 
     27   USE oce      , ONLY :   ssh            ! Model variables 
    2828 
    2929   IMPLICIT NONE 
    … …  
    4444CONTAINS 
    4545 
    46    SUBROUTINE obs_rea_mdt( sladata, k2dint ) 
     46   SUBROUTINE obs_rea_mdt( sladata, k2dint, Kmm ) 
    4747      !!--------------------------------------------------------------------- 
    4848      !! 
    … …  
    5959      TYPE(obs_surf), INTENT(inout) ::   sladata   ! SLA data 
    6060      INTEGER       , INTENT(in)    ::   k2dint    ! ? 
     61      INTEGER       , INTENT(in)    ::   Kmm       ! ? 
    6162      ! 
    6263      CHARACTER(LEN=12), PARAMETER ::   cpname  = 'obs_rea_mdt' 
    … …  
    106107      ! Remove the offset between the MDT used with the sla and the model MDT 
    107108      IF( nn_msshc == 1 .OR. nn_msshc == 2 ) & 
    108          & CALL obs_offset_mdt( jpi, jpj, z_mdt, zfill ) 
     109         & CALL obs_offset_mdt( jpi, jpj, z_mdt, zfill, Kmm ) 
    109110 
    110111      ! Intepolate the MDT already on the model grid at the observation point 
    … …  
    169170 
    170171 
    171    SUBROUTINE obs_offset_mdt( kpi, kpj, mdt, zfill ) 
     172   SUBROUTINE obs_offset_mdt( kpi, kpj, mdt, zfill, Kmm ) 
    172173      !!--------------------------------------------------------------------- 
    173174      !! 
    … …  
    183184      !!---------------------------------------------------------------------- 
    184185      INTEGER, INTENT(IN) ::  kpi, kpj 
     186      INTEGER, INTENT(IN) ::  Kmm 
    185187      REAL(wp), DIMENSION(kpi,kpj), INTENT(INOUT) ::   mdt     ! MDT used on the model grid 
    186188      REAL(wp)                    , INTENT(IN   ) ::   zfill  
    … …  
    216218          zarea = zarea + zdxdy 
    217219          zeta1 = zeta1 + mdt(ji,jj) * zdxdy 
    218           zeta2 = zeta2 + sshn (ji,jj) * zdxdy 
     220          zeta2 = zeta2 + ssh(ji,jj,Kmm) * zdxdy 
    219221        END DO       
    220222      END DO 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/OBS/obs_sstbias.F90

    r9023 r11053  
    2828      & glamt 
    2929   USE oce, ONLY : &           ! Model variables 
    30       & sshn 
     30      & ssh 
    3131   USE obs_inter_h2d 
    3232   USE obs_utils               ! Various observation tools 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/SBC/fldread.F90

    r10922 r11053  
    130130CONTAINS 
    131131 
    132    SUBROUTINE fld_read( kt, kn_fsbc, sd, map, kit, kt_offset, jpk_bdy, fvl ) 
     132   SUBROUTINE fld_read( kt, kn_fsbc, sd, map, kit, kt_offset, jpk_bdy, fvl, Kmm ) 
    133133      !!--------------------------------------------------------------------- 
    134134      !!                    ***  ROUTINE fld_read  *** 
    … …  
    153153      INTEGER  , INTENT(in   ), OPTIONAL     ::   jpk_bdy   ! number of vertical levels in the BDY data 
    154154      LOGICAL  , INTENT(in   ), OPTIONAL     ::   fvl   ! number of vertical levels in the BDY data 
     155      INTEGER  , INTENT(in   ), OPTIONAL     ::   Kmm   ! ocean time level index 
    155156      !! 
    156157      INTEGER  ::   itmp         ! local variable 
    … …  
    287288               ! read after data 
    288289               IF( PRESENT(jpk_bdy) ) THEN 
    289                   CALL fld_get( sd(jf), imap, jpk_bdy, fvl) 
     290                  CALL fld_get( sd(jf), imap, jpk_bdy, fvl, Kmm ) 
    290291               ELSE 
    291292                  CALL fld_get( sd(jf), imap ) 
    … …  
    614615 
    615616 
    616    SUBROUTINE fld_get( sdjf, map, jpk_bdy, fvl ) 
     617   SUBROUTINE fld_get( sdjf, map, jpk_bdy, fvl, Kmm ) 
    617618      !!--------------------------------------------------------------------- 
    618619      !!                    ***  ROUTINE fld_get  *** 
    … …  
    624625      INTEGER  , INTENT(in), OPTIONAL  ::   jpk_bdy ! number of vertical levels in the bdy data 
    625626      LOGICAL  , INTENT(in), OPTIONAL  ::   fvl     ! number of vertical levels in the bdy data 
     627      INTEGER  , INTENT(in), OPTIONAL  ::   Kmm     ! ocean time level index 
    626628      ! 
    627629      INTEGER ::   ipk      ! number of vertical levels of sdjf%fdta ( 2D: ipk=1 ; 3D: ipk=jpk ) 
    … …  
    638640         IF( PRESENT(jpk_bdy) ) THEN 
    639641            IF( sdjf%ln_tint ) THEN   ;   CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fdta(:,:,:,2),                & 
    640                                                         sdjf%nrec_a(1), map, sdjf%igrd, sdjf%ibdy, jpk_bdy, fvl ) 
     642                                                        sdjf%nrec_a(1), map, sdjf%igrd, sdjf%ibdy, jpk_bdy, fvl, Kmm ) 
    641643            ELSE                      ;   CALL fld_map( sdjf%num, sdjf%clvar, sdjf%fnow(:,:,:  ),                & 
    642                                                         sdjf%nrec_a(1), map, sdjf%igrd, sdjf%ibdy, jpk_bdy, fvl ) 
     644                                                        sdjf%nrec_a(1), map, sdjf%igrd, sdjf%ibdy, jpk_bdy, fvl, Kmm ) 
    643645            ENDIF 
    644646         ELSE 
    … …  
    701703   END SUBROUTINE fld_get 
    702704 
    703    SUBROUTINE fld_map( num, clvar, dta, nrec, map, igrd, ibdy, jpk_bdy, fvl ) 
     705   SUBROUTINE fld_map( num, clvar, dta, nrec, map, igrd, ibdy, jpk_bdy, fvl, Kmm ) 
    704706      !!--------------------------------------------------------------------- 
    705707      !!                    ***  ROUTINE fld_map  *** 
    … …  
    718720      INTEGER  , INTENT(in), OPTIONAL         ::   igrd, ibdy, jpk_bdy  ! grid type, set number and number of vertical levels in the bdy data 
    719721      LOGICAL  , INTENT(in), OPTIONAL         ::   fvl     ! grid type, set number and number of vertical levels in the bdy data 
     722      INTEGER  , INTENT(in), OPTIONAL         ::   Kmm     ! ocean time level index  
    720723      INTEGER                                 ::   jpkm1_bdy! number of vertical levels in the bdy data minus 1 
    721724      !! 
    … …  
    813816 
    814817      IF ( ln_bdy ) &  
    815          CALL fld_bdy_interp(dta_read, dta_read_z, dta_read_dz, map, jpk_bdy, igrd, ibdy, fv, dta, fvl, ilendta) 
     818         CALL fld_bdy_interp(dta_read, dta_read_z, dta_read_dz, map, jpk_bdy, igrd, ibdy, fv, dta, fvl, ilendta, Kmm) 
    816819 
    817820      ELSE ! boundary data assumed to be on model grid 
    … …  
    838841   END SUBROUTINE fld_map 
    839842    
    840    SUBROUTINE fld_bdy_interp(dta_read, dta_read_z, dta_read_dz, map, jpk_bdy, igrd, ibdy, fv, dta, fvl, ilendta) 
     843   SUBROUTINE fld_bdy_interp(dta_read, dta_read_z, dta_read_dz, map, jpk_bdy, igrd, ibdy, fv, dta, fvl, ilendta, Kmm) 
    841844 
    842845      !!--------------------------------------------------------------------- 
    … …  
    857860      INTEGER  , INTENT(in)                   ::   igrd, ibdy, jpk_bdy        ! number of levels in bdy data 
    858861      INTEGER  , INTENT(in)                   ::   ilendta                    ! length of data in file 
     862      INTEGER  , INTENT(in), OPTIONAL         ::   Kmm                        ! ocean time level index 
    859863      !! 
    860864      INTEGER                                 ::   ipi                        ! length of boundary data on local process 
    … …  
    900904            SELECT CASE( igrd )                          
    901905               CASE(1) 
    902                   IF( ABS( (zh - ht_n(zij,zjj)) / ht_n(zij,zjj)) * tmask(zij,zjj,1) > 0.01_wp ) THEN 
     906                  IF( ABS( (zh - ht(zij,zjj)) / ht(zij,zjj)) * tmask(zij,zjj,1) > 0.01_wp ) THEN 
    903907                     WRITE(ibstr,"(I10.10)") map%ptr(ib)  
    904908                     CALL ctl_warn('fld_bdy_interp: T depths differ between grids at BDY point '//TRIM(ibstr)//' by more than 1%') 
    905                  !   IF(lwp) WRITE(*,*) 'DEPTHT', zh, sum(e3t(zij,zjj,:,nfld_Nnn), mask=tmask(zij,zjj,:)==1),  ht_n(zij,zjj), map%ptr(ib), ib, zij, zjj 
     909                 !   IF(lwp) WRITE(*,*) 'DEPTHT', zh, sum(e3t(zij,zjj,:,Kmm), mask=tmask(zij,zjj,:)==1),  ht(zij,zjj), map%ptr(ib), ib, zij, zjj 
    906910                  ENDIF 
    907911               CASE(2) 
    908                   IF( ABS( (zh - hu_n(zij,zjj)) * r1_hu_n(zij,zjj)) * umask(zij,zjj,1) > 0.01_wp ) THEN 
     912                  IF( ABS( (zh - hu(zij,zjj,Kmm)) * r1_hu(zij,zjj,Kmm)) * umask(zij,zjj,1) > 0.01_wp ) THEN 
    909913                     WRITE(ibstr,"(I10.10)") map%ptr(ib)  
    910914                     CALL ctl_warn('fld_bdy_interp: U depths differ between grids at BDY point '//TRIM(ibstr)//' by more than 1%') 
    911                      IF(lwp) WRITE(*,*) 'DEPTHU', zh, sum(e3u(zij,zjj,:,nfld_Nnn), mask=umask(zij,zjj,:)==1),  sum(umask(zij,zjj,:)), & 
    912                        &                hu_n(zij,zjj), map%ptr(ib), ib, zij, zjj, narea-1  , & 
     915                     IF(lwp) WRITE(*,*) 'DEPTHU', zh, sum(e3u(zij,zjj,:,Kmm), mask=umask(zij,zjj,:)==1),  sum(umask(zij,zjj,:)), & 
     916                       &                hu(zij,zjj,Kmm), map%ptr(ib), ib, zij, zjj, narea-1  , & 
    913917                        &                dta_read(map%ptr(ib),1,:) 
    914918                  ENDIF 
    915919               CASE(3) 
    916                   IF( ABS( (zh - hv_n(zij,zjj)) * r1_hv_n(zij,zjj)) * vmask(zij,zjj,1) > 0.01_wp ) THEN 
     920                  IF( ABS( (zh - hv(zij,zjj,Kmm)) * r1_hv(zij,zjj,Kmm)) * vmask(zij,zjj,1) > 0.01_wp ) THEN 
    917921                     WRITE(ibstr,"(I10.10)") map%ptr(ib)  
    918922                     CALL ctl_warn('fld_bdy_interp: V depths differ between grids at BDY point '//TRIM(ibstr)//' by more than 1%') 
    … …  
    922926               SELECT CASE( igrd )                        
    923927                  CASE(1) 
    924                      zl =  gdept(zij,zjj,ik,nfld_Nnn)                                          ! if using in step could use fsdept instead of gdept_n? 
     928                     zl =  gdept(zij,zjj,ik,Kmm)                                          ! if using in step could use fsdept instead of gdept_n? 
    925929                  CASE(2) 
    926930                     IF(ln_sco) THEN 
    927                         zl =  ( gdept(zij,zjj,ik,nfld_Nnn) + gdept(zij+1,zjj,ik,nfld_Nnn) ) * 0.5_wp  ! if using in step could use fsdept instead of gdept_n? 
     931                        zl =  ( gdept(zij,zjj,ik,Kmm) + gdept(zij+1,zjj,ik,Kmm) ) * 0.5_wp  ! if using in step could use fsdept instead of gdept_n? 
    928932                     ELSE 
    929                         zl =  MIN( gdept(zij,zjj,ik,nfld_Nnn), gdept(zij+1,zjj,ik,nfld_Nnn) )  
     933                        zl =  MIN( gdept(zij,zjj,ik,Kmm), gdept(zij+1,zjj,ik,Kmm) )  
    930934                     ENDIF 
    931935                  CASE(3) 
    932936                     IF(ln_sco) THEN 
    933                         zl =  ( gdept(zij,zjj,ik,nfld_Nnn) + gdept(zij,zjj+1,ik,nfld_Nnn) ) * 0.5_wp  ! if using in step could use fsdept instead of gdept_n? 
     937                        zl =  ( gdept(zij,zjj,ik,Kmm) + gdept(zij,zjj+1,ik,Kmm) ) * 0.5_wp  ! if using in step could use fsdept instead of gdept_n? 
    934938                     ELSE 
    935                         zl =  MIN( gdept(zij,zjj,ik,nfld_Nnn), gdept(zij,zjj+1,ik,nfld_Nnn) ) 
     939                        zl =  MIN( gdept(zij,zjj,ik,Kmm), gdept(zij,zjj+1,ik,Kmm) ) 
    936940                     ENDIF 
    937941               END SELECT 
    … …  
    941945                  dta(ib,1,ik) =  dta_read(map%ptr(ib),1,MAXLOC(dta_read_z(map%ptr(ib),1,:),1)) 
    942946               ELSE                                                                                ! inbetween : vertical interpolation between ikk & ikk+1 
    943                   DO ikk = 1, jpkm1_bdy                                                            ! when  gdept(ikk,nfld_Nnn) < zl < gdept(ikk+1,nfld_Nnn) 
     947                  DO ikk = 1, jpkm1_bdy                                                            ! when  gdept(ikk,Kmm) < zl < gdept(ikk+1,Kmm) 
    944948                     IF( ( (zl-dta_read_z(map%ptr(ib),1,ikk)) * (zl-dta_read_z(map%ptr(ib),1,ikk+1)) <= 0._wp) & 
    945949                    &    .AND. (dta_read_z(map%ptr(ib),1,ikk+1) /= fv_alt)) THEN 
    … …  
    965969              ENDDO 
    966970              DO ik = 1, ipk                                ! calculate transport on model grid 
    967                   ztrans_new = ztrans_new + dta(ib,1,ik) * e3u(zij,zjj,ik,nfld_Nnn) * umask(zij,zjj,ik) 
     971                  ztrans_new = ztrans_new + dta(ib,1,ik) * e3u(zij,zjj,ik,Kmm) * umask(zij,zjj,ik) 
    968972              ENDDO 
    969973              DO ik = 1, ipk                                ! make transport correction 
    970974                 IF(fvl) THEN ! bdy data are total velocity so adjust bt transport term to match input data 
    971                     dta(ib,1,ik) = ( dta(ib,1,ik) + ( ztrans - ztrans_new ) * r1_hu_n(zij,zjj) ) * umask(zij,zjj,ik) 
     975                    dta(ib,1,ik) = ( dta(ib,1,ik) + ( ztrans - ztrans_new ) * r1_hu(zij,zjj,Kmm) ) * umask(zij,zjj,ik) 
    972976                 ELSE ! we're just dealing with bc velocity so bt transport term should sum to zero 
    973                     IF( ABS(ztrans * r1_hu_n(zij,zjj)) > 0.01_wp ) & 
     977                    IF( ABS(ztrans * r1_hu(zij,zjj,Kmm)) > 0.01_wp ) & 
    974978                   &   CALL ctl_warn('fld_bdy_interp: barotropic component of > 0.01 ms-1 found in baroclinic velocities at') 
    975                     dta(ib,1,ik) = dta(ib,1,ik) + ( 0._wp - ztrans_new ) * r1_hu_n(zij,zjj) * umask(zij,zjj,ik) 
     979                    dta(ib,1,ik) = dta(ib,1,ik) + ( 0._wp - ztrans_new ) * r1_hu(zij,zjj,Kmm) * umask(zij,zjj,ik) 
    976980                 ENDIF 
    977981              ENDDO 
    … …  
    990994              ENDDO 
    991995              DO ik = 1, ipk                                ! calculate transport on model grid 
    992                   ztrans_new = ztrans_new + dta(ib,1,ik) * e3v(zij,zjj,ik,nfld_Nnn) * vmask(zij,zjj,ik) 
     996                  ztrans_new = ztrans_new + dta(ib,1,ik) * e3v(zij,zjj,ik,Kmm) * vmask(zij,zjj,ik) 
    993997              ENDDO 
    994998              DO ik = 1, ipk                                ! make transport correction 
    995999                 IF(fvl) THEN ! bdy data are total velocity so adjust bt transport term to match input data 
    996                     dta(ib,1,ik) = ( dta(ib,1,ik) + ( ztrans - ztrans_new ) * r1_hv_n(zij,zjj) ) * vmask(zij,zjj,ik) 
     1000                    dta(ib,1,ik) = ( dta(ib,1,ik) + ( ztrans - ztrans_new ) * r1_hv(zij,zjj,Kmm) ) * vmask(zij,zjj,ik) 
    9971001                 ELSE ! we're just dealing with bc velocity so bt transport term should sum to zero 
    998                     dta(ib,1,ik) = dta(ib,1,ik) + ( 0._wp - ztrans_new ) * r1_hv_n(zij,zjj) * vmask(zij,zjj,ik) 
     1002                    dta(ib,1,ik) = dta(ib,1,ik) + ( 0._wp - ztrans_new ) * r1_hv(zij,zjj,Kmm) * vmask(zij,zjj,ik) 
    9991003                 ENDIF 
    10001004              ENDDO 
    … …  
    10251029            SELECT CASE( igrd )                          
    10261030               CASE(1) 
    1027                   IF( ABS( (zh - ht_n(zij,zjj)) / ht_n(zij,zjj)) * tmask(zij,zjj,1) > 0.01_wp ) THEN 
     1031                  IF( ABS( (zh - ht(zij,zjj)) / ht(zij,zjj)) * tmask(zij,zjj,1) > 0.01_wp ) THEN 
    10281032                     WRITE(ibstr,"(I10.10)") map%ptr(ib)  
    10291033                     CALL ctl_warn('fld_bdy_interp: T depths differ between grids at BDY point '//TRIM(ibstr)//' by more than 1%') 
    1030                  !   IF(lwp) WRITE(*,*) 'DEPTHT', zh, sum(e3t(zij,zjj,:,nfld_Nnn), mask=tmask(zij,zjj,:)==1),  ht_n(zij,zjj), map%ptr(ib), ib, zij, zjj 
     1034                 !   IF(lwp) WRITE(*,*) 'DEPTHT', zh, sum(e3t(zij,zjj,:,Kmm), mask=tmask(zij,zjj,:)==1),  ht(zij,zjj), map%ptr(ib), ib, zij, zjj 
    10311035                  ENDIF 
    10321036               CASE(2) 
    1033                   IF( ABS( (zh - hu_n(zij,zjj)) * r1_hu_n(zij,zjj)) * umask(zij,zjj,1) > 0.01_wp ) THEN 
     1037                  IF( ABS( (zh - hu(zij,zjj,Kmm)) * r1_hu(zij,zjj,Kmm)) * umask(zij,zjj,1) > 0.01_wp ) THEN 
    10341038                     WRITE(ibstr,"(I10.10)") map%ptr(ib)  
    10351039                     CALL ctl_warn('fld_bdy_interp: U depths differ between grids at BDY point '//TRIM(ibstr)//' by more than 1%') 
    10361040                  ENDIF 
    10371041               CASE(3) 
    1038                   IF( ABS( (zh - hv_n(zij,zjj)) * r1_hv_n(zij,zjj)) * vmask(zij,zjj,1) > 0.01_wp ) THEN 
     1042                  IF( ABS( (zh - hv(zij,zjj,Kmm)) * r1_hv(zij,zjj,Kmm)) * vmask(zij,zjj,1) > 0.01_wp ) THEN 
    10391043                     WRITE(ibstr,"(I10.10)") map%ptr(ib)  
    10401044                     CALL ctl_warn('fld_bdy_interp: V depths differ between grids at BDY point '//TRIM(ibstr)//' by more than 1%') 
    … …  
    10441048               SELECT CASE( igrd )                          ! coded for sco - need zco and zps option using min 
    10451049                  CASE(1) 
    1046                      zl =  gdept(zij,zjj,ik,nfld_Nnn)              ! if using in step could use fsdept instead of gdept_n? 
     1050                     zl =  gdept(zij,zjj,ik,Kmm)              ! if using in step could use fsdept instead of gdept_n? 
    10471051                  CASE(2) 
    10481052                     IF(ln_sco) THEN 
    1049                         zl =  ( gdept(zij,zjj,ik,nfld_Nnn) + gdept(zij+1,zjj,ik,nfld_Nnn) ) * 0.5_wp  ! if using in step could use fsdept instead of gdept_n? 
     1053                        zl =  ( gdept(zij,zjj,ik,Kmm) + gdept(zij+1,zjj,ik,Kmm) ) * 0.5_wp  ! if using in step could use fsdept instead of gdept_n? 
    10501054                     ELSE 
    1051                         zl =  MIN( gdept(zij,zjj,ik,nfld_Nnn), gdept(zij+1,zjj,ik,nfld_Nnn) ) 
     1055                        zl =  MIN( gdept(zij,zjj,ik,Kmm), gdept(zij+1,zjj,ik,Kmm) ) 
    10521056                     ENDIF 
    10531057                  CASE(3) 
    10541058                     IF(ln_sco) THEN 
    1055                         zl =  ( gdept(zij,zjj,ik,nfld_Nnn) + gdept(zij,zjj+1,ik,nfld_Nnn) ) * 0.5_wp  ! if using in step could use fsdept instead of gdept_n? 
     1059                        zl =  ( gdept(zij,zjj,ik,Kmm) + gdept(zij,zjj+1,ik,Kmm) ) * 0.5_wp  ! if using in step could use fsdept instead of gdept_n? 
    10561060                     ELSE 
    1057                         zl =  MIN( gdept(zij,zjj,ik,nfld_Nnn), gdept(zij,zjj+1,ik,nfld_Nnn) ) 
     1061                        zl =  MIN( gdept(zij,zjj,ik,Kmm), gdept(zij,zjj+1,ik,Kmm) ) 
    10581062                     ENDIF 
    10591063               END SELECT 
    … …  
    10631067                  dta(ib,1,ik) =  dta_read(ji,jj,MAXLOC(dta_read_z(ji,jj,:),1)) 
    10641068               ELSE                                                                     ! inbetween : vertical interpolation between ikk & ikk+1 
    1065                   DO ikk = 1, jpkm1_bdy                                                 ! when  gdept(ikk,nfld_Nnn) < zl < gdept(ikk+1,nfld_Nnn) 
     1069                  DO ikk = 1, jpkm1_bdy                                                 ! when  gdept(ikk,Kmm) < zl < gdept(ikk+1,Kmm) 
    10661070                     IF( ( (zl-dta_read_z(ji,jj,ikk)) * (zl-dta_read_z(ji,jj,ikk+1)) <= 0._wp) & 
    10671071                    &    .AND. (dta_read_z(ji,jj,ikk+1) /= fv_alt)) THEN 
    … …  
    10891093               ENDDO 
    10901094               DO ik = 1, ipk                                ! calculate transport on model grid 
    1091                   ztrans_new = ztrans_new + dta(ib,1,ik) * e3u(zij,zjj,ik,nfld_Nnn) * umask(zij,zjj,ik) 
     1095                  ztrans_new = ztrans_new + dta(ib,1,ik) * e3u(zij,zjj,ik,Kmm) * umask(zij,zjj,ik) 
    10921096               ENDDO 
    10931097               DO ik = 1, ipk                                ! make transport correction 
    10941098                  IF(fvl) THEN ! bdy data are total velocity so adjust bt transport term to match input data 
    1095                      dta(ib,1,ik) = ( dta(ib,1,ik) + ( ztrans - ztrans_new ) * r1_hu_n(zij,zjj) ) * umask(zij,zjj,ik) 
     1099                     dta(ib,1,ik) = ( dta(ib,1,ik) + ( ztrans - ztrans_new ) * r1_hu(zij,zjj,Kmm) ) * umask(zij,zjj,ik) 
    10961100                  ELSE ! we're just dealing with bc velocity so bt transport term should sum to zero 
    1097                      dta(ib,1,ik) = ( dta(ib,1,ik) + ( 0._wp  - ztrans_new ) * r1_hu_n(zij,zjj) ) * umask(zij,zjj,ik) 
     1101                     dta(ib,1,ik) = ( dta(ib,1,ik) + ( 0._wp  - ztrans_new ) * r1_hu(zij,zjj,Kmm) ) * umask(zij,zjj,ik) 
    10981102                  ENDIF 
    10991103               ENDDO 
    … …  
    11141118               ENDDO 
    11151119               DO ik = 1, ipk                                ! calculate transport on model grid 
    1116                   ztrans_new = ztrans_new + dta(ib,1,ik) * e3v(zij,zjj,ik,nfld_Nnn) * vmask(zij,zjj,ik) 
     1120                  ztrans_new = ztrans_new + dta(ib,1,ik) * e3v(zij,zjj,ik,Kmm) * vmask(zij,zjj,ik) 
    11171121               ENDDO 
    11181122               DO ik = 1, ipk                                ! make transport correction 
    11191123                  IF(fvl) THEN ! bdy data are total velocity so adjust bt transport term to match input data 
    1120                      dta(ib,1,ik) = ( dta(ib,1,ik) + ( ztrans - ztrans_new ) * r1_hv_n(zij,zjj) ) * vmask(zij,zjj,ik) 
     1124                     dta(ib,1,ik) = ( dta(ib,1,ik) + ( ztrans - ztrans_new ) * r1_hv(zij,zjj,Kmm) ) * vmask(zij,zjj,ik) 
    11211125                  ELSE ! we're just dealing with bc velocity so bt transport term should sum to zero 
    1122                      dta(ib,1,ik) = ( dta(ib,1,ik) + ( 0._wp  - ztrans_new ) * r1_hv_n(zij,zjj) ) * vmask(zij,zjj,ik) 
     1126                     dta(ib,1,ik) = ( dta(ib,1,ik) + ( 0._wp  - ztrans_new ) * r1_hv(zij,zjj,Kmm) ) * vmask(zij,zjj,ik) 
    11231127                  ENDIF 
    11241128               ENDDO 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/SBC/sbccpl.F90

    r10922 r11053  
    3232   USE cpl_oasis3     ! OASIS3 coupling 
    3333   USE geo2ocean      !  
    34    USE oce     , ONLY : ts, uu, vv, sshn, sshb, fraqsr_1lev 
     34   USE oce     , ONLY : ts, uu, vv, ssh, fraqsr_1lev 
    3535   USE ocealb         !  
    3636   USE eosbn2         !  
    … …  
    20372037    
    20382038    
    2039    SUBROUTINE sbc_cpl_snd( kt, Kmm ) 
     2039   SUBROUTINE sbc_cpl_snd( kt, Kbb, Kmm ) 
    20402040      !!---------------------------------------------------------------------- 
    20412041      !!             ***  ROUTINE sbc_cpl_snd  *** 
    … …  
    20472047      !!---------------------------------------------------------------------- 
    20482048      INTEGER, INTENT(in) ::   kt 
    2049       INTEGER, INTENT(in) ::   Kmm    ! ocean model time level index 
     2049      INTEGER, INTENT(in) ::   Kbb, Kmm    ! ocean model time level index 
    20502050      ! 
    20512051      INTEGER ::   ji, jj, jl   ! dummy loop indices 
    … …  
    24762476         IF( ln_apr_dyn ) THEN   
    24772477            IF( kt /= nit000 ) THEN   
    2478                ztmp1(:,:) = sshb(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )   
     2478               ztmp1(:,:) = ssh(:,:,Kbb) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) )   
    24792479            ELSE   
    2480                ztmp1(:,:) = sshb(:,:)   
     2480               ztmp1(:,:) = ssh(:,:,Kbb)   
    24812481            ENDIF   
    24822482         ELSE   
    2483             ztmp1(:,:) = sshn(:,:)   
     2483            ztmp1(:,:) = ssh(:,:,Kmm)   
    24842484         ENDIF   
    24852485         CALL cpl_snd( jps_wlev  , isec, RESHAPE ( ztmp1, (/jpi,jpj,1/) ), info )  
    … …  
    24912491         !                          ! removed inverse barometer ssh when Patm 
    24922492         !                          forcing is used (for sea-ice dynamics) 
    2493          IF( ln_apr_dyn ) THEN   ;   ztmp1(:,:) = sshb(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 
    2494          ELSE                    ;   ztmp1(:,:) = sshn(:,:) 
     2493         IF( ln_apr_dyn ) THEN   ;   ztmp1(:,:) = ssh(:,:,Kbb) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 
     2494         ELSE                    ;   ztmp1(:,:) = ssh(:,:,Kmm) 
    24952495         ENDIF 
    24962496         CALL cpl_snd( jps_ssh   , isec, RESHAPE ( ztmp1            , (/jpi,jpj,1/) ), info ) 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/SBC/sbcfwb.F90

    r10570 r11053  
    4848CONTAINS 
    4949 
    50    SUBROUTINE sbc_fwb( kt, kn_fwb, kn_fsbc ) 
     50   SUBROUTINE sbc_fwb( kt, kn_fwb, kn_fsbc, Kmm ) 
    5151      !!--------------------------------------------------------------------- 
    5252      !!                  ***  ROUTINE sbc_fwb  *** 
    … …  
    6565      INTEGER, INTENT( in ) ::   kn_fsbc  !  
    6666      INTEGER, INTENT( in ) ::   kn_fwb   ! ocean time-step index 
     67      INTEGER, INTENT( in ) ::   Kmm      ! ocean time level index 
    6768      ! 
    6869      INTEGER  ::   inum, ikty, iyear     ! local integers 
    … …  
    131132            a_fwb_b = a_fwb                           ! mean sea level taking into account the ice+snow 
    132133                                                      ! sum over the global domain 
    133             a_fwb   = glob_sum( 'sbcfwb', e1e2t(:,:) * ( sshn(:,:) + snwice_mass(:,:) * r1_rau0 ) ) 
     134            a_fwb   = glob_sum( 'sbcfwb', e1e2t(:,:) * ( ssh(:,:,Kmm) + snwice_mass(:,:) * r1_rau0 ) ) 
    134135            a_fwb   = a_fwb * 1.e+3 / ( area * rday * 365. )     ! convert in Kg/m3/s = mm/s 
    135136!!gm        !                                                      !!bug 365d year  

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/SBC/sbcice_cice.F90

    r10922 r11053  
    147147 
    148148 
    149    SUBROUTINE cice_sbc_init( ksbc ) 
     149   SUBROUTINE cice_sbc_init( ksbc, Kbb, Kmm ) 
    150150      !!--------------------------------------------------------------------- 
    151151      !!                    ***  ROUTINE cice_sbc_init  *** 
    … …  
    154154      !!--------------------------------------------------------------------- 
    155155      INTEGER, INTENT( in  ) ::   ksbc                ! surface forcing type 
     156      INTEGER, INTENT( in  ) ::   Kbb, Kmm            ! time level indices 
    156157      REAL(wp), DIMENSION(jpi,jpj) :: ztmp1, ztmp2 
    157158      REAL(wp) ::   zcoefu, zcoefv, zcoeff            ! local scalar 
    … …  
    227228      IF( .NOT.ln_rstart ) THEN 
    228229         IF( ln_ice_embd ) THEN            ! embedded sea-ice: deplete the initial ssh below sea-ice area 
    229             sshn(:,:) = sshn(:,:) - snwice_mass(:,:) * r1_rau0 
    230             sshb(:,:) = sshb(:,:) - snwice_mass(:,:) * r1_rau0 
     230            ssh(:,:,Kmm) = ssh(:,:,Kmm) - snwice_mass(:,:) * r1_rau0 
     231            ssh(:,:,Kbb) = ssh(:,:,Kbb) - snwice_mass(:,:) * r1_rau0 
    231232 
    232233!!gm This should be put elsewhere....   (same remark for limsbc) 
    … …  
    235236               ! 
    236237               DO jk = 1,jpkm1                     ! adjust initial vertical scale factors 
    237                   e3t(:,:,jk,Kmm) = e3t_0(:,:,jk)*( 1._wp + sshn(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 
    238                   e3t(:,:,jk,Kbb) = e3t_0(:,:,jk)*( 1._wp + sshb(:,:)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 
     238                  e3t(:,:,jk,Kmm) = e3t_0(:,:,jk)*( 1._wp + ssh(:,:,Kmm)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 
     239                  e3t(:,:,jk,Kbb) = e3t_0(:,:,jk)*( 1._wp + ssh(:,:,Kbb)*tmask(:,:,1)/(ht_0(:,:) + 1.0 - tmask(:,:,1)) ) 
    239240               ENDDO 
    240241               e3t(:,:,:,Krhs) = e3t(:,:,:,Kbb) 
    … …  
    259260               gdept(:,:,1,Kmm) = 0.5_wp * e3w(:,:,1,Kmm) 
    260261               gdepw(:,:,1,Kmm) = 0.0_wp 
    261                gde3w(:,:,1)     = gdept(:,:,1,Kmm) - sshn(:,:) 
     262               gde3w(:,:,1)     = gdept(:,:,1,Kmm) - ssh(:,:,Kmm) 
    262263               DO jk = 2, jpk 
    263264                  gdept(:,:,jk,Kmm) = gdept(:,:,jk-1,Kmm) + e3w(:,:,jk,Kmm) 
    … …  
    10561057   END SUBROUTINE sbc_ice_cice 
    10571058 
    1058    SUBROUTINE cice_sbc_init (ksbc)    ! Dummy routine 
     1059   SUBROUTINE cice_sbc_init (ksbc, Kbb, Kmm)    ! Dummy routine 
    10591060      IMPLICIT NONE 
    10601061      INTEGER, INTENT( in ) :: ksbc 
     1062      INTEGER, INTENT( in ) :: Kbb, Kmm 
    10611063      WRITE(*,*) 'cice_sbc_init: You should not have seen this print! error?', ksbc 
    10621064   END SUBROUTINE cice_sbc_init 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/SBC/sbcisf.F90

    r10954 r11053  
    149149         DO jj = 1,jpj 
    150150            DO ji = 1,jpi 
    151                zdep(ji,jj)=gdepw_n(ji,jj,misfkt(ji,jj)) 
     151               zdep(ji,jj)=gdepw(ji,jj,misfkt(ji,jj),Kmm) 
    152152            END DO 
    153153         END DO 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/SBC/sbcmod.F90

    r10998 r11053  
    341341                          IF( sbc_ice_alloc() /= 0 )   CALL ctl_stop('STOP', 'sbc_ice_alloc : unable to allocate arrays' ) 
    342342      ELSEIF( nn_ice == 2 ) THEN 
    343                           CALL ice_init( Kbb, Kmm, Kaa )  ! ICE initialization 
     343                          CALL ice_init( Kbb, Kmm, Kaa )         ! ICE initialization 
    344344      ENDIF 
    345345#endif 
    346       IF( nn_ice == 3 )   CALL cice_sbc_init( nsbc )   ! CICE initialization 
    347       ! 
    348       IF( ln_wave     )   CALL sbc_wave_init           ! surface wave initialisation 
     346      IF( nn_ice == 3 )   CALL cice_sbc_init( nsbc, Kbb, Kmm )   ! CICE initialization 
     347      ! 
     348      IF( ln_wave     )   CALL sbc_wave_init                     ! surface wave initialisation 
    349349      ! 
    350350      IF( lwxios ) THEN 
    … …  
    442442      CASE(  1 )   ;         CALL sbc_ice_if   ( kt, Kbb, Kmm )   ! Ice-cover climatology ("Ice-if" model) 
    443443#if defined key_si3 
    444       CASE(  2 )   ;         CALL ice_stp  ( kt, Kbb, nsbc )  ! SI3 ice model 
     444      CASE(  2 )   ;         CALL ice_stp  ( kt, Kbb, Kmm, nsbc ) ! SI3 ice model 
    445445#endif 
    446446      CASE(  3 )   ;         CALL sbc_ice_cice ( kt, nsbc )       ! CICE ice model 
    … …  
    454454      ENDIF 
    455455 
    456       IF( ln_isf         )   CALL sbc_isf( kt, Kmm )              ! compute iceshelves 
    457  
    458       IF( ln_rnf         )   CALL sbc_rnf( kt )                   ! add runoffs to fresh water fluxes 
    459  
    460       IF( ln_ssr         )   CALL sbc_ssr( kt )                   ! add SST/SSS damping term 
    461  
    462       IF( nn_fwb    /= 0 )   CALL sbc_fwb( kt, nn_fwb, nn_fsbc )  ! control the freshwater budget 
     456      IF( ln_isf         )   CALL sbc_isf( kt, Kmm )                   ! compute iceshelves 
     457 
     458      IF( ln_rnf         )   CALL sbc_rnf( kt )                        ! add runoffs to fresh water fluxes 
     459 
     460      IF( ln_ssr         )   CALL sbc_ssr( kt )                        ! add SST/SSS damping term 
     461 
     462      IF( nn_fwb    /= 0 )   CALL sbc_fwb( kt, nn_fwb, nn_fsbc, Kmm )  ! control the freshwater budget 
    463463 
    464464      ! Special treatment of freshwater fluxes over closed seas in the model domain 
    … …  
    471471      IF ( ll_wd ) THEN     ! If near WAD point limit the flux for now 
    472472         zthscl = atanh(rn_wd_sbcfra)                     ! taper frac default is .999  
    473          zwdht(:,:) = sshn(:,:) + ht_0(:,:) - rn_wdmin1   ! do this calc of water 
     473         zwdht(:,:) = ssh(:,:,Kmm) + ht_0(:,:) - rn_wdmin1   ! do this calc of water 
    474474                                                     ! depth above wd limit once 
    475475         WHERE( zwdht(:,:) <= 0.0 ) 
    … …  
    557557      ! 
    558558      IF(ln_ctl) THEN         ! print mean trends (used for debugging) 
    559          CALL prt_ctl(tab2d_1=fr_i              , clinfo1=' fr_i    - : ', mask1=tmask ) 
    560          CALL prt_ctl(tab2d_1=(emp-rnf + fwfisf), clinfo1=' emp-rnf - : ', mask1=tmask ) 
    561          CALL prt_ctl(tab2d_1=(sfx-rnf + fwfisf), clinfo1=' sfx-rnf - : ', mask1=tmask ) 
    562          CALL prt_ctl(tab2d_1=qns              , clinfo1=' qns      - : ', mask1=tmask ) 
    563          CALL prt_ctl(tab2d_1=qsr              , clinfo1=' qsr      - : ', mask1=tmask ) 
    564          CALL prt_ctl(tab3d_1=tmask            , clinfo1=' tmask    - : ', mask1=tmask, kdim=jpk ) 
    565          CALL prt_ctl(tab3d_1=tsn(:,:,:,jp_tem), clinfo1=' sst      - : ', mask1=tmask, kdim=1   ) 
    566          CALL prt_ctl(tab3d_1=tsn(:,:,:,jp_sal), clinfo1=' sss      - : ', mask1=tmask, kdim=1   ) 
    567          CALL prt_ctl(tab2d_1=utau             , clinfo1=' utau     - : ', mask1=umask,                      & 
    568             &         tab2d_2=vtau             , clinfo2=' vtau     - : ', mask2=vmask ) 
     559         CALL prt_ctl(tab2d_1=fr_i                , clinfo1=' fr_i    - : ' , mask1=tmask ) 
     560         CALL prt_ctl(tab2d_1=(emp-rnf + fwfisf)  , clinfo1=' emp-rnf - : ' , mask1=tmask ) 
     561         CALL prt_ctl(tab2d_1=(sfx-rnf + fwfisf)  , clinfo1=' sfx-rnf - : ' , mask1=tmask ) 
     562         CALL prt_ctl(tab2d_1=qns                 , clinfo1=' qns      - : ', mask1=tmask ) 
     563         CALL prt_ctl(tab2d_1=qsr                 , clinfo1=' qsr      - : ', mask1=tmask ) 
     564         CALL prt_ctl(tab3d_1=tmask               , clinfo1=' tmask    - : ', mask1=tmask, kdim=jpk ) 
     565         CALL prt_ctl(tab3d_1=ts(:,:,:,jp_tem,Kmm), clinfo1=' sst      - : ', mask1=tmask, kdim=1   ) 
     566         CALL prt_ctl(tab3d_1=ts(:,:,:,jp_sal,Kmm), clinfo1=' sss      - : ', mask1=tmask, kdim=1   ) 
     567         CALL prt_ctl(tab2d_1=utau                , clinfo1=' utau     - : ', mask1=umask,                      & 
     568            &         tab2d_2=vtau                , clinfo2=' vtau     - : ', mask2=vmask ) 
    569569      ENDIF 
    570570 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/SBC/sbcssm.F90

    r10922 r11053  
    7777         sss_m(:,:) = zts(:,:,jp_sal) 
    7878         !                          ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics) 
    79          IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 
    80          ELSE                    ;   ssh_m(:,:) = sshn(:,:) 
     79         IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = ssh(:,:,Kmm) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 
     80         ELSE                    ;   ssh_m(:,:) = ssh(:,:,Kmm) 
    8181         ENDIF 
    8282         ! 
    … …  
    100100            sss_m(:,:) = zcoef * zts(:,:,jp_sal) 
    101101            !                          ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics) 
    102             IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = zcoef * ( sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) ) 
    103             ELSE                    ;   ssh_m(:,:) = zcoef * sshn(:,:) 
     102            IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = zcoef * ( ssh(:,:,Kmm) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) ) 
     103            ELSE                    ;   ssh_m(:,:) = zcoef *   ssh(:,:,Kmm) 
    104104            ENDIF 
    105105            ! 
    … …  
    128128         sss_m(:,:) = sss_m(:,:) + zts(:,:,jp_sal) 
    129129         !                          ! removed inverse barometer ssh when Patm forcing is used (for sea-ice dynamics) 
    130          IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = ssh_m(:,:) + sshn(:,:) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 
    131          ELSE                    ;   ssh_m(:,:) = ssh_m(:,:) + sshn(:,:) 
     130         IF( ln_apr_dyn ) THEN   ;   ssh_m(:,:) = ssh_m(:,:) + ssh(:,:,Kmm) - 0.5 * ( ssh_ib(:,:) + ssh_ibb(:,:) ) 
     131         ELSE                    ;   ssh_m(:,:) = ssh_m(:,:) + ssh(:,:,Kmm) 
    132132         ENDIF 
    133133         ! 
    … …  
    250250         ENDIF 
    251251         sss_m(:,:) = ts  (:,:,1,jp_sal,Kmm) 
    252          ssh_m(:,:) = sshn(:,:) 
     252         ssh_m(:,:) = ssh(:,:,Kmm) 
    253253         e3t_m(:,:) = e3t (:,:,1,Kmm) 
    254254         frq_m(:,:) = 1._wp 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/TRD/trddyn.F90

    r10946 r11053  
    123123                              z3dx(:,:,:) = 0._wp                  ! U.dxU & V.dyV (approximation) 
    124124                              z3dy(:,:,:) = 0._wp 
    125                               DO jk = 1, jpkm1   ! no mask as un,vn are masked 
     125                              DO jk = 1, jpkm1   ! no mask as uu, vv are masked 
    126126                                 DO jj = 2, jpjm1 
    127127                                    DO ji = 2, jpim1 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/TRD/trdvor.F90

    r10946 r11053  
    189189 
    190190      ! Average except for Beta.V 
    191       zudpvor(:,:) = zudpvor(:,:) * r1_hu_n(:,:) 
    192       zvdpvor(:,:) = zvdpvor(:,:) * r1_hv_n(:,:) 
     191      zudpvor(:,:) = zudpvor(:,:) * r1_hu(:,:,Kmm) 
     192      zvdpvor(:,:) = zvdpvor(:,:) * r1_hv(:,:,Kmm) 
    193193    
    194194      ! Curl 
    … …  
    276276         END DO 
    277277         ! Average of the Curl and Surface mask 
    278          vortrd(:,:,jpvor_bev) = vortrd(:,:,jpvor_bev) * r1_hu_n(:,:) * fmask(:,:,1) 
     278         vortrd(:,:,jpvor_bev) = vortrd(:,:,jpvor_bev) * r1_hu(:,:,Kmm) * fmask(:,:,1) 
    279279      ENDIF 
    280280      ! 
    281281      ! Average  
    282       zudpvor(:,:) = zudpvor(:,:) * r1_hu_n(:,:) 
    283       zvdpvor(:,:) = zvdpvor(:,:) * r1_hv_n(:,:) 
     282      zudpvor(:,:) = zudpvor(:,:) * r1_hu(:,:,Kmm) 
     283      zvdpvor(:,:) = zvdpvor(:,:) * r1_hv(:,:,Kmm) 
    284284      ! 
    285285      ! Curl 
    … …  
    342342      END DO 
    343343  
    344       zuu(:,:) = zuu(:,:) * r1_hu_n(:,:) 
    345       zvv(:,:) = zvv(:,:) * r1_hv_n(:,:) 
     344      zuu(:,:) = zuu(:,:) * r1_hu(:,:,Kmm) 
     345      zvv(:,:) = zvv(:,:) * r1_hv(:,:,Kmm) 
    346346 
    347347      ! Curl 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/ZDF/zdfosm.F90

    r10955 r11053  
    489489 
    490490      zhbl_t(:,:) = hbl(:,:) + (zdhdt(:,:) - ww(ji,jj,ibld(ji,jj)))* rn_rdt ! certainly need wb here, so subtract it 
    491       zhbl_t(:,:) = MIN(zhbl_t(:,:), ht_n(:,:)) 
     491      zhbl_t(:,:) = MIN(zhbl_t(:,:), ht(:,:)) 
    492492      zdhdt(:,:) = MIN(zdhdt(:,:), (zhbl_t(:,:) - hbl(:,:))/rn_rdt + ww(ji,jj,ibld(ji,jj))) ! adjustment to represent limiting by ocean bottom 
    493493 
    … …  
    525525 
    526526                     zhbl_s = zhbl_s + MIN( - zwb_ent(ji,jj) / zdb * rn_rdt / FLOAT(ibld(ji,jj)-imld(ji,jj) ), e3w(ji,jj,jk,Kmm) ) 
    527                      zhbl_s = MIN(zhbl_s, ht_n(ji,jj)) 
     527                     zhbl_s = MIN(zhbl_s, ht(ji,jj)) 
    528528 
    529529                     IF ( zhbl_s >= gdepw(ji,jj,jm+1,Kmm) ) jm = jm + 1 
    … …  
    546546                          &          * zwstrl(ji,jj)**3 / hbli(ji,jj) ) / zdb * e3w(ji,jj,jk,Kmm) / zdhdt(ji,jj)  ! ALMG to investigate whether need to include ww here 
    547547 
    548                      zhbl_s = MIN(zhbl_s, ht_n(ji,jj)) 
     548                     zhbl_s = MIN(zhbl_s, ht(ji,jj)) 
    549549                     IF ( zhbl_s >= gdepw(ji,jj,jm,Kmm) ) jm = jm + 1 
    550550                  END DO 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/nemogcm.F90

    r10998 r11053  
    137137      !                            !-----------------------! 
    138138#if defined key_agrif 
     139      Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs   ! agrif_oce module copies of time level indices 
    139140      CALL Agrif_Declare_Var_dom   ! AGRIF: set the meshes for DOM 
    140141      CALL Agrif_Declare_Var       !  "      "   "   "      "  DYN/TRA  
    … …  
    169170      ! 
    170171      ! Recursive update from highest nested level to lowest: 
     172      Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nnn    ! agrif_oce module copies of time level indices 
    171173      CALL Agrif_step_child_adj(Agrif_Update_All) 
    172174      ! 
    … …  
    404406      Nbb = 1; Nnn = 2; Naa = 3; Nrhs = Naa 
    405407 
    406       ! Initialisation of temporary pointers (to be deleted after development finished) 
    407       CALL update_pointers( Nbb, Nnn, Naa ) 
    408408      !                             !-------------------------------! 
    409409      !                             !  NEMO general initialization  ! 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/oce.F90

    r10919 r11053  
    1717   PUBLIC oce_alloc ! routine called by nemo_init in nemogcm.F90 
    1818 
    19    !! dynamics and tracer fields  NOTE THAT "TARGET" ATTRIBUTE CAN BE REMOVED AFTER IMMERSE DEVELOPMENT FINISHED                             
     19   !! dynamics and tracer fields 
    2020   !! --------------------------                             
    21    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:),  TARGET ::   uu   ,  vv     !: horizontal velocities        [m/s] 
    22    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:),    TARGET ::   ww             !: vertical velocity            [m/s] 
    23    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)            ::   wi             !: vertical vel. (adaptive-implicit) [m/s] 
    24    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:),    TARGET ::   hdiv           !: horizontal divergence        [s-1] 
    25    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:),TARGET ::   ts             !: 4D T-S fields                  [Celsius,psu]  
    26    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:) ::   rab_b,  rab_n          !: thermal/haline expansion coef. [Celsius-1,psu-1] 
    27    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)   ::   rn2b ,  rn2            !: brunt-vaisala frequency**2     [s-2] 
     21   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)  ::   uu   ,  vv     !: horizontal velocities        [m/s] 
     22   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)    ::   ww             !: vertical velocity            [m/s] 
     23   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   wi             !: vertical vel. (adaptive-implicit) [m/s] 
     24   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)    ::   hdiv           !: horizontal divergence        [s-1] 
     25   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) ::   ts             !: 4D T-S fields                  [Celsius,psu]  
     26   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:)   ::   rab_b,  rab_n  !: thermal/haline expansion coef. [Celsius-1,psu-1] 
     27   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:)     ::   rn2b ,  rn2    !: brunt-vaisala frequency**2     [s-2] 
    2828   ! 
    2929   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   rhd    !: in situ density anomalie rhd=(rho-rau0)/rau0  [no units] 
    … …  
    3333   !! free surface                                      !  before  ! now    ! after  ! 
    3434   !! ------------                                      !  fields  ! fields ! fields ! 
    35    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:), TARGET ::   ssh, uu_b,  vv_b   !: SSH [m] and barotropic velocities [m/s] 
     35   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:) ::   ssh, uu_b,  vv_b   !: SSH [m] and barotropic velocities [m/s] 
    3636 
    3737   !! Arrays at barotropic time step:                   ! befbefore! before !  now   ! after  ! 
    … …  
    6464 
    6565   !! Energy budget of the leads (open water embedded in sea ice) 
    66    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fraqsr_1lev        !: fraction of solar net radiation absorbed in the first ocean level [-] 
    67  
    68    !! TEMPORARY POINTERS FOR DEVELOPMENT ONLY 
    69    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:)   ::   ub   ,  un    , ua       !: i-horizontal velocity        [m/s] 
    70    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:)   ::   vb   ,  vn    , va       !: j-horizontal velocity        [m/s] 
    71    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:)   ::           wn               !: k-vertical   velocity        [m/s] 
    72    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:)   ::           hdivn            !: horizontal divergence        [s-1] 
    73    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:,:) ::   tsb  ,  tsn   , tsa      !: 4D T-S fields                [Celsius,psu]          
    74    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:)     ::   ub_b   ,  un_b  ,  ua_b  !: Barotropic velocities at u-point [m/s] 
    75    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:)     ::   vb_b   ,  vn_b  ,  va_b  !: Barotropic velocities at v-point [m/s] 
    76    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:)     ::   sshb   ,  sshn  ,  ssha  !: sea surface height at t-point [m] 
    77    !! TEMPORARY POINTERS FOR DEVELOPMENT ONLY 
     66   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fraqsr_1lev  !: fraction of solar net radiation absorbed in the first ocean level [-] 
     67   INTEGER, PUBLIC, DIMENSION(2) :: noce_array                             !: unused array but seems to be needed to prevent agrif from creating an empty module 
    7868 
    7969   !!---------------------------------------------------------------------- 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OCE/step.F90

    r11050 r11053  
    4444 
    4545   PUBLIC   stp   ! called by nemogcm.F90 
    46    PUBLIC   update_pointers ! called by nemo_init 
    4746 
    4847   !!---------------------------------------------------------------------- 
    … …  
    253252#endif 
    254253                         CALL tra_adv    ( kstp, Nbb, Nnn, ts, Nrhs )  ! hor. + vert. advection ==> RHS 
    255       IF( ln_zdfosm  )   CALL tra_osm    ( kstp, Nnn     , ts, Nrhs )  ! OSMOSIS non-local tracer fluxes ==> RHS 
     254      IF( ln_zdfosm  )   CALL tra_osm    ( kstp,      Nnn, ts, Nrhs )  ! OSMOSIS non-local tracer fluxes ==> RHS 
    256255      IF( lrst_oce .AND. ln_zdfosm ) & 
    257            &             CALL osm_rst    ( kstp, Nnn, 'WRITE' )        ! write OSMOSIS outputs + ww (so must do here) to restarts 
     256           &             CALL osm_rst    ( kstp,      Nnn, 'WRITE'  )  ! write OSMOSIS outputs + ww (so must do here) to restarts 
    258257                         CALL tra_ldf    ( kstp, Nbb, Nnn, ts, Nrhs )  ! lateral mixing 
    259258 
    260259!!gm : why CALL to dia_ptr has been moved here??? (use trends info?) 
    261       IF( ln_diaptr  )   CALL dia_ptr( Nnn )                 ! Poleward adv/ldf TRansports diagnostics 
     260      IF( ln_diaptr  )   CALL dia_ptr( Nnn )                           ! Poleward adv/ldf TRansports diagnostics 
    262261!!gm 
    263262                         CALL tra_zdf    ( kstp, Nbb, Nnn, Nrhs, ts, Naa  )  ! vert. mixing & after tracer  ==> after 
    … …  
    282281!!jc2: dynnxt must be the latest call. e3t(:,:,:,Nbb) are indeed updated in that routine 
    283282                         CALL tra_nxt       ( kstp, Nbb, Nnn, Nrhs, Naa )  ! finalize (bcs) tracer fields at next time step and swap 
    284                          CALL dyn_atf       ( kstp, Nbb, Nnn, Naa, uu, vv, e3t, e3u, e3v  )  ! time swapping of "now" arrays 
     283                         CALL dyn_atf       ( kstp, Nbb, Nnn, Naa, uu, vv, e3t, e3u, e3v  )  ! time filtering of "now" arrays 
    285284                         CALL ssh_swp       ( kstp, Nbb, Nnn, Naa )  ! swap of sea surface height 
    286285      ! 
    … …  
    291290      Naa = Nrhs 
    292291      ! 
    293       ! Update temporary pointers 
    294       CALL update_pointers( Nbb, Nnn, Naa ) 
    295  
    296292      IF(.NOT.ln_linssh) CALL dom_vvl_sf_swp( kstp, Nbb, Nnn, Naa )  ! swap of vertical scale factors 
    297293      ! 
    … …  
    310306      ! AGRIF 
    311307      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<       
    312                          CALL Agrif_Integrate_ChildGrids( stp )  ! allows to finish all the Child Grids before updating 
    313  
    314                          IF( Agrif_NbStepint() == 0 ) CALL Agrif_update_all( ) ! Update all components 
     308                         CALL Agrif_Integrate_ChildGrids( stp )       ! allows to finish all the Child Grids before updating 
     309 
     310                         IF( Agrif_NbStepint() == 0 ) THEN 
     311                            Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs   ! agrif_oce module copies of time level indices 
     312                            CALL Agrif_update_all( )                  ! Update all components 
     313                         ENDIF 
    315314#endif 
    316315      IF( ln_diaobs  )   CALL dia_obs      ( kstp, Nnn )      ! obs-minus-model (assimilation) diagnostics (call after dynamics update) 
    … …  
    331330      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    332331!!gm why lk_oasis and not lk_cpl ???? 
    333       IF( lk_oasis   )   CALL sbc_cpl_snd( kstp, Nnn )     ! coupled mode : field exchanges 
     332      IF( lk_oasis   )   CALL sbc_cpl_snd( kstp, Nbb, Nnn )        ! coupled mode : field exchanges 
    334333      ! 
    335334#if defined key_iomput 
    … …  
    344343      ! 
    345344   END SUBROUTINE stp 
    346     
    347    SUBROUTINE update_pointers( Kbb, Kmm, Kaa ) 
    348       !!---------------------------------------------------------------------- 
    349       !!                     ***  ROUTINE update_pointers  *** 
    350       !! 
    351       !! ** Purpose :   Associate temporary pointer arrays. 
    352       !!                For IMMERSE development phase only - to be deleted 
    353       !! 
    354       !! ** Method  : 
    355       !!---------------------------------------------------------------------- 
    356       INTEGER, INTENT( in ) :: Kbb, Kmm, Kaa ! time level indices 
    357  
    358       ub => uu(:,:,:,Kbb); un => uu(:,:,:,Kmm); ua => uu(:,:,:,Kaa) 
    359       vb => vv(:,:,:,Kbb); vn => vv(:,:,:,Kmm); va => vv(:,:,:,Kaa) 
    360       wn => ww(:,:,:) 
    361       hdivn => hdiv(:,:,:) 
    362  
    363       sshb =>  ssh(:,:,Kbb); sshn =>  ssh(:,:,Kmm); ssha =>  ssh(:,:,Kaa) 
    364       ub_b => uu_b(:,:,Kbb); un_b => uu_b(:,:,Kmm); ua_b => uu_b(:,:,Kaa) 
    365       vb_b => vv_b(:,:,Kbb); vn_b => vv_b(:,:,Kmm); va_b => vv_b(:,:,Kaa) 
    366  
    367       tsb => ts(:,:,:,:,Kbb); tsn => ts(:,:,:,:,Kmm); tsa => ts(:,:,:,:,Kaa) 
    368  
    369       e3t_b => e3t(:,:,:,Kbb); e3t_n => e3t(:,:,:,Kmm); e3t_a => e3t(:,:,:,Kaa) 
    370       e3u_b => e3u(:,:,:,Kbb); e3u_n => e3u(:,:,:,Kmm); e3u_a => e3u(:,:,:,Kaa) 
    371       e3v_b => e3v(:,:,:,Kbb); e3v_n => e3v(:,:,:,Kmm); e3v_a => e3v(:,:,:,Kaa) 
    372  
    373       e3f_n => e3f(:,:,:) 
    374  
    375       e3w_b  => e3w (:,:,:,Kbb); e3w_n  => e3w (:,:,:,Kmm) 
    376       e3uw_b => e3uw(:,:,:,Kbb); e3uw_n => e3uw(:,:,:,Kmm) 
    377       e3vw_b => e3vw(:,:,:,Kbb); e3vw_n => e3vw(:,:,:,Kmm) 
    378  
    379       gdept_b => gdept(:,:,:,Kbb); gdept_n => gdept(:,:,:,Kmm)  
    380       gdepw_b => gdepw(:,:,:,Kbb); gdepw_n => gdepw(:,:,:,Kmm)  
    381       gde3w_n => gde3w(:,:,:) 
    382  
    383       ht_n => ht(:,:) 
    384  
    385       hu_b => hu(:,:,Kbb); hu_n => hu(:,:,Kmm); hu_a => hu(:,:,Kaa) 
    386       hv_b => hv(:,:,Kbb); hv_n => hv(:,:,Kmm); hv_a => hv(:,:,Kaa) 
    387  
    388       r1_hu_b => r1_hu(:,:,Kbb); r1_hu_n => r1_hu(:,:,Kmm); r1_hu_a => r1_hu(:,:,Kaa) 
    389       r1_hv_b => r1_hv(:,:,Kbb); r1_hv_n => r1_hv(:,:,Kmm); r1_hv_a => r1_hv(:,:,Kaa) 
    390  
    391  
    392    END SUBROUTINE update_pointers 
    393  
     345   ! 
    394346   !!====================================================================== 
    395347END MODULE step 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OFF/dtadyn.F90

    r10955 r11053  
    182182         CALL prt_ctl(tab3d_1=uu(:,:,:,Kmm)               , clinfo1=' uu(:,:,:,Kmm)      - : ', mask1=umask,  kdim=jpk   ) 
    183183         CALL prt_ctl(tab3d_1=vv(:,:,:,Kmm)               , clinfo1=' vv(:,:,:,Kmm)      - : ', mask1=vmask,  kdim=jpk   ) 
    184          CALL prt_ctl(tab3d_1=wn               , clinfo1=' ww      - : ', mask1=tmask,  kdim=jpk   ) 
     184         CALL prt_ctl(tab3d_1=ww               , clinfo1=' ww      - : ', mask1=tmask,  kdim=jpk   ) 
    185185         CALL prt_ctl(tab3d_1=avt              , clinfo1=' kz      - : ', mask1=tmask,  kdim=jpk   ) 
    186186         CALL prt_ctl(tab3d_1=uslp             , clinfo1=' slp  - u : ', tab3d_2=vslp, clinfo2=' v : ', kdim=jpk) 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/OFF/nemogcm.F90

    r10998 r11053  
    5959   USE lib_fortran    ! Fortran utilities (allows no signed zero when 'key_nosignedzero' defined) 
    6060   USE lbcnfd  , ONLY : isendto, nsndto, nfsloop, nfeloop   ! Setup of north fold exchanges 
    61    USE step, ONLY : update_pointers  
    6261 
    6362   IMPLICIT NONE 
    … …  
    296295      Nbb = 1; Nnn = 2; Naa = 3; Nrhs = Naa 
    297296    
    298       ! Initialisation of temporary pointers (to be deleted after development finished) 
    299       CALL update_pointers( Nbb, Nnn, Naa ) 
    300297 
    301298      !                             !-------------------------------! 
    … …  
    536533      vv   (:,:,:,Kmm)   = 0._wp   ;   vv(:,:,:,Kaa) = 0._wp   ! 
    537534      ww   (:,:,:)   = 0._wp   !                       ! 
    538       hdivn(:,:,:)   = 0._wp   !                       ! 
     535      hdiv (:,:,:)   = 0._wp   !                       ! 
    539536      ts  (:,:,:,:,Kmm) = 0._wp   !                       ! 
    540537      ! 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/SAS/diawri.F90

    r10425 r11053  
    7878 
    7979    
    80    SUBROUTINE dia_wri( kt ) 
     80   SUBROUTINE dia_wri( kt, Kmm ) 
    8181      !!--------------------------------------------------------------------- 
    8282      !!                  ***  ROUTINE dia_wri  *** 
    … …  
    9090      !! 
    9191      INTEGER, INTENT( in ) ::   kt      ! ocean time-step index 
     92      INTEGER, INTENT( in ) ::   Kmm     ! ocean time levelindex 
    9293      !!---------------------------------------------------------------------- 
    9394      !  
    9495      ! Output the initial state and forcings 
    9596      IF( ninist == 1 ) THEN 
    96          CALL dia_wri_state( 'output.init' ) 
     97         CALL dia_wri_state( 'output.init', Kmm ) 
    9798         ninist = 0 
    9899      ENDIF 
    … …  
    330331#endif 
    331332 
    332    SUBROUTINE dia_wri_state( cdfile_name ) 
     333   SUBROUTINE dia_wri_state( cdfile_name, Kmm ) 
    333334      !!--------------------------------------------------------------------- 
    334335      !!                 ***  ROUTINE dia_wri_state  *** 
    … …  
    344345      !!---------------------------------------------------------------------- 
    345346      CHARACTER (len=* ), INTENT( in ) ::   cdfile_name      ! name of the file created 
     347      INTEGER           , INTENT( in ) ::   Kmm              ! ocean time levelindex 
    346348      !! 
    347349      INTEGER :: inum 
    … …  
    359361#endif 
    360362 
    361       CALL iom_rstput( 0, 0, inum, 'votemper', tsn(:,:,:,jp_tem) )    ! now temperature 
    362       CALL iom_rstput( 0, 0, inum, 'vosaline', tsn(:,:,:,jp_sal) )    ! now salinity 
    363       CALL iom_rstput( 0, 0, inum, 'sossheig', sshn              )    ! sea surface height 
    364       CALL iom_rstput( 0, 0, inum, 'vozocrtx', un                )    ! now i-velocity 
    365       CALL iom_rstput( 0, 0, inum, 'vomecrty', vn                )    ! now j-velocity 
    366       CALL iom_rstput( 0, 0, inum, 'vovecrtz', wn                )    ! now k-velocity 
    367       CALL iom_rstput( 0, 0, inum, 'sowaflup', emp - rnf         )    ! freshwater budget 
    368       CALL iom_rstput( 0, 0, inum, 'sohefldo', qsr + qns         )    ! total heat flux 
    369       CALL iom_rstput( 0, 0, inum, 'soshfldo', qsr               )    ! solar heat flux 
    370       CALL iom_rstput( 0, 0, inum, 'soicecov', fr_i              )    ! ice fraction 
    371       CALL iom_rstput( 0, 0, inum, 'sozotaux', utau              )    ! i-wind stress 
    372       CALL iom_rstput( 0, 0, inum, 'sometauy', vtau              )    ! j-wind stress 
     363      CALL iom_rstput( 0, 0, inum, 'votemper', ts (:,:,:,jp_tem,Kmm) )    ! now temperature 
     364      CALL iom_rstput( 0, 0, inum, 'vosaline', ts (:,:,:,jp_sal,Kmm) )    ! now salinity 
     365      CALL iom_rstput( 0, 0, inum, 'sossheig', ssh(:,:,         Kmm) )    ! sea surface height 
     366      CALL iom_rstput( 0, 0, inum, 'vozocrtx', uu (:,:,:,       Kmm) )    ! now i-velocity 
     367      CALL iom_rstput( 0, 0, inum, 'vomecrty', vv (:,:,:,       Kmm) )    ! now j-velocity 
     368      CALL iom_rstput( 0, 0, inum, 'vovecrtz', ww                    )    ! now k-velocity 
     369      CALL iom_rstput( 0, 0, inum, 'sowaflup', emp - rnf             )    ! freshwater budget 
     370      CALL iom_rstput( 0, 0, inum, 'sohefldo', qsr + qns             )    ! total heat flux 
     371      CALL iom_rstput( 0, 0, inum, 'soshfldo', qsr                   )    ! solar heat flux 
     372      CALL iom_rstput( 0, 0, inum, 'soicecov', fr_i                  )    ! ice fraction 
     373      CALL iom_rstput( 0, 0, inum, 'sozotaux', utau                  )    ! i-wind stress 
     374      CALL iom_rstput( 0, 0, inum, 'sometauy', vtau                  )    ! j-wind stress 
    373375  
    374376#if defined key_si3 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/SAS/nemogcm.F90

    r10998 r11053  
    355355      Nbb = 1; Nnn = 2; Naa = 3; Nrhs = Naa 
    356356 
    357       ! Initialisation of temporary pointers (to be deleted after development finished) 
    358       CALL update_pointers( Nbb, Nnn, Naa ) 
    359357      !                             !-------------------------------! 
    360358      !                             !  NEMO general initialization  ! 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/SAS/sbcssm.F90

    r10922 r11053  
    121121         IF( .NOT. ln_linssh ) e3t_m(:,:) = e3t_0(:,:,1) !clem: necessary at least for sas2D 
    122122         frq_m(:,:) = 1._wp                              !              - - 
    123          sshn (:,:) = 0._wp                              !              - - 
     123         ssh  (:,:,Kmm) = 0._wp                              !              - - 
    124124      ENDIF 
    125125       
    126126      IF ( nn_ice == 1 ) THEN 
    127          tsn(:,:,1,jp_tem) = sst_m(:,:) 
    128          tsn(:,:,1,jp_sal) = sss_m(:,:) 
    129          tsb(:,:,1,jp_tem) = sst_m(:,:) 
    130          tsb(:,:,1,jp_sal) = sss_m(:,:) 
    131       ENDIF 
    132       ub (:,:,1) = ssu_m(:,:) 
    133       vb (:,:,1) = ssv_m(:,:) 
     127         ts(:,:,1,jp_tem,Kmm) = sst_m(:,:) 
     128         ts(:,:,1,jp_sal,Kmm) = sss_m(:,:) 
     129         ts(:,:,1,jp_tem,Kbb) = sst_m(:,:) 
     130         ts(:,:,1,jp_sal,Kbb) = sss_m(:,:) 
     131      ENDIF 
     132      uu (:,:,1,Kbb) = ssu_m(:,:) 
     133      vv (:,:,1,Kbb) = ssv_m(:,:) 
    134134  
    135135      IF(ln_ctl) THEN                  ! print control 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/SAS/step.F90

    r10975 r11053  
    4747 
    4848   PUBLIC   stp   ! called by nemogcm.F90 
    49    PUBLIC   update_pointers ! called by nemo_init 
    5049 
    5150   !!---------------------------------------------------------------------- 
    … …  
    105104                             CALL sbc    ( kstp, Nbb, Nnn )                   ! Sea Boundary Condition (including sea-ice) 
    106105 
    107                              CALL dia_wri( kstp )         ! ocean model: outputs 
     106                             CALL dia_wri( kstp,      Nnn )                   ! ocean model: outputs 
    108107 
    109108#if defined key_agrif 
    … …  
    126125      IF( indic < 0  )  THEN 
    127126                             CALL ctl_stop( 'step: indic < 0' ) 
    128                              CALL dia_wri_state( 'output.abort' ) 
     127                             CALL dia_wri_state( 'output.abort', Nnn ) 
    129128      ENDIF 
    130       IF( kstp == nit000   ) CALL iom_close( numror )     ! close input  ocean restart file 
     129      IF( kstp == nit000   ) CALL iom_close( numror )           ! close input  ocean restart file 
    131130       
    132131      !>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>>> 
    133132      ! Coupled mode 
    134133      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    135       IF( lk_oasis    )  CALL sbc_cpl_snd( kstp, Nnn )     ! coupled mode : field exchanges if OASIS-coupled ice 
     134      IF( lk_oasis    )  CALL sbc_cpl_snd( kstp, Nbb, Nnn )     ! coupled mode : field exchanges if OASIS-coupled ice 
    136135 
    137136#if defined key_iomput 
    … …  
    153152   END SUBROUTINE stp 
    154153 
    155    SUBROUTINE update_pointers( Kbb, Kmm, Kaa ) 
    156       !!---------------------------------------------------------------------- 
    157       !!                     ***  ROUTINE update_pointers  *** 
    158       !! 
    159       !! ** Purpose :   Associate temporary pointer arrays. 
    160       !!                For IMMERSE development phase only - to be deleted 
    161       !! 
    162       !! ** Method  : 
    163       !!---------------------------------------------------------------------- 
    164       INTEGER, INTENT( in ) :: Kbb, Kmm, Kaa ! time level indices 
    165  
    166       ub => uu(:,:,:,Kbb); un => uu(:,:,:,Kmm); ua => uu(:,:,:,Kaa) 
    167       vb => vv(:,:,:,Kbb); vn => vv(:,:,:,Kmm); va => vv(:,:,:,Kaa) 
    168       wn => ww(:,:,:) 
    169       hdivn => hdiv(:,:,:) 
    170  
    171       sshb =>  ssh(:,:,Kbb); sshn =>  ssh(:,:,Kmm); ssha =>  ssh(:,:,Kaa) 
    172       ub_b => uu_b(:,:,Kbb); un_b => uu_b(:,:,Kmm); ua_b => uu_b(:,:,Kaa) 
    173       vb_b => vv_b(:,:,Kbb); vn_b => vv_b(:,:,Kmm); va_b => vv_b(:,:,Kaa) 
    174  
    175       tsb => ts(:,:,:,:,Kbb); tsn => ts(:,:,:,:,Kmm); tsa => ts(:,:,:,:,Kaa) 
    176  
    177       e3t_b => e3t(:,:,:,Kbb); e3t_n => e3t(:,:,:,Kmm); e3t_a => e3t(:,:,:,Kaa) 
    178       e3u_b => e3u(:,:,:,Kbb); e3u_n => e3u(:,:,:,Kmm); e3u_a => e3u(:,:,:,Kaa) 
    179       e3v_b => e3v(:,:,:,Kbb); e3v_n => e3v(:,:,:,Kmm); e3v_a => e3v(:,:,:,Kaa) 
    180  
    181       e3f_n => e3f(:,:,:) 
    182  
    183       e3w_b  => e3w (:,:,:,Kbb); e3w_n  => e3w (:,:,:,Kmm) 
    184       e3uw_b => e3uw(:,:,:,Kbb); e3uw_n => e3uw(:,:,:,Kmm) 
    185       e3vw_b => e3vw(:,:,:,Kbb); e3vw_n => e3vw(:,:,:,Kmm) 
    186  
    187       gdept_b => gdept(:,:,:,Kbb); gdept_n => gdept(:,:,:,Kmm)  
    188       gdepw_b => gdepw(:,:,:,Kbb); gdepw_n => gdepw(:,:,:,Kmm)  
    189       gde3w_n => gde3w(:,:,:) 
    190  
    191    END SUBROUTINE update_pointers 
    192  
    193154   !!====================================================================== 
    194155END MODULE step 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/TOP/oce_trc.F90

    r10963 r11053  
    3434 
    3535   !* ocean fields: here now and after fields * 
    36    USE oce , ONLY :   tsn     =>    tsn     !: 4D array contaning ( tn, sn ) !TEMPORARY 
    37    USE oce , ONLY :   tsb     =>    tsb     !: 4D array contaning ( tb, sb ) !TEMPORARY 
    38    USE oce , ONLY :   tsa     =>    tsa     !: 4D array contaning ( ta, sa ) !TEMPORARY 
    39    USE oce , ONLY :   sshn    =>    sshn    !: sea surface height at t-point [m]    !TEMPORARY 
    40    USE oce , ONLY :   sshb    =>    sshb    !: sea surface height at t-point [m]    !TEMPORARY 
    41    USE oce , ONLY :   ssha    =>    ssha    !: sea surface height at t-point [m]    !TEMPORARY 
    42    USE oce , ONLY :    un     =>     un     !: 4D array  !TEMPORARY 
    43    USE oce , ONLY :    vn     =>     vn     !: 4D array  !TEMPORARY 
    44    USE oce , ONLY :    wn     =>     wn     !: 4D array  !TEMPORARY 
    4536   USE oce , ONLY :   uu     =>    uu     !: i-horizontal velocity (m s-1)  
    4637   USE oce , ONLY :   vv     =>    vv     !: j-horizontal velocity (m s-1) 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/TOP/trc.F90

    r10880 r11053  
    3333   REAL(wp), PUBLIC                                        ::  areatot        !: total volume  
    3434   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  ) ::  cvol           !: volume correction -degrad option-  
    35    REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:), TARGET ::  tr             !: tracer concentration  
     35   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:,:,:) ::  tr           !: tracer concentration  
    3636   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  ) ::  sbc_trc_b      !: Before sbc fluxes for tracers 
    3737   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  ) ::  sbc_trc        !: Now sbc fluxes for tracers 
    … …  
    4040   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  ) ::  trc_o          !: prescribed tracer concentration in ocean for SBC 
    4141   INTEGER             , PUBLIC                            ::  nn_ice_tr      !: handling of sea ice tracers 
    42  
    43    !! TEMPORARY POINTERS - TO BE DELETED AFTER IMMERSE DEVELOPMENT COMPLETE 
    44    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:,:)   ::  trn            !: tracer concentration for now time step 
    45    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:,:)   ::  tra            !: tracer concentration for next time step 
    46    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:,:)   ::  trb            !: tracer concentration for before time step 
    47    !! TEMPORARY POINTERS - TO BE DELETED AFTER IMMERSE DEVELOPMENT COMPLETE 
    4842 
    4943   !! interpolated gradient 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/TOP/trcini.F90

    r10975 r11053  
    5252      !!                or read data or analytical formulation 
    5353      !!--------------------------------------------------------------------- 
    54       !! Time level indices only required for call to update_pointers_trc 
    55       !! To be removed after IMMERSE development finished.  
    5654      INTEGER, INTENT( in ) :: Kbb, Kmm, Kaa ! time level indices 
    5755      ! 
    … …  
    6664      CALL top_alloc()   ! allocate TOP arrays 
    6765 
    68       ! Initialisation of temporary pointers (to be deleted after development finished) 
    69       CALL update_pointers_trc( Kbb, Kmm, Kaa ) 
    7066      ! 
    7167      IF(.NOT.ln_trcdta )   ln_trc_ini(:) = .FALSE. 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps_rewrite_time_filterswap/src/TOP/trcstp.F90

    r10975 r11053  
    3030 
    3131   PUBLIC   trc_stp    ! called by step 
    32    PUBLIC   update_pointers_trc ! called in initialisation 
    3332 
    3433   LOGICAL  ::   llnew                   ! ??? 
    … …  
    126125      ! 
    127126   END SUBROUTINE trc_stp 
    128  
    129    SUBROUTINE update_pointers_trc( Kbb, Kmm, Kaa ) 
    130       !!---------------------------------------------------------------------- 
    131       !!                     ***  ROUTINE update_pointers_trc  *** 
    132       !! 
    133       !! ** Purpose :   Associate temporary pointer arrays. 
    134       !!                For IMMERSE development phase only - to be deleted 
    135       !! 
    136       !! ** Method  : 
    137       !!---------------------------------------------------------------------- 
    138       INTEGER, INTENT( in ) :: Kbb, Kmm, Kaa ! time level indices 
    139  
    140       trb => tr(:,:,:,:,Kbb); trn => tr(:,:,:,:,Kmm); tra => tr(:,:,:,:,Kaa) 
    141  
    142    END SUBROUTINE update_pointers_trc 
    143127 
    144128   SUBROUTINE trc_mean_qsr( kt ) 
Note: See TracChangeset for help on using the changeset viewer.