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 13026 for NEMO/branches/2020/dev_r12973_AGRIF_CMEMS/src/NST/agrif_user.F90 – NEMO

Ignore:
Timestamp:
2020-06-03T16:30:02+02:00 (4 years ago)
Author:
rblod
Message:

AGRIF with northfold and perio, see ticket #2129

File:
1 edited

Legend:

Unmodified
Added
Removed
  • NEMO/branches/2020/dev_r12973_AGRIF_CMEMS/src/NST/agrif_user.F90

    r12489 r13026  
    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      l_ini_child = .TRUE. 
     55      Agrif_SpecialValue    = 0._wp 
     56      Agrif_UseSpecialValue = .TRUE. 
     57      uu(:,:,:,:) = 0.  ;  vv(:,:,:,:) = 0.   ;  ts(:,:,:,:,:) = 0. 
     58        
     59      Krhs_a = Kbb ; Kmm_a = Kbb 
     60 
     61      ! Brutal fix to pas 1x1 refinment.  
     62  !    IF(Agrif_Irhox() == 1) THEN 
     63         CALL Agrif_Init_Variable(tsini_id, procname=agrif_initts) 
     64  !    ELSE 
     65   !      CALL Agrif_Init_Variable(tsini_id, procname=interptsn) 
     66 
     67  !    ENDIF 
     68      Agrif_UseSpecialValue = ln_spc_dyn 
     69      use_sign_north = .TRUE. 
     70      sign_north = -1. 
     71  !    CALL Agrif_Init_Variable(uini_id , procname=interpun ) 
     72  !    CALL Agrif_Init_Variable(vini_id , procname=interpvn ) 
     73       use_sign_north = .FALSE. 
     74 
     75      Agrif_UseSpecialValue = .FALSE.            ! 
     76      l_ini_child = .FALSE. 
     77      Krhs_a = Kaa ; Kmm_a = Kmm 
     78 
     79      DO jn = 1, jpts 
     80         ts(:,:,:,jn,Kbb) = ts(:,:,:,jn,Kbb)*tmask(:,:,:) 
     81      END DO 
     82      uu(:,:,:,Kbb) =  uu(:,:,:,Kbb) * umask(:,:,:)      
     83      vv(:,:,:,Kbb) =  vv(:,:,:,Kbb) * vmask(:,:,:)  
     84 
     85 
     86      CALL lbc_lnk_multi( 'agrif_istate', uu(:,:,:,Kbb), 'U', -1. , vv(:,:,:,Kbb), 'V', -1. ) 
     87      CALL lbc_lnk( 'agrif_istate', ts(:,:,:,:,Kbb), 'T', 1. ) 
     88 
     89   END SUBROUTINE agrif_istate    
     90 
     91   SUBROUTINE agrif_declare_var_ini 
     92      !!---------------------------------------------------------------------- 
     93      !!                 *** ROUTINE agrif_declare_var *** 
     94      !!---------------------------------------------------------------------- 
     95      USE agrif_util 
     96      USE agrif_oce 
     97      USE par_oce 
     98      USE zdf_oce  
     99      USE oce 
     100      USE dom_oce 
    56101      ! 
    57102      IMPLICIT NONE 
    58103      ! 
    59104      INTEGER :: ind1, ind2, ind3 
    60       !!---------------------------------------------------------------------- 
     105      External :: nemo_mapping 
     106      !!---------------------------------------------------------------------- 
     107 
     108! In case of East-West periodicity, prevent AGRIF interpolation at east and west boundaries 
     109! The procnames will not be called at these boundaries 
     110      IF (jperio == 1) THEN 
     111         CALL Agrif_Set_NearCommonBorderX(.TRUE.) 
     112         CALL Agrif_Set_DistantCommonBorderX(.TRUE.) 
     113      ENDIF 
     114 
     115      IF ( .NOT. ln_bry_south) THEN 
     116         CALL Agrif_Set_NearCommonBorderY(.TRUE.) 
     117      ENDIF 
    61118 
    62119      ! 1. Declaration of the type of variable which have to be interpolated 
    63120      !--------------------------------------------------------------------- 
    64121      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  
     122      ind2 = 2 + nbghostcells_x 
     123      ind3 = 2 + nbghostcells_y_s 
     124 
     125      CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id) 
     126      CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),mbkt_id) 
     127      CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ht0_id) 
     128 
     129      CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e1u_id) 
     130      CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e2v_id) 
     131 
     132    
     133      ! Initial or restart velues 
     134      CALL Agrif_Set_MaskMaxSearch(25) 
     135      ! 
     136      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/),tsini_id) 
     137      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 )  
     138      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 ) 
     139      CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshini_id) 
     140      !  
     141      CALL Agrif_Set_MaskMaxSearch(5) 
     142      
    70143      ! 2. Type of interpolation 
    71144      !------------------------- 
     145      CALL Agrif_Set_bcinterp(e3t_id,interp=AGRIF_constant) 
     146 
     147      CALL Agrif_Set_bcinterp(mbkt_id,interp=AGRIF_constant) 
     148      CALL Agrif_Set_interp  (mbkt_id,interp=AGRIF_constant) 
     149      CALL Agrif_Set_bcinterp(ht0_id ,interp=AGRIF_constant) 
     150      CALL Agrif_Set_interp  (ht0_id ,interp=AGRIF_constant) 
     151 
    72152      CALL Agrif_Set_bcinterp( e1u_id, interp1=Agrif_linear, interp2=AGRIF_ppm    ) 
    73153      CALL Agrif_Set_bcinterp( e2v_id, interp1=AGRIF_ppm   , interp2=Agrif_linear ) 
    74154 
    75       ! 3. Location of interpolation 
     155      ! Initial fields 
     156      CALL Agrif_Set_bcinterp(tsini_id ,interp=AGRIF_linear) 
     157      CALL Agrif_Set_interp  (tsini_id ,interp=AGRIF_linear) 
     158      CALL Agrif_Set_bcinterp(uini_id  ,interp=AGRIF_linear) 
     159      CALL Agrif_Set_interp  (uini_id  ,interp=AGRIF_linear) 
     160      CALL Agrif_Set_bcinterp(vini_id  ,interp=AGRIF_linear) 
     161      CALL Agrif_Set_interp  (vini_id  ,interp=AGRIF_linear) 
     162      CALL Agrif_Set_bcinterp(sshini_id,interp=AGRIF_linear) 
     163      CALL Agrif_Set_interp  (sshini_id,interp=AGRIF_linear) 
     164 
     165       ! 3. Location of interpolation 
    76166      !----------------------------- 
     167!      CALL Agrif_Set_bc(  e3t_id, (/-nn_sponge_len*Agrif_irhox(),ind1-1/) )   
     168! JC: check near the boundary only until matching in sponge has been sorted out: 
     169      CALL Agrif_Set_bc(  e3t_id, (/0,ind1-1/) )   
     170 
     171      ! extend the interpolation zone by 1 more point than necessary: 
     172      ! RB check here 
     173      CALL Agrif_Set_bc(  mbkt_id, (/-nn_sponge_len*Agrif_irhox()-2,ind1/) ) 
     174      CALL Agrif_Set_bc(  ht0_id,  (/-nn_sponge_len*Agrif_irhox()-2,ind1/) ) 
     175       
    77176      CALL Agrif_Set_bc(e1u_id,(/0,ind1-1/)) 
    78       CALL Agrif_Set_bc(e2v_id,(/0,ind1-1/)) 
     177      CALL Agrif_Set_bc(e2v_id,(/0,ind1-1/))   
     178 
     179      CALL Agrif_Set_bc( tsini_id , (/0,ind1-1/) ) ! if west,  rhox=3 and nbghost=3: columns 2 to 4 
     180      CALL Agrif_Set_bc( uini_id  , (/0,ind1-1/) )  
     181      CALL Agrif_Set_bc( vini_id  , (/0,ind1-1/) ) 
     182      CALL Agrif_Set_bc( sshini_id, (/0,ind1-1/) ) 
    79183 
    80184      ! 4. Update type 
     
    87191      CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy) 
    88192#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 
     193       
     194      CALL Agrif_Set_ExternalMapping(nemo_mapping) 
     195      ! 
     196   END SUBROUTINE agrif_declare_var_ini 
     197 
     198 
     199   SUBROUTINE Agrif_Init_Domain( Kbb, Kmm, Kaa )  
     200      !!---------------------------------------------------------------------- 
     201      !!                 *** ROUTINE Agrif_InitValues_cont_dom *** 
     202      !!---------------------------------------------------------------------- 
     203   
     204         !!---------------------------------------------------------------------- 
     205         !!                 *** ROUTINE Agrif_InitValues_cont *** 
     206         !! 
     207         !! ** Purpose ::   Declaration of variables to be interpolated 
     208         !!---------------------------------------------------------------------- 
     209      USE agrif_oce_update 
    97210      USE agrif_oce_interp 
    98211      USE agrif_oce_sponge 
     212      USE Agrif_Util 
     213      USE oce  
    99214      USE dom_oce 
    100       USE oce 
     215      USE zdf_oce 
     216      USE nemogcm 
     217      USE agrif_oce 
     218      ! 
     219      USE lbclnk 
    101220      USE lib_mpp 
    102       USE lbclnk 
     221      USE in_out_manager 
    103222      ! 
    104223      IMPLICIT NONE 
    105224      ! 
    106       INTEGER :: ji, jj 
     225      INTEGER, INTENT(in) ::  Kbb, Kmm, Kaa 
     226      ! 
    107227      LOGICAL :: check_namelist 
    108228      CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3, cl_check4  
    109 #if defined key_vertical 
    110229      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 
     230      INTEGER :: ji, jj, jk, iminspon 
     231      !!---------------------------------------------------------------------- 
     232     
     233     ! CALL Agrif_Declare_Var_ini 
     234 
     235      IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed') 
     236 
     237    !  lk_west  = ( ((nbondi == -1) .OR. (nbondi == 2) ).AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6)) 
     238    !  lk_east  = ( ((nbondi ==  1) .OR. (nbondi == 2) ).AND. .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6)) 
     239    !  lk_south = ( ((nbondj == -1) .OR. (nbondj == 2) ).AND. ln_bry_south) 
     240    !  lk_north = ( ((nbondj ==  1) .OR. (nbondj == 2) )) 
     241     
     242      lk_west  = ( .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6) ) 
     243      lk_east  = ( .NOT. (jperio == 1 .OR. jperio == 4 .OR. jperio == 6) ) 
     244      lk_south = ln_bry_south 
     245      lk_north = .true. 
     246 
     247      ! Check sponge length: 
     248      iminspon = MIN(FLOOR(REAL(jpiglo-4)/REAL(2*Agrif_irhox())), FLOOR(REAL(jpjglo-4)/REAL(2*Agrif_irhox())) ) 
     249      IF (lk_mpp) iminspon = MIN(iminspon,FLOOR(REAL(jpi-2)/REAL(Agrif_irhox())), FLOOR(REAL(jpj-2)/REAL(Agrif_irhox())) ) 
     250      IF (nn_sponge_len > iminspon)  CALL ctl_stop('agrif sponge length is too large')  
     251       
    122252      ! Build consistent parent bathymetry and number of levels 
    123253      ! on the child grid  
     
    126256      mbkt_parent(:,:) = 0 
    127257      ! 
    128       CALL Agrif_Bc_variable(ht0_id ,calledweight=1.,procname=interpht0 ) 
    129       CALL Agrif_Bc_variable(mbkt_id,calledweight=1.,procname=interpmbkt) 
     258  !    CALL Agrif_Bc_variable(ht0_id ,calledweight=1.,procname=interpht0 ) 
     259  !    CALL Agrif_Bc_variable(mbkt_id,calledweight=1.,procname=interpmbkt) 
     260      CALL Agrif_Init_Variable(ht0_id , procname=interpht0 ) 
     261      CALL Agrif_Init_Variable(mbkt_id, procname=interpmbkt) 
    130262      ! 
    131263      ! Assume step wise change of bathymetry near interface 
     
    149281      ENDIF 
    150282      ! 
    151       CALL lbc_lnk( 'Agrif_InitValues_cont', hu0_parent, 'U', 1. ) 
    152       CALL lbc_lnk( 'Agrif_InitValues_cont', hv0_parent, 'V', 1. ) 
     283      CALL lbc_lnk( 'Agrif_Init_Domain', hu0_parent, 'U', 1. ) 
     284      CALL lbc_lnk( 'Agrif_Init_Domain', hv0_parent, 'V', 1. ) 
    153285      zk(:,:) = REAL( mbku_parent(:,:), wp )   ;   CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'U', 1. ) 
    154       mbku_parent(:,:) = MAX( NINT( zk(:,:) ), 1 ) 
     286      mbku_parent(:,:) = MAX( NINT( zk(:,:) ), 1 ) ; 
    155287      zk(:,:) = REAL( mbkv_parent(:,:), wp )   ;   CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'V', 1. ) 
    156288      mbkv_parent(:,:) = MAX( NINT( zk(:,:) ), 1 )    
    157 #endif 
    158  
     289 
     290 
     291      CALL Agrif_Init_Variable(sshini_id, procname=agrif_initssh) 
     292      CALL lbc_lnk( 'Agrif_Init_Domain', ssh(:,:,Kbb), 'T', 1. ) 
     293      DO jk = 1, jpk 
     294            e3t(:,:,jk,Kbb) =  e3t_0(:,:,jk) * ( ht_0(:,:) + ssh(:,:,Kbb)  ) & 
     295      &                            / ( ht_0(:,:) + 1._wp - ssmask(:,:) ) * tmask(:,:,jk)   & 
     296                     &              + e3t_0(:,:,jk) * ( 1._wp - tmask(:,:,jk) ) 
     297      END DO 
     298 
     299      ! check if masks and bathymetries match 
     300      IF(ln_chk_bathy) THEN 
     301         Agrif_UseSpecialValue = .FALSE. 
     302         ! 
     303         IF(lwp) WRITE(numout,*) ' ' 
     304         IF(lwp) WRITE(numout,*) 'AGRIF: Check Bathymetry and masks near bdys. Level: ', Agrif_Level() 
     305         ! 
     306         kindic_agr = 0 
     307         IF( .NOT. l_vremap ) THEN 
     308            ! 
     309            ! check if tmask and vertical scale factors agree with parent in sponge area: 
     310            CALL Agrif_Bc_variable(e3t_id,calledweight=1.,procname=interpe3t) 
     311            ! 
     312         ELSE 
     313            ! 
     314            ! In case of vertical interpolation, check only that total depths agree between child and parent: 
     315            DO ji = 1, jpi 
     316               DO jj = 1, jpj 
     317                  IF ((mbkt_parent(ji,jj)/=0).AND.(ABS(ht0_parent(ji,jj)-ht_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1 
     318                  IF ((mbku_parent(ji,jj)/=0).AND.(ABS(hu0_parent(ji,jj)-hu_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1 
     319                  IF ((mbkv_parent(ji,jj)/=0).AND.(ABS(hv0_parent(ji,jj)-hv_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1 
     320               END DO 
     321            END DO 
     322 
     323            CALL mpp_sum( 'agrif_user', kindic_agr ) 
     324            IF( kindic_agr /= 0 ) THEN 
     325               CALL ctl_stop('==> Child Bathymetry is NOT correct near boundaries.') 
     326            ELSE 
     327               IF(lwp) WRITE(numout,*) '==> Child Bathymetry is ok near boundaries.' 
     328               IF(lwp) WRITE(numout,*) ' ' 
     329            ENDIF   
     330         ENDIF 
     331      ENDIF 
     332 
     333      IF( l_vremap ) THEN 
     334      ! Additional constrain that should be removed someday: 
     335         IF ( Agrif_Parent(jpk).GT.jpk ) THEN 
     336            CALL ctl_stop( ' With l_vremap, child grids must have jpk greater or equal to the parent value' ) 
     337         ENDIF 
     338      ENDIF 
     339      ! 
     340   END SUBROUTINE Agrif_Init_Domain 
     341 
     342 
     343   SUBROUTINE Agrif_InitValues_cont 
     344         !!---------------------------------------------------------------------- 
     345         !!                 *** ROUTINE Agrif_InitValues_cont *** 
     346         !! 
     347         !! ** Purpose ::   Declaration of variables to be interpolated 
     348         !!---------------------------------------------------------------------- 
     349      USE agrif_oce_update 
     350      USE agrif_oce_interp 
     351      USE agrif_oce_sponge 
     352      USE Agrif_Util 
     353      USE oce  
     354      USE dom_oce 
     355      USE zdf_oce 
     356      USE nemogcm 
     357      USE agrif_oce 
     358      ! 
     359      USE lbclnk 
     360      USE lib_mpp 
     361      USE in_out_manager 
     362      ! 
     363      IMPLICIT NONE 
     364      ! 
     365      LOGICAL :: check_namelist 
     366      CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3, cl_check4  
     367      REAL(wp), DIMENSION(jpi,jpj) ::   zk   ! workspace 
     368      INTEGER :: ji, jj 
     369 
     370      ! 1. Declaration of the type of variable which have to be interpolated 
     371      !--------------------------------------------------------------------- 
     372      CALL agrif_declare_var 
     373 
     374      ! 2. First interpolations of potentially non zero fields 
     375      !------------------------------------------------------- 
    159376      Agrif_SpecialValue    = 0._wp 
    160377      Agrif_UseSpecialValue = .TRUE. 
     
    163380      tabspongedone_tsn = .FALSE. 
    164381      CALL Agrif_Bc_variable(tsn_sponge_id,calledweight=1.,procname=interptsn_sponge) 
    165       ! reset ts(:,:,:,:,Krhs_a) to zero 
     382      ! reset tsa to zero 
    166383      ts(:,:,:,:,Krhs_a) = 0._wp 
    167384 
    168385      Agrif_UseSpecialValue = ln_spc_dyn 
     386      use_sign_north = .TRUE. 
     387      sign_north = -1. 
    169388      CALL Agrif_Bc_variable(un_interp_id,calledweight=1.,procname=interpun) 
    170389      CALL Agrif_Bc_variable(vn_interp_id,calledweight=1.,procname=interpvn) 
     
    175394      tabspongedone_v = .FALSE. 
    176395      CALL Agrif_Bc_variable(vn_sponge_id,calledweight=1.,procname=interpvn_sponge) 
     396      use_sign_north = .FALSE. 
    177397      uu(:,:,:,Krhs_a) = 0._wp 
    178398      vv(:,:,:,Krhs_a) = 0._wp 
     
    185405      IF ( ln_dynspg_ts ) THEN 
    186406         Agrif_UseSpecialValue = ln_spc_dyn 
     407         use_sign_north = .TRUE. 
     408         sign_north = -1. 
    187409         CALL Agrif_Bc_variable(unb_id,calledweight=1.,procname=interpunb) 
    188410         CALL Agrif_Bc_variable(vnb_id,calledweight=1.,procname=interpvnb) 
    189411         CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b) 
    190412         CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b) 
     413         use_sign_north = .FALSE. 
    191414         ubdy(:,:) = 0._wp 
    192415         vbdy(:,:) = 0._wp 
    193416      ENDIF 
    194  
    195       Agrif_UseSpecialValue = .FALSE. 
    196  
    197       ! 3. Some controls 
     417      Agrif_UseSpecialValue = .FALSE.  
     418 
    198419      !----------------- 
    199420      check_namelist = .TRUE. 
    200421 
    201422      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  
    226423         ! Check free surface scheme 
    227424         IF ( ( Agrif_Parent(ln_dynspg_ts ).AND.ln_dynspg_exp ).OR.& 
     
    251448            STOP 
    252449         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       !  
     450      ENDIF 
     451 
    297452   END SUBROUTINE Agrif_InitValues_cont 
    298453 
     
    314469      ! 1. Declaration of the type of variable which have to be interpolated 
    315470      !--------------------------------------------------------------------- 
     471 
    316472      ind1 =     nbghostcells 
    317       ind2 = 1 + nbghostcells 
    318       ind3 = 2 + nbghostcells 
     473      ind2 = 2 + nbghostcells_x 
     474      ind3 = 2 + nbghostcells_y_s 
     475 
    319476# if defined key_vertical 
    320477      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) 
    321478      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) 
    322479 
    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) 
     480      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) ! 
     481      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) 
     482      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) 
     483      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) 
     484      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) 
     485      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) 
    329486# else 
    330487      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) 
    331488      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) 
    332489 
    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) 
     490      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) 
     491      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) 
     492      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) 
     493      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) 
     494      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) 
     495      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) 
    339496# 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) 
    349497 
    350498      CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),unb_id) 
     
    357505      CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id) 
    358506 
    359       IF( ln_zdftke.OR.ln_zdfgls ) THEN 
     507 
     508      IF( ln_zdftke.OR.ln_zdfgls ) THEN  ! logical not known at this point 
    360509!         CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/), en_id) 
    361510!         CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),avt_id) 
     
    366515# endif 
    367516      ENDIF 
    368  
     517      
    369518      ! 2. Type of interpolation 
    370519      !------------------------- 
    371520      CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear) 
    372  
    373521      CALL Agrif_Set_bcinterp(un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    374522      CALL Agrif_Set_bcinterp(vn_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
    375523 
    376524      CALL Agrif_Set_bcinterp(tsn_sponge_id,interp=AGRIF_linear) 
     525      CALL Agrif_Set_bcinterp(un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
     526      CALL Agrif_Set_bcinterp(vn_sponge_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
    377527 
    378528      CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_linear) 
     
    390540!< 
    391541 
    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 
     542      IF( ln_zdftke.OR.ln_zdfgls )  CALL Agrif_Set_bcinterp( avm_id, interp=AGRIF_linear ) 
     543     
     544 
     545       ! 3. Location of interpolation 
    405546      !----------------------------- 
    406547      CALL Agrif_Set_bc(       tsn_id, (/0,ind1-1/) ) ! if west,  rhox=3 and nbghost=3: columns 2 to 4 
     
    418559      CALL Agrif_Set_bc( vb2b_interp_id, (/0,ind1-1/) ) 
    419560 
    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/) ) 
     561      IF( ln_zdftke.OR.ln_zdfgls ) CALL Agrif_Set_bc( avm_id, (/0,ind1/) ) 
    431562 
    432563      ! 4. Update type 
    433564      !---------------  
    434       CALL Agrif_Set_Updatetype(scales_t_id, update = AGRIF_Update_Average) 
    435565 
    436566# if defined UPD_HIGH 
     
    444574      CALL Agrif_Set_Updatetype(e3t_id, update = Agrif_Update_Full_Weighting) 
    445575 
    446       IF( ln_zdftke.OR.ln_zdfgls ) THEN 
     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 
     
    460590      CALL Agrif_Set_Updatetype(e3t_id, update = AGRIF_Update_Average) 
    461591 
    462       IF( ln_zdftke.OR.ln_zdfgls ) THEN 
     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 
     
    472602#if defined key_si3 
    473603SUBROUTINE Agrif_InitValues_cont_ice 
    474       !!---------------------------------------------------------------------- 
    475       !!                 *** ROUTINE Agrif_InitValues_cont_ice *** 
    476       !!---------------------------------------------------------------------- 
    477604      USE Agrif_Util 
    478605      USE sbc_oce, ONLY : nn_fsbc  ! clem: necessary otherwise Agrif_Parent(nn_fsbc) = nn_fsbc 
     
    482609      USE agrif_ice_interp 
    483610      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 
     611      !!---------------------------------------------------------------------- 
     612      !!                 *** ROUTINE Agrif_InitValues_cont_ice *** 
     613      !!---------------------------------------------------------------------- 
    491614 
    492615      ! Controls 
     
    495618      !          the run must satisfy CFL=Uice/(dx/dt) < 0.6/nn_fsbc(child) 
    496619      !          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 
     620      !       If a solution is found, the following stop could be removed because the rest of the code take nn_fsbc(child) into account      
    498621      IF( nn_fsbc > 1 )  CALL ctl_stop('nn_fsbc(child) must be set to 1 otherwise agrif and sea-ice may not work properly') 
    499622 
     
    516639      !!                 *** ROUTINE agrif_declare_var_ice *** 
    517640      !!---------------------------------------------------------------------- 
     641 
    518642      USE Agrif_Util 
    519643      USE ice 
    520       USE par_oce, ONLY : nbghostcells 
     644      USE par_oce, ONLY : nbghostcells, nbghostcells_x, nbghostcells_y_s 
    521645      ! 
    522646      IMPLICIT NONE 
    523647      ! 
    524648      INTEGER :: ind1, ind2, ind3 
    525       !!---------------------------------------------------------------------- 
     649         !!---------------------------------------------------------------------- 
    526650      ! 
    527651      ! 1. Declaration of the type of variable which have to be interpolated (parent=>child) 
     
    532656      !                            2,2 = two ghost lines 
    533657      !------------------------------------------------------------------------------------- 
     658 
    534659      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  ) 
     660      ind2 = 2 + nbghostcells_x 
     661      ind3 = 2 + nbghostcells_y_s 
     662      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) 
     663      CALL agrif_declare_variable((/1,2/)  ,(/ind2-1,ind3/)  ,(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,u_ice_id  ) 
     664      CALL agrif_declare_variable((/2,1/)  ,(/ind2,ind3-1/)  ,(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,v_ice_id  ) 
     665 
     666      CALL Agrif_Set_MaskMaxSearch(25) 
     667      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) 
     668      CALL agrif_declare_variable((/1,2/)  ,(/ind2-1,ind3/)  ,(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,u_iceini_id  ) 
     669      CALL agrif_declare_variable((/2,1/)  ,(/ind2,ind3-1/)  ,(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,v_iceini_id  ) 
     670      CALL Agrif_Set_MaskMaxSearch(5) 
    540671 
    541672      ! 2. Set interpolations (normal & tangent to the grid cell for velocities) 
     
    545676      CALL Agrif_Set_bcinterp(v_ice_id  , interp1 = AGRIF_ppm   ,interp2 = Agrif_linear) 
    546677 
     678      CALL Agrif_Set_bcinterp(tra_iceini_id, interp  = AGRIF_linear) 
     679      CALL Agrif_Set_interp  (tra_iceini_id, interp  = AGRIF_linear) 
     680      CALL Agrif_Set_bcinterp(u_iceini_id  , interp  = AGRIF_linear  ) 
     681      CALL Agrif_Set_interp  (u_iceini_id  , interp  = AGRIF_linear   ) 
     682      CALL Agrif_Set_bcinterp(v_iceini_id  , interp  = AGRIF_linear) 
     683      CALL Agrif_Set_interp  (v_iceini_id  , interp  = AGRIF_linear) 
     684 
    547685      ! 3. Set location of interpolations 
    548686      !---------------------------------- 
     
    550688      CALL Agrif_Set_bc(u_ice_id  ,(/0,ind1/)) 
    551689      CALL Agrif_Set_bc(v_ice_id  ,(/0,ind1/)) 
     690 
     691      CALL Agrif_Set_bc(tra_iceini_id,(/0,ind1/)) 
     692      CALL Agrif_Set_bc(u_iceini_id  ,(/0,ind1/)) 
     693      CALL Agrif_Set_bc(v_iceini_id  ,(/0,ind1/)) 
    552694 
    553695      ! 4. Set update type in case 2 ways (child=>parent) (normal & tangent to the grid cell for velocities) 
     
    557699      CALL Agrif_Set_Updatetype(u_ice_id  , update1 = Agrif_Update_Average       , update2 = Agrif_Update_Full_Weighting) 
    558700      CALL Agrif_Set_Updatetype(v_ice_id  , update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average       ) 
    559 #else 
     701# else 
    560702      CALL Agrif_Set_Updatetype(tra_ice_id, update  = AGRIF_Update_Average) 
    561703      CALL Agrif_Set_Updatetype(u_ice_id  , update1 = Agrif_Update_Copy   , update2 = Agrif_Update_Average) 
    562704      CALL Agrif_Set_Updatetype(v_ice_id  , update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy   ) 
    563 #endif 
     705# endif 
    564706 
    565707   END SUBROUTINE agrif_declare_var_ice 
     
    585727      USE agrif_top_sponge 
    586728      !! 
    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() 
     729   
     730   !! 
     731   IMPLICIT NONE 
     732   ! 
     733   CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3 
     734   LOGICAL :: check_namelist 
     735      !!---------------------------------------------------------------------- 
     736 
     737 
     738   ! 1. Declaration of the type of variable which have to be interpolated 
     739   !--------------------------------------------------------------------- 
     740   CALL agrif_declare_var_top 
     741 
     742   ! 2. First interpolations of potentially non zero fields 
     743   !------------------------------------------------------- 
     744   Agrif_SpecialValue=0. 
     745   Agrif_UseSpecialValue = .TRUE. 
     746   CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn) 
     747   Agrif_UseSpecialValue = .FALSE. 
     748   CALL Agrif_Sponge 
     749   tabspongedone_trn = .FALSE. 
     750   CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge) 
     751   ! reset tsa to zero 
     752   tra(:,:,:,:) = 0. 
     753 
     754   ! 3. Some controls 
     755   !----------------- 
     756   check_namelist = .TRUE. 
     757 
     758   IF( check_namelist ) THEN 
     759      ! Check time steps 
     760      IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN 
     761         WRITE(cl_check1,*)  Agrif_Parent(rdt) 
     762         WRITE(cl_check2,*)  rdt 
     763         WRITE(cl_check3,*)  rdt*Agrif_Rhot() 
    619764         CALL ctl_stop( 'incompatible time step between grids',   & 
    620765               &               'parent grid value : '//cl_check1    ,   &  
     
    635780         nitend =  Agrif_Parent(nitend)   *Agrif_IRhot() 
    636781      ENDIF 
    637  
    638782   ENDIF 
    639783   ! 
     
    655799      !!---------------------------------------------------------------------- 
    656800 
     801 
     802 
     803!RB_CMEMS : declare here init for top       
    657804      ! 1. Declaration of the type of variable which have to be interpolated 
    658805      !--------------------------------------------------------------------- 
    659806      ind1 =     nbghostcells 
    660       ind2 = 1 + nbghostcells 
    661       ind3 = 2 + nbghostcells 
     807      ind2 = 2 + nbghostcells_x 
     808      ind3 = 2 + nbghostcells_y_s 
    662809# 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) 
     810      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) 
     811      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) 
    665812# 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) 
     813! LAURENT: STRANGE why (3,3) here ? 
     814      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) 
     815      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) 
    668816# endif 
    669817 
     
    705853      !!                     *** ROUTINE agrif_init *** 
    706854      !!---------------------------------------------------------------------- 
    707       USE agrif_oce  
    708       USE agrif_ice 
    709       USE in_out_manager 
    710       USE lib_mpp 
     855   USE agrif_oce  
     856   USE agrif_ice 
     857   USE dom_oce 
     858   USE in_out_manager 
     859   USE lib_mpp 
    711860      !! 
    712861      IMPLICIT NONE 
     
    714863      INTEGER  ::   ios                 ! Local integer output status for namelist read 
    715864      NAMELIST/namagrif/ ln_agrif_2way, rn_sponge_tra, rn_sponge_dyn, rn_trelax_tra, rn_trelax_dyn, & 
    716                        & ln_spc_dyn, ln_chk_bathy 
     865                       & ln_spc_dyn, ln_chk_bathy, ln_bry_south 
    717866      !!-------------------------------------------------------------------------------------- 
    718867      ! 
     
    735884         WRITE(numout,*) '      use special values for dynamics   ln_spc_dyn    = ', ln_spc_dyn 
    736885         WRITE(numout,*) '      check bathymetry                  ln_chk_bathy  = ', ln_chk_bathy 
    737       ENDIF 
    738       ! 
    739       ! 
    740       IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed') 
     886         WRITE(numout,*) '      south boundary                    ln_bry_south  = ', ln_bry_south 
     887      ENDIF 
     888      ! 
     889      ! Set the number of ghost cells according to periodicity 
     890      nbghostcells_x = nbghostcells 
     891      nbghostcells_y_s = nbghostcells 
     892      nbghostcells_y_n = nbghostcells 
     893      ! 
     894      IF ( jperio == 1 ) nbghostcells_x = 0 
     895      IF ( .NOT. ln_bry_south ) nbghostcells_y_s = 0 
     896 
     897      ! Some checks 
     898      IF( jpiglo /= nbcellsx + 2 + 2*nbghostcells_x )   & 
     899          CALL ctl_stop( 'STOP', 'agrif_nemo_init: Agrif children requires jpiglo == nbcellsx + 2 + 2*nbghostcells_x' ) 
     900      IF( jpjglo /= nbcellsy + 2 + nbghostcells_y_s + nbghostcells_y_n )   & 
     901          CALL ctl_stop( 'STOP', 'agrif_nemo_init: Agrif children requires jpjglo == nbcellsy + 2 + nbghostcells_y_s + nbghostcells_y_n' ) 
     902      IF( ln_use_jattr )   CALL ctl_stop( 'STOP', 'agrif_nemo_init:Agrif children requires ln_use_jattr = .false. ' ) 
    741903      ! 
    742904   END SUBROUTINE agrif_nemo_init 
    743905 
    744906# if defined key_mpp_mpi 
    745  
    746907   SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob ) 
    747908      !!---------------------------------------------------------------------- 
     
    803964# endif 
    804965 
     966   SUBROUTINE nemo_mapping(ndim,ptx,pty,bounds,bounds_chunks,correction_required,nb_chunks) 
     967      !!---------------------------------------------------------------------- 
     968      !!                   *** ROUTINE Nemo_mapping *** 
     969      !!---------------------------------------------------------------------- 
     970      USE dom_oce 
     971      !! 
     972      IMPLICIT NONE 
     973      ! 
     974      INTEGER :: ndim 
     975      INTEGER :: ptx, pty 
     976      INTEGER, DIMENSION(ndim,2,2) :: bounds 
     977      INTEGER, DIMENSION(:,:,:,:), ALLOCATABLE :: bounds_chunks 
     978      LOGICAL, DIMENSION(:), ALLOCATABLE :: correction_required 
     979      INTEGER :: nb_chunks 
     980      ! 
     981      INTEGER :: i 
     982 
     983      IF (agrif_debug_interp) THEN 
     984         DO i=1,ndim 
     985            WRITE(*,*) 'direction = ',i,bounds(i,1,2),bounds(i,2,2) 
     986         ENDDO 
     987      ENDIF 
     988 
     989      IF( bounds(2,2,2) > jpjglo) THEN 
     990         IF( bounds(2,1,2) <=jpjglo) THEN 
     991            nb_chunks = 2 
     992            ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2)) 
     993            ALLOCATE(correction_required(nb_chunks)) 
     994            DO i = 1,nb_chunks 
     995               bounds_chunks(i,:,:,:) = bounds 
     996            END DO 
     997         
     998      ! FIRST CHUNCK (for j<=jpjglo)    
     999 
     1000      ! Original indices 
     1001            bounds_chunks(1,1,1,1) = bounds(1,1,2) 
     1002            bounds_chunks(1,1,2,1) = bounds(1,2,2) 
     1003            bounds_chunks(1,2,1,1) = bounds(2,1,2) 
     1004            bounds_chunks(1,2,2,1) = jpjglo 
     1005 
     1006            bounds_chunks(1,1,1,2) = bounds(1,1,2) 
     1007            bounds_chunks(1,1,2,2) = bounds(1,2,2) 
     1008            bounds_chunks(1,2,1,2) = bounds(2,1,2) 
     1009            bounds_chunks(1,2,2,2) = jpjglo 
     1010 
     1011      ! Correction required or not 
     1012            correction_required(1)=.FALSE. 
     1013        
     1014      ! SECOND CHUNCK (for j>jpjglo) 
     1015 
     1016      ! Original indices 
     1017            bounds_chunks(2,1,1,1) = bounds(1,1,2) 
     1018            bounds_chunks(2,1,2,1) = bounds(1,2,2) 
     1019            bounds_chunks(2,2,1,1) = jpjglo-2 
     1020            bounds_chunks(2,2,2,1) = bounds(2,2,2) 
     1021 
     1022      ! Where to find them 
     1023      ! We use the relation TAB(ji,jj)=TAB(jpiglo-ji+2,jpjglo-2-(jj-jpjglo)) 
     1024 
     1025            IF( ptx == 2) THEN ! T, V points 
     1026               bounds_chunks(2,1,1,2) = jpiglo-bounds(1,2,2)+2 
     1027               bounds_chunks(2,1,2,2) = jpiglo-bounds(1,1,2)+2 
     1028            ELSE ! U, F points 
     1029               bounds_chunks(2,1,1,2) = jpiglo-bounds(1,2,2)+1 
     1030               bounds_chunks(2,1,2,2) = jpiglo-bounds(1,1,2)+1        
     1031            ENDIF 
     1032 
     1033            IF( pty == 2) THEN ! T, U points 
     1034               bounds_chunks(2,2,1,2) = jpjglo-2-(bounds(2,2,2) -jpjglo) 
     1035               bounds_chunks(2,2,2,2) = jpjglo-2-(jpjglo-2      -jpjglo) 
     1036            ELSE ! V, F points 
     1037               bounds_chunks(2,2,1,2) = jpjglo-3-(bounds(2,2,2) -jpjglo) 
     1038               bounds_chunks(2,2,2,2) = jpjglo-3-(jpjglo-2      -jpjglo) 
     1039            ENDIF 
     1040      ! Correction required or not 
     1041            correction_required(2)=.TRUE. 
     1042 
     1043         ELSE 
     1044            nb_chunks = 1 
     1045            ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2)) 
     1046            ALLOCATE(correction_required(nb_chunks)) 
     1047            DO i=1,nb_chunks 
     1048               bounds_chunks(i,:,:,:) = bounds 
     1049            END DO 
     1050 
     1051            bounds_chunks(1,1,1,1) = bounds(1,1,2) 
     1052            bounds_chunks(1,1,2,1) = bounds(1,2,2) 
     1053            bounds_chunks(1,2,1,1) = bounds(2,1,2) 
     1054            bounds_chunks(1,2,2,1) = bounds(2,2,2) 
     1055 
     1056            bounds_chunks(1,1,1,2) = jpiglo-bounds(1,2,2)+2 
     1057            bounds_chunks(1,1,2,2) = jpiglo-bounds(1,1,2)+2 
     1058 
     1059            bounds_chunks(1,2,1,2) = jpjglo-2-(bounds(2,2,2)-jpjglo) 
     1060            bounds_chunks(1,2,2,2) = jpjglo-2-(bounds(2,1,2)-jpjglo) 
     1061 
     1062            IF( ptx == 2) THEN ! T, V points 
     1063               bounds_chunks(1,1,1,2) = jpiglo-bounds(1,2,2)+2 
     1064               bounds_chunks(1,1,2,2) = jpiglo-bounds(1,1,2)+2 
     1065            ELSE ! U, F points 
     1066               bounds_chunks(1,1,1,2) = jpiglo-bounds(1,2,2)+1 
     1067               bounds_chunks(1,1,2,2) = jpiglo-bounds(1,1,2)+1        
     1068            ENDIF 
     1069 
     1070            IF (pty == 2) THEN ! T, U points 
     1071               bounds_chunks(1,2,1,2) = jpjglo-2-(bounds(2,2,2) -jpjglo) 
     1072               bounds_chunks(1,2,2,2) = jpjglo-2-(bounds(2,1,2) -jpjglo) 
     1073            ELSE ! V, F points 
     1074               bounds_chunks(1,2,1,2) = jpjglo-3-(bounds(2,2,2) -jpjglo) 
     1075               bounds_chunks(1,2,2,2) = jpjglo-3-(bounds(2,1,2) -jpjglo) 
     1076            ENDIF 
     1077 
     1078            correction_required(1)=.TRUE.           
     1079         ENDIF 
     1080 
     1081      ELSE IF (bounds(1,1,2) < 1) THEN 
     1082         IF (bounds(1,2,2) > 0) THEN 
     1083            nb_chunks = 2 
     1084            ALLOCATE(correction_required(nb_chunks)) 
     1085            correction_required=.FALSE. 
     1086            ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2)) 
     1087            DO i=1,nb_chunks 
     1088               bounds_chunks(i,:,:,:) = bounds 
     1089            END DO 
     1090               
     1091            bounds_chunks(1,1,1,2) = bounds(1,1,2)+jpiglo-2 
     1092            bounds_chunks(1,1,2,2) = 1+jpiglo-2 
     1093           
     1094            bounds_chunks(1,1,1,1) = bounds(1,1,2) 
     1095            bounds_chunks(1,1,2,1) = 1 
     1096        
     1097            bounds_chunks(2,1,1,2) = 2 
     1098            bounds_chunks(2,1,2,2) = bounds(1,2,2) 
     1099           
     1100            bounds_chunks(2,1,1,1) = 2 
     1101            bounds_chunks(2,1,2,1) = bounds(1,2,2) 
     1102 
     1103         ELSE 
     1104            nb_chunks = 1 
     1105            ALLOCATE(correction_required(nb_chunks)) 
     1106            correction_required=.FALSE. 
     1107            ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2)) 
     1108            DO i=1,nb_chunks 
     1109               bounds_chunks(i,:,:,:) = bounds 
     1110            END DO     
     1111            bounds_chunks(1,1,1,2) = bounds(1,1,2)+jpiglo-2 
     1112            bounds_chunks(1,1,2,2) = bounds(1,2,2)+jpiglo-2 
     1113           
     1114            bounds_chunks(1,1,1,1) = bounds(1,1,2) 
     1115           bounds_chunks(1,1,2,1) = bounds(1,2,2) 
     1116         ENDIF 
     1117      ELSE 
     1118         nb_chunks=1   
     1119         ALLOCATE(correction_required(nb_chunks)) 
     1120         correction_required=.FALSE. 
     1121         ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2)) 
     1122         DO i=1,nb_chunks 
     1123            bounds_chunks(i,:,:,:) = bounds 
     1124         END DO 
     1125         bounds_chunks(1,1,1,2) = bounds(1,1,2) 
     1126         bounds_chunks(1,1,2,2) = bounds(1,2,2) 
     1127         bounds_chunks(1,2,1,2) = bounds(2,1,2) 
     1128         bounds_chunks(1,2,2,2) = bounds(2,2,2) 
     1129           
     1130         bounds_chunks(1,1,1,1) = bounds(1,1,2) 
     1131         bounds_chunks(1,1,2,1) = bounds(1,2,2) 
     1132         bounds_chunks(1,2,1,1) = bounds(2,1,2) 
     1133         bounds_chunks(1,2,2,1) = bounds(2,2,2)               
     1134      ENDIF 
     1135         
     1136   END SUBROUTINE nemo_mapping 
     1137 
     1138   FUNCTION agrif_external_switch_index(ptx,pty,i1,isens) 
     1139 
     1140   USE dom_oce 
     1141 
     1142   INTEGER :: ptx, pty, i1, isens 
     1143   INTEGER :: agrif_external_switch_index 
     1144 
     1145   IF( isens == 1 ) THEN 
     1146      IF( ptx == 2 ) THEN ! T, V points 
     1147         agrif_external_switch_index = jpiglo-i1+2 
     1148      ELSE ! U, F points 
     1149         agrif_external_switch_index = jpiglo-i1+1       
     1150      ENDIF 
     1151   ELSE IF( isens ==2 ) THEN 
     1152      IF ( pty == 2 ) THEN ! T, U points 
     1153         agrif_external_switch_index = jpjglo-2-(i1 -jpjglo) 
     1154      ELSE ! V, F points 
     1155         agrif_external_switch_index = jpjglo-3-(i1 -jpjglo) 
     1156      ENDIF 
     1157   ENDIF 
     1158 
     1159   END function agrif_external_switch_index 
     1160 
     1161   SUBROUTINE Correct_field(tab2d,i1,i2,j1,j2) 
     1162      !!---------------------------------------------------------------------- 
     1163      !!                   *** ROUTINE Correct_field *** 
     1164      !!---------------------------------------------------------------------- 
     1165    
     1166   USE dom_oce 
     1167   USE agrif_oce 
     1168 
     1169   INTEGER :: i1,i2,j1,j2 
     1170   REAL(wp), DIMENSION(i1:i2,j1:j2) :: tab2d 
     1171 
     1172   INTEGER :: i,j 
     1173   REAL(wp), DIMENSION(i1:i2,j1:j2) :: tab2dtemp 
     1174 
     1175   tab2dtemp = tab2d 
     1176 
     1177   IF( .NOT. use_sign_north ) THEN 
     1178      DO j=j1,j2 
     1179         DO i=i1,i2 
     1180            tab2d(i,j)=tab2dtemp(i2-(i-i1),j2-(j-j1)) 
     1181         END DO 
     1182      END DO 
     1183   ELSE 
     1184      DO j=j1,j2 
     1185         DO i=i1,i2 
     1186            tab2d(i,j)=sign_north * tab2dtemp(i2-(i-i1),j2-(j-j1)) 
     1187         END DO 
     1188      END DO 
     1189   ENDIF 
     1190 
     1191   END SUBROUTINE Correct_field 
     1192 
    8051193#else 
    8061194   SUBROUTINE Subcalledbyagrif 
Note: See TracChangeset for help on using the changeset viewer.