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 NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/NST – NEMO

Context Navigation

source: NEMO/branches/2020/dev_r12558_HPC-08_epico_Extra_Halo/src/NST/agrif_user.F90 @ 13123

Last change on this file since 13123 was 13123, checked in by smasson, 4 years ago
Extra_Halo: deactivate longitude and latitude check in AGRIF, see #2366
Property svn:keywords set to `Id`
File size: 39.4 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 ! do the interpolation over nbghostcells points
65	ind2 = nn_hls + nbghostcells + 1 ! U/V points: array index of the first point in the reference grid
66	ind3 = nn_hls + nbghostcells + 2 ! T points: array index of the first point in the reference grid
67	CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),e1u_id)
68	CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),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(rn_Dt) .NE. Agrif_Parent(rn_Dt) ) THEN
205	WRITE(cl_check1,*) NINT(Agrif_Parent(rn_Dt))
206	WRITE(cl_check2,*) NINT(rn_Dt)
207	WRITE(cl_check3,*) NINT(Agrif_Parent(rn_Dt)/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_2D_00_00
273	IF ((mbkt_parent(ji,jj)/=0).AND.(ABS(ht0_parent(ji,jj)-ht_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1
274	IF ((mbku_parent(ji,jj)/=0).AND.(ABS(hu0_parent(ji,jj)-hu_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1
275	IF ((mbkv_parent(ji,jj)/=0).AND.(ABS(hv0_parent(ji,jj)-hv_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1
276	END_2D
277	# endif
278	CALL mpp_sum( 'agrif_user', kindic_agr )
279	IF( kindic_agr /= 0 ) THEN
280	CALL ctl_stop('==> Child Bathymetry is NOT correct near boundaries.')
281	ELSE
282	IF(lwp) WRITE(numout,*) '==> Child Bathymetry is ok near boundaries.'
283	IF(lwp) WRITE(numout,*) ' '
284	END IF
285	!
286	!!$ IF(lwp) WRITE(numout,*) ' '
287	!!$ IF(lwp) WRITE(numout,*) 'AGRIF: Check longitude and latitude near bdys. Level: ', Agrif_Level()
288	!!$ !
289	!!$ ! check glamt in sponge area:
290	!!$ kindic_agr = 0
291	!!$ CALL Agrif_Bc_variable(glamt_id,calledweight=1.,procname=interpglamt)
292	!!$ CALL mpp_sum( 'agrif_user', kindic_agr )
293	!!$ IF( kindic_agr /= 0 ) THEN
294	!!$ CALL ctl_stop('==> Child glamt is NOT correct near boundaries.')1
295	!!$ ELSE
296	!!$ IF(lwp) WRITE(numout,*) '==> Child glamt is ok near boundaries.'
297	!!$ IF(lwp) WRITE(numout,*) ' '
298	!!$ END IF
299	!!$ !
300	!!$ ! check gphit in sponge area:
301	!!$ kindic_agr = 0
302	!!$ CALL Agrif_Bc_variable(gphit_id,calledweight=1.,procname=interpgphit)
303	!!$ CALL mpp_sum( 'agrif_user', kindic_agr )
304	!!$ IF( kindic_agr /= 0 ) THEN
305	!!$ CALL ctl_stop('==> Child gphit is NOT correct near boundaries.')
306	!!$ ELSE
307	!!$ IF(lwp) WRITE(numout,*) '==> Child gphit is ok near boundaries.'
308	!!$ IF(lwp) WRITE(numout,*) ' '
309	!!$ END IF
310	!
311	ENDIF
312
313	# if defined key_vertical
314	! Additional constrain that should be removed someday:
315	IF ( Agrif_Parent(jpk).GT.jpk ) THEN
316	CALL ctl_stop( ' With key_vertical, child grids must have jpk greater or equal to the parent value' )
317	ENDIF
318	# endif
319	!
320	END SUBROUTINE Agrif_InitValues_cont
321
322	SUBROUTINE agrif_declare_var
323	!!----------------------------------------------------------------------
324	!! * ROUTINE agrif_declare_var *
325	!!----------------------------------------------------------------------
326	USE agrif_util
327	USE agrif_oce
328	USE par_oce
329	USE zdf_oce
330	USE oce
331	!
332	IMPLICIT NONE
333	!
334	INTEGER :: ind1, ind2, ind3
335	!!----------------------------------------------------------------------
336
337	! 1. Declaration of the type of variable which have to be interpolated
338	!---------------------------------------------------------------------
339	ind1 = nbghostcells ! do the interpolation over nbghostcells points
340	ind2 = nn_hls + nbghostcells + 1 ! U/V points: array index of the first point in the reference grid
341	ind3 = nn_hls + nbghostcells + 2 ! T points: array index of the first point in the reference grid
342	# if defined key_vertical
343	CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts+1/),tsn_id)
344	CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts+1/),tsn_sponge_id)
345
346	CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_interp_id)
347	CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_interp_id)
348	CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_update_id)
349	CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_update_id)
350	CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_sponge_id)
351	CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_sponge_id)
352	# else
353	CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsn_id)
354	CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts/),tsn_sponge_id)
355
356	CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),un_interp_id)
357	CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),vn_interp_id)
358	CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),un_update_id)
359	CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),vn_update_id)
360	CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),un_sponge_id)
361	CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),vn_sponge_id)
362	# endif
363
364	CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),e3t_id)
365	CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),glamt_id)
366	CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),gphit_id)
367
368	# if defined key_vertical
369	CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),mbkt_id)
370	CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ht0_id)
371	# endif
372
373	CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,3/),scales_t_id)
374
375	CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),unb_id)
376	CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vnb_id)
377	CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ub2b_interp_id)
378	CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vb2b_interp_id)
379	CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ub2b_update_id)
380	CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vb2b_update_id)
381
382	CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),sshn_id)
383
384	IF( ln_zdftke.OR.ln_zdfgls ) THEN
385	! CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/), en_id)
386	! CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id)
387	# if defined key_vertical
388	CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),avm_id)
389	# else
390	CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,1/),avm_id)
391	# endif
392	ENDIF
393
394	! 2. Type of interpolation
395	!-------------------------
396	CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear)
397
398	CALL Agrif_Set_bcinterp(un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
399	CALL Agrif_Set_bcinterp(vn_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
400
401	CALL Agrif_Set_bcinterp(tsn_sponge_id,interp=AGRIF_linear)
402
403	CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_linear)
404	CALL Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
405	CALL Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
406	CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
407	CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
408	!
409	! > Divergence conserving alternative:
410	! CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_constant)
411	! CALL Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_constant)
412	! CALL Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_constant,interp2=Agrif_linear)
413	! CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_constant)
414	! CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_constant,interp2=Agrif_linear)
415	!<
416
417	CALL Agrif_Set_bcinterp(un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
418	CALL Agrif_Set_bcinterp(vn_sponge_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
419
420	CALL Agrif_Set_bcinterp( e3t_id,interp=AGRIF_constant)
421	CALL Agrif_Set_bcinterp(gphit_id,interp=AGRIF_constant)
422	CALL Agrif_Set_bcinterp(glamt_id,interp=AGRIF_constant)
423
424	# if defined key_vertical
425	CALL Agrif_Set_bcinterp(mbkt_id,interp=AGRIF_constant)
426	CALL Agrif_Set_bcinterp(ht0_id ,interp=AGRIF_constant)
427	# endif
428
429	IF( ln_zdftke.OR.ln_zdfgls ) CALL Agrif_Set_bcinterp( avm_id, interp=AGRIF_linear )
430
431	! 3. Location of interpolation
432	!-----------------------------
433	CALL Agrif_Set_bc( tsn_id, (/0,ind1-1/) ) ! if west, rhox=3 and nbghost=3: columns 2 to 4
434	CALL Agrif_Set_bc( un_interp_id, (/0,ind1-1/) )
435	CALL Agrif_Set_bc( vn_interp_id, (/0,ind1-1/) )
436
437	CALL Agrif_Set_bc( tsn_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) ) ! if west, rhox=3, nn_sponge_len=2
438	CALL Agrif_Set_bc( un_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) ) ! and nbghost=3:
439	CALL Agrif_Set_bc( vn_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) ) ! columns 4 to 11
440
441	CALL Agrif_Set_bc( sshn_id, (/0,ind1-1/) )
442	CALL Agrif_Set_bc( unb_id, (/0,ind1-1/) )
443	CALL Agrif_Set_bc( vnb_id, (/0,ind1-1/) )
444	CALL Agrif_Set_bc( ub2b_interp_id, (/0,ind1-1/) )
445	CALL Agrif_Set_bc( vb2b_interp_id, (/0,ind1-1/) )
446
447	! CALL Agrif_Set_bc( e3t_id, (/-nn_sponge_len*Agrif_irhox(),ind1-1/) )
448	! JC: check near the boundary only until matching in sponge has been sorted out:
449	CALL Agrif_Set_bc( e3t_id, (/0,ind1-1/) )
450	CALL Agrif_Set_bc(glamt_id, (/0,ind1-1/) )
451	CALL Agrif_Set_bc(gphit_id, (/0,ind1-1/) )
452
453	# if defined key_vertical
454	! extend the interpolation zone by 1 more point than necessary:
455	CALL Agrif_Set_bc( mbkt_id, (/-nn_sponge_len*Agrif_irhox()-2,ind1/) )
456	CALL Agrif_Set_bc( ht0_id, (/-nn_sponge_len*Agrif_irhox()-2,ind1/) )
457	# endif
458
459	IF( ln_zdftke.OR.ln_zdfgls ) CALL Agrif_Set_bc( avm_id, (/0,ind1/) )
460
461	! 4. Update type
462	!---------------
463	CALL Agrif_Set_Updatetype(scales_t_id, update = AGRIF_Update_Average)
464	!!$ CALL Agrif_Set_Updatetype(glamt_id, update = AGRIF_Update_Average)
465	!!$ CALL Agrif_Set_Updatetype(gphit_id, update = AGRIF_Update_Average)
466
467	# if defined UPD_HIGH
468	CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting)
469	CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting)
470	CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average)
471
472	CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting)
473	CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average)
474	CALL Agrif_Set_Updatetype(sshn_id,update = Agrif_Update_Full_Weighting)
475	CALL Agrif_Set_Updatetype(e3t_id, update = Agrif_Update_Full_Weighting)
476
477	IF( ln_zdftke.OR.ln_zdfgls ) THEN
478	! CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Full_Weighting)
479	! CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Full_Weighting)
480	! CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Full_Weighting)
481	ENDIF
482
483	#else
484	CALL Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average)
485	CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
486	CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
487
488	CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
489	CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
490	CALL Agrif_Set_Updatetype(sshn_id,update = AGRIF_Update_Average)
491	CALL Agrif_Set_Updatetype(e3t_id, update = AGRIF_Update_Average)
492
493	IF( ln_zdftke.OR.ln_zdfgls ) THEN
494	! CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Average)
495	! CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Average)
496	! CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Average)
497	ENDIF
498
499	#endif
500	!
501	END SUBROUTINE agrif_declare_var
502
503	#if defined key_si3
504	SUBROUTINE Agrif_InitValues_cont_ice
505	!!----------------------------------------------------------------------
506	!! * ROUTINE Agrif_InitValues_cont_ice *
507	!!----------------------------------------------------------------------
508	USE Agrif_Util
509	USE sbc_oce, ONLY : nn_fsbc ! clem: necessary otherwise Agrif_Parent(nn_fsbc) = nn_fsbc
510	USE ice
511	USE agrif_ice
512	USE in_out_manager
513	USE agrif_ice_interp
514	USE lib_mpp
515	!
516	IMPLICIT NONE
517	!!----------------------------------------------------------------------
518	!
519	! Declaration of the type of variable which have to be interpolated (parent=>child)
520	!----------------------------------------------------------------------------------
521	CALL agrif_declare_var_ice
522
523	! Controls
524
525	! clem: For some reason, nn_fsbc(child)/=1 does not work properly (signal can be largely degraded by the agrif zoom)
526	! the run must satisfy CFL=Uice/(dx/dt) < 0.6/nn_fsbc(child)
527	! therefore, if nn_fsbc(child)>1 one must reduce the time-step in proportion to nn_fsbc(child), which is not acceptable
528	! If a solution is found, the following stop could be removed because the rest of the code take nn_fsbc(child) into account
529	IF( nn_fsbc > 1 ) CALL ctl_stop('nn_fsbc(child) must be set to 1 otherwise agrif and sea-ice may not work properly')
530
531	! stop if rhot * nn_fsbc(parent) /= N * nn_fsbc(child) with N being integer
532	IF( MOD( Agrif_irhot() * Agrif_Parent(nn_fsbc), nn_fsbc ) /= 0 ) THEN
533	CALL ctl_stop('rhot * nn_fsbc(parent) /= N * nn_fsbc(child), therefore nn_fsbc(child) should be set to 1 or nn_fsbc(parent)')
534	ENDIF
535	! First Interpolations (using "after" ice subtime step => nbstep_ice=1)
536	!----------------------------------------------------------------------
537	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)
538	CALL agrif_interp_ice('U') ! interpolation of ice velocities
539	CALL agrif_interp_ice('V') ! interpolation of ice velocities
540	CALL agrif_interp_ice('T') ! interpolation of ice tracers
541	nbstep_ice = 0
542	!
543	END SUBROUTINE Agrif_InitValues_cont_ice
544
545	SUBROUTINE agrif_declare_var_ice
546	!!----------------------------------------------------------------------
547	!! * ROUTINE agrif_declare_var_ice *
548	!!----------------------------------------------------------------------
549	USE Agrif_Util
550	USE ice
551	USE par_oce, ONLY : nbghostcells
552	!
553	IMPLICIT NONE
554	!
555	INTEGER :: ind1, ind2, ind3
556	!!----------------------------------------------------------------------
557	!
558	! 1. Declaration of the type of variable which have to be interpolated (parent=>child)
559	! agrif_declare_variable(position,1st point index,--,--,dimensions,name)
560	! ex.: position=> 1,1 = not-centered (in i and j)
561	! 2,2 = centered ( - )
562	! index => 1,1 = one ghost line
563	! 2,2 = two ghost lines
564	!-------------------------------------------------------------------------------------
565	ind1 = nbghostcells ! do the interpolation over nbghostcells points
566	ind2 = nn_hls + nbghostcells + 1 ! U/V points: array index of the first point in the reference grid
567	ind3 = nn_hls + nbghostcells + 2 ! T points: array index of the first point in the reference grid
568	CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpl*(8+nlay_s+nlay_i)/),tra_ice_id)
569	CALL agrif_declare_variable((/1,2/) ,(/ind2,ind3/) ,(/'x','y'/) ,(/1,1/) ,(/jpi,jpj/) ,u_ice_id )
570	CALL agrif_declare_variable((/2,1/) ,(/ind3,ind2/) ,(/'x','y'/) ,(/1,1/) ,(/jpi,jpj/) ,v_ice_id )
571
572	! 2. Set interpolations (normal & tangent to the grid cell for velocities)
573	!-----------------------------------
574	CALL Agrif_Set_bcinterp(tra_ice_id, interp = AGRIF_linear)
575	CALL Agrif_Set_bcinterp(u_ice_id , interp1 = Agrif_linear,interp2 = AGRIF_ppm )
576	CALL Agrif_Set_bcinterp(v_ice_id , interp1 = AGRIF_ppm ,interp2 = Agrif_linear)
577
578	! 3. Set location of interpolations
579	!----------------------------------
580	CALL Agrif_Set_bc(tra_ice_id,(/0,ind1/))
581	CALL Agrif_Set_bc(u_ice_id ,(/0,ind1/))
582	CALL Agrif_Set_bc(v_ice_id ,(/0,ind1/))
583
584	! 4. Set update type in case 2 ways (child=>parent) (normal & tangent to the grid cell for velocities)
585	!--------------------------------------------------
586	# if defined UPD_HIGH
587	CALL Agrif_Set_Updatetype(tra_ice_id, update = Agrif_Update_Full_Weighting)
588	CALL Agrif_Set_Updatetype(u_ice_id , update1 = Agrif_Update_Average , update2 = Agrif_Update_Full_Weighting)
589	CALL Agrif_Set_Updatetype(v_ice_id , update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average )
590	#else
591	CALL Agrif_Set_Updatetype(tra_ice_id, update = AGRIF_Update_Average)
592	CALL Agrif_Set_Updatetype(u_ice_id , update1 = Agrif_Update_Copy , update2 = Agrif_Update_Average)
593	CALL Agrif_Set_Updatetype(v_ice_id , update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy )
594	#endif
595
596	END SUBROUTINE agrif_declare_var_ice
597	#endif
598
599
600	# if defined key_top
601	SUBROUTINE Agrif_InitValues_cont_top
602	!!----------------------------------------------------------------------
603	!! * ROUTINE Agrif_InitValues_cont_top *
604	!!----------------------------------------------------------------------
605	USE Agrif_Util
606	USE oce
607	USE dom_oce
608	USE nemogcm
609	USE par_trc
610	USE lib_mpp
611	USE trc
612	USE in_out_manager
613	USE agrif_oce_sponge
614	USE agrif_top_update
615	USE agrif_top_interp
616	USE agrif_top_sponge
617	!!
618	IMPLICIT NONE
619	!
620	CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3
621	LOGICAL :: check_namelist
622	!!----------------------------------------------------------------------
623
624	! 1. Declaration of the type of variable which have to be interpolated
625	!---------------------------------------------------------------------
626	CALL agrif_declare_var_top
627
628	! 2. First interpolations of potentially non zero fields
629	!-------------------------------------------------------
630	Agrif_SpecialValue=0._wp
631	Agrif_UseSpecialValue = .TRUE.
632	CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn)
633	Agrif_UseSpecialValue = .FALSE.
634	CALL Agrif_Sponge
635	tabspongedone_trn = .FALSE.
636	CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge)
637	! reset ts(:,:,:,:,Krhs_a) to zero
638	tr(:,:,:,:,Krhs_a) = 0._wp
639
640	! 3. Some controls
641	!-----------------
642	check_namelist = .TRUE.
643
644	IF( check_namelist ) THEN
645	! Check time steps
646	IF( NINT(Agrif_Rhot()) * NINT(rn_Dt) .NE. Agrif_Parent(rn_Dt) ) THEN
647	WRITE(cl_check1,*) Agrif_Parent(rn_Dt)
648	WRITE(cl_check2,*) rn_Dt
649	WRITE(cl_check3,) rn_DtAgrif_Rhot()
650	CALL ctl_stop( 'incompatible time step between grids', &
651	& 'parent grid value : '//cl_check1 , &
652	& 'child grid value : '//cl_check2 , &
653	& 'value on child grid should be changed to &
654	& :'//cl_check3 )
655	ENDIF
656
657	! Check run length
658	IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
659	Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN
660	WRITE(cl_check1,) (Agrif_Parent(nit000)-1)Agrif_IRhot() + 1
661	WRITE(cl_check2,) Agrif_Parent(nitend) Agrif_IRhot()
662	CALL ctl_warn( 'incompatible run length between grids' , &
663	& ' nit000 on fine grid will be change to : '//cl_check1, &
664	& ' nitend on fine grid will be change to : '//cl_check2 )
665	nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
666	nitend = Agrif_Parent(nitend) *Agrif_IRhot()
667	ENDIF
668
669	ENDIF
670	!
671	END SUBROUTINE Agrif_InitValues_cont_top
672
673
674	SUBROUTINE agrif_declare_var_top
675	!!----------------------------------------------------------------------
676	!! * ROUTINE agrif_declare_var_top *
677	!!----------------------------------------------------------------------
678	USE agrif_util
679	USE agrif_oce
680	USE dom_oce
681	USE trc
682	!!
683	IMPLICIT NONE
684	!
685	INTEGER :: ind1, ind2, ind3
686	!!----------------------------------------------------------------------
687
688	! 1. Declaration of the type of variable which have to be interpolated
689	!---------------------------------------------------------------------
690	ind1 = nbghostcells ! do the interpolation over nbghostcells points
691	ind2 = nn_hls + nbghostcells + 1 ! U/V points: array index of the first point in the reference grid
692	ind3 = nn_hls + nbghostcells + 2 ! T points: array index of the first point in the reference grid
693	# if defined key_vertical
694	CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra+1/),trn_id)
695	CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra+1/),trn_sponge_id)
696	# else
697	CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_id)
698	CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra/),trn_sponge_id)
699	# endif
700
701	! 2. Type of interpolation
702	!-------------------------
703	CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear)
704	CALL Agrif_Set_bcinterp(trn_sponge_id,interp=AGRIF_linear)
705
706	! 3. Location of interpolation
707	!-----------------------------
708	CALL Agrif_Set_bc(trn_id,(/0,ind1-1/))
709	CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/))
710
711	! 4. Update type
712	!---------------
713	# if defined UPD_HIGH
714	CALL Agrif_Set_Updatetype(trn_id, update = Agrif_Update_Full_Weighting)
715	#else
716	CALL Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average)
717	#endif
718	!
719	END SUBROUTINE agrif_declare_var_top
720	# endif
721
722	SUBROUTINE Agrif_detect( kg, ksizex )
723	!!----------------------------------------------------------------------
724	!! * ROUTINE Agrif_detect *
725	!!----------------------------------------------------------------------
726	INTEGER, DIMENSION(2) :: ksizex
727	INTEGER, DIMENSION(ksizex(1),ksizex(2)) :: kg
728	!!----------------------------------------------------------------------
729	!
730	RETURN
731	!
732	END SUBROUTINE Agrif_detect
733
734	SUBROUTINE agrif_nemo_init
735	!!----------------------------------------------------------------------
736	!! * ROUTINE agrif_init *
737	!!----------------------------------------------------------------------
738	USE agrif_oce
739	USE agrif_ice
740	USE in_out_manager
741	USE lib_mpp
742	!!
743	IMPLICIT NONE
744	!
745	INTEGER :: ios ! Local integer output status for namelist read
746	NAMELIST/namagrif/ ln_agrif_2way, rn_sponge_tra, rn_sponge_dyn, rn_trelax_tra, rn_trelax_dyn, &
747	& ln_spc_dyn, ln_chk_bathy
748	!!--------------------------------------------------------------------------------------
749	!
750	READ ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901)
751	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in reference namelist' )
752	READ ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 )
753	902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namagrif in configuration namelist' )
754	IF(lwm) WRITE ( numond, namagrif )
755	!
756	IF(lwp) THEN ! control print
757	WRITE(numout,*)
758	WRITE(numout,*) 'agrif_nemo_init : AGRIF parameters'
759	WRITE(numout,*) '~~~~~~~~~~~~~~~'
760	WRITE(numout,*) ' Namelist namagrif : set AGRIF parameters'
761	WRITE(numout,*) ' Two way nesting activated ln_agrif_2way = ', ln_agrif_2way
762	WRITE(numout,*) ' sponge coefficient for tracers rn_sponge_tra = ', rn_sponge_tra, ' m^2/s'
763	WRITE(numout,*) ' sponge coefficient for dynamics rn_sponge_tra = ', rn_sponge_dyn, ' m^2/s'
764	WRITE(numout,*) ' time relaxation for tracers rn_trelax_tra = ', rn_trelax_tra, ' ad.'
765	WRITE(numout,*) ' time relaxation for dynamics rn_trelax_dyn = ', rn_trelax_dyn, ' ad.'
766	WRITE(numout,*) ' use special values for dynamics ln_spc_dyn = ', ln_spc_dyn
767	WRITE(numout,*) ' check bathymetry ln_chk_bathy = ', ln_chk_bathy
768	ENDIF
769	!
770	!
771	IF( agrif_oce_alloc() > 0 ) CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed')
772	!
773	END SUBROUTINE agrif_nemo_init
774
775	# if defined key_mpp_mpi
776
777	SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob )
778	!!----------------------------------------------------------------------
779	!! * ROUTINE Agrif_InvLoc *
780	!!----------------------------------------------------------------------
781	USE dom_oce
782	!!
783	IMPLICIT NONE
784	!
785	INTEGER :: indglob, indloc, nprocloc, i
786	!!----------------------------------------------------------------------
787	!
788	SELECT CASE( i )
789	CASE(1) ; indglob = mig(indloc)
790	CASE(2) ; indglob = mjg(indloc)
791	CASE DEFAULT ; indglob = indloc
792	END SELECT
793	!
794	END SUBROUTINE Agrif_InvLoc
795
796	SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax )
797	!!----------------------------------------------------------------------
798	!! * ROUTINE Agrif_get_proc_info *
799	!!----------------------------------------------------------------------
800	USE par_oce
801	!!
802	IMPLICIT NONE
803	!
804	INTEGER, INTENT(out) :: imin, imax
805	INTEGER, INTENT(out) :: jmin, jmax
806	!!----------------------------------------------------------------------
807	!
808	imin = mig( 1 )
809	jmin = mjg( 1 )
810	imax = mig(jpi)
811	jmax = mjg(jpj)
812	!
813	END SUBROUTINE Agrif_get_proc_info
814
815	SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost)
816	!!----------------------------------------------------------------------
817	!! * ROUTINE Agrif_estimate_parallel_cost *
818	!!----------------------------------------------------------------------
819	USE par_oce
820	!!
821	IMPLICIT NONE
822	!
823	INTEGER, INTENT(in) :: imin, imax
824	INTEGER, INTENT(in) :: jmin, jmax
825	INTEGER, INTENT(in) :: nbprocs
826	REAL(wp), INTENT(out) :: grid_cost
827	!!----------------------------------------------------------------------
828	!
829	grid_cost = REAL(imax-imin+1,wp)*REAL(jmax-jmin+1,wp) / REAL(nbprocs,wp)
830	!
831	END SUBROUTINE Agrif_estimate_parallel_cost
832
833	# endif
834
835	#else
836	SUBROUTINE Subcalledbyagrif
837	!!----------------------------------------------------------------------
838	!! * ROUTINE Subcalledbyagrif *
839	!!----------------------------------------------------------------------
840	WRITE(,) 'Impossible to be here'
841	END SUBROUTINE Subcalledbyagrif
842	#endif

Note: See TracBrowser for help on using the repository browser.

Download in other formats: