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/2017/dev_METO_MERCATOR_2017_agrif/NEMOGCM/NEMO/NST_SRC – NEMO

source: branches/2017/dev_METO_MERCATOR_2017_agrif/NEMOGCM/NEMO/NST_SRC/agrif_user.F90 @ 8998

Last change on this file since 8998 was 8998, checked in by timgraham, 7 years ago

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