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 @ 9031

Last change on this file since 9031 was 9031, checked in by timgraham, 7 years ago

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