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/2017/dev_merge_2017/NEMOGCM/NEMO/NST_SRC – NEMO

source: branches/2017/dev_merge_2017/NEMOGCM/NEMO/NST_SRC/agrif_opa_interp.F90 @ 9082

Last change on this file since 9082 was 9082, checked in by clem, 6 years ago

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