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 13540 for NEMO/branches/2020/r12377_ticket2386/src/NST/agrif_oce_interp.F90 – NEMO

Ignore:
Timestamp:
2020-09-29T12:41:06+02:00 (4 years ago)
Author:
andmirek
Message:

Ticket #2386: update to latest trunk

Location:
NEMO/branches/2020/r12377_ticket2386
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2020/r12377_ticket2386

    • 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 
        88 
        99# SETTE 
        10 ^/utils/CI/sette@HEAD         sette 
         10^/utils/CI/sette@13507        sette 

  • NEMO/branches/2020/r12377_ticket2386/src/NST/agrif_oce_interp.F90

    r12377 r13540  
    3434   USE lib_mpp 
    3535   USE vremap 
     36   USE lbclnk 
    3637  
    3738   IMPLICIT NONE 
    … …  
    4344   PUBLIC   interptsn, interpsshn, interpavm 
    4445   PUBLIC   interpunb, interpvnb , interpub2b, interpvb2b 
    45    PUBLIC   interpe3t 
    46 #if defined key_vertical 
     46   PUBLIC   interpe3t, interpglamt, interpgphit 
    4747   PUBLIC   interpht0, interpmbkt 
    48 # endif 
     48   PUBLIC   agrif_initts, agrif_initssh 
     49 
    4950   INTEGER ::   bdy_tinterp = 0 
    5051 
    … …  
    8687      IF( Agrif_Root() )   RETURN 
    8788      ! 
    88       Agrif_SpecialValue    = 0._wp 
     89      Agrif_SpecialValue    = 0.0_wp 
    8990      Agrif_UseSpecialValue = ln_spc_dyn 
    9091      ! 
     92      use_sign_north = .TRUE. 
     93      sign_north = -1.0_wp 
    9194      CALL Agrif_Bc_variable( un_interp_id, procname=interpun ) 
    9295      CALL Agrif_Bc_variable( vn_interp_id, procname=interpvn ) 
     96      use_sign_north = .FALSE. 
    9397      ! 
    9498      Agrif_UseSpecialValue = .FALSE. 
    9599      ! 
    96100      ! --- West --- ! 
    97       ibdy1 = 2 
    98       ibdy2 = 1+nbghostcells  
    99       ! 
    100       IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
     101      IF( lk_west ) THEN 
     102         ibdy1 = nn_hls + 2                  ! halo + land + 1 
     103         ibdy2 = nn_hls + 1 + nbghostcells   ! halo + land + nbghostcells 
     104         ! 
     105         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
     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         ! 
    101119         DO ji = mi0(ibdy1), mi1(ibdy2) 
    102             uu_b(ji,:,Krhs_a) = 0._wp 
    103  
     120            zub(ji,:) = 0._wp    ! Correct transport 
    104121            DO jk = 1, jpkm1 
    105122               DO jj = 1, jpj 
    106                   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) 
    107                END DO 
    108             END DO 
    109  
    110             DO jj = 1, jpj 
    111                uu_b(ji,jj,Krhs_a) = uu_b(ji,jj,Krhs_a) * r1_hu(ji,jj,Krhs_a) 
    112             END DO 
    113          END DO 
    114       ENDIF 
    115       ! 
    116       DO ji = mi0(ibdy1), mi1(ibdy2) 
    117          zub(ji,:) = 0._wp    ! Correct transport 
    118          DO jk = 1, jpkm1 
    119             DO jj = 1, jpj 
    120                zub(ji,jj) = zub(ji,jj) &  
    121                   & + e3u(ji,jj,jk,Krhs_a)  * uu(ji,jj,jk,Krhs_a)*umask(ji,jj,jk) 
    122             END DO 
    123          END DO 
    124          DO jj=1,jpj 
    125             zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a) 
    126          END DO 
    127              
    128          DO jk = 1, jpkm1 
    129             DO jj = 1, jpj 
    130                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) 
    131             END DO 
    132          END DO 
    133       END DO 
    134              
    135       IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate 
    136          DO ji = mi0(ibdy1), mi1(ibdy2) 
    137             zvb(ji,:) = 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  
    138129            DO jk = 1, jpkm1 
    139130               DO jj = 1, jpj 
    140                   zvb(ji,jj) = zvb(ji,jj) + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 
    141                END DO 
    142             END DO 
    143             DO jj = 1, jpj 
    144                zvb(ji,jj) = zvb(ji,jj) * r1_hv(ji,jj,Krhs_a) 
    145             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 
    146178            DO jk = 1, jpkm1 
    147179               DO jj = 1, jpj 
    148                   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) 
    149                END DO 
    150             END DO 
    151          END DO 
    152       ENDIF 
    153  
    154       ! --- East --- ! 
    155       ibdy1 = jpiglo-1-nbghostcells 
    156       ibdy2 = jpiglo-2  
    157       ! 
    158       IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
    159          DO ji = mi0(ibdy1), mi1(ibdy2) 
    160             uu_b(ji,:,Krhs_a) = 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 
    161186            DO jk = 1, jpkm1 
    162187               DO jj = 1, jpj 
    163                   uu_b(ji,jj,Krhs_a) = uu_b(ji,jj,Krhs_a) &  
    164                       & + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 
    165                END DO 
    166             END DO 
    167             DO jj = 1, jpj 
    168                uu_b(ji,jj,Krhs_a) = uu_b(ji,jj,Krhs_a) * r1_hu(ji,jj,Krhs_a) 
    169             END DO 
    170          END DO 
    171       ENDIF 
    172       ! 
    173       DO ji = mi0(ibdy1), mi1(ibdy2) 
    174          zub(ji,:) = 0._wp    ! Correct transport 
    175          DO jk = 1, jpkm1 
    176             DO jj = 1, jpj 
    177                zub(ji,jj) = zub(ji,jj) &  
    178                   & + e3u(ji,jj,jk,Krhs_a)  * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 
    179             END DO 
    180          END DO 
    181          DO jj=1,jpj 
    182             zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a) 
    183          END DO 
    184              
    185          DO jk = 1, jpkm1 
    186             DO jj = 1, jpj 
    187                uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) &  
    188                  & + 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-nbghostcells 
    195          ibdy2 = jpiglo-1  
    196          DO ji = mi0(ibdy1), mi1(ibdy2) 
    197             zvb(ji,:) = 0._wp 
    198             DO jk = 1, jpkm1 
     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 
    199203               DO jj = 1, jpj 
    200                   zvb(ji,jj) = zvb(ji,jj) & 
    201                      & + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 
    202                END DO 
    203             END DO 
    204             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 
     211            END DO 
     212         ENDIF 
     213         ! 
     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)      
     231               END DO 
     232            END DO 
     233         ENDIF 
     234         ! 
     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 
    205243               zvb(ji,jj) = zvb(ji,jj) * r1_hv(ji,jj,Krhs_a) 
    206244            END DO 
    207             DO jk = 1, jpkm1 
    208                DO jj = 1, jpj 
    209                   vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) &  
    210                       & + vv_b(ji,jj,Krhs_a)-zvb(ji,jj)) * vmask(ji,jj,jk) 
    211                END DO 
    212             END DO 
    213          END DO 
    214       ENDIF 
    215  
    216       ! --- South --- ! 
    217       jbdy1 = 2 
    218       jbdy2 = 1+nbghostcells  
    219       ! 
    220       IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
    221          DO jj = mj0(jbdy1), mj1(jbdy2) 
    222             vv_b(:,jj,Krhs_a) = 0._wp 
    223245            DO jk = 1, jpkm1 
    224246               DO ji = 1, jpi 
    225                   vv_b(ji,jj,Krhs_a) = vv_b(ji,jj,Krhs_a) &  
    226                       & + 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)      
    231             END DO 
    232          END DO 
    233       ENDIF 
    234       ! 
    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) &  
    240                   & + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 
    241             END DO 
    242          END DO 
    243          DO ji = 1, jpi 
    244             zvb(ji,jj) = zvb(ji,jj) * r1_hv(ji,jj,Krhs_a) 
    245          END DO 
    246  
    247          DO jk = 1, jpkm1 
     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 
     268            END DO 
     269         ENDIF 
     270         ! 
     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) 
     288               END DO 
     289            END DO 
     290         ENDIF 
     291         ! 
     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 
    248299            DO ji = 1, jpi 
    249                vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) &  
    250                  & + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) ) * vmask(ji,jj,jk) 
    251             END DO 
    252          END DO 
    253       END DO 
    254              
    255       IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate 
    256          DO jj = mj0(jbdy1), mj1(jbdy2) 
    257             zub(:,jj) = 0._wp 
     300               zvb(ji,jj) = zvb(ji,jj) * r1_hv(ji,jj,Krhs_a) 
     301            END DO 
    258302            DO jk = 1, jpkm1 
    259303               DO ji = 1, jpi 
    260                   zub(ji,jj) = zub(ji,jj) &  
    261                      & + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 
    262                END DO 
    263             END DO 
    264             DO ji = 1, jpi 
    265                zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a) 
    266             END DO 
    267                 
    268             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 
    269319               DO ji = 1, jpi 
    270                   uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) &  
    271                     & + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk) 
    272                END DO 
    273             END DO 
    274          END DO 
    275       ENDIF 
    276  
    277       ! --- North --- ! 
    278       jbdy1 = jpjglo-1-nbghostcells 
    279       jbdy2 = jpjglo-2  
    280       ! 
    281       IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
    282          DO jj = mj0(jbdy1), mj1(jbdy2) 
    283             vv_b(:,jj,Krhs_a) = 0._wp 
    284             DO jk = 1, jpkm1 
    285                DO ji = 1, jpi 
    286                   vv_b(ji,jj,Krhs_a) = vv_b(ji,jj,Krhs_a) &  
    287                       & + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 
    288                END DO 
    289             END DO 
    290             DO ji=1,jpi 
    291                vv_b(ji,jj,Krhs_a) = vv_b(ji,jj,Krhs_a) * r1_hv(ji,jj,Krhs_a) 
    292             END DO 
    293          END DO 
    294       ENDIF 
    295       ! 
    296       DO jj = mj0(jbdy1), mj1(jbdy2) 
    297          zvb(:,jj) = 0._wp    ! Correct transport 
    298          DO jk=1,jpkm1 
    299             DO ji=1,jpi 
    300                zvb(ji,jj) = zvb(ji,jj) &  
    301                   & + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 
    302             END DO 
    303          END DO 
    304          DO ji = 1, jpi 
    305             zvb(ji,jj) = zvb(ji,jj) * r1_hv(ji,jj,Krhs_a) 
    306          END DO 
    307  
    308          DO jk = 1, jpkm1 
    309             DO ji = 1, jpi 
    310                vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) &  
    311                  & + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) ) * vmask(ji,jj,jk) 
    312             END DO 
    313          END DO 
    314       END DO 
    315              
    316       IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate 
    317          jbdy1 = jpjglo-nbghostcells 
    318          jbdy2 = jpjglo-1 
    319          DO jj = mj0(jbdy1), mj1(jbdy2) 
    320             zub(:,jj) = 0._wp 
    321             DO jk = 1, jpkm1 
    322                DO ji = 1, jpi 
    323                   zub(ji,jj) = zub(ji,jj) &  
    324                      & + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 
    325                END DO 
    326             END DO 
    327             DO ji = 1, jpi 
    328                zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a) 
    329             END DO 
    330                 
    331             DO jk = 1, jpkm1 
    332                DO ji = 1, jpi 
    333                   uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) &  
    334                     & + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk) 
    335                END DO 
    336             END DO 
    337          END DO 
     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 
     326               END DO 
     327            END DO 
     328         ENDIF 
     329         ! 
    338330      ENDIF 
    339331      ! 
    … …  
    354346      ! 
    355347      !--- West ---! 
    356       istart = 2 
    357       iend   = nbghostcells+1 
    358       DO ji = mi0(istart), mi1(iend) 
    359          DO jj=1,jpj 
    360             va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj) 
    361             ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj) 
    362          END DO 
    363       END DO 
     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 
    364358      ! 
    365359      !--- East ---! 
    366       istart = jpiglo-nbghostcells 
    367       iend   = jpiglo-1 
    368       DO ji = mi0(istart), mi1(iend) 
    369          DO jj=1,jpj 
    370             va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj) 
    371          END DO 
    372       END DO 
    373       istart = jpiglo-nbghostcells-1 
    374       iend   = jpiglo-2 
    375       DO ji = mi0(istart), mi1(iend) 
    376          DO jj=1,jpj 
    377             ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj) 
    378          END DO 
    379       END DO 
     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  
    380377      ! 
    381378      !--- South ---! 
    382       jstart = 2 
    383       jend   = nbghostcells+1 
    384       DO jj = mj0(jstart), mj1(jend) 
    385          DO ji=1,jpi 
    386             ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj) 
    387             va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj) 
    388          END DO 
    389       END DO 
     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        
    390390      ! 
    391391      !--- North ---! 
    392       jstart = jpjglo-nbghostcells 
    393       jend   = jpjglo-1 
    394       DO jj = mj0(jstart), mj1(jend) 
    395          DO ji=1,jpi 
    396             ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj) 
    397          END DO 
    398       END DO 
    399       jstart = jpjglo-nbghostcells-1 
    400       jend   = jpjglo-2 
    401       DO jj = mj0(jstart), mj1(jend) 
    402          DO ji=1,jpi 
    403             va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj) 
    404          END DO 
    405       END DO 
     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  
    406408      ! 
    407409   END SUBROUTINE Agrif_dyn_ts 
    408410 
     411    
    409412   SUBROUTINE Agrif_dyn_ts_flux( jn, zu, zv ) 
    410413      !!---------------------------------------------------------------------- 
    … …  
    421424      ! 
    422425      !--- West ---! 
    423       istart = 2 
    424       iend   = nbghostcells+1 
    425       DO ji = mi0(istart), mi1(iend) 
    426          DO jj=1,jpj 
    427             zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj) 
    428             zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj) 
    429          END DO 
    430       END DO 
     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 
    431436      ! 
    432437      !--- East ---! 
    433       istart = jpiglo-nbghostcells 
    434       iend   = jpiglo-1 
    435       DO ji = mi0(istart), mi1(iend) 
    436          DO jj=1,jpj 
    437             zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj) 
    438          END DO 
    439       END DO 
    440       istart = jpiglo-nbghostcells-1 
    441       iend   = jpiglo-2 
    442       DO ji = mi0(istart), mi1(iend) 
    443          DO jj=1,jpj 
    444             zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj) 
    445          END DO 
    446       END DO 
     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 
    447454      ! 
    448455      !--- South ---! 
    449       jstart = 2 
    450       jend   = nbghostcells+1 
    451       DO jj = mj0(jstart), mj1(jend) 
    452          DO ji=1,jpi 
    453             zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj) 
    454             zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj) 
    455          END DO 
    456       END DO 
     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 
    457466      ! 
    458467      !--- North ---! 
    459       jstart = jpjglo-nbghostcells 
    460       jend   = jpjglo-1 
    461       DO jj = mj0(jstart), mj1(jend) 
    462          DO ji=1,jpi 
    463             zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj) 
    464          END DO 
    465       END DO 
    466       jstart = jpjglo-nbghostcells-1 
    467       jend   = jpjglo-2 
    468       DO jj = mj0(jstart), mj1(jend) 
    469          DO ji=1,jpi 
    470             zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj) 
    471          END DO 
    472       END DO 
     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 
    473484      ! 
    474485   END SUBROUTINE Agrif_dyn_ts_flux 
    475486 
     487    
    476488   SUBROUTINE Agrif_dta_ts( kt ) 
    477489      !!---------------------------------------------------------------------- 
    … …  
    494506      Agrif_SpecialValue = 0._wp 
    495507      Agrif_UseSpecialValue = ln_spc_dyn 
     508 
     509      use_sign_north = .TRUE. 
     510      sign_north = -1. 
     511 
    496512      ! 
    497513      ! Set bdy time interpolation stage to 0 (latter incremented locally do deal with corners) 
    … …  
    518534      ENDIF 
    519535      Agrif_UseSpecialValue = .FALSE. 
     536      use_sign_north = .FALSE. 
    520537      !  
    521538   END SUBROUTINE Agrif_dta_ts 
    … …  
    542559      ! 
    543560      ! --- West --- ! 
    544       istart = 2 
    545       iend   = 1 + nbghostcells 
    546       DO ji = mi0(istart), mi1(iend) 
    547          DO jj = 1, jpj 
    548             ssh(ji,jj,Krhs_a) = hbdy(ji,jj) 
    549          ENDDO 
    550       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 
     569      ENDIF 
    551570      ! 
    552571      ! --- East --- ! 
    553       istart = jpiglo - nbghostcells 
    554       iend   = jpiglo - 1 
    555       DO ji = mi0(istart), mi1(iend) 
    556          DO jj = 1, jpj 
    557             ssh(ji,jj,Krhs_a) = hbdy(ji,jj) 
    558          ENDDO 
    559       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 
     580      ENDIF 
    560581      ! 
    561582      ! --- South --- ! 
    562       jstart = 2 
    563       jend   = 1 + nbghostcells 
    564       DO jj = mj0(jstart), mj1(jend) 
    565          DO ji = 1, jpi 
    566             ssh(ji,jj,Krhs_a) = hbdy(ji,jj) 
    567          ENDDO 
    568       ENDDO 
     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) 
     587            DO ji = 1, jpi 
     588               ssh(ji,jj,Krhs_a) = hbdy(ji,jj) 
     589            END DO 
     590         END DO 
     591      ENDIF 
    569592      ! 
    570593      ! --- North --- ! 
    571       jstart = jpjglo - nbghostcells 
    572       jend   = jpjglo - 1 
    573       DO jj = mj0(jstart), mj1(jend) 
    574          DO ji = 1, jpi 
    575             ssh(ji,jj,Krhs_a) = hbdy(ji,jj) 
    576          ENDDO 
    577       ENDDO 
     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) 
     598            DO ji = 1, jpi 
     599               ssh(ji,jj,Krhs_a) = hbdy(ji,jj) 
     600            END DO 
     601         END DO 
     602      ENDIF 
    578603      ! 
    579604   END SUBROUTINE Agrif_ssh 
    … …  
    593618      ! 
    594619      ! --- West --- ! 
    595       istart = 2 
    596       iend   = 1+nbghostcells 
    597       DO ji = mi0(istart), mi1(iend) 
    598          DO jj = 1, jpj 
    599             ssha_e(ji,jj) = hbdy(ji,jj) 
    600          ENDDO 
    601       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 
     628      ENDIF 
    602629      ! 
    603630      ! --- East --- ! 
    604       istart = jpiglo - nbghostcells 
    605       iend   = jpiglo - 1 
    606       DO ji = mi0(istart), mi1(iend) 
    607          DO jj = 1, jpj 
    608             ssha_e(ji,jj) = hbdy(ji,jj) 
    609          ENDDO 
    610       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 
     639      ENDIF 
    611640      ! 
    612641      ! --- South --- ! 
    613       jstart = 2 
    614       jend   = 1+nbghostcells 
    615       DO jj = mj0(jstart), mj1(jend) 
    616          DO ji = 1, jpi 
    617             ssha_e(ji,jj) = hbdy(ji,jj) 
    618          ENDDO 
    619       ENDDO 
     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) 
     646            DO ji = 1, jpi 
     647               ssha_e(ji,jj) = hbdy(ji,jj) 
     648            END DO 
     649         END DO 
     650      ENDIF 
    620651      ! 
    621652      ! --- North --- ! 
    622       jstart = jpjglo - nbghostcells 
    623       jend   = jpjglo - 1 
    624       DO jj = mj0(jstart), mj1(jend) 
    625          DO ji = 1, jpi 
    626             ssha_e(ji,jj) = hbdy(ji,jj) 
    627          ENDDO 
    628       ENDDO 
     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) 
     657            DO ji = 1, jpi 
     658               ssha_e(ji,jj) = hbdy(ji,jj) 
     659            END DO 
     660         END DO 
     661      ENDIF 
    629662      ! 
    630663   END SUBROUTINE Agrif_ssh_ts 
    631664 
     665    
    632666   SUBROUTINE Agrif_avm 
    633667      !!---------------------------------------------------------------------- 
    … …  
    650684      ! 
    651685   END SUBROUTINE Agrif_avm 
    652     
     686 
    653687 
    654688   SUBROUTINE interptsn( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before ) 
    … …  
    662696      INTEGER  ::   ji, jj, jk, jn  ! dummy loop indices 
    663697      INTEGER  ::   N_in, N_out 
     698      INTEGER  :: item 
    664699      ! vertical interpolation: 
    665700      REAL(wp) :: zhtot 
    666701      REAL(wp), DIMENSION(k1:k2,1:jpts) :: tabin 
    667       REAL(wp), DIMENSION(k1:k2) :: h_in 
    668       REAL(wp), DIMENSION(1:jpk) :: h_out 
    669       !!---------------------------------------------------------------------- 
    670  
    671       IF( before ) THEN          
     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 
    672711         DO jn = 1,jpts 
    673712            DO jk=k1,k2 
    … …  
    678717              END DO 
    679718           END DO 
    680         END DO 
    681  
    682 # if defined key_vertical 
    683         ! Interpolate thicknesses 
    684         ! Warning: these are masked, hence extrapolated prior interpolation. 
    685         DO jk=k1,k2 
    686            DO jj=j1,j2 
    687               DO ji=i1,i2 
    688                   ptab(ji,jj,jk,jpts+1) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kmm_a) 
    689               END DO 
    690            END DO 
    691         END DO 
    692  
    693         ! Extrapolate thicknesses in partial bottom cells: 
    694         ! Set them to Agrif_SpecialValue (0.). Correct bottom thicknesses are retrieved later on 
    695         IF (ln_zps) THEN 
    696            DO jj=j1,j2 
    697               DO ji=i1,i2 
    698                   jk = mbkt(ji,jj) 
    699                   ptab(ji,jj,jk,jpts+1) = 0._wp 
    700               END DO 
    701            END DO            
    702         END IF 
    703       
    704         ! Save ssh at last level: 
    705         IF (.NOT.ln_linssh) THEN 
    706            ptab(i1:i2,j1:j2,k2,jpts+1) = ssh(i1:i2,j1:j2,Kmm_a)*tmask(i1:i2,j1:j2,1)  
    707         ELSE 
    708            ptab(i1:i2,j1:j2,k2,jpts+1) = 0._wp 
    709         END IF       
    710 # 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 
    711753      ELSE  
    712  
    713 # if defined key_vertical  
    714          IF (ln_linssh) ptab(i1:i2,j1:j2,k2,n2) = 0._wp  
    715              
    716          DO jj=j1,j2 
    717             DO ji=i1,i2 
    718                ts(ji,jj,:,:,Krhs_a) = 0._wp 
    719                N_in = mbkt_parent(ji,jj) 
    720                zhtot = 0._wp 
    721                DO jk=1,N_in !k2 = jpk of parent grid 
    722                   IF (jk==N_in) THEN 
    723                      h_in(jk) = ht0_parent(ji,jj) + ptab(ji,jj,k2,n2) - zhtot 
    724                   ELSE 
    725                      h_in(jk) = ptab(ji,jj,jk,n2) 
     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 
    726800                  ENDIF 
    727                   zhtot = zhtot + h_in(jk) 
    728                   tabin(jk,:) = ptab(ji,jj,jk,n1:n2-1) 
    729                END DO 
    730                N_out = 0 
    731                DO jk=1,jpk ! jpk of child grid 
    732                   IF (tmask(ji,jj,jk) == 0._wp) EXIT  
    733                   N_out = N_out + 1 
    734                   h_out(jk) = e3t(ji,jj,jk,Krhs_a) 
    735                ENDDO 
    736                IF (N_in*N_out > 0) THEN 
    737                   CALL reconstructandremap(tabin(1:N_in,1:jpts),h_in(1:N_in),ts(ji,jj,1:N_out,1:jpts,Krhs_a),h_out(1:N_out),N_in,N_out,jpts) 
    738                ENDIF 
    739             ENDDO 
    740          ENDDO 
    741 # else 
    742          ! 
    743          DO jn=1, jpts 
    744             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)  
    745          END DO 
    746 # 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 
     810         ENDIF 
    747811 
    748812      ENDIF 
    … …  
    750814   END SUBROUTINE interptsn 
    751815 
     816    
    752817   SUBROUTINE interpsshn( ptab, i1, i2, j1, j2, before ) 
    753818      !!---------------------------------------------------------------------- 
    … …  
    768833   END SUBROUTINE interpsshn 
    769834 
     835    
    770836   SUBROUTINE interpun( ptab, i1, i2, j1, j2, k1, k2, m1, m2, before ) 
    771837      !!---------------------------------------------------------------------- 
    … …  
    780846      REAL(wp) :: zrhoy, zhtot 
    781847      ! vertical interpolation: 
    782       REAL(wp), DIMENSION(k1:k2) :: tabin, h_in 
    783       REAL(wp), DIMENSION(1:jpk) :: h_out 
    784       INTEGER  :: N_in, N_out 
     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 
    785851      REAL(wp) :: h_diff 
    786852      !!---------------------------------------------     
    787853      ! 
    788854      IF (before) THEN  
     855 
     856         item = Kmm_a 
     857         IF( l_ini_child )   Kmm_a = Kbb_a      
     858 
    789859         DO jk=1,jpk 
    790860            DO jj=j1,j2 
    791861               DO ji=i1,i2 
    792862                  ptab(ji,jj,jk,1) = (e2u(ji,jj) * e3u(ji,jj,jk,Kmm_a) * uu(ji,jj,jk,Kmm_a)*umask(ji,jj,jk))  
    793 # if defined key_vertical 
    794                   ! Interpolate thicknesses (masked for subsequent extrapolation) 
    795                   ptab(ji,jj,jk,2) = umask(ji,jj,jk) * e2u(ji,jj) * e3u(ji,jj,jk,Kmm_a) 
    796 # endif 
    797                END DO 
    798             END DO 
    799          END DO 
    800 # if defined key_vertical 
     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 
    801872         ! Extrapolate thicknesses in partial bottom cells: 
    802873         ! Set them to Agrif_SpecialValue (0.). Correct bottom thicknesses are retrieved later on 
    803          IF (ln_zps) THEN 
    804             DO jj=j1,j2 
    805                DO ji=i1,i2 
    806                   jk = mbku(ji,jj) 
    807                   ptab(ji,jj,jk,2) = 0._wp 
    808                END DO 
    809             END DO            
    810          END IF 
    811         ! Save ssh at last level: 
    812         ptab(i1:i2,j1:j2,k2,2) = 0._wp 
    813         IF (.NOT.ln_linssh) THEN 
    814            ! This vertical sum below should be replaced by the sea-level at U-points (optimization): 
    815            DO jk=1,jpk 
    816               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) 
    817            END DO 
    818            ptab(i1:i2,j1:j2,k2,2) = ptab(i1:i2,j1:j2,k2,2) - hu_0(i1:i2,j1:j2) 
    819         END IF  
    820 # endif 
     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 
    821895         ! 
    822896      ELSE 
    823897         zrhoy = Agrif_rhoy() 
    824 # if defined key_vertical 
     898 
     899        IF( l_vremap .OR. l_ini_child) THEN 
    825900! VERTICAL REFINEMENT BEGIN 
    826901 
    827          IF (ln_linssh) ptab(i1:i2,j1:j2,k2,2) = 0._wp  
    828  
    829          DO ji=i1,i2 
    830             DO jj=j1,j2 
    831                uu(ji,jj,:,Krhs_a) = 0._wp 
    832                N_in = mbku_parent(ji,jj) 
    833                zhtot = 0._wp 
    834                DO jk=1,N_in 
    835                   IF (jk==N_in) THEN 
    836                      h_in(jk) = hu0_parent(ji,jj) + ptab(ji,jj,k2,2) - zhtot 
    837                   ELSE 
    838                      h_in(jk) = ptab(ji,jj,jk,2)/(e2u(ji,jj)*zrhoy)  
    839                   ENDIF 
    840                   zhtot = zhtot + h_in(jk) 
    841                   tabin(jk) = ptab(ji,jj,jk,1)/(e2u(ji,jj)*zrhoy*h_in(jk)) 
    842               ENDDO 
    843                    
    844               N_out = 0 
    845               DO jk=1,jpk 
    846                  if (umask(ji,jj,jk) == 0) EXIT 
    847                  N_out = N_out + 1 
    848                  h_out(N_out) = e3u(ji,jj,jk,Krhs_a) 
    849               ENDDO 
    850               IF (N_in*N_out > 0) THEN 
    851                  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) 
    852               ENDIF 
    853             ENDDO 
    854          ENDDO 
    855  
    856 # else 
    857          DO jk = 1, jpkm1 
    858             DO jj=j1,j2 
    859                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) ) 
    860             END DO 
    861          END DO 
    862 # endif 
     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 
    863955 
    864956      ENDIF 
    … …  
    866958   END SUBROUTINE interpun 
    867959 
     960    
    868961   SUBROUTINE interpvn( ptab, i1, i2, j1, j2, k1, k2, m1, m2, before ) 
    869962      !!---------------------------------------------------------------------- 
    … …  
    878971      REAL(wp) :: zrhox 
    879972      ! vertical interpolation: 
    880       REAL(wp), DIMENSION(k1:k2) :: tabin, h_in 
    881       REAL(wp), DIMENSION(1:jpk) :: h_out 
    882       INTEGER  :: N_in, N_out 
     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 
    883976      REAL(wp) :: h_diff, zhtot 
    884977      !!---------------------------------------------     
    885978      !       
    886       IF (before) THEN           
     979      IF (before) THEN    
     980 
     981         item = Kmm_a 
     982         IF( l_ini_child )   Kmm_a = Kbb_a      
     983        
    887984         DO jk=k1,k2 
    888985            DO jj=j1,j2 
    889986               DO ji=i1,i2 
    890987                  ptab(ji,jj,jk,1) = (e1v(ji,jj) * e3v(ji,jj,jk,Kmm_a) * vv(ji,jj,jk,Kmm_a)*vmask(ji,jj,jk)) 
    891 # if defined key_vertical 
    892                   ! Interpolate thicknesses (masked for subsequent extrapolation) 
    893                   ptab(ji,jj,jk,2) = vmask(ji,jj,jk) * e1v(ji,jj) * e3v(ji,jj,jk,Kmm_a) 
    894 # endif 
    895                END DO 
    896             END DO 
    897          END DO 
    898 # if defined key_vertical 
     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 
    899997         ! Extrapolate thicknesses in partial bottom cells: 
    900998         ! Set them to Agrif_SpecialValue (0.). Correct bottom thicknesses are retrieved later on 
    901          IF (ln_zps) THEN 
     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 
     1019      ELSE        
     1020         zrhox = Agrif_rhox() 
     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 
    9021026            DO jj=j1,j2 
    9031027               DO ji=i1,i2 
    904                   jk = mbkv(ji,jj) 
    905                   ptab(ji,jj,jk,2) = 0._wp 
    906                END DO 
    907             END DO            
    908          END IF 
    909         ! Save ssh at last level: 
    910         ptab(i1:i2,j1:j2,k2,2) = 0._wp 
    911         IF (.NOT.ln_linssh) THEN 
    912            ! This vertical sum below should be replaced by the sea-level at V-points (optimization): 
    913            DO jk=1,jpk 
    914               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) 
    915            END DO 
    916            ptab(i1:i2,j1:j2,k2,2) = ptab(i1:i2,j1:j2,k2,2) - hv_0(i1:i2,j1:j2) 
    917         END IF  
    918 # endif 
    919       ELSE        
    920          zrhox = Agrif_rhox() 
    921 # if defined key_vertical 
    922  
    923          IF (ln_linssh) ptab(i1:i2,j1:j2,k2,2) = 0._wp  
    924  
    925          DO jj=j1,j2 
    926             DO ji=i1,i2 
    927                vv(ji,jj,:,Krhs_a) = 0._wp 
    928                N_in = mbkv_parent(ji,jj) 
    929                zhtot = 0._wp 
    930                DO jk=1,N_in 
    931                   IF (jk==N_in) THEN 
    932                      h_in(jk) = hv0_parent(ji,jj) + ptab(ji,jj,k2,2) - zhtot 
    933                   ELSE 
    934                      h_in(jk) = ptab(ji,jj,jk,2)/(e1v(ji,jj)*zrhox)  
     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    
    9351068                  ENDIF 
    936                   zhtot = zhtot + h_in(jk) 
    937                   tabin(jk) = ptab(ji,jj,jk,1)/(e1v(ji,jj)*zrhox*h_in(jk)) 
    938               ENDDO 
    939           
    940                N_out = 0 
    941                DO jk=1,jpk 
    942                   if (vmask(ji,jj,jk) == 0) EXIT 
    943                   N_out = N_out + 1 
    944                   h_out(N_out) = e3v(ji,jj,jk,Krhs_a) 
    945                END DO 
    946                IF (N_in*N_out > 0) THEN 
    947                   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) 
    948                ENDIF 
    949             END DO 
    950          END DO 
    951 # else 
    952          DO jk = 1, jpkm1 
    953             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) ) 
    954          END DO 
    955 # 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 
    9561076      ENDIF 
    9571077      !         
    … …  
    11521272                     WRITE(numout,*) ' Agrif error for e3t_0: parent , child, i, j, k ',  &  
    11531273                     &                 ptab(ji,jj,jk), tmask(ji,jj,jk) * e3t_0(ji,jj,jk), & 
    1154                      &                 ji+nimpp-1, jj+njmpp-1, jk 
    1155                      kindic_agr = kindic_agr + 1 
     1274                     &                 mig0(ji), mig0(jj), jk 
     1275                !     kindic_agr = kindic_agr + 1 
    11561276                  ENDIF 
    11571277               END DO 
    … …  
    11621282      !  
    11631283   END SUBROUTINE interpe3t 
     1284 
     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 
     1295      !!----------------------------------------------------------------------   
     1296      !     
     1297      IF( before ) THEN 
     1298         ptab(i1:i2,j1:j2) = glamt(i1:i2,j1:j2) 
     1299      ELSE 
     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 
     1309      ENDIF 
     1310      !  
     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 
     1324      !!----------------------------------------------------------------------   
     1325      !     
     1326      IF( before ) THEN 
     1327         ptab(i1:i2,j1:j2) = gphit(i1:i2,j1:j2) 
     1328      ELSE 
     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 
     1338      ENDIF 
     1339      !  
     1340   END SUBROUTINE interpgphit 
    11641341 
    11651342 
    … …  
    11851362              END DO 
    11861363           END DO 
    1187         END DO 
    1188  
    1189 # if defined key_vertical 
    1190         ! Interpolate thicknesses 
    1191         ! Warning: these are masked, hence extrapolated prior interpolation. 
    1192         DO jk=k1,k2 
    1193            DO jj=j1,j2 
    1194               DO ji=i1,i2 
    1195                   ptab(ji,jj,jk,2) = tmask(ji,jj,jk) * e3t(ji,jj,jk,Kmm_a) 
    1196               END DO 
    1197            END DO 
    1198         END DO 
    1199  
    1200         ! Extrapolate thicknesses in partial bottom cells: 
    1201         ! Set them to Agrif_SpecialValue (0.). Correct bottom thicknesses are retrieved later on 
    1202         IF (ln_zps) THEN 
    1203            DO jj=j1,j2 
    1204               DO ji=i1,i2 
    1205                   jk = mbkt(ji,jj) 
    1206                   ptab(ji,jj,jk,2) = 0._wp 
    1207               END DO 
    1208            END DO            
    1209         END IF 
    1210       
    1211         ! Save ssh at last level: 
    1212         IF (.NOT.ln_linssh) THEN 
    1213            ptab(i1:i2,j1:j2,k2,2) = ssh(i1:i2,j1:j2,Kmm_a)*tmask(i1:i2,j1:j2,1)  
    1214         ELSE 
    1215            ptab(i1:i2,j1:j2,k2,2) = 0._wp 
    1216         END IF       
    1217 # 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 
    12181396      ELSE  
    1219 #ifdef key_vertical          
    1220          IF (ln_linssh) ptab(i1:i2,j1:j2,k2,2) = 0._wp  
    1221          avm_k(i1:i2,j1:j2,k1:k2) = 0._wp 
    1222              
    1223          DO jj = j1, j2 
    1224             DO ji =i1, i2 
    1225                N_in = mbkt_parent(ji,jj) 
    1226                IF ( tmask(ji,jj,1) == 0._wp) N_in = 0 
    1227                z_in(N_in+1) = ht0_parent(ji,jj) + ptab(ji,jj,k2,2) 
    1228                DO jk = N_in, 1, -1  ! Parent vertical grid                
    1229                      z_in(jk) = z_in(jk+1) - ptab(ji,jj,jk,2) 
    1230                     tabin(jk) = ptab(ji,jj,jk,1) 
    1231                END DO 
    1232                N_out = mbkt(ji,jj)  
    1233                DO jk = 1, N_out        ! Child vertical grid 
    1234                   z_out(jk) = gdepw(ji,jj,jk,Kmm_a) 
    1235                ENDDO 
    1236                IF (N_in*N_out > 0) THEN 
    1237                   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) 
    1238                ENDIF 
    1239             ENDDO 
    1240          ENDDO 
    1241 #else 
    1242          avm_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2,1) 
    1243 #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 
    12441423      ENDIF 
    12451424      ! 
    12461425   END SUBROUTINE interpavm 
    12471426 
    1248 # if defined key_vertical 
     1427    
    12491428   SUBROUTINE interpmbkt( ptab, i1, i2, j1, j2, before ) 
    12501429      !!---------------------------------------------------------------------- 
    … …  
    12651444   END SUBROUTINE interpmbkt 
    12661445 
     1446    
    12671447   SUBROUTINE interpht0( ptab, i1, i2, j1, j2, before ) 
    12681448      !!---------------------------------------------------------------------- 
    … …  
    12821462      ! 
    12831463   END SUBROUTINE interpht0 
    1284 #endif 
    1285  
     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    
    12861503#else 
    12871504   !!---------------------------------------------------------------------- 
Note: See TracChangeset for help on using the changeset viewer.