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_opa_interp.F90 in branches/2015/dev_r5803_UKMO_AGRIF_Vert_interp/NEMOGCM/NEMO/NST_SRC – NEMO

Context Navigation

source: branches/2015/dev_r5803_UKMO_AGRIF_Vert_interp/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90 @ 6404

Last change on this file since 6404 was 6404, checked in by timgraham, 9 years ago
First attempt at upgrading branch to the head of the trunk. This should include all of the simplification branch from the merge in Dec 2015.
Property svn:keywords set to `Id`
File size: 56.9 KB

Line
1	MODULE agrif_opa_interp
2	!!======================================================================
3	!! * MODULE agrif_opa_interp *
4	!! AGRIF: interpolation package
5	!!======================================================================
6	!! History : 2.0 ! 2002-06 (XXX) Original cade
7	!! - ! 2005-11 (XXX)
8	!! 3.2 ! 2009-04 (R. Benshila)
9	!! 3.6 ! 2014-09 (R. Benshila)
10	!!----------------------------------------------------------------------
11	#if defined key_agrif && ! defined key_offline
12	!!----------------------------------------------------------------------
13	!! 'key_agrif' AGRIF zoom
14	!! NOT 'key_offline' NO off-line tracers
15	!!----------------------------------------------------------------------
16	!! Agrif_tra :
17	!! Agrif_dyn :
18	!! interpu :
19	!! interpv :
20	!!----------------------------------------------------------------------
21	USE par_oce
22	USE oce
23	USE dom_oce
24	USE zdf_oce
25	USE agrif_oce
26	USE phycst
27	!
28	USE in_out_manager
29	USE agrif_opa_sponge
30	USE lib_mpp
31	USE wrk_nemo
32
33	IMPLICIT NONE
34	PRIVATE
35
36	PUBLIC Agrif_tra, Agrif_dyn, Agrif_ssh, Agrif_dyn_ts, Agrif_ssh_ts, Agrif_dta_ts
37	! VERTICAL REFINEMENT BEGIN
38	PUBLIC Agrif_Init_InterpScales
39	! VERTICAL REFINEMENT END
40	PUBLIC interpun, interpvn, interpun2d, interpvn2d
41	PUBLIC interptsn, interpsshn
42	PUBLIC interpunb, interpvnb, interpub2b, interpvb2b
43	PUBLIC interpe3t, interpumsk, interpvmsk
44	# if defined key_zdftke
45	PUBLIC Agrif_tke, interpavm
46	# endif
47
48	INTEGER :: bdy_tinterp = 0
49
50	# include "vectopt_loop_substitute.h90"
51	!!----------------------------------------------------------------------
52	!! NEMO/NST 3.7 , NEMO Consortium (2015)
53	!! $Id$
54	!! Software governed by the CeCILL licence (NEMOGCM/NEMO_CeCILL.txt)
55	!!----------------------------------------------------------------------
56	! VERTICAL REFINEMENT BEGIN
57	REAL, DIMENSION(:,:,:), ALLOCATABLE :: interp_scales_t, interp_scales_u, interp_scales_v
58	!$AGRIF_DO_NOT_TREAT
59	LOGICAL :: scaleT, scaleU, scaleV = .FALSE.
60	!$AGRIF_END_DO_NOT_TREAT
61	! VERTICAL REFINEMENT END
62
63	CONTAINS
64
65	! VERTICAL REFINEMENT BEGIN
66
67	SUBROUTINE Agrif_Init_InterpScales
68
69	scaleT = .TRUE.
70	Call Agrif_Bc_Variable(scales_t_id,calledweight=1.,procname=interpscales)
71	scaleT = .FALSE.
72
73	scaleU = .TRUE.
74	Call Agrif_Bc_Variable(scales_u_id,calledweight=1.,procname=interpscales)
75	scaleU = .FALSE.
76
77	scaleV = .TRUE.
78	Call Agrif_Bc_Variable(scales_v_id,calledweight=1.,procname=interpscales)
79	scaleV = .FALSE.
80
81	END SUBROUTINE Agrif_Init_InterpScales
82
83	SUBROUTINE interpscales(ptab,i1,i2,j1,j2,k1,k2,before)
84	!!---------------------------------------------
85	!! * ROUTINE interpscales *
86	!!---------------------------------------------
87
88	INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2
89	REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
90
91	INTEGER :: ji, jj, jk
92	LOGICAL :: before
93
94	IF (before) THEN
95	IF (scaleT ) THEN
96	DO jk=k1,k2
97	DO jj=j1,j2
98	DO ji=i1,i2
99	! ptab(ji,jj,jk) = e3t_n(ji,jj,jk) * tmask(ji,jj,jk)
100	ptab(ji,jj,jk) = e3t_n(ji,jj,jk)
101	END DO
102	END DO
103	END DO
104	ELSEIF (scaleU) THEN
105	DO jk=k1,k2
106	DO jj=j1,j2
107	DO ji=i1,i2
108	! ptab(ji,jj,jk) = e3u_n(ji,jj,jk) * umask(ji,jj,jk)
109	! ptab(ji,jj,jk) = e3u_n(ji,jj,jk)
110	ptab(ji,jj,jk) = umask(ji,jj,jk)
111	END DO
112	END DO
113	END DO
114	ELSEIF (scaleV) THEN
115	DO jk=k1,k2
116	DO jj=j1,j2
117	DO ji=i1,i2
118	! ptab(ji,jj,jk) = e3v_n(ji,jj,jk) * vmask(ji,jj,jk)
119	! ptab(ji,jj,jk) = e3v_n(ji,jj,jk)
120	ptab(ji,jj,jk) = vmask(ji,jj,jk)
121	END DO
122	END DO
123	END DO
124	ENDIF
125	ELSE
126	IF (scaleT ) THEN
127	IF (.not.allocated(interp_scales_t)) allocate(interp_scales_t(jpi,jpj,k1:k2))
128	DO jk=k1,k2
129	DO jj=j1,j2
130	DO ji=i1,i2
131	interp_scales_t(ji,jj,jk) = ptab(ji,jj,jk)
132	END DO
133	END DO
134	END DO
135	ELSEIF (scaleU) THEN
136	IF (.not.allocated(interp_scales_u)) allocate(interp_scales_u(jpi,jpj,k1:k2))
137	DO jk=k1,k2
138	DO jj=j1,j2
139	DO ji=i1,i2
140	interp_scales_u(ji,jj,jk) = ptab(ji,jj,jk)
141	END DO
142	END DO
143	END DO
144	ELSEIF (scaleV) THEN
145	IF (.not.allocated(interp_scales_v)) allocate(interp_scales_v(jpi,jpj,k1:k2))
146	DO jk=k1,k2
147	DO jj=j1,j2
148	DO ji=i1,i2
149	interp_scales_v(ji,jj,jk) = ptab(ji,jj,jk)
150	END DO
151	END DO
152	END DO
153	ENDIF
154	ENDIF
155
156	END SUBROUTINE interpscales
157
158	! VERTICAL REFINEMENT END
159
160	SUBROUTINE Agrif_tra
161	!!----------------------------------------------------------------------
162	!! * ROUTINE Agrif_tra *
163	!!----------------------------------------------------------------------
164	!
165	IF( Agrif_Root() ) RETURN
166	!
167	Agrif_SpecialValue = 0._wp
168	Agrif_UseSpecialValue = .TRUE.
169	!
170	CALL Agrif_Bc_variable( tsn_id, procname=interptsn )
171	!
172	Agrif_UseSpecialValue = .FALSE.
173	!
174	END SUBROUTINE Agrif_tra
175
176
177	SUBROUTINE Agrif_dyn( kt )
178	!!----------------------------------------------------------------------
179	!! * ROUTINE Agrif_DYN *
180	!!----------------------------------------------------------------------
181	INTEGER, INTENT(in) :: kt
182	!
183	INTEGER :: ji, jj, jk ! dummy loop indices
184	INTEGER :: j1, j2, i1, i2
185	REAL(wp), POINTER, DIMENSION(:,:) :: zub, zvb
186	!!----------------------------------------------------------------------
187	!
188	IF( Agrif_Root() ) RETURN
189	!
190	CALL wrk_alloc( jpi,jpj, zub, zvb )
191	!
192	Agrif_SpecialValue = 0._wp
193	Agrif_UseSpecialValue = ln_spc_dyn
194	!
195	CALL Agrif_Bc_variable( un_interp_id, procname=interpun )
196	CALL Agrif_Bc_variable( vn_interp_id, procname=interpvn )
197	!
198	Agrif_UseSpecialValue = .FALSE.
199	!
200	! prevent smoothing in ghost cells
201	i1 = 1 ; i2 = jpi
202	j1 = 1 ; j2 = jpj
203	IF( nbondj == -1 .OR. nbondj == 2 ) j1 = 3
204	IF( nbondj == +1 .OR. nbondj == 2 ) j2 = nlcj-2
205	IF( nbondi == -1 .OR. nbondi == 2 ) i1 = 3
206	IF( nbondi == +1 .OR. nbondi == 2 ) i2 = nlci-2
207
208	IF( nbondi == -1 .OR. nbondi == 2 ) THEN
209	!
210	! Smoothing
211	! ---------
212	IF( .NOT.ln_dynspg_ts ) THEN ! Store transport
213	ua_b(2,:) = 0._wp
214	DO jk = 1, jpkm1
215	DO jj = 1, jpj
216	ua_b(2,jj) = ua_b(2,jj) + e3u_a(2,jj,jk) * ua(2,jj,jk)
217	END DO
218	END DO
219	DO jj = 1, jpj
220	ua_b(2,jj) = ua_b(2,jj) * r1_hu_a(2,jj)
221	END DO
222	ENDIF
223	!
224	DO jk=1,jpkm1 ! Smooth
225	DO jj=j1,j2
226	ua(2,jj,jk) = 0.25_wp(ua(1,jj,jk)+2._wpua(2,jj,jk)+ua(3,jj,jk))
227	ua(2,jj,jk) = ua(2,jj,jk) * umask(2,jj,jk)
228	END DO
229	END DO
230	!
231	zub(2,:) = 0._wp ! Correct transport
232	DO jk = 1, jpkm1
233	DO jj = 1, jpj
234	zub(2,jj) = zub(2,jj) + e3u_a(2,jj,jk) * ua(2,jj,jk)
235	END DO
236	END DO
237	DO jj=1,jpj
238	zub(2,jj) = zub(2,jj) * r1_hu_a(2,jj)
239	END DO
240
241	DO jk=1,jpkm1
242	DO jj=1,jpj
243	ua(2,jj,jk) = (ua(2,jj,jk)+ua_b(2,jj)-zub(2,jj))*umask(2,jj,jk)
244	END DO
245	END DO
246
247	! Set tangential velocities to time splitting estimate
248	!-----------------------------------------------------
249	IF( ln_dynspg_ts ) THEN
250	zvb(2,:) = 0._wp
251	DO jk = 1, jpkm1
252	DO jj = 1, jpj
253	zvb(2,jj) = zvb(2,jj) + e3v_a(2,jj,jk) * va(2,jj,jk)
254	END DO
255	END DO
256	DO jj = 1, jpj
257	zvb(2,jj) = zvb(2,jj) * r1_hv_a(2,jj)
258	END DO
259	DO jk = 1, jpkm1
260	DO jj = 1, jpj
261	va(2,jj,jk) = (va(2,jj,jk)+va_b(2,jj)-zvb(2,jj)) * vmask(2,jj,jk)
262	END DO
263	END DO
264	ENDIF
265	!
266	! Mask domain edges:
267	!-------------------
268	DO jk = 1, jpkm1
269	DO jj = 1, jpj
270	ua(1,jj,jk) = 0._wp
271	va(1,jj,jk) = 0._wp
272	END DO
273	END DO
274	!
275	ENDIF
276
277	IF( nbondi == 1 .OR. nbondi == 2 ) THEN
278
279	! Smoothing
280	! ---------
281	IF( .NOT.ln_dynspg_ts ) THEN ! Store transport
282	ua_b(nlci-2,:) = 0._wp
283	DO jk=1,jpkm1
284	DO jj=1,jpj
285	ua_b(nlci-2,jj) = ua_b(nlci-2,jj) + e3u_a(nlci-2,jj,jk) * ua(nlci-2,jj,jk)
286	END DO
287	END DO
288	DO jj=1,jpj
289	ua_b(nlci-2,jj) = ua_b(nlci-2,jj) * r1_hu_a(nlci-2,jj)
290	END DO
291	ENDIF
292
293	DO jk = 1, jpkm1 ! Smooth
294	DO jj = j1, j2
295	ua(nlci-2,jj,jk) = 0.25_wp * umask(nlci-2,jj,jk) &
296	& * ( ua(nlci-3,jj,jk) + 2._wp*ua(nlci-2,jj,jk) + ua(nlci-1,jj,jk) )
297	END DO
298	END DO
299
300	zub(nlci-2,:) = 0._wp ! Correct transport
301	DO jk = 1, jpkm1
302	DO jj = 1, jpj
303	zub(nlci-2,jj) = zub(nlci-2,jj) + e3u_a(nlci-2,jj,jk) * ua(nlci-2,jj,jk)
304	END DO
305	END DO
306	DO jj = 1, jpj
307	zub(nlci-2,jj) = zub(nlci-2,jj) * r1_hu_a(nlci-2,jj)
308	END DO
309
310	DO jk = 1, jpkm1
311	DO jj = 1, jpj
312	ua(nlci-2,jj,jk) = ( ua(nlci-2,jj,jk) + ua_b(nlci-2,jj) - zub(nlci-2,jj) ) * umask(nlci-2,jj,jk)
313	END DO
314	END DO
315	!
316	! Set tangential velocities to time splitting estimate
317	!-----------------------------------------------------
318	IF( ln_dynspg_ts ) THEN
319	zvb(nlci-1,:) = 0._wp
320	DO jk = 1, jpkm1
321	DO jj = 1, jpj
322	zvb(nlci-1,jj) = zvb(nlci-1,jj) + e3v_a(nlci-1,jj,jk) * va(nlci-1,jj,jk)
323	END DO
324	END DO
325	DO jj=1,jpj
326	zvb(nlci-1,jj) = zvb(nlci-1,jj) * r1_hv_a(nlci-1,jj)
327	END DO
328	DO jk = 1, jpkm1
329	DO jj = 1, jpj
330	va(nlci-1,jj,jk) = ( va(nlci-1,jj,jk) + va_b(nlci-1,jj) - zvb(nlci-1,jj) ) * vmask(nlci-1,jj,jk)
331	END DO
332	END DO
333	ENDIF
334	!
335	! Mask domain edges:
336	!-------------------
337	DO jk = 1, jpkm1
338	DO jj = 1, jpj
339	ua(nlci-1,jj,jk) = 0._wp
340	va(nlci ,jj,jk) = 0._wp
341	END DO
342	END DO
343	!
344	ENDIF
345
346	IF( nbondj == -1 .OR. nbondj == 2 ) THEN
347
348	! Smoothing
349	! ---------
350	IF( .NOT.ln_dynspg_ts ) THEN ! Store transport
351	va_b(:,2) = 0._wp
352	DO jk = 1, jpkm1
353	DO ji = 1, jpi
354	va_b(ji,2) = va_b(ji,2) + e3v_a(ji,2,jk) * va(ji,2,jk)
355	END DO
356	END DO
357	DO ji=1,jpi
358	va_b(ji,2) = va_b(ji,2) * r1_hv_a(ji,2)
359	END DO
360	ENDIF
361	!
362	DO jk = 1, jpkm1 ! Smooth
363	DO ji = i1, i2
364	va(ji,2,jk) = 0.25_wp * vmask(ji,2,jk) &
365	& * ( va(ji,1,jk) + 2._wp*va(ji,2,jk) + va(ji,3,jk) )
366	END DO
367	END DO
368	!
369	zvb(:,2) = 0._wp ! Correct transport
370	DO jk=1,jpkm1
371	DO ji=1,jpi
372	zvb(ji,2) = zvb(ji,2) + e3v_a(ji,2,jk) * va(ji,2,jk) * vmask(ji,2,jk)
373	END DO
374	END DO
375	DO ji = 1, jpi
376	zvb(ji,2) = zvb(ji,2) * r1_hv_a(ji,2)
377	END DO
378	DO jk = 1, jpkm1
379	DO ji = 1, jpi
380	va(ji,2,jk) = ( va(ji,2,jk) + va_b(ji,2) - zvb(ji,2) ) * vmask(ji,2,jk)
381	END DO
382	END DO
383
384	! Set tangential velocities to time splitting estimate
385	!-----------------------------------------------------
386	IF( ln_dynspg_ts ) THEN
387	zub(:,2) = 0._wp
388	DO jk = 1, jpkm1
389	DO ji = 1, jpi
390	zub(ji,2) = zub(ji,2) + e3u_a(ji,2,jk) * ua(ji,2,jk) * umask(ji,2,jk)
391	END DO
392	END DO
393	DO ji = 1, jpi
394	zub(ji,2) = zub(ji,2) * r1_hu_a(ji,2)
395	END DO
396
397	DO jk = 1, jpkm1
398	DO ji = 1, jpi
399	ua(ji,2,jk) = ( ua(ji,2,jk) + ua_b(ji,2) - zub(ji,2) ) * umask(ji,2,jk)
400	END DO
401	END DO
402	ENDIF
403
404	! Mask domain edges:
405	!-------------------
406	DO jk = 1, jpkm1
407	DO ji = 1, jpi
408	ua(ji,1,jk) = 0._wp
409	va(ji,1,jk) = 0._wp
410	END DO
411	END DO
412
413	ENDIF
414
415	IF( nbondj == 1 .OR. nbondj == 2 ) THEN
416	!
417	! Smoothing
418	! ---------
419	IF( .NOT.ln_dynspg_ts ) THEN ! Store transport
420	va_b(:,nlcj-2) = 0._wp
421	DO jk = 1, jpkm1
422	DO ji = 1, jpi
423	va_b(ji,nlcj-2) = va_b(ji,nlcj-2) + e3v_a(ji,nlcj-2,jk) * va(ji,nlcj-2,jk)
424	END DO
425	END DO
426	DO ji = 1, jpi
427	va_b(ji,nlcj-2) = va_b(ji,nlcj-2) * r1_hv_a(ji,nlcj-2)
428	END DO
429	ENDIF
430	!
431	DO jk = 1, jpkm1 ! Smooth
432	DO ji = i1, i2
433	va(ji,nlcj-2,jk) = 0.25_wp * vmask(ji,nlcj-2,jk) &
434	& * ( va(ji,nlcj-3,jk) + 2._wp * va(ji,nlcj-2,jk) + va(ji,nlcj-1,jk) )
435	END DO
436	END DO
437	!
438	zvb(:,nlcj-2) = 0._wp ! Correct transport
439	DO jk = 1, jpkm1
440	DO ji = 1, jpi
441	zvb(ji,nlcj-2) = zvb(ji,nlcj-2) + e3v_a(ji,nlcj-2,jk) * va(ji,nlcj-2,jk) * vmask(ji,nlcj-2,jk)
442	END DO
443	END DO
444	DO ji = 1, jpi
445	zvb(ji,nlcj-2) = zvb(ji,nlcj-2) * r1_hv_a(ji,nlcj-2)
446	END DO
447	DO jk = 1, jpkm1
448	DO ji = 1, jpi
449	va(ji,nlcj-2,jk) = ( va(ji,nlcj-2,jk) + va_b(ji,nlcj-2) - zvb(ji,nlcj-2) ) * vmask(ji,nlcj-2,jk)
450	END DO
451	END DO
452	!
453	! Set tangential velocities to time splitting estimate
454	!-----------------------------------------------------
455	IF( ln_dynspg_ts ) THEN
456	zub(:,nlcj-1) = 0._wp
457	DO jk = 1, jpkm1
458	DO ji = 1, jpi
459	zub(ji,nlcj-1) = zub(ji,nlcj-1) + e3u_a(ji,nlcj-1,jk) * ua(ji,nlcj-1,jk) * umask(ji,nlcj-1,jk)
460	END DO
461	END DO
462	DO ji = 1, jpi
463	zub(ji,nlcj-1) = zub(ji,nlcj-1) * r1_hu_a(ji,nlcj-1)
464	END DO
465	!
466	DO jk = 1, jpkm1
467	DO ji = 1, jpi
468	ua(ji,nlcj-1,jk) = ( ua(ji,nlcj-1,jk) + ua_b(ji,nlcj-1) - zub(ji,nlcj-1) ) * umask(ji,nlcj-1,jk)
469	END DO
470	END DO
471	ENDIF
472	!
473	! Mask domain edges:
474	!-------------------
475	DO jk = 1, jpkm1
476	DO ji = 1, jpi
477	ua(ji,nlcj ,jk) = 0._wp
478	va(ji,nlcj-1,jk) = 0._wp
479	END DO
480	END DO
481	!
482	ENDIF
483	!
484	CALL wrk_dealloc( jpi,jpj, zub, zvb )
485	!
486	END SUBROUTINE Agrif_dyn
487
488
489	SUBROUTINE Agrif_dyn_ts( jn )
490	!!----------------------------------------------------------------------
491	!! * ROUTINE Agrif_dyn_ts *
492	!!----------------------------------------------------------------------
493	!!
494	INTEGER, INTENT(in) :: jn
495	!!
496	INTEGER :: ji, jj
497	!!----------------------------------------------------------------------
498	!
499	IF( Agrif_Root() ) RETURN
500	!
501	IF((nbondi == -1).OR.(nbondi == 2)) THEN
502	DO jj=1,jpj
503	va_e(2,jj) = vbdy_w(jj) * hvr_e(2,jj)
504	! Specified fluxes:
505	ua_e(2,jj) = ubdy_w(jj) * hur_e(2,jj)
506	! Characteristics method:
507	!alt ua_e(2,jj) = 0.5_wp * ( ubdy_w(jj) * hur_e(2,jj) + ua_e(3,jj) &
508	!alt & - sqrt(grav * hur_e(2,jj)) * (sshn_e(3,jj) - hbdy_w(jj)) )
509	END DO
510	ENDIF
511	!
512	IF((nbondi == 1).OR.(nbondi == 2)) THEN
513	DO jj=1,jpj
514	va_e(nlci-1,jj) = vbdy_e(jj) * hvr_e(nlci-1,jj)
515	! Specified fluxes:
516	ua_e(nlci-2,jj) = ubdy_e(jj) * hur_e(nlci-2,jj)
517	! Characteristics method:
518	!alt ua_e(nlci-2,jj) = 0.5_wp * ( ubdy_e(jj) * hur_e(nlci-2,jj) + ua_e(nlci-3,jj) &
519	!alt & + sqrt(grav * hur_e(nlci-2,jj)) * (sshn_e(nlci-2,jj) - hbdy_e(jj)) )
520	END DO
521	ENDIF
522	!
523	IF((nbondj == -1).OR.(nbondj == 2)) THEN
524	DO ji=1,jpi
525	ua_e(ji,2) = ubdy_s(ji) * hur_e(ji,2)
526	! Specified fluxes:
527	va_e(ji,2) = vbdy_s(ji) * hvr_e(ji,2)
528	! Characteristics method:
529	!alt va_e(ji,2) = 0.5_wp * ( vbdy_s(ji) * hvr_e(ji,2) + va_e(ji,3) &
530	!alt & - sqrt(grav * hvr_e(ji,2)) * (sshn_e(ji,3) - hbdy_s(ji)) )
531	END DO
532	ENDIF
533	!
534	IF((nbondj == 1).OR.(nbondj == 2)) THEN
535	DO ji=1,jpi
536	ua_e(ji,nlcj-1) = ubdy_n(ji) * hur_e(ji,nlcj-1)
537	! Specified fluxes:
538	va_e(ji,nlcj-2) = vbdy_n(ji) * hvr_e(ji,nlcj-2)
539	! Characteristics method:
540	!alt va_e(ji,nlcj-2) = 0.5_wp * ( vbdy_n(ji) * hvr_e(ji,nlcj-2) + va_e(ji,nlcj-3) &
541	!alt & + sqrt(grav * hvr_e(ji,nlcj-2)) * (sshn_e(ji,nlcj-2) - hbdy_n(ji)) )
542	END DO
543	ENDIF
544	!
545	END SUBROUTINE Agrif_dyn_ts
546
547
548	SUBROUTINE Agrif_dta_ts( kt )
549	!!----------------------------------------------------------------------
550	!! * ROUTINE Agrif_dta_ts *
551	!!----------------------------------------------------------------------
552	!!
553	INTEGER, INTENT(in) :: kt
554	!!
555	INTEGER :: ji, jj
556	LOGICAL :: ll_int_cons
557	REAL(wp) :: zrhot, zt
558	!!----------------------------------------------------------------------
559	!
560	IF( Agrif_Root() ) RETURN
561	!
562	ll_int_cons = ln_bt_fw ! Assume conservative temporal integration in the forward case only
563	!
564	zrhot = Agrif_rhot()
565	!
566	! "Central" time index for interpolation:
567	IF( ln_bt_fw ) THEN
568	zt = REAL( Agrif_NbStepint()+0.5_wp, wp ) / zrhot
569	ELSE
570	zt = REAL( Agrif_NbStepint() , wp ) / zrhot
571	ENDIF
572	!
573	! Linear interpolation of sea level
574	Agrif_SpecialValue = 0._wp
575	Agrif_UseSpecialValue = .TRUE.
576	CALL Agrif_Bc_variable( sshn_id, calledweight=zt, procname=interpsshn )
577	Agrif_UseSpecialValue = .FALSE.
578	!
579	! Interpolate barotropic fluxes
580	Agrif_SpecialValue=0.
581	Agrif_UseSpecialValue = ln_spc_dyn
582	!
583	IF( ll_int_cons ) THEN ! Conservative interpolation
584	! orders matters here !!!!!!
585	CALL Agrif_Bc_variable( ub2b_interp_id, calledweight=1._wp, procname=interpub2b ) ! Time integrated
586	CALL Agrif_Bc_variable( vb2b_interp_id, calledweight=1._wp, procname=interpvb2b )
587	bdy_tinterp = 1
588	CALL Agrif_Bc_variable( unb_id , calledweight=1._wp, procname=interpunb ) ! After
589	CALL Agrif_Bc_variable( vnb_id , calledweight=1._wp, procname=interpvnb )
590	bdy_tinterp = 2
591	CALL Agrif_Bc_variable( unb_id , calledweight=0._wp, procname=interpunb ) ! Before
592	CALL Agrif_Bc_variable( vnb_id , calledweight=0._wp, procname=interpvnb )
593	ELSE ! Linear interpolation
594	bdy_tinterp = 0
595	ubdy_w(:) = 0._wp ; vbdy_w(:) = 0._wp
596	ubdy_e(:) = 0._wp ; vbdy_e(:) = 0._wp
597	ubdy_n(:) = 0._wp ; vbdy_n(:) = 0._wp
598	ubdy_s(:) = 0._wp ; vbdy_s(:) = 0._wp
599	CALL Agrif_Bc_variable( unb_id, calledweight=zt, procname=interpunb )
600	CALL Agrif_Bc_variable( vnb_id, calledweight=zt, procname=interpvnb )
601	ENDIF
602	Agrif_UseSpecialValue = .FALSE.
603	!
604	END SUBROUTINE Agrif_dta_ts
605
606
607	SUBROUTINE Agrif_ssh( kt )
608	!!----------------------------------------------------------------------
609	!! * ROUTINE Agrif_DYN *
610	!!----------------------------------------------------------------------
611	INTEGER, INTENT(in) :: kt
612	!!
613	!!----------------------------------------------------------------------
614	!
615	IF( Agrif_Root() ) RETURN
616	!
617	IF((nbondi == -1).OR.(nbondi == 2)) THEN
618	ssha(2,:)=ssha(3,:)
619	sshn(2,:)=sshn(3,:)
620	ENDIF
621	!
622	IF((nbondi == 1).OR.(nbondi == 2)) THEN
623	ssha(nlci-1,:)=ssha(nlci-2,:)
624	sshn(nlci-1,:)=sshn(nlci-2,:)
625	ENDIF
626	!
627	IF((nbondj == -1).OR.(nbondj == 2)) THEN
628	ssha(:,2)=ssha(:,3)
629	sshn(:,2)=sshn(:,3)
630	ENDIF
631	!
632	IF((nbondj == 1).OR.(nbondj == 2)) THEN
633	ssha(:,nlcj-1)=ssha(:,nlcj-2)
634	sshn(:,nlcj-1)=sshn(:,nlcj-2)
635	ENDIF
636	!
637	END SUBROUTINE Agrif_ssh
638
639
640	SUBROUTINE Agrif_ssh_ts( jn )
641	!!----------------------------------------------------------------------
642	!! * ROUTINE Agrif_ssh_ts *
643	!!----------------------------------------------------------------------
644	INTEGER, INTENT(in) :: jn
645	!!
646	INTEGER :: ji,jj
647	!!----------------------------------------------------------------------
648	!
649	IF((nbondi == -1).OR.(nbondi == 2)) THEN
650	DO jj = 1, jpj
651	ssha_e(2,jj) = hbdy_w(jj)
652	END DO
653	ENDIF
654	!
655	IF((nbondi == 1).OR.(nbondi == 2)) THEN
656	DO jj = 1, jpj
657	ssha_e(nlci-1,jj) = hbdy_e(jj)
658	END DO
659	ENDIF
660	!
661	IF((nbondj == -1).OR.(nbondj == 2)) THEN
662	DO ji = 1, jpi
663	ssha_e(ji,2) = hbdy_s(ji)
664	END DO
665	ENDIF
666	!
667	IF((nbondj == 1).OR.(nbondj == 2)) THEN
668	DO ji = 1, jpi
669	ssha_e(ji,nlcj-1) = hbdy_n(ji)
670	END DO
671	ENDIF
672	!
673	END SUBROUTINE Agrif_ssh_ts
674
675	# if defined key_zdftke
676
677	SUBROUTINE Agrif_tke
678	!!----------------------------------------------------------------------
679	!! * ROUTINE Agrif_tke *
680	!!----------------------------------------------------------------------
681	REAL(wp) :: zalpha
682	!!----------------------------------------------------------------------
683	!
684	return
685
686	zalpha = REAL( Agrif_NbStepint() + Agrif_IRhot() - 1, wp ) / REAL( Agrif_IRhot(), wp )
687	IF( zalpha > 1. ) zalpha = 1.
688	!
689	Agrif_SpecialValue = 0.e0
690	Agrif_UseSpecialValue = .TRUE.
691	!
692	CALL Agrif_Bc_variable(avm_id ,calledweight=zalpha, procname=interpavm)
693	!
694	Agrif_UseSpecialValue = .FALSE.
695	!
696	END SUBROUTINE Agrif_tke
697
698	# endif
699
700	SUBROUTINE interptsn( ptab, i1, i2, j1, j2, k1, k2, n1, n2, before, nb, ndir )
701	!!----------------------------------------------------------------------
702	!! * ROUTINE interptsn *
703	!!----------------------------------------------------------------------
704	REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,n1:n2), INTENT(inout) :: ptab
705	INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2, n1, n2
706	LOGICAL , INTENT(in ) :: before
707	INTEGER , INTENT(in ) :: nb , ndir
708	!
709	INTEGER :: ji, jj, jk, jn ! dummy loop indices
710	INTEGER :: imin, imax, jmin, jmax
711	REAL(wp) :: zrhox , zalpha1, zalpha2, zalpha3
712	REAL(wp) :: zalpha4, zalpha5, zalpha6, zalpha7
713	LOGICAL :: western_side, eastern_side,northern_side,southern_side
714	! VERTICAL REFINEMENT BEGIN
715	REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk,n1:n2) :: ptab_child
716	REAL(wp) :: h_in(k1:k2)
717	REAL(wp) :: h_out(1:jpk)
718	INTEGER :: N_in, N_out
719	REAL(wp) :: h_diff
720	! VERTICAL REFINEMENT END
721
722	IF (before) THEN
723	ptab(i1:i2,j1:j2,k1:k2,n1:n2) = tsn(i1:i2,j1:j2,k1:k2,n1:n2)
724	ELSE
725	! VERTICAL REFINEMENT BEGIN
726
727	ptab_child(:,:,:,:) = 0.
728	do jj=j1,j2
729	do ji=i1,i2
730	h_in(k1:k2) = interp_scales_t(ji,jj,k1:k2)
731	h_out(1:jpk) = e3t_n(ji,jj,1:jpk)
732	h_diff = sum(h_out(1:jpk-1))-sum(h_in(k1:k2-1))
733	N_in = k2-1
734	N_out = jpk-1
735	if (h_diff > 0) then
736	h_in(N_in+1) = h_diff
737	N_in = N_in + 1
738	else
739	h_out(N_out+1) = -h_diff
740	N_out = N_out + 1
741	endif
742	ptab(ji,jj,k2,:) = ptab(ji,jj,k2-1,:)
743	do jn=1,jpts
744	call reconstructandremap(ptab(ji,jj,1:N_in,jn),h_in,ptab_child(ji,jj,1:N_out,jn),h_out,N_in,N_out)
745	enddo
746	! if (abs(h_diff) > 1000.) then
747	! do jn=1,jpts
748	! do jk=1,N_out
749	! print *,'AVANT APRES = ',ji,jj,jk,N_out,ptab(ji,jj,jk,jn),ptab_child(ji,jj,jk,jn)
750	! enddo
751	! enddo
752	! endif
753	enddo
754	enddo
755
756	! VERTICAL REFINEMENT END
757
758	!
759	western_side = (nb == 1).AND.(ndir == 1)
760	eastern_side = (nb == 1).AND.(ndir == 2)
761	southern_side = (nb == 2).AND.(ndir == 1)
762	northern_side = (nb == 2).AND.(ndir == 2)
763	!
764	zrhox = Agrif_Rhox()
765	!
766	zalpha1 = ( zrhox - 1. ) * 0.5
767	zalpha2 = 1. - zalpha1
768	!
769	zalpha3 = ( zrhox - 1. ) / ( zrhox + 1. )
770	zalpha4 = 1. - zalpha3
771	!
772	zalpha6 = 2. * ( zrhox - 1. ) / ( zrhox + 1. )
773	zalpha7 = - ( zrhox - 1. ) / ( zrhox + 3. )
774	zalpha5 = 1. - zalpha6 - zalpha7
775	!
776	imin = i1
777	imax = i2
778	jmin = j1
779	jmax = j2
780	!
781	! Remove CORNERS
782	IF((nbondj == -1).OR.(nbondj == 2)) jmin = 3
783	IF((nbondj == +1).OR.(nbondj == 2)) jmax = nlcj-2
784	IF((nbondi == -1).OR.(nbondi == 2)) imin = 3
785	IF((nbondi == +1).OR.(nbondi == 2)) imax = nlci-2
786	!
787	! VERTICAL REFINEMENT BEGIN
788
789	! WARNING :
790	! ptab replaced by ptab_child in the following
791	! k1 k2 replaced by 1 jpk
792	! VERTICAL REFINEMENT END
793	IF( eastern_side) THEN
794	DO jn = 1, jpts
795	tsa(nlci,j1:j2,1:jpk,jn) = zalpha1 * ptab_child(nlci,j1:j2,1:jpk,jn) + zalpha2 * ptab_child(nlci-1,j1:j2,1:jpk,jn)
796	DO jk = 1, jpkm1
797	DO jj = jmin,jmax
798	IF( umask(nlci-2,jj,jk) == 0._wp ) THEN
799	tsa(nlci-1,jj,jk,jn) = tsa(nlci,jj,jk,jn) * tmask(nlci-1,jj,jk)
800	ELSE
801	tsa(nlci-1,jj,jk,jn)=(zalpha4tsa(nlci,jj,jk,jn)+zalpha3tsa(nlci-2,jj,jk,jn))*tmask(nlci-1,jj,jk)
802	IF( un(nlci-2,jj,jk) > 0._wp ) THEN
803	tsa(nlci-1,jj,jk,jn)=( zalpha6tsa(nlci-2,jj,jk,jn)+zalpha5tsa(nlci,jj,jk,jn) &
804	+ zalpha7tsa(nlci-3,jj,jk,jn) ) tmask(nlci-1,jj,jk)
805	ENDIF
806	ENDIF
807	END DO
808	END DO
809	tsa(nlci,j1:j2,k1:k2,jn) = 0._wp
810	END DO
811	ENDIF
812	!
813	IF( northern_side ) THEN
814	DO jn = 1, jpts
815	tsa(i1:i2,nlcj,1:jpk,jn) = zalpha1 * ptab_child(i1:i2,nlcj,1:jpk,jn) + zalpha2 * ptab_child(i1:i2,nlcj-1,1:jpk,jn)
816	DO jk = 1, jpkm1
817	DO ji = imin,imax
818	IF( vmask(ji,nlcj-2,jk) == 0._wp ) THEN
819	tsa(ji,nlcj-1,jk,jn) = tsa(ji,nlcj,jk,jn) * tmask(ji,nlcj-1,jk)
820	ELSE
821	tsa(ji,nlcj-1,jk,jn)=(zalpha4tsa(ji,nlcj,jk,jn)+zalpha3tsa(ji,nlcj-2,jk,jn))*tmask(ji,nlcj-1,jk)
822	IF (vn(ji,nlcj-2,jk) > 0._wp ) THEN
823	tsa(ji,nlcj-1,jk,jn)=( zalpha6tsa(ji,nlcj-2,jk,jn)+zalpha5tsa(ji,nlcj,jk,jn) &
824	+ zalpha7tsa(ji,nlcj-3,jk,jn) ) tmask(ji,nlcj-1,jk)
825	ENDIF
826	ENDIF
827	END DO
828	END DO
829	tsa(i1:i2,nlcj,k1:k2,jn) = 0._wp
830	END DO
831	ENDIF
832	!
833	IF( western_side ) THEN
834	DO jn = 1, jpts
835	tsa(1,j1:j2,1:jpk,jn) = zalpha1 * ptab_child(1,j1:j2,1:jpk,jn) + zalpha2 * ptab_child(2,j1:j2,1:jpk,jn)
836	DO jk = 1, jpkm1
837	DO jj = jmin,jmax
838	IF( umask(2,jj,jk) == 0._wp ) THEN
839	tsa(2,jj,jk,jn) = tsa(1,jj,jk,jn) * tmask(2,jj,jk)
840	ELSE
841	tsa(2,jj,jk,jn)=(zalpha4tsa(1,jj,jk,jn)+zalpha3tsa(3,jj,jk,jn))*tmask(2,jj,jk)
842	IF( un(2,jj,jk) < 0._wp ) THEN
843	tsa(2,jj,jk,jn)=(zalpha6tsa(3,jj,jk,jn)+zalpha5tsa(1,jj,jk,jn)+zalpha7tsa(4,jj,jk,jn))tmask(2,jj,jk)
844	ENDIF
845	ENDIF
846	END DO
847	END DO
848	tsa(1,j1:j2,k1:k2,jn) = 0._wp
849	END DO
850	ENDIF
851	!
852	IF( southern_side ) THEN
853	DO jn = 1, jpts
854	tsa(i1:i2,1,1:jpk,jn) = zalpha1 * ptab_child(i1:i2,1,1:jpk,jn) + zalpha2 * ptab_child(i1:i2,2,1:jpk,jn)
855	DO jk = 1, jpk
856	DO ji=imin,imax
857	IF( vmask(ji,2,jk) == 0._wp ) THEN
858	tsa(ji,2,jk,jn)=tsa(ji,1,jk,jn) * tmask(ji,2,jk)
859	ELSE
860	tsa(ji,2,jk,jn)=(zalpha4tsa(ji,1,jk,jn)+zalpha3tsa(ji,3,jk,jn))*tmask(ji,2,jk)
861	IF( vn(ji,2,jk) < 0._wp ) THEN
862	tsa(ji,2,jk,jn)=(zalpha6tsa(ji,3,jk,jn)+zalpha5tsa(ji,1,jk,jn)+zalpha7tsa(ji,4,jk,jn))tmask(ji,2,jk)
863	ENDIF
864	ENDIF
865	END DO
866	END DO
867	tsa(i1:i2,1,k1:k2,jn) = 0._wp
868	END DO
869	ENDIF
870	!
871	! Treatment of corners
872	!
873	! East south
874	IF ((eastern_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN
875	tsa(nlci-1,2,:,:) = ptab_child(nlci-1,2,:,:)
876	ENDIF
877	! East north
878	IF ((eastern_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN
879	tsa(nlci-1,nlcj-1,:,:) = ptab_child(nlci-1,nlcj-1,:,:)
880	ENDIF
881	! West south
882	IF ((western_side).AND.((nbondj == -1).OR.(nbondj == 2))) THEN
883	tsa(2,2,:,:) = ptab_child(2,2,:,:)
884	ENDIF
885	! West north
886	IF ((western_side).AND.((nbondj == 1).OR.(nbondj == 2))) THEN
887	tsa(2,nlcj-1,:,:) = ptab_child(2,nlcj-1,:,:)
888	ENDIF
889	!
890	ENDIF
891	!
892	END SUBROUTINE interptsn
893
894
895	SUBROUTINE interpsshn( ptab, i1, i2, j1, j2, before, nb, ndir )
896	!!----------------------------------------------------------------------
897	!! * ROUTINE interpsshn *
898	!!----------------------------------------------------------------------
899	INTEGER , INTENT(in ) :: i1, i2, j1, j2
900	REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
901	LOGICAL , INTENT(in ) :: before
902	INTEGER , INTENT(in ) :: nb , ndir
903	!
904	LOGICAL :: western_side, eastern_side,northern_side,southern_side
905	!!----------------------------------------------------------------------
906	!
907	IF( before) THEN
908	ptab(i1:i2,j1:j2) = sshn(i1:i2,j1:j2)
909	ELSE
910	western_side = (nb == 1).AND.(ndir == 1)
911	eastern_side = (nb == 1).AND.(ndir == 2)
912	southern_side = (nb == 2).AND.(ndir == 1)
913	northern_side = (nb == 2).AND.(ndir == 2)
914	IF(western_side) hbdy_w(j1:j2) = ptab(i1,j1:j2) * tmask(i1,j1:j2,1)
915	IF(eastern_side) hbdy_e(j1:j2) = ptab(i1,j1:j2) * tmask(i1,j1:j2,1)
916	IF(southern_side) hbdy_s(i1:i2) = ptab(i1:i2,j1) * tmask(i1:i2,j1,1)
917	IF(northern_side) hbdy_n(i1:i2) = ptab(i1:i2,j1) * tmask(i1:i2,j1,1)
918	ENDIF
919	!
920	END SUBROUTINE interpsshn
921
922	SUBROUTINE interpun(ptab,i1,i2,j1,j2,k1,k2,m1,m2,before,nb,ndir)
923	!!---------------------------------------------
924	!! * ROUTINE interpun *
925	!!---------------------------------------------
926	!!
927	INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,m1,m2
928	REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,m1:m2), INTENT(inout) :: ptab
929	LOGICAL, INTENT(in) :: before
930	INTEGER, INTENT(in) :: nb , ndir
931	!!
932	INTEGER :: ji,jj,jk
933	REAL(wp) :: zrhoy
934	! VERTICAL REFINEMENT BEGIN
935	REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: ptab_child
936	REAL(wp), DIMENSION(k1:k2) :: tabin
937	REAL(wp) :: h_in(k1:k2)
938	REAL(wp) :: h_out(1:jpk)
939	INTEGER :: N_in, N_out
940	REAL(wp) :: h_diff
941	LOGICAL :: western_side, eastern_side
942	INTEGER :: iref
943
944	! VERTICAL REFINEMENT END
945	!!---------------------------------------------
946	!
947	IF (before) THEN
948	DO jk=1,jpk
949	DO jj=j1,j2
950	DO ji=i1,i2
951	ptab(ji,jj,jk,1) = e2u(ji,jj) * un(ji,jj,jk)
952	ptab(ji,jj,jk,1) = ptab(ji,jj,jk,1) * e3u_n(ji,jj,jk)
953	ptab(ji,jj,jk,2) = e3u_n(ji,jj,jk)
954	END DO
955	END DO
956	END DO
957	ELSE
958	! VERTICAL REFINEMENT BEGIN
959	western_side = (nb == 1).AND.(ndir == 1)
960	eastern_side = (nb == 1).AND.(ndir == 2)
961
962	ptab_child(:,:,:) = 0.
963	do jj=j1,j2
964	do ji=i1,i2
965	iref = ji
966	IF (western_side) iref = 2
967	IF (eastern_side) iref = nlci-2
968
969	N_in = 0
970	do jk=k1,k2
971	if (interp_scales_u(ji,jj,jk) == 0) EXIT
972	N_in = N_in + 1
973	tabin(jk) = ptab(ji,jj,jk,1)/ptab(ji,jj,jk,2)
974	h_in(N_in) = ptab(ji,jj,jk,2)
975	enddo
976
977	IF (N_in == 0) THEN
978	ptab_child(ji,jj,:) = 0.
979	CYCLE
980	ENDIF
981
982	N_out = 0
983	do jk=1,jpk
984	if (umask(iref,jj,jk) == 0) EXIT
985	N_out = N_out + 1
986	h_out(N_out) = e3u_n(ji,jj,jk)
987	enddo
988
989	IF (N_out == 0) THEN
990	ptab_child(ji,jj,:) = 0.
991	CYCLE
992	ENDIF
993
994	h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in))
995	IF (h_diff > 0.) THEN
996	N_in = N_in + 1
997	h_in(N_in) = h_diff
998	tabin(N_in) = 0.
999	ELSE
1000	h_out(N_out) = h_out(N_out) - h_diff
1001	ENDIF
1002
1003	call reconstructandremap(tabin(1:N_in),h_in(1:N_in),ptab_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out)
1004
1005	ptab_child(ji,jj,N_out) = ptab_child(ji,jj,N_out) * h_out(N_out) / e3u_n(ji,jj,N_out)
1006
1007	ENDDO
1008	ENDDO
1009
1010	! in the following
1011	! remove division of ua by fs e3u (already done)
1012	! VERTICAL REFINEMENT END
1013
1014	zrhoy = Agrif_Rhoy()
1015	DO jk = 1, jpkm1
1016	DO jj=j1,j2
1017	ua(i1:i2,jj,jk) = (ptab_child(i1:i2,jj,jk)/(zrhoy*e2u(i1:i2,jj)))
1018	END DO
1019	END DO
1020	ENDIF
1021	!
1022	END SUBROUTINE interpun
1023
1024
1025	SUBROUTINE interpun2d(ptab,i1,i2,j1,j2,before)
1026	!!---------------------------------------------
1027	!! * ROUTINE interpun *
1028	!!---------------------------------------------
1029	!
1030	INTEGER, INTENT(in) :: i1,i2,j1,j2
1031	REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
1032	LOGICAL, INTENT(in) :: before
1033	!
1034	INTEGER :: ji,jj
1035	REAL(wp) :: ztref
1036	REAL(wp) :: zrhoy
1037	!!---------------------------------------------
1038	!
1039	ztref = 1.
1040
1041	IF (before) THEN
1042	DO jj=j1,j2
1043	DO ji=i1,MIN(i2,nlci-1)
1044	ptab(ji,jj) = e2u(ji,jj) * ((gcx(ji+1,jj) - gcx(ji,jj))/e1u(ji,jj))
1045	END DO
1046	END DO
1047	ELSE
1048	zrhoy = Agrif_Rhoy()
1049	DO jj=j1,j2
1050	laplacu(i1:i2,jj) = ztref * (ptab(i1:i2,jj)/(zrhoye2u(i1:i2,jj))) !umask(i1:i2,jj,1)
1051	END DO
1052	ENDIF
1053	!
1054	END SUBROUTINE interpun2d
1055
1056
1057	SUBROUTINE interpvn(ptab,i1,i2,j1,j2,k1,k2,m1,m2,before,nb,ndir)
1058	!!---------------------------------------------
1059	!! * ROUTINE interpvn *
1060	!!----------------------------------------------------------------------
1061	INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2
1062	REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
1063	LOGICAL , INTENT(in ) :: before
1064	!
1065	INTEGER, INTENT(in) :: i1,i2,j1,j2,k1,k2,m1,m2
1066	REAL(wp), DIMENSION(i1:i2,j1:j2,k1:k2,m1:m2), INTENT(inout) :: ptab
1067	LOGICAL, INTENT(in) :: before
1068	INTEGER, INTENT(in) :: nb , ndir
1069	!
1070	INTEGER :: ji,jj,jk
1071	REAL(wp) :: zrhox
1072	! VERTICAL REFINEMENT BEGIN
1073	REAL(wp), DIMENSION(i1:i2,j1:j2,1:jpk) :: ptab_child
1074	REAL(wp), DIMENSION(k1:k2) :: tabin
1075	REAL(wp) :: h_in(k1:k2)
1076	REAL(wp) :: h_out(1:jpk)
1077	INTEGER :: N_in, N_out
1078	REAL(wp) :: h_diff
1079	LOGICAL :: northern_side,southern_side
1080	INTEGER :: jref
1081
1082	! VERTICAL REFINEMENT END
1083	!!---------------------------------------------
1084	!
1085	IF (before) THEN
1086	!interpv entre 1 et k2 et interpv2d en jpkp1
1087	DO jk=k1,jpk
1088	DO jj=j1,j2
1089	DO ji=i1,i2
1090	ptab(ji,jj,jk,1) = e1v(ji,jj) * vn(ji,jj,jk)
1091	ptab(ji,jj,jk,1) = ptab(ji,jj,jk,1) * e3v_n(ji,jj,jk)
1092	ptab(ji,jj,jk,2) = e3v_n(ji,jj,jk)
1093	END DO
1094	END DO
1095	END DO
1096	ELSE
1097	! VERTICAL REFINEMENT BEGIN
1098	ptab_child(:,:,:) = 0.
1099	southern_side = (nb == 2).AND.(ndir == 1)
1100	northern_side = (nb == 2).AND.(ndir == 2)
1101	do jj=j1,j2
1102	jref = jj
1103	IF (southern_side) jref = 2
1104	IF (northern_side) jref = nlcj-2
1105	do ji=i1,i2
1106
1107	N_in = 0
1108	do jk=k1,k2
1109	if (interp_scales_v(ji,jj,jk) == 0) EXIT
1110	N_in = N_in + 1
1111	tabin(jk) = ptab(ji,jj,jk,1)/ptab(ji,jj,jk,2)
1112	h_in(N_in) = ptab(ji,jj,jk,2)
1113	enddo
1114	IF (N_in == 0) THEN
1115	ptab_child(ji,jj,:) = 0.
1116	CYCLE
1117	ENDIF
1118
1119	N_out = 0
1120	do jk=1,jpk
1121	if (vmask(ji,jref,jk) == 0) EXIT
1122	N_out = N_out + 1
1123	h_out(N_out) = e3v_n(ji,jj,jk)
1124	enddo
1125	IF (N_out == 0) THEN
1126	ptab_child(ji,jj,:) = 0.
1127	CYCLE
1128	ENDIF
1129
1130	h_diff = sum(h_out(1:N_out))-sum(h_in(1:N_in))
1131	IF (h_diff > 0.) THEN
1132	N_in = N_in + 1
1133	h_in(N_in) = h_diff
1134	tabin(N_in) = 0.
1135	ELSE
1136	h_out(N_out) = h_out(N_out) - h_diff
1137	ENDIF
1138
1139	call reconstructandremap(tabin(1:N_in),h_in(1:N_in),ptab_child(ji,jj,1:N_out),h_out(1:N_out),N_in,N_out)
1140
1141	ptab_child(ji,jj,N_out) = ptab_child(ji,jj,N_out) * h_out(N_out) / e3v_n(ji,jj,N_out)
1142
1143	enddo
1144	enddo
1145	! in the following
1146	! remove division of va by fs e3v (already done)
1147	! VERTICAL REFINEMENT END
1148	zrhox= Agrif_Rhox()
1149	<<<<<<< .working
1150	DO jk=1,jpkm1
1151	DO jj=j1,j2
1152	va(i1:i2,jj,jk) = (ptab_child(i1:i2,jj,jk)/(zrhox*e1v(i1:i2,jj)))
1153	END DO
1154	END DO
1155	ENDIF
1156	!
1157	END SUBROUTINE interpvn
1158
1159
1160	SUBROUTINE interpunb( ptab, i1, i2, j1, j2, before, nb, ndir )
1161	!!----------------------------------------------------------------------
1162	!! * ROUTINE interpunb *
1163	!!----------------------------------------------------------------------
1164	INTEGER , INTENT(in ) :: i1, i2, j1, j2
1165	REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
1166	LOGICAL , INTENT(in ) :: before
1167	INTEGER , INTENT(in ) :: nb , ndir
1168	!
1169	INTEGER :: ji, jj
1170	REAL(wp) :: zrhoy, zrhot, zt0, zt1, ztcoeff
1171	LOGICAL :: western_side, eastern_side,northern_side,southern_side
1172	!!----------------------------------------------------------------------
1173	!
1174	IF( before ) THEN
1175	ptab(i1:i2,j1:j2) = e2u(i1:i2,j1:j2) * hu_n(i1:i2,j1:j2) * un_b(i1:i2,j1:j2)
1176	ELSE
1177	western_side = (nb == 1).AND.(ndir == 1)
1178	eastern_side = (nb == 1).AND.(ndir == 2)
1179	southern_side = (nb == 2).AND.(ndir == 1)
1180	northern_side = (nb == 2).AND.(ndir == 2)
1181	zrhoy = Agrif_Rhoy()
1182	zrhot = Agrif_rhot()
1183	! Time indexes bounds for integration
1184	zt0 = REAL(Agrif_NbStepint() , wp) / zrhot
1185	zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot
1186	! Polynomial interpolation coefficients:
1187	IF( bdy_tinterp == 1 ) THEN
1188	ztcoeff = zrhot * ( zt1*2._wp ( zt1 - 1._wp) &
1189	& - zt0*2._wp ( zt0 - 1._wp) )
1190	ELSEIF( bdy_tinterp == 2 ) THEN
1191	ztcoeff = zrhot * ( zt1 * ( zt1 - 1._wp)**2._wp &
1192	& - zt0 * ( zt0 - 1._wp)**2._wp )
1193
1194	ELSE
1195	ztcoeff = 1
1196	ENDIF
1197	!
1198	IF(western_side) THEN
1199	ubdy_w(j1:j2) = ubdy_w(j1:j2) + ztcoeff * ptab(i1,j1:j2)
1200	ENDIF
1201	IF(eastern_side) THEN
1202	ubdy_e(j1:j2) = ubdy_e(j1:j2) + ztcoeff * ptab(i1,j1:j2)
1203	ENDIF
1204	IF(southern_side) THEN
1205	ubdy_s(i1:i2) = ubdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j1)
1206	ENDIF
1207	IF(northern_side) THEN
1208	ubdy_n(i1:i2) = ubdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1)
1209	ENDIF
1210	!
1211	IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN
1212	IF(western_side) THEN
1213	ubdy_w(j1:j2) = ubdy_w(j1:j2) / (zrhoye2u(i1,j1:j2)) umask(i1,j1:j2,1)
1214	ENDIF
1215	IF(eastern_side) THEN
1216	ubdy_e(j1:j2) = ubdy_e(j1:j2) / (zrhoye2u(i1,j1:j2)) umask(i1,j1:j2,1)
1217	ENDIF
1218	IF(southern_side) THEN
1219	ubdy_s(i1:i2) = ubdy_s(i1:i2) / (zrhoye2u(i1:i2,j1)) umask(i1:i2,j1,1)
1220	ENDIF
1221	IF(northern_side) THEN
1222	ubdy_n(i1:i2) = ubdy_n(i1:i2) / (zrhoye2u(i1:i2,j1)) umask(i1:i2,j1,1)
1223	ENDIF
1224	ENDIF
1225	ENDIF
1226	!
1227	END SUBROUTINE interpunb
1228
1229
1230	SUBROUTINE interpvnb( ptab, i1, i2, j1, j2, before, nb, ndir )
1231	!!----------------------------------------------------------------------
1232	!! * ROUTINE interpvnb *
1233	!!----------------------------------------------------------------------
1234	INTEGER , INTENT(in ) :: i1, i2, j1, j2
1235	REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
1236	LOGICAL , INTENT(in ) :: before
1237	INTEGER , INTENT(in ) :: nb , ndir
1238	!
1239	INTEGER :: ji,jj
1240	REAL(wp) :: zrhox, zrhot, zt0, zt1, ztcoeff
1241	LOGICAL :: western_side, eastern_side,northern_side,southern_side
1242	!!----------------------------------------------------------------------
1243	!
1244	IF( before ) THEN
1245	ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * hv_n(i1:i2,j1:j2) * vn_b(i1:i2,j1:j2)
1246	ELSE
1247	western_side = (nb == 1).AND.(ndir == 1)
1248	eastern_side = (nb == 1).AND.(ndir == 2)
1249	southern_side = (nb == 2).AND.(ndir == 1)
1250	northern_side = (nb == 2).AND.(ndir == 2)
1251	zrhox = Agrif_Rhox()
1252	zrhot = Agrif_rhot()
1253	! Time indexes bounds for integration
1254	zt0 = REAL(Agrif_NbStepint() , wp) / zrhot
1255	zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot
1256	IF( bdy_tinterp == 1 ) THEN
1257	ztcoeff = zrhot * ( zt1*2._wp ( zt1 - 1._wp) &
1258	& - zt0*2._wp ( zt0 - 1._wp) )
1259	ELSEIF( bdy_tinterp == 2 ) THEN
1260	ztcoeff = zrhot * ( zt1 * ( zt1 - 1._wp)**2._wp &
1261	& - zt0 * ( zt0 - 1._wp)**2._wp )
1262	ELSE
1263	ztcoeff = 1
1264	ENDIF
1265	!
1266	IF(western_side) THEN
1267	vbdy_w(j1:j2) = vbdy_w(j1:j2) + ztcoeff * ptab(i1,j1:j2)
1268	ENDIF
1269	IF(eastern_side) THEN
1270	vbdy_e(j1:j2) = vbdy_e(j1:j2) + ztcoeff * ptab(i1,j1:j2)
1271	ENDIF
1272	IF(southern_side) THEN
1273	vbdy_s(i1:i2) = vbdy_s(i1:i2) + ztcoeff * ptab(i1:i2,j1)
1274	ENDIF
1275	IF(northern_side) THEN
1276	vbdy_n(i1:i2) = vbdy_n(i1:i2) + ztcoeff * ptab(i1:i2,j1)
1277	ENDIF
1278	!
1279	IF( bdy_tinterp == 0 .OR. bdy_tinterp == 2) THEN
1280	IF(western_side) THEN
1281	vbdy_w(j1:j2) = vbdy_w(j1:j2) / (zrhox*e1v(i1,j1:j2)) &
1282	& * vmask(i1,j1:j2,1)
1283	ENDIF
1284	IF(eastern_side) THEN
1285	vbdy_e(j1:j2) = vbdy_e(j1:j2) / (zrhox*e1v(i1,j1:j2)) &
1286	& * vmask(i1,j1:j2,1)
1287	ENDIF
1288	IF(southern_side) THEN
1289	vbdy_s(i1:i2) = vbdy_s(i1:i2) / (zrhox*e1v(i1:i2,j1)) &
1290	& * vmask(i1:i2,j1,1)
1291	ENDIF
1292	IF(northern_side) THEN
1293	vbdy_n(i1:i2) = vbdy_n(i1:i2) / (zrhox*e1v(i1:i2,j1)) &
1294	& * vmask(i1:i2,j1,1)
1295	ENDIF
1296	ENDIF
1297	ENDIF
1298	!
1299	END SUBROUTINE interpvnb
1300
1301
1302	SUBROUTINE interpub2b( ptab, i1, i2, j1, j2, before, nb, ndir )
1303	!!----------------------------------------------------------------------
1304	!! * ROUTINE interpub2b *
1305	!!----------------------------------------------------------------------
1306	INTEGER , INTENT(in ) :: i1, i2, j1, j2
1307	REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
1308	LOGICAL , INTENT(in ) :: before
1309	INTEGER , INTENT(in ) :: nb , ndir
1310	!
1311	INTEGER :: ji,jj
1312	REAL(wp) :: zrhot, zt0, zt1,zat
1313	LOGICAL :: western_side, eastern_side,northern_side,southern_side
1314	!!----------------------------------------------------------------------
1315	IF( before ) THEN
1316	ptab(i1:i2,j1:j2) = e2u(i1:i2,j1:j2) * ub2_b(i1:i2,j1:j2)
1317	ELSE
1318	western_side = (nb == 1).AND.(ndir == 1)
1319	eastern_side = (nb == 1).AND.(ndir == 2)
1320	southern_side = (nb == 2).AND.(ndir == 1)
1321	northern_side = (nb == 2).AND.(ndir == 2)
1322	zrhot = Agrif_rhot()
1323	! Time indexes bounds for integration
1324	zt0 = REAL(Agrif_NbStepint() , wp) / zrhot
1325	zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot
1326	! Polynomial interpolation coefficients:
1327	zat = zrhot * ( zt1*2._wp (-2._wp*zt1 + 3._wp) &
1328	& - zt0*2._wp (-2._wp*zt0 + 3._wp) )
1329	!
1330	IF(western_side ) ubdy_w(j1:j2) = zat * ptab(i1,j1:j2)
1331	IF(eastern_side ) ubdy_e(j1:j2) = zat * ptab(i1,j1:j2)
1332	IF(southern_side) ubdy_s(i1:i2) = zat * ptab(i1:i2,j1)
1333	IF(northern_side) ubdy_n(i1:i2) = zat * ptab(i1:i2,j1)
1334	ENDIF
1335	!
1336	END SUBROUTINE interpub2b
1337
1338
1339	SUBROUTINE interpvb2b( ptab, i1, i2, j1, j2, before, nb, ndir )
1340	!!----------------------------------------------------------------------
1341	!! * ROUTINE interpvb2b *
1342	!!----------------------------------------------------------------------
1343	INTEGER , INTENT(in ) :: i1, i2, j1, j2
1344	REAL(wp), DIMENSION(i1:i2,j1:j2), INTENT(inout) :: ptab
1345	LOGICAL , INTENT(in ) :: before
1346	INTEGER , INTENT(in ) :: nb , ndir
1347	!
1348	INTEGER :: ji,jj
1349	REAL(wp) :: zrhot, zt0, zt1,zat
1350	LOGICAL :: western_side, eastern_side,northern_side,southern_side
1351	!!----------------------------------------------------------------------
1352	!
1353	IF( before ) THEN
1354	ptab(i1:i2,j1:j2) = e1v(i1:i2,j1:j2) * vb2_b(i1:i2,j1:j2)
1355	ELSE
1356	western_side = (nb == 1).AND.(ndir == 1)
1357	eastern_side = (nb == 1).AND.(ndir == 2)
1358	southern_side = (nb == 2).AND.(ndir == 1)
1359	northern_side = (nb == 2).AND.(ndir == 2)
1360	zrhot = Agrif_rhot()
1361	! Time indexes bounds for integration
1362	zt0 = REAL(Agrif_NbStepint() , wp) / zrhot
1363	zt1 = REAL(Agrif_NbStepint()+1, wp) / zrhot
1364	! Polynomial interpolation coefficients:
1365	zat = zrhot * ( zt1*2._wp (-2._wp*zt1 + 3._wp) &
1366	& - zt0*2._wp (-2._wp*zt0 + 3._wp) )
1367	!
1368	IF(western_side ) vbdy_w(j1:j2) = zat * ptab(i1,j1:j2)
1369	IF(eastern_side ) vbdy_e(j1:j2) = zat * ptab(i1,j1:j2)
1370	IF(southern_side) vbdy_s(i1:i2) = zat * ptab(i1:i2,j1)
1371	IF(northern_side) vbdy_n(i1:i2) = zat * ptab(i1:i2,j1)
1372	ENDIF
1373	!
1374	END SUBROUTINE interpvb2b
1375
1376
1377	SUBROUTINE interpe3t( ptab, i1, i2, j1, j2, k1, k2, before, nb, ndir )
1378	!!----------------------------------------------------------------------
1379	!! * ROUTINE interpe3t *
1380	!!----------------------------------------------------------------------
1381	INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2
1382	REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
1383	LOGICAL , INTENT(in ) :: before
1384	INTEGER , INTENT(in ) :: nb , ndir
1385	!
1386	INTEGER :: ji, jj, jk
1387	LOGICAL :: western_side, eastern_side, northern_side, southern_side
1388	REAL(wp) :: ztmpmsk
1389	!!----------------------------------------------------------------------
1390	!
1391	IF( before ) THEN
1392	ptab(i1:i2,j1:j2,k1:k2) = tmask(i1:i2,j1:j2,k1:k2) * e3t_0(i1:i2,j1:j2,k1:k2)
1393	ELSE
1394	western_side = (nb == 1).AND.(ndir == 1)
1395	eastern_side = (nb == 1).AND.(ndir == 2)
1396	southern_side = (nb == 2).AND.(ndir == 1)
1397	northern_side = (nb == 2).AND.(ndir == 2)
1398
1399	DO jk = k1, k2
1400	DO jj = j1, j2
1401	DO ji = i1, i2
1402	! Get velocity mask at boundary edge points:
1403	IF( western_side ) ztmpmsk = umask(ji ,jj ,1)
1404	IF( eastern_side ) ztmpmsk = umask(nlci-2,jj ,1)
1405	IF( northern_side) ztmpmsk = vmask(ji ,nlcj-2,1)
1406	IF( southern_side) ztmpmsk = vmask(ji ,2 ,1)
1407	!
1408	IF( ABS( ptab(ji,jj,jk) - tmask(ji,jj,jk) * e3t_0(ji,jj,jk) )*ztmpmsk > 1.D-2) THEN
1409	IF (western_side) THEN
1410	WRITE(numout,*) 'ERROR bathymetry merge at the western border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk
1411	ELSEIF (eastern_side) THEN
1412	WRITE(numout,*) 'ERROR bathymetry merge at the eastern border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk
1413	ELSEIF (southern_side) THEN
1414	WRITE(numout,*) 'ERROR bathymetry merge at the southern border ji,jj,jk', ji+nimpp-1,jj+njmpp-1,jk
1415	ELSEIF (northern_side) THEN
1416	WRITE(numout,*) 'ERROR bathymetry merge at the northen border ji,jj,jk', ji+nimpp-1,jj+njmpp-1,jk
1417	ENDIF
1418	WRITE(numout,*) ' ptab(ji,jj,jk), e3t(ji,jj,jk) ', ptab(ji,jj,jk), e3t_0(ji,jj,jk)
1419	kindic_agr = kindic_agr + 1
1420	ENDIF
1421	END DO
1422	END DO
1423	END DO
1424	!
1425	ENDIF
1426	!
1427	END SUBROUTINE interpe3t
1428
1429
1430	SUBROUTINE interpumsk( ptab, i1, i2, j1, j2, k1, k2, before, nb, ndir )
1431	!!----------------------------------------------------------------------
1432	!! * ROUTINE interpumsk *
1433	!!----------------------------------------------------------------------
1434	INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2
1435	REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
1436	LOGICAL , INTENT(in ) :: before
1437	INTEGER , INTENT(in ) :: nb , ndir
1438	!
1439	INTEGER :: ji, jj, jk
1440	LOGICAL :: western_side, eastern_side
1441	!!----------------------------------------------------------------------
1442	!
1443	IF( before ) THEN
1444	ptab(i1:i2,j1:j2,k1:k2) = umask(i1:i2,j1:j2,k1:k2)
1445	ELSE
1446	western_side = (nb == 1).AND.(ndir == 1)
1447	eastern_side = (nb == 1).AND.(ndir == 2)
1448	DO jk = k1, k2
1449	DO jj = j1, j2
1450	DO ji = i1, i2
1451	! Velocity mask at boundary edge points:
1452	IF (ABS(ptab(ji,jj,jk) - umask(ji,jj,jk)) > 1.D-2) THEN
1453	IF (western_side) THEN
1454	WRITE(numout,*) 'ERROR with umask at the western border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk
1455	WRITE(numout,*) ' masks: parent, child ', ptab(ji,jj,jk), umask(ji,jj,jk)
1456	kindic_agr = kindic_agr + 1
1457	ELSEIF (eastern_side) THEN
1458	WRITE(numout,*) 'ERROR with umask at the eastern border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk
1459	WRITE(numout,*) ' masks: parent, child ', ptab(ji,jj,jk), umask(ji,jj,jk)
1460	kindic_agr = kindic_agr + 1
1461	ENDIF
1462	ENDIF
1463	END DO
1464	END DO
1465	END DO
1466	!
1467	ENDIF
1468	!
1469	END SUBROUTINE interpumsk
1470
1471
1472	SUBROUTINE interpvmsk( ptab, i1, i2, j1, j2, k1, k2, before, nb, ndir )
1473	!!----------------------------------------------------------------------
1474	!! * ROUTINE interpvmsk *
1475	!!----------------------------------------------------------------------
1476	INTEGER , INTENT(in ) :: i1,i2,j1,j2,k1,k2
1477	REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
1478	LOGICAL , INTENT(in ) :: before
1479	INTEGER , INTENT(in ) :: nb , ndir
1480	!
1481	INTEGER :: ji, jj, jk
1482	LOGICAL :: northern_side, southern_side
1483	!!----------------------------------------------------------------------
1484	!
1485	IF( before ) THEN
1486	ptab(i1:i2,j1:j2,k1:k2) = vmask(i1:i2,j1:j2,k1:k2)
1487	ELSE
1488	southern_side = (nb == 2).AND.(ndir == 1)
1489	northern_side = (nb == 2).AND.(ndir == 2)
1490	DO jk = k1, k2
1491	DO jj = j1, j2
1492	DO ji = i1, i2
1493	! Velocity mask at boundary edge points:
1494	IF (ABS(ptab(ji,jj,jk) - vmask(ji,jj,jk)) > 1.D-2) THEN
1495	IF (southern_side) THEN
1496	WRITE(numout,*) 'ERROR with vmask at the southern border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk
1497	WRITE(numout,*) ' masks: parent, child ', ptab(ji,jj,jk), vmask(ji,jj,jk)
1498	kindic_agr = kindic_agr + 1
1499	ELSEIF (northern_side) THEN
1500	WRITE(numout,*) 'ERROR with vmask at the northern border ji,jj,jk ', ji+nimpp-1,jj+njmpp-1,jk
1501	WRITE(numout,*) ' masks: parent, child ', ptab(ji,jj,jk), vmask(ji,jj,jk)
1502	kindic_agr = kindic_agr + 1
1503	ENDIF
1504	ENDIF
1505	END DO
1506	END DO
1507	END DO
1508	!
1509	ENDIF
1510	!
1511	END SUBROUTINE interpvmsk
1512
1513	# if defined key_zdftke
1514
1515	SUBROUTINE interpavm( ptab, i1, i2, j1, j2, k1, k2, before )
1516	!!----------------------------------------------------------------------
1517	!! * ROUTINE interavm *
1518	!!----------------------------------------------------------------------
1519	INTEGER , INTENT(in ) :: i1, i2, j1, j2, k1, k2
1520	REAL(wp),DIMENSION(i1:i2,j1:j2,k1:k2), INTENT(inout) :: ptab
1521	LOGICAL , INTENT(in ) :: before
1522	!!----------------------------------------------------------------------
1523	!
1524	IF( before ) THEN
1525	ptab (i1:i2,j1:j2,k1:k2) = avm_k(i1:i2,j1:j2,k1:k2)
1526	ELSE
1527	avm_k(i1:i2,j1:j2,k1:k2) = ptab (i1:i2,j1:j2,k1:k2)
1528	ENDIF
1529	!
1530	END SUBROUTINE interpavm
1531
1532	# endif /* key_zdftke */
1533
1534	#else
1535	!!----------------------------------------------------------------------
1536	!! Empty module no AGRIF zoom
1537	!!----------------------------------------------------------------------
1538	CONTAINS
1539	SUBROUTINE Agrif_OPA_Interp_empty
1540	WRITE(,) 'agrif_opa_interp : You should not have seen this print! error?'
1541	END SUBROUTINE Agrif_OPA_Interp_empty
1542	#endif
1543
1544	!!======================================================================
1545	END MODULE agrif_opa_interp

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

Download in other formats: