Ignore:
Timestamp:
2015-12-14T10:27:28+01:00 (5 years ago)
Author:
timgraham
Message:

Merged head of trunk into branch

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/2014/dev_r4650_UKMO14.12_STAND_ALONE_OBSOPER/NEMOGCM/NEMO/NST_SRC/agrif_user.F90

    r5600 r6043  
    3030      jpi     = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci 
    3131      jpj     = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj 
    32       jpk     = jpkdta  
     32! JC: change to allow for different vertical levels 
     33!     jpk is already set 
     34!     keep it jpk possibly different from jpkdta which  
     35!     hold parent grid vertical levels number (set earlier) 
     36!      jpk     = jpkdta  
    3337      jpim1   = jpi-1  
    3438      jpjm1   = jpj-1  
     
    6367   ! 0. Initializations 
    6468   !------------------- 
    65    IF( cp_cfg == 'orca' ) then 
     69   IF( cp_cfg == 'orca' ) THEN 
    6670      IF ( jp_cfg == 2 .OR. jp_cfg == 025 .OR. jp_cfg == 05 & 
    67   &                      .OR. jp_cfg == 4 ) THEN 
     71            &                      .OR. jp_cfg == 4 ) THEN 
    6872         jp_cfg = -1    ! set special value for jp_cfg on fine grids 
    6973         cp_cfg = "default" 
     
    100104   USE dom_oce 
    101105   USE nemogcm 
    102    USE sol_oce 
    103106   USE in_out_manager 
    104107   USE agrif_opa_update 
     
    119122SUBROUTINE agrif_declare_var_dom 
    120123   !!---------------------------------------------------------------------- 
    121    !!                 *** ROUTINE agrif_declarE_var *** 
     124   !!                 *** ROUTINE agrif_declare_var *** 
    122125   !! 
    123126   !! ** Purpose :: Declaration of variables to be interpolated 
    124127   !!---------------------------------------------------------------------- 
    125128   USE agrif_util 
    126    USE par_oce       !   ONLY : jpts 
     129   USE par_oce        
    127130   USE oce 
    128131   IMPLICIT NONE 
     
    131134   ! 1. Declaration of the type of variable which have to be interpolated 
    132135   !--------------------------------------------------------------------- 
    133    CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e1u_id) 
    134    CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e2v_id) 
    135  
     136   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e1u_id) 
     137   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e2v_id) 
    136138 
    137139   ! 2. Type of interpolation 
    138140   !------------------------- 
    139    Call Agrif_Set_bcinterp(e1u_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    140    Call Agrif_Set_bcinterp(e2v_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
     141   CALL Agrif_Set_bcinterp(e1u_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
     142   CALL Agrif_Set_bcinterp(e2v_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
    141143 
    142144   ! 3. Location of interpolation 
    143145   !----------------------------- 
    144    Call Agrif_Set_bc(e1u_id,(/0,0/)) 
    145    Call Agrif_Set_bc(e2v_id,(/0,0/)) 
     146   CALL Agrif_Set_bc(e1u_id,(/0,0/)) 
     147   CALL Agrif_Set_bc(e2v_id,(/0,0/)) 
    146148 
    147149   ! 5. Update type 
    148150   !---------------  
    149    Call Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average) 
    150    Call Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy) 
    151  
     151   CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average) 
     152   CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy) 
     153 
     154! High order updates 
     155!   CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Average,            update2=Agrif_Update_Full_Weighting) 
     156!   CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Full_Weighting,     update2=Agrif_Update_Average) 
     157    ! 
    152158END SUBROUTINE agrif_declare_var_dom 
    153159 
     
    165171   USE dom_oce 
    166172   USE nemogcm 
    167    USE sol_oce 
     173   USE lib_mpp 
    168174   USE in_out_manager 
    169175   USE agrif_opa_update 
     
    173179   IMPLICIT NONE 
    174180   ! 
    175    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tabtstemp 
    176    REAL(wp), DIMENSION(:,:,:  ), ALLOCATABLE :: tabuvtemp 
    177    REAL(wp), DIMENSION(:,:    ), ALLOCATABLE :: tab2d 
    178181   LOGICAL :: check_namelist 
    179    !!---------------------------------------------------------------------- 
    180  
    181    ALLOCATE( tabtstemp(jpi, jpj, jpk, jpts) ) 
    182    ALLOCATE( tabuvtemp(jpi, jpj, jpk)       ) 
    183    ALLOCATE( tab2d(jpi, jpj)                ) 
    184  
     182   CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3 
     183   !!---------------------------------------------------------------------- 
    185184 
    186185   ! 1. Declaration of the type of variable which have to be interpolated 
     
    192191   Agrif_SpecialValue=0. 
    193192   Agrif_UseSpecialValue = .TRUE. 
    194    Call Agrif_Bc_variable(tabtstemp,tsn_id,calledweight=1.,procname=interptsn) 
    195    Call Agrif_Bc_variable(tabtstemp,tsa_id,calledweight=1.,procname=interptsn) 
    196  
    197    Call Agrif_Bc_variable(tabuvtemp,un_id,calledweight=1.,procname=interpu) 
    198    Call Agrif_Bc_variable(tabuvtemp,vn_id,calledweight=1.,procname=interpv) 
    199    Call Agrif_Bc_variable(tabuvtemp,ua_id,calledweight=1.,procname=interpun) 
    200    Call Agrif_Bc_variable(tabuvtemp,va_id,calledweight=1.,procname=interpvn) 
    201  
    202    Call Agrif_Bc_variable(tab2d,unb_id,calledweight=1.,procname=interpunb) 
    203    Call Agrif_Bc_variable(tab2d,vnb_id,calledweight=1.,procname=interpvnb) 
    204    Call Agrif_Bc_variable(tab2d,sshn_id,calledweight=1.,procname=interpsshn) 
    205    Agrif_UseSpecialValue = .FALSE. 
     193   CALL Agrif_Bc_variable(tsn_id,calledweight=1.,procname=interptsn) 
     194   CALL Agrif_Sponge 
     195   tabspongedone_tsn = .FALSE. 
     196   CALL Agrif_Bc_variable(tsn_sponge_id,calledweight=1.,procname=interptsn_sponge) 
     197   ! reset tsa to zero 
     198   tsa(:,:,:,:) = 0. 
     199 
     200   Agrif_UseSpecialValue = ln_spc_dyn 
     201   CALL Agrif_Bc_variable(un_interp_id,calledweight=1.,procname=interpun) 
     202   CALL Agrif_Bc_variable(vn_interp_id,calledweight=1.,procname=interpvn) 
     203   tabspongedone_u = .FALSE. 
     204   tabspongedone_v = .FALSE. 
     205   CALL Agrif_Bc_variable(un_sponge_id,calledweight=1.,procname=interpun_sponge) 
     206   tabspongedone_u = .FALSE. 
     207   tabspongedone_v = .FALSE. 
     208   CALL Agrif_Bc_variable(vn_sponge_id,calledweight=1.,procname=interpvn_sponge) 
     209 
     210   Agrif_UseSpecialValue = .TRUE. 
     211   CALL Agrif_Bc_variable(sshn_id,calledweight=1., procname=interpsshn ) 
     212 
     213   IF ( ln_dynspg_ts ) THEN 
     214      Agrif_UseSpecialValue = ln_spc_dyn 
     215      CALL Agrif_Bc_variable(unb_id,calledweight=1.,procname=interpunb) 
     216      CALL Agrif_Bc_variable(vnb_id,calledweight=1.,procname=interpvnb) 
     217      CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b) 
     218      CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b) 
     219      ubdy_w(:) = 0.e0 ; vbdy_w(:) = 0.e0 ; hbdy_w(:) =0.e0 
     220      ubdy_e(:) = 0.e0 ; vbdy_e(:) = 0.e0 ; hbdy_e(:) =0.e0  
     221      ubdy_n(:) = 0.e0 ; vbdy_n(:) = 0.e0 ; hbdy_n(:) =0.e0  
     222      ubdy_s(:) = 0.e0 ; vbdy_s(:) = 0.e0 ; hbdy_s(:) =0.e0 
     223   ENDIF 
     224 
     225   Agrif_UseSpecialValue = .FALSE.  
     226   ! reset velocities to zero 
     227   ua(:,:,:) = 0. 
     228   va(:,:,:) = 0. 
    206229 
    207230   ! 3. Some controls 
    208231   !----------------- 
    209    check_namelist = .true. 
    210  
    211    IF( check_namelist ) THEN 
     232   check_namelist = .TRUE. 
     233 
     234   IF( check_namelist ) THEN  
    212235 
    213236      ! Check time steps            
    214       IF( NINT(Agrif_Rhot()) * nint(rdt) /= Agrif_Parent(rdt) ) THEN 
    215          WRITE(*,*) 'incompatible time step between grids' 
    216          WRITE(*,*) 'parent grid value : ',Agrif_Parent(rdt) 
    217          WRITE(*,*) 'child  grid value : ',nint(rdt) 
    218          WRITE(*,*) 'value on parent grid should be : ',rdt*Agrif_Rhot() 
    219          STOP 
     237      IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN 
     238         WRITE(cl_check1,*)  NINT(Agrif_Parent(rdt)) 
     239         WRITE(cl_check2,*)  NINT(rdt) 
     240         WRITE(cl_check3,*)  NINT(Agrif_Parent(rdt)/Agrif_Rhot()) 
     241         CALL ctl_warn( 'incompatible time step between grids',   & 
     242               &               'parent grid value : '//cl_check1    ,   &  
     243               &               'child  grid value : '//cl_check2    ,   &  
     244               &               'value on child grid will be changed to : '//cl_check3 ) 
     245         rdt=Agrif_Parent(rdt)/Agrif_Rhot() 
    220246      ENDIF 
    221247 
    222248      ! Check run length 
    223249      IF( Agrif_IRhot() * (Agrif_Parent(nitend)- & 
    224            Agrif_Parent(nit000)+1) .ne. (nitend-nit000+1) ) THEN 
    225          WRITE(*,*) 'incompatible run length between grids' 
    226          WRITE(*,*) 'parent grid value : ',(Agrif_Parent(nitend)- & 
    227               Agrif_Parent(nit000)+1),' time step' 
    228          WRITE(*,*) 'child  grid value : ', & 
    229               (nitend-nit000+1),' time step' 
    230          WRITE(*,*) 'value on child grid should be : ', & 
    231               Agrif_IRhot() * (Agrif_Parent(nitend)- & 
    232               Agrif_Parent(nit000)+1) 
    233          STOP 
     250            Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN 
     251         WRITE(cl_check1,*)  (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 
     252         WRITE(cl_check2,*)   Agrif_Parent(nitend)   *Agrif_IRhot() 
     253         CALL ctl_warn( 'incompatible run length between grids'               ,   & 
     254               &              ' nit000 on fine grid will be change to : '//cl_check1,   & 
     255               &              ' nitend on fine grid will be change to : '//cl_check2    ) 
     256         nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 
     257         nitend =  Agrif_Parent(nitend)   *Agrif_IRhot() 
    234258      ENDIF 
    235259 
     
    237261      IF( ln_zps ) THEN 
    238262         ! check parameters for partial steps  
    239          IF( Agrif_Parent(e3zps_min) .ne. e3zps_min ) THEN 
     263         IF( Agrif_Parent(e3zps_min) .NE. e3zps_min ) THEN 
    240264            WRITE(*,*) 'incompatible e3zps_min between grids' 
    241265            WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min) 
     
    252276         ENDIF 
    253277      ENDIF 
     278 
     279      ! Check free surface scheme 
     280      IF ( ( Agrif_Parent(ln_dynspg_ts ).AND.ln_dynspg_exp ).OR.& 
     281         & ( Agrif_Parent(ln_dynspg_exp).AND.ln_dynspg_ts ) ) THEN 
     282         WRITE(*,*) 'incompatible free surface scheme between grids' 
     283         WRITE(*,*) 'parent grid ln_dynspg_ts  :', Agrif_Parent(ln_dynspg_ts ) 
     284         WRITE(*,*) 'parent grid ln_dynspg_exp :', Agrif_Parent(ln_dynspg_exp) 
     285         WRITE(*,*) 'child grid  ln_dynspg_ts  :', ln_dynspg_ts 
     286         WRITE(*,*) 'child grid  ln_dynspg_exp :', ln_dynspg_exp 
     287         WRITE(*,*) 'those logicals should be identical'                   
     288         STOP 
     289      ENDIF 
     290 
     291      ! check if masks and bathymetries match 
     292      IF(ln_chk_bathy) THEN 
     293         ! 
     294         IF(lwp) WRITE(numout,*) 'AGRIF: Check Bathymetry and masks near bdys. Level: ', Agrif_Level() 
     295         ! 
     296         kindic_agr = 0 
     297         ! check if umask agree with parent along western and eastern boundaries: 
     298         CALL Agrif_Bc_variable(umsk_id,calledweight=1.,procname=interpumsk) 
     299         ! check if vmask agree with parent along northern and southern boundaries: 
     300         CALL Agrif_Bc_variable(vmsk_id,calledweight=1.,procname=interpvmsk) 
     301    ! check if tmask and vertical scale factors agree with parent over first two coarse grid points: 
     302         CALL Agrif_Bc_variable(e3t_id,calledweight=1.,procname=interpe3t) 
     303         ! 
     304         IF (lk_mpp) CALL mpp_sum( kindic_agr ) 
     305         IF( kindic_agr /= 0 ) THEN                    
     306            CALL ctl_stop('Child Bathymetry is not correct near boundaries.') 
     307         ELSE 
     308            IF(lwp) WRITE(numout,*) 'Child Bathymetry is ok near boundaries.' 
     309         END IF 
     310      ENDIF 
     311      ! 
    254312   ENDIF 
    255  
    256    CALL Agrif_Update_tra(0) 
    257    CALL Agrif_Update_dyn(0) 
    258  
    259    nbcline = 0 
    260    ! 
    261    DEALLOCATE(tabtstemp) 
    262    DEALLOCATE(tabuvtemp) 
    263    DEALLOCATE(tab2d) 
     313   !  
     314   ! Do update at initialisation because not done before writing restarts 
     315   ! This would indeed change boundary conditions values at initial time 
     316   ! hence produce restartability issues. 
     317   ! Note that update below is recursive (with lk_agrif_doupd=T): 
     318   !  
     319! JC: I am not sure if Agrif_MaxLevel() is the "relative" 
     320!     or the absolute maximum nesting level...TBC                         
     321   IF ( Agrif_Level().EQ.Agrif_MaxLevel() ) THEN  
     322      ! NB: Do tracers first, dynamics after because nbcline incremented in dynamics 
     323      CALL Agrif_Update_tra() 
     324      CALL Agrif_Update_dyn() 
     325   ENDIF 
     326   ! 
     327# if defined key_zdftke 
     328   CALL Agrif_Update_tke(0) 
     329# endif 
     330   ! 
     331   Agrif_UseSpecialValueInUpdate = .FALSE. 
     332   nbcline = 0  
     333   lk_agrif_doupd = .FALSE. 
    264334   ! 
    265335END SUBROUTINE Agrif_InitValues_cont 
     
    275345   USE par_oce       !   ONLY : jpts 
    276346   USE oce 
     347   USE agrif_oce 
    277348   IMPLICIT NONE 
    278349   !!---------------------------------------------------------------------- 
     
    280351   ! 1. Declaration of the type of variable which have to be interpolated 
    281352   !--------------------------------------------------------------------- 
    282    CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsn_id) 
    283    CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsa_id) 
    284    CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsb_id) 
    285  
    286    CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),un_id) 
    287    CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),vn_id) 
    288    CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),ua_id) 
    289    CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),va_id) 
    290  
    291    CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),unb_id) 
    292    CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vnb_id) 
    293    CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),sshn_id) 
    294    CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),gcb_id) 
    295    CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ub2b_id) 
    296    CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vb2b_id) 
     353   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_id) 
     354   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_sponge_id) 
     355 
     356   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_interp_id) 
     357   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_interp_id) 
     358   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_update_id) 
     359   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_update_id) 
     360   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_sponge_id) 
     361   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_sponge_id) 
     362 
     363   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id) 
     364   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),umsk_id) 
     365   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vmsk_id) 
     366 
     367   CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,3/),scales_t_id) 
     368 
     369   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),unb_id) 
     370   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vnb_id) 
     371   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_interp_id) 
     372   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_interp_id) 
     373   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_update_id) 
     374   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_update_id) 
     375 
     376   CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id) 
     377 
     378# if defined key_zdftke 
     379   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/), en_id) 
     380   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id) 
     381   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avm_id) 
     382# endif 
    297383 
    298384   ! 2. Type of interpolation 
    299385   !------------------------- 
    300386   CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear) 
    301    CALL Agrif_Set_bcinterp(tsa_id,interp=AGRIF_linear) 
    302  
    303    Call Agrif_Set_bcinterp(un_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    304    Call Agrif_Set_bcinterp(vn_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
    305  
    306    Call Agrif_Set_bcinterp(ua_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    307    Call Agrif_Set_bcinterp(va_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
     387 
     388   CALL Agrif_Set_bcinterp(un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
     389   CALL Agrif_Set_bcinterp(vn_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
     390 
     391   CALL Agrif_Set_bcinterp(tsn_sponge_id,interp=AGRIF_linear) 
    308392 
    309393   CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_linear) 
    310    Call Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    311    Call Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
    312    Call Agrif_Set_bcinterp(ub2b_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    313    Call Agrif_Set_bcinterp(vb2b_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
     394   CALL Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
     395   CALL Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
     396   CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
     397   CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
     398 
     399 
     400   CALL Agrif_Set_bcinterp(un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
     401   CALL Agrif_Set_bcinterp(vn_sponge_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
     402 
     403   CALL Agrif_Set_bcinterp(e3t_id,interp=AGRIF_constant) 
     404   CALL Agrif_Set_bcinterp(umsk_id,interp=AGRIF_constant) 
     405   CALL Agrif_Set_bcinterp(vmsk_id,interp=AGRIF_constant) 
     406 
     407# if defined key_zdftke 
     408   CALL Agrif_Set_bcinterp(avm_id ,interp=AGRIF_linear) 
     409# endif 
     410 
    314411 
    315412   ! 3. Location of interpolation 
    316413   !----------------------------- 
    317    Call Agrif_Set_bc(un_id,(/0,1/)) 
    318    Call Agrif_Set_bc(vn_id,(/0,1/)) 
    319  
    320    Call Agrif_Set_bc(sshn_id,(/0,1/)) 
    321    Call Agrif_Set_bc(unb_id,(/0,1/)) 
    322    Call Agrif_Set_bc(vnb_id,(/0,1/)) 
    323    Call Agrif_Set_bc(ub2b_id,(/0,1/)) 
    324    Call Agrif_Set_bc(vb2b_id,(/0,1/)) 
    325  
    326    Call Agrif_Set_bc(tsn_id,(/0,1/)) 
    327    Call Agrif_Set_bc(tsa_id,(/-3*Agrif_irhox(),0/)) 
    328  
    329    Call Agrif_Set_bc(ua_id,(/-2*Agrif_irhox(),0/)) 
    330    Call Agrif_Set_bc(va_id,(/-2*Agrif_irhox(),0/)) 
     414   CALL Agrif_Set_bc(tsn_id,(/0,1/)) 
     415   CALL Agrif_Set_bc(un_interp_id,(/0,1/)) 
     416   CALL Agrif_Set_bc(vn_interp_id,(/0,1/)) 
     417 
     418!   CALL Agrif_Set_bc(tsn_sponge_id,(/-3*Agrif_irhox(),0/)) 
     419!   CALL Agrif_Set_bc(un_sponge_id,(/-2*Agrif_irhox()-1,0/)) 
     420!   CALL Agrif_Set_bc(vn_sponge_id,(/-2*Agrif_irhox()-1,0/)) 
     421   CALL Agrif_Set_bc(tsn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/)) 
     422   CALL Agrif_Set_bc(un_sponge_id ,(/-nn_sponge_len*Agrif_irhox()-1,0/)) 
     423   CALL Agrif_Set_bc(vn_sponge_id ,(/-nn_sponge_len*Agrif_irhox()-1,0/)) 
     424 
     425   CALL Agrif_Set_bc(sshn_id,(/0,0/)) 
     426   CALL Agrif_Set_bc(unb_id ,(/0,0/)) 
     427   CALL Agrif_Set_bc(vnb_id ,(/0,0/)) 
     428   CALL Agrif_Set_bc(ub2b_interp_id,(/0,0/)) 
     429   CALL Agrif_Set_bc(vb2b_interp_id,(/0,0/)) 
     430 
     431   CALL Agrif_Set_bc(e3t_id,(/-2*Agrif_irhox()-1,0/))   ! if west and rhox=3: column 2 to 9 
     432   CALL Agrif_Set_bc(umsk_id,(/0,0/)) 
     433   CALL Agrif_Set_bc(vmsk_id,(/0,0/)) 
     434 
     435# if defined key_zdftke 
     436   CALL Agrif_Set_bc(avm_id ,(/0,1/)) 
     437# endif 
    331438 
    332439   ! 5. Update type 
    333440   !---------------  
    334    Call Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average) 
    335    Call Agrif_Set_Updatetype(tsb_id, update = AGRIF_Update_Average) 
    336  
    337    Call Agrif_Set_Updatetype(sshn_id, update = AGRIF_Update_Average) 
    338    Call Agrif_Set_Updatetype(gcb_id,update = AGRIF_Update_Average) 
    339  
    340    Call Agrif_Set_Updatetype(un_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 
    341    Call Agrif_Set_Updatetype(vn_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 
    342  
    343    Call Agrif_Set_Updatetype(ub2b_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 
    344    Call Agrif_Set_Updatetype(vb2b_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 
    345  
     441   CALL Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average) 
     442 
     443   CALL Agrif_Set_Updatetype(scales_t_id, update = AGRIF_Update_Average) 
     444 
     445   CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 
     446   CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 
     447 
     448   CALL Agrif_Set_Updatetype(sshn_id, update = AGRIF_Update_Average) 
     449 
     450   CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 
     451   CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 
     452 
     453# if defined key_zdftke 
     454   CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Average) 
     455   CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Average) 
     456   CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Average) 
     457# endif 
     458 
     459! High order updates 
     460!   CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting) 
     461!   CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting) 
     462!   CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average) 
     463! 
     464!   CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting) 
     465!   CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average) 
     466!   CALL Agrif_Set_Updatetype(sshn_id, update = Agrif_Update_Full_Weighting) 
     467  
     468   ! 
    346469END SUBROUTINE agrif_declare_var 
    347470# endif 
     
    364487   IMPLICIT NONE 
    365488   ! 
    366    REAL(wp), DIMENSION(:,:)  , ALLOCATABLE :: zvel 
    367    REAL(wp), DIMENSION(:,:,:), ALLOCATABLE :: zadv 
    368    !!---------------------------------------------------------------------- 
    369  
    370    ALLOCATE( zvel(jpi,jpj), zadv(jpi,jpj,7)) 
     489   !!---------------------------------------------------------------------- 
    371490 
    372491   ! 1. Declaration of the type of variable which have to be interpolated 
     
    400519   CALL Agrif_Update_lim2(0) 
    401520   ! 
    402    DEALLOCATE( zvel, zadv ) 
    403    ! 
    404521END SUBROUTINE Agrif_InitValues_cont_lim2 
    405522 
     
    430547   !------------------------- 
    431548   CALL Agrif_Set_bcinterp(adv_ice_id ,interp=AGRIF_linear) 
    432    Call Agrif_Set_bcinterp(u_ice_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
    433    Call Agrif_Set_bcinterp(v_ice_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
     549   CALL Agrif_Set_bcinterp(u_ice_id,interp1=Agrif_linear,interp2=AGRIF_ppm) 
     550   CALL Agrif_Set_bcinterp(v_ice_id,interp1=AGRIF_ppm,interp2=Agrif_linear) 
    434551 
    435552   ! 3. Location of interpolation 
    436553   !----------------------------- 
    437    Call Agrif_Set_bc(adv_ice_id ,(/0,1/)) 
    438    Call Agrif_Set_bc(u_ice_id,(/0,1/)) 
    439    Call Agrif_Set_bc(v_ice_id,(/0,1/)) 
     554   CALL Agrif_Set_bc(adv_ice_id ,(/0,1/)) 
     555   CALL Agrif_Set_bc(u_ice_id,(/0,1/)) 
     556   CALL Agrif_Set_bc(v_ice_id,(/0,1/)) 
    440557 
    441558   ! 5. Update type 
    442559   !--------------- 
    443    Call Agrif_Set_Updatetype(adv_ice_id , update = AGRIF_Update_Average) 
    444    Call Agrif_Set_Updatetype(u_ice_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 
    445    Call Agrif_Set_Updatetype(v_ice_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 
    446  
     560   CALL Agrif_Set_Updatetype(adv_ice_id , update = AGRIF_Update_Average) 
     561   CALL Agrif_Set_Updatetype(u_ice_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average) 
     562   CALL Agrif_Set_Updatetype(v_ice_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy) 
     563   !  
    447564END SUBROUTINE agrif_declare_var_lim2 
    448565#  endif 
     
    461578   USE nemogcm 
    462579   USE par_trc 
     580   USE lib_mpp 
    463581   USE trc 
    464582   USE in_out_manager 
     583   USE agrif_opa_sponge 
    465584   USE agrif_top_update 
    466585   USE agrif_top_interp 
     
    469588   IMPLICIT NONE 
    470589   ! 
    471    REAL(wp), DIMENSION(:,:,:,:), ALLOCATABLE :: tabtrtemp 
     590   CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3 
    472591   LOGICAL :: check_namelist 
    473592   !!---------------------------------------------------------------------- 
    474  
    475    ALLOCATE( tabtrtemp(jpi,jpj,jpk,jptra) ) 
    476593 
    477594 
     
    484601   Agrif_SpecialValue=0. 
    485602   Agrif_UseSpecialValue = .TRUE. 
    486    Call Agrif_Bc_variable(tabtrtemp,trn_id,calledweight=1.,procname=interptrn) 
    487    Call Agrif_Bc_variable(tabtrtemp,tra_id,calledweight=1.,procname=interptrn) 
     603   CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn) 
    488604   Agrif_UseSpecialValue = .FALSE. 
     605   CALL Agrif_Sponge 
     606   tabspongedone_trn = .FALSE. 
     607   CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge) 
     608   ! reset tsa to zero 
     609   tra(:,:,:,:) = 0. 
     610 
    489611 
    490612   ! 3. Some controls 
    491613   !----------------- 
    492    check_namelist = .true. 
     614   check_namelist = .TRUE. 
    493615 
    494616   IF( check_namelist ) THEN 
    495 #  if defined offline      
     617# if defined key_offline 
    496618      ! Check time steps 
    497       IF( nint(Agrif_Rhot()) * nint(rdt) .ne. Agrif_Parent(rdt) ) THEN 
    498          WRITE(*,*) 'incompatible time step between grids' 
    499          WRITE(*,*) 'parent grid value : ',Agrif_Parent(rdt) 
    500          WRITE(*,*) 'child  grid value : ',nint(rdt) 
    501          WRITE(*,*) 'value on parent grid should be : ',rdt*Agrif_Rhot() 
    502          STOP 
     619      IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN 
     620         WRITE(cl_check1,*)  Agrif_Parent(rdt) 
     621         WRITE(cl_check2,*)  rdt 
     622         WRITE(cl_check3,*)  rdt*Agrif_Rhot() 
     623         CALL ctl_warn( 'incompatible time step between grids',   & 
     624               &               'parent grid value : '//cl_check1    ,   &  
     625               &               'child  grid value : '//cl_check2    ,   &  
     626               &               'value on child grid will be changed to  & 
     627               &               :'//cl_check3  ) 
     628         rdt=rdt*Agrif_Rhot() 
    503629      ENDIF 
    504630 
    505631      ! Check run length 
    506632      IF( Agrif_IRhot() * (Agrif_Parent(nitend)- & 
    507            Agrif_Parent(nit000)+1) .ne. (nitend-nit000+1) ) THEN 
    508          WRITE(*,*) 'incompatible run length between grids' 
    509          WRITE(*,*) 'parent grid value : ',(Agrif_Parent(nitend)- & 
    510               Agrif_Parent(nit000)+1),' time step' 
    511          WRITE(*,*) 'child  grid value : ', & 
    512               (nitend-nit000+1),' time step' 
    513          WRITE(*,*) 'value on child grid should be : ', & 
    514               Agrif_IRhot() * (Agrif_Parent(nitend)- & 
    515               Agrif_Parent(nit000)+1) 
    516          STOP 
     633            Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN 
     634         WRITE(cl_check1,*)  (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 
     635         WRITE(cl_check2,*)   Agrif_Parent(nitend)   *Agrif_IRhot() 
     636         CALL ctl_warn( 'incompatible run length between grids'               ,   & 
     637               &              ' nit000 on fine grid will be change to : '//cl_check1,   & 
     638               &              ' nitend on fine grid will be change to : '//cl_check2    ) 
     639         nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1 
     640         nitend =  Agrif_Parent(nitend)   *Agrif_IRhot() 
    517641      ENDIF 
    518642 
     
    520644      IF( ln_zps ) THEN 
    521645         ! check parameters for partial steps  
    522          IF( Agrif_Parent(e3zps_min) .ne. e3zps_min ) THEN 
     646         IF( Agrif_Parent(e3zps_min) .NE. e3zps_min ) THEN 
    523647            WRITE(*,*) 'incompatible e3zps_min between grids' 
    524648            WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min) 
     
    527651            STOP 
    528652         ENDIF 
    529          IF( Agrif_Parent(e3zps_rat) .ne. e3zps_rat ) THEN 
     653         IF( Agrif_Parent(e3zps_rat) .NE. e3zps_rat ) THEN 
    530654            WRITE(*,*) 'incompatible e3zps_rat between grids' 
    531655            WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat) 
     
    537661#  endif          
    538662      ! Check passive tracer cell 
    539       IF( nn_dttrc .ne. 1 ) THEN 
     663      IF( nn_dttrc .NE. 1 ) THEN 
    540664         WRITE(*,*) 'nn_dttrc should be equal to 1' 
    541665      ENDIF 
    542666   ENDIF 
    543667 
    544 !ch   CALL Agrif_Update_trc(0) 
     668   CALL Agrif_Update_trc(0) 
     669   ! 
     670   Agrif_UseSpecialValueInUpdate = .FALSE. 
    545671   nbcline_trc = 0 
    546    ! 
    547    DEALLOCATE(tabtrtemp) 
    548672   ! 
    549673END SUBROUTINE Agrif_InitValues_cont_top 
     
    557681   !!---------------------------------------------------------------------- 
    558682   USE agrif_util 
     683   USE agrif_oce 
    559684   USE dom_oce 
    560685   USE trc 
     
    564689   ! 1. Declaration of the type of variable which have to be interpolated 
    565690   !--------------------------------------------------------------------- 
    566    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) 
    567    CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trb_id) 
    568    CALL agrif_declare_variable((/2,2,0,0/),(/3,3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),tra_id) 
     691   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) 
     692   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) 
    569693 
    570694   ! 2. Type of interpolation 
    571695   !------------------------- 
    572696   CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear) 
    573    CALL Agrif_Set_bcinterp(tra_id,interp=AGRIF_linear) 
     697   CALL Agrif_Set_bcinterp(trn_sponge_id,interp=AGRIF_linear) 
    574698 
    575699   ! 3. Location of interpolation 
    576700   !----------------------------- 
    577    Call Agrif_Set_bc(trn_id,(/0,1/)) 
    578    Call Agrif_Set_bc(tra_id,(/-3*Agrif_irhox(),0/)) 
     701   CALL Agrif_Set_bc(trn_id,(/0,1/)) 
     702!   CALL Agrif_Set_bc(trn_sponge_id,(/-3*Agrif_irhox(),0/)) 
     703   CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/)) 
    579704 
    580705   ! 5. Update type 
    581706   !---------------  
    582    Call Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average) 
    583    Call Agrif_Set_Updatetype(trb_id, update = AGRIF_Update_Average) 
    584  
    585  
     707   CALL Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average) 
     708 
     709!   Higher order update 
     710!   CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting) 
     711 
     712   ! 
    586713END SUBROUTINE agrif_declare_var_top 
    587714# endif 
     
    591718   !!   *** ROUTINE Agrif_detect *** 
    592719   !!---------------------------------------------------------------------- 
    593    USE Agrif_Types 
    594720   ! 
    595721   INTEGER, DIMENSION(2) :: ksizex 
     
    613739   ! 
    614740   INTEGER  ::   ios                 ! Local integer output status for namelist read 
    615    NAMELIST/namagrif/ nn_cln_update, rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn 
    616    !!---------------------------------------------------------------------- 
    617    ! 
    618       REWIND( numnam_ref )              ! Namelist namagrif in reference namelist : AGRIF zoom 
    619       READ  ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901) 
    620 901   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in reference namelist', lwp ) 
    621  
    622       REWIND( numnam_cfg )              ! Namelist namagrif in configuration namelist : AGRIF zoom 
    623       READ  ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 ) 
    624 902   IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in configuration namelist', lwp ) 
    625       IF(lwm) WRITE ( numond, namagrif ) 
     741   INTEGER  ::   iminspon 
     742   NAMELIST/namagrif/ nn_cln_update, rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn, ln_chk_bathy 
     743   !!-------------------------------------------------------------------------------------- 
     744   ! 
     745   REWIND( numnam_ref )              ! Namelist namagrif in reference namelist : AGRIF zoom 
     746   READ  ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901) 
     747901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in reference namelist', lwp ) 
     748 
     749   REWIND( numnam_cfg )              ! Namelist namagrif in configuration namelist : AGRIF zoom 
     750   READ  ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 ) 
     751902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in configuration namelist', lwp ) 
     752   IF(lwm) WRITE ( numond, namagrif ) 
    626753   ! 
    627754   IF(lwp) THEN                    ! control print 
     
    634761      WRITE(numout,*) '      sponge coefficient for dynamics   rn_sponge_tra = ', rn_sponge_dyn, ' s' 
    635762      WRITE(numout,*) '      use special values for dynamics   ln_spc_dyn    = ', ln_spc_dyn 
     763      WRITE(numout,*) '      check bathymetry                  ln_chk_bathy  = ', ln_chk_bathy 
    636764      WRITE(numout,*)  
    637765   ENDIF 
     
    642770   visc_dyn      = rn_sponge_dyn 
    643771   ! 
    644    IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif sol_oce_alloc: allocation of arrays failed') 
     772   ! Check sponge length: 
     773   iminspon = MIN(FLOOR(REAL(jpiglo-4)/REAL(2*Agrif_irhox())), FLOOR(REAL(jpjglo-4)/REAL(2*Agrif_irhox())) ) 
     774   IF (lk_mpp) iminspon = MIN(iminspon,FLOOR(REAL(jpi-2)/REAL(Agrif_irhox())), FLOOR(REAL(jpj-2)/REAL(Agrif_irhox())) ) 
     775   IF (nn_sponge_len > iminspon)  CALL ctl_stop('agrif sponge length is too large') 
     776   ! 
     777   IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed') 
    645778# if defined key_lim2 
    646779   IF( agrif_ice_alloc()  > 0 )   CALL ctl_stop('agrif agrif_ice_alloc: allocation of arrays failed') 
     
    663796   SELECT CASE( i ) 
    664797   CASE(1)   ;   indglob = indloc + nimppt(nprocloc+1) - 1 
    665    CASE(2)   ;   indglob = indloc + njmppt(nprocloc+1) - 1  
    666    CASE(3)   ;   indglob = indloc 
    667    CASE(4)   ;   indglob = indloc 
     798   CASE(2)   ;   indglob = indloc + njmppt(nprocloc+1) - 1 
     799   CASE DEFAULT 
     800      indglob = indloc 
    668801   END SELECT 
    669802   ! 
    670803END SUBROUTINE Agrif_InvLoc 
     804 
     805SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax ) 
     806   !!---------------------------------------------------------------------- 
     807   !!                 *** ROUTINE Agrif_get_proc_info *** 
     808   !!---------------------------------------------------------------------- 
     809   USE par_oce 
     810   IMPLICIT NONE 
     811   ! 
     812   INTEGER, INTENT(out) :: imin, imax 
     813   INTEGER, INTENT(out) :: jmin, jmax 
     814   !!---------------------------------------------------------------------- 
     815   ! 
     816   imin = nimppt(Agrif_Procrank+1)  ! ????? 
     817   jmin = njmppt(Agrif_Procrank+1)  ! ????? 
     818   imax = imin + jpi - 1 
     819   jmax = jmin + jpj - 1 
     820   !  
     821END SUBROUTINE Agrif_get_proc_info 
     822 
     823SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost) 
     824   !!---------------------------------------------------------------------- 
     825   !!                 *** ROUTINE Agrif_estimate_parallel_cost *** 
     826   !!---------------------------------------------------------------------- 
     827   USE par_oce 
     828   IMPLICIT NONE 
     829   ! 
     830   INTEGER,  INTENT(in)  :: imin, imax 
     831   INTEGER,  INTENT(in)  :: jmin, jmax 
     832   INTEGER,  INTENT(in)  :: nbprocs 
     833   REAL(wp), INTENT(out) :: grid_cost 
     834   !!---------------------------------------------------------------------- 
     835   ! 
     836   grid_cost = REAL(imax-imin+1,wp)*REAL(jmax-jmin+1,wp) / REAL(nbprocs,wp) 
     837   ! 
     838END SUBROUTINE Agrif_estimate_parallel_cost 
    671839 
    672840# endif 
Note: See TracChangeset for help on using the changeset viewer.