source: vendors/AGRIF/current/AGRIF_FILES/modupdate.F @ 2671

Last change on this file since 2671 was 2671, checked in by rblod, 10 years ago

Load working_directory into vendors/AGRIF/current.

File size: 94.8 KB
Line 
1!
2! $Id: modupdate.F 779 2007-12-22 17:04:17Z rblod $
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_Update
26C
27      Module Agrif_Update
28C
29CCC   Description:
30CCC   Module to update a parent grid from its child grids
31C
32C     Modules used:
33C   
34      Use Agrif_Updatebasic
35c      Use Agrif_Boundary
36      Use Agrif_Arrays
37      Use Agrif_CurgridFunctions
38      Use Agrif_Mask
39#ifdef AGRIF_MPI
40      Use Agrif_mpp
41#endif
42C
43      IMPLICIT NONE
44      logical, private :: precomputedone(7) = .FALSE.     
45C     
46      CONTAINS
47C     Define procedures contained in this module
48C
49C
50C
51C     **************************************************************************
52CCC   Subroutine Agrif_Update_1d
53C     **************************************************************************
54C 
55      Subroutine Agrif_Update_1d(TypeUpdate,parent,child,tab,deb,fin,
56     &                           procname)
57C
58CCC   Description:
59CCC   Subroutine to update a 1D grid variable on the parent grid.
60C
61C     Declarations:
62C
63     
64C
65C     Arguments     
66      INTEGER, DIMENSION(6) :: TypeUpdate                  ! TYPE of update (copy or average)
67      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
68      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
69      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
70      INTEGER, DIMENSION(6) :: deb,fin       ! Positions where interpolations
71                                              ! are done on the fine grid       
72      External :: procname
73      Optional ::  procname     
74      REAL, DIMENSION(
75     &         child%var%lb(1):child%var%ub(1)
76     &         ), Target :: tab    ! Result
77C
78C
79C     Definition of a temporary AGRIF_PVariable data TYPE 
80      allocate(childtemp % var)
81C
82C     Pointer on the root variable
83      childtemp % var % root_var => child % var %root_var
84C     
85C     Number of dimensions of the grid variable
86      childtemp % var % nbdim = 1 
87C     
88C     Values on the current grid used for the update
89C      childtemp % var % array1 => tab
90     
91      childtemp % var % lb = child % var % lb
92      childtemp % var % ub = child % var % ub             
93     
94C      childtemp % var % list_update => child%var%list_update
95             
96C
97     
98      IF (present(procname)) THEN
99      CALL Agrif_UpdateVariable
100     &     (TypeUpdate,parent,child,deb,fin,procname)
101      ELSE
102      CALL Agrif_UpdateVariable
103     &     (TypeUpdate,parent,child,deb,fin)
104      ENDIF     
105C     
106C      child % var % list_update => childtemp%var%list_update
107     
108      deallocate(childtemp % var)
109C
110C       
111      End Subroutine Agrif_Update_1D
112C
113C
114C
115C     **************************************************************************
116CCC   Subroutine Agrif_Update_2d
117C     **************************************************************************
118C 
119
120      Subroutine Agrif_Update_2d(TypeUpdate,parent,child,tab,deb,fin,
121     &                           procname)
122C
123CCC   Description:
124CCC   Subroutine to update a 2D grid variable on the parent grid.
125C
126C     Declarations:
127C
128     
129C
130C     Arguments     
131      INTEGER, DIMENSION(6) :: TypeUpdate                  ! TYPE of update (copy or average)
132      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
133      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
134      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
135      INTEGER, DIMENSION(6) :: deb,fin       ! Positions where interpolations 
136                                              ! are done on the fine grid
137                                             
138      External :: procname
139      Optional ::  procname
140                                                         
141      REAL, DIMENSION(
142     &         child%var%lb(1):child%var%ub(1),
143     &         child%var%lb(2):child%var%ub(2)
144     &    ), Target :: tab    ! Result
145C
146C
147C     Definition of a temporary AGRIF_PVariable data TYPE
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 = 2 
155C     
156C     Values on the current grid used for the update
157C      childtemp % var % array2 => tab 
158     
159      childtemp % var % lb = child % var % lb
160      childtemp % var % ub = child % var % ub             
161     
162C      childtemp % var % list_update => child%var%list_update     
163C
164      IF (present(procname)) THEN
165      CALL Agrif_UpdateVariable
166     &     (TypeUpdate,parent,child,deb,fin,procname)
167      ELSE
168      CALL Agrif_UpdateVariable
169     &     (TypeUpdate,parent,child,deb,fin)
170      ENDIF
171C     
172C      child % var % list_update => childtemp%var%list_update
173     
174      deallocate(childtemp % var)
175C
176C       
177      End Subroutine Agrif_Update_2D
178C
179C
180C
181C     **************************************************************************
182CCC   Subroutine Agrif_Update_3d
183C     **************************************************************************
184C 
185      Subroutine Agrif_Update_3d(TypeUpdate,parent,child,tab,deb,fin,
186     &                           procname)
187C
188CCC   Description:
189CCC   Subroutine to update a 3D grid variable on the parent grid.
190C
191C     Declarations:
192C
193     
194C
195C     Arguments     
196      INTEGER, DIMENSION(6) :: TypeUpdate                  ! TYPE of update (copy or average)
197      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
198      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
199      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
200      INTEGER, DIMENSION(6) :: deb,fin       ! Positions where interpolations
201                                              ! are done on the fine grid   
202      External :: procname
203      Optional ::  procname
204                                                       
205      REAL, DIMENSION(
206     &         child%var%lb(1):child%var%ub(1),
207     &         child%var%lb(2):child%var%ub(2),
208     &         child%var%lb(3):child%var%ub(3)
209     &      ), Target :: tab  ! Results 
210C
211C
212C     Definition of a temporary AGRIF_PVariable data TYPE 
213      allocate(childtemp % var)
214C
215C     Pointer on the root variable
216      childtemp % var % root_var => child % var %root_var
217C     
218C     Number of dimensions of the grid variable
219      childtemp % var % nbdim = 3 
220C     
221C     Values on the current grid used for the update
222C      childtemp % var % array3 => tab     
223     
224      childtemp % var % lb = child % var % lb
225      childtemp % var % ub = child % var % ub 
226           
227     
228C      childtemp % var % list_update => child%var%list_update     
229C
230      IF (present(procname)) THEN
231      CALL Agrif_UpdateVariable
232     &     (TypeUpdate,parent,child,deb,fin,procname)
233      ELSE
234      CALL Agrif_UpdateVariable
235     &     (TypeUpdate,parent,child,deb,fin)
236      ENDIF
237C     
238C      child % var % list_update => childtemp%var%list_update
239     
240      DEALLOCATE(childtemp % var)
241C
242C       
243      End Subroutine Agrif_Update_3D
244C
245C
246C
247C     **************************************************************************
248CCC   Subroutine Agrif_Update_4d
249C     **************************************************************************
250C 
251      Subroutine Agrif_Update_4d(TypeUpdate,parent,child,tab,deb,fin,
252     &                           procname)
253C
254CCC   Description:
255CCC   Subroutine to update a 4D grid variable on the parent grid.
256C
257C     Declarations:
258C
259     
260C
261C     Arguments     
262      INTEGER, DIMENSION(6) :: TypeUpdate                  ! TYPE of update (copy or average)
263      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
264      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
265      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
266      INTEGER, DIMENSION(6) :: deb,fin       ! Positions where interpolations
267                                              ! are done on the fine grid     
268      External :: procname
269      Optional ::  procname       
270      REAL, DIMENSION(
271     &         child%var%lb(1):child%var%ub(1),
272     &         child%var%lb(2):child%var%ub(2),
273     &         child%var%lb(3):child%var%ub(3),
274     &         child%var%lb(4):child%var%ub(4)
275     &      ), Target :: tab  ! Results
276C
277C
278C     Definition of a temporary AGRIF_PVariable data TYPE 
279      allocate(childtemp % var)
280C
281C     Pointer on the root variable
282      childtemp % var % root_var => child % var %root_var
283C     
284C     Number of dimensions of the grid variable
285      childtemp % var % nbdim = 4 
286C     
287C     Values on the current grid used for the update
288C      childtemp % var % array4 => tab     
289     
290      childtemp % var % lb = child % var % lb
291      childtemp % var % ub = child % var % ub 
292           
293     
294C      childtemp % var % list_update => child%var%list_update
295           
296C
297      IF (present(procname)) THEN
298      CALL Agrif_UpdateVariable
299     &     (TypeUpdate,parent,child,deb,fin,procname)
300      ELSE
301      CALL Agrif_UpdateVariable
302     &     (TypeUpdate,parent,child,deb,fin)
303      ENDIF
304
305C      child % var % list_update => childtemp%var%list_update     
306C
307      deallocate(childtemp % var)
308C
309C       
310      End Subroutine Agrif_Update_4D
311C
312C
313C
314C     **************************************************************************
315CCC   Subroutine Agrif_Update_5d
316C     **************************************************************************
317C 
318      Subroutine Agrif_Update_5d(TypeUpdate,parent,child,tab,deb,fin,
319     &                           procname)
320C
321CCC   Description:
322CCC   Subroutine to update a 5D grid variable on the parent grid.
323C
324C     Declarations:
325C
326     
327C
328C     Arguments     
329      INTEGER, DIMENSION(6) :: TypeUpdate                  ! TYPE of update (copy or average)
330      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
331      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
332      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
333      INTEGER, DIMENSION(6) :: deb,fin       ! Positions where interpolations
334                                              ! are done on the fine grid     
335      External :: procname
336      Optional ::  procname
337             
338      REAL, DIMENSION(
339     &         child%var%lb(1):child%var%ub(1),
340     &         child%var%lb(2):child%var%ub(2),
341     &         child%var%lb(3):child%var%ub(3),
342     &         child%var%lb(4):child%var%ub(4),
343     &         child%var%lb(5):child%var%ub(5)
344     &      ),  Target :: tab  ! Results
345C
346C
347C     Definition of a temporary AGRIF_PVariable data TYPE 
348      allocate(childtemp % var)
349C
350C     Pointer on the root variable
351      childtemp % var % root_var => child % var %root_var
352C
353C     Number of dimensions of the grid variable
354      childtemp % var % nbdim = 5 
355C     
356C     Values on the current grid used for the update
357C      childtemp % var % array5 => tab     
358     
359      childtemp % var % lb = child % var % lb
360      childtemp % var % ub = child % var % ub       
361     
362C      childtemp % var % list_update => child%var%list_update     
363C
364      IF (present(procname)) THEN
365      CALL Agrif_UpdateVariable
366     &     (TypeUpdate,parent,child,deb,fin,procname)
367      ELSE
368      CALL Agrif_UpdateVariable
369     &     (TypeUpdate,parent,child,deb,fin)
370      ENDIF
371     
372C      child % var % list_update => childtemp%var%list_update
373           
374C     
375      deallocate(childtemp % var)
376C
377C       
378      End Subroutine Agrif_Update_5D
379C
380C
381C
382C
383C     **************************************************************************
384CCC   Subroutine Agrif_Update_6d
385C     **************************************************************************
386C 
387      Subroutine Agrif_Update_6d(TypeUpdate,parent,child,tab,deb,fin)
388C
389CCC   Description:
390CCC   Subroutine to update a 6D grid variable on the parent grid.
391C
392C     Declarations:
393C
394     
395C
396C     Arguments     
397      INTEGER, DIMENSION(6) :: TypeUpdate                  ! TYPE of update (copy or average)
398      TYPE(AGRIF_PVariable) :: parent        ! Variable on the parent grid
399      TYPE(AGRIF_PVariable) :: child         ! Variable on the child grid
400      TYPE(AGRIF_PVariable) :: childtemp     ! Temporary variable on the child
401      INTEGER, DIMENSION(6) :: deb,fin       ! Positions where interpolations
402                                              ! are done on the fine grid       
403      REAL, DIMENSION(
404     &         child%var%lb(1):child%var%ub(1),
405     &         child%var%lb(2):child%var%ub(2),
406     &         child%var%lb(3):child%var%ub(3),
407     &         child%var%lb(4):child%var%ub(4),
408     &         child%var%lb(5):child%var%ub(5),
409     &         child%var%lb(6):child%var%ub(6)
410     &      ),  Target :: tab  ! Results
411C
412C
413C     Definition of a temporary AGRIF_PVariable data TYPE 
414      allocate(childtemp % var)
415C
416C     Pointer on the root variable
417      childtemp % var % root_var => child % var %root_var
418C     
419C     Number of dimensions of the grid variable
420      childtemp % var % nbdim = 6 
421C     
422C     Values on the current grid used for the update
423C      childtemp % var % array6 => tab     
424     
425      childtemp % var % lb = child % var % lb
426      childtemp % var % ub = child % var % ub 
427           
428C      childtemp % var % list_update => child%var%list_update
429C
430      Call Agrif_UpdateVariable
431     &     (TypeUpdate,parent,child,deb,fin)
432     
433C      child % var % list_update => childtemp%var%list_update
434           
435C     
436      deallocate(childtemp % var)
437C
438C       
439      End Subroutine Agrif_Update_6D
440C
441C
442C
443C     ************************************************************************** 
444C     Subroutine Agrif_UpdateVariable   
445C     ************************************************************************** 
446C   
447      Subroutine Agrif_UpdateVariable(TypeUpdate,parent,child,deb,fin,
448     &                   procname)   
449C
450CCC   Description:
451CCC   Subroutine to set arguments of Agrif_UpdatenD, n being the number of
452C         dimensions of the grid variable.
453C
454CC    Declarations:
455C     
456c     
457C     
458C     Scalar argument
459      INTEGER, DIMENSION(6) :: TypeUpdate                  ! TYPE of update (copy or average)
460C     Data TYPE arguments
461      TYPE(AGRIF_PVariable) :: parent   ! Variable on the parent grid
462      TYPE(AGRIF_PVariable) :: child    ! Variable on the child grid
463      INTEGER, DIMENSION(6) :: deb,fin       ! Positions where interpolations
464                                        !    are calculated     
465      External :: procname
466      Optional ::  procname
467     
468C
469C     Local scalars     
470      INTEGER :: nbdim                  ! Number of dimensions of the current
471                                        !    grid
472      INTEGER ,DIMENSION(6) :: pttab_child 
473      INTEGER ,DIMENSION(6) :: petab_child     
474      INTEGER ,DIMENSION(6) :: pttab_parent 
475      REAL    ,DIMENSION(6) :: s_child,s_parent
476      REAL    ,DIMENSION(6) :: ds_child,ds_parent
477      INTEGER,DIMENSION(6)          :: loctab_Child ! Indicates if the child
478                                        !    grid has a common border with
479                                        !    the root grid           
480      TYPE(AGRIF_Variable), Pointer :: root               ! Variable on the root grid
481      INTEGER,DIMENSION(6)          :: posvartab_Child    ! Position of the
482                                        !    variable on the cell
483      INTEGER,DIMENSION(6)          :: nbtab_Child        ! Number of the cells   
484      INTEGER :: n             
485      LOGICAL :: wholeupdate
486C
487C 
488
489      loctab_child(:) = 0
490C
491      root => child % var % root_var 
492      nbdim = root % nbdim
493C
494      do n = 1,nbdim
495        posvartab_child(n) = root % posvar(n)
496      enddo
497C     
498     
499      Call PreProcessToInterpOrUpdate(parent,child,
500     &             petab_Child(1:nbdim),
501     &             pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
502     &             s_Child(1:nbdim),s_Parent(1:nbdim),
503     &             ds_Child(1:nbdim),ds_Parent(1:nbdim),
504     &             nbdim)
505C
506C
507      do n = 1,nbdim
508C
509        Select case(root % interptab(n))
510C
511          case('x') ! x DIMENSION
512C
513            nbtab_Child(n) = Agrif_Curgrid % nb(1)
514C
515          case('y') ! y DIMENSION     
516C
517            nbtab_Child(n) = Agrif_Curgrid % nb(2)
518C
519          case('z') ! z DIMENSION
520C
521            nbtab_Child(n) = Agrif_Curgrid % nb(3)
522C
523          case('N') ! No space DIMENSION     
524C
525           
526            nbtab_Child(n) = child % var % ub(n) - child % var % lb(n)
527C
528C           No interpolation but only a copy of the values of the grid variable     
529C     
530            posvartab_child(n) = 1
531           
532            loctab_child(n) = -3
533C
534        End select
535C
536      enddo
537     
538C     Call to a procedure of update according to the number of dimensions of
539C     the grid variable
540
541      wholeupdate = .FALSE.
542     
543      do n=1,nbdim
544      if (loctab_child(n) /= -3) then
545        if (deb(n)>fin(n)) wholeupdate = .TRUE.
546        if ((deb(n) == -99).AND.(deb(n)==fin(n))) wholeupdate=.TRUE.
547      endif
548      enddo
549
550       IF (present(procname)) THEN
551
552          IF (wholeupdate) THEN
553
554          Call AGRIF_UpdateWhole
555     &         (TypeUpdate,parent,child,deb,fin,
556     &          pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
557     &          nbtab_Child(1:nbdim),posvartab_Child(1:nbdim),
558     &          loctab_Child(1:nbdim),
559     &          s_Child(1:nbdim),s_Parent(1:nbdim),
560     &          ds_Child(1:nbdim),ds_Parent(1:nbdim),nbdim,procname) 
561         ELSE
562          Call AGRIF_UpdateBcnD
563     &         (TypeUpdate,parent,child,deb,fin,
564     &          pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
565     &          nbtab_Child(1:nbdim),posvartab_Child(1:nbdim),
566     &          loctab_Child(1:nbdim),
567     &          s_Child(1:nbdim),s_Parent(1:nbdim),
568     &          ds_Child(1:nbdim),ds_Parent(1:nbdim),nbdim,procname) 
569         ENDIF
570       ELSE
571         IF (wholeupdate) THEN
572          Call AGRIF_UpdateWhole
573     &         (TypeUpdate,parent,child,deb,fin,
574     &          pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
575     &          nbtab_Child(1:nbdim),posvartab_Child(1:nbdim),
576     &          loctab_Child(1:nbdim),
577     &          s_Child(1:nbdim),s_Parent(1:nbdim),
578     &          ds_Child(1:nbdim),ds_Parent(1:nbdim),nbdim)
579         ELSE
580          Call AGRIF_UpdateBcnD
581     &         (TypeUpdate,parent,child,deb,fin,
582     &          pttab_Child(1:nbdim),pttab_Parent(1:nbdim),
583     &          nbtab_Child(1:nbdim),posvartab_Child(1:nbdim),
584     &          loctab_Child(1:nbdim),
585     &          s_Child(1:nbdim),s_Parent(1:nbdim),
586     &          ds_Child(1:nbdim),ds_Parent(1:nbdim),nbdim)
587         ENDIF
588       ENDIF
589C
590      Return
591C
592C
593      End subroutine Agrif_UpdateVariable
594C
595C     **************************************************************************
596CCC   Subroutine Agrif_UpdateWhole
597C     **************************************************************************               
598C
599      Subroutine AGRIF_UpdateWhole(TypeUpdate,parent,child,deb,fin,
600     &                           pttab_child,pttab_Parent,
601     &                           nbtab_Child,posvartab_Child,
602     &                           loctab_Child,
603     &                           s_Child,s_Parent,
604     &                           ds_Child,ds_Parent,nbdim,procname)
605C
606CCC   Description:
607CCC   Subroutine to calculate the boundary conditions for a nD grid variable on 
608CCC   a fine grid by using a space and time interpolations; it is called by the 
609CCC   Agrif_CorrectVariable procedure.
610C
611C
612C     Declarations:
613C
614     
615C
616#ifdef AGRIF_MPI
617C
618#include "mpif.h"
619C
620#endif
621C
622C     Arguments
623      INTEGER, DIMENSION(6) :: TypeUpdate            ! TYPE of update (copy or
624                                                     !    average)
625      TYPE(AGRIF_PVariable)    :: parent             ! Variable on the parent
626                                                     !    grid
627      TYPE(AGRIF_PVariable)    :: child              ! Variable on the child
628                                                     !    grid
629      INTEGER, DIMENSION(6) :: deb, fin
630      INTEGER                  :: nbdim              ! Number of dimensions of
631                                                     !    the grid variable
632      INTEGER,DIMENSION(nbdim) :: pttab_child        ! Index of the first point
633                                                     !    inside the domain for
634                                                     !    the parent grid
635                                                     !    variable
636      INTEGER,DIMENSION(nbdim) :: pttab_Parent       ! Index of the first point
637                                                     !    inside the domain for
638                                                     !    the child grid
639                                                     !    variable
640      INTEGER,DIMENSION(nbdim) :: nbtab_Child        ! Number of cells of the
641                                                     !    child grid
642      INTEGER,DIMENSION(nbdim) :: posvartab_Child    ! Position of the grid
643                                                     !    variable (1 or 2)
644      INTEGER,DIMENSION(nbdim) :: loctab_Child       ! Indicates if the child
645                                                     !    grid has a common
646                                                     !    border with the root
647                                                     !    grid
648      REAL   ,DIMENSION(nbdim) :: s_Child,s_Parent   ! Positions of the parent
649                                                     !    and child grids
650      REAL   ,DIMENSION(nbdim) :: ds_Child,ds_Parent ! Space steps of the parent
651                                                     !    and child grids
652      External :: procname
653      Optional ::  procname     
654C
655C     Local variables     
656      INTEGER,DIMENSION(nbdim,2)   :: lubglob
657      INTEGER                      :: i                 
658      INTEGER,DIMENSION(nbdim,2,2) :: indtab         ! Arrays indicating the
659                                                     !    limits of the child
660      INTEGER,DIMENSION(nbdim,2,2) :: indtruetab     ! grid variable where
661                                                     !   boundary conditions are
662      integer :: coeffraf
663      INTEGER :: debloc, finloc
664C
665#ifdef AGRIF_MPI
666C
667      INTEGER,DIMENSION(nbdim)   :: lb,ub
668      INTEGER,DIMENSION(nbdim,2) :: iminmaxg
669      INTEGER                    :: code
670C
671#endif
672C     
673C
674C indtab contains the limits for the fine grid points that will be used
675C in the update scheme
676
677      DO i = 1, nbdim
678        coeffraf = nint(ds_Parent(i)/ds_Child(i))
679        debloc = 0
680        finloc = nbtab_Child(i)/coeffraf - 1
681
682        IF (posvartab_child(i) == 1) THEN
683           finloc = finloc - 1
684        ENDIF
685
686        IF (deb(i) > fin(i)) THEN
687          debloc = deb(i)
688          finloc = finloc - deb(i)
689        ENDIF
690
691        indtab(i,1,1) = pttab_child(i) + (debloc + 1) * coeffraf
692        indtab(i,1,2) = pttab_child(i) + (finloc + 1) * coeffraf
693
694        IF (posvartab_child(i) == 1) THEN
695          IF (TypeUpdate(i) .EQ. Agrif_Update_Full_Weighting) THEN
696            indtab(i,1,1) = indtab(i,1,1) - (coeffraf - 1)
697            indtab(i,1,2) = indtab(i,1,2) + (coeffraf - 1)       
698          ELSE IF (TypeUpdate(i) .NE. Agrif_Update_Copy) THEN
699            indtab(i,1,1) = indtab(i,1,1) - coeffraf / 2
700            indtab(i,1,2) = indtab(i,1,2) + coeffraf / 2
701          ENDIF
702        ELSE
703          indtab(i,1,1) = indtab(i,1,1) - coeffraf
704          indtab(i,1,2) = indtab(i,1,2) - 1
705C at this point, indices are OK for an average         
706          IF ((TypeUpdate(i) .EQ. Agrif_Update_Full_Weighting)) THEN
707            indtab(i,1,1) = indtab(i,1,1) - coeffraf/2
708            indtab(i,1,2) = indtab(i,1,2) + coeffraf/2
709          ENDIF
710        ENDIF
711        IF (loctab_child(i) == -3) THEN
712           indtab(i,1,1) = pttab_child(i)
713C
714               if (posvartab_child(i) == 1) then
715C
716               indtab(i,1,2) = pttab_child(i) + nbtab_child(i) 
717C
718               else
719C
720               indtab(i,1,2) = pttab_child(i) + nbtab_child(i) - 1
721               ENDIF
722        ENDIF
723      ENDDO
724
725C lubglob contains the global lbound and ubound of the child array
726C lubglob(:,1) : global lbound for each dimension
727C lubglob(:,2) : global lbound for each dimension
728
729#if !defined AGRIF_MPI
730        Call Agrif_nbdim_Get_bound_dimension(child % var,lubglob(:,1),
731     &               lubglob(:,2),nbdim)
732C
733#else
734C     
735        Call Agrif_nbdim_Get_bound_dimension(child % var,lb,ub,nbdim)
736      DO i = 1,nbdim
737C
738        Call Agrif_Invloc(lb(i),Agrif_Procrank,i,iminmaxg(i,1))
739        Call Agrif_Invloc(ub(i),Agrif_Procrank,i,iminmaxg(i,2))
740C
741      ENDDO
742C
743      iminmaxg(1:nbdim,2) = - iminmaxg(1:nbdim,2)
744     
745      CALL MPI_ALLREDUCE(iminmaxg,lubglob,2*nbdim,MPI_INTEGER,MPI_MIN,
746     &                     MPI_COMM_WORLD,code)
747
748      lubglob(1:nbdim,2) = - lubglob(1:nbdim,2)     
749C
750#endif
751C
752      indtruetab(1:nbdim,1,1) = max(indtab(1:nbdim,1,1),
753     &     lubglob(1:nbdim,1))
754      indtruetab(1:nbdim,1,2) = min(indtab(1:nbdim,1,2),
755     &     lubglob(1:nbdim,2))
756
757C
758C
759           IF (present(procname)) THEN
760              Call Agrif_UpdatenD             
761     &             (TypeUpdate,parent,child,
762     &              indtruetab(1:nbdim,1,1),indtruetab(1:nbdim,1,2),
763     &              pttab_child(1:nbdim),pttab_Parent(1:nbdim),
764     &              s_Child(1:nbdim),s_Parent(1:nbdim),
765     &              ds_Child(1:nbdim),ds_Parent(1:nbdim),
766     &              posvartab_child,loctab_Child,
767     &              nbdim,procname)
768           ELSE
769              Call Agrif_UpdatenD             
770     &             (TypeUpdate,parent,child,
771     &              indtruetab(1:nbdim,1,1),indtruetab(1:nbdim,1,2),
772     &              pttab_child(1:nbdim),pttab_Parent(1:nbdim),
773     &              s_Child(1:nbdim),s_Parent(1:nbdim),
774     &              ds_Child(1:nbdim),ds_Parent(1:nbdim),
775     &              posvartab_child,loctab_Child,
776     &              nbdim)           
777           ENDIF       
778C
779C     
780C 
781      End Subroutine Agrif_UpdateWhole
782C
783C     **************************************************************************
784CCC   Subroutine Agrif_UpdateBcnd
785C     **************************************************************************               
786C
787      Subroutine AGRIF_UpdateBcnd(TypeUpdate,parent,child,deb,fin,
788     &                           pttab_child,pttab_Parent,
789     &                           nbtab_Child,posvartab_Child,
790     &                           loctab_Child,
791     &                           s_Child,s_Parent,
792     &                           ds_Child,ds_Parent,nbdim,procname)
793C
794CCC   Description:
795CCC   Subroutine to calculate the boundary conditions for a nD grid variable on
796CCC   a fine grid by using a space and time interpolations; it is called by the 
797CCC   Agrif_CorrectVariable procedure.
798C
799C
800C     Declarations:
801C
802     
803C
804#ifdef AGRIF_MPI
805C
806#include "mpif.h"
807C
808#endif
809C
810C     Arguments
811      INTEGER, DIMENSION(6) :: TypeUpdate            ! TYPE of update
812                                                     !   (copy or average)
813      TYPE(AGRIF_PVariable)    :: parent             ! Variable on the parent
814                                                     !   grid
815      TYPE(AGRIF_PVariable)    :: child              ! Variable on the child
816                                                     !   grid
817      INTEGER, DIMENSION(6) :: deb, fin
818      INTEGER                  :: nbdim              ! Number of dimensions of
819                                                     !   the grid variable
820      INTEGER,DIMENSION(nbdim) :: pttab_child        ! Index of the first point
821                                                     !   inside the domain for
822                                                     !   the parent grid
823                                                     !   variable
824      INTEGER,DIMENSION(nbdim) :: pttab_Parent       ! Index of the first point
825                                                     !   inside the domain for
826                                                     !   the child grid variable
827      INTEGER,DIMENSION(nbdim) :: nbtab_Child        ! Number of cells of the
828                                                     !   child grid
829      INTEGER,DIMENSION(nbdim) :: posvartab_Child    ! Position of the grid
830                                                     !   variable (1 or 2)
831      INTEGER,DIMENSION(nbdim) :: loctab_Child       ! Indicates if the child
832                                                     !   grid has a common
833                                                     !   border with the root
834                                                     !   grid
835      REAL   ,DIMENSION(nbdim) :: s_Child,s_Parent   ! Positions of the parent
836                                                     !   and child grids
837      REAL   ,DIMENSION(nbdim) :: ds_Child,ds_Parent ! Space steps of the parent
838                                                     !   and child grids
839      External :: procname
840      Optional ::  procname     
841C
842C     Local variables
843      INTEGER,DIMENSION(nbdim,2)   :: lubglob
844      INTEGER                      :: i                 
845      INTEGER,DIMENSION(nbdim,2,2) :: indtab         ! Arrays indicating the
846                                                     !   limits of the child
847      INTEGER,DIMENSION(nbdim,2,2) :: indtruetab     ! grid variable where
848                                                     !  boundary conditions are
849      INTEGER,DIMENSION(nbdim,2,2,nbdim)   :: ptres      ! calculated
850      INTEGER                      :: nb,ndir,n
851      integer :: coeffraf
852C
853#ifdef AGRIF_MPI
854C
855      INTEGER,DIMENSION(nbdim)   :: lb,ub
856      INTEGER,DIMENSION(nbdim,2) :: iminmaxg
857      INTEGER                    :: code
858C
859#endif
860C     
861C
862
863      DO i = 1, nbdim
864        coeffraf = nint(ds_Parent(i)/ds_Child(i))
865        indtab(i,1,1) = pttab_child(i) + (deb(i) + 1) * coeffraf
866        indtab(i,1,2) = pttab_child(i) + (fin(i) + 1) * coeffraf
867
868        indtab(i,2,1) = pttab_child(i) + nbtab_child(i)
869     &    - (fin(i) + 1) *  coeffraf
870        indtab(i,2,2) = pttab_child(i) + nbtab_child(i)
871     &    - (deb(i) + 1) *  coeffraf
872
873        IF (posvartab_child(i) == 1) THEN
874          IF (TypeUpdate(i) .EQ. Agrif_Update_Full_Weighting) THEN
875            indtab(i,:,1) = indtab(i,:,1) - (coeffraf - 1)
876            indtab(i,:,2) = indtab(i,:,2) + (coeffraf - 1)       
877          ELSE IF (TypeUpdate(i) .NE. Agrif_Update_Copy) THEN
878            indtab(i,:,1) = indtab(i,:,1) - coeffraf / 2
879            indtab(i,:,2) = indtab(i,:,2) + coeffraf / 2
880          ENDIF
881        ELSE
882          indtab(i,1,1) = indtab(i,1,1) - coeffraf
883          indtab(i,1,2) = indtab(i,1,2) - 1
884          indtab(i,2,2) = indtab(i,2,2) + coeffraf - 1
885          IF (TypeUpdate(i) .EQ. Agrif_Update_Full_Weighting) THEN
886            indtab(i,1,1) = indtab(i,1,1) - coeffraf/2
887            indtab(i,1,2) = indtab(i,1,2) + coeffraf/2
888            indtab(i,2,1) = indtab(i,2,1) - coeffraf/2
889            indtab(i,2,2) = indtab(i,2,2) + coeffraf/2
890          ENDIF         
891        ENDIF
892      ENDDO
893
894#if !defined AGRIF_MPI     
895        Call Agrif_nbdim_Get_bound_dimension(child % var,lubglob(:,1),
896     &               lubglob(:,2),nbdim)
897
898C
899#else
900C     
901        Call Agrif_nbdim_Get_bound_dimension(child % var,lb,ub,nbdim)
902      DO i = 1,nbdim
903C
904        Call Agrif_Invloc(lb(i),Agrif_Procrank,i,iminmaxg(i,1))
905        Call Agrif_Invloc(ub(i),Agrif_Procrank,i,iminmaxg(i,2))
906C
907      ENDDO
908C
909      iminmaxg(1:nbdim,2) = - iminmaxg(1:nbdim,2)
910     
911      CALL MPI_ALLREDUCE(iminmaxg,lubglob,2*nbdim,MPI_INTEGER,MPI_MIN,
912     &                     MPI_COMM_WORLD,code) 
913     
914      lubglob(1:nbdim,2) = - lubglob(1:nbdim,2)     
915C
916#endif
917C     
918      indtruetab(1:nbdim,1,1) = max(indtab(1:nbdim,1,1),
919     &     lubglob(1:nbdim,1))
920      indtruetab(1:nbdim,1,2) = max(indtab(1:nbdim,1,2),
921     &     lubglob(1:nbdim,1))
922      indtruetab(1:nbdim,2,1) = min(indtab(1:nbdim,2,1),
923     &     lubglob(1:nbdim,2))
924      indtruetab(1:nbdim,2,2) = min(indtab(1:nbdim,2,2),
925     &     lubglob(1:nbdim,2))
926                       
927C 
928C
929      do nb = 1,nbdim
930C
931        do ndir = 1,2
932C
933          if (loctab_child(nb) /= -3) then
934C           
935              do n = 1,2
936C
937                ptres(nb,n,ndir,nb) = indtruetab(nb,ndir,n)
938C
939              enddo             
940C
941              do i = 1,nbdim
942C     
943                if (i .NE. nb) then     
944C
945                    if (loctab_child(i) == -3) then
946C
947                        ptres(i,1,ndir,nb) = pttab_child(i)
948C
949                      else
950C
951                        ptres(i,1,ndir,nb) = indtruetab(i,1,1)
952C
953                    endif
954C
955                    if (loctab_child(i) == -3) then
956C
957                        if (posvartab_child(i) == 1) then
958C
959                            ptres(i,2,ndir,nb) = pttab_child(i) 
960     &                                + nbtab_child(i)
961C
962                          else
963C
964                            ptres(i,2,ndir,nb) = pttab_child(i) 
965     &                             + nbtab_child(i) - 1
966C
967                        endif                             
968C
969                      else
970C
971                        ptres(i,2,ndir,nb) = indtruetab(i,2,2)
972C
973                    endif                       
974C     
975                endif
976C     
977              enddo
978     
979C
980           
981        endif
982     
983        enddo
984       enddo
985C
986
987C
988
989      do nb = 1,nbdim
990C
991        do ndir = 1,2               
992C
993          if (loctab_child(nb) /= -3) then
994C
995           IF (present(procname)) THEN
996              Call Agrif_UpdatenD             
997     &             (TypeUpdate,parent,child,
998     &              ptres(1:nbdim,1,ndir,nb),ptres(1:nbdim,2,ndir,nb),
999     &              pttab_child(1:nbdim),pttab_Parent(1:nbdim),
1000     &              s_Child(1:nbdim),s_Parent(1:nbdim),
1001     &              ds_Child(1:nbdim),ds_Parent(1:nbdim),
1002     &              posvartab_Child,loctab_Child,
1003     &              nbdim,procname,nb,ndir)
1004           ELSE
1005              Call Agrif_UpdatenD             
1006     &             (TypeUpdate,parent,child,
1007     &              ptres(1:nbdim,1,ndir,nb),ptres(1:nbdim,2,ndir,nb),
1008     &              pttab_child(1:nbdim),pttab_Parent(1:nbdim),
1009     &              s_Child(1:nbdim),s_Parent(1:nbdim),
1010     &              ds_Child(1:nbdim),ds_Parent(1:nbdim),
1011     &              posvartab_Child,loctab_Child,
1012     &              nbdim)           
1013           ENDIF
1014C
1015          endif
1016         
1017C
1018        enddo       
1019C
1020      enddo
1021C
1022C     
1023C 
1024      End Subroutine Agrif_UpdateBcnd
1025C
1026C     ************************************************************************** 
1027CCC   Subroutine Agrif_UpdatenD 
1028C     ************************************************************************** 
1029C 
1030      Subroutine Agrif_UpdatenD(TypeUpdate,parent,child,
1031     &                          pttab,petab,
1032     &                          pttab_Child,pttab_Parent,
1033     &                          s_Child,s_Parent,
1034     &                          ds_Child,ds_Parent,
1035     &                          posvartab_Child,loctab_Child,
1036     &                          nbdim,procname,nb,ndir) 
1037C
1038C     Description:
1039C     Subroutine to update a 2D grid variable on the parent grid of 
1040C        the current grid. 
1041C
1042C     Declarations:
1043C
1044     
1045C
1046#ifdef AGRIF_MPI
1047C
1048#include "mpif.h"
1049C
1050#endif
1051C
1052C     Arguments
1053      INTEGER                    :: nbdim
1054      INTEGER, DIMENSION(6) :: TypeUpdate              ! TYPE of update
1055                                                       !  (copy or average)
1056      TYPE(AGRIF_PVARIABLE)      :: parent             ! Variable of the parent
1057                                                       !   grid   
1058      TYPE(AGRIF_PVARIABLE)      :: child              ! Variable of the child
1059                                                       !   grid
1060      INTEGER,DIMENSION(nbdim)   :: pttab              ! Index of the first
1061                                                       !   point inside the
1062                                                       !   domain
1063      INTEGER,DIMENSION(nbdim)   :: petab              ! Index of the first
1064                                                       !   point inside the
1065                                                       !   domain
1066      INTEGER,DIMENSION(nbdim)   :: pttab_Child        ! Index of the first
1067                                                       !   point inside the
1068                                                       !   domain for the child
1069                                                       !   grid variable
1070      INTEGER,DIMENSION(nbdim)   :: pttab_Parent       ! Index of the first
1071                                                       !   point inside the
1072                                                       !   domain for the parent
1073                                                       !   grid variable
1074      REAL,DIMENSION(nbdim)      :: s_Child,s_Parent   ! Positions of the parent
1075                                                       !   and child grids
1076      REAL,DIMENSION(nbdim)      :: ds_Child,ds_Parent ! Space steps of the
1077                                                       !   parent and child
1078                                                       !   grids
1079      External :: procname
1080      Optional ::  procname
1081      Integer :: nb,ndir
1082      Optional :: nb,ndir
1083     
1084C
1085C     Local pointers
1086      TYPE(AGRIF_PVARIABLE), SAVE      :: tempP      ! Temporary parent grid variable
1087      TYPE(AGRIF_PVARIABLE), SAVE      :: tempC      ! Temporary child grid variable
1088C
1089C     Local scalars
1090      INTEGER,DIMENSION(nbdim)    :: pttruetab,cetruetab
1091      INTEGER,DIMENSION(nbdim)    :: posvartab_Child,loctab_Child
1092      INTEGER,DIMENSION(nbdim)    :: indmin,indmax
1093      INTEGER,DIMENSION(nbdim)    :: indminglob,indmaxglob
1094      REAL   ,DIMENSION(nbdim)    :: s_Child_temp,s_Parent_temp
1095cccccccc      LOGICAL,DIMENSION(nbdim)    :: noraftab
1096      INTEGER,DIMENSION(nbdim)    :: lowerbound,upperbound
1097      LOGICAL :: memberin, member
1098      INTEGER,DIMENSION(nbdim)    :: pttruetabwhole,cetruetabwhole
1099      INTEGER,DIMENSION(nbdim,2,2) :: childarray
1100      INTEGER,DIMENSION(nbdim,2,2) :: parentarray
1101      TYPE(AGRIF_PVARIABLE), SAVE      :: tempCextend,tempPextend ! Temporary child
1102      INTEGER :: nbin, ndirin
1103C
1104#ifdef AGRIF_MPI
1105C
1106      INTEGER,DIMENSION(nbdim)    :: indminglob2,indmaxglob2
1107      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc1,recvfromproc1
1108      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc2,recvfromproc2     
1109      INTEGER                              :: code
1110      INTEGER                              :: i,j,k
1111      INTEGER,DIMENSION(nbdim,4)           :: tab3
1112      INTEGER,DIMENSION(nbdim,4,0:Agrif_Nbprocs-1) :: tab4
1113      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t
1114      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab5t     
1115      LOGICAL :: find_list_update
1116      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: memberinall, memberinall2
1117      LOGICAL, DIMENSION(1) :: memberin1     
1118C
1119#endif
1120C
1121 
1122C
1123C     local lbound and ubound of the child array
1124
1125      Call Agrif_nbdim_Get_bound_dimension(child%var,
1126     &                              lowerbound,upperbound,nbdim)
1127
1128C here pttab and petab corresponds to the (global) indices of the points needed
1129C in the update
1130C pttruetab and cetruetab contains only indices that are present
1131C on the local processor
1132
1133      Call Agrif_Childbounds(nbdim,
1134     &                       lowerbound,upperbound,
1135     &                       pttab,petab,
1136     &                       pttruetab,cetruetab,memberin)
1137
1138       Call Agrif_Prtbounds(nbdim,indminglob,indmaxglob,s_Parent_temp,
1139     &                     s_Child_temp,s_Child,ds_Child,
1140     &                     s_Parent,ds_Parent,
1141     &                     pttab,petab,pttab_Child,
1142     &                     pttab_Parent,
1143     &                     posvartab_Child,TypeUpdate,loctab_Child
1144#ifdef AGRIF_MPI
1145     &                 ,pttruetabwhole,cetruetabwhole
1146#endif
1147     &     )
1148
1149#ifdef AGRIF_MPI
1150      IF (memberin) THEN
1151       Call Agrif_GlobtoLocInd2(childarray,
1152     &                     lowerbound,upperbound,
1153     &                     pttruetab,cetruetab,
1154     &                     nbdim,Agrif_Procrank,
1155     &                     member)
1156
1157      ENDIF
1158
1159
1160         Call Agrif_Prtbounds(nbdim,indmin,indmax,s_Parent_temp,
1161     &                     s_Child_temp,s_Child,ds_Child,
1162     &                     s_Parent,ds_Parent,
1163     &                     pttruetab,cetruetab,pttab_Child,
1164     &                     pttab_Parent,
1165     &                     posvartab_Child,TypeUpdate,loctab_Child
1166     &                 ,pttruetabwhole,cetruetabwhole
1167     &     )
1168
1169#else
1170       indmin = indminglob
1171       indmax = indmaxglob
1172       pttruetabwhole = pttruetab
1173       cetruetabwhole = cetruetab
1174       childarray(:,1,2) = pttruetab
1175       childarray(:,2,2) = cetruetab
1176#endif
1177
1178       IF (present(procname)) THEN
1179       IF (.Not.present(nb)) THEN
1180       nbin=0
1181       ndirin=0
1182       ELSE
1183       nbin = nb
1184       ndirin = ndir
1185       ENDIF
1186       ENDIF
1187       
1188      IF (memberin) THEN
1189      IF (.not.associated(tempC%var)) allocate(tempC%var)
1190
1191C
1192      Call Agrif_nbdim_allocation(tempC%var,
1193     &                 pttruetab,cetruetab,nbdim)
1194
1195      Call Agrif_nbdim_Full_VarEQreal(tempC%var,0.,nbdim)
1196
1197      IF (present(procname)) THEN
1198        SELECT CASE (nbdim)
1199        CASE(1)
1200          CALL procname(tempC%var%array1,
1201     &                          childarray(1,1,2),childarray(1,2,2),
1202     &                                   .TRUE.,nbin,ndirin)
1203        CASE(2)
1204          CALL procname(tempC%var%array2,
1205     &                          childarray(1,1,2),childarray(1,2,2),
1206     &                          childarray(2,1,2),childarray(2,2,2),
1207     &                                   .TRUE.,nbin,ndirin)
1208        CASE(3)
1209          CALL procname(tempC%var%array3,
1210     &                          childarray(1,1,2),childarray(1,2,2),
1211     &                          childarray(2,1,2),childarray(2,2,2),
1212     &                          childarray(3,1,2),childarray(3,2,2),
1213     &                                   .TRUE.,nbin,ndirin)
1214        CASE(4)
1215          CALL procname(tempC%var%array4,
1216     &                          childarray(1,1,2),childarray(1,2,2),
1217     &                          childarray(2,1,2),childarray(2,2,2),
1218     &                          childarray(3,1,2),childarray(3,2,2),
1219     &                          childarray(4,1,2),childarray(4,2,2),
1220     &                                   .TRUE.,nbin,ndirin)
1221        CASE(5)
1222          CALL procname(tempC%var%array5,
1223     &                          childarray(1,1,2),childarray(1,2,2),
1224     &                          childarray(2,1,2),childarray(2,2,2),
1225     &                          childarray(3,1,2),childarray(3,2,2),
1226     &                          childarray(4,1,2),childarray(4,2,2),
1227     &                          childarray(5,1,2),childarray(5,2,2),
1228     &                                   .TRUE.,nbin,ndirin)
1229        CASE(6)
1230          CALL procname(tempC%var%array6,
1231     &                          childarray(1,1,2),childarray(1,2,2),
1232     &                          childarray(2,1,2),childarray(2,2,2),
1233     &                          childarray(3,1,2),childarray(3,2,2),
1234     &                          childarray(4,1,2),childarray(4,2,2),
1235     &                          childarray(5,1,2),childarray(5,2,2),
1236     &                          childarray(6,1,2),childarray(6,2,2),
1237     &                                   .TRUE.,nbin,ndirin)
1238        END SELECT
1239      ELSE
1240      Call Agrif_nbdim_VarEQvar(tempC%var,pttruetab,cetruetab,
1241     &          child%var,childarray(:,1,2),childarray(:,2,2),
1242     &                          nbdim)
1243      ENDIF
1244
1245      ENDIF
1246
1247
1248
1249C
1250C
1251#ifdef AGRIF_MPI
1252C
1253C     tab2 contains the necessary limits of the parent grid for each processor
1254
1255      IF (Associated(child%var%list_update)) THEN
1256      Call Agrif_Find_list_update(child%var%list_update,pttab,petab,
1257     &                          pttab_Child,pttab_Parent,nbdim,
1258     &       find_list_update,tab4t,tab5t,memberinall,memberinall2,
1259     &     sendtoproc1,recvfromproc1,sendtoproc2,recvfromproc2)
1260      ELSE
1261      find_list_update = .FALSE.
1262      ENDIF
1263     
1264      if (.not.find_list_update) then     
1265      tab3(:,1) = pttruetab(:)
1266      tab3(:,2) = cetruetab(:)
1267      tab3(:,3) = pttruetabwhole(:)
1268      tab3(:,4) = cetruetabwhole(:)
1269C
1270C
1271      Call MPI_ALLGATHER(tab3,4*nbdim,MPI_INTEGER,tab4,4*nbdim,
1272     &                   MPI_INTEGER,MPI_COMM_WORLD,code)
1273
1274      IF (.not.associated(tempCextend%var)) Allocate(tempCextend%var)
1275      DO k=0,Agrif_Nbprocs-1
1276       do j=1,4
1277         do i=1,nbdim
1278         tab4t(i,k,j) = tab4(i,j,k)
1279         enddo
1280       enddo
1281      enddo
1282     
1283      memberin1(1) = memberin
1284      CALL MPI_ALLGATHER(memberin1,1,MPI_LOGICAL,memberinall,
1285     &                  1,MPI_LOGICAL,MPI_COMM_WORLD,code)
1286 
1287       Call Get_External_Data_first(tab4t(:,:,1),
1288     &            tab4t(:,:,2),
1289     &            tab4t(:,:,3),tab4t(:,:,4),nbdim,memberin,memberin,
1290     &            memberinall,sendtoproc1,recvfromproc1,tab4t(:,:,5),
1291     & tab4t(:,:,6),tab4t(:,:,7),tab4t(:,:,8))
1292               
1293      endif
1294
1295      Call ExchangeSameLevel2(sendtoproc1,recvfromproc1,nbdim,
1296     &            tab4t(:,:,3),tab4t(:,:,4),tab4t(:,:,5),tab4t(:,:,6),
1297     &            tab4t(:,:,7),tab4t(:,:,8),memberin,tempC,
1298     &            tempCextend) 
1299           
1300!      Call Get_External_Data(tempC,tempCextend,tab4t(:,:,1),
1301!     &            tab4t(:,:,2),
1302!     &            tab4t(:,:,3),tab4t(:,:,4),nbdim,memberin,memberin,
1303!     &            memberinall)
1304
1305#else
1306      tempCextend%var => tempC%var
1307#endif
1308
1309C
1310C
1311C     Update of the parent grid (tempP) from the child grid (tempC)
1312
1313
1314      IF (memberin) THEN
1315
1316      IF (.not.associated(tempP%var)) allocate(tempP%var)
1317      Call Agrif_nbdim_allocation(tempP%var,
1318     &                 indmin,indmax,nbdim)
1319
1320      if ( nbdim .EQ. 1 ) then
1321         tempP%var%array1 = 0.
1322         Call Agrif_Update_1D_recursive(TypeUpdate,
1323     &           tempP%var%array1,tempCextend%var%array1,
1324     &           indmin,indmax,
1325     &           pttruetabwhole,cetruetabwhole,
1326     &           s_Child_temp,s_Parent_temp,
1327     &           ds_Child,ds_Parent,nbdim)
1328      endif
1329      if ( nbdim .EQ. 2 ) then
1330         Call Agrif_Update_2D_recursive(TypeUpdate,
1331     &           tempP%var%array2,tempCextend%var%array2,
1332     &           indmin,indmax,
1333     &           pttruetabwhole,cetruetabwhole,
1334     &           s_Child_temp,s_Parent_temp,
1335     &           ds_Child,ds_Parent,nbdim)
1336      endif
1337
1338      if ( nbdim .EQ. 3 ) then
1339         Call Agrif_Update_3D_recursive(TypeUpdate,
1340     &           tempP%var%array3,tempCextend%var%array3,
1341     &           indmin,indmax,
1342     &           pttruetabwhole,cetruetabwhole,
1343     &           s_Child_temp,s_Parent_temp,
1344     &           ds_Child,ds_Parent,nbdim)
1345      endif
1346      if ( nbdim .EQ. 4 ) then
1347         Call Agrif_Update_4D_recursive(TypeUpdate,
1348     &           tempP%var%array4,tempCextend%var%array4,
1349     &           indmin,indmax,
1350     &           pttruetabwhole,cetruetabwhole,
1351     &           s_Child_temp,s_Parent_temp,
1352     &           ds_Child,ds_Parent,nbdim)
1353      endif
1354      if ( nbdim .EQ. 5 ) then
1355         Call Agrif_Update_5D_recursive(TypeUpdate,
1356     &           tempP%var%array5,tempCextend%var%array5,
1357     &           indmin,indmax,
1358     &           pttruetabwhole,cetruetabwhole,
1359     &           s_Child_temp,s_Parent_temp,
1360     &           ds_Child,ds_Parent,nbdim)
1361      endif
1362      if ( nbdim .EQ. 6 ) then
1363         Call Agrif_Update_6D_recursive(TypeUpdate,
1364     &           tempP%var%array6,tempCextend%var%array6,
1365     &           indmin,indmax,
1366     &           pttruetabwhole,cetruetabwhole,
1367     &           s_Child_temp,s_Parent_temp,
1368     &           ds_Child,ds_Parent,nbdim)
1369      endif
1370
1371      Call Agrif_nbdim_deallocation(tempCextend%var,nbdim)
1372C      Deallocate(tempCextend%var)
1373
1374      ENDIF
1375
1376#ifdef AGRIF_MPI
1377      Call Agrif_nbdim_Get_bound_dimension(parent%var,
1378     &                              lowerbound,upperbound,nbdim)
1379
1380      Call Agrif_ChildGrid_to_ParentGrid()
1381C
1382      Call Agrif_Childbounds(nbdim,
1383     &                       lowerbound,upperbound,
1384     &                       indminglob,indmaxglob,
1385     &                       indminglob2,indmaxglob2,member)
1386C
1387      IF (member) THEN
1388      Call Agrif_GlobtoLocInd2(parentarray,
1389     &                     lowerbound,upperbound,
1390     &                     indminglob2,indmaxglob2,
1391     &                     nbdim,Agrif_Procrank,
1392     &                     member)
1393      ENDIF
1394
1395      Call Agrif_ParentGrid_to_ChildGrid()
1396
1397      if (.not.find_list_update) then
1398      tab3(:,1) = indmin(:)
1399      tab3(:,2) = indmax(:)
1400      tab3(:,3) = indminglob2(:)
1401      tab3(:,4) = indmaxglob2(:)
1402C
1403      Call MPI_ALLGATHER(tab3,4*nbdim,MPI_INTEGER,tab4,4*nbdim,
1404     &                   MPI_INTEGER,MPI_COMM_WORLD,code)
1405
1406      IF (.not.associated(tempPextend%var)) Allocate(tempPextend%var)
1407      DO k=0,Agrif_Nbprocs-1
1408       do j=1,4
1409         do i=1,nbdim
1410         tab5t(i,k,j) = tab4(i,j,k)
1411         enddo
1412       enddo
1413      enddo
1414 
1415      memberin1(1) = member
1416      CALL MPI_ALLGATHER(memberin1,1,MPI_LOGICAL,memberinall2,
1417     &                  1,MPI_LOGICAL,MPI_COMM_WORLD,code)
1418 
1419      Call Get_External_Data_first(tab5t(:,:,1),
1420     &            tab5t(:,:,2),
1421     &            tab5t(:,:,3),tab5t(:,:,4),nbdim,memberin,member,
1422     &            memberinall2,sendtoproc2,recvfromproc2,tab5t(:,:,5),
1423     & tab5t(:,:,6),tab5t(:,:,7),tab5t(:,:,8))
1424         
1425      Call Agrif_Addto_list_update(child%var%list_update,pttab,petab,
1426     &                          pttab_Child,pttab_Parent,nbdim
1427     &   ,tab4t,tab5t,memberinall,memberinall2,
1428     &   sendtoproc1,recvfromproc1,sendtoproc2,recvfromproc2) 
1429         
1430      endif
1431     
1432c      Call Get_External_Data(tempP,tempPextend,tab5t(:,:,1),
1433c     &            tab5t(:,:,2),
1434c     &            tab5t(:,:,3),tab5t(:,:,4),nbdim,memberin,member,
1435c     &            memberinall2)
1436     
1437      Call ExchangeSameLevel2(sendtoproc2,recvfromproc2,nbdim,
1438     &            tab5t(:,:,3),tab5t(:,:,4),tab5t(:,:,5),tab5t(:,:,6),
1439     &            tab5t(:,:,7),tab5t(:,:,8),member,tempP,
1440     &            tempPextend)     
1441
1442#else
1443      tempPextend%var => tempP%var
1444      parentarray(:,1,1) = indmin
1445      parentarray(:,2,1) = indmax
1446      parentarray(:,1,2) = indmin
1447      parentarray(:,2,2) = indmax
1448      member = .TRUE.
1449#endif
1450
1451C
1452C
1453C
1454C     Special values on the child grid
1455      if (Agrif_UseSpecialValueFineGrid) then
1456C
1457ccc         noraftab(1:nbdim) =
1458ccc     &    child % var % root_var % interptab(1:nbdim) .EQ. 'N'
1459C
1460#ifdef AGRIF_MPI
1461C
1462c          Allocate(childvalues% var)
1463C
1464c          Call Agrif_nbdim_allocation(childvalues%var,
1465c     &                      pttruetab,cetruetab,nbdim)
1466c          Call Agrif_nbdim_Full_VarEQvar(childvalues% var,
1467c     &                                tempC% var,
1468c     &                                nbdim)
1469c          Call Agrif_CheckMasknD(tempC,childvalues,
1470c     &                           pttruetab(1:nbdim),cetruetab(1:nbdim),
1471c     &                           pttruetab(1:nbdim),cetruetab(1:nbdim),
1472c     &                           noraftab(1:nbdim),nbdim)
1473c          Call Agrif_nbdim_deallocation(childvalues% var,nbdim)
1474c         Deallocate(childvalues % var)
1475C
1476#else
1477C
1478c          Call Agrif_nbdim_Get_bound_dimension(child%var,
1479c     &                              lowerbound,upperbound,nbdim)
1480c          Call Agrif_CheckMasknD(tempC,child,
1481c     &                           pttruetab(1:nbdim),cetruetab(1:nbdim),
1482c     &                           lowerbound,
1483c     &                           upperbound,
1484c     &                           noraftab(1:nbdim),nbdim)
1485C
1486#endif
1487C
1488      endif
1489
1490
1491C
1492C
1493C
1494C
1495C     Special values on the parent grid
1496      if (Agrif_UseSpecialValue) then
1497C
1498#ifdef AGRIF_MPI
1499C
1500c          Call GiveAgrif_SpecialValueToTab_mpi(parent%var,tempP%var,
1501c     &                 parentarray,
1502c     &                 indmin,indmax,
1503c     &                 Agrif_SpecialValue,nbdim)
1504C
1505C
1506#else
1507C
1508c          Call GiveAgrif_SpecialValueToTab(parent%var,tempP%var,
1509c     &                  indmin,indmax,
1510c     &                  Agrif_SpecialValue,nbdim)
1511C
1512#endif
1513C
1514C
1515      endif   
1516C
1517C
1518        IF (member) THEN
1519
1520          IF (present(procname)) THEN
1521            CALL Agrif_ChildGrid_to_ParentGrid()
1522            SELECT CASE(nbdim)
1523            CASE(1)
1524            CALL procname(
1525     &      tempPextend%var%array1(
1526     &                      parentarray(1,1,1):parentarray(1,2,1)),
1527     &                      parentarray(1,1,2),parentarray(1,2,2),
1528     &                                   .FALSE.,nbin,ndirin
1529     &                      )
1530            CASE(2)
1531            CALL procname(
1532     &      tempPextend%var%array2(
1533     &                      parentarray(1,1,1):parentarray(1,2,1),
1534     &                      parentarray(2,1,1):parentarray(2,2,1)),
1535     &                      parentarray(1,1,2),parentarray(1,2,2),
1536     &                      parentarray(2,1,2),parentarray(2,2,2),
1537     &                                   .FALSE.,nbin,ndirin
1538     &                      )
1539            CASE(3)
1540            CALL procname(
1541     &      tempPextend%var%array3(
1542     &                      parentarray(1,1,1):parentarray(1,2,1),
1543     &                      parentarray(2,1,1):parentarray(2,2,1),
1544     &                      parentarray(3,1,1):parentarray(3,2,1)),
1545     &                      parentarray(1,1,2),parentarray(1,2,2),
1546     &                      parentarray(2,1,2),parentarray(2,2,2),
1547     &                      parentarray(3,1,2),parentarray(3,2,2),
1548     &                                   .FALSE.,nbin,ndirin
1549     &                      )
1550            CASE(4)
1551            CALL procname(
1552     &      tempPextend%var%array4(
1553     &                      parentarray(1,1,1):parentarray(1,2,1),
1554     &                      parentarray(2,1,1):parentarray(2,2,1),
1555     &                      parentarray(3,1,1):parentarray(3,2,1),
1556     &                      parentarray(4,1,1):parentarray(4,2,1)),
1557     &                      parentarray(1,1,2),parentarray(1,2,2),
1558     &                      parentarray(2,1,2),parentarray(2,2,2),
1559     &                      parentarray(3,1,2),parentarray(3,2,2),
1560     &                      parentarray(4,1,2),parentarray(4,2,2),
1561     &                                   .FALSE.,nbin,ndirin
1562     &                      )
1563            CASE(5)
1564            CALL procname(
1565     &      tempPextend%var%array5(
1566     &                      parentarray(1,1,1):parentarray(1,2,1),
1567     &                      parentarray(2,1,1):parentarray(2,2,1),
1568     &                      parentarray(3,1,1):parentarray(3,2,1),
1569     &                      parentarray(4,1,1):parentarray(4,2,1),
1570     &                      parentarray(5,1,1):parentarray(5,2,1)),
1571     &                      parentarray(1,1,2),parentarray(1,2,2),
1572     &                      parentarray(2,1,2),parentarray(2,2,2),
1573     &                      parentarray(3,1,2),parentarray(3,2,2),
1574     &                      parentarray(4,1,2),parentarray(4,2,2),
1575     &                      parentarray(5,1,2),parentarray(5,2,2),
1576     &                                   .FALSE.,nbin,ndirin
1577     &                      )
1578            CASE(6)
1579            CALL procname(
1580     &      tempPextend%var%array6(
1581     &                      parentarray(1,1,1):parentarray(1,2,1),
1582     &                      parentarray(2,1,1):parentarray(2,2,1),
1583     &                      parentarray(3,1,1):parentarray(3,2,1),
1584     &                      parentarray(4,1,1):parentarray(4,2,1),
1585     &                      parentarray(5,1,1):parentarray(5,2,1),
1586     &                      parentarray(6,1,1):parentarray(6,2,1)),
1587     &                      parentarray(1,1,2),parentarray(1,2,2),
1588     &                      parentarray(2,1,2),parentarray(2,2,2),
1589     &                      parentarray(3,1,2),parentarray(3,2,2),
1590     &                      parentarray(4,1,2),parentarray(4,2,2),
1591     &                      parentarray(5,1,2),parentarray(5,2,2),
1592     &                      parentarray(6,1,2),parentarray(6,2,2),
1593     &                                   .FALSE.,nbin,ndirin
1594     &                      )
1595            END SELECT
1596            CALL Agrif_ParentGrid_to_ChildGrid()
1597          ELSE
1598            SELECT CASE(nbdim)
1599            CASE(1)
1600            parent%var%array1(parentarray(1,1,2):parentarray(1,2,2)) =
1601     &      tempPextend%var%array1(
1602     &                      parentarray(1,1,1):parentarray(1,2,1))
1603            CASE(2)
1604            parent%var%array2(parentarray(1,1,2):parentarray(1,2,2),
1605     &                      parentarray(2,1,2):parentarray(2,2,2)) =
1606     &      tempPextend%var%array2(
1607     &                      parentarray(1,1,1):parentarray(1,2,1),
1608     &                      parentarray(2,1,1):parentarray(2,2,1))
1609            CASE(3)
1610            parent%var%array3(parentarray(1,1,2):parentarray(1,2,2),
1611     &                      parentarray(2,1,2):parentarray(2,2,2),
1612     &                      parentarray(3,1,2):parentarray(3,2,2)) =
1613     &      tempPextend%var%array3(
1614     &                      parentarray(1,1,1):parentarray(1,2,1),
1615     &                      parentarray(2,1,1):parentarray(2,2,1),
1616     &                      parentarray(3,1,1):parentarray(3,2,1))
1617            CASE(4)
1618            parent%var%array4(parentarray(1,1,2):parentarray(1,2,2),
1619     &                      parentarray(2,1,2):parentarray(2,2,2),
1620     &                      parentarray(3,1,2):parentarray(3,2,2),
1621     &                      parentarray(4,1,2):parentarray(4,2,2)) =
1622     &      tempPextend%var%array4(
1623     &                      parentarray(1,1,1):parentarray(1,2,1),
1624     &                      parentarray(2,1,1):parentarray(2,2,1),
1625     &                      parentarray(3,1,1):parentarray(3,2,1),
1626     &                      parentarray(4,1,1):parentarray(4,2,1))
1627            CASE(5)
1628            parent%var%array5(parentarray(1,1,2):parentarray(1,2,2),
1629     &                      parentarray(2,1,2):parentarray(2,2,2),
1630     &                      parentarray(3,1,2):parentarray(3,2,2),
1631     &                      parentarray(4,1,2):parentarray(4,2,2),
1632     &                      parentarray(5,1,2):parentarray(5,2,2)) =
1633     &      tempPextend%var%array5(
1634     &                      parentarray(1,1,1):parentarray(1,2,1),
1635     &                      parentarray(2,1,1):parentarray(2,2,1),
1636     &                      parentarray(3,1,1):parentarray(3,2,1),
1637     &                      parentarray(4,1,1):parentarray(4,2,1),
1638     &                      parentarray(5,1,1):parentarray(5,2,1))
1639            CASE(6)
1640            parent%var%array6(parentarray(1,1,2):parentarray(1,2,2),
1641     &                      parentarray(2,1,2):parentarray(2,2,2),
1642     &                      parentarray(3,1,2):parentarray(3,2,2),
1643     &                      parentarray(4,1,2):parentarray(4,2,2),
1644     &                      parentarray(5,1,2):parentarray(5,2,2),
1645     &                      parentarray(6,1,2):parentarray(6,2,2)) =
1646     &      tempPextend%var%array6(
1647     &                      parentarray(1,1,1):parentarray(1,2,1),
1648     &                      parentarray(2,1,1):parentarray(2,2,1),
1649     &                      parentarray(3,1,1):parentarray(3,2,1),
1650     &                      parentarray(4,1,1):parentarray(4,2,1),
1651     &                      parentarray(5,1,1):parentarray(5,2,1),
1652     &                      parentarray(6,1,1):parentarray(6,2,1))
1653            END SELECT
1654          ENDIF
1655
1656        Call Agrif_nbdim_deallocation(tempPextend%var,nbdim)
1657       ENDIF
1658C
1659C
1660C     Deallocations
1661
1662      IF (memberin) THEN
1663#ifdef AGRIF_MPI
1664      Call Agrif_nbdim_deallocation(tempP%var,nbdim)
1665      Call Agrif_nbdim_deallocation(tempC%var,nbdim)
1666!      Deallocate(tempC % var)
1667#endif
1668!      Deallocate(tempP % var)
1669      ENDIF
1670#ifdef AGRIF_MPI
1671!      Deallocate(tempPextend%var)
1672!      IF (.Not.memberin) Deallocate(tempCextend%var)
1673#endif
1674
1675C
1676C
1677      End Subroutine Agrif_UpdatenD
1678C
1679C
1680C     **************************************************************************
1681CCC   Subroutine Agrif_Prtbounds
1682C     **************************************************************************
1683C
1684      Subroutine Agrif_Prtbounds(nbdim,indmin,indmax,s_Parent_temp,
1685     &                              s_Child_temp,s_Child,ds_Child,
1686     &                              s_Parent,ds_Parent,
1687     &                              pttruetab,cetruetab,pttab_Child,
1688     &                              pttab_Parent,
1689     &                              posvartab_child,TypeUpdate,
1690     &                              loctab_Child
1691#ifdef AGRIF_MPI
1692     &                 ,pttruetabwhole,cetruetabwhole
1693#endif
1694     &                 )
1695C
1696CCC   Description:
1697CCC   Subroutine calculating the bounds of the parent grid to be updated
1698CCC   by the child grid     
1699C
1700C
1701C     Declarations:
1702C
1703     
1704C
1705#ifdef AGRIF_MPI
1706cccccccccccccccccccccccccc#include "mpif.h"
1707#endif
1708C
1709C     Arguments
1710      INTEGER :: nbdim
1711      INTEGER,DIMENSION(nbdim) :: indmin,indmax
1712      REAL,DIMENSION(nbdim) :: s_Parent_temp,s_child_temp
1713      REAL,DIMENSION(nbdim) :: s_Child,ds_child
1714      REAL,DIMENSION(nbdim) :: s_Parent,ds_Parent
1715      INTEGER,DIMENSION(nbdim) :: pttruetab,cetruetab
1716      INTEGER,DIMENSION(nbdim) :: posvartab_child,TypeUpdate
1717      INTEGER,DIMENSION(nbdim) :: loctab_Child
1718      INTEGER,DIMENSION(nbdim) :: pttab_Child,pttab_Parent
1719C
1720C     Local variables
1721      INTEGER :: i
1722      REAL,DIMENSION(nbdim) :: dim_newmin,dim_newmax     
1723#ifdef AGRIF_MPI
1724      INTEGER,DIMENSION(nbdim)    :: pttruetabwhole,cetruetabwhole
1725      REAL :: positionmin,positionmax
1726      INTEGER :: imin,imax
1727      INTEGER :: coeffraf
1728#endif
1729C
1730C
1731      do i = 1,nbdim
1732C
1733        dim_newmin(i) = s_Child(i) + (pttruetab(i) -
1734     &                                pttab_Child(i)) * ds_Child(i)
1735C
1736        dim_newmax(i) = s_Child(i) + (cetruetab(i) - 
1737     &                                pttab_Child(i)) * ds_Child(i)
1738C     
1739        indmin(i) = pttab_Parent(i) +
1740     &        agrif_ceiling((dim_newmin(i)-s_Parent(i))/ds_Parent(i))
1741C
1742        indmax(i) = pttab_Parent(i) +
1743     &        agrif_int((dim_newmax(i)-s_Parent(i))/ds_Parent(i))
1744C
1745#ifdef AGRIF_MPI
1746        positionmin = s_Parent(i) + (indmin(i)-
1747     &                          pttab_Parent(i))*ds_Parent(i)
1748        IF (loctab_Child(i) .NE. -3) THEN
1749        IF (posvartab_child(i) == 1) THEN
1750          IF (TypeUpdate(i) .EQ. Agrif_Update_Average) THEN
1751          positionmin = positionmin - ds_Parent(i)/2.
1752          ELSE IF (TypeUpdate(i) .EQ. Agrif_Update_Full_Weighting) THEN
1753          positionmin = positionmin - (ds_Parent(i)-ds_Child(i))
1754          ENDIF
1755        ELSE
1756          IF (TypeUpdate(i).NE.Agrif_Update_Full_Weighting) THEN
1757            positionmin = positionmin - ds_Parent(i)/2.
1758          ELSE
1759          coeffraf = nint(ds_Parent(i)/ds_Child(i))
1760          if (mod(coeffraf,2) == 1) then
1761            positionmin = positionmin - (ds_Parent(i)-ds_Child(i))
1762          else
1763            positionmin = positionmin - (ds_Parent(i)-ds_Child(i))-ds_Child(i)/2.
1764          endif
1765          ENDIF
1766        ENDIF
1767        ENDIF
1768        imin = pttab_Child(i) +
1769     &        agrif_ceiling((positionmin-s_Child(i))/ds_Child(i))
1770
1771       positionmin = s_Child(i) + (imin -
1772     &                                pttab_Child(i)) * ds_Child(i)
1773
1774        pttruetabwhole(i) = imin
1775
1776        positionmax = s_Parent(i) + (indmax(i)-
1777     &                          pttab_Parent(i))*ds_Parent(i)
1778        IF (loctab_Child(i) .NE. -3) THEN
1779        IF (posvartab_child(i) == 1) THEN
1780          IF (TypeUpdate(i) .EQ. Agrif_Update_Average) THEN
1781        positionmax = positionmax  + ds_Parent(i)/2.
1782          ELSE IF (TypeUpdate(i) .EQ. Agrif_Update_Full_Weighting) THEN
1783          positionmax = positionmax  + (ds_Parent(i)-ds_Child(i))
1784          ENDIF
1785        ELSE
1786          IF (TypeUpdate(i).NE.Agrif_Update_Full_Weighting) THEN       
1787            positionmax = positionmax  + ds_Parent(i)/2.
1788          ELSE
1789          coeffraf = nint(ds_Parent(i)/ds_Child(i))
1790          if (mod(coeffraf,2) == 1) then
1791            positionmax = positionmax + (ds_Parent(i)-ds_Child(i))
1792          else
1793            positionmax = positionmax + (ds_Parent(i)-ds_Child(i)) + ds_Child(i)/2.
1794          endif
1795
1796          ENDIF       
1797        ENDIF
1798        ENDIF
1799        imax = pttab_Child(i) +
1800     &        agrif_int((positionmax-s_Child(i))/ds_Child(i))
1801
1802        positionmax = s_Child(i) + (imax -
1803     &                                pttab_Child(i)) * ds_Child(i)
1804
1805        cetruetabwhole(i) = imax
1806
1807#endif
1808C
1809        s_Parent_temp(i) = s_Parent(i) + 
1810     &                     (indmin(i) - pttab_Parent(i)) * 
1811     &                      ds_Parent(i) 
1812C     
1813        s_Child_temp(i) = dim_newmin(i)
1814
1815#ifdef AGRIF_MPI
1816        s_Child_temp(i) = positionmin
1817#endif
1818C
1819      enddo
1820C
1821      Return
1822C
1823C
1824      End Subroutine Agrif_Prtbounds
1825C
1826C
1827C
1828C
1829
1830C
1831C
1832C
1833C     ************************************************************************** 
1834CCC   Subroutine Agrif_Update_2D_Recursive 
1835C     **************************************************************************
1836C
1837      Subroutine Agrif_Update_2D_recursive(TypeUpdate,tempP,tempC,
1838     &                                     indmin,indmax,
1839     &                                     pttab_child,petab_child,
1840     &                                     s_child,s_parent,
1841     &                                     ds_child,ds_parent,nbdim)
1842C
1843CCC   Description:
1844CCC   Subroutine to update a 2D grid variable on the parent grid. 
1845CCC   It calls Agrif_Update_1D_Recursive and Agrif_UpdateBase.   
1846C
1847CC    Method:
1848C
1849C     Declarations:
1850C
1851     
1852C     
1853      INTEGER                   :: nbdim
1854      INTEGER, DIMENSION(nbdim) :: TypeUpdate            ! TYPE of update (copy or average)
1855      INTEGER, DIMENSION(nbdim) :: indmin,indmax
1856      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
1857      REAL, DIMENSION(nbdim)    :: s_child,s_parent
1858      REAL, DIMENSION(nbdim)    :: ds_child,ds_parent
1859      REAL, DIMENSION(indmin(1):indmax(1),
1860     &                indmin(2):indmax(2))           :: tempP
1861C      REAL, DIMENSION(pttab_child(1):petab_child(1),
1862C     &                pttab_child(2):petab_child(2)) :: tempC
1863     
1864      REAL, DIMENSION(:,:) :: tempC     
1865C
1866C     Local variables     
1867      REAL, DIMENSION(indmin(1):indmax(1),
1868     &                 pttab_child(2):petab_child(2)) :: tabtemp
1869      REAL, DIMENSION(indmin(2):indmax(2),
1870     &                indmin(1):indmax(1))           :: tempP_trsp
1871      REAL, DIMENSION(pttab_child(2):petab_child(2),
1872     &                 indmin(1):indmax(1)) :: tabtemp_trsp
1873      INTEGER :: i,j
1874      INTEGER :: coeffraf,locind_child_left
1875C
1876      tabtemp = 0.
1877
1878
1879      coeffraf = nint ( ds_parent(1) / ds_child(1) ) 
1880      IF((TypeUpdate(1) == AGRIF_Update_average) 
1881     &                 .AND. (coeffraf /= 1 ))THEN
1882!---CDIR NEXPAND
1883         IF(.NOT. precomputedone(1) ) Call average1Dprecompute2D
1884     &       (petab_child(2)-pttab_child(2)+1,
1885     &        indmax(1)-indmin(1)+1,
1886     &        petab_child(1)-pttab_child(1)+1,
1887     &        s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
1888!---CDIR NEXPAND
1889          Call average1Daftercompute
1890     &       (  tabtemp, tempC,
1891     &          size(tabtemp), size(tempC),
1892     &          s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
1893 
1894      ELSEIF((TypeUpdate(1) == AGRIF_Update_copy)
1895     &                 .AND. (coeffraf /= 1 ))THEN
1896!---CDIR NEXPAND
1897         IF(.NOT. precomputedone(1) ) Call copy1Dprecompute2D
1898     &       (petab_child(2)-pttab_child(2)+1,
1899     &        indmax(1)-indmin(1)+1,
1900     &        petab_child(1)-pttab_child(1)+1,
1901     &        s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
1902!---CDIR NEXPAND
1903          Call copy1Daftercompute
1904     &       (  tabtemp, tempC,
1905     &          size(tabtemp), size(tempC),
1906     &          s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
1907
1908      ELSE
1909      do j = pttab_child(nbdim),petab_child(nbdim)
1910C
1911!---CDIR NEXPAND
1912        Call Agrif_Update_1D_recursive(TypeUpdate(1:nbdim-1),   
1913     &         tabtemp(:,j),
1914     &         tempC(:,j-pttab_child(nbdim)+1),
1915     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
1916     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
1917     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
1918     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
1919C
1920      enddo
1921      ENDIF
1922      tabtemp_trsp = TRANSPOSE(tabtemp) 
1923      coeffraf = nint(ds_parent(nbdim)/ds_child(nbdim))
1924   
1925!---CDIR NEXPAND
1926      Call Agrif_Compute_nbdim_update(s_parent(nbdim),s_child(nbdim),
1927     &  ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left)
1928C
1929     
1930      tempP_trsp = 0. 
1931
1932      IF((TypeUpdate(2) == AGRIF_Update_average)
1933     &                .AND. (coeffraf /= 1 ))THEN
1934!---CDIR NEXPAND
1935         IF(.NOT. precomputedone(2) ) Call average1Dprecompute2D
1936     &      ( indmax(1)-indmin(1)+1,
1937     &        indmax(2)-indmin(2)+1,
1938     &        petab_child(2)-pttab_child(2)+1,
1939     &        s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
1940!---CDIR NEXPAND
1941          Call average1Daftercompute
1942     &       (  tempP_trsp, tabtemp_trsp,
1943     &          size(tempP_trsp), size(tabtemp_trsp),
1944     &          s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
1945
1946      ELSEIF((TypeUpdate(2) == AGRIF_Update_copy)
1947     &                .AND. (coeffraf /= 1 ))THEN
1948!---CDIR NEXPAND
1949         IF(.NOT. precomputedone(2) ) Call copy1Dprecompute2D
1950     &      ( indmax(1)-indmin(1)+1,
1951     &        indmax(2)-indmin(2)+1,
1952     &        petab_child(2)-pttab_child(2)+1,
1953     &        s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
1954!---CDIR NEXPAND
1955          Call copy1Daftercompute
1956     &       (  tempP_trsp, tabtemp_trsp,
1957     &          size(tempP_trsp), size(tabtemp_trsp),
1958     &          s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
1959
1960      ELSE
1961
1962      do i = indmin(1),indmax(1)
1963C
1964!---CDIR NEXPAND
1965        Call Agrif_UpdateBase(TypeUpdate(2),
1966     &           tempP_trsp(indmin(nbdim):indmax(nbdim),i),
1967     &          tabtemp_trsp(pttab_child(nbdim):petab_child(nbdim),i),
1968     &           indmin(nbdim),indmax(nbdim),
1969     &           pttab_child(nbdim),petab_child(nbdim),
1970     &           s_parent(nbdim),s_child(nbdim),
1971     &           ds_parent(nbdim),ds_child(nbdim),
1972     &                  coeffraf,locind_child_left)
1973C       
1974      enddo
1975     
1976      ENDIF
1977
1978      tempP = TRANSPOSE(tempP_trsp)
1979C
1980      Return
1981C
1982C
1983      End Subroutine Agrif_Update_2D_recursive
1984C
1985C
1986C
1987C     ************************************************************************** 
1988CCC   Subroutine Agrif_Update_3D_Recursive 
1989C     **************************************************************************
1990C
1991      Subroutine Agrif_Update_3D_recursive(TypeUpdate,tempP,tempC,
1992     &                                     indmin,indmax,   
1993     &                                     pttab_child,petab_child,
1994     &                                     s_child,s_parent,
1995     &                                     ds_child,ds_parent,nbdim)
1996C
1997CCC   Description:
1998CCC   Subroutine to update a 3D grid variable on the parent grid. 
1999CCC   It calls Agrif_Update_2D_Recursive and Agrif_UpdateBase.   
2000C
2001CC    Method:
2002C
2003C     Declarations:
2004C
2005     
2006C     
2007      INTEGER                   :: nbdim
2008      INTEGER, DIMENSION(nbdim) :: TypeUpdate            ! TYPE of update (copy or average)
2009      INTEGER, DIMENSION(nbdim) :: indmin,indmax
2010      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
2011      REAL, DIMENSION(nbdim)    :: s_child,s_parent
2012      REAL, DIMENSION(nbdim)    :: ds_child,ds_parent
2013      REAL, DIMENSION(indmin(1):indmax(1),
2014     &                indmin(2):indmax(2),
2015     &                indmin(3):indmax(3))           :: tempP
2016      REAL, DIMENSION(pttab_child(1):petab_child(1),
2017     &                pttab_child(2):petab_child(2),
2018     &                pttab_child(3):petab_child(3)) :: tempC
2019C
2020C     Local variables     
2021      REAL, DIMENSION(indmin(1):indmax(1),
2022     &                 indmin(2):indmax(2), 
2023     &                 pttab_child(3):petab_child(3)) :: tabtemp
2024      INTEGER :: i,j,k
2025      INTEGER :: coeffraf,locind_child_left
2026      INTEGER :: kdeb
2027C
2028C
2029      coeffraf = nint ( ds_parent(1) / ds_child(1) )
2030      IF((TypeUpdate(1) == AGRIF_Update_average)
2031     &                 .AND. (coeffraf /= 1 ))THEN
2032!---CDIR NEXPAND
2033         Call average1Dprecompute2D
2034     &       (petab_child(2)-pttab_child(2)+1,
2035     &        indmax(1)-indmin(1)+1,
2036     &        petab_child(1)-pttab_child(1)+1,
2037     &        s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
2038      precomputedone(1) = .TRUE.
2039      ELSEIF((TypeUpdate(1) == AGRIF_Update_copy)
2040     &                 .AND. (coeffraf /= 1 ))THEN
2041!---CDIR NEXPAND
2042         Call copy1Dprecompute2D
2043     &       (petab_child(2)-pttab_child(2)+1,
2044     &        indmax(1)-indmin(1)+1,
2045     &        petab_child(1)-pttab_child(1)+1,
2046     &        s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
2047      precomputedone(1) = .TRUE.
2048      ENDIF
2049
2050      coeffraf = nint ( ds_parent(2) / ds_child(2) )
2051      IF((TypeUpdate(2) == AGRIF_Update_average)
2052     &                .AND. (coeffraf /= 1 ))THEN
2053!---CDIR NEXPAND
2054         Call average1Dprecompute2D
2055     &      ( indmax(1)-indmin(1)+1,
2056     &        indmax(2)-indmin(2)+1,
2057     &        petab_child(2)-pttab_child(2)+1,
2058     &        s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
2059      precomputedone(2) = .TRUE.
2060      ELSEIF((TypeUpdate(2) == AGRIF_Update_copy)
2061     &                .AND. (coeffraf /= 1 ))THEN
2062!---CDIR NEXPAND
2063         Call copy1Dprecompute2D
2064     &      ( indmax(1)-indmin(1)+1,
2065     &        indmax(2)-indmin(2)+1,
2066     &        petab_child(2)-pttab_child(2)+1,
2067     &        s_parent(2),s_child(2),ds_parent(2),ds_child(2),2)
2068      precomputedone(2) = .TRUE.
2069      ENDIF
2070
2071
2072      do k = pttab_child(nbdim),petab_child(nbdim)
2073C
2074        Call Agrif_Update_2D_recursive(TypeUpdate(1:nbdim-1),   
2075     &         tabtemp(:,:,k),
2076     &         tempC(:,:,k),
2077     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
2078     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
2079     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
2080     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
2081C
2082      enddo
2083C
2084      precomputedone(1) = .FALSE.
2085      precomputedone(2) = .FALSE.
2086      coeffraf = nint ( ds_parent(3) / ds_child(3) )
2087
2088      Call Agrif_Compute_nbdim_update(s_parent(nbdim),s_child(nbdim),
2089     &  ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left)
2090     
2091      IF (coeffraf == 1) THEN
2092     
2093      kdeb = pttab_child(3)+locind_child_left-2
2094      do k=indmin(3),indmax(3)
2095      kdeb = kdeb + 1
2096      do j = indmin(2),indmax(2)
2097        do i = indmin(1),indmax(1)
2098        tempP(i,j,k) = tabtemp(i,j,kdeb)
2099      enddo
2100      enddo
2101      enddo
2102             
2103      ELSE
2104      tempP = 0.
2105C
2106      do j = indmin(2),indmax(2)
2107C
2108        do i = indmin(1),indmax(1)
2109C
2110          Call Agrif_UpdateBase(TypeUpdate(3),
2111     &           tempP(i,j,:),
2112     &          tabtemp(i,j,:),
2113     &           indmin(nbdim),indmax(nbdim),
2114     &           pttab_child(nbdim),petab_child(nbdim),
2115     &           s_parent(nbdim),s_child(nbdim),
2116     &           ds_parent(nbdim),ds_child(nbdim),
2117     &                  coeffraf,locind_child_left)
2118C
2119        enddo 
2120C       
2121      enddo
2122      ENDIF
2123C
2124      Return
2125C
2126C
2127      End Subroutine Agrif_Update_3D_recursive
2128C
2129C
2130C
2131C     ************************************************************************** 
2132CCC   Subroutine Agrif_Update_4D_Recursive 
2133C     **************************************************************************
2134C
2135      Subroutine Agrif_Update_4D_recursive(TypeUpdate,tempP,tempC,
2136     &                                     indmin,indmax,   
2137     &                                     pttab_child,petab_child,
2138     &                                     s_child,s_parent,
2139     &                                     ds_child,ds_parent,nbdim)
2140C
2141CCC   Description:
2142CCC   Subroutine to update a 4D grid variable on the parent grid. 
2143CCC   It calls Agrif_Update_3D_Recursive and Agrif_UpdateBase.   
2144C
2145CC    Method:
2146C
2147C     Declarations:
2148C
2149     
2150C     
2151      INTEGER                   :: nbdim
2152      INTEGER, DIMENSION(nbdim) :: TypeUpdate            ! TYPE of update (copy or average)
2153      INTEGER, DIMENSION(nbdim) :: indmin,indmax
2154      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
2155      REAL, DIMENSION(nbdim)    :: s_child,s_parent
2156      REAL, DIMENSION(nbdim)    :: ds_child,ds_parent
2157      REAL, DIMENSION(indmin(1):indmax(1),
2158     &                indmin(2):indmax(2),
2159     &                indmin(3):indmax(3),
2160     &                indmin(4):indmax(4))           :: tempP
2161      REAL, DIMENSION(pttab_child(1):petab_child(1),
2162     &                pttab_child(2):petab_child(2),
2163     &                pttab_child(3):petab_child(3),
2164     &                pttab_child(4):petab_child(4)) :: tempC
2165C
2166C     Local variables     
2167      REAL, DIMENSION(:,:,:,:), Allocatable :: tabtemp
2168      INTEGER :: i,j,k,l
2169      INTEGER :: coeffraf,locind_child_left
2170C
2171C
2172      Allocate(tabtemp(indmin(1):indmax(1),
2173     &                 indmin(2):indmax(2),
2174     &                 indmin(3):indmax(3), 
2175     &                 pttab_child(4):petab_child(4)))
2176C
2177      do l = pttab_child(nbdim),petab_child(nbdim)
2178C
2179        Call Agrif_Update_3D_recursive(TypeUpdate(1:nbdim-1),   
2180     &         tabtemp(indmin(nbdim-3):indmax(nbdim-3),
2181     &                 indmin(nbdim-2):indmax(nbdim-2),
2182     &                 indmin(nbdim-1):indmax(nbdim-1),l),
2183     &         tempC(pttab_child(nbdim-3):petab_child(nbdim-3),
2184     &               pttab_child(nbdim-2):petab_child(nbdim-2),
2185     &               pttab_child(nbdim-1):petab_child(nbdim-1),l),
2186     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
2187     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
2188     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
2189     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
2190C
2191      enddo
2192     
2193      Call Agrif_Compute_nbdim_update(s_parent(nbdim),s_child(nbdim),
2194     &  ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left)
2195C
2196      tempP = 0.
2197
2198      do k = indmin(3),indmax(3)
2199C
2200        do j = indmin(2),indmax(2)
2201C
2202          do i = indmin(1),indmax(1)
2203C
2204            Call Agrif_UpdateBase(TypeUpdate(4),
2205     &           tempP(i,j,k,indmin(nbdim):indmax(nbdim)),
2206     &          tabtemp(i,j,k,pttab_child(nbdim):petab_child(nbdim)),
2207     &           indmin(nbdim),indmax(nbdim),
2208     &           pttab_child(nbdim),petab_child(nbdim),
2209     &           s_parent(nbdim),s_child(nbdim),
2210     &           ds_parent(nbdim),ds_child(nbdim),
2211     &                  coeffraf,locind_child_left)
2212C
2213          enddo 
2214C
2215        enddo 
2216C       
2217      enddo
2218C
2219      Deallocate(tabtemp)
2220C
2221      Return
2222C
2223C
2224      End Subroutine Agrif_Update_4D_recursive
2225C
2226C
2227C
2228C     ************************************************************************** 
2229CCC   Subroutine Agrif_Update_5D_Recursive 
2230C     **************************************************************************
2231C
2232      Subroutine Agrif_Update_5D_recursive(TypeUpdate,tempP,tempC,
2233     &                                     indmin,indmax,   
2234     &                                     pttab_child,petab_child,
2235     &                                     s_child,s_parent,
2236     &                                     ds_child,ds_parent,nbdim)
2237C
2238CCC   Description:
2239CCC   Subroutine to update a 5D grid variable on the parent grid. 
2240CCC   It calls Agrif_Update_4D_Recursive and Agrif_UpdateBase.   
2241C
2242CC    Method:
2243C
2244C     Declarations:
2245C
2246     
2247C     
2248      INTEGER                   :: nbdim
2249      INTEGER, DIMENSION(nbdim) :: TypeUpdate            ! TYPE of update (copy or average)
2250      INTEGER, DIMENSION(nbdim) :: indmin,indmax
2251      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
2252      REAL, DIMENSION(nbdim)    :: s_child,s_parent
2253      REAL, DIMENSION(nbdim)    :: ds_child,ds_parent
2254      REAL, DIMENSION(indmin(1):indmax(1),
2255     &                indmin(2):indmax(2),
2256     &                indmin(3):indmax(3),
2257     &                indmin(4):indmax(4),
2258     &                indmin(5):indmax(5))           :: tempP
2259      REAL, DIMENSION(pttab_child(1):petab_child(1),
2260     &                pttab_child(2):petab_child(2),
2261     &                pttab_child(3):petab_child(3),
2262     &                pttab_child(4):petab_child(4),
2263     &                pttab_child(5):petab_child(5)) :: tempC
2264C
2265C     Local variables     
2266      REAL, DIMENSION(:,:,:,:,:), Allocatable :: tabtemp
2267      INTEGER :: i,j,k,l,m
2268      INTEGER :: coeffraf,locind_child_left
2269C
2270C
2271      Allocate(tabtemp(indmin(1):indmax(1),
2272     &                 indmin(2):indmax(2),
2273     &                 indmin(3):indmax(3),
2274     &                 indmin(4):indmax(4),   
2275     &                 pttab_child(5):petab_child(5)))
2276C
2277      do m = pttab_child(nbdim),petab_child(nbdim)
2278C
2279        Call Agrif_Update_4D_recursive(TypeUpdate(1:nbdim-1),   
2280     &         tabtemp(indmin(nbdim-4):indmax(nbdim-4),
2281     &                 indmin(nbdim-3):indmax(nbdim-3),
2282     &                 indmin(nbdim-2):indmax(nbdim-2),
2283     &                 indmin(nbdim-1):indmax(nbdim-1),m),
2284     &         tempC(pttab_child(nbdim-4):petab_child(nbdim-4),
2285     &               pttab_child(nbdim-3):petab_child(nbdim-3),
2286     &               pttab_child(nbdim-2):petab_child(nbdim-2),
2287     &               pttab_child(nbdim-1):petab_child(nbdim-1),m),
2288     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
2289     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
2290     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
2291     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
2292C
2293      enddo
2294     
2295      Call Agrif_Compute_nbdim_update(s_parent(nbdim),s_child(nbdim),
2296     &  ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left)
2297      tempP = 0.
2298C
2299      do l = indmin(4),indmax(4)
2300C
2301        do k = indmin(3),indmax(3)
2302C
2303          do j = indmin(2),indmax(2)
2304C
2305            do i = indmin(1),indmax(1)
2306C
2307              Call Agrif_UpdateBase(TypeUpdate(5),
2308     &           tempP(i,j,k,l,indmin(nbdim):indmax(nbdim)),
2309     &          tabtemp(i,j,k,l,
2310     &                   pttab_child(nbdim):petab_child(nbdim)),
2311     &           indmin(nbdim),indmax(nbdim),
2312     &           pttab_child(nbdim),petab_child(nbdim),
2313     &           s_parent(nbdim),s_child(nbdim),
2314     &           ds_parent(nbdim),ds_child(nbdim),
2315     &                  coeffraf,locind_child_left)
2316C
2317            enddo
2318C
2319          enddo 
2320C
2321        enddo 
2322C       
2323      enddo
2324C
2325      Deallocate(tabtemp)
2326C
2327      Return
2328C
2329C
2330      End Subroutine Agrif_Update_5D_recursive
2331C
2332C
2333C
2334C
2335C     ************************************************************************** 
2336CCC   Subroutine Agrif_Update_6D_Recursive 
2337C     **************************************************************************
2338C
2339      Subroutine Agrif_Update_6D_recursive(TypeUpdate,tempP,tempC,
2340     &                                     indmin,indmax,   
2341     &                                     pttab_child,petab_child,
2342     &                                     s_child,s_parent,
2343     &                                     ds_child,ds_parent,nbdim)
2344C
2345CCC   Description:
2346CCC   Subroutine to update a 6D grid variable on the parent grid. 
2347CCC   It calls Agrif_Update_5D_Recursive and Agrif_UpdateBase.   
2348C
2349CC    Method:
2350C
2351C     Declarations:
2352C
2353     
2354C     
2355      INTEGER                   :: nbdim
2356      INTEGER, DIMENSION(nbdim) :: TypeUpdate            ! TYPE of update (copy or average)
2357      INTEGER, DIMENSION(nbdim) :: indmin,indmax
2358      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
2359      REAL, DIMENSION(nbdim)    :: s_child,s_parent
2360      REAL, DIMENSION(nbdim)    :: ds_child,ds_parent
2361      REAL, DIMENSION(indmin(1):indmax(1),
2362     &                indmin(2):indmax(2),
2363     &                indmin(3):indmax(3),
2364     &                indmin(4):indmax(4),
2365     &                indmin(5):indmax(5),
2366     &                indmin(6):indmax(6))           :: tempP
2367      REAL, DIMENSION(pttab_child(1):petab_child(1),
2368     &                pttab_child(2):petab_child(2),
2369     &                pttab_child(3):petab_child(3),
2370     &                pttab_child(4):petab_child(4),
2371     &                pttab_child(5):petab_child(5),
2372     &                pttab_child(6):petab_child(6)) :: tempC
2373C
2374C     Local variables     
2375      REAL, DIMENSION(:,:,:,:,:,:), Allocatable :: tabtemp
2376      INTEGER :: i,j,k,l,m,n
2377      INTEGER :: coeffraf,locind_child_left
2378C
2379C
2380      Allocate(tabtemp(indmin(1):indmax(1),
2381     &                 indmin(2):indmax(2),
2382     &                 indmin(3):indmax(3),
2383     &                 indmin(4):indmax(4),   
2384     &                 indmin(5):indmax(5),   
2385     &                 pttab_child(6):petab_child(6)))
2386C
2387      do n = pttab_child(nbdim),petab_child(nbdim)
2388C
2389        Call Agrif_Update_5D_recursive(TypeUpdate(1:nbdim-1),   
2390     &         tabtemp(indmin(nbdim-5):indmax(nbdim-5),
2391     &                 indmin(nbdim-4):indmax(nbdim-4),
2392     &                 indmin(nbdim-3):indmax(nbdim-3),
2393     &                 indmin(nbdim-2):indmax(nbdim-2),
2394     &                 indmin(nbdim-1):indmax(nbdim-1),n),
2395     &         tempC(pttab_child(nbdim-5):petab_child(nbdim-5),
2396     &               pttab_child(nbdim-4):petab_child(nbdim-4),
2397     &               pttab_child(nbdim-3):petab_child(nbdim-3),
2398     &               pttab_child(nbdim-2):petab_child(nbdim-2),
2399     &               pttab_child(nbdim-1):petab_child(nbdim-1),n),
2400     &         indmin(1:nbdim-1),indmax(1:nbdim-1),
2401     &         pttab_child(1:nbdim-1),petab_child(1:nbdim-1),
2402     &         s_child(1:nbdim-1),s_parent(1:nbdim-1),
2403     &         ds_child(1:nbdim-1),ds_parent(1:nbdim-1),nbdim-1)
2404C
2405      enddo
2406     
2407      Call Agrif_Compute_nbdim_update(s_parent(nbdim),s_child(nbdim),
2408     &  ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left)
2409C
2410      tempP = 0.
2411
2412      do m = indmin(5),indmax(5)
2413      do l = indmin(4),indmax(4)
2414C
2415        do k = indmin(3),indmax(3)
2416C
2417          do j = indmin(2),indmax(2)
2418C
2419            do i = indmin(1),indmax(1)
2420C
2421              Call Agrif_UpdateBase(TypeUpdate(6),
2422     &           tempP(i,j,k,l,m,indmin(nbdim):indmax(nbdim)),
2423     &          tabtemp(i,j,k,l,m,
2424     &                   pttab_child(nbdim):petab_child(nbdim)),
2425     &           indmin(nbdim),indmax(nbdim),
2426     &           pttab_child(nbdim),petab_child(nbdim),
2427     &           s_parent(nbdim),s_child(nbdim),
2428     &           ds_parent(nbdim),ds_child(nbdim),
2429     &                  coeffraf,locind_child_left)
2430C
2431            enddo
2432C
2433          enddo 
2434C
2435        enddo 
2436C       
2437      enddo
2438      enddo
2439C
2440      Deallocate(tabtemp)
2441C
2442      Return
2443C
2444C
2445      End Subroutine Agrif_Update_6D_recursive
2446C
2447C
2448C
2449C     ************************************************************************** 
2450CCC   Subroutine Agrif_UpdateBase 
2451C     ************************************************************************** 
2452C 
2453      Subroutine Agrif_UpdateBase(TypeUpdate,
2454     &                            parenttab,childtab,
2455     &                            indmin,indmax,pttab_child,petab_child,
2456     &                            s_parent,s_child,ds_parent,ds_child,
2457     &                            coeffraf,locind_child_left)
2458C
2459CCC   Description:
2460CCC   Subroutine calling the updating method chosen by the user (copy, average
2461CCC   or full-weighting).   
2462C
2463CC    Method:
2464C
2465C     Declarations:
2466C
2467     
2468C
2469      INTEGER :: TypeUpdate
2470      INTEGER :: indmin,indmax
2471      INTEGER :: pttab_child,petab_child
2472      REAL,DIMENSION(indmin:indmax)           :: parenttab       
2473      REAL,DIMENSION(pttab_child:petab_child) :: childtab     
2474      REAL    :: s_parent,s_child
2475      REAL    :: ds_parent,ds_child     
2476      INTEGER :: coeffraf,locind_child_left
2477C
2478C
2479      if (TypeUpdate == AGRIF_Update_copy) then
2480C             
2481          Call agrif_copy1D
2482     &       (parenttab,childtab,
2483     &          indmax-indmin+1,petab_child-pttab_child+1,
2484     &          s_parent,s_child,ds_parent,ds_child)     
2485C
2486        elseif (TypeUpdate == AGRIF_Update_average) then
2487C           
2488          Call average1D
2489     &       (parenttab,childtab,
2490     &          indmax-indmin+1,petab_child-pttab_child+1,
2491     &          s_parent,s_child,ds_parent,ds_child) 
2492C
2493        elseif (TypeUpdate == AGRIF_Update_full_weighting) then
2494C             
2495          Call full_weighting1D
2496     &       (parenttab,childtab,
2497     &          indmax-indmin+1,petab_child-pttab_child+1,
2498     &          s_parent,s_child,ds_parent,ds_child,
2499     &          coeffraf,locind_child_left)
2500C
2501      endif
2502C
2503      Return               
2504C
2505C     
2506      End Subroutine Agrif_UpdateBase
2507C
2508C
2509
2510      Subroutine Agrif_Compute_nbdim_update(s_parent,s_child,
2511     &  ds_parent,ds_child,coeffraf,locind_child_left)
2512      real :: s_parent,s_child,ds_parent,ds_child
2513      integer :: coeffraf,locind_child_left
2514     
2515      coeffraf = nint(ds_parent/ds_child)
2516      locind_child_left = 1 + agrif_int((s_parent-s_child)/ds_child)
2517     
2518      End Subroutine Agrif_Compute_nbdim_update
2519 
2520#if defined AGRIF_MPI     
2521      Subroutine Agrif_Find_list_update(list_update,pttab,petab,
2522     &                          pttab_Child,pttab_Parent,nbdim,
2523     &     find_list_update,tab4t,tab5t,memberinall,memberinall2,
2524     &     sendtoproc1,recvfromproc1,sendtoproc2,recvfromproc2)     
2525      TYPE(Agrif_List_Interp_Loc), Pointer :: list_update
2526      INTEGER :: nbdim
2527      INTEGER,DIMENSION(nbdim)   :: pttab,petab,pttab_Child,pttab_Parent
2528      LOGICAL :: find_list_update
2529      Type(Agrif_List_Interp_loc), Pointer :: parcours
2530      INTEGER :: i
2531C
2532      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t
2533      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab5t     
2534      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: memberinall,memberinall2
2535      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc1,recvfromproc1     
2536      LOGICAL, DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc2,recvfromproc2     
2537                   
2538      find_list_update = .FALSE.
2539     
2540      parcours => list_update
2541     
2542      Find_loop :   Do While (associated(parcours))
2543        Do i=1,nbdim
2544          IF ((pttab(i) /= parcours%interp_loc%pttab(i)).OR.
2545     &        (petab(i) /= parcours%interp_loc%petab(i)).OR.
2546     &        (pttab_child(i) /= parcours%interp_loc%pttab_child(i)).OR.
2547     &        (pttab_parent(i) /= parcours%interp_loc%pttab_parent(i)))
2548     &               THEN
2549            parcours=>parcours%suiv
2550            Cycle Find_loop
2551          ENDIF
2552        EndDo
2553       
2554        tab4t = parcours%interp_loc%tab4t(1:nbdim,0:Agrif_Nbprocs-1,1:8)
2555        memberinall = parcours%interp_loc%memberinall(0:Agrif_Nbprocs-1)
2556       
2557        tab5t = parcours%interp_loc%tab5t(1:nbdim,0:Agrif_Nbprocs-1,1:8)
2558        memberinall2 = 
2559     &       parcours%interp_loc%memberinall2(0:Agrif_Nbprocs-1)
2560        sendtoproc1 = 
2561     &       parcours%interp_loc%sendtoproc1(0:Agrif_Nbprocs-1)   
2562        recvfromproc1 = 
2563     &       parcours%interp_loc%recvfromproc1(0:Agrif_Nbprocs-1)     
2564        sendtoproc2 = 
2565     &       parcours%interp_loc%sendtoproc2(0:Agrif_Nbprocs-1)   
2566        recvfromproc2 = 
2567     &       parcours%interp_loc%recvfromproc2(0:Agrif_Nbprocs-1)         
2568       
2569        find_list_update = .TRUE.   
2570        Exit Find_loop
2571      End Do Find_loop 
2572                             
2573      End Subroutine Agrif_Find_list_update 
2574     
2575      Subroutine Agrif_AddTo_list_update(list_update,pttab,petab,
2576     &                          pttab_Child,pttab_Parent,nbdim
2577     &      ,tab4t,tab5t,memberinall,memberinall2,
2578     &      sendtoproc1,recvfromproc1,sendtoproc2,recvfromproc2)
2579         
2580      TYPE(Agrif_List_Interp_Loc), Pointer :: list_update
2581      INTEGER :: nbdim
2582      INTEGER,DIMENSION(nbdim)   :: pttab,petab,pttab_Child,pttab_Parent
2583      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab4t
2584      INTEGER,DIMENSION(nbdim,0:Agrif_Nbprocs-1,8) :: tab5t     
2585      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1) :: memberinall, memberinall2
2586      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc1, recvfromproc1     
2587      LOGICAL,DIMENSION(0:Agrif_Nbprocs-1) :: sendtoproc2, recvfromproc2
2588
2589      Type(Agrif_List_Interp_loc), Pointer :: parcours
2590           
2591       Allocate(parcours)
2592      Allocate(parcours%interp_loc)
2593     
2594      parcours%interp_loc%pttab(1:nbdim) = pttab(1:nbdim)
2595      parcours%interp_loc%petab(1:nbdim) = petab(1:nbdim)
2596      parcours%interp_loc%pttab_child(1:nbdim) = pttab_child(1:nbdim)
2597      parcours%interp_loc%pttab_parent(1:nbdim) = pttab_parent(1:nbdim)
2598      Allocate(parcours%interp_loc%tab4t(nbdim,0:Agrif_Nbprocs-1,8))
2599      Allocate(parcours%interp_loc%memberinall(0:Agrif_Nbprocs-1))
2600     
2601      Allocate(parcours%interp_loc%tab5t(nbdim,0:Agrif_Nbprocs-1,8))
2602      Allocate(parcours%interp_loc%memberinall2(0:Agrif_Nbprocs-1))
2603      Allocate(parcours%interp_loc%sendtoproc1(0:Agrif_Nbprocs-1))
2604      Allocate(parcours%interp_loc%recvfromproc1(0:Agrif_Nbprocs-1))     
2605      Allocate(parcours%interp_loc%sendtoproc2(0:Agrif_Nbprocs-1))
2606      Allocate(parcours%interp_loc%recvfromproc2(0:Agrif_Nbprocs-1))           
2607           
2608      parcours%interp_loc%tab4t=tab4t   
2609      parcours%interp_loc%memberinall=memberinall
2610 
2611      parcours%interp_loc%tab5t=tab5t   
2612      parcours%interp_loc%memberinall2=memberinall2
2613      parcours%interp_loc%sendtoproc1=sendtoproc1   
2614      parcours%interp_loc%recvfromproc1=recvfromproc1     
2615      parcours%interp_loc%sendtoproc2=sendtoproc2       
2616      parcours%interp_loc%recvfromproc2=recvfromproc2     
2617           
2618      parcours%suiv => list_update
2619     
2620      list_update => parcours
2621     
2622      End Subroutine Agrif_Addto_list_update
2623#endif
2624           
2625
2626C     **************************************************************************
2627CCC   Subroutine Agrif_Update_1D_Recursive
2628C     **************************************************************************
2629C
2630      Subroutine Agrif_Update_1D_recursive(TypeUpdate,tempP,tempC,
2631     &                                     indmin,indmax,
2632     &                                     pttab_child,petab_child,
2633     &                                     s_child,s_parent,
2634     &                                     ds_child,ds_parent,nbdim)
2635C
2636CCC   Description:
2637CCC   Subroutine to update a 1D grid variable on the parent grid.
2638C
2639CC    Method:
2640C
2641C     Declarations:
2642C
2643     
2644C
2645C     Arguments
2646      INTEGER                   :: nbdim
2647      INTEGER, DIMENSION(nbdim) :: TypeUpdate            ! TYPE of update (copy or average)
2648      INTEGER, DIMENSION(nbdim) :: indmin,indmax
2649      INTEGER, DIMENSION(nbdim) :: pttab_child,petab_child
2650      REAL, DIMENSION(nbdim)    :: s_child,s_parent
2651      REAL, DIMENSION(nbdim)    :: ds_child,ds_parent
2652      REAL, DIMENSION(indmin(nbdim):indmax(nbdim))           :: tempP
2653      REAL, DIMENSION(pttab_child(nbdim):petab_child(nbdim)) :: tempC
2654      INTEGER :: coeffraf,locind_child_left
2655C
2656C
2657      Call Agrif_Compute_nbdim_update(s_parent(nbdim),s_child(nbdim),
2658     &  ds_parent(nbdim),ds_child(nbdim),coeffraf,locind_child_left)
2659     
2660      Call Agrif_UpdateBase(TypeUpdate(1),
2661     &                  tempP(indmin(nbdim):indmax(nbdim)),
2662     &                  tempC(pttab_child(nbdim):petab_child(nbdim)),
2663     &                  indmin(nbdim),indmax(nbdim),           
2664     &                  pttab_child(nbdim),petab_child(nbdim),
2665     &                  s_parent(nbdim),s_child(nbdim),
2666     &                  ds_parent(nbdim),ds_child(nbdim),
2667     &                  coeffraf,locind_child_left)
2668
2669C
2670      Return
2671C
2672C
2673      End Subroutine Agrif_Update_1D_recursive     
2674
2675      End Module Agrif_Update
Note: See TracBrowser for help on using the repository browser.