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

Last change on this file since 14702 was 14702, checked in by jchanut, 3 years ago
#2638, push restrictions in agrif mapping in case of East-West periodic or North Fold lbcs
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 + 1 + nbghostcells_x
82	ind3 = nn_hls + 1 + 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 + 1 + nbghostcells_x
432	ind3 = nn_hls + 1 + 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 + 1 + nbghostcells_x
632	ind3 = nn_hls + 1 + 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 + 1 + nbghostcells_x
772	ind3 = nn_hls + 1 + 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	! JC => side effects of lines below to be checked:
853	IF (.not.agrif_root()) THEN
854	nbghostcells_x = nbghostcells
855	nbghostcells_y_s = nbghostcells
856	nbghostcells_y_n = nbghostcells
857
858	lk_west = .NOT. ( Agrif_Ix() == 1 )
859	lk_east = .NOT. ( Agrif_Ix() + nbcellsx/AGRIF_Irhox() == Agrif_Parent(Ni0glo) + 1 )
860	lk_south = .NOT. ( Agrif_Iy() == 1 )
861	lk_north = .NOT. ( Agrif_Iy() + nbcellsy/AGRIF_Irhoy() == Agrif_Parent(Nj0glo) + 1 )
862	!
863	! Correct number of ghost cells according to periodicity
864	!
865	IF( l_Iperio ) nbghostcells_x = 0
866	IF( .NOT. lk_south ) nbghostcells_y_s = 0
867	IF( .NOT. lk_north ) nbghostcells_y_n = 0
868	!
869	! Some checks
870	IF( (.NOT.ln_vert_remap).AND.(jpkglo>Agrif_Parent(jpkglo)) ) CALL ctl_stop( 'STOP', &
871	& 'agrif_nemo_init: Agrif children must have less or equal number of vertical levels without ln_vert_remap defined' )
872	IF( Ni0glo /= nbcellsx + nbghostcells_x + nbghostcells_x ) CALL ctl_stop( 'STOP', &
873	& 'agrif_nemo_init: Agrif children requires jpiglo == nbcellsx + 2*nbghostcells_x' )
874	IF( Nj0glo /= nbcellsy + nbghostcells_y_s + nbghostcells_y_n ) CALL ctl_stop( 'STOP', &
875	& 'agrif_nemo_init: Agrif children requires jpjglo == nbcellsy + nbghostcells_y_s + nbghostcells_y_n' )
876	IF( ln_use_jattr ) CALL ctl_stop( 'STOP', 'agrif_nemo_init:Agrif children requires ln_use_jattr = .false. ' )
877	ELSE
878	! Root grid
879	nbghostcells_x = 0
880	nbghostcells_y_s = 0
881	nbghostcells_y_n = 0
882	ENDIF
883	!
884	!
885	END SUBROUTINE agrif_nemo_init
886
887
888	# if ! defined key_mpi_off
889	SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob )
890	!!----------------------------------------------------------------------
891	!! * ROUTINE Agrif_InvLoc *
892	!!----------------------------------------------------------------------
893	USE dom_oce
894	!!
895	IMPLICIT NONE
896	!
897	INTEGER :: indglob, indloc, nprocloc, i
898	!!----------------------------------------------------------------------
899	!
900	SELECT CASE( i )
901	CASE(1) ; indglob = mig(indloc)
902	CASE(2) ; indglob = mjg(indloc)
903	CASE DEFAULT ; indglob = indloc
904	END SELECT
905	!
906	END SUBROUTINE Agrif_InvLoc
907
908
909	SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax )
910	!!----------------------------------------------------------------------
911	!! * ROUTINE Agrif_get_proc_info *
912	!!----------------------------------------------------------------------
913	USE par_oce
914	!!
915	IMPLICIT NONE
916	!
917	INTEGER, INTENT(out) :: imin, imax
918	INTEGER, INTENT(out) :: jmin, jmax
919	!!----------------------------------------------------------------------
920	!
921	imin = mig( 1 )
922	jmin = mjg( 1 )
923	imax = mig(jpi)
924	jmax = mjg(jpj)
925	!
926	END SUBROUTINE Agrif_get_proc_info
927
928
929	SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost)
930	!!----------------------------------------------------------------------
931	!! * ROUTINE Agrif_estimate_parallel_cost *
932	!!----------------------------------------------------------------------
933	USE par_oce
934	!!
935	IMPLICIT NONE
936	!
937	INTEGER, INTENT(in) :: imin, imax
938	INTEGER, INTENT(in) :: jmin, jmax
939	INTEGER, INTENT(in) :: nbprocs
940	REAL(wp), INTENT(out) :: grid_cost
941	!!----------------------------------------------------------------------
942	!
943	grid_cost = REAL(imax-imin+1,wp)*REAL(jmax-jmin+1,wp) / REAL(nbprocs,wp)
944	!
945	END SUBROUTINE Agrif_estimate_parallel_cost
946
947	# endif
948
949	SUBROUTINE nemo_mapping(ndim,ptx,pty,bounds,bounds_chunks,correction_required,nb_chunks)
950	!!----------------------------------------------------------------------
951	!! * ROUTINE Nemo_mapping *
952	!!----------------------------------------------------------------------
953	USE dom_oce
954	!!
955	IMPLICIT NONE
956	!
957	INTEGER :: ndim
958	INTEGER :: ptx, pty
959	INTEGER, DIMENSION(ndim,2,2) :: bounds
960	INTEGER, DIMENSION(:,:,:,:), ALLOCATABLE :: bounds_chunks
961	LOGICAL, DIMENSION(:), ALLOCATABLE :: correction_required
962	INTEGER :: nb_chunks
963	!
964	INTEGER :: i
965
966	IF (agrif_debug_interp) THEN
967	DO i=1,ndim
968	WRITE(,) 'direction = ',i,bounds(i,1,2),bounds(i,2,2)
969	ENDDO
970	ENDIF
971
972	IF(( bounds(2,2,2) > jpjglo).AND. ( l_NFold )) THEN
973	IF( bounds(2,1,2) <=jpjglo) THEN
974	nb_chunks = 2
975	ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2))
976	ALLOCATE(correction_required(nb_chunks))
977	DO i = 1,nb_chunks
978	bounds_chunks(i,:,:,:) = bounds
979	END DO
980
981	! FIRST CHUNCK (for j<=jpjglo)
982
983	! Original indices
984	bounds_chunks(1,1,1,1) = bounds(1,1,2)
985	bounds_chunks(1,1,2,1) = bounds(1,2,2)
986	bounds_chunks(1,2,1,1) = bounds(2,1,2)
987	bounds_chunks(1,2,2,1) = jpjglo
988
989	bounds_chunks(1,1,1,2) = bounds(1,1,2)
990	bounds_chunks(1,1,2,2) = bounds(1,2,2)
991	bounds_chunks(1,2,1,2) = bounds(2,1,2)
992	bounds_chunks(1,2,2,2) = jpjglo
993
994	! Correction required or not
995	correction_required(1)=.FALSE.
996
997	! SECOND CHUNCK (for j>jpjglo)
998
999	! Original indices
1000	bounds_chunks(2,1,1,1) = bounds(1,1,2)
1001	bounds_chunks(2,1,2,1) = bounds(1,2,2)
1002	bounds_chunks(2,2,1,1) = jpjglo-2
1003	bounds_chunks(2,2,2,1) = bounds(2,2,2)
1004
1005	! Where to find them
1006	! We use the relation TAB(ji,jj)=TAB(jpiglo-ji+2,jpjglo-2-(jj-jpjglo))
1007
1008	IF( ptx == 2) THEN ! T, V points
1009	bounds_chunks(2,1,1,2) = jpiglo-bounds(1,2,2)+2
1010	bounds_chunks(2,1,2,2) = jpiglo-bounds(1,1,2)+2
1011	ELSE ! U, F points
1012	bounds_chunks(2,1,1,2) = jpiglo-bounds(1,2,2)+1
1013	bounds_chunks(2,1,2,2) = jpiglo-bounds(1,1,2)+1
1014	ENDIF
1015
1016	IF( pty == 2) THEN ! T, U points
1017	bounds_chunks(2,2,1,2) = jpjglo-2-(bounds(2,2,2) -jpjglo)
1018	bounds_chunks(2,2,2,2) = jpjglo-2-(jpjglo-2 -jpjglo)
1019	ELSE ! V, F points
1020	bounds_chunks(2,2,1,2) = jpjglo-3-(bounds(2,2,2) -jpjglo)
1021	bounds_chunks(2,2,2,2) = jpjglo-3-(jpjglo-2 -jpjglo)
1022	ENDIF
1023	! Correction required or not
1024	correction_required(2)=.TRUE.
1025
1026	ELSE
1027	nb_chunks = 1
1028	ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2))
1029	ALLOCATE(correction_required(nb_chunks))
1030	DO i=1,nb_chunks
1031	bounds_chunks(i,:,:,:) = bounds
1032	END DO
1033
1034	bounds_chunks(1,1,1,1) = bounds(1,1,2)
1035	bounds_chunks(1,1,2,1) = bounds(1,2,2)
1036	bounds_chunks(1,2,1,1) = bounds(2,1,2)
1037	bounds_chunks(1,2,2,1) = bounds(2,2,2)
1038
1039	bounds_chunks(1,1,1,2) = jpiglo-bounds(1,2,2)+2
1040	bounds_chunks(1,1,2,2) = jpiglo-bounds(1,1,2)+2
1041
1042	bounds_chunks(1,2,1,2) = jpjglo-2-(bounds(2,2,2)-jpjglo)
1043	bounds_chunks(1,2,2,2) = jpjglo-2-(bounds(2,1,2)-jpjglo)
1044
1045	IF( ptx == 2) THEN ! T, V points
1046	bounds_chunks(1,1,1,2) = jpiglo-bounds(1,2,2)+2
1047	bounds_chunks(1,1,2,2) = jpiglo-bounds(1,1,2)+2
1048	ELSE ! U, F points
1049	bounds_chunks(1,1,1,2) = jpiglo-bounds(1,2,2)+1
1050	bounds_chunks(1,1,2,2) = jpiglo-bounds(1,1,2)+1
1051	ENDIF
1052
1053	IF (pty == 2) THEN ! T, U points
1054	bounds_chunks(1,2,1,2) = jpjglo-2-(bounds(2,2,2) -jpjglo)
1055	bounds_chunks(1,2,2,2) = jpjglo-2-(bounds(2,1,2) -jpjglo)
1056	ELSE ! V, F points
1057	bounds_chunks(1,2,1,2) = jpjglo-3-(bounds(2,2,2) -jpjglo)
1058	bounds_chunks(1,2,2,2) = jpjglo-3-(bounds(2,1,2) -jpjglo)
1059	ENDIF
1060
1061	correction_required(1)=.TRUE.
1062	ENDIF
1063
1064	ELSE IF ((bounds(1,1,2) < 1).AND.( l_Iperio )) THEN
1065	IF (bounds(1,2,2) > 0) THEN
1066	nb_chunks = 2
1067	ALLOCATE(correction_required(nb_chunks))
1068	correction_required=.FALSE.
1069	ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2))
1070	DO i=1,nb_chunks
1071	bounds_chunks(i,:,:,:) = bounds
1072	END DO
1073
1074	bounds_chunks(1,1,1,2) = bounds(1,1,2)+jpiglo-2
1075	bounds_chunks(1,1,2,2) = 1+jpiglo-2
1076
1077	bounds_chunks(1,1,1,1) = bounds(1,1,2)
1078	bounds_chunks(1,1,2,1) = 1
1079
1080	bounds_chunks(2,1,1,2) = 2
1081	bounds_chunks(2,1,2,2) = bounds(1,2,2)
1082
1083	bounds_chunks(2,1,1,1) = 2
1084	bounds_chunks(2,1,2,1) = bounds(1,2,2)
1085
1086	ELSE
1087	nb_chunks = 1
1088	ALLOCATE(correction_required(nb_chunks))
1089	correction_required=.FALSE.
1090	ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2))
1091	DO i=1,nb_chunks
1092	bounds_chunks(i,:,:,:) = bounds
1093	END DO
1094	bounds_chunks(1,1,1,2) = bounds(1,1,2)+jpiglo-2
1095	bounds_chunks(1,1,2,2) = bounds(1,2,2)+jpiglo-2
1096
1097	bounds_chunks(1,1,1,1) = bounds(1,1,2)
1098	bounds_chunks(1,1,2,1) = bounds(1,2,2)
1099	ENDIF
1100	ELSE
1101	nb_chunks=1
1102	ALLOCATE(correction_required(nb_chunks))
1103	correction_required=.FALSE.
1104	ALLOCATE(bounds_chunks(nb_chunks,ndim,2,2))
1105	DO i=1,nb_chunks
1106	bounds_chunks(i,:,:,:) = bounds
1107	END DO
1108	bounds_chunks(1,1,1,2) = bounds(1,1,2)
1109	bounds_chunks(1,1,2,2) = bounds(1,2,2)
1110	bounds_chunks(1,2,1,2) = bounds(2,1,2)
1111	bounds_chunks(1,2,2,2) = bounds(2,2,2)
1112
1113	bounds_chunks(1,1,1,1) = bounds(1,1,2)
1114	bounds_chunks(1,1,2,1) = bounds(1,2,2)
1115	bounds_chunks(1,2,1,1) = bounds(2,1,2)
1116	bounds_chunks(1,2,2,1) = bounds(2,2,2)
1117	ENDIF
1118
1119	END SUBROUTINE nemo_mapping
1120
1121	FUNCTION agrif_external_switch_index(ptx,pty,i1,isens)
1122
1123	USE dom_oce
1124	!
1125	IMPLICIT NONE
1126
1127	INTEGER :: ptx, pty, i1, isens
1128	INTEGER :: agrif_external_switch_index
1129	!!----------------------------------------------------------------------
1130
1131	IF( isens == 1 ) THEN
1132	IF( ptx == 2 ) THEN ! T, V points
1133	agrif_external_switch_index = jpiglo-i1+2
1134	ELSE ! U, F points
1135	agrif_external_switch_index = jpiglo-i1+1
1136	ENDIF
1137	ELSE IF( isens ==2 ) THEN
1138	IF ( pty == 2 ) THEN ! T, U points
1139	agrif_external_switch_index = jpjglo-2-(i1 -jpjglo)
1140	ELSE ! V, F points
1141	agrif_external_switch_index = jpjglo-3-(i1 -jpjglo)
1142	ENDIF
1143	ENDIF
1144
1145	END FUNCTION agrif_external_switch_index
1146
1147	SUBROUTINE Correct_field(tab2d,i1,i2,j1,j2)
1148	!!----------------------------------------------------------------------
1149	!! * ROUTINE Correct_field *
1150	!!----------------------------------------------------------------------
1151	USE dom_oce
1152	USE agrif_oce
1153	!
1154	IMPLICIT NONE
1155	!
1156	INTEGER :: i1,i2,j1,j2
1157	REAL(wp), DIMENSION(i1:i2,j1:j2) :: tab2d
1158	!
1159	INTEGER :: i,j
1160	REAL(wp), DIMENSION(i1:i2,j1:j2) :: tab2dtemp
1161	!!----------------------------------------------------------------------
1162
1163	tab2dtemp = tab2d
1164
1165	IF( .NOT. use_sign_north ) THEN
1166	DO j=j1,j2
1167	DO i=i1,i2
1168	tab2d(i,j)=tab2dtemp(i2-(i-i1),j2-(j-j1))
1169	END DO
1170	END DO
1171	ELSE
1172	DO j=j1,j2
1173	DO i=i1,i2
1174	tab2d(i,j)=sign_north * tab2dtemp(i2-(i-i1),j2-(j-j1))
1175	END DO
1176	END DO
1177	ENDIF
1178
1179	END SUBROUTINE Correct_field
1180
1181	#else
1182	SUBROUTINE Subcalledbyagrif
1183	!!----------------------------------------------------------------------
1184	!! * ROUTINE Subcalledbyagrif *
1185	!!----------------------------------------------------------------------
1186	WRITE(,) 'Impossible to be here'
1187	END SUBROUTINE Subcalledbyagrif
1188	#endif

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

Download in other formats: