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/2021/dev_r14608_AGRIF_domcfg/src/NST – NEMO

Context Navigation

source: NEMO/branches/2021/dev_r14608_AGRIF_domcfg/src/NST/agrif_user.F90 @ 14641

Last change on this file since 14641 was 14641, checked in by jchanut, 3 years ago
1) Revise boundary checking with AGRIF (unify vertical remaping case or not) 2) Disable parent volume check without vertical remaping until we sort out what to do in the damned overlapping zone. At this stage DOMAINcfg produces meshes in agreement with what NEMO expects, except for cyclic East-West child grids for which a mismatch persists at boundaries. Child grids over North Pole Fold or East-West boundaries are however correct, #2638
Property svn:keywords set to `Id`
File size: 51.9 KB

Line
1	#undef UPD_HIGH /* MIX HIGH UPDATE */
2	#define DIV_CONS /* DIVERGENCE CONS */
3	#if defined key_agrif
4	!! * Substitutions
5	# include "do_loop_substitute.h90"
6	!!----------------------------------------------------------------------
7	!! NEMO/NST 4.0 , NEMO Consortium (2018)
8	!! $Id$
9	!! Software governed by the CeCILL license (see ./LICENSE)
10	!!----------------------------------------------------------------------
11	SUBROUTINE agrif_user
12	END SUBROUTINE agrif_user
13
14
15	SUBROUTINE agrif_before_regridding
16	END SUBROUTINE agrif_before_regridding
17
18
19	SUBROUTINE Agrif_InitWorkspace
20	END SUBROUTINE Agrif_InitWorkspace
21
22
23	SUBROUTINE Agrif_InitValues
24	!!----------------------------------------------------------------------
25	!! * ROUTINE Agrif_InitValues *
26	!!----------------------------------------------------------------------
27	USE nemogcm
28	!!----------------------------------------------------------------------
29	!
30	CALL nemo_init !* Initializations of each fine grid
31	Kbb_a = Nbb; Kmm_a = Nnn; Krhs_a = Nrhs ! agrif_oce module copies of time level indices
32	!
33	! !* Agrif initialization
34	CALL Agrif_InitValues_cont
35	# if defined key_top
36	CALL Agrif_InitValues_cont_top
37	# endif
38	# if defined key_si3
39	CALL Agrif_InitValues_cont_ice
40	# endif
41	!
42	END SUBROUTINE Agrif_initvalues
43
44
45	SUBROUTINE agrif_declare_var_ini
46	!!----------------------------------------------------------------------
47	!! * ROUTINE agrif_declare_var_ini *
48	!!----------------------------------------------------------------------
49	USE agrif_util
50	USE agrif_oce
51	USE par_oce
52	USE zdf_oce
53	USE oce
54	USE dom_oce
55	!
56	IMPLICIT NONE
57	!
58	INTEGER :: ind1, ind2, ind3, imaxrho
59	INTEGER :: its
60	External :: nemo_mapping
61	!!----------------------------------------------------------------------
62
63	! In case of East-West periodicity, prevent AGRIF interpolation at east and west boundaries
64	! The procnames will not be called at these boundaries
65	IF (l_Iperio) THEN
66	CALL Agrif_Set_NearCommonBorderX(.TRUE.)
67	CALL Agrif_Set_DistantCommonBorderX(.TRUE.)
68	ENDIF
69
70	IF ( .NOT. lk_south ) THEN
71	CALL Agrif_Set_NearCommonBorderY(.TRUE.)
72	ENDIF
73
74	IF ( .NOT. lk_north ) THEN
75	CALL Agrif_Set_DistantCommonBorderY(.TRUE.)
76	ENDIF
77
78	! 1. Declaration of the type of variable which have to be interpolated
79	!---------------------------------------------------------------------
80	ind1 = nbghostcells
81	ind2 = nn_hls + 2 + nbghostcells_x
82	ind3 = nn_hls + 2 + nbghostcells_y_s
83	imaxrho = MAX(Agrif_irhox(), Agrif_irhoy())
84
85	CALL agrif_declare_variable((/2,2,0 /),(/ind2 ,ind3,0 /),(/'x','y','N' /),(/1,1,1 /),(/jpi,jpj,jpk /), e3t_id)
86	CALL agrif_declare_variable((/2,2,0 /),(/ind2 ,ind3,0 /),(/'x','y','N' /),(/1,1,1 /),(/jpi,jpj,jpk /),e3t0_interp_id)
87	CALL agrif_declare_variable((/2,2 /),(/ind2 ,ind3 /),(/'x','y' /),(/1,1 /),(/jpi,jpj /), mbkt_id)
88	CALL agrif_declare_variable((/2,2 /),(/ind2 ,ind3 /),(/'x','y' /),(/1,1 /),(/jpi,jpj /), ht0_id)
89
90	! Initial or restart velues
91	its = jpts+1
92	CALL agrif_declare_variable((/2,2,0,0/),(/ind2 ,ind3 ,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,its/), tsini_id)
93	CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3 ,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2 /), uini_id)
94	CALL agrif_declare_variable((/2,1,0,0/),(/ind2 ,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2 /), vini_id)
95	CALL agrif_declare_variable((/2,2 /),(/ind2 ,ind3 /),(/'x','y' /),(/1,1 /),(/jpi,jpj /),sshini_id)
96	!
97	! Update location
98	CALL agrif_declare_variable((/2,2/),(/ind2 ,ind3 /),(/'x','y'/),(/1,1/),(/jpi,jpj/), batupd_id)
99
100	! 2. Type of interpolation
101	!-------------------------
102	CALL Agrif_Set_bcinterp( e3t_id,interp =AGRIF_constant)
103	CALL Agrif_Set_bcinterp(e3t0_interp_id,interp =AGRIF_linear )
104	CALL Agrif_Set_interp (e3t0_interp_id,interp =AGRIF_linear )
105	CALL Agrif_Set_bcinterp( mbkt_id,interp =AGRIF_constant)
106	CALL Agrif_Set_interp ( mbkt_id,interp =AGRIF_constant)
107	CALL Agrif_Set_bcinterp( ht0_id,interp =AGRIF_constant)
108	CALL Agrif_Set_interp ( ht0_id,interp =AGRIF_constant)
109
110	! Initial fields
111	CALL Agrif_Set_bcinterp( tsini_id,interp =AGRIF_linear )
112	CALL Agrif_Set_interp ( tsini_id,interp =AGRIF_linear )
113	CALL Agrif_Set_bcinterp( uini_id,interp =AGRIF_linear )
114	CALL Agrif_Set_interp ( uini_id,interp =AGRIF_linear )
115	CALL Agrif_Set_bcinterp( vini_id,interp =AGRIF_linear )
116	CALL Agrif_Set_interp ( vini_id,interp =AGRIF_linear )
117	CALL Agrif_Set_bcinterp(sshini_id,interp =AGRIF_linear )
118	CALL Agrif_Set_interp (sshini_id,interp =AGRIF_linear )
119
120	! 3. Location of interpolation
121	!-----------------------------
122	CALL Agrif_Set_bc( e3t_id, (/-nn_sponge_len*imaxrho-2,ind1-1/) )
123
124	! extend the interpolation zone by 1 more point than necessary:
125	! RB check here
126	CALL Agrif_Set_bc( e3t0_interp_id, (/-nn_sponge_len*imaxrho-2,ind1-1/) )
127	CALL Agrif_Set_bc( mbkt_id, (/-nn_sponge_len*imaxrho-2,ind1-1/) )
128	CALL Agrif_Set_bc( ht0_id, (/-nn_sponge_len*imaxrho-2,ind1-1/) )
129
130	CALL Agrif_Set_bc( tsini_id, (/0,ind1-1/) ) ! if west, rhox=3 and nbghost=3: columns 2 to 4
131	CALL Agrif_Set_bc( uini_id, (/0,ind1-1/) )
132	CALL Agrif_Set_bc( vini_id, (/0,ind1-1/) )
133	CALL Agrif_Set_bc( sshini_id, (/0,ind1-1/) )
134
135	! 4. Update type
136	!---------------
137	# if defined UPD_HIGH
138	CALL Agrif_Set_Updatetype(batupd_id, update = Agrif_Update_Full_Weighting)
139	#else
140	CALL Agrif_Set_Updatetype(batupd_id, update = Agrif_Update_Average)
141	#endif
142
143	CALL Agrif_Set_ExternalMapping(nemo_mapping)
144	!
145	END SUBROUTINE agrif_declare_var_ini
146
147
148	SUBROUTINE Agrif_Init_Domain
149	!!----------------------------------------------------------------------
150	!! * ROUTINE Agrif_Init_Domain *
151	!!----------------------------------------------------------------------
152	USE agrif_oce_update
153	USE agrif_oce_interp
154	USE agrif_oce_sponge
155	USE Agrif_Util
156	USE oce
157	USE dom_oce
158	USE zdf_oce
159	USE nemogcm
160	USE agrif_oce
161	!
162	USE lbclnk
163	USE lib_mpp
164	USE in_out_manager
165	!
166	IMPLICIT NONE
167	!
168	!
169	LOGICAL :: check_namelist
170	CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3, cl_check4
171	REAL(wp), DIMENSION(jpi,jpj) :: zk ! workspace
172	INTEGER :: ji, jj, jk
173	INTEGER :: jpk_parent, ierr
174	!!----------------------------------------------------------------------
175
176	! CALL Agrif_Declare_Var_ini
177
178	IF( agrif_oce_alloc() > 0 ) CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed')
179
180	! Build consistent parent bathymetry and number of levels
181	! on the child grid
182	Agrif_UseSpecialValue = .FALSE.
183	ht0_parent( :,:) = 0._wp
184	mbkt_parent(:,:) = 0
185	!
186	! CALL Agrif_Bc_variable(ht0_id ,calledweight=1.,procname=interpht0 )
187	! CALL Agrif_Bc_variable(mbkt_id,calledweight=1.,procname=interpmbkt)
188	CALL Agrif_Init_Variable(ht0_id , procname=interpht0 )
189	CALL Agrif_Init_Variable(mbkt_id, procname=interpmbkt)
190	!
191	! Assume step wise change of bathymetry near interface
192	! TODO: Switch to linear interpolation of bathymetry in the s-coordinate case
193	! and no refinement
194	DO_2D( 1, 0, 1, 0 )
195	mbku_parent(ji,jj) = MIN( mbkt_parent(ji+1,jj ), mbkt_parent(ji,jj) )
196	mbkv_parent(ji,jj) = MIN( mbkt_parent(ji ,jj+1), mbkt_parent(ji,jj) )
197	END_2D
198	IF ( ln_sco.AND.Agrif_Parent(ln_sco) ) THEN
199	DO_2D( 1, 0, 1, 0 )
200	hu0_parent(ji,jj) = 0.5_wp * ( ht0_parent(ji,jj)+ht0_parent(ji+1,jj) ) * ssumask(ji,jj)
201	hv0_parent(ji,jj) = 0.5_wp * ( ht0_parent(ji,jj)+ht0_parent(ji,jj+1) ) * ssvmask(ji,jj)
202	END_2D
203	ELSE
204	DO_2D( 1, 0, 1, 0 )
205	hu0_parent(ji,jj) = MIN( ht0_parent(ji,jj), ht0_parent(ji+1,jj) )
206	hv0_parent(ji,jj) = MIN( ht0_parent(ji,jj), ht0_parent(ji,jj+1) )
207	END_2D
208	ENDIF
209	!
210	CALL lbc_lnk( 'Agrif_Init_Domain', hu0_parent, 'U', 1.0_wp, hv0_parent, 'V', 1.0_wp )
211	DO_2D( 0, 0, 0, 0 )
212	zk(ji,jj) = REAL( mbku_parent(ji,jj), wp )
213	END_2D
214	CALL lbc_lnk( 'Agrif_InitValues_Domain', zk, 'U', 1.0_wp )
215	mbku_parent(:,:) = MAX( NINT( zk(:,:) ), 1 )
216	DO_2D( 0, 0, 0, 0 )
217	zk(ji,jj) = REAL( mbkv_parent(ji,jj), wp )
218	END_2D
219	CALL lbc_lnk( 'Agrif_InitValues_Domain', zk, 'V', 1.0_wp )
220	mbkv_parent(:,:) = MAX( NINT( zk(:,:) ), 1 )
221	!
222	! Build "intermediate" parent vertical grid on child domain
223	jpk_parent = Agrif_parent( jpk )
224	ALLOCATE(e3t0_parent(jpi,jpj,jpk_parent), &
225	& e3u0_parent(jpi,jpj,jpk_parent), &
226	& e3v0_parent(jpi,jpj,jpk_parent), STAT = ierr)
227	IF( ierr > 0 ) CALL ctl_warn('Agrif_Init_Domain: allocation of arrays failed')
228
229	! Retrieve expected parent scale factors on child grid:
230	Agrif_UseSpecialValue = .FALSE.
231	e3t0_parent(:,:,:) = 0._wp
232	CALL Agrif_Init_Variable(e3t0_interp_id, procname=interpe3t0_vremap)
233	!
234	! Deduce scale factors at U and V points:
235	DO_3D( 0, 0, 0, 0, 1, jpk_parent )
236	e3u0_parent(ji,jj,jk) = 0.5_wp * (e3t0_parent(ji,jj,jk) + e3t0_parent(ji+1,jj ,jk))
237	e3v0_parent(ji,jj,jk) = 0.5_wp * (e3t0_parent(ji,jj,jk) + e3t0_parent(ji ,jj+1,jk))
238	END_3D
239
240	! Assume a step at the bottom except if (pure) s-coordinates
241	IF ( .NOT.Agrif_Parent(ln_sco) ) THEN
242	DO_2D( 1, 0, 1, 0 )
243	jk = mbku_parent(ji,jj)
244	e3u0_parent(ji,jj,jk) = MIN(e3t0_parent(ji,jj,jk), e3t0_parent(ji+1,jj ,jk))
245	jk = mbkv_parent(ji,jj)
246	e3v0_parent(ji,jj,jk) = MIN(e3t0_parent(ji,jj,jk), e3t0_parent(ji ,jj+1,jk))
247	END_2D
248	ENDIF
249
250	CALL lbc_lnk( 'Agrif_Init_Domain', e3u0_parent, 'U', 1.0_wp, e3v0_parent, 'V', 1.0_wp )
251
252	! check if masks and bathymetries match
253	IF(ln_chk_bathy) THEN
254	Agrif_UseSpecialValue = .FALSE.
255	!
256	IF(lwp) WRITE(numout,*) ' '
257	IF(lwp) WRITE(numout,*) 'AGRIF: Check Bathymetry and masks near bdys. Level: ', Agrif_Level()
258	!
259	kindic_agr = 0
260	!
261	CALL Agrif_check_bat( kindic_agr )
262	!
263	CALL mpp_sum( 'agrif_InitValues_Domain', kindic_agr )
264	IF( kindic_agr /= 0 ) THEN
265	CALL ctl_stop('==> Child Bathymetry is NOT correct near boundaries.')
266	ELSE
267	IF(lwp) WRITE(numout,*) '==> Child Bathymetry is ok near boundaries.'
268	IF(lwp) WRITE(numout,*) ' '
269	ENDIF
270	ENDIF
271	!
272	WHERE (ssumask(:,:) == 0._wp) mbku_parent(:,:) = 0
273	WHERE (ssvmask(:,:) == 0._wp) mbkv_parent(:,:) = 0
274	WHERE (ssmask(:,:) == 0._wp) mbkt_parent(:,:) = 0
275	!
276	IF ( .NOT.ln_vert_remap ) DEALLOCATE(e3t0_parent, e3u0_parent, e3v0_parent)
277
278	END SUBROUTINE Agrif_Init_Domain
279
280
281	SUBROUTINE Agrif_InitValues_cont
282	!!----------------------------------------------------------------------
283	!! * ROUTINE Agrif_InitValues_cont *
284	!!
285	!! ** Purpose :: Declaration of variables to be interpolated
286	!!----------------------------------------------------------------------
287	USE agrif_oce_update
288	USE agrif_oce_interp
289	USE agrif_oce_sponge
290	USE Agrif_Util
291	USE oce
292	USE dom_oce
293	USE zdf_oce
294	USE nemogcm
295	USE agrif_oce
296	!
297	USE lbclnk
298	USE lib_mpp
299	USE in_out_manager
300	!
301	IMPLICIT NONE
302	!
303	LOGICAL :: check_namelist
304	CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3, cl_check4
305
306	! 1. Declaration of the type of variable which have to be interpolated
307	!---------------------------------------------------------------------
308	CALL agrif_declare_var
309
310	! 2. First interpolations of potentially non zero fields
311	!-------------------------------------------------------
312	Agrif_SpecialValue = 0._wp
313	Agrif_UseSpecialValue = .TRUE.
314	l_vremap = ln_vert_remap
315
316	CALL Agrif_Bc_variable(ts_interp_id,calledweight=1.,procname=interptsn)
317	CALL Agrif_Sponge
318	tabspongedone_tsn = .FALSE.
319	CALL Agrif_Bc_variable(ts_sponge_id,calledweight=1.,procname=interptsn_sponge)
320	! reset tsa to zero
321	ts(:,:,:,:,Krhs_a) = 0._wp
322
323	Agrif_UseSpecialValue = ln_spc_dyn
324	use_sign_north = .TRUE.
325	sign_north = -1.
326	CALL Agrif_Bc_variable(un_interp_id,calledweight=1.,procname=interpun)
327	CALL Agrif_Bc_variable(vn_interp_id,calledweight=1.,procname=interpvn)
328	tabspongedone_u = .FALSE.
329	tabspongedone_v = .FALSE.
330	CALL Agrif_Bc_variable(un_sponge_id,calledweight=1.,procname=interpun_sponge)
331	tabspongedone_u = .FALSE.
332	tabspongedone_v = .FALSE.
333	CALL Agrif_Bc_variable(vn_sponge_id,calledweight=1.,procname=interpvn_sponge)
334	IF (nn_shift_bar>0) THEN
335	CALL Agrif_Sponge_2d
336	tabspongedone_u = .FALSE.
337	tabspongedone_v = .FALSE.
338	CALL Agrif_Bc_variable(unb_sponge_id,calledweight=1.,procname=interpunb_sponge)
339	tabspongedone_u = .FALSE.
340	tabspongedone_v = .FALSE.
341	CALL Agrif_Bc_variable(vnb_sponge_id,calledweight=1.,procname=interpvnb_sponge)
342	ENDIF
343	use_sign_north = .FALSE.
344	uu(:,:,:,Krhs_a) = 0._wp
345	vv(:,:,:,Krhs_a) = 0._wp
346
347	Agrif_UseSpecialValue = .TRUE.
348	CALL Agrif_Bc_variable(sshn_id,calledweight=1., procname=interpsshn )
349	hbdy(:,:) = 0._wp
350	ssh(:,:,Krhs_a) = 0._wp
351
352	IF ( ln_dynspg_ts ) THEN
353	Agrif_UseSpecialValue = ln_spc_dyn
354	use_sign_north = .TRUE.
355	sign_north = -1.
356	CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b) ! must be called before unb_id to define ubdy
357	CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b) ! must be called before vnb_id to define vbdy
358	CALL Agrif_Bc_variable( unb_interp_id,calledweight=1.,procname=interpunb )
359	CALL Agrif_Bc_variable( vnb_interp_id,calledweight=1.,procname=interpvnb )
360	use_sign_north = .FALSE.
361	ubdy(:,:) = 0._wp
362	vbdy(:,:) = 0._wp
363	ELSEIF ( ln_dynspg_EXP ) THEN
364	Agrif_UseSpecialValue = ln_spc_dyn
365	use_sign_north = .TRUE.
366	sign_north = -1.
367	ubdy(:,:) = 0._wp
368	vbdy(:,:) = 0._wp
369	CALL Agrif_Bc_variable( unb_interp_id,calledweight=1.,procname=interpunb )
370	CALL Agrif_Bc_variable( vnb_interp_id,calledweight=1.,procname=interpvnb )
371	use_sign_north = .FALSE.
372	ubdy(:,:) = 0._wp
373	vbdy(:,:) = 0._wp
374	ENDIF
375	Agrif_UseSpecialValue = .FALSE.
376	l_vremap = .FALSE.
377
378	!-----------------
379	check_namelist = .TRUE.
380
381	IF( check_namelist ) THEN
382	! Check free surface scheme
383	IF ( ( Agrif_Parent(ln_dynspg_ts ).AND.ln_dynspg_exp ).OR.&
384	& ( Agrif_Parent(ln_dynspg_exp).AND.ln_dynspg_ts ) ) THEN
385	WRITE(cl_check1,*) Agrif_Parent( ln_dynspg_ts )
386	WRITE(cl_check2,*) ln_dynspg_ts
387	WRITE(cl_check3,*) Agrif_Parent( ln_dynspg_exp )
388	WRITE(cl_check4,*) ln_dynspg_exp
389	CALL ctl_stop( 'Incompatible free surface scheme between grids' , &
390	& 'parent grid ln_dynspg_ts :'//cl_check1 , &
391	& 'child grid ln_dynspg_ts :'//cl_check2 , &
392	& 'parent grid ln_dynspg_exp :'//cl_check3 , &
393	& 'child grid ln_dynspg_exp :'//cl_check4 , &
394	& 'those logicals should be identical' )
395	STOP
396	ENDIF
397
398	! Check if identical linear free surface option
399	IF ( ( Agrif_Parent(ln_linssh ).AND.(.NOT.ln_linssh )).OR.&
400	& ( (.NOT.Agrif_Parent(ln_linssh)).AND.ln_linssh ) ) THEN
401	WRITE(cl_check1,*) Agrif_Parent(ln_linssh )
402	WRITE(cl_check2,*) ln_linssh
403	CALL ctl_stop( 'Incompatible linearized fs option between grids', &
404	& 'parent grid ln_linssh :'//cl_check1 , &
405	& 'child grid ln_linssh :'//cl_check2 , &
406	& 'those logicals should be identical' )
407	STOP
408	ENDIF
409	ENDIF
410
411	END SUBROUTINE Agrif_InitValues_cont
412
413	SUBROUTINE agrif_declare_var
414	!!----------------------------------------------------------------------
415	!! * ROUTINE agrif_declare_var *
416	!!----------------------------------------------------------------------
417	USE agrif_util
418	USE agrif_oce
419	USE par_oce
420	USE zdf_oce
421	USE oce
422	!
423	IMPLICIT NONE
424	!
425	INTEGER :: ind1, ind2, ind3, imaxrho
426	!!----------------------------------------------------------------------
427
428	! 1. Declaration of the type of variable which have to be interpolated
429	!---------------------------------------------------------------------
430	ind1 = nbghostcells
431	ind2 = nn_hls + 2 + nbghostcells_x
432	ind3 = nn_hls + 2 + nbghostcells_y_s
433	imaxrho = MAX(Agrif_irhox(), Agrif_irhoy())
434
435	CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/) ,(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts+1/),ts_interp_id)
436	CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/) ,(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts+1/),ts_update_id)
437	CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/) ,(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jpts+1/),ts_sponge_id)
438	CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_interp_id)
439	CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_interp_id)
440	CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_update_id)
441	CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_update_id)
442	CALL agrif_declare_variable((/1,2,0,0/),(/ind2-1,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),un_sponge_id)
443	CALL agrif_declare_variable((/2,1,0,0/),(/ind2,ind3-1,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),vn_sponge_id)
444
445	CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/) ,sshn_id)
446	CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/), unb_interp_id)
447	CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/), vnb_interp_id)
448	CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ub2b_interp_id)
449	CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vb2b_interp_id)
450	CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/), unb_sponge_id)
451	CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/), vnb_sponge_id)
452	CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),ub2b_update_id)
453	CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/),vb2b_update_id)
454	CALL agrif_declare_variable((/1,2/),(/ind2-1,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/), unb_update_id)
455	CALL agrif_declare_variable((/2,1/),(/ind2,ind3-1/),(/'x','y'/),(/1,1/),(/jpi,jpj/), vnb_update_id)
456	CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/) ,ub2b_cor_id)
457	CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/) ,vb2b_cor_id)
458	! CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),glamt_id)
459	! CALL agrif_declare_variable((/2,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/jpi,jpj/),gphit_id)
460
461
462	IF( ln_zdftke.OR.ln_zdfgls ) THEN ! logical not known at this point
463	! CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/), en_id)
464	! CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,jpk/),avt_id)
465	CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,2/),avm_id)
466	ENDIF
467
468	! 2. Type of interpolation
469	!-------------------------
470	CALL Agrif_Set_bcinterp( ts_interp_id,interp =AGRIF_linear)
471	CALL Agrif_Set_bcinterp( ts_sponge_id,interp =AGRIF_linear)
472
473	#if defined DIV_CONS
474	lk_tint2d_notinterp = .TRUE.
475	CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_constant)
476	CALL Agrif_Set_bcinterp(ub2b_cor_id,interp=AGRIF_constant)
477	CALL Agrif_Set_bcinterp(vb2b_cor_id,interp=AGRIF_constant)
478	CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_linearconserv)
479	CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_linearconserv,interp2=Agrif_linear)
480	#else
481	lk_tint2d_notinterp = .FALSE.
482	CALL Agrif_Set_bcinterp(sshn_id,interp =AGRIF_linear)
483	CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
484	CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
485	#endif
486
487	CALL Agrif_Set_bcinterp(unb_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm )
488	CALL Agrif_Set_bcinterp(vnb_interp_id,interp1=AGRIF_ppm ,interp2=Agrif_linear)
489	CALL Agrif_Set_bcinterp(unb_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm )
490	CALL Agrif_Set_bcinterp(vnb_sponge_id,interp1=AGRIF_ppm ,interp2=Agrif_linear)
491
492	CALL Agrif_Set_bcinterp(un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm )
493	CALL Agrif_Set_bcinterp(vn_interp_id,interp1=AGRIF_ppm ,interp2=Agrif_linear)
494
495	CALL Agrif_Set_bcinterp(un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm )
496	CALL Agrif_Set_bcinterp(vn_sponge_id,interp1=AGRIF_ppm ,interp2=Agrif_linear)
497
498	IF( ln_zdftke.OR.ln_zdfgls ) CALL Agrif_Set_bcinterp( avm_id, interp=AGRIF_linear )
499
500
501	! CALL Agrif_Set_bcinterp(gphit_id,interp=AGRIF_constant)
502	! CALL Agrif_Set_bcinterp(glamt_id,interp=AGRIF_constant)
503
504	! 3. Location of interpolation
505	!-----------------------------
506	CALL Agrif_Set_bc( ts_interp_id, (/0,ind1-1/) ) ! if west, rhox=3 and nbghost=3: columns 2 to 4
507	CALL Agrif_Set_bc( un_interp_id, (/0,ind1-1/) )
508	CALL Agrif_Set_bc( vn_interp_id, (/0,ind1-1/) )
509
510	CALL Agrif_Set_bc( ts_sponge_id, (/-nn_sponge_len*imaxrho-1,0/) ) ! if west, rhox=3, nn_sponge_len=2
511	CALL Agrif_Set_bc( un_sponge_id, (/-nn_sponge_len*imaxrho-1,0/) ) ! and nbghost=3:
512	CALL Agrif_Set_bc( vn_sponge_id, (/-nn_sponge_len*imaxrho-1,0/) ) ! columns 4 to 11
513
514	CALL Agrif_Set_bc( sshn_id, (/-imaxrho*nn_shift_bar,ind1-1/) )
515	CALL Agrif_Set_bc( unb_interp_id, (/-imaxrho*nn_shift_bar,ind1-1/) )
516	CALL Agrif_Set_bc( vnb_interp_id, (/-imaxrho*nn_shift_bar,ind1-1/) )
517	CALL Agrif_Set_bc(ub2b_interp_id, (/-imaxrho*nn_shift_bar,ind1-1/) )
518	CALL Agrif_Set_bc(vb2b_interp_id, (/-imaxrho*nn_shift_bar,ind1-1/) )
519	CALL Agrif_Set_bc( unb_sponge_id, (/-(nn_sponge_len+nn_shift_bar)imaxrho,-imaxrhonn_shift_bar/) )
520	CALL Agrif_Set_bc( vnb_sponge_id, (/-(nn_sponge_len+nn_shift_bar)imaxrho,-imaxrhonn_shift_bar/) )
521	CALL Agrif_Set_bc( ub2b_cor_id, (/-imaxrho*nn_shift_bar,ind1/) )
522	CALL Agrif_Set_bc( vb2b_cor_id, (/-imaxrho*nn_shift_bar,ind1/) )
523	IF( ln_zdftke.OR.ln_zdfgls ) CALL Agrif_Set_bc( avm_id, (/0,ind1-1/) )
524	!!$ CALL Agrif_Set_bc(glamt_id, (/0,ind1-1/) )
525	!!$ CALL Agrif_Set_bc(gphit_id, (/0,ind1-1/) )
526
527	! 4. Update type
528	!---------------
529
530	# if defined UPD_HIGH
531	CALL Agrif_Set_Updatetype( ts_interp_id,update = Agrif_Update_Full_Weighting)
532	CALL Agrif_Set_Updatetype( un_update_id,update1 = Agrif_Update_Average , update2 = Agrif_Update_Full_Weighting)
533	CALL Agrif_Set_Updatetype( vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average )
534
535	CALL Agrif_Set_Updatetype( unb_update_id,update1 = Agrif_Update_Average , update2 = Agrif_Update_Full_Weighting)
536	CALL Agrif_Set_Updatetype( vnb_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average )
537	CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average , update2 = Agrif_Update_Full_Weighting)
538	CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average )
539	CALL Agrif_Set_Updatetype( sshn_id,update = Agrif_Update_Full_Weighting)
540	CALL Agrif_Set_Updatetype( e3t_id,update = Agrif_Update_Full_Weighting)
541
542	! IF( ln_zdftke.OR.ln_zdfgls ) THEN
543	! CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Full_Weighting)
544	! CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Full_Weighting)
545	! CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Full_Weighting)
546	! ENDIF
547
548	#else
549	CALL Agrif_Set_Updatetype( ts_update_id,update = AGRIF_Update_Average)
550	CALL Agrif_Set_Updatetype( un_update_id,update1 = Agrif_Update_Copy , update2 = Agrif_Update_Average)
551	CALL Agrif_Set_Updatetype( vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy )
552
553	CALL Agrif_Set_Updatetype( unb_update_id,update1 = Agrif_Update_Copy , update2 = Agrif_Update_Average)
554	CALL Agrif_Set_Updatetype( vnb_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy )
555	CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy , update2 = Agrif_Update_Average)
556	CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy )
557	CALL Agrif_Set_Updatetype( sshn_id,update = AGRIF_Update_Average)
558	CALL Agrif_Set_Updatetype( e3t_id,update = AGRIF_Update_Average)
559
560	! IF( ln_zdftke.OR.ln_zdfgls ) THEN
561	! CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Average)
562	! CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Average)
563	! CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Average)
564	! ENDIF
565
566	#endif
567	!
568	END SUBROUTINE agrif_declare_var
569
570	#if defined key_si3
571	SUBROUTINE Agrif_InitValues_cont_ice
572	!!----------------------------------------------------------------------
573	!! * ROUTINE Agrif_InitValues_cont_ice *
574	!!----------------------------------------------------------------------
575	USE Agrif_Util
576	USE sbc_oce, ONLY : nn_fsbc ! clem: necessary otherwise Agrif_Parent(nn_fsbc) = nn_fsbc
577	USE ice
578	USE agrif_ice
579	USE in_out_manager
580	USE agrif_ice_interp
581	USE lib_mpp
582	!
583	IMPLICIT NONE
584	!
585	!!----------------------------------------------------------------------
586	! Controls
587
588	! clem: For some reason, nn_fsbc(child)/=1 does not work properly (signal can be largely degraded by the agrif zoom)
589	! the run must satisfy CFL=Uice/(dx/dt) < 0.6/nn_fsbc(child)
590	! therefore, if nn_fsbc(child)>1 one must reduce the time-step in proportion to nn_fsbc(child), which is not acceptable
591	! If a solution is found, the following stop could be removed because the rest of the code take nn_fsbc(child) into account
592	IF( nn_fsbc > 1 ) CALL ctl_stop('nn_fsbc(child) must be set to 1 otherwise agrif and sea-ice may not work properly')
593
594	! stop if rhot * nn_fsbc(parent) /= N * nn_fsbc(child) with N being integer
595	IF( MOD( Agrif_irhot() * Agrif_Parent(nn_fsbc), nn_fsbc ) /= 0 ) THEN
596	CALL ctl_stop('rhot * nn_fsbc(parent) /= N * nn_fsbc(child), therefore nn_fsbc(child) should be set to 1 or nn_fsbc(parent)')
597	ENDIF
598	! First Interpolations (using "after" ice subtime step => nbstep_ice=1)
599	!----------------------------------------------------------------------
600	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)
601	CALL agrif_interp_ice('U') ! interpolation of ice velocities
602	CALL agrif_interp_ice('V') ! interpolation of ice velocities
603	CALL agrif_interp_ice('T') ! interpolation of ice tracers
604	nbstep_ice = 0
605	!
606	END SUBROUTINE Agrif_InitValues_cont_ice
607
608
609	SUBROUTINE agrif_declare_var_ice
610	!!----------------------------------------------------------------------
611	!! * ROUTINE agrif_declare_var_ice *
612	!!----------------------------------------------------------------------
613	USE Agrif_Util
614	USE ice
615	USE par_oce, ONLY : nbghostcells, nbghostcells_x, nbghostcells_y_s
616	!
617	IMPLICIT NONE
618	!
619	INTEGER :: ind1, ind2, ind3
620	INTEGER :: ipl
621	!!----------------------------------------------------------------------
622	!
623	! 1. Declaration of the type of variable which have to be interpolated (parent=>child)
624	! agrif_declare_variable(position,1st point index,--,--,dimensions,name)
625	! ex.: position=> 1,1 = not-centered (in i and j)
626	! 2,2 = centered ( - )
627	! index => 1,1 = one ghost line
628	! 2,2 = two ghost lines
629	!-------------------------------------------------------------------------------------
630	ind1 = nbghostcells
631	ind2 = nn_hls + 2 + nbghostcells_x
632	ind3 = nn_hls + 2 + nbghostcells_y_s
633	ipl = jpl*(9+nlay_s+nlay_i)
634	CALL agrif_declare_variable((/2,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,ipl/),tra_ice_id)
635	CALL agrif_declare_variable((/1,2/) ,(/ind2-1,ind3/),(/'x','y' /),(/1,1 /),(/jpi,jpj /), u_ice_id)
636	CALL agrif_declare_variable((/2,1/) ,(/ind2,ind3-1/),(/'x','y' /),(/1,1 /),(/jpi,jpj /), v_ice_id)
637
638	CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/jpi,jpj,ipl/),tra_iceini_id)
639	CALL agrif_declare_variable((/1,2/) ,(/ind2-1,ind3/),(/'x','y' /),(/1,1 /),(/jpi,jpj /), u_iceini_id)
640	CALL agrif_declare_variable((/2,1/) ,(/ind2,ind3-1/),(/'x','y' /),(/1,1 /),(/jpi,jpj /), v_iceini_id)
641
642	! 2. Set interpolations (normal & tangent to the grid cell for velocities)
643	!-----------------------------------
644	CALL Agrif_Set_bcinterp(tra_ice_id, interp = AGRIF_linear)
645	CALL Agrif_Set_bcinterp(u_ice_id , interp1 = Agrif_linear,interp2 = AGRIF_ppm )
646	CALL Agrif_Set_bcinterp(v_ice_id , interp1 = AGRIF_ppm ,interp2 = Agrif_linear)
647
648	CALL Agrif_Set_bcinterp(tra_iceini_id, interp = AGRIF_linear)
649	CALL Agrif_Set_interp (tra_iceini_id, interp = AGRIF_linear)
650	CALL Agrif_Set_bcinterp(u_iceini_id , interp = AGRIF_linear)
651	CALL Agrif_Set_interp (u_iceini_id , interp = AGRIF_linear)
652	CALL Agrif_Set_bcinterp(v_iceini_id , interp = AGRIF_linear)
653	CALL Agrif_Set_interp (v_iceini_id , interp = AGRIF_linear)
654
655	! 3. Set location of interpolations
656	!----------------------------------
657	CALL Agrif_Set_bc(tra_ice_id,(/0,ind1/))
658	CALL Agrif_Set_bc(u_ice_id ,(/0,ind1/))
659	CALL Agrif_Set_bc(v_ice_id ,(/0,ind1/))
660
661	CALL Agrif_Set_bc(tra_iceini_id,(/0,ind1/))
662	CALL Agrif_Set_bc(u_iceini_id ,(/0,ind1/))
663	CALL Agrif_Set_bc(v_iceini_id ,(/0,ind1/))
664
665	! 4. Set update type in case 2 ways (child=>parent) (normal & tangent to the grid cell for velocities)
666	!--------------------------------------------------
667	# if defined UPD_HIGH
668	CALL Agrif_Set_Updatetype(tra_ice_id, update = Agrif_Update_Full_Weighting)
669	CALL Agrif_Set_Updatetype(u_ice_id , update1 = Agrif_Update_Average , update2 = Agrif_Update_Full_Weighting)
670	CALL Agrif_Set_Updatetype(v_ice_id , update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average )
671	# else
672	CALL Agrif_Set_Updatetype(tra_ice_id, update = AGRIF_Update_Average)
673	CALL Agrif_Set_Updatetype(u_ice_id , update1 = Agrif_Update_Copy , update2 = Agrif_Update_Average)
674	CALL Agrif_Set_Updatetype(v_ice_id , update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy )
675	# endif
676
677	END SUBROUTINE agrif_declare_var_ice
678	#endif
679
680
681	# if defined key_top
682	SUBROUTINE Agrif_InitValues_cont_top
683	!!----------------------------------------------------------------------
684	!! * ROUTINE Agrif_InitValues_cont_top *
685	!!----------------------------------------------------------------------
686	USE Agrif_Util
687	USE oce
688	USE dom_oce
689	USE nemogcm
690	USE par_trc
691	USE lib_mpp
692	USE trc
693	USE in_out_manager
694	USE agrif_oce_sponge
695	USE agrif_top_update
696	USE agrif_top_interp
697	USE agrif_top_sponge
698	!
699	IMPLICIT NONE
700	!
701	CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3
702	LOGICAL :: check_namelist
703	!!----------------------------------------------------------------------
704
705	! 1. Declaration of the type of variable which have to be interpolated
706	!---------------------------------------------------------------------
707	CALL agrif_declare_var_top
708
709	! 2. First interpolations of potentially non zero fields
710	!-------------------------------------------------------
711	Agrif_SpecialValue=0._wp
712	Agrif_UseSpecialValue = .TRUE.
713	CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn)
714	Agrif_UseSpecialValue = .FALSE.
715	CALL Agrif_Sponge
716	tabspongedone_trn = .FALSE.
717	CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge)
718	! reset tsa to zero
719	tr(:,:,:,:,Krhs_a) = 0._wp
720
721	! 3. Some controls
722	!-----------------
723	check_namelist = .TRUE.
724
725	IF( check_namelist ) THEN
726	! Check time steps
727	IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN
728	WRITE(cl_check1,*) Agrif_Parent(rdt)
729	WRITE(cl_check2,*) rdt
730	WRITE(cl_check3,) rdtAgrif_Rhot()
731	CALL ctl_stop( 'incompatible time step between grids', &
732	& 'parent grid value : '//cl_check1 , &
733	& 'child grid value : '//cl_check2 , &
734	& 'value on child grid should be changed to &
735	& :'//cl_check3 )
736	ENDIF
737
738	! Check run length
739	IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
740	Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN
741	WRITE(cl_check1,) (Agrif_Parent(nit000)-1)Agrif_IRhot() + 1
742	WRITE(cl_check2,) Agrif_Parent(nitend) Agrif_IRhot()
743	CALL ctl_warn( 'incompatible run length between grids' , &
744	& ' nit000 on fine grid will be change to : '//cl_check1, &
745	& ' nitend on fine grid will be change to : '//cl_check2 )
746	nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
747	nitend = Agrif_Parent(nitend) *Agrif_IRhot()
748	ENDIF
749	ENDIF
750	!
751	END SUBROUTINE Agrif_InitValues_cont_top
752
753
754	SUBROUTINE agrif_declare_var_top
755	!!----------------------------------------------------------------------
756	!! * ROUTINE agrif_declare_var_top *
757	!!----------------------------------------------------------------------
758	USE agrif_util
759	USE agrif_oce
760	USE dom_oce
761	USE trc
762	!!
763	IMPLICIT NONE
764	!
765	INTEGER :: ind1, ind2, ind3, imaxrho
766	!!----------------------------------------------------------------------
767	!RB_CMEMS : declare here init for top
768	! 1. Declaration of the type of variable which have to be interpolated
769	!---------------------------------------------------------------------
770	ind1 = nbghostcells
771	ind2 = nn_hls + 2 + nbghostcells_x
772	ind3 = nn_hls + 2 + nbghostcells_y_s
773	imaxrho = MAX(Agrif_irhox(), Agrif_irhoy())
774
775	CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra+1/),trn_id)
776	CALL agrif_declare_variable((/2,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/jpi,jpj,jpk,jptra+1/),trn_sponge_id)
777
778	! 2. Type of interpolation
779	!-------------------------
780	CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear)
781	CALL Agrif_Set_bcinterp(trn_sponge_id,interp=AGRIF_linear)
782
783	! 3. Location of interpolation
784	!-----------------------------
785	CALL Agrif_Set_bc(trn_id,(/0,ind1-1/))
786	CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*imaxrho-1,0/))
787
788	! 4. Update type
789	!---------------
790	# if defined UPD_HIGH
791	CALL Agrif_Set_Updatetype(trn_id, update = Agrif_Update_Full_Weighting)
792	#else
793	CALL Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average)
794	#endif
795	!
796	END SUBROUTINE agrif_declare_var_top
797	# endif
798
799
800	SUBROUTINE Agrif_detect( kg, ksizex )
801	!!----------------------------------------------------------------------
802	!! * ROUTINE Agrif_detect *
803	!!----------------------------------------------------------------------
804	INTEGER, DIMENSION(2) :: ksizex
805	INTEGER, DIMENSION(ksizex(1),ksizex(2)) :: kg
806	!!----------------------------------------------------------------------
807	!
808	RETURN
809	!
810	END SUBROUTINE Agrif_detect
811
812
813	SUBROUTINE agrif_nemo_init
814	!!----------------------------------------------------------------------
815	!! * ROUTINE agrif_init *
816	!!----------------------------------------------------------------------
817	USE agrif_oce
818	USE agrif_ice
819	USE dom_oce
820	USE in_out_manager
821	USE lib_mpp
822	!
823	IMPLICIT NONE
824	!
825	INTEGER :: ios ! Local integer output status for namelist read
826	NAMELIST/namagrif/ ln_agrif_2way, ln_init_chfrpar, rn_sponge_tra, rn_sponge_dyn, rn_trelax_tra, rn_trelax_dyn, &
827	& ln_spc_dyn, ln_vert_remap, ln_chk_bathy
828	!!--------------------------------------------------------------------------------------
829	!
830	READ ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901)
831	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in reference namelist' )
832	READ ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 )
833	902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namagrif in configuration namelist' )
834	IF(lwm) WRITE ( numond, namagrif )
835	!
836	IF(lwp) THEN ! control print
837	WRITE(numout,*)
838	WRITE(numout,*) 'agrif_nemo_init : AGRIF parameters'
839	WRITE(numout,*) '~~~~~~~~~~~~~~~'
840	WRITE(numout,*) ' Namelist namagrif : set AGRIF parameters'
841	WRITE(numout,*) ' Two way nesting activated ln_agrif_2way = ', ln_agrif_2way
842	WRITE(numout,*) ' child initial state from parent ln_init_chfrpar = ', ln_init_chfrpar
843	WRITE(numout,*) ' ad. sponge coeft for tracers rn_sponge_tra = ', rn_sponge_tra
844	WRITE(numout,*) ' ad. sponge coeft for dynamics rn_sponge_tra = ', rn_sponge_dyn
845	WRITE(numout,*) ' ad. time relaxation for tracers rn_trelax_tra = ', rn_trelax_tra
846	WRITE(numout,*) ' ad. time relaxation for dynamics rn_trelax_dyn = ', rn_trelax_dyn
847	WRITE(numout,*) ' use special values for dynamics ln_spc_dyn = ', ln_spc_dyn
848	WRITE(numout,*) ' vertical remapping ln_vert_remap = ', ln_vert_remap
849	WRITE(numout,*) ' check bathymetry ln_chk_bathy = ', ln_chk_bathy
850	ENDIF
851
852	! Set the number of ghost cells according to periodicity
853	nbghostcells_x = nbghostcells
854	nbghostcells_y_s = nbghostcells
855	nbghostcells_y_n = nbghostcells
856
857	!IF ((jperio == 1).OR.(jperio == 4) ) THEN
858	IF ( l_Iperio ) nbghostcells_x = 0
859	lk_south = .NOT. ( Agrif_Iy() == 1 )
860	IF( .NOT. lk_south ) nbghostcells_y_s = 0
861
862	! JC => side effects of lines below to be checked:
863	IF (.not.agrif_root()) THEN
864	lk_west = .NOT. ( Agrif_Ix() == 1 )
865	lk_east = .NOT. ( Agrif_Ix() + nbcellsx/AGRIF_Irhox() == Agrif_Parent(Ni0glo) -1 )
866	lk_south = .NOT. ( Agrif_Iy() == 1 )
867	lk_north = .NOT. ( Agrif_Iy() + nbcellsy/AGRIF_Irhoy() == Agrif_Parent(Nj0glo) -1 )
868	!
869
870	!
871	IF( l_Iperio ) nbghostcells_x = 0
872	IF( .NOT. lk_south ) nbghostcells_y_s = 0
873	IF( .NOT. lk_north ) nbghostcells_y_n = 0
874	!
875	! Some checks
876	IF( (.NOT.ln_vert_remap).AND.(jpkglo>Agrif_Parent(jpkglo)) ) CALL ctl_stop( 'STOP', &
877	& 'agrif_nemo_init: Agrif children must have less or equal number of vertical levels without ln_vert_remap defined' )
878	IF( jpiglo /= nbcellsx + 2 + 2*nn_hls + nbghostcells_x + nbghostcells_x ) CALL ctl_stop( 'STOP', &
879	& 'agrif_nemo_init: Agrif children requires jpiglo == nbcellsx + 2 + 2nn_hls + 2nbghostcells_x' )
880	IF( jpjglo /= nbcellsy + 2 + 2*nn_hls + nbghostcells_y_s + nbghostcells_y_n ) CALL ctl_stop( 'STOP', &
881	& 'agrif_nemo_init: Agrif children requires jpjglo == nbcellsy + 2 + 2*nn_hls + nbghostcells_y_s + nbghostcells_y_n' )
882	IF( ln_use_jattr ) CALL ctl_stop( 'STOP', 'agrif_nemo_init:Agrif children requires ln_use_jattr = .false. ' )
883	ENDIF
884
885	!
886	!
887	END SUBROUTINE agrif_nemo_init
888
889
890	# if ! defined key_mpi_off
891	SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob )
892	!!----------------------------------------------------------------------
893	!! * ROUTINE Agrif_InvLoc *
894	!!----------------------------------------------------------------------
895	USE dom_oce
896	!!
897	IMPLICIT NONE
898	!
899	INTEGER :: indglob, indloc, nprocloc, i
900	!!----------------------------------------------------------------------
901	!
902	SELECT CASE( i )
903	CASE(1) ; indglob = mig(indloc)
904	CASE(2) ; indglob = mjg(indloc)
905	CASE DEFAULT ; indglob = indloc
906	END SELECT
907	!
908	END SUBROUTINE Agrif_InvLoc
909
910
911	SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax )
912	!!----------------------------------------------------------------------
913	!! * ROUTINE Agrif_get_proc_info *
914	!!----------------------------------------------------------------------
915	USE par_oce
916	!!
917	IMPLICIT NONE
918	!
919	INTEGER, INTENT(out) :: imin, imax
920	INTEGER, INTENT(out) :: jmin, jmax
921	!!----------------------------------------------------------------------
922	!
923	imin = mig( 1 )
924	jmin = mjg( 1 )
925	imax = mig(jpi)
926	jmax = mjg(jpj)
927	!
928	END SUBROUTINE Agrif_get_proc_info
929
930
931	SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost)
932	!!----------------------------------------------------------------------
933	!! * ROUTINE Agrif_estimate_parallel_cost *
934	!!----------------------------------------------------------------------
935	USE par_oce
936	!!
937	IMPLICIT NONE
938	!
939	INTEGER, INTENT(in) :: imin, imax
940	INTEGER, INTENT(in) :: jmin, jmax
941	INTEGER, INTENT(in) :: nbprocs
942	REAL(wp), INTENT(out) :: grid_cost
943	!!----------------------------------------------------------------------
944	!
945	grid_cost = REAL(imax-imin+1,wp)*REAL(jmax-jmin+1,wp) / REAL(nbprocs,wp)
946	!
947	END SUBROUTINE Agrif_estimate_parallel_cost
948
949	# endif
950
951	SUBROUTINE nemo_mapping(ndim,ptx,pty,bounds,bounds_chunks,correction_required,nb_chunks)
952	!!----------------------------------------------------------------------
953	!! * ROUTINE Nemo_mapping *
954	!!----------------------------------------------------------------------
955	USE dom_oce
956	!!
957	IMPLICIT NONE
958	!
959	INTEGER :: ndim
960	INTEGER :: ptx, pty
961	INTEGER, DIMENSION(ndim,2,2) :: bounds
962	INTEGER, DIMENSION(:,:,:,:), ALLOCATABLE :: bounds_chunks
963	LOGICAL, DIMENSION(:), ALLOCATABLE :: correction_required
964	INTEGER :: nb_chunks
965	!
966	INTEGER :: i
967
968	IF (agrif_debug_interp) THEN
969	DO i=1,ndim
970	WRITE(,) 'direction = ',i,bounds(i,1,2),bounds(i,2,2)
971	ENDDO
972	ENDIF
973
974	IF( bounds(2,2,2) > jpjglo) THEN
975	IF( bounds(2,1,2) <=jpjglo) THEN
976	nb_chunks = 2
977	ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2))
978	ALLOCATE(correction_required(nb_chunks))
979	DO i = 1,nb_chunks
980	bounds_chunks(i,:,:,:) = bounds
981	END DO
982
983	! FIRST CHUNCK (for j<=jpjglo)
984
985	! Original indices
986	bounds_chunks(1,1,1,1) = bounds(1,1,2)
987	bounds_chunks(1,1,2,1) = bounds(1,2,2)
988	bounds_chunks(1,2,1,1) = bounds(2,1,2)
989	bounds_chunks(1,2,2,1) = jpjglo
990
991	bounds_chunks(1,1,1,2) = bounds(1,1,2)
992	bounds_chunks(1,1,2,2) = bounds(1,2,2)
993	bounds_chunks(1,2,1,2) = bounds(2,1,2)
994	bounds_chunks(1,2,2,2) = jpjglo
995
996	! Correction required or not
997	correction_required(1)=.FALSE.
998
999	! SECOND CHUNCK (for j>jpjglo)
1000
1001	! Original indices
1002	bounds_chunks(2,1,1,1) = bounds(1,1,2)
1003	bounds_chunks(2,1,2,1) = bounds(1,2,2)
1004	bounds_chunks(2,2,1,1) = jpjglo-2
1005	bounds_chunks(2,2,2,1) = bounds(2,2,2)
1006
1007	! Where to find them
1008	! We use the relation TAB(ji,jj)=TAB(jpiglo-ji+2,jpjglo-2-(jj-jpjglo))
1009
1010	IF( ptx == 2) THEN ! T, V points
1011	bounds_chunks(2,1,1,2) = jpiglo-bounds(1,2,2)+2
1012	bounds_chunks(2,1,2,2) = jpiglo-bounds(1,1,2)+2
1013	ELSE ! U, F points
1014	bounds_chunks(2,1,1,2) = jpiglo-bounds(1,2,2)+1
1015	bounds_chunks(2,1,2,2) = jpiglo-bounds(1,1,2)+1
1016	ENDIF
1017
1018	IF( pty == 2) THEN ! T, U points
1019	bounds_chunks(2,2,1,2) = jpjglo-2-(bounds(2,2,2) -jpjglo)
1020	bounds_chunks(2,2,2,2) = jpjglo-2-(jpjglo-2 -jpjglo)
1021	ELSE ! V, F points
1022	bounds_chunks(2,2,1,2) = jpjglo-3-(bounds(2,2,2) -jpjglo)
1023	bounds_chunks(2,2,2,2) = jpjglo-3-(jpjglo-2 -jpjglo)
1024	ENDIF
1025	! Correction required or not
1026	correction_required(2)=.TRUE.
1027
1028	ELSE
1029	nb_chunks = 1
1030	ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2))
1031	ALLOCATE(correction_required(nb_chunks))
1032	DO i=1,nb_chunks
1033	bounds_chunks(i,:,:,:) = bounds
1034	END DO
1035
1036	bounds_chunks(1,1,1,1) = bounds(1,1,2)
1037	bounds_chunks(1,1,2,1) = bounds(1,2,2)
1038	bounds_chunks(1,2,1,1) = bounds(2,1,2)
1039	bounds_chunks(1,2,2,1) = bounds(2,2,2)
1040
1041	bounds_chunks(1,1,1,2) = jpiglo-bounds(1,2,2)+2
1042	bounds_chunks(1,1,2,2) = jpiglo-bounds(1,1,2)+2
1043
1044	bounds_chunks(1,2,1,2) = jpjglo-2-(bounds(2,2,2)-jpjglo)
1045	bounds_chunks(1,2,2,2) = jpjglo-2-(bounds(2,1,2)-jpjglo)
1046
1047	IF( ptx == 2) THEN ! T, V points
1048	bounds_chunks(1,1,1,2) = jpiglo-bounds(1,2,2)+2
1049	bounds_chunks(1,1,2,2) = jpiglo-bounds(1,1,2)+2
1050	ELSE ! U, F points
1051	bounds_chunks(1,1,1,2) = jpiglo-bounds(1,2,2)+1
1052	bounds_chunks(1,1,2,2) = jpiglo-bounds(1,1,2)+1
1053	ENDIF
1054
1055	IF (pty == 2) THEN ! T, U points
1056	bounds_chunks(1,2,1,2) = jpjglo-2-(bounds(2,2,2) -jpjglo)
1057	bounds_chunks(1,2,2,2) = jpjglo-2-(bounds(2,1,2) -jpjglo)
1058	ELSE ! V, F points
1059	bounds_chunks(1,2,1,2) = jpjglo-3-(bounds(2,2,2) -jpjglo)
1060	bounds_chunks(1,2,2,2) = jpjglo-3-(bounds(2,1,2) -jpjglo)
1061	ENDIF
1062
1063	correction_required(1)=.TRUE.
1064	ENDIF
1065
1066	ELSE IF (bounds(1,1,2) < 1) THEN
1067	IF (bounds(1,2,2) > 0) THEN
1068	nb_chunks = 2
1069	ALLOCATE(correction_required(nb_chunks))
1070	correction_required=.FALSE.
1071	ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2))
1072	DO i=1,nb_chunks
1073	bounds_chunks(i,:,:,:) = bounds
1074	END DO
1075
1076	bounds_chunks(1,1,1,2) = bounds(1,1,2)+jpiglo-2
1077	bounds_chunks(1,1,2,2) = 1+jpiglo-2
1078
1079	bounds_chunks(1,1,1,1) = bounds(1,1,2)
1080	bounds_chunks(1,1,2,1) = 1
1081
1082	bounds_chunks(2,1,1,2) = 2
1083	bounds_chunks(2,1,2,2) = bounds(1,2,2)
1084
1085	bounds_chunks(2,1,1,1) = 2
1086	bounds_chunks(2,1,2,1) = bounds(1,2,2)
1087
1088	ELSE
1089	nb_chunks = 1
1090	ALLOCATE(correction_required(nb_chunks))
1091	correction_required=.FALSE.
1092	ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2))
1093	DO i=1,nb_chunks
1094	bounds_chunks(i,:,:,:) = bounds
1095	END DO
1096	bounds_chunks(1,1,1,2) = bounds(1,1,2)+jpiglo-2
1097	bounds_chunks(1,1,2,2) = bounds(1,2,2)+jpiglo-2
1098
1099	bounds_chunks(1,1,1,1) = bounds(1,1,2)
1100	bounds_chunks(1,1,2,1) = bounds(1,2,2)
1101	ENDIF
1102	ELSE
1103	nb_chunks=1
1104	ALLOCATE(correction_required(nb_chunks))
1105	correction_required=.FALSE.
1106	ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2))
1107	DO i=1,nb_chunks
1108	bounds_chunks(i,:,:,:) = bounds
1109	END DO
1110	bounds_chunks(1,1,1,2) = bounds(1,1,2)
1111	bounds_chunks(1,1,2,2) = bounds(1,2,2)
1112	bounds_chunks(1,2,1,2) = bounds(2,1,2)
1113	bounds_chunks(1,2,2,2) = bounds(2,2,2)
1114
1115	bounds_chunks(1,1,1,1) = bounds(1,1,2)
1116	bounds_chunks(1,1,2,1) = bounds(1,2,2)
1117	bounds_chunks(1,2,1,1) = bounds(2,1,2)
1118	bounds_chunks(1,2,2,1) = bounds(2,2,2)
1119	ENDIF
1120
1121	END SUBROUTINE nemo_mapping
1122
1123	FUNCTION agrif_external_switch_index(ptx,pty,i1,isens)
1124
1125	USE dom_oce
1126	!
1127	IMPLICIT NONE
1128
1129	INTEGER :: ptx, pty, i1, isens
1130	INTEGER :: agrif_external_switch_index
1131	!!----------------------------------------------------------------------
1132
1133	IF( isens == 1 ) THEN
1134	IF( ptx == 2 ) THEN ! T, V points
1135	agrif_external_switch_index = jpiglo-i1+2
1136	ELSE ! U, F points
1137	agrif_external_switch_index = jpiglo-i1+1
1138	ENDIF
1139	ELSE IF( isens ==2 ) THEN
1140	IF ( pty == 2 ) THEN ! T, U points
1141	agrif_external_switch_index = jpjglo-2-(i1 -jpjglo)
1142	ELSE ! V, F points
1143	agrif_external_switch_index = jpjglo-3-(i1 -jpjglo)
1144	ENDIF
1145	ENDIF
1146
1147	END FUNCTION agrif_external_switch_index
1148
1149	SUBROUTINE Correct_field(tab2d,i1,i2,j1,j2)
1150	!!----------------------------------------------------------------------
1151	!! * ROUTINE Correct_field *
1152	!!----------------------------------------------------------------------
1153	USE dom_oce
1154	USE agrif_oce
1155	!
1156	IMPLICIT NONE
1157	!
1158	INTEGER :: i1,i2,j1,j2
1159	REAL(wp), DIMENSION(i1:i2,j1:j2) :: tab2d
1160	!
1161	INTEGER :: i,j
1162	REAL(wp), DIMENSION(i1:i2,j1:j2) :: tab2dtemp
1163	!!----------------------------------------------------------------------
1164
1165	tab2dtemp = tab2d
1166
1167	IF( .NOT. use_sign_north ) THEN
1168	DO j=j1,j2
1169	DO i=i1,i2
1170	tab2d(i,j)=tab2dtemp(i2-(i-i1),j2-(j-j1))
1171	END DO
1172	END DO
1173	ELSE
1174	DO j=j1,j2
1175	DO i=i1,i2
1176	tab2d(i,j)=sign_north * tab2dtemp(i2-(i-i1),j2-(j-j1))
1177	END DO
1178	END DO
1179	ENDIF
1180
1181	END SUBROUTINE Correct_field
1182
1183	#else
1184	SUBROUTINE Subcalledbyagrif
1185	!!----------------------------------------------------------------------
1186	!! * ROUTINE Subcalledbyagrif *
1187	!!----------------------------------------------------------------------
1188	WRITE(,) 'Impossible to be here'
1189	END SUBROUTINE Subcalledbyagrif
1190	#endif

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

Download in other formats: