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.
modinterp.F in trunk/AGRIF/AGRIF_FILES – NEMO

source: trunk/AGRIF/AGRIF_FILES/modinterp.F @ 396

Last change on this file since 396 was 396, checked in by opalod, 18 years ago

Initial revision

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 63.7 KB
RevLine 
[396]1!
2! $Id$
3!
4C     AGRIF (Adaptive Grid Refinement In Fortran)
5C
6C     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
7C                        Christophe Vouland (Christophe.Vouland@imag.fr)   
8C
9C     This program is free software; you can redistribute it and/or modify
10C     it under the terms of the GNU General Public License as published by
11C     the Free Software Foundation; either version 2 of the License, or
12C     (at your option) any later version.
13C
14C     This program is distributed in the hope that it will be useful,
15C     but WITHOUT ANY WARRANTY; without even the implied warranty of
16C     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
17C     GNU General Public License for more details.
18C
19C     You should have received a copy of the GNU General Public License
20C     along with this program; if not, write to the Free Software
21C     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
22C
23C
24C
25CCC   Module Agrif_Interpolation
26C
27      Module Agrif_Interpolation
28C
29CCC   Description:
30CCC   Module to initialize a fine grid from its parent grid, by using a space 
31CCC   interpolation
32C
33C     Modules used:
34C 
35      Use Agrif_Interpbasic
36      Use Agrif_Arrays
37      Use Agrif_Mask 
38      Use Agrif_CurgridFunctions
39#if defined AGRIF_MPI
40      Use Agrif_mpp
41#endif
42C     
43      IMPLICIT NONE
44C
45      CONTAINS
46C     Define procedures contained in this module       
47C
48C
49C
50C     **************************************************************************
51CCC   Subroutine Agrif_Interp_1d
52C     **************************************************************************
53C 
54      Subroutine Agrif_Interp_1d(TypeInterp,parent,child,tab,
55     &    torestore,nbdim)           
56C
57CCC   Description:
58CCC   Subroutine to calculate the boundary conditions of a fine grid for a 1D
59C        grid variable.
60C
61C     Declarations:
62C     
63     
64C
65C     Arguments     
66      INTEGER :: nbdim
67      INTEGER,DIMENSION(6) :: TypeInterp     ! Kind of interpolation
68                                             !    (linear,lagrange,spline)
69      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
70      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
71      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
72                                             !    grid
73      LOGICAL :: torestore
74      REAL, DIMENSION(
75     &         lbound(child%var%array1,1):ubound(child%var%array1,1)
76     &         ), Target :: tab    ! Result
77C
78C
79      allocate(childtemp % var) 
80C     
81C     Pointer on the root variable
82      childtemp % var % root_var => child % var %root_var
83C     
84C     Number of dimensions of the grid variable
85      childtemp % var % nbdim = nbdim
86C
87C     Tab is the result of the interpolation
88      childtemp % var % array1 => tab 
89C     
90      if (torestore) then
91C 
92          childtemp % var % array1 = child % var % array1
93C         
94          childtemp % var % restore1D => child % var % restore1D
95C     
96        else
97C       
98          Nullify(childtemp % var % restore1D)
99C     
100      endif     
101C 
102C     Index indicating (in the Agrif_Interp1D procedure) if a space
103C        interpolation is necessary
104      childtemp % var % interpIndex => child % var % interpIndex       
105      childtemp % var % Interpolationshouldbemade = 
106     &    child % var % Interpolationshouldbemade       
107C     
108      Call Agrif_InterpVariable
109     &     (TypeInterp,parent,childtemp,torestore)
110C     
111      deallocate(childtemp % var)
112C
113C       
114      End Subroutine Agrif_Interp_1D
115C
116C
117C
118C     **************************************************************************
119CCC   Subroutine Agrif_Interp_2d
120C     **************************************************************************
121C 
122      Subroutine Agrif_Interp_2d(TypeInterp,parent,child,tab,
123     &                           torestore,nbdim)           
124C
125CCC   Description:
126CCC   Subroutine to calculate the boundary conditions of a fine grid for a 2D
127C        grid variable.
128C
129C     Declarations:
130C     
131     
132C
133C     Arguments     
134      INTEGER :: nbdim
135      INTEGER,DIMENSION(6) :: TypeInterp     ! Kind of interpolation
136                                             !    (linear,lagrange,spline)
137      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
138      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
139      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
140                                             !    grid
141      LOGICAL :: torestore
142      REAL, DIMENSION(
143     &    lbound(child%var%array2,1):ubound(child%var%array2,1),
144     &    lbound(child%var%array2,2):ubound(child%var%array2,2)
145     &    ), Target :: tab    ! Result
146C
147C
148      allocate(childtemp % var) 
149C     
150C     Pointer on the root variable
151      childtemp % var % root_var => child % var %root_var
152C     
153C     Number of dimensions of the grid variable
154      childtemp % var % nbdim = nbdim
155C
156C     Tab is the result of the interpolation
157      childtemp % var % array2 => tab 
158C     
159      if (torestore) then     
160C 
161          childtemp % var % array2 = child % var % array2
162C 
163          childtemp % var % restore2D => child % var % restore2D       
164C     
165        else
166C       
167          Nullify(childtemp % var % restore2D)
168C     
169      endif       
170C 
171C     Index indicating (in the Agrif_Interp2D procedure) if a space
172C        interpolation is necessary
173      childtemp % var % interpIndex => child % var % interpIndex       
174      childtemp % var % Interpolationshouldbemade = 
175     &    child % var % Interpolationshouldbemade       
176C     
177      Call Agrif_InterpVariable
178     &     (TypeInterp,parent,childtemp,torestore)
179C     
180      deallocate(childtemp % var)
181C
182C       
183      End Subroutine Agrif_Interp_2D
184C
185C
186C
187C     **************************************************************************
188CCC   Subroutine Agrif_Interp_3d
189C     **************************************************************************
190C 
191      Subroutine Agrif_Interp_3d(TypeInterp,parent,child,tab,
192     &   torestore,nbdim)           
193C
194CCC   Description:
195CCC   Subroutine to calculate the boundary conditions of a fine grid for a 3D
196C        grid variable.
197C
198C     Declarations:
199C     
200     
201C
202C     Arguments     
203      INTEGER :: nbdim
204      INTEGER,DIMENSION(6) :: TypeInterp     ! Kind of interpolation
205                                             !    (linear,lagrange,spline)
206      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
207      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
208      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
209                                             !    grid
210      LOGICAL :: torestore
211      REAL, DIMENSION(
212     &      lbound(child%var%array3,1):ubound(child%var%array3,1),
213     &      lbound(child%var%array3,2):ubound(child%var%array3,2),
214     &      lbound(child%var%array3,3):ubound(child%var%array3,3)
215     &      ), Target :: tab  ! Results
216C
217C
218      allocate(childtemp % var) 
219C
220C     Pointer on the root variable
221      childtemp % var % root_var => child % var %root_var
222C     
223C     Number of dimensions of the grid variable
224      childtemp % var % nbdim = nbdim 
225C     
226C     Tab is the result of the interpolation 
227      childtemp % var % array3 => tab 
228C     
229      if (torestore) then
230C     
231          childtemp % var % array3 = child % var % array3
232C
233          childtemp % var % restore3D => child % var % restore3D
234C     
235        else
236C       
237          Nullify(childtemp % var % restore3D)
238C     
239      endif
240C 
241C     Index indicating (in the Agrif_Interp3D procedure) if a space
242C        interpolation is necessary
243      childtemp % var % interpIndex => child % var % interpIndex   
244      childtemp % var % Interpolationshouldbemade = 
245     &    child % var % Interpolationshouldbemade       
246C     
247      Call Agrif_InterpVariable
248     &     (TypeInterp,parent,childtemp,torestore)
249C     
250      deallocate(childtemp % var)
251C
252C       
253      End Subroutine Agrif_Interp_3D               
254C
255C
256C
257C     **************************************************************************
258CCC   Subroutine Agrif_Interp_4d
259C     **************************************************************************
260C 
261      Subroutine Agrif_Interp_4d(TypeInterp,parent,child,tab,
262     &   torestore,nbdim)           
263C
264CCC   Description:
265CCC   Subroutine to calculate the boundary conditions of a fine grid for a 4D
266C        grid variable.
267C
268C     Declarations:
269C     
270     
271C
272C     Arguments     
273      INTEGER :: nbdim
274      INTEGER,DIMENSION(6) :: TypeInterp     ! Kind of interpolation
275                                             !    (linear,lagrange,spline)
276      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
277      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
278      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
279                                             !    grid
280      LOGICAL :: torestore
281      REAL, DIMENSION(
282     &      lbound(child%var%array4,1):ubound(child%var%array4,1),
283     &      lbound(child%var%array4,2):ubound(child%var%array4,2),
284     &      lbound(child%var%array4,3):ubound(child%var%array4,3),
285     &      lbound(child%var%array4,4):ubound(child%var%array4,4)
286     &      ), Target :: tab  ! Results
287C
288C
289      allocate(childtemp % var) 
290C
291C     Pointer on the root variable
292      childtemp % var % root_var => child % var %root_var
293C     
294C     Number of dimensions of the grid variable
295      childtemp % var % nbdim = nbdim 
296C     
297C     Tab is the result of the interpolation
298      childtemp % var % array4 => tab 
299C 
300      if (torestore) then
301C 
302          childtemp % var % array4 = child % var % array4
303C
304          childtemp % var % restore4D => child % var % restore4D
305C     
306        else
307C       
308          Nullify(childtemp % var % restore4D)
309C     
310      endif       
311C 
312C     Index indicating (in the Agrif_Interp4D procedure) if a space
313C        interpolation is necessary
314      childtemp % var % interpIndex => child % var % interpIndex   
315      childtemp % var % Interpolationshouldbemade = 
316     &    child % var % Interpolationshouldbemade       
317C     
318      Call Agrif_InterpVariable
319     &     (TypeInterp,parent,childtemp,torestore)
320C     
321      deallocate(childtemp % var)
322C
323C       
324      End Subroutine Agrif_Interp_4D
325C
326C
327C
328C     **************************************************************************
329CCC   Subroutine Agrif_Interp_5d
330C     **************************************************************************
331C 
332      Subroutine Agrif_Interp_5d(TypeInterp,parent,child,tab,
333     &   torestore,nbdim)           
334C
335CCC   Description:
336CCC   Subroutine to calculate the boundary conditions of a fine grid for a 5D
337C        grid variable.
338C
339C     Declarations:
340C     
341     
342C
343C     Arguments     
344      INTEGER :: nbdim
345      INTEGER,DIMENSION(6) :: TypeInterp     ! Kind of interpolation
346                                             !    (linear,lagrange,spline)
347      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
348      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
349      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
350                                             !    grid
351      LOGICAL :: torestore
352      REAL, DIMENSION(
353     &      lbound(child%var%array5,1):ubound(child%var%array5,1),
354     &      lbound(child%var%array5,2):ubound(child%var%array5,2),
355     &      lbound(child%var%array5,3):ubound(child%var%array5,3),
356     &      lbound(child%var%array5,4):ubound(child%var%array5,4),
357     &      lbound(child%var%array5,5):ubound(child%var%array5,5)
358     &      ),  Target :: tab  ! Results
359C
360C
361      allocate(childtemp % var) 
362C
363C     Pointer on the root variable
364      childtemp % var % root_var => child % var %root_var
365C     
366C     Number of dimensions of the grid variable
367      childtemp % var % nbdim = nbdim 
368C     
369C     Tab is the result of the interpolation
370      childtemp % var % array5 => tab 
371C     
372      if (torestore) then
373C 
374          childtemp % var % array5 = child % var % array5
375C
376          childtemp % var % restore5D => child % var % restore5D
377C     
378        else
379C       
380          Nullify(childtemp % var % restore5D)
381C     
382      endif       
383C 
384C     Index indicating (in the Agrif_Interp5D procedure) if a space
385C        interpolation is necessary
386      childtemp % var % interpIndex => child % var % interpIndex   
387      childtemp % var % Interpolationshouldbemade = 
388     &    child % var % Interpolationshouldbemade       
389C     
390      Call Agrif_InterpVariable
391     &     (TypeInterp,parent,childtemp,torestore)
392C     
393      deallocate(childtemp % var)
394C
395C       
396      End Subroutine Agrif_Interp_5D
397C
398C
399C
400C     **************************************************************************
401CCC   Subroutine Agrif_Interp_6d
402C     **************************************************************************
403C 
404      Subroutine Agrif_Interp_6d(TypeInterp,parent,child,tab,
405     &  torestore,nbdim)           
406C
407CCC   Description:
408CCC   Subroutine to calculate the boundary conditions of a fine grid for a 6D
409C        grid variable.
410C
411C     Declarations:
412C     
413     
414C
415C     Arguments     
416      INTEGER :: nbdim
417      INTEGER,DIMENSION(6) :: TypeInterp     ! Kind of interpolation
418                                             !    (linear,lagrange,spline)
419      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
420      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
421      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
422                                             !    grid
423      LOGICAL :: torestore
424      REAL, DIMENSION(
425     &      lbound(child%var%array6,1):ubound(child%var%array6,1),
426     &      lbound(child%var%array6,2):ubound(child%var%array6,2),
427     &      lbound(child%var%array6,3):ubound(child%var%array6,3),
428     &      lbound(child%var%array6,4):ubound(child%var%array6,4),
429     &      lbound(child%var%array6,5):ubound(child%var%array6,5),
430     &      lbound(child%var%array6,6):ubound(child%var%array6,6)
431     &      ),  Target :: tab  ! Results
432C
433C
434      allocate(childtemp % var) 
435C
436C     Pointer on the root variable
437      childtemp % var % root_var => child % var %root_var
438C     
439C     Number of dimensions of the grid variable
440      childtemp % var % nbdim = nbdim 
441C     
442C     Tab is the result of the interpolation
443      childtemp % var % array6 => tab 
444C     
445      if (torestore) then
446C 
447          childtemp % var % array6 = child % var % array6
448C
449          childtemp % var % restore6D => child % var % restore6D
450C     
451        else
452C       
453          Nullify(childtemp % var % restore6D)
454C     
455      endif       
456C 
457C     Index indicating (in the Agrif_Interp6D procedure) if a space
458C        interpolation is necessary
459      childtemp % var % interpIndex => child % var % interpIndex   
460      childtemp % var % Interpolationshouldbemade = 
461     &    child % var % Interpolationshouldbemade       
462C     
463      Call Agrif_InterpVariable
464     &     (TypeInterp,parent,childtemp,torestore)
465C     
466      deallocate(childtemp % var)
467C
468C       
469      End Subroutine Agrif_Interp_6D
470C
471C
472C
473C     **************************************************************************
474C     Subroutine Agrif_InterpVariable   
475C     **************************************************************************
476C   
477      Subroutine Agrif_InterpVariable(TYPEinterp,parent,child,torestore)
478C
479CCC   Description:
480CCC   Subroutine to set some arguments of subroutine Agrif_InterpnD, n being the
481CCC   DIMENSION of the grid variable.
482C
483CC    Declarations:
484C     
485c     
486C     
487C
488C     Scalar argument
489      INTEGER,DIMENSION(6) :: TYPEinterp! TYPE of interpolation
490                                        !    (linear,spline,...)
491C     Data TYPE arguments                                   
492      TYPE(AGRIF_PVariable) :: parent   ! Variable on the parent grid
493      TYPE(AGRIF_PVariable) :: child    ! Variable on the child grid
494C
495C     LOGICAL argument     
496      LOGICAL:: torestore               ! Its value is .false., it indicates the
497                                        ! results of the interpolation are   
498                                        ! applied on the whole current grid   
499C
500C     Local scalars     
501      INTEGER               :: nbdim          ! Number of dimensions of the
502                                              !    current grid
503      INTEGER ,DIMENSION(6) :: pttab_child 
504      INTEGER ,DIMENSION(6) :: petab_child     
505      INTEGER ,DIMENSION(6) :: pttab_parent 
506      REAL    ,DIMENSION(6) :: s_child,s_parent
507      REAL    ,DIMENSION(6) :: ds_child,ds_parent
508C
509      Call PreProcessToInterpOrUpdate(parent,child,
510     &             petab_Child(1:nbdim),
511     &             pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
512     &             s_Child(1:nbdim),s_Parent(1:nbdim),
513     &             ds_Child(1:nbdim),ds_Parent(1:nbdim),
514     &             nbdim)
515C
516C
517C     Call to a procedure of interpolation against the number of dimensions of 
518C     the grid variable
519C
520      call Agrif_InterpnD
521     &            (TYPEinterp,parent,child,
522     &             pttab_Child(1:nbdim),petab_Child(1:nbdim),
523     &             pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
524     &             s_Child(1:nbdim),s_Parent(1:nbdim),
525     &             ds_Child(1:nbdim),ds_Parent(1:nbdim),
526     &             child,torestore,nbdim)
527C
528      Return
529C
530C
531      End subroutine Agrif_InterpVariable       
532C
533C
534C     **************************************************************************
535C     Subroutine Agrif_InterpnD 
536C     **************************************************************************
537C 
538      Subroutine Agrif_InterpnD(TYPEinterp,parent,child,
539     &                          pttab,petab,
540     &                          pttab_Child,pttab_Parent,
541     &                          s_Child,s_Parent,ds_Child,ds_Parent,
542     &                          restore,torestore,nbdim,procname)
543C
544C     Description:
545C     Subroutine to interpolate a nD grid variable from its parent grid,
546C     by using a space interpolation. 
547C
548C     Declarations:
549C
550     
551C
552#ifdef AGRIF_MPI
553C
554#include "mpif.h"
555C
556#endif
557C
558C     Arguments
559      External :: procname
560      Optional :: procname
561      INTEGER                    :: nbdim
562      INTEGER,DIMENSION(6)       :: TYPEinterp         ! TYPE of interpolation
563                                                       !    (linear,...)
564      TYPE(AGRIF_PVARIABLE)      :: parent             ! Variable of the parent
565                                                       !    grid
566      TYPE(AGRIF_PVARIABLE)      :: child              ! Variable of the child
567                                                       !    grid
568      INTEGER,DIMENSION(nbdim)   :: pttab              ! Index of the first
569                                                       !    point inside the
570                                                       !    domain
571      INTEGER,DIMENSION(nbdim)   :: petab              ! Index of the first
572                                                       !    point inside the
573                                                       !    domain
574      INTEGER,DIMENSION(nbdim)   :: pttab_Child        ! Index of the first
575                                                       !    point inside the
576                                                       !    domain for the child
577                                                       !    grid variable
578      INTEGER,DIMENSION(nbdim)   :: pttab_Parent       ! Index of the first
579                                                       !    point inside the
580                                                       !    domain for the
581                                                       !    parent grid variable
582      TYPE(AGRIF_PVARIABLE)      :: restore            ! Indicates points where
583                                                       !    interpolation
584      REAL,DIMENSION(nbdim)      :: s_Child,s_Parent   ! Positions of the parent
585                                                       !    and child grids
586      REAL,DIMENSION(nbdim)      :: ds_Child,ds_Parent ! Space steps of the
587                                                       !    parent and child
588                                                       !    grids
589      LOGICAL                        :: torestore      ! Indicates if the array
590                                                       !    restore is used
591C
592C     Local pointers
593      TYPE(AGRIF_PVARIABLE)      :: tempP,tempPextend  ! Temporary parent grid variable
594      TYPE(AGRIF_PVARIABLE)      :: tempC      ! Temporary child grid variable
595C
596C     Local scalars       
597      INTEGER                     :: i,j,k,l,m,n
598      INTEGER,DIMENSION(nbdim)    :: pttruetab,cetruetab
599      INTEGER,DIMENSION(nbdim)    :: indmin,indmax
600      LOGICAL,DIMENSION(nbdim)    :: noraftab
601      REAL   ,DIMENSION(nbdim)    :: s_Child_temp,s_Parent_temp
602      INTEGER,DIMENSION(nbdim)    :: lowerbound,upperbound
603      INTEGER,DIMENSION(nbdim)    :: indminglob,indmaxglob
604      INTEGER,DIMENSION(nbdim,2,2) :: childarray
605      INTEGER,DIMENSION(nbdim,2,2) :: parentarray
606      LOGICAL :: memberin,member
607      TYPE(AGRIF_PVARIABLE)                      ::  parentvalues
608C
609#ifdef AGRIF_MPI
610C
611      LOGICAL :: memberout
612      INTEGER,PARAMETER                          :: etiquette = 100
613      INTEGER                                    :: code
614      INTEGER,DIMENSION(nbdim)    :: indminglob2,indmaxglob2
615      INTEGER,DIMENSION(nbdim,4)           :: tab3
616      INTEGER,DIMENSION(nbdim,4,0:Agrif_Nbprocs-1) :: tab4
617      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,4) :: tab4t
618C
619#endif     
620C     
621C   
622C     Boundaries of the current grid where interpolation is done
623      Call Agrif_nbdim_Get_bound_dimension(child % var,
624     &                               lowerbound,upperbound,nbdim)
625
626      Call Agrif_Childbounds(nbdim,lowerbound,upperbound,
627     &                                   pttab,petab,
628     &                                   pttruetab,cetruetab,memberin)
629C
630C
631
632      Call Agrif_Parentbounds(TYPEinterp,nbdim,indminglob,indmaxglob,
633     &                        s_Parent_temp,s_Child_temp,
634     &                        s_Child,ds_Child,
635     &                        s_Parent,ds_Parent,
636     &                        pttab,petab,
637     &                        pttab_Child,pttab_Parent,
638     &                        child%var%root_var%posvar,
639     &                        child % var % root_var % interptab)
640
641
642#ifdef AGRIF_MPI 
643
644      IF (memberin) THEN
645      Call Agrif_Parentbounds(TYPEinterp,nbdim,indmin,indmax,
646     &                        s_Parent_temp,s_Child_temp,
647     &                        s_Child,ds_Child,
648     &                        s_Parent,ds_Parent,
649     &                        pttruetab,cetruetab,
650     &                        pttab_Child,pttab_Parent,
651     &                        child%var%root_var%posvar,
652     &                        child % var % root_var % interptab)
653      ENDIF
654   
655
656      Call Agrif_nbdim_Get_bound_dimension(parent%var,
657     &                              lowerbound,upperbound,nbdim)
658
659      Call Agrif_ChildGrid_to_ParentGrid()
660C
661      Call Agrif_Childbounds(nbdim,
662     &                       lowerbound,upperbound,
663     &                       indminglob,indmaxglob,
664     &                       indminglob2,indmaxglob2,member)
665
666C
667      IF (member) THEN
668      Call Agrif_GlobtoLocInd2(parentarray,
669     &                     lowerbound,upperbound,
670     &                     indminglob2,indmaxglob2,
671     &                     nbdim,Agrif_Procrank,
672     &                     member)
673            endif
674
675      Call Agrif_ParentGrid_to_ChildGrid()
676#else
677      parentarray(:,1,1) = indminglob
678      parentarray(:,2,1) = indmaxglob
679      parentarray(:,1,2) = indminglob
680      parentarray(:,2,2) = indmaxglob
681      indmin = indminglob
682      indmax = indmaxglob
683      member = .TRUE.
684#endif
685
686
687
688      IF (member) THEN
689      allocate(tempP%var)
690
691C
692      Call Agrif_nbdim_allocation(tempP%var,
693     &     parentarray(:,1,1),parentarray(:,2,1),nbdim)
694
695      Call Agrif_nbdim_Full_VarEQreal(tempP%var,0.,nbdim)
696
697
698
699      IF (present(procname)) THEN
700      Call Agrif_ChildGrid_to_ParentGrid()
701            SELECT CASE (nbdim)
702        CASE(1)
703          CALL procname(tempP%var%array1,
704     &                          parentarray(1,1,2),parentarray(1,2,2))
705        CASE(2)
706          CALL procname(tempP%var%array2,
707     &                          parentarray(1,1,2),parentarray(1,2,2),
708     &                          parentarray(2,1,2),parentarray(2,2,2))
709        CASE(3)
710          CALL procname(tempP%var%array3,
711     &                          parentarray(1,1,2),parentarray(1,2,2),
712     &                          parentarray(2,1,2),parentarray(2,2,2),
713     &                          parentarray(3,1,2),parentarray(3,2,2))
714        CASE(4)
715          CALL procname(tempP%var%array4,
716     &                          parentarray(1,1,2),parentarray(1,2,2),
717     &                          parentarray(2,1,2),parentarray(2,2,2),
718     &                          parentarray(3,1,2),parentarray(3,2,2),
719     &                          parentarray(4,1,2),parentarray(4,2,2))
720        CASE(5)
721          CALL procname(tempP%var%array5,
722     &                          parentarray(1,1,2),parentarray(1,2,2),
723     &                          parentarray(2,1,2),parentarray(2,2,2),
724     &                          parentarray(3,1,2),parentarray(3,2,2),
725     &                          parentarray(4,1,2),parentarray(4,2,2),
726     &                          parentarray(5,1,2),parentarray(5,2,2))
727        CASE(6)
728          CALL procname(tempP%var%array6,
729     &                          parentarray(1,1,2),parentarray(1,2,2),
730     &                          parentarray(2,1,2),parentarray(2,2,2),
731     &                          parentarray(3,1,2),parentarray(3,2,2),
732     &                          parentarray(4,1,2),parentarray(4,2,2),
733     &                          parentarray(5,1,2),parentarray(5,2,2),
734     &                          parentarray(6,1,2),parentarray(6,2,2))
735            END SELECT
736      Call Agrif_ParentGrid_to_ChildGrid()
737      ELSE
738      Call Agrif_nbdim_VarEQvar(tempP%var,
739     &        parentarray(:,1,1),parentarray(:,2,1),
740     &        parent%var,parentarray(:,1,2),parentarray(:,2,2),
741     &        nbdim)
742      ENDIF
743            endif
744
745#ifdef AGRIF_MPI
746      tab3(:,1) = indminglob2(:)
747      tab3(:,2) = indmaxglob2(:)
748      tab3(:,3) = indmin(:)
749      tab3(:,4) = indmax(:)
750C
751C
752      Call MPI_ALLGATHER(tab3,4*nbdim,MPI_INTEGER,tab4,4*nbdim,
753     &                   MPI_INTEGER,MPI_COMM_WORLD,code)
754
755      Allocate(tempPextend%var)
756      DO k=0,Agrif_Nbprocs-1
757       do j=1,4
758         do i=1,nbdim
759         tab4t(i,k,j) = tab4(i,j,k)
760                enddo
761      enddo
762      enddo
763      Call Get_External_Data(tempP,tempPextend,tab4t(:,:,1),
764     &            tab4t(:,:,2),
765     &            tab4t(:,:,3),tab4t(:,:,4),nbdim,member,memberin)
766#else
767      tempPextend%var => tempP%var
768#endif
769
770C
771C
772      IF (memberin) THEN
773      allocate(tempC%var)
774C
775
776      Call Agrif_nbdim_allocation(tempC%var,pttruetab,cetruetab,nbdim)
777
778C
779C
780C     Special values on the parent grid
781      if (Agrif_UseSpecialValue) then
782C
783          noraftab(1:nbdim) =
784     &         child % var % root_var % interptab(1:nbdim) .EQ. 'N'
785C
786          Allocate(parentvalues%var)
787C
788          Call Agrif_nbdim_allocation
789     &               (parentvalues%var,indmin,indmax,nbdim)
790          Call Agrif_nbdim_Full_VarEQvar
791     &               (parentvalues%var,tempPextend%var,nbdim)
792C
793          Call Agrif_CheckMasknD(tempPextend,
794     &                           parentvalues,
795     &                           indmin(1:nbdim),indmax(1:nbdim),
796     &                           indmin(1:nbdim),indmax(1:nbdim),
797     &                           noraftab(1:nbdim),nbdim)
798C
799          Call Agrif_nbdim_deallocation(parentvalues%var,nbdim)
800          Deallocate(parentvalues%var)
801C
802C
803      endif     
804
805C
806C
807C     Interpolation of the current grid
808
809      IF (memberin) THEN
810      if ( nbdim .EQ. 1 ) then
811         Call Agrif_Interp_1D_recursive(TypeInterp,
812     &           tempPextend%var%array1,tempC%var%array1,
813     &           indmin,indmax,
814     &           pttruetab,cetruetab,
815     &           s_Child_temp,s_Parent_temp,
816     &           ds_Child,ds_Parent,nbdim)
817      elseif ( nbdim .EQ. 2 ) then
818
819         Call Agrif_Interp_2D_recursive(TypeInterp,
820     &           tempPextend%var%array2,tempC%var%array2,
821     &           indmin,indmax,
822     &           pttruetab,cetruetab,
823     &           s_Child_temp,s_Parent_temp,
824     &           ds_Child,ds_Parent,nbdim)
825      elseif ( nbdim .EQ. 3 ) then
826
827         Call Agrif_Interp_3D_recursive(TypeInterp,
828     &           tempPextend%var%array3,tempC%var%array3,
829     &           indmin,indmax,
830     &           pttruetab,cetruetab,
831     &           s_Child_temp,s_Parent_temp,
832     &           ds_Child,ds_Parent,nbdim)
833      elseif ( nbdim .EQ. 4 ) then
834         Call Agrif_Interp_4D_recursive(TypeInterp,
835     &           tempPextend%var%array4,tempC%var%array4,
836     &           indmin,indmax,
837     &           pttruetab,cetruetab,
838     &           s_Child_temp,s_Parent_temp,
839     &           ds_Child,ds_Parent,nbdim)
840      elseif ( nbdim .EQ. 5 ) then
841         Call Agrif_Interp_5D_recursive(TypeInterp,
842     &           tempPextend%var%array5,tempC%var%array5,
843     &           indmin,indmax,
844     &           pttruetab,cetruetab,
845     &           s_Child_temp,s_Parent_temp,
846     &           ds_Child,ds_Parent,nbdim)
847      elseif ( nbdim .EQ. 6 ) then
848         Call Agrif_Interp_6D_recursive(TypeInterp,
849     &           tempPextend%var%array6,tempC%var%array6,
850     &           indmin,indmax,
851     &           pttruetab,cetruetab,
852     &           s_Child_temp,s_Parent_temp,
853     &           ds_Child,ds_Parent,nbdim)
854       endif
855
856
857C
858C
859C     Special values on the child grid 
860      if (Agrif_UseSpecialValueFineGrid) then
861C
862#ifdef AGRIF_MPI
863C       
864          Call GiveAgrif_SpecialValueToTab_mpi(child%var,tempC%var,
865     &                 childarray,
866     &                 pttruetab,cetruetab,
867     &                 Agrif_SpecialValueFineGrid,nbdim)
868C
869#else
870C
871          Call GiveAgrif_SpecialValueToTab(child%var,tempC%var,
872     &                  pttruetab,cetruetab,
873     &                  Agrif_SpecialValueFineGrid,nbdim)
874C
875#endif
876C
877C       
878      endif
879C 
880
881      Call Agrif_nbdim_Get_bound_dimension(child % var,
882     &                               lowerbound,upperbound,nbdim)
883
884#ifdef AGRIF_MPI
885      Call Agrif_GlobtoLocInd2(childarray,
886     &                     lowerbound,upperbound,
887     &                     pttruetab,cetruetab,
888     &                     nbdim,Agrif_Procrank,
889     &                     memberout)
890
891#else
892       childarray(:,1,1) = pttruetab
893       childarray(:,2,1) = cetruetab
894       childarray(:,1,2) = pttruetab
895       childarray(:,2,2) = cetruetab
896ccccccccccccccc       memberout = .TRUE.
897#endif
898
899      endif
900
901C
902      if (torestore) then
903C
904#ifdef AGRIF_MPI
905C
906        SELECT CASE (nbdim)
907        CASE (1)
908             do i = pttruetab(1),cetruetab(1)         
909ChildarrayAModifier                if (restore%var%restore1D(i) == 0) 
910ChildarrayAModifier     &                child%var%array1(childarray(i,1,2)
911ChildarrayAModifier     &                                 ) = 
912ChildarrayAModifier     &                tempC%var%array1(i)
913             enddo
914        CASE (2)
915             do i = pttruetab(1),cetruetab(1)
916             do j = pttruetab(2),cetruetab(2)
917ChildarrayAModifier                   if (restore%var%restore2D(i,j) == 0) 
918ChildarrayAModifier     &                child%var%array2(childarray(i,1,2),
919ChildarrayAModifier     &                                 childarray(j,2,2)) = 
920ChildarrayAModifier     &                tempC%var%array2(i,j)
921             enddo
922             enddo
923        CASE (3)
924             do i = pttruetab(1),cetruetab(1)
925             do j = pttruetab(2),cetruetab(2) 
926             do k = pttruetab(3),cetruetab(3)
927ChildarrayAModifier                      if (restore%var%restore3D(i,j,k) == 0) 
928ChildarrayAModifier     &                child%var%array3(childarray(i,1,2),
929ChildarrayAModifier     &                                 childarray(j,2,2),
930ChildarrayAModifier     &                                 childarray(k,3,2)) = 
931ChildarrayAModifier     &                tempC%var%array3(i,j,k)
932             enddo
933             enddo
934             enddo
935        CASE (4)
936             do i = pttruetab(1),cetruetab(1)
937             do j = pttruetab(2),cetruetab(2)
938             do k = pttruetab(3),cetruetab(3)
939             do l = pttruetab(4),cetruetab(4)
940ChildarrayAModifier                         if (restore%var%restore4D(i,j,k,l) == 0) 
941ChildarrayAModifier     &                      child%var%array4(childarray(i,1,2),
942ChildarrayAModifier     &                                       childarray(j,2,2),
943ChildarrayAModifier     &                                       childarray(k,3,2),
944ChildarrayAModifier     &                                       childarray(l,4,2)) = 
945ChildarrayAModifier     &                      tempC%var%array4(i,j,k,l)
946             enddo
947             enddo
948             enddo
949             enddo
950        CASE (5)
951             do i = pttruetab(1),cetruetab(1)
952             do j = pttruetab(2),cetruetab(2)
953             do k = pttruetab(3),cetruetab(3)
954             do l = pttruetab(4),cetruetab(4)
955             do m = pttruetab(5),cetruetab(5)
956ChildarrayAModifier              if (restore%var%restore5D(i,j,k,l,m) == 0) 
957ChildarrayAModifier     &                child%var%array5(childarray(i,1,2),
958ChildarrayAModifier     &                                 childarray(j,2,2),
959ChildarrayAModifier     &                                 childarray(k,3,2),
960ChildarrayAModifier     &                                 childarray(l,4,2),
961ChildarrayAModifier     &                                 childarray(m,5,2)) = 
962ChildarrayAModifier     &                tempC%var%array5(i,j,k,l,m)
963             enddo
964             enddo
965             enddo
966             enddo
967             enddo
968        CASE (6)
969             do i = pttruetab(1),cetruetab(1)
970             do j = pttruetab(2),cetruetab(2)
971             do k = pttruetab(3),cetruetab(3)
972             do l = pttruetab(4),cetruetab(4)
973             do m = pttruetab(5),cetruetab(5)
974             do n = pttruetab(6),cetruetab(6)
975ChildarrayAModifier              if (restore%var%restore6D(i,j,k,l,m,n) == 0) 
976ChildarrayAModifier     &                child%var%array6(childarray(i,1,2),
977ChildarrayAModifier     &                                 childarray(j,2,2),
978ChildarrayAModifier     &                                 childarray(k,3,2),
979ChildarrayAModifier     &                                 childarray(l,4,2),
980ChildarrayAModifier     &                                 childarray(m,5,2),
981ChildarrayAModifier     &                                 childarray(n,6,2)) = 
982ChildarrayAModifier     &                tempC%var%array6(i,j,k,l,m,n)
983             enddo
984             enddo
985             enddo
986             enddo
987             enddo
988             enddo
989        END SELECT
990C
991#else
992        SELECT CASE (nbdim)
993        CASE (1)
994           do i = pttruetab(1),cetruetab(1)         
995            if (restore%var%restore1D(i) == 0)
996     &            child % var % array1(i) = 
997     &            tempC % var % array1(i)   
998          enddo
999        CASE (2)
1000           do j = pttruetab(2),cetruetab(2)
1001             do i = pttruetab(1),cetruetab(1)   
1002              if (restore%var%restore2D(i,j) == 0)
1003     &              child % var % array2(i,j) = 
1004     &              tempC % var % array2(i,j)   
1005              enddo
1006             enddo
1007        CASE (3)
1008           do k = pttruetab(3),cetruetab(3)
1009           do j = pttruetab(2),cetruetab(2)
1010             do i = pttruetab(1),cetruetab(1) 
1011              if (restore%var%restore3D(i,j,k) == 0)
1012     &                  child % var % array3(i,j,k) =
1013     &                  tempC % var % array3(i,j,k)   
1014                  enddo
1015              enddo
1016             enddo
1017        CASE (4)
1018           do l = pttruetab(4),cetruetab(4)
1019           do k = pttruetab(3),cetruetab(3)
1020          do j = pttruetab(2),cetruetab(2)
1021             do i = pttruetab(1),cetruetab(1)
1022                if (restore%var%restore4D(i,j,k,l) == 0)
1023     &                 child % var % array4(i,j,k,l) = 
1024     &                 tempC % var % array4(i,j,k,l)   
1025             enddo
1026             enddo
1027              enddo
1028             enddo
1029        CASE (5)
1030           do m = pttruetab(5),cetruetab(5)
1031          do l = pttruetab(4),cetruetab(4)
1032         do k = pttruetab(3),cetruetab(3)
1033           do j = pttruetab(2),cetruetab(2)
1034             do i = pttruetab(1),cetruetab(1)
1035                if (restore%var%restore5D(i,j,k,l,m) == 0)
1036     &                  child % var % array5(i,j,k,l,m) = 
1037     &                  tempC % var % array5(i,j,k,l,m)   
1038             enddo
1039             enddo
1040                  enddo
1041              enddo
1042             enddo
1043        CASE (6)
1044           do n = pttruetab(6),cetruetab(6)
1045          do m = pttruetab(5),cetruetab(5)
1046          do l = pttruetab(4),cetruetab(4)
1047         do k = pttruetab(3),cetruetab(3)
1048          do j = pttruetab(2),cetruetab(2)
1049             do i = pttruetab(1),cetruetab(1)
1050                if (restore%var%restore6D(i,j,k,l,m,n) == 0)
1051     &                      child % var % array6(i,j,k,l,m,n) = 
1052     &                      tempC % var % array6(i,j,k,l,m,n)   
1053             enddo
1054            enddo
1055                      enddo
1056                  enddo
1057              enddo
1058             enddo
1059        END SELECT
1060C
1061#endif
1062C       
1063        else
1064C
1065C
1066          IF (memberin) THEN
1067          SELECT CASE (nbdim)
1068          CASE (1)
1069            child%var%array1(childarray(1,1,2):childarray(1,2,2)) =
1070     &       tempC%var%array1(childarray(1,1,1):childarray(1,2,1))
1071          CASE (2)
1072            child%var%array2(childarray(1,1,2):childarray(1,2,2),
1073     &                       childarray(2,1,2):childarray(2,2,2)) =
1074     &      tempC%var%array2(childarray(1,1,1):childarray(1,2,1),
1075     &                       childarray(2,1,1):childarray(2,2,1))
1076          CASE (3)
1077            child%var%array3(childarray(1,1,2):childarray(1,2,2),
1078     &                       childarray(2,1,2):childarray(2,2,2),
1079     &                       childarray(3,1,2):childarray(3,2,2)) =
1080     &      tempC%var%array3(childarray(1,1,1):childarray(1,2,1),
1081     &                       childarray(2,1,1):childarray(2,2,1),
1082     &                       childarray(3,1,1):childarray(3,2,1))
1083          CASE (4)
1084            child%var%array4(childarray(1,1,2):childarray(1,2,2),
1085     &                       childarray(2,1,2):childarray(2,2,2),
1086     &                       childarray(3,1,2):childarray(3,2,2),
1087     &                       childarray(4,1,2):childarray(4,2,2)) =
1088     &      tempC%var%array4(childarray(1,1,1):childarray(1,2,1),
1089     &                       childarray(2,1,1):childarray(2,2,1),
1090     &                       childarray(3,1,1):childarray(3,2,1),
1091     &                       childarray(4,1,1):childarray(4,2,1))
1092          CASE (5)
1093            child%var%array5(childarray(1,1,2):childarray(1,2,2),
1094     &                       childarray(2,1,2):childarray(2,2,2),
1095     &                       childarray(3,1,2):childarray(3,2,2),
1096     &                       childarray(4,1,2):childarray(4,2,2),
1097     &                       childarray(5,1,2):childarray(5,2,2)) =
1098     &      tempC%var%array5(childarray(1,1,1):childarray(1,2,1),
1099     &                       childarray(2,1,1):childarray(2,2,1),
1100     &                       childarray(3,1,1):childarray(3,2,1),
1101     &                       childarray(4,1,1):childarray(4,2,1),
1102     &                       childarray(5,1,1):childarray(5,2,1))
1103          CASE (6)
1104            child%var%array6(childarray(1,1,2):childarray(1,2,2),
1105     &                       childarray(2,1,2):childarray(2,2,2),
1106     &                       childarray(3,1,2):childarray(3,2,2),
1107     &                       childarray(4,1,2):childarray(4,2,2),
1108     &                       childarray(5,1,2):childarray(5,2,2),
1109     &                       childarray(6,1,2):childarray(6,2,2)) =
1110     &      tempC%var%array6(childarray(1,1,1):childarray(1,2,1),
1111     &                       childarray(2,1,1):childarray(2,2,1),
1112     &                       childarray(3,1,1):childarray(3,2,1),
1113     &                       childarray(4,1,1):childarray(4,2,1),
1114     &                       childarray(5,1,1):childarray(5,2,1),
1115     &                       childarray(6,1,1):childarray(6,2,1))
1116          END SELECT
1117          ENDIF
1118C
1119C       
1120      endif
1121
1122        Call Agrif_nbdim_deallocation(tempPextend%var,nbdim)
1123        deallocate(tempPextend%var)
1124
1125      Call Agrif_nbdim_deallocation(tempC%var,nbdim)
1126     
1127      Deallocate(tempC % var)
1128      ELSE
1129     
1130      deallocate(tempPextend%var)
1131
1132      ENDIF
1133C
1134C             
1135C     Deallocations
1136#ifdef AGRIF_MPI       
1137      IF (member) THEN
1138      Call Agrif_nbdim_deallocation(tempP%var,nbdim)
1139      Deallocate(tempP % var)
1140      endif
1141#endif
1142C
1143C
1144     
1145C
1146C
1147      End Subroutine Agrif_InterpnD 
1148C
1149C
1150C
1151C                 
1152C
1153C     **************************************************************************
1154CCC   Subroutine Agrif_Parentbounds
1155C     **************************************************************************
1156C
1157      Subroutine Agrif_Parentbounds(TYPEinterp,nbdim,indmin,indmax,
1158     &                              s_Parent_temp,
1159     &                              s_Child_temp,s_Child,ds_Child,
1160     &                              s_Parent,ds_Parent,
1161     &                              pttruetab,cetruetab,pttab_Child,
1162     &                              pttab_Parent,posvar,interptab)
1163C
1164CCC   Description:
1165CCC   Subroutine calculating the bounds of the parent grid for the interpolation
1166CCC   of the child grid     
1167C
1168C
1169C     Declarations:
1170C
1171     
1172C
1173#ifdef AGRIF_MPI
1174C
1175ccccccccccccccccccccccc#include "mpif.h"
1176C
1177#endif
1178C
1179C     Arguments
1180      INTEGER :: nbdim
1181      INTEGER, DIMENSION(6) :: TypeInterp
1182      INTEGER,DIMENSION(nbdim) :: indmin,indmax
1183      REAL,DIMENSION(nbdim) :: s_Parent_temp,s_child_temp
1184      REAL,DIMENSION(nbdim) :: s_Child,ds_child
1185      REAL,DIMENSION(nbdim) :: s_Parent,ds_Parent
1186      INTEGER,DIMENSION(nbdim) :: pttruetab,cetruetab
1187      INTEGER,DIMENSION(nbdim) :: pttab_Child,pttab_Parent
1188      INTEGER,DIMENSION(nbdim) :: posvar
1189      CHARACTER(6), DIMENSION(nbdim) :: interptab
1190C
1191C     Local variables
1192      INTEGER :: i
1193      REAL,DIMENSION(nbdim) :: dim_newmin,dim_newmax     
1194C
1195      dim_newmin = s_Child + (pttruetab - pttab_Child) * ds_Child
1196      dim_newmax = s_Child + (cetruetab - pttab_Child) * ds_Child
1197     
1198      DO i = 1,nbdim         
1199C     
1200        indmin(i) = pttab_Parent(i) + 
1201     &         agrif_int((dim_newmin(i)-s_Parent(i))/ds_Parent(i))
1202C
1203        indmax(i) = pttab_Parent(i) + 
1204     &                agrif_ceiling((dim_newmax(i)-
1205     &                s_Parent(i))/ds_Parent(i))
1206     
1207C
1208C
1209C       Necessary for the Quadratic interpolation
1210C 
1211
1212        IF ((pttruetab(i) == cetruetab(i)) .AND. 
1213     &                           (posvar(i) == 1)) THEN
1214        ELSEIF (interptab(i) .EQ. 'N') THEN
1215        ELSEIF ( TYPEinterp(i) .eq. Agrif_ppm .or.
1216     &      TYPEinterp(i) .eq. Agrif_eno ) THEN           
1217           indmin(i) = indmin(i) - 2 
1218           indmax(i) = indmax(i) + 2                 
1219        ELSE IF( TYPEinterp(i) .ne. Agrif_constant ) THEN
1220           indmin(i) = indmin(i) - 1 
1221           indmax(i) = indmax(i) + 1
1222        ENDIF
1223       
1224
1225C       
1226       ENDDO 
1227C
1228        s_Parent_temp = s_Parent + (indmin - pttab_Parent) * ds_Parent
1229C     
1230        s_Child_temp = s_Child + (pttruetab - pttab_Child) * ds_Child
1231C
1232C
1233      Return
1234C
1235C
1236      End Subroutine Agrif_Parentbounds
1237C
1238C
1239C
1240C     **************************************************************************
1241CCC   Subroutine Agrif_Interp_1D_Recursive 
1242C     **************************************************************************
1243C
1244      Subroutine Agrif_Interp_1D_recursive(TypeInterp,tabin,tabout,
1245     &           indmin,indmax, 
1246     &           pttab_child,petab_child,
1247     &           s_child,s_parent,ds_child,ds_parent,nbdim)     
1248C
1249CCC   Description:
1250CCC   Subroutine for the interpolation of a 1D grid variable. 
1251CCC   It calls Agrif_InterpBase. 
1252C
1253C     Declarations:
1254C
1255     
1256C
1257C     Arguments
1258      INTEGER :: nbdim
1259      INTEGER,DIMENSION(1) :: TypeInterp
1260      INTEGER, DIMENSION(nbdim) :: indmin,indmax
1261      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
1262      REAL, DIMENSION(nbdim) :: s_child,s_parent
1263      REAL, DIMENSION(nbdim) :: ds_child,ds_parent
1264      REAL, DIMENSION(indmin(nbdim):indmax(nbdim)) :: tabin       
1265      REAL, DIMENSION(pttab_child(nbdim):petab_child(nbdim)) :: tabout
1266C
1267C
1268C     Commentaire perso : nbdim vaut toujours 1 ici. 
1269C
1270      Call Agrif_InterpBase(TypeInterp(1),
1271     &                  tabin(indmin(nbdim):indmax(nbdim)),
1272     &                  tabout(pttab_child(nbdim):petab_child(nbdim)),
1273     &                  indmin(nbdim),indmax(nbdim),           
1274     &                  pttab_child(nbdim),petab_child(nbdim),
1275     &                  s_parent(nbdim),s_child(nbdim),
1276     &                  ds_parent(nbdim),ds_child(nbdim))
1277C               
1278      Return
1279C
1280C
1281      End Subroutine Agrif_Interp_1D_recursive
1282C
1283C
1284C     
1285C     **************************************************************************
1286CCC   Subroutine Agrif_Interp_2D_Recursive 
1287C     **************************************************************************
1288C
1289      Subroutine Agrif_Interp_2D_recursive(TypeInterp,
1290     &           tabin,tabout,
1291     &           indmin,indmax,   
1292     &           pttab_child,petab_child,
1293     &            s_child, s_parent,
1294     &           ds_child,ds_parent,
1295     &           nbdim)
1296C
1297CCC   Description:
1298CCC   Subroutine for the interpolation of a 2D grid variable. 
1299CCC   It calls Agrif_Interp_1D_recursive and Agrif_InterpBase.   
1300C
1301C     Declarations:
1302C
1303     
1304C     
1305      INTEGER                   :: nbdim
1306      INTEGER,DIMENSION(2)      :: TypeInterp
1307      INTEGER, DIMENSION(nbdim) :: indmin,indmax
1308      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
1309      REAL   , DIMENSION(nbdim) ::  s_child, s_parent
1310      REAL   , DIMENSION(nbdim) :: ds_child,ds_parent
1311      REAL   , DIMENSION(
1312     &                indmin(nbdim-1):indmax(nbdim-1),
1313     &                indmin(nbdim):indmax(nbdim)
1314     &                ) :: tabin       
1315      REAL   , DIMENSION(
1316     &                pttab_child(nbdim-1):petab_child(nbdim-1),
1317     &                pttab_child(nbdim):petab_child(nbdim)
1318     &                ) :: tabout
1319C
1320C     Local variables     
1321      REAL, DIMENSION(:,:), Allocatable :: tabtemp
1322      INTEGER i,j
1323C
1324C       
1325      Allocate(tabtemp(pttab_child(nbdim-1):petab_child(nbdim-1),
1326     &                 indmin(nbdim):indmax(nbdim)))
1327C
1328C
1329C     Commentaire perso : nbdim vaut toujours 2 ici.
1330C
1331      do j = indmin(nbdim),indmax(nbdim)
1332C       
1333        Call Agrif_Interp_1D_recursive(TypeInterp(1),
1334     &         tabin(indmin(nbdim-1):indmax(nbdim-1),j),
1335     &         tabtemp(pttab_child(nbdim-1):petab_child(nbdim-1),j),
1336     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
1337     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
1338     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
1339     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
1340C       
1341      enddo
1342C       
1343      do i=pttab_child(nbdim-1),petab_child(nbdim-1)
1344C
1345        Call Agrif_InterpBase(TypeInterp(2),
1346     &           tabtemp(i,indmin(nbdim):indmax(nbdim)),
1347     &                  tabout(i,pttab_child(nbdim):petab_child(nbdim)),
1348     &           indmin(nbdim),indmax(nbdim),
1349     &           pttab_child(nbdim),petab_child(nbdim),
1350     &           s_parent(nbdim),s_child(nbdim),
1351     &           ds_parent(nbdim),ds_child(nbdim))
1352C       
1353      enddo
1354C               
1355      Deallocate(tabtemp)
1356C
1357      Return
1358C
1359C
1360      End Subroutine Agrif_Interp_2D_recursive
1361C
1362C
1363C     
1364C     **************************************************************************
1365CCC   Subroutine Agrif_Interp_3D_Recursive 
1366C     **************************************************************************
1367C
1368      Subroutine Agrif_Interp_3D_recursive(TypeInterp,tabin,tabout,
1369     &           indmin,indmax,   
1370     &           pttab_child,petab_child,
1371     &           s_child,s_parent,ds_child,ds_parent,nbdim)
1372C
1373CCC   Description:
1374CCC   Subroutine for the interpolation of a 3D grid variable. 
1375CCC   It calls Agrif_Interp_2D_recursive and Agrif_InterpBase.   
1376C
1377C     Declarations:
1378C
1379     
1380C     
1381      INTEGER :: nbdim
1382      INTEGER,DIMENSION(3) :: TypeInterp
1383      INTEGER, DIMENSION(nbdim) :: indmin,indmax
1384      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
1385      REAL, DIMENSION(nbdim) :: s_child,s_parent,ds_child,ds_parent
1386      REAL, DIMENSION(indmin(nbdim-2):indmax(nbdim-2),
1387     &                indmin(nbdim-1):indmax(nbdim-1),
1388     &                indmin(nbdim)  :indmax(nbdim)) :: tabin       
1389      REAL, DIMENSION(pttab_child(nbdim-2):petab_child(nbdim-2),
1390     &                pttab_child(nbdim-1):petab_child(nbdim-1),
1391     &                pttab_child(nbdim):petab_child(nbdim)) :: tabout
1392C
1393C     Local variables     
1394      REAL, DIMENSION(:,:,:), Allocatable :: tabtemp
1395      INTEGER i,j,k
1396C
1397C       
1398      Allocate(tabtemp(pttab_child(nbdim-2):petab_child(nbdim-2),
1399     &                 pttab_child(nbdim-1):petab_child(nbdim-1),
1400     &                 indmin(nbdim):indmax(nbdim)))
1401C
1402      do k = indmin(nbdim),indmax(nbdim)
1403C       
1404        Call Agrif_Interp_2D_recursive(TypeInterp(1:2),
1405     &         tabin(indmin(nbdim-2):indmax(nbdim-2),
1406     &         indmin(nbdim-1):indmax(nbdim-1),k),
1407     &         tabtemp(pttab_child(nbdim-2):petab_child(nbdim-2),
1408     &         pttab_child(nbdim-1):petab_child(nbdim-1),k),
1409     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
1410     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
1411     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
1412     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
1413C       
1414      enddo
1415C
1416      do j=pttab_child(nbdim-1),petab_child(nbdim-1) 
1417C       
1418        do i=pttab_child(nbdim-2),petab_child(nbdim-2)
1419C
1420          Call Agrif_InterpBase(TypeInterp(3),
1421     &           tabtemp(i,j,indmin(nbdim):indmax(nbdim)),
1422     &           tabout(i,j,pttab_child(nbdim):petab_child(nbdim)),
1423     &           indmin(nbdim),indmax(nbdim),
1424     &           pttab_child(nbdim),petab_child(nbdim),
1425     &           s_parent(nbdim),s_child(nbdim),
1426     &           ds_parent(nbdim),ds_child(nbdim))
1427C
1428        enddo 
1429C       
1430      enddo
1431C               
1432      Deallocate(tabtemp)
1433C
1434      Return
1435C       
1436C
1437      End Subroutine Agrif_Interp_3D_recursive
1438C
1439C
1440C
1441C     **************************************************************************
1442CCC   Subroutine Agrif_Interp_4D_Recursive 
1443C     **************************************************************************
1444C
1445      Subroutine Agrif_Interp_4D_recursive(TypeInterp,tabin,tabout,
1446     &           indmin,indmax,   
1447     &           pttab_child,petab_child,
1448     &           s_child,s_parent,ds_child,ds_parent,nbdim)
1449C
1450CCC   Description:
1451CCC   Subroutine for the interpolation of a 4D grid variable. 
1452CCC   It calls Agrif_Interp_3D_recursive and Agrif_InterpBase.   
1453C
1454C     Declarations:
1455C
1456     
1457C     
1458      INTEGER :: nbdim
1459      INTEGER,DIMENSION(4) :: TypeInterp
1460      INTEGER, DIMENSION(nbdim) :: indmin,indmax
1461      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
1462      REAL, DIMENSION(nbdim) :: s_child,s_parent,ds_child,ds_parent
1463      REAL, DIMENSION(indmin(nbdim-3):indmax(nbdim-3),
1464     &                indmin(nbdim-2):indmax(nbdim-2),
1465     &                indmin(nbdim-1):indmax(nbdim-1),
1466     &                indmin(nbdim):indmax(nbdim)) :: tabin       
1467      REAL, DIMENSION(pttab_child(nbdim-3):petab_child(nbdim-3),
1468     &                pttab_child(nbdim-2):petab_child(nbdim-2),
1469     &                pttab_child(nbdim-1):petab_child(nbdim-1),
1470     &                pttab_child(nbdim):petab_child(nbdim)) :: tabout
1471C
1472C     Local variables     
1473      REAL, DIMENSION(:,:,:,:), Allocatable :: tabtemp
1474      INTEGER i,j,k,l
1475C
1476C       
1477      Allocate(tabtemp(pttab_child(nbdim-3):petab_child(nbdim-3),
1478     &                 pttab_child(nbdim-2):petab_child(nbdim-2),
1479     &                 pttab_child(nbdim-1):petab_child(nbdim-1), 
1480     &                 indmin(nbdim):indmax(nbdim)))
1481C
1482      do l = indmin(nbdim),indmax(nbdim)
1483C       
1484        Call Agrif_Interp_3D_recursive(TypeInterp(1:3),
1485     &         tabin(indmin(nbdim-3):indmax(nbdim-3),
1486     &               indmin(nbdim-2):indmax(nbdim-2),
1487     &               indmin(nbdim-1):indmax(nbdim-1),l),
1488     &         tabtemp(pttab_child(nbdim-3):petab_child(nbdim-3),
1489     &         pttab_child(nbdim-2):petab_child(nbdim-2),
1490     &         pttab_child(nbdim-1):petab_child(nbdim-1),l),
1491     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
1492     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
1493     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
1494     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
1495C       
1496      enddo
1497C
1498      do k = pttab_child(nbdim-1),petab_child(nbdim-1)
1499C
1500        do j = pttab_child(nbdim-2),petab_child(nbdim-2) 
1501C       
1502          do i = pttab_child(nbdim-3),petab_child(nbdim-3)
1503C
1504            Call Agrif_InterpBase(TypeInterp(4),
1505     &           tabtemp(i,j,k,indmin(nbdim):indmax(nbdim)),
1506     &           tabout(i,j,k,pttab_child(nbdim):petab_child(nbdim)),
1507     &           indmin(nbdim),indmax(nbdim),
1508     &           pttab_child(nbdim),petab_child(nbdim),
1509     &           s_parent(nbdim),s_child(nbdim),
1510     &           ds_parent(nbdim),ds_child(nbdim))
1511C
1512          enddo
1513C
1514        enddo 
1515C       
1516      enddo
1517C               
1518      Deallocate(tabtemp)
1519C
1520      Return
1521C
1522C       
1523      End Subroutine Agrif_Interp_4D_recursive
1524C
1525C
1526C
1527C     **************************************************************************
1528CCC   Subroutine Agrif_Interp_5D_Recursive 
1529C     **************************************************************************
1530C
1531      Subroutine Agrif_Interp_5D_recursive(TypeInterp,tabin,tabout,
1532     &           indmin,indmax,   
1533     &           pttab_child,petab_child,
1534     &           s_child,s_parent,ds_child,ds_parent,nbdim)
1535C
1536CCC   Description:
1537CCC   Subroutine for the interpolation of a 5D grid variable. 
1538CCC   It calls Agrif_Interp_4D_recursive and Agrif_InterpBase.   
1539C
1540C     Declarations:
1541C
1542     
1543C     
1544      INTEGER :: nbdim
1545      INTEGER,DIMENSION(5) :: TypeInterp
1546      INTEGER, DIMENSION(nbdim) :: indmin,indmax
1547      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
1548      REAL, DIMENSION(nbdim) :: s_child,s_parent,ds_child,ds_parent
1549      REAL, DIMENSION(indmin(nbdim-4):indmax(nbdim-4),
1550     &                indmin(nbdim-3):indmax(nbdim-3),
1551     &                indmin(nbdim-2):indmax(nbdim-2),
1552     &                indmin(nbdim-1):indmax(nbdim-1),
1553     &                indmin(nbdim):indmax(nbdim)) :: tabin 
1554      REAL, DIMENSION(pttab_child(nbdim-4):petab_child(nbdim-4),
1555     &                pttab_child(nbdim-3):petab_child(nbdim-3),
1556     &                pttab_child(nbdim-2):petab_child(nbdim-2),
1557     &                pttab_child(nbdim-1):petab_child(nbdim-1),
1558     &                pttab_child(nbdim):petab_child(nbdim)) :: tabout
1559C
1560C     Local variables     
1561      REAL, DIMENSION(:,:,:,:,:), Allocatable :: tabtemp
1562      INTEGER i,j,k,l,m
1563C
1564C       
1565      Allocate(tabtemp(pttab_child(nbdim-4):petab_child(nbdim-4),
1566     &                 pttab_child(nbdim-3):petab_child(nbdim-3),
1567     &                 pttab_child(nbdim-2):petab_child(nbdim-2),
1568     &                 pttab_child(nbdim-1):petab_child(nbdim-1),   
1569     &                 indmin(nbdim):indmax(nbdim)))
1570C
1571      do m = indmin(nbdim),indmax(nbdim)
1572C       
1573        Call Agrif_Interp_4D_recursive(TypeInterp(1:4),
1574     &         tabin(indmin(nbdim-4):indmax(nbdim-4),
1575     &               indmin(nbdim-3):indmax(nbdim-3),
1576     &               indmin(nbdim-2):indmax(nbdim-2),
1577     &               indmin(nbdim-1):indmax(nbdim-1),m),
1578     &         tabtemp(pttab_child(nbdim-4):petab_child(nbdim-4),
1579     &                 pttab_child(nbdim-3):petab_child(nbdim-3),
1580     &                 pttab_child(nbdim-2):petab_child(nbdim-2),
1581     &                 pttab_child(nbdim-1):petab_child(nbdim-1),m),
1582     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
1583     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
1584     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
1585     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
1586C       
1587      enddo
1588C
1589      do l = pttab_child(nbdim-1),petab_child(nbdim-1) 
1590C
1591        do k = pttab_child(nbdim-2),petab_child(nbdim-2)
1592C
1593          do j = pttab_child(nbdim-3),petab_child(nbdim-3) 
1594C       
1595            do i = pttab_child(nbdim-4),petab_child(nbdim-4)
1596C
1597              Call Agrif_InterpBase(TypeInterp(5),
1598     &             tabtemp(i,j,k,l,indmin(nbdim):indmax(nbdim)),
1599     &                    tabout(i,j,k,l,
1600     &             pttab_child(nbdim):petab_child(nbdim)),
1601     &             indmin(nbdim),indmax(nbdim),
1602     &             pttab_child(nbdim),petab_child(nbdim),
1603     &             s_parent(nbdim),s_child(nbdim),
1604     &             ds_parent(nbdim),ds_child(nbdim))
1605C
1606            enddo
1607C
1608          enddo
1609C
1610        enddo 
1611C       
1612      enddo
1613C               
1614      Deallocate(tabtemp)
1615C
1616      Return
1617C
1618C       
1619      End Subroutine Agrif_Interp_5D_recursive
1620C
1621C
1622C
1623C     **************************************************************************
1624CCC   Subroutine Agrif_Interp_6D_Recursive 
1625C     **************************************************************************
1626C
1627      Subroutine Agrif_Interp_6D_recursive(TypeInterp,tabin,tabout,
1628     &           indmin,indmax,   
1629     &           pttab_child,petab_child,
1630     &           s_child,s_parent,ds_child,ds_parent,nbdim)
1631C
1632CCC   Description:
1633CCC   Subroutine for the interpolation of a 6D grid variable. 
1634CCC   It calls Agrif_Interp_4D_recursive and Agrif_InterpBase.   
1635C
1636C     Declarations:
1637C
1638     
1639C     
1640      INTEGER :: nbdim
1641      INTEGER,DIMENSION(6) :: TypeInterp
1642      INTEGER, DIMENSION(nbdim) :: indmin,indmax
1643      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
1644      REAL, DIMENSION(nbdim) :: s_child,s_parent,ds_child,ds_parent
1645      REAL, DIMENSION(indmin(nbdim-5):indmax(nbdim-5),
1646     &                indmin(nbdim-4):indmax(nbdim-4),
1647     &                indmin(nbdim-3):indmax(nbdim-3), 
1648     &                indmin(nbdim-2):indmax(nbdim-2),
1649     &                indmin(nbdim-1):indmax(nbdim-1),
1650     &                indmin(nbdim):indmax(nbdim)) :: tabin       
1651      REAL, DIMENSION(pttab_child(nbdim-5):petab_child(nbdim-5),
1652     &                pttab_child(nbdim-4):petab_child(nbdim-4),
1653     &                pttab_child(nbdim-3):petab_child(nbdim-3),
1654     &                pttab_child(nbdim-2):petab_child(nbdim-2),
1655     &                pttab_child(nbdim-1):petab_child(nbdim-1),
1656     &                pttab_child(nbdim):petab_child(nbdim)) :: tabout
1657C
1658C     Local variables     
1659      REAL, DIMENSION(:,:,:,:,:,:), Allocatable :: tabtemp
1660      INTEGER i,j,k,l,m,n
1661C
1662C       
1663      Allocate(tabtemp(pttab_child(nbdim-5):petab_child(nbdim-5),
1664     &                 pttab_child(nbdim-4):petab_child(nbdim-4),
1665     &                 pttab_child(nbdim-3):petab_child(nbdim-3),
1666     &                 pttab_child(nbdim-2):petab_child(nbdim-2),   
1667     &                 pttab_child(nbdim-1):petab_child(nbdim-1),   
1668     &                 indmin(nbdim):indmax(nbdim)))
1669C
1670      do n = indmin(nbdim),indmax(nbdim)
1671C       
1672        Call Agrif_Interp_5D_recursive(TypeInterp(1:5),
1673     &         tabin(indmin(nbdim-5):indmax(nbdim-5),
1674     &               indmin(nbdim-4):indmax(nbdim-4),
1675     &               indmin(nbdim-3):indmax(nbdim-3),
1676     &               indmin(nbdim-2):indmax(nbdim-2),
1677     &               indmin(nbdim-1):indmax(nbdim-1),n),
1678     &         tabtemp(pttab_child(nbdim-5):petab_child(nbdim-5),
1679     &                 pttab_child(nbdim-4):petab_child(nbdim-4),
1680     &                 pttab_child(nbdim-3):petab_child(nbdim-3),
1681     &                 pttab_child(nbdim-2):petab_child(nbdim-2),
1682     &                 pttab_child(nbdim-1):petab_child(nbdim-1),n),
1683     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
1684     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
1685     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
1686     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
1687C       
1688      enddo
1689C
1690      do m = pttab_child(nbdim-1),petab_child(nbdim-1) 
1691      do l = pttab_child(nbdim-2),petab_child(nbdim-2) 
1692C
1693        do k = pttab_child(nbdim-3),petab_child(nbdim-3)
1694C
1695          do j = pttab_child(nbdim-4),petab_child(nbdim-4) 
1696C       
1697            do i = pttab_child(nbdim-5),petab_child(nbdim-5)
1698C
1699              Call Agrif_InterpBase(TypeInterp(6),
1700     &             tabtemp(i,j,k,l,m,indmin(nbdim):indmax(nbdim)),
1701     &                    tabout(i,j,k,l,m,
1702     &                    pttab_child(nbdim):petab_child(nbdim)),
1703     &             indmin(nbdim),indmax(nbdim),
1704     &             pttab_child(nbdim),petab_child(nbdim),
1705     &             s_parent(nbdim),s_child(nbdim),
1706     &             ds_parent(nbdim),ds_child(nbdim))
1707C
1708            enddo
1709C
1710          enddo
1711C
1712        enddo 
1713C       
1714      enddo
1715      enddo
1716C               
1717      Deallocate(tabtemp)
1718C
1719      Return
1720C
1721C       
1722      End Subroutine Agrif_Interp_6D_recursive
1723C
1724C
1725C
1726C     **************************************************************************
1727CCC   Subroutine Agrif_InterpBase 
1728C     **************************************************************************
1729C 
1730      Subroutine Agrif_InterpBase(TypeInterp,
1731     &                           parenttab,childtab,
1732     &                           indmin,indmax,pttab_child,petab_child,
1733     &                           s_parent,s_child,ds_parent,ds_child)   
1734C
1735CCC   Description:
1736CCC   Subroutine calling the interpolation method chosen by the user (linear, 
1737CCC   lagrange or spline). 
1738C
1739C     Declarations:
1740C
1741     
1742C
1743      INTEGER                :: TypeInterp
1744      INTEGER :: indmin,indmax
1745      INTEGER :: pttab_child,petab_child
1746      REAL,DIMENSION(indmin:indmax)           :: parenttab       
1747      REAL,DIMENSION(pttab_child:petab_child) :: childtab     
1748      REAL    :: s_parent,s_child,ds_parent,ds_child 
1749C 
1750C
1751       IF ((indmin == indmax).AND.(pttab_child == petab_child)) THEN
1752         childtab(pttab_child) = parenttab(indmin)
1753       ELSEIF (TYPEinterp .EQ. AGRIF_LINEAR) then   
1754C
1755C         Linear interpolation         
1756          Call linear1D
1757     &         (parenttab,childtab,
1758     &          indmax-indmin+1,petab_child-pttab_child+1,
1759     &          s_parent,s_child,ds_parent,ds_child)
1760C         
1761        elseif (TYPEinterp .EQ. AGRIF_LAGRANGE) then
1762C         
1763C         Lagrange interpolation   
1764          Call lagrange1D
1765     &        (parenttab,childtab,
1766     &         indmax-indmin+1,petab_child-pttab_child+1,
1767     &         s_parent,s_child,ds_parent,ds_child)
1768C           
1769        elseif (TYPEinterp .EQ. AGRIF_ENO) then
1770C         
1771C         Eno interpolation
1772          Call eno1D
1773     &         (parenttab,childtab,
1774     &         indmax-indmin+1,petab_child-pttab_child+1,
1775     &         s_parent,s_child,ds_parent,ds_child)
1776C             
1777        Else if (TYPEinterp .EQ. AGRIF_LINEARCONSERV) then
1778C         
1779C         Linear conservative interpolation
1780         
1781          Call linear1Dconserv
1782     &         (parenttab,childtab,
1783     &         indmax-indmin+1,petab_child-pttab_child+1,
1784     &         s_parent,s_child,ds_parent,ds_child)   
1785C             
1786        Else if (TYPEinterp .EQ. AGRIF_LINEARCONSERVLIM) then
1787C         
1788C         Linear conservative interpolation
1789         
1790          Call linear1Dconservlim
1791     &         (parenttab,childtab,
1792     &         indmax-indmin+1,petab_child-pttab_child+1,
1793     &         s_parent,s_child,ds_parent,ds_child)         
1794C             
1795        elseif (TYPEinterp .EQ. AGRIF_CONSTANT) then
1796C         
1797          Call constant1D
1798     &         (parenttab,childtab,
1799     &         indmax-indmin+1,petab_child-pttab_child+1,
1800     &         s_parent,s_child,ds_parent,ds_child)
1801C             
1802      elseif ( TYPEinterp .EQ. AGRIF_PPM ) then
1803          Call ppm1D         
1804     &         (parenttab,childtab,
1805     &         indmax-indmin+1,petab_child-pttab_child+1,
1806     &         s_parent,s_child,ds_parent,ds_child)
1807C
1808      endif
1809C
1810C     
1811      End Subroutine Agrif_InterpBase 
1812C
1813
1814
1815C                       
1816      End Module Agrif_Interpolation
Note: See TracBrowser for help on using the repository browser.