source: NEMO/branches/2020/dev_r12377_KERNEL-06_techene_e3/src/NST/agrif_user.F90 @ 12460

Last change on this file since 12460 was 12377, checked in by acc, 16 months ago

The big one. Merging all 2019 developments from the option 1 branch back onto the trunk.

This changeset reproduces 2019/dev_r11943_MERGE_2019 on the trunk using a 2-URL merge
onto a working copy of the trunk. I.e.:

svn merge —ignore-ancestry \

svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/trunk \
svn+ssh://acc@forge.ipsl.jussieu.fr/ipsl/forge/projets/nemo/svn/NEMO/branches/2019/dev_r11943_MERGE_2019 ./

The —ignore-ancestry flag avoids problems that may otherwise arise from the fact that
the merge history been trunk and branch may have been applied in a different order but
care has been taken before this step to ensure that all applicable fixes and updates
are present in the merge branch.

The trunk state just before this step has been branched to releases/release-4.0-HEAD
and that branch has been immediately tagged as releases/release-4.0.2. Any fixes
or additions in response to tickets on 4.0, 4.0.1 or 4.0.2 should be done on
releases/release-4.0-HEAD. From now on future 'point' releases (e.g. 4.0.2) will
remain unchanged with periodic releases as needs demand. Note release-4.0-HEAD is a
transitional naming convention. Future full releases, say 4.2, will have a release-4.2
branch which fulfills this role and the first point release (e.g. 4.2.0) will be made
immediately following the release branch creation.

2020 developments can be started from any trunk revision later than this one.

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