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

source: branches/2017/dev_r8183_ICEMODEL/NEMOGCM/NEMO/NST_SRC/agrif_user.F90 @ 8288

Last change on this file since 8288 was 8226, checked in by clem, 7 years ago

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