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/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST – NEMO

Context Navigation

source: NEMO/branches/2019/dev_r11233_AGRIF-05_jchanut_vert_coord_interp/src/NST/agrif_user.F90 @ 12152

Last change on this file since 12152 was 12119, checked in by jchanut, 4 years ago
#2222, remove useless mask checking (and restrict scale factor check at the boundary only until nesting tools are updated in sponge areas). Take into account special values in tracer updates, again, till nesting tools are updated.
Property svn:keywords set to `Id`
File size: 37.4 KB

Line
1	#undef UPD_HIGH /* MIX HIGH UPDATE */
2	#if defined key_agrif
3	!!----------------------------------------------------------------------
4	!! NEMO/NST 4.0 , NEMO Consortium (2018)
5	!! $Id$
6	!! Software governed by the CeCILL license (see ./LICENSE)
7	!!----------------------------------------------------------------------
8	SUBROUTINE agrif_user
9	END SUBROUTINE agrif_user
10
11	SUBROUTINE agrif_before_regridding
12	END SUBROUTINE agrif_before_regridding
13
14	SUBROUTINE Agrif_InitWorkspace
15	END SUBROUTINE Agrif_InitWorkspace
16
17	SUBROUTINE Agrif_InitValues
18	!!----------------------------------------------------------------------
19	!! * ROUTINE Agrif_InitValues *
20	!!----------------------------------------------------------------------
21	USE nemogcm
22	!!----------------------------------------------------------------------
23	!
24	CALL nemo_init !* Initializations of each fine grid
25	!
26	! !* Agrif initialization
27	CALL agrif_nemo_init
28	CALL Agrif_InitValues_cont_dom
29	CALL Agrif_InitValues_cont
30	# if defined key_top
31	CALL Agrif_InitValues_cont_top
32	# endif
33	# if defined key_si3
34	CALL Agrif_InitValues_cont_ice
35	# endif
36	!
37	END SUBROUTINE Agrif_initvalues
38
39	SUBROUTINE Agrif_InitValues_cont_dom
40	!!----------------------------------------------------------------------
41	!! * ROUTINE Agrif_InitValues_cont_dom *
42	!!----------------------------------------------------------------------
43	!
44	CALL agrif_declare_var_dom
45	!
46	END SUBROUTINE Agrif_InitValues_cont_dom
47
48	SUBROUTINE agrif_declare_var_dom
49	!!----------------------------------------------------------------------
50	!! * ROUTINE agrif_declare_var_dom *
51	!!----------------------------------------------------------------------
52	USE par_oce, ONLY: nbghostcells
53	!
54	IMPLICIT NONE
55	!
56	INTEGER :: ind1, ind2, ind3
57	!!----------------------------------------------------------------------
58
59	! 1. Declaration of the type of variable which have to be interpolated
60	!---------------------------------------------------------------------
61	ind1 = nbghostcells
62	ind2 = 1 + nbghostcells
63	ind3 = 2 + nbghostcells
64	CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e1u_id)
65	CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),e2v_id)
66
67	! 2. Type of interpolation
68	!-------------------------
69	CALL Agrif_Set_bcinterp( e1u_id, interp1=Agrif_linear, interp2=AGRIF_ppm )
70	CALL Agrif_Set_bcinterp( e2v_id, interp1=AGRIF_ppm , interp2=Agrif_linear )
71
72	! 3. Location of interpolation
73	!-----------------------------
74	CALL Agrif_Set_bc(e1u_id,(/0,ind1-1/))
75	CALL Agrif_Set_bc(e2v_id,(/0,ind1-1/))
76
77	! 4. Update type
78	!---------------
79	# if defined UPD_HIGH
80	CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Full_Weighting)
81	CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Full_Weighting, update2=Agrif_Update_Average)
82	#else
83	CALL Agrif_Set_Updatetype(e1u_id,update1 = Agrif_Update_Copy, update2=Agrif_Update_Average)
84	CALL Agrif_Set_Updatetype(e2v_id,update1 = Agrif_Update_Average, update2=Agrif_Update_Copy)
85	#endif
86
87	END SUBROUTINE agrif_declare_var_dom
88
89	SUBROUTINE Agrif_InitValues_cont
90	!!----------------------------------------------------------------------
91	!! * ROUTINE Agrif_InitValues_cont *
92	!!----------------------------------------------------------------------
93	USE agrif_oce
94	USE agrif_oce_interp
95	USE agrif_oce_sponge
96	USE dom_oce
97	USE oce
98	USE lib_mpp
99	USE lbclnk
100	!
101	IMPLICIT NONE
102	!
103	INTEGER :: ji, jj
104	LOGICAL :: check_namelist
105	CHARACTER(len=15) :: cl_check1, cl_check2, cl_check3, cl_check4
106	#if defined key_vertical
107	REAL(wp), DIMENSION(jpi,jpj) :: zk ! workspace
108	#endif
109	!!----------------------------------------------------------------------
110
111	! 1. Declaration of the type of variable which have to be interpolated
112	!---------------------------------------------------------------------
113	CALL agrif_declare_var
114
115	! 2. First interpolations of potentially non zero fields
116	!-------------------------------------------------------
117
118	#if defined key_vertical
119	! Build consistent parent bathymetry and number of levels
120	! on the child grid
121	Agrif_UseSpecialValue = .FALSE.
122	ht0_parent(:,:) = 0._wp
123	mbkt_parent(:,:) = 0
124	!
125	CALL Agrif_Bc_variable(ht0_id ,calledweight=1.,procname=interpht0 )
126	CALL Agrif_Bc_variable(mbkt_id,calledweight=1.,procname=interpmbkt)
127	!
128	! Assume step wise change of bathymetry near interface
129	! TODO: Switch to linear interpolation of bathymetry in the s-coordinate case
130	! and no refinement
131	DO jj = 1, jpjm1
132	DO ji = 1, jpim1
133	mbku_parent(ji,jj) = MIN( mbkt_parent(ji+1,jj ) , mbkt_parent(ji,jj) )
134	mbkv_parent(ji,jj) = MIN( mbkt_parent(ji ,jj+1) , mbkt_parent(ji,jj) )
135	END DO
136	END DO
137	IF ( ln_sco.AND.Agrif_Parent(ln_sco) ) THEN
138	DO jj = 1, jpjm1
139	DO ji = 1, jpim1
140	hu0_parent(ji,jj) = 0.5_wp * ( ht0_parent(ji,jj)+ht0_parent(ji+1,jj) )
141	hv0_parent(ji,jj) = 0.5_wp * ( ht0_parent(ji,jj)+ht0_parent(ji,jj+1) )
142	END DO
143	END DO
144	ELSE
145	DO jj = 1, jpjm1
146	DO ji = 1, jpim1
147	hu0_parent(ji,jj) = MIN( ht0_parent(ji,jj), ht0_parent(ji+1,jj))
148	hv0_parent(ji,jj) = MIN( ht0_parent(ji,jj), ht0_parent(ji,jj+1))
149	END DO
150	END DO
151
152	ENDIF
153	!
154	CALL lbc_lnk( 'Agrif_InitValues_cont', hu0_parent, 'U', 1. )
155	CALL lbc_lnk( 'Agrif_InitValues_cont', hv0_parent, 'V', 1. )
156	zk(:,:) = REAL( mbku_parent(:,:), wp ) ; CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'U', 1. )
157	mbku_parent(:,:) = MAX( NINT( zk(:,:) ), 1 )
158	zk(:,:) = REAL( mbkv_parent(:,:), wp ) ; CALL lbc_lnk( 'Agrif_InitValues_cont', zk, 'V', 1. )
159	mbkv_parent(:,:) = MAX( NINT( zk(:,:) ), 1 )
160	#endif
161
162	Agrif_SpecialValue = 0._wp
163	Agrif_UseSpecialValue = .TRUE.
164	CALL Agrif_Bc_variable(tsn_id,calledweight=1.,procname=interptsn)
165	CALL Agrif_Sponge
166	tabspongedone_tsn = .FALSE.
167	CALL Agrif_Bc_variable(tsn_sponge_id,calledweight=1.,procname=interptsn_sponge)
168	! reset tsa to zero
169	tsa(:,:,:,:) = 0._wp
170
171	Agrif_UseSpecialValue = ln_spc_dyn
172	CALL Agrif_Bc_variable(un_interp_id,calledweight=1.,procname=interpun)
173	CALL Agrif_Bc_variable(vn_interp_id,calledweight=1.,procname=interpvn)
174	tabspongedone_u = .FALSE.
175	tabspongedone_v = .FALSE.
176	CALL Agrif_Bc_variable(un_sponge_id,calledweight=1.,procname=interpun_sponge)
177	tabspongedone_u = .FALSE.
178	tabspongedone_v = .FALSE.
179	CALL Agrif_Bc_variable(vn_sponge_id,calledweight=1.,procname=interpvn_sponge)
180	ua(:,:,:) = 0._wp
181	va(:,:,:) = 0._wp
182
183	Agrif_UseSpecialValue = .TRUE.
184	CALL Agrif_Bc_variable(sshn_id,calledweight=1., procname=interpsshn )
185	hbdy(:,:) = 0._wp
186	ssha(:,:) = 0._wp
187
188	IF ( ln_dynspg_ts ) THEN
189	Agrif_UseSpecialValue = ln_spc_dyn
190	CALL Agrif_Bc_variable(unb_id,calledweight=1.,procname=interpunb)
191	CALL Agrif_Bc_variable(vnb_id,calledweight=1.,procname=interpvnb)
192	CALL Agrif_Bc_variable(ub2b_interp_id,calledweight=1.,procname=interpub2b)
193	CALL Agrif_Bc_variable(vb2b_interp_id,calledweight=1.,procname=interpvb2b)
194	ubdy(:,:) = 0._wp
195	vbdy(:,:) = 0._wp
196	ENDIF
197
198	Agrif_UseSpecialValue = .FALSE.
199
200	! 3. Some controls
201	!-----------------
202	check_namelist = .TRUE.
203
204	IF( check_namelist ) THEN
205
206	! Check time steps
207	IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN
208	WRITE(cl_check1,*) NINT(Agrif_Parent(rdt))
209	WRITE(cl_check2,*) NINT(rdt)
210	WRITE(cl_check3,*) NINT(Agrif_Parent(rdt)/Agrif_Rhot())
211	CALL ctl_stop( 'Incompatible time step between ocean grids', &
212	& 'parent grid value : '//cl_check1 , &
213	& 'child grid value : '//cl_check2 , &
214	& 'value on child grid should be changed to : '//cl_check3 )
215	ENDIF
216
217	! Check run length
218	IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
219	Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN
220	WRITE(cl_check1,) (Agrif_Parent(nit000)-1)Agrif_IRhot() + 1
221	WRITE(cl_check2,) Agrif_Parent(nitend) Agrif_IRhot()
222	CALL ctl_warn( 'Incompatible run length between grids' , &
223	& 'nit000 on fine grid will be changed to : '//cl_check1, &
224	& 'nitend on fine grid will be changed to : '//cl_check2 )
225	nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
226	nitend = Agrif_Parent(nitend) *Agrif_IRhot()
227	ENDIF
228
229	! Check free surface scheme
230	IF ( ( Agrif_Parent(ln_dynspg_ts ).AND.ln_dynspg_exp ).OR.&
231	& ( Agrif_Parent(ln_dynspg_exp).AND.ln_dynspg_ts ) ) THEN
232	WRITE(cl_check1,*) Agrif_Parent( ln_dynspg_ts )
233	WRITE(cl_check2,*) ln_dynspg_ts
234	WRITE(cl_check3,*) Agrif_Parent( ln_dynspg_exp )
235	WRITE(cl_check4,*) ln_dynspg_exp
236	CALL ctl_stop( 'Incompatible free surface scheme between grids' , &
237	& 'parent grid ln_dynspg_ts :'//cl_check1 , &
238	& 'child grid ln_dynspg_ts :'//cl_check2 , &
239	& 'parent grid ln_dynspg_exp :'//cl_check3 , &
240	& 'child grid ln_dynspg_exp :'//cl_check4 , &
241	& 'those logicals should be identical' )
242	STOP
243	ENDIF
244
245	! Check if identical linear free surface option
246	IF ( ( Agrif_Parent(ln_linssh ).AND.(.NOT.ln_linssh )).OR.&
247	& ( (.NOT.Agrif_Parent(ln_linssh)).AND.ln_linssh ) ) THEN
248	WRITE(cl_check1,*) Agrif_Parent(ln_linssh )
249	WRITE(cl_check2,*) ln_linssh
250	CALL ctl_stop( 'Incompatible linearized fs option between grids', &
251	& 'parent grid ln_linssh :'//cl_check1 , &
252	& 'child grid ln_linssh :'//cl_check2 , &
253	& 'those logicals should be identical' )
254	STOP
255	ENDIF
256
257	ENDIF
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	# if ! defined key_vertical
268	!
269	! check if tmask and vertical scale factors agree with parent in sponge area:
270	CALL Agrif_Bc_variable(e3t_id,calledweight=1.,procname=interpe3t)
271	!
272	# else
273	!
274	! In case of vertical interpolation, check only that total depths agree between child and parent:
275	DO ji = 1, jpi
276	DO jj = 1, jpj
277	IF ((mbkt_parent(ji,jj)/=0).AND.(ABS(ht0_parent(ji,jj)-ht_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1
278	IF ((mbku_parent(ji,jj)/=0).AND.(ABS(hu0_parent(ji,jj)-hu_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1
279	IF ((mbkv_parent(ji,jj)/=0).AND.(ABS(hv0_parent(ji,jj)-hv_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1
280	END DO
281	END DO
282	# endif
283	CALL mpp_sum( 'agrif_user', kindic_agr )
284	IF( kindic_agr /= 0 ) THEN
285	CALL ctl_stop('==> Child Bathymetry is NOT correct near boundaries.')
286	ELSE
287	IF(lwp) WRITE(numout,*) '==> Child Bathymetry is ok near boundaries.'
288	IF(lwp) WRITE(numout,*) ' '
289	END IF
290	!
291	ENDIF
292
293	# if defined key_vertical
294	! Additional constrain that should be removed someday:
295	IF ( Agrif_Parent(jpk).GT.jpk ) THEN
296	CALL ctl_stop( ' With key_vertical, child grids must have jpk greater or equal to the parent value' )
297	ENDIF
298	# endif
299	!
300	END SUBROUTINE Agrif_InitValues_cont
301
302	SUBROUTINE agrif_declare_var
303	!!----------------------------------------------------------------------
304	!! * ROUTINE agrif_declare_var *
305	!!----------------------------------------------------------------------
306	USE agrif_util
307	USE agrif_oce
308	USE par_oce
309	USE zdf_oce
310	USE oce
311	!
312	IMPLICIT NONE
313	!
314	INTEGER :: ind1, ind2, ind3
315	!!----------------------------------------------------------------------
316
317	! 1. Declaration of the type of variable which have to be interpolated
318	!---------------------------------------------------------------------
319	ind1 = nbghostcells
320	ind2 = 1 + nbghostcells
321	ind3 = 2 + nbghostcells
322	# if defined key_vertical
323	CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts+1/),tsn_id)
324	CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts+1/),tsn_sponge_id)
325
326	CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_interp_id)
327	CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_interp_id)
328	CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_update_id)
329	CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_update_id)
330	CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),un_sponge_id)
331	CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),vn_sponge_id)
332	# else
333	CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_id)
334	CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jpts/),tsn_sponge_id)
335
336	CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_interp_id)
337	CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_interp_id)
338	CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_update_id)
339	CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_update_id)
340	CALL agrif_declare_variable((/1,2,0,0/),(/ind2,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),un_sponge_id)
341	CALL agrif_declare_variable((/2,1,0,0/),(/ind3,ind2,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),vn_sponge_id)
342	# endif
343
344	CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id)
345
346	# if defined key_vertical
347	CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),mbkt_id)
348	CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ht0_id)
349	# endif
350
351	CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,3/),scales_t_id)
352
353	CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),unb_id)
354	CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vnb_id)
355	CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_interp_id)
356	CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_interp_id)
357	CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_update_id)
358	CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_update_id)
359
360	CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id)
361
362	IF( ln_zdftke.OR.ln_zdfgls ) THEN
363	! CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/), en_id)
364	! CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),avt_id)
365	# if defined key_vertical
366	CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,2/),avm_id)
367	# else
368	CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,1/),avm_id)
369	# endif
370	ENDIF
371
372	! 2. Type of interpolation
373	!-------------------------
374	CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear)
375
376	CALL Agrif_Set_bcinterp(un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
377	CALL Agrif_Set_bcinterp(vn_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
378
379	CALL Agrif_Set_bcinterp(tsn_sponge_id,interp=AGRIF_linear)
380
381	CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_linear)
382	CALL Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
383	CALL Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
384	CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
385	CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
386	!
387	! > Divergence conserving alternative:
388	! CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_constant)
389	! CALL Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_constant)
390	! CALL Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_constant,interp2=Agrif_linear)
391	! CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_constant)
392	! CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_constant,interp2=Agrif_linear)
393	!<
394
395	CALL Agrif_Set_bcinterp(un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
396	CALL Agrif_Set_bcinterp(vn_sponge_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
397
398	CALL Agrif_Set_bcinterp(e3t_id,interp=AGRIF_constant)
399
400	# if defined key_vertical
401	CALL Agrif_Set_bcinterp(mbkt_id,interp=AGRIF_constant)
402	CALL Agrif_Set_bcinterp(ht0_id ,interp=AGRIF_constant)
403	# endif
404
405	IF( ln_zdftke.OR.ln_zdfgls ) CALL Agrif_Set_bcinterp( avm_id, interp=AGRIF_linear )
406
407	! 3. Location of interpolation
408	!-----------------------------
409	CALL Agrif_Set_bc( tsn_id, (/0,ind1-1/) ) ! if west, rhox=3 and nbghost=3: columns 2 to 4
410	CALL Agrif_Set_bc( un_interp_id, (/0,ind1-1/) )
411	CALL Agrif_Set_bc( vn_interp_id, (/0,ind1-1/) )
412
413	CALL Agrif_Set_bc( tsn_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) ) ! if west, rhox=3, nn_sponge_len=2
414	CALL Agrif_Set_bc( un_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) ) ! and nbghost=3:
415	CALL Agrif_Set_bc( vn_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) ) ! columns 4 to 11
416
417	CALL Agrif_Set_bc( sshn_id, (/0,ind1-1/) )
418	CALL Agrif_Set_bc( unb_id, (/0,ind1-1/) )
419	CALL Agrif_Set_bc( vnb_id, (/0,ind1-1/) )
420	CALL Agrif_Set_bc( ub2b_interp_id, (/0,ind1-1/) )
421	CALL Agrif_Set_bc( vb2b_interp_id, (/0,ind1-1/) )
422
423	! CALL Agrif_Set_bc( e3t_id, (/-nn_sponge_len*Agrif_irhox(),ind1-1/) )
424	! JC: check near the boundary only until matching in sponge has been sorted out:
425	CALL Agrif_Set_bc( e3t_id, (/0,ind1-1/) )
426
427	# if defined key_vertical
428	! extend the interpolation zone by 1 more point than necessary:
429	CALL Agrif_Set_bc( mbkt_id, (/-nn_sponge_len*Agrif_irhox()-2,ind1/) )
430	CALL Agrif_Set_bc( ht0_id, (/-nn_sponge_len*Agrif_irhox()-2,ind1/) )
431	# endif
432
433	IF( ln_zdftke.OR.ln_zdfgls ) CALL Agrif_Set_bc( avm_id, (/0,ind1/) )
434
435	! 4. Update type
436	!---------------
437	CALL Agrif_Set_Updatetype(scales_t_id, update = AGRIF_Update_Average)
438
439	# if defined UPD_HIGH
440	CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting)
441	CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting)
442	CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average)
443
444	CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting)
445	CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average)
446	CALL Agrif_Set_Updatetype(sshn_id,update = Agrif_Update_Full_Weighting)
447	CALL Agrif_Set_Updatetype(e3t_id, update = Agrif_Update_Full_Weighting)
448
449	IF( ln_zdftke.OR.ln_zdfgls ) THEN
450	! CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Full_Weighting)
451	! CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Full_Weighting)
452	! CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Full_Weighting)
453	ENDIF
454
455	#else
456	CALL Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average)
457	CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
458	CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
459
460	CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
461	CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
462	CALL Agrif_Set_Updatetype(sshn_id,update = AGRIF_Update_Average)
463	CALL Agrif_Set_Updatetype(e3t_id, update = AGRIF_Update_Average)
464
465	IF( ln_zdftke.OR.ln_zdfgls ) THEN
466	! CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Average)
467	! CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Average)
468	! CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Average)
469	ENDIF
470
471	#endif
472	!
473	END SUBROUTINE agrif_declare_var
474
475	#if defined key_si3
476	SUBROUTINE Agrif_InitValues_cont_ice
477	!!----------------------------------------------------------------------
478	!! * ROUTINE Agrif_InitValues_cont_ice *
479	!!----------------------------------------------------------------------
480	USE Agrif_Util
481	USE sbc_oce, ONLY : nn_fsbc ! clem: necessary otherwise Agrif_Parent(nn_fsbc) = nn_fsbc
482	USE ice
483	USE agrif_ice
484	USE in_out_manager
485	USE agrif_ice_interp
486	USE lib_mpp
487	!
488	IMPLICIT NONE
489	!!----------------------------------------------------------------------
490	!
491	! Declaration of the type of variable which have to be interpolated (parent=>child)
492	!----------------------------------------------------------------------------------
493	CALL agrif_declare_var_ice
494
495	! Controls
496
497	! clem: For some reason, nn_fsbc(child)/=1 does not work properly (signal can be largely degraded by the agrif zoom)
498	! the run must satisfy CFL=Uice/(dx/dt) < 0.6/nn_fsbc(child)
499	! therefore, if nn_fsbc(child)>1 one must reduce the time-step in proportion to nn_fsbc(child), which is not acceptable
500	! If a solution is found, the following stop could be removed because the rest of the code take nn_fsbc(child) into account
501	IF( nn_fsbc > 1 ) CALL ctl_stop('nn_fsbc(child) must be set to 1 otherwise agrif and sea-ice may not work properly')
502
503	! stop if rhot * nn_fsbc(parent) /= N * nn_fsbc(child) with N being integer
504	IF( MOD( Agrif_irhot() * Agrif_Parent(nn_fsbc), nn_fsbc ) /= 0 ) THEN
505	CALL ctl_stop('rhot * nn_fsbc(parent) /= N * nn_fsbc(child), therefore nn_fsbc(child) should be set to 1 or nn_fsbc(parent)')
506	ENDIF
507	! First Interpolations (using "after" ice subtime step => nbstep_ice=1)
508	!----------------------------------------------------------------------
509	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)
510	CALL agrif_interp_ice('U') ! interpolation of ice velocities
511	CALL agrif_interp_ice('V') ! interpolation of ice velocities
512	CALL agrif_interp_ice('T') ! interpolation of ice tracers
513	nbstep_ice = 0
514	!
515	END SUBROUTINE Agrif_InitValues_cont_ice
516
517	SUBROUTINE agrif_declare_var_ice
518	!!----------------------------------------------------------------------
519	!! * ROUTINE agrif_declare_var_ice *
520	!!----------------------------------------------------------------------
521	USE Agrif_Util
522	USE ice
523	USE par_oce, ONLY : nbghostcells
524	!
525	IMPLICIT NONE
526	!
527	INTEGER :: ind1, ind2, ind3
528	!!----------------------------------------------------------------------
529	!
530	! 1. Declaration of the type of variable which have to be interpolated (parent=>child)
531	! agrif_declare_variable(position,1st point index,--,--,dimensions,name)
532	! ex.: position=> 1,1 = not-centered (in i and j)
533	! 2,2 = centered ( - )
534	! index => 1,1 = one ghost line
535	! 2,2 = two ghost lines
536	!-------------------------------------------------------------------------------------
537	ind1 = nbghostcells
538	ind2 = 1 + nbghostcells
539	ind3 = 2 + nbghostcells
540	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_ice_id)
541	CALL agrif_declare_variable((/1,2/) ,(/ind2,ind3/) ,(/'x','y'/) ,(/1,1/) ,(/nlci,nlcj/) ,u_ice_id )
542	CALL agrif_declare_variable((/2,1/) ,(/ind3,ind2/) ,(/'x','y'/) ,(/1,1/) ,(/nlci,nlcj/) ,v_ice_id )
543
544	! 2. Set interpolations (normal & tangent to the grid cell for velocities)
545	!-----------------------------------
546	CALL Agrif_Set_bcinterp(tra_ice_id, interp = AGRIF_linear)
547	CALL Agrif_Set_bcinterp(u_ice_id , interp1 = Agrif_linear,interp2 = AGRIF_ppm )
548	CALL Agrif_Set_bcinterp(v_ice_id , interp1 = AGRIF_ppm ,interp2 = Agrif_linear)
549
550	! 3. Set location of interpolations
551	!----------------------------------
552	CALL Agrif_Set_bc(tra_ice_id,(/0,ind1/))
553	CALL Agrif_Set_bc(u_ice_id ,(/0,ind1/))
554	CALL Agrif_Set_bc(v_ice_id ,(/0,ind1/))
555
556	! 4. Set update type in case 2 ways (child=>parent) (normal & tangent to the grid cell for velocities)
557	!--------------------------------------------------
558	# if defined UPD_HIGH
559	CALL Agrif_Set_Updatetype(tra_ice_id, update = Agrif_Update_Full_Weighting)
560	CALL Agrif_Set_Updatetype(u_ice_id , update1 = Agrif_Update_Average , update2 = Agrif_Update_Full_Weighting)
561	CALL Agrif_Set_Updatetype(v_ice_id , update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average )
562	#else
563	CALL Agrif_Set_Updatetype(tra_ice_id, update = AGRIF_Update_Average)
564	CALL Agrif_Set_Updatetype(u_ice_id , update1 = Agrif_Update_Copy , update2 = Agrif_Update_Average)
565	CALL Agrif_Set_Updatetype(v_ice_id , update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy )
566	#endif
567
568	END SUBROUTINE agrif_declare_var_ice
569	#endif
570
571
572	# if defined key_top
573	SUBROUTINE Agrif_InitValues_cont_top
574	!!----------------------------------------------------------------------
575	!! * ROUTINE Agrif_InitValues_cont_top *
576	!!----------------------------------------------------------------------
577	USE Agrif_Util
578	USE oce
579	USE dom_oce
580	USE nemogcm
581	USE par_trc
582	USE lib_mpp
583	USE trc
584	USE in_out_manager
585	USE agrif_oce_sponge
586	USE agrif_top_update
587	USE agrif_top_interp
588	USE agrif_top_sponge
589	!!
590	IMPLICIT NONE
591	!
592	CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3
593	LOGICAL :: check_namelist
594	!!----------------------------------------------------------------------
595
596	! 1. Declaration of the type of variable which have to be interpolated
597	!---------------------------------------------------------------------
598	CALL agrif_declare_var_top
599
600	! 2. First interpolations of potentially non zero fields
601	!-------------------------------------------------------
602	Agrif_SpecialValue=0._wp
603	Agrif_UseSpecialValue = .TRUE.
604	CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn)
605	Agrif_UseSpecialValue = .FALSE.
606	CALL Agrif_Sponge
607	tabspongedone_trn = .FALSE.
608	CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge)
609	! reset tsa to zero
610	tra(:,:,:,:) = 0._wp
611
612	! 3. Some controls
613	!-----------------
614	check_namelist = .TRUE.
615
616	IF( check_namelist ) THEN
617	! Check time steps
618	IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN
619	WRITE(cl_check1,*) Agrif_Parent(rdt)
620	WRITE(cl_check2,*) rdt
621	WRITE(cl_check3,) rdtAgrif_Rhot()
622	CALL ctl_stop( 'incompatible time step between grids', &
623	& 'parent grid value : '//cl_check1 , &
624	& 'child grid value : '//cl_check2 , &
625	& 'value on child grid should be changed to &
626	& :'//cl_check3 )
627	ENDIF
628
629	! Check run length
630	IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
631	Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN
632	WRITE(cl_check1,) (Agrif_Parent(nit000)-1)Agrif_IRhot() + 1
633	WRITE(cl_check2,) Agrif_Parent(nitend) Agrif_IRhot()
634	CALL ctl_warn( 'incompatible run length between grids' , &
635	& ' nit000 on fine grid will be change to : '//cl_check1, &
636	& ' nitend on fine grid will be change to : '//cl_check2 )
637	nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
638	nitend = Agrif_Parent(nitend) *Agrif_IRhot()
639	ENDIF
640
641	! Check passive tracer cell
642	IF( nn_dttrc .NE. 1 ) THEN
643	WRITE(,) 'nn_dttrc should be equal to 1'
644	ENDIF
645	ENDIF
646	!
647	END SUBROUTINE Agrif_InitValues_cont_top
648
649
650	SUBROUTINE agrif_declare_var_top
651	!!----------------------------------------------------------------------
652	!! * ROUTINE agrif_declare_var_top *
653	!!----------------------------------------------------------------------
654	USE agrif_util
655	USE agrif_oce
656	USE dom_oce
657	USE trc
658	!!
659	IMPLICIT NONE
660	!
661	INTEGER :: ind1, ind2, ind3
662	!!----------------------------------------------------------------------
663
664	! 1. Declaration of the type of variable which have to be interpolated
665	!---------------------------------------------------------------------
666	ind1 = nbghostcells
667	ind2 = 1 + nbghostcells
668	ind3 = 2 + nbghostcells
669	# if defined key_vertical
670	CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra+1/),trn_id)
671	CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra+1/),trn_sponge_id)
672	# else
673	CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_id)
674	CALL agrif_declare_variable((/2,2,0,0/),(/ind3,ind3,0,0/),(/'x','y','N','N'/),(/1,1,1,1/),(/nlci,nlcj,jpk,jptra/),trn_sponge_id)
675	# endif
676
677	! 2. Type of interpolation
678	!-------------------------
679	CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear)
680	CALL Agrif_Set_bcinterp(trn_sponge_id,interp=AGRIF_linear)
681
682	! 3. Location of interpolation
683	!-----------------------------
684	CALL Agrif_Set_bc(trn_id,(/0,ind1-1/))
685	CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/))
686
687	! 4. Update type
688	!---------------
689	# if defined UPD_HIGH
690	CALL Agrif_Set_Updatetype(trn_id, update = Agrif_Update_Full_Weighting)
691	#else
692	CALL Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average)
693	#endif
694	!
695	END SUBROUTINE agrif_declare_var_top
696	# endif
697
698	SUBROUTINE Agrif_detect( kg, ksizex )
699	!!----------------------------------------------------------------------
700	!! * ROUTINE Agrif_detect *
701	!!----------------------------------------------------------------------
702	INTEGER, DIMENSION(2) :: ksizex
703	INTEGER, DIMENSION(ksizex(1),ksizex(2)) :: kg
704	!!----------------------------------------------------------------------
705	!
706	RETURN
707	!
708	END SUBROUTINE Agrif_detect
709
710	SUBROUTINE agrif_nemo_init
711	!!----------------------------------------------------------------------
712	!! * ROUTINE agrif_init *
713	!!----------------------------------------------------------------------
714	USE agrif_oce
715	USE agrif_ice
716	USE in_out_manager
717	USE lib_mpp
718	!!
719	IMPLICIT NONE
720	!
721	INTEGER :: ios ! Local integer output status for namelist read
722	NAMELIST/namagrif/ ln_agrif_2way, rn_sponge_tra, rn_sponge_dyn, rn_trelax_tra, rn_trelax_dyn, &
723	& ln_spc_dyn, ln_chk_bathy
724	!!--------------------------------------------------------------------------------------
725	!
726	REWIND( numnam_ref ) ! Namelist namagrif in reference namelist : AGRIF zoom
727	READ ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901)
728	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in reference namelist' )
729	REWIND( numnam_cfg ) ! Namelist namagrif in configuration namelist : AGRIF zoom
730	READ ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 )
731	902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namagrif in configuration namelist' )
732	IF(lwm) WRITE ( numond, namagrif )
733	!
734	IF(lwp) THEN ! control print
735	WRITE(numout,*)
736	WRITE(numout,*) 'agrif_nemo_init : AGRIF parameters'
737	WRITE(numout,*) '~~~~~~~~~~~~~~~'
738	WRITE(numout,*) ' Namelist namagrif : set AGRIF parameters'
739	WRITE(numout,*) ' Two way nesting activated ln_agrif_2way = ', ln_agrif_2way
740	WRITE(numout,*) ' sponge coefficient for tracers rn_sponge_tra = ', rn_sponge_tra, ' m^2/s'
741	WRITE(numout,*) ' sponge coefficient for dynamics rn_sponge_tra = ', rn_sponge_dyn, ' m^2/s'
742	WRITE(numout,*) ' time relaxation for tracers rn_trelax_tra = ', rn_trelax_tra, ' ad.'
743	WRITE(numout,*) ' time relaxation for dynamics rn_trelax_dyn = ', rn_trelax_dyn, ' ad.'
744	WRITE(numout,*) ' use special values for dynamics ln_spc_dyn = ', ln_spc_dyn
745	WRITE(numout,*) ' check bathymetry ln_chk_bathy = ', ln_chk_bathy
746	ENDIF
747	!
748	!
749	IF( agrif_oce_alloc() > 0 ) CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed')
750	!
751	END SUBROUTINE agrif_nemo_init
752
753	# if defined key_mpp_mpi
754
755	SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob )
756	!!----------------------------------------------------------------------
757	!! * ROUTINE Agrif_InvLoc *
758	!!----------------------------------------------------------------------
759	USE dom_oce
760	!!
761	IMPLICIT NONE
762	!
763	INTEGER :: indglob, indloc, nprocloc, i
764	!!----------------------------------------------------------------------
765	!
766	SELECT CASE( i )
767	CASE(1) ; indglob = indloc + nimppt(nprocloc+1) - 1
768	CASE(2) ; indglob = indloc + njmppt(nprocloc+1) - 1
769	CASE DEFAULT
770	indglob = indloc
771	END SELECT
772	!
773	END SUBROUTINE Agrif_InvLoc
774
775	SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax )
776	!!----------------------------------------------------------------------
777	!! * ROUTINE Agrif_get_proc_info *
778	!!----------------------------------------------------------------------
779	USE par_oce
780	!!
781	IMPLICIT NONE
782	!
783	INTEGER, INTENT(out) :: imin, imax
784	INTEGER, INTENT(out) :: jmin, jmax
785	!!----------------------------------------------------------------------
786	!
787	imin = nimppt(Agrif_Procrank+1) ! ?????
788	jmin = njmppt(Agrif_Procrank+1) ! ?????
789	imax = imin + jpi - 1
790	jmax = jmin + jpj - 1
791	!
792	END SUBROUTINE Agrif_get_proc_info
793
794	SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost)
795	!!----------------------------------------------------------------------
796	!! * ROUTINE Agrif_estimate_parallel_cost *
797	!!----------------------------------------------------------------------
798	USE par_oce
799	!!
800	IMPLICIT NONE
801	!
802	INTEGER, INTENT(in) :: imin, imax
803	INTEGER, INTENT(in) :: jmin, jmax
804	INTEGER, INTENT(in) :: nbprocs
805	REAL(wp), INTENT(out) :: grid_cost
806	!!----------------------------------------------------------------------
807	!
808	grid_cost = REAL(imax-imin+1,wp)*REAL(jmax-jmin+1,wp) / REAL(nbprocs,wp)
809	!
810	END SUBROUTINE Agrif_estimate_parallel_cost
811
812	# endif
813
814	#else
815	SUBROUTINE Subcalledbyagrif
816	!!----------------------------------------------------------------------
817	!! * ROUTINE Subcalledbyagrif *
818	!!----------------------------------------------------------------------
819	WRITE(,) 'Impossible to be here'
820	END SUBROUTINE Subcalledbyagrif
821	#endif

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

Download in other formats: