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 13463 for NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/NST/agrif_oce_interp.F90 – NEMO

Ignore:
Timestamp:
2020-09-14T17:40:34+02:00 (4 years ago)
Author:
andmirek
Message:

Ticket #2195:update to trunk 13461

Location:
NEMO/branches/2019/dev_r11351_fldread_with_XIOS
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS

    • Property svn:externals

      •  

        old new  
        33^/utils/build/mk@HEAD         mk 
        44^/utils/tools@HEAD            tools 
        5 ^/vendors/AGRIF/dev@HEAD      ext/AGRIF 
         5^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 
         8 
         9# SETTE 
         10^/utils/CI/sette@13382        sette 

  • NEMO/branches/2019/dev_r11351_fldread_with_XIOS/src/NST/agrif_oce_interp.F90

    r10068 r13463  
    3333   USE agrif_oce_sponge 
    3434   USE lib_mpp 
     35   USE vremap 
     36   USE lbclnk 
    3537  
    3638   IMPLICIT NONE 
    3739   PRIVATE 
    3840 
    39    PUBLIC   Agrif_dyn, Agrif_ssh, Agrif_dyn_ts, Agrif_ssh_ts, Agrif_dta_ts 
     41   PUBLIC   Agrif_dyn, Agrif_ssh, Agrif_dyn_ts, Agrif_dyn_ts_flux, Agrif_ssh_ts, Agrif_dta_ts 
    4042   PUBLIC   Agrif_tra, Agrif_avm 
    4143   PUBLIC   interpun , interpvn 
    4244   PUBLIC   interptsn, interpsshn, interpavm 
    4345   PUBLIC   interpunb, interpvnb , interpub2b, interpvb2b 
    44    PUBLIC   interpe3t, interpumsk, interpvmsk 
     46   PUBLIC   interpe3t, interpglamt, interpgphit 
     47   PUBLIC   interpht0, interpmbkt 
     48   PUBLIC   agrif_initts, agrif_initssh 
    4549 
    4650   INTEGER ::   bdy_tinterp = 0 
    4751 
    48 #  include "vectopt_loop_substitute.h90" 
    4952   !!---------------------------------------------------------------------- 
    5053   !! NEMO/NST 4.0 , NEMO Consortium (2018) 
    … …  
    7881      ! 
    7982      INTEGER ::   ji, jj, jk       ! dummy loop indices 
    80       INTEGER ::   j1, j2, i1, i2 
    8183      INTEGER ::   ibdy1, jbdy1, ibdy2, jbdy2 
    8284      REAL(wp), DIMENSION(jpi,jpj) ::   zub, zvb 
    … …  
    8587      IF( Agrif_Root() )   RETURN 
    8688      ! 
    87       Agrif_SpecialValue    = 0._wp 
     89      Agrif_SpecialValue    = 0.0_wp 
    8890      Agrif_UseSpecialValue = ln_spc_dyn 
    8991      ! 
     92      use_sign_north = .TRUE. 
     93      sign_north = -1.0_wp 
    9094      CALL Agrif_Bc_variable( un_interp_id, procname=interpun ) 
    9195      CALL Agrif_Bc_variable( vn_interp_id, procname=interpvn ) 
     96      use_sign_north = .FALSE. 
    9297      ! 
    9398      Agrif_UseSpecialValue = .FALSE. 
    9499      ! 
    95       ! prevent smoothing in ghost cells 
    96       i1 =  1   ;   i2 = nlci 
    97       j1 =  1   ;   j2 = nlcj 
    98       IF( nbondj == -1 .OR. nbondj == 2 )   j1 = 2 + nbghostcells 
    99       IF( nbondj == +1 .OR. nbondj == 2 )   j2 = nlcj - nbghostcells - 1 
    100       IF( nbondi == -1 .OR. nbondi == 2 )   i1 = 2 + nbghostcells  
    101       IF( nbondi == +1 .OR. nbondi == 2 )   i2 = nlci - nbghostcells - 1 
    102  
    103100      ! --- West --- ! 
    104       IF( nbondi == -1 .OR. nbondi == 2 ) THEN 
    105          ibdy1 = 2 
    106          ibdy2 = 1+nbghostcells  
     101      IF( lk_west ) THEN 
     102         ibdy1 = nn_hls + 2                  ! halo + land + 1 
     103         ibdy2 = nn_hls + 1 + nbghostcells   ! halo + land + nbghostcells 
    107104         ! 
    108105         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
    109             ua_b(ibdy1:ibdy2,:) = 0._wp 
     106            DO ji = mi0(ibdy1), mi1(ibdy2) 
     107               uu_b(ji,:,Krhs_a) = 0._wp 
     108               DO jk = 1, jpkm1 
     109                  DO jj = 1, jpj 
     110                     uu_b(ji,jj,Krhs_a) = uu_b(ji,jj,Krhs_a) + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 
     111                  END DO 
     112               END DO 
     113               DO jj = 1, jpj 
     114                  uu_b(ji,jj,Krhs_a) = uu_b(ji,jj,Krhs_a) * r1_hu(ji,jj,Krhs_a) 
     115               END DO 
     116            END DO 
     117         ENDIF 
     118         ! 
     119         DO ji = mi0(ibdy1), mi1(ibdy2) 
     120            zub(ji,:) = 0._wp    ! Correct transport 
    110121            DO jk = 1, jpkm1 
    111122               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) 
    114                END DO 
    115             END DO 
    116             DO jj = 1, jpj 
    117                ua_b(ibdy1:ibdy2,jj) = ua_b(ibdy1:ibdy2,jj) * r1_hu_a(ibdy1:ibdy2,jj) 
    118             END DO 
    119          ENDIF 
    120          ! 
    121          IF( .NOT.lk_agrif_clp ) THEN 
    122             DO jk=1,jpkm1              ! Smooth 
    123                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)) 
    125                END DO 
    126             END DO 
    127          ENDIF 
    128          ! 
    129          zub(ibdy1:ibdy2,:) = 0._wp    ! Correct transport 
    130          DO jk = 1, jpkm1 
    131             DO jj = 1, jpj 
    132                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) 
    134             END DO 
    135          END DO 
    136          DO jj=1,jpj 
    137             zub(ibdy1:ibdy2,jj) = zub(ibdy1:ibdy2,jj) * r1_hu_a(ibdy1:ibdy2,jj) 
    138          END DO 
    139              
    140          DO jk = 1, jpkm1 
    141             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) 
    144             END DO 
    145          END DO 
    146              
    147          IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate 
    148             zvb(ibdy1:ibdy2,:) = 0._wp 
     123                  zub(ji,jj) = zub(ji,jj) + e3u(ji,jj,jk,Krhs_a)  * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 
     124               END DO 
     125            END DO 
     126            DO jj=1,jpj 
     127               zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a) 
     128            END DO  
    149129            DO jk = 1, jpkm1 
    150130               DO jj = 1, jpj 
    151                   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) 
    153                END DO 
    154             END DO 
    155             DO jj = 1, jpj 
    156                zvb(ibdy1:ibdy2,jj) = zvb(ibdy1:ibdy2,jj) * r1_hv_a(ibdy1:ibdy2,jj) 
    157             END DO 
     131                  uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk) 
     132               END DO 
     133            END DO 
     134         END DO 
     135         !    
     136         IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate 
     137            DO ji = mi0(ibdy1), mi1(ibdy2) 
     138               zvb(ji,:) = 0._wp 
     139               DO jk = 1, jpkm1 
     140                  DO jj = 1, jpj 
     141                     zvb(ji,jj) = zvb(ji,jj) + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 
     142                  END DO 
     143               END DO 
     144               DO jj = 1, jpj 
     145                  zvb(ji,jj) = zvb(ji,jj) * r1_hv(ji,jj,Krhs_a) 
     146               END DO 
     147               DO jk = 1, jpkm1 
     148                  DO jj = 1, jpj 
     149                     vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) )*vmask(ji,jj,jk) 
     150                  END DO 
     151               END DO 
     152            END DO 
     153         ENDIF 
     154         ! 
     155      ENDIF 
     156 
     157      ! --- East --- ! 
     158      IF( lk_east) THEN 
     159         ibdy1 = jpiglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
     160         ibdy2 = jpiglo - ( nn_hls + 2 )                 ! halo + land + 1 
     161         ! 
     162         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
     163            DO ji = mi0(ibdy1), mi1(ibdy2) 
     164               uu_b(ji,:,Krhs_a) = 0._wp 
     165               DO jk = 1, jpkm1 
     166                  DO jj = 1, jpj 
     167                     uu_b(ji,jj,Krhs_a) = uu_b(ji,jj,Krhs_a) + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 
     168                  END DO 
     169               END DO 
     170               DO jj = 1, jpj 
     171                  uu_b(ji,jj,Krhs_a) = uu_b(ji,jj,Krhs_a) * r1_hu(ji,jj,Krhs_a) 
     172               END DO 
     173            END DO 
     174         ENDIF 
     175         ! 
     176         DO ji = mi0(ibdy1), mi1(ibdy2) 
     177            zub(ji,:) = 0._wp    ! Correct transport 
    158178            DO jk = 1, jpkm1 
    159179               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) 
    162                END DO 
    163             END DO 
    164          ENDIF 
    165          ! 
    166          DO jk = 1, jpkm1              ! Mask domain edges 
    167             DO jj = 1, jpj 
    168                ua(1,jj,jk) = 0._wp 
    169                va(1,jj,jk) = 0._wp 
    170             END DO 
    171          END DO  
    172       ENDIF 
    173  
    174       ! --- East --- ! 
    175       IF( nbondi ==  1 .OR. nbondi == 2 ) THEN 
    176          ibdy1 = nlci-1-nbghostcells 
    177          ibdy2 = nlci-2  
    178          ! 
    179          IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
    180             ua_b(ibdy1:ibdy2,:) = 0._wp 
     180                  zub(ji,jj) = zub(ji,jj) + e3u(ji,jj,jk,Krhs_a)  * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 
     181               END DO 
     182            END DO 
     183            DO jj=1,jpj 
     184               zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a) 
     185            END DO 
    181186            DO jk = 1, jpkm1 
    182187               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) 
    185                END DO 
    186             END DO 
    187             DO jj = 1, jpj 
    188                ua_b(ibdy1:ibdy2,jj) = ua_b(ibdy1:ibdy2,jj) * r1_hu_a(ibdy1:ibdy2,jj) 
     188                  uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk) 
     189               END DO 
     190            END DO 
     191         END DO 
     192         ! 
     193         IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate 
     194            ibdy1 = jpiglo - ( nn_hls + nbghostcells )   ! halo + land + nbghostcells - 1 
     195            ibdy2 = jpiglo - ( nn_hls + 1 )              ! halo + land + 1            - 1 
     196            DO ji = mi0(ibdy1), mi1(ibdy2) 
     197               zvb(ji,:) = 0._wp 
     198               DO jk = 1, jpkm1 
     199                  DO jj = 1, jpj 
     200                     zvb(ji,jj) = zvb(ji,jj) + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 
     201                  END DO 
     202               END DO 
     203               DO jj = 1, jpj 
     204                  zvb(ji,jj) = zvb(ji,jj) * r1_hv(ji,jj,Krhs_a) 
     205               END DO 
     206               DO jk = 1, jpkm1 
     207                  DO jj = 1, jpj 
     208                     vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) ) * vmask(ji,jj,jk) 
     209                  END DO 
     210               END DO 
    189211            END DO 
    190212         ENDIF 
    191213         ! 
    192          IF( .NOT.lk_agrif_clp ) THEN 
    193             DO jk=1,jpkm1              ! Smooth 
    194                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)) 
     214      ENDIF 
     215 
     216      ! --- South --- ! 
     217      IF( lk_south ) THEN 
     218         jbdy1 = nn_hls + 2                  ! halo + land + 1 
     219         jbdy2 = nn_hls + 1 + nbghostcells   ! halo + land + nbghostcells 
     220         ! 
     221         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
     222            DO jj = mj0(jbdy1), mj1(jbdy2) 
     223               vv_b(:,jj,Krhs_a) = 0._wp 
     224               DO jk = 1, jpkm1 
     225                  DO ji = 1, jpi 
     226                     vv_b(ji,jj,Krhs_a) = vv_b(ji,jj,Krhs_a) + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 
     227                  END DO 
     228               END DO 
     229               DO ji=1,jpi 
     230                  vv_b(ji,jj,Krhs_a) = vv_b(ji,jj,Krhs_a) * r1_hv(ji,jj,Krhs_a)      
    196231               END DO 
    197232            END DO 
    198233         ENDIF 
    199234         ! 
    200          zub(ibdy1:ibdy2,:) = 0._wp    ! Correct transport 
    201          DO jk = 1, jpkm1 
    202             DO jj = 1, jpj 
    203                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) 
    205             END DO 
    206          END DO 
    207          DO jj=1,jpj 
    208             zub(ibdy1:ibdy2,jj) = zub(ibdy1:ibdy2,jj) * r1_hu_a(ibdy1:ibdy2,jj) 
    209          END DO 
    210              
    211          DO jk = 1, jpkm1 
    212             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) 
    215             END DO 
    216          END DO 
    217              
    218          IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate 
    219             ibdy1 = ibdy1 + 1 
    220             ibdy2 = ibdy2 + 1  
    221             zvb(ibdy1:ibdy2,:) = 0._wp 
    222             DO jk = 1, jpkm1 
    223                DO jj = 1, jpj 
    224                   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) 
    226                END DO 
    227             END DO 
    228             DO jj = 1, jpj 
    229                zvb(ibdy1:ibdy2,jj) = zvb(ibdy1:ibdy2,jj) * r1_hv_a(ibdy1:ibdy2,jj) 
    230             END DO 
    231             DO jk = 1, jpkm1 
    232                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) 
    235                END DO 
    236             END DO 
    237          ENDIF 
    238          ! 
    239          DO jk = 1, jpkm1              ! Mask domain edges 
    240             DO jj = 1, jpj 
    241                ua(nlci-1,jj,jk) = 0._wp 
    242                va(nlci  ,jj,jk) = 0._wp 
    243             END DO 
    244          END DO  
    245       ENDIF 
    246  
    247       ! --- South --- ! 
    248       IF( nbondj == -1 .OR. nbondj == 2 ) THEN 
    249          jbdy1 = 2 
    250          jbdy2 = 1+nbghostcells  
    251          ! 
    252          IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
    253             va_b(:,jbdy1:jbdy2) = 0._wp 
     235         DO jj = mj0(jbdy1), mj1(jbdy2) 
     236            zvb(:,jj) = 0._wp    ! Correct transport 
     237            DO jk=1,jpkm1 
     238               DO ji=1,jpi 
     239                  zvb(ji,jj) = zvb(ji,jj) + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 
     240               END DO 
     241            END DO 
     242            DO ji = 1, jpi 
     243               zvb(ji,jj) = zvb(ji,jj) * r1_hv(ji,jj,Krhs_a) 
     244            END DO 
    254245            DO jk = 1, jpkm1 
    255246               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) 
    258                END DO 
    259             END DO 
    260             DO ji=1,jpi 
    261                va_b(ji,jbdy1:jbdy2) = va_b(ji,jbdy1:jbdy2) * r1_hv_a(ji,jbdy1:jbdy2) 
     247                  vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) ) * vmask(ji,jj,jk) 
     248               END DO 
     249            END DO 
     250         END DO 
     251         ! 
     252         IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate 
     253            DO jj = mj0(jbdy1), mj1(jbdy2) 
     254               zub(:,jj) = 0._wp 
     255               DO jk = 1, jpkm1 
     256                  DO ji = 1, jpi 
     257                     zub(ji,jj) = zub(ji,jj) + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 
     258                  END DO 
     259               END DO 
     260               DO ji = 1, jpi 
     261                  zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a) 
     262               END DO 
     263               DO jk = 1, jpkm1 
     264                  DO ji = 1, jpi 
     265                     uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk) 
     266                  END DO 
     267               END DO 
    262268            END DO 
    263269         ENDIF 
    264270         ! 
    265          IF ( .NOT.lk_agrif_clp ) THEN 
    266             DO jk = 1, jpkm1           ! Smooth 
    267                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)) 
     271      ENDIF 
     272 
     273      ! --- North --- ! 
     274      IF( lk_north ) THEN 
     275         jbdy1 = jpjglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
     276         jbdy2 = jpjglo - ( nn_hls + 2 )                 ! halo + land + 1 
     277         ! 
     278         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
     279            DO jj = mj0(jbdy1), mj1(jbdy2) 
     280               vv_b(:,jj,Krhs_a) = 0._wp 
     281               DO jk = 1, jpkm1 
     282                  DO ji = 1, jpi 
     283                     vv_b(ji,jj,Krhs_a) = vv_b(ji,jj,Krhs_a) + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 
     284                  END DO 
     285               END DO 
     286               DO ji=1,jpi 
     287                  vv_b(ji,jj,Krhs_a) = vv_b(ji,jj,Krhs_a) * r1_hv(ji,jj,Krhs_a) 
    269288               END DO 
    270289            END DO 
    271290         ENDIF 
    272291         ! 
    273          zvb(:,jbdy1:jbdy2) = 0._wp    ! Correct transport 
    274          DO jk=1,jpkm1 
    275             DO ji=1,jpi 
    276                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) 
    278             END DO 
    279          END DO 
    280          DO ji = 1, jpi 
    281             zvb(ji,jbdy1:jbdy2) = zvb(ji,jbdy1:jbdy2) * r1_hv_a(ji,jbdy1:jbdy2) 
    282          END DO 
    283  
    284          DO jk = 1, jpkm1 
     292         DO jj = mj0(jbdy1), mj1(jbdy2) 
     293            zvb(:,jj) = 0._wp    ! Correct transport 
     294            DO jk=1,jpkm1 
     295               DO ji=1,jpi 
     296                  zvb(ji,jj) = zvb(ji,jj) + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 
     297               END DO 
     298            END DO 
    285299            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) 
    288             END DO 
    289          END DO 
    290              
    291          IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate 
    292             zub(:,jbdy1:jbdy2) = 0._wp 
     300               zvb(ji,jj) = zvb(ji,jj) * r1_hv(ji,jj,Krhs_a) 
     301            END DO 
    293302            DO jk = 1, jpkm1 
    294303               DO ji = 1, jpi 
    295                   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) 
    297                END DO 
    298             END DO 
    299             DO ji = 1, jpi 
    300                zub(ji,jbdy1:jbdy2) = zub(ji,jbdy1:jbdy2) * r1_hu_a(ji,jbdy1:jbdy2) 
    301             END DO 
    302                 
    303             DO jk = 1, jpkm1 
     304                  vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) ) * vmask(ji,jj,jk) 
     305               END DO 
     306            END DO 
     307         END DO 
     308         ! 
     309         IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate 
     310            jbdy1 = jpjglo - ( nn_hls + nbghostcells )   ! halo + land + nbghostcells - 1 
     311            jbdy2 = jpjglo - ( nn_hls + 1 )              ! halo + land + 1            - 1 
     312            DO jj = mj0(jbdy1), mj1(jbdy2) 
     313               zub(:,jj) = 0._wp 
     314               DO jk = 1, jpkm1 
     315                  DO ji = 1, jpi 
     316                     zub(ji,jj) = zub(ji,jj) + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 
     317                  END DO 
     318               END DO 
    304319               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) 
     320                  zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a) 
     321               END DO 
     322               DO jk = 1, jpkm1 
     323                  DO ji = 1, jpi 
     324                     uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk) 
     325                  END DO 
    307326               END DO 
    308327            END DO 
    309328         ENDIF 
    310329         ! 
    311          DO jk = 1, jpkm1              ! Mask domain edges 
    312             DO ji = 1, jpi 
    313                ua(ji,1,jk) = 0._wp 
    314                va(ji,1,jk) = 0._wp 
    315             END DO 
    316          END DO  
    317       ENDIF 
    318  
    319       ! --- North --- ! 
    320       IF( nbondj ==  1 .OR. nbondj == 2 ) THEN 
    321          jbdy1 = nlcj-1-nbghostcells 
    322          jbdy2 = nlcj-2  
    323          ! 
    324          IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
    325             va_b(:,jbdy1:jbdy2) = 0._wp 
    326             DO jk = 1, jpkm1 
    327                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) 
    330                END DO 
    331             END DO 
    332             DO ji=1,jpi 
    333                va_b(ji,jbdy1:jbdy2) = va_b(ji,jbdy1:jbdy2) * r1_hv_a(ji,jbdy1:jbdy2) 
    334             END DO 
    335          ENDIF 
    336          ! 
    337          IF ( .NOT.lk_agrif_clp ) THEN 
    338             DO jk = 1, jpkm1           ! Smooth 
    339                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)) 
    341                END DO 
    342             END DO 
    343          ENDIF 
    344          ! 
    345          zvb(:,jbdy1:jbdy2) = 0._wp    ! Correct transport 
    346          DO jk=1,jpkm1 
    347             DO ji=1,jpi 
    348                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) 
    350             END DO 
    351          END DO 
    352          DO ji = 1, jpi 
    353             zvb(ji,jbdy1:jbdy2) = zvb(ji,jbdy1:jbdy2) * r1_hv_a(ji,jbdy1:jbdy2) 
    354          END DO 
    355  
    356          DO jk = 1, jpkm1 
    357             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) 
    360             END DO 
    361          END DO 
    362              
    363          IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate 
    364             jbdy1 = jbdy1 + 1 
    365             jbdy2 = jbdy2 + 1  
    366             zub(:,jbdy1:jbdy2) = 0._wp 
    367             DO jk = 1, jpkm1 
    368                DO ji = 1, jpi 
    369                   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) 
    371                END DO 
    372             END DO 
    373             DO ji = 1, jpi 
    374                zub(ji,jbdy1:jbdy2) = zub(ji,jbdy1:jbdy2) * r1_hu_a(ji,jbdy1:jbdy2) 
    375             END DO 
    376                 
    377             DO jk = 1, jpkm1 
    378                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) 
    381                END DO 
    382             END DO 
    383          ENDIF 
    384          ! 
    385          DO jk = 1, jpkm1              ! Mask domain edges 
    386             DO ji = 1, jpi 
    387                ua(ji,nlcj  ,jk) = 0._wp 
    388                va(ji,nlcj-1,jk) = 0._wp 
    389             END DO 
    390          END DO  
    391330      ENDIF 
    392331      ! 
    … …  
    401340      !! 
    402341      INTEGER :: ji, jj 
     342      INTEGER :: istart, iend, jstart, jend 
    403343      !!----------------------------------------------------------------------   
    404344      ! 
    405345      IF( Agrif_Root() )   RETURN 
    406346      ! 
    407       IF((nbondi == -1).OR.(nbondi == 2)) THEN 
    408          DO jj=1,jpj 
    409             va_e(2:nbghostcells+1,jj) = vbdy_w(1:nbghostcells,jj) * hvr_e(2:nbghostcells+1,jj) 
    410             ! Specified fluxes: 
    411             ua_e(2:nbghostcells+1,jj) = ubdy_w(1:nbghostcells,jj) * hur_e(2:nbghostcells+1,jj) 
    412             ! Characteristics method (only if ghostcells=1): 
    413             !alt            ua_e(2,jj) = 0.5_wp * ( ubdy_w(jj) * hur_e(2,jj) + ua_e(3,jj) & 
    414             !alt                       &           - sqrt(grav * hur_e(2,jj)) * (sshn_e(3,jj) - hbdy_w(jj)) ) 
    415          END DO 
    416       ENDIF 
    417       ! 
    418       IF((nbondi == 1).OR.(nbondi == 2)) THEN 
    419          DO jj=1,jpj 
    420             va_e(nlci-nbghostcells:nlci-1,jj)   = vbdy_e(1:nbghostcells,jj) * hvr_e(nlci-nbghostcells:nlci-1,jj) 
    421             ! Specified fluxes: 
    422             ua_e(nlci-nbghostcells-1:nlci-2,jj) = ubdy_e(1:nbghostcells,jj) * hur_e(nlci-nbghostcells-1:nlci-2,jj) 
    423             ! Characteristics method (only if ghostcells=1): 
    424             !alt            ua_e(nlci-2,jj) = 0.5_wp * ( ubdy_e(jj) * hur_e(nlci-2,jj) + ua_e(nlci-3,jj) & 
    425             !alt                            &           + sqrt(grav * hur_e(nlci-2,jj)) * (sshn_e(nlci-2,jj) - hbdy_e(jj)) ) 
    426          END DO 
    427       ENDIF 
    428       ! 
    429       IF((nbondj == -1).OR.(nbondj == 2)) THEN 
    430          DO ji=1,jpi 
    431             ua_e(ji,2:nbghostcells+1) = ubdy_s(ji,1:nbghostcells) * hur_e(ji,2:nbghostcells+1) 
    432             ! Specified fluxes: 
    433             va_e(ji,2:nbghostcells+1) = vbdy_s(ji,1:nbghostcells) * hvr_e(ji,2:nbghostcells+1) 
    434             ! Characteristics method (only if ghostcells=1): 
    435             !alt            va_e(ji,2) = 0.5_wp * ( vbdy_s(ji) * hvr_e(ji,2) + va_e(ji,3) & 
    436             !alt                       &           - sqrt(grav * hvr_e(ji,2)) * (sshn_e(ji,3) - hbdy_s(ji)) ) 
    437          END DO 
    438       ENDIF 
    439       ! 
    440       IF((nbondj == 1).OR.(nbondj == 2)) THEN 
    441          DO ji=1,jpi 
    442             ua_e(ji,nlcj-nbghostcells:nlcj-1)   = ubdy_n(ji,1:nbghostcells) * hur_e(ji,nlcj-nbghostcells:nlcj-1) 
    443             ! Specified fluxes: 
    444             va_e(ji,nlcj-nbghostcells-1:nlcj-2) = vbdy_n(ji,1:nbghostcells) * hvr_e(ji,nlcj-nbghostcells-1:nlcj-2) 
    445             ! Characteristics method (only if ghostcells=1): 
    446             !alt            va_e(ji,nlcj-2) = 0.5_wp * ( vbdy_n(ji) * hvr_e(ji,nlcj-2)  + va_e(ji,nlcj-3) & 
    447             !alt                            &           + sqrt(grav * hvr_e(ji,nlcj-2)) * (sshn_e(ji,nlcj-2) - hbdy_n(ji)) ) 
    448          END DO 
    449       ENDIF 
     347      !--- West ---! 
     348      IF( lk_west ) THEN 
     349         istart = nn_hls + 2                              ! halo + land + 1 
     350         iend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
     351         DO ji = mi0(istart), mi1(iend) 
     352            DO jj=1,jpj 
     353               va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj) 
     354               ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj) 
     355            END DO 
     356         END DO 
     357      ENDIF 
     358      ! 
     359      !--- East ---! 
     360      IF( lk_east ) THEN 
     361         istart = jpiglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
     362         iend   = jpiglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1 
     363         DO ji = mi0(istart), mi1(iend) 
     364 
     365            DO jj=1,jpj 
     366               va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj) 
     367            END DO 
     368         END DO 
     369         istart = jpiglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
     370         iend   = jpiglo - ( nn_hls + 2 )                 ! halo + land + 1 
     371         DO ji = mi0(istart), mi1(iend) 
     372            DO jj=1,jpj 
     373               ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj) 
     374            END DO 
     375         END DO 
     376      ENDIF  
     377      ! 
     378      !--- South ---! 
     379      IF( lk_south ) THEN 
     380         jstart = nn_hls + 2                              ! halo + land + 1 
     381         jend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
     382         DO jj = mj0(jstart), mj1(jend) 
     383 
     384            DO ji=1,jpi 
     385               ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj) 
     386               va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj) 
     387            END DO 
     388         END DO 
     389      ENDIF        
     390      ! 
     391      !--- North ---! 
     392      IF( lk_north ) THEN 
     393         jstart = jpjglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
     394         jend   = jpjglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1 
     395         DO jj = mj0(jstart), mj1(jend) 
     396            DO ji=1,jpi 
     397               ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj) 
     398            END DO 
     399         END DO 
     400         jstart = jpjglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
     401         jend   = jpjglo - ( nn_hls + 2 )                 ! halo + land + 1 
     402         DO jj = mj0(jstart), mj1(jend) 
     403            DO ji=1,jpi 
     404               va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj) 
     405            END DO 
     406         END DO 
     407      ENDIF  
    450408      ! 
    451409   END SUBROUTINE Agrif_dyn_ts 
    452410 
    453  
     411    
     412   SUBROUTINE Agrif_dyn_ts_flux( jn, zu, zv ) 
     413      !!---------------------------------------------------------------------- 
     414      !!                  ***  ROUTINE Agrif_dyn_ts_flux  *** 
     415      !!----------------------------------------------------------------------   
     416      INTEGER, INTENT(in) ::   jn 
     417      REAL(wp), DIMENSION(jpi,jpj), INTENT(inout) ::   zu, zv 
     418      !! 
     419      INTEGER :: ji, jj 
     420      INTEGER :: istart, iend, jstart, jend 
     421      !!----------------------------------------------------------------------   
     422      ! 
     423      IF( Agrif_Root() )   RETURN 
     424      ! 
     425      !--- West ---! 
     426      IF( lk_west ) THEN 
     427         istart = nn_hls + 2                              ! halo + land + 1 
     428         iend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
     429         DO ji = mi0(istart), mi1(iend) 
     430            DO jj=1,jpj 
     431               zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj) 
     432               zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj) 
     433            END DO 
     434         END DO 
     435      ENDIF 
     436      ! 
     437      !--- East ---! 
     438      IF( lk_east ) THEN 
     439         istart = jpiglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
     440         iend   = jpiglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1 
     441         DO ji = mi0(istart), mi1(iend) 
     442            DO jj=1,jpj 
     443               zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj) 
     444            END DO 
     445         END DO 
     446         istart = jpiglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
     447         iend   = jpiglo - ( nn_hls + 2 )                 ! halo + land + 1 
     448         DO ji = mi0(istart), mi1(iend) 
     449            DO jj=1,jpj 
     450               zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj) 
     451            END DO 
     452         END DO 
     453      ENDIF 
     454      ! 
     455      !--- South ---! 
     456      IF( lk_south ) THEN 
     457         jstart = nn_hls + 2                              ! halo + land + 1 
     458         jend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
     459         DO jj = mj0(jstart), mj1(jend) 
     460            DO ji=1,jpi 
     461               zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj) 
     462               zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj) 
     463            END DO 
     464         END DO 
     465      ENDIF 
     466      ! 
     467      !--- North ---! 
     468      IF( lk_north ) THEN 
     469         jstart = jpjglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
     470         jend   = jpjglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1 
     471         DO jj = mj0(jstart), mj1(jend) 
     472            DO ji=1,jpi 
     473               zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj) 
     474            END DO 
     475         END DO 
     476         jstart = jpjglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
     477         jend   = jpjglo - ( nn_hls + 2 )                 ! halo + land + 1 
     478         DO jj = mj0(jstart), mj1(jend) 
     479            DO ji=1,jpi 
     480               zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj) 
     481            END DO 
     482         END DO 
     483      ENDIF 
     484      ! 
     485   END SUBROUTINE Agrif_dyn_ts_flux 
     486 
     487    
    454488   SUBROUTINE Agrif_dta_ts( kt ) 
    455489      !!---------------------------------------------------------------------- 
    … …  
    470504      ! 
    471505      ! Interpolate barotropic fluxes 
    472       Agrif_SpecialValue=0._wp 
     506      Agrif_SpecialValue = 0._wp 
    473507      Agrif_UseSpecialValue = ln_spc_dyn 
     508 
     509      use_sign_north = .TRUE. 
     510      sign_north = -1. 
     511 
     512      ! 
     513      ! Set bdy time interpolation stage to 0 (latter incremented locally do deal with corners) 
     514      utint_stage(:,:) = 0 
     515      vtint_stage(:,:) = 0 
    474516      ! 
    475517      IF( ll_int_cons ) THEN  ! Conservative interpolation 
    476518         ! order matters here !!!!!! 
    477519         CALL Agrif_Bc_variable( ub2b_interp_id, calledweight=1._wp, procname=interpub2b ) ! Time integrated 
    478          CALL Agrif_Bc_variable( vb2b_interp_id, calledweight=1._wp, procname=interpvb2b ) 
     520         CALL Agrif_Bc_variable( vb2b_interp_id, calledweight=1._wp, procname=interpvb2b )  
     521         ! 
    479522         bdy_tinterp = 1 
    480523         CALL Agrif_Bc_variable( unb_id        , calledweight=1._wp, procname=interpunb  ) ! After 
    481          CALL Agrif_Bc_variable( vnb_id        , calledweight=1._wp, procname=interpvnb  ) 
     524         CALL Agrif_Bc_variable( vnb_id        , calledweight=1._wp, procname=interpvnb  )   
     525         ! 
    482526         bdy_tinterp = 2 
    483527         CALL Agrif_Bc_variable( unb_id        , calledweight=0._wp, procname=interpunb  ) ! Before 
    484          CALL Agrif_Bc_variable( vnb_id        , calledweight=0._wp, procname=interpvnb  )          
     528         CALL Agrif_Bc_variable( vnb_id        , calledweight=0._wp, procname=interpvnb  )    
    485529      ELSE ! Linear interpolation 
    486          bdy_tinterp = 0 
    487          ubdy_w(:,:) = 0._wp   ;   vbdy_w(:,:) = 0._wp  
    488          ubdy_e(:,:) = 0._wp   ;   vbdy_e(:,:) = 0._wp  
    489          ubdy_n(:,:) = 0._wp   ;   vbdy_n(:,:) = 0._wp  
    490          ubdy_s(:,:) = 0._wp   ;   vbdy_s(:,:) = 0._wp 
     530         ! 
     531         ubdy(:,:) = 0._wp   ;   vbdy(:,:) = 0._wp  
    491532         CALL Agrif_Bc_variable( unb_id, procname=interpunb ) 
    492533         CALL Agrif_Bc_variable( vnb_id, procname=interpvnb ) 
    493534      ENDIF 
    494535      Agrif_UseSpecialValue = .FALSE. 
     536      use_sign_north = .FALSE. 
    495537      !  
    496538   END SUBROUTINE Agrif_dta_ts 
    … …  
    503545      INTEGER, INTENT(in) ::   kt 
    504546      ! 
    505       INTEGER  :: ji, jj, indx, indy 
     547      INTEGER  :: ji, jj 
     548      INTEGER  :: istart, iend, jstart, jend 
    506549      !!----------------------------------------------------------------------   
    507550      ! 
    … …  
    516559      ! 
    517560      ! --- West --- ! 
    518       IF((nbondi == -1).OR.(nbondi == 2)) THEN 
    519          indx = 1+nbghostcells 
    520          DO jj = 1, jpj 
    521             DO ji = 2, indx 
    522                ssha(ji,jj) = hbdy_w(ji-1,jj) 
    523             ENDDO 
    524          ENDDO 
     561      IF(lk_west) THEN 
     562         istart = nn_hls + 2                              ! halo + land + 1 
     563         iend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
     564         DO ji = mi0(istart), mi1(iend) 
     565            DO jj = 1, jpj 
     566               ssh(ji,jj,Krhs_a) = hbdy(ji,jj) 
     567            END DO 
     568         END DO 
    525569      ENDIF 
    526570      ! 
    527571      ! --- East --- ! 
    528       IF((nbondi == 1).OR.(nbondi == 2)) THEN 
    529          indx = nlci-nbghostcells 
    530          DO jj = 1, jpj 
    531             DO ji = indx, nlci-1 
    532                ssha(ji,jj) = hbdy_e(ji-indx+1,jj) 
    533             ENDDO 
    534          ENDDO 
     572      IF(lk_east) THEN 
     573         istart = jpiglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
     574         iend   = jpiglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1 
     575         DO ji = mi0(istart), mi1(iend) 
     576            DO jj = 1, jpj 
     577               ssh(ji,jj,Krhs_a) = hbdy(ji,jj) 
     578            END DO 
     579         END DO 
    535580      ENDIF 
    536581      ! 
    537582      ! --- South --- ! 
    538       IF((nbondj == -1).OR.(nbondj == 2)) THEN 
    539          indy = 1+nbghostcells 
    540          DO jj = 2, indy 
     583      IF(lk_south) THEN 
     584         jstart = nn_hls + 2                              ! halo + land + 1 
     585         jend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
     586         DO jj = mj0(jstart), mj1(jend) 
    541587            DO ji = 1, jpi 
    542                ssha(ji,jj) = hbdy_s(ji,jj-1) 
    543             ENDDO 
    544          ENDDO 
     588               ssh(ji,jj,Krhs_a) = hbdy(ji,jj) 
     589            END DO 
     590         END DO 
    545591      ENDIF 
    546592      ! 
    547593      ! --- North --- ! 
    548       IF((nbondj == 1).OR.(nbondj == 2)) THEN 
    549          indy = nlcj-nbghostcells 
    550          DO jj = indy, nlcj-1 
     594      IF(lk_north) THEN 
     595         jstart = jpjglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
     596         jend   = jpjglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1 
     597         DO jj = mj0(jstart), mj1(jend) 
    551598            DO ji = 1, jpi 
    552                ssha(ji,jj) = hbdy_n(ji,jj-indy+1) 
    553             ENDDO 
    554          ENDDO 
     599               ssh(ji,jj,Krhs_a) = hbdy(ji,jj) 
     600            END DO 
     601         END DO 
    555602      ENDIF 
    556603      ! 
    … …  
    564611      INTEGER, INTENT(in) ::   jn 
    565612      !! 
    566       INTEGER :: ji, jj, indx, indy 
    567       !!----------------------------------------------------------------------   
    568       !! clem ghost (starting at i,j=1 is important I think otherwise you introduce a grad(ssh)/=0 at point 2) 
     613      INTEGER :: ji, jj 
     614      INTEGER  :: istart, iend, jstart, jend 
     615      !!----------------------------------------------------------------------   
    569616      ! 
    570617      IF( Agrif_Root() )   RETURN 
    571618      ! 
    572619      ! --- West --- ! 
    573       IF((nbondi == -1).OR.(nbondi == 2)) THEN 
    574          indx = 1+nbghostcells 
    575          DO jj = 1, jpj 
    576             DO ji = 2, indx 
    577                ssha_e(ji,jj) = hbdy_w(ji-1,jj) 
    578             ENDDO 
    579          ENDDO 
     620      IF(lk_west) THEN 
     621         istart = nn_hls + 2                              ! halo + land + 1 
     622         iend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
     623         DO ji = mi0(istart), mi1(iend) 
     624            DO jj = 1, jpj 
     625               ssha_e(ji,jj) = hbdy(ji,jj) 
     626            END DO 
     627         END DO 
    580628      ENDIF 
    581629      ! 
    582630      ! --- East --- ! 
    583       IF((nbondi == 1).OR.(nbondi == 2)) THEN 
    584          indx = nlci-nbghostcells 
    585          DO jj = 1, jpj 
    586             DO ji = indx, nlci-1 
    587                ssha_e(ji,jj) = hbdy_e(ji-indx+1,jj) 
    588             ENDDO 
    589          ENDDO 
     631      IF(lk_east) THEN 
     632         istart = jpiglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
     633         iend   = jpiglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1 
     634         DO ji = mi0(istart), mi1(iend) 
     635            DO jj = 1, jpj 
     636               ssha_e(ji,jj) = hbdy(ji,jj) 
     637            END DO 
     638         END DO 
    590639      ENDIF 
    591640      ! 
    592641      ! --- South --- ! 
    593       IF((nbondj == -1).OR.(nbondj == 2)) THEN 
    594          indy = 1+nbghostcells 
    595          DO jj = 2, indy 
     642      IF(lk_south) THEN 
     643         jstart = nn_hls + 2                              ! halo + land + 1 
     644         jend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
     645         DO jj = mj0(jstart), mj1(jend) 
    596646            DO ji = 1, jpi 
    597                ssha_e(ji,jj) = hbdy_s(ji,jj-1) 
    598             ENDDO 
    599          ENDDO 
     647               ssha_e(ji,jj) = hbdy(ji,jj) 
     648            END DO 
     649         END DO 
    600650      ENDIF 
    601651      ! 
    602652      ! --- North --- ! 
    603       IF((nbondj == 1).OR.(nbondj == 2)) THEN 
    604          indy = nlcj-nbghostcells 
    605          DO jj = indy, nlcj-1 
     653      IF(lk_north) THEN 
     654         jstart = jpjglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
     655         jend   = jpjglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1 
     656         DO jj = mj0(jstart), mj1(jend) 
    606657            DO ji = 1, jpi 
    607                ssha_e(ji,jj) = hbdy_n(ji,jj-indy+1) 
    608             ENDDO 
    609          ENDDO 
     658               ssha_e(ji,jj) = hbdy(ji,jj) 
     659            END DO 
     660         END DO 
    610661      ENDIF 
    611662      ! 
    612663   END SUBROUTINE Agrif_ssh_ts 
    613664 
     665    
    614666   SUBROUTINE Agrif_avm 
    615667      !!---------------------------------------------------------------------- 
    … …  
    632684      ! 
    633685   END SUBROUTINE Agrif_avm 
    634     
    635  
    636    SUBROUTINE interptsn( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before, nb, ndir ) 
     686 
     687 
     688   SUBROUTINE interptsn( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before ) 
    637689      !!---------------------------------------------------------------------- 
    638690      !!                  *** ROUTINE interptsn *** 
    … …  
    641693      INTEGER                                     , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2, n1, n2 
    642694      LOGICAL                                     , INTENT(in   ) ::   before 
    643       INTEGER                                     , INTENT(in   ) ::   nb , ndir 
    644       ! 
    645       INTEGER  ::   ji, jj, jk, jn, iref, jref, ibdy, jbdy   ! dummy loop indices 
    646       INTEGER  ::   imin, imax, jmin, jmax, N_in, N_out 
    647       REAL(wp) ::   zrho, z1, z2, z3, z4, z5, z6, z7 
    648       LOGICAL :: western_side, eastern_side,northern_side,southern_side 
     695      ! 
     696      INTEGER  ::   ji, jj, jk, jn  ! dummy loop indices 
     697      INTEGER  ::   N_in, N_out 
     698      INTEGER  :: item 
    649699      ! vertical interpolation: 
    650       REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk,n1:n2) :: ptab_child 
    651       REAL(wp), DIMENSION(k1:k2,n1:n2-1) :: tabin 
    652       REAL(wp), DIMENSION(k1:k2) :: h_in 
    653       REAL(wp), DIMENSION(1:jpk) :: h_out 
    654       REAL(wp) :: h_diff 
    655  
    656       IF( before ) THEN          
     700      REAL(wp) :: zhtot 
     701      REAL(wp), DIMENSION(k1:k2,1:jpts) :: tabin 
     702      REAL(wp), DIMENSION(k1:k2) :: h_in, z_in 
     703      REAL(wp), DIMENSION(1:jpk) :: h_out, z_out 
     704      !!---------------------------------------------------------------------- 
     705 
     706      IF( before ) THEN 
     707 
     708         item = Kmm_a 
     709         IF( l_ini_child )   Kmm_a = Kbb_a   
     710 
    657711         DO jn = 1,jpts 
    658712            DO jk=k1,k2 
    659713               DO jj=j1,j2 
    660714                 DO ji=i1,i2 
    661                        ptab(ji,jj,jk,jn) = tsn(ji,jj,jk,jn) 
     715                       ptab(ji,jj,jk,jn) = ts(ji,jj,jk,jn,Kmm_a) 
    662716                 END DO 
    663717              END DO 
    664718           END DO 
    665         END DO 
    666  
    667 # if defined key_vertical 
    668         DO jk=k1,k2 
    669            DO jj=j1,j2 
    670               DO ji=i1,i2 
    671                  ptab(ji,jj,jk,jpts+1) = tmask(ji,jj,jk) * e3t_n(ji,jj,jk)  
    672               END DO 
    673            END DO 
    674         END DO 
    675 # endif 
     719         END DO 
     720 
     721         IF( l_vremap .OR. l_ini_child) THEN 
     722            ! Interpolate thicknesses 
     723            ! Warning: these are masked, hence extrapolated prior interpolation. 
     724            DO jk=k1,k2 
     725               DO jj=j1,j2 
     726                  DO ji=i1,i2 
     727                      ptab(ji,jj,jk,jpts+1) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kmm_a) 
     728 
     729                  END DO 
     730               END DO 
     731            END DO 
     732 
     733            ! Extrapolate thicknesses in partial bottom cells: 
     734            ! Set them to Agrif_SpecialValue (0.). Correct bottom thicknesses are retrieved later on 
     735            IF (ln_zps) THEN 
     736               DO jj=j1,j2 
     737                  DO ji=i1,i2 
     738                      jk = mbkt(ji,jj) 
     739                      ptab(ji,jj,jk,jpts+1) = 0._wp 
     740                  END DO 
     741               END DO            
     742            END IF 
     743         
     744            ! Save ssh at last level: 
     745            IF (.NOT.ln_linssh) THEN 
     746               ptab(i1:i2,j1:j2,k2,jpts+1) = ssh(i1:i2,j1:j2,Kmm_a)*tmask(i1:i2,j1:j2,1)  
     747            ELSE 
     748               ptab(i1:i2,j1:j2,k2,jpts+1) = 0._wp 
     749            END IF       
     750         ENDIF 
     751         Kmm_a = item 
     752 
    676753      ELSE  
    677  
    678          western_side  = (nb == 1).AND.(ndir == 1)   ;   eastern_side  = (nb == 1).AND.(ndir == 2) 
    679          southern_side = (nb == 2).AND.(ndir == 1)   ;   northern_side = (nb == 2).AND.(ndir == 2) 
    680  
    681 # if defined key_vertical               
    682          DO jj=j1,j2 
    683             DO ji=i1,i2 
    684                iref = ji 
    685                jref = jj 
    686                if(western_side) iref=MAX(2,ji) 
    687                if(eastern_side) iref=MIN(nlci-1,ji) 
    688                if(southern_side) jref=MAX(2,jj) 
    689                if(northern_side) jref=MIN(nlcj-1,jj) 
    690                N_in = 0 
    691                DO jk=k1,k2 !k2 = jpk of parent grid 
    692                   IF (ptab(ji,jj,jk,n2) == 0) EXIT 
    693                   N_in = N_in + 1 
    694                   tabin(jk,:) = ptab(ji,jj,jk,n1:n2-1) 
    695                   h_in(N_in) = ptab(ji,jj,jk,n2) 
    696                END DO 
    697                N_out = 0 
    698                DO jk=1,jpk ! jpk of child grid 
    699                   IF (tmask(iref,jref,jk) == 0) EXIT  
    700                   N_out = N_out + 1 
    701                   h_out(jk) = e3t_n(iref,jref,jk) 
    702                ENDDO 
    703                IF (N_in > 0) THEN 
    704                   DO jn=1,jpts 
    705                      call reconstructandremap(tabin(1:N_in,jn),h_in,ptab_child(ji,jj,1:N_out,jn),h_out,N_in,N_out) 
    706                   ENDDO 
    707                ENDIF 
    708             ENDDO 
    709          ENDDO 
    710 # else 
    711          ptab_child(i1:i2,j1:j2,1:jpk,1:jpts) = ptab(i1:i2,j1:j2,1:jpk,1:jpts) 
    712 # endif 
    713          ! 
    714          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)  
    716          END DO 
    717  
    718          IF ( .NOT.lk_agrif_clp ) THEN  
    719             ! 
    720             imin = i1 ; imax = i2 
    721             jmin = j1 ; jmax = j2 
    722             !  
    723             ! Remove CORNERS 
    724             IF((nbondj == -1).OR.(nbondj == 2)) jmin = 2 + nbghostcells 
    725             IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj - nbghostcells - 1 
    726             IF((nbondi == -1).OR.(nbondi == 2)) imin = 2 + nbghostcells 
    727             IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci - nbghostcells - 1       
    728             ! 
    729             IF( eastern_side ) THEN 
    730                zrho = Agrif_Rhox() 
    731                z1 = ( zrho - 1._wp ) * 0.5_wp                     
    732                z3 = ( zrho - 1._wp ) / ( zrho + 1._wp )          
    733                z6 = 2._wp * ( zrho - 1._wp ) / ( zrho + 1._wp ) 
    734                z7 =       - ( zrho - 1._wp ) / ( zrho + 3._wp ) 
    735                z2 = 1._wp - z1 ; z4 = 1._wp - z3 ; z5 = 1._wp - z6 - z7 
    736                ! 
    737                ibdy = nlci-nbghostcells 
    738                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) 
    740                   DO jk = 1, jpkm1 
    741                      DO jj = jmin,jmax 
    742                         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) 
    744                         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) 
    749                            ENDIF 
    750                         ENDIF 
    751                      END DO 
    752                   END DO 
    753                   ! 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) 
    755                END DO 
    756             ENDIF 
    757             !  
    758             IF( northern_side ) THEN 
    759                zrho = Agrif_Rhoy() 
    760                z1 = ( zrho - 1._wp ) * 0.5_wp                     
    761                z3 = ( zrho - 1._wp ) / ( zrho + 1._wp )          
    762                z6 = 2._wp * ( zrho - 1._wp ) / ( zrho + 1._wp ) 
    763                z7 =       - ( zrho - 1._wp ) / ( zrho + 3._wp ) 
    764                z2 = 1._wp - z1 ; z4 = 1._wp - z3 ; z5 = 1._wp - z6 - z7 
    765                ! 
    766                jbdy = nlcj-nbghostcells          
    767                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) 
    769                   DO jk = 1, jpkm1 
    770                      DO ji = imin,imax 
    771                         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) 
    773                         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) 
    778                            ENDIF 
    779                         ENDIF 
    780                      END DO 
    781                   END DO 
    782                   ! 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) 
    784                END DO 
    785             ENDIF 
    786             ! 
    787             IF( western_side ) THEN 
    788                zrho = Agrif_Rhox() 
    789                z1 = ( zrho - 1._wp ) * 0.5_wp                     
    790                z3 = ( zrho - 1._wp ) / ( zrho + 1._wp )          
    791                z6 = 2._wp * ( zrho - 1._wp ) / ( zrho + 1._wp ) 
    792                z7 =       - ( zrho - 1._wp ) / ( zrho + 3._wp ) 
    793                z2 = 1._wp - z1 ; z4 = 1._wp - z3 ; z5 = 1._wp - z6 - z7 
    794                !     
    795                ibdy = 1+nbghostcells        
    796                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) 
    798                   DO jk = 1, jpkm1 
    799                      DO jj = jmin,jmax 
    800                         IF( umask(ibdy,jj,jk) == 0._wp ) THEN 
    801                            tsa(ibdy,jj,jk,jn) = tsa(ibdy-1,jj,jk,jn) * tmask(ibdy,jj,jk) 
    802                         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) 
    807                            ENDIF 
    808                         ENDIF 
    809                      END DO 
    810                   END DO 
    811                   ! 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) 
    813                END DO 
    814             ENDIF 
    815             ! 
    816             IF( southern_side ) THEN 
    817                zrho = Agrif_Rhoy() 
    818                z1 = ( zrho - 1._wp ) * 0.5_wp                     
    819                z3 = ( zrho - 1._wp ) / ( zrho + 1._wp )          
    820                z6 = 2._wp * ( zrho - 1._wp ) / ( zrho + 1._wp ) 
    821                z7 =       - ( zrho - 1._wp ) / ( zrho + 3._wp ) 
    822                z2 = 1._wp - z1 ; z4 = 1._wp - z3 ; z5 = 1._wp - z6 - z7 
    823                !   
    824                jbdy=1+nbghostcells         
    825                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) 
    827                   DO jk = 1, jpkm1       
    828                      DO ji = imin,imax 
    829                         IF( vmask(ji,jbdy,jk) == 0._wp ) THEN 
    830                            tsa(ji,jbdy,jk,jn)=tsa(ji,jbdy-1,jk,jn) * tmask(ji,jbdy,jk) 
    831                         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) 
    836                            ENDIF 
    837                         ENDIF 
    838                      END DO 
    839                   END DO 
    840                   ! 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) 
    842                END DO 
    843             ENDIF 
    844             ! 
     754         item = Krhs_a 
     755         IF( l_ini_child )   Krhs_a = Kbb_a   
     756 
     757         IF( l_vremap .OR. l_ini_child ) THEN 
     758            IF (ln_linssh) ptab(i1:i2,j1:j2,k2,n2) = 0._wp  
     759                
     760            DO jj=j1,j2 
     761               DO ji=i1,i2 
     762                  ts(ji,jj,:,:,Krhs_a) = 0.                   
     763               !   IF( l_ini_child) ts(ji,jj,:,:,Krhs_a) = ptab(ji,jj,:,1:jpts) 
     764                  N_in = mbkt_parent(ji,jj) 
     765                  zhtot = 0._wp 
     766                  DO jk=1,N_in !k2 = jpk of parent grid 
     767                     IF (jk==N_in) THEN 
     768                        h_in(jk) = ht0_parent(ji,jj) + ptab(ji,jj,k2,n2) - zhtot 
     769                     ELSE 
     770                        h_in(jk) = ptab(ji,jj,jk,n2) 
     771                     ENDIF 
     772                     zhtot = zhtot + h_in(jk) 
     773                     tabin(jk,:) = ptab(ji,jj,jk,n1:n2-1) 
     774                  END DO 
     775                  z_in(1) = 0.5_wp * h_in(1) - zhtot + ht0_parent(ji,jj) 
     776                  DO jk=2,N_in 
     777                     z_in(jk) = z_in(jk-1) + 0.5_wp * h_in(jk) 
     778                  END DO 
     779 
     780                  N_out = 0 
     781                  DO jk=1,jpk ! jpk of child grid 
     782                     IF (tmask(ji,jj,jk) == 0._wp) EXIT  
     783                     N_out = N_out + 1 
     784                     h_out(jk) = e3t(ji,jj,jk,Krhs_a) 
     785                  END DO 
     786 
     787                  z_out(1) = 0.5_wp * h_out(1) - SUM(h_out(1:N_out)) + ht_0(ji,jj) 
     788                  DO jk=2,N_out 
     789                     z_out(jk) = z_out(jk-1) + 0.5_wp * h_out(jk) 
     790                  END DO 
     791 
     792                  IF (N_in*N_out > 0) THEN 
     793                     IF( l_ini_child ) THEN 
     794                        CALL remap_linear(tabin(1:N_in,1:jpts),z_in(1:N_in),ts(ji,jj,1:N_out,1:jpts,Krhs_a),          & 
     795                                      &   z_out(1:N_out),N_in,N_out,jpts)   
     796                     ELSE  
     797                        CALL reconstructandremap(tabin(1:N_in,1:jpts),h_in(1:N_in),ts(ji,jj,1:N_out,1:jpts,Krhs_a),   & 
     798                                      &   h_out(1:N_out),N_in,N_out,jpts)   
     799                     ENDIF 
     800                  ENDIF 
     801               END DO 
     802            END DO 
     803            Krhs_a = item 
     804  
     805         ELSE 
     806          
     807            DO jn=1, jpts 
     808                ts(i1:i2,j1:j2,1:jpk,jn,Krhs_a)=ptab(i1:i2,j1:j2,1:jpk,jn)*tmask(i1:i2,j1:j2,1:jpk)  
     809            END DO 
    845810         ENDIF 
     811 
    846812      ENDIF 
    847813      ! 
    848814   END SUBROUTINE interptsn 
    849815 
    850    SUBROUTINE interpsshn( ptab, i1, i2, j1, j2, before, nb, ndir ) 
     816    
     817   SUBROUTINE interpsshn( ptab, i1, i2, j1, j2, before ) 
    851818      !!---------------------------------------------------------------------- 
    852819      !!                  ***  ROUTINE interpsshn  *** 
    … …  
    855822      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab 
    856823      LOGICAL                         , INTENT(in   ) ::   before 
    857       INTEGER                         , INTENT(in   ) ::   nb , ndir 
    858       ! 
    859       LOGICAL :: western_side, eastern_side,northern_side,southern_side 
     824      ! 
    860825      !!----------------------------------------------------------------------   
    861826      ! 
    862827      IF( before) THEN 
    863          ptab(i1:i2,j1:j2) = sshn(i1:i2,j1:j2) 
     828         ptab(i1:i2,j1:j2) = ssh(i1:i2,j1:j2,Kmm_a) 
    864829      ELSE 
    865          western_side  = (nb == 1).AND.(ndir == 1) 
    866          eastern_side  = (nb == 1).AND.(ndir == 2) 
    867          southern_side = (nb == 2).AND.(ndir == 1) 
    868          northern_side = (nb == 2).AND.(ndir == 2) 
    869          !! clem ghost 
    870          IF(western_side)  hbdy_w(1:nbghostcells,j1:j2) = ptab(i1:i2,j1:j2) * tmask(i1:i2,j1:j2,1) 
    871          IF(eastern_side)  hbdy_e(1:nbghostcells,j1:j2) = ptab(i1:i2,j1:j2) * tmask(i1:i2,j1:j2,1) 
    872          IF(southern_side) hbdy_s(i1:i2,1:nbghostcells) = ptab(i1:i2,j1:j2) * tmask(i1:i2,j1:j2,1)  
    873          IF(northern_side) hbdy_n(i1:i2,1:nbghostcells) = ptab(i1:i2,j1:j2) * tmask(i1:i2,j1:j2,1) 
     830         hbdy(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) * tmask(i1:i2,j1:j2,1) 
    874831      ENDIF 
    875832      ! 
    876833   END SUBROUTINE interpsshn 
    877834 
    878    SUBROUTINE interpun( ptab, i1, i2, j1, j2, k1, k2, m1, m2, before, nb, ndir ) 
     835    
     836   SUBROUTINE interpun( ptab, i1, i2, j1, j2, k1, k2, m1, m2, before ) 
    879837      !!---------------------------------------------------------------------- 
    880838      !!                  *** ROUTINE interpun *** 
    … …  
    884842      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,m1:m2), INTENT(inout) :: ptab 
    885843      LOGICAL, INTENT(in) :: before 
    886       INTEGER, INTENT(in) :: nb , ndir 
    887844      !! 
    888845      INTEGER :: ji,jj,jk 
    889       REAL(wp) :: zrhoy 
     846      REAL(wp) :: zrhoy, zhtot 
    890847      ! vertical interpolation: 
    891       REAL(wp), DIMENSION(k1:k2) :: tabin, h_in 
    892       REAL(wp), DIMENSION(1:jpk) :: h_out 
    893       INTEGER  :: N_in, N_out, iref 
     848      REAL(wp), DIMENSION(k1:k2) :: tabin, h_in, z_in 
     849      REAL(wp), DIMENSION(1:jpk) :: h_out, z_out 
     850      INTEGER  :: N_in, N_out,item 
    894851      REAL(wp) :: h_diff 
    895       LOGICAL  :: western_side, eastern_side 
    896852      !!---------------------------------------------     
    897853      ! 
    898854      IF (before) THEN  
     855 
     856         item = Kmm_a 
     857         IF( l_ini_child )   Kmm_a = Kbb_a      
     858 
    899859         DO jk=1,jpk 
    900860            DO jj=j1,j2 
    901861               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))  
    903 # if defined key_vertical 
    904                   ptab(ji,jj,jk,2) = (umask(ji,jj,jk) * e2u(ji,jj) * e3u_n(ji,jj,jk)) 
    905 # endif 
    906                END DO 
    907             END DO 
    908          END DO 
     862                  ptab(ji,jj,jk,1) = (e2u(ji,jj) * e3u(ji,jj,jk,Kmm_a) * uu(ji,jj,jk,Kmm_a)*umask(ji,jj,jk))  
     863                  IF( l_vremap .OR. l_ini_child) THEN 
     864                     ! Interpolate thicknesses (masked for subsequent extrapolation) 
     865                     ptab(ji,jj,jk,2) = umask(ji,jj,jk) * e2u(ji,jj) * e3u(ji,jj,jk,Kmm_a) 
     866                  ENDIF 
     867               END DO 
     868            END DO 
     869         END DO 
     870 
     871        IF( l_vremap .OR. l_ini_child) THEN 
     872         ! Extrapolate thicknesses in partial bottom cells: 
     873         ! Set them to Agrif_SpecialValue (0.). Correct bottom thicknesses are retrieved later on 
     874            IF (ln_zps) THEN 
     875               DO jj=j1,j2 
     876                  DO ji=i1,i2 
     877                     jk = mbku(ji,jj) 
     878                     ptab(ji,jj,jk,2) = 0._wp 
     879                  END DO 
     880               END DO            
     881            END IF 
     882 
     883           ! Save ssh at last level: 
     884           ptab(i1:i2,j1:j2,k2,2) = 0._wp 
     885           IF (.NOT.ln_linssh) THEN 
     886              ! This vertical sum below should be replaced by the sea-level at U-points (optimization): 
     887              DO jk=1,jpk 
     888                 ptab(i1:i2,j1:j2,k2,2) = ptab(i1:i2,j1:j2,k2,2) + e3u(i1:i2,j1:j2,jk,Kmm_a) * umask(i1:i2,j1:j2,jk) 
     889              END DO 
     890              ptab(i1:i2,j1:j2,k2,2) = ptab(i1:i2,j1:j2,k2,2) - hu_0(i1:i2,j1:j2) 
     891           END IF 
     892        ENDIF 
     893 
     894         Kmm_a = item 
     895         ! 
    909896      ELSE 
    910897         zrhoy = Agrif_rhoy() 
    911 # if defined key_vertical 
     898 
     899        IF( l_vremap .OR. l_ini_child) THEN 
    912900! VERTICAL REFINEMENT BEGIN 
    913          western_side  = (nb == 1).AND.(ndir == 1) 
    914          eastern_side  = (nb == 1).AND.(ndir == 2) 
    915  
    916          DO ji=i1,i2 
    917             iref = ji 
    918             IF (western_side) iref = MAX(2,ji) 
    919             IF (eastern_side) iref = MIN(nlci-2,ji) 
    920             DO jj=j1,j2 
    921                N_in = 0 
    922                DO jk=k1,k2 
    923                   IF (ptab(ji,jj,jk,2) == 0) EXIT 
    924                   N_in = N_in + 1 
    925                   tabin(jk) = ptab(ji,jj,jk,1)/ptab(ji,jj,jk,2) 
    926                   h_in(N_in) = ptab(ji,jj,jk,2)/(e2u(ji,jj)*zrhoy)  
    927               ENDDO 
    928           
    929               IF (N_in == 0) THEN 
    930                  ua(ji,jj,:) = 0._wp 
    931                  CYCLE 
    932               ENDIF 
    933           
    934               N_out = 0 
    935               DO jk=1,jpk 
    936                  if (umask(iref,jj,jk) == 0) EXIT 
    937                  N_out = N_out + 1 
    938                  h_out(N_out) = e3u_a(iref,jj,jk) 
    939               ENDDO 
    940           
    941               IF (N_out == 0) THEN 
    942                  ua(ji,jj,:) = 0._wp 
    943                  CYCLE 
    944               ENDIF 
    945           
    946               IF (N_in * N_out > 0) THEN 
    947                  h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in)) 
    948 ! Should be able to remove the next IF/ELSEIF statement once scale factors are dealt with properly 
    949                  if (h_diff < -1.e4) then 
    950                     print *,'CHECK YOUR BATHY ...', h_diff, sum(h_out(1:N_out)), sum(h_in(1:N_in)) 
    951 !                    stop 
    952                  endif 
    953               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) 
    955             ENDDO 
    956          ENDDO 
    957  
    958 # else 
    959          DO jk = 1, jpkm1 
    960             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) ) 
    962             END DO 
    963          END DO 
    964 # endif 
     901 
     902            IF (ln_linssh) ptab(i1:i2,j1:j2,k2,2) = 0._wp  
     903 
     904            DO ji=i1,i2 
     905               DO jj=j1,j2 
     906                  uu(ji,jj,:,Krhs_a) = 0._wp 
     907                  N_in = mbku_parent(ji,jj) 
     908                  zhtot = 0._wp 
     909                  DO jk=1,N_in 
     910                     IF (jk==N_in) THEN 
     911                        h_in(jk) = hu0_parent(ji,jj) + ptab(ji,jj,k2,2) - zhtot 
     912                     ELSE 
     913                        h_in(jk) = ptab(ji,jj,jk,2)/(e2u(ji,jj)*zrhoy)  
     914                     ENDIF 
     915                     zhtot = zhtot + h_in(jk) 
     916                     IF( h_in(jk) .GT. 0. ) THEN 
     917                     tabin(jk) = ptab(ji,jj,jk,1)/(e2u(ji,jj)*zrhoy*h_in(jk)) 
     918                     ELSE 
     919                     tabin(jk) = 0. 
     920                     ENDIF 
     921                 END DO 
     922                 z_in(1) = 0.5_wp * h_in(1) - zhtot + hu0_parent(ji,jj)  
     923                 DO jk=2,N_in 
     924                    z_in(jk) = z_in(jk-1) + 0.5_wp * h_in(jk) 
     925                 END DO 
     926                      
     927                 N_out = 0 
     928                 DO jk=1,jpk 
     929                    IF (umask(ji,jj,jk) == 0) EXIT 
     930                    N_out = N_out + 1 
     931                    h_out(N_out) = e3u(ji,jj,jk,Krhs_a) 
     932                 END DO 
     933 
     934                 z_out(1) = 0.5_wp * h_out(1) - SUM(h_out(1:N_out)) + hu_0(ji,jj) 
     935                 DO jk=2,N_out 
     936                    z_out(jk) = z_out(jk-1) + 0.5_wp * h_out(jk)  
     937                 END DO   
     938 
     939                 IF (N_in*N_out > 0) THEN 
     940                     IF( l_ini_child ) THEN 
     941                        CALL remap_linear       (tabin(1:N_in),z_in(1:N_in),uu(ji,jj,1:N_out,Krhs_a),z_out(1:N_out),N_in,N_out,1) 
     942                     ELSE 
     943                        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,1) 
     944                     ENDIF    
     945                 ENDIF 
     946               END DO 
     947            END DO 
     948         ELSE 
     949            DO jk = 1, jpkm1 
     950               DO jj=j1,j2 
     951                  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) ) 
     952               END DO 
     953            END DO 
     954         ENDIF 
    965955 
    966956      ENDIF 
    … …  
    968958   END SUBROUTINE interpun 
    969959 
    970    SUBROUTINE interpvn( ptab, i1, i2, j1, j2, k1, k2, m1, m2, before, nb, ndir ) 
     960    
     961   SUBROUTINE interpvn( ptab, i1, i2, j1, j2, k1, k2, m1, m2, before ) 
    971962      !!---------------------------------------------------------------------- 
    972963      !!                  *** ROUTINE interpvn *** 
    … …  
    976967      REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,m1:m2), INTENT(inout) :: ptab 
    977968      LOGICAL, INTENT(in) :: before 
    978       INTEGER, INTENT(in) :: nb , ndir 
    979969      ! 
    980970      INTEGER :: ji,jj,jk 
    981971      REAL(wp) :: zrhox 
    982972      ! vertical interpolation: 
    983       REAL(wp), DIMENSION(k1:k2) :: tabin, h_in 
    984       REAL(wp), DIMENSION(1:jpk) :: h_out 
    985       INTEGER  :: N_in, N_out, jref 
    986       REAL(wp) :: h_diff 
    987       LOGICAL  :: northern_side,southern_side 
     973      REAL(wp), DIMENSION(k1:k2) :: tabin, h_in, z_in 
     974      REAL(wp), DIMENSION(1:jpk) :: h_out, z_out 
     975      INTEGER  :: N_in, N_out, item 
     976      REAL(wp) :: h_diff, zhtot 
    988977      !!---------------------------------------------     
    989978      !       
    990       IF (before) THEN           
     979      IF (before) THEN    
     980 
     981         item = Kmm_a 
     982         IF( l_ini_child )   Kmm_a = Kbb_a      
     983        
    991984         DO jk=k1,k2 
    992985            DO jj=j1,j2 
    993986               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)) 
    995 # if defined key_vertical 
    996                   ptab(ji,jj,jk,2) = vmask(ji,jj,jk) * e1v(ji,jj) * e3v_n(ji,jj,jk) 
    997 # endif 
    998                END DO 
    999             END DO 
    1000          END DO 
     987                  ptab(ji,jj,jk,1) = (e1v(ji,jj) * e3v(ji,jj,jk,Kmm_a) * vv(ji,jj,jk,Kmm_a)*vmask(ji,jj,jk)) 
     988                  IF( l_vremap .OR. l_ini_child) THEN 
     989                     ! Interpolate thicknesses (masked for subsequent extrapolation) 
     990                     ptab(ji,jj,jk,2) = vmask(ji,jj,jk) * e1v(ji,jj) * e3v(ji,jj,jk,Kmm_a) 
     991                  ENDIF 
     992               END DO 
     993            END DO 
     994         END DO 
     995 
     996         IF( l_vremap .OR. l_ini_child) THEN 
     997         ! Extrapolate thicknesses in partial bottom cells: 
     998         ! Set them to Agrif_SpecialValue (0.). Correct bottom thicknesses are retrieved later on 
     999            IF (ln_zps) THEN 
     1000               DO jj=j1,j2 
     1001                  DO ji=i1,i2 
     1002                     jk = mbkv(ji,jj) 
     1003                     ptab(ji,jj,jk,2) = 0._wp 
     1004                  END DO 
     1005               END DO            
     1006            END IF 
     1007            ! Save ssh at last level: 
     1008            ptab(i1:i2,j1:j2,k2,2) = 0._wp 
     1009            IF (.NOT.ln_linssh) THEN 
     1010               ! This vertical sum below should be replaced by the sea-level at V-points (optimization): 
     1011               DO jk=1,jpk 
     1012                  ptab(i1:i2,j1:j2,k2,2) = ptab(i1:i2,j1:j2,k2,2) + e3v(i1:i2,j1:j2,jk,Kmm_a) * vmask(i1:i2,j1:j2,jk) 
     1013               END DO 
     1014               ptab(i1:i2,j1:j2,k2,2) = ptab(i1:i2,j1:j2,k2,2) - hv_0(i1:i2,j1:j2) 
     1015            END IF  
     1016         ENDIF 
     1017         item = Kmm_a 
     1018 
    10011019      ELSE        
    10021020         zrhox = Agrif_rhox() 
    1003 # if defined key_vertical 
    1004  
    1005          southern_side = (nb == 2).AND.(ndir == 1) 
    1006          northern_side = (nb == 2).AND.(ndir == 2) 
    1007  
    1008          DO jj=j1,j2 
    1009             jref = jj 
    1010             IF (southern_side) jref = MAX(2,jj) 
    1011             IF (northern_side) jref = MIN(nlcj-2,jj) 
    1012             DO ji=i1,i2 
    1013                N_in = 0 
    1014                DO jk=k1,k2 
    1015                   if (ptab(ji,jj,jk,2) == 0) EXIT 
    1016                   N_in = N_in + 1 
    1017                   tabin(jk) = ptab(ji,jj,jk,1)/ptab(ji,jj,jk,2) 
    1018                   h_in(N_in) = ptab(ji,jj,jk,2)/(e1v(ji,jj)*zrhox) 
    1019                END DO 
    1020                IF (N_in == 0) THEN 
    1021                   va(ji,jj,:) = 0._wp 
    1022                   CYCLE 
    1023                ENDIF 
    1024           
    1025                N_out = 0 
    1026                DO jk=1,jpk 
    1027                   if (vmask(ji,jref,jk) == 0) EXIT 
    1028                   N_out = N_out + 1 
    1029                   h_out(N_out) = e3v_a(ji,jref,jk) 
    1030                END DO 
    1031                IF (N_out == 0) THEN 
    1032                  va(ji,jj,:) = 0._wp 
    1033                  CYCLE 
    1034                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) 
    1036             END DO 
    1037          END DO 
    1038 # else 
    1039          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) ) 
    1041          END DO 
    1042 # endif 
     1021 
     1022         IF( l_vremap .OR. l_ini_child ) THEN 
     1023 
     1024            IF (ln_linssh) ptab(i1:i2,j1:j2,k2,2) = 0._wp  
     1025 
     1026            DO jj=j1,j2 
     1027               DO ji=i1,i2 
     1028                  vv(ji,jj,:,Krhs_a) = 0._wp 
     1029                  N_in = mbkv_parent(ji,jj) 
     1030                  zhtot = 0._wp 
     1031                  DO jk=1,N_in 
     1032                     IF (jk==N_in) THEN 
     1033                        h_in(jk) = hv0_parent(ji,jj) + ptab(ji,jj,k2,2) - zhtot 
     1034                     ELSE 
     1035                        h_in(jk) = ptab(ji,jj,jk,2)/(e1v(ji,jj)*zrhox)  
     1036                     ENDIF 
     1037                     zhtot = zhtot + h_in(jk) 
     1038                     IF( h_in(jk) .GT. 0. ) THEN 
     1039                       tabin(jk) = ptab(ji,jj,jk,1)/(e1v(ji,jj)*zrhox*h_in(jk)) 
     1040                     ELSE 
     1041                       tabin(jk)  = 0. 
     1042                     ENDIF  
     1043                  END DO 
     1044 
     1045                  z_in(1) = 0.5_wp * h_in(1) - zhtot + hv0_parent(ji,jj) 
     1046                  DO jk=2,N_in 
     1047                     z_in(jk) = z_in(jk-1) + 0.5_wp * h_in(jk) 
     1048                  END DO 
     1049 
     1050                  N_out = 0 
     1051                  DO jk=1,jpk 
     1052                     IF (vmask(ji,jj,jk) == 0) EXIT 
     1053                     N_out = N_out + 1 
     1054                     h_out(N_out) = e3v(ji,jj,jk,Krhs_a) 
     1055                  END DO 
     1056 
     1057                  z_out(1) = 0.5_wp * h_out(1) - SUM(h_out(1:N_out)) + hv_0(ji,jj) 
     1058                  DO jk=2,N_out 
     1059                     z_out(jk) = z_out(jk-1) + 0.5_wp * h_out(jk) 
     1060                  END DO 
     1061  
     1062                  IF (N_in*N_out > 0) THEN 
     1063                     IF( l_ini_child ) THEN 
     1064                        CALL remap_linear       (tabin(1:N_in),z_in(1:N_in),vv(ji,jj,1:N_out,Krhs_a),z_out(1:N_out),N_in,N_out,1) 
     1065                     ELSE 
     1066                        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,1) 
     1067                     ENDIF    
     1068                  ENDIF 
     1069               END DO 
     1070            END DO 
     1071         ELSE 
     1072            DO jk = 1, jpkm1 
     1073               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) ) 
     1074            END DO 
     1075         ENDIF 
    10431076      ENDIF 
    10441077      !         
    10451078   END SUBROUTINE interpvn 
    10461079 
    1047    SUBROUTINE interpunb( ptab, i1, i2, j1, j2, before, nb, ndir ) 
     1080   SUBROUTINE interpunb( ptab, i1, i2, j1, j2, before) 
    10481081      !!---------------------------------------------------------------------- 
    10491082      !!                  ***  ROUTINE interpunb  *** 
    … …  
    10521085      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab 
    10531086      LOGICAL                         , INTENT(in   ) ::   before 
    1054       INTEGER                         , INTENT(in   ) ::   nb , ndir 
    10551087      ! 
    10561088      INTEGER  ::   ji, jj 
    10571089      REAL(wp) ::   zrhoy, zrhot, zt0, zt1, ztcoeff 
    1058       LOGICAL  ::   western_side, eastern_side,northern_side,southern_side 
    10591090      !!----------------------------------------------------------------------   
    10601091      ! 
    10611092      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) 
     1093         ptab(i1:i2,j1:j2) = e2u(i1:i2,j1:j2) * hu(i1:i2,j1:j2,Kmm_a) * uu_b(i1:i2,j1:j2,Kmm_a) 
    10631094      ELSE 
    1064          western_side  = (nb == 1).AND.(ndir == 1) 
    1065          eastern_side  = (nb == 1).AND.(ndir == 2) 
    1066          southern_side = (nb == 2).AND.(ndir == 1) 
    1067          northern_side = (nb == 2).AND.(ndir == 2) 
    10681095         zrhoy = Agrif_Rhoy() 
    10691096         zrhot = Agrif_rhot() 
    … …  
    10711098         zt0 = REAL(Agrif_NbStepint()  , wp) / zrhot 
    10721099         zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot       
    1073          ! Polynomial interpolation coefficients: 
    1074          IF( bdy_tinterp == 1 ) THEN 
    1075             ztcoeff = zrhot * (  zt1**2._wp * (       zt1 - 1._wp)        & 
    1076                &               - zt0**2._wp * (       zt0 - 1._wp)        ) 
    1077          ELSEIF( bdy_tinterp == 2 ) THEN 
    1078             ztcoeff = zrhot * (  zt1        * (       zt1 - 1._wp)**2._wp & 
    1079                &               - zt0        * (       zt0 - 1._wp)**2._wp ) 
    1080          ELSE 
    1081             ztcoeff = 1 
    1082          ENDIF 
    1083          !    
    1084          IF(western_side)   ubdy_w(1:nbghostcells,j1:j2) = ubdy_w(1:nbghostcells,j1:j2) + ztcoeff * ptab(i1:i2,j1:j2)   
    1085          IF(eastern_side)   ubdy_e(1:nbghostcells,j1:j2) = ubdy_e(1:nbghostcells,j1:j2) + ztcoeff * ptab(i1:i2,j1:j2)   
    1086          IF(southern_side)  ubdy_s(i1:i2,1:nbghostcells) = ubdy_s(i1:i2,1:nbghostcells) + ztcoeff * ptab(i1:i2,j1:j2) 
    1087          IF(northern_side)  ubdy_n(i1:i2,1:nbghostcells) = ubdy_n(i1:i2,1:nbghostcells) + ztcoeff * ptab(i1:i2,j1:j2)  
    1088          !             
    1089          IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN 
    1090             IF(western_side)   ubdy_w(1:nbghostcells,j1:j2) = ubdy_w(1:nbghostcells,j1:j2) / (zrhoy*e2u(i1:i2,j1:j2)) * umask(i1:i2,j1:j2,1) 
    1091             IF(eastern_side)   ubdy_e(1:nbghostcells,j1:j2) = ubdy_e(1:nbghostcells,j1:j2) / (zrhoy*e2u(i1:i2,j1:j2)) * umask(i1:i2,j1:j2,1) 
    1092             IF(southern_side)  ubdy_s(i1:i2,1:nbghostcells) = ubdy_s(i1:i2,1:nbghostcells) / (zrhoy*e2u(i1:i2,j1:j2)) * umask(i1:i2,j1:j2,1) 
    1093             IF(northern_side)  ubdy_n(i1:i2,1:nbghostcells) = ubdy_n(i1:i2,1:nbghostcells) / (zrhoy*e2u(i1:i2,j1:j2)) * umask(i1:i2,j1:j2,1) 
    1094          ENDIF 
    1095       ENDIF 
     1100         !  
     1101         DO ji = i1, i2 
     1102            DO jj = j1, j2 
     1103               IF ( utint_stage(ji,jj) < (bdy_tinterp + 1) ) THEN 
     1104                  IF    ( utint_stage(ji,jj) == 1  ) THEN 
     1105                     ztcoeff = zrhot * (  zt1**2._wp * (       zt1 - 1._wp)        & 
     1106                        &               - zt0**2._wp * (       zt0 - 1._wp)        ) 
     1107                  ELSEIF( utint_stage(ji,jj) == 2  ) THEN 
     1108                     ztcoeff = zrhot * (  zt1        * (       zt1 - 1._wp)**2._wp & 
     1109                        &               - zt0        * (       zt0 - 1._wp)**2._wp ) 
     1110                  ELSEIF( utint_stage(ji,jj) == 0  ) THEN                 
     1111                     ztcoeff = 1._wp 
     1112                  ELSE 
     1113                     ztcoeff = 0._wp 
     1114                  ENDIF 
     1115                  !    
     1116                  ubdy(ji,jj) = ubdy(ji,jj) + ztcoeff * ptab(ji,jj) 
     1117                  !             
     1118                  IF (( utint_stage(ji,jj) == 2 ).OR.( utint_stage(ji,jj) == 0 )) THEN 
     1119                     ubdy(ji,jj) = ubdy(ji,jj) / (zrhoy*e2u(ji,jj)) * umask(ji,jj,1) 
     1120                  ENDIF 
     1121                  ! 
     1122                  utint_stage(ji,jj) = utint_stage(ji,jj) + 1 
     1123               ENDIF 
     1124            END DO 
     1125         END DO 
     1126      END IF 
    10961127      !  
    10971128   END SUBROUTINE interpunb 
    10981129 
    10991130 
    1100    SUBROUTINE interpvnb( ptab, i1, i2, j1, j2, before, nb, ndir ) 
     1131   SUBROUTINE interpvnb( ptab, i1, i2, j1, j2, before ) 
    11011132      !!---------------------------------------------------------------------- 
    11021133      !!                  ***  ROUTINE interpvnb  *** 
    … …  
    11051136      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab 
    11061137      LOGICAL                         , INTENT(in   ) ::   before 
    1107       INTEGER                         , INTENT(in   ) ::   nb , ndir 
    1108       ! 
    1109       INTEGER  ::   ji,jj 
     1138      ! 
     1139      INTEGER  ::   ji, jj 
    11101140      REAL(wp) ::   zrhox, zrhot, zt0, zt1, ztcoeff    
    1111       LOGICAL  ::   western_side, eastern_side,northern_side,southern_side 
    11121141      !!----------------------------------------------------------------------   
    11131142      !  
    11141143      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) 
     1144         ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * hv(i1:i2,j1:j2,Kmm_a) * vv_b(i1:i2,j1:j2,Kmm_a) 
    11161145      ELSE 
    1117          western_side  = (nb == 1).AND.(ndir == 1) 
    1118          eastern_side  = (nb == 1).AND.(ndir == 2) 
    1119          southern_side = (nb == 2).AND.(ndir == 1) 
    1120          northern_side = (nb == 2).AND.(ndir == 2) 
    11211146         zrhox = Agrif_Rhox() 
    11221147         zrhot = Agrif_rhot() 
    11231148         ! Time indexes bounds for integration 
    11241149         zt0 = REAL(Agrif_NbStepint()  , wp) / zrhot 
    1125          zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot       
    1126          IF( bdy_tinterp == 1 ) THEN 
    1127             ztcoeff = zrhot * (  zt1**2._wp * (       zt1 - 1._wp)        & 
    1128                &               - zt0**2._wp * (       zt0 - 1._wp)        ) 
    1129          ELSEIF( bdy_tinterp == 2 ) THEN 
    1130             ztcoeff = zrhot * (  zt1        * (       zt1 - 1._wp)**2._wp & 
    1131                &               - zt0        * (       zt0 - 1._wp)**2._wp )  
    1132          ELSE 
    1133             ztcoeff = 1 
    1134          ENDIF 
    1135          !! clem ghost 
    1136          IF(western_side)   vbdy_w(1:nbghostcells,j1:j2) = vbdy_w(1:nbghostcells,j1:j2) + ztcoeff * ptab(i1:i2,j1:j2)   
    1137          IF(eastern_side)   vbdy_e(1:nbghostcells,j1:j2) = vbdy_e(1:nbghostcells,j1:j2) + ztcoeff * ptab(i1:i2,j1:j2)    
    1138          IF(southern_side)  vbdy_s(i1:i2,1:nbghostcells) = vbdy_s(i1:i2,1:nbghostcells) + ztcoeff * ptab(i1:i2,j1:j2) 
    1139          IF(northern_side)  vbdy_n(i1:i2,1:nbghostcells) = vbdy_n(i1:i2,1:nbghostcells) + ztcoeff * ptab(i1:i2,j1:j2)  
    1140          !             
    1141          IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN 
    1142             IF(western_side)   vbdy_w(1:nbghostcells,j1:j2) = vbdy_w(1:nbghostcells,j1:j2) / (zrhox*e1v(i1:i2,j1:j2)) * vmask(i1:i2,j1:j2,1) 
    1143             IF(eastern_side)   vbdy_e(1:nbghostcells,j1:j2) = vbdy_e(1:nbghostcells,j1:j2) / (zrhox*e1v(i1:i2,j1:j2)) * vmask(i1:i2,j1:j2,1) 
    1144             IF(southern_side)  vbdy_s(i1:i2,1:nbghostcells) = vbdy_s(i1:i2,1:nbghostcells) / (zrhox*e1v(i1:i2,j1:j2)) * vmask(i1:i2,j1:j2,1) 
    1145             IF(northern_side)  vbdy_n(i1:i2,1:nbghostcells) = vbdy_n(i1:i2,1:nbghostcells) / (zrhox*e1v(i1:i2,j1:j2)) * vmask(i1:i2,j1:j2,1) 
    1146          ENDIF 
     1150         zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot  
     1151         !      
     1152         DO ji = i1, i2 
     1153            DO jj = j1, j2 
     1154               IF ( vtint_stage(ji,jj) < (bdy_tinterp + 1) ) THEN 
     1155                  IF    ( vtint_stage(ji,jj) == 1  ) THEN 
     1156                     ztcoeff = zrhot * (  zt1**2._wp * (       zt1 - 1._wp)        & 
     1157                        &               - zt0**2._wp * (       zt0 - 1._wp)        ) 
     1158                  ELSEIF( vtint_stage(ji,jj) == 2  ) THEN 
     1159                     ztcoeff = zrhot * (  zt1        * (       zt1 - 1._wp)**2._wp & 
     1160                        &               - zt0        * (       zt0 - 1._wp)**2._wp ) 
     1161                  ELSEIF( vtint_stage(ji,jj) == 0  ) THEN                 
     1162                     ztcoeff = 1._wp 
     1163                  ELSE 
     1164                     ztcoeff = 0._wp 
     1165                  ENDIF 
     1166                  !    
     1167                  vbdy(ji,jj) = vbdy(ji,jj) + ztcoeff * ptab(ji,jj) 
     1168                  !             
     1169                  IF (( vtint_stage(ji,jj) == 2 ).OR.( vtint_stage(ji,jj) == 0 )) THEN 
     1170                     vbdy(ji,jj) = vbdy(ji,jj) / (zrhox*e1v(ji,jj)) * vmask(ji,jj,1) 
     1171                  ENDIF 
     1172                  ! 
     1173                  vtint_stage(ji,jj) = vtint_stage(ji,jj) + 1 
     1174               ENDIF 
     1175            END DO 
     1176         END DO           
    11471177      ENDIF 
    11481178      ! 
    … …  
    11501180 
    11511181 
    1152    SUBROUTINE interpub2b( ptab, i1, i2, j1, j2, before, nb, ndir ) 
     1182   SUBROUTINE interpub2b( ptab, i1, i2, j1, j2, before ) 
    11531183      !!---------------------------------------------------------------------- 
    11541184      !!                  ***  ROUTINE interpub2b  *** 
    … …  
    11571187      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab 
    11581188      LOGICAL                         , INTENT(in   ) ::   before 
    1159       INTEGER                         , INTENT(in   ) ::   nb , ndir 
    11601189      ! 
    11611190      INTEGER  ::   ji,jj 
    1162       REAL(wp) ::   zrhot, zt0, zt1,zat 
    1163       LOGICAL  ::   western_side, eastern_side,northern_side,southern_side 
     1191      REAL(wp) ::   zrhot, zt0, zt1, zat 
    11641192      !!----------------------------------------------------------------------   
    11651193      IF( before ) THEN 
    … …  
    11701198         ENDIF 
    11711199      ELSE 
    1172          western_side  = (nb == 1).AND.(ndir == 1) 
    1173          eastern_side  = (nb == 1).AND.(ndir == 2) 
    1174          southern_side = (nb == 2).AND.(ndir == 1) 
    1175          northern_side = (nb == 2).AND.(ndir == 2) 
    11761200         zrhot = Agrif_rhot() 
    11771201         ! Time indexes bounds for integration 
    … …  
    11811205         zat = zrhot * (  zt1**2._wp * (-2._wp*zt1 + 3._wp)    & 
    11821206            &           - zt0**2._wp * (-2._wp*zt0 + 3._wp)    )  
    1183          !! clem ghost 
    1184          IF(western_side ) ubdy_w(1:nbghostcells,j1:j2) = zat * ptab(i1:i2,j1:j2)  
    1185          IF(eastern_side ) ubdy_e(1:nbghostcells,j1:j2) = zat * ptab(i1:i2,j1:j2)   
    1186          IF(southern_side) ubdy_s(i1:i2,1:nbghostcells) = zat * ptab(i1:i2,j1:j2) 
    1187          IF(northern_side) ubdy_n(i1:i2,1:nbghostcells) = zat * ptab(i1:i2,j1:j2)  
     1207         ! 
     1208         ubdy(i1:i2,j1:j2) = zat * ptab(i1:i2,j1:j2)  
     1209         ! 
     1210         ! Update interpolation stage: 
     1211         utint_stage(i1:i2,j1:j2) = 1 
    11881212      ENDIF 
    11891213      !  
    … …  
    11911215    
    11921216 
    1193    SUBROUTINE interpvb2b( ptab, i1, i2, j1, j2, before, nb, ndir ) 
     1217   SUBROUTINE interpvb2b( ptab, i1, i2, j1, j2, before ) 
    11941218      !!---------------------------------------------------------------------- 
    11951219      !!                  ***  ROUTINE interpvb2b  *** 
    … …  
    11981222      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab 
    11991223      LOGICAL                         , INTENT(in   ) ::   before 
    1200       INTEGER                         , INTENT(in   ) ::   nb , ndir 
    12011224      ! 
    12021225      INTEGER ::   ji,jj 
    1203       REAL(wp) ::   zrhot, zt0, zt1,zat 
    1204       LOGICAL ::   western_side, eastern_side,northern_side,southern_side 
     1226      REAL(wp) ::   zrhot, zt0, zt1, zat 
    12051227      !!----------------------------------------------------------------------   
    12061228      ! 
    … …  
    12121234         ENDIF 
    12131235      ELSE       
    1214          western_side  = (nb == 1).AND.(ndir == 1) 
    1215          eastern_side  = (nb == 1).AND.(ndir == 2) 
    1216          southern_side = (nb == 2).AND.(ndir == 1) 
    1217          northern_side = (nb == 2).AND.(ndir == 2) 
    12181236         zrhot = Agrif_rhot() 
    12191237         ! Time indexes bounds for integration 
    … …  
    12241242            &           - zt0**2._wp * (-2._wp*zt0 + 3._wp)    )  
    12251243         ! 
    1226          IF(western_side )   vbdy_w(1:nbghostcells,j1:j2) = zat * ptab(i1:i2,j1:j2)   
    1227          IF(eastern_side )   vbdy_e(1:nbghostcells,j1:j2) = zat * ptab(i1:i2,j1:j2)   
    1228          IF(southern_side)   vbdy_s(i1:i2,1:nbghostcells) = zat * ptab(i1:i2,j1:j2) 
    1229          IF(northern_side)   vbdy_n(i1:i2,1:nbghostcells) = zat * ptab(i1:i2,j1:j2)  
     1244         vbdy(i1:i2,j1:j2) = zat * ptab(i1:i2,j1:j2) 
     1245         ! 
     1246         ! update interpolation stage: 
     1247         vtint_stage(i1:i2,j1:j2) = 1 
    12301248      ENDIF 
    12311249      !       
    … …  
    12331251 
    12341252 
    1235    SUBROUTINE interpe3t( ptab, i1, i2, j1, j2, k1, k2, before, nb, ndir ) 
     1253   SUBROUTINE interpe3t( ptab, i1, i2, j1, j2, k1, k2, before ) 
    12361254      !!---------------------------------------------------------------------- 
    12371255      !!                  ***  ROUTINE interpe3t  *** 
    … …  
    12401258      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab 
    12411259      LOGICAL                              , INTENT(in   ) :: before 
    1242       INTEGER                              , INTENT(in   ) :: nb , ndir 
    12431260      ! 
    12441261      INTEGER :: ji, jj, jk 
    1245       LOGICAL :: western_side, eastern_side, northern_side, southern_side 
    12461262      !!----------------------------------------------------------------------   
    12471263      !     
    … …  
    12491265         ptab(i1:i2,j1:j2,k1:k2) = tmask(i1:i2,j1:j2,k1:k2) * e3t_0(i1:i2,j1:j2,k1:k2) 
    12501266      ELSE 
    1251          western_side  = (nb == 1).AND.(ndir == 1) 
    1252          eastern_side  = (nb == 1).AND.(ndir == 2) 
    1253          southern_side = (nb == 2).AND.(ndir == 1) 
    1254          northern_side = (nb == 2).AND.(ndir == 2) 
    12551267         ! 
    12561268         DO jk = k1, k2 
    12571269            DO jj = j1, j2 
    12581270               DO ji = i1, i2 
    1259                   ! 
    12601271                  IF( ABS( ptab(ji,jj,jk) - tmask(ji,jj,jk) * e3t_0(ji,jj,jk) ) > 1.D-2) THEN 
    1261                      IF (western_side.AND.(ptab(i1+nbghostcells-1,jj,jk)>0._wp)) THEN 
    1262                         WRITE(numout,*) 'ERROR bathymetry merge at the western border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk 
    1263                         WRITE(numout,*)  ptab(ji,jj,jk), e3t_0(ji,jj,jk)  
    1264                         kindic_agr = kindic_agr + 1 
    1265                      ELSEIF (eastern_side.AND.(ptab(i2-nbghostcells+1,jj,jk)>0._wp)) THEN 
    1266                         WRITE(numout,*) 'ERROR bathymetry merge at the eastern border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk 
    1267                         WRITE(numout,*)  ptab(ji,jj,jk), e3t_0(ji,jj,jk) 
    1268                         kindic_agr = kindic_agr + 1 
    1269                      ELSEIF (southern_side.AND.(ptab(ji,j1+nbghostcells-1,jk)>0._wp)) THEN 
    1270                         WRITE(numout,*) 'ERROR bathymetry merge at the southern border ji,jj,jk', ji+nimpp-1,jj+njmpp-1,jk 
    1271                         WRITE(numout,*)  ptab(ji,jj,jk), e3t_0(ji,jj,jk) 
    1272                         kindic_agr = kindic_agr + 1 
    1273                      ELSEIF (northern_side.AND.(ptab(ji,j2-nbghostcells+1,jk)>0._wp)) THEN 
    1274                         WRITE(numout,*) 'ERROR bathymetry merge at the northen border ji,jj,jk', ji+nimpp-1,jj+njmpp-1,jk 
    1275                         WRITE(numout,*)  ptab(ji,jj,jk), e3t_0(ji,jj,jk) 
    1276                         kindic_agr = kindic_agr + 1 
    1277                      ENDIF 
     1272                     WRITE(numout,*) ' Agrif error for e3t_0: parent , child, i, j, k ',  &  
     1273                     &                 ptab(ji,jj,jk), tmask(ji,jj,jk) * e3t_0(ji,jj,jk), & 
     1274                     &                 mig0(ji), mig0(jj), jk 
     1275                !     kindic_agr = kindic_agr + 1 
    12781276                  ENDIF 
    12791277               END DO 
    … …  
    12851283   END SUBROUTINE interpe3t 
    12861284 
    1287  
    1288    SUBROUTINE interpumsk( ptab, i1, i2, j1, j2, k1, k2, before, nb, ndir ) 
    1289       !!---------------------------------------------------------------------- 
    1290       !!                  ***  ROUTINE interpumsk  *** 
    1291       !!----------------------------------------------------------------------   
    1292       INTEGER                              , INTENT(in   ) ::   i1, i2, j1, j2, k1, k2 
    1293       REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   ptab 
    1294       LOGICAL                              , INTENT(in   ) ::   before 
    1295       INTEGER                              , INTENT(in   ) ::   nb , ndir 
    1296       ! 
    1297       INTEGER ::   ji, jj, jk 
    1298       LOGICAL ::   western_side, eastern_side    
     1285   SUBROUTINE interpglamt( ptab, i1, i2, j1, j2, before ) 
     1286      !!---------------------------------------------------------------------- 
     1287      !!                  ***  ROUTINE interpglamt  *** 
     1288      !!----------------------------------------------------------------------   
     1289      INTEGER                        , INTENT(in   ) :: i1, i2, j1, j2 
     1290      REAL(wp),DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 
     1291      LOGICAL                        , INTENT(in   ) :: before 
     1292      ! 
     1293      INTEGER :: ji, jj, jk 
     1294      REAL(wp):: ztst 
    12991295      !!----------------------------------------------------------------------   
    13001296      !     
    13011297      IF( before ) THEN 
    1302          ptab(i1:i2,j1:j2,k1:k2) = umask(i1:i2,j1:j2,k1:k2) 
     1298         ptab(i1:i2,j1:j2) = glamt(i1:i2,j1:j2) 
    13031299      ELSE 
    1304          western_side = (nb == 1).AND.(ndir == 1) 
    1305          eastern_side = (nb == 1).AND.(ndir == 2) 
    1306          DO jk = k1, k2 
    1307             DO jj = j1, j2 
    1308                DO ji = i1, i2 
    1309                    ! Velocity mask at boundary edge points: 
    1310                   IF (ABS(ptab(ji,jj,jk) - umask(ji,jj,jk)) > 1.D-2) THEN 
    1311                      IF (western_side) THEN 
    1312                         WRITE(numout,*) 'ERROR with umask at the western border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk 
    1313                         WRITE(numout,*) '      masks: parent, child ', ptab(ji,jj,jk), umask(ji,jj,jk) 
    1314                         kindic_agr = kindic_agr + 1 
    1315                      ELSEIF (eastern_side) THEN 
    1316                         WRITE(numout,*) 'ERROR with umask at the eastern border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk 
    1317                         WRITE(numout,*) '      masks: parent, child ', ptab(ji,jj,jk), umask(ji,jj,jk) 
    1318                         kindic_agr = kindic_agr + 1 
    1319                      ENDIF 
    1320                   ENDIF 
    1321                END DO 
    1322             END DO 
    1323          END DO 
    1324          ! 
     1300         ztst = MAXVAL(ABS(glamt(i1:i2,j1:j2)))*1.e-4 
     1301         DO jj = j1, j2 
     1302            DO ji = i1, i2 
     1303               IF( ABS( ptab(ji,jj) - glamt(ji,jj) ) > ztst ) THEN 
     1304                  WRITE(numout,*) ' Agrif error for glamt: parent, child, i, j ', ptab(ji,jj), glamt(ji,jj), mig0(ji), mig0(jj) 
     1305!                  kindic_agr = kindic_agr + 1 
     1306               ENDIF 
     1307            END DO 
     1308         END DO 
    13251309      ENDIF 
    13261310      !  
    1327    END SUBROUTINE interpumsk 
    1328  
    1329  
    1330    SUBROUTINE interpvmsk( ptab, i1, i2, j1, j2, k1, k2, before, nb, ndir ) 
    1331       !!---------------------------------------------------------------------- 
    1332       !!                  ***  ROUTINE interpvmsk  *** 
    1333       !!----------------------------------------------------------------------   
    1334       INTEGER                              , INTENT(in   ) ::   i1,i2,j1,j2,k1,k2 
    1335       REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) ::   ptab 
    1336       LOGICAL                              , INTENT(in   ) ::   before 
    1337       INTEGER                              , INTENT(in   ) :: nb , ndir 
    1338       ! 
    1339       INTEGER ::   ji, jj, jk 
    1340       LOGICAL ::   northern_side, southern_side      
     1311   END SUBROUTINE interpglamt 
     1312 
     1313 
     1314   SUBROUTINE interpgphit( ptab, i1, i2, j1, j2, before ) 
     1315      !!---------------------------------------------------------------------- 
     1316      !!                  ***  ROUTINE interpgphit  *** 
     1317      !!----------------------------------------------------------------------   
     1318      INTEGER                        , INTENT(in   ) :: i1, i2, j1, j2 
     1319      REAL(wp),DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab 
     1320      LOGICAL                        , INTENT(in   ) :: before 
     1321      ! 
     1322      INTEGER :: ji, jj, jk 
     1323      REAL(wp):: ztst 
    13411324      !!----------------------------------------------------------------------   
    13421325      !     
    13431326      IF( before ) THEN 
    1344          ptab(i1:i2,j1:j2,k1:k2) = vmask(i1:i2,j1:j2,k1:k2) 
     1327         ptab(i1:i2,j1:j2) = gphit(i1:i2,j1:j2) 
    13451328      ELSE 
    1346          southern_side = (nb == 2).AND.(ndir == 1) 
    1347          northern_side = (nb == 2).AND.(ndir == 2) 
    1348          DO jk = k1, k2 
    1349             DO jj = j1, j2 
    1350                DO ji = i1, i2 
    1351                    ! Velocity mask at boundary edge points: 
    1352                   IF (ABS(ptab(ji,jj,jk) - vmask(ji,jj,jk)) > 1.D-2) THEN 
    1353                      IF (southern_side) THEN 
    1354                         WRITE(numout,*) 'ERROR with vmask at the southern border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk 
    1355                         WRITE(numout,*) '      masks: parent, child ', ptab(ji,jj,jk), vmask(ji,jj,jk) 
    1356                         kindic_agr = kindic_agr + 1 
    1357                      ELSEIF (northern_side) THEN 
    1358                         WRITE(numout,*) 'ERROR with vmask at the northern border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk 
    1359                         WRITE(numout,*) '      masks: parent, child ', ptab(ji,jj,jk), vmask(ji,jj,jk) 
    1360                         kindic_agr = kindic_agr + 1 
    1361                      ENDIF 
    1362                   ENDIF 
    1363                END DO 
    1364             END DO 
    1365          END DO 
    1366          ! 
     1329         ztst = MAXVAL(ABS(gphit(i1:i2,j1:j2)))*1.e-4 
     1330         DO jj = j1, j2 
     1331            DO ji = i1, i2 
     1332               IF( ABS( ptab(ji,jj) - gphit(ji,jj) ) > ztst ) THEN 
     1333                  WRITE(numout,*) ' Agrif error for gphit: parent, child, i, j ', ptab(ji,jj), gphit(ji,jj), mig0(ji), mig0(jj) 
     1334!                  kindic_agr = kindic_agr + 1 
     1335               ENDIF 
     1336            END DO 
     1337         END DO 
    13671338      ENDIF 
    13681339      !  
    1369    END SUBROUTINE interpvmsk 
     1340   END SUBROUTINE interpgphit 
    13701341 
    13711342 
    … …  
    13771348      REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2,m1:m2), INTENT(inout) ::   ptab 
    13781349      LOGICAL                                    , INTENT(in   ) ::   before 
    1379       REAL(wp), DIMENSION(k1:k2) :: tabin, h_in 
    1380       REAL(wp), DIMENSION(1:jpk) :: h_out 
    1381       INTEGER  :: N_in, N_out, ji, jj, jk 
     1350      ! 
     1351      INTEGER  :: ji, jj, jk 
     1352      INTEGER  :: N_in, N_out 
     1353      REAL(wp), DIMENSION(k1:k2) :: tabin, z_in 
     1354      REAL(wp), DIMENSION(1:jpk) :: z_out 
    13821355      !!----------------------------------------------------------------------   
    13831356      !       
    … …  
    13891362              END DO 
    13901363           END DO 
    1391         END DO 
    1392 #ifdef key_vertical          
    1393         DO jk=k1,k2 
    1394            DO jj=j1,j2 
    1395               DO ji=i1,i2 
    1396                  ptab(ji,jj,jk,2) = wmask(ji,jj,jk) * e3w_n(ji,jj,jk)  
    1397               END DO 
    1398            END DO 
    1399         END DO 
    1400 #endif 
     1364         END DO 
     1365 
     1366         IF( l_vremap ) THEN 
     1367            ! Interpolate thicknesses 
     1368            ! Warning: these are masked, hence extrapolated prior interpolation. 
     1369            DO jk=k1,k2 
     1370               DO jj=j1,j2 
     1371                  DO ji=i1,i2 
     1372                      ptab(ji,jj,jk,2) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kmm_a) 
     1373                  END DO 
     1374               END DO 
     1375            END DO 
     1376 
     1377            ! Extrapolate thicknesses in partial bottom cells: 
     1378            ! Set them to Agrif_SpecialValue (0.). Correct bottom thicknesses are retrieved later on 
     1379            IF (ln_zps) THEN 
     1380               DO jj=j1,j2 
     1381                  DO ji=i1,i2 
     1382                      jk = mbkt(ji,jj) 
     1383                      ptab(ji,jj,jk,2) = 0._wp 
     1384                  END DO 
     1385               END DO            
     1386            END IF 
     1387         
     1388           ! Save ssh at last level: 
     1389            IF (.NOT.ln_linssh) THEN 
     1390               ptab(i1:i2,j1:j2,k2,2) = ssh(i1:i2,j1:j2,Kmm_a)*tmask(i1:i2,j1:j2,1)  
     1391            ELSE 
     1392               ptab(i1:i2,j1:j2,k2,2) = 0._wp 
     1393            END IF       
     1394          ENDIF 
     1395 
    14011396      ELSE  
    1402 #ifdef key_vertical          
    1403          avm_k(i1:i2,j1:j2,1:jpk) = 0. 
    1404          DO jj=j1,j2 
    1405             DO ji=i1,i2 
    1406                N_in = 0 
    1407                DO jk=k1,k2 !k2 = jpk of parent grid 
    1408                   IF (ptab(ji,jj,jk,2) == 0) EXIT 
    1409                   N_in = N_in + 1 
    1410                   tabin(jk) = ptab(ji,jj,jk,1) 
    1411                   h_in(N_in) = ptab(ji,jj,jk,2) 
    1412                END DO 
    1413                N_out = 0 
    1414                DO jk=1,jpk ! jpk of child grid 
    1415                   IF (wmask(ji,jj,jk) == 0) EXIT  
    1416                   N_out = N_out + 1 
    1417                   h_out(jk) = e3t_n(ji,jj,jk) 
    1418                ENDDO 
    1419                IF (N_in > 0) THEN 
    1420                   CALL reconstructandremap(tabin(1:N_in),h_in,avm_k(ji,jj,1:N_out),h_out,N_in,N_out) 
    1421                ENDIF 
    1422             ENDDO 
    1423          ENDDO 
    1424 #else 
    1425          avm_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2,1) 
    1426 #endif 
     1397 
     1398         IF( l_vremap ) THEN 
     1399            IF (ln_linssh) ptab(i1:i2,j1:j2,k2,2) = 0._wp  
     1400            avm_k(i1:i2,j1:j2,k1:k2) = 0._wp 
     1401                
     1402            DO jj = j1, j2 
     1403               DO ji =i1, i2 
     1404                  N_in = mbkt_parent(ji,jj) 
     1405                  IF ( tmask(ji,jj,1) == 0._wp) N_in = 0 
     1406                  z_in(N_in+1) = ht0_parent(ji,jj) + ptab(ji,jj,k2,2) 
     1407                  DO jk = N_in, 1, -1  ! Parent vertical grid                
     1408                        z_in(jk) = z_in(jk+1) - ptab(ji,jj,jk,2) 
     1409                       tabin(jk) = ptab(ji,jj,jk,1) 
     1410                  END DO 
     1411                  N_out = mbkt(ji,jj)  
     1412                  DO jk = 1, N_out        ! Child vertical grid 
     1413                     z_out(jk) = gdepw(ji,jj,jk,Kmm_a) 
     1414                  END DO 
     1415                  IF (N_in*N_out > 0) THEN 
     1416                     CALL remap_linear(tabin(1:N_in),z_in(1:N_in),avm_k(ji,jj,1:N_out),z_out(1:N_out),N_in,N_out,1) 
     1417                  ENDIF 
     1418               END DO 
     1419            END DO 
     1420         ELSE 
     1421            avm_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2,1) 
     1422         ENDIF 
    14271423      ENDIF 
    14281424      ! 
    14291425   END SUBROUTINE interpavm 
    14301426 
     1427    
     1428   SUBROUTINE interpmbkt( ptab, i1, i2, j1, j2, before ) 
     1429      !!---------------------------------------------------------------------- 
     1430      !!                  ***  ROUTINE interpsshn  *** 
     1431      !!----------------------------------------------------------------------   
     1432      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2 
     1433      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab 
     1434      LOGICAL                         , INTENT(in   ) ::   before 
     1435      ! 
     1436      !!----------------------------------------------------------------------   
     1437      ! 
     1438      IF( before) THEN 
     1439         ptab(i1:i2,j1:j2) = REAL(mbkt(i1:i2,j1:j2),wp) 
     1440      ELSE 
     1441         mbkt_parent(i1:i2,j1:j2) = NINT(ptab(i1:i2,j1:j2)) 
     1442      ENDIF 
     1443      ! 
     1444   END SUBROUTINE interpmbkt 
     1445 
     1446    
     1447   SUBROUTINE interpht0( ptab, i1, i2, j1, j2, before ) 
     1448      !!---------------------------------------------------------------------- 
     1449      !!                  ***  ROUTINE interpsshn  *** 
     1450      !!----------------------------------------------------------------------   
     1451      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2 
     1452      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab 
     1453      LOGICAL                         , INTENT(in   ) ::   before 
     1454      ! 
     1455      !!----------------------------------------------------------------------   
     1456      ! 
     1457      IF( before) THEN 
     1458         ptab(i1:i2,j1:j2) = ht_0(i1:i2,j1:j2) 
     1459      ELSE 
     1460         ht0_parent(i1:i2,j1:j2) = ptab(i1:i2,j1:j2) 
     1461      ENDIF 
     1462      ! 
     1463   END SUBROUTINE interpht0 
     1464 
     1465    
     1466   SUBROUTINE agrif_initts(tabres,i1,i2,j1,j2,k1,k2,m1,m2,before) 
     1467       INTEGER :: i1, i2, j1, j2, k1, k2, m1, m2 
     1468       REAL(wp):: tabres(i1:i2,j1:j2,k1:k2,m1:m2) 
     1469       LOGICAL :: before 
     1470 
     1471       INTEGER :: jm 
     1472 
     1473       IF (before) THEN 
     1474         DO jm=1,jpts 
     1475             tabres(i1:i2,j1:j2,k1:k2,jm) = ts(i1:i2,j1:j2,k1:k2,jm,Kbb_a) 
     1476         END DO 
     1477       ELSE 
     1478         DO jm=1,jpts 
     1479             ts(i1:i2,j1:j2,k1:k2,jm,Kbb_a)=tabres(i1:i2,j1:j2,k1:k2,jm) 
     1480         END DO 
     1481       ENDIF 
     1482   END SUBROUTINE agrif_initts  
     1483 
     1484    
     1485   SUBROUTINE agrif_initssh( ptab, i1, i2, j1, j2, before ) 
     1486      !!---------------------------------------------------------------------- 
     1487      !!                  ***  ROUTINE interpsshn  *** 
     1488      !!----------------------------------------------------------------------   
     1489      INTEGER                         , INTENT(in   ) ::   i1, i2, j1, j2 
     1490      REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) ::   ptab 
     1491      LOGICAL                         , INTENT(in   ) ::   before 
     1492      ! 
     1493      !!----------------------------------------------------------------------   
     1494      ! 
     1495      IF( before) THEN 
     1496         ptab(i1:i2,j1:j2) = ssh(i1:i2,j1:j2,Kbb_a) 
     1497      ELSE 
     1498         ssh(i1:i2,j1:j2,Kbb_a) = ptab(i1:i2,j1:j2)*tmask(i1:i2,j1:j2,1) 
     1499      ENDIF 
     1500      ! 
     1501   END SUBROUTINE agrif_initssh 
     1502    
    14311503#else 
    14321504   !!---------------------------------------------------------------------- 
Note: See TracChangeset for help on using the changeset viewer.