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 @ 13130

Last change on this file since 13130 was 13130, checked in by smasson, 4 years ago
Extra_Halo: supress halos from outputs and coupling, see #2366
Property svn:keywords set to `Id`
File size: 39.3 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
465	# if defined UPD_HIGH
466	CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting)
467	CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting)
468	CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average)
469
470	CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting)
471	CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average)
472	CALL Agrif_Set_Updatetype(sshn_id,update = Agrif_Update_Full_Weighting)
473	CALL Agrif_Set_Updatetype(e3t_id, update = Agrif_Update_Full_Weighting)
474
475	IF( ln_zdftke.OR.ln_zdfgls ) THEN
476	! CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Full_Weighting)
477	! CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Full_Weighting)
478	! CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Full_Weighting)
479	ENDIF
480
481	#else
482	CALL Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average)
483	CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
484	CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
485
486	CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
487	CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
488	CALL Agrif_Set_Updatetype(sshn_id,update = AGRIF_Update_Average)
489	CALL Agrif_Set_Updatetype(e3t_id, update = AGRIF_Update_Average)
490
491	IF( ln_zdftke.OR.ln_zdfgls ) THEN
492	! CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Average)
493	! CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Average)
494	! CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Average)
495	ENDIF
496
497	#endif
498	!
499	END SUBROUTINE agrif_declare_var
500
501	#if defined key_si3
502	SUBROUTINE Agrif_InitValues_cont_ice
503	!!----------------------------------------------------------------------
504	!! * ROUTINE Agrif_InitValues_cont_ice *
505	!!----------------------------------------------------------------------
506	USE Agrif_Util
507	USE sbc_oce, ONLY : nn_fsbc ! clem: necessary otherwise Agrif_Parent(nn_fsbc) = nn_fsbc
508	USE ice
509	USE agrif_ice
510	USE in_out_manager
511	USE agrif_ice_interp
512	USE lib_mpp
513	!
514	IMPLICIT NONE
515	!!----------------------------------------------------------------------
516	!
517	! Declaration of the type of variable which have to be interpolated (parent=>child)
518	!----------------------------------------------------------------------------------
519	CALL agrif_declare_var_ice
520
521	! Controls
522
523	! clem: For some reason, nn_fsbc(child)/=1 does not work properly (signal can be largely degraded by the agrif zoom)
524	! the run must satisfy CFL=Uice/(dx/dt) < 0.6/nn_fsbc(child)
525	! therefore, if nn_fsbc(child)>1 one must reduce the time-step in proportion to nn_fsbc(child), which is not acceptable
526	! If a solution is found, the following stop could be removed because the rest of the code take nn_fsbc(child) into account
527	IF( nn_fsbc > 1 ) CALL ctl_stop('nn_fsbc(child) must be set to 1 otherwise agrif and sea-ice may not work properly')
528
529	! stop if rhot * nn_fsbc(parent) /= N * nn_fsbc(child) with N being integer
530	IF( MOD( Agrif_irhot() * Agrif_Parent(nn_fsbc), nn_fsbc ) /= 0 ) THEN
531	CALL ctl_stop('rhot * nn_fsbc(parent) /= N * nn_fsbc(child), therefore nn_fsbc(child) should be set to 1 or nn_fsbc(parent)')
532	ENDIF
533	! First Interpolations (using "after" ice subtime step => nbstep_ice=1)
534	!----------------------------------------------------------------------
535	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)
536	CALL agrif_interp_ice('U') ! interpolation of ice velocities
537	CALL agrif_interp_ice('V') ! interpolation of ice velocities
538	CALL agrif_interp_ice('T') ! interpolation of ice tracers
539	nbstep_ice = 0
540	!
541	END SUBROUTINE Agrif_InitValues_cont_ice
542
543	SUBROUTINE agrif_declare_var_ice
544	!!----------------------------------------------------------------------
545	!! * ROUTINE agrif_declare_var_ice *
546	!!----------------------------------------------------------------------
547	USE Agrif_Util
548	USE ice
549	USE par_oce, ONLY : nbghostcells
550	!
551	IMPLICIT NONE
552	!
553	INTEGER :: ind1, ind2, ind3
554	!!----------------------------------------------------------------------
555	!
556	! 1. Declaration of the type of variable which have to be interpolated (parent=>child)
557	! agrif_declare_variable(position,1st point index,--,--,dimensions,name)
558	! ex.: position=> 1,1 = not-centered (in i and j)
559	! 2,2 = centered ( - )
560	! index => 1,1 = one ghost line
561	! 2,2 = two ghost lines
562	!-------------------------------------------------------------------------------------
563	ind1 = nbghostcells ! do the interpolation over nbghostcells points
564	ind2 = nn_hls + nbghostcells + 1 ! U/V points: array index of the first point in the reference grid
565	ind3 = nn_hls + nbghostcells + 2 ! T points: array index of the first point in the reference grid
566	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)
567	CALL agrif_declare_variable((/1,2/) ,(/ind2,ind3/) ,(/'x','y'/) ,(/1,1/) ,(/jpi,jpj/) ,u_ice_id )
568	CALL agrif_declare_variable((/2,1/) ,(/ind3,ind2/) ,(/'x','y'/) ,(/1,1/) ,(/jpi,jpj/) ,v_ice_id )
569
570	! 2. Set interpolations (normal & tangent to the grid cell for velocities)
571	!-----------------------------------
572	CALL Agrif_Set_bcinterp(tra_ice_id, interp = AGRIF_linear)
573	CALL Agrif_Set_bcinterp(u_ice_id , interp1 = Agrif_linear,interp2 = AGRIF_ppm )
574	CALL Agrif_Set_bcinterp(v_ice_id , interp1 = AGRIF_ppm ,interp2 = Agrif_linear)
575
576	! 3. Set location of interpolations
577	!----------------------------------
578	CALL Agrif_Set_bc(tra_ice_id,(/0,ind1/))
579	CALL Agrif_Set_bc(u_ice_id ,(/0,ind1/))
580	CALL Agrif_Set_bc(v_ice_id ,(/0,ind1/))
581
582	! 4. Set update type in case 2 ways (child=>parent) (normal & tangent to the grid cell for velocities)
583	!--------------------------------------------------
584	# if defined UPD_HIGH
585	CALL Agrif_Set_Updatetype(tra_ice_id, update = Agrif_Update_Full_Weighting)
586	CALL Agrif_Set_Updatetype(u_ice_id , update1 = Agrif_Update_Average , update2 = Agrif_Update_Full_Weighting)
587	CALL Agrif_Set_Updatetype(v_ice_id , update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average )
588	#else
589	CALL Agrif_Set_Updatetype(tra_ice_id, update = AGRIF_Update_Average)
590	CALL Agrif_Set_Updatetype(u_ice_id , update1 = Agrif_Update_Copy , update2 = Agrif_Update_Average)
591	CALL Agrif_Set_Updatetype(v_ice_id , update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy )
592	#endif
593
594	END SUBROUTINE agrif_declare_var_ice
595	#endif
596
597
598	# if defined key_top
599	SUBROUTINE Agrif_InitValues_cont_top
600	!!----------------------------------------------------------------------
601	!! * ROUTINE Agrif_InitValues_cont_top *
602	!!----------------------------------------------------------------------
603	USE Agrif_Util
604	USE oce
605	USE dom_oce
606	USE nemogcm
607	USE par_trc
608	USE lib_mpp
609	USE trc
610	USE in_out_manager
611	USE agrif_oce_sponge
612	USE agrif_top_update
613	USE agrif_top_interp
614	USE agrif_top_sponge
615	!!
616	IMPLICIT NONE
617	!
618	CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3
619	LOGICAL :: check_namelist
620	!!----------------------------------------------------------------------
621
622	! 1. Declaration of the type of variable which have to be interpolated
623	!---------------------------------------------------------------------
624	CALL agrif_declare_var_top
625
626	! 2. First interpolations of potentially non zero fields
627	!-------------------------------------------------------
628	Agrif_SpecialValue=0._wp
629	Agrif_UseSpecialValue = .TRUE.
630	CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn)
631	Agrif_UseSpecialValue = .FALSE.
632	CALL Agrif_Sponge
633	tabspongedone_trn = .FALSE.
634	CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge)
635	! reset ts(:,:,:,:,Krhs_a) to zero
636	tr(:,:,:,:,Krhs_a) = 0._wp
637
638	! 3. Some controls
639	!-----------------
640	check_namelist = .TRUE.
641
642	IF( check_namelist ) THEN
643	! Check time steps
644	IF( NINT(Agrif_Rhot()) * NINT(rn_Dt) .NE. Agrif_Parent(rn_Dt) ) THEN
645	WRITE(cl_check1,*) Agrif_Parent(rn_Dt)
646	WRITE(cl_check2,*) rn_Dt
647	WRITE(cl_check3,) rn_DtAgrif_Rhot()
648	CALL ctl_stop( 'incompatible time step between grids', &
649	& 'parent grid value : '//cl_check1 , &
650	& 'child grid value : '//cl_check2 , &
651	& 'value on child grid should be changed to &
652	& :'//cl_check3 )
653	ENDIF
654
655	! Check run length
656	IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
657	Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN
658	WRITE(cl_check1,) (Agrif_Parent(nit000)-1)Agrif_IRhot() + 1
659	WRITE(cl_check2,) Agrif_Parent(nitend) Agrif_IRhot()
660	CALL ctl_warn( 'incompatible run length between grids' , &
661	& ' nit000 on fine grid will be change to : '//cl_check1, &
662	& ' nitend on fine grid will be change to : '//cl_check2 )
663	nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
664	nitend = Agrif_Parent(nitend) *Agrif_IRhot()
665	ENDIF
666
667	ENDIF
668	!
669	END SUBROUTINE Agrif_InitValues_cont_top
670
671
672	SUBROUTINE agrif_declare_var_top
673	!!----------------------------------------------------------------------
674	!! * ROUTINE agrif_declare_var_top *
675	!!----------------------------------------------------------------------
676	USE agrif_util
677	USE agrif_oce
678	USE dom_oce
679	USE trc
680	!!
681	IMPLICIT NONE
682	!
683	INTEGER :: ind1, ind2, ind3
684	!!----------------------------------------------------------------------
685
686	! 1. Declaration of the type of variable which have to be interpolated
687	!---------------------------------------------------------------------
688	ind1 = nbghostcells ! do the interpolation over nbghostcells points
689	ind2 = nn_hls + nbghostcells + 1 ! U/V points: array index of the first point in the reference grid
690	ind3 = nn_hls + nbghostcells + 2 ! T points: array index of the first point in the reference grid
691	# if defined key_vertical
692	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)
693	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)
694	# else
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/),trn_id)
696	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)
697	# endif
698
699	! 2. Type of interpolation
700	!-------------------------
701	CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear)
702	CALL Agrif_Set_bcinterp(trn_sponge_id,interp=AGRIF_linear)
703
704	! 3. Location of interpolation
705	!-----------------------------
706	CALL Agrif_Set_bc(trn_id,(/0,ind1-1/))
707	CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/))
708
709	! 4. Update type
710	!---------------
711	# if defined UPD_HIGH
712	CALL Agrif_Set_Updatetype(trn_id, update = Agrif_Update_Full_Weighting)
713	#else
714	CALL Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average)
715	#endif
716	!
717	END SUBROUTINE agrif_declare_var_top
718	# endif
719
720	SUBROUTINE Agrif_detect( kg, ksizex )
721	!!----------------------------------------------------------------------
722	!! * ROUTINE Agrif_detect *
723	!!----------------------------------------------------------------------
724	INTEGER, DIMENSION(2) :: ksizex
725	INTEGER, DIMENSION(ksizex(1),ksizex(2)) :: kg
726	!!----------------------------------------------------------------------
727	!
728	RETURN
729	!
730	END SUBROUTINE Agrif_detect
731
732	SUBROUTINE agrif_nemo_init
733	!!----------------------------------------------------------------------
734	!! * ROUTINE agrif_init *
735	!!----------------------------------------------------------------------
736	USE agrif_oce
737	USE agrif_ice
738	USE in_out_manager
739	USE lib_mpp
740	!!
741	IMPLICIT NONE
742	!
743	INTEGER :: ios ! Local integer output status for namelist read
744	NAMELIST/namagrif/ ln_agrif_2way, rn_sponge_tra, rn_sponge_dyn, rn_trelax_tra, rn_trelax_dyn, &
745	& ln_spc_dyn, ln_chk_bathy
746	!!--------------------------------------------------------------------------------------
747	!
748	READ ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901)
749	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in reference namelist' )
750	READ ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 )
751	902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namagrif in configuration namelist' )
752	IF(lwm) WRITE ( numond, namagrif )
753	!
754	IF(lwp) THEN ! control print
755	WRITE(numout,*)
756	WRITE(numout,*) 'agrif_nemo_init : AGRIF parameters'
757	WRITE(numout,*) '~~~~~~~~~~~~~~~'
758	WRITE(numout,*) ' Namelist namagrif : set AGRIF parameters'
759	WRITE(numout,*) ' Two way nesting activated ln_agrif_2way = ', ln_agrif_2way
760	WRITE(numout,*) ' sponge coefficient for tracers rn_sponge_tra = ', rn_sponge_tra, ' m^2/s'
761	WRITE(numout,*) ' sponge coefficient for dynamics rn_sponge_tra = ', rn_sponge_dyn, ' m^2/s'
762	WRITE(numout,*) ' time relaxation for tracers rn_trelax_tra = ', rn_trelax_tra, ' ad.'
763	WRITE(numout,*) ' time relaxation for dynamics rn_trelax_dyn = ', rn_trelax_dyn, ' ad.'
764	WRITE(numout,*) ' use special values for dynamics ln_spc_dyn = ', ln_spc_dyn
765	WRITE(numout,*) ' check bathymetry ln_chk_bathy = ', ln_chk_bathy
766	ENDIF
767	!
768	!
769	IF( agrif_oce_alloc() > 0 ) CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed')
770	!
771	END SUBROUTINE agrif_nemo_init
772
773	# if defined key_mpp_mpi
774
775	SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob )
776	!!----------------------------------------------------------------------
777	!! * ROUTINE Agrif_InvLoc *
778	!!----------------------------------------------------------------------
779	USE dom_oce
780	!!
781	IMPLICIT NONE
782	!
783	INTEGER :: indglob, indloc, nprocloc, i
784	!!----------------------------------------------------------------------
785	!
786	SELECT CASE( i )
787	CASE(1) ; indglob = mig(indloc)
788	CASE(2) ; indglob = mjg(indloc)
789	CASE DEFAULT ; indglob = indloc
790	END SELECT
791	!
792	END SUBROUTINE Agrif_InvLoc
793
794	SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax )
795	!!----------------------------------------------------------------------
796	!! * ROUTINE Agrif_get_proc_info *
797	!!----------------------------------------------------------------------
798	USE par_oce
799	!!
800	IMPLICIT NONE
801	!
802	INTEGER, INTENT(out) :: imin, imax
803	INTEGER, INTENT(out) :: jmin, jmax
804	!!----------------------------------------------------------------------
805	!
806	imin = mig( 1 )
807	jmin = mjg( 1 )
808	imax = mig(jpi)
809	jmax = mjg(jpj)
810	!
811	END SUBROUTINE Agrif_get_proc_info
812
813	SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost)
814	!!----------------------------------------------------------------------
815	!! * ROUTINE Agrif_estimate_parallel_cost *
816	!!----------------------------------------------------------------------
817	USE par_oce
818	!!
819	IMPLICIT NONE
820	!
821	INTEGER, INTENT(in) :: imin, imax
822	INTEGER, INTENT(in) :: jmin, jmax
823	INTEGER, INTENT(in) :: nbprocs
824	REAL(wp), INTENT(out) :: grid_cost
825	!!----------------------------------------------------------------------
826	!
827	grid_cost = REAL(imax-imin+1,wp)*REAL(jmax-jmin+1,wp) / REAL(nbprocs,wp)
828	!
829	END SUBROUTINE Agrif_estimate_parallel_cost
830
831	# endif
832
833	#else
834	SUBROUTINE Subcalledbyagrif
835	!!----------------------------------------------------------------------
836	!! * ROUTINE Subcalledbyagrif *
837	!!----------------------------------------------------------------------
838	WRITE(,) 'Impossible to be here'
839	END SUBROUTINE Subcalledbyagrif
840	#endif

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

Download in other formats: