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

Changeset 10989


Ignore:
Timestamp:
2019-05-16T17:45:46+02:00 (5 years ago)
Author:
acc
Message:

2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps : Convert NST routines in preparation for getting AGRIF back up and running. AGRIF conv stage now works but requires some renaming of recently changes DIU modules (included in this commit). AGRIF compile and link stage not yet working (agrif routines need to be passed the time-level indices) but non-AGRIF SETTE tests are all OK

Location:
NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src
Files:
11 edited
3 moved

Legend:

Unmodified
Added
Removed

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

    r10068 r10989  
    107107         ! 
    108108         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
    109             ua_b(ibdy1:ibdy2,:) = 0._wp 
     109            uu_b(ibdy1:ibdy2,:,Krhs) = 0._wp 
    110110            DO jk = 1, jpkm1 
    111111               DO jj = 1, jpj 
    112                   ua_b(ibdy1:ibdy2,jj) = ua_b(ibdy1:ibdy2,jj) &  
    113                       & + e3u_a(ibdy1:ibdy2,jj,jk) * ua(ibdy1:ibdy2,jj,jk) * umask(ibdy1:ibdy2,jj,jk) 
     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) 
    114114               END DO 
    115115            END DO 
    116116            DO jj = 1, jpj 
    117                ua_b(ibdy1:ibdy2,jj) = ua_b(ibdy1:ibdy2,jj) * r1_hu_a(ibdy1:ibdy2,jj) 
     117               uu_b(ibdy1:ibdy2,jj,Krhs) = uu_b(ibdy1:ibdy2,jj,Krhs) * r1_hu_a(ibdy1:ibdy2,jj) 
    118118            END DO 
    119119         ENDIF 
    … …  
    122122            DO jk=1,jpkm1              ! Smooth 
    123123               DO jj=j1,j2 
    124                   ua(ibdy2,jj,jk) = 0.25_wp*(ua(ibdy2-1,jj,jk)+2._wp*ua(ibdy2,jj,jk)+ua(ibdy2+1,jj,jk)) 
     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)) 
    125125               END DO 
    126126            END DO 
    … …  
    131131            DO jj = 1, jpj 
    132132               zub(ibdy1:ibdy2,jj) = zub(ibdy1:ibdy2,jj) &  
    133                   & + e3u_a(ibdy1:ibdy2,jj,jk)  * ua(ibdy1:ibdy2,jj,jk)*umask(ibdy1:ibdy2,jj,jk) 
     133                  & + e3u(ibdy1:ibdy2,jj,jk,Krhs)  * uu(ibdy1:ibdy2,jj,jk,Krhs)*umask(ibdy1:ibdy2,jj,jk) 
    134134            END DO 
    135135         END DO 
    … …  
    140140         DO jk = 1, jpkm1 
    141141            DO jj = 1, jpj 
    142                ua(ibdy1:ibdy2,jj,jk) = ( ua(ibdy1:ibdy2,jj,jk) & 
    143                  & + ua_b(ibdy1:ibdy2,jj)-zub(ibdy1:ibdy2,jj)) * umask(ibdy1:ibdy2,jj,jk) 
     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) 
    144144            END DO 
    145145         END DO 
    … …  
    150150               DO jj = 1, jpj 
    151151                  zvb(ibdy1:ibdy2,jj) = zvb(ibdy1:ibdy2,jj) &  
    152                      & + e3v_a(ibdy1:ibdy2,jj,jk) * va(ibdy1:ibdy2,jj,jk) * vmask(ibdy1:ibdy2,jj,jk) 
     152                     & + e3v(ibdy1:ibdy2,jj,jk,Krhs) * vv(ibdy1:ibdy2,jj,jk,Krhs) * vmask(ibdy1:ibdy2,jj,jk) 
    153153               END DO 
    154154            END DO 
    … …  
    158158            DO jk = 1, jpkm1 
    159159               DO jj = 1, jpj 
    160                   va(ibdy1:ibdy2,jj,jk) = ( va(ibdy1:ibdy2,jj,jk) &  
    161                     & + va_b(ibdy1:ibdy2,jj)-zvb(ibdy1:ibdy2,jj))*vmask(ibdy1:ibdy2,jj,jk) 
     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) 
    162162               END DO 
    163163            END DO 
    … …  
    166166         DO jk = 1, jpkm1              ! Mask domain edges 
    167167            DO jj = 1, jpj 
    168                ua(1,jj,jk) = 0._wp 
    169                va(1,jj,jk) = 0._wp 
     168               uu(1,jj,jk,Krhs) = 0._wp 
     169               vv(1,jj,jk,Krhs) = 0._wp 
    170170            END DO 
    171171         END DO  
    … …  
    178178         ! 
    179179         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
    180             ua_b(ibdy1:ibdy2,:) = 0._wp 
     180            uu_b(ibdy1:ibdy2,:,Krhs) = 0._wp 
    181181            DO jk = 1, jpkm1 
    182182               DO jj = 1, jpj 
    183                   ua_b(ibdy1:ibdy2,jj) = ua_b(ibdy1:ibdy2,jj) &  
    184                       & + e3u_a(ibdy1:ibdy2,jj,jk) * ua(ibdy1:ibdy2,jj,jk) * umask(ibdy1:ibdy2,jj,jk) 
     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) 
    185185               END DO 
    186186            END DO 
    187187            DO jj = 1, jpj 
    188                ua_b(ibdy1:ibdy2,jj) = ua_b(ibdy1:ibdy2,jj) * r1_hu_a(ibdy1:ibdy2,jj) 
     188               uu_b(ibdy1:ibdy2,jj,Krhs) = uu_b(ibdy1:ibdy2,jj,Krhs) * r1_hu_a(ibdy1:ibdy2,jj) 
    189189            END DO 
    190190         ENDIF 
    … …  
    193193            DO jk=1,jpkm1              ! Smooth 
    194194               DO jj=j1,j2 
    195                   ua(ibdy1,jj,jk) = 0.25_wp*(ua(ibdy1-1,jj,jk)+2._wp*ua(ibdy1,jj,jk)+ua(ibdy1+1,jj,jk)) 
     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)) 
    196196               END DO 
    197197            END DO 
    … …  
    202202            DO jj = 1, jpj 
    203203               zub(ibdy1:ibdy2,jj) = zub(ibdy1:ibdy2,jj) &  
    204                   & + e3u_a(ibdy1:ibdy2,jj,jk)  * ua(ibdy1:ibdy2,jj,jk) * umask(ibdy1:ibdy2,jj,jk) 
     204                  & + e3u(ibdy1:ibdy2,jj,jk,Krhs)  * uu(ibdy1:ibdy2,jj,jk,Krhs) * umask(ibdy1:ibdy2,jj,jk) 
    205205            END DO 
    206206         END DO 
    … …  
    211211         DO jk = 1, jpkm1 
    212212            DO jj = 1, jpj 
    213                ua(ibdy1:ibdy2,jj,jk) = ( ua(ibdy1:ibdy2,jj,jk) &  
    214                  & + ua_b(ibdy1:ibdy2,jj)-zub(ibdy1:ibdy2,jj))*umask(ibdy1:ibdy2,jj,jk) 
     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) 
    215215            END DO 
    216216         END DO 
    … …  
    223223               DO jj = 1, jpj 
    224224                  zvb(ibdy1:ibdy2,jj) = zvb(ibdy1:ibdy2,jj) & 
    225                      & + e3v_a(ibdy1:ibdy2,jj,jk) * va(ibdy1:ibdy2,jj,jk) * vmask(ibdy1:ibdy2,jj,jk) 
     225                     & + e3v(ibdy1:ibdy2,jj,jk,Krhs) * vv(ibdy1:ibdy2,jj,jk,Krhs) * vmask(ibdy1:ibdy2,jj,jk) 
    226226               END DO 
    227227            END DO 
    … …  
    231231            DO jk = 1, jpkm1 
    232232               DO jj = 1, jpj 
    233                   va(ibdy1:ibdy2,jj,jk) = ( va(ibdy1:ibdy2,jj,jk) &  
    234                       & + va_b(ibdy1:ibdy2,jj)-zvb(ibdy1:ibdy2,jj)) * vmask(ibdy1:ibdy2,jj,jk) 
     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) 
    235235               END DO 
    236236            END DO 
    … …  
    239239         DO jk = 1, jpkm1              ! Mask domain edges 
    240240            DO jj = 1, jpj 
    241                ua(nlci-1,jj,jk) = 0._wp 
    242                va(nlci  ,jj,jk) = 0._wp 
     241               uu(nlci-1,jj,jk,Krhs) = 0._wp 
     242               vv(nlci  ,jj,jk,Krhs) = 0._wp 
    243243            END DO 
    244244         END DO  
    … …  
    251251         ! 
    252252         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
    253             va_b(:,jbdy1:jbdy2) = 0._wp 
     253            vv_b(:,jbdy1:jbdy2,Krhs) = 0._wp 
    254254            DO jk = 1, jpkm1 
    255255               DO ji = 1, jpi 
    256                   va_b(ji,jbdy1:jbdy2) = va_b(ji,jbdy1:jbdy2) &  
    257                       & + e3v_a(ji,jbdy1:jbdy2,jk) * va(ji,jbdy1:jbdy2,jk) * vmask(ji,jbdy1:jbdy2,jk) 
     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) 
    258258               END DO 
    259259            END DO 
    260260            DO ji=1,jpi 
    261                va_b(ji,jbdy1:jbdy2) = va_b(ji,jbdy1:jbdy2) * r1_hv_a(ji,jbdy1:jbdy2) 
     261               vv_b(ji,jbdy1:jbdy2,Krhs) = vv_b(ji,jbdy1:jbdy2,Krhs) * r1_hv_a(ji,jbdy1:jbdy2) 
    262262            END DO 
    263263         ENDIF 
    … …  
    266266            DO jk = 1, jpkm1           ! Smooth 
    267267               DO ji = i1, i2 
    268                   va(ji,jbdy2,jk) = 0.25_wp*(va(ji,jbdy2-1,jk)+2._wp*va(ji,jbdy2,jk)+va(ji,jbdy2+1,jk)) 
     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)) 
    269269               END DO 
    270270            END DO 
    … …  
    275275            DO ji=1,jpi 
    276276               zvb(ji,jbdy1:jbdy2) = zvb(ji,jbdy1:jbdy2) &  
    277                   & + e3v_a(ji,jbdy1:jbdy2,jk) * va(ji,jbdy1:jbdy2,jk) * vmask(ji,jbdy1:jbdy2,jk) 
     277                  & + e3v(ji,jbdy1:jbdy2,jk,Krhs) * vv(ji,jbdy1:jbdy2,jk,Krhs) * vmask(ji,jbdy1:jbdy2,jk) 
    278278            END DO 
    279279         END DO 
    … …  
    284284         DO jk = 1, jpkm1 
    285285            DO ji = 1, jpi 
    286                va(ji,jbdy1:jbdy2,jk) = ( va(ji,jbdy1:jbdy2,jk) &  
    287                  & + va_b(ji,jbdy1:jbdy2) - zvb(ji,jbdy1:jbdy2) ) * vmask(ji,jbdy1:jbdy2,jk) 
     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) 
    288288            END DO 
    289289         END DO 
    … …  
    294294               DO ji = 1, jpi 
    295295                  zub(ji,jbdy1:jbdy2) = zub(ji,jbdy1:jbdy2) &  
    296                      & + e3u_a(ji,jbdy1:jbdy2,jk) * ua(ji,jbdy1:jbdy2,jk) * umask(ji,jbdy1:jbdy2,jk) 
     296                     & + e3u(ji,jbdy1:jbdy2,jk,Krhs) * uu(ji,jbdy1:jbdy2,jk,Krhs) * umask(ji,jbdy1:jbdy2,jk) 
    297297               END DO 
    298298            END DO 
    … …  
    303303            DO jk = 1, jpkm1 
    304304               DO ji = 1, jpi 
    305                   ua(ji,jbdy1:jbdy2,jk) = ( ua(ji,jbdy1:jbdy2,jk) &  
    306                     & + ua_b(ji,jbdy1:jbdy2) - zub(ji,jbdy1:jbdy2) ) * umask(ji,jbdy1:jbdy2,jk) 
     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) 
    307307               END DO 
    308308            END DO 
    … …  
    311311         DO jk = 1, jpkm1              ! Mask domain edges 
    312312            DO ji = 1, jpi 
    313                ua(ji,1,jk) = 0._wp 
    314                va(ji,1,jk) = 0._wp 
     313               uu(ji,1,jk,Krhs) = 0._wp 
     314               vv(ji,1,jk,Krhs) = 0._wp 
    315315            END DO 
    316316         END DO  
    … …  
    323323         ! 
    324324         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
    325             va_b(:,jbdy1:jbdy2) = 0._wp 
     325            vv_b(:,jbdy1:jbdy2,Krhs) = 0._wp 
    326326            DO jk = 1, jpkm1 
    327327               DO ji = 1, jpi 
    328                   va_b(ji,jbdy1:jbdy2) = va_b(ji,jbdy1:jbdy2) &  
    329                       & + e3v_a(ji,jbdy1:jbdy2,jk) * va(ji,jbdy1:jbdy2,jk) * vmask(ji,jbdy1:jbdy2,jk) 
     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) 
    330330               END DO 
    331331            END DO 
    332332            DO ji=1,jpi 
    333                va_b(ji,jbdy1:jbdy2) = va_b(ji,jbdy1:jbdy2) * r1_hv_a(ji,jbdy1:jbdy2) 
     333               vv_b(ji,jbdy1:jbdy2,Krhs) = vv_b(ji,jbdy1:jbdy2,Krhs) * r1_hv_a(ji,jbdy1:jbdy2) 
    334334            END DO 
    335335         ENDIF 
    … …  
    338338            DO jk = 1, jpkm1           ! Smooth 
    339339               DO ji = i1, i2 
    340                   va(ji,jbdy1,jk) = 0.25_wp*(va(ji,jbdy1-1,jk)+2._wp*va(ji,jbdy1,jk)+va(ji,jbdy1+1,jk)) 
     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)) 
    341341               END DO 
    342342            END DO 
    … …  
    347347            DO ji=1,jpi 
    348348               zvb(ji,jbdy1:jbdy2) = zvb(ji,jbdy1:jbdy2) &  
    349                   & + e3v_a(ji,jbdy1:jbdy2,jk) * va(ji,jbdy1:jbdy2,jk) * vmask(ji,jbdy1:jbdy2,jk) 
     349                  & + e3v(ji,jbdy1:jbdy2,jk,Krhs) * vv(ji,jbdy1:jbdy2,jk,Krhs) * vmask(ji,jbdy1:jbdy2,jk) 
    350350            END DO 
    351351         END DO 
    … …  
    356356         DO jk = 1, jpkm1 
    357357            DO ji = 1, jpi 
    358                va(ji,jbdy1:jbdy2,jk) = ( va(ji,jbdy1:jbdy2,jk) &  
    359                  & + va_b(ji,jbdy1:jbdy2) - zvb(ji,jbdy1:jbdy2) ) * vmask(ji,jbdy1:jbdy2,jk) 
     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) 
    360360            END DO 
    361361         END DO 
    … …  
    368368               DO ji = 1, jpi 
    369369                  zub(ji,jbdy1:jbdy2) = zub(ji,jbdy1:jbdy2) &  
    370                      & + e3u_a(ji,jbdy1:jbdy2,jk) * ua(ji,jbdy1:jbdy2,jk) * umask(ji,jbdy1:jbdy2,jk) 
     370                     & + e3u(ji,jbdy1:jbdy2,jk,Krhs) * uu(ji,jbdy1:jbdy2,jk,Krhs) * umask(ji,jbdy1:jbdy2,jk) 
    371371               END DO 
    372372            END DO 
    … …  
    377377            DO jk = 1, jpkm1 
    378378               DO ji = 1, jpi 
    379                   ua(ji,jbdy1:jbdy2,jk) = ( ua(ji,jbdy1:jbdy2,jk) &  
    380                     & + ua_b(ji,jbdy1:jbdy2) - zub(ji,jbdy1:jbdy2) ) * umask(ji,jbdy1:jbdy2,jk) 
     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) 
    381381               END DO 
    382382            END DO 
    … …  
    385385         DO jk = 1, jpkm1              ! Mask domain edges 
    386386            DO ji = 1, jpi 
    387                ua(ji,nlcj  ,jk) = 0._wp 
    388                va(ji,nlcj-1,jk) = 0._wp 
     387               uu(ji,nlcj  ,jk,Krhs) = 0._wp 
     388               vv(ji,nlcj-1,jk,Krhs) = 0._wp 
    389389            END DO 
    390390         END DO  
    … …  
    520520         DO jj = 1, jpj 
    521521            DO ji = 2, indx 
    522                ssha(ji,jj) = hbdy_w(ji-1,jj) 
     522               ssh(ji,jj,Krhs) = hbdy_w(ji-1,jj) 
    523523            ENDDO 
    524524         ENDDO 
    … …  
    530530         DO jj = 1, jpj 
    531531            DO ji = indx, nlci-1 
    532                ssha(ji,jj) = hbdy_e(ji-indx+1,jj) 
     532               ssh(ji,jj,Krhs) = hbdy_e(ji-indx+1,jj) 
    533533            ENDDO 
    534534         ENDDO 
    … …  
    540540         DO jj = 2, indy 
    541541            DO ji = 1, jpi 
    542                ssha(ji,jj) = hbdy_s(ji,jj-1) 
     542               ssh(ji,jj,Krhs) = hbdy_s(ji,jj-1) 
    543543            ENDDO 
    544544         ENDDO 
    … …  
    550550         DO jj = indy, nlcj-1 
    551551            DO ji = 1, jpi 
    552                ssha(ji,jj) = hbdy_n(ji,jj-indy+1) 
     552               ssh(ji,jj,Krhs) = 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) = tsn(ji,jj,jk,jn) 
     661                       ptab(ji,jj,jk,jn) = ts(ji,jj,jk,jn,Kmm) 
    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_n(ji,jj,jk)  
     671                 ptab(ji,jj,jk,jpts+1) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kmm)  
    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_n(iref,jref,jk) 
     701                  h_out(jk) = e3t(iref,jref,jk,Kmm) 
    702702               ENDDO 
    703703               IF (N_in > 0) THEN 
    … …  
    713713         ! 
    714714         DO jn=1, jpts 
    715             tsa(i1:i2,j1:j2,1:jpk,jn)=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)=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                   tsa(ibdy+1,jmin:jmax,1:jpkm1,jn) = 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) = 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                            tsa(ibdy,jj,jk,jn) = tsa(ibdy+1,jj,jk,jn) * tmask(ibdy,jj,jk) 
     743                           ts(ibdy,jj,jk,jn,Krhs) = ts(ibdy+1,jj,jk,jn,Krhs) * tmask(ibdy,jj,jk) 
    744744                        ELSE 
    745                            tsa(ibdy,jj,jk,jn)=(z4*tsa(ibdy+1,jj,jk,jn)+z3*tsa(ibdy-1,jj,jk,jn))*tmask(ibdy,jj,jk) 
    746                            IF( un(ibdy-1,jj,jk) > 0._wp ) THEN 
    747                               tsa(ibdy,jj,jk,jn)=( z6*tsa(ibdy-1,jj,jk,jn)+z5*tsa(ibdy+1,jj,jk,jn) &  
    748                                                  + z7*tsa(ibdy-2,jj,jk,jn) ) * tmask(ibdy,jj,jk) 
     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) 
    749749                           ENDIF 
    750750                        ENDIF 
    … …  
    752752                  END DO 
    753753                  ! Restore ghost points: 
    754                   tsa(ibdy+1,jmin:jmax,1:jpkm1,jn) = 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) = 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                   tsa(imin:imax,jbdy+1,1:jpkm1,jn) = 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) = 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                            tsa(ji,jbdy,jk,jn) = tsa(ji,jbdy+1,jk,jn) * tmask(ji,jbdy,jk) 
     772                           ts(ji,jbdy,jk,jn,Krhs) = ts(ji,jbdy+1,jk,jn,Krhs) * tmask(ji,jbdy,jk) 
    773773                        ELSE 
    774                            tsa(ji,jbdy,jk,jn)=(z4*tsa(ji,jbdy+1,jk,jn)+z3*tsa(ji,jbdy-1,jk,jn))*tmask(ji,jbdy,jk)         
    775                            IF (vn(ji,jbdy-1,jk) > 0._wp ) THEN 
    776                               tsa(ji,jbdy,jk,jn)=( z6*tsa(ji,jbdy-1,jk,jn)+z5*tsa(ji,jbdy+1,jk,jn)  & 
    777                                                  + z7*tsa(ji,jbdy-2,jk,jn) ) * tmask(ji,jbdy,jk) 
     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) 
    778778                           ENDIF 
    779779                        ENDIF 
    … …  
    781781                  END DO 
    782782                  ! Restore ghost points: 
    783                   tsa(imin:imax,jbdy+1,1:jpkm1,jn) = 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) = 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                   tsa(ibdy-1,jmin:jmax,1:jpkm1,jn) = 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) = 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                            tsa(ibdy,jj,jk,jn) = tsa(ibdy-1,jj,jk,jn) * tmask(ibdy,jj,jk) 
     801                           ts(ibdy,jj,jk,jn,Krhs) = ts(ibdy-1,jj,jk,jn,Krhs) * tmask(ibdy,jj,jk) 
    802802                        ELSE 
    803                            tsa(ibdy,jj,jk,jn)=(z4*tsa(ibdy-1,jj,jk,jn)+z3*tsa(ibdy+1,jj,jk,jn))*tmask(ibdy,jj,jk)         
    804                            IF( un(ibdy,jj,jk) < 0._wp ) THEN 
    805                               tsa(ibdy,jj,jk,jn)=( z6*tsa(ibdy+1,jj,jk,jn)+z5*tsa(ibdy-1,jj,jk,jn) & 
    806                                                  + z7*tsa(ibdy+2,jj,jk,jn) ) * tmask(ibdy,jj,jk) 
     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) 
    807807                           ENDIF 
    808808                        ENDIF 
    … …  
    810810                  END DO 
    811811                  ! Restore ghost points: 
    812                   tsa(ibdy-1,jmin:jmax,1:jpkm1,jn) = 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) = 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                   tsa(imin:imax,jbdy-1,1:jpkm1,jn) = 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) = 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                            tsa(ji,jbdy,jk,jn)=tsa(ji,jbdy-1,jk,jn) * tmask(ji,jbdy,jk) 
     830                           ts(ji,jbdy,jk,jn,Krhs)=ts(ji,jbdy-1,jk,jn,Krhs) * tmask(ji,jbdy,jk) 
    831831                        ELSE 
    832                            tsa(ji,jbdy,jk,jn)=(z4*tsa(ji,jbdy-1,jk,jn)+z3*tsa(ji,jbdy+1,jk,jn))*tmask(ji,jbdy,jk) 
    833                            IF( vn(ji,jbdy,jk) < 0._wp ) THEN 
    834                               tsa(ji,jbdy,jk,jn)=( z6*tsa(ji,jbdy+1,jk,jn)+z5*tsa(ji,jbdy-1,jk,jn) &  
    835                                                  + z7*tsa(ji,jbdy+2,jk,jn) ) * tmask(ji,jbdy,jk) 
     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) 
    836836                           ENDIF 
    837837                        ENDIF 
    … …  
    839839                  END DO 
    840840                  ! Restore ghost points: 
    841                   tsa(imin:imax,jbdy-1,1:jpkm1,jn) = 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) = 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) = sshn(i1:i2,j1:j2) 
     863         ptab(i1:i2,j1:j2) = ssh(i1:i2,j1:j2,Kmm) 
    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_n(ji,jj,jk) * un(ji,jj,jk)*umask(ji,jj,jk))  
     902                  ptab(ji,jj,jk,1) = (e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm)*umask(ji,jj,jk))  
    903903# if defined key_vertical 
    904                   ptab(ji,jj,jk,2) = (umask(ji,jj,jk) * e2u(ji,jj) * e3u_n(ji,jj,jk)) 
     904                  ptab(ji,jj,jk,2) = (umask(ji,jj,jk) * e2u(ji,jj) * e3u(ji,jj,jk,Kmm)) 
    905905# endif 
    906906               END DO 
    … …  
    928928          
    929929              IF (N_in == 0) THEN 
    930                  ua(ji,jj,:) = 0._wp 
     930                 uu(ji,jj,:,Krhs) = 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_a(iref,jj,jk) 
     938                 h_out(N_out) = e3u(iref,jj,jk,Krhs) 
    939939              ENDDO 
    940940          
    941941              IF (N_out == 0) THEN 
    942                  ua(ji,jj,:) = 0._wp 
     942                 uu(ji,jj,:,Krhs) = 0._wp 
    943943                 CYCLE 
    944944              ENDIF 
    … …  
    952952                 endif 
    953953              ENDIF 
    954               call reconstructandremap(tabin(1:N_in),h_in(1:N_in),ua(ji,jj,1:N_out),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),h_out(1:N_out),N_in,N_out) 
    955955            ENDDO 
    956956         ENDDO 
    … …  
    959959         DO jk = 1, jpkm1 
    960960            DO jj=j1,j2 
    961                ua(i1:i2,jj,jk) = ptab(i1:i2,jj,jk,1) / ( zrhoy * e2u(i1:i2,jj) * e3u_a(i1:i2,jj,jk) ) 
     961               uu(i1:i2,jj,jk,Krhs) = ptab(i1:i2,jj,jk,1) / ( zrhoy * e2u(i1:i2,jj) * e3u(i1:i2,jj,jk,Krhs) ) 
    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_n(ji,jj,jk) * vn(ji,jj,jk)*vmask(ji,jj,jk)) 
     994                  ptab(ji,jj,jk,1) = (e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm)*vmask(ji,jj,jk)) 
    995995# if defined key_vertical 
    996                   ptab(ji,jj,jk,2) = vmask(ji,jj,jk) * e1v(ji,jj) * e3v_n(ji,jj,jk) 
     996                  ptab(ji,jj,jk,2) = vmask(ji,jj,jk) * e1v(ji,jj) * e3v(ji,jj,jk,Kmm) 
    997997# endif 
    998998               END DO 
    … …  
    10191019               END DO 
    10201020               IF (N_in == 0) THEN 
    1021                   va(ji,jj,:) = 0._wp 
     1021                  vv(ji,jj,:,Krhs) = 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_a(ji,jref,jk) 
     1029                  h_out(N_out) = e3v(ji,jref,jk,Krhs) 
    10301030               END DO 
    10311031               IF (N_out == 0) THEN 
    1032                  va(ji,jj,:) = 0._wp 
     1032                 vv(ji,jj,:,Krhs) = 0._wp 
    10331033                 CYCLE 
    10341034               ENDIF 
    1035                call reconstructandremap(tabin(1:N_in),h_in(1:N_in),va(ji,jj,1:N_out),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),h_out(1:N_out),N_in,N_out) 
    10361036            END DO 
    10371037         END DO 
    10381038# else 
    10391039         DO jk = 1, jpkm1 
    1040             va(i1:i2,j1:j2,jk) = ptab(i1:i2,j1:j2,jk,1) / ( zrhox * e1v(i1:i2,j1:j2) * e3v_a(i1:i2,j1:j2,jk) ) 
     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) ) 
    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) * un_b(i1:i2,j1:j2) 
     1062         ptab(i1:i2,j1:j2) = e2u(i1:i2,j1:j2) * hu_n(i1:i2,j1:j2) * uu_b(i1:i2,j1:j2,Kmm) 
    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) * vn_b(i1:i2,j1:j2) 
     1115         ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * hv_n(i1:i2,j1:j2) * vv_b(i1:i2,j1:j2,Kmm) 
    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_n(ji,jj,jk)  
     1396                 ptab(ji,jj,jk,2) = wmask(ji,jj,jk) * e3w(ji,jj,jk,Kmm)  
    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_n(ji,jj,jk) 
     1417                  h_out(jk) = e3t(ji,jj,jk,Kmm) 
    14181418               ENDDO 
    14191419               IF (N_in > 0) THEN 

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

    r10425 r10989  
    218218               DO jj=j1,j2 
    219219                  DO ji=i1,i2 
    220                      tabres(ji,jj,jk,jn) = tsb(ji,jj,jk,jn) 
     220                     tabres(ji,jj,jk,jn) = ts(ji,jj,jk,jn,Kbb) 
    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_n(ji,jj,jk)  
     230                  tabres(ji,jj,jk,jpts+1) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kmm)  
    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_n(ji,jj,jk) !Child grid scale factors. Could multiply by e1e2t here instead of division above 
     253                  h_out(jk) = e3t(ji,jj,jk,Kmm) !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) = tsb(ji,jj,jk,1:jpts) - tabres_child(ji,jj,jk,1:jpts) 
     270                  tsbdiff(ji,jj,jk,1:jpts) = ts(ji,jj,jk,1:jpts,Kbb) - tabres_child(ji,jj,jk,1:jpts) 
    271271# else 
    272                   tsbdiff(ji,jj,jk,1:jpts) = tsb(ji,jj,jk,1:jpts) - tabres(ji,jj,jk,1:jpts) 
     272                  tsbdiff(ji,jj,jk,1:jpts) = ts(ji,jj,jk,1:jpts,Kbb) - 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_n(ji,jj,jk) 
     283                     zabe1 = fsaht_spu(ji,jj) * umask(ji,jj,jk) * e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm) 
    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_n(ji,jj,jk) 
     290                     zabe2 = fsaht_spv(ji,jj) * vmask(ji,jj,jk) * e1_e2v(ji,jj) * e3v(ji,jj,jk,Kmm) 
    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_n(ji,jj,jk) 
     312                        zbtr = r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 
    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                         tsa(ji,jj,jk,jn) = tsa(ji,jj,jk,jn) + ztsa 
     316                        ts(ji,jj,jk,jn,Krhs) = ts(ji,jj,jk,jn,Krhs) + ztsa 
    317317                     ENDIF 
    318318                  END DO 
    … …  
    353353            DO jj=j1,j2 
    354354               DO ji=i1,i2 
    355                   tabres(ji,jj,jk,m1) = ub(ji,jj,jk) 
     355                  tabres(ji,jj,jk,m1) = uu(ji,jj,jk,Kbb) 
    356356# if defined key_vertical 
    357                   tabres(ji,jj,jk,m2) = e3u_n(ji,jj,jk)*umask(ji,jj,jk) 
     357                  tabres(ji,jj,jk,m2) = e3u(ji,jj,jk,Kmm)*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_n(ji,jj,jk) 
     386                 h_out(N_out) = e3u(ji,jj,jk,Kmm) 
    387387              ENDDO 
    388388          
    … …  
    403403         ENDDO 
    404404 
    405          ubdiff(i1:i2,j1:j2,:) = (ub(i1:i2,j1:j2,:) - tabres_child(i1:i2,j1:j2,:))*umask(i1:i2,j1:j2,:) 
     405         ubdiff(i1:i2,j1:j2,:) = (uu(i1:i2,j1:j2,:,Kbb) - tabres_child(i1:i2,j1:j2,:))*umask(i1:i2,j1:j2,:) 
    406406#else 
    407          ubdiff(i1:i2,j1:j2,:) = (ub(i1:i2,j1:j2,:) - tabres(i1:i2,j1:j2,:,1))*umask(i1:i2,j1:j2,:) 
     407         ubdiff(i1:i2,j1:j2,:) = (uu(i1:i2,j1:j2,:,Kbb) - 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_n(ji,jj,jk) * fsahm_spt(ji,jj) 
    419                   hdivdiff(ji,jj,jk) = (  e2u(ji  ,jj)*e3u_n(ji  ,jj,jk) * ubdiff(ji  ,jj,jk) & 
    420                                      &   -e2u(ji-1,jj)*e3u_n(ji-1,jj,jk) * ubdiff(ji-1,jj,jk) ) * zbtr 
     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 
    421421               END DO 
    422422            END DO 
    … …  
    424424            DO jj = j1,j2-1 
    425425               DO ji = i1,i2   ! vector opt. 
    426                   zbtr = r1_e1e2f(ji,jj) * e3f_n(ji,jj,jk) * fsahm_spf(ji,jj) 
     426                  zbtr = r1_e1e2f(ji,jj) * e3f(ji,jj,jk) * fsahm_spf(ji,jj) 
    427427                  rotdiff(ji,jj,jk) = ( -e1u(ji,jj+1) * ubdiff(ji,jj+1,jk)   & 
    428428                                    &   +e1u(ji,jj  ) * ubdiff(ji,jj  ,jk) ) * fmask(ji,jj,jk) * zbtr  
    … …  
    439439                     ze1v = hdivdiff(ji,jj,jk) 
    440440                     ! horizontal diffusive trends 
    441                      zua = - ( ze2u - rotdiff (ji,jj-1,jk) ) / ( e2u(ji,jj) * e3u_n(ji,jj,jk) )   & 
     441                     zua = - ( ze2u - rotdiff (ji,jj-1,jk) ) / ( e2u(ji,jj) * e3u(ji,jj,jk,Kmm) )   & 
    442442                           + ( hdivdiff(ji+1,jj,jk) - ze1v ) * r1_e1u(ji,jj) 
    443443 
    444444                     ! add it to the general momentum trends 
    445                      ua(ji,jj,jk) = ua(ji,jj,jk) + zua 
     445                     uu(ji,jj,jk,Krhs) = uu(ji,jj,jk,Krhs) + zua 
    446446 
    447447                  END DO 
    … …  
    465465 
    466466                     ! horizontal diffusive trends 
    467                      zva = + ( ze2u - rotdiff (ji-1,jj,jk) ) / ( e1v(ji,jj) * e3v_n(ji,jj,jk) )   & 
     467                     zva = + ( ze2u - rotdiff (ji-1,jj,jk) ) / ( e1v(ji,jj) * e3v(ji,jj,jk,Kmm) )   & 
    468468                           + ( hdivdiff(ji,jj+1,jk) - ze1v ) * r1_e2v(ji,jj) 
    469469 
    470470                     ! add it to the general momentum trends 
    471                      va(ji,jj,jk) = va(ji,jj,jk) + zva 
     471                     vv(ji,jj,jk,Krhs) = vv(ji,jj,jk,Krhs) + zva 
    472472                  END DO 
    473473               ENDIF 
    … …  
    506506            DO jj=j1,j2 
    507507               DO ji=i1,i2 
    508                   tabres(ji,jj,jk,m1) = vb(ji,jj,jk) 
     508                  tabres(ji,jj,jk,m1) = vv(ji,jj,jk,Kbb) 
    509509# if defined key_vertical 
    510                   tabres(ji,jj,jk,m2) = vmask(ji,jj,jk) * e3v_n(ji,jj,jk) 
     510                  tabres(ji,jj,jk,m2) = vmask(ji,jj,jk) * e3v(ji,jj,jk,Kmm) 
    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_n(ji,jj,jk) 
     538                 h_out(N_out) = e3v(ji,jj,jk,Kmm) 
    539539              ENDDO 
    540540          
    … …  
    549549         ENDDO 
    550550 
    551          vbdiff(i1:i2,j1:j2,:) = (vb(i1:i2,j1:j2,:) - tabres_child(i1:i2,j1:j2,:))*vmask(i1:i2,j1:j2,:)   
     551         vbdiff(i1:i2,j1:j2,:) = (vv(i1:i2,j1:j2,:,Kbb) - tabres_child(i1:i2,j1:j2,:))*vmask(i1:i2,j1:j2,:)   
    552552# else 
    553          vbdiff(i1:i2,j1:j2,:) = (vb(i1:i2,j1:j2,:) - tabres(i1:i2,j1:j2,:,1))*vmask(i1:i2,j1:j2,:) 
     553         vbdiff(i1:i2,j1:j2,:) = (vv(i1:i2,j1:j2,:,Kbb) - 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_n(ji,jj,jk) * fsahm_spt(ji,jj) 
    565                   hdivdiff(ji,jj,jk) = ( e1v(ji,jj  ) * e3v_n(ji,jj  ,jk) * vbdiff(ji,jj  ,jk)  & 
    566                                      &  -e1v(ji,jj-1) * e3v_n(ji,jj-1,jk) * vbdiff(ji,jj-1,jk)  ) * zbtr 
     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 
    567567               END DO 
    568568            END DO 
    569569            DO jj = j1,j2 
    570570               DO ji = i1,i2-1   ! vector opt. 
    571                   zbtr = r1_e1e2f(ji,jj) * e3f_n(ji,jj,jk) * fsahm_spf(ji,jj) 
     571                  zbtr = r1_e1e2f(ji,jj) * e3f(ji,jj,jk) * fsahm_spf(ji,jj) 
    572572                  rotdiff(ji,jj,jk) = ( e2v(ji+1,jj) * vbdiff(ji+1,jj,jk) &  
    573573                                    &  -e2v(ji  ,jj) * vbdiff(ji  ,jj,jk)  ) * fmask(ji,jj,jk) * zbtr 
    … …  
    586586               IF( .NOT. tabspongedone_u(ji,jj) ) THEN 
    587587                  DO jk = 1, jpkm1 
    588                      ua(ji,jj,jk) = ua(ji,jj,jk)                                                               & 
    589                         & - ( rotdiff (ji  ,jj,jk) - rotdiff (ji,jj-1,jk)) / ( e2u(ji,jj) * e3u_n(ji,jj,jk) )  & 
     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) )  & 
    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                      va(ji,jj,jk) = va(ji,jj,jk)                                                                  & 
    603                         &  + ( rotdiff (ji,jj  ,jk) - rotdiff (ji-1,jj,jk) ) / ( e1v(ji,jj) * e3v_n(ji,jj,jk) )   & 
     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) )   & 
    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/src/NST/agrif_oce_update.F90

    r10068 r10989  
    230230      ! ----------------------- 
    231231      ! 
    232       e3u_a(:,:,:) = e3u_n(:,:,:) 
    233       e3v_a(:,:,:) = e3v_n(:,:,:) 
    234 !      ua(:,:,:) = e3u_b(:,:,:) 
    235 !      va(:,:,:) = e3v_b(:,:,:) 
     232      e3u(:,:,:,Krhs) = e3u(:,:,:,Kmm) 
     233      e3v(:,:,:,Krhs) = e3v(:,:,:,Kmm) 
     234!      uu(:,:,:,Krhs) = e3u(:,:,:,Kbb) 
     235!      vv(:,:,:,Krhs) = e3v(:,:,:,Kbb) 
    236236      hu_a(:,:) = hu_n(:,:) 
    237237      hv_a(:,:) = hv_n(:,:) 
    … …  
    242242         ! Vertical scale factor interpolations 
    243243         ! ------------------------------------ 
    244       CALL dom_vvl_interpol( e3t_n(:,:,:), e3u_n(:,:,:) ,  'U' ) 
    245       CALL dom_vvl_interpol( e3t_n(:,:,:), e3v_n(:,:,:) ,  'V' ) 
    246       CALL dom_vvl_interpol( e3u_n(:,:,:), e3f_n(:,:,:) ,  'F' ) 
    247  
    248       CALL dom_vvl_interpol( e3u_n(:,:,:), e3uw_n(:,:,:), 'UW' ) 
    249       CALL dom_vvl_interpol( e3v_n(:,:,:), e3vw_n(:,:,:), 'VW' ) 
     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' ) 
    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_n(:,:,jk) * umask(:,:,jk) 
    257          hv_n(:,:) = hv_n(:,:) + e3v_n(:,:,jk) * vmask(:,:,jk) 
     256         hu_n(:,:) = hu_n(:,:) + e3u(:,:,jk,Kmm) * umask(:,:,jk) 
     257         hv_n(:,:) = hv_n(:,:) + e3v(:,:,jk,Kmm) * vmask(:,:,jk) 
    258258      END DO 
    259259      !                                        ! Inverse of the local depth 
    … …  
    268268         ! Vertical scale factor interpolations 
    269269         ! ------------------------------------ 
    270          CALL dom_vvl_interpol( e3t_b(:,:,:), e3u_b(:,:,:),  'U'  ) 
    271          CALL dom_vvl_interpol( e3t_b(:,:,:), e3v_b(:,:,:),  'V'  ) 
    272  
    273          CALL dom_vvl_interpol( e3u_b(:,:,:), e3uw_b(:,:,:), 'UW' ) 
    274          CALL dom_vvl_interpol( e3v_b(:,:,:), e3vw_b(:,:,:), 'VW' ) 
     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' ) 
    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_b(:,:,jk) * umask(:,:,jk) 
    282             hv_b(:,:) = hv_b(:,:) + e3v_b(:,:,jk) * vmask(:,:,jk) 
     281            hu_b(:,:) = hu_b(:,:) + e3u(:,:,jk,Kbb) * umask(:,:,jk) 
     282            hv_b(:,:) = hv_b(:,:) + e3v(:,:,jk,Kbb) * 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) = (tsn(ji,jj,jk,jn) * e3t_n(ji,jj,jk) ) & 
     317                     tabres(ji,jj,jk,jn) = (ts(ji,jj,jk,jn,Kmm) * e3t(ji,jj,jk,Kmm) ) & 
    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_n(ji,jj,jk) & 
     326                  tabres(ji,jj,jk,n2) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kmm) & 
    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_n(ji,jj,jk)  
     347                  h_out(N_out) = e3t(ji,jj,jk,Kmm)  
    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                            tsb(ji,jj,jk,jn) = tsb(ji,jj,jk,jn) &  
     371                           ts(ji,jj,jk,jn,Kbb) = ts(ji,jj,jk,jn,Kbb) &  
    372372                                 & + atfp * ( tabres_child(ji,jj,jk,jn) & 
    373                                  &          - tsn(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 
     373                                 &          - ts(ji,jj,jk,jn,Kmm) ) * 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                         tsn(ji,jj,jk,jn) = tabres_child(ji,jj,jk,jn) * tmask(ji,jj,jk) 
     385                        ts(ji,jj,jk,jn,Kmm) = 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) = tsn(ji,jj,jk,jn)  * e3t_n(ji,jj,jk) / e3t_0(ji,jj,jk) 
    416 !                     tabres(ji,jj,jk,jn) = tsn(ji,jj,jk,jn)  * e3t_n(ji,jj,jk) 
     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) 
    417417!< jc tmp 
    418418                  END DO 
    … …  
    434434                     DO ji = i1, i2 
    435435                        IF( tabres(ji,jj,jk,jn) /= 0._wp ) THEN 
    436                            ztb  = tsb(ji,jj,jk,jn) * e3t_b(ji,jj,jk) ! fse3t_b prior update should be used 
     436                           ztb  = ts(ji,jj,jk,jn,Kbb) * e3t(ji,jj,jk,Kbb) ! fse3t_b prior update should be used 
    437437                           ztnu = tabres(ji,jj,jk,jn) 
    438                            ztno = tsn(ji,jj,jk,jn) * e3t_a(ji,jj,jk) 
    439                            tsb(ji,jj,jk,jn) = ( ztb + atfp * ( ztnu - ztno) )  &  
    440                                      &        * tmask(ji,jj,jk) / e3t_b(ji,jj,jk) 
     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) 
    441441                        ENDIF 
    442442                     END DO 
    … …  
    450450                  DO ji=i1,i2 
    451451                     IF( tabres(ji,jj,jk,jn) /= 0._wp ) THEN  
    452                         tsn(ji,jj,jk,jn) = tabres(ji,jj,jk,jn) / e3t_n(ji,jj,jk) 
     452                        ts(ji,jj,jk,jn,Kmm) = tabres(ji,jj,jk,jn) / e3t(ji,jj,jk,Kmm) 
    453453                     END IF 
    454454                  END DO 
    … …  
    458458         ! 
    459459         IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 
    460             tsb(i1:i2,j1:j2,k1:k2,1:jpts)  = tsn(i1:i2,j1:j2,k1:k2,1:jpts) 
     460            ts(i1:i2,j1:j2,k1:k2,1:jpts,Kbb)  = ts(i1:i2,j1:j2,k1:k2,1:jpts,Kmm) 
    461461         ENDIF 
    462462         ! 
    … …  
    495495            DO jj=j1,j2 
    496496               DO ji=i1,i2 
    497                   tabres(ji,jj,jk,1) = zrhoy * e2u(ji,jj) * e3u_n(ji,jj,jk) * umask(ji,jj,jk) * un(ji,jj,jk)  & 
     497                  tabres(ji,jj,jk,1) = zrhoy * e2u(ji,jj) * e3u(ji,jj,jk,Kmm) * umask(ji,jj,jk) * uu(ji,jj,jk,Kmm)  & 
    498498                                       + (umask(ji,jj,jk)-1)*999._wp 
    499                   tabres(ji,jj,jk,2) = zrhoy * umask(ji,jj,jk) * e2u(ji,jj) * e3u_n(ji,jj,jk)  & 
     499                  tabres(ji,jj,jk,2) = zrhoy * umask(ji,jj,jk) * e2u(ji,jj) * e3u(ji,jj,jk,Kmm)  & 
    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_n(ji,jj,jk) 
     522                  h_out(N_out) = e3u(ji,jj,jk,Kmm) 
    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                      ub(ji,jj,jk) = ub(ji,jj,jk) &  
    553                            & + atfp * ( tabres_child(ji,jj,jk) - un(ji,jj,jk) ) * umask(ji,jj,jk) 
     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) 
    554554                  ENDIF 
    555555                  ! 
    556                   un(ji,jj,jk) = tabres_child(ji,jj,jk) * umask(ji,jj,jk) 
     556                  uu(ji,jj,jk,Kmm) = 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_n(i1:i2,j1:j2,jk) * un(i1:i2,j1:j2,jk) 
     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) 
    582582         END DO 
    583583      ELSE 
    … …  
    588588                  ! 
    589589                  IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 
    590                      zub  = ub(ji,jj,jk) * e3u_b(ji,jj,jk)  ! fse3t_b prior update should be used 
    591                      zuno = un(ji,jj,jk) * e3u_a(ji,jj,jk) 
     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) 
    592592                     zunu = tabres(ji,jj,jk,1) 
    593                      ub(ji,jj,jk) = ( zub + atfp * ( zunu - zuno) ) &       
    594                                     & * umask(ji,jj,jk) / e3u_b(ji,jj,jk) 
     593                     uu(ji,jj,jk,Kbb) = ( zub + atfp * ( zunu - zuno) ) &       
     594                                    & * umask(ji,jj,jk) / e3u(ji,jj,jk,Kbb) 
    595595                  ENDIF 
    596596                  ! 
    597                   un(ji,jj,jk) = tabres(ji,jj,jk,1) * umask(ji,jj,jk) / e3u_n(ji,jj,jk) 
     597                  uu(ji,jj,jk,Kmm) = tabres(ji,jj,jk,1) * umask(ji,jj,jk) / e3u(ji,jj,jk,Kmm) 
    598598               END DO 
    599599            END DO 
    … …  
    601601         ! 
    602602         IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 
    603             ub(i1:i2,j1:j2,k1:k2)  = un(i1:i2,j1:j2,k1:k2) 
     603            uu(i1:i2,j1:j2,k1:k2,Kbb)  = uu(i1:i2,j1:j2,k1:k2,Kmm) 
    604604         ENDIF 
    605605         ! 
    … …  
    632632         IF (western_side) THEN 
    633633            DO jj=j1,j2 
    634                zcor = un_b(i1-1,jj) * hu_a(i1-1,jj) * r1_hu_n(i1-1,jj) - un_b(i1-1,jj) 
    635                un_b(i1-1,jj) = un_b(i1-1,jj) + zcor 
     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 
    636636               DO jk=1,jpkm1 
    637                   un(i1-1,jj,jk) = un(i1-1,jj,jk) + zcor * umask(i1-1,jj,jk) 
     637                  uu(i1-1,jj,jk,Kmm) = uu(i1-1,jj,jk,Kmm) + zcor * umask(i1-1,jj,jk) 
    638638               END DO  
    639639            END DO 
    … …  
    642642         IF (eastern_side) THEN 
    643643            DO jj=j1,j2 
    644                zcor = un_b(i2+1,jj) * hu_a(i2+1,jj) * r1_hu_n(i2+1,jj) - un_b(i2+1,jj) 
    645                un_b(i2+1,jj) = un_b(i2+1,jj) + zcor 
     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 
    646646               DO jk=1,jpkm1 
    647                   un(i2+1,jj,jk) = un(i2+1,jj,jk) + zcor * umask(i2+1,jj,jk) 
     647                  uu(i2+1,jj,jk,Kmm) = uu(i2+1,jj,jk,Kmm) + 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_n(ji,jj,jk) * vmask(ji,jj,jk) * vn(ji,jj,jk) & 
     684                  tabres(ji,jj,jk,1) = zrhox * e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * vmask(ji,jj,jk) * vv(ji,jj,jk,Kmm) & 
    685685                                       + (vmask(ji,jj,jk)-1)*999._wp 
    686                   tabres(ji,jj,jk,2) = vmask(ji,jj,jk) * zrhox * e1v(ji,jj) * e3v_n(ji,jj,jk) & 
     686                  tabres(ji,jj,jk,2) = vmask(ji,jj,jk) * zrhox * e1v(ji,jj) * e3v(ji,jj,jk,Kmm) & 
    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_n(ji,jj,jk) 
     707                  h_out(N_out) = e3v(ji,jj,jk,Kmm) 
    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                      vb(ji,jj,jk) = vb(ji,jj,jk) &  
    739                            & + atfp * ( tabres_child(ji,jj,jk) - vn(ji,jj,jk) ) * vmask(ji,jj,jk) 
     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) 
    740740                  ENDIF 
    741741                  ! 
    742                   vn(ji,jj,jk) = tabres_child(ji,jj,jk) * vmask(ji,jj,jk) 
     742                  vv(ji,jj,jk,Kmm) = 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_n(ji,jj,jk) * vn(ji,jj,jk) 
     769                  tabres(ji,jj,jk,1) = zrhox * e1v(ji,jj) * e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) 
    770770               END DO 
    771771            END DO 
    … …  
    778778                  ! 
    779779                  IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) THEN ! Add asselin part 
    780                      zvb  = vb(ji,jj,jk) * e3v_b(ji,jj,jk) ! fse3t_b prior update should be used 
    781                      zvno = vn(ji,jj,jk) * e3v_a(ji,jj,jk) 
     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) 
    782782                     zvnu = tabres(ji,jj,jk,1) 
    783                      vb(ji,jj,jk) = ( zvb + atfp * ( zvnu - zvno) ) &       
    784                                     & * vmask(ji,jj,jk) / e3v_b(ji,jj,jk) 
     783                     vv(ji,jj,jk,Kbb) = ( zvb + atfp * ( zvnu - zvno) ) &       
     784                                    & * vmask(ji,jj,jk) / e3v(ji,jj,jk,Kbb) 
    785785                  ENDIF 
    786786                  ! 
    787                   vn(ji,jj,jk) = tabres(ji,jj,jk,1) * vmask(ji,jj,jk) / e3v_n(ji,jj,jk) 
     787                  vv(ji,jj,jk,Kmm) = tabres(ji,jj,jk,1) * vmask(ji,jj,jk) / e3v(ji,jj,jk,Kmm) 
    788788               END DO 
    789789            END DO 
    … …  
    791791         ! 
    792792         IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 
    793             vb(i1:i2,j1:j2,k1:k2)  = vn(i1:i2,j1:j2,k1:k2) 
     793            vv(i1:i2,j1:j2,k1:k2,Kbb)  = vv(i1:i2,j1:j2,k1:k2,Kmm) 
    794794         ENDIF 
    795795         ! 
    … …  
    822822         IF (southern_side) THEN 
    823823            DO ji=i1,i2 
    824                zcor = vn_b(ji,j1-1) * hv_a(ji,j1-1) * r1_hv_n(ji,j1-1) - vn_b(ji,j1-1) 
    825                vn_b(ji,j1-1) = vn_b(ji,j1-1) + zcor 
     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 
    826826               DO jk=1,jpkm1 
    827                   vn(ji,j1-1,jk) = vn(ji,j1-1,jk) + zcor * vmask(ji,j1-1,jk) 
     827                  vv(ji,j1-1,jk,Kmm) = vv(ji,j1-1,jk,Kmm) + zcor * vmask(ji,j1-1,jk) 
    828828               END DO  
    829829            END DO 
    … …  
    832832         IF (northern_side) THEN 
    833833            DO ji=i1,i2 
    834                zcor = vn_b(ji,j2+1) * hv_a(ji,j2+1) * r1_hv_n(ji,j2+1) - vn_b(ji,j2+1) 
    835                vn_b(ji,j2+1) = vn_b(ji,j2+1) + zcor 
     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 
    836836               DO jk=1,jpkm1 
    837                   vn(ji,j2+1,jk) = vn(ji,j2+1,jk) + zcor * vmask(ji,j2+1,jk) 
     837                  vv(ji,j2+1,jk,Kmm) = vv(ji,j2+1,jk,Kmm) + 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 * un_b(ji,jj) * hu_n(ji,jj) * e2u(ji,jj) 
     864               tabres(ji,jj) = zrhoy * uu_b(ji,jj,Kmm) * 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_n(ji,jj,jk) * un(ji,jj,jk) 
     875                  spgu(ji,jj) = spgu(ji,jj) + e3u(ji,jj,jk,Kmm) * uu(ji,jj,jk,Kmm) 
    876876               END DO 
    877877               ! 
    878878               zcorr = (tabres(ji,jj) - spgu(ji,jj)) * r1_hu_n(ji,jj) 
    879879               DO jk=1,jpkm1               
    880                   un(ji,jj,jk) = un(ji,jj,jk) + zcorr * umask(ji,jj,jk)            
     880                  uu(ji,jj,jk,Kmm) = uu(ji,jj,jk,Kmm) + 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) - un_b(ji,jj) * hu_a(ji,jj)) * r1_hu_b(ji,jj) 
    887                      ub_b(ji,jj) = ub_b(ji,jj) + atfp * zcorr * umask(ji,jj,1) 
     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) 
    888888                  END IF 
    889889               ENDIF     
    890                un_b(ji,jj) = tabres(ji,jj) * r1_hu_n(ji,jj) * umask(ji,jj,1) 
     890               uu_b(ji,jj,Kmm) = 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_b(ji,jj,jk) * ub(ji,jj,jk) 
     895                  spgu(ji,jj) = spgu(ji,jj) + e3u(ji,jj,jk,Kbb) * uu(ji,jj,jk,Kbb) 
    896896               END DO 
    897897               ! 
    898                zcorr = ub_b(ji,jj) - spgu(ji,jj) * r1_hu_b(ji,jj) 
     898               zcorr = uu_b(ji,jj,Kbb) - spgu(ji,jj) * r1_hu_b(ji,jj) 
    899899               DO jk=1,jpkm1               
    900                   ub(ji,jj,jk) = ub(ji,jj,jk) + zcorr * umask(ji,jj,jk)            
     900                  uu(ji,jj,jk,Kbb) = uu(ji,jj,jk,Kbb) + zcorr * umask(ji,jj,jk)            
    901901               END DO 
    902902               ! 
    … …  
    905905         ! 
    906906         IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 
    907             ub_b(i1:i2,j1:j2)  = un_b(i1:i2,j1:j2) 
     907            uu_b(i1:i2,j1:j2,Kbb)  = uu_b(i1:i2,j1:j2,Kmm) 
    908908         ENDIF 
    909909      ENDIF 
    … …  
    928928         DO jj=j1,j2 
    929929            DO ji=i1,i2 
    930                tabres(ji,jj) = zrhox * vn_b(ji,jj) * hv_n(ji,jj) * e1v(ji,jj)  
     930               tabres(ji,jj) = zrhox * vv_b(ji,jj,Kmm) * 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_n(ji,jj,jk) * vn(ji,jj,jk) 
     941                  spgv(ji,jj) = spgv(ji,jj) + e3v(ji,jj,jk,Kmm) * vv(ji,jj,jk,Kmm) 
    942942               END DO 
    943943               ! 
    944944               zcorr = (tabres(ji,jj) - spgv(ji,jj)) * r1_hv_n(ji,jj) 
    945945               DO jk=1,jpkm1               
    946                   vn(ji,jj,jk) = vn(ji,jj,jk) + zcorr * vmask(ji,jj,jk)            
     946                  vv(ji,jj,jk,Kmm) = vv(ji,jj,jk,Kmm) + 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) - vn_b(ji,jj) * hv_a(ji,jj)) * r1_hv_b(ji,jj) 
    953                      vb_b(ji,jj) = vb_b(ji,jj) + atfp * zcorr * vmask(ji,jj,1) 
     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) 
    954954                  END IF 
    955955               ENDIF               
    956                vn_b(ji,jj) = tabres(ji,jj) * r1_hv_n(ji,jj) * vmask(ji,jj,1) 
     956               vv_b(ji,jj,Kmm) = 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_b(ji,jj,jk) * vb(ji,jj,jk) 
     961                  spgv(ji,jj) = spgv(ji,jj) + e3v(ji,jj,jk,Kbb) * vv(ji,jj,jk,Kbb) 
    962962               END DO 
    963963               ! 
    964                zcorr = vb_b(ji,jj) - spgv(ji,jj) * r1_hv_b(ji,jj) 
     964               zcorr = vv_b(ji,jj,Kbb) - spgv(ji,jj) * r1_hv_b(ji,jj) 
    965965               DO jk=1,jpkm1               
    966                   vb(ji,jj,jk) = vb(ji,jj,jk) + zcorr * vmask(ji,jj,jk)            
     966                  vv(ji,jj,jk,Kbb) = vv(ji,jj,jk,Kbb) + zcorr * vmask(ji,jj,jk)            
    967967               END DO 
    968968               ! 
    … …  
    971971         ! 
    972972         IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 
    973             vb_b(i1:i2,j1:j2)  = vn_b(i1:i2,j1:j2) 
     973            vv_b(i1:i2,j1:j2,Kbb)  = vv_b(i1:i2,j1:j2,Kmm) 
    974974         ENDIF 
    975975         ! 
    … …  
    993993         DO jj=j1,j2 
    994994            DO ji=i1,i2 
    995                tabres(ji,jj) = sshn(ji,jj) 
     995               tabres(ji,jj) = ssh(ji,jj,Kmm) 
    996996            END DO 
    997997         END DO 
    … …  
    10001000            DO jj=j1,j2 
    10011001               DO ji=i1,i2 
    1002                   sshb(ji,jj) =   sshb(ji,jj) & 
    1003                         & + atfp * ( tabres(ji,jj) - sshn(ji,jj) ) * tmask(ji,jj,1) 
     1002                  ssh(ji,jj,Kbb) =   ssh(ji,jj,Kbb) & 
     1003                        & + atfp * ( tabres(ji,jj) - ssh(ji,jj,Kmm) ) * tmask(ji,jj,1) 
    10041004               END DO 
    10051005            END DO 
    … …  
    10081008         DO jj=j1,j2 
    10091009            DO ji=i1,i2 
    1010                sshn(ji,jj) = tabres(ji,jj) * tmask(ji,jj,1) 
     1010               ssh(ji,jj,Kmm) = 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             sshb(i1:i2,j1:j2)  = sshn(i1:i2,j1:j2) 
     1015            ssh(i1:i2,j1:j2,Kbb)  = ssh(i1:i2,j1:j2,Kmm) 
    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                sshn(i1  ,jj) = sshn(i1  ,jj) + zcor 
    1097                IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) sshb(i1  ,jj) = sshb(i1  ,jj) + atfp * zcor 
     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 
    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                sshn(i2+1,jj) = sshn(i2+1,jj) + zcor 
    1104                IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) sshb(i2+1,jj) = sshb(i2+1,jj) + atfp * zcor 
     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 
    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                sshn(ji,j1  ) = sshn(ji,j1  ) + zcor 
    1185                IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) sshb(ji,j1  ) = sshb(ji,j1) + atfp * zcor 
     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 
    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                sshn(ji,j2+1) = sshn(ji,j2+1) + zcor 
    1192                IF (.NOT.(lk_agrif_fstep.AND.(neuler==0))) sshb(ji,j2+1) = sshb(ji,j2+1) + atfp * zcor 
     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 
    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 + sshn(ji,jj) & 
     1321                  ptab(ji,jj,jk) = e3t_0(ji,jj,jk) * (1._wp + ssh(ji,jj,Kmm) & 
    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_a(i1:i2,j1:j2,1:jpkm1) = e3t_n(i1:i2,j1:j2,1:jpkm1) 
    1333  
    1334          ! One should also save e3t_b, but lacking of workspace... 
    1335 !         hdivn(i1:i2,j1:j2,1:jpkm1)   = e3t_b(i1:i2,j1:j2,1:jpkm1) 
     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) 
    13361336 
    13371337         IF (.NOT.(lk_agrif_fstep.AND.(neuler==0) )) THEN 
    … …  
    13391339               DO jj=j1,j2 
    13401340                  DO ji=i1,i2 
    1341                      e3t_b(ji,jj,jk) =  e3t_b(ji,jj,jk) & 
    1342                            & + atfp * ( ptab(ji,jj,jk) - e3t_n(ji,jj,jk) ) 
     1341                     e3t(ji,jj,jk,Kbb) =  e3t(ji,jj,jk,Kbb) & 
     1342                           & + atfp * ( ptab(ji,jj,jk) - e3t(ji,jj,jk,Kmm) ) 
    13431343                  END DO 
    13441344               END DO 
    13451345            END DO 
    13461346            ! 
    1347             e3w_b  (i1:i2,j1:j2,1) = e3w_0(i1:i2,j1:j2,1) + e3t_b(i1:i2,j1:j2,1) - e3t_0(i1:i2,j1:j2,1) 
    1348             gdepw_b(i1:i2,j1:j2,1) = 0.0_wp 
    1349             gdept_b(i1:i2,j1:j2,1) = 0.5_wp * e3w_b(i1:i2,j1:j2,1) 
     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) 
    13501350            ! 
    13511351            DO jk = 2, jpk 
    … …  
    13531353                  DO ji = i1,i2             
    13541354                     zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) 
    1355                      e3w_b(ji,jj,jk)  = e3w_0(ji,jj,jk) + ( 1.0_wp - 0.5_wp * tmask(ji,jj,jk) ) *        &  
    1356                      &                                        ( e3t_b(ji,jj,jk-1) - e3t_0(ji,jj,jk-1) )  & 
     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) )  & 
    13571357                     &                                  +            0.5_wp * tmask(ji,jj,jk)   *        & 
    1358                      &                                        ( e3t_b(ji,jj,jk  ) - e3t_0(ji,jj,jk  ) ) 
    1359                      gdepw_b(ji,jj,jk) = gdepw_b(ji,jj,jk-1) + e3t_b(ji,jj,jk-1) 
    1360                      gdept_b(ji,jj,jk) =      zcoef  * ( gdepw_b(ji,jj,jk  ) + 0.5 * e3w_b(ji,jj,jk))  & 
    1361                          &               + (1-zcoef) * ( gdept_b(ji,jj,jk-1) +       e3w_b(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))  
    13621362                  END DO 
    13631363               END DO 
    … …  
    13701370         ! 
    13711371         ! Update vertical scale factor at T-points: 
    1372          e3t_n(i1:i2,j1:j2,1:jpkm1) = ptab(i1:i2,j1:j2,1:jpkm1) 
     1372         e3t(i1:i2,j1:j2,1:jpkm1,Kmm) = 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_n(i1:i2,j1:j2,jk) * 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) * tmask(i1:i2,j1:j2,jk) 
    13781378         END DO 
    13791379         ! 
    13801380         ! Update vertical scale factor at W-points and depths: 
    1381          e3w_n (i1:i2,j1:j2,1) = e3w_0(i1:i2,j1:j2,1) + e3t_n(i1:i2,j1:j2,1) - e3t_0(i1:i2,j1:j2,1) 
    1382          gdept_n(i1:i2,j1:j2,1) = 0.5_wp * e3w_n(i1:i2,j1:j2,1) 
    1383          gdepw_n(i1:i2,j1:j2,1) = 0.0_wp 
    1384          gde3w_n(i1:i2,j1:j2,1) = gdept_n(i1:i2,j1:j2,1) - (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) = 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 
    13851385         ! 
    13861386         DO jk = 2, jpk 
    … …  
    13881388               DO ji = i1,i2             
    13891389               zcoef = (tmask(ji,jj,jk) - wmask(ji,jj,jk)) 
    1390                e3w_n(ji,jj,jk)  = e3w_0(ji,jj,jk) + ( 1.0_wp - 0.5_wp * tmask(ji,jj,jk) ) * ( e3t_n(ji,jj,jk-1) - e3t_0(ji,jj,jk-1) )   & 
    1391                &                                  +            0.5_wp * tmask(ji,jj,jk)   * ( e3t_n(ji,jj,jk  ) - e3t_0(ji,jj,jk  ) ) 
    1392                gdepw_n(ji,jj,jk) = gdepw_n(ji,jj,jk-1) + e3t_n(ji,jj,jk-1) 
    1393                gdept_n(ji,jj,jk) =      zcoef  * ( gdepw_n(ji,jj,jk  ) + 0.5 * e3w_n(ji,jj,jk))  & 
    1394                    &               + (1-zcoef) * ( gdept_n(ji,jj,jk-1) +       e3w_n(ji,jj,jk))  
    1395                gde3w_n(ji,jj,jk) = gdept_n(ji,jj,jk) - (ht_n(ji,jj)-ht_0(ji,jj)) ! Last term in the rhs is ssh 
     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 
    13961396               END DO 
    13971397            END DO 
    … …  
    13991399         ! 
    14001400         IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 
    1401             e3t_b (i1:i2,j1:j2,1:jpk)  = e3t_n (i1:i2,j1:j2,1:jpk) 
    1402             e3w_b (i1:i2,j1:j2,1:jpk)  = e3w_n (i1:i2,j1:j2,1:jpk) 
    1403             gdepw_b(i1:i2,j1:j2,1:jpk) = gdepw_n(i1:i2,j1:j2,1:jpk) 
    1404             gdept_b(i1:i2,j1:j2,1:jpk) = gdept_n(i1:i2,j1:j2,1:jpk) 
     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) 
    14051405         ENDIF 
    14061406         ! 

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

    r10068 r10989  
    7373               DO jj=j1,j2 
    7474                 DO ji=i1,i2 
    75                        ptab(ji,jj,jk,jn) = trn(ji,jj,jk,jn) 
     75                       ptab(ji,jj,jk,jn) = tr(ji,jj,jk,jn,Kmm) 
    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_n(ji,jj,jk)  
     85                 ptab(ji,jj,jk,jptra+1) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kmm)  
    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_n(iref,jref,jk) 
     115                  h_out(jk) = e3t(iref,jref,jk,Kmm) 
    116116               ENDDO 
    117117               IF (N_in > 0) THEN 
    … …  
    127127         ! 
    128128         DO jn=1, jptra 
    129             tra(i1:i2,j1:j2,1:jpk,jn)=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)=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                   tra(ibdy+1,jmin:jmax,1:jpkm1,jn) = 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) = 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                            tra(ibdy,jj,jk,jn) = tra(ibdy+1,jj,jk,jn) * tmask(ibdy,jj,jk) 
    158                         ELSE 
    159                            tra(ibdy,jj,jk,jn)=(z4*tra(ibdy+1,jj,jk,jn)+z3*tra(ibdy-1,jj,jk,jn))*tmask(ibdy,jj,jk) 
    160                            IF( un(ibdy-1,jj,jk) > 0._wp ) THEN 
    161                               tra(ibdy,jj,jk,jn)=( z6*tra(ibdy-1,jj,jk,jn)+z5*tra(ibdy+1,jj,jk,jn) &  
    162                                                  + z7*tra(ibdy-2,jj,jk,jn) ) * tmask(ibdy,jj,jk) 
    163                            ENDIF 
    164                         ENDIF 
    165                      END DO 
    166                   END DO 
    167                   ! Restore ghost points: 
    168                   tra(ibdy+1,jmin:jmax,1:jpkm1,jn) = ptab_child(ibdy+1,jmin:jmax,1:jpkm1,jn) * tmask(ibdy+1,jmin:jmax,1:jpkm1) 
     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) 
    169169               END DO 
    170170            ENDIF 
    … …  
    180180               jbdy = nlcj-nbghostcells          
    181181               DO jn = 1, jptra 
    182                   tra(imin:imax,jbdy+1,1:jpkm1,jn) = 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) = 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                            tra(ji,jbdy,jk,jn) = tra(ji,jbdy+1,jk,jn) * tmask(ji,jbdy,jk) 
    187                         ELSE 
    188                            tra(ji,jbdy,jk,jn)=(z4*tra(ji,jbdy+1,jk,jn)+z3*tra(ji,jbdy-1,jk,jn))*tmask(ji,jbdy,jk)         
    189                            IF (vn(ji,jbdy-1,jk) > 0._wp ) THEN 
    190                               tra(ji,jbdy,jk,jn)=( z6*tra(ji,jbdy-1,jk,jn)+z5*tra(ji,jbdy+1,jk,jn)  & 
    191                                                  + z7*tra(ji,jbdy-2,jk,jn) ) * tmask(ji,jbdy,jk) 
    192                            ENDIF 
    193                         ENDIF 
    194                      END DO 
    195                   END DO 
    196                   ! Restore ghost points: 
    197                   tra(imin:imax,jbdy+1,1:jpkm1,jn) = ptab_child(imin:imax,jbdy+1,1:jpkm1,jn) * tmask(imin:imax,jbdy+1,1:jpkm1) 
     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) 
    198198               END DO 
    199199            ENDIF 
    … …  
    209209               ibdy = 1+nbghostcells        
    210210               DO jn = 1, jptra 
    211                   tra(ibdy-1,jmin:jmax,1:jpkm1,jn) = 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) = 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                            tra(ibdy,jj,jk,jn) = tra(ibdy-1,jj,jk,jn) * tmask(ibdy,jj,jk) 
    216                         ELSE 
    217                            tra(ibdy,jj,jk,jn)=(z4*tra(ibdy-1,jj,jk,jn)+z3*tra(ibdy+1,jj,jk,jn))*tmask(ibdy,jj,jk)         
    218                            IF( un(ibdy,jj,jk) < 0._wp ) THEN 
    219                               tra(ibdy,jj,jk,jn)=( z6*tra(ibdy+1,jj,jk,jn)+z5*tra(ibdy-1,jj,jk,jn) & 
    220                                                  + z7*tra(ibdy+2,jj,jk,jn) ) * tmask(ibdy,jj,jk) 
    221                            ENDIF 
    222                         ENDIF 
    223                      END DO 
    224                   END DO 
    225                   ! Restore ghost points: 
    226                   tra(ibdy-1,jmin:jmax,1:jpkm1,jn) = ptab_child(ibdy-1,jmin:jmax,1:jpkm1,jn) * tmask(ibdy-1,jmin:jmax,1:jpkm1) 
     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) 
    227227               END DO 
    228228            ENDIF 
    … …  
    238238               jbdy=1+nbghostcells         
    239239               DO jn = 1, jptra 
    240                   tra(imin:imax,jbdy-1,1:jpkm1,jn) = 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) = 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                            tra(ji,jbdy,jk,jn)=tra(ji,jbdy-1,jk,jn) * tmask(ji,jbdy,jk) 
    245                         ELSE 
    246                            tra(ji,jbdy,jk,jn)=(z4*tra(ji,jbdy-1,jk,jn)+z3*tra(ji,jbdy+1,jk,jn))*tmask(ji,jbdy,jk) 
    247                            IF( vn(ji,jbdy,jk) < 0._wp ) THEN 
    248                               tra(ji,jbdy,jk,jn)=( z6*tra(ji,jbdy+1,jk,jn)+z5*tra(ji,jbdy-1,jk,jn) &  
    249                                                  + z7*tra(ji,jbdy+2,jk,jn) ) * tmask(ji,jbdy,jk) 
    250                            ENDIF 
    251                         ENDIF 
    252                      END DO 
    253                   END DO 
    254                   ! Restore ghost points: 
    255                   tra(imin:imax,jbdy-1,1:jpkm1,jn) = ptab_child(imin:imax,jbdy-1,1:jpkm1,jn) * tmask(imin:imax,jbdy-1,1:jpkm1) 
     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) 
    256256               END DO 
    257257            ENDIF 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/NST/agrif_top_sponge.F90

    r10068 r10989  
    8383               DO jj=j1,j2 
    8484                  DO ji=i1,i2 
    85                      tabres(ji,jj,jk,jn) = trb(ji,jj,jk,jn) 
     85                     tabres(ji,jj,jk,jn) = tr(ji,jj,jk,jn,Kbb) 
    8686                  END DO 
    8787               END DO 
    … …  
    9393            DO jj=j1,j2 
    9494               DO ji=i1,i2 
    95                   tabres(ji,jj,jk,jpts+1) = tmask(ji,jj,jk) * e3t_n(ji,jj,jk)  
     95                  tabres(ji,jj,jk,jpts+1) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kmm)  
    9696               END DO 
    9797            END DO 
    … …  
    114114                  IF (tmask(ji,jj,jk) == 0) EXIT  
    115115                  N_out = N_out + 1 
    116                   h_out(jk) = e3t_n(ji,jj,jk) !Child grid scale factors. Could multiply by e1e2t here instead of division above 
     116                  h_out(jk) = e3t(ji,jj,jk,Kmm) !Child grid scale factors. Could multiply by e1e2t here instead of division above 
    117117               ENDDO 
    118118               IF (N_in > 0) THEN 
    … …  
    131131               DO jk=1,jpkm1 
    132132# if defined key_vertical 
    133                   trbdiff(ji,jj,jk,1:jptra) = trb(ji,jj,jk,1:jptra) - tabres_child(ji,jj,jk,1:jptra) 
     133                  trbdiff(ji,jj,jk,1:jptra) = tr(ji,jj,jk,1:jptra,Kbb) - tabres_child(ji,jj,jk,1:jptra) 
    134134# else 
    135                   trbdiff(ji,jj,jk,1:jptra) = trb(ji,jj,jk,1:jptra) - tabres(ji,jj,jk,1:jptra) 
     135                  trbdiff(ji,jj,jk,1:jptra) = tr(ji,jj,jk,1:jptra,Kbb) - tabres(ji,jj,jk,1:jptra) 
    136136# endif 
    137137               ENDDO 
    … …  
    143143               DO jj = j1,j2-1 
    144144                  DO ji = i1,i2-1 
    145                      zabe1 = fsaht_spu(ji,jj) * e2_e1u(ji,jj) * e3u_n(ji,jj,jk) * umask(ji,jj,jk) 
    146                      zabe2 = fsaht_spv(ji,jj) * e1_e2v(ji,jj) * e3v_n(ji,jj,jk) * vmask(ji,jj,jk) 
     145                     zabe1 = fsaht_spu(ji,jj) * e2_e1u(ji,jj) * e3u(ji,jj,jk,Kmm) * umask(ji,jj,jk) 
     146                     zabe2 = fsaht_spv(ji,jj) * e1_e2v(ji,jj) * e3v(ji,jj,jk,Kmm) * vmask(ji,jj,jk) 
    147147                     ztu(ji,jj) = zabe1 * ( trbdiff(ji+1,jj  ,jk,jn) - trbdiff(ji,jj,jk,jn) ) 
    148148                     ztv(ji,jj) = zabe2 * ( trbdiff(ji  ,jj+1,jk,jn) - trbdiff(ji,jj,jk,jn) ) 
    … …  
    153153                  DO ji = i1+1,i2-1 
    154154                     IF( .NOT. tabspongedone_trn(ji,jj) ) THEN  
    155                         tra(ji,jj,jk,jn) = tra(ji,jj,jk,jn) + (  ztu(ji,jj) - ztu(ji-1,jj  )     & 
     155                        tr(ji,jj,jk,jn,Krhs) = tr(ji,jj,jk,jn,Krhs) + (  ztu(ji,jj) - ztu(ji-1,jj  )     & 
    156156                           &                                   + ztv(ji,jj) - ztv(ji  ,jj-1)  )  & 
    157                            &                                * r1_e1e2t(ji,jj) / e3t_n(ji,jj,jk) 
     157                           &                                * r1_e1e2t(ji,jj) / e3t(ji,jj,jk,Kmm) 
    158158                     ENDIF 
    159159                  END DO 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/NST/agrif_top_update.F90

    r10068 r10989  
    8484               DO jj=j1,j2 
    8585                  DO ji=i1,i2 
    86                      tabres(ji,jj,jk,jn) = (trn(ji,jj,jk,jn) * e3t_n(ji,jj,jk) ) & 
     86                     tabres(ji,jj,jk,jn) = (tr(ji,jj,jk,jn,Kmm) * e3t(ji,jj,jk,Kmm) ) & 
    8787                                           * tmask(ji,jj,jk) + (tmask(ji,jj,jk)-1)*999._wp 
    8888                  END DO 
    … …  
    9393            DO jj=j1,j2 
    9494               DO ji=i1,i2 
    95                   tabres(ji,jj,jk,n2) = tmask(ji,jj,jk) * e3t_n(ji,jj,jk) & 
     95                  tabres(ji,jj,jk,n2) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kmm) & 
    9696                                           + (tmask(ji,jj,jk)-1)*999._wp 
    9797               END DO 
    … …  
    114114                  IF (tmask(ji,jj,jk) < -900) EXIT ! TODO: Will not work with ISF 
    115115                  N_out = N_out + 1 
    116                   h_out(N_out) = e3t_n(ji,jj,jk) !Parent grid scale factors. Could multiply by e1e2t here instead of division above 
     116                  h_out(N_out) = e3t(ji,jj,jk,Kmm) !Parent grid scale factors. Could multiply by e1e2t here instead of division above 
    117117               ENDDO 
    118118               IF (N_in > 0) THEN !Remove this? 
    … …  
    138138                     DO ji=i1,i2 
    139139                        IF( tabres_child(ji,jj,jk,jn) .NE. 0. ) THEN 
    140                            trb(ji,jj,jk,jn) = tsb(ji,jj,jk,jn) &  
     140                           tr(ji,jj,jk,jn,Kbb) = ts(ji,jj,jk,jn,Kbb) &  
    141141                                 & + atfp * ( tabres_child(ji,jj,jk,jn) & 
    142                                  &          - trn(ji,jj,jk,jn) ) * tmask(ji,jj,jk) 
     142                                 &          - tr(ji,jj,jk,jn,Kmm) ) * tmask(ji,jj,jk) 
    143143                        ENDIF 
    144144                     ENDDO 
    … …  
    152152                  DO ji=i1,i2 
    153153                     IF( tabres_child(ji,jj,jk,jn) .NE. 0. ) THEN  
    154                         trn(ji,jj,jk,jn) = tabres_child(ji,jj,jk,jn) * tmask(ji,jj,jk) 
     154                        tr(ji,jj,jk,jn,Kmm) = tabres_child(ji,jj,jk,jn) * tmask(ji,jj,jk) 
    155155                     END IF 
    156156                  END DO 
    … …  
    183183                  DO ji=i1,i2 
    184184!> jc tmp 
    185                      tabres(ji,jj,jk,jn) = trn(ji,jj,jk,jn)  * e3t_n(ji,jj,jk) / e3t_0(ji,jj,jk) 
    186 !                     tabres(ji,jj,jk,jn) = trn(ji,jj,jk,jn)  * e3t_n(ji,jj,jk) 
     185                     tabres(ji,jj,jk,jn) = tr(ji,jj,jk,jn,Kmm)  * e3t(ji,jj,jk,Kmm) / e3t_0(ji,jj,jk) 
     186!                     tabres(ji,jj,jk,jn) = tr(ji,jj,jk,jn,Kmm)  * e3t(ji,jj,jk,Kmm) 
    187187!< jc tmp 
    188188                  END DO 
    … …  
    204204                     DO ji=i1,i2 
    205205                        IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN 
    206                            ztb  = trb(ji,jj,jk,jn) * e3t_b(ji,jj,jk) ! fse3t_b prior update should be used 
     206                           ztb  = tr(ji,jj,jk,jn,Kbb) * e3t(ji,jj,jk,Kbb) ! fse3t_b prior update should be used 
    207207                           ztnu = tabres(ji,jj,jk,jn) 
    208                            ztno = trn(ji,jj,jk,jn) * e3t_a(ji,jj,jk) 
    209                            trb(ji,jj,jk,jn) = ( ztb + atfp * ( ztnu - ztno) )  &  
    210                                      &        * tmask(ji,jj,jk) / e3t_b(ji,jj,jk) 
     208                           ztno = tr(ji,jj,jk,jn,Kmm) * e3t(ji,jj,jk,Krhs) 
     209                           tr(ji,jj,jk,jn,Kbb) = ( ztb + atfp * ( ztnu - ztno) )  &  
     210                                     &        * tmask(ji,jj,jk) / e3t(ji,jj,jk,Kbb) 
    211211                        ENDIF 
    212212                     ENDDO 
    … …  
    220220                  DO ji=i1,i2 
    221221                     IF( tabres(ji,jj,jk,jn) .NE. 0. ) THEN  
    222                         trn(ji,jj,jk,jn) = tabres(ji,jj,jk,jn) / e3t_n(ji,jj,jk) 
     222                        tr(ji,jj,jk,jn,Kmm) = tabres(ji,jj,jk,jn) / e3t(ji,jj,jk,Kmm) 
    223223                     END IF 
    224224                  END DO 
    … …  
    228228         ! 
    229229         IF  ((neuler==0).AND.(Agrif_Nb_Step()==0) ) THEN 
    230             trb(i1:i2,j1:j2,k1:k2,n1:n2)  = trn(i1:i2,j1:j2,k1:k2,n1:n2) 
     230            tr(i1:i2,j1:j2,k1:k2,n1:n2,Kbb)  = tr(i1:i2,j1:j2,k1:k2,n1:n2,Kmm) 
    231231         ENDIF 
    232232         ! 

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

    r10425 r10989  
    175175   tabspongedone_tsn = .FALSE. 
    176176   CALL Agrif_Bc_variable(tsn_sponge_id,calledweight=1.,procname=interptsn_sponge) 
    177    ! reset tsa to zero 
    178    tsa(:,:,:,:) = 0. 
     177   ! reset ts(:,:,:,:,Krhs) to zero 
     178   ts(:,:,:,:,Krhs) = 0. 
    179179 
    180180   Agrif_UseSpecialValue = ln_spc_dyn 
    … …  
    191191   CALL Agrif_Bc_variable(sshn_id,calledweight=1., procname=interpsshn ) 
    192192   hbdy_w(:,:) = 0.e0 ; hbdy_e(:,:) = 0.e0 ; hbdy_n(:,:) = 0.e0 ; hbdy_s(:,:) = 0.e0 
    193    ssha(:,:) = 0.e0 
     193   ssh(:,:,Krhs) = 0.e0 
    194194 
    195195   IF ( ln_dynspg_ts ) THEN 
    … …  
    207207   Agrif_UseSpecialValue = .FALSE.  
    208208   ! reset velocities to zero 
    209    ua(:,:,:) = 0. 
    210    va(:,:,:) = 0. 
     209   uu(:,:,:,Krhs) = 0. 
     210   vv(:,:,:,Krhs) = 0. 
    211211 
    212212   ! 3. Some controls 
    … …  
    591591   tabspongedone_trn = .FALSE. 
    592592   CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge) 
    593    ! reset tsa to zero 
    594    tra(:,:,:,:) = 0. 
     593   ! reset ts(:,:,:,:,Krhs) to zero 
     594   tr(:,:,:,:,Krhs) = 0. 
    595595 
    596596 

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

    r10965 r10989  
    5757   USE lib_mpp         ! MPP library 
    5858   USE timing          ! preformance summary 
    59    USE diurnal_bulk    ! diurnal warm layer 
    60    USE cool_skin       ! Cool skin 
     59   USE diu_bulk        ! diurnal warm layer 
     60   USE diu_coolskin    ! Cool skin 
    6161 
    6262   IMPLICIT NONE 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/DIU/diu_bulk.F90

    r10985 r10989  
    1 MODULE diurnal_bulk 
     1MODULE diu_bulk 
    22   !!====================================================================== 
    3    !!                    ***  MODULE  diurnal_bulk  *** 
     3   !!                    ***  MODULE  diu_bulk  *** 
    44   !!     Takaya model of diurnal warming (Takaya, 2010) 
    55   !!===================================================================== 
    … …  
    265265      END FUNCTION t_imp 
    266266 
    267 END MODULE diurnal_bulk 
     267END MODULE diu_bulk 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/DIU/diu_coolskin.F90

    r10985 r10989  
    1 MODULE cool_skin 
     1MODULE diu_coolskin 
    22   !!====================================================================== 
    3    !!                    ***  MODULE  cool_skin  *** 
     3   !!                    ***  MODULE  diu_coolskin  *** 
    44   !!     Cool skin thickness and delta T correction using Artele et al. (2002) 
    55   !!     [see also Tu and Tsuang (2005)] 
    … …  
    3838   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: x_csdsst    ! Cool skin delta SST 
    3939   REAL(wp), PUBLIC, ALLOCATABLE, DIMENSION(:,:) :: x_csthick   ! Cool skin thickness 
    40  
    4140   PUBLIC diurnal_sst_coolskin_step, diurnal_sst_coolskin_init 
    4241 
    … …  
    9695      !!---------------------------------------------------------------------- 
    9796      ! 
    98       IF( .NOT. ln_blk )   CALL ctl_stop("cool_skin.f90: diurnal flux processing only implemented for bulk forcing") 
     97      IF( .NOT. ln_blk )   CALL ctl_stop("diu_coolskin.f90: diurnal flux processing only implemented for bulk forcing") 
    9998      ! 
    10099      DO jj = 1,jpj 
    … …  
    144143 
    145144   !!====================================================================== 
    146 END MODULE cool_skin 
     145END MODULE diu_coolskin 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/DIU/diu_layers.F90

    r10985 r10989  
    66   !! History :  3.7  ! 2015-11  (J. While)  Original code 
    77 
    8    USE diurnal_bulk    ! diurnal SST bulk routines  (diurnal_sst_takaya routine)  
    9    USE cool_skin      ! diurnal cool skin correction (diurnal_sst_coolskin routine)    
     8   USE diu_bulk     ! diurnal SST bulk routines  (diurnal_sst_takaya routine)  
     9   USE diu_coolskin ! diurnal cool skin correction (diurnal_sst_coolskin routine)    
    1010   USE oce 
    1111   USE iom 
    1212   USE sbc_oce 
    13    USE sbcmod           ! surface boundary condition       (sbc     routine) 
     13   USE sbcmod       ! surface boundary condition       (sbc     routine) 
    1414    
    1515   IMPLICIT NONE 

  • NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/OCE/IOM/iom.F90

    r10523 r10989  
    4646#endif 
    4747   USE lib_fortran  
    48    USE diurnal_bulk, ONLY : ln_diurnal_only, ln_diurnal 
     48   USE diu_bulk, ONLY : ln_diurnal_only, ln_diurnal 
    4949 
    5050   IMPLICIT NONE 

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

    r10922 r10989  
    2727   USE in_out_manager  ! I/O manager 
    2828   USE iom             ! I/O module 
    29    USE diurnal_bulk 
     29   USE diu_bulk 
    3030   USE lib_mpp         ! distribued memory computing library 
    3131 

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

    r10946 r10989  
    5959   USE timing         ! Timing 
    6060   USE wet_dry 
    61    USE diurnal_bulk, ONLY:   ln_diurnal_only   ! diurnal SST diagnostic 
     61   USE diu_bulk, ONLY:   ln_diurnal_only   ! diurnal SST diagnostic 
    6262 
    6363   IMPLICIT NONE 
Note: See TracChangeset for help on using the changeset viewer.