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

source: branches/2017/dev_merge_2017/NEMOGCM/NEMO/NST_SRC/agrif_user.F90 @ 9160

Last change on this file since 9160 was 9160, checked in by clem, 6 years ago

make ice with agrif restartable. Reproducibility still needs to be checked out
  • Property svn:keywords set to Id
File size: 36.7 KB
Line 
1#undef UPD_HIGH   /* MIX HIGH UPDATE */
2#if defined key_agrif
3!!----------------------------------------------------------------------
4!! NEMO/NST 4.0 , NEMO Consortium (2017)
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*nn_hls + (jpni-1+0) ) / jpni + 2*nn_hls
32      jpj     = ( jpjglo-2*nn_hls + (jpnj-1+0) ) / jpnj + 2*nn_hls
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   INTEGER :: ind1, ind2, ind3
136   !!----------------------------------------------------------------------
137
138   ! 1. Declaration of the type of variable which have to be interpolated
139   !---------------------------------------------------------------------
140   ind1 =     nbghostcells
141   ind2 = 1 + nbghostcells
142   ind3 = 2 + nbghostcells
143   CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e1u_id)
144   CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e2v_id)
145
146   ! 2. Type of interpolation
147   !-------------------------
148   CALL Agrif_Set_bcinterp( e1u_id, interp1=Agrif_linear, interp2=AGRIF_ppm    )
149   CALL Agrif_Set_bcinterp( e2v_id, interp1=AGRIF_ppm   , interp2=Agrif_linear )
150
151   ! 3. Location of interpolation
152   !-----------------------------
153   CALL Agrif_Set_bc(e1u_id,(/0,ind1-1/))
154   CALL Agrif_Set_bc(e2v_id,(/0,ind1-1/))
155
156   ! 4. Update type
157   !---------------
158# if defined UPD_HIGH
159   CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Full_Weighting)
160   CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Full_Weighting, update2=Agrif_Update_Average)
161#else
162   CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average)
163   CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy)
164#endif
165
166END SUBROUTINE agrif_declare_var_dom
167
168
169SUBROUTINE Agrif_InitValues_cont
170   !!----------------------------------------------------------------------
171   !!                 *** ROUTINE Agrif_InitValues_cont ***
172   !!
173   !! ** Purpose ::   Declaration of variables to be interpolated
174   !!----------------------------------------------------------------------
175   USE agrif_opa_update
176   USE agrif_opa_interp
177   USE agrif_opa_sponge
178   USE Agrif_Util
179   USE oce 
180   USE dom_oce
181   USE zdf_oce
182   USE nemogcm
183   !
184   USE lib_mpp
185   USE in_out_manager
186   !
187   IMPLICIT NONE
188   !
189   LOGICAL :: check_namelist
190   CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3, cl_check4 
191   !!----------------------------------------------------------------------
192
193   ! 1. Declaration of the type of variable which have to be interpolated
194   !---------------------------------------------------------------------
195   CALL agrif_declare_var
196
197   ! 2. First interpolations of potentially non zero fields
198   !-------------------------------------------------------
199   Agrif_SpecialValue    = 0._wp
200   Agrif_UseSpecialValue = .TRUE.
201   CALL Agrif_Bc_variable(tsn_id,calledweight=1.,procname=interptsn)
202   CALL Agrif_Sponge
203   tabspongedone_tsn = .FALSE.
204   CALL Agrif_Bc_variable(tsn_sponge_id,calledweight=1.,procname=interptsn_sponge)
205   ! reset tsa to zero
206   tsa(:,:,:,:) = 0.
207
208   Agrif_UseSpecialValue = ln_spc_dyn
209   CALL Agrif_Bc_variable(un_interp_id,calledweight=1.,procname=interpun)
210   CALL Agrif_Bc_variable(vn_interp_id,calledweight=1.,procname=interpvn)
211   tabspongedone_u = .FALSE.
212   tabspongedone_v = .FALSE.
213   CALL Agrif_Bc_variable(un_sponge_id,calledweight=1.,procname=interpun_sponge)
214   tabspongedone_u = .FALSE.
215   tabspongedone_v = .FALSE.
216   CALL Agrif_Bc_variable(vn_sponge_id,calledweight=1.,procname=interpvn_sponge)
217
218   Agrif_UseSpecialValue = .TRUE.
219   CALL Agrif_Bc_variable(sshn_id,calledweight=1., procname=interpsshn )
220   hbdy_w(:,:) = 0.e0 ; hbdy_e(:,:) = 0.e0 ; hbdy_n(:,:) = 0.e0 ; hbdy_s(:,:) = 0.e0
221   ssha(:,:) = 0.e0
222
223   IF ( ln_dynspg_ts ) THEN
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
230      ubdy_e(:,:) = 0.e0 ; vbdy_e(:,:) = 0.e0
231      ubdy_n(:,:) = 0.e0 ; vbdy_n(:,:) = 0.e0
232      ubdy_s(:,:) = 0.e0 ; vbdy_s(:,:) = 0.e0
233   ENDIF
234
235   Agrif_UseSpecialValue = .FALSE. 
236   ! reset velocities to zero
237   ua(:,:,:) = 0.
238   va(:,:,:) = 0.
239
240   ! 3. Some controls
241   !-----------------
242   check_namelist = .TRUE.
243
244   IF( check_namelist ) THEN 
245
246      ! Check time steps           
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())
251         CALL ctl_stop( 'Incompatible time step between ocean grids',   &
252               &               'parent grid value : '//cl_check1    ,   & 
253               &               'child  grid value : '//cl_check2    ,   & 
254               &               'value on child grid should be changed to : '//cl_check3 )
255      ENDIF
256
257      ! Check run length
258      IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
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 changed to : '//cl_check1,   &
264               &               'nitend on fine grid will be changed to : '//cl_check2    )
265         nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
266         nitend =  Agrif_Parent(nitend)   *Agrif_IRhot()
267      ENDIF
268
269      ! Check free surface scheme
270      IF ( ( Agrif_Parent(ln_dynspg_ts ).AND.ln_dynspg_exp ).OR.&
271         & ( Agrif_Parent(ln_dynspg_exp).AND.ln_dynspg_ts ) ) THEN
272         WRITE(cl_check1,*)  Agrif_Parent( ln_dynspg_ts )
273         WRITE(cl_check2,*)  ln_dynspg_ts
274         WRITE(cl_check3,*)  Agrif_Parent( ln_dynspg_exp )
275         WRITE(cl_check4,*)  ln_dynspg_exp
276         CALL ctl_stop( 'Incompatible free surface scheme between grids' ,  &
277               &               'parent grid ln_dynspg_ts  :'//cl_check1  ,  & 
278               &               'child  grid ln_dynspg_ts  :'//cl_check2  ,  &
279               &               'parent grid ln_dynspg_exp :'//cl_check3  ,  &
280               &               'child  grid ln_dynspg_exp :'//cl_check4  ,  &
281               &               'those logicals should be identical' )                 
282         STOP
283      ENDIF
284
285      ! Check if identical linear free surface option
286      IF ( ( Agrif_Parent(ln_linssh ).AND.(.NOT.ln_linssh )).OR.&
287         & ( (.NOT.Agrif_Parent(ln_linssh)).AND.ln_linssh ) ) THEN
288         WRITE(cl_check1,*)  Agrif_Parent(ln_linssh )
289         WRITE(cl_check2,*)  ln_linssh
290         CALL ctl_stop( 'Incompatible linearized fs option between grids',  &
291               &               'parent grid ln_linssh  :'//cl_check1     ,  &
292               &               'child  grid ln_linssh  :'//cl_check2     ,  &
293               &               'those logicals should be identical' )                 
294         STOP
295      ENDIF
296
297      ! check if masks and bathymetries match
298      IF(ln_chk_bathy) THEN
299         !
300         IF(lwp) WRITE(numout,*) 'AGRIF: Check Bathymetry and masks near bdys. Level: ', Agrif_Level()
301         !
302         kindic_agr = 0
303         ! check if umask agree with parent along western and eastern boundaries:
304         CALL Agrif_Bc_variable(umsk_id,calledweight=1.,procname=interpumsk)
305         ! check if vmask agree with parent along northern and southern boundaries:
306         CALL Agrif_Bc_variable(vmsk_id,calledweight=1.,procname=interpvmsk)
307         ! check if tmask and vertical scale factors agree with parent over first two coarse grid points:
308         CALL Agrif_Bc_variable(e3t_id,calledweight=1.,procname=interpe3t)
309         !
310         IF (lk_mpp) CALL mpp_sum( kindic_agr )
311         IF( kindic_agr /= 0 ) THEN
312            CALL ctl_stop('Child Bathymetry is not correct near boundaries.')
313         ELSE
314            IF(lwp) WRITE(numout,*) 'Child Bathymetry is ok near boundaries.'
315         END IF
316      ENDIF
317      !
318   ENDIF
319   !
320END SUBROUTINE Agrif_InitValues_cont
321
322RECURSIVE SUBROUTINE Agrif_Update_ini( )
323   !!----------------------------------------------------------------------
324   !!                 *** ROUTINE agrif_Update_ini ***
325   !!
326   !! ** Purpose :: Recursive update done at initialization
327   !!----------------------------------------------------------------------
328   USE dom_oce
329   USE agrif_opa_update
330#if defined key_top
331   USE agrif_top_update
332#endif
333   !
334   IMPLICIT NONE
335   !!----------------------------------------------------------------------
336   !
337   IF (Agrif_Root()) RETURN
338   !
339   CALL Agrif_Update_ssh()
340   IF (.NOT.ln_linssh) CALL Agrif_Update_vvl()
341   CALL Agrif_Update_tra()
342#if defined key_top
343   CALL Agrif_Update_Trc()
344#endif
345   CALL Agrif_Update_dyn()
346! JC remove update because this precludes from perfect restartability
347!!   CALL Agrif_Update_tke(0)
348
349   CALL Agrif_ChildGrid_To_ParentGrid()
350   CALL Agrif_Update_ini()
351   CALL Agrif_ParentGrid_To_ChildGrid()
352
353END SUBROUTINE agrif_update_ini
354
355SUBROUTINE agrif_declare_var
356   !!----------------------------------------------------------------------
357   !!                 *** ROUTINE agrif_declarE_var ***
358   !!
359   !! ** Purpose :: Declaration of variables to be interpolated
360   !!----------------------------------------------------------------------
361   USE agrif_util
362   USE agrif_oce
363   USE par_oce       ! ocean parameters
364   USE zdf_oce       ! vertical physics
365   USE oce
366   !
367   IMPLICIT NONE
368   !
369   INTEGER :: ind1, ind2, ind3
370   !!----------------------------------------------------------------------
371
372   ! 1. Declaration of the type of variable which have to be interpolated
373   !---------------------------------------------------------------------
374   ind1 =     nbghostcells
375   ind2 = 1 + nbghostcells
376   ind3 = 2 + nbghostcells
377# if defined key_vertical
378   CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts+1/),tsn_id)
379   CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts+1/),tsn_sponge_id)
380
381   CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_interp_id)
382   CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_interp_id)
383   CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_update_id)
384   CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_update_id)
385   CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_sponge_id)
386   CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_sponge_id)
387# else
388   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)
389   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)
390
391   CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_interp_id)
392   CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_interp_id)
393   CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_update_id)
394   CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_update_id)
395   CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_sponge_id)
396   CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_sponge_id)
397# endif
398
399   CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id)
400   CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),umsk_id)
401   CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vmsk_id)
402
403   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)
404
405   CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),unb_id)
406   CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vnb_id)
407   CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_interp_id)
408   CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_interp_id)
409   CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_update_id)
410   CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_update_id)
411
412   CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id)
413
414   IF( ln_zdftke.OR.ln_zdfgls ) THEN
415!      CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/), en_id)
416!      CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),avt_id)
417# if defined key_vertical
418      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),avm_id)
419# else
420      CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),avm_id)
421# endif
422   ENDIF
423
424   ! 2. Type of interpolation
425   !-------------------------
426   CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear)
427
428   CALL Agrif_Set_bcinterp(un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
429   CALL Agrif_Set_bcinterp(vn_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
430
431   CALL Agrif_Set_bcinterp(tsn_sponge_id,interp=AGRIF_linear)
432
433   CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_linear)
434   CALL Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
435   CALL Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
436   CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
437   CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
438
439
440   CALL Agrif_Set_bcinterp(un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
441   CALL Agrif_Set_bcinterp(vn_sponge_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
442
443   CALL Agrif_Set_bcinterp(e3t_id,interp=AGRIF_constant)
444   CALL Agrif_Set_bcinterp(umsk_id,interp=AGRIF_constant)
445   CALL Agrif_Set_bcinterp(vmsk_id,interp=AGRIF_constant)
446
447   IF( ln_zdftke.OR.ln_zdfgls )   CALL Agrif_Set_bcinterp( avm_id, interp=AGRIF_linear )
448
449   ! 3. Location of interpolation
450   !-----------------------------
451   CALL Agrif_Set_bc(       tsn_id, (/0,ind1/) )
452   CALL Agrif_Set_bc( un_interp_id, (/0,ind1/) )
453   CALL Agrif_Set_bc( vn_interp_id, (/0,ind1/) )
454
455   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
456   CALL Agrif_Set_bc(  un_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) )
457   CALL Agrif_Set_bc(  vn_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) )
458
459   CALL Agrif_Set_bc(        sshn_id, (/0,ind1-1/) )
460   CALL Agrif_Set_bc(         unb_id, (/0,ind1-1/) )
461   CALL Agrif_Set_bc(         vnb_id, (/0,ind1-1/) )
462   CALL Agrif_Set_bc( ub2b_interp_id, (/0,ind1-1/) )
463   CALL Agrif_Set_bc( vb2b_interp_id, (/0,ind1-1/) )
464
465   CALL Agrif_Set_bc(  e3t_id, (/-2*Agrif_irhox()-1,ind1-1/) )   ! if west and rhox=3 and ghost=1: column 2 to 9
466   CALL Agrif_Set_bc( umsk_id, (/0,ind1-1/)                  )
467   CALL Agrif_Set_bc( vmsk_id, (/0,ind1-1/)                  )
468
469   IF( ln_zdftke.OR.ln_zdfgls )   CALL Agrif_Set_bc( avm_id, (/0,ind1/) )
470
471   ! 4. Update type
472   !---------------
473   CALL Agrif_Set_Updatetype(scales_t_id, update = AGRIF_Update_Average)
474
475# if defined UPD_HIGH
476   CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting)
477   CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting)
478   CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average)
479
480   CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting)
481   CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average)
482   CALL Agrif_Set_Updatetype(sshn_id, update = Agrif_Update_Full_Weighting)
483   CALL Agrif_Set_Updatetype(e3t_id, update = Agrif_Update_Full_Weighting)
484
485   IF( ln_zdftke.OR.ln_zdfgls ) THEN
486!      CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Full_Weighting)
487!      CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Full_Weighting)
488!      CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Full_Weighting)
489   ENDIF
490
491#else
492   CALL Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average)
493   CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
494   CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
495
496   CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
497   CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
498   CALL Agrif_Set_Updatetype(sshn_id, update = AGRIF_Update_Average)
499   CALL Agrif_Set_Updatetype(e3t_id, update = AGRIF_Update_Average)
500
501   IF( ln_zdftke.OR.ln_zdfgls ) THEN
502!      CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Average)
503!      CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Average)
504!      CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Average)
505   ENDIF
506
507#endif
508   !
509END SUBROUTINE agrif_declare_var
510
511#if defined key_lim3
512SUBROUTINE Agrif_InitValues_cont_lim3
513   !!----------------------------------------------------------------------
514   !!                 *** ROUTINE Agrif_InitValues_cont_lim3 ***
515   !!
516   !! ** Purpose :: Initialisation of variables to be interpolated for LIM3
517   !!----------------------------------------------------------------------
518   USE Agrif_Util
519   USE sbc_oce, ONLY : nn_fsbc  ! clem: necessary otherwise Agrif_Parent(nn_fsbc) = nn_fsbc
520   USE ice
521   USE agrif_ice
522   USE in_out_manager
523   USE agrif_lim3_update
524   USE agrif_lim3_interp
525   USE lib_mpp
526   !
527   IMPLICIT NONE
528   !!----------------------------------------------------------------------
529   !
530   ! Declaration of the type of variable which have to be interpolated (parent=>child)
531   !----------------------------------------------------------------------------------
532   CALL agrif_declare_var_lim3
533
534   ! Controls
535
536   ! clem: For some reason, nn_fsbc(child)/=1 does not work properly (signal is largely degraded by the agrif zoom)
537   !          the run must satisfy CFL=Uice/(dx/dt) < 0.6/nn_fsbc(child)
538   !          therefore, if nn_fsbc(child)>1 one must reduce the time-step in proportion to nn_fsbc(child), which is not acceptable
539   !       If a solution is found, the following stop could be removed
540   IF( nn_fsbc > 1 )  CALL ctl_stop('nn_fsbc(child) must be set to 1 otherwise agrif and lim3 do not work properly')
541
542   ! stop if rhot * nn_fsbc(parent) /= N * nn_fsbc(child) with N being integer
543   IF( MOD( Agrif_irhot() * Agrif_Parent(nn_fsbc), nn_fsbc ) /= 0 )  THEN
544      CALL ctl_stop('rhot * nn_fsbc(parent) /= N * nn_fsbc(child), therefore nn_fsbc(child) should be set to 1 or nn_fsbc(parent)')
545   ENDIF
546   ! First Interpolations (using "after" ice subtime step => lim_nbstep=1)
547   !----------------------------------------------------------------------
548   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)
549   CALL agrif_interp_lim3('U') ! interpolation of ice velocities
550   CALL agrif_interp_lim3('V') ! interpolation of ice velocities
551   CALL agrif_interp_lim3('T') ! interpolation of ice tracers
552   lim_nbstep = 0
553   
554   ! Update in case 2 ways
555   !----------------------
556   CALL agrif_update_lim3(0)
557
558   !
559END SUBROUTINE Agrif_InitValues_cont_lim3
560
561SUBROUTINE agrif_declare_var_lim3
562   !!----------------------------------------------------------------------
563   !!                 *** ROUTINE agrif_declare_var_lim3 ***
564   !!
565   !! ** Purpose :: Declaration of variables to be interpolated for LIM3
566   !!----------------------------------------------------------------------
567   USE Agrif_Util
568   USE ice
569   USE par_oce, ONLY : nbghostcells
570   !
571   IMPLICIT NONE
572   !
573   INTEGER :: ind1, ind2, ind3
574   !!----------------------------------------------------------------------
575   !
576   ! 1. Declaration of the type of variable which have to be interpolated (parent=>child)
577   !       agrif_declare_variable(position,1st point index,--,--,dimensions,name)
578   !           ex.:  position=> 1,1 = not-centered (in i and j)
579   !                            2,2 =     centered (    -     )
580   !                 index   => 1,1 = one ghost line
581   !                            2,2 = two ghost lines
582   !-------------------------------------------------------------------------------------
583   ind1 =     nbghostcells
584   ind2 = 1 + nbghostcells
585   ind3 = 2 + nbghostcells
586   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 )
587   CALL agrif_declare_variable((/1,2/)  ,(/ind2,ind3/)  ,(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,u_ice_id   )
588   CALL agrif_declare_variable((/2,1/)  ,(/ind3,ind2/)  ,(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,v_ice_id   )
589
590   ! 2. Set interpolations (normal & tangent to the grid cell for velocities)
591   !-----------------------------------
592   CALL Agrif_Set_bcinterp(tra_ice_id,  interp = AGRIF_linear)
593   CALL Agrif_Set_bcinterp(u_ice_id  , interp1 = Agrif_linear,interp2 = AGRIF_ppm   )
594   CALL Agrif_Set_bcinterp(v_ice_id  , interp1 = AGRIF_ppm   ,interp2 = Agrif_linear)
595
596   ! 3. Set location of interpolations
597   !----------------------------------
598   CALL Agrif_Set_bc(tra_ice_id,(/0,ind1/))
599   CALL Agrif_Set_bc(u_ice_id  ,(/0,ind1/))
600   CALL Agrif_Set_bc(v_ice_id  ,(/0,ind1/))
601
602   ! 4. Set update type in case 2 ways (child=>parent) (normal & tangent to the grid cell for velocities)
603   !--------------------------------------------------
604# if defined UPD_HIGH
605   CALL Agrif_Set_Updatetype(tra_ice_id, update = Agrif_Update_Full_Weighting)
606   CALL Agrif_Set_Updatetype(u_ice_id  ,update1 = Agrif_Update_Average       , update2 = Agrif_Update_Full_Weighting)
607   CALL Agrif_Set_Updatetype(v_ice_id  ,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average)
608#else
609   CALL Agrif_Set_Updatetype(tra_ice_id, update = AGRIF_Update_Average)
610   CALL Agrif_Set_Updatetype(u_ice_id  ,update1 = Agrif_Update_Copy   , update2 = Agrif_Update_Average)
611   CALL Agrif_Set_Updatetype(v_ice_id  ,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy   )
612#endif
613
614END SUBROUTINE agrif_declare_var_lim3
615#endif
616
617
618# if defined key_top
619SUBROUTINE Agrif_InitValues_cont_top
620   !!----------------------------------------------------------------------
621   !!                 *** ROUTINE Agrif_InitValues_cont_top ***
622   !!
623   !! ** Purpose :: Declaration of variables to be interpolated
624   !!----------------------------------------------------------------------
625   USE Agrif_Util
626   USE oce 
627   USE dom_oce
628   USE nemogcm
629   USE par_trc
630   USE lib_mpp
631   USE trc
632   USE in_out_manager
633   USE agrif_opa_sponge
634   USE agrif_top_update
635   USE agrif_top_interp
636   USE agrif_top_sponge
637   !!
638   IMPLICIT NONE
639   !
640   CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3
641   LOGICAL :: check_namelist
642   !!----------------------------------------------------------------------
643
644
645   ! 1. Declaration of the type of variable which have to be interpolated
646   !---------------------------------------------------------------------
647   CALL agrif_declare_var_top
648
649   ! 2. First interpolations of potentially non zero fields
650   !-------------------------------------------------------
651   Agrif_SpecialValue=0.
652   Agrif_UseSpecialValue = .TRUE.
653   CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn)
654   Agrif_UseSpecialValue = .FALSE.
655   CALL Agrif_Sponge
656   tabspongedone_trn = .FALSE.
657   CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge)
658   ! reset tsa to zero
659   tra(:,:,:,:) = 0.
660
661
662   ! 3. Some controls
663   !-----------------
664   check_namelist = .TRUE.
665
666   IF( check_namelist ) THEN
667      ! Check time steps
668      IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN
669         WRITE(cl_check1,*)  Agrif_Parent(rdt)
670         WRITE(cl_check2,*)  rdt
671         WRITE(cl_check3,*)  rdt*Agrif_Rhot()
672         CALL ctl_stop( 'incompatible time step between grids',   &
673               &               'parent grid value : '//cl_check1    ,   & 
674               &               'child  grid value : '//cl_check2    ,   & 
675               &               'value on child grid should be changed to  &
676               &               :'//cl_check3  )
677      ENDIF
678
679      ! Check run length
680      IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
681            Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN
682         WRITE(cl_check1,*)  (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
683         WRITE(cl_check2,*)   Agrif_Parent(nitend)   *Agrif_IRhot()
684         CALL ctl_warn( 'incompatible run length between grids'               ,   &
685               &              ' nit000 on fine grid will be change to : '//cl_check1,   &
686               &              ' nitend on fine grid will be change to : '//cl_check2    )
687         nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
688         nitend =  Agrif_Parent(nitend)   *Agrif_IRhot()
689      ENDIF
690
691      ENDIF
692      ! Check passive tracer cell
693      IF( nn_dttrc .NE. 1 ) THEN
694         WRITE(*,*) 'nn_dttrc should be equal to 1'
695      ENDIF
696   ENDIF
697   !
698END SUBROUTINE Agrif_InitValues_cont_top
699
700
701SUBROUTINE agrif_declare_var_top
702   !!----------------------------------------------------------------------
703   !!                 *** ROUTINE agrif_declare_var_top ***
704   !!
705   !! ** Purpose :: Declaration of TOP variables to be interpolated
706   !!----------------------------------------------------------------------
707   USE agrif_util
708   USE agrif_oce
709   USE dom_oce
710   USE trc
711   !!
712   IMPLICIT NONE
713   !
714   INTEGER :: ind1, ind2, ind3
715   !!----------------------------------------------------------------------
716
717   ! 1. Declaration of the type of variable which have to be interpolated
718   !---------------------------------------------------------------------
719   ind1 =     nbghostcells
720   ind2 = 1 + nbghostcells
721   ind3 = 2 + nbghostcells
722# if defined key_vertical
723   CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra+1/),trn_id)
724   CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra+1/),trn_sponge_id)
725# else
726   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)
727   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)
728# endif
729
730   ! 2. Type of interpolation
731   !-------------------------
732   CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear)
733   CALL Agrif_Set_bcinterp(trn_sponge_id,interp=AGRIF_linear)
734
735   ! 3. Location of interpolation
736   !-----------------------------
737   CALL Agrif_Set_bc(trn_id,(/0,ind1/))
738   CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/))
739
740   ! 4. Update type
741   !---------------
742# if defined UPD_HIGH
743   CALL Agrif_Set_Updatetype(trn_id, update = Agrif_Update_Full_Weighting)
744#else
745   CALL Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average)
746#endif
747   !
748END SUBROUTINE agrif_declare_var_top
749# endif
750
751SUBROUTINE Agrif_detect( kg, ksizex )
752   !!----------------------------------------------------------------------
753   !!                      *** ROUTINE Agrif_detect ***
754   !!----------------------------------------------------------------------
755   INTEGER, DIMENSION(2) :: ksizex
756   INTEGER, DIMENSION(ksizex(1),ksizex(2)) :: kg 
757   !!----------------------------------------------------------------------
758   !
759   RETURN
760   !
761END SUBROUTINE Agrif_detect
762
763
764SUBROUTINE agrif_nemo_init
765   !!----------------------------------------------------------------------
766   !!                     *** ROUTINE agrif_init ***
767   !!----------------------------------------------------------------------
768   USE agrif_oce 
769   USE agrif_ice
770   USE in_out_manager
771   USE lib_mpp
772   !!
773   IMPLICIT NONE
774   !
775   INTEGER  ::   ios                 ! Local integer output status for namelist read
776   INTEGER  ::   iminspon
777   NAMELIST/namagrif/ rn_sponge_tra, rn_sponge_dyn, ln_spc_dyn, ln_chk_bathy
778   !!--------------------------------------------------------------------------------------
779   !
780   REWIND( numnam_ref )              ! Namelist namagrif in reference namelist : AGRIF zoom
781   READ  ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901)
782901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in reference namelist', lwp )
783
784   REWIND( numnam_cfg )              ! Namelist namagrif in configuration namelist : AGRIF zoom
785   READ  ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 )
786902 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in configuration namelist', lwp )
787   IF(lwm) WRITE ( numond, namagrif )
788   !
789   IF(lwp) THEN                    ! control print
790      WRITE(numout,*)
791      WRITE(numout,*) 'agrif_nemo_init : AGRIF parameters'
792      WRITE(numout,*) '~~~~~~~~~~~~~~~'
793      WRITE(numout,*) '   Namelist namagrif : set AGRIF parameters'
794      WRITE(numout,*) '      sponge coefficient for tracers    rn_sponge_tra = ', rn_sponge_tra, ' s'
795      WRITE(numout,*) '      sponge coefficient for dynamics   rn_sponge_tra = ', rn_sponge_dyn, ' s'
796      WRITE(numout,*) '      use special values for dynamics   ln_spc_dyn    = ', ln_spc_dyn
797      WRITE(numout,*) '      check bathymetry                  ln_chk_bathy  = ', ln_chk_bathy
798      WRITE(numout,*) 
799   ENDIF
800   !
801   ! convert DOCTOR namelist name into OLD names
802   visc_tra      = rn_sponge_tra
803   visc_dyn      = rn_sponge_dyn
804   !
805   ! Check sponge length:
806   iminspon = MIN(FLOOR(REAL(jpiglo-4)/REAL(2*Agrif_irhox())), FLOOR(REAL(jpjglo-4)/REAL(2*Agrif_irhox())) )
807   IF (lk_mpp) iminspon = MIN(iminspon,FLOOR(REAL(jpi-2)/REAL(Agrif_irhox())), FLOOR(REAL(jpj-2)/REAL(Agrif_irhox())) )
808   IF (nn_sponge_len > iminspon)  CALL ctl_stop('agrif sponge length is too large')
809   !
810   IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed')
811   !
812END SUBROUTINE agrif_nemo_init
813
814# if defined key_mpp_mpi
815
816SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob )
817   !!----------------------------------------------------------------------
818   !!                     *** ROUTINE Agrif_InvLoc ***
819   !!----------------------------------------------------------------------
820   USE dom_oce
821   !!
822   IMPLICIT NONE
823   !
824   INTEGER :: indglob, indloc, nprocloc, i
825   !!----------------------------------------------------------------------
826   !
827   SELECT CASE( i )
828   CASE(1)   ;   indglob = indloc + nimppt(nprocloc+1) - 1
829   CASE(2)   ;   indglob = indloc + njmppt(nprocloc+1) - 1
830   CASE DEFAULT
831      indglob = indloc
832   END SELECT
833   !
834END SUBROUTINE Agrif_InvLoc
835
836
837SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax )
838   !!----------------------------------------------------------------------
839   !!                 *** ROUTINE Agrif_get_proc_info ***
840   !!----------------------------------------------------------------------
841   USE par_oce
842   !!
843   IMPLICIT NONE
844   !
845   INTEGER, INTENT(out) :: imin, imax
846   INTEGER, INTENT(out) :: jmin, jmax
847   !!----------------------------------------------------------------------
848   !
849   imin = nimppt(Agrif_Procrank+1)  ! ?????
850   jmin = njmppt(Agrif_Procrank+1)  ! ?????
851   imax = imin + jpi - 1
852   jmax = jmin + jpj - 1
853   !
854END SUBROUTINE Agrif_get_proc_info
855
856
857SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost)
858   !!----------------------------------------------------------------------
859   !!                 *** ROUTINE Agrif_estimate_parallel_cost ***
860   !!----------------------------------------------------------------------
861   USE par_oce
862   !!
863   IMPLICIT NONE
864   !
865   INTEGER,  INTENT(in)  :: imin, imax
866   INTEGER,  INTENT(in)  :: jmin, jmax
867   INTEGER,  INTENT(in)  :: nbprocs
868   REAL(wp), INTENT(out) :: grid_cost
869   !!----------------------------------------------------------------------
870   !
871   grid_cost = REAL(imax-imin+1,wp)*REAL(jmax-jmin+1,wp) / REAL(nbprocs,wp)
872   !
873END SUBROUTINE Agrif_estimate_parallel_cost
874
875# endif
876
877#else
878SUBROUTINE Subcalledbyagrif
879   !!----------------------------------------------------------------------
880   !!                   *** ROUTINE Subcalledbyagrif ***
881   !!----------------------------------------------------------------------
882   WRITE(*,*) 'Impossible to be here'
883END SUBROUTINE Subcalledbyagrif
884#endif
Note: See TracBrowser for help on using the repository browser.