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

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.

agrif_user.F90 in NEMO/branches/2020/dev_r12973_AGRIF_CMEMS/src/NST – NEMO

Context Navigation

source: NEMO/branches/2020/dev_r12973_AGRIF_CMEMS/src/NST/agrif_user.F90 @ 13141

Last change on this file since 13141 was 13141, checked in by jchanut, 4 years ago
#2129, corrections/add ons to initial state interpolation with AGRIF 1) add namelist flag for child grid initial state interpolation - ice not considered yet 2) provide depths and not thicknesses as inputs to vertical linear interpolation 3) extend initial state interpolation to a restart scenario for parent grid (warning should be added in that case in order to prevent users doing this at each model restart...) The online interpolation seems to work fine in the VORTEX case (provided 0. is not considered as a special value in the initial velocity field, i.e. ln_spc_dyn=F)
Property svn:keywords set to `Id`
File size: 51.1 KB

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

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

Download in other formats: