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

Changeset 11027


Ignore:
Timestamp:
2019-05-21T17:33:54+02:00 (6 years ago)
Author:
acc
Message:

2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps : Final renaming conversions and removal of temporary pointers. All non-AGRIF SETTE tests are passing (including test cases). AGRIF tests compile and link but segment on first call to Agrif_Regrid. NST changes are therefore a work in progress but nothing is broken that was not broken before

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

Legend:

Unmodified
Added
Removed

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

    r10425 r11027  
    6666   INTEGER, PUBLIC :: umsk_id, vmsk_id 
    6767   INTEGER, PUBLIC :: kindic_agr 
     68   INTEGER, PUBLIC :: Kbb_a, Kmm_a, Krhs_a 
    6869    
    6970   !!---------------------------------------------------------------------- 

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

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

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

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

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

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

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

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

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

    r10989 r11027  
    175175   tabspongedone_tsn = .FALSE. 
    176176   CALL Agrif_Bc_variable(tsn_sponge_id,calledweight=1.,procname=interptsn_sponge) 
    177    ! reset ts(:,:,:,:,Krhs) to zero 
    178    ts(:,:,:,:,Krhs) = 0. 
     177   ! reset ts(:,:,:,:,Krhs_a) to zero 
     178   ts(:,:,:,:,Krhs_a) = 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    ssh(:,:,Krhs) = 0.e0 
     193   ssh(:,:,Krhs_a) = 0.e0 
    194194 
    195195   IF ( ln_dynspg_ts ) THEN 
    … …  
    207207   Agrif_UseSpecialValue = .FALSE.  
    208208   ! reset velocities to zero 
    209    uu(:,:,:,Krhs) = 0. 
    210    vv(:,:,:,Krhs) = 0. 
     209   uu(:,:,:,Krhs_a) = 0. 
     210   vv(:,:,:,Krhs_a) = 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 ts(:,:,:,:,Krhs) to zero 
    594    tr(:,:,:,:,Krhs) = 0. 
     593   ! reset ts(:,:,:,:,Krhs_a) to zero 
     594   tr(:,:,:,:,Krhs_a) = 0. 
    595595 
    596596 

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

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

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

    r10880 r11027  
    155155   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::           r1_hu_b , r1_hu_n , r1_hu_a   !: inverse of u-depth [1/m] 
    156156   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) ::           r1_hv_b , r1_hv_n , r1_hv_a   !: inverse of v-depth [1/m] 
    157  
    158    !! TEMPORARY POINTERS FOR DEVELOPMENT ONLY 
    159    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:) ::     e3t_b ,   e3t_n ,  e3t_a   !: t- vert. scale factor [m] 
    160    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:) ::     e3u_b ,   e3u_n ,  e3u_a   !: u- vert. scale factor [m] 
    161    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:) ::     e3v_b ,   e3v_n ,  e3v_a   !: v- vert. scale factor [m] 
    162    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:) ::               e3f_n            !: f- vert. scale factor [m] 
    163    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:) ::     e3w_b ,   e3w_n            !: w- vert. scale factor [m] 
    164    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:) ::    e3uw_b ,  e3uw_n            !: uw-vert. scale factor [m] 
    165    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:) ::    e3vw_b ,  e3vw_n            !: vw-vert. scale factor [m] 
    166    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:) ::    gdept_b , gdept_n           !: t- depth              [m]     
    167    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:) ::    gdepw_b , gdepw_n           !: w- depth              [m] 
    168    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:) ::    gde3w_n                     !: w- depth (sum of e3w) [m] 
    169    !! TEMPORARY POINTERS FOR DEVELOPMENT ONLY 
    170157 
    171158   INTEGER, PUBLIC ::   nla10              !: deepest    W level Above  ~10m (nlb10 - 1) 

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

    r10957 r11027  
    6464CONTAINS 
    6565 
    66    SUBROUTINE dyn_nxt ( kt, Kbb, Kmm, Kaa ) 
     66   SUBROUTINE dyn_nxt ( kt, Kbb, Kmm, Krhs, puu, pvv, Kaa ) 
    6767      !!---------------------------------------------------------------------- 
    6868      !!                  ***  ROUTINE dyn_nxt  *** 
    … …  
    8383      !!              * Apply the time filter applied and swap of the dynamics 
    8484      !!             arrays to start the next time step: 
    85       !!                (ub,vb) = (un,vn) + atfp [ (ub,vb) + (ua,va) - 2 (un,vn) ] 
    86       !!                (un,vn) = (ua,va). 
     85      !!                (puu(Kbb),pvv(Kbb)) = (puu(Kmm),pvv(Kmm)) + atfp [ (puu(Kbb),pvv(Kbb)) + (puu(Krhs),pvv(Krhs)) - 2 (puu(Kmm),pvv(Kmm)) ] 
     86      !!                (puu(Kmm),pvv(Kmm)) = (puu(Krhs),pvv(Krhs)). 
    8787      !!             Note that with flux form advection and non linear free surface, 
    8888      !!             the time filter is applied on thickness weighted velocity. 
    8989      !!             As a result, dyn_nxt MUST be called after tra_nxt. 
    9090      !! 
    91       !! ** Action :   ub,vb   filtered before horizontal velocity of next time-step 
    92       !!               un,vn   now horizontal velocity of next time-step 
     91      !! ** Action :   puu(Kbb),pvv(Kbb)   filtered before horizontal velocity of next time-step 
     92      !!               puu(Kmm),pvv(Kmm)   now horizontal velocity of next time-step 
    9393      !!---------------------------------------------------------------------- 
    94       INTEGER, INTENT( in ) ::   kt             ! ocean time-step index 
    95       INTEGER, INTENT( in ) ::   Kbb, Kmm, Kaa  ! time level indices 
     94      INTEGER, INTENT( in ) ::   kt                   ! ocean time-step index 
     95      INTEGER, INTENT( in ) ::   Kbb, Kmm, Krhs, Kaa  ! time level indices 
     96      REAL(wp), DIMENSION(jpi,jpj,jpk,jpt), INTENT(inout) :: puu, pvv        !  velocity arrays 
    9697      ! 
    9798      INTEGER  ::   ji, jj, jk   ! dummy loop indices 
    … …  
    116117         ! Ensure below that barotropic velocities match time splitting estimate 
    117118         ! Compute actual transport and replace it with ts estimate at "after" time step 
    118          zue(:,:) = e3u_a(:,:,1) * ua(:,:,1) * umask(:,:,1) 
    119          zve(:,:) = e3v_a(:,:,1) * va(:,:,1) * vmask(:,:,1) 
     119         zue(:,:) = e3u(:,:,1,Krhs) * puu(:,:,1,Krhs) * umask(:,:,1) 
     120         zve(:,:) = e3v(:,:,1,Krhs) * pvv(:,:,1,Krhs) * vmask(:,:,1) 
    120121         DO jk = 2, jpkm1 
    121             zue(:,:) = zue(:,:) + e3u_a(:,:,jk) * ua(:,:,jk) * umask(:,:,jk) 
    122             zve(:,:) = zve(:,:) + e3v_a(:,:,jk) * va(:,:,jk) * vmask(:,:,jk) 
     122            zue(:,:) = zue(:,:) + e3u(:,:,jk,Krhs) * puu(:,:,jk,Krhs) * umask(:,:,jk) 
     123            zve(:,:) = zve(:,:) + e3v(:,:,jk,Krhs) * pvv(:,:,jk,Krhs) * vmask(:,:,jk) 
    123124         END DO 
    124125         DO jk = 1, jpkm1 
    125             ua(:,:,jk) = ( ua(:,:,jk) - zue(:,:) * r1_hu_a(:,:) + ua_b(:,:) ) * umask(:,:,jk) 
    126             va(:,:,jk) = ( va(:,:,jk) - zve(:,:) * r1_hv_a(:,:) + va_b(:,:) ) * vmask(:,:,jk) 
     126            puu(:,:,jk,Krhs) = ( puu(:,:,jk,Krhs) - zue(:,:) * r1_hu_a(:,:) + uu_b(:,:,Krhs) ) * umask(:,:,jk) 
     127            pvv(:,:,jk,Krhs) = ( pvv(:,:,jk,Krhs) - zve(:,:) * r1_hv_a(:,:) + vv_b(:,:,Krhs) ) * vmask(:,:,jk) 
    127128         END DO 
    128129         ! 
    … …  
    133134            ! so that asselin contribution is removed at the same time  
    134135            DO jk = 1, jpkm1 
    135                un(:,:,jk) = ( un(:,:,jk) - un_adv(:,:)*r1_hu_n(:,:) + un_b(:,:) )*umask(:,:,jk) 
    136                vn(:,:,jk) = ( vn(:,:,jk) - vn_adv(:,:)*r1_hv_n(:,:) + vn_b(:,:) )*vmask(:,:,jk) 
     136               puu(:,:,jk,Kmm) = ( puu(:,:,jk,Kmm) - un_adv(:,:)*r1_hu_n(:,:) + uu_b(:,:,Kmm) )*umask(:,:,jk) 
     137               pvv(:,:,jk,Kmm) = ( pvv(:,:,jk,Kmm) - vn_adv(:,:)*r1_hv_n(:,:) + vv_b(:,:,Kmm) )*vmask(:,:,jk) 
    137138            END DO   
    138139         ENDIF 
    … …  
    142143      ! --------------------------------------------------       
    143144# if defined key_agrif 
    144       CALL Agrif_dyn( kt )             !* AGRIF zoom boundaries 
     145      Krhs_a = Krhs ; CALL Agrif_dyn( kt )             !* AGRIF zoom boundaries 
    145146# endif 
    146147      ! 
    147       CALL lbc_lnk_multi( 'dynnxt', ua, 'U', -1., va, 'V', -1. )     !* local domain boundaries 
     148      CALL lbc_lnk_multi( 'dynnxt', puu(:,:,:,Krhs), 'U', -1., pvv(:,:,:,Krhs), 'V', -1. )     !* local domain boundaries 
    148149      ! 
    149150      !                                !* BDY open boundaries 
    … …  
    162163         ! 
    163164         !                                  ! Kinetic energy and Conversion 
    164          IF( ln_KE_trd  )   CALL trd_dyn( ua, va, jpdyn_ken, kt, Kmm ) 
     165         IF( ln_KE_trd  )   CALL trd_dyn( puu(:,:,:,Krhs), pvv(:,:,:,Krhs), jpdyn_ken, kt, Kmm ) 
    165166         ! 
    166167         IF( ln_dyn_trd ) THEN              ! 3D output: total momentum trends 
    167             zua(:,:,:) = ( ua(:,:,:) - ub(:,:,:) ) * z1_2dt 
    168             zva(:,:,:) = ( va(:,:,:) - vb(:,:,:) ) * z1_2dt 
     168            zua(:,:,:) = ( puu(:,:,:,Krhs) - puu(:,:,:,Kbb) ) * z1_2dt 
     169            zva(:,:,:) = ( pvv(:,:,:,Krhs) - pvv(:,:,:,Kbb) ) * z1_2dt 
    169170            CALL iom_put( "utrd_tot", zua )        ! total momentum trends, except the asselin time filter 
    170171            CALL iom_put( "vtrd_tot", zva ) 
    171172         ENDIF 
    172173         ! 
    173          zua(:,:,:) = un(:,:,:)             ! save the now velocity before the asselin filter 
    174          zva(:,:,:) = vn(:,:,:)             ! (caution: there will be a shift by 1 timestep in the 
     174         zua(:,:,:) = puu(:,:,:,Kmm)             ! save the now velocity before the asselin filter 
     175         zva(:,:,:) = pvv(:,:,:,Kmm)             ! (caution: there will be a shift by 1 timestep in the 
    175176         !                                  !  computation of the asselin filter trends) 
    176177      ENDIF 
    … …  
    180181      IF( neuler == 0 .AND. kt == nit000 ) THEN        !* Euler at first time-step: only swap 
    181182         DO jk = 1, jpkm1 
    182             un(:,:,jk) = ua(:,:,jk)                         ! un <-- ua 
    183             vn(:,:,jk) = va(:,:,jk) 
     183            puu(:,:,jk,Kmm) = puu(:,:,jk,Krhs)                         ! puu(:,:,:,Kmm) <-- puu(:,:,:,Krhs) 
     184            pvv(:,:,jk,Kmm) = pvv(:,:,jk,Krhs) 
    184185         END DO 
    185186         IF( .NOT.ln_linssh ) THEN                          ! e3._b <-- e3._n 
    186187!!gm BUG ????    I don't understand why it is not : e3._n <-- e3._a   
    187188            DO jk = 1, jpkm1 
    188 !               e3t_b(:,:,jk) = e3t_n(:,:,jk) 
    189 !               e3u_b(:,:,jk) = e3u_n(:,:,jk) 
    190 !               e3v_b(:,:,jk) = e3v_n(:,:,jk) 
     189!               e3t(:,:,jk,Kbb) = e3t(:,:,jk,Kmm) 
     190!               e3u(:,:,jk,Kbb) = e3u(:,:,jk,Kmm) 
     191!               e3v(:,:,jk,Kbb) = e3v(:,:,jk,Kmm) 
    191192               ! 
    192                e3t_n(:,:,jk) = e3t_a(:,:,jk) 
    193                e3u_n(:,:,jk) = e3u_a(:,:,jk) 
    194                e3v_n(:,:,jk) = e3v_a(:,:,jk) 
     193               e3t(:,:,jk,Kmm) = e3t(:,:,jk,Krhs) 
     194               e3u(:,:,jk,Kmm) = e3u(:,:,jk,Krhs) 
     195               e3v(:,:,jk,Kmm) = e3v(:,:,jk,Krhs) 
    195196            END DO 
    196197!!gm BUG end 
    … …  
    205206               DO jj = 1, jpj 
    206207                  DO ji = 1, jpi     
    207                      zuf = un(ji,jj,jk) + atfp * ( ub(ji,jj,jk) - 2._wp * un(ji,jj,jk) + ua(ji,jj,jk) ) 
    208                      zvf = vn(ji,jj,jk) + atfp * ( vb(ji,jj,jk) - 2._wp * vn(ji,jj,jk) + va(ji,jj,jk) ) 
     208                     zuf = puu(ji,jj,jk,Kmm) + atfp * ( puu(ji,jj,jk,Kbb) - 2._wp * puu(ji,jj,jk,Kmm) + puu(ji,jj,jk,Krhs) ) 
     209                     zvf = pvv(ji,jj,jk,Kmm) + atfp * ( pvv(ji,jj,jk,Kbb) - 2._wp * pvv(ji,jj,jk,Kmm) + pvv(ji,jj,jk,Krhs) ) 
    209210                     ! 
    210                      ub(ji,jj,jk) = zuf                      ! ub <-- filtered velocity 
    211                      vb(ji,jj,jk) = zvf 
    212                      un(ji,jj,jk) = ua(ji,jj,jk)             ! un <-- ua 
    213                      vn(ji,jj,jk) = va(ji,jj,jk) 
     211                     puu(ji,jj,jk,Kbb) = zuf                      ! puu(:,:,:,Kbb) <-- filtered velocity 
     212                     pvv(ji,jj,jk,Kbb) = zvf 
     213                     puu(ji,jj,jk,Kmm) = puu(ji,jj,jk,Krhs)             ! puu(:,:,:,Kmm) <-- puu(:,:,:,Krhs) 
     214                     pvv(ji,jj,jk,Kmm) = pvv(ji,jj,jk,Krhs) 
    214215                  END DO 
    215216               END DO 
    … …  
    222223            ! ---------------------------------------------------- 
    223224            DO jk = 1, jpkm1 
    224                e3t_b(:,:,jk) = e3t_n(:,:,jk) + atfp * ( e3t_b(:,:,jk) - 2._wp * e3t_n(:,:,jk) + e3t_a(:,:,jk) ) 
     225               e3t(:,:,jk,Kbb) = e3t(:,:,jk,Kmm) + atfp * ( e3t(:,:,jk,Kbb) - 2._wp * e3t(:,:,jk,Kmm) + e3t(:,:,jk,Krhs) ) 
    225226            END DO 
    226227            ! Add volume filter correction: compatibility with tracer advection scheme 
    … …  
    228229            zcoef = atfp * rdt * r1_rau0 
    229230 
    230             e3t_b(:,:,1) = e3t_b(:,:,1) - zcoef * ( emp_b(:,:) - emp(:,:) ) * tmask(:,:,1) 
     231            e3t(:,:,1,Kbb) = e3t(:,:,1,Kbb) - zcoef * ( emp_b(:,:) - emp(:,:) ) * tmask(:,:,1) 
    231232 
    232233            IF ( ln_rnf ) THEN 
    … …  
    236237                        DO ji = 1, jpi 
    237238                           IF( jk <=  nk_rnf(ji,jj)  ) THEN 
    238                                e3t_b(ji,jj,jk) =   e3t_b(ji,jj,jk) - zcoef *  ( - rnf_b(ji,jj) + rnf(ji,jj) ) & 
    239                                       &          * ( e3t_n(ji,jj,jk) / h_rnf(ji,jj) ) * tmask(ji,jj,jk) 
     239                               e3t(ji,jj,jk,Kbb) =   e3t(ji,jj,jk,Kbb) - zcoef *  ( - rnf_b(ji,jj) + rnf(ji,jj) ) & 
     240                                      &          * ( e3t(ji,jj,jk,Kmm) / h_rnf(ji,jj) ) * tmask(ji,jj,jk) 
    240241                           ENDIF 
    241242                        ENDDO 
    … …  
    243244                  ENDDO 
    244245               ELSE 
    245                   e3t_b(:,:,1) = e3t_b(:,:,1) - zcoef *  ( -rnf_b(:,:) + rnf(:,:))*tmask(:,:,1) 
     246                  e3t(:,:,1,Kbb) = e3t(:,:,1,Kbb) - zcoef *  ( -rnf_b(:,:) + rnf(:,:))*tmask(:,:,1) 
    246247               ENDIF 
    247248            END IF 
    … …  
    252253                     DO ji = 1, jpi 
    253254                        IF( misfkt(ji,jj) <=jk .and. jk < misfkb(ji,jj)  ) THEN 
    254                            e3t_b(ji,jj,jk) = e3t_b(ji,jj,jk) - zcoef * ( fwfisf_b(ji,jj) - fwfisf(ji,jj) ) & 
    255                                 &          * ( e3t_n(ji,jj,jk) * r1_hisf_tbl(ji,jj) ) * tmask(ji,jj,jk) 
     255                           e3t(ji,jj,jk,Kbb) = e3t(ji,jj,jk,Kbb) - zcoef * ( fwfisf_b(ji,jj) - fwfisf(ji,jj) ) & 
     256                                &          * ( e3t(ji,jj,jk,Kmm) * r1_hisf_tbl(ji,jj) ) * tmask(ji,jj,jk) 
    256257                        ELSEIF ( jk==misfkb(ji,jj) ) THEN 
    257                            e3t_b(ji,jj,jk) = e3t_b(ji,jj,jk) - zcoef * ( fwfisf_b(ji,jj) - fwfisf(ji,jj) ) & 
    258                                 &          * ( e3t_n(ji,jj,jk) * r1_hisf_tbl(ji,jj) ) * ralpha(ji,jj) * tmask(ji,jj,jk) 
     258                           e3t(ji,jj,jk,Kbb) = e3t(ji,jj,jk,Kbb) - zcoef * ( fwfisf_b(ji,jj) - fwfisf(ji,jj) ) & 
     259                                &          * ( e3t(ji,jj,jk,Kmm) * r1_hisf_tbl(ji,jj) ) * ralpha(ji,jj) * tmask(ji,jj,jk) 
    259260                        ENDIF 
    260261                     END DO 
    … …  
    265266            IF( ln_dynadv_vec ) THEN      ! Asselin filter applied on velocity 
    266267               ! Before filtered scale factor at (u/v)-points 
    267                CALL dom_vvl_interpol( e3t_b(:,:,:), e3u_b(:,:,:), 'U' ) 
    268                CALL dom_vvl_interpol( e3t_b(:,:,:), e3v_b(:,:,:), 'V' ) 
     268               CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3u(:,:,:,Kbb), 'U' ) 
     269               CALL dom_vvl_interpol( e3t(:,:,:,Kbb), e3v(:,:,:,Kbb), 'V' ) 
    269270               DO jk = 1, jpkm1 
    270271                  DO jj = 1, jpj 
    271272                     DO ji = 1, jpi 
    272                         zuf = un(ji,jj,jk) + atfp * ( ub(ji,jj,jk) - 2._wp * un(ji,jj,jk) + ua(ji,jj,jk) ) 
    273                         zvf = vn(ji,jj,jk) + atfp * ( vb(ji,jj,jk) - 2._wp * vn(ji,jj,jk) + va(ji,jj,jk) ) 
     273                        zuf = puu(ji,jj,jk,Kmm) + atfp * ( puu(ji,jj,jk,Kbb) - 2._wp * puu(ji,jj,jk,Kmm) + puu(ji,jj,jk,Krhs) ) 
     274                        zvf = pvv(ji,jj,jk,Kmm) + atfp * ( pvv(ji,jj,jk,Kbb) - 2._wp * pvv(ji,jj,jk,Kmm) + pvv(ji,jj,jk,Krhs) ) 
    274275                        ! 
    275                         ub(ji,jj,jk) = zuf                      ! ub <-- filtered velocity 
    276                         vb(ji,jj,jk) = zvf 
    277                         un(ji,jj,jk) = ua(ji,jj,jk)             ! un <-- ua 
    278                         vn(ji,jj,jk) = va(ji,jj,jk) 
     276                        puu(ji,jj,jk,Kbb) = zuf                      ! puu(:,:,:,Kbb) <-- filtered velocity 
     277                        pvv(ji,jj,jk,Kbb) = zvf 
     278                        puu(ji,jj,jk,Kmm) = puu(ji,jj,jk,Krhs)             ! puu(:,:,:,Kmm) <-- puu(:,:,:,Krhs) 
     279                        pvv(ji,jj,jk,Kmm) = pvv(ji,jj,jk,Krhs) 
    279280                     END DO 
    280281                  END DO 
    … …  
    285286               ALLOCATE( ze3u_f(jpi,jpj,jpk) , ze3v_f(jpi,jpj,jpk) ) 
    286287               ! Before filtered scale factor at (u/v)-points stored in ze3u_f, ze3v_f 
    287                CALL dom_vvl_interpol( e3t_b(:,:,:), ze3u_f, 'U' ) 
    288                CALL dom_vvl_interpol( e3t_b(:,:,:), ze3v_f, 'V' ) 
     288               CALL dom_vvl_interpol( e3t(:,:,:,Kbb), ze3u_f, 'U' ) 
     289               CALL dom_vvl_interpol( e3t(:,:,:,Kbb), ze3v_f, 'V' ) 
    289290               DO jk = 1, jpkm1 
    290291                  DO jj = 1, jpj 
    291292                     DO ji = 1, jpi                   
    292                         zue3a = e3u_a(ji,jj,jk) * ua(ji,jj,jk) 
    293                         zve3a = e3v_a(ji,jj,jk) * va(ji,jj,jk) 
    294                         zue3n = e3u_n(ji,jj,jk) * un(ji,jj,jk) 
    295                         zve3n = e3v_n(ji,jj,jk) * vn(ji,jj,jk) 
    296                         zue3b = e3u_b(ji,jj,jk) * ub(ji,jj,jk) 
    297                         zve3b = e3v_b(ji,jj,jk) * vb(ji,jj,jk) 
     293                        zue3a = e3u(ji,jj,jk,Krhs) * puu(ji,jj,jk,Krhs) 
     294                        zve3a = e3v(ji,jj,jk,Krhs) * pvv(ji,jj,jk,Krhs) 
     295                        zue3n = e3u(ji,jj,jk,Kmm) * puu(ji,jj,jk,Kmm) 
     296                        zve3n = e3v(ji,jj,jk,Kmm) * pvv(ji,jj,jk,Kmm) 
     297                        zue3b = e3u(ji,jj,jk,Kbb) * puu(ji,jj,jk,Kbb) 
     298                        zve3b = e3v(ji,jj,jk,Kbb) * pvv(ji,jj,jk,Kbb) 
    298299                        ! 
    299300                        zuf = ( zue3n + atfp * ( zue3b - 2._wp * zue3n  + zue3a ) ) / ze3u_f(ji,jj,jk) 
    300301                        zvf = ( zve3n + atfp * ( zve3b - 2._wp * zve3n  + zve3a ) ) / ze3v_f(ji,jj,jk) 
    301302                        ! 
    302                         ub(ji,jj,jk) = zuf                     ! ub <-- filtered velocity 
    303                         vb(ji,jj,jk) = zvf 
    304                         un(ji,jj,jk) = ua(ji,jj,jk)            ! un <-- ua 
    305                         vn(ji,jj,jk) = va(ji,jj,jk) 
     303                        puu(ji,jj,jk,Kbb) = zuf                     ! puu(:,:,:,Kbb) <-- filtered velocity 
     304                        pvv(ji,jj,jk,Kbb) = zvf 
     305                        puu(ji,jj,jk,Kmm) = puu(ji,jj,jk,Krhs)            ! puu(:,:,:,Kmm) <-- puu(:,:,:,Krhs) 
     306                        pvv(ji,jj,jk,Kmm) = pvv(ji,jj,jk,Krhs) 
    306307                     END DO 
    307308                  END DO 
    308309               END DO 
    309                e3u_b(:,:,1:jpkm1) = ze3u_f(:,:,1:jpkm1)        ! e3u_b <-- filtered scale factor 
    310                e3v_b(:,:,1:jpkm1) = ze3v_f(:,:,1:jpkm1) 
     310               e3u(:,:,1:jpkm1,Kbb) = ze3u_f(:,:,1:jpkm1)        ! e3u(:,:,:,Kbb) <-- filtered scale factor 
     311               e3v(:,:,1:jpkm1,Kbb) = ze3v_f(:,:,1:jpkm1) 
    311312               ! 
    312313               DEALLOCATE( ze3u_f , ze3v_f ) 
    … …  
    318319            ! Revert "before" velocities to time split estimate 
    319320            ! Doing it here also means that asselin filter contribution is removed   
    320             zue(:,:) = e3u_b(:,:,1) * ub(:,:,1) * umask(:,:,1) 
    321             zve(:,:) = e3v_b(:,:,1) * vb(:,:,1) * vmask(:,:,1)     
     321            zue(:,:) = e3u(:,:,1,Kbb) * puu(:,:,1,Kbb) * umask(:,:,1) 
     322            zve(:,:) = e3v(:,:,1,Kbb) * pvv(:,:,1,Kbb) * vmask(:,:,1)     
    322323            DO jk = 2, jpkm1 
    323                zue(:,:) = zue(:,:) + e3u_b(:,:,jk) * ub(:,:,jk) * umask(:,:,jk) 
    324                zve(:,:) = zve(:,:) + e3v_b(:,:,jk) * vb(:,:,jk) * vmask(:,:,jk)     
     324               zue(:,:) = zue(:,:) + e3u(:,:,jk,Kbb) * puu(:,:,jk,Kbb) * umask(:,:,jk) 
     325               zve(:,:) = zve(:,:) + e3v(:,:,jk,Kbb) * pvv(:,:,jk,Kbb) * vmask(:,:,jk)     
    325326            END DO 
    326327            DO jk = 1, jpkm1 
    327                ub(:,:,jk) = ub(:,:,jk) - (zue(:,:) * r1_hu_n(:,:) - un_b(:,:)) * umask(:,:,jk) 
    328                vb(:,:,jk) = vb(:,:,jk) - (zve(:,:) * r1_hv_n(:,:) - vn_b(:,:)) * vmask(:,:,jk) 
     328               puu(:,:,jk,Kbb) = puu(:,:,jk,Kbb) - (zue(:,:) * r1_hu_n(:,:) - uu_b(:,:,Kmm)) * umask(:,:,jk) 
     329               pvv(:,:,jk,Kbb) = pvv(:,:,jk,Kbb) - (zve(:,:) * r1_hv_n(:,:) - vv_b(:,:,Kmm)) * vmask(:,:,jk) 
    329330            END DO 
    330331         ENDIF 
    … …  
    338339      ! 
    339340      IF(.NOT.ln_linssh ) THEN 
    340          hu_b(:,:) = e3u_b(:,:,1) * umask(:,:,1) 
    341          hv_b(:,:) = e3v_b(:,:,1) * vmask(:,:,1) 
     341         hu_b(:,:) = e3u(:,:,1,Kbb) * umask(:,:,1) 
     342         hv_b(:,:) = e3v(:,:,1,Kbb) * vmask(:,:,1) 
    342343         DO jk = 2, jpkm1 
    343             hu_b(:,:) = hu_b(:,:) + e3u_b(:,:,jk) * umask(:,:,jk) 
    344             hv_b(:,:) = hv_b(:,:) + e3v_b(:,:,jk) * vmask(:,:,jk) 
     344            hu_b(:,:) = hu_b(:,:) + e3u(:,:,jk,Kbb) * umask(:,:,jk) 
     345            hv_b(:,:) = hv_b(:,:) + e3v(:,:,jk,Kbb) * vmask(:,:,jk) 
    345346         END DO 
    346347         r1_hu_b(:,:) = ssumask(:,:) / ( hu_b(:,:) + 1._wp - ssumask(:,:) ) 
    … …  
    348349      ENDIF 
    349350      ! 
    350       un_b(:,:) = e3u_a(:,:,1) * un(:,:,1) * umask(:,:,1) 
    351       ub_b(:,:) = e3u_b(:,:,1) * ub(:,:,1) * umask(:,:,1) 
    352       vn_b(:,:) = e3v_a(:,:,1) * vn(:,:,1) * vmask(:,:,1) 
    353       vb_b(:,:) = e3v_b(:,:,1) * vb(:,:,1) * vmask(:,:,1) 
     351      uu_b(:,:,Kmm) = e3u(:,:,1,Krhs) * puu(:,:,1,Kmm) * umask(:,:,1) 
     352      uu_b(:,:,Kbb) = e3u(:,:,1,Kbb) * puu(:,:,1,Kbb) * umask(:,:,1) 
     353      vv_b(:,:,Kmm) = e3v(:,:,1,Krhs) * pvv(:,:,1,Kmm) * vmask(:,:,1) 
     354      vv_b(:,:,Kbb) = e3v(:,:,1,Kbb) * pvv(:,:,1,Kbb) * vmask(:,:,1) 
    354355      DO jk = 2, jpkm1 
    355          un_b(:,:) = un_b(:,:) + e3u_a(:,:,jk) * un(:,:,jk) * umask(:,:,jk) 
    356          ub_b(:,:) = ub_b(:,:) + e3u_b(:,:,jk) * ub(:,:,jk) * umask(:,:,jk) 
    357          vn_b(:,:) = vn_b(:,:) + e3v_a(:,:,jk) * vn(:,:,jk) * vmask(:,:,jk) 
    358          vb_b(:,:) = vb_b(:,:) + e3v_b(:,:,jk) * vb(:,:,jk) * vmask(:,:,jk) 
     356         uu_b(:,:,Kmm) = uu_b(:,:,Kmm) + e3u(:,:,jk,Krhs) * puu(:,:,jk,Kmm) * umask(:,:,jk) 
     357         uu_b(:,:,Kbb) = uu_b(:,:,Kbb) + e3u(:,:,jk,Kbb) * puu(:,:,jk,Kbb) * umask(:,:,jk) 
     358         vv_b(:,:,Kmm) = vv_b(:,:,Kmm) + e3v(:,:,jk,Krhs) * pvv(:,:,jk,Kmm) * vmask(:,:,jk) 
     359         vv_b(:,:,Kbb) = vv_b(:,:,Kbb) + e3v(:,:,jk,Kbb) * pvv(:,:,jk,Kbb) * vmask(:,:,jk) 
    359360      END DO 
    360       un_b(:,:) = un_b(:,:) * r1_hu_a(:,:) 
    361       vn_b(:,:) = vn_b(:,:) * r1_hv_a(:,:) 
    362       ub_b(:,:) = ub_b(:,:) * r1_hu_b(:,:) 
    363       vb_b(:,:) = vb_b(:,:) * r1_hv_b(:,:) 
     361      uu_b(:,:,Kmm) = uu_b(:,:,Kmm) * r1_hu_a(:,:) 
     362      vv_b(:,:,Kmm) = vv_b(:,:,Kmm) * r1_hv_a(:,:) 
     363      uu_b(:,:,Kbb) = uu_b(:,:,Kbb) * r1_hu_b(:,:) 
     364      vv_b(:,:,Kbb) = vv_b(:,:,Kbb) * r1_hv_b(:,:) 
    364365      ! 
    365366      IF( .NOT.ln_dynspg_ts ) THEN        ! output the barotropic currents 
    366          CALL iom_put(  "ubar", un_b(:,:) ) 
    367          CALL iom_put(  "vbar", vn_b(:,:) ) 
     367         CALL iom_put(  "ubar", uu_b(:,:,Kmm) ) 
     368         CALL iom_put(  "vbar", vv_b(:,:,Kmm) ) 
    368369      ENDIF 
    369370      IF( l_trddyn ) THEN                ! 3D output: asselin filter trends on momentum 
    370          zua(:,:,:) = ( ub(:,:,:) - zua(:,:,:) ) * z1_2dt 
    371          zva(:,:,:) = ( vb(:,:,:) - zva(:,:,:) ) * z1_2dt 
     371         zua(:,:,:) = ( puu(:,:,:,Kbb) - zua(:,:,:) ) * z1_2dt 
     372         zva(:,:,:) = ( pvv(:,:,:,Kbb) - zva(:,:,:) ) * z1_2dt 
    372373         CALL trd_dyn( zua, zva, jpdyn_atf, kt, Kmm ) 
    373374      ENDIF 
    374375      ! 
    375       IF(ln_ctl)   CALL prt_ctl( tab3d_1=un, clinfo1=' nxt  - Un: ', mask1=umask,   & 
    376          &                       tab3d_2=vn, clinfo2=' Vn: '       , mask2=vmask ) 
     376      IF(ln_ctl)   CALL prt_ctl( tab3d_1=puu(:,:,:,Kmm), clinfo1=' nxt  - Un: ', mask1=umask,   & 
     377         &                       tab3d_2=pvv(:,:,:,Kmm), clinfo2=' Vn: '       , mask2=vmask ) 
    377378      !  
    378379      IF( ln_dynspg_ts )   DEALLOCATE( zue, zve ) 

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

    r10919 r11027  
    13071307      ! 
    13081308      IF( ln_diatmb ) THEN 
    1309          CALL iom_put( "baro_u" , un_b*ssumask(:,:)+zmdi*(1.-ssumask(:,:) ) )  ! Barotropic  U Velocity 
    1310          CALL iom_put( "baro_v" , vn_b*ssvmask(:,:)+zmdi*(1.-ssvmask(:,:) ) )  ! Barotropic  V Velocity 
     1309         CALL iom_put( "baro_u" , uu_b(:,:,Kmm)*ssumask(:,:)+zmdi*(1.-ssumask(:,:) ) )  ! Barotropic  U Velocity 
     1310         CALL iom_put( "baro_v" , vv_b(:,:,Kmm)*ssvmask(:,:)+zmdi*(1.-ssvmask(:,:) ) )  ! Barotropic  V Velocity 
    13111311      ENDIF 
    13121312      ! 

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    r10919 r11027  
    6666   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:)   ::   fraqsr_1lev        !: fraction of solar net radiation absorbed in the first ocean level [-] 
    6767 
    68    !! TEMPORARY POINTERS FOR DEVELOPMENT ONLY 
    69    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:)   ::   ub   ,  un    , ua       !: i-horizontal velocity        [m/s] 
    70    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:)   ::   vb   ,  vn    , va       !: j-horizontal velocity        [m/s] 
    71    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:)   ::           wn               !: k-vertical   velocity        [m/s] 
    72    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:)   ::           hdivn            !: horizontal divergence        [s-1] 
    73    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:,:) ::   tsb  ,  tsn   , tsa      !: 4D T-S fields                [Celsius,psu]          
    74    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:)     ::   ub_b   ,  un_b  ,  ua_b  !: Barotropic velocities at u-point [m/s] 
    75    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:)     ::   vb_b   ,  vn_b  ,  va_b  !: Barotropic velocities at v-point [m/s] 
    76    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:)     ::   sshb   ,  sshn  ,  ssha  !: sea surface height at t-point [m] 
    77    !! TEMPORARY POINTERS FOR DEVELOPMENT ONLY 
    78  
    7968   !!---------------------------------------------------------------------- 
    8069   !! NEMO/OCE 4.0 , NEMO Consortium (2018) 

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

    r11001 r11027  
    4444 
    4545   PUBLIC   stp   ! called by nemogcm.F90 
    46    PUBLIC   update_pointers ! called by nemo_init 
    4746 
    4847   !!---------------------------------------------------------------------- 
    … …  
    253252#endif 
    254253                         CALL tra_adv    ( kstp, Nbb, Nnn, ts, Nrhs )  ! hor. + vert. advection ==> RHS 
    255       IF( ln_zdfosm  )   CALL tra_osm    ( kstp, Nnn     , ts, Nrhs )  ! OSMOSIS non-local tracer fluxes ==> RHS 
     254      IF( ln_zdfosm  )   CALL tra_osm    ( kstp,      Nnn, ts, Nrhs )  ! OSMOSIS non-local tracer fluxes ==> RHS 
    256255      IF( lrst_oce .AND. ln_zdfosm ) & 
    257            &             CALL osm_rst    ( kstp, Nnn, 'WRITE' )        ! write OSMOSIS outputs + ww (so must do here) to restarts 
     256           &             CALL osm_rst    ( kstp,      Nnn, 'WRITE'  )  ! write OSMOSIS outputs + ww (so must do here) to restarts 
    258257                         CALL tra_ldf    ( kstp, Nbb, Nnn, ts, Nrhs )  ! lateral mixing 
    259258 
    260259!!gm : why CALL to dia_ptr has been moved here??? (use trends info?) 
    261       IF( ln_diaptr  )   CALL dia_ptr( Nnn )                 ! Poleward adv/ldf TRansports diagnostics 
     260      IF( ln_diaptr  )   CALL dia_ptr( Nnn )                           ! Poleward adv/ldf TRansports diagnostics 
    262261!!gm 
    263262                         CALL tra_zdf    ( kstp, Nbb, Nnn, Nrhs, ts, Naa  )  ! vert. mixing & after tracer  ==> after 
    … …  
    282281!!jc2: dynnxt must be the latest call. e3t(:,:,:,Nbb) are indeed updated in that routine 
    283282                         CALL tra_nxt       ( kstp, Nbb, Nnn, Nrhs, Naa )  ! finalize (bcs) tracer fields at next time step and swap 
    284                          CALL dyn_nxt       ( kstp, Nbb, Nnn, Naa  )  ! finalize (bcs) velocities at next time step and swap (always called after tra_nxt) 
     283                         CALL dyn_nxt       ( kstp, Nbb, Nnn, Nrhs, uu, vv, Naa  )  ! finalize (bcs) velocities at next time step and swap (always called after tra_nxt) 
    285284                         CALL ssh_swp       ( kstp, Nbb, Nnn, Naa )  ! swap of sea surface height 
    286285      IF(.NOT.ln_linssh) CALL dom_vvl_sf_swp( kstp, Nbb, Nnn, Naa )  ! swap of vertical scale factors 
    … …  
    300299      ! AGRIF 
    301300      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<       
    302                          CALL Agrif_Integrate_ChildGrids( stp )  ! allows to finish all the Child Grids before updating 
    303  
    304                          IF( Agrif_NbStepint() == 0 ) CALL Agrif_update_all( ) ! Update all components 
     301                         CALL Agrif_Integrate_ChildGrids( stp )       ! allows to finish all the Child Grids before updating 
     302 
     303                         IF( Agrif_NbStepint() == 0 ) THEN 
     304                            Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs   ! agrif_oce module copies of time level indices 
     305                            CALL Agrif_update_all( )                  ! Update all components 
     306                         ENDIF 
    305307#endif 
    306308      IF( ln_diaobs  )   CALL dia_obs      ( kstp, Nnn )      ! obs-minus-model (assimilation) diagnostics (call after dynamics update) 
    … …  
    321323      !<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<<< 
    322324!!gm why lk_oasis and not lk_cpl ???? 
    323       IF( lk_oasis   )   CALL sbc_cpl_snd( kstp, Nnn )     ! coupled mode : field exchanges 
     325      IF( lk_oasis   )   CALL sbc_cpl_snd( kstp, Nbb, Nnn )        ! coupled mode : field exchanges 
    324326      ! 
    325327#if defined key_iomput 
    … …  
    335337   END SUBROUTINE stp 
    336338    
    337    SUBROUTINE update_pointers( Kbb, Kmm, Kaa ) 
    338       !!---------------------------------------------------------------------- 
    339       !!                     ***  ROUTINE update_pointers  *** 
    340       !! 
    341       !! ** Purpose :   Associate temporary pointer arrays. 
    342       !!                For IMMERSE development phase only - to be deleted 
    343       !! 
    344       !! ** Method  : 
    345       !!---------------------------------------------------------------------- 
    346       INTEGER, INTENT( in ) :: Kbb, Kmm, Kaa ! time level indices 
    347  
    348       ub => uu(:,:,:,Kbb); un => uu(:,:,:,Kmm); ua => uu(:,:,:,Kaa) 
    349       vb => vv(:,:,:,Kbb); vn => vv(:,:,:,Kmm); va => vv(:,:,:,Kaa) 
    350       wn => ww(:,:,:) 
    351       hdivn => hdiv(:,:,:) 
    352  
    353       sshb =>  ssh(:,:,Kbb); sshn =>  ssh(:,:,Kmm); ssha =>  ssh(:,:,Kaa) 
    354       ub_b => uu_b(:,:,Kbb); un_b => uu_b(:,:,Kmm); ua_b => uu_b(:,:,Kaa) 
    355       vb_b => vv_b(:,:,Kbb); vn_b => vv_b(:,:,Kmm); va_b => vv_b(:,:,Kaa) 
    356  
    357       tsb => ts(:,:,:,:,Kbb); tsn => ts(:,:,:,:,Kmm); tsa => ts(:,:,:,:,Kaa) 
    358  
    359       e3t_b => e3t(:,:,:,Kbb); e3t_n => e3t(:,:,:,Kmm); e3t_a => e3t(:,:,:,Kaa) 
    360       e3u_b => e3u(:,:,:,Kbb); e3u_n => e3u(:,:,:,Kmm); e3u_a => e3u(:,:,:,Kaa) 
    361       e3v_b => e3v(:,:,:,Kbb); e3v_n => e3v(:,:,:,Kmm); e3v_a => e3v(:,:,:,Kaa) 
    362  
    363       e3f_n => e3f(:,:,:) 
    364  
    365       e3w_b  => e3w (:,:,:,Kbb); e3w_n  => e3w (:,:,:,Kmm) 
    366       e3uw_b => e3uw(:,:,:,Kbb); e3uw_n => e3uw(:,:,:,Kmm) 
    367       e3vw_b => e3vw(:,:,:,Kbb); e3vw_n => e3vw(:,:,:,Kmm) 
    368  
    369       gdept_b => gdept(:,:,:,Kbb); gdept_n => gdept(:,:,:,Kmm)  
    370       gdepw_b => gdepw(:,:,:,Kbb); gdepw_n => gdepw(:,:,:,Kmm)  
    371       gde3w_n => gde3w(:,:,:) 
    372  
    373    END SUBROUTINE update_pointers 
    374  
    375339   !!====================================================================== 
    376340END MODULE step 

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

    r10880 r11027  
    4040   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:,:  ) ::  trc_o          !: prescribed tracer concentration in ocean for SBC 
    4141   INTEGER             , PUBLIC                            ::  nn_ice_tr      !: handling of sea ice tracers 
    42  
    43    !! TEMPORARY POINTERS - TO BE DELETED AFTER IMMERSE DEVELOPMENT COMPLETE 
    44    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:,:)   ::  trn            !: tracer concentration for now time step 
    45    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:,:)   ::  tra            !: tracer concentration for next time step 
    46    REAL(wp), PUBLIC, POINTER, SAVE, DIMENSION(:,:,:,:)   ::  trb            !: tracer concentration for before time step 
    47    !! TEMPORARY POINTERS - TO BE DELETED AFTER IMMERSE DEVELOPMENT COMPLETE 
    4842 
    4943   !! interpolated gradient 

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

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

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

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