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

Context Navigation

source: NEMO/branches/2019/dev_r11943_MERGE_2019/src/NST/agrif_user.F90 @ 12229

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

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

Download in other formats: