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

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

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

Download in other formats: