Context Navigation

agrif_user.F90 @ 12340

Last change on this file since 12340 was 12340, checked in by acc, 4 years ago

Branch 2019/dev_r11943_MERGE_2019. This commit introduces basic do loop macro
substitution to the 2019 option 1, merge branch. These changes have been SETTE
tested. The only addition is the do_loop_substitute.h90 file in the OCE directory but
the macros defined therein are used throughout the code to replace identifiable, 2D-
and 3D- nested loop opening and closing statements with single-line alternatives. Code
indents are also adjusted accordingly.

The following explanation is taken from comments in the new header file:

This header file contains preprocessor definitions and macros used in the do-loop
substitutions introduced between version 4.0 and 4.2. The primary aim of these macros
is to assist in future applications of tiling to improve performance. This is expected
to be achieved by alternative versions of these macros in selected locations. The
initial introduction of these macros simply replaces all identifiable nested 2D- and
3D-loops with single line statements (and adjusts indenting accordingly). Do loops
are identifiable if they comform to either:

DO jk = ....

DO jj = .... DO jj = ...

DO ji = .... DO ji = ...
. OR .
. .

END DO END DO

END DO END DO

END DO

and white-space variants thereof.

Additionally, only loops with recognised jj and ji loops limits are treated; these are:
Lower limits of 1, 2 or fs_2
Upper limits of jpi, jpim1 or fs_jpim1 (for ji) or jpj, jpjm1 or fs_jpjm1 (for jj)

The macro naming convention takes the form: DO_2D_BT_LR where:

B is the Bottom offset from the PE's inner domain;
T is the Top offset from the PE's inner domain;
L is the Left offset from the PE's inner domain;
R is the Right offset from the PE's inner domain

So, given an inner domain of 2,jpim1 and 2,jpjm1, a typical example would replace:

DO jj = 2, jpj

DO ji = 1, jpim1
.
.

END DO

END DO

with:

DO_2D_01_10
.
.
END_2D

similar conventions apply to the 3D loops macros. jk loop limits are retained
through macro arguments and are not restricted. This includes the possibility of
strides for which an extra set of DO_3DS macros are defined.

In the example definition below the inner PE domain is defined by start indices of
(kIs, kJs) and end indices of (kIe, KJe)

#define DO_2D_00_00 DO jj = kJs, kJe ; DO ji = kIs, kIe
#define END_2D END DO ; END DO

TO DO:

Only conventional nested loops have been identified and replaced by this step. There are constructs such as:

DO jk = 2, jpkm1

z2d(:,:) = z2d(:,:) + e3w(:,:,jk,Kmm) * z3d(:,:,jk) * wmask(:,:,jk)

END DO

which may need to be considered.

Property svn:keywords set to Id

File size: 37.1 KB

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

New URL for NEMO forge! http://forge.nemo-ocean.eu

Context Navigation

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

Download in other formats: