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

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

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

Download in other formats: