source: NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST/agrif_user.F90 @ 12048

Last change on this file since 12048 was 12048, checked in by jchanut, 10 months ago

#2222, add small tolerance for bathymetry matching test; correct U-V parent bathymetry on child grid in the special case of s coord into s coord

  • Property svn:keywords set to Id
File size: 38.1 KB
Line 
1#undef UPD_HIGH   /* MIX HIGH UPDATE */
2#if defined key_agrif
3   !!----------------------------------------------------------------------
4   !! NEMO/NST 4.0 , NEMO Consortium (2018)
5   !! $Id$
6   !! Software governed by the CeCILL license (see ./LICENSE)
7   !!----------------------------------------------------------------------
8   SUBROUTINE agrif_user
9   END SUBROUTINE agrif_user
10
11   SUBROUTINE agrif_before_regridding
12   END SUBROUTINE agrif_before_regridding
13
14   SUBROUTINE Agrif_InitWorkspace
15   END SUBROUTINE Agrif_InitWorkspace
16
17   SUBROUTINE Agrif_InitValues
18      !!----------------------------------------------------------------------
19      !!                 *** ROUTINE Agrif_InitValues ***
20      !!----------------------------------------------------------------------
21      USE nemogcm
22      !!----------------------------------------------------------------------
23      !
24      CALL nemo_init       !* Initializations of each fine grid
25      !
26      !                    !* Agrif initialization
27      CALL agrif_nemo_init
28      CALL Agrif_InitValues_cont_dom
29      CALL Agrif_InitValues_cont
30# if defined key_top
31      CALL Agrif_InitValues_cont_top
32# endif
33# if defined key_si3
34      CALL Agrif_InitValues_cont_ice
35# endif
36      !   
37   END SUBROUTINE Agrif_initvalues
38
39   SUBROUTINE Agrif_InitValues_cont_dom
40      !!----------------------------------------------------------------------
41      !!                 *** ROUTINE Agrif_InitValues_cont_dom ***
42      !!----------------------------------------------------------------------
43      !
44      CALL agrif_declare_var_dom
45      !
46   END SUBROUTINE Agrif_InitValues_cont_dom
47
48   SUBROUTINE agrif_declare_var_dom
49      !!----------------------------------------------------------------------
50      !!                 *** ROUTINE agrif_declare_var_dom ***
51      !!----------------------------------------------------------------------
52      USE par_oce, ONLY:  nbghostcells     
53      !
54      IMPLICIT NONE
55      !
56      INTEGER :: ind1, ind2, ind3
57      !!----------------------------------------------------------------------
58
59      ! 1. Declaration of the type of variable which have to be interpolated
60      !---------------------------------------------------------------------
61      ind1 =     nbghostcells
62      ind2 = 1 + nbghostcells
63      ind3 = 2 + nbghostcells
64      CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e1u_id)
65      CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e2v_id)
66
67      ! 2. Type of interpolation
68      !-------------------------
69      CALL Agrif_Set_bcinterp( e1u_id, interp1=Agrif_linear, interp2=AGRIF_ppm    )
70      CALL Agrif_Set_bcinterp( e2v_id, interp1=AGRIF_ppm   , interp2=Agrif_linear )
71
72      ! 3. Location of interpolation
73      !-----------------------------
74      CALL Agrif_Set_bc(e1u_id,(/0,ind1-1/))
75      CALL Agrif_Set_bc(e2v_id,(/0,ind1-1/))
76
77      ! 4. Update type
78      !---------------
79# if defined UPD_HIGH
80      CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Full_Weighting)
81      CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Full_Weighting, update2=Agrif_Update_Average)
82#else
83      CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average)
84      CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy)
85#endif
86
87   END SUBROUTINE agrif_declare_var_dom
88
89   SUBROUTINE Agrif_InitValues_cont
90      !!----------------------------------------------------------------------
91      !!                 *** ROUTINE Agrif_InitValues_cont ***
92      !!----------------------------------------------------------------------
93      USE agrif_oce
94      USE agrif_oce_interp
95      USE agrif_oce_sponge
96      USE dom_oce
97      USE oce
98      USE lib_mpp
99      USE lbclnk
100      !
101      IMPLICIT NONE
102      !
103      INTEGER :: ji, jj
104      LOGICAL :: check_namelist
105      CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3, cl_check4 
106#if defined key_vertical
107      REAL(wp), DIMENSION(jpi,jpj) ::   zk   ! workspace
108#endif
109      !!----------------------------------------------------------------------
110
111      ! 1. Declaration of the type of variable which have to be interpolated
112      !---------------------------------------------------------------------
113      CALL agrif_declare_var
114
115      ! 2. First interpolations of potentially non zero fields
116      !-------------------------------------------------------
117
118#if defined key_vertical
119      ! Build consistent parent bathymetry and number of levels
120      ! on the child grid
121      Agrif_UseSpecialValue = .FALSE.
122      ht0_parent(:,:) = 0._wp
123      mbkt_parent(:,:) = 0
124      !
125      CALL Agrif_Bc_variable(ht0_id ,calledweight=1.,procname=interpht0 )
126      CALL Agrif_Bc_variable(mbkt_id,calledweight=1.,procname=interpmbkt)
127      !
128      ! Assume step wise change of bathymetry near interface
129      ! TODO: Switch to linear interpolation of bathymetry in the s-coordinate case
130      !       and no refinement
131      DO jj = 1, jpjm1
132         DO ji = 1, jpim1
133            mbku_parent(ji,jj) = MIN(  mbkt_parent(ji+1,jj  ) , mbkt_parent(ji,jj)  )
134            mbkv_parent(ji,jj) = MIN(  mbkt_parent(ji  ,jj+1) , mbkt_parent(ji,jj)  )
135         END DO
136      END DO
137      IF ( ln_sco.AND.Agrif_Parent(ln_sco) ) THEN
138         DO jj = 1, jpjm1
139            DO ji = 1, jpim1
140               hu0_parent(ji,jj) = 0.5_wp * ( ht0_parent(ji,jj)+ht0_parent(ji+1,jj) )
141               hv0_parent(ji,jj) = 0.5_wp * ( ht0_parent(ji,jj)+ht0_parent(ji,jj+1) )
142            END DO
143         END DO
144      ELSE
145         DO jj = 1, jpjm1
146            DO ji = 1, jpim1
147               hu0_parent(ji,jj) = MIN( ht0_parent(ji,jj), ht0_parent(ji+1,jj))
148               hv0_parent(ji,jj) = MIN( ht0_parent(ji,jj), ht0_parent(ji,jj+1))
149            END DO
150         END DO
151
152      ENDIF
153      !
154      CALL lbc_lnk( 'Agrif_InitValues_cont', hu0_parent, 'U', 1. )
155      CALL lbc_lnk( 'Agrif_InitValues_cont', hv0_parent, 'V', 1. )
156      zk(:,:) = REAL( mbku_parent(:,:), wp )   ;   CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'U', 1. )
157      mbku_parent(:,:) = MAX( NINT( zk(:,:) ), 1 )
158      zk(:,:) = REAL( mbkv_parent(:,:), wp )   ;   CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'V', 1. )
159      mbkv_parent(:,:) = MAX( NINT( zk(:,:) ), 1 )   
160#endif
161
162      Agrif_SpecialValue    = 0._wp
163      Agrif_UseSpecialValue = .TRUE.
164      CALL Agrif_Bc_variable(tsn_id,calledweight=1.,procname=interptsn)
165      CALL Agrif_Sponge
166      tabspongedone_tsn = .FALSE.
167      CALL Agrif_Bc_variable(tsn_sponge_id,calledweight=1.,procname=interptsn_sponge)
168      ! reset tsa to zero
169      tsa(:,:,:,:) = 0._wp
170
171      Agrif_UseSpecialValue = ln_spc_dyn
172      CALL Agrif_Bc_variable(un_interp_id,calledweight=1.,procname=interpun)
173      CALL Agrif_Bc_variable(vn_interp_id,calledweight=1.,procname=interpvn)
174      tabspongedone_u = .FALSE.
175      tabspongedone_v = .FALSE.
176      CALL Agrif_Bc_variable(un_sponge_id,calledweight=1.,procname=interpun_sponge)
177      tabspongedone_u = .FALSE.
178      tabspongedone_v = .FALSE.
179      CALL Agrif_Bc_variable(vn_sponge_id,calledweight=1.,procname=interpvn_sponge)
180      ua(:,:,:) = 0._wp
181      va(:,:,:) = 0._wp
182
183      Agrif_UseSpecialValue = .TRUE.
184      CALL Agrif_Bc_variable(sshn_id,calledweight=1., procname=interpsshn )
185      hbdy(:,:) = 0._wp
186      ssha(:,:) = 0._wp
187
188      IF ( ln_dynspg_ts ) THEN
189         Agrif_UseSpecialValue = ln_spc_dyn
190         CALL Agrif_Bc_variable(unb_id,calledweight=1.,procname=interpunb)
191         CALL Agrif_Bc_variable(vnb_id,calledweight=1.,procname=interpvnb)
192         CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b)
193         CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b)
194         ubdy(:,:) = 0._wp
195         vbdy(:,:) = 0._wp
196      ENDIF
197
198      Agrif_UseSpecialValue = .FALSE.
199
200      ! 3. Some controls
201      !-----------------
202      check_namelist = .TRUE.
203
204      IF( check_namelist ) THEN 
205
206         ! Check time steps           
207         IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN
208            WRITE(cl_check1,*)  NINT(Agrif_Parent(rdt))
209            WRITE(cl_check2,*)  NINT(rdt)
210            WRITE(cl_check3,*)  NINT(Agrif_Parent(rdt)/Agrif_Rhot())
211            CALL ctl_stop( 'Incompatible time step between ocean grids',   &
212                  &               'parent grid value : '//cl_check1    ,   & 
213                  &               'child  grid value : '//cl_check2    ,   & 
214                  &               'value on child grid should be changed to : '//cl_check3 )
215         ENDIF
216
217         ! Check run length
218         IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
219               Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN
220            WRITE(cl_check1,*)  (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
221            WRITE(cl_check2,*)   Agrif_Parent(nitend)   *Agrif_IRhot()
222            CALL ctl_warn( 'Incompatible run length between grids'                      ,   &
223                  &               'nit000 on fine grid will be changed to : '//cl_check1,   &
224                  &               'nitend on fine grid will be changed to : '//cl_check2    )
225            nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
226            nitend =  Agrif_Parent(nitend)   *Agrif_IRhot()
227         ENDIF
228
229         ! Check free surface scheme
230         IF ( ( Agrif_Parent(ln_dynspg_ts ).AND.ln_dynspg_exp ).OR.&
231            & ( Agrif_Parent(ln_dynspg_exp).AND.ln_dynspg_ts ) ) THEN
232            WRITE(cl_check1,*)  Agrif_Parent( ln_dynspg_ts )
233            WRITE(cl_check2,*)  ln_dynspg_ts
234            WRITE(cl_check3,*)  Agrif_Parent( ln_dynspg_exp )
235            WRITE(cl_check4,*)  ln_dynspg_exp
236            CALL ctl_stop( 'Incompatible free surface scheme between grids' ,  &
237                  &               'parent grid ln_dynspg_ts  :'//cl_check1  ,  & 
238                  &               'child  grid ln_dynspg_ts  :'//cl_check2  ,  &
239                  &               'parent grid ln_dynspg_exp :'//cl_check3  ,  &
240                  &               'child  grid ln_dynspg_exp :'//cl_check4  ,  &
241                  &               'those logicals should be identical' )                 
242            STOP
243         ENDIF
244
245         ! Check if identical linear free surface option
246         IF ( ( Agrif_Parent(ln_linssh ).AND.(.NOT.ln_linssh )).OR.&
247            & ( (.NOT.Agrif_Parent(ln_linssh)).AND.ln_linssh ) ) THEN
248            WRITE(cl_check1,*)  Agrif_Parent(ln_linssh )
249            WRITE(cl_check2,*)  ln_linssh
250            CALL ctl_stop( 'Incompatible linearized fs option between grids',  &
251                  &               'parent grid ln_linssh  :'//cl_check1     ,  &
252                  &               'child  grid ln_linssh  :'//cl_check2     ,  &
253                  &               'those logicals should be identical' )                 
254            STOP
255         ENDIF
256
257      ENDIF
258
259      ! check if masks and bathymetries match
260      IF(ln_chk_bathy) THEN
261         !
262         IF(lwp) WRITE(numout,*) ' '
263         IF(lwp) WRITE(numout,*) 'AGRIF: Check Bathymetry and masks near bdys. Level: ', Agrif_Level()
264         !
265         kindic_agr = 0
266# if ! defined key_vertical
267         !
268         ! check if umask agree with parent along western and eastern boundaries:
269         CALL Agrif_Bc_variable(umsk_id,calledweight=1.,procname=interpumsk)
270         ! check if vmask agree with parent along northern and southern boundaries:
271         CALL Agrif_Bc_variable(vmsk_id,calledweight=1.,procname=interpvmsk)
272         ! check if tmask and vertical scale factors agree with parent over first two coarse grid points:
273         CALL Agrif_Bc_variable(e3t_id,calledweight=1.,procname=interpe3t)
274         !
275# else
276         !
277         ! In case of vertical interpolation, check only that total depths agree between child and parent:
278         DO ji = 1, jpi
279            DO jj = 1, jpj
280               IF ((mbkt_parent(ji,jj)/=0).AND.(ABS(ht0_parent(ji,jj)-ht_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1
281               IF ((mbku_parent(ji,jj)/=0).AND.(ABS(hu0_parent(ji,jj)-hu_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1
282               IF ((mbkv_parent(ji,jj)/=0).AND.(ABS(hv0_parent(ji,jj)-hv_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1
283            END DO
284         END DO
285# endif
286         CALL mpp_sum( 'agrif_user', kindic_agr )
287         IF( kindic_agr /= 0 ) THEN
288            CALL ctl_stop('==> Child Bathymetry is NOT correct near boundaries.')
289         ELSE
290            IF(lwp) WRITE(numout,*) '==> Child Bathymetry is ok near boundaries.'
291            IF(lwp) WRITE(numout,*) ' '
292         END IF 
293         !   
294      ENDIF
295
296# if defined key_vertical
297      ! Additional constrain that should be removed someday:
298      IF ( Agrif_Parent(jpk).GT.jpk ) THEN
299    CALL ctl_stop( ' With key_vertical, child grids must have jpk greater or equal to the parent value' )
300      ENDIF
301# endif
302      !
303   END SUBROUTINE Agrif_InitValues_cont
304
305   SUBROUTINE agrif_declare_var
306      !!----------------------------------------------------------------------
307      !!                 *** ROUTINE agrif_declare_var ***
308      !!----------------------------------------------------------------------
309      USE agrif_util
310      USE agrif_oce
311      USE par_oce
312      USE zdf_oce 
313      USE oce
314      !
315      IMPLICIT NONE
316      !
317      INTEGER :: ind1, ind2, ind3
318      !!----------------------------------------------------------------------
319
320      ! 1. Declaration of the type of variable which have to be interpolated
321      !---------------------------------------------------------------------
322      ind1 =     nbghostcells
323      ind2 = 1 + nbghostcells
324      ind3 = 2 + nbghostcells
325# if defined key_vertical
326      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)
327      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)
328
329      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)
330      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)
331      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)
332      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)
333      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)
334      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)
335# else
336      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)
337      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)
338
339      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)
340      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)
341      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)
342      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)
343      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)
344      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)
345# endif
346
347      CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id)
348      CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),umsk_id)
349      CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vmsk_id)
350# if defined key_vertical
351      CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),mbkt_id)
352      CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ht0_id)
353# endif
354
355      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)
356
357      CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),unb_id)
358      CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vnb_id)
359      CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_interp_id)
360      CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_interp_id)
361      CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_update_id)
362      CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_update_id)
363
364      CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id)
365
366      IF( ln_zdftke.OR.ln_zdfgls ) THEN
367!         CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/), en_id)
368!         CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),avt_id)
369# if defined key_vertical
370         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)
371# else
372         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)
373# endif
374      ENDIF
375
376      ! 2. Type of interpolation
377      !-------------------------
378      CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear)
379
380      CALL Agrif_Set_bcinterp(un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
381      CALL Agrif_Set_bcinterp(vn_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
382
383      CALL Agrif_Set_bcinterp(tsn_sponge_id,interp=AGRIF_linear)
384
385      CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_linear)
386      CALL Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
387      CALL Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
388      CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
389      CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
390!
391! > Divergence conserving alternative:
392!      CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_constant)
393!      CALL Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_constant)
394!      CALL Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_constant,interp2=Agrif_linear)
395!      CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_constant)
396!      CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_constant,interp2=Agrif_linear)
397!<
398
399      CALL Agrif_Set_bcinterp(un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
400      CALL Agrif_Set_bcinterp(vn_sponge_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
401
402      CALL Agrif_Set_bcinterp(e3t_id,interp=AGRIF_constant)
403      CALL Agrif_Set_bcinterp(umsk_id,interp=AGRIF_constant)
404      CALL Agrif_Set_bcinterp(vmsk_id,interp=AGRIF_constant)
405
406# if defined key_vertical
407      CALL Agrif_Set_bcinterp(mbkt_id,interp=AGRIF_constant)
408      CALL Agrif_Set_bcinterp(ht0_id ,interp=AGRIF_constant)
409# endif
410
411      IF( ln_zdftke.OR.ln_zdfgls )   CALL Agrif_Set_bcinterp( avm_id, interp=AGRIF_linear )
412
413      ! 3. Location of interpolation
414      !-----------------------------
415      CALL Agrif_Set_bc(       tsn_id, (/0,ind1-1/) ) ! if west,  rhox=3 and nbghost=3: columns 2 to 4
416      CALL Agrif_Set_bc( un_interp_id, (/0,ind1-1/) ) 
417      CALL Agrif_Set_bc( vn_interp_id, (/0,ind1-1/) )
418
419      CALL Agrif_Set_bc( tsn_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) )  ! if west,  rhox=3, nn_sponge_len=2
420      CALL Agrif_Set_bc(  un_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) )  ! and nbghost=3:
421      CALL Agrif_Set_bc(  vn_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) )  ! columns 4 to 11
422
423      CALL Agrif_Set_bc(        sshn_id, (/0,ind1-1/) )
424      CALL Agrif_Set_bc(         unb_id, (/0,ind1-1/) )
425      CALL Agrif_Set_bc(         vnb_id, (/0,ind1-1/) )
426      CALL Agrif_Set_bc( ub2b_interp_id, (/0,ind1-1/) )
427      CALL Agrif_Set_bc( vb2b_interp_id, (/0,ind1-1/) )
428
429      CALL Agrif_Set_bc(  e3t_id, (/-nn_sponge_len*Agrif_irhox(),ind1-1/) )     ! if west,  rhox=3, nn_sponge_len=2
430      CALL Agrif_Set_bc( umsk_id, (/0,0/) )                                     ! and nbghost=3:
431      CALL Agrif_Set_bc( vmsk_id, (/0,0/) )                                     ! columns 2 to 10
432# if defined key_vertical 
433      ! extend the interpolation zone by 1 more point than necessary:
434      CALL Agrif_Set_bc(  mbkt_id, (/-nn_sponge_len*Agrif_irhox()-2,ind1/) )
435      CALL Agrif_Set_bc(  ht0_id,  (/-nn_sponge_len*Agrif_irhox()-2,ind1/) )
436# endif
437
438      IF( ln_zdftke.OR.ln_zdfgls )   CALL Agrif_Set_bc( avm_id, (/0,ind1/) )
439
440      ! 4. Update type
441      !---------------
442      CALL Agrif_Set_Updatetype(scales_t_id, update = AGRIF_Update_Average)
443
444# if defined UPD_HIGH
445      CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting)
446      CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting)
447      CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average)
448
449      CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting)
450      CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average)
451      CALL Agrif_Set_Updatetype(sshn_id,update = Agrif_Update_Full_Weighting)
452      CALL Agrif_Set_Updatetype(e3t_id, update = Agrif_Update_Full_Weighting)
453
454      IF( ln_zdftke.OR.ln_zdfgls ) THEN
455!         CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Full_Weighting)
456!         CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Full_Weighting)
457!         CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Full_Weighting)
458      ENDIF
459
460#else
461      CALL Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average)
462      CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
463      CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
464
465      CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
466      CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
467      CALL Agrif_Set_Updatetype(sshn_id,update = AGRIF_Update_Average)
468      CALL Agrif_Set_Updatetype(e3t_id, update = AGRIF_Update_Average)
469
470      IF( ln_zdftke.OR.ln_zdfgls ) THEN
471!         CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Average)
472!         CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Average)
473!         CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Average)
474      ENDIF
475
476#endif
477      !
478   END SUBROUTINE agrif_declare_var
479
480#if defined key_si3
481SUBROUTINE Agrif_InitValues_cont_ice
482      !!----------------------------------------------------------------------
483      !!                 *** ROUTINE Agrif_InitValues_cont_ice ***
484      !!----------------------------------------------------------------------
485      USE Agrif_Util
486      USE sbc_oce, ONLY : nn_fsbc  ! clem: necessary otherwise Agrif_Parent(nn_fsbc) = nn_fsbc
487      USE ice
488      USE agrif_ice
489      USE in_out_manager
490      USE agrif_ice_interp
491      USE lib_mpp
492      !
493      IMPLICIT NONE
494      !!----------------------------------------------------------------------
495      !
496      ! Declaration of the type of variable which have to be interpolated (parent=>child)
497      !----------------------------------------------------------------------------------
498      CALL agrif_declare_var_ice
499
500      ! Controls
501
502      ! clem: For some reason, nn_fsbc(child)/=1 does not work properly (signal can be largely degraded by the agrif zoom)
503      !          the run must satisfy CFL=Uice/(dx/dt) < 0.6/nn_fsbc(child)
504      !          therefore, if nn_fsbc(child)>1 one must reduce the time-step in proportion to nn_fsbc(child), which is not acceptable
505      !       If a solution is found, the following stop could be removed because the rest of the code take nn_fsbc(child) into account
506      IF( nn_fsbc > 1 )  CALL ctl_stop('nn_fsbc(child) must be set to 1 otherwise agrif and sea-ice may not work properly')
507
508      ! stop if rhot * nn_fsbc(parent) /= N * nn_fsbc(child) with N being integer
509      IF( MOD( Agrif_irhot() * Agrif_Parent(nn_fsbc), nn_fsbc ) /= 0 )  THEN
510         CALL ctl_stop('rhot * nn_fsbc(parent) /= N * nn_fsbc(child), therefore nn_fsbc(child) should be set to 1 or nn_fsbc(parent)')
511      ENDIF
512      ! First Interpolations (using "after" ice subtime step => nbstep_ice=1)
513      !----------------------------------------------------------------------
514      nbstep_ice = ( Agrif_irhot() * Agrif_Parent(nn_fsbc) / nn_fsbc ) ! clem: to have calledweight=1 in interp (otherwise the western border of the zoom is wrong)
515      CALL agrif_interp_ice('U') ! interpolation of ice velocities
516      CALL agrif_interp_ice('V') ! interpolation of ice velocities
517      CALL agrif_interp_ice('T') ! interpolation of ice tracers
518      nbstep_ice = 0   
519      !
520   END SUBROUTINE Agrif_InitValues_cont_ice
521
522   SUBROUTINE agrif_declare_var_ice
523      !!----------------------------------------------------------------------
524      !!                 *** ROUTINE agrif_declare_var_ice ***
525      !!----------------------------------------------------------------------
526      USE Agrif_Util
527      USE ice
528      USE par_oce, ONLY : nbghostcells
529      !
530      IMPLICIT NONE
531      !
532      INTEGER :: ind1, ind2, ind3
533      !!----------------------------------------------------------------------
534      !
535      ! 1. Declaration of the type of variable which have to be interpolated (parent=>child)
536      !       agrif_declare_variable(position,1st point index,--,--,dimensions,name)
537      !           ex.:  position=> 1,1 = not-centered (in i and j)
538      !                            2,2 =     centered (    -     )
539      !                 index   => 1,1 = one ghost line
540      !                            2,2 = two ghost lines
541      !-------------------------------------------------------------------------------------
542      ind1 =     nbghostcells
543      ind2 = 1 + nbghostcells
544      ind3 = 2 + nbghostcells
545      CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpl*(8+nlay_s+nlay_i)/),tra_ice_id)
546      CALL agrif_declare_variable((/1,2/)  ,(/ind2,ind3/)  ,(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,u_ice_id  )
547      CALL agrif_declare_variable((/2,1/)  ,(/ind3,ind2/)  ,(/'x','y'/)    ,(/1,1/)  ,(/nlci,nlcj/)                      ,v_ice_id  )
548
549      ! 2. Set interpolations (normal & tangent to the grid cell for velocities)
550      !-----------------------------------
551      CALL Agrif_Set_bcinterp(tra_ice_id, interp  = AGRIF_linear)
552      CALL Agrif_Set_bcinterp(u_ice_id  , interp1 = Agrif_linear,interp2 = AGRIF_ppm   )
553      CALL Agrif_Set_bcinterp(v_ice_id  , interp1 = AGRIF_ppm   ,interp2 = Agrif_linear)
554
555      ! 3. Set location of interpolations
556      !----------------------------------
557      CALL Agrif_Set_bc(tra_ice_id,(/0,ind1/))
558      CALL Agrif_Set_bc(u_ice_id  ,(/0,ind1/))
559      CALL Agrif_Set_bc(v_ice_id  ,(/0,ind1/))
560
561      ! 4. Set update type in case 2 ways (child=>parent) (normal & tangent to the grid cell for velocities)
562      !--------------------------------------------------
563# if defined UPD_HIGH
564      CALL Agrif_Set_Updatetype(tra_ice_id, update  = Agrif_Update_Full_Weighting)
565      CALL Agrif_Set_Updatetype(u_ice_id  , update1 = Agrif_Update_Average       , update2 = Agrif_Update_Full_Weighting)
566      CALL Agrif_Set_Updatetype(v_ice_id  , update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average       )
567#else
568      CALL Agrif_Set_Updatetype(tra_ice_id, update  = AGRIF_Update_Average)
569      CALL Agrif_Set_Updatetype(u_ice_id  , update1 = Agrif_Update_Copy   , update2 = Agrif_Update_Average)
570      CALL Agrif_Set_Updatetype(v_ice_id  , update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy   )
571#endif
572
573   END SUBROUTINE agrif_declare_var_ice
574#endif
575
576
577# if defined key_top
578   SUBROUTINE Agrif_InitValues_cont_top
579      !!----------------------------------------------------------------------
580      !!                 *** ROUTINE Agrif_InitValues_cont_top ***
581      !!----------------------------------------------------------------------
582      USE Agrif_Util
583      USE oce 
584      USE dom_oce
585      USE nemogcm
586      USE par_trc
587      USE lib_mpp
588      USE trc
589      USE in_out_manager
590      USE agrif_oce_sponge
591      USE agrif_top_update
592      USE agrif_top_interp
593      USE agrif_top_sponge
594      !!
595      IMPLICIT NONE
596      !
597      CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3
598      LOGICAL :: check_namelist
599      !!----------------------------------------------------------------------
600
601      ! 1. Declaration of the type of variable which have to be interpolated
602      !---------------------------------------------------------------------
603      CALL agrif_declare_var_top
604
605      ! 2. First interpolations of potentially non zero fields
606      !-------------------------------------------------------
607      Agrif_SpecialValue=0._wp
608      Agrif_UseSpecialValue = .TRUE.
609      CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn)
610      Agrif_UseSpecialValue = .FALSE.
611      CALL Agrif_Sponge
612      tabspongedone_trn = .FALSE.
613      CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge)
614      ! reset tsa to zero
615      tra(:,:,:,:) = 0._wp
616
617      ! 3. Some controls
618      !-----------------
619      check_namelist = .TRUE.
620
621      IF( check_namelist ) THEN
622         ! Check time steps
623      IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN
624         WRITE(cl_check1,*)  Agrif_Parent(rdt)
625         WRITE(cl_check2,*)  rdt
626         WRITE(cl_check3,*)  rdt*Agrif_Rhot()
627         CALL ctl_stop( 'incompatible time step between grids',   &
628               &               'parent grid value : '//cl_check1    ,   & 
629               &               'child  grid value : '//cl_check2    ,   & 
630               &               'value on child grid should be changed to  &
631               &               :'//cl_check3  )
632      ENDIF
633
634      ! Check run length
635      IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
636            Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN
637         WRITE(cl_check1,*)  (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
638         WRITE(cl_check2,*)   Agrif_Parent(nitend)   *Agrif_IRhot()
639         CALL ctl_warn( 'incompatible run length between grids'               ,   &
640               &              ' nit000 on fine grid will be change to : '//cl_check1,   &
641               &              ' nitend on fine grid will be change to : '//cl_check2    )
642         nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
643         nitend =  Agrif_Parent(nitend)   *Agrif_IRhot()
644      ENDIF
645
646      ! Check passive tracer cell
647      IF( nn_dttrc .NE. 1 ) THEN
648         WRITE(*,*) 'nn_dttrc should be equal to 1'
649      ENDIF
650   ENDIF
651   !
652   END SUBROUTINE Agrif_InitValues_cont_top
653
654
655   SUBROUTINE agrif_declare_var_top
656      !!----------------------------------------------------------------------
657      !!                 *** ROUTINE agrif_declare_var_top ***
658      !!----------------------------------------------------------------------
659      USE agrif_util
660      USE agrif_oce
661      USE dom_oce
662      USE trc
663      !!
664      IMPLICIT NONE
665      !
666      INTEGER :: ind1, ind2, ind3
667      !!----------------------------------------------------------------------
668
669      ! 1. Declaration of the type of variable which have to be interpolated
670      !---------------------------------------------------------------------
671      ind1 =     nbghostcells
672      ind2 = 1 + nbghostcells
673      ind3 = 2 + nbghostcells
674# if defined key_vertical
675      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)
676      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)
677# else
678      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)
679      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)
680# endif
681
682      ! 2. Type of interpolation
683      !-------------------------
684      CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear)
685      CALL Agrif_Set_bcinterp(trn_sponge_id,interp=AGRIF_linear)
686
687      ! 3. Location of interpolation
688      !-----------------------------
689      CALL Agrif_Set_bc(trn_id,(/0,ind1-1/))
690      CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/))
691
692      ! 4. Update type
693      !---------------
694# if defined UPD_HIGH
695      CALL Agrif_Set_Updatetype(trn_id, update = Agrif_Update_Full_Weighting)
696#else
697      CALL Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average)
698#endif
699   !
700   END SUBROUTINE agrif_declare_var_top
701# endif
702
703   SUBROUTINE Agrif_detect( kg, ksizex )
704      !!----------------------------------------------------------------------
705      !!                      *** ROUTINE Agrif_detect ***
706      !!----------------------------------------------------------------------
707      INTEGER, DIMENSION(2) :: ksizex
708      INTEGER, DIMENSION(ksizex(1),ksizex(2)) :: kg 
709      !!----------------------------------------------------------------------
710      !
711      RETURN
712      !
713   END SUBROUTINE Agrif_detect
714
715   SUBROUTINE agrif_nemo_init
716      !!----------------------------------------------------------------------
717      !!                     *** ROUTINE agrif_init ***
718      !!----------------------------------------------------------------------
719      USE agrif_oce 
720      USE agrif_ice
721      USE in_out_manager
722      USE lib_mpp
723      !!
724      IMPLICIT NONE
725      !
726      INTEGER  ::   ios                 ! Local integer output status for namelist read
727      NAMELIST/namagrif/ ln_agrif_2way, rn_sponge_tra, rn_sponge_dyn, rn_trelax_tra, rn_trelax_dyn, &
728                       & ln_spc_dyn, ln_chk_bathy
729      !!--------------------------------------------------------------------------------------
730      !
731      REWIND( numnam_ref )              ! Namelist namagrif in reference namelist : AGRIF zoom
732      READ  ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901)
733901 IF( ios /= 0 )   CALL ctl_nam ( ios , 'namagrif in reference namelist' )
734      REWIND( numnam_cfg )              ! Namelist namagrif in configuration namelist : AGRIF zoom
735      READ  ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 )
736902 IF( ios >  0 )   CALL ctl_nam ( ios , 'namagrif in configuration namelist' )
737      IF(lwm) WRITE ( numond, namagrif )
738      !
739      IF(lwp) THEN                    ! control print
740         WRITE(numout,*)
741         WRITE(numout,*) 'agrif_nemo_init : AGRIF parameters'
742         WRITE(numout,*) '~~~~~~~~~~~~~~~'
743         WRITE(numout,*) '   Namelist namagrif : set AGRIF parameters'
744         WRITE(numout,*) '      Two way nesting activated ln_agrif_2way         = ', ln_agrif_2way
745         WRITE(numout,*) '      sponge coefficient for tracers    rn_sponge_tra = ', rn_sponge_tra, ' m^2/s'
746         WRITE(numout,*) '      sponge coefficient for dynamics   rn_sponge_tra = ', rn_sponge_dyn, ' m^2/s'
747         WRITE(numout,*) '      time relaxation for tracers       rn_trelax_tra = ', rn_trelax_tra, ' ad.'
748         WRITE(numout,*) '      time relaxation for dynamics      rn_trelax_dyn = ', rn_trelax_dyn, ' ad.'
749         WRITE(numout,*) '      use special values for dynamics   ln_spc_dyn    = ', ln_spc_dyn
750         WRITE(numout,*) '      check bathymetry                  ln_chk_bathy  = ', ln_chk_bathy
751      ENDIF
752      !
753      !
754      IF( agrif_oce_alloc()  > 0 )   CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed')
755      !
756   END SUBROUTINE agrif_nemo_init
757
758# if defined key_mpp_mpi
759
760   SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob )
761      !!----------------------------------------------------------------------
762      !!                     *** ROUTINE Agrif_InvLoc ***
763      !!----------------------------------------------------------------------
764      USE dom_oce
765      !!
766      IMPLICIT NONE
767      !
768      INTEGER :: indglob, indloc, nprocloc, i
769      !!----------------------------------------------------------------------
770      !
771      SELECT CASE( i )
772      CASE(1)   ;   indglob = indloc + nimppt(nprocloc+1) - 1
773      CASE(2)   ;   indglob = indloc + njmppt(nprocloc+1) - 1
774      CASE DEFAULT
775         indglob = indloc
776      END SELECT
777      !
778   END SUBROUTINE Agrif_InvLoc
779
780   SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax )
781      !!----------------------------------------------------------------------
782      !!                 *** ROUTINE Agrif_get_proc_info ***
783      !!----------------------------------------------------------------------
784      USE par_oce
785      !!
786      IMPLICIT NONE
787      !
788      INTEGER, INTENT(out) :: imin, imax
789      INTEGER, INTENT(out) :: jmin, jmax
790      !!----------------------------------------------------------------------
791      !
792      imin = nimppt(Agrif_Procrank+1)  ! ?????
793      jmin = njmppt(Agrif_Procrank+1)  ! ?????
794      imax = imin + jpi - 1
795      jmax = jmin + jpj - 1
796      !
797   END SUBROUTINE Agrif_get_proc_info
798
799   SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost)
800      !!----------------------------------------------------------------------
801      !!                 *** ROUTINE Agrif_estimate_parallel_cost ***
802      !!----------------------------------------------------------------------
803      USE par_oce
804      !!
805      IMPLICIT NONE
806      !
807      INTEGER,  INTENT(in)  :: imin, imax
808      INTEGER,  INTENT(in)  :: jmin, jmax
809      INTEGER,  INTENT(in)  :: nbprocs
810      REAL(wp), INTENT(out) :: grid_cost
811      !!----------------------------------------------------------------------
812      !
813      grid_cost = REAL(imax-imin+1,wp)*REAL(jmax-jmin+1,wp) / REAL(nbprocs,wp)
814      !
815   END SUBROUTINE Agrif_estimate_parallel_cost
816
817# endif
818
819#else
820   SUBROUTINE Subcalledbyagrif
821      !!----------------------------------------------------------------------
822      !!                   *** ROUTINE Subcalledbyagrif ***
823      !!----------------------------------------------------------------------
824      WRITE(*,*) 'Impossible to be here'
825   END SUBROUTINE Subcalledbyagrif
826#endif
Note: See TracBrowser for help on using the repository browser.