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 13229 for NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/NST – NEMO

Ignore:
Timestamp:
2020-07-02T17:33:41+02:00 (4 years ago)
Author:
francesca
Message:

dev_r12558_HPC-08_epico_Extra_Halo: merge with trunk@13218, see #2366

Location:
NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/NST
Files:
9 edited

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/NST/agrif_ice.F90

    r10068 r13229  
    1616 
    1717   INTEGER, PUBLIC ::  u_ice_id, v_ice_id, tra_ice_id 
     18   INTEGER, PUBLIC ::  u_iceini_id, v_iceini_id, tra_iceini_id 
    1819   INTEGER, PUBLIC ::  nbstep_ice = 0    ! child time position in sea-ice model 
    1920 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/NST/agrif_ice_interp.F90

    r12807 r13229  
    1414   !!---------------------------------------------------------------------- 
    1515   !!  agrif_interp_ice    : interpolation of ice at "after" sea-ice time step 
    16    !!  agrif_interp_u_ice   : atomic routine to interpolate u_ice  
    17    !!  agrif_interp_v_ice   : atomic routine to interpolate v_ice  
    18    !!  agrif_interp_tra_ice : atomic routine to interpolate ice properties  
     16   !!  interp_u_ice   : atomic routine to interpolate u_ice  
     17   !!  interp_v_ice   : atomic routine to interpolate v_ice  
     18   !!  interp_tra_ice : atomic routine to interpolate ice properties  
    1919   !!---------------------------------------------------------------------- 
    2020   USE par_oce 
    … …  
    2323   USE ice 
    2424   USE agrif_ice 
     25   USE agrif_oce 
    2526   USE phycst , ONLY: rt0 
    2627    
    … …  
    2930 
    3031   PUBLIC   agrif_interp_ice   ! called by agrif_user.F90 
     32   PUBLIC   interp_tra_ice, interp_u_ice, interp_v_ice  ! called by iceistate.F90 
    3133 
    3234   !!---------------------------------------------------------------------- 
    … …  
    6870      Agrif_SpecialValue    = -9999. 
    6971      Agrif_UseSpecialValue = .TRUE. 
     72 
     73      use_sign_north = .TRUE. 
     74      sign_north = -1. 
     75      if (cd_type == 'T') use_sign_north = .FALSE. 
     76 
    7077      SELECT CASE( cd_type ) 
    7178      CASE('U')   ;   CALL Agrif_Bc_variable( u_ice_id  , procname=interp_u_ice  , calledweight=zbeta ) 
    … …  
    7582      Agrif_SpecialValue    = 0._wp 
    7683      Agrif_UseSpecialValue = .FALSE. 
     84       
     85      use_sign_north = .FALSE. 
    7786      ! 
    7887   END SUBROUTINE agrif_interp_ice 
    … …  
    156165      ! and it is ok since we conserve tracers (same as in the ocean). 
    157166      ALLOCATE( ztab(SIZE(a_i,1),SIZE(a_i,2),SIZE(ptab,3)) ) 
    158       
     167 
    159168      IF( before ) THEN  ! parent grid 
    160169         jm = 1 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/NST/agrif_ice_update.F90

    r12377 r13229  
    6666      CALL Agrif_Update_Variable( tra_ice_id , locupdate=(/1,0/), procname = update_tra_ice  ) 
    6767#endif 
     68      use_sign_north = .TRUE. 
     69      sign_north = -1. 
     70 
    6871# if ! defined DECAL_FEEDBACK 
    6972      CALL Agrif_Update_Variable( u_ice_id   , procname = update_u_ice    ) 
    … …  
    7376      CALL Agrif_Update_Variable( v_ice_id   , locupdate1=(/1,-2/),locupdate2=(/0,-1/),procname=update_v_ice) 
    7477#endif 
     78      use_sign_north = .FALSE. 
    7579!      CALL Agrif_Update_Variable( tra_ice_id , locupdate=(/0,2/), procname = update_tra_ice  ) 
    7680!      CALL Agrif_Update_Variable( u_ice_id   , locupdate=(/0,1/), procname = update_u_ice    ) 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/NST/agrif_oce.F90

    r13065 r13229  
    1919   
    2020   !                                              !!* Namelist namagrif: AGRIF parameters 
     21   LOGICAL , PUBLIC ::   ln_init_chfrpar = .FALSE. !: set child grids initial state from parent 
    2122   LOGICAL , PUBLIC ::   ln_agrif_2way = .TRUE.    !: activate two way nesting  
    2223   LOGICAL , PUBLIC ::   ln_spc_dyn    = .FALSE.   !: use zeros (.false.) or not (.true.) in 
    … …  
    2930   ! 
    3031   INTEGER , PUBLIC, PARAMETER ::   nn_sponge_len = 2  !: Sponge width (in number of parent grid points) 
     32 
    3133   LOGICAL , PUBLIC :: spongedoneT = .FALSE.       !: tracer   sponge layer indicator 
    3234   LOGICAL , PUBLIC :: spongedoneU = .FALSE.       !: dynamics sponge layer indicator 
    … …  
    4951   INTEGER , PUBLIC,              SAVE                 ::  Kbb_a, Kmm_a, Krhs_a   !: AGRIF module-specific copies of time-level indices 
    5052 
    51 # if defined key_vertical 
    5253   REAL(wp), PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: ht0_parent, hu0_parent, hv0_parent 
    5354   INTEGER,  PUBLIC, ALLOCATABLE, SAVE, DIMENSION(:,:) :: mbkt_parent, mbku_parent, mbkv_parent 
    54 # endif 
    5555 
    5656   INTEGER, PUBLIC :: tsn_id                                                  ! AGRIF profile for tracers interpolation and update 
    … …  
    5858   INTEGER, PUBLIC :: un_update_id, vn_update_id                              ! AGRIF profiles for udpates 
    5959   INTEGER, PUBLIC :: tsn_sponge_id, un_sponge_id, vn_sponge_id               ! AGRIF profiles for sponge layers 
     60   INTEGER, PUBLIC :: tsini_id, uini_id, vini_id, sshini_id                   ! AGRIF profile for initialization 
    6061# if defined key_top 
    6162   INTEGER, PUBLIC :: trn_id, trn_sponge_id 
    … …  
    6970   INTEGER, PUBLIC :: glamt_id, gphit_id 
    7071   INTEGER, PUBLIC :: kindic_agr 
     72 
     73   ! North fold 
     74!$AGRIF_DO_NOT_TREAT 
     75   LOGICAL, PUBLIC :: use_sign_north 
     76   REAL, PUBLIC :: sign_north 
     77   LOGICAL, PUBLIC :: l_ini_child = .FALSE. 
     78# if defined key_vertical 
     79   LOGICAL, PUBLIC :: l_vremap    = .TRUE. 
     80# else 
     81   LOGICAL, PUBLIC :: l_vremap    = .FALSE. 
     82# endif 
     83!$AGRIF_END_DO_NOT_TREAT 
    7184    
    7285   !!---------------------------------------------------------------------- 
    … …  
    92105         &      tabspongedone_trn(jpi,jpj),           & 
    93106# endif    
    94 # if defined key_vertical 
    95107         &      ht0_parent(jpi,jpj), mbkt_parent(jpi,jpj),  & 
    96108         &      hu0_parent(jpi,jpj), mbku_parent(jpi,jpj),  & 
    97109         &      hv0_parent(jpi,jpj), mbkv_parent(jpi,jpj),  & 
    98 # endif       
    99110         &      tabspongedone_u  (jpi,jpj),           & 
    100111         &      tabspongedone_v  (jpi,jpj), STAT = ierr(1) ) 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/NST/agrif_oce_interp.F90

    r13130 r13229  
    9595      ! 
    9696      ! --- West --- ! 
    97       ibdy1 = nn_hls + 2                  ! halo + land + 1 
    98       ibdy2 = nn_hls + 1 + nbghostcells   ! halo + land + nbghostcells 
    99       ! 
    100       IF( .NOT.ln_dynspg_ts ) THEN  ! Store tangential transport 
     97      IF( lk_west ) THEN 
     98         ibdy1 = nn_hls + 2                  ! halo + land + 1 
     99         ibdy2 = nn_hls + 1 + nbghostcells   ! halo + land + nbghostcells 
     100         ! 
     101         IF( .NOT.ln_dynspg_ts ) THEN  ! Store tangential transport 
     102            DO ji = mi0(ibdy1), mi1(ibdy2) 
     103               uu_b(ji,:,Krhs_a) = 0._wp 
     104 
     105               DO jk = 1, jpkm1 
     106                  DO jj = 1, jpj 
     107                     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) 
     108                  END DO 
     109               END DO 
     110 
     111               DO jj = 1, jpj 
     112                  uu_b(ji,jj,Krhs_a) = uu_b(ji,jj,Krhs_a) * r1_hu(ji,jj,Krhs_a) 
     113               END DO 
     114            END DO 
     115         ENDIF 
     116         ! 
    101117         DO ji = mi0(ibdy1), mi1(ibdy2) 
    102             uu_b(ji,:,Krhs_a) = 0._wp 
    103  
     118            zub(ji,:) = 0._wp    ! Correct tangential transport 
    104119            DO jk = 1, jpkm1 
    105120               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 tangential 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 
     121                  zub(ji,jj) = zub(ji,jj) &  
     122                     & + e3u(ji,jj,jk,Krhs_a)  * uu(ji,jj,jk,Krhs_a)*umask(ji,jj,jk) 
     123               END DO 
     124            END DO 
     125            DO jj=1,jpj 
     126               zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a) 
     127            END DO 
    127128             
    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 
    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      ENDIF 
     155 
     156      ! --- East --- ! 
     157      IF( lk_east ) THEN 
     158         ibdy1 = jpiglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
     159         ibdy2 = jpiglo - ( nn_hls + 2 )                 ! halo + land + 1 
     160         ! 
     161         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
     162            DO ji = mi0(ibdy1), mi1(ibdy2) 
     163               uu_b(ji,:,Krhs_a) = 0._wp 
     164               DO jk = 1, jpkm1 
     165                  DO jj = 1, jpj 
     166                     uu_b(ji,jj,Krhs_a) = uu_b(ji,jj,Krhs_a) &  
     167                         & + 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 - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
    156       ibdy2 = jpiglo - ( nn_hls + 2 )                 ! halo + land + 1 
    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) &  
     181                     & + e3u(ji,jj,jk,Krhs_a)  * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 
     182               END DO 
     183            END DO 
     184            DO jj=1,jpj 
     185               zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a) 
     186            END DO 
     187             
    161188            DO jk = 1, jpkm1 
    162189               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) 
     190                  uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) &  
     191                    & + uu_b(ji,jj,Krhs_a)-zub(ji,jj))*umask(ji,jj,jk) 
     192               END DO 
     193            END DO 
    183194         END DO 
    184195             
    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 - ( 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 
     196         IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate 
     197            ibdy1 = jpiglo - ( nn_hls + nbghostcells )   ! halo + land + nbghostcells - 1 
     198            ibdy2 = jpiglo - ( nn_hls + 1 )              ! halo + land + 1            - 1 
     199            DO ji = mi0(ibdy1), mi1(ibdy2) 
     200               zvb(ji,:) = 0._wp 
     201               DO jk = 1, jpkm1 
     202                  DO jj = 1, jpj 
     203                     zvb(ji,jj) = zvb(ji,jj) & 
     204                        & + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 
     205                  END DO 
     206               END DO 
    199207               DO jj = 1, jpj 
    200                   zvb(ji,jj) = zvb(ji,jj) & 
     208                  zvb(ji,jj) = zvb(ji,jj) * r1_hv(ji,jj,Krhs_a) 
     209               END DO 
     210               DO jk = 1, jpkm1 
     211                  DO jj = 1, jpj 
     212                     vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) &  
     213                         & + vv_b(ji,jj,Krhs_a)-zvb(ji,jj)) * vmask(ji,jj,jk) 
     214                  END DO 
     215               END DO 
     216            END DO 
     217         ENDIF 
     218      ENDIF 
     219 
     220      ! --- South --- ! 
     221      IF( lk_south ) THEN 
     222         jbdy1 = nn_hls + 2                  ! halo + land + 1 
     223         jbdy2 = nn_hls + 1 + nbghostcells   ! halo + land + nbghostcells 
     224         ! 
     225         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
     226            DO jj = mj0(jbdy1), mj1(jbdy2) 
     227               vv_b(:,jj,Krhs_a) = 0._wp 
     228               DO jk = 1, jpkm1 
     229                  DO ji = 1, jpi 
     230                     vv_b(ji,jj,Krhs_a) = vv_b(ji,jj,Krhs_a) &  
     231                         & + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 
     232                  END DO 
     233               END DO 
     234               DO ji=1,jpi 
     235                  vv_b(ji,jj,Krhs_a) = vv_b(ji,jj,Krhs_a) * r1_hv(ji,jj,Krhs_a)      
     236               END DO 
     237            END DO 
     238         ENDIF 
     239         ! 
     240         DO jj = mj0(jbdy1), mj1(jbdy2) 
     241            zvb(:,jj) = 0._wp    ! Correct transport 
     242            DO jk=1,jpkm1 
     243               DO ji=1,jpi 
     244                  zvb(ji,jj) = zvb(ji,jj) &  
    201245                     & + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 
    202246               END DO 
    203247            END DO 
    204             DO jj = 1, jpj 
     248            DO ji = 1, jpi 
    205249               zvb(ji,jj) = zvb(ji,jj) * r1_hv(ji,jj,Krhs_a) 
    206250            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 = nn_hls + 2                  ! halo + land + 1 
    218       jbdy2 = nn_hls + 1 + nbghostcells   ! halo + land + 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 
     251 
    223252            DO jk = 1, jpkm1 
    224253               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 
     254                  vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) &  
     255                    & + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) ) * vmask(ji,jj,jk) 
     256               END DO 
     257            END DO 
     258         END DO 
     259             
     260         IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate 
     261            DO jj = mj0(jbdy1), mj1(jbdy2) 
     262               zub(:,jj) = 0._wp 
     263               DO jk = 1, jpkm1 
     264                  DO ji = 1, jpi 
     265                     zub(ji,jj) = zub(ji,jj) &  
     266                        & + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 
     267                  END DO 
     268               END DO 
     269               DO ji = 1, jpi 
     270                  zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a) 
     271               END DO 
     272                
     273               DO jk = 1, jpkm1 
     274                  DO ji = 1, jpi 
     275                     uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) &  
     276                        & + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk) 
     277                  END DO 
     278               END DO 
     279            END DO 
     280         ENDIF 
     281      ENDIF 
     282 
     283      ! --- North --- ! 
     284      IF( lk_north ) THEN 
     285         jbdy1 = jpjglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
     286         jbdy2 = jpjglo - ( nn_hls + 2 )                 ! halo + land + 1 
     287         ! 
     288         IF( .NOT.ln_dynspg_ts ) THEN  ! Store transport 
     289            DO jj = mj0(jbdy1), mj1(jbdy2) 
     290               vv_b(:,jj,Krhs_a) = 0._wp 
     291               DO jk = 1, jpkm1 
     292                  DO ji = 1, jpi 
     293                     vv_b(ji,jj,Krhs_a) = vv_b(ji,jj,Krhs_a) &  
     294                         & + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 
     295                  END DO 
     296               END DO 
     297               DO ji=1,jpi 
     298                  vv_b(ji,jj,Krhs_a) = vv_b(ji,jj,Krhs_a) * r1_hv(ji,jj,Krhs_a) 
     299               END DO 
     300            END DO 
     301         ENDIF 
     302         ! 
     303         DO jj = mj0(jbdy1), mj1(jbdy2) 
     304            zvb(:,jj) = 0._wp    ! Correct transport 
     305            DO jk=1,jpkm1 
     306               DO ji=1,jpi 
     307                  zvb(ji,jj) = zvb(ji,jj) &  
     308                     & + e3v(ji,jj,jk,Krhs_a) * vv(ji,jj,jk,Krhs_a) * vmask(ji,jj,jk) 
     309               END DO 
     310            END DO 
    248311            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 
     312               zvb(ji,jj) = zvb(ji,jj) * r1_hv(ji,jj,Krhs_a) 
     313            END DO 
     314 
    258315            DO jk = 1, jpkm1 
    259316               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 
     317                  vv(ji,jj,jk,Krhs_a) = ( vv(ji,jj,jk,Krhs_a) &  
     318                     & + vv_b(ji,jj,Krhs_a) - zvb(ji,jj) ) * vmask(ji,jj,jk) 
     319               END DO 
     320            END DO 
     321         END DO 
     322             
     323         IF( ln_dynspg_ts ) THEN       ! Set tangential velocities to time splitting estimate 
     324            jbdy1 = jpjglo - ( nn_hls + nbghostcells )   ! halo + land + nbghostcells - 1 
     325            jbdy2 = jpjglo - ( nn_hls + 1 )              ! halo + land + 1            - 1 
     326            DO jj = mj0(jbdy1), mj1(jbdy2) 
     327               zub(:,jj) = 0._wp 
     328               DO jk = 1, jpkm1 
     329                  DO ji = 1, jpi 
     330                     zub(ji,jj) = zub(ji,jj) &  
     331                        & + e3u(ji,jj,jk,Krhs_a) * uu(ji,jj,jk,Krhs_a) * umask(ji,jj,jk) 
     332                  END DO 
     333               END DO 
     334               DO ji = 1, jpi 
     335                  zub(ji,jj) = zub(ji,jj) * r1_hu(ji,jj,Krhs_a) 
     336               END DO 
    267337                
    268             DO jk = 1, jpkm1 
    269                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 - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
    279       jbdy2 = jpjglo - ( nn_hls + 2 )                 ! halo + land + 1 
    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 - ( nn_hls + nbghostcells )   ! halo + land + nbghostcells - 1 
    318          jbdy2 = jpjglo - ( nn_hls + 1 )              ! halo + land + 1            - 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 
     338               DO jk = 1, jpkm1 
     339                  DO ji = 1, jpi 
     340                     uu(ji,jj,jk,Krhs_a) = ( uu(ji,jj,jk,Krhs_a) &  
     341                       & + uu_b(ji,jj,Krhs_a) - zub(ji,jj) ) * umask(ji,jj,jk) 
     342                  END DO 
     343               END DO 
     344            END DO 
     345         ENDIF 
    338346      ENDIF 
    339347      ! 
    … …  
    354362      ! 
    355363      !--- West ---! 
    356       istart = nn_hls + 2                              ! halo + land + 1 
    357       iend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    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 
     364      IF( lk_west ) THEN 
     365         istart = nn_hls + 2                              ! halo + land + 1 
     366         iend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
     367         DO ji = mi0(istart), mi1(iend) 
     368            DO jj=1,jpj 
     369               va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj) 
     370               ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj) 
     371            END DO 
     372         END DO 
     373      ENDIF 
    364374      ! 
    365375      !--- East ---! 
    366       istart = jpiglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
    367       iend   = jpiglo - ( nn_hls + 1 )                 ! halo + land + 1            - 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 - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
    374       iend   = jpiglo - ( nn_hls + 2 )                 ! halo + land + 1 
    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 
     376      IF( lk_east ) THEN 
     377         istart = jpiglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
     378         iend   = jpiglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1 
     379         DO ji = mi0(istart), mi1(iend) 
     380            DO jj=1,jpj 
     381               va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj) 
     382            END DO 
     383         END DO 
     384         istart = jpiglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
     385         iend   = jpiglo - ( nn_hls + 2 )                 ! halo + land + 1 
     386         DO ji = mi0(istart), mi1(iend) 
     387            DO jj=1,jpj 
     388               ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj) 
     389            END DO 
     390         END DO 
     391      ENDIF 
    380392      ! 
    381393      !--- South ---! 
    382       jstart = nn_hls + 2                              ! halo + land + 1 
    383       jend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    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 
     394      IF( lk_south ) THEN 
     395         jstart = nn_hls + 2                              ! halo + land + 1 
     396         jend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
     397         DO jj = mj0(jstart), mj1(jend) 
     398            DO ji=1,jpi 
     399               ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj) 
     400               va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj) 
     401            END DO 
     402         END DO 
     403      ENDIF 
    390404      ! 
    391405      !--- North ---! 
    392       jstart = jpjglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
    393       jend   = jpjglo - ( nn_hls + 1 )                 ! halo + land + 1            - 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 - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
    400       jend   = jpjglo - ( nn_hls + 2 )                 ! halo + land + 1 
    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 
     406      IF( lk_north ) THEN 
     407         jstart = jpjglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
     408         jend   = jpjglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1 
     409         DO jj = mj0(jstart), mj1(jend) 
     410            DO ji=1,jpi 
     411               ua_e(ji,jj) = ubdy(ji,jj) * hur_e(ji,jj) 
     412            END DO 
     413         END DO 
     414         jstart = jpjglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
     415         jend   = jpjglo - ( nn_hls + 2 )                 ! halo + land + 1 
     416         DO jj = mj0(jstart), mj1(jend) 
     417            DO ji=1,jpi 
     418               va_e(ji,jj) = vbdy(ji,jj) * hvr_e(ji,jj) 
     419            END DO 
     420         END DO 
     421      ENDIF 
    406422      ! 
    407423   END SUBROUTINE Agrif_dyn_ts 
    … …  
    421437      ! 
    422438      !--- West ---! 
    423       istart = nn_hls + 2                              ! halo + land + 1 
    424       iend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    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 
     439      IF( lk_west ) THEN 
     440         istart = nn_hls + 2                              ! halo + land + 1 
     441         iend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
     442         DO ji = mi0(istart), mi1(iend) 
     443            DO jj=1,jpj 
     444               zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj) 
     445               zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj) 
     446            END DO 
     447         END DO 
     448      ENDIF 
    431449      ! 
    432450      !--- East ---! 
    433       istart = jpiglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
    434       iend   = jpiglo - ( nn_hls + 1 )                 ! halo + land + 1            - 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 - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
    441       iend   = jpiglo - ( nn_hls + 2 )                 ! halo + land + 1 
    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 
     451      IF( lk_east ) THEN 
     452         istart = jpiglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
     453         iend   = jpiglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1 
     454         DO ji = mi0(istart), mi1(iend) 
     455            DO jj=1,jpj 
     456               zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj) 
     457            END DO 
     458         END DO 
     459         istart = jpiglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
     460         iend   = jpiglo - ( nn_hls + 2 )                 ! halo + land + 1 
     461         DO ji = mi0(istart), mi1(iend) 
     462            DO jj=1,jpj 
     463               zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj) 
     464            END DO 
     465         END DO 
     466      ENDIF 
    447467      ! 
    448468      !--- South ---! 
    449       jstart = nn_hls + 2                              ! halo + land + 1 
    450       jend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    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 
     469      IF( lk_south ) THEN 
     470         jstart = nn_hls + 2                              ! halo + land + 1 
     471         jend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
     472         DO jj = mj0(jstart), mj1(jend) 
     473            DO ji=1,jpi 
     474               zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj) 
     475               zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj) 
     476            END DO 
     477         END DO 
     478      ENDIF 
    457479      ! 
    458480      !--- North ---! 
    459       jstart = jpjglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
    460       jend   = jpjglo - ( nn_hls + 1 )                 ! halo + land + 1            - 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 - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
    467       jend   = jpjglo - ( nn_hls + 2 )                 ! halo + land + 1 
    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 
     481      IF( lk_north ) THEN 
     482         jstart = jpjglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
     483         jend   = jpjglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1 
     484         DO jj = mj0(jstart), mj1(jend) 
     485            DO ji=1,jpi 
     486               zu(ji,jj) = ubdy(ji,jj) * e2u(ji,jj) 
     487            END DO 
     488         END DO 
     489         jstart = jpjglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
     490         jend   = jpjglo - ( nn_hls + 2 )                 ! halo + land + 1 
     491         DO jj = mj0(jstart), mj1(jend) 
     492            DO ji=1,jpi 
     493               zv(ji,jj) = vbdy(ji,jj) * e1v(ji,jj) 
     494            END DO 
     495         END DO 
     496      ENDIF 
    473497      ! 
    474498   END SUBROUTINE Agrif_dyn_ts_flux 
    … …  
    489513      ! 
    490514      ! Enforce volume conservation if no time refinement:   
    491       IF ( Agrif_rhot()==1 ) ll_int_cons=.TRUE.   
     515      IF    ( Agrif_rhot()==1 ) ll_int_cons=.TRUE.   
    492516      ! 
    493517      ! Interpolate barotropic fluxes 
    … …  
    542566      ! 
    543567      ! --- West --- ! 
    544       istart = nn_hls + 2                              ! halo + land + 1 
    545       iend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    546       DO ji = mi0(istart), mi1(iend) 
    547          DO jj = 1, jpj 
    548             ssh(ji,jj,Krhs_a) = hbdy(ji,jj) 
     568      IF( lk_west ) THEN 
     569        istart = nn_hls + 2                              ! halo + land + 1 
     570         iend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
     571         DO ji = mi0(istart), mi1(iend) 
     572            DO jj = 1, jpj 
     573               ssh(ji,jj,Krhs_a) = hbdy(ji,jj) 
     574            ENDDO 
    549575         ENDDO 
    550       ENDDO 
     576      ENDIF 
    551577      ! 
    552578      ! --- East --- ! 
    553       istart = jpiglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
    554       iend   = jpiglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1 
    555       DO ji = mi0(istart), mi1(iend) 
    556          DO jj = 1, jpj 
    557             ssh(ji,jj,Krhs_a) = hbdy(ji,jj) 
     579      IF( lk_east ) THEN 
     580         istart = jpiglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
     581         iend   = jpiglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1 
     582         DO ji = mi0(istart), mi1(iend) 
     583            DO jj = 1, jpj 
     584               ssh(ji,jj,Krhs_a) = hbdy(ji,jj) 
     585            ENDDO 
    558586         ENDDO 
    559       ENDDO 
     587      ENDIF 
    560588      ! 
    561589      ! --- South --- ! 
    562       jstart = nn_hls + 2                              ! halo + land + 1 
    563       jend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    564       DO jj = mj0(jstart), mj1(jend) 
    565          DO ji = 1, jpi 
    566             ssh(ji,jj,Krhs_a) = hbdy(ji,jj) 
     590      IF( lk_south ) THEN 
     591         jstart = nn_hls + 2                              ! halo + land + 1 
     592         jend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
     593         DO jj = mj0(jstart), mj1(jend) 
     594            DO ji = 1, jpi 
     595               ssh(ji,jj,Krhs_a) = hbdy(ji,jj) 
     596            ENDDO 
    567597         ENDDO 
    568       ENDDO 
     598      ENDIF 
    569599      ! 
    570600      ! --- North --- ! 
    571       jstart = jpjglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
    572       jend   = jpjglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1 
    573       DO jj = mj0(jstart), mj1(jend) 
    574          DO ji = 1, jpi 
    575             ssh(ji,jj,Krhs_a) = hbdy(ji,jj) 
     601      IF( lk_north ) THEN 
     602         jstart = jpjglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
     603         jend   = jpjglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1 
     604         DO jj = mj0(jstart), mj1(jend) 
     605            DO ji = 1, jpi 
     606               ssh(ji,jj,Krhs_a) = hbdy(ji,jj) 
     607            ENDDO 
    576608         ENDDO 
    577       ENDDO 
     609      ENDIF 
    578610      ! 
    579611   END SUBROUTINE Agrif_ssh 
    … …  
    593625      ! 
    594626      ! --- West --- ! 
    595       istart = nn_hls + 2                              ! halo + land + 1 
    596       iend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    597       DO ji = mi0(istart), mi1(iend) 
    598          DO jj = 1, jpj 
    599             ssha_e(ji,jj) = hbdy(ji,jj) 
     627      IF( lk_west ) THEN 
     628         istart = nn_hls + 2                              ! halo + land + 1 
     629         iend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
     630         DO ji = mi0(istart), mi1(iend) 
     631            DO jj = 1, jpj 
     632               ssha_e(ji,jj) = hbdy(ji,jj) 
     633            ENDDO 
    600634         ENDDO 
    601       ENDDO 
     635      ENDIF 
    602636      ! 
    603637      ! --- East --- ! 
    604       istart = jpiglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
    605       iend   = jpiglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1 
    606       DO ji = mi0(istart), mi1(iend) 
    607          DO jj = 1, jpj 
    608             ssha_e(ji,jj) = hbdy(ji,jj) 
     638      IF( lk_east ) THEN 
     639         istart = jpiglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
     640         iend   = jpiglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1 
     641         DO ji = mi0(istart), mi1(iend) 
     642            DO jj = 1, jpj 
     643               ssha_e(ji,jj) = hbdy(ji,jj) 
     644            ENDDO 
    609645         ENDDO 
    610       ENDDO 
     646      ENDIF 
    611647      ! 
    612648      ! --- South --- ! 
    613       jstart = nn_hls + 2                              ! halo + land + 1 
    614       jend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    615       DO jj = mj0(jstart), mj1(jend) 
    616          DO ji = 1, jpi 
    617             ssha_e(ji,jj) = hbdy(ji,jj) 
     649      IF( lk_south ) THEN 
     650         jstart = nn_hls + 2                              ! halo + land + 1 
     651         jend   = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
     652         DO jj = mj0(jstart), mj1(jend) 
     653            DO ji = 1, jpi 
     654               ssha_e(ji,jj) = hbdy(ji,jj) 
     655            ENDDO 
    618656         ENDDO 
    619       ENDDO 
     657      ENDIF 
    620658      ! 
    621659      ! --- North --- ! 
    622       jstart = jpjglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
    623       jend   = jpjglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1 
    624       DO jj = mj0(jstart), mj1(jend) 
    625          DO ji = 1, jpi 
    626             ssha_e(ji,jj) = hbdy(ji,jj) 
     660      IF( lk_north ) THEN 
     661         jstart = jpjglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
     662         jend   = jpjglo - ( nn_hls + 1 )                 ! halo + land + 1            - 1 
     663         DO jj = mj0(jstart), mj1(jend) 
     664            DO ji = 1, jpi 
     665               ssha_e(ji,jj) = hbdy(ji,jj) 
     666            ENDDO 
    627667         ENDDO 
    628       ENDDO 
     668      ENDIF 
    629669      ! 
    630670   END SUBROUTINE Agrif_ssh_ts 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/NST/agrif_oce_sponge.F90

    r13065 r13229  
    131131 
    132132         ! --- West --- ! 
    133          ztabramp(:,:) = 0._wp 
    134          ind1 = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    135          DO ji = mi0(ind1), mi1(ind1)                 
    136             ztabramp(ji,:) = ssumask(ji,:) 
    137          END DO 
    138          ! 
    139          zmskwest(1:jpj) = MAXVAL(ztabramp(:,:), dim=1) 
    140          zmskwest(jpj+1:jpjmax) = 0._wp 
     133         IF( lk_west ) THEN 
     134            ztabramp(:,:) = 0._wp 
     135            ind1 = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
     136            DO ji = mi0(ind1), mi1(ind1)                 
     137               ztabramp(ji,:) = ssumask(ji,:) 
     138            END DO 
     139            ! 
     140            zmskwest(1:jpj) = MAXVAL(ztabramp(:,:), dim=1) 
     141            zmskwest(jpj+1:jpjmax) = 0._wp 
     142         ENDIF 
    141143 
    142144         ! --- East --- ! 
    143          ztabramp(:,:) = 0._wp 
    144          ind1 = jpiglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
    145          DO ji = mi0(ind1), mi1(ind1)                  
    146             ztabramp(ji,:) = ssumask(ji,:) 
    147          END DO 
    148          ! 
    149          zmskeast(1:jpj) = MAXVAL(ztabramp(:,:), dim=1) 
    150          zmskeast(jpj+1:jpjmax) = 0._wp 
     145         IF( lk_east ) THEN 
     146            ztabramp(:,:) = 0._wp 
     147            ind1 = jpiglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
     148            DO ji = mi0(ind1), mi1(ind1)                  
     149               ztabramp(ji,:) = ssumask(ji,:) 
     150            END DO 
     151            ! 
     152            zmskeast(1:jpj) = MAXVAL(ztabramp(:,:), dim=1) 
     153            zmskeast(jpj+1:jpjmax) = 0._wp 
     154         ENDIF 
    151155 
    152156         ! --- South --- ! 
    153          ztabramp(:,:) = 0._wp 
    154          ind1 = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    155          DO jj = mj0(ind1), mj1(ind1)                  
    156             ztabramp(:,jj) = ssvmask(:,jj) 
    157          END DO 
    158          ! 
    159          zmsksouth(1:jpi) = MAXVAL(ztabramp(:,:), dim=2) 
    160          zmsksouth(jpi+1:jpimax) = 0._wp 
     157         IF( lk_south ) THEN 
     158            ztabramp(:,:) = 0._wp 
     159            ind1 = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
     160            DO jj = mj0(ind1), mj1(ind1)                  
     161               ztabramp(:,jj) = ssvmask(:,jj) 
     162            END DO 
     163            ! 
     164            zmsksouth(1:jpi) = MAXVAL(ztabramp(:,:), dim=2) 
     165            zmsksouth(jpi+1:jpimax) = 0._wp 
     166         ENDIF 
    161167 
    162168         ! --- North --- ! 
    163          ztabramp(:,:) = 0._wp 
    164          ind1 = jpjglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
    165          DO jj = mj0(ind1), mj1(ind1)                  
    166             ztabramp(:,jj) = ssvmask(:,jj) 
    167          END DO 
    168          ! 
    169          zmsknorth(1:jpi) = MAXVAL(ztabramp(:,:), dim=2) 
    170          zmsknorth(jpi+1:jpimax) = 0._wp 
     169         IF( lk_north ) THEN 
     170            ztabramp(:,:) = 0._wp 
     171            ind1 = jpjglo - ( nn_hls + nbghostcells + 1)   ! halo + land + nbghostcells 
     172            DO jj = mj0(ind1), mj1(ind1)                  
     173               ztabramp(:,jj) = ssvmask(:,jj) 
     174            END DO 
     175            ! 
     176            zmsknorth(1:jpi) = MAXVAL(ztabramp(:,:), dim=2) 
     177            zmsknorth(jpi+1:jpimax) = 0._wp 
     178         ENDIF 
    171179 
    172180         ! JC: SPONGE MASKING TO BE SORTED OUT: 
    … …  
    197205 
    198206         ! --- West --- ! 
    199          ind1 = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    200          ind2 = nn_hls + 1 + nbghostcells + ispongearea  
    201          DO ji = mi0(ind1), mi1(ind2)    
    202             DO jj = 1, jpj                
    203                ztabramp(ji,jj) = REAL( ind2 - mig(ji) ) * z1_ispongearea * zmskwest(jj) 
    204             END DO 
    205          END DO 
    206  
    207          ! ghost cells: 
    208          ind1 = 1 
    209          ind2 = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    210          DO ji = mi0(ind1), mi1(ind2)    
    211             DO jj = 1, jpj                
    212                ztabramp(ji,jj) = zmskwest(jj) 
    213             END DO 
    214          END DO 
     207         IF( lk_west ) THEN 
     208            ind1 = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
     209            ind2 = nn_hls + 1 + nbghostcells + ispongearea  
     210            DO ji = mi0(ind1), mi1(ind2)    
     211               DO jj = 1, jpj                
     212                  ztabramp(ji,jj) = REAL( ind2 - mig(ji) ) * z1_ispongearea * zmskwest(jj) 
     213               END DO 
     214            END DO 
     215 
     216            ! ghost cells: 
     217            ind1 = 1 
     218            ind2 = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
     219            DO ji = mi0(ind1), mi1(ind2)    
     220               DO jj = 1, jpj                
     221                  ztabramp(ji,jj) = zmskwest(jj) 
     222               END DO 
     223            END DO 
     224         ENDIF 
    215225 
    216226         ! --- East --- ! 
    217          ind1 = jpiglo - ( nn_hls + nbghostcells ) - ispongearea 
    218          ind2 = jpiglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
    219          DO ji = mi0(ind1), mi1(ind2) 
    220             DO jj = 1, jpj 
    221                ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( mig(ji) - ind1 ) * z1_ispongearea) * zmskeast(jj) 
    222             ENDDO 
    223          END DO 
    224  
    225          ! ghost cells: 
    226          ind1 = jpiglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
    227          ind2 = jpiglo 
    228          DO ji = mi0(ind1), mi1(ind2) 
    229             DO jj = 1, jpj 
    230                ztabramp(ji,jj) = zmskeast(jj) 
    231             ENDDO 
    232          END DO 
     227         IF( lk_east ) THEN 
     228            ind1 = jpiglo - ( nn_hls + nbghostcells ) - ispongearea 
     229            ind2 = jpiglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
     230            DO ji = mi0(ind1), mi1(ind2) 
     231               DO jj = 1, jpj 
     232                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( mig(ji) - ind1 ) * z1_ispongearea) * zmskeast(jj) 
     233               ENDDO 
     234            END DO 
     235 
     236            ! ghost cells: 
     237            ind1 = jpiglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
     238            ind2 = jpiglo 
     239            DO ji = mi0(ind1), mi1(ind2) 
     240               DO jj = 1, jpj 
     241                  ztabramp(ji,jj) = zmskeast(jj) 
     242               ENDDO 
     243            END DO 
     244         ENDIF 
    233245 
    234246         ! --- South --- ! 
    235          ind1 = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    236          ind2 = nn_hls + 1 + nbghostcells + jspongearea  
    237          DO jj = mj0(ind1), mj1(ind2)  
    238             DO ji = 1, jpi 
    239                ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ind2 - mjg(jj) ) * z1_jspongearea) * zmsksouth(ji) 
    240             END DO 
    241          END DO 
    242  
    243          ! ghost cells: 
    244          ind1 = 1 
    245          ind2 = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
    246          DO jj = mj0(ind1), mj1(ind2)  
    247             DO ji = 1, jpi 
    248                ztabramp(ji,jj) = zmsksouth(ji) 
    249             END DO 
    250          END DO 
     247         IF( lk_south ) THEN 
     248            ind1 = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
     249            ind2 = nn_hls + 1 + nbghostcells + jspongearea  
     250            DO jj = mj0(ind1), mj1(ind2)  
     251               DO ji = 1, jpi 
     252                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( ind2 - mjg(jj) ) * z1_jspongearea) * zmsksouth(ji) 
     253               END DO 
     254            END DO 
     255 
     256            ! ghost cells: 
     257            ind1 = 1 
     258            ind2 = nn_hls + 1 + nbghostcells               ! halo + land + nbghostcells 
     259            DO jj = mj0(ind1), mj1(ind2)  
     260               DO ji = 1, jpi 
     261                  ztabramp(ji,jj) = zmsksouth(ji) 
     262               END DO 
     263            END DO 
     264         ENDIF 
    251265 
    252266         ! --- North --- ! 
    253          ind1 = jpjglo - ( nn_hls + nbghostcells ) - jspongearea 
    254          ind2 = jpjglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
    255          DO jj = mj0(ind1), mj1(ind2) 
    256             DO ji = 1, jpi 
    257                ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( mjg(jj) - ind1 ) * z1_jspongearea) * zmsknorth(ji) 
    258             END DO 
    259          END DO 
    260  
    261          ! ghost cells: 
    262          ind1 = jpjglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
    263          ind2 = jpjglo 
    264          DO jj = mj0(ind1), mj1(ind2) 
    265             DO ji = 1, jpi 
    266                ztabramp(ji,jj) = zmsknorth(ji) 
    267             END DO 
    268          END DO 
     267         IF( lk_north ) THEN 
     268            ind1 = jpjglo - ( nn_hls + nbghostcells ) - jspongearea 
     269            ind2 = jpjglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
     270            DO jj = mj0(ind1), mj1(ind2) 
     271               DO ji = 1, jpi 
     272                  ztabramp(ji,jj) = MAX( ztabramp(ji,jj), REAL( mjg(jj) - ind1 ) * z1_jspongearea) * zmsknorth(ji) 
     273               END DO 
     274            END DO 
     275 
     276            ! ghost cells: 
     277            ind1 = jpjglo - ( nn_hls + nbghostcells )      ! halo + land + nbghostcells - 1 
     278            ind2 = jpjglo 
     279            DO jj = mj0(ind1), mj1(ind2) 
     280               DO ji = 1, jpi 
     281                  ztabramp(ji,jj) = zmsknorth(ji) 
     282               END DO 
     283            END DO 
     284         ENDIF 
    269285 
    270286      ENDIF 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/NST/agrif_oce_update.F90

    r12489 r13229  
    2626   USE domvvl         ! Need interpolation routines  
    2727   USE vremap         ! Vertical remapping 
     28   USE lbclnk  
    2829 
    2930   IMPLICIT NONE 
    … …  
    8586      Agrif_UseSpecialValueInUpdate = .FALSE. 
    8687      Agrif_SpecialValueFineGrid = 0. 
     88 
     89      use_sign_north = .TRUE. 
     90      sign_north = -1. 
     91 
    8792      !      
    8893# if ! defined DECAL_FEEDBACK 
    … …  
    127132      END IF 
    128133      ! 
     134      use_sign_north = .FALSE. 
     135      ! 
    129136   END SUBROUTINE Agrif_Update_Dyn 
    130137 
    … …  
    148155#  if defined VOL_REFLUX 
    149156      IF ( ln_dynspg_ts.AND.ln_bt_fw ) THEN 
     157         use_sign_north = .TRUE. 
     158         sign_north = -1. 
    150159         ! Refluxing on ssh: 
    151160#  if defined DECAL_FEEDBACK_2D 
    … …  
    156165         CALL Agrif_Update_Variable(vb2b_update_id,locupdate1=(/ 0, 0/),locupdate2=(/-1,-1/),procname = reflux_sshv) 
    157166#  endif 
     167         use_sign_north = .FALSE. 
    158168      END IF 
    159169#  endif 
    … …  
    826836   SUBROUTINE correct_v_bdy( tabres, i1, i2, j1, j2, k1, k2, n1, n2, before, nb, ndir ) 
    827837      !!--------------------------------------------- 
    828       !!           *** ROUTINE correct_u_bdy *** 
     838      !!           *** ROUTINE correct_v_bdy *** 
    829839      !!--------------------------------------------- 
    830840      INTEGER                                     , INTENT(in   ) :: i1, i2, j1, j2, k1, k2, n1, n2 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/NST/agrif_top_interp.F90

    r12377 r13229  
    119119            tr(i1:i2,j1:j2,1:jpk,jn,Krhs_a)=ptab_child(i1:i2,j1:j2,1:jpk,jn)*tmask(i1:i2,j1:j2,1:jpk)  
    120120         END DO 
    121  
    122121      ENDIF 
    123122      ! 

  • NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/NST/agrif_user.F90

    r13130 r13229  
    2828      ! 
    2929      !                    !* Agrif initialization 
    30       CALL agrif_nemo_init 
    31       CALL Agrif_InitValues_cont_dom 
    3230      CALL Agrif_InitValues_cont 
    3331# if defined key_top 
    … …  
    4038   END SUBROUTINE Agrif_initvalues 
    4139 
    42    SUBROUTINE Agrif_InitValues_cont_dom 
    43       !!---------------------------------------------------------------------- 
    44       !!                 *** ROUTINE Agrif_InitValues_cont_dom *** 
    45       !!---------------------------------------------------------------------- 
    46       ! 
    47       CALL agrif_declare_var_dom 
    48       ! 
    49    END SUBROUTINE Agrif_InitValues_cont_dom 
    50  
    51    SUBROUTINE agrif_declare_var_dom 
    52       !!---------------------------------------------------------------------- 
    53       !!                 *** ROUTINE agrif_declare_var_dom *** 
    54       !!---------------------------------------------------------------------- 
    55       USE par_oce, ONLY:  nbghostcells       
     40   SUBROUTINE agrif_istate( Kbb, Kmm, Kaa ) 
     41 
     42       USE domvvl 
     43       USE domain 
     44       USE par_oce 
     45       USE agrif_oce 
     46       USE agrif_oce_interp 
     47       USE oce 
     48       USE lib_mpp 
     49       USe lbclnk 
     50 
     51      INTEGER, INTENT(in)  :: Kbb, Kmm, Kaa 
     52      INTEGER :: jn 
     53 
     54      IF(lwp) WRITE(numout,*) ' ' 
     55      IF(lwp) WRITE(numout,*) 'AGRIF: interp child initial state from parent' 
     56      IF(lwp) WRITE(numout,*) ' ' 
     57 
     58      l_ini_child = .TRUE. 
     59      Agrif_SpecialValue    = 0._wp 
     60      Agrif_UseSpecialValue = .TRUE. 
     61      uu(:,:,:,:) = 0.  ;  vv(:,:,:,:) = 0.   ;  ts(:,:,:,:,:) = 0. 
     62        
     63      Krhs_a = Kbb ; Kmm_a = Kbb 
     64 
     65      ! Brutal fix to pas 1x1 refinment.  
     66  !    IF(Agrif_Irhox() == 1) THEN 
     67  !       CALL Agrif_Init_Variable(tsini_id, procname=agrif_initts) 
     68  !    ELSE 
     69      CALL Agrif_Init_Variable(tsini_id, procname=interptsn) 
     70 
     71  !    ENDIF 
     72! just for VORTEX because Parent velocities can actually be exactly zero 
     73!      Agrif_UseSpecialValue = .FALSE. 
     74      Agrif_UseSpecialValue = ln_spc_dyn 
     75      use_sign_north = .TRUE. 
     76      sign_north = -1. 
     77      CALL Agrif_Init_Variable(uini_id , procname=interpun ) 
     78      CALL Agrif_Init_Variable(vini_id , procname=interpvn ) 
     79      use_sign_north = .FALSE. 
     80 
     81      Agrif_UseSpecialValue = .FALSE.            ! 
     82      l_ini_child = .FALSE. 
     83 
     84      Krhs_a = Kaa ; Kmm_a = Kmm 
     85 
     86      DO jn = 1, jpts 
     87         ts(:,:,:,jn,Kbb) = ts(:,:,:,jn,Kbb)*tmask(:,:,:) 
     88      END DO 
     89      uu(:,:,:,Kbb) =  uu(:,:,:,Kbb) * umask(:,:,:)      
     90      vv(:,:,:,Kbb) =  vv(:,:,:,Kbb) * vmask(:,:,:)  
     91 
     92 
     93      CALL lbc_lnk_multi( 'agrif_istate', uu(:,:,:,Kbb), 'U', -1. , vv(:,:,:,Kbb), 'V', -1. ) 
     94      CALL lbc_lnk( 'agrif_istate', ts(:,:,:,:,Kbb), 'T', 1. ) 
     95 
     96   END SUBROUTINE agrif_istate    
     97 
     98   SUBROUTINE agrif_declare_var_ini 
     99      !!---------------------------------------------------------------------- 
     100      !!                 *** ROUTINE agrif_declare_var *** 
     101      !!---------------------------------------------------------------------- 
     102      USE agrif_util 
     103      USE agrif_oce 
     104      USE par_oce 
     105      USE zdf_oce  
     106      USE oce 
     107      USE dom_oce 
    56108      ! 
    57109      IMPLICIT NONE 
    58110      ! 
    59111      INTEGER :: ind1, ind2, ind3 
    60       !!---------------------------------------------------------------------- 
     112      External :: nemo_mapping 
     113      !!---------------------------------------------------------------------- 
     114 
     115! In case of East-West periodicity, prevent AGRIF interpolation at east and west boundaries 
     116! The procnames will not be called at these boundaries 
     117      IF (jperio == 1) THEN 
     118         CALL Agrif_Set_NearCommonBorderX(.TRUE.) 
     119         CALL Agrif_Set_DistantCommonBorderX(.TRUE.) 
     120      ENDIF 
     121 
     122      IF ( .NOT. lk_south ) THEN 
     123         CALL Agrif_Set_NearCommonBorderY(.TRUE.) 
     124      ENDIF 
    61125 
    62126      ! 1. Declaration of the type of variable which have to be interpolated 
    63127      !--------------------------------------------------------------------- 
    64       ind1 =          nbghostcells       ! do the interpolation over nbghostcells points 
    65       ind2 = nn_hls + nbghostcells + 1   ! U/V points: array index of the first point in the reference grid  
    66       ind3 = nn_hls + nbghostcells + 2   ! T   points: array index of the first point in the reference grid  
    67       CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e1u_id) 
    68       CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e2v_id) 
    69  
     128      ind1 =              nbghostcells 
     129      ind2 = nn_hls + 2 + nbghostcells_x 
     130      ind3 = nn_hls + 2 + nbghostcells_y_s 
     131 
     132      CALL agrif_declare_variable((/2,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),e3t_id) 
     133      CALL agrif_declare_variable((/2,2/)  ,(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),mbkt_id) 
     134      CALL agrif_declare_variable((/2,2/)  ,(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ht0_id) 
     135 
     136      CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e1u_id) 
     137      CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e2v_id) 
     138 
     139    
     140      ! Initial or restart velues 
     141       
     142      CALL agrif_declare_variable((/2,2,0,0/),(/ind2  ,ind3  ,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts+1/),tsini_id) 
     143      CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3  ,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/)     ,uini_id )  
     144      CALL agrif_declare_variable((/2,1,0,0/),(/ind2  ,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/)     ,vini_id ) 
     145      CALL agrif_declare_variable((/2,2/)    ,(/ind2,ind3/)        ,(/'x','y'/),(/1,1/),(/jpi,jpj/),sshini_id) 
     146      !  
     147      
    70148      ! 2. Type of interpolation 
    71149      !------------------------- 
     150      CALL Agrif_Set_bcinterp(e3t_id,interp=AGRIF_constant) 
     151 
     152      CALL Agrif_Set_bcinterp(mbkt_id,interp=AGRIF_constant) 
     153      CALL Agrif_Set_interp  (mbkt_id,interp=AGRIF_constant) 
     154      CALL Agrif_Set_bcinterp(ht0_id ,interp=AGRIF_constant) 
     155      CALL Agrif_Set_interp  (ht0_id ,interp=AGRIF_constant) 
     156 
    72157      CALL Agrif_Set_bcinterp( e1u_id, interp1=Agrif_linear, interp2=AGRIF_ppm    ) 
    73158      CALL Agrif_Set_bcinterp( e2v_id, interp1=AGRIF_ppm   , interp2=Agrif_linear ) 
    74159 
    75       ! 3. Location of interpolation 
     160      ! Initial fields 
     161      CALL Agrif_Set_bcinterp(tsini_id ,interp=AGRIF_linear) 
     162      CALL Agrif_Set_interp  (tsini_id ,interp=AGRIF_linear) 
     163      CALL Agrif_Set_bcinterp(uini_id  ,interp=AGRIF_linear) 
     164      CALL Agrif_Set_interp  (uini_id  ,interp=AGRIF_linear) 
     165      CALL Agrif_Set_bcinterp(vini_id  ,interp=AGRIF_linear) 
     166      CALL Agrif_Set_interp  (vini_id  ,interp=AGRIF_linear) 
     167      CALL Agrif_Set_bcinterp(sshini_id,interp=AGRIF_linear) 
     168      CALL Agrif_Set_interp  (sshini_id,interp=AGRIF_linear) 
     169 
     170       ! 3. Location of interpolation 
    76171      !----------------------------- 
     172!      CALL Agrif_Set_bc(  e3t_id, (/-nn_sponge_len*Agrif_irhox(),ind1-1/) )   
     173! JC: check near the boundary only until matching in sponge has been sorted out: 
     174      CALL Agrif_Set_bc(  e3t_id, (/0,ind1-1/) )   
     175 
     176      ! extend the interpolation zone by 1 more point than necessary: 
     177      ! RB check here 
     178      CALL Agrif_Set_bc(  mbkt_id, (/-nn_sponge_len*Agrif_irhox()-2,ind1/) ) 
     179      CALL Agrif_Set_bc(  ht0_id,  (/-nn_sponge_len*Agrif_irhox()-2,ind1/) ) 
     180       
    77181      CALL Agrif_Set_bc(e1u_id,(/0,ind1-1/)) 
    78       CALL Agrif_Set_bc(e2v_id,(/0,ind1-1/)) 
     182      CALL Agrif_Set_bc(e2v_id,(/0,ind1-1/))   
     183 
     184      CALL Agrif_Set_bc( tsini_id , (/0,ind1-1/) ) ! if west,  rhox=3 and nbghost=3: columns 2 to 4 
     185      CALL Agrif_Set_bc( uini_id  , (/0,ind1-1/) )  
     186      CALL Agrif_Set_bc( vini_id  , (/0,ind1-1/) ) 
     187      CALL Agrif_Set_bc( sshini_id, (/0,ind1-1/) ) 
    79188 
    80189      ! 4. Update type 
    … …  
    87196      CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy) 
    88197#endif 
    89  
    90    END SUBROUTINE agrif_declare_var_dom 
    91  
    92    SUBROUTINE Agrif_InitValues_cont 
    93       !!---------------------------------------------------------------------- 
    94       !!                 *** ROUTINE Agrif_InitValues_cont *** 
    95       !!---------------------------------------------------------------------- 
    96       USE agrif_oce 
     198       
     199   !   CALL Agrif_Set_ExternalMapping(nemo_mapping) 
     200      ! 
     201   END SUBROUTINE agrif_declare_var_ini 
     202 
     203 
     204   SUBROUTINE Agrif_Init_Domain( Kbb, Kmm, Kaa )  
     205      !!---------------------------------------------------------------------- 
     206      !!                 *** ROUTINE Agrif_InitValues_cont_dom *** 
     207      !!---------------------------------------------------------------------- 
     208   
     209         !!---------------------------------------------------------------------- 
     210         !!                 *** ROUTINE Agrif_InitValues_cont *** 
     211         !! 
     212         !! ** Purpose ::   Declaration of variables to be interpolated 
     213         !!---------------------------------------------------------------------- 
     214      USE agrif_oce_update 
    97215      USE agrif_oce_interp 
    98216      USE agrif_oce_sponge 
     217      USE Agrif_Util 
     218      USE oce  
    99219      USE dom_oce 
    100       USE oce 
     220      USE zdf_oce 
     221      USE nemogcm 
     222      USE agrif_oce 
     223      ! 
     224      USE lbclnk 
    101225      USE lib_mpp 
    102       USE lbclnk 
     226      USE in_out_manager 
    103227      ! 
    104228      IMPLICIT NONE 
    105229      ! 
    106       INTEGER :: ji, jj 
     230      INTEGER, INTENT(in) ::  Kbb, Kmm, Kaa 
     231      ! 
    107232      LOGICAL :: check_namelist 
    108233      CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3, cl_check4  
    109 #if defined key_vertical 
    110234      REAL(wp), DIMENSION(jpi,jpj) ::   zk   ! workspace 
    111 #endif 
    112       !!---------------------------------------------------------------------- 
    113  
    114       ! 1. Declaration of the type of variable which have to be interpolated 
    115       !--------------------------------------------------------------------- 
    116       CALL agrif_declare_var 
    117  
    118       ! 2. First interpolations of potentially non zero fields 
    119       !------------------------------------------------------- 
    120  
    121 #if defined key_vertical 
     235      INTEGER :: ji, jj, jk 
     236      !!---------------------------------------------------------------------- 
     237     
     238     ! CALL Agrif_Declare_Var_ini 
     239 
     240      IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed') 
     241 
    122242      ! Build consistent parent bathymetry and number of levels 
    123243      ! on the child grid  
    … …  
    126246      mbkt_parent(:,:) = 0 
    127247      ! 
    128       CALL Agrif_Bc_variable(ht0_id ,calledweight=1.,procname=interpht0 ) 
    129       CALL Agrif_Bc_variable(mbkt_id,calledweight=1.,procname=interpmbkt) 
     248  !    CALL Agrif_Bc_variable(ht0_id ,calledweight=1.,procname=interpht0 ) 
     249  !    CALL Agrif_Bc_variable(mbkt_id,calledweight=1.,procname=interpmbkt) 
     250      CALL Agrif_Init_Variable(ht0_id , procname=interpht0 ) 
     251      CALL Agrif_Init_Variable(mbkt_id, procname=interpmbkt) 
    130252      ! 
    131253      ! Assume step wise change of bathymetry near interface 
    … …  
    149271      ENDIF 
    150272      ! 
    151       CALL lbc_lnk( 'Agrif_InitValues_cont', hu0_parent, 'U', 1. ) 
    152       CALL lbc_lnk( 'Agrif_InitValues_cont', hv0_parent, 'V', 1. ) 
     273      CALL lbc_lnk( 'Agrif_Init_Domain', hu0_parent, 'U', 1. ) 
     274      CALL lbc_lnk( 'Agrif_Init_Domain', hv0_parent, 'V', 1. ) 
    153275      zk(:,:) = REAL( mbku_parent(:,:), wp )   ;   CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'U', 1. ) 
    154       mbku_parent(:,:) = MAX( NINT( zk(:,:) ), 1 ) 
     276      mbku_parent(:,:) = MAX( NINT( zk(:,:) ), 1 ) ; 
    155277      zk(:,:) = REAL( mbkv_parent(:,:), wp )   ;   CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'V', 1. ) 
    156278      mbkv_parent(:,:) = MAX( NINT( zk(:,:) ), 1 )    
    157 #endif 
    158  
     279 
     280      IF ( ln_init_chfrpar ) THEN  
     281         CALL Agrif_Init_Variable(sshini_id, procname=agrif_initssh) 
     282         CALL lbc_lnk( 'Agrif_Init_Domain', ssh(:,:,Kbb), 'T', 1. ) 
     283         DO jk = 1, jpk 
     284               e3t(:,:,jk,Kbb) =  e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kbb)  ) & 
     285                        &             / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk)   & 
     286                        &              + e3t_0(:,:,jk) * ( 1._wp - tmask(:,:,jk) ) 
     287         END DO 
     288      ENDIF 
     289 
     290      ! check if masks and bathymetries match 
     291      IF(ln_chk_bathy) THEN 
     292         Agrif_UseSpecialValue = .FALSE. 
     293         ! 
     294         IF(lwp) WRITE(numout,*) ' ' 
     295         IF(lwp) WRITE(numout,*) 'AGRIF: Check Bathymetry and masks near bdys. Level: ', Agrif_Level() 
     296         ! 
     297         kindic_agr = 0 
     298         IF( .NOT. l_vremap ) THEN 
     299            ! 
     300            ! check if tmask and vertical scale factors agree with parent in sponge area: 
     301            CALL Agrif_Bc_variable(e3t_id,calledweight=1.,procname=interpe3t) 
     302            ! 
     303         ELSE 
     304            ! 
     305            ! In case of vertical interpolation, check only that total depths agree between child and parent: 
     306            DO ji = 1, jpi 
     307               DO jj = 1, jpj 
     308                  IF ((mbkt_parent(ji,jj)/=0).AND.(ABS(ht0_parent(ji,jj)-ht_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1 
     309                  IF ((mbku_parent(ji,jj)/=0).AND.(ABS(hu0_parent(ji,jj)-hu_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1 
     310                  IF ((mbkv_parent(ji,jj)/=0).AND.(ABS(hv0_parent(ji,jj)-hv_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1 
     311               END DO 
     312            END DO 
     313 
     314            CALL mpp_sum( 'agrif_user', kindic_agr ) 
     315            IF( kindic_agr /= 0 ) THEN 
     316               CALL ctl_stop('==> Child Bathymetry is NOT correct near boundaries.') 
     317            ELSE 
     318               IF(lwp) WRITE(numout,*) '==> Child Bathymetry is ok near boundaries.' 
     319               IF(lwp) WRITE(numout,*) ' ' 
     320            ENDIF   
     321         ENDIF 
     322      ENDIF 
     323 
     324      IF( l_vremap ) THEN 
     325      ! Additional constrain that should be removed someday: 
     326         IF ( Agrif_Parent(jpk).GT.jpk ) THEN 
     327            CALL ctl_stop( ' With l_vremap, child grids must have jpk greater or equal to the parent value' ) 
     328         ENDIF 
     329      ENDIF 
     330      ! 
     331   END SUBROUTINE Agrif_Init_Domain 
     332 
     333 
     334   SUBROUTINE Agrif_InitValues_cont 
     335         !!---------------------------------------------------------------------- 
     336         !!                 *** ROUTINE Agrif_InitValues_cont *** 
     337         !! 
     338         !! ** Purpose ::   Declaration of variables to be interpolated 
     339         !!---------------------------------------------------------------------- 
     340      USE agrif_oce_update 
     341      USE agrif_oce_interp 
     342      USE agrif_oce_sponge 
     343      USE Agrif_Util 
     344      USE oce  
     345      USE dom_oce 
     346      USE zdf_oce 
     347      USE nemogcm 
     348      USE agrif_oce 
     349      ! 
     350      USE lbclnk 
     351      USE lib_mpp 
     352      USE in_out_manager 
     353      ! 
     354      IMPLICIT NONE 
     355      ! 
     356      LOGICAL :: check_namelist 
     357      CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3, cl_check4  
     358      REAL(wp), DIMENSION(jpi,jpj) ::   zk   ! workspace 
     359      INTEGER :: ji, jj 
     360 
     361      ! 1. Declaration of the type of variable which have to be interpolated 
     362      !--------------------------------------------------------------------- 
     363      CALL agrif_declare_var 
     364 
     365      ! 2. First interpolations of potentially non zero fields 
     366      !------------------------------------------------------- 
    159367      Agrif_SpecialValue    = 0._wp 
    160368      Agrif_UseSpecialValue = .TRUE. 
    … …  
    163371      tabspongedone_tsn = .FALSE. 
    164372      CALL Agrif_Bc_variable(tsn_sponge_id,calledweight=1.,procname=interptsn_sponge) 
    165       ! reset ts(:,:,:,:,Krhs_a) to zero 
     373      ! reset tsa to zero 
    166374      ts(:,:,:,:,Krhs_a) = 0._wp 
    167375 
    168376      Agrif_UseSpecialValue = ln_spc_dyn 
     377      use_sign_north = .TRUE. 
     378      sign_north = -1. 
    169379      CALL Agrif_Bc_variable(un_interp_id,calledweight=1.,procname=interpun) 
    170380      CALL Agrif_Bc_variable(vn_interp_id,calledweight=1.,procname=interpvn) 
    … …  
    175385      tabspongedone_v = .FALSE. 
    176386      CALL Agrif_Bc_variable(vn_sponge_id,calledweight=1.,procname=interpvn_sponge) 
     387      use_sign_north = .FALSE. 
    177388      uu(:,:,:,Krhs_a) = 0._wp 
    178389      vv(:,:,:,Krhs_a) = 0._wp 
    … …  
    185396      IF ( ln_dynspg_ts ) THEN 
    186397         Agrif_UseSpecialValue = ln_spc_dyn 
     398         use_sign_north = .TRUE. 
     399         sign_north = -1. 
    187400         CALL Agrif_Bc_variable(unb_id,calledweight=1.,procname=interpunb) 
    188401         CALL Agrif_Bc_variable(vnb_id,calledweight=1.,procname=interpvnb) 
    189402         CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b) 
    190403         CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b) 
     404         use_sign_north = .FALSE. 
    191405         ubdy(:,:) = 0._wp 
    192406         vbdy(:,:) = 0._wp 
    193407      ENDIF 
    194  
    195       Agrif_UseSpecialValue = .FALSE. 
    196  
    197       ! 3. Some controls 
     408      Agrif_UseSpecialValue = .FALSE.  
     409 
    198410      !----------------- 
    199411      check_namelist = .TRUE. 
    200412 
    201413      IF( check_namelist ) THEN  
    202  
    203          ! Check time steps            
    204          IF( NINT(Agrif_Rhot()) * NINT(rn_Dt) .NE. Agrif_Parent(rn_Dt) ) THEN 
    205             WRITE(cl_check1,*)  NINT(Agrif_Parent(rn_Dt)) 
    206             WRITE(cl_check2,*)  NINT(rn_Dt) 
    207             WRITE(cl_check3,*)  NINT(Agrif_Parent(rn_Dt)/Agrif_Rhot()) 
    208             CALL ctl_stop( 'Incompatible time step between ocean grids',   & 
    209                   &               'parent grid value : '//cl_check1    ,   &  
    210                   &               'child  grid value : '//cl_check2    ,   &  
    211                   &               'value on child grid should be changed to : '//cl_check3 ) 
    212          ENDIF 
    213  
    214          ! Check run length 
    215          IF( Agrif_IRhot() * (Agrif_Parent(nitend)- & 
    216                Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN 
    217             WRITE(cl_check1,*)  (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 
    218             WRITE(cl_check2,*)   Agrif_Parent(nitend)   *Agrif_IRhot() 
    219             CALL ctl_warn( 'Incompatible run length between grids'                      ,   & 
    220                   &               'nit000 on fine grid will be changed to : '//cl_check1,   & 
    221                   &               'nitend on fine grid will be changed to : '//cl_check2    ) 
    222             nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 
    223             nitend =  Agrif_Parent(nitend)   *Agrif_IRhot() 
    224          ENDIF 
    225  
    226414         ! Check free surface scheme 
    227415         IF ( ( Agrif_Parent(ln_dynspg_ts ).AND.ln_dynspg_exp ).OR.& 
    … …  
    251439            STOP 
    252440         ENDIF 
    253  
    254       ENDIF 
    255  
    256       ! check if masks and bathymetries match 
    257       IF(ln_chk_bathy) THEN 
    258          Agrif_UseSpecialValue = .FALSE. 
    259          ! 
    260          IF(lwp) WRITE(numout,*) ' ' 
    261          IF(lwp) WRITE(numout,*) 'AGRIF: Check Bathymetry and masks near bdys. Level: ', Agrif_Level() 
    262          ! 
    263          kindic_agr = 0 
    264 # if ! defined key_vertical 
    265          ! 
    266          ! check if tmask and vertical scale factors agree with parent in sponge area: 
    267          CALL Agrif_Bc_variable(e3t_id,calledweight=1.,procname=interpe3t) 
    268          ! 
    269 # else 
    270          ! 
    271          ! In case of vertical interpolation, check only that total depths agree between child and parent: 
    272          DO_2D_00_00 
    273             IF ((mbkt_parent(ji,jj)/=0).AND.(ABS(ht0_parent(ji,jj)-ht_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1 
    274             IF ((mbku_parent(ji,jj)/=0).AND.(ABS(hu0_parent(ji,jj)-hu_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1 
    275             IF ((mbkv_parent(ji,jj)/=0).AND.(ABS(hv0_parent(ji,jj)-hv_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1 
    276          END_2D 
    277 # endif 
    278          CALL mpp_sum( 'agrif_user', kindic_agr ) 
    279          IF( kindic_agr /= 0 ) THEN 
    280             CALL ctl_stop('==> Child Bathymetry is NOT correct near boundaries.') 
    281          ELSE 
    282             IF(lwp) WRITE(numout,*) '==> Child Bathymetry is ok near boundaries.' 
    283             IF(lwp) WRITE(numout,*) ' ' 
    284          END IF   
    285          !     
    286 !!$         IF(lwp) WRITE(numout,*) ' ' 
    287 !!$         IF(lwp) WRITE(numout,*) 'AGRIF: Check longitude and latitude near bdys. Level: ', Agrif_Level() 
    288 !!$         ! 
    289 !!$         ! check glamt in sponge area: 
    290 !!$         kindic_agr = 0 
    291 !!$         CALL Agrif_Bc_variable(glamt_id,calledweight=1.,procname=interpglamt) 
    292 !!$         CALL mpp_sum( 'agrif_user', kindic_agr ) 
    293 !!$         IF( kindic_agr /= 0 ) THEN 
    294 !!$            CALL ctl_stop('==> Child glamt is NOT correct near boundaries.')1 
    295 !!$         ELSE 
    296 !!$            IF(lwp) WRITE(numout,*) '==> Child glamt is ok near boundaries.' 
    297 !!$            IF(lwp) WRITE(numout,*) ' ' 
    298 !!$         END IF   
    299 !!$         ! 
    300 !!$         ! check gphit in sponge area: 
    301 !!$         kindic_agr = 0 
    302 !!$         CALL Agrif_Bc_variable(gphit_id,calledweight=1.,procname=interpgphit) 
    303 !!$         CALL mpp_sum( 'agrif_user', kindic_agr ) 
    304 !!$         IF( kindic_agr /= 0 ) THEN 
    305 !!$            CALL ctl_stop('==> Child gphit is NOT correct near boundaries.') 
    306 !!$         ELSE 
    307 !!$            IF(lwp) WRITE(numout,*) '==> Child gphit is ok near boundaries.' 
    308 !!$            IF(lwp) WRITE(numout,*) ' ' 
    309 !!$         END IF   
    310          ! 
    311       ENDIF 
    312  
    313 # if defined key_vertical 
    314       ! Additional constrain that should be removed someday: 
    315       IF ( Agrif_Parent(jpk).GT.jpk ) THEN 
    316     CALL ctl_stop( ' With key_vertical, child grids must have jpk greater or equal to the parent value' ) 
    317       ENDIF 
    318 # endif 
    319       !  
     441      ENDIF 
     442 
    320443   END SUBROUTINE Agrif_InitValues_cont 
    321444 
    … …  
    337460      ! 1. Declaration of the type of variable which have to be interpolated 
    338461      !--------------------------------------------------------------------- 
    339       ind1 =          nbghostcells       ! do the interpolation over nbghostcells points 
    340       ind2 = nn_hls + nbghostcells + 1   ! U/V points: array index of the first point in the reference grid  
    341       ind3 = nn_hls + nbghostcells + 2   ! T   points: array index of the first point in the reference grid  
     462      ind1 =              nbghostcells 
     463      ind2 = nn_hls + 2 + nbghostcells_x 
     464      ind3 = nn_hls + 2 + nbghostcells_y_s 
    342465# if defined key_vertical 
    343       CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts+1/),tsn_id) 
    344       CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts+1/),tsn_sponge_id) 
    345  
    346       CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_interp_id) 
    347       CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_interp_id) 
    348       CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_update_id) 
    349       CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_update_id) 
    350       CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_sponge_id) 
    351       CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_sponge_id) 
     466      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts+1/),tsn_id) 
     467      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts+1/),tsn_sponge_id) 
     468      CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_interp_id) 
     469      CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_interp_id) 
     470      CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_update_id) 
     471      CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_update_id) 
     472      CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_sponge_id) 
     473      CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_sponge_id) 
    352474# else 
    353       CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsn_id) 
    354       CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsn_sponge_id) 
    355  
    356       CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),un_interp_id) 
    357       CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),vn_interp_id) 
    358       CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),un_update_id) 
    359       CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),vn_update_id) 
    360       CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),un_sponge_id) 
    361       CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),vn_sponge_id) 
     475      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsn_id) 
     476      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsn_sponge_id) 
     477      CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),un_interp_id) 
     478      CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),vn_interp_id) 
     479      CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),un_update_id) 
     480      CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),vn_update_id) 
     481      CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),un_sponge_id) 
     482      CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),vn_sponge_id) 
    362483# endif 
    363  
    364       CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),e3t_id) 
    365       CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),glamt_id) 
    366       CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),gphit_id) 
    367  
    368 # if defined key_vertical 
    369       CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),mbkt_id) 
    370       CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ht0_id) 
    371 # endif 
    372  
    373       CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,3/),scales_t_id) 
    374  
    375       CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),unb_id) 
    376       CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vnb_id) 
    377       CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ub2b_interp_id) 
    378       CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vb2b_interp_id) 
    379       CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ub2b_update_id) 
    380       CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vb2b_update_id) 
    381  
    382       CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),sshn_id) 
    383  
    384       IF( ln_zdftke.OR.ln_zdfgls ) THEN 
     484      CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),unb_id) 
     485      CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vnb_id) 
     486      CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ub2b_interp_id) 
     487      CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vb2b_interp_id) 
     488      CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ub2b_update_id) 
     489      CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vb2b_update_id) 
     490 
     491!      CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),glamt_id) 
     492!      CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),gphit_id) 
     493      CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),sshn_id) 
     494 
     495 
     496      IF( ln_zdftke.OR.ln_zdfgls ) THEN  ! logical not known at this point 
    385497!         CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/), en_id) 
    386498!         CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id) 
    387499# if defined key_vertical 
    388          CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),avm_id) 
     500         CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),avm_id) 
    389501# else 
    390          CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),avm_id) 
     502         CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),avm_id) 
    391503# endif 
    392504      ENDIF 
    393  
     505      
    394506      ! 2. Type of interpolation 
    395507      !------------------------- 
    396508      CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear) 
    397  
    398509      CALL Agrif_Set_bcinterp(un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    399510      CALL Agrif_Set_bcinterp(vn_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
    400511 
    401512      CALL Agrif_Set_bcinterp(tsn_sponge_id,interp=AGRIF_linear) 
     513      CALL Agrif_Set_bcinterp(un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
     514      CALL Agrif_Set_bcinterp(vn_sponge_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
    402515 
    403516      CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_linear) 
    … …  
    415528!< 
    416529 
    417       CALL Agrif_Set_bcinterp(un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    418       CALL Agrif_Set_bcinterp(vn_sponge_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
    419  
    420       CALL Agrif_Set_bcinterp(  e3t_id,interp=AGRIF_constant) 
    421       CALL Agrif_Set_bcinterp(gphit_id,interp=AGRIF_constant) 
    422       CALL Agrif_Set_bcinterp(glamt_id,interp=AGRIF_constant) 
    423  
    424 # if defined key_vertical 
    425       CALL Agrif_Set_bcinterp(mbkt_id,interp=AGRIF_constant) 
    426       CALL Agrif_Set_bcinterp(ht0_id ,interp=AGRIF_constant) 
    427 # endif 
    428  
    429       IF( ln_zdftke.OR.ln_zdfgls )   CALL Agrif_Set_bcinterp( avm_id, interp=AGRIF_linear ) 
     530      IF( ln_zdftke.OR.ln_zdfgls )  CALL Agrif_Set_bcinterp( avm_id, interp=AGRIF_linear ) 
     531     
     532 
     533!      CALL Agrif_Set_bcinterp(gphit_id,interp=AGRIF_constant) 
     534!      CALL Agrif_Set_bcinterp(glamt_id,interp=AGRIF_constant) 
    430535 
    431536      ! 3. Location of interpolation 
    … …  
    445550      CALL Agrif_Set_bc( vb2b_interp_id, (/0,ind1-1/) ) 
    446551 
    447 !      CALL Agrif_Set_bc(  e3t_id, (/-nn_sponge_len*Agrif_irhox(),ind1-1/) )   
    448 ! JC: check near the boundary only until matching in sponge has been sorted out: 
    449       CALL Agrif_Set_bc(  e3t_id, (/0,ind1-1/) )   
     552      IF( ln_zdftke.OR.ln_zdfgls ) CALL Agrif_Set_bc( avm_id, (/0,ind1/) ) 
    450553      CALL Agrif_Set_bc(glamt_id, (/0,ind1-1/) )   
    451554      CALL Agrif_Set_bc(gphit_id, (/0,ind1-1/) )   
    452555 
    453 # if defined key_vertical  
    454       ! extend the interpolation zone by 1 more point than necessary: 
    455       CALL Agrif_Set_bc(  mbkt_id, (/-nn_sponge_len*Agrif_irhox()-2,ind1/) ) 
    456       CALL Agrif_Set_bc(  ht0_id,  (/-nn_sponge_len*Agrif_irhox()-2,ind1/) ) 
    457 # endif 
    458  
    459       IF( ln_zdftke.OR.ln_zdfgls )   CALL Agrif_Set_bc( avm_id, (/0,ind1/) ) 
    460  
    461556      ! 4. Update type 
    462557      !---------------  
    463       CALL Agrif_Set_Updatetype(scales_t_id, update = AGRIF_Update_Average) 
    464558 
    465559# if defined UPD_HIGH 
    … …  
    473567      CALL Agrif_Set_Updatetype(e3t_id, update = Agrif_Update_Full_Weighting) 
    474568 
    475       IF( ln_zdftke.OR.ln_zdfgls ) THEN 
     569  !    IF( ln_zdftke.OR.ln_zdfgls ) THEN 
    476570!         CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Full_Weighting) 
    477571!         CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Full_Weighting) 
    478572!         CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Full_Weighting) 
    479       ENDIF 
     573   !   ENDIF 
    480574 
    481575#else 
    … …  
    489583      CALL Agrif_Set_Updatetype(e3t_id, update = AGRIF_Update_Average) 
    490584 
    491       IF( ln_zdftke.OR.ln_zdfgls ) THEN 
     585 !     IF( ln_zdftke.OR.ln_zdfgls ) THEN 
    492586!         CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Average) 
    493587!         CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Average) 
    494588!         CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Average) 
    495       ENDIF 
     589 !     ENDIF 
    496590 
    497591#endif 
    … …  
    501595#if defined key_si3 
    502596SUBROUTINE Agrif_InitValues_cont_ice 
    503       !!---------------------------------------------------------------------- 
    504       !!                 *** ROUTINE Agrif_InitValues_cont_ice *** 
    505       !!---------------------------------------------------------------------- 
    506597      USE Agrif_Util 
    507598      USE sbc_oce, ONLY : nn_fsbc  ! clem: necessary otherwise Agrif_Parent(nn_fsbc) = nn_fsbc 
    … …  
    511602      USE agrif_ice_interp 
    512603      USE lib_mpp 
    513       ! 
    514       IMPLICIT NONE 
    515       !!---------------------------------------------------------------------- 
    516       ! 
    517       ! Declaration of the type of variable which have to be interpolated (parent=>child) 
    518       !---------------------------------------------------------------------------------- 
    519       CALL agrif_declare_var_ice 
     604      !!---------------------------------------------------------------------- 
     605      !!                 *** ROUTINE Agrif_InitValues_cont_ice *** 
     606      !!---------------------------------------------------------------------- 
    520607 
    521608      ! Controls 
    … …  
    524611      !          the run must satisfy CFL=Uice/(dx/dt) < 0.6/nn_fsbc(child) 
    525612      !          therefore, if nn_fsbc(child)>1 one must reduce the time-step in proportion to nn_fsbc(child), which is not acceptable 
    526       !       If a solution is found, the following stop could be removed because the rest of the code take nn_fsbc(child) into account 
     613      !       If a solution is found, the following stop could be removed because the rest of the code take nn_fsbc(child) into account      
    527614      IF( nn_fsbc > 1 )  CALL ctl_stop('nn_fsbc(child) must be set to 1 otherwise agrif and sea-ice may not work properly') 
    528615 
    … …  
    545632      !!                 *** ROUTINE agrif_declare_var_ice *** 
    546633      !!---------------------------------------------------------------------- 
     634 
    547635      USE Agrif_Util 
    548636      USE ice 
    549       USE par_oce, ONLY : nbghostcells 
     637      USE par_oce, ONLY : nbghostcells, nbghostcells_x, nbghostcells_y_s 
    550638      ! 
    551639      IMPLICIT NONE 
    552640      ! 
    553641      INTEGER :: ind1, ind2, ind3 
    554       !!---------------------------------------------------------------------- 
     642         !!---------------------------------------------------------------------- 
    555643      ! 
    556644      ! 1. Declaration of the type of variable which have to be interpolated (parent=>child) 
    … …  
    561649      !                            2,2 = two ghost lines 
    562650      !------------------------------------------------------------------------------------- 
    563       ind1 =          nbghostcells       ! do the interpolation over nbghostcells points 
    564       ind2 = nn_hls + nbghostcells + 1   ! U/V points: array index of the first point in the reference grid  
    565       ind3 = nn_hls + nbghostcells + 2   ! T   points: array index of the first point in the reference grid  
    566       CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpl*(8+nlay_s+nlay_i)/),tra_ice_id) 
    567       CALL agrif_declare_variable((/1,2/)  ,(/ind2,ind3/)  ,(/'x','y'/)    ,(/1,1/)  ,(/jpi,jpj/)                      ,u_ice_id  ) 
    568       CALL agrif_declare_variable((/2,1/)  ,(/ind3,ind2/)  ,(/'x','y'/)    ,(/1,1/)  ,(/jpi,jpj/)                      ,v_ice_id  ) 
     651      ind1 =              nbghostcells 
     652      ind2 = nn_hls + 2 + nbghostcells_x 
     653      ind3 = nn_hls + 2 + nbghostcells_y_s 
     654      CALL agrif_declare_variable((/2,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpl*(8+nlay_s+nlay_i)/),tra_ice_id) 
     655      CALL agrif_declare_variable((/1,2/)  ,(/ind2-1,ind3/)  ,(/'x','y'/)    ,(/1,1/)  ,(/jpi,jpj/)                      ,u_ice_id  ) 
     656      CALL agrif_declare_variable((/2,1/)  ,(/ind2,ind3-1/)  ,(/'x','y'/)    ,(/1,1/)  ,(/jpi,jpj/)                      ,v_ice_id  ) 
     657 
     658      CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpl*(8+nlay_s+nlay_i)/),tra_iceini_id) 
     659      CALL agrif_declare_variable((/1,2/)  ,(/ind2-1,ind3/)  ,(/'x','y'/)    ,(/1,1/)  ,(/jpi,jpj/)                      ,u_iceini_id  ) 
     660      CALL agrif_declare_variable((/2,1/)  ,(/ind2,ind3-1/)  ,(/'x','y'/)    ,(/1,1/)  ,(/jpi,jpj/)                      ,v_iceini_id  ) 
    569661 
    570662      ! 2. Set interpolations (normal & tangent to the grid cell for velocities) 
    … …  
    574666      CALL Agrif_Set_bcinterp(v_ice_id  , interp1 = AGRIF_ppm   ,interp2 = Agrif_linear) 
    575667 
     668      CALL Agrif_Set_bcinterp(tra_iceini_id, interp  = AGRIF_linear) 
     669      CALL Agrif_Set_interp  (tra_iceini_id, interp  = AGRIF_linear) 
     670      CALL Agrif_Set_bcinterp(u_iceini_id  , interp  = AGRIF_linear  ) 
     671      CALL Agrif_Set_interp  (u_iceini_id  , interp  = AGRIF_linear   ) 
     672      CALL Agrif_Set_bcinterp(v_iceini_id  , interp  = AGRIF_linear) 
     673      CALL Agrif_Set_interp  (v_iceini_id  , interp  = AGRIF_linear) 
     674 
    576675      ! 3. Set location of interpolations 
    577676      !---------------------------------- 
    … …  
    579678      CALL Agrif_Set_bc(u_ice_id  ,(/0,ind1/)) 
    580679      CALL Agrif_Set_bc(v_ice_id  ,(/0,ind1/)) 
     680 
     681      CALL Agrif_Set_bc(tra_iceini_id,(/0,ind1/)) 
     682      CALL Agrif_Set_bc(u_iceini_id  ,(/0,ind1/)) 
     683      CALL Agrif_Set_bc(v_iceini_id  ,(/0,ind1/)) 
    581684 
    582685      ! 4. Set update type in case 2 ways (child=>parent) (normal & tangent to the grid cell for velocities) 
    … …  
    586689      CALL Agrif_Set_Updatetype(u_ice_id  , update1 = Agrif_Update_Average       , update2 = Agrif_Update_Full_Weighting) 
    587690      CALL Agrif_Set_Updatetype(v_ice_id  , update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average       ) 
    588 #else 
     691# else 
    589692      CALL Agrif_Set_Updatetype(tra_ice_id, update  = AGRIF_Update_Average) 
    590693      CALL Agrif_Set_Updatetype(u_ice_id  , update1 = Agrif_Update_Copy   , update2 = Agrif_Update_Average) 
    591694      CALL Agrif_Set_Updatetype(v_ice_id  , update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy   ) 
    592 #endif 
     695# endif 
    593696 
    594697   END SUBROUTINE agrif_declare_var_ice 
    … …  
    614717      USE agrif_top_sponge 
    615718      !! 
    616       IMPLICIT NONE 
    617       ! 
    618       CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3 
    619       LOGICAL :: check_namelist 
    620       !!---------------------------------------------------------------------- 
    621  
    622       ! 1. Declaration of the type of variable which have to be interpolated 
    623       !--------------------------------------------------------------------- 
    624       CALL agrif_declare_var_top 
    625  
    626       ! 2. First interpolations of potentially non zero fields 
    627       !------------------------------------------------------- 
    628       Agrif_SpecialValue=0._wp 
    629       Agrif_UseSpecialValue = .TRUE. 
    630       CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn) 
    631       Agrif_UseSpecialValue = .FALSE. 
    632       CALL Agrif_Sponge 
    633       tabspongedone_trn = .FALSE. 
    634       CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge) 
    635       ! reset ts(:,:,:,:,Krhs_a) to zero 
    636       tr(:,:,:,:,Krhs_a) = 0._wp 
    637  
    638       ! 3. Some controls 
    639       !----------------- 
    640       check_namelist = .TRUE. 
    641  
    642       IF( check_namelist ) THEN 
    643          ! Check time steps 
    644       IF( NINT(Agrif_Rhot()) * NINT(rn_Dt) .NE. Agrif_Parent(rn_Dt) ) THEN 
    645          WRITE(cl_check1,*)  Agrif_Parent(rn_Dt) 
    646          WRITE(cl_check2,*)  rn_Dt 
    647          WRITE(cl_check3,*)  rn_Dt*Agrif_Rhot() 
     719   
     720   !! 
     721   IMPLICIT NONE 
     722   ! 
     723   CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3 
     724   LOGICAL :: check_namelist 
     725      !!---------------------------------------------------------------------- 
     726 
     727 
     728   ! 1. Declaration of the type of variable which have to be interpolated 
     729   !--------------------------------------------------------------------- 
     730   CALL agrif_declare_var_top 
     731 
     732   ! 2. First interpolations of potentially non zero fields 
     733   !------------------------------------------------------- 
     734   Agrif_SpecialValue=0. 
     735   Agrif_UseSpecialValue = .TRUE. 
     736   CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn) 
     737   Agrif_UseSpecialValue = .FALSE. 
     738   CALL Agrif_Sponge 
     739   tabspongedone_trn = .FALSE. 
     740   CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge) 
     741   ! reset tsa to zero 
     742   tra(:,:,:,:) = 0. 
     743 
     744   ! 3. Some controls 
     745   !----------------- 
     746   check_namelist = .TRUE. 
     747 
     748   IF( check_namelist ) THEN 
     749      ! Check time steps 
     750      IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN 
     751         WRITE(cl_check1,*)  Agrif_Parent(rdt) 
     752         WRITE(cl_check2,*)  rdt 
     753         WRITE(cl_check3,*)  rdt*Agrif_Rhot() 
    648754         CALL ctl_stop( 'incompatible time step between grids',   & 
    649755               &               'parent grid value : '//cl_check1    ,   &  
    … …  
    664770         nitend =  Agrif_Parent(nitend)   *Agrif_IRhot() 
    665771      ENDIF 
    666  
    667772   ENDIF 
    668773   ! 
    … …  
    684789      !!---------------------------------------------------------------------- 
    685790 
     791 
     792 
     793!RB_CMEMS : declare here init for top       
    686794      ! 1. Declaration of the type of variable which have to be interpolated 
    687795      !--------------------------------------------------------------------- 
    688       ind1 =          nbghostcells       ! do the interpolation over nbghostcells points 
    689       ind2 = nn_hls + nbghostcells + 1   ! U/V points: array index of the first point in the reference grid  
    690       ind3 = nn_hls + nbghostcells + 2   ! T   points: array index of the first point in the reference grid  
     796      ind1 =              nbghostcells 
     797      ind2 = nn_hls + 2 + nbghostcells_x 
     798      ind3 = nn_hls + 2 + nbghostcells_y_s 
    691799# if defined key_vertical 
    692       CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra+1/),trn_id) 
    693       CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra+1/),trn_sponge_id) 
     800      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra+1/),trn_id) 
     801      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra+1/),trn_sponge_id) 
    694802# else 
    695       CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_id) 
    696       CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_sponge_id) 
     803! LAURENT: STRANGE why (3,3) here ? 
     804      CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_id) 
     805      CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_sponge_id) 
    697806# endif 
    698807 
    … …  
    734843      !!                     *** ROUTINE agrif_init *** 
    735844      !!---------------------------------------------------------------------- 
    736       USE agrif_oce  
    737       USE agrif_ice 
    738       USE in_out_manager 
    739       USE lib_mpp 
     845   USE agrif_oce  
     846   USE agrif_ice 
     847   USE dom_oce 
     848   USE in_out_manager 
     849   USE lib_mpp 
    740850      !! 
    741851      IMPLICIT NONE 
    742852      ! 
    743853      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    744       NAMELIST/namagrif/ ln_agrif_2way, rn_sponge_tra, rn_sponge_dyn, rn_trelax_tra, rn_trelax_dyn, & 
     854      NAMELIST/namagrif/ ln_agrif_2way, ln_init_chfrpar, rn_sponge_tra, rn_sponge_dyn, rn_trelax_tra, rn_trelax_dyn, & 
    745855                       & ln_spc_dyn, ln_chk_bathy 
    746856      !!-------------------------------------------------------------------------------------- 
    … …  
    758868         WRITE(numout,*) '   Namelist namagrif : set AGRIF parameters' 
    759869         WRITE(numout,*) '      Two way nesting activated ln_agrif_2way         = ', ln_agrif_2way 
    760          WRITE(numout,*) '      sponge coefficient for tracers    rn_sponge_tra = ', rn_sponge_tra, ' m^2/s' 
    761          WRITE(numout,*) '      sponge coefficient for dynamics   rn_sponge_tra = ', rn_sponge_dyn, ' m^2/s' 
    762          WRITE(numout,*) '      time relaxation for tracers       rn_trelax_tra = ', rn_trelax_tra, ' ad.' 
    763          WRITE(numout,*) '      time relaxation for dynamics      rn_trelax_dyn = ', rn_trelax_dyn, ' ad.' 
     870         WRITE(numout,*) '      child initial state from parent ln_init_chfrpar = ', ln_init_chfrpar 
     871         WRITE(numout,*) '      ad. sponge coeft for tracers      rn_sponge_tra = ', rn_sponge_tra 
     872         WRITE(numout,*) '      ad. sponge coeft for dynamics     rn_sponge_tra = ', rn_sponge_dyn 
     873         WRITE(numout,*) '      ad. time relaxation for tracers   rn_trelax_tra = ', rn_trelax_tra 
     874         WRITE(numout,*) '      ad. time relaxation for dynamics  rn_trelax_dyn = ', rn_trelax_dyn 
    764875         WRITE(numout,*) '      use special values for dynamics   ln_spc_dyn    = ', ln_spc_dyn 
    765876         WRITE(numout,*) '      check bathymetry                  ln_chk_bathy  = ', ln_chk_bathy 
    766877      ENDIF 
    767       ! 
    768       ! 
    769       IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed') 
     878 
     879      lk_west  = .NOT. ( Agrif_Ix() == 1 ) 
     880      lk_east  = .NOT. ( Agrif_Ix() + nbcellsx/AGRIF_Irhox() == Agrif_Parent(jpiglo) -1 ) 
     881      lk_south = .NOT. ( Agrif_Iy() == 1 ) 
     882      lk_north = .NOT. ( Agrif_Iy() + nbcellsy/AGRIF_Irhoy() == Agrif_Parent(jpjglo) -1 ) 
     883 
     884      ! 
     885      ! Set the number of ghost cells according to periodicity 
     886      nbghostcells_x = nbghostcells 
     887      nbghostcells_y_s = nbghostcells 
     888      nbghostcells_y_n = nbghostcells 
     889      ! 
     890      IF ( jperio == 1 ) nbghostcells_x = 0 
     891      IF ( .NOT. lk_south ) nbghostcells_y_s = 0 
     892 
     893      ! Some checks 
     894      IF( jpiglo /= nbcellsx + 2 + 2*nbghostcells_x )   & 
     895          CALL ctl_stop( 'STOP', 'agrif_nemo_init: Agrif children requires jpiglo == nbcellsx + 2 + 2*nbghostcells_x' ) 
     896      IF( jpjglo /= nbcellsy + 2 + nbghostcells_y_s + nbghostcells_y_n )   & 
     897          CALL ctl_stop( 'STOP', 'agrif_nemo_init: Agrif children requires jpjglo == nbcellsy + 2 + nbghostcells_y_s + nbghostcells_y_n' ) 
     898      IF( ln_use_jattr )   CALL ctl_stop( 'STOP', 'agrif_nemo_init:Agrif children requires ln_use_jattr = .false. ' ) 
    770899      ! 
    771900   END SUBROUTINE agrif_nemo_init 
    772901 
    773902# if defined key_mpp_mpi 
    774  
    775903   SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob ) 
    776904      !!---------------------------------------------------------------------- 
    … …  
    831959# endif 
    832960 
     961   SUBROUTINE nemo_mapping(ndim,ptx,pty,bounds,bounds_chunks,correction_required,nb_chunks) 
     962      !!---------------------------------------------------------------------- 
     963      !!                   *** ROUTINE Nemo_mapping *** 
     964      !!---------------------------------------------------------------------- 
     965      USE dom_oce 
     966      !! 
     967      IMPLICIT NONE 
     968      ! 
     969      INTEGER :: ndim 
     970      INTEGER :: ptx, pty 
     971      INTEGER, DIMENSION(ndim,2,2) :: bounds 
     972      INTEGER, DIMENSION(:,:,:,:), ALLOCATABLE :: bounds_chunks 
     973      LOGICAL, DIMENSION(:), ALLOCATABLE :: correction_required 
     974      INTEGER :: nb_chunks 
     975      ! 
     976      INTEGER :: i 
     977 
     978      IF (agrif_debug_interp) THEN 
     979         DO i=1,ndim 
     980            WRITE(*,*) 'direction = ',i,bounds(i,1,2),bounds(i,2,2) 
     981         ENDDO 
     982      ENDIF 
     983 
     984      IF( bounds(2,2,2) > jpjglo) THEN 
     985         IF( bounds(2,1,2) <=jpjglo) THEN 
     986            nb_chunks = 2 
     987            ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2)) 
     988            ALLOCATE(correction_required(nb_chunks)) 
     989            DO i = 1,nb_chunks 
     990               bounds_chunks(i,:,:,:) = bounds 
     991            END DO 
     992         
     993      ! FIRST CHUNCK (for j<=jpjglo)    
     994 
     995      ! Original indices 
     996            bounds_chunks(1,1,1,1) = bounds(1,1,2) 
     997            bounds_chunks(1,1,2,1) = bounds(1,2,2) 
     998            bounds_chunks(1,2,1,1) = bounds(2,1,2) 
     999            bounds_chunks(1,2,2,1) = jpjglo 
     1000 
     1001            bounds_chunks(1,1,1,2) = bounds(1,1,2) 
     1002            bounds_chunks(1,1,2,2) = bounds(1,2,2) 
     1003            bounds_chunks(1,2,1,2) = bounds(2,1,2) 
     1004            bounds_chunks(1,2,2,2) = jpjglo 
     1005 
     1006      ! Correction required or not 
     1007            correction_required(1)=.FALSE. 
     1008        
     1009      ! SECOND CHUNCK (for j>jpjglo) 
     1010 
     1011      ! Original indices 
     1012            bounds_chunks(2,1,1,1) = bounds(1,1,2) 
     1013            bounds_chunks(2,1,2,1) = bounds(1,2,2) 
     1014            bounds_chunks(2,2,1,1) = jpjglo-2 
     1015            bounds_chunks(2,2,2,1) = bounds(2,2,2) 
     1016 
     1017      ! Where to find them 
     1018      ! We use the relation TAB(ji,jj)=TAB(jpiglo-ji+2,jpjglo-2-(jj-jpjglo)) 
     1019 
     1020            IF( ptx == 2) THEN ! T, V points 
     1021               bounds_chunks(2,1,1,2) = jpiglo-bounds(1,2,2)+2 
     1022               bounds_chunks(2,1,2,2) = jpiglo-bounds(1,1,2)+2 
     1023            ELSE ! U, F points 
     1024               bounds_chunks(2,1,1,2) = jpiglo-bounds(1,2,2)+1 
     1025               bounds_chunks(2,1,2,2) = jpiglo-bounds(1,1,2)+1        
     1026            ENDIF 
     1027 
     1028            IF( pty == 2) THEN ! T, U points 
     1029               bounds_chunks(2,2,1,2) = jpjglo-2-(bounds(2,2,2) -jpjglo) 
     1030               bounds_chunks(2,2,2,2) = jpjglo-2-(jpjglo-2      -jpjglo) 
     1031            ELSE ! V, F points 
     1032               bounds_chunks(2,2,1,2) = jpjglo-3-(bounds(2,2,2) -jpjglo) 
     1033               bounds_chunks(2,2,2,2) = jpjglo-3-(jpjglo-2      -jpjglo) 
     1034            ENDIF 
     1035      ! Correction required or not 
     1036            correction_required(2)=.TRUE. 
     1037 
     1038         ELSE 
     1039            nb_chunks = 1 
     1040            ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2)) 
     1041            ALLOCATE(correction_required(nb_chunks)) 
     1042            DO i=1,nb_chunks 
     1043               bounds_chunks(i,:,:,:) = bounds 
     1044            END DO 
     1045 
     1046            bounds_chunks(1,1,1,1) = bounds(1,1,2) 
     1047            bounds_chunks(1,1,2,1) = bounds(1,2,2) 
     1048            bounds_chunks(1,2,1,1) = bounds(2,1,2) 
     1049            bounds_chunks(1,2,2,1) = bounds(2,2,2) 
     1050 
     1051            bounds_chunks(1,1,1,2) = jpiglo-bounds(1,2,2)+2 
     1052            bounds_chunks(1,1,2,2) = jpiglo-bounds(1,1,2)+2 
     1053 
     1054            bounds_chunks(1,2,1,2) = jpjglo-2-(bounds(2,2,2)-jpjglo) 
     1055            bounds_chunks(1,2,2,2) = jpjglo-2-(bounds(2,1,2)-jpjglo) 
     1056 
     1057            IF( ptx == 2) THEN ! T, V points 
     1058               bounds_chunks(1,1,1,2) = jpiglo-bounds(1,2,2)+2 
     1059               bounds_chunks(1,1,2,2) = jpiglo-bounds(1,1,2)+2 
     1060            ELSE ! U, F points 
     1061               bounds_chunks(1,1,1,2) = jpiglo-bounds(1,2,2)+1 
     1062               bounds_chunks(1,1,2,2) = jpiglo-bounds(1,1,2)+1        
     1063            ENDIF 
     1064 
     1065            IF (pty == 2) THEN ! T, U points 
     1066               bounds_chunks(1,2,1,2) = jpjglo-2-(bounds(2,2,2) -jpjglo) 
     1067               bounds_chunks(1,2,2,2) = jpjglo-2-(bounds(2,1,2) -jpjglo) 
     1068            ELSE ! V, F points 
     1069               bounds_chunks(1,2,1,2) = jpjglo-3-(bounds(2,2,2) -jpjglo) 
     1070               bounds_chunks(1,2,2,2) = jpjglo-3-(bounds(2,1,2) -jpjglo) 
     1071            ENDIF 
     1072 
     1073            correction_required(1)=.TRUE.           
     1074         ENDIF 
     1075 
     1076      ELSE IF (bounds(1,1,2) < 1) THEN 
     1077         IF (bounds(1,2,2) > 0) THEN 
     1078            nb_chunks = 2 
     1079            ALLOCATE(correction_required(nb_chunks)) 
     1080            correction_required=.FALSE. 
     1081            ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2)) 
     1082            DO i=1,nb_chunks 
     1083               bounds_chunks(i,:,:,:) = bounds 
     1084            END DO 
     1085               
     1086            bounds_chunks(1,1,1,2) = bounds(1,1,2)+jpiglo-2 
     1087            bounds_chunks(1,1,2,2) = 1+jpiglo-2 
     1088           
     1089            bounds_chunks(1,1,1,1) = bounds(1,1,2) 
     1090            bounds_chunks(1,1,2,1) = 1 
     1091        
     1092            bounds_chunks(2,1,1,2) = 2 
     1093            bounds_chunks(2,1,2,2) = bounds(1,2,2) 
     1094           
     1095            bounds_chunks(2,1,1,1) = 2 
     1096            bounds_chunks(2,1,2,1) = bounds(1,2,2) 
     1097 
     1098         ELSE 
     1099            nb_chunks = 1 
     1100            ALLOCATE(correction_required(nb_chunks)) 
     1101            correction_required=.FALSE. 
     1102            ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2)) 
     1103            DO i=1,nb_chunks 
     1104               bounds_chunks(i,:,:,:) = bounds 
     1105            END DO     
     1106            bounds_chunks(1,1,1,2) = bounds(1,1,2)+jpiglo-2 
     1107            bounds_chunks(1,1,2,2) = bounds(1,2,2)+jpiglo-2 
     1108           
     1109            bounds_chunks(1,1,1,1) = bounds(1,1,2) 
     1110           bounds_chunks(1,1,2,1) = bounds(1,2,2) 
     1111         ENDIF 
     1112      ELSE 
     1113         nb_chunks=1   
     1114         ALLOCATE(correction_required(nb_chunks)) 
     1115         correction_required=.FALSE. 
     1116         ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2)) 
     1117         DO i=1,nb_chunks 
     1118            bounds_chunks(i,:,:,:) = bounds 
     1119         END DO 
     1120         bounds_chunks(1,1,1,2) = bounds(1,1,2) 
     1121         bounds_chunks(1,1,2,2) = bounds(1,2,2) 
     1122         bounds_chunks(1,2,1,2) = bounds(2,1,2) 
     1123         bounds_chunks(1,2,2,2) = bounds(2,2,2) 
     1124           
     1125         bounds_chunks(1,1,1,1) = bounds(1,1,2) 
     1126         bounds_chunks(1,1,2,1) = bounds(1,2,2) 
     1127         bounds_chunks(1,2,1,1) = bounds(2,1,2) 
     1128         bounds_chunks(1,2,2,1) = bounds(2,2,2)               
     1129      ENDIF 
     1130         
     1131   END SUBROUTINE nemo_mapping 
     1132 
     1133   FUNCTION agrif_external_switch_index(ptx,pty,i1,isens) 
     1134 
     1135   USE dom_oce 
     1136 
     1137   INTEGER :: ptx, pty, i1, isens 
     1138   INTEGER :: agrif_external_switch_index 
     1139 
     1140   IF( isens == 1 ) THEN 
     1141      IF( ptx == 2 ) THEN ! T, V points 
     1142         agrif_external_switch_index = jpiglo-i1+2 
     1143      ELSE ! U, F points 
     1144         agrif_external_switch_index = jpiglo-i1+1       
     1145      ENDIF 
     1146   ELSE IF( isens ==2 ) THEN 
     1147      IF ( pty == 2 ) THEN ! T, U points 
     1148         agrif_external_switch_index = jpjglo-2-(i1 -jpjglo) 
     1149      ELSE ! V, F points 
     1150         agrif_external_switch_index = jpjglo-3-(i1 -jpjglo) 
     1151      ENDIF 
     1152   ENDIF 
     1153 
     1154   END FUNCTION agrif_external_switch_index 
     1155 
     1156   SUBROUTINE Correct_field(tab2d,i1,i2,j1,j2) 
     1157      !!---------------------------------------------------------------------- 
     1158      !!                   *** ROUTINE Correct_field *** 
     1159      !!---------------------------------------------------------------------- 
     1160    
     1161   USE dom_oce 
     1162   USE agrif_oce 
     1163 
     1164   INTEGER :: i1,i2,j1,j2 
     1165   REAL(wp), DIMENSION(i1:i2,j1:j2) :: tab2d 
     1166 
     1167   INTEGER :: i,j 
     1168   REAL(wp), DIMENSION(i1:i2,j1:j2) :: tab2dtemp 
     1169 
     1170   tab2dtemp = tab2d 
     1171 
     1172   IF( .NOT. use_sign_north ) THEN 
     1173      DO j=j1,j2 
     1174         DO i=i1,i2 
     1175            tab2d(i,j)=tab2dtemp(i2-(i-i1),j2-(j-j1)) 
     1176         END DO 
     1177      END DO 
     1178   ELSE 
     1179      DO j=j1,j2 
     1180         DO i=i1,i2 
     1181            tab2d(i,j)=sign_north * tab2dtemp(i2-(i-i1),j2-(j-j1)) 
     1182         END DO 
     1183      END DO 
     1184   ENDIF 
     1185 
     1186   END SUBROUTINE Correct_field 
     1187 
    8331188#else 
    8341189   SUBROUTINE Subcalledbyagrif 
Note: See TracChangeset for help on using the changeset viewer.