Ignore:
Timestamp:
2020-07-02T12:40:30+02:00 (3 months ago)
Author:
smasson
Message:

better e3: update with trunk@13218 see #2385

Location:
NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3

    • Property svn:externals
      •  

        old new  
        22^/utils/build/makenemo@HEAD   makenemo 
        33^/utils/build/mk@HEAD         mk 
        4 ^/utils/tools@HEAD            tools 
        5 ^/vendors/AGRIF/dev@HEAD      ext/AGRIF 
         4^/utils/tools/@HEAD           tools 
         5^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 
  • NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/NST/agrif_user.F90

    r12724 r13219  
    2828      ! 
    2929      !                    !* Agrif initialization 
    30       CALL agrif_nemo_init 
    31       CALL Agrif_InitValues_cont_dom 
    3230      CALL Agrif_InitValues_cont 
    3331# if defined key_top 
     
    4038   END SUBROUTINE Agrif_initvalues 
    4139 
    42    SUBROUTINE Agrif_InitValues_cont_dom 
    43       !!---------------------------------------------------------------------- 
    44       !!                 *** ROUTINE Agrif_InitValues_cont_dom *** 
    45       !!---------------------------------------------------------------------- 
    46       ! 
    47       CALL agrif_declare_var_dom 
    48       ! 
    49    END SUBROUTINE Agrif_InitValues_cont_dom 
    50  
    51    SUBROUTINE agrif_declare_var_dom 
    52       !!---------------------------------------------------------------------- 
    53       !!                 *** ROUTINE agrif_declare_var_dom *** 
    54       !!---------------------------------------------------------------------- 
    55       USE par_oce, ONLY:  nbghostcells       
     40   SUBROUTINE agrif_istate( Kbb, Kmm, Kaa ) 
     41 
     42       USE domvvl 
     43       USE domain 
     44       USE par_oce 
     45       USE agrif_oce 
     46       USE agrif_oce_interp 
     47       USE oce 
     48       USE lib_mpp 
     49       USe lbclnk 
     50 
     51      INTEGER, INTENT(in)  :: Kbb, Kmm, Kaa 
     52      INTEGER :: jn 
     53 
     54      IF(lwp) WRITE(numout,*) ' ' 
     55      IF(lwp) WRITE(numout,*) 'AGRIF: interp child initial state from parent' 
     56      IF(lwp) WRITE(numout,*) ' ' 
     57 
     58      l_ini_child = .TRUE. 
     59      Agrif_SpecialValue    = 0._wp 
     60      Agrif_UseSpecialValue = .TRUE. 
     61      uu(:,:,:,:) = 0.  ;  vv(:,:,:,:) = 0.   ;  ts(:,:,:,:,:) = 0. 
     62        
     63      Krhs_a = Kbb ; Kmm_a = Kbb 
     64 
     65      ! Brutal fix to pas 1x1 refinment.  
     66  !    IF(Agrif_Irhox() == 1) THEN 
     67  !       CALL Agrif_Init_Variable(tsini_id, procname=agrif_initts) 
     68  !    ELSE 
     69      CALL Agrif_Init_Variable(tsini_id, procname=interptsn) 
     70 
     71  !    ENDIF 
     72! just for VORTEX because Parent velocities can actually be exactly zero 
     73!      Agrif_UseSpecialValue = .FALSE. 
     74      Agrif_UseSpecialValue = ln_spc_dyn 
     75      use_sign_north = .TRUE. 
     76      sign_north = -1. 
     77      CALL Agrif_Init_Variable(uini_id , procname=interpun ) 
     78      CALL Agrif_Init_Variable(vini_id , procname=interpvn ) 
     79      use_sign_north = .FALSE. 
     80 
     81      Agrif_UseSpecialValue = .FALSE.            ! 
     82      l_ini_child = .FALSE. 
     83 
     84      Krhs_a = Kaa ; Kmm_a = Kmm 
     85 
     86      DO jn = 1, jpts 
     87         ts(:,:,:,jn,Kbb) = ts(:,:,:,jn,Kbb)*tmask(:,:,:) 
     88      END DO 
     89      uu(:,:,:,Kbb) =  uu(:,:,:,Kbb) * umask(:,:,:)      
     90      vv(:,:,:,Kbb) =  vv(:,:,:,Kbb) * vmask(:,:,:)  
     91 
     92 
     93      CALL lbc_lnk_multi( 'agrif_istate', uu(:,:,:,Kbb), 'U', -1. , vv(:,:,:,Kbb), 'V', -1. ) 
     94      CALL lbc_lnk( 'agrif_istate', ts(:,:,:,:,Kbb), 'T', 1. ) 
     95 
     96   END SUBROUTINE agrif_istate    
     97 
     98   SUBROUTINE agrif_declare_var_ini 
     99      !!---------------------------------------------------------------------- 
     100      !!                 *** ROUTINE agrif_declare_var *** 
     101      !!---------------------------------------------------------------------- 
     102      USE agrif_util 
     103      USE agrif_oce 
     104      USE par_oce 
     105      USE zdf_oce  
     106      USE oce 
     107      USE dom_oce 
    56108      ! 
    57109      IMPLICIT NONE 
    58110      ! 
    59111      INTEGER :: ind1, ind2, ind3 
    60       !!---------------------------------------------------------------------- 
     112      External :: nemo_mapping 
     113      !!---------------------------------------------------------------------- 
     114 
     115! In case of East-West periodicity, prevent AGRIF interpolation at east and west boundaries 
     116! The procnames will not be called at these boundaries 
     117      IF (jperio == 1) THEN 
     118         CALL Agrif_Set_NearCommonBorderX(.TRUE.) 
     119         CALL Agrif_Set_DistantCommonBorderX(.TRUE.) 
     120      ENDIF 
     121 
     122      IF ( .NOT. lk_south ) THEN 
     123         CALL Agrif_Set_NearCommonBorderY(.TRUE.) 
     124      ENDIF 
    61125 
    62126      ! 1. Declaration of the type of variable which have to be interpolated 
    63127      !--------------------------------------------------------------------- 
    64128      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) 
    69  
     129      ind2 = 2 + nbghostcells_x 
     130      ind3 = 2 + nbghostcells_y_s 
     131 
     132      CALL agrif_declare_variable((/2,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id) 
     133      CALL agrif_declare_variable((/2,2/)  ,(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),mbkt_id) 
     134      CALL agrif_declare_variable((/2,2/)  ,(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ht0_id) 
     135 
     136      CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e1u_id) 
     137      CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e2v_id) 
     138 
     139    
     140      ! Initial or restart velues 
     141       
     142      CALL agrif_declare_variable((/2,2,0,0/),(/ind2  ,ind3  ,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts+1/),tsini_id) 
     143      CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3  ,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/)     ,uini_id )  
     144      CALL agrif_declare_variable((/2,1,0,0/),(/ind2  ,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/)     ,vini_id ) 
     145      CALL agrif_declare_variable((/2,2/)    ,(/ind2,ind3/)        ,(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshini_id) 
     146      !  
     147      
    70148      ! 2. Type of interpolation 
    71149      !------------------------- 
     150      CALL Agrif_Set_bcinterp(e3t_id,interp=AGRIF_constant) 
     151 
     152      CALL Agrif_Set_bcinterp(mbkt_id,interp=AGRIF_constant) 
     153      CALL Agrif_Set_interp  (mbkt_id,interp=AGRIF_constant) 
     154      CALL Agrif_Set_bcinterp(ht0_id ,interp=AGRIF_constant) 
     155      CALL Agrif_Set_interp  (ht0_id ,interp=AGRIF_constant) 
     156 
    72157      CALL Agrif_Set_bcinterp( e1u_id, interp1=Agrif_linear, interp2=AGRIF_ppm    ) 
    73158      CALL Agrif_Set_bcinterp( e2v_id, interp1=AGRIF_ppm   , interp2=Agrif_linear ) 
    74159 
    75       ! 3. Location of interpolation 
     160      ! Initial fields 
     161      CALL Agrif_Set_bcinterp(tsini_id ,interp=AGRIF_linear) 
     162      CALL Agrif_Set_interp  (tsini_id ,interp=AGRIF_linear) 
     163      CALL Agrif_Set_bcinterp(uini_id  ,interp=AGRIF_linear) 
     164      CALL Agrif_Set_interp  (uini_id  ,interp=AGRIF_linear) 
     165      CALL Agrif_Set_bcinterp(vini_id  ,interp=AGRIF_linear) 
     166      CALL Agrif_Set_interp  (vini_id  ,interp=AGRIF_linear) 
     167      CALL Agrif_Set_bcinterp(sshini_id,interp=AGRIF_linear) 
     168      CALL Agrif_Set_interp  (sshini_id,interp=AGRIF_linear) 
     169 
     170       ! 3. Location of interpolation 
    76171      !----------------------------- 
     172!      CALL Agrif_Set_bc(  e3t_id, (/-nn_sponge_len*Agrif_irhox(),ind1-1/) )   
     173! JC: check near the boundary only until matching in sponge has been sorted out: 
     174      CALL Agrif_Set_bc(  e3t_id, (/0,ind1-1/) )   
     175 
     176      ! extend the interpolation zone by 1 more point than necessary: 
     177      ! RB check here 
     178      CALL Agrif_Set_bc(  mbkt_id, (/-nn_sponge_len*Agrif_irhox()-2,ind1/) ) 
     179      CALL Agrif_Set_bc(  ht0_id,  (/-nn_sponge_len*Agrif_irhox()-2,ind1/) ) 
     180       
    77181      CALL Agrif_Set_bc(e1u_id,(/0,ind1-1/)) 
    78       CALL Agrif_Set_bc(e2v_id,(/0,ind1-1/)) 
     182      CALL Agrif_Set_bc(e2v_id,(/0,ind1-1/))   
     183 
     184      CALL Agrif_Set_bc( tsini_id , (/0,ind1-1/) ) ! if west,  rhox=3 and nbghost=3: columns 2 to 4 
     185      CALL Agrif_Set_bc( uini_id  , (/0,ind1-1/) )  
     186      CALL Agrif_Set_bc( vini_id  , (/0,ind1-1/) ) 
     187      CALL Agrif_Set_bc( sshini_id, (/0,ind1-1/) ) 
    79188 
    80189      ! 4. Update type 
     
    87196      CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy) 
    88197#endif 
    89  
    90    END SUBROUTINE agrif_declare_var_dom 
    91  
    92    SUBROUTINE Agrif_InitValues_cont 
    93       !!---------------------------------------------------------------------- 
    94       !!                 *** ROUTINE Agrif_InitValues_cont *** 
    95       !!---------------------------------------------------------------------- 
    96       USE agrif_oce 
     198       
     199   !   CALL Agrif_Set_ExternalMapping(nemo_mapping) 
     200      ! 
     201   END SUBROUTINE agrif_declare_var_ini 
     202 
     203 
     204   SUBROUTINE Agrif_Init_Domain( Kbb, Kmm, Kaa )  
     205      !!---------------------------------------------------------------------- 
     206      !!                 *** ROUTINE Agrif_InitValues_cont_dom *** 
     207      !!---------------------------------------------------------------------- 
     208   
     209         !!---------------------------------------------------------------------- 
     210         !!                 *** ROUTINE Agrif_InitValues_cont *** 
     211         !! 
     212         !! ** Purpose ::   Declaration of variables to be interpolated 
     213         !!---------------------------------------------------------------------- 
     214      USE agrif_oce_update 
    97215      USE agrif_oce_interp 
    98216      USE agrif_oce_sponge 
     217      USE Agrif_Util 
     218      USE oce  
    99219      USE dom_oce 
    100       USE oce 
     220      USE zdf_oce 
     221      USE nemogcm 
     222      USE agrif_oce 
     223      ! 
     224      USE lbclnk 
    101225      USE lib_mpp 
    102       USE lbclnk 
     226      USE in_out_manager 
    103227      ! 
    104228      IMPLICIT NONE 
    105229      ! 
    106       INTEGER :: ji, jj 
     230      INTEGER, INTENT(in) ::  Kbb, Kmm, Kaa 
     231      ! 
    107232      LOGICAL :: check_namelist 
    108233      CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3, cl_check4  
    109 #if defined key_vertical 
    110234      REAL(wp), DIMENSION(jpi,jpj) ::   zk   ! workspace 
    111 #endif 
    112       !!---------------------------------------------------------------------- 
    113  
    114       ! 1. Declaration of the type of variable which have to be interpolated 
    115       !--------------------------------------------------------------------- 
    116       CALL agrif_declare_var 
    117  
    118       ! 2. First interpolations of potentially non zero fields 
    119       !------------------------------------------------------- 
    120  
    121 #if defined key_vertical 
     235      INTEGER :: ji, jj, jk 
     236      !!---------------------------------------------------------------------- 
     237     
     238     ! CALL Agrif_Declare_Var_ini 
     239 
     240      IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed') 
     241 
    122242      ! Build consistent parent bathymetry and number of levels 
    123243      ! on the child grid  
     
    126246      mbkt_parent(:,:) = 0 
    127247      ! 
    128       CALL Agrif_Bc_variable(ht0_id ,calledweight=1.,procname=interpht0 ) 
    129       CALL Agrif_Bc_variable(mbkt_id,calledweight=1.,procname=interpmbkt) 
     248  !    CALL Agrif_Bc_variable(ht0_id ,calledweight=1.,procname=interpht0 ) 
     249  !    CALL Agrif_Bc_variable(mbkt_id,calledweight=1.,procname=interpmbkt) 
     250      CALL Agrif_Init_Variable(ht0_id , procname=interpht0 ) 
     251      CALL Agrif_Init_Variable(mbkt_id, procname=interpmbkt) 
    130252      ! 
    131253      ! Assume step wise change of bathymetry near interface 
     
    149271      ENDIF 
    150272      ! 
    151       CALL lbc_lnk( 'Agrif_InitValues_cont', hu0_parent, 'U', 1. ) 
    152       CALL lbc_lnk( 'Agrif_InitValues_cont', hv0_parent, 'V', 1. ) 
     273      CALL lbc_lnk( 'Agrif_Init_Domain', hu0_parent, 'U', 1. ) 
     274      CALL lbc_lnk( 'Agrif_Init_Domain', hv0_parent, 'V', 1. ) 
    153275      zk(:,:) = REAL( mbku_parent(:,:), wp )   ;   CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'U', 1. ) 
    154       mbku_parent(:,:) = MAX( NINT( zk(:,:) ), 1 ) 
     276      mbku_parent(:,:) = MAX( NINT( zk(:,:) ), 1 ) ; 
    155277      zk(:,:) = REAL( mbkv_parent(:,:), wp )   ;   CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'V', 1. ) 
    156278      mbkv_parent(:,:) = MAX( NINT( zk(:,:) ), 1 )    
    157 #endif 
    158  
     279 
     280      IF ( ln_init_chfrpar ) THEN  
     281         CALL Agrif_Init_Variable(sshini_id, procname=agrif_initssh) 
     282         CALL lbc_lnk( 'Agrif_Init_Domain', ssh(:,:,Kbb), 'T', 1. ) 
     283         DO jk = 1, jpk 
     284               e3t(:,:,jk,Kbb) =  e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kbb)  ) & 
     285                        &             / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk)   & 
     286                        &              + e3t_0(:,:,jk) * ( 1._wp - tmask(:,:,jk) ) 
     287         END DO 
     288      ENDIF 
     289 
     290      ! check if masks and bathymetries match 
     291      IF(ln_chk_bathy) THEN 
     292         Agrif_UseSpecialValue = .FALSE. 
     293         ! 
     294         IF(lwp) WRITE(numout,*) ' ' 
     295         IF(lwp) WRITE(numout,*) 'AGRIF: Check Bathymetry and masks near bdys. Level: ', Agrif_Level() 
     296         ! 
     297         kindic_agr = 0 
     298         IF( .NOT. l_vremap ) THEN 
     299            ! 
     300            ! check if tmask and vertical scale factors agree with parent in sponge area: 
     301            CALL Agrif_Bc_variable(e3t_id,calledweight=1.,procname=interpe3t) 
     302            ! 
     303         ELSE 
     304            ! 
     305            ! In case of vertical interpolation, check only that total depths agree between child and parent: 
     306            DO ji = 1, jpi 
     307               DO jj = 1, jpj 
     308                  IF ((mbkt_parent(ji,jj)/=0).AND.(ABS(ht0_parent(ji,jj)-ht_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1 
     309                  IF ((mbku_parent(ji,jj)/=0).AND.(ABS(hu0_parent(ji,jj)-hu_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1 
     310                  IF ((mbkv_parent(ji,jj)/=0).AND.(ABS(hv0_parent(ji,jj)-hv_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1 
     311               END DO 
     312            END DO 
     313 
     314            CALL mpp_sum( 'agrif_user', kindic_agr ) 
     315            IF( kindic_agr /= 0 ) THEN 
     316               CALL ctl_stop('==> Child Bathymetry is NOT correct near boundaries.') 
     317            ELSE 
     318               IF(lwp) WRITE(numout,*) '==> Child Bathymetry is ok near boundaries.' 
     319               IF(lwp) WRITE(numout,*) ' ' 
     320            ENDIF   
     321         ENDIF 
     322      ENDIF 
     323 
     324      IF( l_vremap ) THEN 
     325      ! Additional constrain that should be removed someday: 
     326         IF ( Agrif_Parent(jpk).GT.jpk ) THEN 
     327            CALL ctl_stop( ' With l_vremap, child grids must have jpk greater or equal to the parent value' ) 
     328         ENDIF 
     329      ENDIF 
     330      ! 
     331   END SUBROUTINE Agrif_Init_Domain 
     332 
     333 
     334   SUBROUTINE Agrif_InitValues_cont 
     335         !!---------------------------------------------------------------------- 
     336         !!                 *** ROUTINE Agrif_InitValues_cont *** 
     337         !! 
     338         !! ** Purpose ::   Declaration of variables to be interpolated 
     339         !!---------------------------------------------------------------------- 
     340      USE agrif_oce_update 
     341      USE agrif_oce_interp 
     342      USE agrif_oce_sponge 
     343      USE Agrif_Util 
     344      USE oce  
     345      USE dom_oce 
     346      USE zdf_oce 
     347      USE nemogcm 
     348      USE agrif_oce 
     349      ! 
     350      USE lbclnk 
     351      USE lib_mpp 
     352      USE in_out_manager 
     353      ! 
     354      IMPLICIT NONE 
     355      ! 
     356      LOGICAL :: check_namelist 
     357      CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3, cl_check4  
     358      REAL(wp), DIMENSION(jpi,jpj) ::   zk   ! workspace 
     359      INTEGER :: ji, jj 
     360 
     361      ! 1. Declaration of the type of variable which have to be interpolated 
     362      !--------------------------------------------------------------------- 
     363      CALL agrif_declare_var 
     364 
     365      ! 2. First interpolations of potentially non zero fields 
     366      !------------------------------------------------------- 
    159367      Agrif_SpecialValue    = 0._wp 
    160368      Agrif_UseSpecialValue = .TRUE. 
     
    163371      tabspongedone_tsn = .FALSE. 
    164372      CALL Agrif_Bc_variable(tsn_sponge_id,calledweight=1.,procname=interptsn_sponge) 
    165       ! reset ts(:,:,:,:,Krhs_a) to zero 
     373      ! reset tsa to zero 
    166374      ts(:,:,:,:,Krhs_a) = 0._wp 
    167375 
    168376      Agrif_UseSpecialValue = ln_spc_dyn 
     377      use_sign_north = .TRUE. 
     378      sign_north = -1. 
    169379      CALL Agrif_Bc_variable(un_interp_id,calledweight=1.,procname=interpun) 
    170380      CALL Agrif_Bc_variable(vn_interp_id,calledweight=1.,procname=interpvn) 
     
    175385      tabspongedone_v = .FALSE. 
    176386      CALL Agrif_Bc_variable(vn_sponge_id,calledweight=1.,procname=interpvn_sponge) 
     387      use_sign_north = .FALSE. 
    177388      uu(:,:,:,Krhs_a) = 0._wp 
    178389      vv(:,:,:,Krhs_a) = 0._wp 
     
    185396      IF ( ln_dynspg_ts ) THEN 
    186397         Agrif_UseSpecialValue = ln_spc_dyn 
     398         use_sign_north = .TRUE. 
     399         sign_north = -1. 
    187400         CALL Agrif_Bc_variable(unb_id,calledweight=1.,procname=interpunb) 
    188401         CALL Agrif_Bc_variable(vnb_id,calledweight=1.,procname=interpvnb) 
    189402         CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b) 
    190403         CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b) 
     404         use_sign_north = .FALSE. 
    191405         ubdy(:,:) = 0._wp 
    192406         vbdy(:,:) = 0._wp 
    193407      ENDIF 
    194  
    195       Agrif_UseSpecialValue = .FALSE. 
    196  
    197       ! 3. Some controls 
     408      Agrif_UseSpecialValue = .FALSE.  
     409 
    198410      !----------------- 
    199411      check_namelist = .TRUE. 
    200412 
    201413      IF( check_namelist ) THEN  
    202  
    203          ! Check time steps            
    204          IF( NINT(Agrif_Rhot()) * NINT(rn_Dt) .NE. Agrif_Parent(rn_Dt) ) THEN 
    205             WRITE(cl_check1,*)  NINT(Agrif_Parent(rn_Dt)) 
    206             WRITE(cl_check2,*)  NINT(rn_Dt) 
    207             WRITE(cl_check3,*)  NINT(Agrif_Parent(rn_Dt)/Agrif_Rhot()) 
    208             CALL ctl_stop( 'Incompatible time step between ocean grids',   & 
    209                   &               'parent grid value : '//cl_check1    ,   &  
    210                   &               'child  grid value : '//cl_check2    ,   &  
    211                   &               'value on child grid should be changed to : '//cl_check3 ) 
    212          ENDIF 
    213  
    214          ! Check run length 
    215          IF( Agrif_IRhot() * (Agrif_Parent(nitend)- & 
    216                Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN 
    217             WRITE(cl_check1,*)  (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 
    218             WRITE(cl_check2,*)   Agrif_Parent(nitend)   *Agrif_IRhot() 
    219             CALL ctl_warn( 'Incompatible run length between grids'                      ,   & 
    220                   &               'nit000 on fine grid will be changed to : '//cl_check1,   & 
    221                   &               'nitend on fine grid will be changed to : '//cl_check2    ) 
    222             nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 
    223             nitend =  Agrif_Parent(nitend)   *Agrif_IRhot() 
    224          ENDIF 
    225  
    226414         ! Check free surface scheme 
    227415         IF ( ( Agrif_Parent(ln_dynspg_ts ).AND.ln_dynspg_exp ).OR.& 
     
    251439            STOP 
    252440         ENDIF 
    253  
    254       ENDIF 
    255  
    256       ! check if masks and bathymetries match 
    257       IF(ln_chk_bathy) THEN 
    258          Agrif_UseSpecialValue = .FALSE. 
    259          ! 
    260          IF(lwp) WRITE(numout,*) ' ' 
    261          IF(lwp) WRITE(numout,*) 'AGRIF: Check Bathymetry and masks near bdys. Level: ', Agrif_Level() 
    262          ! 
    263          kindic_agr = 0 
    264 # if ! defined key_vertical 
    265          ! 
    266          ! check if tmask and vertical scale factors agree with parent in sponge area: 
    267          CALL Agrif_Bc_variable(e3t_id,calledweight=1.,procname=interpe3t) 
    268          ! 
    269 # else 
    270          ! 
    271          ! In case of vertical interpolation, check only that total depths agree between child and parent: 
    272          DO 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 
    280          CALL mpp_sum( 'agrif_user', kindic_agr ) 
    281          IF( kindic_agr /= 0 ) THEN 
    282             CALL ctl_stop('==> Child Bathymetry is NOT correct near boundaries.') 
    283          ELSE 
    284             IF(lwp) WRITE(numout,*) '==> Child Bathymetry is ok near boundaries.' 
    285             IF(lwp) WRITE(numout,*) ' ' 
    286          END IF   
    287          !     
    288       ENDIF 
    289  
    290 # if defined key_vertical 
    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       !  
     441      ENDIF 
     442 
    297443   END SUBROUTINE Agrif_InitValues_cont 
    298444 
     
    314460      ! 1. Declaration of the type of variable which have to be interpolated 
    315461      !--------------------------------------------------------------------- 
     462 
    316463      ind1 =     nbghostcells 
    317       ind2 = 1 + nbghostcells 
    318       ind3 = 2 + nbghostcells 
     464      ind2 = 2 + nbghostcells_x 
     465      ind3 = 2 + nbghostcells_y_s 
     466 
    319467# 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) 
     468      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts+1/),tsn_id) 
     469      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts+1/),tsn_sponge_id) 
     470      CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_interp_id) 
     471      CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_interp_id) 
     472      CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_update_id) 
     473      CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_update_id) 
     474      CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_sponge_id) 
     475      CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_sponge_id) 
    329476# else 
    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) 
     477      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_id) 
     478      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_sponge_id) 
     479      CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_interp_id) 
     480      CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_interp_id) 
     481      CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_update_id) 
     482      CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_update_id) 
     483      CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_sponge_id) 
     484      CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_sponge_id) 
    339485# 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  
    343 # if defined key_vertical 
    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 
     486      CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),unb_id) 
     487      CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vnb_id) 
     488      CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_interp_id) 
     489      CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_interp_id) 
     490      CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_update_id) 
     491      CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_update_id) 
     492 
     493      CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id) 
     494 
     495 
     496      IF( ln_zdftke.OR.ln_zdfgls ) THEN  ! logical not known at this point 
    360497!         CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/), en_id) 
    361498!         CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),avt_id) 
    362499# 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) 
     500         CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),avm_id) 
    364501# else 
    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) 
     502         CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),avm_id) 
    366503# endif 
    367504      ENDIF 
    368  
     505      
    369506      ! 2. Type of interpolation 
    370507      !------------------------- 
    371508      CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear) 
    372  
    373509      CALL Agrif_Set_bcinterp(un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    374510      CALL Agrif_Set_bcinterp(vn_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
    375511 
    376512      CALL Agrif_Set_bcinterp(tsn_sponge_id,interp=AGRIF_linear) 
     513      CALL Agrif_Set_bcinterp(un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
     514      CALL Agrif_Set_bcinterp(vn_sponge_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
    377515 
    378516      CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_linear) 
     
    390528!< 
    391529 
    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 
     530      IF( ln_zdftke.OR.ln_zdfgls )  CALL Agrif_Set_bcinterp( avm_id, interp=AGRIF_linear ) 
     531     
     532 
     533       ! 3. Location of interpolation 
    405534      !----------------------------- 
    406535      CALL Agrif_Set_bc(       tsn_id, (/0,ind1-1/) ) ! if west,  rhox=3 and nbghost=3: columns 2 to 4 
     
    418547      CALL Agrif_Set_bc( vb2b_interp_id, (/0,ind1-1/) ) 
    419548 
    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/) ) 
     549      IF( ln_zdftke.OR.ln_zdfgls ) CALL Agrif_Set_bc( avm_id, (/0,ind1/) ) 
    431550 
    432551      ! 4. Update type 
    433552      !---------------  
    434       CALL Agrif_Set_Updatetype(scales_t_id, update = AGRIF_Update_Average) 
    435553 
    436554# if defined UPD_HIGH 
     
    444562      CALL Agrif_Set_Updatetype(e3t_id, update = Agrif_Update_Full_Weighting) 
    445563 
    446       IF( ln_zdftke.OR.ln_zdfgls ) THEN 
     564  !    IF( ln_zdftke.OR.ln_zdfgls ) THEN 
    447565!         CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Full_Weighting) 
    448566!         CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Full_Weighting) 
    449567!         CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Full_Weighting) 
    450       ENDIF 
     568   !   ENDIF 
    451569 
    452570#else 
     
    460578      CALL Agrif_Set_Updatetype(e3t_id, update = AGRIF_Update_Average) 
    461579 
    462       IF( ln_zdftke.OR.ln_zdfgls ) THEN 
     580 !     IF( ln_zdftke.OR.ln_zdfgls ) THEN 
    463581!         CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Average) 
    464582!         CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Average) 
    465583!         CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Average) 
    466       ENDIF 
     584 !     ENDIF 
    467585 
    468586#endif 
     
    472590#if defined key_si3 
    473591SUBROUTINE Agrif_InitValues_cont_ice 
    474       !!---------------------------------------------------------------------- 
    475       !!                 *** ROUTINE Agrif_InitValues_cont_ice *** 
    476       !!---------------------------------------------------------------------- 
    477592      USE Agrif_Util 
    478593      USE sbc_oce, ONLY : nn_fsbc  ! clem: necessary otherwise Agrif_Parent(nn_fsbc) = nn_fsbc 
     
    482597      USE agrif_ice_interp 
    483598      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 
     599      !!---------------------------------------------------------------------- 
     600      !!                 *** ROUTINE Agrif_InitValues_cont_ice *** 
     601      !!---------------------------------------------------------------------- 
    491602 
    492603      ! Controls 
     
    495606      !          the run must satisfy CFL=Uice/(dx/dt) < 0.6/nn_fsbc(child) 
    496607      !          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 
     608      !       If a solution is found, the following stop could be removed because the rest of the code take nn_fsbc(child) into account      
    498609      IF( nn_fsbc > 1 )  CALL ctl_stop('nn_fsbc(child) must be set to 1 otherwise agrif and sea-ice may not work properly') 
    499610 
     
    516627      !!                 *** ROUTINE agrif_declare_var_ice *** 
    517628      !!---------------------------------------------------------------------- 
     629 
    518630      USE Agrif_Util 
    519631      USE ice 
    520       USE par_oce, ONLY : nbghostcells 
     632      USE par_oce, ONLY : nbghostcells, nbghostcells_x, nbghostcells_y_s 
    521633      ! 
    522634      IMPLICIT NONE 
    523635      ! 
    524636      INTEGER :: ind1, ind2, ind3 
    525       !!---------------------------------------------------------------------- 
     637         !!---------------------------------------------------------------------- 
    526638      ! 
    527639      ! 1. Declaration of the type of variable which have to be interpolated (parent=>child) 
     
    532644      !                            2,2 = two ghost lines 
    533645      !------------------------------------------------------------------------------------- 
     646 
    534647      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  ) 
     648      ind2 = 2 + nbghostcells_x 
     649      ind3 = 2 + nbghostcells_y_s 
     650      CALL agrif_declare_variable((/2,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpl*(8+nlay_s+nlay_i)/),tra_ice_id) 
     651      CALL agrif_declare_variable((/1,2/)  ,(/ind2-1,ind3/)  ,(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,u_ice_id  ) 
     652      CALL agrif_declare_variable((/2,1/)  ,(/ind2,ind3-1/)  ,(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,v_ice_id  ) 
     653 
     654      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_iceini_id) 
     655      CALL agrif_declare_variable((/1,2/)  ,(/ind2-1,ind3/)  ,(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,u_iceini_id  ) 
     656      CALL agrif_declare_variable((/2,1/)  ,(/ind2,ind3-1/)  ,(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,v_iceini_id  ) 
    540657 
    541658      ! 2. Set interpolations (normal & tangent to the grid cell for velocities) 
     
    545662      CALL Agrif_Set_bcinterp(v_ice_id  , interp1 = AGRIF_ppm   ,interp2 = Agrif_linear) 
    546663 
     664      CALL Agrif_Set_bcinterp(tra_iceini_id, interp  = AGRIF_linear) 
     665      CALL Agrif_Set_interp  (tra_iceini_id, interp  = AGRIF_linear) 
     666      CALL Agrif_Set_bcinterp(u_iceini_id  , interp  = AGRIF_linear  ) 
     667      CALL Agrif_Set_interp  (u_iceini_id  , interp  = AGRIF_linear   ) 
     668      CALL Agrif_Set_bcinterp(v_iceini_id  , interp  = AGRIF_linear) 
     669      CALL Agrif_Set_interp  (v_iceini_id  , interp  = AGRIF_linear) 
     670 
    547671      ! 3. Set location of interpolations 
    548672      !---------------------------------- 
     
    550674      CALL Agrif_Set_bc(u_ice_id  ,(/0,ind1/)) 
    551675      CALL Agrif_Set_bc(v_ice_id  ,(/0,ind1/)) 
     676 
     677      CALL Agrif_Set_bc(tra_iceini_id,(/0,ind1/)) 
     678      CALL Agrif_Set_bc(u_iceini_id  ,(/0,ind1/)) 
     679      CALL Agrif_Set_bc(v_iceini_id  ,(/0,ind1/)) 
    552680 
    553681      ! 4. Set update type in case 2 ways (child=>parent) (normal & tangent to the grid cell for velocities) 
     
    557685      CALL Agrif_Set_Updatetype(u_ice_id  , update1 = Agrif_Update_Average       , update2 = Agrif_Update_Full_Weighting) 
    558686      CALL Agrif_Set_Updatetype(v_ice_id  , update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average       ) 
    559 #else 
     687# else 
    560688      CALL Agrif_Set_Updatetype(tra_ice_id, update  = AGRIF_Update_Average) 
    561689      CALL Agrif_Set_Updatetype(u_ice_id  , update1 = Agrif_Update_Copy   , update2 = Agrif_Update_Average) 
    562690      CALL Agrif_Set_Updatetype(v_ice_id  , update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy   ) 
    563 #endif 
     691# endif 
    564692 
    565693   END SUBROUTINE agrif_declare_var_ice 
     
    585713      USE agrif_top_sponge 
    586714      !! 
    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() 
     715   
     716   !! 
     717   IMPLICIT NONE 
     718   ! 
     719   CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3 
     720   LOGICAL :: check_namelist 
     721      !!---------------------------------------------------------------------- 
     722 
     723 
     724   ! 1. Declaration of the type of variable which have to be interpolated 
     725   !--------------------------------------------------------------------- 
     726   CALL agrif_declare_var_top 
     727 
     728   ! 2. First interpolations of potentially non zero fields 
     729   !------------------------------------------------------- 
     730   Agrif_SpecialValue=0. 
     731   Agrif_UseSpecialValue = .TRUE. 
     732   CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn) 
     733   Agrif_UseSpecialValue = .FALSE. 
     734   CALL Agrif_Sponge 
     735   tabspongedone_trn = .FALSE. 
     736   CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge) 
     737   ! reset tsa to zero 
     738   tra(:,:,:,:) = 0. 
     739 
     740   ! 3. Some controls 
     741   !----------------- 
     742   check_namelist = .TRUE. 
     743 
     744   IF( check_namelist ) THEN 
     745      ! Check time steps 
     746      IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN 
     747         WRITE(cl_check1,*)  Agrif_Parent(rdt) 
     748         WRITE(cl_check2,*)  rdt 
     749         WRITE(cl_check3,*)  rdt*Agrif_Rhot() 
    619750         CALL ctl_stop( 'incompatible time step between grids',   & 
    620751               &               'parent grid value : '//cl_check1    ,   &  
     
    635766         nitend =  Agrif_Parent(nitend)   *Agrif_IRhot() 
    636767      ENDIF 
    637  
    638768   ENDIF 
    639769   ! 
     
    655785      !!---------------------------------------------------------------------- 
    656786 
     787 
     788 
     789!RB_CMEMS : declare here init for top       
    657790      ! 1. Declaration of the type of variable which have to be interpolated 
    658791      !--------------------------------------------------------------------- 
    659792      ind1 =     nbghostcells 
    660       ind2 = 1 + nbghostcells 
    661       ind3 = 2 + nbghostcells 
     793      ind2 = 2 + nbghostcells_x 
     794      ind3 = 2 + nbghostcells_y_s 
    662795# if defined key_vertical 
    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) 
     796      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra+1/),trn_id) 
     797      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra+1/),trn_sponge_id) 
    665798# else 
    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) 
     799! LAURENT: STRANGE why (3,3) here ? 
     800      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) 
     801      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) 
    668802# endif 
    669803 
     
    705839      !!                     *** ROUTINE agrif_init *** 
    706840      !!---------------------------------------------------------------------- 
    707       USE agrif_oce  
    708       USE agrif_ice 
    709       USE in_out_manager 
    710       USE lib_mpp 
     841   USE agrif_oce  
     842   USE agrif_ice 
     843   USE dom_oce 
     844   USE in_out_manager 
     845   USE lib_mpp 
    711846      !! 
    712847      IMPLICIT NONE 
    713848      ! 
    714849      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, & 
     850      NAMELIST/namagrif/ ln_agrif_2way, ln_init_chfrpar, rn_sponge_tra, rn_sponge_dyn, rn_trelax_tra, rn_trelax_dyn, & 
    716851                       & ln_spc_dyn, ln_chk_bathy 
    717852      !!-------------------------------------------------------------------------------------- 
     
    729864         WRITE(numout,*) '   Namelist namagrif : set AGRIF parameters' 
    730865         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.' 
     866         WRITE(numout,*) '      child initial state from parent ln_init_chfrpar = ', ln_init_chfrpar 
     867         WRITE(numout,*) '      ad. sponge coeft for tracers      rn_sponge_tra = ', rn_sponge_tra 
     868         WRITE(numout,*) '      ad. sponge coeft for dynamics     rn_sponge_tra = ', rn_sponge_dyn 
     869         WRITE(numout,*) '      ad. time relaxation for tracers   rn_trelax_tra = ', rn_trelax_tra 
     870         WRITE(numout,*) '      ad. time relaxation for dynamics  rn_trelax_dyn = ', rn_trelax_dyn 
    735871         WRITE(numout,*) '      use special values for dynamics   ln_spc_dyn    = ', ln_spc_dyn 
    736872         WRITE(numout,*) '      check bathymetry                  ln_chk_bathy  = ', ln_chk_bathy 
    737873      ENDIF 
    738       ! 
    739       ! 
    740       IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed') 
     874 
     875      lk_west  = .NOT. ( Agrif_Ix() == 1 ) 
     876      lk_east  = .NOT. ( Agrif_Ix() + nbcellsx/AGRIF_Irhox() == Agrif_Parent(jpiglo) -1 ) 
     877      lk_south = .NOT. ( Agrif_Iy() == 1 ) 
     878      lk_north = .NOT. ( Agrif_Iy() + nbcellsy/AGRIF_Irhoy() == Agrif_Parent(jpjglo) -1 ) 
     879 
     880      ! 
     881      ! Set the number of ghost cells according to periodicity 
     882      nbghostcells_x = nbghostcells 
     883      nbghostcells_y_s = nbghostcells 
     884      nbghostcells_y_n = nbghostcells 
     885      ! 
     886      IF ( jperio == 1 ) nbghostcells_x = 0 
     887      IF ( .NOT. lk_south ) nbghostcells_y_s = 0 
     888 
     889      ! Some checks 
     890      IF( jpiglo /= nbcellsx + 2 + 2*nbghostcells_x )   & 
     891          CALL ctl_stop( 'STOP', 'agrif_nemo_init: Agrif children requires jpiglo == nbcellsx + 2 + 2*nbghostcells_x' ) 
     892      IF( jpjglo /= nbcellsy + 2 + nbghostcells_y_s + nbghostcells_y_n )   & 
     893          CALL ctl_stop( 'STOP', 'agrif_nemo_init: Agrif children requires jpjglo == nbcellsy + 2 + nbghostcells_y_s + nbghostcells_y_n' ) 
     894      IF( ln_use_jattr )   CALL ctl_stop( 'STOP', 'agrif_nemo_init:Agrif children requires ln_use_jattr = .false. ' ) 
    741895      ! 
    742896   END SUBROUTINE agrif_nemo_init 
    743897 
    744898# if defined key_mpp_mpi 
    745  
    746899   SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob ) 
    747900      !!---------------------------------------------------------------------- 
     
    803956# endif 
    804957 
     958   SUBROUTINE nemo_mapping(ndim,ptx,pty,bounds,bounds_chunks,correction_required,nb_chunks) 
     959      !!---------------------------------------------------------------------- 
     960      !!                   *** ROUTINE Nemo_mapping *** 
     961      !!---------------------------------------------------------------------- 
     962      USE dom_oce 
     963      !! 
     964      IMPLICIT NONE 
     965      ! 
     966      INTEGER :: ndim 
     967      INTEGER :: ptx, pty 
     968      INTEGER, DIMENSION(ndim,2,2) :: bounds 
     969      INTEGER, DIMENSION(:,:,:,:), ALLOCATABLE :: bounds_chunks 
     970      LOGICAL, DIMENSION(:), ALLOCATABLE :: correction_required 
     971      INTEGER :: nb_chunks 
     972      ! 
     973      INTEGER :: i 
     974 
     975      IF (agrif_debug_interp) THEN 
     976         DO i=1,ndim 
     977            WRITE(*,*) 'direction = ',i,bounds(i,1,2),bounds(i,2,2) 
     978         ENDDO 
     979      ENDIF 
     980 
     981      IF( bounds(2,2,2) > jpjglo) THEN 
     982         IF( bounds(2,1,2) <=jpjglo) THEN 
     983            nb_chunks = 2 
     984            ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2)) 
     985            ALLOCATE(correction_required(nb_chunks)) 
     986            DO i = 1,nb_chunks 
     987               bounds_chunks(i,:,:,:) = bounds 
     988            END DO 
     989         
     990      ! FIRST CHUNCK (for j<=jpjglo)    
     991 
     992      ! Original indices 
     993            bounds_chunks(1,1,1,1) = bounds(1,1,2) 
     994            bounds_chunks(1,1,2,1) = bounds(1,2,2) 
     995            bounds_chunks(1,2,1,1) = bounds(2,1,2) 
     996            bounds_chunks(1,2,2,1) = jpjglo 
     997 
     998            bounds_chunks(1,1,1,2) = bounds(1,1,2) 
     999            bounds_chunks(1,1,2,2) = bounds(1,2,2) 
     1000            bounds_chunks(1,2,1,2) = bounds(2,1,2) 
     1001            bounds_chunks(1,2,2,2) = jpjglo 
     1002 
     1003      ! Correction required or not 
     1004            correction_required(1)=.FALSE. 
     1005        
     1006      ! SECOND CHUNCK (for j>jpjglo) 
     1007 
     1008      ! Original indices 
     1009            bounds_chunks(2,1,1,1) = bounds(1,1,2) 
     1010            bounds_chunks(2,1,2,1) = bounds(1,2,2) 
     1011            bounds_chunks(2,2,1,1) = jpjglo-2 
     1012            bounds_chunks(2,2,2,1) = bounds(2,2,2) 
     1013 
     1014      ! Where to find them 
     1015      ! We use the relation TAB(ji,jj)=TAB(jpiglo-ji+2,jpjglo-2-(jj-jpjglo)) 
     1016 
     1017            IF( ptx == 2) THEN ! T, V points 
     1018               bounds_chunks(2,1,1,2) = jpiglo-bounds(1,2,2)+2 
     1019               bounds_chunks(2,1,2,2) = jpiglo-bounds(1,1,2)+2 
     1020            ELSE ! U, F points 
     1021               bounds_chunks(2,1,1,2) = jpiglo-bounds(1,2,2)+1 
     1022               bounds_chunks(2,1,2,2) = jpiglo-bounds(1,1,2)+1        
     1023            ENDIF 
     1024 
     1025            IF( pty == 2) THEN ! T, U points 
     1026               bounds_chunks(2,2,1,2) = jpjglo-2-(bounds(2,2,2) -jpjglo) 
     1027               bounds_chunks(2,2,2,2) = jpjglo-2-(jpjglo-2      -jpjglo) 
     1028            ELSE ! V, F points 
     1029               bounds_chunks(2,2,1,2) = jpjglo-3-(bounds(2,2,2) -jpjglo) 
     1030               bounds_chunks(2,2,2,2) = jpjglo-3-(jpjglo-2      -jpjglo) 
     1031            ENDIF 
     1032      ! Correction required or not 
     1033            correction_required(2)=.TRUE. 
     1034 
     1035         ELSE 
     1036            nb_chunks = 1 
     1037            ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2)) 
     1038            ALLOCATE(correction_required(nb_chunks)) 
     1039            DO i=1,nb_chunks 
     1040               bounds_chunks(i,:,:,:) = bounds 
     1041            END DO 
     1042 
     1043            bounds_chunks(1,1,1,1) = bounds(1,1,2) 
     1044            bounds_chunks(1,1,2,1) = bounds(1,2,2) 
     1045            bounds_chunks(1,2,1,1) = bounds(2,1,2) 
     1046            bounds_chunks(1,2,2,1) = bounds(2,2,2) 
     1047 
     1048            bounds_chunks(1,1,1,2) = jpiglo-bounds(1,2,2)+2 
     1049            bounds_chunks(1,1,2,2) = jpiglo-bounds(1,1,2)+2 
     1050 
     1051            bounds_chunks(1,2,1,2) = jpjglo-2-(bounds(2,2,2)-jpjglo) 
     1052            bounds_chunks(1,2,2,2) = jpjglo-2-(bounds(2,1,2)-jpjglo) 
     1053 
     1054            IF( ptx == 2) THEN ! T, V points 
     1055               bounds_chunks(1,1,1,2) = jpiglo-bounds(1,2,2)+2 
     1056               bounds_chunks(1,1,2,2) = jpiglo-bounds(1,1,2)+2 
     1057            ELSE ! U, F points 
     1058               bounds_chunks(1,1,1,2) = jpiglo-bounds(1,2,2)+1 
     1059               bounds_chunks(1,1,2,2) = jpiglo-bounds(1,1,2)+1        
     1060            ENDIF 
     1061 
     1062            IF (pty == 2) THEN ! T, U points 
     1063               bounds_chunks(1,2,1,2) = jpjglo-2-(bounds(2,2,2) -jpjglo) 
     1064               bounds_chunks(1,2,2,2) = jpjglo-2-(bounds(2,1,2) -jpjglo) 
     1065            ELSE ! V, F points 
     1066               bounds_chunks(1,2,1,2) = jpjglo-3-(bounds(2,2,2) -jpjglo) 
     1067               bounds_chunks(1,2,2,2) = jpjglo-3-(bounds(2,1,2) -jpjglo) 
     1068            ENDIF 
     1069 
     1070            correction_required(1)=.TRUE.           
     1071         ENDIF 
     1072 
     1073      ELSE IF (bounds(1,1,2) < 1) THEN 
     1074         IF (bounds(1,2,2) > 0) THEN 
     1075            nb_chunks = 2 
     1076            ALLOCATE(correction_required(nb_chunks)) 
     1077            correction_required=.FALSE. 
     1078            ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2)) 
     1079            DO i=1,nb_chunks 
     1080               bounds_chunks(i,:,:,:) = bounds 
     1081            END DO 
     1082               
     1083            bounds_chunks(1,1,1,2) = bounds(1,1,2)+jpiglo-2 
     1084            bounds_chunks(1,1,2,2) = 1+jpiglo-2 
     1085           
     1086            bounds_chunks(1,1,1,1) = bounds(1,1,2) 
     1087            bounds_chunks(1,1,2,1) = 1 
     1088        
     1089            bounds_chunks(2,1,1,2) = 2 
     1090            bounds_chunks(2,1,2,2) = bounds(1,2,2) 
     1091           
     1092            bounds_chunks(2,1,1,1) = 2 
     1093            bounds_chunks(2,1,2,1) = bounds(1,2,2) 
     1094 
     1095         ELSE 
     1096            nb_chunks = 1 
     1097            ALLOCATE(correction_required(nb_chunks)) 
     1098            correction_required=.FALSE. 
     1099            ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2)) 
     1100            DO i=1,nb_chunks 
     1101               bounds_chunks(i,:,:,:) = bounds 
     1102            END DO     
     1103            bounds_chunks(1,1,1,2) = bounds(1,1,2)+jpiglo-2 
     1104            bounds_chunks(1,1,2,2) = bounds(1,2,2)+jpiglo-2 
     1105           
     1106            bounds_chunks(1,1,1,1) = bounds(1,1,2) 
     1107           bounds_chunks(1,1,2,1) = bounds(1,2,2) 
     1108         ENDIF 
     1109      ELSE 
     1110         nb_chunks=1   
     1111         ALLOCATE(correction_required(nb_chunks)) 
     1112         correction_required=.FALSE. 
     1113         ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2)) 
     1114         DO i=1,nb_chunks 
     1115            bounds_chunks(i,:,:,:) = bounds 
     1116         END DO 
     1117         bounds_chunks(1,1,1,2) = bounds(1,1,2) 
     1118         bounds_chunks(1,1,2,2) = bounds(1,2,2) 
     1119         bounds_chunks(1,2,1,2) = bounds(2,1,2) 
     1120         bounds_chunks(1,2,2,2) = bounds(2,2,2) 
     1121           
     1122         bounds_chunks(1,1,1,1) = bounds(1,1,2) 
     1123         bounds_chunks(1,1,2,1) = bounds(1,2,2) 
     1124         bounds_chunks(1,2,1,1) = bounds(2,1,2) 
     1125         bounds_chunks(1,2,2,1) = bounds(2,2,2)               
     1126      ENDIF 
     1127         
     1128   END SUBROUTINE nemo_mapping 
     1129 
     1130   FUNCTION agrif_external_switch_index(ptx,pty,i1,isens) 
     1131 
     1132   USE dom_oce 
     1133 
     1134   INTEGER :: ptx, pty, i1, isens 
     1135   INTEGER :: agrif_external_switch_index 
     1136 
     1137   IF( isens == 1 ) THEN 
     1138      IF( ptx == 2 ) THEN ! T, V points 
     1139         agrif_external_switch_index = jpiglo-i1+2 
     1140      ELSE ! U, F points 
     1141         agrif_external_switch_index = jpiglo-i1+1       
     1142      ENDIF 
     1143   ELSE IF( isens ==2 ) THEN 
     1144      IF ( pty == 2 ) THEN ! T, U points 
     1145         agrif_external_switch_index = jpjglo-2-(i1 -jpjglo) 
     1146      ELSE ! V, F points 
     1147         agrif_external_switch_index = jpjglo-3-(i1 -jpjglo) 
     1148      ENDIF 
     1149   ENDIF 
     1150 
     1151   END FUNCTION agrif_external_switch_index 
     1152 
     1153   SUBROUTINE Correct_field(tab2d,i1,i2,j1,j2) 
     1154      !!---------------------------------------------------------------------- 
     1155      !!                   *** ROUTINE Correct_field *** 
     1156      !!---------------------------------------------------------------------- 
     1157    
     1158   USE dom_oce 
     1159   USE agrif_oce 
     1160 
     1161   INTEGER :: i1,i2,j1,j2 
     1162   REAL(wp), DIMENSION(i1:i2,j1:j2) :: tab2d 
     1163 
     1164   INTEGER :: i,j 
     1165   REAL(wp), DIMENSION(i1:i2,j1:j2) :: tab2dtemp 
     1166 
     1167   tab2dtemp = tab2d 
     1168 
     1169   IF( .NOT. use_sign_north ) THEN 
     1170      DO j=j1,j2 
     1171         DO i=i1,i2 
     1172            tab2d(i,j)=tab2dtemp(i2-(i-i1),j2-(j-j1)) 
     1173         END DO 
     1174      END DO 
     1175   ELSE 
     1176      DO j=j1,j2 
     1177         DO i=i1,i2 
     1178            tab2d(i,j)=sign_north * tab2dtemp(i2-(i-i1),j2-(j-j1)) 
     1179         END DO 
     1180      END DO 
     1181   ENDIF 
     1182 
     1183   END SUBROUTINE Correct_field 
     1184 
    8051185#else 
    8061186   SUBROUTINE Subcalledbyagrif 
Note: See TracChangeset for help on using the changeset viewer.