Context Navigation

← Previous Revision
Next Revision →
Blame
Revision Log

agrif_user.F90

Last change on this file was 15265, checked in by jchanut, 3 years ago
Improve ghost cell initialization with AGRIF + minor changes such as missing _wp, tests namelists updates, etc... can be assigned to #2638
Property svn:keywords set to `Id`
File size: 56.9 KB

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

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

New URL for NEMO forge! http://forge.nemo-ocean.eu

Context Navigation

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

Download in other formats: