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_oce_interp.F90 in NEMO/branches/2019/dev_r10973_AGRIF-01_jchanut_small_jpi_jpj/src/NST – NEMO

source: NEMO/branches/2019/dev_r10973_AGRIF-01_jchanut_small_jpi_jpj/src/NST/agrif_oce_interp.F90 @ 11205

Last change on this file since 11205 was 11205, checked in by jchanut, 5 years ago

#2199
1) Make sponge independent of sub-domain size. Partially masked open boundary segments are not taken into account anymore. To do so, sponge coefficients should be read in a file for realistic applications (then nesting tools need to be modified accordingly).
2) Replace East-West-North-South barotropic data arrays by a global 2d array. Then apply barotropic open boundary conditions thanks to mi0/mi1, mj0/mj1 indexes.
3) Call AGRIF bdy update one more time in dynspg_ts during extrapolation phase. This removes a dozen lines of code in dynspg_ts routine.

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