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

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 10989 for NEMO/branches/2019/dev_r10721_KERNEL-02_Storkey_Coward_IMMERSE_first_steps/src/NST/agrif_oce_interp.F90 – NEMO

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

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

File:
1 edited

Legend:

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

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