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

Last change on this file since 12048 was 12048, checked in by jchanut, 4 years ago
#2222, add small tolerance for bathymetry matching test; correct U-V parent bathymetry on child grid in the special case of s coord into s coord
Property svn:keywords set to `Id`
File size: 38.1 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	!
262	IF(lwp) WRITE(numout,*) ' '
263	IF(lwp) WRITE(numout,*) 'AGRIF: Check Bathymetry and masks near bdys. Level: ', Agrif_Level()
264	!
265	kindic_agr = 0
266	# if ! defined key_vertical
267	!
268	! check if umask agree with parent along western and eastern boundaries:
269	CALL Agrif_Bc_variable(umsk_id,calledweight=1.,procname=interpumsk)
270	! check if vmask agree with parent along northern and southern boundaries:
271	CALL Agrif_Bc_variable(vmsk_id,calledweight=1.,procname=interpvmsk)
272	! check if tmask and vertical scale factors agree with parent over first two coarse grid points:
273	CALL Agrif_Bc_variable(e3t_id,calledweight=1.,procname=interpe3t)
274	!
275	# else
276	!
277	! In case of vertical interpolation, check only that total depths agree between child and parent:
278	DO ji = 1, jpi
279	DO jj = 1, jpj
280	IF ((mbkt_parent(ji,jj)/=0).AND.(ABS(ht0_parent(ji,jj)-ht_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1
281	IF ((mbku_parent(ji,jj)/=0).AND.(ABS(hu0_parent(ji,jj)-hu_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1
282	IF ((mbkv_parent(ji,jj)/=0).AND.(ABS(hv0_parent(ji,jj)-hv_0(ji,jj))>1.e-3)) kindic_agr = kindic_agr + 1
283	END DO
284	END DO
285	# endif
286	CALL mpp_sum( 'agrif_user', kindic_agr )
287	IF( kindic_agr /= 0 ) THEN
288	CALL ctl_stop('==> Child Bathymetry is NOT correct near boundaries.')
289	ELSE
290	IF(lwp) WRITE(numout,*) '==> Child Bathymetry is ok near boundaries.'
291	IF(lwp) WRITE(numout,*) ' '
292	END IF
293	!
294	ENDIF
295
296	# if defined key_vertical
297	! Additional constrain that should be removed someday:
298	IF ( Agrif_Parent(jpk).GT.jpk ) THEN
299	CALL ctl_stop( ' With key_vertical, child grids must have jpk greater or equal to the parent value' )
300	ENDIF
301	# endif
302	!
303	END SUBROUTINE Agrif_InitValues_cont
304
305	SUBROUTINE agrif_declare_var
306	!!----------------------------------------------------------------------
307	!! * ROUTINE agrif_declare_var *
308	!!----------------------------------------------------------------------
309	USE agrif_util
310	USE agrif_oce
311	USE par_oce
312	USE zdf_oce
313	USE oce
314	!
315	IMPLICIT NONE
316	!
317	INTEGER :: ind1, ind2, ind3
318	!!----------------------------------------------------------------------
319
320	! 1. Declaration of the type of variable which have to be interpolated
321	!---------------------------------------------------------------------
322	ind1 = nbghostcells
323	ind2 = 1 + nbghostcells
324	ind3 = 2 + nbghostcells
325	# if defined key_vertical
326	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)
327	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)
328
329	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)
330	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)
331	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)
332	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)
333	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)
334	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)
335	# else
336	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)
337	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)
338
339	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)
340	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)
341	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)
342	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)
343	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)
344	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)
345	# endif
346
347	CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),e3t_id)
348	CALL agrif_declare_variable((/1,2,0/),(/ind2,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),umsk_id)
349	CALL agrif_declare_variable((/2,1,0/),(/ind3,ind2,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),vmsk_id)
350	# if defined key_vertical
351	CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),mbkt_id)
352	CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ht0_id)
353	# endif
354
355	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)
356
357	CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),unb_id)
358	CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vnb_id)
359	CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_interp_id)
360	CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_interp_id)
361	CALL agrif_declare_variable((/1,2/),(/ind2,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),ub2b_update_id)
362	CALL agrif_declare_variable((/2,1/),(/ind3,ind2/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),vb2b_update_id)
363
364	CALL agrif_declare_variable((/2,2/),(/ind3,ind3/),(/'x','y'/),(/1,1/),(/nlci,nlcj/),sshn_id)
365
366	IF( ln_zdftke.OR.ln_zdfgls ) THEN
367	! CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/), en_id)
368	! CALL agrif_declare_variable((/2,2,0/),(/ind3,ind3,0/),(/'x','y','N'/),(/1,1,1/),(/nlci,nlcj,jpk/),avt_id)
369	# if defined key_vertical
370	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)
371	# else
372	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)
373	# endif
374	ENDIF
375
376	! 2. Type of interpolation
377	!-------------------------
378	CALL Agrif_Set_bcinterp(tsn_id,interp=AGRIF_linear)
379
380	CALL Agrif_Set_bcinterp(un_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
381	CALL Agrif_Set_bcinterp(vn_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
382
383	CALL Agrif_Set_bcinterp(tsn_sponge_id,interp=AGRIF_linear)
384
385	CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_linear)
386	CALL Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
387	CALL Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
388	CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
389	CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
390	!
391	! > Divergence conserving alternative:
392	! CALL Agrif_Set_bcinterp(sshn_id,interp=AGRIF_constant)
393	! CALL Agrif_Set_bcinterp(unb_id,interp1=Agrif_linear,interp2=AGRIF_constant)
394	! CALL Agrif_Set_bcinterp(vnb_id,interp1=AGRIF_constant,interp2=Agrif_linear)
395	! CALL Agrif_Set_bcinterp(ub2b_interp_id,interp1=Agrif_linear,interp2=AGRIF_constant)
396	! CALL Agrif_Set_bcinterp(vb2b_interp_id,interp1=AGRIF_constant,interp2=Agrif_linear)
397	!<
398
399	CALL Agrif_Set_bcinterp(un_sponge_id,interp1=Agrif_linear,interp2=AGRIF_ppm)
400	CALL Agrif_Set_bcinterp(vn_sponge_id,interp1=AGRIF_ppm,interp2=Agrif_linear)
401
402	CALL Agrif_Set_bcinterp(e3t_id,interp=AGRIF_constant)
403	CALL Agrif_Set_bcinterp(umsk_id,interp=AGRIF_constant)
404	CALL Agrif_Set_bcinterp(vmsk_id,interp=AGRIF_constant)
405
406	# if defined key_vertical
407	CALL Agrif_Set_bcinterp(mbkt_id,interp=AGRIF_constant)
408	CALL Agrif_Set_bcinterp(ht0_id ,interp=AGRIF_constant)
409	# endif
410
411	IF( ln_zdftke.OR.ln_zdfgls ) CALL Agrif_Set_bcinterp( avm_id, interp=AGRIF_linear )
412
413	! 3. Location of interpolation
414	!-----------------------------
415	CALL Agrif_Set_bc( tsn_id, (/0,ind1-1/) ) ! if west, rhox=3 and nbghost=3: columns 2 to 4
416	CALL Agrif_Set_bc( un_interp_id, (/0,ind1-1/) )
417	CALL Agrif_Set_bc( vn_interp_id, (/0,ind1-1/) )
418
419	CALL Agrif_Set_bc( tsn_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) ) ! if west, rhox=3, nn_sponge_len=2
420	CALL Agrif_Set_bc( un_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) ) ! and nbghost=3:
421	CALL Agrif_Set_bc( vn_sponge_id, (/-nn_sponge_len*Agrif_irhox()-1,0/) ) ! columns 4 to 11
422
423	CALL Agrif_Set_bc( sshn_id, (/0,ind1-1/) )
424	CALL Agrif_Set_bc( unb_id, (/0,ind1-1/) )
425	CALL Agrif_Set_bc( vnb_id, (/0,ind1-1/) )
426	CALL Agrif_Set_bc( ub2b_interp_id, (/0,ind1-1/) )
427	CALL Agrif_Set_bc( vb2b_interp_id, (/0,ind1-1/) )
428
429	CALL Agrif_Set_bc( e3t_id, (/-nn_sponge_len*Agrif_irhox(),ind1-1/) ) ! if west, rhox=3, nn_sponge_len=2
430	CALL Agrif_Set_bc( umsk_id, (/0,0/) ) ! and nbghost=3:
431	CALL Agrif_Set_bc( vmsk_id, (/0,0/) ) ! columns 2 to 10
432	# if defined key_vertical
433	! extend the interpolation zone by 1 more point than necessary:
434	CALL Agrif_Set_bc( mbkt_id, (/-nn_sponge_len*Agrif_irhox()-2,ind1/) )
435	CALL Agrif_Set_bc( ht0_id, (/-nn_sponge_len*Agrif_irhox()-2,ind1/) )
436	# endif
437
438	IF( ln_zdftke.OR.ln_zdfgls ) CALL Agrif_Set_bc( avm_id, (/0,ind1/) )
439
440	! 4. Update type
441	!---------------
442	CALL Agrif_Set_Updatetype(scales_t_id, update = AGRIF_Update_Average)
443
444	# if defined UPD_HIGH
445	CALL Agrif_Set_Updatetype(tsn_id, update = Agrif_Update_Full_Weighting)
446	CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting)
447	CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average)
448
449	CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Full_Weighting)
450	CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average)
451	CALL Agrif_Set_Updatetype(sshn_id,update = Agrif_Update_Full_Weighting)
452	CALL Agrif_Set_Updatetype(e3t_id, update = Agrif_Update_Full_Weighting)
453
454	IF( ln_zdftke.OR.ln_zdfgls ) THEN
455	! CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Full_Weighting)
456	! CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Full_Weighting)
457	! CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Full_Weighting)
458	ENDIF
459
460	#else
461	CALL Agrif_Set_Updatetype(tsn_id, update = AGRIF_Update_Average)
462	CALL Agrif_Set_Updatetype(un_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
463	CALL Agrif_Set_Updatetype(vn_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
464
465	CALL Agrif_Set_Updatetype(ub2b_update_id,update1 = Agrif_Update_Copy, update2 = Agrif_Update_Average)
466	CALL Agrif_Set_Updatetype(vb2b_update_id,update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy)
467	CALL Agrif_Set_Updatetype(sshn_id,update = AGRIF_Update_Average)
468	CALL Agrif_Set_Updatetype(e3t_id, update = AGRIF_Update_Average)
469
470	IF( ln_zdftke.OR.ln_zdfgls ) THEN
471	! CALL Agrif_Set_Updatetype( en_id, update = AGRIF_Update_Average)
472	! CALL Agrif_Set_Updatetype(avt_id, update = AGRIF_Update_Average)
473	! CALL Agrif_Set_Updatetype(avm_id, update = AGRIF_Update_Average)
474	ENDIF
475
476	#endif
477	!
478	END SUBROUTINE agrif_declare_var
479
480	#if defined key_si3
481	SUBROUTINE Agrif_InitValues_cont_ice
482	!!----------------------------------------------------------------------
483	!! * ROUTINE Agrif_InitValues_cont_ice *
484	!!----------------------------------------------------------------------
485	USE Agrif_Util
486	USE sbc_oce, ONLY : nn_fsbc ! clem: necessary otherwise Agrif_Parent(nn_fsbc) = nn_fsbc
487	USE ice
488	USE agrif_ice
489	USE in_out_manager
490	USE agrif_ice_interp
491	USE lib_mpp
492	!
493	IMPLICIT NONE
494	!!----------------------------------------------------------------------
495	!
496	! Declaration of the type of variable which have to be interpolated (parent=>child)
497	!----------------------------------------------------------------------------------
498	CALL agrif_declare_var_ice
499
500	! Controls
501
502	! clem: For some reason, nn_fsbc(child)/=1 does not work properly (signal can be largely degraded by the agrif zoom)
503	! the run must satisfy CFL=Uice/(dx/dt) < 0.6/nn_fsbc(child)
504	! therefore, if nn_fsbc(child)>1 one must reduce the time-step in proportion to nn_fsbc(child), which is not acceptable
505	! If a solution is found, the following stop could be removed because the rest of the code take nn_fsbc(child) into account
506	IF( nn_fsbc > 1 ) CALL ctl_stop('nn_fsbc(child) must be set to 1 otherwise agrif and sea-ice may not work properly')
507
508	! stop if rhot * nn_fsbc(parent) /= N * nn_fsbc(child) with N being integer
509	IF( MOD( Agrif_irhot() * Agrif_Parent(nn_fsbc), nn_fsbc ) /= 0 ) THEN
510	CALL ctl_stop('rhot * nn_fsbc(parent) /= N * nn_fsbc(child), therefore nn_fsbc(child) should be set to 1 or nn_fsbc(parent)')
511	ENDIF
512	! First Interpolations (using "after" ice subtime step => nbstep_ice=1)
513	!----------------------------------------------------------------------
514	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)
515	CALL agrif_interp_ice('U') ! interpolation of ice velocities
516	CALL agrif_interp_ice('V') ! interpolation of ice velocities
517	CALL agrif_interp_ice('T') ! interpolation of ice tracers
518	nbstep_ice = 0
519	!
520	END SUBROUTINE Agrif_InitValues_cont_ice
521
522	SUBROUTINE agrif_declare_var_ice
523	!!----------------------------------------------------------------------
524	!! * ROUTINE agrif_declare_var_ice *
525	!!----------------------------------------------------------------------
526	USE Agrif_Util
527	USE ice
528	USE par_oce, ONLY : nbghostcells
529	!
530	IMPLICIT NONE
531	!
532	INTEGER :: ind1, ind2, ind3
533	!!----------------------------------------------------------------------
534	!
535	! 1. Declaration of the type of variable which have to be interpolated (parent=>child)
536	! agrif_declare_variable(position,1st point index,--,--,dimensions,name)
537	! ex.: position=> 1,1 = not-centered (in i and j)
538	! 2,2 = centered ( - )
539	! index => 1,1 = one ghost line
540	! 2,2 = two ghost lines
541	!-------------------------------------------------------------------------------------
542	ind1 = nbghostcells
543	ind2 = 1 + nbghostcells
544	ind3 = 2 + nbghostcells
545	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)
546	CALL agrif_declare_variable((/1,2/) ,(/ind2,ind3/) ,(/'x','y'/) ,(/1,1/) ,(/nlci,nlcj/) ,u_ice_id )
547	CALL agrif_declare_variable((/2,1/) ,(/ind3,ind2/) ,(/'x','y'/) ,(/1,1/) ,(/nlci,nlcj/) ,v_ice_id )
548
549	! 2. Set interpolations (normal & tangent to the grid cell for velocities)
550	!-----------------------------------
551	CALL Agrif_Set_bcinterp(tra_ice_id, interp = AGRIF_linear)
552	CALL Agrif_Set_bcinterp(u_ice_id , interp1 = Agrif_linear,interp2 = AGRIF_ppm )
553	CALL Agrif_Set_bcinterp(v_ice_id , interp1 = AGRIF_ppm ,interp2 = Agrif_linear)
554
555	! 3. Set location of interpolations
556	!----------------------------------
557	CALL Agrif_Set_bc(tra_ice_id,(/0,ind1/))
558	CALL Agrif_Set_bc(u_ice_id ,(/0,ind1/))
559	CALL Agrif_Set_bc(v_ice_id ,(/0,ind1/))
560
561	! 4. Set update type in case 2 ways (child=>parent) (normal & tangent to the grid cell for velocities)
562	!--------------------------------------------------
563	# if defined UPD_HIGH
564	CALL Agrif_Set_Updatetype(tra_ice_id, update = Agrif_Update_Full_Weighting)
565	CALL Agrif_Set_Updatetype(u_ice_id , update1 = Agrif_Update_Average , update2 = Agrif_Update_Full_Weighting)
566	CALL Agrif_Set_Updatetype(v_ice_id , update1 = Agrif_Update_Full_Weighting, update2 = Agrif_Update_Average )
567	#else
568	CALL Agrif_Set_Updatetype(tra_ice_id, update = AGRIF_Update_Average)
569	CALL Agrif_Set_Updatetype(u_ice_id , update1 = Agrif_Update_Copy , update2 = Agrif_Update_Average)
570	CALL Agrif_Set_Updatetype(v_ice_id , update1 = Agrif_Update_Average, update2 = Agrif_Update_Copy )
571	#endif
572
573	END SUBROUTINE agrif_declare_var_ice
574	#endif
575
576
577	# if defined key_top
578	SUBROUTINE Agrif_InitValues_cont_top
579	!!----------------------------------------------------------------------
580	!! * ROUTINE Agrif_InitValues_cont_top *
581	!!----------------------------------------------------------------------
582	USE Agrif_Util
583	USE oce
584	USE dom_oce
585	USE nemogcm
586	USE par_trc
587	USE lib_mpp
588	USE trc
589	USE in_out_manager
590	USE agrif_oce_sponge
591	USE agrif_top_update
592	USE agrif_top_interp
593	USE agrif_top_sponge
594	!!
595	IMPLICIT NONE
596	!
597	CHARACTER(len=10) :: cl_check1, cl_check2, cl_check3
598	LOGICAL :: check_namelist
599	!!----------------------------------------------------------------------
600
601	! 1. Declaration of the type of variable which have to be interpolated
602	!---------------------------------------------------------------------
603	CALL agrif_declare_var_top
604
605	! 2. First interpolations of potentially non zero fields
606	!-------------------------------------------------------
607	Agrif_SpecialValue=0._wp
608	Agrif_UseSpecialValue = .TRUE.
609	CALL Agrif_Bc_variable(trn_id,calledweight=1.,procname=interptrn)
610	Agrif_UseSpecialValue = .FALSE.
611	CALL Agrif_Sponge
612	tabspongedone_trn = .FALSE.
613	CALL Agrif_Bc_variable(trn_sponge_id,calledweight=1.,procname=interptrn_sponge)
614	! reset tsa to zero
615	tra(:,:,:,:) = 0._wp
616
617	! 3. Some controls
618	!-----------------
619	check_namelist = .TRUE.
620
621	IF( check_namelist ) THEN
622	! Check time steps
623	IF( NINT(Agrif_Rhot()) * NINT(rdt) .NE. Agrif_Parent(rdt) ) THEN
624	WRITE(cl_check1,*) Agrif_Parent(rdt)
625	WRITE(cl_check2,*) rdt
626	WRITE(cl_check3,) rdtAgrif_Rhot()
627	CALL ctl_stop( 'incompatible time step between grids', &
628	& 'parent grid value : '//cl_check1 , &
629	& 'child grid value : '//cl_check2 , &
630	& 'value on child grid should be changed to &
631	& :'//cl_check3 )
632	ENDIF
633
634	! Check run length
635	IF( Agrif_IRhot() * (Agrif_Parent(nitend)- &
636	Agrif_Parent(nit000)+1) .NE. (nitend-nit000+1) ) THEN
637	WRITE(cl_check1,) (Agrif_Parent(nit000)-1)Agrif_IRhot() + 1
638	WRITE(cl_check2,) Agrif_Parent(nitend) Agrif_IRhot()
639	CALL ctl_warn( 'incompatible run length between grids' , &
640	& ' nit000 on fine grid will be change to : '//cl_check1, &
641	& ' nitend on fine grid will be change to : '//cl_check2 )
642	nit000 = (Agrif_Parent(nit000)-1)*Agrif_IRhot() + 1
643	nitend = Agrif_Parent(nitend) *Agrif_IRhot()
644	ENDIF
645
646	! Check passive tracer cell
647	IF( nn_dttrc .NE. 1 ) THEN
648	WRITE(,) 'nn_dttrc should be equal to 1'
649	ENDIF
650	ENDIF
651	!
652	END SUBROUTINE Agrif_InitValues_cont_top
653
654
655	SUBROUTINE agrif_declare_var_top
656	!!----------------------------------------------------------------------
657	!! * ROUTINE agrif_declare_var_top *
658	!!----------------------------------------------------------------------
659	USE agrif_util
660	USE agrif_oce
661	USE dom_oce
662	USE trc
663	!!
664	IMPLICIT NONE
665	!
666	INTEGER :: ind1, ind2, ind3
667	!!----------------------------------------------------------------------
668
669	! 1. Declaration of the type of variable which have to be interpolated
670	!---------------------------------------------------------------------
671	ind1 = nbghostcells
672	ind2 = 1 + nbghostcells
673	ind3 = 2 + nbghostcells
674	# if defined key_vertical
675	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)
676	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)
677	# else
678	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)
679	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)
680	# endif
681
682	! 2. Type of interpolation
683	!-------------------------
684	CALL Agrif_Set_bcinterp(trn_id,interp=AGRIF_linear)
685	CALL Agrif_Set_bcinterp(trn_sponge_id,interp=AGRIF_linear)
686
687	! 3. Location of interpolation
688	!-----------------------------
689	CALL Agrif_Set_bc(trn_id,(/0,ind1-1/))
690	CALL Agrif_Set_bc(trn_sponge_id,(/-nn_sponge_len*Agrif_irhox()-1,0/))
691
692	! 4. Update type
693	!---------------
694	# if defined UPD_HIGH
695	CALL Agrif_Set_Updatetype(trn_id, update = Agrif_Update_Full_Weighting)
696	#else
697	CALL Agrif_Set_Updatetype(trn_id, update = AGRIF_Update_Average)
698	#endif
699	!
700	END SUBROUTINE agrif_declare_var_top
701	# endif
702
703	SUBROUTINE Agrif_detect( kg, ksizex )
704	!!----------------------------------------------------------------------
705	!! * ROUTINE Agrif_detect *
706	!!----------------------------------------------------------------------
707	INTEGER, DIMENSION(2) :: ksizex
708	INTEGER, DIMENSION(ksizex(1),ksizex(2)) :: kg
709	!!----------------------------------------------------------------------
710	!
711	RETURN
712	!
713	END SUBROUTINE Agrif_detect
714
715	SUBROUTINE agrif_nemo_init
716	!!----------------------------------------------------------------------
717	!! * ROUTINE agrif_init *
718	!!----------------------------------------------------------------------
719	USE agrif_oce
720	USE agrif_ice
721	USE in_out_manager
722	USE lib_mpp
723	!!
724	IMPLICIT NONE
725	!
726	INTEGER :: ios ! Local integer output status for namelist read
727	NAMELIST/namagrif/ ln_agrif_2way, rn_sponge_tra, rn_sponge_dyn, rn_trelax_tra, rn_trelax_dyn, &
728	& ln_spc_dyn, ln_chk_bathy
729	!!--------------------------------------------------------------------------------------
730	!
731	REWIND( numnam_ref ) ! Namelist namagrif in reference namelist : AGRIF zoom
732	READ ( numnam_ref, namagrif, IOSTAT = ios, ERR = 901)
733	901 IF( ios /= 0 ) CALL ctl_nam ( ios , 'namagrif in reference namelist' )
734	REWIND( numnam_cfg ) ! Namelist namagrif in configuration namelist : AGRIF zoom
735	READ ( numnam_cfg, namagrif, IOSTAT = ios, ERR = 902 )
736	902 IF( ios > 0 ) CALL ctl_nam ( ios , 'namagrif in configuration namelist' )
737	IF(lwm) WRITE ( numond, namagrif )
738	!
739	IF(lwp) THEN ! control print
740	WRITE(numout,*)
741	WRITE(numout,*) 'agrif_nemo_init : AGRIF parameters'
742	WRITE(numout,*) '~~~~~~~~~~~~~~~'
743	WRITE(numout,*) ' Namelist namagrif : set AGRIF parameters'
744	WRITE(numout,*) ' Two way nesting activated ln_agrif_2way = ', ln_agrif_2way
745	WRITE(numout,*) ' sponge coefficient for tracers rn_sponge_tra = ', rn_sponge_tra, ' m^2/s'
746	WRITE(numout,*) ' sponge coefficient for dynamics rn_sponge_tra = ', rn_sponge_dyn, ' m^2/s'
747	WRITE(numout,*) ' time relaxation for tracers rn_trelax_tra = ', rn_trelax_tra, ' ad.'
748	WRITE(numout,*) ' time relaxation for dynamics rn_trelax_dyn = ', rn_trelax_dyn, ' ad.'
749	WRITE(numout,*) ' use special values for dynamics ln_spc_dyn = ', ln_spc_dyn
750	WRITE(numout,*) ' check bathymetry ln_chk_bathy = ', ln_chk_bathy
751	ENDIF
752	!
753	!
754	IF( agrif_oce_alloc() > 0 ) CALL ctl_warn('agrif agrif_oce_alloc: allocation of arrays failed')
755	!
756	END SUBROUTINE agrif_nemo_init
757
758	# if defined key_mpp_mpi
759
760	SUBROUTINE Agrif_InvLoc( indloc, nprocloc, i, indglob )
761	!!----------------------------------------------------------------------
762	!! * ROUTINE Agrif_InvLoc *
763	!!----------------------------------------------------------------------
764	USE dom_oce
765	!!
766	IMPLICIT NONE
767	!
768	INTEGER :: indglob, indloc, nprocloc, i
769	!!----------------------------------------------------------------------
770	!
771	SELECT CASE( i )
772	CASE(1) ; indglob = indloc + nimppt(nprocloc+1) - 1
773	CASE(2) ; indglob = indloc + njmppt(nprocloc+1) - 1
774	CASE DEFAULT
775	indglob = indloc
776	END SELECT
777	!
778	END SUBROUTINE Agrif_InvLoc
779
780	SUBROUTINE Agrif_get_proc_info( imin, imax, jmin, jmax )
781	!!----------------------------------------------------------------------
782	!! * ROUTINE Agrif_get_proc_info *
783	!!----------------------------------------------------------------------
784	USE par_oce
785	!!
786	IMPLICIT NONE
787	!
788	INTEGER, INTENT(out) :: imin, imax
789	INTEGER, INTENT(out) :: jmin, jmax
790	!!----------------------------------------------------------------------
791	!
792	imin = nimppt(Agrif_Procrank+1) ! ?????
793	jmin = njmppt(Agrif_Procrank+1) ! ?????
794	imax = imin + jpi - 1
795	jmax = jmin + jpj - 1
796	!
797	END SUBROUTINE Agrif_get_proc_info
798
799	SUBROUTINE Agrif_estimate_parallel_cost(imin, imax,jmin, jmax, nbprocs, grid_cost)
800	!!----------------------------------------------------------------------
801	!! * ROUTINE Agrif_estimate_parallel_cost *
802	!!----------------------------------------------------------------------
803	USE par_oce
804	!!
805	IMPLICIT NONE
806	!
807	INTEGER, INTENT(in) :: imin, imax
808	INTEGER, INTENT(in) :: jmin, jmax
809	INTEGER, INTENT(in) :: nbprocs
810	REAL(wp), INTENT(out) :: grid_cost
811	!!----------------------------------------------------------------------
812	!
813	grid_cost = REAL(imax-imin+1,wp)*REAL(jmax-jmin+1,wp) / REAL(nbprocs,wp)
814	!
815	END SUBROUTINE Agrif_estimate_parallel_cost
816
817	# endif
818
819	#else
820	SUBROUTINE Subcalledbyagrif
821	!!----------------------------------------------------------------------
822	!! * ROUTINE Subcalledbyagrif *
823	!!----------------------------------------------------------------------
824	WRITE(,) 'Impossible to be here'
825	END SUBROUTINE Subcalledbyagrif
826	#endif

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

Download in other formats: