New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
Changeset 13540 for NEMO/branches/2020/r12377_ticket2386/src/NST/agrif_user.F90 – NEMO

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

Ticket #2386: update to latest trunk

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

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2020/r12377_ticket2386

    • Property svn:externals
      •  

        old new  
        33^/utils/build/mk@HEAD         mk 
        44^/utils/tools@HEAD            tools 
        5 ^/vendors/AGRIF/dev@HEAD      ext/AGRIF 
         5^/vendors/AGRIF/dev_r12970_AGRIF_CMEMS      ext/AGRIF 
        66^/vendors/FCM@HEAD            ext/FCM 
        77^/vendors/IOIPSL@HEAD         ext/IOIPSL 
        88 
        99# SETTE 
        10 ^/utils/CI/sette@HEAD         sette 
         10^/utils/CI/sette@13507        sette 
  • NEMO/branches/2020/r12377_ticket2386/src/NST/agrif_user.F90

    r12511 r13540  
    1111   END SUBROUTINE agrif_user 
    1212 
     13    
    1314   SUBROUTINE agrif_before_regridding 
    1415   END SUBROUTINE agrif_before_regridding 
    1516 
     17    
    1618   SUBROUTINE Agrif_InitWorkspace 
    1719   END SUBROUTINE Agrif_InitWorkspace 
    1820 
     21    
    1922   SUBROUTINE Agrif_InitValues 
    2023      !!---------------------------------------------------------------------- 
     
    2831      ! 
    2932      !                    !* Agrif initialization 
    30       CALL agrif_nemo_init 
    31       CALL Agrif_InitValues_cont_dom 
    3233      CALL Agrif_InitValues_cont 
    3334# if defined key_top 
     
    4041   END SUBROUTINE Agrif_initvalues 
    4142 
    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       
     43    
     44   SUBROUTINE Agrif_Istate( Kbb, Kmm, Kaa ) 
     45      !!---------------------------------------------------------------------- 
     46      !!                 *** ROUTINE agrif_istate *** 
     47      !!---------------------------------------------------------------------- 
     48      USE domvvl 
     49      USE domain 
     50      USE par_oce 
     51      USE agrif_oce 
     52      USE agrif_oce_interp 
     53      USE oce 
     54      USE lib_mpp 
     55      USE lbclnk 
     56      ! 
     57      IMPLICIT NONE 
     58      ! 
     59      INTEGER, INTENT(in)  :: Kbb, Kmm, Kaa 
     60      INTEGER :: jn 
     61      !!---------------------------------------------------------------------- 
     62      IF(lwp) WRITE(numout,*) ' ' 
     63      IF(lwp) WRITE(numout,*) 'AGRIF: interp child initial state from parent' 
     64      IF(lwp) WRITE(numout,*) ' ' 
     65 
     66      l_ini_child           = .TRUE. 
     67      Agrif_SpecialValue    = 0.0_wp 
     68      Agrif_UseSpecialValue = .TRUE. 
     69      uu(:,:,:,:) = 0.0_wp   ;   vv(:,:,:,:) = 0.0_wp   ;   ts(:,:,:,:,:) = 0.0_wp 
     70        
     71      Krhs_a = Kbb   ;   Kmm_a = Kbb 
     72 
     73      ! Brutal fix to pas 1x1 refinment.  
     74  !    IF(Agrif_Irhox() == 1) THEN 
     75  !       CALL Agrif_Init_Variable(tsini_id, procname=agrif_initts) 
     76  !    ELSE 
     77      CALL Agrif_Init_Variable(tsini_id, procname=interptsn) 
     78 
     79  !    ENDIF 
     80! just for VORTEX because Parent velocities can actually be exactly zero 
     81!      Agrif_UseSpecialValue = .FALSE. 
     82      Agrif_UseSpecialValue = ln_spc_dyn 
     83      use_sign_north = .TRUE. 
     84      sign_north = -1. 
     85      CALL Agrif_Init_Variable(uini_id , procname=interpun ) 
     86      CALL Agrif_Init_Variable(vini_id , procname=interpvn ) 
     87      use_sign_north = .FALSE. 
     88 
     89      Agrif_UseSpecialValue = .FALSE. 
     90      l_ini_child           = .FALSE. 
     91 
     92      Krhs_a = Kaa   ;   Kmm_a = Kmm 
     93 
     94      DO jn = 1, jpts 
     95         ts(:,:,:,jn,Kbb) = ts(:,:,:,jn,Kbb)*tmask(:,:,:) 
     96      END DO 
     97      uu(:,:,:,Kbb) = uu(:,:,:,Kbb) * umask(:,:,:)      
     98      vv(:,:,:,Kbb) = vv(:,:,:,Kbb) * vmask(:,:,:)  
     99 
     100 
     101      CALL lbc_lnk_multi( 'agrif_istate', uu(:,:,:  ,Kbb), 'U', -1.0_wp , vv(:,:,:,Kbb), 'V', -1.0_wp ) 
     102      CALL lbc_lnk(       'agrif_istate', ts(:,:,:,:,Kbb), 'T',  1.0_wp ) 
     103 
     104   END SUBROUTINE Agrif_Istate 
     105 
     106    
     107   SUBROUTINE agrif_declare_var_ini 
     108      !!---------------------------------------------------------------------- 
     109      !!                 *** ROUTINE agrif_declare_var_ini *** 
     110      !!---------------------------------------------------------------------- 
     111      USE agrif_util 
     112      USE agrif_oce 
     113      USE par_oce 
     114      USE zdf_oce  
     115      USE oce 
     116      USE dom_oce 
    56117      ! 
    57118      IMPLICIT NONE 
    58119      ! 
    59120      INTEGER :: ind1, ind2, ind3 
    60       !!---------------------------------------------------------------------- 
     121      INTEGER :: its 
     122      External :: nemo_mapping 
     123      !!---------------------------------------------------------------------- 
     124 
     125! In case of East-West periodicity, prevent AGRIF interpolation at east and west boundaries 
     126! The procnames will not be called at these boundaries 
     127      IF (jperio == 1) THEN 
     128         CALL Agrif_Set_NearCommonBorderX(.TRUE.) 
     129         CALL Agrif_Set_DistantCommonBorderX(.TRUE.) 
     130      ENDIF 
     131 
     132      IF ( .NOT. lk_south ) THEN 
     133         CALL Agrif_Set_NearCommonBorderY(.TRUE.) 
     134      ENDIF 
    61135 
    62136      ! 1. Declaration of the type of variable which have to be interpolated 
    63137      !--------------------------------------------------------------------- 
    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) 
    69  
     138      ind1 =              nbghostcells 
     139      ind2 = nn_hls + 2 + nbghostcells_x 
     140      ind3 = nn_hls + 2 + nbghostcells_y_s 
     141 
     142      CALL agrif_declare_variable((/2,2,0  /),(/ind2  ,ind3,0    /),(/'x','y','N'    /),(/1,1,1  /),(/jpi,jpj,jpk    /),   e3t_id) 
     143      CALL agrif_declare_variable((/2,2    /),(/ind2  ,ind3      /),(/'x','y'        /),(/1,1    /),(/jpi,jpj        /),  mbkt_id) 
     144      CALL agrif_declare_variable((/2,2    /),(/ind2  ,ind3      /),(/'x','y'        /),(/1,1    /),(/jpi,jpj        /),   ht0_id) 
     145 
     146      CALL agrif_declare_variable((/1,2    /),(/ind2-1,ind3      /),(/'x','y'        /),(/1,1    /),(/jpi,jpj        /),   e1u_id) 
     147      CALL agrif_declare_variable((/2,1    /),(/ind2  ,ind3-1    /),(/'x','y'        /),(/1,1    /),(/jpi,jpj        /),   e2v_id) 
     148    
     149      ! Initial or restart velues 
     150      its = jpts+1 
     151      CALL agrif_declare_variable((/2,2,0,0/),(/ind2  ,ind3  ,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,its/), tsini_id) 
     152      CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3  ,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2  /),  uini_id)  
     153      CALL agrif_declare_variable((/2,1,0,0/),(/ind2  ,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2  /),  vini_id) 
     154      CALL agrif_declare_variable((/2,2    /),(/ind2  ,ind3      /),(/'x','y'        /),(/1,1    /),(/jpi,jpj        /),sshini_id) 
     155      !  
     156      
    70157      ! 2. Type of interpolation 
    71158      !------------------------- 
    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 ) 
    74  
    75       ! 3. Location of interpolation 
     159      CALL Agrif_Set_bcinterp(   e3t_id,interp =AGRIF_constant) 
     160 
     161      CALL Agrif_Set_bcinterp(  mbkt_id,interp =AGRIF_constant) 
     162      CALL Agrif_Set_interp  (  mbkt_id,interp =AGRIF_constant) 
     163      CALL Agrif_Set_bcinterp(   ht0_id,interp =AGRIF_constant) 
     164      CALL Agrif_Set_interp  (   ht0_id,interp =AGRIF_constant) 
     165 
     166      CALL Agrif_Set_bcinterp(   e1u_id,interp1=Agrif_linear, interp2=AGRIF_ppm    ) 
     167      CALL Agrif_Set_bcinterp(   e2v_id,interp1=AGRIF_ppm   , interp2=Agrif_linear ) 
     168 
     169      ! Initial fields 
     170      CALL Agrif_Set_bcinterp( tsini_id,interp =AGRIF_linear  ) 
     171      CALL Agrif_Set_interp  ( tsini_id,interp =AGRIF_linear  ) 
     172      CALL Agrif_Set_bcinterp(  uini_id,interp =AGRIF_linear  ) 
     173      CALL Agrif_Set_interp  (  uini_id,interp =AGRIF_linear  ) 
     174      CALL Agrif_Set_bcinterp(  vini_id,interp =AGRIF_linear  ) 
     175      CALL Agrif_Set_interp  (  vini_id,interp =AGRIF_linear  ) 
     176      CALL Agrif_Set_bcinterp(sshini_id,interp =AGRIF_linear  ) 
     177      CALL Agrif_Set_interp  (sshini_id,interp =AGRIF_linear  ) 
     178 
     179       ! 3. Location of interpolation 
    76180      !----------------------------- 
    77       CALL Agrif_Set_bc(e1u_id,(/0,ind1-1/)) 
    78       CALL Agrif_Set_bc(e2v_id,(/0,ind1-1/)) 
     181!      CALL Agrif_Set_bc(  e3t_id, (/-nn_sponge_len*Agrif_irhox(),ind1-1/) )   
     182! JC: check near the boundary only until matching in sponge has been sorted out: 
     183      CALL Agrif_Set_bc(    e3t_id, (/0,ind1-1/) )   
     184 
     185      ! extend the interpolation zone by 1 more point than necessary: 
     186      ! RB check here 
     187      CALL Agrif_Set_bc(   mbkt_id, (/-nn_sponge_len*Agrif_irhox()-2,ind1/) ) 
     188      CALL Agrif_Set_bc(    ht0_id, (/-nn_sponge_len*Agrif_irhox()-2,ind1/) ) 
     189       
     190      CALL Agrif_Set_bc(    e1u_id, (/0,ind1-1/) ) 
     191      CALL Agrif_Set_bc(    e2v_id, (/0,ind1-1/) )   
     192 
     193      CALL Agrif_Set_bc(  tsini_id, (/0,ind1-1/) ) ! if west,  rhox=3 and nbghost=3: columns 2 to 4 
     194      CALL Agrif_Set_bc(   uini_id, (/0,ind1-1/) )  
     195      CALL Agrif_Set_bc(   vini_id, (/0,ind1-1/) ) 
     196      CALL Agrif_Set_bc( sshini_id, (/0,ind1-1/) ) 
    79197 
    80198      ! 4. Update type 
    81199      !---------------  
    82200# if defined UPD_HIGH 
    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) 
     201      CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Average       , update2=Agrif_Update_Full_Weighting) 
     202      CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Full_Weighting, update2=Agrif_Update_Average       ) 
    85203#else 
    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) 
     204      CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy          , update2=Agrif_Update_Average       ) 
     205      CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average       , update2=Agrif_Update_Copy          ) 
    88206#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 
     207       
     208   !   CALL Agrif_Set_ExternalMapping(nemo_mapping) 
     209      ! 
     210   END SUBROUTINE agrif_declare_var_ini 
     211 
     212 
     213   SUBROUTINE Agrif_Init_Domain( Kbb, Kmm, Kaa )  
     214      !!---------------------------------------------------------------------- 
     215      !!                 *** ROUTINE Agrif_Init_Domain *** 
     216      !!---------------------------------------------------------------------- 
     217      USE agrif_oce_update 
    97218      USE agrif_oce_interp 
    98219      USE agrif_oce_sponge 
     220      USE Agrif_Util 
     221      USE oce  
    99222      USE dom_oce 
    100       USE oce 
     223      USE zdf_oce 
     224      USE nemogcm 
     225      USE agrif_oce 
     226      ! 
     227      USE lbclnk 
    101228      USE lib_mpp 
    102       USE lbclnk 
    103       ! 
    104       IMPLICIT NONE 
    105       ! 
    106       INTEGER :: ji, jj 
     229      USE in_out_manager 
     230      ! 
     231      IMPLICIT NONE 
     232      ! 
     233      INTEGER, INTENT(in) ::  Kbb, Kmm, Kaa 
     234      ! 
    107235      LOGICAL :: check_namelist 
    108236      CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3, cl_check4  
    109 #if defined key_vertical 
    110237      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 
     238      INTEGER :: ji, jj, jk 
     239      !!---------------------------------------------------------------------- 
     240     
     241     ! CALL Agrif_Declare_Var_ini 
     242 
     243      IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed') 
     244 
    122245      ! Build consistent parent bathymetry and number of levels 
    123246      ! on the child grid  
    124247      Agrif_UseSpecialValue = .FALSE. 
    125       ht0_parent(:,:) = 0._wp 
     248      ht0_parent( :,:) = 0._wp 
    126249      mbkt_parent(:,:) = 0 
    127250      ! 
    128       CALL Agrif_Bc_variable(ht0_id ,calledweight=1.,procname=interpht0 ) 
    129       CALL Agrif_Bc_variable(mbkt_id,calledweight=1.,procname=interpmbkt) 
     251  !    CALL Agrif_Bc_variable(ht0_id ,calledweight=1.,procname=interpht0 ) 
     252  !    CALL Agrif_Bc_variable(mbkt_id,calledweight=1.,procname=interpmbkt) 
     253      CALL Agrif_Init_Variable(ht0_id , procname=interpht0 ) 
     254      CALL Agrif_Init_Variable(mbkt_id, procname=interpmbkt) 
    130255      ! 
    131256      ! Assume step wise change of bathymetry near interface 
    132257      ! TODO: Switch to linear interpolation of bathymetry in the s-coordinate case 
    133258      !       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) ) 
     259      DO_2D( 1, 0, 1, 0 ) 
     260         mbku_parent(ji,jj) = MIN( mbkt_parent(ji+1,jj  ), mbkt_parent(ji,jj) ) 
     261         mbkv_parent(ji,jj) = MIN( mbkt_parent(ji  ,jj+1), mbkt_parent(ji,jj) ) 
    137262      END_2D 
    138263      IF ( ln_sco.AND.Agrif_Parent(ln_sco) ) THEN  
    139          DO_2D_10_10 
     264         DO_2D( 1, 0, 1, 0 ) 
    140265            hu0_parent(ji,jj) = 0.5_wp * ( ht0_parent(ji,jj)+ht0_parent(ji+1,jj) ) 
    141266            hv0_parent(ji,jj) = 0.5_wp * ( ht0_parent(ji,jj)+ht0_parent(ji,jj+1) ) 
    142267         END_2D 
    143268      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)) 
     269         DO_2D( 1, 0, 1, 0 ) 
     270            hu0_parent(ji,jj) = MIN( ht0_parent(ji,jj), ht0_parent(ji+1,jj) ) 
     271            hv0_parent(ji,jj) = MIN( ht0_parent(ji,jj), ht0_parent(ji,jj+1) ) 
    147272         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. ) 
     273      ENDIF 
     274      ! 
     275      CALL lbc_lnk_multi( 'Agrif_Init_Domain', hu0_parent, 'U', 1.0_wp, hv0_parent, 'V', 1.0_wp ) 
     276      DO_2D( 0, 0, 0, 0 ) 
     277         zk(ji,jj) = REAL( mbku_parent(ji,jj), wp ) 
     278      END_2D 
     279      CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'U', 1.0_wp ) 
    154280      mbku_parent(:,:) = MAX( NINT( zk(:,:) ), 1 ) 
    155       zk(:,:) = REAL( mbkv_parent(:,:), wp )   ;   CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'V', 1. ) 
     281      DO_2D( 0, 0, 0, 0 ) 
     282         zk(ji,jj) = REAL( mbkv_parent(ji,jj), wp ) 
     283      END_2D 
     284      CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'V', 1.0_wp ) 
    156285      mbkv_parent(:,:) = MAX( NINT( zk(:,:) ), 1 )    
    157 #endif 
    158  
     286 
     287      IF ( ln_init_chfrpar ) THEN  
     288         CALL Agrif_Init_Variable(sshini_id, procname=agrif_initssh) 
     289         CALL lbc_lnk( 'Agrif_Init_Domain', ssh(:,:,Kbb), 'T', 1. ) 
     290         DO jk = 1, jpk 
     291               e3t(:,:,jk,Kbb) =  e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kbb)  ) & 
     292                        &             / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk)   & 
     293                        &              + e3t_0(:,:,jk) * ( 1._wp - tmask(:,:,jk) ) 
     294         END DO 
     295      ENDIF 
     296 
     297      ! check if masks and bathymetries match 
     298      IF(ln_chk_bathy) THEN 
     299         Agrif_UseSpecialValue = .FALSE. 
     300         ! 
     301         IF(lwp) WRITE(numout,*) ' ' 
     302         IF(lwp) WRITE(numout,*) 'AGRIF: Check Bathymetry and masks near bdys. Level: ', Agrif_Level() 
     303         ! 
     304         kindic_agr = 0 
     305         IF( .NOT. l_vremap ) THEN 
     306            ! 
     307            ! check if tmask and vertical scale factors agree with parent in sponge area: 
     308            CALL Agrif_Bc_variable(e3t_id,calledweight=1.,procname=interpe3t) 
     309            ! 
     310         ELSE 
     311            ! 
     312            ! In case of vertical interpolation, check only that total depths agree between child and parent: 
     313            DO ji = 1, jpi 
     314               DO jj = 1, jpj 
     315                  IF ((mbkt_parent(ji,jj)/=0).AND.(ABS(ht0_parent(ji,jj)-ht_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1 
     316                  IF ((mbku_parent(ji,jj)/=0).AND.(ABS(hu0_parent(ji,jj)-hu_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1 
     317                  IF ((mbkv_parent(ji,jj)/=0).AND.(ABS(hv0_parent(ji,jj)-hv_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1 
     318               END DO 
     319            END DO 
     320 
     321            CALL mpp_sum( 'agrif_user', kindic_agr ) 
     322            IF( kindic_agr /= 0 ) THEN 
     323               CALL ctl_stop('==> Child Bathymetry is NOT correct near boundaries.') 
     324            ELSE 
     325               IF(lwp) WRITE(numout,*) '==> Child Bathymetry is ok near boundaries.' 
     326               IF(lwp) WRITE(numout,*) ' ' 
     327            ENDIF   
     328         ENDIF 
     329      ENDIF 
     330 
     331      IF( l_vremap ) THEN 
     332      ! Additional constrain that should be removed someday: 
     333         IF ( Agrif_Parent(jpk).GT.jpk ) THEN 
     334            CALL ctl_stop( ' With l_vremap, child grids must have jpk greater or equal to the parent value' ) 
     335         ENDIF 
     336      ENDIF 
     337      ! 
     338   END SUBROUTINE Agrif_Init_Domain 
     339 
     340 
     341   SUBROUTINE Agrif_InitValues_cont 
     342      !!---------------------------------------------------------------------- 
     343      !!                 *** ROUTINE Agrif_InitValues_cont *** 
     344      !! 
     345      !! ** Purpose ::   Declaration of variables to be interpolated 
     346      !!---------------------------------------------------------------------- 
     347      USE agrif_oce_update 
     348      USE agrif_oce_interp 
     349      USE agrif_oce_sponge 
     350      USE Agrif_Util 
     351      USE oce  
     352      USE dom_oce 
     353      USE zdf_oce 
     354      USE nemogcm 
     355      USE agrif_oce 
     356      ! 
     357      USE lbclnk 
     358      USE lib_mpp 
     359      USE in_out_manager 
     360      ! 
     361      IMPLICIT NONE 
     362      ! 
     363      LOGICAL :: check_namelist 
     364      CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3, cl_check4  
     365      REAL(wp), DIMENSION(jpi,jpj) ::   zk   ! workspace 
     366      INTEGER :: ji, jj 
     367 
     368      ! 1. Declaration of the type of variable which have to be interpolated 
     369      !--------------------------------------------------------------------- 
     370      CALL agrif_declare_var 
     371 
     372      ! 2. First interpolations of potentially non zero fields 
     373      !------------------------------------------------------- 
    159374      Agrif_SpecialValue    = 0._wp 
    160375      Agrif_UseSpecialValue = .TRUE. 
    161       CALL Agrif_Bc_variable(tsn_id,calledweight=1.,procname=interptsn) 
     376      CALL Agrif_Bc_variable(       tsn_id,calledweight=1.,procname=interptsn) 
    162377      CALL Agrif_Sponge 
    163378      tabspongedone_tsn = .FALSE. 
    164379      CALL Agrif_Bc_variable(tsn_sponge_id,calledweight=1.,procname=interptsn_sponge) 
    165       ! reset ts(:,:,:,:,Krhs_a) to zero 
     380      ! reset tsa to zero 
    166381      ts(:,:,:,:,Krhs_a) = 0._wp 
    167382 
    168383      Agrif_UseSpecialValue = ln_spc_dyn 
     384      use_sign_north = .TRUE. 
     385      sign_north = -1. 
    169386      CALL Agrif_Bc_variable(un_interp_id,calledweight=1.,procname=interpun) 
    170387      CALL Agrif_Bc_variable(vn_interp_id,calledweight=1.,procname=interpvn) 
     
    175392      tabspongedone_v = .FALSE. 
    176393      CALL Agrif_Bc_variable(vn_sponge_id,calledweight=1.,procname=interpvn_sponge) 
     394      use_sign_north = .FALSE. 
    177395      uu(:,:,:,Krhs_a) = 0._wp 
    178396      vv(:,:,:,Krhs_a) = 0._wp 
     
    185403      IF ( ln_dynspg_ts ) THEN 
    186404         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) 
     405         use_sign_north = .TRUE. 
     406         sign_north = -1. 
     407         CALL Agrif_Bc_variable(        unb_id,calledweight=1.,procname=interpunb ) 
     408         CALL Agrif_Bc_variable(        vnb_id,calledweight=1.,procname=interpvnb ) 
    189409         CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b) 
    190410         CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b) 
     411         use_sign_north = .FALSE. 
    191412         ubdy(:,:) = 0._wp 
    192413         vbdy(:,:) = 0._wp 
    193414      ENDIF 
    194  
    195       Agrif_UseSpecialValue = .FALSE. 
    196  
    197       ! 3. Some controls 
     415      Agrif_UseSpecialValue = .FALSE.  
     416 
    198417      !----------------- 
    199418      check_namelist = .TRUE. 
    200419 
    201420      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  
    226421         ! Check free surface scheme 
    227422         IF ( ( Agrif_Parent(ln_dynspg_ts ).AND.ln_dynspg_exp ).OR.& 
     
    251446            STOP 
    252447         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       !  
     448      ENDIF 
     449 
    297450   END SUBROUTINE Agrif_InitValues_cont 
    298451 
     
    314467      ! 1. Declaration of the type of variable which have to be interpolated 
    315468      !--------------------------------------------------------------------- 
    316       ind1 =     nbghostcells 
    317       ind2 = 1 + nbghostcells 
    318       ind3 = 2 + nbghostcells 
     469      ind1 =              nbghostcells 
     470      ind2 = nn_hls + 2 + nbghostcells_x 
     471      ind3 = nn_hls + 2 + nbghostcells_y_s 
    319472# 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) 
     473      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts+1/),tsn_id) 
     474      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts+1/),tsn_sponge_id) 
     475      CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_interp_id) 
     476      CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_interp_id) 
     477      CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_update_id) 
     478      CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_update_id) 
     479      CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_sponge_id) 
     480      CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_sponge_id) 
    329481# 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) 
     482      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsn_id) 
     483      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsn_sponge_id) 
     484      CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),un_interp_id) 
     485      CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),vn_interp_id) 
     486      CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),un_update_id) 
     487      CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),vn_update_id) 
     488      CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),un_sponge_id) 
     489      CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),vn_sponge_id) 
    339490# 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  
     491      CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),unb_id) 
     492      CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vnb_id) 
     493      CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ub2b_interp_id) 
     494      CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vb2b_interp_id) 
     495      CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ub2b_update_id) 
     496      CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vb2b_update_id) 
     497 
     498!      CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),glamt_id) 
     499!      CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),gphit_id) 
     500      CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),sshn_id) 
     501 
     502 
     503      IF( ln_zdftke.OR.ln_zdfgls ) THEN  ! logical not known at this point 
     504!         CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/), en_id) 
     505!         CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id) 
    343506# 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) 
     507         CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),avm_id) 
     508# else 
     509         CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),avm_id) 
    346510# 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) 
    364 # 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) 
    366 # endif 
    367       ENDIF 
    368  
     511      ENDIF 
     512      
    369513      ! 2. Type of interpolation 
    370514      !------------------------- 
    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) 
     515      CALL Agrif_Set_bcinterp(       tsn_id,interp =AGRIF_linear) 
     516      CALL Agrif_Set_bcinterp( un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm   ) 
     517      CALL Agrif_Set_bcinterp( vn_interp_id,interp1=AGRIF_ppm   ,interp2=Agrif_linear) 
     518 
     519      CALL Agrif_Set_bcinterp( tsn_sponge_id,interp =AGRIF_linear) 
     520      CALL Agrif_Set_bcinterp(  un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm   ) 
     521      CALL Agrif_Set_bcinterp(  vn_sponge_id,interp1=AGRIF_ppm   ,interp2=Agrif_linear) 
     522 
     523      CALL Agrif_Set_bcinterp(       sshn_id,interp =AGRIF_linear) 
     524      CALL Agrif_Set_bcinterp(        unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm   ) 
     525      CALL Agrif_Set_bcinterp(        vnb_id,interp1=AGRIF_ppm   ,interp2=Agrif_linear) 
     526      CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm   ) 
     527      CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm   ,interp2=Agrif_linear) 
    383528! 
    384529! > Divergence conserving alternative: 
     
    390535!< 
    391536 
    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 ) 
     537      IF( ln_zdftke.OR.ln_zdfgls )  CALL Agrif_Set_bcinterp( avm_id, interp=AGRIF_linear ) 
     538     
     539 
     540!      CALL Agrif_Set_bcinterp(gphit_id,interp=AGRIF_constant) 
     541!      CALL Agrif_Set_bcinterp(glamt_id,interp=AGRIF_constant) 
    403542 
    404543      ! 3. Location of interpolation 
     
    418557      CALL Agrif_Set_bc( vb2b_interp_id, (/0,ind1-1/) ) 
    419558 
    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/) ) 
     559      IF( ln_zdftke.OR.ln_zdfgls ) CALL Agrif_Set_bc( avm_id, (/0,ind1/) ) 
     560!!$      CALL Agrif_Set_bc(glamt_id, (/0,ind1-1/) )   
     561!!$      CALL Agrif_Set_bc(gphit_id, (/0,ind1-1/) )   
    431562 
    432563      ! 4. Update type 
    433564      !---------------  
    434       CALL Agrif_Set_Updatetype(scales_t_id, update = AGRIF_Update_Average) 
    435565 
    436566# if defined UPD_HIGH 
    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 
     567      CALL Agrif_Set_Updatetype(      tsn_id,update = Agrif_Update_Full_Weighting) 
     568      CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average       , update2 = Agrif_Update_Full_Weighting) 
     569      CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average       ) 
     570 
     571      CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average       , update2 = Agrif_Update_Full_Weighting) 
     572      CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average       ) 
     573      CALL Agrif_Set_Updatetype(       sshn_id,update = Agrif_Update_Full_Weighting) 
     574      CALL Agrif_Set_Updatetype(        e3t_id,update = Agrif_Update_Full_Weighting) 
     575 
     576  !    IF( ln_zdftke.OR.ln_zdfgls ) THEN 
    447577!         CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Full_Weighting) 
    448578!         CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Full_Weighting) 
    449579!         CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Full_Weighting) 
    450       ENDIF 
     580   !   ENDIF 
    451581 
    452582#else 
    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 
     583      CALL Agrif_Set_Updatetype(     tsn_id, update = AGRIF_Update_Average) 
     584      CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Copy   , update2 = Agrif_Update_Average) 
     585      CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy   ) 
     586 
     587      CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy   , update2 = Agrif_Update_Average) 
     588      CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy   ) 
     589      CALL Agrif_Set_Updatetype(       sshn_id,update = AGRIF_Update_Average) 
     590      CALL Agrif_Set_Updatetype(        e3t_id,update = AGRIF_Update_Average) 
     591 
     592 !     IF( ln_zdftke.OR.ln_zdfgls ) THEN 
    463593!         CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Average) 
    464594!         CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Average) 
    465595!         CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Average) 
    466       ENDIF 
     596 !     ENDIF 
    467597 
    468598#endif 
     
    471601 
    472602#if defined key_si3 
    473 SUBROUTINE Agrif_InitValues_cont_ice 
     603   SUBROUTINE Agrif_InitValues_cont_ice 
    474604      !!---------------------------------------------------------------------- 
    475605      !!                 *** ROUTINE Agrif_InitValues_cont_ice *** 
     
    484614      ! 
    485615      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  
     616      ! 
     617      !!---------------------------------------------------------------------- 
    492618      ! Controls 
    493619 
     
    495621      !          the run must satisfy CFL=Uice/(dx/dt) < 0.6/nn_fsbc(child) 
    496622      !          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 
     623      !       If a solution is found, the following stop could be removed because the rest of the code take nn_fsbc(child) into account      
    498624      IF( nn_fsbc > 1 )  CALL ctl_stop('nn_fsbc(child) must be set to 1 otherwise agrif and sea-ice may not work properly') 
    499625 
     
    512638   END SUBROUTINE Agrif_InitValues_cont_ice 
    513639 
     640    
    514641   SUBROUTINE agrif_declare_var_ice 
    515642      !!---------------------------------------------------------------------- 
     
    518645      USE Agrif_Util 
    519646      USE ice 
    520       USE par_oce, ONLY : nbghostcells 
     647      USE par_oce, ONLY : nbghostcells, nbghostcells_x, nbghostcells_y_s 
    521648      ! 
    522649      IMPLICIT NONE 
    523650      ! 
    524651      INTEGER :: ind1, ind2, ind3 
     652      INTEGER :: ipl 
    525653      !!---------------------------------------------------------------------- 
    526654      ! 
     
    532660      !                            2,2 = two ghost lines 
    533661      !------------------------------------------------------------------------------------- 
    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  ) 
     662      ind1 =              nbghostcells 
     663      ind2 = nn_hls + 2 + nbghostcells_x 
     664      ind3 = nn_hls + 2 + nbghostcells_y_s 
     665      ipl = jpl*(9+nlay_s+nlay_i) 
     666      CALL agrif_declare_variable((/2,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,ipl/),tra_ice_id) 
     667      CALL agrif_declare_variable((/1,2/)  ,(/ind2-1,ind3/),(/'x','y'    /),(/1,1  /),(/jpi,jpj    /),  u_ice_id) 
     668      CALL agrif_declare_variable((/2,1/)  ,(/ind2,ind3-1/),(/'x','y'    /),(/1,1  /),(/jpi,jpj    /),  v_ice_id) 
     669 
     670      CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,ipl/),tra_iceini_id) 
     671      CALL agrif_declare_variable((/1,2/)  ,(/ind2-1,ind3/),(/'x','y'    /),(/1,1  /),(/jpi,jpj    /),  u_iceini_id) 
     672      CALL agrif_declare_variable((/2,1/)  ,(/ind2,ind3-1/),(/'x','y'    /),(/1,1  /),(/jpi,jpj    /),  v_iceini_id) 
    540673 
    541674      ! 2. Set interpolations (normal & tangent to the grid cell for velocities) 
     
    545678      CALL Agrif_Set_bcinterp(v_ice_id  , interp1 = AGRIF_ppm   ,interp2 = Agrif_linear) 
    546679 
     680      CALL Agrif_Set_bcinterp(tra_iceini_id, interp  = AGRIF_linear) 
     681      CALL Agrif_Set_interp  (tra_iceini_id, interp  = AGRIF_linear) 
     682      CALL Agrif_Set_bcinterp(u_iceini_id  , interp  = AGRIF_linear  ) 
     683      CALL Agrif_Set_interp  (u_iceini_id  , interp  = AGRIF_linear   ) 
     684      CALL Agrif_Set_bcinterp(v_iceini_id  , interp  = AGRIF_linear) 
     685      CALL Agrif_Set_interp  (v_iceini_id  , interp  = AGRIF_linear) 
     686 
    547687      ! 3. Set location of interpolations 
    548688      !---------------------------------- 
     
    550690      CALL Agrif_Set_bc(u_ice_id  ,(/0,ind1/)) 
    551691      CALL Agrif_Set_bc(v_ice_id  ,(/0,ind1/)) 
     692 
     693      CALL Agrif_Set_bc(tra_iceini_id,(/0,ind1/)) 
     694      CALL Agrif_Set_bc(u_iceini_id  ,(/0,ind1/)) 
     695      CALL Agrif_Set_bc(v_iceini_id  ,(/0,ind1/)) 
    552696 
    553697      ! 4. Set update type in case 2 ways (child=>parent) (normal & tangent to the grid cell for velocities) 
     
    557701      CALL Agrif_Set_Updatetype(u_ice_id  , update1 = Agrif_Update_Average       , update2 = Agrif_Update_Full_Weighting) 
    558702      CALL Agrif_Set_Updatetype(v_ice_id  , update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average       ) 
    559 #else 
     703# else 
    560704      CALL Agrif_Set_Updatetype(tra_ice_id, update  = AGRIF_Update_Average) 
    561705      CALL Agrif_Set_Updatetype(u_ice_id  , update1 = Agrif_Update_Copy   , update2 = Agrif_Update_Average) 
    562706      CALL Agrif_Set_Updatetype(v_ice_id  , update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy   ) 
    563 #endif 
     707# endif 
    564708 
    565709   END SUBROUTINE agrif_declare_var_ice 
     
    584728      USE agrif_top_interp 
    585729      USE agrif_top_sponge 
    586       !! 
     730      ! 
    587731      IMPLICIT NONE 
    588732      ! 
     
    604748      tabspongedone_trn = .FALSE. 
    605749      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 
     750      ! reset tsa to zero 
     751      tra(:,:,:,:) = 0._wp 
    608752 
    609753      ! 3. Some controls 
     
    613757      IF( check_namelist ) THEN 
    614758         ! 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() 
    619          CALL ctl_stop( 'incompatible time step between grids',   & 
     759         IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN 
     760            WRITE(cl_check1,*)  Agrif_Parent(rdt) 
     761            WRITE(cl_check2,*)  rdt 
     762            WRITE(cl_check3,*)  rdt*Agrif_Rhot() 
     763            CALL ctl_stop( 'incompatible time step between grids',   & 
    620764               &               'parent grid value : '//cl_check1    ,   &  
    621765               &               'child  grid value : '//cl_check2    ,   &  
    622766               &               'value on child grid should be changed to  & 
    623767               &               :'//cl_check3  ) 
    624       ENDIF 
    625  
    626       ! Check run length 
    627       IF( Agrif_IRhot() * (Agrif_Parent(nitend)- & 
     768         ENDIF 
     769 
     770         ! Check run length 
     771         IF( Agrif_IRhot() * (Agrif_Parent(nitend)- & 
    628772            Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN 
    629          WRITE(cl_check1,*)  (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 
    630          WRITE(cl_check2,*)   Agrif_Parent(nitend)   *Agrif_IRhot() 
    631          CALL ctl_warn( 'incompatible run length between grids'               ,   & 
     773            WRITE(cl_check1,*)  (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 
     774            WRITE(cl_check2,*)   Agrif_Parent(nitend)   *Agrif_IRhot() 
     775            CALL ctl_warn( 'incompatible run length between grids'               ,   & 
    632776               &              ' nit000 on fine grid will be change to : '//cl_check1,   & 
    633777               &              ' nitend on fine grid will be change to : '//cl_check2    ) 
    634          nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 
    635          nitend =  Agrif_Parent(nitend)   *Agrif_IRhot() 
    636       ENDIF 
    637  
    638    ENDIF 
    639    ! 
     778            nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 
     779            nitend =  Agrif_Parent(nitend)   *Agrif_IRhot() 
     780         ENDIF 
     781      ENDIF 
     782      ! 
    640783   END SUBROUTINE Agrif_InitValues_cont_top 
    641784 
     
    654797      INTEGER :: ind1, ind2, ind3 
    655798      !!---------------------------------------------------------------------- 
    656  
     799!RB_CMEMS : declare here init for top       
    657800      ! 1. Declaration of the type of variable which have to be interpolated 
    658801      !--------------------------------------------------------------------- 
    659       ind1 =     nbghostcells 
    660       ind2 = 1 + nbghostcells 
    661       ind3 = 2 + nbghostcells 
     802      ind1 =              nbghostcells 
     803      ind2 = nn_hls + 2 + nbghostcells_x 
     804      ind3 = nn_hls + 2 + nbghostcells_y_s 
    662805# 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) 
     806      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra+1/),trn_id) 
     807      CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra+1/),trn_sponge_id) 
    665808# 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) 
     809! LAURENT: STRANGE why (3,3) here ? 
     810      CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_id) 
     811      CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_sponge_id) 
    668812# endif 
    669813 
     
    688832   END SUBROUTINE agrif_declare_var_top 
    689833# endif 
     834    
    690835 
    691836   SUBROUTINE Agrif_detect( kg, ksizex ) 
     
    701846   END SUBROUTINE Agrif_detect 
    702847 
     848    
    703849   SUBROUTINE agrif_nemo_init 
    704850      !!---------------------------------------------------------------------- 
     
    707853      USE agrif_oce  
    708854      USE agrif_ice 
     855      USE dom_oce 
    709856      USE in_out_manager 
    710857      USE lib_mpp 
    711       !! 
     858      ! 
    712859      IMPLICIT NONE 
    713860      ! 
    714861      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, & 
     862      NAMELIST/namagrif/ ln_agrif_2way, ln_init_chfrpar, rn_sponge_tra, rn_sponge_dyn, rn_trelax_tra, rn_trelax_dyn, & 
    716863                       & ln_spc_dyn, ln_chk_bathy 
    717864      !!-------------------------------------------------------------------------------------- 
     
    729876         WRITE(numout,*) '   Namelist namagrif : set AGRIF parameters' 
    730877         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.' 
     878         WRITE(numout,*) '      child initial state from parent ln_init_chfrpar = ', ln_init_chfrpar 
     879         WRITE(numout,*) '      ad. sponge coeft for tracers      rn_sponge_tra = ', rn_sponge_tra 
     880         WRITE(numout,*) '      ad. sponge coeft for dynamics     rn_sponge_tra = ', rn_sponge_dyn 
     881         WRITE(numout,*) '      ad. time relaxation for tracers   rn_trelax_tra = ', rn_trelax_tra 
     882         WRITE(numout,*) '      ad. time relaxation for dynamics  rn_trelax_dyn = ', rn_trelax_dyn 
    735883         WRITE(numout,*) '      use special values for dynamics   ln_spc_dyn    = ', ln_spc_dyn 
    736884         WRITE(numout,*) '      check bathymetry                  ln_chk_bathy  = ', ln_chk_bathy 
    737885      ENDIF 
    738       ! 
    739       ! 
    740       IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed') 
     886 
     887      lk_west  = .NOT. ( Agrif_Ix() == 1 ) 
     888      lk_east  = .NOT. ( Agrif_Ix() + nbcellsx/AGRIF_Irhox() == Agrif_Parent(jpiglo) -1 ) 
     889      lk_south = .NOT. ( Agrif_Iy() == 1 ) 
     890      lk_north = .NOT. ( Agrif_Iy() + nbcellsy/AGRIF_Irhoy() == Agrif_Parent(jpjglo) -1 ) 
     891 
     892      ! 
     893      ! Set the number of ghost cells according to periodicity 
     894      nbghostcells_x   = nbghostcells 
     895      nbghostcells_y_s = nbghostcells 
     896      nbghostcells_y_n = nbghostcells 
     897      ! 
     898      IF(   jperio == 1  )   nbghostcells_x   = 0 
     899      IF( .NOT. lk_south )   nbghostcells_y_s = 0 
     900      ! Some checks 
     901      IF( jpiglo /= nbcellsx + 2 + 2*nn_hls + nbghostcells_x   + nbghostcells_x   )   CALL ctl_stop( 'STOP',    & 
     902         &   'agrif_nemo_init: Agrif children requires jpiglo == nbcellsx + 2 + 2*nn_hls + 2*nbghostcells_x' ) 
     903      IF( jpjglo /= nbcellsy + 2 + 2*nn_hls + nbghostcells_y_s + nbghostcells_y_n )   CALL ctl_stop( 'STOP',    & 
     904         &   'agrif_nemo_init: Agrif children requires jpjglo == nbcellsy + 2 + 2*nn_hls + nbghostcells_y_s + nbghostcells_y_n' ) 
     905      IF( ln_use_jattr )   CALL ctl_stop( 'STOP', 'agrif_nemo_init:Agrif children requires ln_use_jattr = .false. ' ) 
    741906      ! 
    742907   END SUBROUTINE agrif_nemo_init 
    743908 
     909    
    744910# if defined key_mpp_mpi 
    745  
    746911   SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob ) 
    747912      !!---------------------------------------------------------------------- 
     
    756921      ! 
    757922      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 
     923      CASE(1)        ;   indglob = mig(indloc) 
     924      CASE(2)        ;   indglob = mjg(indloc) 
     925      CASE DEFAULT   ;   indglob = indloc 
    762926      END SELECT 
    763927      ! 
    764928   END SUBROUTINE Agrif_InvLoc 
    765929 
     930    
    766931   SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax ) 
    767932      !!---------------------------------------------------------------------- 
     
    776941      !!---------------------------------------------------------------------- 
    777942      ! 
    778       imin = nimppt(Agrif_Procrank+1)  ! ????? 
    779       jmin = njmppt(Agrif_Procrank+1)  ! ????? 
    780       imax = imin + jpi - 1 
    781       jmax = jmin + jpj - 1 
     943      imin = mig( 1 ) 
     944      jmin = mjg( 1 ) 
     945      imax = mig(jpi) 
     946      jmax = mjg(jpj) 
    782947      !  
    783948   END SUBROUTINE Agrif_get_proc_info 
    784949 
     950    
    785951   SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost) 
    786952      !!---------------------------------------------------------------------- 
     
    803969# endif 
    804970 
     971   SUBROUTINE nemo_mapping(ndim,ptx,pty,bounds,bounds_chunks,correction_required,nb_chunks) 
     972      !!---------------------------------------------------------------------- 
     973      !!                   *** ROUTINE Nemo_mapping *** 
     974      !!---------------------------------------------------------------------- 
     975      USE dom_oce 
     976      !! 
     977      IMPLICIT NONE 
     978      ! 
     979      INTEGER :: ndim 
     980      INTEGER :: ptx, pty 
     981      INTEGER, DIMENSION(ndim,2,2) :: bounds 
     982      INTEGER, DIMENSION(:,:,:,:), ALLOCATABLE :: bounds_chunks 
     983      LOGICAL, DIMENSION(:), ALLOCATABLE :: correction_required 
     984      INTEGER :: nb_chunks 
     985      ! 
     986      INTEGER :: i 
     987 
     988      IF (agrif_debug_interp) THEN 
     989         DO i=1,ndim 
     990            WRITE(*,*) 'direction = ',i,bounds(i,1,2),bounds(i,2,2) 
     991         ENDDO 
     992      ENDIF 
     993 
     994      IF( bounds(2,2,2) > jpjglo) THEN 
     995         IF( bounds(2,1,2) <=jpjglo) THEN 
     996            nb_chunks = 2 
     997            ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2)) 
     998            ALLOCATE(correction_required(nb_chunks)) 
     999            DO i = 1,nb_chunks 
     1000               bounds_chunks(i,:,:,:) = bounds 
     1001            END DO 
     1002         
     1003      ! FIRST CHUNCK (for j<=jpjglo)    
     1004 
     1005      ! Original indices 
     1006            bounds_chunks(1,1,1,1) = bounds(1,1,2) 
     1007            bounds_chunks(1,1,2,1) = bounds(1,2,2) 
     1008            bounds_chunks(1,2,1,1) = bounds(2,1,2) 
     1009            bounds_chunks(1,2,2,1) = jpjglo 
     1010 
     1011            bounds_chunks(1,1,1,2) = bounds(1,1,2) 
     1012            bounds_chunks(1,1,2,2) = bounds(1,2,2) 
     1013            bounds_chunks(1,2,1,2) = bounds(2,1,2) 
     1014            bounds_chunks(1,2,2,2) = jpjglo 
     1015 
     1016      ! Correction required or not 
     1017            correction_required(1)=.FALSE. 
     1018        
     1019      ! SECOND CHUNCK (for j>jpjglo) 
     1020 
     1021      ! Original indices 
     1022            bounds_chunks(2,1,1,1) = bounds(1,1,2) 
     1023            bounds_chunks(2,1,2,1) = bounds(1,2,2) 
     1024            bounds_chunks(2,2,1,1) = jpjglo-2 
     1025            bounds_chunks(2,2,2,1) = bounds(2,2,2) 
     1026 
     1027      ! Where to find them 
     1028      ! We use the relation TAB(ji,jj)=TAB(jpiglo-ji+2,jpjglo-2-(jj-jpjglo)) 
     1029 
     1030            IF( ptx == 2) THEN ! T, V points 
     1031               bounds_chunks(2,1,1,2) = jpiglo-bounds(1,2,2)+2 
     1032               bounds_chunks(2,1,2,2) = jpiglo-bounds(1,1,2)+2 
     1033            ELSE ! U, F points 
     1034               bounds_chunks(2,1,1,2) = jpiglo-bounds(1,2,2)+1 
     1035               bounds_chunks(2,1,2,2) = jpiglo-bounds(1,1,2)+1        
     1036            ENDIF 
     1037 
     1038            IF( pty == 2) THEN ! T, U points 
     1039               bounds_chunks(2,2,1,2) = jpjglo-2-(bounds(2,2,2) -jpjglo) 
     1040               bounds_chunks(2,2,2,2) = jpjglo-2-(jpjglo-2      -jpjglo) 
     1041            ELSE ! V, F points 
     1042               bounds_chunks(2,2,1,2) = jpjglo-3-(bounds(2,2,2) -jpjglo) 
     1043               bounds_chunks(2,2,2,2) = jpjglo-3-(jpjglo-2      -jpjglo) 
     1044            ENDIF 
     1045      ! Correction required or not 
     1046            correction_required(2)=.TRUE. 
     1047 
     1048         ELSE 
     1049            nb_chunks = 1 
     1050            ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2)) 
     1051            ALLOCATE(correction_required(nb_chunks)) 
     1052            DO i=1,nb_chunks 
     1053               bounds_chunks(i,:,:,:) = bounds 
     1054            END DO 
     1055 
     1056            bounds_chunks(1,1,1,1) = bounds(1,1,2) 
     1057            bounds_chunks(1,1,2,1) = bounds(1,2,2) 
     1058            bounds_chunks(1,2,1,1) = bounds(2,1,2) 
     1059            bounds_chunks(1,2,2,1) = bounds(2,2,2) 
     1060 
     1061            bounds_chunks(1,1,1,2) = jpiglo-bounds(1,2,2)+2 
     1062            bounds_chunks(1,1,2,2) = jpiglo-bounds(1,1,2)+2 
     1063 
     1064            bounds_chunks(1,2,1,2) = jpjglo-2-(bounds(2,2,2)-jpjglo) 
     1065            bounds_chunks(1,2,2,2) = jpjglo-2-(bounds(2,1,2)-jpjglo) 
     1066 
     1067            IF( ptx == 2) THEN ! T, V points 
     1068               bounds_chunks(1,1,1,2) = jpiglo-bounds(1,2,2)+2 
     1069               bounds_chunks(1,1,2,2) = jpiglo-bounds(1,1,2)+2 
     1070            ELSE ! U, F points 
     1071               bounds_chunks(1,1,1,2) = jpiglo-bounds(1,2,2)+1 
     1072               bounds_chunks(1,1,2,2) = jpiglo-bounds(1,1,2)+1        
     1073            ENDIF 
     1074 
     1075            IF (pty == 2) THEN ! T, U points 
     1076               bounds_chunks(1,2,1,2) = jpjglo-2-(bounds(2,2,2) -jpjglo) 
     1077               bounds_chunks(1,2,2,2) = jpjglo-2-(bounds(2,1,2) -jpjglo) 
     1078            ELSE ! V, F points 
     1079               bounds_chunks(1,2,1,2) = jpjglo-3-(bounds(2,2,2) -jpjglo) 
     1080               bounds_chunks(1,2,2,2) = jpjglo-3-(bounds(2,1,2) -jpjglo) 
     1081            ENDIF 
     1082 
     1083            correction_required(1)=.TRUE.           
     1084         ENDIF 
     1085 
     1086      ELSE IF (bounds(1,1,2) < 1) THEN 
     1087         IF (bounds(1,2,2) > 0) THEN 
     1088            nb_chunks = 2 
     1089            ALLOCATE(correction_required(nb_chunks)) 
     1090            correction_required=.FALSE. 
     1091            ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2)) 
     1092            DO i=1,nb_chunks 
     1093               bounds_chunks(i,:,:,:) = bounds 
     1094            END DO 
     1095               
     1096            bounds_chunks(1,1,1,2) = bounds(1,1,2)+jpiglo-2 
     1097            bounds_chunks(1,1,2,2) = 1+jpiglo-2 
     1098           
     1099            bounds_chunks(1,1,1,1) = bounds(1,1,2) 
     1100            bounds_chunks(1,1,2,1) = 1 
     1101        
     1102            bounds_chunks(2,1,1,2) = 2 
     1103            bounds_chunks(2,1,2,2) = bounds(1,2,2) 
     1104           
     1105            bounds_chunks(2,1,1,1) = 2 
     1106            bounds_chunks(2,1,2,1) = bounds(1,2,2) 
     1107 
     1108         ELSE 
     1109            nb_chunks = 1 
     1110            ALLOCATE(correction_required(nb_chunks)) 
     1111            correction_required=.FALSE. 
     1112            ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2)) 
     1113            DO i=1,nb_chunks 
     1114               bounds_chunks(i,:,:,:) = bounds 
     1115            END DO     
     1116            bounds_chunks(1,1,1,2) = bounds(1,1,2)+jpiglo-2 
     1117            bounds_chunks(1,1,2,2) = bounds(1,2,2)+jpiglo-2 
     1118           
     1119            bounds_chunks(1,1,1,1) = bounds(1,1,2) 
     1120           bounds_chunks(1,1,2,1) = bounds(1,2,2) 
     1121         ENDIF 
     1122      ELSE 
     1123         nb_chunks=1   
     1124         ALLOCATE(correction_required(nb_chunks)) 
     1125         correction_required=.FALSE. 
     1126         ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2)) 
     1127         DO i=1,nb_chunks 
     1128            bounds_chunks(i,:,:,:) = bounds 
     1129         END DO 
     1130         bounds_chunks(1,1,1,2) = bounds(1,1,2) 
     1131         bounds_chunks(1,1,2,2) = bounds(1,2,2) 
     1132         bounds_chunks(1,2,1,2) = bounds(2,1,2) 
     1133         bounds_chunks(1,2,2,2) = bounds(2,2,2) 
     1134           
     1135         bounds_chunks(1,1,1,1) = bounds(1,1,2) 
     1136         bounds_chunks(1,1,2,1) = bounds(1,2,2) 
     1137         bounds_chunks(1,2,1,1) = bounds(2,1,2) 
     1138         bounds_chunks(1,2,2,1) = bounds(2,2,2)               
     1139      ENDIF 
     1140         
     1141   END SUBROUTINE nemo_mapping 
     1142 
     1143   FUNCTION agrif_external_switch_index(ptx,pty,i1,isens) 
     1144 
     1145      USE dom_oce 
     1146      ! 
     1147      IMPLICIT NONE 
     1148 
     1149      INTEGER :: ptx, pty, i1, isens 
     1150      INTEGER :: agrif_external_switch_index 
     1151      !!---------------------------------------------------------------------- 
     1152 
     1153      IF( isens == 1 ) THEN 
     1154         IF( ptx == 2 ) THEN ! T, V points 
     1155            agrif_external_switch_index = jpiglo-i1+2 
     1156         ELSE ! U, F points 
     1157            agrif_external_switch_index = jpiglo-i1+1       
     1158         ENDIF 
     1159      ELSE IF( isens ==2 ) THEN 
     1160         IF ( pty == 2 ) THEN ! T, U points 
     1161            agrif_external_switch_index = jpjglo-2-(i1 -jpjglo) 
     1162         ELSE ! V, F points 
     1163            agrif_external_switch_index = jpjglo-3-(i1 -jpjglo) 
     1164         ENDIF 
     1165      ENDIF 
     1166 
     1167   END FUNCTION agrif_external_switch_index 
     1168 
     1169   SUBROUTINE Correct_field(tab2d,i1,i2,j1,j2) 
     1170      !!---------------------------------------------------------------------- 
     1171      !!                   *** ROUTINE Correct_field *** 
     1172      !!---------------------------------------------------------------------- 
     1173      USE dom_oce 
     1174      USE agrif_oce 
     1175      ! 
     1176      IMPLICIT NONE 
     1177      ! 
     1178      INTEGER :: i1,i2,j1,j2 
     1179      REAL(wp), DIMENSION(i1:i2,j1:j2) :: tab2d 
     1180      ! 
     1181      INTEGER :: i,j 
     1182      REAL(wp), DIMENSION(i1:i2,j1:j2) :: tab2dtemp 
     1183      !!---------------------------------------------------------------------- 
     1184 
     1185      tab2dtemp = tab2d 
     1186 
     1187      IF( .NOT. use_sign_north ) THEN 
     1188         DO j=j1,j2 
     1189            DO i=i1,i2 
     1190               tab2d(i,j)=tab2dtemp(i2-(i-i1),j2-(j-j1)) 
     1191            END DO 
     1192         END DO 
     1193      ELSE 
     1194         DO j=j1,j2 
     1195            DO i=i1,i2 
     1196               tab2d(i,j)=sign_north * tab2dtemp(i2-(i-i1),j2-(j-j1)) 
     1197            END DO 
     1198         END DO 
     1199      ENDIF 
     1200 
     1201   END SUBROUTINE Correct_field 
     1202 
    8051203#else 
    8061204   SUBROUTINE Subcalledbyagrif 
Note: See TracChangeset for help on using the changeset viewer.