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_r12072_MERGE_OPTION2_2019/src/NST – NEMO

Context Navigation

source: NEMO/branches/2019/dev_r12072_MERGE_OPTION2_2019/src/NST/agrif_user.F90 @ 12191

Last change on this file since 12191 was 12191, checked in by jchanut, 4 years ago
Add dev_AGRIF-01-05_merged branch, e.g. 2019 AGRIF dev
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: