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.
agrif_user.F90 in branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/NST_SRC – NEMO

source: branches/2016/dev_v3_6_STABLE_r6506_AGRIF_LIM3/NEMOGCM/NEMO/NST_SRC/agrif_user.F90 @ 8260

Last change on this file since 8260 was 7762, checked in by clem, 7 years ago

cosmetic changes

  • Property svn:keywords set to Id
File size: 37.4 KB
RevLine 
[393]1#if defined key_agrif
[3680]2!!----------------------------------------------------------------------
[7379]3!! NEMO/NST 3.7 , NEMO Consortium (2016)
[3680]4!! $Id$
5!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
6!!----------------------------------------------------------------------
7SUBROUTINE agrif_user
8END SUBROUTINE agrif_user
9
10SUBROUTINE agrif_before_regridding
11END SUBROUTINE agrif_before_regridding
12
13SUBROUTINE Agrif_InitWorkspace
[1156]14   !!----------------------------------------------------------------------
[3680]15   !!                 *** ROUTINE Agrif_InitWorkspace ***
[1156]16   !!----------------------------------------------------------------------
[3680]17   USE par_oce
18   USE dom_oce
19   USE nemogcm
[7510]20   !!
[3680]21   IMPLICIT NONE
22   !!----------------------------------------------------------------------
23   !
24   IF( .NOT. Agrif_Root() ) THEN
25      jpni = Agrif_Parent(jpni)
26      jpnj = Agrif_Parent(jpnj)
27      jpnij = Agrif_Parent(jpnij)
28      jpiglo  = nbcellsx + 2 + 2*nbghostcells
29      jpjglo  = nbcellsy + 2 + 2*nbghostcells
30      jpi     = ( jpiglo-2*jpreci + (jpni-1+0) ) / jpni + 2*jpreci
31      jpj     = ( jpjglo-2*jprecj + (jpnj-1+0) ) / jpnj + 2*jprecj
[6204]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
[7757]37# if defined key_sas2D
38      jpkm1   = 1
39# else
40      jpkm1   = jpk-1
41# endif
[4147]42      jpim1   = jpi-1 
43      jpjm1   = jpj-1 
44      jpij    = jpi*jpj 
[3680]45      jpidta  = jpiglo
46      jpjdta  = jpjglo
47      jpizoom = 1
48      jpjzoom = 1
49      nperio  = 0
50      jperio  = 0
51   ENDIF
52   !
53END SUBROUTINE Agrif_InitWorkspace
[1156]54
[390]55
[3680]56SUBROUTINE Agrif_InitValues
57   !!----------------------------------------------------------------------
58   !!                 *** ROUTINE Agrif_InitValues ***
59   !!
60   !! ** Purpose :: Declaration of variables to be interpolated
61   !!----------------------------------------------------------------------
62   USE Agrif_Util
63   USE oce 
64   USE dom_oce
65   USE nemogcm
66   USE tradmp
67   USE bdy_par
[1300]68
[3680]69   IMPLICIT NONE
70   !!----------------------------------------------------------------------
71   ! 0. Initializations
72   !-------------------
[6204]73   IF( cp_cfg == 'orca' ) THEN
[4147]74      IF ( jp_cfg == 2 .OR. jp_cfg == 025 .OR. jp_cfg == 05 &
[6204]75            &                      .OR. jp_cfg == 4 ) THEN
[4147]76         jp_cfg = -1    ! set special value for jp_cfg on fine grids
77         cp_cfg = "default"
78      ENDIF
79   ENDIF
[3680]80   ! Specific fine grid Initializations
81   ! no tracer damping on fine grids
82   ln_tradmp = .FALSE.
83   ! no open boundary on fine grids
84   lk_bdy = .FALSE.
[2031]85
[4147]86
[3680]87   CALL nemo_init  ! Initializations of each fine grid
[4147]88
[3680]89   CALL agrif_nemo_init
90   CALL Agrif_InitValues_cont_dom
[2715]91# if ! defined key_offline
[3680]92   CALL Agrif_InitValues_cont
[2715]93# endif       
94# if defined key_top
[3680]95   CALL Agrif_InitValues_cont_top
[7510]96# endif
[7757]97# if defined key_lim3
98   CALL Agrif_InitValues_cont_lim3
99# endif
[7510]100   !
[3680]101END SUBROUTINE Agrif_initvalues
[2031]102
[3680]103
104SUBROUTINE Agrif_InitValues_cont_dom
105   !!----------------------------------------------------------------------
106   !!                 *** ROUTINE Agrif_InitValues_cont ***
107   !!
108   !! ** Purpose ::   Declaration of variables to be interpolated
109   !!----------------------------------------------------------------------
110   USE Agrif_Util
111   USE oce 
112   USE dom_oce
113   USE nemogcm
114   USE sol_oce
115   USE in_out_manager
116   USE agrif_opa_update
117   USE agrif_opa_interp
118   USE agrif_opa_sponge
[7510]119   !!
[3680]120   IMPLICIT NONE
[7510]121   !!----------------------------------------------------------------------
[3680]122   !
123   ! Declaration of the type of variable which have to be interpolated
[7510]124   !
[3680]125   CALL agrif_declare_var_dom
126   !
127END SUBROUTINE Agrif_InitValues_cont_dom
128
129
130SUBROUTINE agrif_declare_var_dom
131   !!----------------------------------------------------------------------
[6204]132   !!                 *** ROUTINE agrif_declare_var ***
[3680]133   !!
134   !! ** Purpose :: Declaration of variables to be interpolated
135   !!----------------------------------------------------------------------
136   USE agrif_util
[6204]137   USE par_oce       
[3680]138   USE oce
[7510]139   !!
[3680]140   IMPLICIT NONE
141   !!----------------------------------------------------------------------
142
143   ! 1. Declaration of the type of variable which have to be interpolated
144   !---------------------------------------------------------------------
[6204]145   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e1u_id)
146   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e2v_id)
[3680]147
148   ! 2. Type of interpolation
149   !-------------------------
[6204]150   CALL Agrif_Set_bcinterp(e1u_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
151   CALL Agrif_Set_bcinterp(e2v_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
[3680]152
153   ! 3. Location of interpolation
154   !-----------------------------
[6204]155   CALL Agrif_Set_bc(e1u_id,(/0,0/))
156   CALL Agrif_Set_bc(e2v_id,(/0,0/))
[3680]157
158   ! 5. Update type
159   !---------------
[6204]160   CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average)
161   CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy)
[3680]162
[6204]163! High order updates
164!   CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Average,            update2=Agrif_Update_Full_Weighting)
165!   CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Full_Weighting,     update2=Agrif_Update_Average)
166    !
[3680]167END SUBROUTINE agrif_declare_var_dom
168
169
[2715]170# if ! defined key_offline
[390]171
[3680]172SUBROUTINE Agrif_InitValues_cont
173   !!----------------------------------------------------------------------
174   !!                 *** ROUTINE Agrif_InitValues_cont ***
175   !!
176   !! ** Purpose ::   Declaration of variables to be interpolated
177   !!----------------------------------------------------------------------
178   USE Agrif_Util
179   USE oce 
180   USE dom_oce
181   USE nemogcm
182   USE sol_oce
[6204]183   USE lib_mpp
[3680]184   USE in_out_manager
185   USE agrif_opa_update
186   USE agrif_opa_interp
187   USE agrif_opa_sponge
[7510]188   !!
[3680]189   IMPLICIT NONE
190   !
191   LOGICAL :: check_namelist
[6204]192   CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3
[3680]193   !!----------------------------------------------------------------------
[390]194
[3680]195   ! 1. Declaration of the type of variable which have to be interpolated
196   !---------------------------------------------------------------------
197   CALL agrif_declare_var
[636]198
[3680]199   ! 2. First interpolations of potentially non zero fields
200   !-------------------------------------------------------
201   Agrif_SpecialValue=0.
202   Agrif_UseSpecialValue = .TRUE.
[6204]203   CALL Agrif_Bc_variable(tsn_id,calledweight=1.,procname=interptsn)
204   CALL Agrif_Sponge
205   tabspongedone_tsn = .FALSE.
206   CALL Agrif_Bc_variable(tsn_sponge_id,calledweight=1.,procname=interptsn_sponge)
207   ! reset tsa to zero
208   tsa(:,:,:,:) = 0.
[390]209
[6204]210   Agrif_UseSpecialValue = ln_spc_dyn
211   CALL Agrif_Bc_variable(un_interp_id,calledweight=1.,procname=interpun)
212   CALL Agrif_Bc_variable(vn_interp_id,calledweight=1.,procname=interpvn)
213   tabspongedone_u = .FALSE.
214   tabspongedone_v = .FALSE.
215   CALL Agrif_Bc_variable(un_sponge_id,calledweight=1.,procname=interpun_sponge)
216   tabspongedone_u = .FALSE.
217   tabspongedone_v = .FALSE.
218   CALL Agrif_Bc_variable(vn_sponge_id,calledweight=1.,procname=interpvn_sponge)
[4326]219
[6204]220#if defined key_dynspg_ts
221   Agrif_UseSpecialValue = .TRUE.
222   CALL Agrif_Bc_variable(sshn_id,calledweight=1., procname=interpsshn )
[628]223
[6204]224   Agrif_UseSpecialValue = ln_spc_dyn
225   CALL Agrif_Bc_variable(unb_id,calledweight=1.,procname=interpunb)
226   CALL Agrif_Bc_variable(vnb_id,calledweight=1.,procname=interpvnb)
227   CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b)
228   CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b)
229   ubdy_w(:) = 0.e0 ; vbdy_w(:) = 0.e0 ; hbdy_w(:) =0.e0
230   ubdy_e(:) = 0.e0 ; vbdy_e(:) = 0.e0 ; hbdy_e(:) =0.e0 
231   ubdy_n(:) = 0.e0 ; vbdy_n(:) = 0.e0 ; hbdy_n(:) =0.e0 
232   ubdy_s(:) = 0.e0 ; vbdy_s(:) = 0.e0 ; hbdy_s(:) =0.e0
233#endif
234
235   Agrif_UseSpecialValue = .FALSE. 
236   ! reset velocities to zero
237   ua(:,:,:) = 0.
238   va(:,:,:) = 0.
239
[3680]240   ! 3. Some controls
241   !-----------------
[6204]242   check_namelist = .TRUE.
[3680]243
[6204]244   IF( check_namelist ) THEN 
[3680]245
246      ! Check time steps           
[6204]247      IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN
248         WRITE(cl_check1,*)  NINT(Agrif_Parent(rdt))
249         WRITE(cl_check2,*)  NINT(rdt)
250         WRITE(cl_check3,*)  NINT(Agrif_Parent(rdt)/Agrif_Rhot())
[7158]251         CALL ctl_stop( 'incompatible time step between ocean grids',   &
[6204]252               &               'parent grid value : '//cl_check1    ,   & 
253               &               'child  grid value : '//cl_check2    ,   & 
[7158]254               &               'value on child grid should be changed to : '//cl_check3 )
[3680]255      ENDIF
256
257      ! Check run length
258      IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
[6204]259            Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN
260         WRITE(cl_check1,*)  (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
261         WRITE(cl_check2,*)   Agrif_Parent(nitend)   *Agrif_IRhot()
262         CALL ctl_warn( 'incompatible run length between grids'               ,   &
263               &              ' nit000 on fine grid will be change to : '//cl_check1,   &
264               &              ' nitend on fine grid will be change to : '//cl_check2    )
265         nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
266         nitend =  Agrif_Parent(nitend)   *Agrif_IRhot()
[3680]267      ENDIF
268
269      ! Check coordinates
270      IF( ln_zps ) THEN
271         ! check parameters for partial steps
[6204]272         IF( Agrif_Parent(e3zps_min) .NE. e3zps_min ) THEN
[3680]273            WRITE(*,*) 'incompatible e3zps_min between grids'
274            WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min)
275            WRITE(*,*) 'child grid  :',e3zps_min
276            WRITE(*,*) 'those values should be identical'
[636]277            STOP
278         ENDIF
[3680]279         IF( Agrif_Parent(e3zps_rat) /= e3zps_rat ) THEN
280            WRITE(*,*) 'incompatible e3zps_rat between grids'
281            WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat)
282            WRITE(*,*) 'child grid  :',e3zps_rat
283            WRITE(*,*) 'those values should be identical'                 
[636]284            STOP
285         ENDIF
[390]286      ENDIF
[7510]287
[6204]288      ! check if masks and bathymetries match
289      IF(ln_chk_bathy) THEN
290         !
291         IF(lwp) WRITE(numout,*) 'AGRIF: Check Bathymetry and masks near bdys. Level: ', Agrif_Level()
292         !
293         kindic_agr = 0
294         ! check if umask agree with parent along western and eastern boundaries:
295         CALL Agrif_Bc_variable(umsk_id,calledweight=1.,procname=interpumsk)
296         ! check if vmask agree with parent along northern and southern boundaries:
297         CALL Agrif_Bc_variable(vmsk_id,calledweight=1.,procname=interpvmsk)
[7757]298         ! check if tmask and vertical scale factors agree with parent over first two coarse grid points:
[6204]299         CALL Agrif_Bc_variable(e3t_id,calledweight=1.,procname=interpe3t)
300         !
301         IF (lk_mpp) CALL mpp_sum( kindic_agr )
[7757]302         IF( kindic_agr /= 0 ) THEN
[6204]303            CALL ctl_stop('Child Bathymetry is not correct near boundaries.')
304         ELSE
305            IF(lwp) WRITE(numout,*) 'Child Bathymetry is ok near boundaries.'
306         END IF
307      ENDIF
308      !
[3680]309   ENDIF
[6204]310   !
311   ! Do update at initialisation because not done before writing restarts
312   ! This would indeed change boundary conditions values at initial time
313   ! hence produce restartability issues.
314   ! Note that update below is recursive (with lk_agrif_doupd=T):
315   !
316! JC: I am not sure if Agrif_MaxLevel() is the "relative"
317!     or the absolute maximum nesting level...TBC                       
318   IF ( Agrif_Level().EQ.Agrif_MaxLevel() ) THEN 
319      ! NB: Do tracers first, dynamics after because nbcline incremented in dynamics
320      CALL Agrif_Update_tra()
321      CALL Agrif_Update_dyn()
322   ENDIF
323   !
324# if defined key_zdftke
[7379]325   CALL Agrif_Update_tke(0)
[6204]326# endif
327   !
328   Agrif_UseSpecialValueInUpdate = .FALSE.
[3680]329   nbcline = 0
[6204]330   lk_agrif_doupd = .FALSE.
[3680]331   !
332END SUBROUTINE Agrif_InitValues_cont
[1605]333
[3294]334
[3680]335SUBROUTINE agrif_declare_var
336   !!----------------------------------------------------------------------
337   !!                 *** ROUTINE agrif_declarE_var ***
338   !!
339   !! ** Purpose :: Declaration of variables to be interpolated
340   !!----------------------------------------------------------------------
341   USE agrif_util
342   USE par_oce       !   ONLY : jpts
343   USE oce
[6204]344   USE agrif_oce
[7510]345   !!
[3680]346   IMPLICIT NONE
347   !!----------------------------------------------------------------------
[2715]348
[3680]349   ! 1. Declaration of the type of variable which have to be interpolated
350   !---------------------------------------------------------------------
[6204]351   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)
352   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)
[2715]353
[6204]354   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_interp_id)
355   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_interp_id)
356   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_update_id)
357   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_update_id)
358   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),un_sponge_id)
359   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vn_sponge_id)
[2715]360
[6204]361   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id)
362   CALL agrif_declare_variable((/1,2,0/),(/2,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),umsk_id)
363   CALL agrif_declare_variable((/2,1,0/),(/3,2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vmsk_id)
[2715]364
[6204]365   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)
366
367   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),unb_id)
368   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vnb_id)
369   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_interp_id)
370   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_interp_id)
371   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_update_id)
372   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_update_id)
373
374   CALL agrif_declare_variable((/2,2/),(/3,3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id)
375
376# if defined key_zdftke
377   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/), en_id)
378   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id)
379   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avm_id)
380# endif
381
[3680]382   ! 2. Type of interpolation
383   !-------------------------
384   CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear)
[2715]385
[6204]386   CALL Agrif_Set_bcinterp(un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
387   CALL Agrif_Set_bcinterp(vn_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
[2715]388
[6204]389   CALL Agrif_Set_bcinterp(tsn_sponge_id,interp=AGRIF_linear)
[2715]390
[4326]391   CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_linear)
[6204]392   CALL Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
393   CALL Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
394   CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
395   CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
[4326]396
[6204]397
398   CALL Agrif_Set_bcinterp(un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
399   CALL Agrif_Set_bcinterp(vn_sponge_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
400
401   CALL Agrif_Set_bcinterp(e3t_id,interp=AGRIF_constant)
402   CALL Agrif_Set_bcinterp(umsk_id,interp=AGRIF_constant)
403   CALL Agrif_Set_bcinterp(vmsk_id,interp=AGRIF_constant)
404
405# if defined key_zdftke
406   CALL Agrif_Set_bcinterp(avm_id ,interp=AGRIF_linear)
407# endif
408
409
[3680]410   ! 3. Location of interpolation
411   !-----------------------------
[6204]412   CALL Agrif_Set_bc(tsn_id,(/0,1/))
413   CALL Agrif_Set_bc(un_interp_id,(/0,1/))
414   CALL Agrif_Set_bc(vn_interp_id,(/0,1/))
[2715]415
[6204]416!   CALL Agrif_Set_bc(tsn_sponge_id,(/-3*Agrif_irhox(),0/))
417!   CALL Agrif_Set_bc(un_sponge_id,(/-2*Agrif_irhox()-1,0/))
418!   CALL Agrif_Set_bc(vn_sponge_id,(/-2*Agrif_irhox()-1,0/))
419   CALL Agrif_Set_bc(tsn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/))
420   CALL Agrif_Set_bc(un_sponge_id ,(/-nn_sponge_len*Agrif_irhox()-1,0/))
421   CALL Agrif_Set_bc(vn_sponge_id ,(/-nn_sponge_len*Agrif_irhox()-1,0/))
[4326]422
[6204]423   CALL Agrif_Set_bc(sshn_id,(/0,0/))
424   CALL Agrif_Set_bc(unb_id ,(/0,0/))
425   CALL Agrif_Set_bc(vnb_id ,(/0,0/))
426   CALL Agrif_Set_bc(ub2b_interp_id,(/0,0/))
427   CALL Agrif_Set_bc(vb2b_interp_id,(/0,0/))
[2715]428
[6204]429   CALL Agrif_Set_bc(e3t_id,(/-2*Agrif_irhox()-1,0/))   ! if west and rhox=3: column 2 to 9
430   CALL Agrif_Set_bc(umsk_id,(/0,0/))
431   CALL Agrif_Set_bc(vmsk_id,(/0,0/))
[2715]432
[6204]433# if defined key_zdftke
434   CALL Agrif_Set_bc(avm_id ,(/0,1/))
435# endif
436
[3680]437   ! 5. Update type
438   !---------------
[6204]439   CALL Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average)
[2715]440
[6204]441   CALL Agrif_Set_Updatetype(scales_t_id, update = AGRIF_Update_Average)
[2715]442
[6204]443   CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
444   CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
[3680]445
[6204]446   CALL Agrif_Set_Updatetype(sshn_id, update = AGRIF_Update_Average)
[4486]447
[6204]448   CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
449   CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
450
451# if defined key_zdftke
452   CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Average)
453   CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Average)
454   CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Average)
455# endif
456
457! High order updates
458!   CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting)
459!   CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting)
460!   CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average)
461!
462!   CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting)
463!   CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average)
464!   CALL Agrif_Set_Updatetype(sshn_id, update = Agrif_Update_Full_Weighting)
[7060]465
[6204]466   !
[3680]467END SUBROUTINE agrif_declare_var
[2715]468# endif
[3680]469
470#  if defined key_lim2
471SUBROUTINE Agrif_InitValues_cont_lim2
472   !!----------------------------------------------------------------------
473   !!                 *** ROUTINE Agrif_InitValues_cont_lim2 ***
474   !!
475   !! ** Purpose :: Initialisation of variables to be interpolated for LIM2
476   !!----------------------------------------------------------------------
477   USE Agrif_Util
478   USE ice_2
479   USE agrif_ice
480   USE in_out_manager
481   USE agrif_lim2_update
482   USE agrif_lim2_interp
483   USE lib_mpp
[7510]484   !!
[3680]485   IMPLICIT NONE
486   !!----------------------------------------------------------------------
487
488   ! 1. Declaration of the type of variable which have to be interpolated
489   !---------------------------------------------------------------------
490   CALL agrif_declare_var_lim2
491
492   ! 2. First interpolations of potentially non zero fields
493   !-------------------------------------------------------
494   Agrif_SpecialValue=-9999.
495   Agrif_UseSpecialValue = .TRUE.
496   !     Call Agrif_Bc_variable(zadv ,adv_ice_id ,calledweight=1.,procname=interp_adv_ice )
497   !     Call Agrif_Bc_variable(zvel ,u_ice_id   ,calledweight=1.,procname=interp_u_ice   )
498   !     Call Agrif_Bc_variable(zvel ,v_ice_id   ,calledweight=1.,procname=interp_v_ice   )
499   Agrif_SpecialValue=0.
500   Agrif_UseSpecialValue = .FALSE.
501
502   ! 3. Some controls
503   !-----------------
504
505#   if ! defined key_lim2_vp
506   lim_nbstep = 1.
507   CALL agrif_rhg_lim2_load
508   CALL agrif_trp_lim2_load
509   lim_nbstep = 0.
510#   endif
511   !RB mandatory but why ???
512   !      IF( nbclineupdate /= nn_fsbc .AND. nn_ice == 2 )THEN
513   !         CALL ctl_warn ('With ice model on child grid, nbclineupdate is set to nn_fsbc')
514   !         nbclineupdate = nn_fsbc
515   !       ENDIF
516   CALL Agrif_Update_lim2(0)
517   !
518END SUBROUTINE Agrif_InitValues_cont_lim2
519
[7510]520
[3680]521SUBROUTINE agrif_declare_var_lim2
522   !!----------------------------------------------------------------------
523   !!                 *** ROUTINE agrif_declare_var_lim2 ***
524   !!
525   !! ** Purpose :: Declaration of variables to be interpolated for LIM2
526   !!----------------------------------------------------------------------
527   USE agrif_util
528   USE ice_2
[7510]529   !!
[3680]530   IMPLICIT NONE
531   !!----------------------------------------------------------------------
532
533   ! 1. Declaration of the type of variable which have to be interpolated
534   !---------------------------------------------------------------------
535   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj, 7/),adv_ice_id )
536#   if defined key_lim2_vp
537   CALL agrif_declare_variable((/1,1/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),u_ice_id)
538   CALL agrif_declare_variable((/1,1/),(/3,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),v_ice_id)
539#   else
540   CALL agrif_declare_variable((/1,2/),(/2,3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),u_ice_id)
541   CALL agrif_declare_variable((/2,1/),(/3,2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),v_ice_id)
542#   endif
543
544   ! 2. Type of interpolation
545   !-------------------------
546   CALL Agrif_Set_bcinterp(adv_ice_id ,interp=AGRIF_linear)
[6204]547   CALL Agrif_Set_bcinterp(u_ice_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
548   CALL Agrif_Set_bcinterp(v_ice_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
[3680]549
550   ! 3. Location of interpolation
551   !-----------------------------
[6204]552   CALL Agrif_Set_bc(adv_ice_id ,(/0,1/))
553   CALL Agrif_Set_bc(u_ice_id,(/0,1/))
554   CALL Agrif_Set_bc(v_ice_id,(/0,1/))
[3680]555
556   ! 5. Update type
557   !---------------
[6204]558   CALL Agrif_Set_Updatetype(adv_ice_id , update = AGRIF_Update_Average)
559   CALL Agrif_Set_Updatetype(u_ice_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
560   CALL Agrif_Set_Updatetype(v_ice_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
561   !
[3680]562END SUBROUTINE agrif_declare_var_lim2
563#  endif
564
[6584]565#if defined key_lim3
566SUBROUTINE Agrif_InitValues_cont_lim3
567   !!----------------------------------------------------------------------
568   !!                 *** ROUTINE Agrif_InitValues_cont_lim3 ***
569   !!
570   !! ** Purpose :: Initialisation of variables to be interpolated for LIM3
571   !!----------------------------------------------------------------------
572   USE Agrif_Util
[7158]573   USE sbc_oce, ONLY : nn_fsbc  ! clem: necessary otherwise Agrif_Parent(nn_fsbc) = nn_fsbc
[6584]574   USE ice
575   USE agrif_ice
576   USE in_out_manager
577   USE agrif_lim3_update
578   USE agrif_lim3_interp
579   USE lib_mpp
580   !
581   IMPLICIT NONE
582   !!----------------------------------------------------------------------
583   !
584   ! Declaration of the type of variable which have to be interpolated (parent=>child)
585   !----------------------------------------------------------------------------------
586   CALL agrif_declare_var_lim3
[3680]587
[7757]588   ! Controls
589
590   ! clem: For some reason, nn_fsbc(child)/=1 does not work properly (signal is largely degraded by the agrif zoom)
591   !          the run must satisfy CFL=Uice/(dx/dt) < 0.6/nn_fsbc(child)
592   !          therefore, if nn_fsbc(child)>1 one must reduce the time-step in proportion to nn_fsbc(child), which is not acceptable
593   !       If a solution is found, the following stop could be removed
594   IF( nn_fsbc > 1 )  CALL ctl_stop('nn_fsbc(child) must be set to 1 otherwise agrif and lim3 do not work properly')
595
[7158]596   ! stop if rhot * nn_fsbc(parent) /= N * nn_fsbc(child) with N being integer
[6584]597   IF( MOD( Agrif_irhot() * Agrif_Parent(nn_fsbc), nn_fsbc ) /= 0 )  THEN
[7158]598      CALL ctl_stop('rhot * nn_fsbc(parent) /= N * nn_fsbc(child), therefore nn_fsbc(child) should be set to 1 or nn_fsbc(parent)')
[6584]599   ENDIF
600
[7158]601   ! stop if update frequency is different from nn_fsbc
602   IF( nbclineupdate > nn_fsbc )  CALL ctl_stop('With ice model on child grid, nn_cln_update should be set to 1 or nn_fsbc')
[6584]603
[7158]604
[6584]605   ! First Interpolations (using "after" ice subtime step => lim_nbstep=1)
606   !----------------------------------------------------------------------
[7762]607!!   lim_nbstep = 1
[7757]608   lim_nbstep = ( Agrif_irhot() * Agrif_Parent(nn_fsbc) / nn_fsbc ) ! clem: to have calledweight=1 in interp (otherwise the western border of the zoom is wrong)
[6584]609   CALL agrif_interp_lim3('U') ! interpolation of ice velocities
610   CALL agrif_interp_lim3('V') ! interpolation of ice velocities
611   CALL agrif_interp_lim3('T') ! interpolation of ice tracers
[7762]612   lim_nbstep = 0
[6584]613   
614   ! Update in case 2 ways
615   !----------------------
616   CALL agrif_update_lim3(0)
[7158]617
[6584]618   !
619END SUBROUTINE Agrif_InitValues_cont_lim3
620
621SUBROUTINE agrif_declare_var_lim3
622   !!----------------------------------------------------------------------
623   !!                 *** ROUTINE agrif_declare_var_lim3 ***
624   !!
625   !! ** Purpose :: Declaration of variables to be interpolated for LIM3
626   !!----------------------------------------------------------------------
[7060]627   USE Agrif_Util
[6584]628   USE ice
629
630   IMPLICIT NONE
631   !!----------------------------------------------------------------------
632   !
633   ! 1. Declaration of the type of variable which have to be interpolated (parent=>child)
634   !       agrif_declare_variable(position,1st point index,--,--,dimensions,name)
[7757]635   !           ex.:  position=> 1,1 = not-centered (in i and j)
636   !                            2,2 =     centered (    -     )
637   !                 index   => 1,1 = one ghost line
638   !                            2,2 = two ghost lines
[6584]639   !-------------------------------------------------------------------------------------
[7060]640   CALL agrif_declare_variable((/2,2,0/),(/3,3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpl*(5+nlay_s+nlay_i)/),tra_ice_id )
641   CALL agrif_declare_variable((/1,2/)    ,(/2,3/),(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,u_ice_id   )
642   CALL agrif_declare_variable((/2,1/)    ,(/3,2/),(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,v_ice_id   )
[6584]643
644   ! 2. Set interpolations (normal & tangent to the grid cell for velocities)
645   !-----------------------------------
646   CALL Agrif_Set_bcinterp(tra_ice_id,  interp = AGRIF_linear)
647   CALL Agrif_Set_bcinterp(u_ice_id  , interp1 = Agrif_linear,interp2 = AGRIF_ppm   )
648   CALL Agrif_Set_bcinterp(v_ice_id  , interp1 = AGRIF_ppm   ,interp2 = Agrif_linear)
649
650   ! 3. Set location of interpolations
651   !----------------------------------
652   CALL Agrif_Set_bc(tra_ice_id,(/0,1/))
653   CALL Agrif_Set_bc(u_ice_id  ,(/0,1/))
654   CALL Agrif_Set_bc(v_ice_id  ,(/0,1/))
655
656   ! 4. Set update type in case 2 ways (child=>parent) (normal & tangent to the grid cell for velocities)
657   !--------------------------------------------------
[7757]658   CALL Agrif_Set_Updatetype(tra_ice_id, update = AGRIF_Update_Average)
[6584]659   CALL Agrif_Set_Updatetype(u_ice_id  ,update1 = Agrif_Update_Copy   , update2 = Agrif_Update_Average)
660   CALL Agrif_Set_Updatetype(v_ice_id  ,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy   )
661
662END SUBROUTINE agrif_declare_var_lim3
663#endif
664
665
[2715]666# if defined key_top
[3680]667SUBROUTINE Agrif_InitValues_cont_top
668   !!----------------------------------------------------------------------
669   !!                 *** ROUTINE Agrif_InitValues_cont_top ***
670   !!
671   !! ** Purpose :: Declaration of variables to be interpolated
672   !!----------------------------------------------------------------------
673   USE Agrif_Util
674   USE oce 
675   USE dom_oce
676   USE nemogcm
677   USE par_trc
[6204]678   USE lib_mpp
[3680]679   USE trc
680   USE in_out_manager
[6204]681   USE agrif_opa_sponge
[3680]682   USE agrif_top_update
683   USE agrif_top_interp
684   USE agrif_top_sponge
[7510]685   !!
[3680]686   IMPLICIT NONE
687   !
[6204]688   CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3
[3680]689   LOGICAL :: check_namelist
690   !!----------------------------------------------------------------------
[1300]691
692
[3680]693   ! 1. Declaration of the type of variable which have to be interpolated
694   !---------------------------------------------------------------------
695   CALL agrif_declare_var_top
696
697   ! 2. First interpolations of potentially non zero fields
698   !-------------------------------------------------------
699   Agrif_SpecialValue=0.
700   Agrif_UseSpecialValue = .TRUE.
[6204]701   CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn)
[3680]702   Agrif_UseSpecialValue = .FALSE.
[6204]703   CALL Agrif_Sponge
704   tabspongedone_trn = .FALSE.
705   CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge)
706   ! reset tsa to zero
707   tra(:,:,:,:) = 0.
[3680]708
[6204]709
[3680]710   ! 3. Some controls
711   !-----------------
[6204]712   check_namelist = .TRUE.
[3680]713
714   IF( check_namelist ) THEN
[6204]715# if defined key_offline
[3680]716      ! Check time steps
[6204]717      IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN
718         WRITE(cl_check1,*)  Agrif_Parent(rdt)
719         WRITE(cl_check2,*)  rdt
720         WRITE(cl_check3,*)  rdt*Agrif_Rhot()
[7158]721         CALL ctl_stop( 'incompatible time step between grids',   &
[6204]722               &               'parent grid value : '//cl_check1    ,   & 
723               &               'child  grid value : '//cl_check2    ,   & 
[7158]724               &               'value on child grid should be changed to  &
[6204]725               &               :'//cl_check3  )
[3680]726      ENDIF
727
728      ! Check run length
729      IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
[6204]730            Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN
731         WRITE(cl_check1,*)  (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
732         WRITE(cl_check2,*)   Agrif_Parent(nitend)   *Agrif_IRhot()
733         CALL ctl_warn( 'incompatible run length between grids'               ,   &
734               &              ' nit000 on fine grid will be change to : '//cl_check1,   &
735               &              ' nitend on fine grid will be change to : '//cl_check2    )
736         nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
737         nitend =  Agrif_Parent(nitend)   *Agrif_IRhot()
[3680]738      ENDIF
739
740      ! Check coordinates
741      IF( ln_zps ) THEN
742         ! check parameters for partial steps
[6204]743         IF( Agrif_Parent(e3zps_min) .NE. e3zps_min ) THEN
[3680]744            WRITE(*,*) 'incompatible e3zps_min between grids'
745            WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_min)
746            WRITE(*,*) 'child grid  :',e3zps_min
747            WRITE(*,*) 'those values should be identical'
[1300]748            STOP
749         ENDIF
[6204]750         IF( Agrif_Parent(e3zps_rat) .NE. e3zps_rat ) THEN
[3680]751            WRITE(*,*) 'incompatible e3zps_rat between grids'
752            WRITE(*,*) 'parent grid :',Agrif_Parent(e3zps_rat)
753            WRITE(*,*) 'child grid  :',e3zps_rat
754            WRITE(*,*) 'those values should be identical'                 
[1300]755            STOP
756         ENDIF
[3680]757      ENDIF
[2715]758#  endif         
[3680]759      ! Check passive tracer cell
[6204]760      IF( nn_dttrc .NE. 1 ) THEN
[3680]761         WRITE(*,*) 'nn_dttrc should be equal to 1'
[1300]762      ENDIF
[3680]763   ENDIF
[1300]764
[6204]765   CALL Agrif_Update_trc(0)
766   !
767   Agrif_UseSpecialValueInUpdate = .FALSE.
[3680]768   nbcline_trc = 0
769   !
770END SUBROUTINE Agrif_InitValues_cont_top
[2715]771
772
[3680]773SUBROUTINE agrif_declare_var_top
774   !!----------------------------------------------------------------------
775   !!                 *** ROUTINE agrif_declare_var_top ***
776   !!
777   !! ** Purpose :: Declaration of TOP variables to be interpolated
778   !!----------------------------------------------------------------------
779   USE agrif_util
[6204]780   USE agrif_oce
[3680]781   USE dom_oce
782   USE trc
[7510]783   !!
[3680]784   IMPLICIT NONE
[7510]785   !!----------------------------------------------------------------------
[2715]786
[3680]787   ! 1. Declaration of the type of variable which have to be interpolated
788   !---------------------------------------------------------------------
[6204]789   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)
790   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)
[2715]791
[3680]792   ! 2. Type of interpolation
793   !-------------------------
794   CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear)
[6204]795   CALL Agrif_Set_bcinterp(trn_sponge_id,interp=AGRIF_linear)
[3680]796
797   ! 3. Location of interpolation
798   !-----------------------------
[6204]799   CALL Agrif_Set_bc(trn_id,(/0,1/))
800!   CALL Agrif_Set_bc(trn_sponge_id,(/-3*Agrif_irhox(),0/))
801   CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/))
[3680]802
803   ! 5. Update type
804   !---------------
[6204]805   CALL Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average)
[3680]806
[6204]807!   Higher order update
808!   CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting)
[3680]809
[6204]810   !
[3680]811END SUBROUTINE agrif_declare_var_top
[2715]812# endif
[636]813
[3680]814SUBROUTINE Agrif_detect( kg, ksizex )
815   !!----------------------------------------------------------------------
[7510]816   !!                      *** ROUTINE Agrif_detect ***
[3680]817   !!----------------------------------------------------------------------
818   INTEGER, DIMENSION(2) :: ksizex
819   INTEGER, DIMENSION(ksizex(1),ksizex(2)) :: kg 
820   !!----------------------------------------------------------------------
821   !
822   RETURN
823   !
824END SUBROUTINE Agrif_detect
[390]825
[782]826
[3680]827SUBROUTINE agrif_nemo_init
828   !!----------------------------------------------------------------------
829   !!                     *** ROUTINE agrif_init ***
830   !!----------------------------------------------------------------------
831   USE agrif_oce 
832   USE agrif_ice
833   USE in_out_manager
834   USE lib_mpp
[7510]835   !!
[3680]836   IMPLICIT NONE
837   !
[4147]838   INTEGER  ::   ios                 ! Local integer output status for namelist read
[6204]839   INTEGER  ::   iminspon
840   NAMELIST/namagrif/ nn_cln_update, rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn, ln_chk_bathy
841   !!--------------------------------------------------------------------------------------
[3680]842   !
[6204]843   REWIND( numnam_ref )              ! Namelist namagrif in reference namelist : AGRIF zoom
844   READ  ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901)
845901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in reference namelist', lwp )
[4147]846
[6204]847   REWIND( numnam_cfg )              ! Namelist namagrif in configuration namelist : AGRIF zoom
848   READ  ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 )
849902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in configuration namelist', lwp )
850   IF(lwm) WRITE ( numond, namagrif )
[3680]851   !
852   IF(lwp) THEN                    ! control print
853      WRITE(numout,*)
854      WRITE(numout,*) 'agrif_nemo_init : AGRIF parameters'
855      WRITE(numout,*) '~~~~~~~~~~~~~~~'
856      WRITE(numout,*) '   Namelist namagrif : set AGRIF parameters'
857      WRITE(numout,*) '      baroclinic update frequency       nn_cln_update = ', nn_cln_update
858      WRITE(numout,*) '      sponge coefficient for tracers    rn_sponge_tra = ', rn_sponge_tra, ' s'
859      WRITE(numout,*) '      sponge coefficient for dynamics   rn_sponge_tra = ', rn_sponge_dyn, ' s'
860      WRITE(numout,*) '      use special values for dynamics   ln_spc_dyn    = ', ln_spc_dyn
[6204]861      WRITE(numout,*) '      check bathymetry                  ln_chk_bathy  = ', ln_chk_bathy
[3680]862      WRITE(numout,*) 
863   ENDIF
864   !
865   ! convert DOCTOR namelist name into OLD names
866   nbclineupdate = nn_cln_update
867   visc_tra      = rn_sponge_tra
868   visc_dyn      = rn_sponge_dyn
869   !
[6204]870   ! Check sponge length:
871   iminspon = MIN(FLOOR(REAL(jpiglo-4)/REAL(2*Agrif_irhox())), FLOOR(REAL(jpjglo-4)/REAL(2*Agrif_irhox())) )
872   IF (lk_mpp) iminspon = MIN(iminspon,FLOOR(REAL(jpi-2)/REAL(Agrif_irhox())), FLOOR(REAL(jpj-2)/REAL(Agrif_irhox())) )
873   IF (nn_sponge_len > iminspon)  CALL ctl_stop('agrif sponge length is too large')
874   !
875   IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed')
[3680]876# if defined key_lim2
[6584]877   IF( agrif_ice_alloc()  > 0 )   CALL ctl_stop('agrif agrif_ice_alloc: allocation of arrays failed') ! only for LIM2 (not LIM3)
[3680]878# endif
879   !
880END SUBROUTINE agrif_nemo_init
881
[1605]882# if defined key_mpp_mpi
883
[3680]884SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob )
885   !!----------------------------------------------------------------------
886   !!                     *** ROUTINE Agrif_detect ***
887   !!----------------------------------------------------------------------
888   USE dom_oce
[7510]889   !!
[3680]890   IMPLICIT NONE
891   !
892   INTEGER :: indglob, indloc, nprocloc, i
893   !!----------------------------------------------------------------------
894   !
895   SELECT CASE( i )
896   CASE(1)   ;   indglob = indloc + nimppt(nprocloc+1) - 1
[6204]897   CASE(2)   ;   indglob = indloc + njmppt(nprocloc+1) - 1
898   CASE DEFAULT
899      indglob = indloc
[3680]900   END SELECT
901   !
902END SUBROUTINE Agrif_InvLoc
[390]903
[7510]904
[6204]905SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax )
906   !!----------------------------------------------------------------------
907   !!                 *** ROUTINE Agrif_get_proc_info ***
908   !!----------------------------------------------------------------------
909   USE par_oce
[7510]910   !!
[6204]911   IMPLICIT NONE
912   !
913   INTEGER, INTENT(out) :: imin, imax
914   INTEGER, INTENT(out) :: jmin, jmax
915   !!----------------------------------------------------------------------
916   !
917   imin = nimppt(Agrif_Procrank+1)  ! ?????
918   jmin = njmppt(Agrif_Procrank+1)  ! ?????
919   imax = imin + jpi - 1
920   jmax = jmin + jpj - 1
921   !
922END SUBROUTINE Agrif_get_proc_info
923
[7510]924
[6204]925SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost)
926   !!----------------------------------------------------------------------
927   !!                 *** ROUTINE Agrif_estimate_parallel_cost ***
928   !!----------------------------------------------------------------------
929   USE par_oce
[7510]930   !!
[6204]931   IMPLICIT NONE
932   !
933   INTEGER,  INTENT(in)  :: imin, imax
934   INTEGER,  INTENT(in)  :: jmin, jmax
935   INTEGER,  INTENT(in)  :: nbprocs
936   REAL(wp), INTENT(out) :: grid_cost
937   !!----------------------------------------------------------------------
938   !
939   grid_cost = REAL(imax-imin+1,wp)*REAL(jmax-jmin+1,wp) / REAL(nbprocs,wp)
940   !
941END SUBROUTINE Agrif_estimate_parallel_cost
942
[1605]943# endif
944
[390]945#else
[3680]946SUBROUTINE Subcalledbyagrif
947   !!----------------------------------------------------------------------
948   !!                   *** ROUTINE Subcalledbyagrif ***
949   !!----------------------------------------------------------------------
950   WRITE(*,*) 'Impossible to be here'
951END SUBROUTINE Subcalledbyagrif
[390]952#endif
Note: See TracBrowser for help on using the repository browser.