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

Last change on this file since 14433 was 14433, checked in by smasson, 3 years ago
trunk: merge dev_r14312_MPI_Interface into the trunk, #2598
Property svn:keywords set to `Id`
File size: 52.2 KB

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

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

Download in other formats: