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

Context Navigation

source: NEMO/trunk/src/NST/agrif_user.F90 @ 14976

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

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

Download in other formats: