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 12928 for NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/NST/agrif_user.F90 – NEMO

Ignore:
Timestamp:
2020-05-14T21:46:00+02:00 (4 years ago)
Author:
smueller
Message:

Synchronizing with /NEMO/trunk@12925 (ticket #2170)

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

Legend:

Unmodified
Added
Removed

  • NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser

    • Property svn:externals

      •  

        old new  
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 
         8 
         9# SETTE 
         10^/utils/CI/sette@HEAD         sette 

  • NEMO/branches/2019/dev_r11078_OSMOSIS_IMMERSE_Nurser/src/NST/agrif_user.F90

    r12178 r12928  
    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(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 
     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 
    603       IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN 
    604          WRITE(cl_check1,*)  Agrif_Parent(rdt) 
    605          WRITE(cl_check2,*)  rdt 
    606          WRITE(cl_check3,*)  rdt*Agrif_Rhot() 
     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 
     615      IF( NINT(Agrif_Rhot()) * NINT(rn_Dt) .NE. Agrif_Parent(rn_Dt) ) THEN 
     616         WRITE(cl_check1,*)  Agrif_Parent(rn_Dt) 
     617         WRITE(cl_check2,*)  rn_Dt 
     618         WRITE(cl_check3,*)  rn_Dt*Agrif_Rhot() 
    607619         CALL ctl_stop( 'incompatible time step between grids',   & 
    608620               &               'parent grid value : '//cl_check1    ,   &  
    … …  
    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    iminspon = MIN(FLOOR(REAL(jpiglo-4)/REAL(2*Agrif_irhox())), FLOOR(REAL(jpjglo-4)/REAL(2*Agrif_irhox())) ) 
    739    IF (lk_mpp) iminspon = MIN(iminspon,FLOOR(REAL(jpi-2)/REAL(Agrif_irhox())), FLOOR(REAL(jpj-2)/REAL(Agrif_irhox())) ) 
    740    IF (nn_sponge_len > iminspon)  CALL ctl_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.