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 12377 for NEMO/trunk/src/NST/agrif_user.F90 – NEMO

Ignore:
Timestamp:
2020-02-12T15:39:06+01:00 (4 years ago)
Author:
acc
Message:

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge --ignore-ancestry \

​svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
​svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The --ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.

Location:
NEMO/trunk
Files:
2 edited

Legend:

Unmodified
Added
Removed

  • NEMO/trunk

    • Property svn:externals

      •  

        old new  
        33^/utils/build/mk@HEAD         mk 
        44^/utils/tools@HEAD            tools 
        5 ^/vendors/AGRIF/dev@HEAD      ext/AGRIF 
         5^/vendors/AGRIF/dev_r11615_ENHANCE-04_namelists_as_internalfiles_agrif@HEAD      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 

  • NEMO/trunk/src/NST/agrif_user.F90

    r12138 r12377  
    11#undef UPD_HIGH   /* MIX HIGH UPDATE */ 
    22#if defined key_agrif 
     3   !! * Substitutions 
     4#  include "do_loop_substitute.h90" 
    35   !!---------------------------------------------------------------------- 
    46   !! NEMO/NST 4.0 , NEMO Consortium (2018) 
    … …  
    68   !! Software governed by the CeCILL license (see ./LICENSE) 
    79   !!---------------------------------------------------------------------- 
    8 SUBROUTINE agrif_user 
    9 END SUBROUTINE agrif_user 
    10  
    11 SUBROUTINE agrif_before_regridding 
    12 END SUBROUTINE agrif_before_regridding 
    13  
    14 SUBROUTINE Agrif_InitWorkspace 
    15       !!---------------------------------------------------------------------- 
    16       !!                 *** ROUTINE Agrif_InitWorkspace *** 
    17       !!---------------------------------------------------------------------- 
    18    USE par_oce 
    19    USE dom_oce 
    20    USE nemogcm 
    21    USE mppini 
    22       !! 
    23    IMPLICIT NONE 
    24       !!---------------------------------------------------------------------- 
    25    ! 
    26    IF( .NOT. Agrif_Root() ) THEN 
    27       ! no more static variables 
    28 !!$! JC: change to allow for different vertical levels 
    29 !!$!     jpk is already set 
    30 !!$!     keep it jpk possibly different from jpkglo which  
    31 !!$!     hold parent grid vertical levels number (set earlier) 
    32 !!$!      jpk     = jpkglo  
    33    ENDIF 
    34    ! 
    35 END SUBROUTINE Agrif_InitWorkspace 
    36  
    37  
    38 SUBROUTINE Agrif_InitValues 
     10   SUBROUTINE agrif_user 
     11   END SUBROUTINE agrif_user 
     12 
     13   SUBROUTINE agrif_before_regridding 
     14   END SUBROUTINE agrif_before_regridding 
     15 
     16   SUBROUTINE Agrif_InitWorkspace 
     17   END SUBROUTINE Agrif_InitWorkspace 
     18 
     19   SUBROUTINE Agrif_InitValues 
    3920      !!---------------------------------------------------------------------- 
    4021      !!                 *** ROUTINE Agrif_InitValues *** 
    41       !! 
    42       !! ** Purpose :: Declaration of variables to be interpolated 
    43       !!---------------------------------------------------------------------- 
    44    USE Agrif_Util 
    45    USE oce  
    46    USE dom_oce 
    47    USE nemogcm 
    48    USE tradmp 
    49    USE bdy_oce   , ONLY: ln_bdy 
    50    !! 
    51    IMPLICIT NONE 
    52       !!---------------------------------------------------------------------- 
    53    ! 
    54    CALL nemo_init       !* Initializations of each fine grid 
    55  
    56    !                    !* Agrif initialization 
    57    CALL agrif_nemo_init 
    58    CALL Agrif_InitValues_cont_dom 
    59    CALL Agrif_InitValues_cont 
     22      !!---------------------------------------------------------------------- 
     23      USE nemogcm 
     24      !!---------------------------------------------------------------------- 
     25      ! 
     26      CALL nemo_init       !* Initializations of each fine grid 
     27      Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs   ! agrif_oce module copies of time level indices 
     28      ! 
     29      !                    !* Agrif initialization 
     30      CALL agrif_nemo_init 
     31      CALL Agrif_InitValues_cont_dom 
     32      CALL Agrif_InitValues_cont 
    6033# if defined key_top 
    61    CALL Agrif_InitValues_cont_top 
     34      CALL Agrif_InitValues_cont_top 
    6235# endif 
    6336# if defined key_si3 
    64    CALL Agrif_InitValues_cont_ice 
    65 # endif 
    66    !     
    67 END SUBROUTINE Agrif_initvalues 
    68  
    69  
    70 SUBROUTINE Agrif_InitValues_cont_dom 
    71       !!---------------------------------------------------------------------- 
    72       !!                 *** ROUTINE Agrif_InitValues_cont *** 
    73       !! 
    74       !! ** Purpose ::   Declaration of variables to be interpolated 
    75       !!---------------------------------------------------------------------- 
    76    USE Agrif_Util 
    77    USE oce  
    78    USE dom_oce 
    79    USE nemogcm 
    80    USE in_out_manager 
    81    USE agrif_oce_update 
    82    USE agrif_oce_interp 
    83    USE agrif_oce_sponge 
    84    ! 
    85    IMPLICIT NONE 
    86       !!---------------------------------------------------------------------- 
    87    ! 
    88    ! Declaration of the type of variable which have to be interpolated 
    89    ! 
    90    CALL agrif_declare_var_dom 
    91    ! 
    92 END SUBROUTINE Agrif_InitValues_cont_dom 
    93  
    94  
    95 SUBROUTINE agrif_declare_var_dom 
    96       !!---------------------------------------------------------------------- 
    97       !!                 *** ROUTINE agrif_declare_var *** 
    98       !! 
    99       !! ** Purpose :: Declaration of variables to be interpolated 
    100       !!---------------------------------------------------------------------- 
    101    USE agrif_util 
    102    USE par_oce        
    103    USE oce 
    104    ! 
    105    IMPLICIT NONE 
    106    ! 
    107    INTEGER :: ind1, ind2, ind3 
     37      CALL Agrif_InitValues_cont_ice 
     38# endif 
     39      !     
     40   END SUBROUTINE Agrif_initvalues 
     41 
     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       
     56      ! 
     57      IMPLICIT NONE 
     58      ! 
     59      INTEGER :: ind1, ind2, ind3 
    10860      !!---------------------------------------------------------------------- 
    10961 
    11062      ! 1. Declaration of the type of variable which have to be interpolated 
    11163      !--------------------------------------------------------------------- 
    112    ind1 =     nbghostcells 
    113    ind2 = 1 + nbghostcells 
    114    ind3 = 2 + nbghostcells 
    115    CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e1u_id) 
    116    CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e2v_id) 
     64      ind1 =     nbghostcells 
     65      ind2 = 1 + nbghostcells 
     66      ind3 = 2 + nbghostcells 
     67      CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e1u_id) 
     68      CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e2v_id) 
    11769 
    11870      ! 2. Type of interpolation 
    11971      !------------------------- 
    120    CALL Agrif_Set_bcinterp( e1u_id, interp1=Agrif_linear, interp2=AGRIF_ppm    ) 
    121    CALL Agrif_Set_bcinterp( e2v_id, interp1=AGRIF_ppm   , interp2=Agrif_linear ) 
     72      CALL Agrif_Set_bcinterp( e1u_id, interp1=Agrif_linear, interp2=AGRIF_ppm    ) 
     73      CALL Agrif_Set_bcinterp( e2v_id, interp1=AGRIF_ppm   , interp2=Agrif_linear ) 
    12274 
    12375      ! 3. Location of interpolation 
    12476      !----------------------------- 
    125    CALL Agrif_Set_bc(e1u_id,(/0,ind1-1/)) 
    126    CALL Agrif_Set_bc(e2v_id,(/0,ind1-1/)) 
     77      CALL Agrif_Set_bc(e1u_id,(/0,ind1-1/)) 
     78      CALL Agrif_Set_bc(e2v_id,(/0,ind1-1/)) 
    12779 
    12880      ! 4. Update type 
    12981      !---------------  
    13082# if defined UPD_HIGH 
    131    CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Full_Weighting) 
    132    CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Full_Weighting, update2=Agrif_Update_Average) 
     83      CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Full_Weighting) 
     84      CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Full_Weighting, update2=Agrif_Update_Average) 
    13385#else 
    134    CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average) 
    135    CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy) 
     86      CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average) 
     87      CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy) 
    13688#endif 
    13789 
    138 END SUBROUTINE agrif_declare_var_dom 
    139  
    140  
    141 SUBROUTINE Agrif_InitValues_cont 
     90   END SUBROUTINE agrif_declare_var_dom 
     91 
     92   SUBROUTINE Agrif_InitValues_cont 
    14293      !!---------------------------------------------------------------------- 
    14394      !!                 *** ROUTINE Agrif_InitValues_cont *** 
    144       !! 
    145       !! ** Purpose ::   Declaration of variables to be interpolated 
    146       !!---------------------------------------------------------------------- 
    147    USE agrif_oce_update 
    148    USE agrif_oce_interp 
    149    USE agrif_oce_sponge 
    150    USE Agrif_Util 
    151    USE oce  
    152    USE dom_oce 
    153    USE zdf_oce 
    154    USE nemogcm 
    155    ! 
    156    USE lib_mpp 
    157    USE in_out_manager 
    158    ! 
    159    IMPLICIT NONE 
    160    ! 
    161    LOGICAL :: check_namelist 
    162    CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3, cl_check4  
    163       !!---------------------------------------------------------------------- 
    164  
    165    ! 1. Declaration of the type of variable which have to be interpolated 
    166    !--------------------------------------------------------------------- 
    167    CALL agrif_declare_var 
    168  
    169    ! 2. First interpolations of potentially non zero fields 
    170    !------------------------------------------------------- 
    171    Agrif_SpecialValue    = 0._wp 
    172    Agrif_UseSpecialValue = .TRUE. 
    173    CALL Agrif_Bc_variable(tsn_id,calledweight=1.,procname=interptsn) 
    174    CALL Agrif_Sponge 
    175    tabspongedone_tsn = .FALSE. 
    176    CALL Agrif_Bc_variable(tsn_sponge_id,calledweight=1.,procname=interptsn_sponge) 
    177    ! reset tsa to zero 
    178    tsa(:,:,:,:) = 0. 
    179  
    180    Agrif_UseSpecialValue = ln_spc_dyn 
    181    CALL Agrif_Bc_variable(un_interp_id,calledweight=1.,procname=interpun) 
    182    CALL Agrif_Bc_variable(vn_interp_id,calledweight=1.,procname=interpvn) 
    183    tabspongedone_u = .FALSE. 
    184    tabspongedone_v = .FALSE. 
    185    CALL Agrif_Bc_variable(un_sponge_id,calledweight=1.,procname=interpun_sponge) 
    186    tabspongedone_u = .FALSE. 
    187    tabspongedone_v = .FALSE. 
    188    CALL Agrif_Bc_variable(vn_sponge_id,calledweight=1.,procname=interpvn_sponge) 
    189  
    190    Agrif_UseSpecialValue = .TRUE. 
    191    CALL Agrif_Bc_variable(sshn_id,calledweight=1., procname=interpsshn ) 
    192    hbdy_w(:,:) = 0.e0 ; hbdy_e(:,:) = 0.e0 ; hbdy_n(:,:) = 0.e0 ; hbdy_s(:,:) = 0.e0 
    193    ssha(:,:) = 0.e0 
    194  
    195    IF ( ln_dynspg_ts ) THEN 
     95      !!---------------------------------------------------------------------- 
     96      USE agrif_oce 
     97      USE agrif_oce_interp 
     98      USE agrif_oce_sponge 
     99      USE dom_oce 
     100      USE oce 
     101      USE lib_mpp 
     102      USE lbclnk 
     103      ! 
     104      IMPLICIT NONE 
     105      ! 
     106      INTEGER :: ji, jj 
     107      LOGICAL :: check_namelist 
     108      CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3, cl_check4  
     109#if defined key_vertical 
     110      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 
     122      ! Build consistent parent bathymetry and number of levels 
     123      ! on the child grid  
     124      Agrif_UseSpecialValue = .FALSE. 
     125      ht0_parent(:,:) = 0._wp 
     126      mbkt_parent(:,:) = 0 
     127      ! 
     128      CALL Agrif_Bc_variable(ht0_id ,calledweight=1.,procname=interpht0 ) 
     129      CALL Agrif_Bc_variable(mbkt_id,calledweight=1.,procname=interpmbkt) 
     130      ! 
     131      ! Assume step wise change of bathymetry near interface 
     132      ! TODO: Switch to linear interpolation of bathymetry in the s-coordinate case 
     133      !       and no refinement 
     134      DO_2D_10_10 
     135         mbku_parent(ji,jj) = MIN(  mbkt_parent(ji+1,jj  ) , mbkt_parent(ji,jj)  ) 
     136         mbkv_parent(ji,jj) = MIN(  mbkt_parent(ji  ,jj+1) , mbkt_parent(ji,jj)  ) 
     137      END_2D 
     138      IF ( ln_sco.AND.Agrif_Parent(ln_sco) ) THEN  
     139         DO_2D_10_10 
     140            hu0_parent(ji,jj) = 0.5_wp * ( ht0_parent(ji,jj)+ht0_parent(ji+1,jj) ) 
     141            hv0_parent(ji,jj) = 0.5_wp * ( ht0_parent(ji,jj)+ht0_parent(ji,jj+1) ) 
     142         END_2D 
     143      ELSE 
     144         DO_2D_10_10 
     145            hu0_parent(ji,jj) = MIN( ht0_parent(ji,jj), ht0_parent(ji+1,jj)) 
     146            hv0_parent(ji,jj) = MIN( ht0_parent(ji,jj), ht0_parent(ji,jj+1)) 
     147         END_2D 
     148 
     149      ENDIF 
     150      ! 
     151      CALL lbc_lnk( 'Agrif_InitValues_cont', hu0_parent, 'U', 1. ) 
     152      CALL lbc_lnk( 'Agrif_InitValues_cont', hv0_parent, 'V', 1. ) 
     153      zk(:,:) = REAL( mbku_parent(:,:), wp )   ;   CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'U', 1. ) 
     154      mbku_parent(:,:) = MAX( NINT( zk(:,:) ), 1 ) 
     155      zk(:,:) = REAL( mbkv_parent(:,:), wp )   ;   CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'V', 1. ) 
     156      mbkv_parent(:,:) = MAX( NINT( zk(:,:) ), 1 )    
     157#endif 
     158 
     159      Agrif_SpecialValue    = 0._wp 
     160      Agrif_UseSpecialValue = .TRUE. 
     161      CALL Agrif_Bc_variable(tsn_id,calledweight=1.,procname=interptsn) 
     162      CALL Agrif_Sponge 
     163      tabspongedone_tsn = .FALSE. 
     164      CALL Agrif_Bc_variable(tsn_sponge_id,calledweight=1.,procname=interptsn_sponge) 
     165      ! reset ts(:,:,:,:,Krhs_a) to zero 
     166      ts(:,:,:,:,Krhs_a) = 0._wp 
     167 
    196168      Agrif_UseSpecialValue = ln_spc_dyn 
    197       CALL Agrif_Bc_variable(unb_id,calledweight=1.,procname=interpunb) 
    198       CALL Agrif_Bc_variable(vnb_id,calledweight=1.,procname=interpvnb) 
    199       CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b) 
    200       CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b) 
    201       ubdy_w(:,:) = 0.e0 ; vbdy_w(:,:) = 0.e0 
    202       ubdy_e(:,:) = 0.e0 ; vbdy_e(:,:) = 0.e0 
    203       ubdy_n(:,:) = 0.e0 ; vbdy_n(:,:) = 0.e0 
    204       ubdy_s(:,:) = 0.e0 ; vbdy_s(:,:) = 0.e0 
    205    ENDIF 
    206  
    207    Agrif_UseSpecialValue = .FALSE.  
    208    ! reset velocities to zero 
    209    ua(:,:,:) = 0. 
    210    va(:,:,:) = 0. 
    211  
    212    ! 3. Some controls 
    213    !----------------- 
    214    check_namelist = .TRUE. 
    215  
    216    IF( check_namelist ) THEN  
    217  
    218       ! Check time steps            
    219       IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN 
    220          WRITE(cl_check1,*)  NINT(Agrif_Parent(rdt)) 
    221          WRITE(cl_check2,*)  NINT(rdt) 
    222          WRITE(cl_check3,*)  NINT(Agrif_Parent(rdt)/Agrif_Rhot()) 
    223          CALL ctl_stop( 'Incompatible time step between ocean grids',   & 
    224                &               'parent grid value : '//cl_check1    ,   &  
    225                &               'child  grid value : '//cl_check2    ,   &  
    226                &               'value on child grid should be changed to : '//cl_check3 ) 
    227       ENDIF 
    228  
    229       ! Check run length 
    230       IF( Agrif_IRhot() * (Agrif_Parent(nitend)- & 
    231             Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN 
    232          WRITE(cl_check1,*)  (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 
    233          WRITE(cl_check2,*)   Agrif_Parent(nitend)   *Agrif_IRhot() 
    234          CALL ctl_warn( 'Incompatible run length between grids'                      ,   & 
    235                &               'nit000 on fine grid will be changed to : '//cl_check1,   & 
    236                &               'nitend on fine grid will be changed to : '//cl_check2    ) 
    237          nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 
    238          nitend =  Agrif_Parent(nitend)   *Agrif_IRhot() 
    239       ENDIF 
    240  
    241       ! Check free surface scheme 
    242       IF ( ( Agrif_Parent(ln_dynspg_ts ).AND.ln_dynspg_exp ).OR.& 
    243          & ( Agrif_Parent(ln_dynspg_exp).AND.ln_dynspg_ts ) ) THEN 
    244          WRITE(cl_check1,*)  Agrif_Parent( ln_dynspg_ts ) 
    245          WRITE(cl_check2,*)  ln_dynspg_ts 
    246          WRITE(cl_check3,*)  Agrif_Parent( ln_dynspg_exp ) 
    247          WRITE(cl_check4,*)  ln_dynspg_exp 
    248          CALL ctl_stop( 'Incompatible free surface scheme between grids' ,  & 
    249                &               'parent grid ln_dynspg_ts  :'//cl_check1  ,  &  
    250                &               'child  grid ln_dynspg_ts  :'//cl_check2  ,  & 
    251                &               'parent grid ln_dynspg_exp :'//cl_check3  ,  & 
    252                &               'child  grid ln_dynspg_exp :'//cl_check4  ,  & 
    253                &               'those logicals should be identical' )                  
    254          STOP 
    255       ENDIF 
    256  
    257       ! Check if identical linear free surface option 
    258       IF ( ( Agrif_Parent(ln_linssh ).AND.(.NOT.ln_linssh )).OR.& 
    259          & ( (.NOT.Agrif_Parent(ln_linssh)).AND.ln_linssh ) ) THEN 
    260          WRITE(cl_check1,*)  Agrif_Parent(ln_linssh ) 
    261          WRITE(cl_check2,*)  ln_linssh 
    262          CALL ctl_stop( 'Incompatible linearized fs option between grids',  & 
    263                &               'parent grid ln_linssh  :'//cl_check1     ,  & 
    264                &               'child  grid ln_linssh  :'//cl_check2     ,  & 
    265                &               'those logicals should be identical' )                   
    266          STOP 
     169      CALL Agrif_Bc_variable(un_interp_id,calledweight=1.,procname=interpun) 
     170      CALL Agrif_Bc_variable(vn_interp_id,calledweight=1.,procname=interpvn) 
     171      tabspongedone_u = .FALSE. 
     172      tabspongedone_v = .FALSE. 
     173      CALL Agrif_Bc_variable(un_sponge_id,calledweight=1.,procname=interpun_sponge) 
     174      tabspongedone_u = .FALSE. 
     175      tabspongedone_v = .FALSE. 
     176      CALL Agrif_Bc_variable(vn_sponge_id,calledweight=1.,procname=interpvn_sponge) 
     177      uu(:,:,:,Krhs_a) = 0._wp 
     178      vv(:,:,:,Krhs_a) = 0._wp 
     179 
     180      Agrif_UseSpecialValue = .TRUE. 
     181      CALL Agrif_Bc_variable(sshn_id,calledweight=1., procname=interpsshn ) 
     182      hbdy(:,:) = 0._wp 
     183      ssh(:,:,Krhs_a) = 0._wp 
     184 
     185      IF ( ln_dynspg_ts ) THEN 
     186         Agrif_UseSpecialValue = ln_spc_dyn 
     187         CALL Agrif_Bc_variable(unb_id,calledweight=1.,procname=interpunb) 
     188         CALL Agrif_Bc_variable(vnb_id,calledweight=1.,procname=interpvnb) 
     189         CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b) 
     190         CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b) 
     191         ubdy(:,:) = 0._wp 
     192         vbdy(:,:) = 0._wp 
     193      ENDIF 
     194 
     195      Agrif_UseSpecialValue = .FALSE. 
     196 
     197      ! 3. Some controls 
     198      !----------------- 
     199      check_namelist = .TRUE. 
     200 
     201      IF( check_namelist ) THEN  
     202 
     203         ! Check time steps            
     204         IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN 
     205            WRITE(cl_check1,*)  NINT(Agrif_Parent(rdt)) 
     206            WRITE(cl_check2,*)  NINT(rdt) 
     207            WRITE(cl_check3,*)  NINT(Agrif_Parent(rdt)/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 
     226         ! Check free surface scheme 
     227         IF ( ( Agrif_Parent(ln_dynspg_ts ).AND.ln_dynspg_exp ).OR.& 
     228            & ( Agrif_Parent(ln_dynspg_exp).AND.ln_dynspg_ts ) ) THEN 
     229            WRITE(cl_check1,*)  Agrif_Parent( ln_dynspg_ts ) 
     230            WRITE(cl_check2,*)  ln_dynspg_ts 
     231            WRITE(cl_check3,*)  Agrif_Parent( ln_dynspg_exp ) 
     232            WRITE(cl_check4,*)  ln_dynspg_exp 
     233            CALL ctl_stop( 'Incompatible free surface scheme between grids' ,  & 
     234                  &               'parent grid ln_dynspg_ts  :'//cl_check1  ,  &  
     235                  &               'child  grid ln_dynspg_ts  :'//cl_check2  ,  & 
     236                  &               'parent grid ln_dynspg_exp :'//cl_check3  ,  & 
     237                  &               'child  grid ln_dynspg_exp :'//cl_check4  ,  & 
     238                  &               'those logicals should be identical' )                  
     239            STOP 
     240         ENDIF 
     241 
     242         ! Check if identical linear free surface option 
     243         IF ( ( Agrif_Parent(ln_linssh ).AND.(.NOT.ln_linssh )).OR.& 
     244            & ( (.NOT.Agrif_Parent(ln_linssh)).AND.ln_linssh ) ) THEN 
     245            WRITE(cl_check1,*)  Agrif_Parent(ln_linssh ) 
     246            WRITE(cl_check2,*)  ln_linssh 
     247            CALL ctl_stop( 'Incompatible linearized fs option between grids',  & 
     248                  &               'parent grid ln_linssh  :'//cl_check1     ,  & 
     249                  &               'child  grid ln_linssh  :'//cl_check2     ,  & 
     250                  &               'those logicals should be identical' )                   
     251            STOP 
     252         ENDIF 
     253 
    267254      ENDIF 
    268255 
    269256      ! check if masks and bathymetries match 
    270257      IF(ln_chk_bathy) THEN 
     258         Agrif_UseSpecialValue = .FALSE. 
    271259         ! 
     260         IF(lwp) WRITE(numout,*) ' ' 
    272261         IF(lwp) WRITE(numout,*) 'AGRIF: Check Bathymetry and masks near bdys. Level: ', Agrif_Level() 
    273262         ! 
    274263         kindic_agr = 0 
    275          ! check if umask agree with parent along western and eastern boundaries: 
    276          CALL Agrif_Bc_variable(umsk_id,calledweight=1.,procname=interpumsk) 
    277          ! check if vmask agree with parent along northern and southern boundaries: 
    278          CALL Agrif_Bc_variable(vmsk_id,calledweight=1.,procname=interpvmsk) 
    279          ! check if tmask and vertical scale factors agree with parent over first two coarse grid points: 
     264# if ! defined key_vertical 
     265         ! 
     266         ! check if tmask and vertical scale factors agree with parent in sponge area: 
    280267         CALL Agrif_Bc_variable(e3t_id,calledweight=1.,procname=interpe3t) 
    281268         ! 
     269# else 
     270         ! 
     271         ! In case of vertical interpolation, check only that total depths agree between child and parent: 
     272         DO ji = 1, jpi 
     273            DO jj = 1, jpj 
     274               IF ((mbkt_parent(ji,jj)/=0).AND.(ABS(ht0_parent(ji,jj)-ht_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1 
     275               IF ((mbku_parent(ji,jj)/=0).AND.(ABS(hu0_parent(ji,jj)-hu_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1 
     276               IF ((mbkv_parent(ji,jj)/=0).AND.(ABS(hv0_parent(ji,jj)-hv_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1 
     277            END DO 
     278         END DO 
     279# endif 
    282280         CALL mpp_sum( 'agrif_user', kindic_agr ) 
    283281         IF( kindic_agr /= 0 ) THEN 
    284             CALL ctl_stop('Child Bathymetry is not correct near boundaries.') 
     282            CALL ctl_stop('==> Child Bathymetry is NOT correct near boundaries.') 
    285283         ELSE 
    286             IF(lwp) WRITE(numout,*) 'Child Bathymetry is ok near boundaries.' 
    287          END IF 
    288       ENDIF 
    289       ! 
    290    ENDIF 
    291    !  
    292 END SUBROUTINE Agrif_InitValues_cont 
    293  
    294 SUBROUTINE agrif_declare_var 
    295       !!---------------------------------------------------------------------- 
    296       !!                 *** ROUTINE agrif_declarE_var *** 
    297       !! 
    298       !! ** Purpose :: Declaration of variables to be interpolated 
    299       !!---------------------------------------------------------------------- 
    300    USE agrif_util 
    301    USE agrif_oce 
    302    USE par_oce       ! ocean parameters 
    303    USE zdf_oce       ! vertical physics 
    304    USE oce 
    305    ! 
    306    IMPLICIT NONE 
    307    ! 
    308    INTEGER :: ind1, ind2, ind3 
    309       !!---------------------------------------------------------------------- 
    310  
    311    ! 1. Declaration of the type of variable which have to be interpolated 
    312    !--------------------------------------------------------------------- 
    313    ind1 =     nbghostcells 
    314    ind2 = 1 + nbghostcells 
    315    ind3 = 2 + nbghostcells 
     284            IF(lwp) WRITE(numout,*) '==> Child Bathymetry is ok near boundaries.' 
     285            IF(lwp) WRITE(numout,*) ' ' 
     286         END IF   
     287         !     
     288      ENDIF 
     289 
    316290# if defined key_vertical 
    317    CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts+1/),tsn_id) 
    318    CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts+1/),tsn_sponge_id) 
    319  
    320    CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_interp_id) 
    321    CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_interp_id) 
    322    CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_update_id) 
    323    CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_update_id) 
    324    CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_sponge_id) 
    325    CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_sponge_id) 
     291      ! Additional constrain that should be removed someday: 
     292      IF ( Agrif_Parent(jpk).GT.jpk ) THEN 
     293    CALL ctl_stop( ' With key_vertical, child grids must have jpk greater or equal to the parent value' ) 
     294      ENDIF 
     295# endif 
     296      !  
     297   END SUBROUTINE Agrif_InitValues_cont 
     298 
     299   SUBROUTINE agrif_declare_var 
     300      !!---------------------------------------------------------------------- 
     301      !!                 *** ROUTINE agrif_declare_var *** 
     302      !!---------------------------------------------------------------------- 
     303      USE agrif_util 
     304      USE agrif_oce 
     305      USE par_oce 
     306      USE zdf_oce  
     307      USE oce 
     308      ! 
     309      IMPLICIT NONE 
     310      ! 
     311      INTEGER :: ind1, ind2, ind3 
     312      !!---------------------------------------------------------------------- 
     313 
     314      ! 1. Declaration of the type of variable which have to be interpolated 
     315      !--------------------------------------------------------------------- 
     316      ind1 =     nbghostcells 
     317      ind2 = 1 + nbghostcells 
     318      ind3 = 2 + nbghostcells 
     319# if defined key_vertical 
     320      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts+1/),tsn_id) 
     321      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts+1/),tsn_sponge_id) 
     322 
     323      CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_interp_id) 
     324      CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_interp_id) 
     325      CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_update_id) 
     326      CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_update_id) 
     327      CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_sponge_id) 
     328      CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_sponge_id) 
    326329# else 
    327    CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_id) 
    328    CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_sponge_id) 
    329  
    330    CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_interp_id) 
    331    CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_interp_id) 
    332    CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_update_id) 
    333    CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_update_id) 
    334    CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_sponge_id) 
    335    CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_sponge_id) 
    336 # endif 
    337  
    338    CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id) 
    339    CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),umsk_id) 
    340    CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vmsk_id) 
    341  
    342    CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,3/),scales_t_id) 
    343  
    344    CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),unb_id) 
    345    CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vnb_id) 
    346    CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_interp_id) 
    347    CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_interp_id) 
    348    CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_update_id) 
    349    CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_update_id) 
    350  
    351    CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id) 
    352  
    353    IF( ln_zdftke.OR.ln_zdfgls ) THEN 
    354 !      CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/), en_id) 
    355 !      CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),avt_id) 
     330      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_id) 
     331      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_sponge_id) 
     332 
     333      CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_interp_id) 
     334      CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_interp_id) 
     335      CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_update_id) 
     336      CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_update_id) 
     337      CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_sponge_id) 
     338      CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_sponge_id) 
     339# endif 
     340 
     341      CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id) 
     342 
    356343# if defined key_vertical 
    357       CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),avm_id) 
     344      CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),mbkt_id) 
     345      CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ht0_id) 
     346# endif 
     347 
     348      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,3/),scales_t_id) 
     349 
     350      CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),unb_id) 
     351      CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vnb_id) 
     352      CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_interp_id) 
     353      CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_interp_id) 
     354      CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_update_id) 
     355      CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_update_id) 
     356 
     357      CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id) 
     358 
     359      IF( ln_zdftke.OR.ln_zdfgls ) THEN 
     360!         CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/), en_id) 
     361!         CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),avt_id) 
     362# if defined key_vertical 
     363         CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),avm_id) 
    358364# else 
    359       CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),avm_id) 
    360 # endif 
    361    ENDIF 
    362  
    363    ! 2. Type of interpolation 
    364    !------------------------- 
    365    CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear) 
    366  
    367    CALL Agrif_Set_bcinterp(un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    368    CALL Agrif_Set_bcinterp(vn_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
    369  
    370    CALL Agrif_Set_bcinterp(tsn_sponge_id,interp=AGRIF_linear) 
    371  
    372    CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_linear) 
    373    CALL Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    374    CALL Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
    375    CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    376    CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
    377  
    378  
    379    CALL Agrif_Set_bcinterp(un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    380    CALL Agrif_Set_bcinterp(vn_sponge_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
    381  
    382    CALL Agrif_Set_bcinterp(e3t_id,interp=AGRIF_constant) 
    383    CALL Agrif_Set_bcinterp(umsk_id,interp=AGRIF_constant) 
    384    CALL Agrif_Set_bcinterp(vmsk_id,interp=AGRIF_constant) 
    385  
    386    IF( ln_zdftke.OR.ln_zdfgls )   CALL Agrif_Set_bcinterp( avm_id, interp=AGRIF_linear ) 
    387  
    388    ! 3. Location of interpolation 
    389    !----------------------------- 
    390    CALL Agrif_Set_bc(       tsn_id, (/0,ind1/) ) 
    391    CALL Agrif_Set_bc( un_interp_id, (/0,ind1/) ) 
    392    CALL Agrif_Set_bc( vn_interp_id, (/0,ind1/) ) 
    393  
    394    CALL Agrif_Set_bc( tsn_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) )  ! if west and rhox=3 and sponge=2 and ghost=1: columns 2 to 9  
    395    CALL Agrif_Set_bc(  un_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) ) 
    396    CALL Agrif_Set_bc(  vn_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) ) 
    397  
    398    CALL Agrif_Set_bc(        sshn_id, (/0,ind1-1/) ) 
    399    CALL Agrif_Set_bc(         unb_id, (/0,ind1-1/) ) 
    400    CALL Agrif_Set_bc(         vnb_id, (/0,ind1-1/) ) 
    401    CALL Agrif_Set_bc( ub2b_interp_id, (/0,ind1-1/) ) 
    402    CALL Agrif_Set_bc( vb2b_interp_id, (/0,ind1-1/) ) 
    403  
    404    CALL Agrif_Set_bc(  e3t_id, (/-nn_sponge_len*Agrif_irhox(),ind1-1/) )   ! if west and rhox=3 and ghost=1: column 2 to 6  
    405    CALL Agrif_Set_bc( umsk_id, (/0,0/) ) 
    406    CALL Agrif_Set_bc( vmsk_id, (/0,0/) ) 
    407  
    408  
    409    IF( ln_zdftke.OR.ln_zdfgls )   CALL Agrif_Set_bc( avm_id, (/0,ind1/) ) 
    410  
    411    ! 4. Update type 
    412    !---------------  
    413    CALL Agrif_Set_Updatetype(scales_t_id, update = AGRIF_Update_Average) 
     365         CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),avm_id) 
     366# endif 
     367      ENDIF 
     368 
     369      ! 2. Type of interpolation 
     370      !------------------------- 
     371      CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear) 
     372 
     373      CALL Agrif_Set_bcinterp(un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
     374      CALL Agrif_Set_bcinterp(vn_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
     375 
     376      CALL Agrif_Set_bcinterp(tsn_sponge_id,interp=AGRIF_linear) 
     377 
     378      CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_linear) 
     379      CALL Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
     380      CALL Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
     381      CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
     382      CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
     383! 
     384! > Divergence conserving alternative: 
     385!      CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_constant) 
     386!      CALL Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_constant) 
     387!      CALL Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_constant,interp2=Agrif_linear) 
     388!      CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_constant) 
     389!      CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_constant,interp2=Agrif_linear) 
     390!< 
     391 
     392      CALL Agrif_Set_bcinterp(un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
     393      CALL Agrif_Set_bcinterp(vn_sponge_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
     394 
     395      CALL Agrif_Set_bcinterp(e3t_id,interp=AGRIF_constant) 
     396 
     397# if defined key_vertical 
     398      CALL Agrif_Set_bcinterp(mbkt_id,interp=AGRIF_constant) 
     399      CALL Agrif_Set_bcinterp(ht0_id ,interp=AGRIF_constant) 
     400# endif 
     401 
     402      IF( ln_zdftke.OR.ln_zdfgls )   CALL Agrif_Set_bcinterp( avm_id, interp=AGRIF_linear ) 
     403 
     404      ! 3. Location of interpolation 
     405      !----------------------------- 
     406      CALL Agrif_Set_bc(       tsn_id, (/0,ind1-1/) ) ! if west,  rhox=3 and nbghost=3: columns 2 to 4 
     407      CALL Agrif_Set_bc( un_interp_id, (/0,ind1-1/) )  
     408      CALL Agrif_Set_bc( vn_interp_id, (/0,ind1-1/) ) 
     409 
     410      CALL Agrif_Set_bc( tsn_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) )  ! if west,  rhox=3, nn_sponge_len=2  
     411      CALL Agrif_Set_bc(  un_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) )  ! and nbghost=3:  
     412      CALL Agrif_Set_bc(  vn_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) )  ! columns 4 to 11 
     413 
     414      CALL Agrif_Set_bc(        sshn_id, (/0,ind1-1/) ) 
     415      CALL Agrif_Set_bc(         unb_id, (/0,ind1-1/) ) 
     416      CALL Agrif_Set_bc(         vnb_id, (/0,ind1-1/) ) 
     417      CALL Agrif_Set_bc( ub2b_interp_id, (/0,ind1-1/) ) 
     418      CALL Agrif_Set_bc( vb2b_interp_id, (/0,ind1-1/) ) 
     419 
     420!      CALL Agrif_Set_bc(  e3t_id, (/-nn_sponge_len*Agrif_irhox(),ind1-1/) )   
     421! JC: check near the boundary only until matching in sponge has been sorted out: 
     422      CALL Agrif_Set_bc(  e3t_id, (/0,ind1-1/) )   
     423 
     424# if defined key_vertical  
     425      ! extend the interpolation zone by 1 more point than necessary: 
     426      CALL Agrif_Set_bc(  mbkt_id, (/-nn_sponge_len*Agrif_irhox()-2,ind1/) ) 
     427      CALL Agrif_Set_bc(  ht0_id,  (/-nn_sponge_len*Agrif_irhox()-2,ind1/) ) 
     428# endif 
     429 
     430      IF( ln_zdftke.OR.ln_zdfgls )   CALL Agrif_Set_bc( avm_id, (/0,ind1/) ) 
     431 
     432      ! 4. Update type 
     433      !---------------  
     434      CALL Agrif_Set_Updatetype(scales_t_id, update = AGRIF_Update_Average) 
    414435 
    415436# if defined UPD_HIGH 
    416    CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting) 
    417    CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting) 
    418    CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average) 
    419  
    420    CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting) 
    421    CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average) 
    422    CALL Agrif_Set_Updatetype(sshn_id, update = Agrif_Update_Full_Weighting) 
    423    CALL Agrif_Set_Updatetype(e3t_id, update = Agrif_Update_Full_Weighting) 
    424  
    425    IF( ln_zdftke.OR.ln_zdfgls ) THEN 
    426 !      CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Full_Weighting) 
    427 !      CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Full_Weighting) 
    428 !      CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Full_Weighting) 
    429    ENDIF 
     437      CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting) 
     438      CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting) 
     439      CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average) 
     440 
     441      CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting) 
     442      CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average) 
     443      CALL Agrif_Set_Updatetype(sshn_id,update = Agrif_Update_Full_Weighting) 
     444      CALL Agrif_Set_Updatetype(e3t_id, update = Agrif_Update_Full_Weighting) 
     445 
     446      IF( ln_zdftke.OR.ln_zdfgls ) THEN 
     447!         CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Full_Weighting) 
     448!         CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Full_Weighting) 
     449!         CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Full_Weighting) 
     450      ENDIF 
    430451 
    431452#else 
    432    CALL Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average) 
    433    CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 
    434    CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 
    435  
    436    CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 
    437    CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 
    438    CALL Agrif_Set_Updatetype(sshn_id, update = AGRIF_Update_Average) 
    439    CALL Agrif_Set_Updatetype(e3t_id, update = AGRIF_Update_Average) 
    440  
    441    IF( ln_zdftke.OR.ln_zdfgls ) THEN 
    442 !      CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Average) 
    443 !      CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Average) 
    444 !      CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Average) 
    445    ENDIF 
     453      CALL Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average) 
     454      CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 
     455      CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 
     456 
     457      CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 
     458      CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 
     459      CALL Agrif_Set_Updatetype(sshn_id,update = AGRIF_Update_Average) 
     460      CALL Agrif_Set_Updatetype(e3t_id, update = AGRIF_Update_Average) 
     461 
     462      IF( ln_zdftke.OR.ln_zdfgls ) THEN 
     463!         CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Average) 
     464!         CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Average) 
     465!         CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Average) 
     466      ENDIF 
    446467 
    447468#endif 
    448    ! 
    449 END SUBROUTINE agrif_declare_var 
     469      ! 
     470   END SUBROUTINE agrif_declare_var 
    450471 
    451472#if defined key_si3 
    … …  
    453474      !!---------------------------------------------------------------------- 
    454475      !!                 *** ROUTINE Agrif_InitValues_cont_ice *** 
     476      !!---------------------------------------------------------------------- 
     477      USE Agrif_Util 
     478      USE sbc_oce, ONLY : nn_fsbc  ! clem: necessary otherwise Agrif_Parent(nn_fsbc) = nn_fsbc 
     479      USE ice 
     480      USE agrif_ice 
     481      USE in_out_manager 
     482      USE agrif_ice_interp 
     483      USE lib_mpp 
     484      ! 
     485      IMPLICIT NONE 
     486      !!---------------------------------------------------------------------- 
     487      ! 
     488      ! Declaration of the type of variable which have to be interpolated (parent=>child) 
     489      !---------------------------------------------------------------------------------- 
     490      CALL agrif_declare_var_ice 
     491 
     492      ! Controls 
     493 
     494      ! clem: For some reason, nn_fsbc(child)/=1 does not work properly (signal can be largely degraded by the agrif zoom) 
     495      !          the run must satisfy CFL=Uice/(dx/dt) < 0.6/nn_fsbc(child) 
     496      !          therefore, if nn_fsbc(child)>1 one must reduce the time-step in proportion to nn_fsbc(child), which is not acceptable 
     497      !       If a solution is found, the following stop could be removed because the rest of the code take nn_fsbc(child) into account 
     498      IF( nn_fsbc > 1 )  CALL ctl_stop('nn_fsbc(child) must be set to 1 otherwise agrif and sea-ice may not work properly') 
     499 
     500      ! stop if rhot * nn_fsbc(parent) /= N * nn_fsbc(child) with N being integer 
     501      IF( MOD( Agrif_irhot() * Agrif_Parent(nn_fsbc), nn_fsbc ) /= 0 )  THEN 
     502         CALL ctl_stop('rhot * nn_fsbc(parent) /= N * nn_fsbc(child), therefore nn_fsbc(child) should be set to 1 or nn_fsbc(parent)') 
     503      ENDIF 
     504      ! First Interpolations (using "after" ice subtime step => nbstep_ice=1) 
     505      !---------------------------------------------------------------------- 
     506      nbstep_ice = ( Agrif_irhot() * Agrif_Parent(nn_fsbc) / nn_fsbc ) ! clem: to have calledweight=1 in interp (otherwise the western border of the zoom is wrong) 
     507      CALL agrif_interp_ice('U') ! interpolation of ice velocities 
     508      CALL agrif_interp_ice('V') ! interpolation of ice velocities 
     509      CALL agrif_interp_ice('T') ! interpolation of ice tracers  
     510      nbstep_ice = 0    
     511      ! 
     512   END SUBROUTINE Agrif_InitValues_cont_ice 
     513 
     514   SUBROUTINE agrif_declare_var_ice 
     515      !!---------------------------------------------------------------------- 
     516      !!                 *** ROUTINE agrif_declare_var_ice *** 
     517      !!---------------------------------------------------------------------- 
     518      USE Agrif_Util 
     519      USE ice 
     520      USE par_oce, ONLY : nbghostcells 
     521      ! 
     522      IMPLICIT NONE 
     523      ! 
     524      INTEGER :: ind1, ind2, ind3 
     525      !!---------------------------------------------------------------------- 
     526      ! 
     527      ! 1. Declaration of the type of variable which have to be interpolated (parent=>child) 
     528      !       agrif_declare_variable(position,1st point index,--,--,dimensions,name) 
     529      !           ex.:  position=> 1,1 = not-centered (in i and j) 
     530      !                            2,2 =     centered (    -     ) 
     531      !                 index   => 1,1 = one ghost line 
     532      !                            2,2 = two ghost lines 
     533      !------------------------------------------------------------------------------------- 
     534      ind1 =     nbghostcells 
     535      ind2 = 1 + nbghostcells 
     536      ind3 = 2 + nbghostcells 
     537      CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpl*(8+nlay_s+nlay_i)/),tra_ice_id) 
     538      CALL agrif_declare_variable((/1,2/)  ,(/ind2,ind3/)  ,(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,u_ice_id  ) 
     539      CALL agrif_declare_variable((/2,1/)  ,(/ind3,ind2/)  ,(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,v_ice_id  ) 
     540 
     541      ! 2. Set interpolations (normal & tangent to the grid cell for velocities) 
     542      !----------------------------------- 
     543      CALL Agrif_Set_bcinterp(tra_ice_id, interp  = AGRIF_linear) 
     544      CALL Agrif_Set_bcinterp(u_ice_id  , interp1 = Agrif_linear,interp2 = AGRIF_ppm   ) 
     545      CALL Agrif_Set_bcinterp(v_ice_id  , interp1 = AGRIF_ppm   ,interp2 = Agrif_linear) 
     546 
     547      ! 3. Set location of interpolations 
     548      !---------------------------------- 
     549      CALL Agrif_Set_bc(tra_ice_id,(/0,ind1/)) 
     550      CALL Agrif_Set_bc(u_ice_id  ,(/0,ind1/)) 
     551      CALL Agrif_Set_bc(v_ice_id  ,(/0,ind1/)) 
     552 
     553      ! 4. Set update type in case 2 ways (child=>parent) (normal & tangent to the grid cell for velocities) 
     554      !-------------------------------------------------- 
     555# if defined UPD_HIGH 
     556      CALL Agrif_Set_Updatetype(tra_ice_id, update  = Agrif_Update_Full_Weighting) 
     557      CALL Agrif_Set_Updatetype(u_ice_id  , update1 = Agrif_Update_Average       , update2 = Agrif_Update_Full_Weighting) 
     558      CALL Agrif_Set_Updatetype(v_ice_id  , update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average       ) 
     559#else 
     560      CALL Agrif_Set_Updatetype(tra_ice_id, update  = AGRIF_Update_Average) 
     561      CALL Agrif_Set_Updatetype(u_ice_id  , update1 = Agrif_Update_Copy   , update2 = Agrif_Update_Average) 
     562      CALL Agrif_Set_Updatetype(v_ice_id  , update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy   ) 
     563#endif 
     564 
     565   END SUBROUTINE agrif_declare_var_ice 
     566#endif 
     567 
     568 
     569# if defined key_top 
     570   SUBROUTINE Agrif_InitValues_cont_top 
     571      !!---------------------------------------------------------------------- 
     572      !!                 *** ROUTINE Agrif_InitValues_cont_top *** 
     573      !!---------------------------------------------------------------------- 
     574      USE Agrif_Util 
     575      USE oce  
     576      USE dom_oce 
     577      USE nemogcm 
     578      USE par_trc 
     579      USE lib_mpp 
     580      USE trc 
     581      USE in_out_manager 
     582      USE agrif_oce_sponge 
     583      USE agrif_top_update 
     584      USE agrif_top_interp 
     585      USE agrif_top_sponge 
    455586      !! 
    456       !! ** Purpose :: Initialisation of variables to be interpolated for ice 
    457       !!---------------------------------------------------------------------- 
    458    USE Agrif_Util 
    459    USE sbc_oce, ONLY : nn_fsbc  ! clem: necessary otherwise Agrif_Parent(nn_fsbc) = nn_fsbc 
    460    USE ice 
    461    USE agrif_ice 
    462    USE in_out_manager 
    463    USE agrif_ice_interp 
    464    USE lib_mpp 
    465    ! 
    466    IMPLICIT NONE 
    467       !!---------------------------------------------------------------------- 
    468    ! 
    469    ! Declaration of the type of variable which have to be interpolated (parent=>child) 
    470    !---------------------------------------------------------------------------------- 
    471    CALL agrif_declare_var_ice 
    472  
    473    ! Controls 
    474  
    475    ! clem: For some reason, nn_fsbc(child)/=1 does not work properly (signal can be largely degraded by the agrif zoom) 
    476    !          the run must satisfy CFL=Uice/(dx/dt) < 0.6/nn_fsbc(child) 
    477    !          therefore, if nn_fsbc(child)>1 one must reduce the time-step in proportion to nn_fsbc(child), which is not acceptable 
    478    !       If a solution is found, the following stop could be removed because the rest of the code take nn_fsbc(child) into account 
    479    IF( nn_fsbc > 1 )  CALL ctl_stop('nn_fsbc(child) must be set to 1 otherwise agrif and sea-ice may not work properly') 
    480  
    481    ! stop if rhot * nn_fsbc(parent) /= N * nn_fsbc(child) with N being integer 
    482    IF( MOD( Agrif_irhot() * Agrif_Parent(nn_fsbc), nn_fsbc ) /= 0 )  THEN 
    483       CALL ctl_stop('rhot * nn_fsbc(parent) /= N * nn_fsbc(child), therefore nn_fsbc(child) should be set to 1 or nn_fsbc(parent)') 
    484    ENDIF 
    485    ! First Interpolations (using "after" ice subtime step => nbstep_ice=1) 
    486    !---------------------------------------------------------------------- 
    487    nbstep_ice = ( Agrif_irhot() * Agrif_Parent(nn_fsbc) / nn_fsbc ) ! clem: to have calledweight=1 in interp (otherwise the western border of the zoom is wrong) 
    488    CALL agrif_interp_ice('U') ! interpolation of ice velocities 
    489    CALL agrif_interp_ice('V') ! interpolation of ice velocities 
    490    CALL agrif_interp_ice('T') ! interpolation of ice tracers  
    491    nbstep_ice = 0 
    492     
    493    ! 
    494 END SUBROUTINE Agrif_InitValues_cont_ice 
    495  
    496 SUBROUTINE agrif_declare_var_ice 
    497       !!---------------------------------------------------------------------- 
    498       !!                 *** ROUTINE agrif_declare_var_ice *** 
    499       !! 
    500       !! ** Purpose :: Declaration of variables to be interpolated for ice 
    501       !!---------------------------------------------------------------------- 
    502    USE Agrif_Util 
    503    USE ice 
    504    USE par_oce, ONLY : nbghostcells 
    505    ! 
    506    IMPLICIT NONE 
    507    ! 
    508    INTEGER :: ind1, ind2, ind3 
    509       !!---------------------------------------------------------------------- 
    510    ! 
    511    ! 1. Declaration of the type of variable which have to be interpolated (parent=>child) 
    512    !       agrif_declare_variable(position,1st point index,--,--,dimensions,name) 
    513    !           ex.:  position=> 1,1 = not-centered (in i and j) 
    514    !                            2,2 =     centered (    -     ) 
    515    !                 index   => 1,1 = one ghost line 
    516    !                            2,2 = two ghost lines 
    517    !------------------------------------------------------------------------------------- 
    518    ind1 =     nbghostcells 
    519    ind2 = 1 + nbghostcells 
    520    ind3 = 2 + nbghostcells 
    521    CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpl*(8+nlay_s+nlay_i)/),tra_ice_id) 
    522    CALL agrif_declare_variable((/1,2/)  ,(/ind2,ind3/)  ,(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,u_ice_id  ) 
    523    CALL agrif_declare_variable((/2,1/)  ,(/ind3,ind2/)  ,(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,v_ice_id  ) 
    524  
    525    ! 2. Set interpolations (normal & tangent to the grid cell for velocities) 
    526    !----------------------------------- 
    527    CALL Agrif_Set_bcinterp(tra_ice_id, interp  = AGRIF_linear) 
    528    CALL Agrif_Set_bcinterp(u_ice_id  , interp1 = Agrif_linear,interp2 = AGRIF_ppm   ) 
    529    CALL Agrif_Set_bcinterp(v_ice_id  , interp1 = AGRIF_ppm   ,interp2 = Agrif_linear) 
    530  
    531    ! 3. Set location of interpolations 
    532    !---------------------------------- 
    533    CALL Agrif_Set_bc(tra_ice_id,(/0,ind1/)) 
    534    CALL Agrif_Set_bc(u_ice_id  ,(/0,ind1/)) 
    535    CALL Agrif_Set_bc(v_ice_id  ,(/0,ind1/)) 
    536  
    537    ! 4. Set update type in case 2 ways (child=>parent) (normal & tangent to the grid cell for velocities) 
    538    !-------------------------------------------------- 
    539 # if defined UPD_HIGH 
    540    CALL Agrif_Set_Updatetype(tra_ice_id, update  = Agrif_Update_Full_Weighting) 
    541    CALL Agrif_Set_Updatetype(u_ice_id  , update1 = Agrif_Update_Average       , update2 = Agrif_Update_Full_Weighting) 
    542    CALL Agrif_Set_Updatetype(v_ice_id  , update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average       ) 
    543 #else 
    544    CALL Agrif_Set_Updatetype(tra_ice_id, update  = AGRIF_Update_Average) 
    545    CALL Agrif_Set_Updatetype(u_ice_id  , update1 = Agrif_Update_Copy   , update2 = Agrif_Update_Average) 
    546    CALL Agrif_Set_Updatetype(v_ice_id  , update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy   ) 
    547 #endif 
    548  
    549 END SUBROUTINE agrif_declare_var_ice 
    550 #endif 
    551  
    552  
    553 # if defined key_top 
    554 SUBROUTINE Agrif_InitValues_cont_top 
    555       !!---------------------------------------------------------------------- 
    556       !!                 *** ROUTINE Agrif_InitValues_cont_top *** 
    557       !! 
    558       !! ** Purpose :: Declaration of variables to be interpolated 
    559       !!---------------------------------------------------------------------- 
    560    USE Agrif_Util 
    561    USE oce  
    562    USE dom_oce 
    563    USE nemogcm 
    564    USE par_trc 
    565    USE lib_mpp 
    566    USE trc 
    567    USE in_out_manager 
    568    USE agrif_oce_sponge 
    569    USE agrif_top_update 
    570    USE agrif_top_interp 
    571    USE agrif_top_sponge 
    572    !! 
    573    IMPLICIT NONE 
    574    ! 
    575    CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3 
    576    LOGICAL :: check_namelist 
    577       !!---------------------------------------------------------------------- 
    578  
    579  
    580    ! 1. Declaration of the type of variable which have to be interpolated 
    581    !--------------------------------------------------------------------- 
    582    CALL agrif_declare_var_top 
    583  
    584    ! 2. First interpolations of potentially non zero fields 
    585    !------------------------------------------------------- 
    586    Agrif_SpecialValue=0. 
    587    Agrif_UseSpecialValue = .TRUE. 
    588    CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn) 
    589    Agrif_UseSpecialValue = .FALSE. 
    590    CALL Agrif_Sponge 
    591    tabspongedone_trn = .FALSE. 
    592    CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge) 
    593    ! reset tsa to zero 
    594    tra(:,:,:,:) = 0. 
    595  
    596  
    597    ! 3. Some controls 
    598    !----------------- 
    599    check_namelist = .TRUE. 
    600  
    601    IF( check_namelist ) THEN 
    602       ! Check time steps 
     587      IMPLICIT NONE 
     588      ! 
     589      CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3 
     590      LOGICAL :: check_namelist 
     591      !!---------------------------------------------------------------------- 
     592 
     593      ! 1. Declaration of the type of variable which have to be interpolated 
     594      !--------------------------------------------------------------------- 
     595      CALL agrif_declare_var_top 
     596 
     597      ! 2. First interpolations of potentially non zero fields 
     598      !------------------------------------------------------- 
     599      Agrif_SpecialValue=0._wp 
     600      Agrif_UseSpecialValue = .TRUE. 
     601      CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn) 
     602      Agrif_UseSpecialValue = .FALSE. 
     603      CALL Agrif_Sponge 
     604      tabspongedone_trn = .FALSE. 
     605      CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge) 
     606      ! reset ts(:,:,:,:,Krhs_a) to zero 
     607      tr(:,:,:,:,Krhs_a) = 0._wp 
     608 
     609      ! 3. Some controls 
     610      !----------------- 
     611      check_namelist = .TRUE. 
     612 
     613      IF( check_namelist ) THEN 
     614         ! Check time steps 
    603615      IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN 
    604616         WRITE(cl_check1,*)  Agrif_Parent(rdt) 
    … …  
    624636      ENDIF 
    625637 
    626       ! Check passive tracer cell 
    627       IF( nn_dttrc .NE. 1 ) THEN 
    628          WRITE(*,*) 'nn_dttrc should be equal to 1' 
    629       ENDIF 
    630638   ENDIF 
    631639   ! 
    632 END SUBROUTINE Agrif_InitValues_cont_top 
    633  
    634  
    635 SUBROUTINE agrif_declare_var_top 
     640   END SUBROUTINE Agrif_InitValues_cont_top 
     641 
     642 
     643   SUBROUTINE agrif_declare_var_top 
    636644      !!---------------------------------------------------------------------- 
    637645      !!                 *** ROUTINE agrif_declare_var_top *** 
     646      !!---------------------------------------------------------------------- 
     647      USE agrif_util 
     648      USE agrif_oce 
     649      USE dom_oce 
     650      USE trc 
    638651      !! 
    639       !! ** Purpose :: Declaration of TOP variables to be interpolated 
    640       !!---------------------------------------------------------------------- 
    641    USE agrif_util 
    642    USE agrif_oce 
    643    USE dom_oce 
    644    USE trc 
    645    !! 
    646    IMPLICIT NONE 
    647    ! 
    648    INTEGER :: ind1, ind2, ind3 
    649       !!---------------------------------------------------------------------- 
    650  
    651    ! 1. Declaration of the type of variable which have to be interpolated 
    652    !--------------------------------------------------------------------- 
    653    ind1 =     nbghostcells 
    654    ind2 = 1 + nbghostcells 
    655    ind3 = 2 + nbghostcells 
     652      IMPLICIT NONE 
     653      ! 
     654      INTEGER :: ind1, ind2, ind3 
     655      !!---------------------------------------------------------------------- 
     656 
     657      ! 1. Declaration of the type of variable which have to be interpolated 
     658      !--------------------------------------------------------------------- 
     659      ind1 =     nbghostcells 
     660      ind2 = 1 + nbghostcells 
     661      ind3 = 2 + nbghostcells 
    656662# if defined key_vertical 
    657    CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra+1/),trn_id) 
    658    CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra+1/),trn_sponge_id) 
     663      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra+1/),trn_id) 
     664      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra+1/),trn_sponge_id) 
    659665# else 
    660    CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_id) 
    661    CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_sponge_id) 
    662 # endif 
    663  
    664    ! 2. Type of interpolation 
    665    !------------------------- 
    666    CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear) 
    667    CALL Agrif_Set_bcinterp(trn_sponge_id,interp=AGRIF_linear) 
    668  
    669    ! 3. Location of interpolation 
    670    !----------------------------- 
    671    CALL Agrif_Set_bc(trn_id,(/0,ind1/)) 
    672    CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/)) 
    673  
    674    ! 4. Update type 
    675    !---------------  
     666      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_id) 
     667      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_sponge_id) 
     668# endif 
     669 
     670      ! 2. Type of interpolation 
     671      !------------------------- 
     672      CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear) 
     673      CALL Agrif_Set_bcinterp(trn_sponge_id,interp=AGRIF_linear) 
     674 
     675      ! 3. Location of interpolation 
     676      !----------------------------- 
     677      CALL Agrif_Set_bc(trn_id,(/0,ind1-1/)) 
     678      CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/)) 
     679 
     680      ! 4. Update type 
     681      !---------------  
    676682# if defined UPD_HIGH 
    677    CALL Agrif_Set_Updatetype(trn_id, update = Agrif_Update_Full_Weighting) 
     683      CALL Agrif_Set_Updatetype(trn_id, update = Agrif_Update_Full_Weighting) 
    678684#else 
    679    CALL Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average) 
     685      CALL Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average) 
    680686#endif 
    681687   ! 
    682 END SUBROUTINE agrif_declare_var_top 
    683 # endif 
    684  
    685 SUBROUTINE Agrif_detect( kg, ksizex ) 
     688   END SUBROUTINE agrif_declare_var_top 
     689# endif 
     690 
     691   SUBROUTINE Agrif_detect( kg, ksizex ) 
    686692      !!---------------------------------------------------------------------- 
    687693      !!                      *** ROUTINE Agrif_detect *** 
    688694      !!---------------------------------------------------------------------- 
    689    INTEGER, DIMENSION(2) :: ksizex 
    690    INTEGER, DIMENSION(ksizex(1),ksizex(2)) :: kg  
    691       !!---------------------------------------------------------------------- 
    692    ! 
    693    RETURN 
    694    ! 
    695 END SUBROUTINE Agrif_detect 
    696  
    697  
    698 SUBROUTINE agrif_nemo_init 
     695      INTEGER, DIMENSION(2) :: ksizex 
     696      INTEGER, DIMENSION(ksizex(1),ksizex(2)) :: kg  
     697      !!---------------------------------------------------------------------- 
     698      ! 
     699      RETURN 
     700      ! 
     701   END SUBROUTINE Agrif_detect 
     702 
     703   SUBROUTINE agrif_nemo_init 
    699704      !!---------------------------------------------------------------------- 
    700705      !!                     *** ROUTINE agrif_init *** 
    701706      !!---------------------------------------------------------------------- 
    702    USE agrif_oce  
    703    USE agrif_ice 
    704    USE in_out_manager 
    705    USE lib_mpp 
    706    !! 
    707    IMPLICIT NONE 
    708    ! 
    709    INTEGER  ::   ios                 ! Local integer output status for namelist read 
    710    INTEGER  ::   iminspon 
    711    NAMELIST/namagrif/ rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn, ln_chk_bathy 
     707      USE agrif_oce  
     708      USE agrif_ice 
     709      USE in_out_manager 
     710      USE lib_mpp 
     711      !! 
     712      IMPLICIT NONE 
     713      ! 
     714      INTEGER  ::   ios                 ! Local integer output status for namelist read 
     715      NAMELIST/namagrif/ ln_agrif_2way, rn_sponge_tra, rn_sponge_dyn, rn_trelax_tra, rn_trelax_dyn, & 
     716                       & ln_spc_dyn, ln_chk_bathy 
    712717      !!-------------------------------------------------------------------------------------- 
    713    ! 
    714    REWIND( numnam_ref )              ! Namelist namagrif in reference namelist : AGRIF zoom 
    715    READ  ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901) 
     718      ! 
     719      READ  ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901) 
    716720901 IF( ios /= 0 )   CALL ctl_nam ( ios , 'namagrif in reference namelist' ) 
    717    REWIND( numnam_cfg )              ! Namelist namagrif in configuration namelist : AGRIF zoom 
    718    READ  ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 ) 
     721      READ  ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 ) 
    719722902 IF( ios >  0 )   CALL ctl_nam ( ios , 'namagrif in configuration namelist' ) 
    720    IF(lwm) WRITE ( numond, namagrif ) 
    721    ! 
    722    IF(lwp) THEN                    ! control print 
    723       WRITE(numout,*) 
    724       WRITE(numout,*) 'agrif_nemo_init : AGRIF parameters' 
    725       WRITE(numout,*) '~~~~~~~~~~~~~~~' 
    726       WRITE(numout,*) '   Namelist namagrif : set AGRIF parameters' 
    727       WRITE(numout,*) '      sponge coefficient for tracers    rn_sponge_tra = ', rn_sponge_tra, ' s' 
    728       WRITE(numout,*) '      sponge coefficient for dynamics   rn_sponge_tra = ', rn_sponge_dyn, ' s' 
    729       WRITE(numout,*) '      use special values for dynamics   ln_spc_dyn    = ', ln_spc_dyn 
    730       WRITE(numout,*) '      check bathymetry                  ln_chk_bathy  = ', ln_chk_bathy 
    731    ENDIF 
    732    ! 
    733    ! convert DOCTOR namelist name into OLD names 
    734    visc_tra      = rn_sponge_tra 
    735    visc_dyn      = rn_sponge_dyn 
    736    ! 
    737    ! Check sponge length: 
    738    IF(     MIN(jpi   ,jpj   ) <=     1 + nbghostcells + (nn_sponge_len * Agrif_irhox() + 1)     & 
    739       .OR. MIN(jpiglo,jpjglo) <= 2* (1 + nbghostcells + (nn_sponge_len * Agrif_irhox() + 1) ) ) & 
    740       &     CALL ctl_stop('STOP','agrif sponge length is too large') 
    741    ! 
    742    IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed') 
    743    ! 
    744 END SUBROUTINE agrif_nemo_init 
     723      IF(lwm) WRITE ( numond, namagrif ) 
     724      ! 
     725      IF(lwp) THEN                    ! control print 
     726         WRITE(numout,*) 
     727         WRITE(numout,*) 'agrif_nemo_init : AGRIF parameters' 
     728         WRITE(numout,*) '~~~~~~~~~~~~~~~' 
     729         WRITE(numout,*) '   Namelist namagrif : set AGRIF parameters' 
     730         WRITE(numout,*) '      Two way nesting activated ln_agrif_2way         = ', ln_agrif_2way 
     731         WRITE(numout,*) '      sponge coefficient for tracers    rn_sponge_tra = ', rn_sponge_tra, ' m^2/s' 
     732         WRITE(numout,*) '      sponge coefficient for dynamics   rn_sponge_tra = ', rn_sponge_dyn, ' m^2/s' 
     733         WRITE(numout,*) '      time relaxation for tracers       rn_trelax_tra = ', rn_trelax_tra, ' ad.' 
     734         WRITE(numout,*) '      time relaxation for dynamics      rn_trelax_dyn = ', rn_trelax_dyn, ' ad.' 
     735         WRITE(numout,*) '      use special values for dynamics   ln_spc_dyn    = ', ln_spc_dyn 
     736         WRITE(numout,*) '      check bathymetry                  ln_chk_bathy  = ', ln_chk_bathy 
     737      ENDIF 
     738      ! 
     739      ! 
     740      IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed') 
     741      ! 
     742   END SUBROUTINE agrif_nemo_init 
    745743 
    746744# if defined key_mpp_mpi 
    747745 
    748 SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob ) 
     746   SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob ) 
    749747      !!---------------------------------------------------------------------- 
    750748      !!                     *** ROUTINE Agrif_InvLoc *** 
    751749      !!---------------------------------------------------------------------- 
    752    USE dom_oce 
    753    !! 
    754    IMPLICIT NONE 
    755    ! 
    756    INTEGER :: indglob, indloc, nprocloc, i 
    757       !!---------------------------------------------------------------------- 
    758    ! 
    759    SELECT CASE( i ) 
    760    CASE(1)   ;   indglob = indloc + nimppt(nprocloc+1) - 1 
    761    CASE(2)   ;   indglob = indloc + njmppt(nprocloc+1) - 1 
    762    CASE DEFAULT 
    763       indglob = indloc 
    764    END SELECT 
    765    ! 
    766 END SUBROUTINE Agrif_InvLoc 
    767  
    768  
    769 SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax ) 
     750      USE dom_oce 
     751      !! 
     752      IMPLICIT NONE 
     753      ! 
     754      INTEGER :: indglob, indloc, nprocloc, i 
     755      !!---------------------------------------------------------------------- 
     756      ! 
     757      SELECT CASE( i ) 
     758      CASE(1)   ;   indglob = indloc + nimppt(nprocloc+1) - 1 
     759      CASE(2)   ;   indglob = indloc + njmppt(nprocloc+1) - 1 
     760      CASE DEFAULT 
     761         indglob = indloc 
     762      END SELECT 
     763      ! 
     764   END SUBROUTINE Agrif_InvLoc 
     765 
     766   SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax ) 
    770767      !!---------------------------------------------------------------------- 
    771768      !!                 *** ROUTINE Agrif_get_proc_info *** 
    772769      !!---------------------------------------------------------------------- 
    773    USE par_oce 
    774    !! 
    775    IMPLICIT NONE 
    776    ! 
    777    INTEGER, INTENT(out) :: imin, imax 
    778    INTEGER, INTENT(out) :: jmin, jmax 
    779       !!---------------------------------------------------------------------- 
    780    ! 
    781    imin = nimppt(Agrif_Procrank+1)  ! ????? 
    782    jmin = njmppt(Agrif_Procrank+1)  ! ????? 
    783    imax = imin + jpi - 1 
    784    jmax = jmin + jpj - 1 
    785    !  
    786 END SUBROUTINE Agrif_get_proc_info 
    787  
    788  
    789 SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost) 
     770      USE par_oce 
     771      !! 
     772      IMPLICIT NONE 
     773      ! 
     774      INTEGER, INTENT(out) :: imin, imax 
     775      INTEGER, INTENT(out) :: jmin, jmax 
     776      !!---------------------------------------------------------------------- 
     777      ! 
     778      imin = nimppt(Agrif_Procrank+1)  ! ????? 
     779      jmin = njmppt(Agrif_Procrank+1)  ! ????? 
     780      imax = imin + jpi - 1 
     781      jmax = jmin + jpj - 1 
     782      !  
     783   END SUBROUTINE Agrif_get_proc_info 
     784 
     785   SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost) 
    790786      !!---------------------------------------------------------------------- 
    791787      !!                 *** ROUTINE Agrif_estimate_parallel_cost *** 
    792788      !!---------------------------------------------------------------------- 
    793    USE par_oce 
    794    !! 
    795    IMPLICIT NONE 
    796    ! 
    797    INTEGER,  INTENT(in)  :: imin, imax 
    798    INTEGER,  INTENT(in)  :: jmin, jmax 
    799    INTEGER,  INTENT(in)  :: nbprocs 
    800    REAL(wp), INTENT(out) :: grid_cost 
    801       !!---------------------------------------------------------------------- 
    802    ! 
    803    grid_cost = REAL(imax-imin+1,wp)*REAL(jmax-jmin+1,wp) / REAL(nbprocs,wp) 
    804    ! 
    805 END SUBROUTINE Agrif_estimate_parallel_cost 
     789      USE par_oce 
     790      !! 
     791      IMPLICIT NONE 
     792      ! 
     793      INTEGER,  INTENT(in)  :: imin, imax 
     794      INTEGER,  INTENT(in)  :: jmin, jmax 
     795      INTEGER,  INTENT(in)  :: nbprocs 
     796      REAL(wp), INTENT(out) :: grid_cost 
     797      !!---------------------------------------------------------------------- 
     798      ! 
     799      grid_cost = REAL(imax-imin+1,wp)*REAL(jmax-jmin+1,wp) / REAL(nbprocs,wp) 
     800      ! 
     801   END SUBROUTINE Agrif_estimate_parallel_cost 
    806802 
    807803# endif 
    808804 
    809805#else 
    810 SUBROUTINE Subcalledbyagrif 
     806   SUBROUTINE Subcalledbyagrif 
    811807      !!---------------------------------------------------------------------- 
    812808      !!                   *** ROUTINE Subcalledbyagrif *** 
    813809      !!---------------------------------------------------------------------- 
    814    WRITE(*,*) 'Impossible to be here' 
    815 END SUBROUTINE Subcalledbyagrif 
     810      WRITE(*,*) 'Impossible to be here' 
     811   END SUBROUTINE Subcalledbyagrif 
    816812#endif 
Note: See TracChangeset for help on using the changeset viewer.