Changeset 14107 for vendors/AGRIF/dev/AGRIF_FILES

Timestamp:

2020-12-04T18:02:20+01:00 (3 years ago)

Author:

nicolasmartin

Message:

Reintegration of dev_r12970_AGRIF_CMEMS to AGRIF/dev

Location:

vendors/AGRIF/dev/AGRIF_FILES

Files:

• modarrays.F90 (modified) (19 diffs)
• modbc.F90 (modified) (3 diffs)
• modbcfunction.F90 (modified) (18 diffs)
• modcurgridfunctions.F90 (modified) (4 diffs)
• modgrids.F90 (modified) (3 diffs)
• modinterp.F90 (modified) (28 diffs)
• modinterpbasic.F90 (modified) (24 diffs)
• modlinktomodel.F90 (modified) (4 diffs)
• modmpp.F90 (modified) (8 diffs)
• modtypes.F90 (modified) (11 diffs)
• modupdate.F90 (modified) (50 diffs)
• modupdatebasic.F90 (modified) (1 diff)
• modutil.F90 (modified) (6 diffs)
• modvariables.F90 (modified) (1 diff)

vendors/AGRIF/dev/AGRIF_FILES/modarrays.F90

@@ -55 +55 @@
                                proc_id,         &
                                coords,          &
-                               lb_tab_true, ub_tab_true, memberin )
+                               lb_tab_true, ub_tab_true, memberin,  &
+                               indminglob3,indmaxglob3,check_perio)
 !---------------------------------------------------------------------------------------------------
     integer,                   intent(in)  :: nbdim         !< Number of dimensions
@@ -61 +62 @@
     integer, dimension(nbdim), intent(in)  :: ub_var        !< Local upper boundary on the current processor
     integer, dimension(nbdim), intent(in)  :: lb_tab        !< Global lower boundary of the variable
+    integer, dimension(nbdim),OPTIONAL     :: indminglob3,indmaxglob3 !< True bounds for MPI USE
     integer, dimension(nbdim), intent(in)  :: ub_tab        !< Global upper boundary of the variable
     integer,                   intent(in)  :: proc_id       !< Current processor
@@ -67 +69 @@
     integer, dimension(nbdim), intent(out) :: ub_tab_true   !< Global value of ub_var on the current processor
     logical,                   intent(out) :: memberin
+    logical,optional,          intent(in)  :: check_perio   !< check for periodicity
+    logical :: check_perio_local
 !
     integer :: i, coord_i
     integer :: lb_glob_index, ub_glob_index ! Lower and upper global indices
+    
+    if (present(check_perio)) then
+       check_perio_local=check_perio
+    else
+       check_perio_local = .FALSE.
+    endif
 !
     do i = 1, nbdim
@@ -78 +88 @@
         call Agrif_InvLoc( lb_var(i), proc_id, coord_i, lb_glob_index )
         call Agrif_InvLoc( ub_var(i), proc_id, coord_i, ub_glob_index )
+        if (agrif_debug_interp .or. agrif_debug_update) then
+        print *,'direction ',i,' lblogb ubglob = ',lb_glob_index,ub_glob_index
+        endif
+        if (check_perio_local .AND. agrif_curgrid%periodicity(i)) then
+          if (lb_tab(i)>=lb_glob_index) then
+          else if (lb_tab(i)<ub_glob_index-agrif_curgrid%periodicity_decal(i)) then
+            lb_glob_index = lb_glob_index - agrif_curgrid%periodicity_decal(i)
+            ub_glob_index = ub_glob_index - agrif_curgrid%periodicity_decal(i)
+          endif
+        endif
+        
+        if (present(indminglob3)) then
+          indminglob3(i)=lb_glob_index
+          indmaxglob3(i)=ub_glob_index
+        endif
 #else
         lb_glob_index = lb_var(i)
+        if (check_perio_local .AND. agrif_curgrid%periodicity(i)) then
+          lb_glob_index = lb_tab(i)
+        endif
         ub_glob_index = ub_var(i)
 #endif
         lb_tab_true(i) = max(lb_tab(i), lb_glob_index)
         ub_tab_true(i) = min(ub_tab(i), ub_glob_index)
+        if (agrif_debug_interp .or. agrif_debug_update) then
+        print *,'childbounds = ',i,lb_tab(i),lb_glob_index,lb_tab_true(i), &
+        ub_tab(i),ub_glob_index,ub_tab_true(i)
+        endif
     enddo
 !
@@ -93 +125 @@
         endif
     enddo
+    if (agrif_debug_interp) then
+    print *,'memberin = ',memberin
+    endif
 !---------------------------------------------------------------------------------------------------
 end subroutine Agrif_Childbounds
@@ -98 +133 @@
 !
 !===================================================================================================
-subroutine Agrif_get_var_global_bounds( var, lubglob, nbdim )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Variable),        intent(in)  :: var
+subroutine Agrif_get_var_global_bounds( var, lubglob, nbdim, pvar )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable),          intent(in)  :: var
+    type(Agrif_Variable),optional, intent(in)  :: pvar
     integer, dimension(nbdim,2), intent(out) :: lubglob
     integer,                     intent(in)  :: nbdim
@@ -112 +148 @@
 !
 #if !defined AGRIF_MPI
-    call Agrif_get_var_bounds_array(var, lubglob(:,1), lubglob(:,2), nbdim)
+    if (present(pvar)) then
+      call Agrif_get_var_bounds_array(var, lubglob(:,1), lubglob(:,2), nbdim, pvar)
+    else
+      call Agrif_get_var_bounds_array(var, lubglob(:,1), lubglob(:,2), nbdim)
+    endif
 #else
-    call Agrif_get_var_bounds_array(var, lb, ub, nbdim)
+    if (present(pvar)) then
+      call Agrif_get_var_bounds_array(var, lb, ub, nbdim, pvar)
+    else
+      call Agrif_get_var_bounds_array(var, lb, ub, nbdim)
+    endif
 
     do i = 1,nbdim
@@ -123 +167 @@
 !
     iminmaxg(1:nbdim,2) = - iminmaxg(1:nbdim,2)
-    call MPI_ALLREDUCE(iminmaxg, lubglob, 2*nbdim, MPI_INTEGER, MPI_MIN, Agrif_mpi_comm, code)
+    call MPI_ALLREDUCE(iminmaxg, lubglob, 2*nbdim, MPI_INTEGER, MPI_MIN, &
+                       Agrif_mpi_comm, code)
     lubglob(1:nbdim,2)  = - lubglob(1:nbdim,2)
 #endif
@@ -135 +180 @@
 !> Gets the lower and the upper boundaries of a variable, for one particular direction.
 !---------------------------------------------------------------------------------------------------
-subroutine Agrif_get_var_bounds ( variable, lower, upper, index )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Variable), intent(in)    :: variable   !< Variable for which we want to extract boundaries
+!  subroutine Agrif_get_var_bounds
+!
+!> Gets the lower and the upper boundaries of a variable, for one particular direction.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_get_var_bounds ( variable, lower, upper, index, pvariable )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable),           intent(in)    :: variable   !< Variable for which we want to extract boundaries
+    type(Agrif_Variable), optional, intent(in)    :: pvariable   !< parent Variable for which we want to extract boundaries
     integer,              intent(out)   :: lower      !< Lower bound
     integer,              intent(out)   :: upper      !< Upper bound
     integer,              intent(in)    :: index      !< Direction for wich we want to know the boundaries
 !
-    lower = variable % lb(index)
-    upper = variable % ub(index)
+
+
+    if (present(pvariable)) then
+     if (variable%root_var%interptab(index) == 'N') then
+        lower = pvariable%lb(index)
+        upper = pvariable%ub(index)
+      endif
+    else
+      lower = variable % lb(index)
+      upper = variable % ub(index)      
+    endif
+
 !---------------------------------------------------------------------------------------------------
 end subroutine Agrif_get_var_bounds
@@ -153 +213 @@
 !> Gets the lower and the upper boundaries of a table.
 !---------------------------------------------------------------------------------------------------
-subroutine Agrif_get_var_bounds_array ( variable, lower, upper, nbdim )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Variable),      intent(in)   :: variable   !< Variable for which we want to extract boundaries
+subroutine Agrif_get_var_bounds_array ( variable, lower, upper, nbdim, pvariable )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable),               intent(in)   :: variable   !< Variable for which we want to extract boundaries
+    type(Agrif_Variable), optional,     intent(in)   :: pvariable   !< Parent Variable for which we want to extract boundaries
     integer, dimension(nbdim), intent(out)  :: lower      !< Lower bounds array
     integer, dimension(nbdim), intent(out)  :: upper      !< Upper bounds array
     integer, intent(in)                     :: nbdim      !< Numer of dimensions of the variable
 !
+    integer :: nb
+
     lower = variable % lb(1:nbdim)
     upper = variable % ub(1:nbdim)
+
+    if (present(pvariable)) then
+        do nb=1,nbdim
+            if (variable%root_var%interptab(nb) == 'N') then
+                lower(nb) = pvariable%lb(nb)
+                upper(nb) = pvariable%ub(nb)
+            endif
+        enddo
+    endif
 !---------------------------------------------------------------------------------------------------
 end subroutine Agrif_get_var_bounds_array
@@ -659 +731 @@
         case('x')
 !
-            lb_child(n)  = root_var % point(n)
-            lb_parent(n) = root_var % point(n)
+            lb_child(n)  = child%point(n)
+            lb_parent(n) = child%parent_var%point(n)
             nb_child(n)  = Agrif_Child_Gr % nb(1)
             s_child(n)   = Agrif_Child_Gr  % Agrif_x(1)
@@ -666 +738 @@
             ds_child(n)  = Agrif_Child_Gr  % Agrif_dx(1)
             ds_parent(n) = Agrif_Parent_Gr % Agrif_dx(1)
+            ! Take into account potential difference of first points
+            s_parent(n) = s_parent(n) + (lb_parent(n)-lb_child(n))*ds_parent(n)
 !
             if ( root_var % posvar(n) == 1 ) then
@@ -677 +751 @@
         case('y')
 !
-            lb_child(n)  = root_var % point(n)
-            lb_parent(n) = root_var % point(n)
+            lb_child(n)  = child%point(n)
+            lb_parent(n) = child%parent_var%point(n)
             nb_child(n)  = Agrif_Child_Gr % nb(2)
             s_child(n)   = Agrif_Child_Gr  % Agrif_x(2)
@@ -684 +758 @@
             ds_child(n)  = Agrif_Child_Gr  % Agrif_dx(2)
             ds_parent(n) = Agrif_Parent_Gr % Agrif_dx(2)
+            ! Take into account potential difference of first points
+            s_parent(n) = s_parent(n) + (lb_parent(n)-lb_child(n))*ds_parent(n)
 !
             if (root_var % posvar(n)==1) then
@@ -695 +771 @@
         case('z')
 !
-            lb_child(n)  = root_var % point(n)
-            lb_parent(n) = root_var % point(n)
+            lb_child(n)  = child%point(n)
+            lb_parent(n) = child%parent_var%point(n)
             nb_child(n)  = Agrif_Child_Gr % nb(3)
             s_child(n)   = Agrif_Child_Gr  % Agrif_x(3)
@@ -702 +778 @@
             ds_child(n)  = Agrif_Child_Gr  % Agrif_dx(3)
             ds_parent(n) = Agrif_Parent_Gr % Agrif_dx(3)
+            ! Take into account potential difference of first points
+            s_parent(n) = s_parent(n) + (lb_parent(n)-lb_child(n))*ds_parent(n)
 !
             if (root_var % posvar(n)==1) then
@@ -781 +859 @@
 !---------------------------------------------------------------------------------------------------
 subroutine Agrif_GlobalToLocalBounds ( locbounds, lb_var, ub_var, lb_glob, ub_glob,    &
-                                       coords, nbdim, rank, member )
+                                       coords, nbdim, rank, member,check_perio )
 !---------------------------------------------------------------------------------------------------
     integer, dimension(nbdim,2,2), intent(out)   :: locbounds   !< Local values of \b lb_glob and \b ub_glob
@@ -792 +870 @@
     integer,                       intent(in)    :: rank        !< Rank of the processor
     logical,                       intent(out)   :: member
-!
-    integer     :: i, i1, k
+    logical,optional,          intent(in)  :: check_perio   !< check for periodicity
+    logical :: check_perio_local
+!
+    integer     :: i, i1, k, idecal
     integer     :: nbloc(nbdim)
+    
+    if (present(check_perio)) then
+       check_perio_local=check_perio
+    else
+       check_perio_local = .FALSE.
+    endif
+!
+
 !
     locbounds(:,1,:) =  HUGE(1)
@@ -803 +891 @@
     do i = 1,nbdim
 !
+     if (coords(i) == 0) then
+       nbloc(i) = 1
+       locbounds(i,1,1) = lb_glob(i)
+       locbounds(i,2,1) = ub_glob(i)
+       locbounds(i,1,2) = lb_glob(i)
+       locbounds(i,2,2) = ub_glob(i)
+     else
         call Agrif_InvLoc(lb_var(i), rank, coords(i), i1)
+        if ((i1>ub_glob(i)).AND.check_perio_local) then
+          idecal = agrif_curgrid%periodicity_decal(i)
+        else
+          idecal = 0
+        endif
 !
         do k = lb_glob(i)+lb_var(i)-i1,ub_glob(i)+lb_var(i)-i1
 !
-            if ( (k >= lb_var(i)) .AND. (k <= ub_var(i)) ) then
+            if ( (k + idecal >= lb_var(i)) .AND. (k + idecal <= ub_var(i)) ) then
+!            if ((k<=ub_var(i)).AND.((k>=lb_var(i).OR.check_perio_local))) then
                 nbloc(i) = 1
                 locbounds(i,1,1) = min(locbounds(i,1,1),k-lb_var(i)+i1)
                 locbounds(i,2,1) = max(locbounds(i,2,1),k-lb_var(i)+i1)
 
-                locbounds(i,1,2) = min(locbounds(i,1,2),k)
-                locbounds(i,2,2) = max(locbounds(i,2,2),k)
-            endif
-        enddo
+                locbounds(i,1,2) = min(locbounds(i,1,2),k + idecal)
+                locbounds(i,2,2) = max(locbounds(i,2,2),k + idecal)
+            endif
+        enddo
+     endif
     enddo
 

vendors/AGRIF/dev/AGRIF_FILES/modbc.F90

@@ -73 +73 @@
     Agrif_Parent_Gr => Agrif_Curgrid % parent
 !
-    loctab_child(:) = 0
+    loctab_child(1:nbdim) = 0
     posvartab_child(1:nbdim) = root_var % posvar(1:nbdim)
 !
@@ -188 +188 @@
     END WHERE
 !
-    call Agrif_get_var_global_bounds(child,lubglob,nbdim)
+    call Agrif_get_var_global_bounds(child,lubglob,nbdim,parent)
 !
     indtruetab(1:nbdim,1,1) = max(indtab(1:nbdim,1,1), lubglob(1:nbdim,1))
@@ -229 +229 @@
 !
 #if defined AGRIF_MPI
-                call Agrif_get_var_bounds_array(child,lower,upper,nbdim)
+                call Agrif_get_var_bounds_array(child,lower,upper,nbdim,parent)
 
                 do i = 1,nbdim

vendors/AGRIF/dev/AGRIF_FILES/modbcfunction.F90

@@ -53 +53 @@
 !> To set the TYPE of the variable
 !---------------------------------------------------------------------------------------------------
-subroutine Agrif_Set_parent_int(tabvarsindic,value)
-!---------------------------------------------------------------------------------------------------
-    integer, intent(in)     :: tabvarsindic !< indice of the variable in tabvars
+subroutine Agrif_Set_parent_int(integer_variable,value)
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in)     :: integer_variable !< indice of the variable in tabvars
     integer, intent(in)     :: value        !< input value
 !
-    Agrif_Curgrid % parent % tabvars_i(tabvarsindic) % iarray0 = value
+    
+integer :: i
+logical :: i_found
+
+i_found = .FALSE.
+
+do i=1,Agrif_NbVariables(4)
+  if (LOC(integer_variable) == LOC(agrif_curgrid%tabvars_i(i)%iarray0)) then
+     agrif_curgrid%tabvars_i(i)%parent_var%iarray0 = value
+     i_found = .TRUE.
+     EXIT
+  endif
+enddo
+
+if (.NOT.i_found) STOP 'Agrif_Set_Integer : Variable not found'
+
 !---------------------------------------------------------------------------------------------------
 end subroutine Agrif_Set_parent_int
@@ -66 +81 @@
 !  subroutine Agrif_Set_parent_real4
 !---------------------------------------------------------------------------------------------------
-!> To set the TYPE of the variable
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Set_parent_real4 ( tabvarsindic, value )
-!---------------------------------------------------------------------------------------------------
-    integer, intent(in)     :: tabvarsindic !< indice of the variable in tabvars
-    real(kind=4),intent(in) :: value        !< input value
-!
-    Agrif_Curgrid % parent % tabvars_r(tabvarsindic) % array0 = value
-    Agrif_Curgrid % parent % tabvars_r(tabvarsindic) % sarray0 = value
+!> To set the parent value of a real variable
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_parent_real4 ( real_variable, value )
+!---------------------------------------------------------------------------------------------------
+    real(kind=4), intent(in)     :: real_variable !< input variable
+    real(kind=4),intent(in) :: value        !< input value for the parent grid
+
+integer :: i
+logical :: i_found
+
+i_found = .FALSE.
+
+do i=1,Agrif_NbVariables(2)
+  if (LOC(real_variable) == LOC(agrif_curgrid%tabvars_r(i)%array0)) then
+     agrif_curgrid%tabvars_r(i)%parent_var%array0 = value
+     agrif_curgrid%tabvars_r(i)%parent_var%sarray0 = value
+     i_found = .TRUE.
+     EXIT
+  endif
+enddo
+
+IF (.NOT.i_found) THEN
+do i=1,Agrif_NbVariables(2)
+  if (LOC(real_variable) == LOC(agrif_curgrid%tabvars_r(i)%sarray0)) then
+     agrif_curgrid%tabvars_r(i)%parent_var%array0 = value
+     agrif_curgrid%tabvars_r(i)%parent_var%sarray0 = value
+     i_found = .TRUE.
+     EXIT
+  endif
+enddo
+ENDIF
+
+if (.NOT.i_found) STOP 'Agrif_Set_parent_real4 : Variable not found'
+
 !---------------------------------------------------------------------------------------------------
 end subroutine Agrif_Set_parent_real4
@@ -82 +122 @@
 !  subroutine Agrif_Set_parent_real8
 !---------------------------------------------------------------------------------------------------
-!> To set the TYPE of the variable
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Set_parent_real8 ( tabvarsindic, value )
-!---------------------------------------------------------------------------------------------------
-    integer, intent(in)     :: tabvarsindic !< indice of the variable in tabvars
-    real(kind=8),intent(in) :: value        !< input value
-!
-    Agrif_Curgrid % parent % tabvars_r(tabvarsindic) % darray0 = value
+!> To set the parent value of a real variable
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_parent_real8 ( real_variable, value )
+!---------------------------------------------------------------------------------------------------
+    real(kind=8), intent(in)     :: real_variable !< input variable
+    real(kind=8),intent(in) :: value        !< input value for the parent grid
+
+integer :: i
+logical :: i_found
+
+i_found = .FALSE.
+
+do i=1,Agrif_NbVariables(2)
+  if (LOC(real_variable) == LOC(agrif_curgrid%tabvars_r(i)%array0)) then
+     agrif_curgrid%tabvars_r(i)%parent_var%darray0 = value
+     agrif_curgrid%tabvars_r(i)%parent_var%array0 = value
+     i_found = .TRUE.
+     EXIT
+  endif
+enddo
+
+IF (.NOT.i_found) THEN
+do i=1,Agrif_NbVariables(2)
+  if (LOC(real_variable) == LOC(agrif_curgrid%tabvars_r(i)%darray0)) then
+     agrif_curgrid%tabvars_r(i)%parent_var%darray0 = value
+     agrif_curgrid%tabvars_r(i)%parent_var%array0 = value
+     i_found = .TRUE.
+     EXIT
+  endif
+enddo
+ENDIF
+
+if (.NOT.i_found) STOP 'Agrif_Set_parent_real8 : Variable not found'
+
 !---------------------------------------------------------------------------------------------------
 end subroutine Agrif_Set_parent_real8
@@ -106 +172 @@
     type(Agrif_Variable),  pointer  :: var
 !
-    indic = Agrif_Curgrid % tabvars_i(tabvarsindic) % iarray0
-!
-    if (indic <= 0) then
-        var => Agrif_Search_Variable(Agrif_Curgrid,-indic)
-    else
-        print*,"Agrif_Set_bc : warning indic >= 0 !!!"
-        var => Agrif_Curgrid % tabvars(indic)
-    endif
-
+    var => Agrif_Search_Variable(Agrif_Curgrid,tabvarsindic)
     if (.not.associated(var)) return ! Grand mother grid case
 !
@@ -145 +203 @@
     type(Agrif_Variable), pointer   :: var
 !
-    indic = Agrif_Curgrid % tabvars_i(tabvarsindic) % iarray0
-!
-    if (indic <= 0) then
-        var => Agrif_Search_Variable(Agrif_Mygrid,-indic)
-    else
-        print*,"Agrif_Set_interp : warning indic >= 0 !!!"
-        var => Agrif_Mygrid % tabvars(indic)
-    endif
+    var => Agrif_Search_Variable(Agrif_Curgrid,tabvarsindic)
+    if (.not.associated(var)) return ! Grand mother grid case
 !
     var % type_interp = Agrif_Constant
@@ -178 +230 @@
     TYPE(Agrif_Variable), pointer   :: var
 !
-    indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0
-!
-    if (indic <= 0) then
-        var => Agrif_Search_Variable(Agrif_Mygrid,-indic)
-    else
-        print*,"Agrif_Set_bcinterp : warning indic >= 0 !!!"
-        var => Agrif_Mygrid % tabvars(indic)
-    endif
+    var => Agrif_Search_Variable(Agrif_Curgrid,tabvarsindic)
 !
     var % type_interp_bc = Agrif_Constant
@@ -214 +259 @@
     type(Agrif_Variable),  pointer  :: root_var
 !
-    indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0
-!
-    if (indic <= 0) then
-        root_var => Agrif_Search_Variable(Agrif_Mygrid,-indic)
-    else
-        print*,"Agrif_Set_UpdateType : warning indic >= 0 !!!"
-        root_var => Agrif_Mygrid % tabvars(indic)
-    endif
+
+        root_var => Agrif_Search_Variable(Agrif_Mygrid,tabvarsindic)
+
 !
     root_var % type_update = Agrif_Update_Copy
@@ -243 +283 @@
     INTEGER :: indic  !  indice of the variable in tabvars
 !
+print *,'CURRENTLY BROKEN'
+STOP
+
     indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0
 !
@@ -283 +326 @@
     type(Agrif_Variable), pointer :: child_var
     type(Agrif_Variable), pointer :: child_tmp      ! Temporary variable on the child grid
+    integer :: i
+    integer,dimension(7) :: lb, ub
 !
     if ( Agrif_Curgrid%level <= 0 ) return
 !
-    indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0
 !
     if ( present(calledweight) ) then
@@ -296 +340 @@
     endif
 !
-    if (indic <= 0) then
-        child_var  => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+        child_var  => Agrif_Search_Variable(Agrif_Curgrid,tabvarsindic)
         parent_var => child_var % parent_var
         root_var   => child_var % root_var
-    else
-        print*,"Agrif_Bc_variable : warning indic >= 0 !!!"
-        child_var  => Agrif_Curgrid % tabvars(indic)
-        parent_var => Agrif_Curgrid % parent % tabvars(indic)
-        root_var   => Agrif_Mygrid % tabvars(indic)
-    endif
 !
     nbdim = root_var % nbdim
 !
+    do i=1,nbdim
+      if (root_var%coords(i) == 0) then
+        lb(i) = parent_var%lb(i)
+        ub(i) = parent_var%ub(i)
+      else
+        lb(i) = child_var%lb(i)
+        ub(i) = child_var%ub(i)
+      endif
+    enddo
+
     select case( nbdim )
     case(1)
-        allocate(parray1(child_var%lb(1):child_var%ub(1)))
+        allocate(parray1(lb(1):ub(1)))
     case(2)
-        allocate(parray2(child_var%lb(1):child_var%ub(1), &
-                         child_var%lb(2):child_var%ub(2) ))
+        allocate(parray2(lb(1):ub(1), &
+                         lb(2):ub(2) ))
     case(3)
-        allocate(parray3(child_var%lb(1):child_var%ub(1), &
-                         child_var%lb(2):child_var%ub(2), &
-                         child_var%lb(3):child_var%ub(3) ))
+        allocate(parray3(lb(1):ub(1), &
+                         lb(2):ub(2), &
+                         lb(3):ub(3) ))
     case(4)
-        allocate(parray4(child_var%lb(1):child_var%ub(1), &
-                         child_var%lb(2):child_var%ub(2), &
-                         child_var%lb(3):child_var%ub(3), &
-                         child_var%lb(4):child_var%ub(4) ))
+        allocate(parray4(lb(1):ub(1), &
+                         lb(2):ub(2), &
+                         lb(3):ub(3), &
+                         lb(4):ub(4) ))
     case(5)
-        allocate(parray5(child_var%lb(1):child_var%ub(1), &
-                         child_var%lb(2):child_var%ub(2), &
-                         child_var%lb(3):child_var%ub(3), &
-                         child_var%lb(4):child_var%ub(4), &
-                         child_var%lb(5):child_var%ub(5) ))
+        allocate(parray5(lb(1):ub(1), &
+                         lb(2):ub(2), &
+                         lb(3):ub(3), &
+                         lb(4):ub(4), &
+                         lb(5):ub(5) ))
     case(6)
-        allocate(parray6(child_var%lb(1):child_var%ub(1), &
-                         child_var%lb(2):child_var%ub(2), &
-                         child_var%lb(3):child_var%ub(3), &
-                         child_var%lb(4):child_var%ub(4), &
-                         child_var%lb(5):child_var%ub(5), &
-                         child_var%lb(6):child_var%ub(6) ))
+        allocate(parray6(lb(1):ub(1), &
+                         lb(2):ub(2), &
+                         lb(3):ub(3), &
+                         lb(4):ub(4), &
+                         lb(5):ub(5), &
+                         lb(6):ub(6) ))
     end select
 !
@@ -343 +390 @@
 !
     child_tmp % root_var => root_var
+    child_tmp % parent_var => parent_var
     child_tmp % oldvalues2D => child_var % oldvalues2D
 !
@@ -400 +448 @@
     type(Agrif_Variable), pointer   :: child_tmp        ! Temporary variable on the child grid
 !
+
     if ( Agrif_Curgrid%level <= 0 ) return
 !
-    indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0
-!
-    if (indic <= 0) then
-        child_var  => Agrif_Search_Variable(Agrif_Curgrid,-indic)
+
+        child_var  => Agrif_Search_Variable(Agrif_Curgrid,tabvarsindic)
         parent_var => child_var % parent_var
         root_var   => child_var % root_var
-    else
-        print*,"Agrif_Interp_variable : warning indic >= 0 !!!"
-        child_var  => Agrif_Curgrid % tabvars(indic)
-        parent_var => Agrif_Curgrid % parent % tabvars(indic)
-        root_var   => Agrif_Mygrid % tabvars(indic)
-    endif
+
 !
     nbdim     = root_var % nbdim
@@ -421 +463 @@
 !
     child_tmp % root_var => root_var
+    child_tmp % parent_var => parent_var
     child_tmp % nbdim = root_var % nbdim
     child_tmp % point = child_var % point
@@ -486 +529 @@
     if (agrif_curgrid%grand_mother_grid) return
 !
-    indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0
-!
-    if (indic <= 0) then
-        child_var  => Agrif_Search_Variable(Agrif_Curgrid, -indic)
+
+        child_var  => Agrif_Search_Variable(Agrif_Curgrid, tabvarsindic)
         parent_var => child_var % parent_var
 
         if (.not.associated(parent_var)) then
           ! can occur during the first update of Agrif_Coarsegrid (if any)
-          parent_var => Agrif_Search_Variable(Agrif_Curgrid % parent, -indic)
+          parent_var => Agrif_Search_Variable(Agrif_Curgrid % parent, tabvarsindic)
           child_var % parent_var => parent_var
         endif
 
         root_var   => child_var % root_var
-    else
-        print*,"Agrif_Update_Variable : warning indic >= 0 !!!"
-        root_var   => Agrif_Mygrid  % tabvars(indic)
-        child_var  => Agrif_Curgrid % tabvars(indic)
-        parent_var => Agrif_Curgrid % parent % tabvars(indic)
-    endif
+
 !
     nbdim = root_var % nbdim
@@ -551 +587 @@
     integer :: nbdim
 !
+print *,'CURRENTLY BROKEN'
+STOP
     root_var => Agrif_Mygrid % tabvars(tabvarsindic0)
     save_var => Agrif_Curgrid % tabvars(tabvarsindic0)
@@ -575 +613 @@
     integer                         :: indic
 !
+print *,'CURRENTLY BROKEN'
+STOP
     indic = tabvarsindic
     if (tabvarsindic >= 0) then
@@ -612 +652 @@
     integer                         :: indic
 !
+print *,'CURRENTLY BROKEN'
+STOP
+
     indic = tabvarsindic
     if (tabvarsindic >= 0) then
@@ -650 +693 @@
     integer                         :: indic
 !
+print *,'CURRENTLY BROKEN'
+STOP
     indic = tabvarsindic
     if (tabvarsindic >= 0) then

vendors/AGRIF/dev/AGRIF_FILES/modcurgridfunctions.F90

@@ -29 +29 @@
     implicit none
 !
+
+    interface Agrif_Parent
+        module procedure Agrif_Parent_Real_4,   &
+                         Agrif_Parent_Real_8,   &
+                         Agrif_Parent_Array2_Real_8,   &
+                         Agrif_Parent_Integer, &
+                         Agrif_Parent_Character, &
+                         Agrif_Parent_Logical
+    end interface
+    interface Agrif_Child
+        module procedure Agrif_Child_Logical
+    end interface
+    
 contains
 !
@@ -657 +670 @@
 end subroutine Agrif_Set_coeffreft_z
 !===================================================================================================
+!  subroutine Agrif_Set_coeffreft
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_coeffreft ( coeffref )
+!---------------------------------------------------------------------------------------------------
+    integer, intent(in) :: coeffref
+    integer :: i
+
+    if (coeffref < 0) then
+        write(*,*)'Coefficient of time raffinement should be positive'
+        stop
+    else
+        do i=1,Agrif_Probdim
+          Agrif_coeffreft(i) = coeffref
+          Agrif_Curgrid % timeref(i) = coeffref
+        enddo
+    endif
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_Set_coeffreft
+!===================================================================================================
 !
 !===================================================================================================
@@ -738 +770 @@
 end function Agrif_Level
 !===================================================================================================
+!===================================================================================================
+!  subroutine Agrif_set_periodicity
+!---------------------------------------------------------------------------------------------------
+
+subroutine Agrif_set_periodicity(i,decal)
+!---------------------------------------------------------------------------------------------------
+    integer :: i, decal
+    
+    Agrif_curgrid%periodicity(i)=.TRUE.
+    Agrif_curgrid%periodicity_decal(i)=decal
+    
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_set_periodicity
 !
 !===================================================================================================
@@ -763 +808 @@
 !===================================================================================================
 !
+
+function Agrif_Parent_Real_4(real_variable) result(real_variable_parent)
+real(KIND=4) :: real_variable
+real(KIND=4) :: real_variable_parent
+
+integer :: i
+logical :: i_found
+
+i_found = .FALSE.
+
+do i=1,Agrif_NbVariables(2)
+  if (LOC(real_variable) == LOC(agrif_curgrid%tabvars_r(i)%array0)) then
+     real_variable_parent = agrif_curgrid%tabvars_r(i)%parent_var%array0
+     i_found = .TRUE.
+     EXIT
+  endif
+enddo
+
+IF (.NOT.i_found) THEN
+do i=1,Agrif_NbVariables(2)
+  if (LOC(real_variable) == LOC(agrif_curgrid%tabvars_r(i)%sarray0)) then
+     real_variable_parent = agrif_curgrid%tabvars_r(i)%parent_var%sarray0
+     i_found = .TRUE.
+     EXIT
+  endif
+enddo
+ENDIF
+
+if (.NOT.i_found) STOP 'Agrif_Parent_Real_4 : Variable not found'
+
+end function Agrif_Parent_Real_4
+
+function Agrif_Parent_Real_8(real_variable) result(real_variable_parent)
+real(KIND=8) :: real_variable
+real(KIND=8) :: real_variable_parent
+
+integer :: i
+logical :: i_found
+
+i_found = .FALSE.
+
+do i=1,Agrif_NbVariables(2)
+  if (LOC(real_variable) == LOC(agrif_curgrid%tabvars_r(i)%array0)) then
+     real_variable_parent = agrif_curgrid%tabvars_r(i)%parent_var%array0
+     i_found = .TRUE.
+     EXIT
+  endif
+enddo
+
+IF (.NOT.i_found) THEN
+do i=1,Agrif_NbVariables(2)
+  if (LOC(real_variable) == LOC(agrif_curgrid%tabvars_r(i)%darray0)) then
+     real_variable_parent = agrif_curgrid%tabvars_r(i)%parent_var%darray0
+     i_found = .TRUE.
+     EXIT
+  endif
+enddo
+ENDIF
+
+if (.NOT.i_found) STOP 'Agrif_Parent_Real_8 : Variable not found'
+
+end function Agrif_Parent_Real_8
+
+function Agrif_Parent_Array2_Real_8(real_variable,ji,jj) result(real_variable_parent)
+real(KIND=8), DIMENSION(:,:) :: real_variable
+real(KIND=8) :: real_variable_parent
+integer :: ji,jj
+
+integer :: i
+logical :: i_found
+
+i_found = .FALSE.
+
+do i=1,Agrif_NbVariables(0)
+  if (LOC(real_variable) == LOC(agrif_curgrid%tabvars(i)%array2)) then
+     real_variable_parent = agrif_curgrid%tabvars(i)%parent_var%array2(ji,jj)
+     i_found = .TRUE.
+     EXIT
+  endif
+enddo
+
+if (.NOT.i_found) STOP 'Agrif_Parent_Array2_Real_8 : Variable not found'
+
+end function Agrif_Parent_Array2_Real_8
+
+
+function Agrif_Parent_Integer(integer_variable) result(integer_variable_parent)
+integer :: integer_variable
+integer :: integer_variable_parent
+
+integer :: i
+logical :: i_found
+
+i_found = .FALSE.
+
+do i=1,Agrif_NbVariables(4)
+  if (LOC(integer_variable) == LOC(agrif_curgrid%tabvars_i(i)%iarray0)) then
+     integer_variable_parent = agrif_curgrid%tabvars_i(i)%parent_var%iarray0
+     i_found = .TRUE.
+     EXIT
+  endif
+enddo
+
+if (.NOT.i_found) STOP 'Agrif_Parent : Variable not found'
+
+end function Agrif_Parent_Integer
+
+function Agrif_Parent_Character(character_variable) result(character_variable_parent)
+character(*) :: character_variable
+character(len(character_variable)) :: character_variable_parent
+
+integer :: i
+logical :: i_found
+
+i_found = .FALSE.
+
+do i=1,Agrif_NbVariables(1)
+  if (LOC(character_variable) == LOC(agrif_curgrid%tabvars_c(i)%carray0)) then
+     character_variable_parent = agrif_curgrid%tabvars_c(i)%parent_var%carray0
+     i_found = .TRUE.
+     EXIT
+  endif
+enddo
+
+if (.NOT.i_found) STOP 'Agrif_Parent : Variable not found'
+
+end function Agrif_Parent_Character
+
+function Agrif_Parent_Logical(logical_variable) result(logical_variable_parent)
+logical :: logical_variable
+logical :: logical_variable_parent
+
+integer :: i
+logical :: i_found
+
+i_found = .FALSE.
+
+do i=1,Agrif_NbVariables(3)
+  if (LOC(logical_variable) == LOC(agrif_curgrid%tabvars_l(i)%larray0)) then
+     logical_variable_parent = agrif_curgrid%tabvars_l(i)%parent_var%larray0
+     i_found = .TRUE.
+     EXIT
+  endif
+enddo
+
+if (.NOT.i_found) STOP 'Agrif_Parent : Variable not found'
+
+end function Agrif_Parent_Logical
+
+function Agrif_Child_Logical(logical_variable) result(logical_variable_child)
+logical :: logical_variable
+logical :: logical_variable_child
+
+integer :: i
+logical :: i_found
+
+i_found = .FALSE.
+
+do i=1,Agrif_NbVariables(3)
+  if (LOC(logical_variable) == LOC(agrif_curgrid%tabvars_l(i)%larray0)) then
+     logical_variable_child = Agrif_CurChildgrid%tabvars_l(i)%larray0
+     i_found = .TRUE.
+     EXIT
+  endif
+enddo
+
+if (.NOT.i_found) STOP 'Agrif_Child : Variable not found'
+
+end function Agrif_Child_Logical
+
+function Agrif_Irhox() result(i_val)
+integer :: i_val
+i_val = agrif_curgrid%spaceref(1)
+end function Agrif_Irhox
+
+function Agrif_Irhoy() result(i_val)
+integer :: i_val
+i_val = agrif_curgrid%spaceref(2)
+end function Agrif_Irhoy
+
+function Agrif_Irhoz() result(i_val)
+integer :: i_val
+i_val = agrif_curgrid%spaceref(3)
+end function Agrif_Irhoz
+
+function Agrif_NearCommonBorderX() result(l_val)
+logical :: l_val
+l_val = agrif_curgrid%nearRootBorder(1)
+end function Agrif_NearCommonBorderX
+
+subroutine Agrif_Set_NearCommonBorderX(l_val)
+logical,intent(in) :: l_val
+agrif_curgrid%nearRootBorder(1)=l_val
+end subroutine Agrif_Set_NearCommonBorderX
+
+function Agrif_NearCommonBorderY() result(l_val)
+logical :: l_val
+l_val = agrif_curgrid%nearRootBorder(2)
+end function Agrif_NearCommonBorderY
+
+subroutine Agrif_Set_NearCommonBorderY(l_val)
+logical,intent(in) :: l_val
+agrif_curgrid%nearRootBorder(2)=l_val
+end subroutine Agrif_Set_NearCommonBorderY
+
+function Agrif_NearCommonBorderZ() result(l_val)
+logical :: l_val
+l_val = agrif_curgrid%nearRootBorder(3)
+end function Agrif_NearCommonBorderZ
+
+subroutine Agrif_Set_NearCommonBorderZ(l_val)
+logical,intent(in) :: l_val
+agrif_curgrid%nearRootBorder(3)=l_val
+end subroutine Agrif_Set_NearCommonBorderZ
+
+function Agrif_DistantCommonBorderX() result(l_val)
+logical :: l_val
+l_val = agrif_curgrid%DistantRootBorder(1)
+end function Agrif_DistantCommonBorderX
+
+subroutine Agrif_Set_DistantCommonBorderX(l_val)
+logical,intent(in) :: l_val
+agrif_curgrid%DistantRootBorder(1)=l_val
+end subroutine Agrif_Set_DistantCommonBorderX
+
+function Agrif_DistantCommonBorderY() result(l_val)
+logical :: l_val
+l_val = agrif_curgrid%DistantRootBorder(2)
+end function Agrif_DistantCommonBorderY
+
+subroutine Agrif_Set_DistantCommonBorderY(l_val)
+logical,intent(in) :: l_val
+agrif_curgrid%DistantRootBorder(2)=l_val
+end subroutine Agrif_Set_DistantCommonBorderY
+
+function Agrif_DistantCommonBorderZ() result(l_val)
+logical :: l_val
+l_val = agrif_curgrid%DistantRootBorder(3)
+end function Agrif_DistantCommonBorderZ
+
+subroutine Agrif_Set_DistantCommonBorderZ(l_val)
+logical,intent(in) :: l_val
+agrif_curgrid%DistantRootBorder(3)=l_val
+end subroutine Agrif_Set_DistantCommonBorderZ
+
+function Agrif_Ix() result(i_val)
+integer :: i_val
+i_val = agrif_curgrid%ix(1)
+end function Agrif_Ix
+
+function Agrif_Iy() result(i_val)
+integer :: i_val
+i_val = agrif_curgrid%ix(2)
+end function Agrif_Iy
+
+function Agrif_Iz() result(i_val)
+integer :: i_val
+i_val = agrif_curgrid%ix(3)
+end function Agrif_Iz
+
+function Agrif_Get_grid_id() result(i_val)
+integer :: i_val
+i_val = agrif_curgrid % grid_id
+end function Agrif_Get_grid_id
+
+function Agrif_Get_parent_id() result(i_val)
+integer :: i_val
+i_val = agrif_curgrid % parent % grid_id
+end function Agrif_Get_parent_id
+
+function Agrif_rhox() result(r_val)
+real :: r_val
+r_val = real(agrif_curgrid%spaceref(1))
+end function Agrif_rhox
+
+function Agrif_rhoy() result(r_val)
+real :: r_val
+r_val = real(agrif_curgrid%spaceref(2))
+end function Agrif_rhoy
+
+function Agrif_rhoz() result(r_val)
+real :: r_val
+r_val = real(agrif_curgrid%spaceref(3))
+end function Agrif_rhoz
+
+function Agrif_Nb_Step() result(i_val)
+integer :: i_val
+i_val = agrif_curgrid%ngridstep
+end function Agrif_Nb_Step
+
+function Agrif_Nb_Fine_Grids() result(i_val)
+integer :: i_val
+i_val = Agrif_nbfixedgrids
+end function Agrif_Nb_Fine_Grids
+
+! Set the name of the External mapping subroutine (if needed)
+subroutine Agrif_Set_ExternalMapping(external_mapping)
+Procedure(mapping) :: external_mapping
+
+agrif_external_mapping => external_mapping
+
+end subroutine Agrif_Set_ExternalMapping
+
+! Set the name of the user linear interp function (if needed)
+subroutine Agrif_Set_external_linear_interp(external_linear_interp)
+Procedure(linear_interp) :: external_linear_interp
+
+agrif_external_linear_interp => external_linear_interp
+
+end subroutine Agrif_Set_external_linear_interp
+
+subroutine Agrif_UnSet_external_linear_interp()
+
+nullify(agrif_external_linear_interp)
+
+end subroutine Agrif_UnSet_external_linear_interp
+
 end module Agrif_CurgridFunctions

vendors/AGRIF/dev/AGRIF_FILES/modgrids.F90

@@ -47 +47 @@
     real   , dimension(3)              :: Agrif_dx  !< global space step in the x, y and z direction
     real   , dimension(3)              :: Agrif_dt  !< global time  step in the x, y and z direction
-    integer, dimension(3)              :: nb        !< number of cells in the x, y and z direction
+    integer, dimension(3)              :: nb = 1    !< number of cells in the x, y and z direction
     integer, dimension(3)              :: ix        !< minimal position in the x, y and z direction
     integer, dimension(3)              :: spaceref  !< space refinement factor in the x, y and z direction
@@ -88 +88 @@
     logical                             :: allocation_is_done = .false.
     logical                             :: grand_mother_grid = .false.
+    logical,dimension(4)                :: periodicity = .false.
+    integer,dimension(4)                :: periodicity_decal = 0
 !---------------------------------------------------------------------------------------------------
 end type Agrif_Grid
@@ -104 +106 @@
 !> Pointer to the current grid (the link is done by using the Agrif_Instance procedure (\see module Agrif_Init))
 type(Agrif_Grid) , pointer :: Agrif_Curgrid => NULL()
+
+!> Pointer to the current child grid (the link is done before calls to procname)
+type(Agrif_Grid) , pointer :: Agrif_CurChildgrid => NULL()
 !
 !===================================================================================================

vendors/AGRIF/dev/AGRIF_FILES/modinterp.F90

@@ -127 +127 @@
 !
     INTEGER                       :: i,j,k,l,m,n
+    integer :: i1,j1,k1
     INTEGER, DIMENSION(nbdim)     :: pttruetab,cetruetab
     INTEGER, DIMENSION(nbdim)     :: indmin,     indmax
@@ -132 +133 @@
 #if defined AGRIF_MPI
     INTEGER, DIMENSION(nbdim)     :: indminglob2,indmaxglob2
+    INTEGER, DIMENSION(nbdim)     :: indminglob3,indmaxglob3
+    INTEGER, DIMENSION(:,:),ALLOCATABLE :: indminglob_chunks, indmaxglob_chunks
+    INTEGER, DIMENSION(:,:),ALLOCATABLE :: indminglob2_chunks,indmaxglob2_chunks
+    INTEGER, DIMENSION(:,:),ALLOCATABLE :: indminglob3_chunks,indmaxglob3_chunks
 #endif
     LOGICAL, DIMENSION(nbdim)     :: noraftab
@@ -138 +143 @@
     INTEGER, DIMENSION(nbdim,2,2), INTENT(OUT) :: childarray
     INTEGER, DIMENSION(nbdim,2,2)              :: parentarray
+    INTEGER, DIMENSION(nbdim,2,2)              :: parentarray_decal
     LOGICAL :: member
+    LOGICAL,DIMENSION(:),ALLOCATABLE :: member_chuncks
+    INTEGER,DIMENSION(:,:),ALLOCATABLE :: decal_chunks
     LOGICAL :: find_list_interp
 !
@@ -148 +156 @@
     INTEGER, DIMENSION(nbdim,4,0:Agrif_Nbprocs-1)   :: tab4
     INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1,8)   :: tab4t
+    INTEGER, DIMENSION(nbdim,2) :: tab5
+    INTEGER, DIMENSION(nbdim,2,0:Agrif_Nbprocs-1) :: tab6
+    INTEGER, DIMENSION(nbdim,0:Agrif_Nbprocs-1,2) :: tab5t
     LOGICAL, DIMENSION(0:Agrif_Nbprocs-1)           :: memberinall
     LOGICAL, DIMENSION(0:Agrif_Nbprocs-1)           :: sendtoproc1, recvfromproc1
@@ -154 +165 @@
 !
 #endif
+! CHUNK (periodicity)
+    INTEGER :: nb_chunks
+    INTEGER :: agrif_external_switch_index
+    INTEGER, DIMENSION(2) :: test_orientation
+    !INTEGER, DIMENSION(2,nbdim,2,2) :: parentarray_chunk
+    INTEGER, DIMENSION(:,:,:,:), ALLOCATABLE :: parentarray_chunk
+    INTEGER, DIMENSION(:,:,:,:), ALLOCATABLE :: parentarray_chunk_decal
+    INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: bounds_chunks
+    logical,dimension(:),allocatable :: correction_required
 !
     type(Agrif_Variable), pointer, save :: tempC => NULL()        ! Temporary child grid variable
@@ -168 +188 @@
             pttab, petab, pttab_Child, pttab_Parent, nbdim,         &
             indmin, indmax, indminglob, indmaxglob,                 &
-            pttruetab, cetruetab, memberin                          &
+            pttruetab, cetruetab, memberin,                         &
+            parentarray_chunk,parentarray_chunk_decal,decal_chunks,  &
+            correction_required,member_chuncks,nb_chunks            &
 #if defined AGRIF_MPI
            ,indminglob2, indmaxglob2, parentarray,                  &
@@ -177 +199 @@
     if (.not.find_list_interp) then
 !
-        call Agrif_get_var_bounds_array(child, lowerbound, upperbound, nbdim)
+        call Agrif_get_var_bounds_array(child, lowerbound, upperbound, nbdim, parent)
         call Agrif_Childbounds(nbdim, lowerbound, upperbound,               &
                                pttab, petab, Agrif_Procrank, coords,        &
                                pttruetab, cetruetab, memberin)
+
+        if (agrif_debug_interp) then
+        print *,'************CHILDBOUNDS*********************************'
+#ifdef AGRIF_MPI
+         print *,'Processeur ',Agrif_Procrank
+#endif
+        print *,'memberin ',memberin
+        do i = 1 , nbdim
+        print *,'Direction ',i,' indices debut: ',pttab(i),pttruetab(i)
+        print *,'Direction ',i,' indices fin  : ',petab(i),cetruetab(i)
+        enddo
+        print *,'*********************************************'
+        endif
+
         call Agrif_Parentbounds(type_interp,nbdim,indminglob,indmaxglob,    &
                                 s_Parent_temp,s_Child_temp,                 &
@@ -188 +224 @@
                                 pttab_Child,pttab_Parent,                   &
                                 child%root_var % posvar, coords)
+
+        if (agrif_debug_interp) then
+        print *,'************PARENTBOUNDS*********************************'
+#ifdef AGRIF_MPI
+         print *,'Processeur ',Agrif_Procrank
+#endif
+        do i = 1 , nbdim
+        print *,'Direction ',i,' indices debut: ',pttab(i),indminglob(i)
+        print *,'Direction ',i,' indices fin  : ',petab(i),indmaxglob(i)
+        enddo
+
+        do i = 1 , nbdim
+        print *,'Direction ',i,' s_parent_temp: ',s_parent_temp(i)
+        print *,'Direction ',i,' s_Child_temp : ',s_Child_temp(i)
+        enddo
+        print *,'*********************************************'
+        endif
+
 #if defined AGRIF_MPI
         if (memberin) then
@@ -197 +251 @@
                                     pttab_Child,pttab_Parent,               &
                                     child%root_var % posvar, coords)
+
+        endif
+        if (agrif_debug_interp) then
+        print *,'************PARENTBOUNDSMPI*********************************'
+#ifdef AGRIF_MPI
+         print *,'Processeur ',Agrif_Procrank
+#endif
+        do i = 1 , nbdim
+        print *,'Direction ',i,' indices debut: ',pttruetab(i),indmin(i)
+        print *,'Direction ',i,' indices fin  : ',cetruetab(i),indmax(i)
+        enddo
+
+        do i = 1 , nbdim
+        print *,'Direction ',i,' s_parent_temp: ',s_parent_temp(i)
+        print *,'Direction ',i,' s_Child_temp : ',s_Child_temp(i)
+        enddo
+        print *,'*********************************************'
         endif
 
@@ -202 +273 @@
         call Agrif_get_var_bounds_array(parent,lowerbound,upperbound,nbdim)
         call Agrif_ChildGrid_to_ParentGrid()
-!
-        call Agrif_Childbounds(nbdim,lowerbound,upperbound,                 &
-                               indminglob,indmaxglob, local_proc, coords,   &
-                               indminglob2,indmaxglob2,member)
-!
-        if (member) then
-            call Agrif_GlobalToLocalBounds(parentarray,                     &
-                                           lowerbound,  upperbound,         &
-                                           indminglob2, indmaxglob2, coords,&
-                                           nbdim, local_proc, member)
+
+          parentarray(:,1,1) = indminglob
+          parentarray(:,2,1) = indmaxglob
+          parentarray(:,1,2) = indminglob
+          parentarray(:,2,2) = indmaxglob
+
+        if (associated(agrif_external_mapping)) then
+
+          call agrif_external_mapping(nbdim,child%root_var % posvar(1),child%root_var % posvar(2), &
+                                      parentarray,parentarray_chunk,correction_required,nb_chunks)
+          allocate(decal_chunks(nb_chunks,nbdim))
+          do i=1,nb_chunks
+            decal_chunks(i,:)=parentarray_chunk(i,:,1,1)-parentarray_chunk(i,:,1,2)
+          enddo
+        else
+            nb_chunks=1
+            allocate(correction_required(nb_chunks))
+            correction_required=.FALSE.
+            allocate(parentarray_chunk(nb_chunks,nbdim,2,2))
+            parentarray_chunk(1,:,:,:)=parentarray
+            allocate(decal_chunks(nb_chunks,nbdim))
+            decal_chunks=0
         endif
+        if (agrif_debug_interp) then
+        print *,'AVANT PARENTCHILDBOUNDS'
+        print *,'nombre de chunks ',nb_chunks
+        do i=1,nb_chunks
+          print *,'CHUNK Number : ',i
+          do j=1,nbdim
+           print *,'Direction ',j
+           print *,'MIN MAX (2) = ',parentarray_chunk(i,j,1,2),parentarray_chunk(i,j,2,2)
+           print *,'MIN MAX (1) = ',parentarray_chunk(i,j,1,1),parentarray_chunk(i,j,2,1)
+          enddo
+        enddo
+        print *,'APRES PARENTCHILDBOUNDS'
+        endif
+
+        allocate(indminglob_chunks(nb_chunks,nbdim))
+        allocate(indmaxglob_chunks(nb_chunks,nbdim))
+        allocate(indminglob2_chunks(nb_chunks,nbdim))
+        allocate(indmaxglob2_chunks(nb_chunks,nbdim))
+        allocate(indminglob3_chunks(nb_chunks,nbdim))
+        allocate(indmaxglob3_chunks(nb_chunks,nbdim))
+        allocate(member_chuncks(nb_chunks))
+
+        do i=1,nb_chunks
+          indminglob_chunks(i,:) = parentarray_chunk(i,:,1,2)
+          indmaxglob_chunks(i,:) = parentarray_chunk(i,:,2,2)
+        enddo
+
+        do i=1,nb_chunks
+
+              call Agrif_Childbounds(nbdim,lowerbound,upperbound,         &
+                   indminglob_chunks(i,:),indmaxglob_chunks(i,:), local_proc, coords,   &
+                   indminglob2_chunks(i,:),indmaxglob2_chunks(i,:),member_chuncks(i),   &
+                   indminglob3_chunks(i,:),indmaxglob3_chunks(i,:))
+        enddo
+!
+        ! call Agrif_Childbounds(nbdim,lowerbound,upperbound,                 &
+                               ! indminglob,indmaxglob, local_proc, coords,   &
+                               ! indminglob2,indmaxglob2,member,              &
+                               ! indminglob3,indmaxglob3,check_perio=.TRUE.)
+
+        if (agrif_debug_interp) then
+        print *,'************CHILDBOUNDSPARENTMPI*********************************'
+#ifdef AGRIF_MPI
+         print *,'Processeur ',Agrif_Procrank
+#endif
+        do j=1,nb_chunks
+        print *,'Chunk number ',j
+
+        do i = 1 , nbdim
+        print *,'Direction ',i,' indices debut: ',indminglob_chunks(j,i),indminglob2_chunks(j,i),indminglob3_chunks(j,i)
+        print *,'Direction ',i,' indices fin  : ',indmaxglob_chunks(j,i),indmaxglob2_chunks(j,i),indmaxglob3_chunks(j,i)
+        enddo
+        enddo
+        print *,'*********************************************'
+        endif
+!
+        ! if (member) then
+            ! call Agrif_GlobalToLocalBounds(parentarray,                     &
+                                           ! lowerbound,  upperbound,         &
+                                           ! indminglob2, indmaxglob2, coords,&
+                                           ! nbdim, local_proc, member,check_perio=.TRUE.)
+            ! if (agrif_debug_interp) then
+            ! do i=1,nbdim
+            ! print *,'parentarray = ',i,parentarray(i,1,1),parentarray(i,2,1), &
+                ! parentarray(i,1,2),parentarray(i,2,2)
+            ! enddo
+            ! endif
+        ! endif
+
+        allocate(parentarray_chunk_decal(nb_chunks,nbdim,2,2))
+        do j=1,nb_chunks
+        if (agrif_debug_interp) print *,'CHUNK = ',j
+        if (member_chuncks(j)) then
+            ! call Agrif_GlobalToLocalBounds(parentarray_chunk(j,:,:,:),                               &
+                                           ! lowerbound,  upperbound,                                  &
+                                           ! indminglob2_chunks(j,:), indmaxglob2_chunks(j,:), coords, &
+                                           ! nbdim, local_proc, member_chuncks(j),check_perio=.TRUE.)
+
+            call Agrif_GlobalToLocalBounds(parentarray_chunk(j,:,:,:),                               &
+                                           lowerbound,  upperbound,                                  &
+                                           indminglob2_chunks(j,:), indmaxglob2_chunks(j,:), coords, &
+                                           nbdim, local_proc, member_chuncks(j))
+
+            if (correction_required(j)) then
+                do i=1,2
+                    test_orientation(1)=agrif_external_switch_index(child%root_var % posvar(1),child%root_var % posvar(2), &
+                    parentarray_chunk(j,i,1,1),i)
+                    test_orientation(2)=agrif_external_switch_index(child%root_var % posvar(1),child%root_var % posvar(2), &
+                    parentarray_chunk(j,i,2,1),i)
+                    parentarray_chunk_decal(j,i,1,1)=minval(test_orientation)
+                    parentarray_chunk_decal(j,i,2,1)=maxval(test_orientation)
+                enddo
+                do i=3,nbdim
+                  parentarray_chunk_decal(j,i,:,1) = parentarray_chunk(j,i,:,1)+decal_chunks(j,i)
+                enddo
+            else
+            do i=1,nbdim
+            parentarray_chunk_decal(j,i,:,1) = parentarray_chunk(j,i,:,1)+decal_chunks(j,i)
+            enddo
+            endif
+
+            if (agrif_debug_interp) then
+            do i=1,nbdim
+            print *,'parentarray = ',i,parentarray_chunk(j,i,1,1),parentarray_chunk(j,i,2,1), &
+                parentarray_chunk(j,i,1,2),parentarray_chunk(j,i,2,2)
+                print *,'parentarraydecal = ',i,parentarray_chunk_decal(j,i,1,1),parentarray_chunk_decal(j,i,2,1)
+            enddo
+            endif
+        endif
+        enddo
+
+        parentarray(:,1,:)=Huge(1)
+        parentarray(:,2,:)=-Huge(1)
+        indminglob2=Huge(1)
+        indmaxglob2=-Huge(1)
+        indminglob3=Huge(1)
+        indmaxglob3=-Huge(1)
+        member = .FALSE.
+        do j=1,nb_chunks
+          if (member_chuncks(j)) then
+                           do i=1,nbdim
+             parentarray(i,1,1) = min(parentarray(i,1,1),parentarray_chunk_decal(j,i,1,1))
+             parentarray(i,1,2) = min(parentarray(i,1,2),parentarray_chunk(j,i,1,2))
+             parentarray(i,2,1) = max(parentarray(i,2,1),parentarray_chunk_decal(j,i,2,1))
+             parentarray(i,2,2) = max(parentarray(i,2,2),parentarray_chunk(j,i,2,2))
+                         enddo
+            if (correction_required(j)) then
+               if (agrif_debug_interp) then
+                  do i=1,nbdim
+                     print *,'direction ',i
+                  print *,'glob2_chuk = ',indminglob2_chunks(j,i),indmaxglob2_chunks(j,i)
+                  print *,'glob3_chuk = ',indminglob3_chunks(j,i),indmaxglob3_chunks(j,i)
+               enddo
+               endif
+                do i=1,2
+                    test_orientation(1)=agrif_external_switch_index(child%root_var % posvar(1),child%root_var % posvar(2), &
+                    indminglob2_chunks(j,i),i)
+                    test_orientation(2)=agrif_external_switch_index(child%root_var % posvar(1),child%root_var % posvar(2), &
+                    indmaxglob2_chunks(j,i),i)
+                    indminglob2(i)=min(indminglob2(i),minval(test_orientation))
+                    indmaxglob2(i)=max(indmaxglob2(i),maxval(test_orientation))
+                enddo
+
+                do i=1,2
+                    test_orientation(1)=agrif_external_switch_index(child%root_var % posvar(1),child%root_var % posvar(2), &
+                    indminglob3_chunks(j,i),i)
+                    test_orientation(2)=agrif_external_switch_index(child%root_var % posvar(1),child%root_var % posvar(2), &
+                    indmaxglob3_chunks(j,i),i)
+                    indminglob3(i)=min(indminglob3(i),minval(test_orientation))
+                    indmaxglob3(i)=max(indmaxglob3(i),maxval(test_orientation))
+                enddo
+
+                do i=3,nbdim
+             indminglob2(i)=min(indminglob2(i),indminglob2_chunks(j,i)+decal_chunks(j,i))
+             indmaxglob2(i)=max(indmaxglob2(i),indmaxglob2_chunks(j,i)+decal_chunks(j,i))
+             indminglob3(i)=min(indminglob3(i),indminglob3_chunks(j,i)+decal_chunks(j,i))
+             indmaxglob3(i)=max(indmaxglob3(i),indmaxglob3_chunks(j,i)+decal_chunks(j,i))
+                enddo
+            else
+                           do i=1,nbdim
+             indminglob2(i)=min(indminglob2(i),indminglob2_chunks(j,i)+decal_chunks(j,i))
+             indmaxglob2(i)=max(indmaxglob2(i),indmaxglob2_chunks(j,i)+decal_chunks(j,i))
+             indminglob3(i)=min(indminglob3(i),indminglob3_chunks(j,i)+decal_chunks(j,i))
+             indmaxglob3(i)=max(indmaxglob3(i),indmaxglob3_chunks(j,i)+decal_chunks(j,i))
+                         enddo
+         endif
+
+            member = .TRUE.
+          endif
+        enddo
 
         call Agrif_ParentGrid_to_ChildGrid()
+
+        if (agrif_debug_interp) then
+        print *,'************ FINAL PARENTARRAY *****************'
+#ifdef AGRIF_MPI
+        print *,'Processeur ',Agrif_Procrank,' MEMBER = ',member
+        do i=1,nbdim
+         print *,'Direction ',i,' indices debut = ',parentarray(i,1,1),parentarray(i,1,2)
+         print *,'Direction ',i,' indices fin = ',parentarray(i,2,1),parentarray(i,2,2)
+        enddo
+#endif
+        endif
+
+        if (agrif_debug_interp) then
+        print *,'************ FINAL INDMINGLOB *****************'
+#ifdef AGRIF_MPI
+        print *,'Processeur ',Agrif_Procrank,' MEMBER = ',member
+        do i=1,nbdim
+         print *,'Direction ',i,' indices debut = ',indminglob2(i),indminglob3(i)
+         print *,'Direction ',i,' indices fin = ',indmaxglob2(i),indmaxglob3(i)
+        enddo
+#endif
+        endif
+
 #else
         parentarray(:,1,1) = indminglob
@@ -220 +496 @@
         parentarray(:,1,2) = indminglob
         parentarray(:,2,2) = indmaxglob
+
+
+        if (associated(agrif_external_mapping)) then
+          call Agrif_ChildGrid_to_ParentGrid()
+          call agrif_external_mapping(nbdim,child%root_var % posvar(1),child%root_var % posvar(2), &
+                                      parentarray,parentarray_chunk,correction_required,nb_chunks)
+          call Agrif_ParentGrid_to_ChildGrid()
+          allocate(decal_chunks(nb_chunks,nbdim))
+          do i=1,nb_chunks
+            decal_chunks(i,:)=parentarray_chunk(i,:,1,1)-parentarray_chunk(i,:,1,2)
+          enddo
+        else
+            nb_chunks=1
+            allocate(correction_required(nb_chunks))
+            correction_required=.FALSE.
+            allocate(parentarray_chunk(nb_chunks,nbdim,2,2))
+            parentarray_chunk(1,:,:,:)=parentarray
+        endif
+        if (agrif_debug_interp) then
+        print *,'AVANT PARENTCHILDBOUNDS'
+        print *,'nombre de chunks ',nb_chunks
+        do i=1,nb_chunks
+          print *,'CHUNK Number : ',i
+          do j=1,nbdim
+           print *,'Direction ',j
+           print *,'MIN MAX (2) = ',parentarray_chunk(i,j,1,2),parentarray_chunk(i,j,2,2)
+           print *,'MIN MAX (1) = ',parentarray_chunk(i,j,1,1),parentarray_chunk(i,j,2,1)
+          enddo
+        enddo
+        print *,'APRES PARENTCHILDBOUNDS'
+        endif
+        allocate(member_chuncks(nb_chunks))
+        allocate(parentarray_chunk_decal(nb_chunks,nbdim,2,2))
+        member_chuncks = .TRUE.
+        member = .TRUE.
+        do j=1,nb_chunks
+        if (agrif_debug_interp) print *,'CHUNK = ',j
+        if (member_chuncks(j)) then
+            do i=1,nbdim
+            parentarray_chunk_decal(j,i,:,1) = parentarray_chunk(j,i,:,1)   !+decal_chunks(j,i)
+            if (agrif_debug_interp) then
+                print *,'ENCORE = ',parentarray_chunk(j,i,:,1),parentarray_chunk_decal(j,i,:,1)
+            endif
+            enddo
+            if (agrif_debug_interp) then
+            do i=1,nbdim
+            print *,'parentarray = ',i,parentarray_chunk(j,i,1,1),parentarray_chunk(j,i,2,1), &
+                parentarray_chunk(j,i,1,2),parentarray_chunk(j,i,2,2)
+                print *,'parentarraydecal = ',i,parentarray_chunk_decal(j,i,1,1),parentarray_chunk_decal(j,i,2,1)
+            enddo
+            endif
+        endif
+        enddo
+
+
         indmin = indminglob
         indmax = indmaxglob
         member = .TRUE.
 #endif
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+! Correct for non refined directions
+!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!!
+        do i=1,nbdim
+          if (coords(i) == 0) then
+             indmin(i) = indminglob(i)
+             indmax(i) = indmaxglob(i)
+             pttruetab(i) = indminglob(i)
+             cetruetab(i) = indmaxglob(i)
+          endif
+        enddo
 
     else
@@ -241 +583 @@
         s_Child_temp  = s_Child + (pttab - pttab_Child) * ds_Child
 #endif
+
     endif
+
+        if (agrif_debug_interp) then
+        print *,'************SPARENTCHILD*********************************'
+#ifdef AGRIF_MPI
+         print *,'Processeur ',Agrif_Procrank
+#endif
+        do i = 1 , nbdim
+        print *,'Direction ',i,' s_Parent_temp : ',s_Parent_temp(i),indmin(i)
+        print *,'Direction ',i,' s_Child_temp  : ',s_Child_temp(i),pttruetab(i)
+        enddo
+        print *,'*********************************************'
+        endif
+
+    call Agrif_get_var_bounds_array(parent,lowerbound,upperbound,nbdim)
 !
     if (member) then
@@ -248 +605 @@
         call Agrif_array_allocate(tempP,parentarray(:,1,1),parentarray(:,2,1),nbdim)
         call Agrif_var_set_array_tozero(tempP,nbdim)
-
-        call Agrif_ChildGrid_to_ParentGrid()
-!
+    endif
+    Agrif_CurChildgrid=>Agrif_Curgrid
+    call Agrif_ChildGrid_to_ParentGrid()
+    do i=1,nb_chunks
+    if (agrif_debug_interp) then
+    print *,'PROCNAME POUR CHUCNK ',i
+    endif
+
+    if (member_chuncks(i)) then
         select case (nbdim)
         case(1)
-            call procname(tempP%array1,                         &
-                      parentarray(1,1,2),parentarray(1,2,2),.TRUE.,nb,ndir)
+            ! call procname(tempP%array1,                         &
+            !           parentarray(1,1,2),parentarray(1,2,2),.TRUE.,nb,ndir)
+
+            call procname(tempP%array1(parentarray_chunk_decal(i,1,1,1):parentarray_chunk_decal(i,1,2,1)),         &
+                      parentarray_chunk(i,1,1,2),parentarray_chunk(i,1,2,2),.TRUE.,nb,ndir)
+
         case(2)
-            call procname(tempP%array2,                         &
-                      parentarray(1,1,2),parentarray(1,2,2),    &
-                      parentarray(2,1,2),parentarray(2,2,2),.TRUE.,nb,ndir)
+            ! call procname(tempP%array2,                         &
+                      ! parentarray(1,1,2),parentarray(1,2,2),    &
+                      ! parentarray(2,1,2),parentarray(2,2,2),.TRUE.,nb,ndir)
+
+            call procname(tempP%array2(parentarray_chunk_decal(i,1,1,1):parentarray_chunk_decal(i,1,2,1), &
+                      parentarray_chunk_decal(i,2,1,1):parentarray_chunk_decal(i,2,2,1)),         &
+                      parentarray_chunk(i,1,1,2),parentarray_chunk(i,1,2,2),    &
+                      parentarray_chunk(i,2,1,2),parentarray_chunk(i,2,2,2),.TRUE.,nb,ndir)
+            if (agrif_debug_interp) print *,'SORTIE DE PROCNAME'
+            if (correction_required(i)) then
+             call correct_field(tempP%array2(parentarray_chunk_decal(i,1,1,1):parentarray_chunk_decal(i,1,2,1), &
+                      parentarray_chunk_decal(i,2,1,1):parentarray_chunk_decal(i,2,2,1)), &
+                      parentarray_chunk_decal(i,1,1,1),parentarray_chunk_decal(i,1,2,1), &
+                      parentarray_chunk_decal(i,2,1,1),parentarray_chunk_decal(i,2,2,1))
+            endif
+
         case(3)
-            call procname(tempP%array3,                         &
-                      parentarray(1,1,2),parentarray(1,2,2),    &
-                      parentarray(2,1,2),parentarray(2,2,2),    &
-                      parentarray(3,1,2),parentarray(3,2,2),.TRUE.,nb,ndir)
+            call procname(tempP%array3(parentarray_chunk_decal(i,1,1,1):parentarray_chunk_decal(i,1,2,1), &
+                      parentarray_chunk_decal(i,2,1,1):parentarray_chunk_decal(i,2,2,1), &
+                      parentarray_chunk_decal(i,3,1,1):parentarray_chunk_decal(i,3,2,1)),                 &
+                      parentarray_chunk(i,1,1,2),parentarray_chunk(i,1,2,2),    &
+                      parentarray_chunk(i,2,1,2),parentarray_chunk(i,2,2,2),    &
+                      parentarray_chunk(i,3,1,2),parentarray_chunk(i,3,2,2),.TRUE.,nb,ndir)
+
+            if (agrif_debug_interp) then
+                print *,'CHUNK = ',i
+                print *,'NBNDIR = ',nb,ndir,correction_required(i)
+                print *,'TEMPARRAY3 INDEX LOCAUX PUIS GLOBAUX'
+                print *,parentarray_chunk_decal(i,1,1,1),parentarray_chunk_decal(i,1,2,1)
+                print *,parentarray_chunk_decal(i,2,1,1),parentarray_chunk_decal(i,2,2,1)
+                print *,parentarray_chunk_decal(i,3,1,1),parentarray_chunk_decal(i,3,2,1)
+                print *,parentarray_chunk(i,1,1,2),parentarray_chunk(i,1,2,2)
+                print *,parentarray_chunk(i,2,1,2),parentarray_chunk(i,2,2,2)
+                print *,parentarray_chunk(i,3,1,2),parentarray_chunk(i,3,2,2)
+                do j1=parentarray_chunk_decal(i,2,1,1),parentarray_chunk_decal(i,2,2,1)
+                    do i1=parentarray_chunk_decal(i,1,1,1),parentarray_chunk_decal(i,1,2,1)
+                        print *,'valprocname = ',i1,j1,tempP%array3(i1,j1,1)
+                    enddo
+                enddo
+            endif
+            if (correction_required(i)) then
+                do k=parentarray_chunk(i,3,1,2),parentarray_chunk(i,3,2,2)
+             call correct_field(tempP%array3(parentarray_chunk_decal(i,1,1,1):parentarray_chunk_decal(i,1,2,1), &
+                      parentarray_chunk_decal(i,2,1,1):parentarray_chunk_decal(i,2,2,1),k), &
+                      parentarray_chunk_decal(i,1,1,1),parentarray_chunk_decal(i,1,2,1), &
+                      parentarray_chunk_decal(i,2,1,1),parentarray_chunk_decal(i,2,2,1))
+                enddo
+            if (agrif_debug_interp) then
+                do j1=parentarray_chunk_decal(i,2,1,1),parentarray_chunk_decal(i,2,2,1)
+                    do i1=parentarray_chunk_decal(i,1,1,1),parentarray_chunk_decal(i,1,2,1)
+                        print *,'valprocname apres correction = ',i1,j1,tempP%array3(i1,j1,1)
+                    enddo
+                enddo
+            endif
+            endif
+
+            ! call procname(tempP%array3,                         &
+                      ! parentarray_chunk(i,1,1,2),parentarray_chunk(i,1,2,2),    &
+                      ! parentarray_chunk(i,2,1,2),parentarray_chunk(i,2,2,2),    &
+                      ! parentarray_chunk(i,3,1,2),parentarray_chunk(i,3,2,2),.TRUE.,nb,ndir)
         case(4)
-            call procname(tempP%array4,                         &
-                      parentarray(1,1,2),parentarray(1,2,2),    &
-                      parentarray(2,1,2),parentarray(2,2,2),    &
-                      parentarray(3,1,2),parentarray(3,2,2),    &
-                      parentarray(4,1,2),parentarray(4,2,2),.TRUE.,nb,ndir)
+
+            call procname(tempP%array4(parentarray_chunk_decal(i,1,1,1):parentarray_chunk_decal(i,1,2,1), &
+                      parentarray_chunk_decal(i,2,1,1):parentarray_chunk_decal(i,2,2,1), &
+                      parentarray_chunk_decal(i,3,1,1):parentarray_chunk_decal(i,3,2,1), &
+                      parentarray_chunk_decal(i,4,1,1):parentarray_chunk_decal(i,4,2,1)),                 &
+                      parentarray_chunk(i,1,1,2),parentarray_chunk(i,1,2,2),    &
+                      parentarray_chunk(i,2,1,2),parentarray_chunk(i,2,2,2),    &
+                      parentarray_chunk(i,3,1,2),parentarray_chunk(i,3,2,2),    &
+                      parentarray_chunk(i,4,1,2),parentarray_chunk(i,4,2,2),.TRUE.,nb,ndir)
+
+            if (correction_required(i)) then
+                do l=parentarray_chunk(i,4,1,2),parentarray_chunk(i,4,2,2)
+                do k=parentarray_chunk(i,3,1,2),parentarray_chunk(i,3,2,2)
+             call correct_field(tempP%array4(parentarray_chunk_decal(i,1,1,1):parentarray_chunk_decal(i,1,2,1), &
+                      parentarray_chunk_decal(i,2,1,1):parentarray_chunk_decal(i,2,2,1),k,l), &
+                      parentarray_chunk_decal(i,1,1,1),parentarray_chunk_decal(i,1,2,1), &
+                      parentarray_chunk_decal(i,2,1,1),parentarray_chunk_decal(i,2,2,1))
+                enddo
+            enddo
+            endif
+
+            ! call procname(tempP%array4,                         &
+            !           parentarray(1,1,2),parentarray(1,2,2),    &
+            !           parentarray(2,1,2),parentarray(2,2,2),    &
+            !           parentarray(3,1,2),parentarray(3,2,2),    &
+            !           parentarray(4,1,2),parentarray(4,2,2),.TRUE.,nb,ndir)
         case(5)
-            call procname(tempP%array5,                         &
-                      parentarray(1,1,2),parentarray(1,2,2),    &
-                      parentarray(2,1,2),parentarray(2,2,2),    &
-                      parentarray(3,1,2),parentarray(3,2,2),    &
-                      parentarray(4,1,2),parentarray(4,2,2),    &
-                      parentarray(5,1,2),parentarray(5,2,2),.TRUE.,nb,ndir)
+
+            call procname(tempP%array5(parentarray_chunk_decal(i,1,1,1):parentarray_chunk_decal(i,1,2,1), &
+                      parentarray_chunk_decal(i,2,1,1):parentarray_chunk_decal(i,2,2,1), &
+                      parentarray_chunk_decal(i,3,1,1):parentarray_chunk_decal(i,3,2,1), &
+                      parentarray_chunk_decal(i,4,1,1):parentarray_chunk_decal(i,4,2,1), &
+                      parentarray_chunk_decal(i,5,1,1):parentarray_chunk_decal(i,5,2,1)),                 &
+                      parentarray_chunk(i,1,1,2),parentarray_chunk(i,1,2,2),    &
+                      parentarray_chunk(i,2,1,2),parentarray_chunk(i,2,2,2),    &
+                      parentarray_chunk(i,3,1,2),parentarray_chunk(i,3,2,2),    &
+                      parentarray_chunk(i,4,1,2),parentarray_chunk(i,4,2,2),    &
+                      parentarray_chunk(i,5,1,2),parentarray_chunk(i,5,2,2),.TRUE.,nb,ndir)
+
+            if (correction_required(i)) then
+                do m=parentarray_chunk(i,5,1,2),parentarray_chunk(i,5,2,2)
+                do l=parentarray_chunk(i,4,1,2),parentarray_chunk(i,4,2,2)
+                do k=parentarray_chunk(i,3,1,2),parentarray_chunk(i,3,2,2)
+             call correct_field(tempP%array5(parentarray_chunk_decal(i,1,1,1):parentarray_chunk_decal(i,1,2,1), &
+                      parentarray_chunk_decal(i,2,1,1):parentarray_chunk_decal(i,2,2,1),k,l,m), &
+                      parentarray_chunk_decal(i,1,1,1),parentarray_chunk_decal(i,1,2,1), &
+                      parentarray_chunk_decal(i,2,1,1),parentarray_chunk_decal(i,2,2,1))
+                enddo
+            enddo
+            enddo
+            endif
+
+            ! call procname(tempP%array5,                         &
+            !           parentarray(1,1,2),parentarray(1,2,2),    &
+            !           parentarray(2,1,2),parentarray(2,2,2),    &
+            !           parentarray(3,1,2),parentarray(3,2,2),    &
+            !           parentarray(4,1,2),parentarray(4,2,2),    &
+            !           parentarray(5,1,2),parentarray(5,2,2),.TRUE.,nb,ndir)
         case(6)
-            call procname(tempP%array6,                         &
-                      parentarray(1,1,2),parentarray(1,2,2),    &
-                      parentarray(2,1,2),parentarray(2,2,2),    &
-                      parentarray(3,1,2),parentarray(3,2,2),    &
-                      parentarray(4,1,2),parentarray(4,2,2),    &
-                      parentarray(5,1,2),parentarray(5,2,2),    &
-                      parentarray(6,1,2),parentarray(6,2,2),.TRUE.,nb,ndir)
+
+            call procname(tempP%array6(parentarray_chunk_decal(i,1,1,1):parentarray_chunk_decal(i,1,2,1), &
+                      parentarray_chunk_decal(i,2,1,1):parentarray_chunk_decal(i,2,2,1), &
+                      parentarray_chunk_decal(i,3,1,1):parentarray_chunk_decal(i,3,2,1), &
+                      parentarray_chunk_decal(i,4,1,1):parentarray_chunk_decal(i,4,2,1), &
+                      parentarray_chunk_decal(i,5,1,1):parentarray_chunk_decal(i,5,2,1), &
+                      parentarray_chunk_decal(i,6,1,1):parentarray_chunk_decal(i,6,2,1)),                 &
+                      parentarray_chunk(i,1,1,2),parentarray_chunk(i,1,2,2),    &
+                      parentarray_chunk(i,2,1,2),parentarray_chunk(i,2,2,2),    &
+                      parentarray_chunk(i,3,1,2),parentarray_chunk(i,3,2,2),    &
+                      parentarray_chunk(i,4,1,2),parentarray_chunk(i,4,2,2),    &
+                      parentarray_chunk(i,5,1,2),parentarray_chunk(i,5,2,2),    &
+                      parentarray_chunk(i,6,1,2),parentarray_chunk(i,6,2,2),.TRUE.,nb,ndir)
+
+            ! call procname(tempP%array6,                         &
+            !           parentarray(1,1,2),parentarray(1,2,2),    &
+            !           parentarray(2,1,2),parentarray(2,2,2),    &
+            !           parentarray(3,1,2),parentarray(3,2,2),    &
+            !           parentarray(4,1,2),parentarray(4,2,2),    &
+            !           parentarray(5,1,2),parentarray(5,2,2),    &
+            !           parentarray(6,1,2),parentarray(6,2,2),.TRUE.,nb,ndir)
         end select
 !
-        call Agrif_ParentGrid_to_ChildGrid()
 !
     endif
+    enddo
+    call Agrif_ParentGrid_to_ChildGrid()
+    nullify(Agrif_CurChildgrid)
 
 #if defined AGRIF_MPI
@@ -298 +779 @@
         tab3(:,3) = indmin(:)
         tab3(:,4) = indmax(:)
+        tab5(:,1) = indminglob3(:)
+        tab5(:,2) = indmaxglob3(:)
+        if (agrif_debug_interp) then
+         print *,'********************'
+         print *,'MPI VARIABLES'
+         print *,'INDMINGLOB2'
+         do i=1,nbdim
+            print *,'Direction ',i,indminglob2(i),indmaxglob2(i)
+         enddo
+         print *,'INDMIN'
+         do i=1,nbdim
+            print *,'Direction ',i,indmin(i),indmax(i)
+         enddo
+         print *,'INDMINGLOB3'
+         do i=1,nbdim
+            print *,'Direction ',i,indminglob3(i),indmaxglob3(i)
+         enddo
+        endif
 !
         call MPI_ALLGATHER(tab3,4*nbdim,MPI_INTEGER,tab4,4*nbdim,MPI_INTEGER,Agrif_mpi_comm,code)
-
+        call MPI_ALLGATHER(tab5,2*nbdim,MPI_INTEGER,tab6,2*nbdim,MPI_INTEGER,Agrif_mpi_comm,code)
         if (.not.associated(tempPextend))   allocate(tempPextend)
 
@@ -309 +808 @@
                 enddo
             enddo
+        enddo
+
+        do k=0,Agrif_Nbprocs-1
+          do j=1,2
+            do i=1,nbdim
+               tab5t(i,k,j) = tab6(i,j,k)
+            enddo
+          enddo
         enddo
 
@@ -319 +826 @@
                                      sendtoproc1,recvfromproc1,         &
                                      tab4t(:,:,5),tab4t(:,:,6),         &
-                                     tab4t(:,:,7),tab4t(:,:,8) )
+                                     tab4t(:,:,7),tab4t(:,:,8),         &
+                                     tab5t(:,:,1),tab5t(:,:,2))
     endif
 
@@ -335 +843 @@
                 indminglob,indmaxglob,                          &
                 pttruetab,cetruetab,                            &
-                memberin,nbdim                                  &
+                memberin,nbdim,                                 &
+                parentarray_chunk,parentarray_chunk_decal,decal_chunks,&
+                correction_required,member_chuncks,nb_chunks    &
 #if defined AGRIF_MPI
                ,indminglob2,indmaxglob2,                        &
@@ -391 +901 @@
                                                 ds_Child(1:2),    ds_Parent(1:2) )
             case(3)
+                        if (agrif_debug_interp) then
+        print *,'APRES ECHANGE'
+        print *,'nombre de chunks ',nb_chunks
+        print *,'indmin = ',indmin
+        print *,'indmax = ',indmax
+        do i=1,nb_chunks
+          print *,'CHUNK Number : ',i
+          print *,'MEMBER = ',member_chuncks(i)
+          print *,'Correction = ',correction_required(i)
+        enddo
+        endif
+
+                if (agrif_debug_interp) then
+                !    if ((nb==1).AND.(ndir==1)) then
+                        print *,'valeur parent = '
+                        do j=indmin(2),indmax(2)
+                            do i=indmin(1),indmax(1)
+                                print *,'par = ',i,j,tempPextend%array3(i,j,1)
+                            enddo
+                        enddo
+
+                 !   endif
+                endif
                 call Agrif_Interp_3D_recursive( type_interp(1:3),                       &
                                                 tempPextend % array3,                   &
@@ -398 +931 @@
                                                 s_Child_temp(1:3), s_Parent_temp(1:3),  &
                                                 ds_Child(1:3),    ds_Parent(1:3) )
+                if (agrif_debug_interp) then
+                  !  if ((nb==1).AND.(ndir==1)) then
+                        print *,'valeur enfnat = '
+                        do j=pttruetab(2),cetruetab(2)
+                            do i=pttruetab(1),cetruetab(1)
+                                print *,'par = ',i,j,tempC%array3(i,j,1)
+                            enddo
+                        enddo
+
+                  !  endif
+                endif
             case(4)
                 call Agrif_Interp_4D_recursive( type_interp(1:4),                       &
@@ -424 +968 @@
             end select
 !
-            call Agrif_get_var_bounds_array(child,lowerbound,upperbound,nbdim)
+            call Agrif_get_var_bounds_array(child,lowerbound,upperbound,nbdim,parent)
 
 #if defined AGRIF_MPI
@@ -676 +1220 @@
                                       childarray(2,1,1):childarray(2,2,1),      &
                                       childarray(3,1,1):childarray(3,2,1))
+                if (agrif_debug_interp) then
+                    if ((nb==1).AND.(ndir==1)) then
+                        print *,'valeur enfnat2 = '
+                        do j=childarray(2,1,2),childarray(2,2,2)
+                            do i=childarray(1,1,2),childarray(1,2,2)
+                                print *,'par = ',i,j,parray3(i,j,1)
+                            enddo
+                        enddo
+
+                    endif
+                endif
                     case (4)
                         parray4(childarray(1,1,2):childarray(1,2,2),      &
@@ -723 +1278 @@
 #if defined AGRIF_MPI
     if (member) then
+    if (agrif_debug_interp) then
+    print *,'ALLCOATED 0 = ',allocated(tempP%array3),size(tempP%array3)
+    endif
         call Agrif_array_deallocate(tempP,nbdim)
     endif
@@ -1372 +1930 @@
 function Agrif_Find_list_interp ( list_interp, pttab, petab, pttab_Child, pttab_Parent,     &
                                     nbdim, indmin, indmax, indminglob,  indmaxglob,         &
-                                    pttruetab, cetruetab, memberin                          &
+                                    pttruetab, cetruetab, memberin,                         &
+                                    parentarray_chunk,parentarray_chunk_decal,decal_chunks,   &
+                                    correction_required,member_chuncks,nb_chunks            &
 #if defined AGRIF_MPI
                                    ,indminglob2, indmaxglob2, parentarray,                  &
@@ -1386 +1946 @@
     integer, dimension(nbdim),     intent(out) :: pttruetab, cetruetab
     logical,                       intent(out) :: memberin
+    integer :: nb_chunks
+    integer, dimension(:,:,:,:), allocatable :: parentarray_chunk
+    integer, dimension(:,:,:,:), allocatable :: parentarray_chunk_decal
+    integer, dimension(:,:),allocatable :: decal_chunks
+    logical, dimension(:),allocatable :: correction_required
+    logical, dimension(:),allocatable :: member_chuncks
 #if defined AGRIF_MPI
     integer, dimension(nbdim),     intent(out) :: indminglob2, indmaxglob2
@@ -1441 +2007 @@
 #endif
         memberin = pil % memberin
+
+! chunks
+        nb_chunks = pil % nb_chunks
+        Allocate(parentarray_chunk(nb_chunks,nbdim,2,2))
+        parentarray_chunk = pil % parentarray_chunk
+        Allocate(parentarray_chunk_decal(nb_chunks,nbdim,2,2))
+        parentarray_chunk_decal = pil % parentarray_chunk_decal
+        Allocate(correction_required(nb_chunks))
+        correction_required = pil % correction_required
+        Allocate(decal_chunks(nb_chunks,nbdim))
+        decal_chunks = pil % decal_chunks
+        Allocate(member_chuncks(nb_chunks))
+        member_chuncks = pil % member_chuncks
+
         find_list_interp = .true.
         exit find_loop
@@ -1454 +2034 @@
                                      indmin, indmax, indminglob, indmaxglob,                &
                                      pttruetab, cetruetab,                                  &
-                                     memberin, nbdim                                        &
+                                     memberin, nbdim,                                       &
+                                    parentarray_chunk,parentarray_chunk_decal,decal_chunks,  &
+                                    correction_required,member_chuncks,nb_chunks            &
 #if defined AGRIF_MPI
                                     ,indminglob2, indmaxglob2,                              &
@@ -1470 +2052 @@
     integer, dimension(nbdim)               :: pttruetab, cetruetab
     logical                                 :: memberin
+    integer :: nb_chunks
+    integer, dimension(:,:,:,:), allocatable :: parentarray_chunk
+    integer, dimension(:,:,:,:), allocatable :: parentarray_chunk_decal
+    integer, dimension(:,:),allocatable :: decal_chunks
+    logical, dimension(:),allocatable :: correction_required
+    logical, dimension(:),allocatable :: member_chuncks
 #if defined AGRIF_MPI
     integer, dimension(nbdim,2,2)           :: parentarray
@@ -1518 +2106 @@
     pil % cetruetab(1:nbdim) = cetruetab(1:nbdim)
 
+! chunks
+    pil % nb_chunks = nb_chunks
+    allocate(pil % parentarray_chunk(nb_chunks,nbdim,2,2))
+    allocate(pil % parentarray_chunk_decal(nb_chunks,nbdim,2,2))
+    allocate(pil % correction_required(nb_chunks))
+    allocate(pil % decal_chunks(nb_chunks,nbdim))
+    allocate(pil % member_chuncks(nb_chunks))
+
+    pil % parentarray_chunk   = parentarray_chunk
+    pil % parentarray_chunk_decal = parentarray_chunk_decal
+    pil % correction_required = correction_required
+    pil % decal_chunks        = decal_chunks
+    pil % member_chuncks      = member_chuncks
+
+
     parcours % suiv => list_interp
     list_interp => parcours

vendors/AGRIF/dev/AGRIF_FILES/modinterpbasic.F90

@@ -37 +37 @@
     real, dimension(:),   allocatable       :: tabtest4
     real, dimension(:,:), allocatable       :: coeffparent
-    integer, dimension(:,:), allocatable    :: indparent
+    integer, private, dimension(:,:), allocatable    :: indparent
     integer, dimension(:,:), allocatable    :: indparentppm, indchildppm
     integer, dimension(:), allocatable      :: indparentppm_1d, indchildppm_1d
@@ -56 +56 @@
     integer,             intent(in)     :: np           !< Length of input array
     integer,             intent(in)     :: nc           !< Length of output array
-    real,                intent(in)     :: s_parent     !< Parent grid position (s_root = 0)
-    real,                intent(in)     :: s_child      !< Child  grid position (s_root = 0)
-    real,                intent(in)     :: ds_parent    !< Parent grid dx (ds_root = 1)
-    real,                intent(in)     :: ds_child     !< Child  grid dx (ds_root = 1)
+    real(kind=8),                intent(in)     :: s_parent     !< Parent grid position (s_root = 0)
+    real(kind=8),                intent(in)     :: s_child      !< Child  grid position (s_root = 0)
+    real(kind=8),                intent(in)     :: ds_parent    !< Parent grid dx (ds_root = 1)
+    real(kind=8),                intent(in)     :: ds_child     !< Child  grid dx (ds_root = 1)
 !
     integer :: i, coeffraf, locind_parent_left
-    real    :: globind_parent_left, globind_parent_right
-    real    :: invds, invds2, ypos, ypos2, diff
+    real(kind=8)    :: globind_parent_left, globind_parent_right
+    real(kind=8)    :: invds, invds2, ypos, ypos2, diff
 !
     coeffraf = nint(ds_parent/ds_child)
@@ -92 +92 @@
 !
         diff = globind_parent_right - ypos2
+! quick fix for roundoff error
+        diff=nint(diff*coeffraf)/real(coeffraf)
+
         y(i) = (diff*x(locind_parent_left) + (1.-diff)*x(locind_parent_left+1))
         ypos2 = ypos2 + invds2
@@ -104 +107 @@
     else
         globind_parent_left = s_parent + (locind_parent_left - 1)*ds_parent
-        y(nc) = ((globind_parent_left + ds_parent - ypos)*x(locind_parent_left)  &
-                           + (ypos - globind_parent_left)*x(locind_parent_left+1))*invds
+        diff=(globind_parent_left + ds_parent - ypos)*invds
+
+! quick fix for roundoff error
+        diff=nint(diff*coeffraf)/real(coeffraf)
+!        y(nc) = ((globind_parent_left + ds_parent - ypos)*x(locind_parent_left)  &
+!                           + (ypos - globind_parent_left)*x(locind_parent_left+1))*invds
+        y(nc) = (diff*x(locind_parent_left) + (1.-diff)*x(locind_parent_left+1))
     endif
 !---------------------------------------------------------------------------------------------------
@@ -120 +128 @@
 !---------------------------------------------------------------------------------------------------
     integer, intent(in) :: np,nc,np2
-    real,    intent(in) :: s_parent, s_child
-    real,    intent(in) :: ds_parent, ds_child
+    real(kind=8),    intent(in) :: s_parent, s_child
+    real(kind=8),    intent(in) :: ds_parent, ds_child
     integer, intent(in) :: dir
 !
@@ -127 +135 @@
     integer, dimension(:,:), allocatable :: indparent_tmp
     real, dimension(:,:), allocatable :: coeffparent_tmp
-    real    :: ypos,globind_parent_left,globind_parent_right
-    real    :: invds, invds2, invds3
-    real :: ypos2,diff
+    real(kind=8)    :: ypos,globind_parent_left,globind_parent_right
+    real(kind=8)    :: invds, invds2, invds3
+    real(kind=8) :: ypos2,diff
 !
     coeffraf = nint(ds_parent/ds_child)
@@ -164 +172 @@
         if (ypos2 > globind_parent_right) then
             locind_parent_left = locind_parent_left + 1
-            globind_parent_right = globind_parent_right + 1.
+            globind_parent_right = globind_parent_right + 1.d0
             ypos2 = ypos*invds+(i-1)*invds2
         endif
@@ -220 +228 @@
 !CDIR ALTCODE
 !CDIR NODEP
+    if (associated(agrif_external_linear_interp)) then
+    do i = 1,nc
+        y(i)=agrif_external_linear_interp(x(MAX(indparent(i,dir),1)), &
+              x(indparent(i,dir)+1),coeffparent(i,dir))
+    enddo
+    else
     do i = 1,nc
         y(i) = coeffparent(i,dir)  * x(MAX(indparent(i,dir),1)) + &
            (1.-coeffparent(i,dir)) * x(indparent(i,dir)+1)
     enddo
+    endif
 !---------------------------------------------------------------------------------------------------
 end subroutine Linear1dAfterCompute
@@ -239 +254 @@
     real, dimension(np), intent(in)     :: x
     real, dimension(nc), intent(out)    :: y
-    real,                intent(in)     :: s_parent, s_child
-    real,                intent(in)     :: ds_parent, ds_child
+    real(kind=8),                intent(in)     :: s_parent, s_child
+    real(kind=8),                intent(in)     :: ds_parent, ds_child
 !
     integer :: i, coeffraf, locind_parent_left
-    real    :: ypos,globind_parent_left
-    real    :: deltax, invdsparent
+    real(kind=8)    :: ypos,globind_parent_left
+    real(kind=8)    :: deltax, invdsparent
     real    :: t2,t3,t4,t5,t6,t7,t8
 !
@@ -304 +319 @@
     real, dimension(np), intent(in)     :: x
     real, dimension(nc), intent(out)    :: y
-    real,                intent(in)     :: s_parent, s_child
-    real,                intent(in)     :: ds_parent, ds_child
+    real(kind=8),                intent(in)     :: s_parent, s_child
+    real(kind=8),                intent(in)     :: ds_parent, ds_child
 !
     integer :: i, coeffraf, locind_parent
-    real    :: ypos
+    real(kind=8)    :: ypos
 !
     coeffraf = nint(ds_parent/ds_child)
@@ -342 +357 @@
     real, dimension(np), intent(in)     :: x
     real, dimension(nc), intent(out)    :: y
-    real,                intent(in)     :: s_parent, s_child
-    real,                intent(in)     :: ds_parent, ds_child
+    real(kind=8),                intent(in)     :: s_parent, s_child
+    real(kind=8),                intent(in)     :: ds_parent, ds_child
 !
     real, dimension(:), allocatable :: ytemp
     integer :: i,coeffraf,locind_parent_left,locind_parent_last
-    real    :: ypos,xdiffmod,xpmin,xpmax,slope
+    real(kind=8)    :: ypos,xdiffmod,xpmin,xpmax,slope
     integer :: i1,i2,ii
     integer :: diffmod
@@ -386 +401 @@
 
     do ii = i-coeffraf/2+diffmod,i+coeffraf/2
-        ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
+        ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod)*slope
     enddo
 
@@ -394 +409 @@
         slope = (x(locind_parent_left+1)-x(locind_parent_left-1))/(2.*coeffraf)
         do ii = i-coeffraf/2+diffmod,i+coeffraf/2
-            ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
+            ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod)*slope
         enddo
         locind_parent_left = locind_parent_left + 1
@@ -408 +423 @@
 
     do ii = i-coeffraf/2+diffmod,nc
-        ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
+        ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod)*slope
     enddo
 !
@@ -429 +444 @@
     real, dimension(np), intent(in)     :: x
     real, dimension(nc), intent(out)    :: y
-    real,                intent(in)     :: s_parent, s_child
-    real,                intent(in)     :: ds_parent, ds_child
+    real(kind=8),                intent(in)     :: s_parent, s_child
+    real(kind=8),                intent(in)     :: ds_parent, ds_child
 !
     real, dimension(:), allocatable :: ytemp
     integer :: i,coeffraf,locind_parent_left,locind_parent_last
-    real    :: ypos,xdiffmod,xpmin,xpmax,slope
+    real(kind=8)    :: ypos,xdiffmod,xpmin,xpmax,slope
     integer :: i1,i2,ii
     integer :: diffmod
@@ -479 +494 @@
 
     do ii = i-coeffraf/2+diffmod,i+coeffraf/2
-        ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
+        ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod)*slope
     enddo
 
@@ -488 +503 @@
         slope = slope / coeffraf
         do ii=i-coeffraf/2+diffmod,i+coeffraf/2
-            ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
+            ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod)*slope
         enddo
         locind_parent_left = locind_parent_left + 1
@@ -503 +518 @@
 
     do ii=i-coeffraf/2+diffmod,nc
-        ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod/2.)*slope
+        ytemp(ii) = x(locind_parent_left)+(ii-i-xdiffmod)*slope
     enddo
 !
@@ -524 +539 @@
     real, dimension(np), intent(in)     :: x
     real, dimension(nc), intent(out)    :: y
-    real,                intent(in)     :: s_parent, s_child
-    real,                intent(in)     :: ds_parent, ds_child
+    real(kind=8),                intent(in)     :: s_parent, s_child
+    real(kind=8),                intent(in)     :: ds_parent, ds_child
 !
     integer :: i,coeffraf,locind_parent_left,locind_parent_last
     integer :: iparent,ipos,pos,nmin,nmax
-    real    :: ypos
+    real(kind=8)    :: ypos
     integer :: i1,jj
-    real :: xpmin,a
+    real(kind=8) :: xpmin
+    real :: a
 !
     real, dimension(np) :: xl,delta,a6,slope
@@ -646 +662 @@
 !---------------------------------------------------------------------------------------------------
     integer,             intent(in)     :: np2, np, nc
-    real,                intent(in)     :: s_parent, s_child
-    real,                intent(in)     :: ds_parent, ds_child
+    real(kind=8),                intent(in)     :: s_parent, s_child
+    real(kind=8),                intent(in)     :: ds_parent, ds_child
     integer,             intent(in)     :: dir
 !
@@ -656 +672 @@
     real    :: ypos
     integer :: i1,jj
-    real :: xpmin,a
+    real(kind=8) :: xpmin
+    real :: a
 !
     integer :: diffmod
@@ -1069 +1086 @@
     real, dimension(np), intent(in)     :: x
     real, dimension(nc), intent(out)    :: y
-    real,                intent(in)     :: s_parent, s_child
-    real,                intent(in)     :: ds_parent, ds_child
+    real(kind=8),                intent(in)     :: s_parent, s_child
+    real(kind=8),                intent(in)     :: ds_parent, ds_child
 !
     real, dimension(:), allocatable :: ytemp
     integer :: i,coeffraf,locind_parent_left,locind_parent_last
     integer :: iparent,ipos,pos,nmin,nmax
-    real    :: ypos
+    real(kind=8)    :: ypos
     integer :: i1,jj
-    real :: xpmin
+    real(kind=8) :: xpmin
 !
     real, dimension(np) :: slope
@@ -1166 +1183 @@
     real, dimension(np), intent(in)     :: x
     real, dimension(nc), intent(out)    :: y
-    real,                intent(in)     :: s_parent, s_child
-    real,                intent(in)     :: ds_parent, ds_child
+    real(kind=8),                intent(in)     :: s_parent, s_child
+    real(kind=8),                intent(in)     :: ds_parent, ds_child
 !
     integer :: i,coeffraf,locind_parent_left,locind_parent_last
     integer :: ipos, pos
-    real    :: ypos,xi
+    real(kind=8)    :: ypos,xi
     integer :: i1,jj
-    real :: xpmin
+    real(kind=8) :: xpmin
 !
     real, dimension(:),   allocatable  :: ytemp
@@ -1276 +1293 @@
       Real, Dimension(nc) :: y
       Real, Dimension(:),Allocatable :: ytemp
-      Real                :: s_parent,s_child,ds_parent,ds_child
+      Real(kind=8)        :: s_parent,s_child,ds_parent,ds_child
 !
 !     Local scalars
       Integer :: i,coeffraf,locind_parent_left,locind_parent_last
       Integer :: iparent,ipos,pos,nmin,nmax
-      Real    :: ypos
+      Real(kind=8)    :: ypos
       integer :: i1,jj
-      Real :: xpmin,cavg,a,b
+      Real(kind=8) :: xpmin
+      real :: cavg,a,b
 !      
       Real :: xrmin,xrmax,am3,s2,s1  

vendors/AGRIF/dev/AGRIF_FILES/modlinktomodel.F90

@@ -50 +50 @@
         end subroutine alloc_proc
 !
-        subroutine typdef_proc ( )
+        subroutine typedef_proc ( )
             implicit none
-        end subroutine typdef_proc
+        end subroutine typedef_proc
 !
     end interface
     
     procedure(alloc_proc)   :: Agrif_Allocationcalls
-    procedure(typdef_proc) :: Agrif_probdim_modtype_def
+    procedure(typedef_proc) :: Agrif_probdim_modtype_def
 !
 end module Agrif_Link
@@ -80 +80 @@
 !                    Agrif_Curgrid % spaceref(1)
 !===================================================================================================
-!  function Agrif_Parent_Irhox
-!        modify by conv. To use : var = Agrif_Parent_IRhox()
-!                    Agrif_Curgrid % parent % spaceref(1)
-!===================================================================================================
 !  function Agrif_Rhoy
 !        modify by conv. To use : var = Agrif_Rhoy()
@@ -96 +92 @@
 !                    Agrif_Curgrid % spaceref(2)
 !===================================================================================================
-!  function Agrif_Parent_Irhoy
-!        modify by conv. To use : var = Agrif_Parent_IRhoy()
-!                    Agrif_Curgrid % parent % spaceref(2)
+
+
 !===================================================================================================
 !  function Agrif_Rhoz
@@ -111 +106 @@
 !        modify by conv. To use : var = Agrif_Parent_IRhoz()
 !                    Agrif_Curgrid % spaceref(3)
-!===================================================================================================
-!  function Agrif_Parent_Irhoz
-!        modify by conv. To use : var = Agrif_Parent_IRhoz()
-!                    Agrif_Curgrid % parent % spaceref(3)
+
 !===================================================================================================
 !  function Agrif_NearCommonBorderX

vendors/AGRIF/dev/AGRIF_FILES/modmpp.F90

@@ -166 +166 @@
 subroutine Get_External_Data_first ( pttruetab, cetruetab, pttruetabwhole, cetruetabwhole,  &
                                      nbdim, memberoutall, coords, sendtoproc, recvfromproc, &
-                                     imin, imax, imin_recv, imax_recv )
+                                     imin, imax, imin_recv, imax_recv, bornesmin, bornesmax )
 !---------------------------------------------------------------------------------------------------
     include 'mpif.h'
@@ -179 +179 @@
     integer, dimension(nbdim,0:Agrif_NbProcs-1), intent(out) :: imin,imax
     integer, dimension(nbdim,0:Agrif_NbProcs-1), intent(out) :: imin_recv,imax_recv
+    integer, dimension(nbdim,0:Agrif_NbProcs-1), intent(in) :: bornesmin, bornesmax
 !
     integer :: imintmp, imaxtmp, i, j, k, i1
@@ -190 +191 @@
     pttruetab2(:,Agrif_Procrank) = pttruetab(:,Agrif_Procrank)
     cetruetab2(:,Agrif_Procrank) = cetruetab(:,Agrif_Procrank)
+
+        if (agrif_debug_interp) then
+            print *,'DANS Get_External_Data_first avec proc : ',Agrif_Procrank
+            do k=0,Agrif_Nbprocs-1
+                print *,'Processeur ',k
+                do i=1,nbdim
+                print *,'ptcetretab      = ',i,pttruetab(i,k),cetruetab(i,k)
+                print *,'ptcetretabwhole = ',i,pttruetabwhole(i,k),cetruetabwhole(i,k)
+               enddo
+            enddo
+        endif
 !
     do k = 0,Agrif_Nbprocs-1
+        if (agrif_debug_interp) then
+            print *,'Proc : ',k
+        endif
     do i = 1,nbdim
+        if (agrif_debug_interp) then
+            print *,'Direction : ',i
+        endif
         tochangebis = .TRUE.
         DO i1 = 1,nbdim
@@ -203 +221 @@
             ENDIF
         ENDDO
+        ! Strange CASE
+        if ((pttruetab(i,k)>=pttruetab(i,Agrif_Procrank)).AND. &
+            (cetruetab(i,k)<=cetruetab(i,Agrif_Procrank))) tochangebis = .FALSE.
+
+        if (agrif_debug_interp) then
+            print *,'tochangebis= ',tochangebis
+        endif
         IF (tochangebis) THEN
             imin1 = max(pttruetab(i,Agrif_Procrank), pttruetab(i,k))
             imax1 = min(cetruetab(i,Agrif_Procrank), cetruetab(i,k))
 ! Always send the most interior points
-
+        if (agrif_debug_interp) then
+            print *,'imin1imax1= ',imin1,imax1
+        endif
             tochange = .false.
             IF (cetruetab(i,Agrif_Procrank) > cetruetab(i,k)) THEN
                 DO j=imin1,imax1
-                    IF ((cetruetab(i,k)-j) > (j-pttruetab(i,Agrif_Procrank))) THEN
+                    IF ((bornesmax(i,k)-j) > (j-bornesmin(i,Agrif_Procrank))) THEN
                         imintmp = j+1
                         tochange = .TRUE.
@@ -228 +255 @@
             IF (pttruetab(i,Agrif_Procrank) < pttruetab(i,k)) THEN
                 DO j=imax1,imin1,-1
-                    IF ((j-pttruetab(i,k)) > (cetruetab(i,Agrif_Procrank)-j)) THEN
+                    IF ((j-bornesmin(i,k)) > (bornesmax(i,Agrif_Procrank)-j)) THEN
                         imaxtmp = j-1
                         tochange = .TRUE.
@@ -244 +271 @@
     enddo
 
+        if (agrif_debug_interp) then
+            do k=0,Agrif_Nbprocs-1
+                print *,'Processeur ',k
+                do i=1,nbdim
+                print *,'ptcetretab2      = ',i,pttruetab2(i,k),cetruetab2(i,k)
+               enddo
+            enddo
+        endif
+
     do k = 0,Agrif_NbProcs-1
 !
         sendtoproc(k) = .true.
 !
+        IF ( .not. memberoutall(k) ) THEN
+            sendtoproc(k) = .false.
+        ELSE
 !CDIR SHORTLOOP
         do i = 1,nbdim
@@ -257 +296 @@
             endif
         enddo
-        IF ( .not. memberoutall(k) ) THEN
-            sendtoproc(k) = .false.
         ENDIF
     enddo
@@ -384 +421 @@
     ENDIF
 !
+    if (agrif_debug_interp) then
+        print *,'PROCESSEUR = ',Agrif_Procrank
+        print *,'SENDTOPROC = ',sendtoproc(Agrif_Procrank)
+        if (sendtoproc(Agrif_Procrank)) then
+            print *,'imin imax = ',imin(:,Agrif_Procrank),imax(:,Agrif_Procrank)
+        endif
+        endif
     IF (sendtoproc(Agrif_ProcRank)) THEN
         call Agrif_var_copy_array(tempCextend,imin(:,Agrif_Procrank),imax(:,Agrif_Procrank), &

vendors/AGRIF/dev/AGRIF_FILES/modtypes.F90

@@ -20 +20 @@
 !
 !
-!
+! 
 !> Definition of data types used in AGRIF, of several variables and parameters
 !
@@ -109 +109 @@
     real(4), dimension(:,:,:,:,:,:), allocatable :: sarray6
 !> @}
+!> \name Arrays containing the values of the grid variables (real)
+!> @{
+    real,    dimension(:)          , pointer :: parray1
+    real,    dimension(:,:)        , pointer :: parray2
+    real,    dimension(:,:,:)      , pointer :: parray3
+    real,    dimension(:,:,:,:)    , pointer :: parray4
+    real,    dimension(:,:,:,:,:)  , pointer :: parray5
+    real,    dimension(:,:,:,:,:,:), pointer :: parray6
+!> @}
+!> \name Arrays containing the values of the grid variables (real*8)
+!> @{
+    real(8), dimension(:)          , pointer :: pdarray1
+    real(8), dimension(:,:)        , pointer :: pdarray2
+    real(8), dimension(:,:,:)      , pointer :: pdarray3
+    real(8), dimension(:,:,:,:)    , pointer :: pdarray4
+    real(8), dimension(:,:,:,:,:)  , pointer :: pdarray5
+    real(8), dimension(:,:,:,:,:,:), pointer :: pdarray6
+!> @}
+!> \name Arrays containing the values of the grid variables (real*4)
+!> @{
+    real(4), dimension(:)          , pointer :: psarray1
+    real(4), dimension(:,:)        , pointer :: psarray2
+    real(4), dimension(:,:,:)      , pointer :: psarray3
+    real(4), dimension(:,:,:,:)    , pointer :: psarray4
+    real(4), dimension(:,:,:,:,:)  , pointer :: psarray5
+    real(4), dimension(:,:,:,:,:,:), pointer :: psarray6
+!> @}
 !> \name Arrays used to restore the values
 !> @{
@@ -153 +180 @@
 !> \name Arrays containing the values of the grid variables (character)
 !> @{
-    character(2400)                             :: carray0
+    character(4000)                             :: carray0
     character(:)  ,                 allocatable :: carrayu
-    character(200), dimension(:)  , allocatable :: carray1
-    character(200), dimension(:,:), allocatable :: carray2
+    character(400), dimension(:)  , allocatable :: carray1
+    character(400), dimension(:,:), allocatable :: carray2
 !> @}
 !---------------------------------------------------------------------------------------------------
@@ -219 +246 @@
 !> \name Arrays containing the values of the grid variables (logical)
 !> @{
-    logical                                      :: larray0
+    logical                                      :: larray0 = .FALSE.
     logical, dimension(:)          , allocatable :: larray1
     logical, dimension(:,:)        , allocatable :: larray2
@@ -226 +253 @@
     logical, dimension(:,:,:,:,:)  , allocatable :: larray5
     logical, dimension(:,:,:,:,:,:), allocatable :: larray6
-!> @}
+
+!> @}
+!> \name Arrays containing the values of the grid variables (logical pointers)
+!> @{
+    logical, dimension(:)          , pointer :: plarray1
+    logical, dimension(:,:)        , pointer :: plarray2
+    logical, dimension(:,:,:)      , pointer :: plarray3
+    logical, dimension(:,:,:,:)    , pointer :: plarray4
+    logical, dimension(:,:,:,:,:)  , pointer :: plarray5
+    logical, dimension(:,:,:,:,:,:), pointer :: plarray6
+!> @}
+
 !---------------------------------------------------------------------------------------------------
 end type Agrif_Variable_l
@@ -243 +281 @@
 !> \name Arrays containing the values of the grid variables (integer)
 !> @{
-    integer                                      :: iarray0
+    integer                                      :: iarray0 = 0
     integer, dimension(:)          , allocatable :: iarray1
     integer, dimension(:,:)        , allocatable :: iarray2
@@ -250 +288 @@
     integer, dimension(:,:,:,:,:)  , allocatable :: iarray5
     integer, dimension(:,:,:,:,:,:), allocatable :: iarray6
+
+!> @}
+!
+!> \name Arrays containing the values of the grid variables (integer pointers)
+!> @{
+    integer, dimension(:)          , pointer :: piarray1
+    integer, dimension(:,:)        , pointer :: piarray2
+    integer, dimension(:,:,:)      , pointer :: piarray3
+    integer, dimension(:,:,:,:)    , pointer :: piarray4
+    integer, dimension(:,:,:,:,:)  , pointer :: piarray5
+    integer, dimension(:,:,:,:,:,:), pointer :: piarray6
 !> @}
 !---------------------------------------------------------------------------------------------------
@@ -274 +323 @@
     logical, dimension(:),    pointer :: sendtoproc2    => NULL()
     logical, dimension(:),    pointer :: recvfromproc1  => NULL()
-    logical, dimension(:),    pointer :: recvfromproc2  => NULL()
+    logical, dimension(:),    pointer :: recvfromproc2  => NULL() 
 #endif
+    integer                           :: nb_chunks
+    integer, dimension(:,:,:,:), allocatable :: parentarray_chunk
+    integer, dimension(:,:,:,:), allocatable :: parentarray_chunk_decal
+    integer, dimension(:,:),allocatable :: decal_chunks
+    logical, dimension(:),allocatable :: correction_required
+    logical, dimension(:),allocatable :: member_chuncks 
 !---------------------------------------------------------------------------------------------------
 end type Agrif_Interp_Loc
@@ -345 +400 @@
     integer, parameter    :: Agrif_Update_Average = 2           !< average
     integer, parameter    :: Agrif_Update_Full_Weighting = 3    !< full-weighting
+    integer, parameter    :: Agrif_Update_Max = 4               !< Max
 !> @}
 !> \name Raffinement grid switches
@@ -375 +431 @@
     real, dimension(:,:,:,:,:,:), allocatable :: parray6
 !
-    logical :: agrif_debug = .false.    ! may be activaded in users subroutine for debugging purposes
+    logical :: agrif_debug = .false.        ! may be activaded in users subroutine for debugging purposes
+    logical :: agrif_debug_interp = .false. ! may be activaded in users subroutine for debugging interpolations
+    logical :: agrif_debug_update = .false. ! may be activaded in users subroutine for debugging updates
 
 ! If a grand mother grid is present
@@ -381 +439 @@
     integer, dimension(3) :: coarse_spaceref = (/1,1,1/)
     integer, dimension(3) :: coarse_timeref  = (/1,1,1/)
+    
+    
+! External mapping procedure
+    Procedure(mapping), pointer :: agrif_external_mapping => NULL()
+    abstract interface
+     subroutine mapping(ndim,ptx,pty,bounds,bounds_chunks,correction_required,nb_chunks)
+     integer :: ndim, ptx, pty
+     integer,dimension(ndim,2,2) :: bounds
+     integer,dimension(:,:,:,:),allocatable :: bounds_chunks
+     logical,dimension(:),allocatable :: correction_required
+     integer :: nb_chunks
+     end subroutine mapping
+    end interface
+
+    Procedure(linear_interp), pointer :: agrif_external_linear_interp => NULL()
+    abstract interface
+     real function linear_interp(x1,x2,coeff)
+     real :: x1, x2, coeff
+     end function linear_interp
+    end interface
 !
 contains

vendors/AGRIF/dev/AGRIF_FILES/modupdate.F90

@@ -279 +279 @@
     real,    dimension(nbdim), intent(in)   :: ds_parent    !< Space steps of the parent grid
     procedure()                             :: procname     !< Data recovery procedure
+    integer, dimension(6)  :: loctab_child      ! Indicates if the child grid has a common border
+                                                !    with the root grid
+    type(Agrif_Variable), pointer :: root_var   ! Variable on the root grid
 !
     integer,dimension(nbdim)     :: type_update ! Type of update (copy or average)
@@ -288 +291 @@
     integer                      :: nb, ndir
     integer :: coeffraf
-!
+    integer :: n
+!
+    root_var => child % root_var
+    loctab_child(1:nbdim) = 0
+!
+    do n = 1,nbdim
+!
+        select case(root_var % interptab(n))
+!
+        case('x') ! x DIMENSION
+!
+            if (Agrif_Curgrid % NearRootBorder(1))      loctab_child(n) = -1
+            if (Agrif_Curgrid % DistantRootBorder(1))   loctab_child(n) = -2
+            if ((Agrif_Curgrid % NearRootBorder(1)) .AND. &
+                (Agrif_Curgrid % DistantRootBorder(1))) loctab_child(n) = -3
+!
+        case('y') ! y DIMENSION
+!
+            if (Agrif_Curgrid % NearRootBorder(2))      loctab_child(n) = -1
+            if (Agrif_Curgrid % DistantRootBorder(2))   loctab_child(n) = -2
+            if ((Agrif_Curgrid % NearRootBorder(2)) .AND. &
+                (Agrif_Curgrid % DistantRootBorder(2))) loctab_child(n) = -3
+!
+        case('z') ! z DIMENSION
+!
+            if (Agrif_Curgrid % NearRootBorder(3))      loctab_child(n) = -1
+            if (Agrif_Curgrid % DistantRootBorder(3))   loctab_child(n) = -2
+            if ((Agrif_Curgrid % NearRootBorder(3)) .AND. &
+                (Agrif_Curgrid % DistantRootBorder(3))) loctab_child(n) = -3
+!
+        case('N') ! No space DIMENSION
+!
+            loctab_child(n) = -3
+!
+        end select
+!
+    enddo
+
     type_update = child % root_var % type_update(1:nbdim)
 !
@@ -330 +370 @@
         if ( do_update(nb) ) then
             do ndir = 1,2
+              if (loctab_child(nb) /= (-ndir) .AND. loctab_child(nb) /= -3) then
                 ptres(nb,1,ndir,nb) = indtruetab(nb,ndir,1)
                 ptres(nb,2,ndir,nb) = indtruetab(nb,ndir,2)
@@ -348 +389 @@
                     endif
                 enddo
+              endif
             enddo
         endif
@@ -355 +397 @@
         if ( do_update(nb) ) then
             do ndir = 1,2
+              if (loctab_child(nb) /= (-ndir) .AND. loctab_child(nb) /= -3) then
                 call Agrif_UpdatenD(type_update, parent, child,             &
                         ptres(1:nbdim,1,ndir,nb),ptres(1:nbdim,2,ndir,nb),  &
@@ -364 +407 @@
 #endif
                         nbdim,procname,nb,ndir)
+              endif
             enddo
         endif
@@ -390 +434 @@
 #endif
 !
-    integer, dimension(6),     intent(in)   :: type_update  !< Type of update (copy or average)
     type(Agrif_Variable), pointer           :: parent       !< Variable of the parent grid
     type(Agrif_Variable), pointer           :: child        !< Variable of the child grid
     integer,                   intent(in)   :: nbdim
+    integer, dimension(nbdim), intent(in)   :: type_update  !< Type of update (copy or average)
     integer, dimension(nbdim), intent(in)   :: pttab        !< Index of the first point inside the domain
     integer, dimension(nbdim), intent(in)   :: petab        !< Index of the first point inside the domain
@@ -423 +467 @@
     logical :: memberin, member
     integer :: nbin, ndirin
+    integer :: i, j,k,l,m
+    LOGICAL,DIMENSION(:),ALLOCATABLE :: member_chuncks
+    INTEGER,DIMENSION(:,:),ALLOCATABLE :: decal_chunks
+    INTEGER :: agrif_external_switch_index
+    INTEGER, DIMENSION(2) :: test_orientation
 !
 #if defined AGRIF_MPI
 !
     integer,dimension(nbdim)    :: indminglob2,indmaxglob2
+    INTEGER, DIMENSION(:,:),ALLOCATABLE :: indminglob_chunks, indmaxglob_chunks
+    INTEGER, DIMENSION(:,:),ALLOCATABLE :: indminglob2_chunks,indmaxglob2_chunks
+    INTEGER, DIMENSION(:,:),ALLOCATABLE :: indminglob3_chunks,indmaxglob3_chunks
     logical, dimension(0:Agrif_Nbprocs-1) :: sendtoproc1,recvfromproc1
     logical, dimension(0:Agrif_Nbprocs-1) :: sendtoproc2,recvfromproc2
     integer                               :: code, local_proc
-    integer                               :: i,j,k
     integer, dimension(nbdim,4)           :: tab3
     integer, dimension(nbdim,4,0:Agrif_Nbprocs-1) :: tab4
@@ -444 +495 @@
     type(Agrif_Variable), pointer, save :: tempP => NULL()       ! Temporary parent grid variable
     type(Agrif_Variable), pointer, save :: tempCextend => NULL() ! Temporary child
+
     type(Agrif_Variable), pointer, save :: tempPextend => NULL() ! Temporary parent
+    type(Agrif_Variable), pointer, save :: tempPextend_chunk => NULL() ! Temporary parent
     type(Agrif_Variable), pointer :: tempP_indic, tempP_average
     type(Agrif_Variable), pointer :: tempC_indic
@@ -450 +503 @@
     real :: coeff_multi
     integer :: nb_dimensions
+
+! CHUNK (e.g. periodicity)
+
+    INTEGER :: nb_chunks
+    INTEGER, DIMENSION(:,:,:,:), ALLOCATABLE :: parentarray_chunk
+    INTEGER, DIMENSION(:,:,:,:), ALLOCATABLE :: parentarray_chunk_decal
+    INTEGER, DIMENSION(:,:,:), ALLOCATABLE :: bounds_chunks
+    logical,dimension(:),allocatable :: correction_required
+!
+
 !
 !   Get local lower and upper bound of the child variable
@@ -459 +522 @@
     coords = child % root_var % coords
 !
+
     call Agrif_Childbounds( nbdim, lowerbound, upperbound, pttab, petab, Agrif_Procrank,    &
                             coords, pttruetab, cetruetab, memberin )
+
+        if (agrif_debug_update) then
+        print *,'************CHILDBOUNDS*********************************'
+#ifdef AGRIF_MPI
+         print *,'Processeur ',Agrif_Procrank
+#endif
+        print *,'memberin ',memberin
+        do i = 1 , nbdim
+        print *,'Direction ',i,' indices debut: ',pttab(i),pttruetab(i)
+        print *,'Direction ',i,' indices fin  : ',petab(i),cetruetab(i)
+        enddo
+        print *,'*********************************************'
+        endif
+
     call Agrif_Prtbounds( nbdim, indminglob, indmaxglob, s_Parent_temp, s_Child_temp,       &
                          s_child, ds_child, s_parent, ds_parent,                            &
@@ -469 +547 @@
             )
 
+        if (agrif_debug_update) then
+        print *,'************PRTBOUNDS*********************************'
+#ifdef AGRIF_MPI
+         print *,'Processeur ',Agrif_Procrank
+#endif
+        do i = 1 , nbdim
+        print *,'Direction ',i,' indminglob : ',indminglob(i)
+        print *,'Direction ',i,' indmaxglob : ',indmaxglob(i)
+        enddo
+
+        do i = 1 , nbdim
+        print *,'Direction ',i,' s_Parent_temp : ',s_Parent_temp(i)
+        print *,'Direction ',i,' s_Child_temp  : ',s_Child_temp(i)
+        enddo
+        print *,'*********************************************'
+        endif
+
 #if defined AGRIF_MPI
 !
@@ -476 +571 @@
                                        nbdim, Agrif_Procrank, member)
     ENDIF
+
+        if (agrif_debug_update) then
+        print *,'************GlobalToLocalBounds******************'
+#ifdef AGRIF_MPI
+         print *,'Processeur ',Agrif_Procrank
+#endif
+        do i = 1 , nbdim
+        print *,'Direction ',i,' childarray global : ',childarray(i,1,1),childarray(i,2,1)
+        print *,'Direction ',i,' childarray local  : ',childarray(i,1,2),childarray(i,2,2)
+        enddo
+
+        print *,'*********************************************'
+        endif
 
     call Agrif_Prtbounds(nbdim, indmin, indmax,                     &
@@ -483 +591 @@
                          posvar, type_update, do_update,            &
                          pttruetabwhole, cetruetabwhole)
+
+        if (agrif_debug_update) then
+        print *,'************PRTBOUNDS II *********************************'
+#ifdef AGRIF_MPI
+         print *,'Processeur ',Agrif_Procrank
+#endif
+        do i = 1 , nbdim
+        print *,'Direction ',i,' indmin : ',indmin(i)
+        print *,'Direction ',i,' indmax : ',indmax(i)
+        enddo
+
+        do i = 1 , nbdim
+        print *,'Direction ',i,' s_Parent_temp : ',s_Parent_temp(i)
+        print *,'Direction ',i,' s_Child_temp  : ',s_Child_temp(i)
+        enddo
+        print *,'*********************************************'
+        endif
 !
 #else
@@ -582 +707 @@
                                      nbdim, memberinall, coords,                            &
                                      sendtoproc1,recvfromproc1,                             &
-                                     tab4t(:,:,5),tab4t(:,:,6),tab4t(:,:,7),tab4t(:,:,8))
+                                     tab4t(:,:,5),tab4t(:,:,6),tab4t(:,:,7),tab4t(:,:,8),   &
+                                     tab4t(:,:,1),tab4t(:,:,2))
     endif
 
@@ -610 +736 @@
                                             s_Child_temp(1), s_Parent_temp(1),      &
                                             ds_child(1), ds_parent(1) )
-                                            
+
             IF (Agrif_UseSpecialValueInUpdate) THEN
             allocate(tempC_indic)
@@ -638 +764 @@
               enddo
             ENDIF
-            
+
             WHERE (tempCextend%array1 == Agrif_SpecialValueFineGrid)
               tempC_indic%array1 = 0.
@@ -644 +770 @@
               tempC_indic%array1 = 1.
             END WHERE
-            
+
             Agrif_UseSpecialValueInUpdate = .FALSE.
             Agrif_Update_Weights = .TRUE.
- 
+
              call Agrif_Update_1D_Recursive( type_update_temp(1),   &
                                             tempP_indic%array1,       &
@@ -675 +801 @@
                END WHERE
             ENDIF
-           
+
             deallocate(tempP_indic%array1)
             deallocate(tempC_indic%array1)
@@ -685 +811 @@
             ENDIF
             ENDIF
-            
+
         endif
         if ( nbdim == 2 ) then
@@ -701 +827 @@
             call Agrif_array_allocate(tempC_indic,lbound(tempCextend%array2),ubound(tempCextend%array2),nbdim)
             call Agrif_array_allocate(tempP_indic,lbound(tempP%array2),ubound(tempP%array2),nbdim)
- 
+
             compute_average = .FALSE.
             type_update_temp(1:nbdim) = type_update(1:nbdim)
@@ -723 +849 @@
               enddo
             ENDIF
-            
+
             WHERE (tempCextend%array2 == Agrif_SpecialValueFineGrid)
               tempC_indic%array2 = 0.
@@ -729 +855 @@
               tempC_indic%array2 = 1.
             END WHERE
-            
+
             Agrif_UseSpecialValueInUpdate = .FALSE.
             Agrif_Update_Weights = .TRUE.
-            
+
             call Agrif_Update_2D_Recursive( type_update_temp(1:2),   &
                                             tempP_indic%array2,       &
@@ -760 +886 @@
                END WHERE
             ENDIF
-           
+
             deallocate(tempP_indic%array2)
             deallocate(tempC_indic%array2)
@@ -770 +896 @@
             ENDIF
             ENDIF
-            
+
         endif
         if ( nbdim == 3 ) then
@@ -780 +906 @@
                                             s_Child_temp(1:3), s_Parent_temp(1:3),      &
                                             ds_child(1:3), ds_parent(1:3) )
-                                            
+
             IF (Agrif_UseSpecialValueInUpdate) THEN
             allocate(tempC_indic)
@@ -808 +934 @@
               enddo
             ENDIF
-            
+
             WHERE (tempCextend%array3 == Agrif_SpecialValueFineGrid)
               tempC_indic%array3 = 0.
@@ -814 +940 @@
               tempC_indic%array3 = 1.
             END WHERE
-            
+
             Agrif_UseSpecialValueInUpdate = .FALSE.
             Agrif_Update_Weights = .TRUE.
- 
+
              call Agrif_Update_3D_Recursive( type_update_temp(1:3),   &
                                             tempP_indic%array3,       &
@@ -845 +971 @@
                END WHERE
             ENDIF
-           
+
             deallocate(tempP_indic%array3)
             deallocate(tempC_indic%array3)
@@ -855 +981 @@
             ENDIF
             ENDIF
-            
+
         endif
         if ( nbdim == 4 ) then
@@ -865 +991 @@
                                             s_Child_temp(1:4), s_Parent_temp(1:4),      &
                                             ds_child(1:4), ds_parent(1:4) )
-                                            
+
             IF (Agrif_UseSpecialValueInUpdate) THEN
-            
+
             allocate(tempC_indic)
             allocate(tempP_indic)
             call Agrif_array_allocate(tempC_indic,lbound(tempCextend%array4),ubound(tempCextend%array4),nbdim)
             call Agrif_array_allocate(tempP_indic,lbound(tempP%array4),ubound(tempP%array4),nbdim)
-           
+
             compute_average = .FALSE.
             type_update_temp(1:nbdim) = type_update(1:nbdim)
@@ -894 +1020 @@
               enddo
             ENDIF
-            
+
             WHERE (tempCextend%array4 == Agrif_SpecialValueFineGrid)
               tempC_indic%array4 = 0.
@@ -900 +1026 @@
               tempC_indic%array4 = 1.
             END WHERE
-            
+
             Agrif_UseSpecialValueInUpdate = .FALSE.
             Agrif_Update_Weights = .TRUE.
- 
+
              call Agrif_Update_4D_Recursive( type_update_temp(1:4),   &
                                             tempP_indic%array4,       &
@@ -914 +1040 @@
            Agrif_UseSpecialValueInUpdate = .TRUE.
            Agrif_Update_Weights = .FALSE.
-           
+
            IF (compute_average) THEN
                WHERE (tempP_indic%array4 == 0.)
@@ -940 +1066 @@
             ENDIF
             ENDIF
-            
+
         endif
         if ( nbdim == 5 ) then
@@ -950 +1076 @@
                                             s_Child_temp(1:5), s_Parent_temp(1:5),      &
                                             ds_child(1:5), ds_parent(1:5) )
-                                            
+
             IF (Agrif_UseSpecialValueInUpdate) THEN
             allocate(tempC_indic)
@@ -978 +1104 @@
               enddo
             ENDIF
-            
+
             WHERE (tempCextend%array5 == Agrif_SpecialValueFineGrid)
               tempC_indic%array5 = 0.
@@ -984 +1110 @@
               tempC_indic%array5 = 1.
             END WHERE
-            
+
             Agrif_UseSpecialValueInUpdate = .FALSE.
             Agrif_Update_Weights = .TRUE.
- 
+
              call Agrif_Update_5D_Recursive( type_update_temp(1:5),   &
                                             tempP_indic%array5,       &
@@ -1015 +1141 @@
                END WHERE
             ENDIF
-           
+
             deallocate(tempP_indic%array5)
             deallocate(tempC_indic%array5)
@@ -1025 +1151 @@
             ENDIF
             ENDIF
-            
+
         endif
         if ( nbdim == 6 ) then
@@ -1080 +1206 @@
                END WHERE
             ENDIF
-            
+
             Agrif_UseSpecialValueInUpdate = .FALSE.
             Agrif_Update_Weights = .TRUE.
- 
+
              call Agrif_Update_6D_Recursive( type_update_temp(1:6),   &
                                             tempP_indic%array6,       &
@@ -1094 +1220 @@
            Agrif_UseSpecialValueInUpdate = .TRUE.
            Agrif_Update_Weights = .FALSE.
-           
+
             WHERE (tempP_indic%array6 == 0.)
               tempP%array6 = Agrif_SpecialValueFineGrid
@@ -1100 +1226 @@
               tempP%array6 = tempP%array6 /tempP_indic%array6
             END WHERE
-           
+
             deallocate(tempP_indic%array6)
             deallocate(tempC_indic%array6)
@@ -1116 +1242 @@
     ENDIF
 
+    if (agrif_debug_update .and. nbdim==2) then
+        print *,'MINMAXUPDATE = ',minval(tempP%array2),maxval(tempP%array2)
+    endif
+
 #if defined AGRIF_MPI
     local_proc = Agrif_Procrank
     call Agrif_get_var_bounds_array(parent,lowerbound,upperbound,nbdim)
     call Agrif_ChildGrid_to_ParentGrid()
-    call Agrif_Childbounds(nbdim, lowerbound, upperbound,                   &
-                           indminglob,  indmaxglob,  local_proc, coords,    &
-                           indminglob2, indmaxglob2, member)
-!
-    IF (member) THEN
-        call Agrif_GlobalToLocalBounds(parentarray, lowerbound, upperbound, &
-                                       indminglob2, indmaxglob2, coords,    &
-                                       nbdim, local_proc, member)
-    ENDIF
-
-    call Agrif_ParentGrid_to_ChildGrid()
+
+          parentarray(:,1,1) = indminglob
+          parentarray(:,2,1) = indmaxglob
+          parentarray(:,1,2) = indminglob
+          parentarray(:,2,2) = indmaxglob
+        if (associated(agrif_external_mapping)) then
+          call agrif_external_mapping(nbdim,child%root_var % posvar(1),child%root_var % posvar(2), &
+                                      parentarray,parentarray_chunk,correction_required,nb_chunks)
+          allocate(decal_chunks(nb_chunks,nbdim))
+          do i=1,nb_chunks
+            decal_chunks(i,:)=parentarray_chunk(i,:,1,1)-parentarray_chunk(i,:,1,2)
+          enddo
+        else
+            nb_chunks=1
+            allocate(correction_required(nb_chunks))
+            correction_required=.FALSE.
+            allocate(parentarray_chunk(nb_chunks,nbdim,2,2))
+            parentarray_chunk(1,:,:,:)=parentarray
+            allocate(decal_chunks(nb_chunks,nbdim))
+            decal_chunks=0
+        endif
+        if (agrif_debug_update) then
+        print *,'AVANT PARENTCHILDBOUNDS'
+        print *,'nombre de chunks ',nb_chunks
+        do i=1,nb_chunks
+          print *,'CHUNK Number : ',i
+          do j=1,nbdim
+           print *,'Direction ',j
+           print *,'MIN MAX (2) = ',parentarray_chunk(i,j,1,2),parentarray_chunk(i,j,2,2)
+           print *,'MIN MAX (1) = ',parentarray_chunk(i,j,1,1),parentarray_chunk(i,j,2,1)
+          enddo
+        enddo
+        print *,'APRES PARENTCHILDBOUNDS'
+        endif
+
+        allocate(indminglob_chunks(nb_chunks,nbdim))
+        allocate(indmaxglob_chunks(nb_chunks,nbdim))
+        allocate(indminglob2_chunks(nb_chunks,nbdim))
+        allocate(indmaxglob2_chunks(nb_chunks,nbdim))
+        allocate(indminglob3_chunks(nb_chunks,nbdim))
+        allocate(indmaxglob3_chunks(nb_chunks,nbdim))
+        allocate(member_chuncks(nb_chunks))
+
+        do i=1,nb_chunks
+          indminglob_chunks(i,:) = parentarray_chunk(i,:,1,2)
+          indmaxglob_chunks(i,:) = parentarray_chunk(i,:,2,2)
+        enddo
+
+        do i=1,nb_chunks
+              call Agrif_Childbounds(nbdim,lowerbound,upperbound,         &
+                   indminglob_chunks(i,:),indmaxglob_chunks(i,:), local_proc, coords,   &
+                   indminglob2_chunks(i,:),indmaxglob2_chunks(i,:),member_chuncks(i))
+        enddo
+
+        if (agrif_debug_update) then
+        print *,'************CHILDBOUNDSPARENTMPI*********************************'
+#ifdef AGRIF_MPI
+         print *,'Processeur ',Agrif_Procrank
+#endif
+        do j=1,nb_chunks
+        print *,'Chunk number ',j
+
+        do i = 1 , nbdim
+        print *,'Direction ',i,' indices debut: ',indminglob_chunks(j,i),indminglob2_chunks(j,i)
+        print *,'Direction ',i,' indices fin  : ',indmaxglob_chunks(j,i),indmaxglob2_chunks(j,i)
+        enddo
+        enddo
+        print *,'*********************************************'
+        endif
+
+        allocate(parentarray_chunk_decal(nb_chunks,nbdim,2,2))
+        do j=1,nb_chunks
+        if (agrif_debug_update) print *,'CHUNK = ',j
+        if (member_chuncks(j)) then
+            ! call Agrif_GlobalToLocalBounds(parentarray_chunk(j,:,:,:),                               &
+                                           ! lowerbound,  upperbound,                                  &
+                                           ! indminglob2_chunks(j,:), indmaxglob2_chunks(j,:), coords, &
+                                           ! nbdim, local_proc, member_chuncks(j),check_perio=.TRUE.)
+
+            call Agrif_GlobalToLocalBounds(parentarray_chunk(j,:,:,:),                               &
+                                           lowerbound,  upperbound,                                  &
+                                           indminglob2_chunks(j,:), indmaxglob2_chunks(j,:), coords, &
+                                           nbdim, local_proc, member_chuncks(j))
+
+            if (correction_required(j)) then
+                do i=1,2
+                    test_orientation(1)=agrif_external_switch_index(child%root_var % posvar(1),child%root_var % posvar(2), &
+                    parentarray_chunk(j,i,1,1),i)
+                    test_orientation(2)=agrif_external_switch_index(child%root_var % posvar(1),child%root_var % posvar(2), &
+                    parentarray_chunk(j,i,2,1),i)
+                    parentarray_chunk_decal(j,i,1,1)=minval(test_orientation)
+                    parentarray_chunk_decal(j,i,2,1)=maxval(test_orientation)
+                enddo
+                do i=3,nbdim
+                  parentarray_chunk_decal(j,i,:,1) = parentarray_chunk(j,i,:,1)+decal_chunks(j,i)
+                enddo
+            else
+            do i=1,nbdim
+            parentarray_chunk_decal(j,i,:,1) = parentarray_chunk(j,i,:,1)+decal_chunks(j,i)
+            enddo
+            endif
+
+            if (agrif_debug_update) then
+            do i=1,nbdim
+            print *,'parentarray = ',i,parentarray_chunk(j,i,1,1),parentarray_chunk(j,i,2,1), &
+                parentarray_chunk(j,i,1,2),parentarray_chunk(j,i,2,2)
+                print *,'parentarraydecal = ',i,parentarray_chunk_decal(j,i,1,1),parentarray_chunk_decal(j,i,2,1)
+            enddo
+            endif
+        endif
+        enddo
+
+!     call Agrif_Childbounds(nbdim, lowerbound, upperbound,                   &
+!                            indminglob,  indmaxglob,  local_proc, coords,    &
+!                            indminglob2, indmaxglob2, member)
+
+!         if (agrif_debug_update) then
+!         print *,'************CHILDBOUNDS PARENT*********************************'
+! #ifdef AGRIF_MPI
+!          print *,'Processeur ',Agrif_Procrank
+! #endif
+!         print *,'member ',member
+!         do i = 1 , nbdim
+!         print *,'Direction ',i,' indminglob2 : ',indminglob2(i)
+!         print *,'Direction ',i,' indmaxglob2 : ',indmaxglob2(i)
+!         enddo
+!         print *,'*********************************************'
+!         endif
+!
+!     IF (member) THEN
+!         call Agrif_GlobalToLocalBounds(parentarray, lowerbound, upperbound, &
+!                                        indminglob2, indmaxglob2, coords,    &
+!                                        nbdim, local_proc, member,check_perio=.TRUE.)
+!     ENDIF
+
+!         if (agrif_debug_update) then
+!         print *,'************GlobalToLocalBounds II******************'
+! #ifdef AGRIF_MPI
+!          print *,'Processeur ',Agrif_Procrank
+! #endif
+!         do i = 1 , nbdim
+!         print *,'Direction ',i,' parentarray global : ',parentarray(i,1,1),parentarray(i,2,1)
+!         print *,'Direction ',i,' parentarray local  : ',parentarray(i,1,2),parentarray(i,2,2)
+!         enddo
+
+!         print *,'*********************************************'
+!         endif
+
+
+        parentarray(:,1,:)=Huge(1)
+        parentarray(:,2,:)=-Huge(1)
+        indminglob2=Huge(1)
+        indmaxglob2=-Huge(1)
+        member = .FALSE.
+        do j=1,nb_chunks
+          if (member_chuncks(j)) then
+            do i=1,nbdim
+             parentarray(i,1,1) = min(parentarray(i,1,1),parentarray_chunk_decal(j,i,1,1))
+             parentarray(i,1,2) = min(parentarray(i,1,2),parentarray_chunk(j,i,1,2))
+             parentarray(i,2,1) = max(parentarray(i,2,1),parentarray_chunk_decal(j,i,2,1))
+             parentarray(i,2,2) = max(parentarray(i,2,2),parentarray_chunk(j,i,2,2))
+            enddo
+
+            if (correction_required(j)) then
+                do i=1,2
+                    test_orientation(1)=agrif_external_switch_index(child%root_var % posvar(1),child%root_var % posvar(2), &
+                    indminglob2_chunks(j,i),i)
+                    test_orientation(2)=agrif_external_switch_index(child%root_var % posvar(1),child%root_var % posvar(2), &
+                    indmaxglob2_chunks(j,i),i)
+                    indminglob2(i)=min(indminglob2(i),minval(test_orientation))
+                    indmaxglob2(i)=max(indmaxglob2(i),maxval(test_orientation))
+                enddo
+
+                do i=3,nbdim
+             indminglob2(i)=min(indminglob2(i),indminglob2_chunks(j,i)+decal_chunks(j,i))
+             indmaxglob2(i)=max(indmaxglob2(i),indmaxglob2_chunks(j,i)+decal_chunks(j,i))
+                enddo
+            else
+                           do i=1,nbdim
+             indminglob2(i)=min(indminglob2(i),indminglob2_chunks(j,i)+decal_chunks(j,i))
+             indmaxglob2(i)=max(indmaxglob2(i),indmaxglob2_chunks(j,i)+decal_chunks(j,i))
+                         enddo
+         endif
+
+            member = .TRUE.
+          endif
+        enddo
+
+        call Agrif_ParentGrid_to_ChildGrid()
+
+        if (agrif_debug_update) then
+        print *,'************ FINAL PARENTARRAY *****************'
+#ifdef AGRIF_MPI
+        print *,'Processeur ',Agrif_Procrank,' MEMBER = ',member
+        do i=1,nbdim
+         print *,'Direction ',i,' indices debut = ',parentarray(i,1,1),parentarray(i,1,2)
+         print *,'Direction ',i,' indices fin = ',parentarray(i,2,1),parentarray(i,2,2)
+        enddo
+#endif
+        endif
+
+        if (agrif_debug_update) then
+        print *,'************ FINAL INDMINGLOB *****************'
+#ifdef AGRIF_MPI
+        print *,'Processeur ',Agrif_Procrank,' MEMBER = ',member
+        do i=1,nbdim
+         print *,'Direction ',i,' indices debut = ',indminglob2(i)
+         print *,'Direction ',i,' indices fin = ',indmaxglob2(i)
+        enddo
+#endif
+        endif
 
     if (.not.find_list_update) then
@@ -1154 +1484 @@
                                      nbdim, memberinall2, coords,                           &
                                      sendtoproc2, recvfromproc2,                            &
-                                     tab5t(:,:,5),tab5t(:,:,6),tab5t(:,:,7),tab5t(:,:,8))
+                                     tab5t(:,:,5),tab5t(:,:,6),tab5t(:,:,7),tab5t(:,:,8),   &
+                                     tab5t(:,:,1),tab5t(:,:,2))
 
         call Agrif_Addto_list_update(child%list_update,pttab,petab,lb_child,lb_parent,      &
@@ -1171 +1502 @@
     parentarray(:,1,2) = indmin
     parentarray(:,2,2) = indmax
+
+        if (associated(agrif_external_mapping)) then
+          call Agrif_ChildGrid_to_ParentGrid()
+          call agrif_external_mapping(nbdim,child%root_var % posvar(1),child%root_var % posvar(2), &
+                                      parentarray,parentarray_chunk,correction_required,nb_chunks)
+          call Agrif_ParentGrid_to_ChildGrid()
+          allocate(decal_chunks(nb_chunks,nbdim))
+          do i=1,nb_chunks
+            decal_chunks(i,:)=parentarray_chunk(i,:,1,1)-parentarray_chunk(i,:,1,2)
+          enddo
+        else
+            nb_chunks=1
+            allocate(correction_required(nb_chunks))
+            correction_required=.FALSE.
+            allocate(parentarray_chunk(nb_chunks,nbdim,2,2))
+            parentarray_chunk(1,:,:,:)=parentarray
+        endif
+        if (agrif_debug_update) then
+        print *,'AVANT PARENTCHILDBOUNDS'
+        print *,'nombre de chunks ',nb_chunks
+        do i=1,nb_chunks
+          print *,'CHUNK Number : ',i
+          do j=1,nbdim
+           print *,'Direction ',j
+           print *,'MIN MAX (2) = ',parentarray_chunk(i,j,1,2),parentarray_chunk(i,j,2,2)
+           print *,'MIN MAX (1) = ',parentarray_chunk(i,j,1,1),parentarray_chunk(i,j,2,1)
+          enddo
+        enddo
+        print *,'APRES PARENTCHILDBOUNDS'
+        endif
+        allocate(member_chuncks(nb_chunks))
+        allocate(parentarray_chunk_decal(nb_chunks,nbdim,2,2))
+        member_chuncks = .TRUE.
+        member = .TRUE.
+        do j=1,nb_chunks
+        if (agrif_debug_update) print *,'CHUNK = ',j
+        if (member_chuncks(j)) then
+            do i=1,nbdim
+            parentarray_chunk_decal(j,i,:,1) = parentarray_chunk(j,i,:,1)   !+decal_chunks(j,i)
+            enddo
+            if (agrif_debug_update) then
+            do i=1,nbdim
+            print *,'parentarray = ',i,parentarray_chunk(j,i,1,1),parentarray_chunk(j,i,2,1), &
+                parentarray_chunk(j,i,1,2),parentarray_chunk(j,i,2,2)
+                print *,'parentarraydecal = ',i,parentarray_chunk_decal(j,i,1,1),parentarray_chunk_decal(j,i,2,1)
+            enddo
+            endif
+        endif
+        enddo
+
     member = .TRUE.
 #endif
+
+        if (agrif_debug_update .and. nbdim==2) then
+        print *,'MINMAXUPDATEEXTND = ',minval(tempPextend%array2),maxval(tempPextend%array2)
+    endif
 !
 !   Special values on the child grid
@@ -1230 +1615 @@
     endif
 !
-    IF (member) THEN
+
 
         call Agrif_ChildGrid_to_ParentGrid()
+
+        if (nb_chunks > 1) then
+            allocate(tempPextend_chunk)
+            SELECT CASE(nbdim)
+            CASE(1)
+                call Agrif_array_allocate(tempPextend_chunk,lbound(tempPextend%array1),ubound(tempPextend%array1),nbdim)
+            CASE(2)
+                call Agrif_array_allocate(tempPextend_chunk,lbound(tempPextend%array2),ubound(tempPextend%array2),nbdim)
+            CASE(3)
+                call Agrif_array_allocate(tempPextend_chunk,lbound(tempPextend%array3),ubound(tempPextend%array3),nbdim)
+            CASE(4)
+                call Agrif_array_allocate(tempPextend_chunk,lbound(tempPextend%array4),ubound(tempPextend%array4),nbdim)
+            CASE(5)
+                call Agrif_array_allocate(tempPextend_chunk,lbound(tempPextend%array5),ubound(tempPextend%array5),nbdim)
+            CASE(6)
+                call Agrif_array_allocate(tempPextend_chunk,lbound(tempPextend%array6),ubound(tempPextend%array6),nbdim)
+            END SELECT
+        else
+            tempPextend_chunk => tempPextend
+        endif
+
+        do i=1,nb_chunks
+
+        if (member_chuncks(i)) then
+
+            if (nb_chunks > 1) then
+                call Agrif_var_copy_array (tempPextend_chunk, parentarray_chunk_decal(i,:,1,1), parentarray_chunk_decal(i,:,2,1), &
+                                           tempPextend, parentarray_chunk_decal(i,:,1,1), parentarray_chunk_decal(i,:,2,1), nbdim )
+            endif
 !
         SELECT CASE(nbdim)
         CASE(1)
-            call procname( tempPextend % array1(            &
-                    parentarray(1,1,1):parentarray(1,2,1)), &
-                    parentarray(1,1,2),parentarray(1,2,2),.FALSE.,nbin,ndirin)
+            ! call procname( tempPextend % array1(            &
+            !         parentarray(1,1,1):parentarray(1,2,1)), &
+            !         parentarray(1,1,2),parentarray(1,2,2),.FALSE.,nbin,ndirin)
+
+            call procname(tempPextend_chunk%array1(parentarray_chunk_decal(i,1,1,1):parentarray_chunk_decal(i,1,2,1)),         &
+                      parentarray_chunk(i,1,1,2),parentarray_chunk(i,1,2,2),.FALSE.,nbin,ndirin)
+
         CASE(2)
-            call procname( tempPextend % array2(            &
-                    parentarray(1,1,1):parentarray(1,2,1),  &
-                    parentarray(2,1,1):parentarray(2,2,1)), &
-                    parentarray(1,1,2),parentarray(1,2,2),  &
-                    parentarray(2,1,2),parentarray(2,2,2),.FALSE.,nbin,ndirin)
+
+            if (correction_required(i)) then
+              call correct_field(tempPextend_chunk%array2(parentarray_chunk_decal(i,1,1,1):parentarray_chunk_decal(i,1,2,1), &
+                      parentarray_chunk_decal(i,2,1,1):parentarray_chunk_decal(i,2,2,1)), &
+                      parentarray_chunk_decal(i,1,1,1),parentarray_chunk_decal(i,1,2,1), &
+                      parentarray_chunk_decal(i,2,1,1),parentarray_chunk_decal(i,2,2,1))
+            endif
+
+            call procname(tempPextend_chunk%array2(parentarray_chunk_decal(i,1,1,1):parentarray_chunk_decal(i,1,2,1), &
+                      parentarray_chunk_decal(i,2,1,1):parentarray_chunk_decal(i,2,2,1)),         &
+                      parentarray_chunk(i,1,1,2),parentarray_chunk(i,1,2,2),    &
+                      parentarray_chunk(i,2,1,2),parentarray_chunk(i,2,2,2),.FALSE.,nbin,ndirin)
+
         CASE(3)
-            call procname( tempPextend % array3(            &
-                    parentarray(1,1,1):parentarray(1,2,1),  &
-                    parentarray(2,1,1):parentarray(2,2,1),  &
-                    parentarray(3,1,1):parentarray(3,2,1)), &
-                    parentarray(1,1,2),parentarray(1,2,2),  &
-                    parentarray(2,1,2),parentarray(2,2,2),  &
-                    parentarray(3,1,2),parentarray(3,2,2),.FALSE.,nbin,ndirin)
+
+            if (correction_required(i)) then
+                do k=parentarray_chunk(i,3,1,2),parentarray_chunk(i,3,2,2)
+              call correct_field(tempPextend_chunk%array3(parentarray_chunk_decal(i,1,1,1):parentarray_chunk_decal(i,1,2,1), &
+                      parentarray_chunk_decal(i,2,1,1):parentarray_chunk_decal(i,2,2,1),k), &
+                      parentarray_chunk_decal(i,1,1,1),parentarray_chunk_decal(i,1,2,1), &
+                      parentarray_chunk_decal(i,2,1,1),parentarray_chunk_decal(i,2,2,1))
+                enddo
+            endif
+
+            call procname(tempPextend_chunk%array3(parentarray_chunk_decal(i,1,1,1):parentarray_chunk_decal(i,1,2,1), &
+                      parentarray_chunk_decal(i,2,1,1):parentarray_chunk_decal(i,2,2,1), &
+                      parentarray_chunk_decal(i,3,1,1):parentarray_chunk_decal(i,3,2,1)),         &
+                      parentarray_chunk(i,1,1,2),parentarray_chunk(i,1,2,2),    &
+                      parentarray_chunk(i,2,1,2),parentarray_chunk(i,2,2,2),    &
+                      parentarray_chunk(i,3,1,2),parentarray_chunk(i,3,2,2),.FALSE.,nbin,ndirin)
+
+
+
+
         CASE(4)
-            call procname( tempPextend % array4(            &
-                    parentarray(1,1,1):parentarray(1,2,1),  &
-                    parentarray(2,1,1):parentarray(2,2,1),  &
-                    parentarray(3,1,1):parentarray(3,2,1),  &
-                    parentarray(4,1,1):parentarray(4,2,1)), &
-                    parentarray(1,1,2),parentarray(1,2,2),  &
-                    parentarray(2,1,2),parentarray(2,2,2),  &
-                    parentarray(3,1,2),parentarray(3,2,2),  &
-                    parentarray(4,1,2),parentarray(4,2,2),.FALSE.,nbin,ndirin)
+
+            if (correction_required(i)) then
+                do l=parentarray_chunk(i,4,1,2),parentarray_chunk(i,4,2,2)
+                do k=parentarray_chunk(i,3,1,2),parentarray_chunk(i,3,2,2)
+              call correct_field(tempPextend_chunk%array4(parentarray_chunk_decal(i,1,1,1):parentarray_chunk_decal(i,1,2,1), &
+                      parentarray_chunk_decal(i,2,1,1):parentarray_chunk_decal(i,2,2,1),k,l), &
+                      parentarray_chunk_decal(i,1,1,1),parentarray_chunk_decal(i,1,2,1), &
+                      parentarray_chunk_decal(i,2,1,1),parentarray_chunk_decal(i,2,2,1))
+                enddo
+            enddo
+            endif
+
+            call procname(tempPextend_chunk%array4(parentarray_chunk_decal(i,1,1,1):parentarray_chunk_decal(i,1,2,1), &
+                      parentarray_chunk_decal(i,2,1,1):parentarray_chunk_decal(i,2,2,1), &
+                      parentarray_chunk_decal(i,3,1,1):parentarray_chunk_decal(i,3,2,1), &
+                      parentarray_chunk_decal(i,4,1,1):parentarray_chunk_decal(i,4,2,1)),         &
+                      parentarray_chunk(i,1,1,2),parentarray_chunk(i,1,2,2),    &
+                      parentarray_chunk(i,2,1,2),parentarray_chunk(i,2,2,2),    &
+                      parentarray_chunk(i,3,1,2),parentarray_chunk(i,3,2,2),    &
+                      parentarray_chunk(i,4,1,2),parentarray_chunk(i,4,2,2),.FALSE.,nbin,ndirin)
+
         CASE(5)
-            call procname( tempPextend % array5(            &
-                    parentarray(1,1,1):parentarray(1,2,1),  &
-                    parentarray(2,1,1):parentarray(2,2,1),  &
-                    parentarray(3,1,1):parentarray(3,2,1),  &
-                    parentarray(4,1,1):parentarray(4,2,1),  &
-                    parentarray(5,1,1):parentarray(5,2,1)), &
-                    parentarray(1,1,2),parentarray(1,2,2),  &
-                    parentarray(2,1,2),parentarray(2,2,2),  &
-                    parentarray(3,1,2),parentarray(3,2,2),  &
-                    parentarray(4,1,2),parentarray(4,2,2),  &
-                    parentarray(5,1,2),parentarray(5,2,2),.FALSE.,nbin,ndirin)
+
+            if (correction_required(i)) then
+                do m=parentarray_chunk(i,5,1,2),parentarray_chunk(i,5,2,2)
+                do l=parentarray_chunk(i,4,1,2),parentarray_chunk(i,4,2,2)
+                do k=parentarray_chunk(i,3,1,2),parentarray_chunk(i,3,2,2)
+              call correct_field(tempPextend_chunk%array5(parentarray_chunk_decal(i,1,1,1):parentarray_chunk_decal(i,1,2,1), &
+                      parentarray_chunk_decal(i,2,1,1):parentarray_chunk_decal(i,2,2,1),k,l,m), &
+                      parentarray_chunk_decal(i,1,1,1),parentarray_chunk_decal(i,1,2,1), &
+                      parentarray_chunk_decal(i,2,1,1),parentarray_chunk_decal(i,2,2,1))
+                enddo
+            enddo
+            enddo
+            endif
+
+            call procname(tempPextend_chunk%array5(parentarray_chunk_decal(i,1,1,1):parentarray_chunk_decal(i,1,2,1), &
+                      parentarray_chunk_decal(i,2,1,1):parentarray_chunk_decal(i,2,2,1), &
+                      parentarray_chunk_decal(i,3,1,1):parentarray_chunk_decal(i,3,2,1), &
+                      parentarray_chunk_decal(i,4,1,1):parentarray_chunk_decal(i,4,2,1), &
+                      parentarray_chunk_decal(i,5,1,1):parentarray_chunk_decal(i,5,2,1)),         &
+                      parentarray_chunk(i,1,1,2),parentarray_chunk(i,1,2,2),    &
+                      parentarray_chunk(i,2,1,2),parentarray_chunk(i,2,2,2),    &
+                      parentarray_chunk(i,3,1,2),parentarray_chunk(i,3,2,2),    &
+                      parentarray_chunk(i,4,1,2),parentarray_chunk(i,4,2,2),    &
+                      parentarray_chunk(i,5,1,2),parentarray_chunk(i,5,2,2),.FALSE.,nbin,ndirin)
+
         CASE(6)
-            call procname( tempPextend % array6(            &
-                    parentarray(1,1,1):parentarray(1,2,1),  &
-                    parentarray(2,1,1):parentarray(2,2,1),  &
-                    parentarray(3,1,1):parentarray(3,2,1),  &
-                    parentarray(4,1,1):parentarray(4,2,1),  &
-                    parentarray(5,1,1):parentarray(5,2,1),  &
-                    parentarray(6,1,1):parentarray(6,2,1)), &
-                    parentarray(1,1,2),parentarray(1,2,2),  &
-                    parentarray(2,1,2),parentarray(2,2,2),  &
-                    parentarray(3,1,2),parentarray(3,2,2),  &
-                    parentarray(4,1,2),parentarray(4,2,2),  &
-                    parentarray(5,1,2),parentarray(5,2,2),  &
-                    parentarray(6,1,2),parentarray(6,2,2),.FALSE.,nbin,ndirin)
+
+            call procname(tempPextend_chunk%array6(parentarray_chunk_decal(i,1,1,1):parentarray_chunk_decal(i,1,2,1), &
+                      parentarray_chunk_decal(i,2,1,1):parentarray_chunk_decal(i,2,2,1), &
+                      parentarray_chunk_decal(i,3,1,1):parentarray_chunk_decal(i,3,2,1), &
+                      parentarray_chunk_decal(i,4,1,1):parentarray_chunk_decal(i,4,2,1), &
+                      parentarray_chunk_decal(i,5,1,1):parentarray_chunk_decal(i,5,2,1), &
+                      parentarray_chunk_decal(i,6,1,1):parentarray_chunk_decal(i,6,2,1)),         &
+                      parentarray_chunk(i,1,1,2),parentarray_chunk(i,1,2,2),    &
+                      parentarray_chunk(i,2,1,2),parentarray_chunk(i,2,2,2),    &
+                      parentarray_chunk(i,3,1,2),parentarray_chunk(i,3,2,2),    &
+                      parentarray_chunk(i,4,1,2),parentarray_chunk(i,4,2,2),    &
+                      parentarray_chunk(i,5,1,2),parentarray_chunk(i,5,2,2),&
+                      parentarray_chunk(i,6,1,2),parentarray_chunk(i,6,2,2),.FALSE.,nbin,ndirin)
+
         END SELECT
+        ENDIF
+        enddo ! enddo i=1,nb_chunks
+
+        if (nb_chunks > 1) then
+            call Agrif_array_deallocate(tempPextend_chunk,nbdim)
+            deallocate(tempPextend_chunk)
+        endif
 !
         call Agrif_ParentGrid_to_ChildGrid()
 !
-        call Agrif_array_deallocate(tempPextend,nbdim)
-!
-    ENDIF
+        if (ANY(member_chuncks)) call Agrif_array_deallocate(tempPextend,nbdim)
+!
+
 !
 #if defined AGRIF_MPI
@@ -1355 +1828 @@
         IF ( do_update(i) ) THEN
             IF (posvar(i) == 1) THEN
-                IF      (type_update(i) == Agrif_Update_Average) THEN
+                IF ((type_update(i) == Agrif_Update_Average).OR.(type_update(i) == Agrif_Update_Max)) THEN
                     positionmin = positionmin - ds_parent(i)/2.
                 ELSE IF (type_update(i) == Agrif_Update_Full_Weighting) THEN
@@ -1381 +1854 @@
         IF ( do_update(i) ) THEN
             IF (posvar(i) == 1) THEN
-                IF      (type_update(i) == Agrif_Update_Average) THEN
+                IF ((type_update(i) == Agrif_Update_Average).OR.(type_update(i) == Agrif_Update_Max)) THEN
                     positionmax = positionmax  + ds_parent(i)/2.
                 ELSE IF (type_update(i) == Agrif_Update_Full_Weighting) THEN
@@ -2007 +2480 @@
                     ds_parent, ds_child )
 !
+    elseif ( type_update == Agrif_Update_Max ) then
+!
+        call Agrif_basicupdate_max1d(           &
+                    parent_tab, child_tab,          &
+                    np,         nc,                 &
+                     s_parent,  s_child,            &
+                    ds_parent, ds_child )
     elseif ( type_update == Agrif_Update_Full_Weighting ) then
 !

vendors/AGRIF/dev/AGRIF_FILES/modupdatebasic.F90

@@ -220 +220 @@
 end subroutine Agrif_basicupdate_average1d
 !===================================================================================================
+
+!===================================================================================================
+!  subroutine Agrif_basicupdate_max1d
+!
+!> Carries out an update by taking the maximum on a parent grid (vector x)from its child grid (vector y).
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_basicupdate_max1d ( x, y, np, nc, s_parent, s_child, ds_parent, ds_child )
+!---------------------------------------------------------------------------------------------------
+    REAL, DIMENSION(np), intent(out)    :: x
+    REAL, DIMENSION(nc), intent(in)     :: y
+    INTEGER,             intent(in)     :: np,nc
+    REAL,                intent(in)     :: s_parent,  s_child
+    REAL,                intent(in)     :: ds_parent, ds_child
+!
+    INTEGER :: i, ii, locind_child_left, coeffraf
+    REAL    :: xpos, invcoeffraf
+    INTEGER :: nbnonnuls
+    INTEGER :: diffmod
+!
+    coeffraf = nint(ds_parent/ds_child)
+    invcoeffraf = 1./coeffraf
+!
+    if (coeffraf == 1) then
+        locind_child_left = 1 + nint((s_parent - s_child)/ds_child)
+        x(1:np) = y(locind_child_left:locind_child_left+np-1)
+        return
+    endif
+!
+    xpos = s_parent
+    x = -HUGE(1.0)
+!
+    diffmod = 0
+!
+    IF ( mod(coeffraf,2) == 0 ) diffmod = 1
+!
+    locind_child_left = 1 + agrif_int((xpos - s_child)/ds_child)
+!
+    IF (Agrif_UseSpecialValueInUpdate) THEN
+        do i = 1,np
+            nbnonnuls = 0
+!CDIR NOVECTOR
+            do ii = -coeffraf/2+locind_child_left+diffmod, &
+                     coeffraf/2+locind_child_left
+                IF (y(ii) /= Agrif_SpecialValueFineGrid) THEN
+                    x(i) = max(x(i),y(ii))
+                ENDIF
+            enddo
+            locind_child_left = locind_child_left + coeffraf
+        enddo
+    ELSE
+!
+!CDIR ALTCODE
+        do i = 1,np
+!CDIR NOVECTOR
+            do ii = -coeffraf/2+locind_child_left+diffmod, &
+                     coeffraf/2+locind_child_left
+                x(i) = max(x(i),y(ii))
+            enddo
+            locind_child_left = locind_child_left + coeffraf
+        enddo
+    ENDIF
+!---------------------------------------------------------------------------------------------------
+end subroutine Agrif_basicupdate_max1d
+!===================================================================================================
+
 !
 !===================================================================================================

vendors/AGRIF/dev/AGRIF_FILES/modutil.F90

@@ -108 +108 @@
 !---------------------------------------------------------------------------------------------------
 end subroutine Agrif_Step_Child
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine Agrif_Step_Childs
+!
+!> Apply 'procname' to each child grids of the current grid
+!---------------------------------------------------------------------------------------------------
+!     **************************************************************************
+!!!   Subroutine Agrif_Step_Childs
+!     **************************************************************************
+!
+      Subroutine Agrif_Step_Childs(procname)
+!
+    procedure(step_proc)    :: procname     !< subroutine to call on each grid
+!     Pointer argument
+      Type(Agrif_Grid),pointer   :: g        ! Pointer on the current grid
+!
+
+!
+!     Local pointer
+      Type(Agrif_pgrid),pointer  :: parcours ! Pointer for the recursive
+                                             ! procedure
+!
+      g => Agrif_Curgrid
+      
+      parcours => g % child_list % first
+!
+!     Recursive procedure for the time integration of the grid hierarchy      
+      Do while (associated(parcours))
+!
+!       Instanciation of the variables of the current grid
+        Call Agrif_Instance(parcours % gr)
+
+!     One step on the current grid
+
+         Call procname ()
+        parcours => parcours % next
+      enddo
+   
+      If (associated(g % child_list % first)) Call Agrif_Instance (g)
+      Return
+      End Subroutine Agrif_Step_Childs
 !===================================================================================================
 !
@@ -538 +580 @@
 !===================================================================================================
 !
+!===================================================================================================
+!
 !
 !===================================================================================================
@@ -587 +631 @@
 #ifdef AGRIF_MPI
     else
-#endif    
 ! Continue only if the grid has defined sequences of child integrations.
     if ( .not. associated(save_grid % child_seq) ) return
@@ -610 +653 @@
 !
     enddo
-#ifdef AGRIF_MPI
     endif
 #endif 
@@ -700 +742 @@
 subroutine Agrif_Init_Grids ( procname1, procname2 )
 !---------------------------------------------------------------------------------------------------
-    procedure(typdef_proc), optional   :: procname1 !< (Default: Agrif_probdim_modtype_def)
+    procedure(typedef_proc), optional   :: procname1 !< (Default: Agrif_probdim_modtype_def)
     procedure(alloc_proc),   optional   :: procname2 !< (Default: Agrif_Allocationcalls)
 !
@@ -717 +759 @@
     nunit = Agrif_Get_Unit()
     open(nunit, file='AGRIF_FixedGrids.in', form='formatted', status="old", ERR=98)
-    if (Agrif_Probdim == 3) then
-       read(nunit,*) is_coarse, rhox, rhoy, rhoz, rhot
-    elseif (Agrif_Probdim == 2) then
-       read(nunit,*) is_coarse, rhox, rhoy, rhot
-    elseif (Agrif_Probdim == 2) then
-       read(nunit,*) is_coarse, rhox, rhot
-    endif
+    read(nunit,*) is_coarse
     if (is_coarse == -1) then
        agrif_coarse = .TRUE.
+       rewind(nunit)
        if (Agrif_Probdim == 3) then
+          read(nunit,*) is_coarse, rhox, rhoy, rhoz, rhot
           coarse_spaceref(1:3)=(/rhox,rhoy,rhoz/)
        elseif (Agrif_Probdim == 2) then
+          read(nunit,*) is_coarse, rhox, rhoy, rhot
           coarse_spaceref(1:2)=(/rhox,rhoy/)
-       elseif (Agrif_Probdim == 2) then
+       elseif (Agrif_Probdim == 1) then
+          read(nunit,*) is_coarse, rhox, rhot
           coarse_spaceref(1:1)=(/rhox/)
        endif

vendors/AGRIF/dev/AGRIF_FILES/modvariables.F90

@@ -99 +99 @@
     Agrif_Curgrid % Nbvariables = Agrif_Curgrid % Nbvariables + 1
 
-    varid = -Agrif_Curgrid % Nbvariables
+    varid = Agrif_Curgrid % Nbvariables
 
     var % parent_var => Agrif_Search_Variable(Agrif_Curgrid % parent, Agrif_Curgrid % nbvariables)