Changeset 10087

Timestamp:

2018-09-05T15:33:44+02:00 (6 years ago)

Author:

rblod

Message:

update AGRIF library

Location:

vendors/AGRIF/CMEMS_2020/AGRIF_FILES

Files:

• modarrays.F90 (modified) (14 diffs)
• modbc.F90 (modified) (16 diffs)
• modbcfunction.F90 (modified) (6 diffs)
• modcluster.F90 (modified) (3 diffs)
• modcurgridfunctions.F90 (modified) (1 diff)
• modflux.F90 (added)
• modgrids.F90 (modified) (1 diff)
• modinit.F90 (modified) (1 diff)
• modinterp.F90 (modified) (50 diffs)
• modinterpbasic.F90 (modified) (20 diffs)
• modlinktomodel.F90 (modified) (3 diffs)
• modmask.F90 (modified) (9 diffs)
• modmpp.F90 (modified) (6 diffs)
• modsauv.F90 (modified) (5 diffs)
• modseq.F90 (modified) (1 diff)
• modtypes.F90 (modified) (9 diffs)
• modupdate.F90 (modified) (75 diffs)
• modupdatebasic.F90 (modified) (7 diffs)
• moduserfunctions.F90 (added)
• moduserhierarchy.F90 (added)
• moduserinterpolation.F90 (added)
• moduserupdate.F90 (added)
• moduservariables.F90 (added)
• modutil.F90 (modified) (2 diffs)
• modvariables.F90 (modified) (6 diffs)

vendors/AGRIF/CMEMS_2020/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)
 !---------------------------------------------------------------------------------------------------
     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
@@ -78 +80 @@
         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 (present(indminglob3)) then
+          indminglob3(i)=lb_glob_index
+          indmaxglob3(i)=ub_glob_index
+        endif
 #else
         lb_glob_index = lb_var(i)
         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)
+
     enddo
 !
@@ -123 +131 @@
 !
     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
@@ -225 +234 @@
     case (1) ; call Agrif_set_array_tozero_1D(variable%array1)
     case (2) ; call Agrif_set_array_tozero_2D(variable%array2)
-    case (3) ; call Agrif_set_array_tozero_3D(variable%array3)
+    case (3) ; call Agrif_set_array_tozero_reshape(variable%array3,size(variable%array3))
+!case (3) ; call Agrif_set_array_tozero_3D(variable%array3)
     case (4) ; call Agrif_set_array_tozero_4D(variable%array4)
     case (5) ; call Agrif_set_array_tozero_5D(variable%array5)
@@ -266 +276 @@
 !===================================================================================================
 !
+!===================================================================================================
+!
+!===================================================================================================
+!  subroutine agrif_set_array_cond
+!
+!> Compute the masking of \b variablein, according to the required dimension.
+!---------------------------------------------------------------------------------------------------
+subroutine agrif_set_array_cond ( variablein, variableout, value, nbdim )
+!---------------------------------------------------------------------------------------------------
+    type(Agrif_Variable), intent(in)    :: variablein     !< Variablein
+    type(Agrif_Variable), intent(inout) :: variableout    !< Variableout
+    real,intent(in) :: value                            !< special value
+    integer, intent(in)                 :: nbdim        !< Dimension of the array
+
+!
+    select case (nbdim)
+    case (1) ; call agrif_set_array_cond_1D(variablein%array1,variableout%array1,value)
+    case (2) ; call agrif_set_array_cond_2D(variablein%array2,variableout%array2,value)
+    case (3) ; call agrif_set_array_cond_reshape(variablein%array3,variableout%array3,value,size(variablein%array3))
+!    case (3) ; call agrif_set_array_cond_3D(variablein%array3,variableout%array3,value)
+    case (4) ; call agrif_set_array_cond_4D(variablein%array4,variableout%array4,value)
+    case (5) ; call agrif_set_array_cond_5D(variablein%array5,variableout%array5,value)
+    case (6) ; call agrif_set_array_cond_6D(variablein%array6,variableout%array6,value)
+    end select
+!---------------------------------------------------------------------------------------------------
+contains
+!---------------------------------------------------------------------------------------------------
+subroutine agrif_set_array_cond_1D(arrayin,arrayout,value)
+real,dimension(:),intent(in) :: arrayin
+real,dimension(:),intent(out) :: arrayout
+real :: value
+
+where (arrayin == value)
+  arrayout = 0.
+elsewhere
+  arrayout = 1.
+end where
+
+end subroutine agrif_set_array_cond_1D
+!
+subroutine agrif_set_array_cond_2D(arrayin,arrayout,value)
+real,dimension(:,:),intent(in) :: arrayin
+real,dimension(:,:),intent(out) :: arrayout
+real :: value
+
+where (arrayin == value)
+  arrayout = 0.
+elsewhere
+  arrayout = 1.
+end where
+
+end subroutine agrif_set_array_cond_2D
+!
+subroutine agrif_set_array_cond_3D(arrayin,arrayout,value)
+real,dimension(:,:,:),intent(in) :: arrayin
+real,dimension(:,:,:),intent(out) :: arrayout
+real :: value
+
+where (arrayin == value)
+  arrayout = 0.
+elsewhere
+  arrayout = 1.
+end where
+
+end subroutine agrif_set_array_cond_3D
+!
+subroutine agrif_set_array_cond_4D(arrayin,arrayout,value)
+real,dimension(:,:,:,:),intent(in) :: arrayin
+real,dimension(:,:,:,:),intent(out) :: arrayout
+real :: value
+
+where (arrayin == value)
+  arrayout = 0.
+elsewhere
+  arrayout = 1.
+end where
+
+end subroutine agrif_set_array_cond_4D
+!
+subroutine agrif_set_array_cond_5D(arrayin,arrayout,value)
+real,dimension(:,:,:,:,:),intent(in) :: arrayin
+real,dimension(:,:,:,:,:),intent(out) :: arrayout
+real :: value
+
+where (arrayin == value)
+  arrayout = 0.
+elsewhere
+  arrayout = 1.
+end where
+
+end subroutine agrif_set_array_cond_5D
+!
+subroutine agrif_set_array_cond_6D(arrayin,arrayout,value)
+real,dimension(:,:,:,:,:,:),intent(in) :: arrayin
+real,dimension(:,:,:,:,:,:),intent(out) :: arrayout
+real :: value
+
+where (arrayin == value)
+  arrayout = 0.
+elsewhere
+  arrayout = 1.
+end where
+
+end subroutine agrif_set_array_cond_6D
+!---------------------------------------------------------------------------------------------------
+end subroutine agrif_set_array_cond
 !===================================================================================================
 !  subroutine Agrif_var_copy_array
@@ -330 +446 @@
         real, dimension(l(1):,l(2):,l(3):), intent(out) :: tabout
         real, dimension(m(1):,m(2):,m(3):), intent(in)  :: tabin
-        tabout(inf1(1):sup1(1), &
-               inf1(2):sup1(2), &
-               inf1(3):sup1(3)) = tabin(inf2(1):sup2(1), &
-                                        inf2(2):sup2(2), &
-                                        inf2(3):sup2(3))
+        integer :: i,j,k
+
+
+!$OMP PARALLEL DO DEFAULT(none) PRIVATE(i,j,k) &
+!$OMP SHARED(inf1,inf2,sup1,sup2,tabin,tabout) &
+!$OMP SCHEDULE(RUNTIME)
+        do k=inf1(3),sup1(3)
+        do j=inf1(2),sup1(2)
+        do i=inf1(1),sup1(1)
+!          tabout(i,j,k) = tabin(i+inf2(1)-inf1(1),j+inf2(2)-inf1(2),k+inf2(3)-inf1(3))
+          tabout(i,j,k) = tabin(i,j,k)
+        enddo
+        enddo
+        enddo
+!$OMP END PARALLEL DO
+
+
+!        tabout(inf1(1):sup1(1), &
+!               inf1(2):sup1(2), &
+!               inf1(3):sup1(3)) = tabin(inf2(1):sup2(1), &
+!                                        inf2(2):sup2(2), &
+!                                        inf2(3):sup2(3))
     end subroutine Agrif_copy_array_3d
 !
@@ -631 +764 @@
     integer, dimension(6), intent(out)          :: lb_child     !< Lower bound on the child grid
     integer, dimension(6), intent(out)          :: lb_parent    !< Lower bound on the parent grid
-    real, dimension(6),    intent(out)          :: s_child      !< Child  grid position (s_root = 0)
-    real, dimension(6),    intent(out)          :: s_parent     !< Parent grid position (s_root = 0)
-    real, dimension(6),    intent(out)          :: ds_child     !< Child  grid dx (ds_root = 1)
-    real, dimension(6),    intent(out)          :: ds_parent    !< Parent grid dx (ds_root = 1)
+    real(kind=8), dimension(6),    intent(out)  :: s_child      !< Child  grid position (s_root = 0)
+    real(kind=8), dimension(6),    intent(out)  :: s_parent     !< Parent grid position (s_root = 0)
+    real(kind=8), dimension(6),    intent(out)  :: ds_child     !< Child  grid dx (ds_root = 1)
+    real(kind=8), dimension(6),    intent(out)  :: ds_parent    !< Parent grid dx (ds_root = 1)
     integer,               intent(out)          :: nbdim        !< Number of dimensions
     logical,               intent(in)           :: interp       !< .true. if preprocess for interpolation, \n
@@ -671 +804 @@
             else
                 ub_child(n) = lb_child(n) + Agrif_Child_Gr % nb(1) - 1
-                s_child(n)  = s_child(n)  + 0.5*ds_child(n)
-                s_parent(n) = s_parent(n) + 0.5*ds_parent(n)
+                s_child(n)  = s_child(n)  + 0.5d0*ds_child(n)
+                s_parent(n) = s_parent(n) + 0.5d0*ds_parent(n)
             endif
 !
@@ -689 +822 @@
             else
                 ub_child(n) = lb_child(n) + Agrif_Child_Gr % nb(2) - 1
-                s_child(n)  = s_child(n)  + 0.5*ds_child(n)
-                s_parent(n) = s_parent(n) + 0.5*ds_parent(n)
+                s_child(n)  = s_child(n)  + 0.5d0*ds_child(n)
+                s_parent(n) = s_parent(n) + 0.5d0*ds_parent(n)
             endif
 !
@@ -727 +860 @@
 !           No interpolation but only a copy of the values of the grid variable
             lb_parent(n) = lb_child(n)
-            s_child(n)   = 0.
-            s_parent(n)  = 0.
-            ds_child(n)  = 1.
-            ds_parent(n) = 1.
+            s_child(n)   = 0.d0
+            s_parent(n)  = 0.d0
+            ds_child(n)  = 1.d0
+            ds_parent(n) = 1.d0
 !
         end select
@@ -803 +936 @@
     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)
 !
@@ -816 +956 @@
             endif
         enddo
+     endif
     enddo
 
@@ -825 +966 @@
 !
 end module Agrif_Arrays
+
+
+subroutine agrif_set_array_cond_reshape(arrayin,arrayout,value,n)
+integer :: n
+real,dimension(n) :: arrayin,arrayout
+real :: value
+
+integer :: i
+
+do i=1,n
+  if (arrayin(i) == value) then
+    arrayout(i) = 0.
+  else
+    arrayout(i) = 1.
+  endif
+enddo
+
+end subroutine agrif_set_array_cond_reshape
+
+subroutine agrif_set_array_tozero_reshape(array,n)
+integer :: n
+real,dimension(n) :: array
+
+integer :: i
+
+!$OMP PARALLEL DO DEFAULT(none) PRIVATE(i) &
+!$OMP SHARED(array,n)
+do i=1,n
+    array(i) = 0.
+enddo
+!$OMP END PARALLEL DO
+
+end subroutine agrif_set_array_tozero_reshape

vendors/AGRIF/CMEMS_2020/AGRIF_FILES/modbc.F90

@@ -32 +32 @@
 !
     implicit none
+    REAL,DIMENSION(:),ALLOCATABLE :: parray_temp
 !
 contains
@@ -61 +62 @@
     integer, dimension(6)  :: loctab_child      ! Indicates if the child grid has a common border
                                                 !    with the root grid
-    real, dimension(6)     :: s_child, s_parent   ! Positions of the parent and child grids
-    real, dimension(6)     :: ds_child, ds_parent ! Space steps of the parent and child grids
+    real(kind=8), dimension(6)     :: s_child, s_parent   ! Positions of the parent and child grids
+    real(kind=8), dimension(6)     :: ds_child, ds_parent ! Space steps of the parent and child grids
 !
     call PreProcessToInterpOrUpdate( parent,   child,       &
@@ -145 +146 @@
     INTEGER, DIMENSION(nbdim)   :: posvartab_Child      !< Position of the grid variable (1 or 2)
     INTEGER, DIMENSION(nbdim)   :: loctab_Child         !< Indicates if the child grid has a common border with the root grid
-    REAL   , DIMENSION(nbdim)   :: s_Child,  s_Parent   !< Positions of the parent and child grids
-    REAL   , DIMENSION(nbdim)   :: ds_Child, ds_Parent  !< Space steps of the parent and child grids
+    REAL(kind=8)   , DIMENSION(nbdim)   :: s_Child,  s_Parent   !< Positions of the parent and child grids
+    REAL(kind=8)   , DIMENSION(nbdim)   :: ds_Child, ds_Parent  !< Space steps of the parent and child grids
     INTEGER                             :: nbdim        !< Number of dimensions of the grid variable
     procedure()                         :: procname     !< Data recovery procedure
@@ -159 +160 @@
     INTEGER,DIMENSION(nbdim,2,2,nbdim)  :: ptres,ptres2 ! calculated
     INTEGER,DIMENSION(nbdim)            :: coords
-    INTEGER                             :: i, nb, ndir
+    INTEGER                             :: i, nb, ndir,j,k,l
     INTEGER                             :: n, sizetab
     INTEGER                             :: ibeg, iend
     INTEGER                             :: i1,i2,j1,j2,k1,k2,l1,l2,m1,m2,n1,n2
     REAL                                :: c1t,c2t      ! Coefficients for the time interpolation (c2t=1-c1t)
+    INTEGER :: isize
+    INTEGER :: kindex_2d(2,nbdim)
+
 #if defined AGRIF_MPI
 !
@@ -188 +192 @@
     END WHERE
 !
-    call Agrif_get_var_global_bounds(child,lubglob,nbdim)
+!   call Agrif_get_var_global_bounds(child,lubglob,nbdim)
+    lubglob = child%lubglob(1:nbdim,:)
 !
     indtruetab(1:nbdim,1,1) = max(indtab(1:nbdim,1,1), lubglob(1:nbdim,1))
@@ -194 +199 @@
     indtruetab(1:nbdim,2,1) = min(indtab(1:nbdim,2,1), lubglob(1:nbdim,2))
     indtruetab(1:nbdim,2,2) = min(indtab(1:nbdim,2,2), lubglob(1:nbdim,2))
+   
 !
     do nb = 1,nbdim
@@ -267 +273 @@
                 if (loctab_child(nb) /= (-ndir) .AND. loctab_child(nb) /= -3) then
 !
+
                     call Agrif_InterpnD(type_interp, parent, child,             &
                                         ptres(1:nbdim,1,ndir,nb),               &
@@ -319 +326 @@
         do nb = 1,nbdim
             do ndir = 1,2
-                if (loctab_child(nb) /= (-ndir) .AND. loctab_child(nb) /= -3) then
+                kindex_2d(ndir,nb) = kindex
+                if ( (loctab_child(nb) /= (-ndir)) .AND. (loctab_child(nb) /= -3) .AND. child%memberin(nb,ndir) ) then
                     Call timeInterpolation(child,ptres2(:,:,ndir,nb),kindex,c1t,c2t,nbdim)
                 endif
@@ -325 +333 @@
         enddo
 !
-    endif
-!
     do nb = 1,nbdim
     do ndir = 1,2
         if ( (loctab_child(nb) /= (-ndir)) .AND. (loctab_child(nb) /= -3) .AND. child%memberin(nb,ndir) ) then
+
+         do i=1,nbdim
+         if (ptres2(i,1,ndir,nb) /= child%childarray(i,1,2,nb,ndir)) then
+            print *,'problem ptres2 childarray 1 ',ptres2(i,1,ndir,nb) /= child%childarray(i,1,2,nb,ndir)
+            stop
+         endif
+         if (ptres2(i,2,ndir,nb) /= child%childarray(i,2,2,nb,ndir)) then
+            print *,'problem ptres2 childarray 2 ',ptres2(i,2,ndir,nb) /= child%childarray(i,2,2,nb,ndir)
+          stop
+         endif
+         enddo
+
             select case(nbdim)
             case(1)
@@ -346 +364 @@
                               i1,i2,j1,j2, .FALSE.,coords(nb),ndir)
             case(3)
+
                 i1 = child % childarray(1,1,2,nb,ndir)
                 i2 = child % childarray(1,2,2,nb,ndir)
@@ -353 +372 @@
                 k2 = child % childarray(3,2,2,nb,ndir)
 
-                call procname(parray3(i1:i2,j1:j2,k1:k2),                   &
-                              i1,i2,j1,j2,k1,k2, .FALSE.,coords(nb),ndir)
+               call procname(parray_temp(kindex_2d(ndir,nb)),i1,i2,j1,j2,k1,k2, .FALSE.,coords(nb),ndir)
+
             case(4)
                 i1 = child % childarray(1,1,2,nb,ndir)
@@ -365 +384 @@
                 l2 = child % childarray(4,2,2,nb,ndir)
 
-                call procname(parray4(i1:i2,j1:j2,k1:k2,l1:l2),             &
-                              i1,i2,j1,j2,k1,k2,l1,l2, .FALSE.,coords(nb),ndir)
+                call procname(parray_temp(kindex_2d(ndir,nb)),i1,i2,j1,j2,k1,k2,l1,l2,.FALSE.,coords(nb),ndir)
+
             case(5)
                 i1 = child % childarray(1,1,2,nb,ndir)
@@ -401 +420 @@
     enddo
     enddo
+
+    else
+
+    do nb = 1,nbdim
+    do ndir = 1,2
+        if ( (loctab_child(nb) /= (-ndir)) .AND. (loctab_child(nb) /= -3) .AND. child%memberin(nb,ndir) ) then
+            select case(nbdim)
+            case(1)
+                i1 = child % childarray(1,1,2,nb,ndir)
+                i2 = child % childarray(1,2,2,nb,ndir)
+
+                call procname(parray1(i1:i2),                               &
+                              i1,i2, .FALSE.,coords(nb),ndir)
+            case(2)
+                i1 = child % childarray(1,1,2,nb,ndir)
+                i2 = child % childarray(1,2,2,nb,ndir)
+                j1 = child % childarray(2,1,2,nb,ndir)
+                j2 = child % childarray(2,2,2,nb,ndir)
+
+                call procname(parray2(i1:i2,j1:j2),                         &
+                              i1,i2,j1,j2, .FALSE.,coords(nb),ndir)
+            case(3)
+
+                i1 = child % childarray(1,1,2,nb,ndir)
+                i2 = child % childarray(1,2,2,nb,ndir)
+                j1 = child % childarray(2,1,2,nb,ndir)
+                j2 = child % childarray(2,2,2,nb,ndir)
+                k1 = child % childarray(3,1,2,nb,ndir)
+                k2 = child % childarray(3,2,2,nb,ndir)
+
+                call procname(parray3(i1:i2,j1:j2,k1:k2),                   &
+                              i1,i2,j1,j2,k1,k2, .FALSE.,coords(nb),ndir)
+
+            case(4)
+                i1 = child % childarray(1,1,2,nb,ndir)
+                i2 = child % childarray(1,2,2,nb,ndir)
+                j1 = child % childarray(2,1,2,nb,ndir)
+                j2 = child % childarray(2,2,2,nb,ndir)
+                k1 = child % childarray(3,1,2,nb,ndir)
+                k2 = child % childarray(3,2,2,nb,ndir)
+                l1 = child % childarray(4,1,2,nb,ndir)
+                l2 = child % childarray(4,2,2,nb,ndir)
+
+                call procname(parray4(i1:i2,j1:j2,k1:k2,l1:l2),             &
+                              i1,i2,j1,j2,k1,k2,l1,l2, .FALSE.,coords(nb),ndir)
+
+            case(5)
+                i1 = child % childarray(1,1,2,nb,ndir)
+                i2 = child % childarray(1,2,2,nb,ndir)
+                j1 = child % childarray(2,1,2,nb,ndir)
+                j2 = child % childarray(2,2,2,nb,ndir)
+                k1 = child % childarray(3,1,2,nb,ndir)
+                k2 = child % childarray(3,2,2,nb,ndir)
+                l1 = child % childarray(4,1,2,nb,ndir)
+                l2 = child % childarray(4,2,2,nb,ndir)
+                m1 = child % childarray(5,1,2,nb,ndir)
+                m2 = child % childarray(5,2,2,nb,ndir)
+
+                call procname(parray5(i1:i2,j1:j2,k1:k2,l1:l2,m1:m2),       &
+                              i1,i2,j1,j2,k1,k2,l1,l2,m1,m2, .FALSE.,coords(nb),ndir)
+            case(6)
+                i1 = child % childarray(1,1,2,nb,ndir)
+                i2 = child % childarray(1,2,2,nb,ndir)
+                j1 = child % childarray(2,1,2,nb,ndir)
+                j2 = child % childarray(2,2,2,nb,ndir)
+                k1 = child % childarray(3,1,2,nb,ndir)
+                k2 = child % childarray(3,2,2,nb,ndir)
+                l1 = child % childarray(4,1,2,nb,ndir)
+                l2 = child % childarray(4,2,2,nb,ndir)
+                m1 = child % childarray(5,1,2,nb,ndir)
+                m2 = child % childarray(5,2,2,nb,ndir)
+                n1 = child % childarray(6,1,2,nb,ndir)
+                n2 = child % childarray(6,2,2,nb,ndir)
+
+                call procname(parray6(i1:i2,j1:j2,k1:k2,l1:l2,m1:m2,n1:n2), &
+                              i1,i2,j1,j2,k1,k2,l1,l2,m1,m2,n1,n2, .FALSE.,coords(nb),ndir)
+            end select
+        endif
+    enddo
+    enddo
+
+    endif
+!
+
 !---------------------------------------------------------------------------------------------------
 end subroutine Agrif_Correctnd
@@ -525 +628 @@
 !
     INTEGER :: ir,jr,kr,lr,mr,nr
+    INTEGER :: kindexmax, isize,i
+    REAL,DIMENSION(:),ALLOCATABLE :: tabtemp
+
+    isize = 1
+    DO i=1,nbdim
+      isize = isize * (bounds(i,2)-bounds(i,1)+1)
+    ENDDO
+    IF (isize <= 0) RETURN
+
+    kindexmax = kindex + isize - 1
+    IF (.NOT.ALLOCATED(parray_temp)) THEN
+      ALLOCATE(parray_temp(kindexmax)) 
+    ELSE 
+      IF (size(parray_temp) < kindexmax) THEN
+         ALLOCATE(tabtemp(size(parray_temp)))
+         tabtemp = parray_temp
+         DEALLOCATE(parray_temp)
+         ALLOCATE(parray_temp(kindexmax))
+         parray_temp(1:size(tabtemp)) = tabtemp
+         DEALLOCATE(tabtemp)
+      ENDIF
+    ENDIF
+ 
 !
     SELECT CASE (nbdim)
@@ -546 +672 @@
 !
     CASE (3)
-        do kr = bounds(3,1),bounds(3,2)
-        do jr = bounds(2,1),bounds(2,2)
-!CDIR ALTCODE
-        do ir = bounds(1,1),bounds(1,2)
-            parray3(ir,jr,kr) = c2t*child_var % oldvalues2d(1,kindex) + &
-                                            c1t*child_var % oldvalues2d(2,kindex)
-            kindex = kindex + 1
-        enddo
-        enddo
-        enddo
+
+        parray_temp(kindex:kindexmax) = c2t*child_var % oldvalues2d(1,kindex:kindexmax) + &
+                                        c1t*child_var % oldvalues2d(2,kindex:kindexmax)
+
 !
     CASE (4)
-        do lr = bounds(4,1),bounds(4,2)
-        do kr = bounds(3,1),bounds(3,2)
-        do jr = bounds(2,1),bounds(2,2)
-!CDIR ALTCODE
-        do ir = bounds(1,1),bounds(1,2)
-            parray4(ir,jr,kr,lr) = c2t*child_var % oldvalues2d(1,kindex) + &
-                                               c1t*child_var % oldvalues2d(2,kindex)
-            kindex = kindex + 1
-        enddo
-        enddo
-        enddo
-        enddo
+
+        parray_temp(kindex:kindexmax) = c2t*child_var % oldvalues2d(1,kindex:kindexmax) + &
+                                        c1t*child_var % oldvalues2d(2,kindex:kindexmax)
+
 !
     CASE (5)
@@ -605 +717 @@
         enddo
     END SELECT
+
+    kindex = kindexmax + 1
+
 !---------------------------------------------------------------------------------------------------
 end subroutine timeInterpolation

vendors/AGRIF/CMEMS_2020/AGRIF_FILES/modbcfunction.F90

@@ -21 +21 @@
 !     Foundation, Inc., 59 Temple Place - Suite 330, Boston, MA 02111-1307, USA.
 !
+!---------------------------------------------------------------------------------------------------
 !> Module Agrif_BcFunction.
-!
+!!
+!---------------------------------------------------------------------------------------------------
 module Agrif_BcFunction
 !
 !     Modules used:
 !
-    use Agrif_Boundary
-    use Agrif_Update
-    use Agrif_Save
+   use Agrif_User_Variables
+
 !
     implicit none
-!
-    interface Agrif_Set_Parent
-        module procedure Agrif_Set_Parent_int,      &
-                         Agrif_Set_Parent_real4,    &
-                         Agrif_Set_Parent_real8
-    end interface
 !
     interface Agrif_Save_Forrestore
@@ -47 +42 @@
 !
 contains
-!
-!===================================================================================================
-!  subroutine Agrif_Set_parent_int
-!
-!> To set the TYPE of the variable
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Set_parent_int(tabvarsindic,value)
-!---------------------------------------------------------------------------------------------------
-    integer, intent(in)     :: tabvarsindic !< indice of the variable in tabvars
-    integer, intent(in)     :: value        !< input value
-!
-    Agrif_Curgrid % parent % tabvars_i(tabvarsindic) % iarray0 = value
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Set_parent_int
-!===================================================================================================
-!
-!===================================================================================================
-!  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
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Set_parent_real4
-!===================================================================================================
-!
-!===================================================================================================
-!  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
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Set_parent_real8
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Set_bc
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Set_bc ( tabvarsindic, bcinfsup, Interpolationshouldbemade )
-!---------------------------------------------------------------------------------------------------
-    integer,               intent(in)   :: tabvarsindic !< indice of the variable in tabvars
-    integer, dimension(2), intent(in)   :: bcinfsup     !< bcinfsup
-    logical, optional,     intent(in)   :: Interpolationshouldbemade !< interpolation should be made
-!
-    integer                         :: indic ! indice of the variable in tabvars
-    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
-
-    if (.not.associated(var)) return ! Grand mother grid case
-!
-    if ( Agrif_Curgrid % fixedrank /= 0 ) then
-        if ( .not.associated(var % oldvalues2D) ) then
-            allocate(var % oldvalues2D(2,1))
-            var % interpIndex = -1
-            var % oldvalues2D = 0.
-        endif
-        if ( present(Interpolationshouldbemade) ) then
-            var % Interpolationshouldbemade = Interpolationshouldbemade
-        endif
-    endif
-!
-    var % bcinf = bcinfsup(1)
-    var % bcsup = bcinfsup(2)
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Set_bc
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Set_interp
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Set_interp ( tabvarsindic, interp, interp1, interp2, interp3 , interp4)
-!---------------------------------------------------------------------------------------------------
-    integer,           intent(in)   :: tabvarsindic !< indice of the variable in tabvars
-    integer, optional, intent(in)   :: interp, interp1, interp2, interp3, interp4
-!
-    integer                         :: indic ! indice of the variable in tabvars
-    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 % type_interp = Agrif_Constant
-!
-    if (present(interp))    var % type_interp    = interp
-    if (present(interp1))   var % type_interp(1) = interp1
-    if (present(interp2))   var % type_interp(2) = interp2
-    if (present(interp3))   var % type_interp(3) = interp3
-    if (present(interp4))   var % type_interp(4) = interp4
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Set_interp
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Set_bcinterp
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Set_bcinterp ( tabvarsindic, interp,   interp1,  interp2,  interp3, interp4, &
-                                              interp11, interp12, interp21, interp22 )
-!---------------------------------------------------------------------------------------------------
-    INTEGER,           intent(in)   :: tabvarsindic !< indice of the variable in tabvars
-    INTEGER, OPTIONAL, intent(in)   :: interp,   interp1,  interp2,  interp3, interp4
-    INTEGER, OPTIONAL, intent(in)   :: interp11, interp12, interp21, interp22
-!
-    INTEGER                         :: indic ! indice of the variable in tabvars
-    TYPE(Agrif_Variable), pointer   :: var
-!
+
+!===================================================================================================
+!  subroutine Agrif_Set_restore
+!> This subroutine is used to set the index of the current grid variable we want to restore.
+!---------------------------------------------------------------------------------------------------
+subroutine Agrif_Set_restore ( tabvarsindic )
+!---------------------------------------------------------------------------------------------------
+    INTEGER, intent(in) :: tabvarsindic     !< indice of the variable in tabvars
+!
+    INTEGER :: indic  !  indice of the variable in tabvars
+!
+print *,'CURRENTLY BROKEN'
+STOP
+
     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 % type_interp_bc = Agrif_Constant
-!
-    if (present(interp))    var % type_interp_bc      = interp
-    if (present(interp1))   var % type_interp_bc(:,1) = interp1
-    if (present(interp11))  var % type_interp_bc(1,1) = interp11
-    if (present(interp12))  var % type_interp_bc(1,2) = interp12
-    if (present(interp2))   var % type_interp_bc(:,2) = interp2
-    if (present(interp21))  var % type_interp_bc(2,1) = interp21
-    if (present(interp22))  var % type_interp_bc(2,2) = interp22
-    if (present(interp3))   var % type_interp_bc(:,3) = interp3
-    if (present(interp4))   var % type_interp_bc(:,4) = interp4
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Set_bcinterp
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Set_UpdateType
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Set_UpdateType ( tabvarsindic, update,  update1, update2, &
-                                                update3, update4, update5 )
-!---------------------------------------------------------------------------------------------------
-    INTEGER,           intent(in) :: tabvarsindic     !< indice of the variable in tabvars
-    INTEGER, OPTIONAL, intent(in) :: update, update1, update2, update3, update4, update5
-!
-    INTEGER                         :: indic ! indice of the variable in tabvars
-    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 % type_update = Agrif_Update_Copy
-    if (present(update))    root_var % type_update    = update
-    if (present(update1))   root_var % type_update(1) = update1
-    if (present(update2))   root_var % type_update(2) = update2
-    if (present(update3))   root_var % type_update(3) = update3
-    if (present(update4))   root_var % type_update(4) = update4
-    if (present(update5))   root_var % type_update(5) = update5
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Set_UpdateType
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Set_restore
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Set_restore ( tabvarsindic )
-!---------------------------------------------------------------------------------------------------
-    INTEGER, intent(in) :: tabvarsindic     !< indice of the variable in tabvars
-!
-    INTEGER :: indic  !  indice of the variable in tabvars
-!
-    indic = Agrif_Curgrid%tabvars_i(tabvarsindic)%iarray0
-!
     Agrif_Mygrid%tabvars(indic) % restore = .TRUE.
 !---------------------------------------------------------------------------------------------------
@@ -251 +64 @@
 !
 !===================================================================================================
-!  subroutine Agrif_Init_variable
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Init_variable ( tabvarsindic, procname )
-!---------------------------------------------------------------------------------------------------
-    INTEGER, intent(in)  :: tabvarsindic     !< indice of the variable in tabvars
-    procedure()          :: procname         !< Data recovery procedure
-!
-    if ( Agrif_Curgrid%level <= 0 ) return
-!
-    call Agrif_Interp_variable(tabvarsindic, procname)
-    call Agrif_Bc_variable(tabvarsindic, procname, 1.)
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Init_variable
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Bc_variable
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Bc_variable ( tabvarsindic, procname, calledweight )
-!---------------------------------------------------------------------------------------------------
-    integer,        intent(in) :: tabvarsindic     !< indice of the variable in tabvars
-    procedure()                :: procname
-    real, optional, intent(in) :: calledweight
-!
-    real    :: weight
-    logical :: pweight
-    integer :: indic
-    integer :: nbdim
-    type(Agrif_Variable), pointer :: root_var
-    type(Agrif_Variable), pointer :: parent_var
-    type(Agrif_Variable), pointer :: child_var
-    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 ( present(calledweight) ) then
-        weight  = calledweight
-        pweight = .true.
-    else
-        weight  = 0.
-        pweight = .false.
-    endif
-!
-    if (indic <= 0) then
-        child_var  => Agrif_Search_Variable(Agrif_Curgrid,-indic)
-        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
-!
-    select case( nbdim )
-    case(1)
-        allocate(parray1(child_var%lb(1):child_var%ub(1)))
-    case(2)
-        allocate(parray2(child_var%lb(1):child_var%ub(1), &
-                         child_var%lb(2):child_var%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) ))
-    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) ))
-    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) ))
-    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) ))
-    end select
-!
-!   Create temporary child variable
-    allocate(child_tmp)
-!
-    child_tmp % root_var => root_var
-    child_tmp % oldvalues2D => child_var % oldvalues2D
-!
-!   Index indicating if a space interpolation is necessary
-    child_tmp % interpIndex =  child_var % interpIndex
-    child_tmp % list_interp => child_var % list_interp
-    child_tmp % Interpolationshouldbemade = child_var % Interpolationshouldbemade
-!
-    child_tmp % point = child_var % point
-    child_tmp % lb = child_var % lb
-    child_tmp % ub = child_var % ub
-!
-    child_tmp % bcinf = child_var % bcinf
-    child_tmp % bcsup = child_var % bcsup
-!
-    child_tmp % childarray = child_var % childarray
-    child_tmp % memberin   = child_var % memberin
-!
-    call Agrif_CorrectVariable(parent_var, child_tmp, pweight, weight, procname)
-!
-    child_var % childarray = child_tmp % childarray
-    child_var % memberin   = child_tmp % memberin
-!
-    child_var % oldvalues2D => child_tmp % oldvalues2D
-    child_var % list_interp => child_tmp % list_interp
-!
-    child_var % interpIndex = child_tmp % interpIndex
-!
-    deallocate(child_tmp)
-!
-    select case( nbdim )
-        case(1); deallocate(parray1)
-        case(2); deallocate(parray2)
-        case(3); deallocate(parray3)
-        case(4); deallocate(parray4)
-        case(5); deallocate(parray5)
-        case(6); deallocate(parray6)
-    end select
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Bc_variable
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Interp_variable
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Interp_variable ( tabvarsindic, procname )
-!---------------------------------------------------------------------------------------------------
-    integer,     intent(in)     :: tabvarsindic     !< indice of the variable in tabvars
-    procedure()                 :: procname         !< Data recovery procedure
-!
-    integer :: nbdim
-    integer :: indic  ! indice of the variable in tabvars
-    logical :: torestore
-    type(Agrif_Variable), pointer   :: root_var
-    type(Agrif_Variable), pointer   :: parent_var       ! Variable on the parent grid
-    type(Agrif_Variable), pointer   :: child_var        ! Variable on the parent grid
-    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)
-        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
-    torestore = root_var % restore
-!
-    allocate(child_tmp)
-!
-    child_tmp % root_var => root_var
-    child_tmp % nbdim = root_var % nbdim
-    child_tmp % point = child_var % point
-    child_tmp % lb = child_var % lb
-    child_tmp % ub = child_var % ub
-    child_tmp % interpIndex =  child_var % interpIndex
-    child_tmp % list_interp => child_var % list_interp
-    child_tmp % Interpolationshouldbemade = child_var % Interpolationshouldbemade
-!
-    if ( torestore ) then
-        select case( nbdim )
-        case(1)
-            parray1 = child_var % array1
-            child_tmp % restore1D => child_var % restore1D
-        case(2)
-            parray2 = child_var % array2
-            child_tmp % restore2D => child_var % restore2D
-        case(3)
-            parray3 = child_var % array3
-            child_tmp % restore3D => child_var % restore3D
-        case(4)
-            parray4 = child_var % array4
-            child_tmp % restore4D => child_var % restore4D
-        case(5)
-            parray5 = child_var % array5
-            child_tmp % restore5D => child_var % restore5D
-        case(6)
-            parray6 = child_var % array6
-            child_tmp % restore6D => child_var % restore6D
-        end select
-    endif
-!
-    call Agrif_InterpVariable(parent_var, child_tmp, torestore, procname)
-!
-    child_var % list_interp => child_tmp % list_interp
-!
-    deallocate(child_tmp)
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Interp_variable
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Update_Variable
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Update_Variable ( tabvarsindic, procname, &
-                                   locupdate, locupdate1, locupdate2, locupdate3, locupdate4 )
-!---------------------------------------------------------------------------------------------------
-    integer,               intent(in)           :: tabvarsindic     !< Indice of the variable in tabvars
-    procedure()                                 :: procname         !< Data recovery procedure
-    integer, dimension(2), intent(in), optional :: locupdate
-    integer, dimension(2), intent(in), optional :: locupdate1
-    integer, dimension(2), intent(in), optional :: locupdate2
-    integer, dimension(2), intent(in), optional :: locupdate3
-    integer, dimension(2), intent(in), optional :: locupdate4
-!---------------------------------------------------------------------------------------------------
-    integer :: indic
-    integer :: nbdim
-    integer, dimension(6)           :: updateinf    ! First positions where interpolations are calculated
-    integer, dimension(6)           :: updatesup    ! Last  positions where interpolations are calculated
-    type(Agrif_Variable), pointer   :: root_var
-    type(Agrif_Variable), pointer   :: parent_var
-    type(Agrif_Variable), pointer   :: child_var
-!
-    if ( Agrif_Root() .AND. (.not.agrif_coarse) ) return
-    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)
-        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)
-          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
-!
-    updateinf = -99
-    updatesup = -99
-!
-    if ( present(locupdate) ) then
-        updateinf(1:nbdim) = locupdate(1)
-        updatesup(1:nbdim) = locupdate(2)
-    endif
-!
-    if ( present(locupdate1) ) then
-        updateinf(1) = locupdate1(1)
-        updatesup(1) = locupdate1(2)
-    endif
-!
-    if ( present(locupdate2) ) then
-        updateinf(2) = locupdate2(1)
-        updatesup(2) = locupdate2(2)
-    endif
-
-    if ( present(locupdate3) ) then
-        updateinf(3) = locupdate3(1)
-        updatesup(3) = locupdate3(2)
-    endif
-
-    if ( present(locupdate4) ) then
-        updateinf(4) = locupdate4(1)
-        updatesup(4) = locupdate4(2)
-    endif
-!
-    call Agrif_UpdateVariable( parent_var, child_var, updateinf, updatesup, procname )
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Update_Variable
-!===================================================================================================
-!
-!===================================================================================================
 !  subroutine Agrif_Save_ForRestore0D
 !---------------------------------------------------------------------------------------------------
 subroutine Agrif_Save_ForRestore0D ( tabvarsindic0, tabvarsindic )
 !---------------------------------------------------------------------------------------------------
-    integer, intent(in) :: tabvarsindic0, tabvarsindic
+    integer, intent(in) :: tabvarsindic0 !< index of the current grid variable 
+    integer, intent(in) :: tabvarsindic  !< index of the varible which should be restored
+    
 !
     type(Agrif_Variable), pointer   :: root_var, save_var
     integer :: nbdim
 !
+print *,'CURRENTLY BROKEN'
+STOP
     root_var => Agrif_Mygrid % tabvars(tabvarsindic0)
     save_var => Agrif_Curgrid % tabvars(tabvarsindic0)
@@ -566 +92 @@
 !===================================================================================================
 !  subroutine Agrif_Save_ForRestore2D
+!> This function is used to restore a current grid variable (with the index tabvarsindic) to the input 2D-variable.
 !---------------------------------------------------------------------------------------------------
 subroutine Agrif_Save_ForRestore2D ( q, tabvarsindic )
 !---------------------------------------------------------------------------------------------------
-    real, dimension(:,:), intent(in)        :: q
-    integer,              intent(in)        :: tabvarsindic
+!
+real, dimension(:,:), intent(in) :: q            !< input 2D-variable which should be saved
+integer,            intent(in) :: tabvarsindic !< index of the current grid variable we want to restore
 !
     type(Agrif_Variable),  pointer  :: root_var, save_var
     integer                         :: indic
 !
+print *,'CURRENTLY BROKEN'
+STOP
     indic = tabvarsindic
     if (tabvarsindic >= 0) then
@@ -603 +133 @@
 !===================================================================================================
 !  subroutine Agrif_Save_ForRestore3D
+!> This function is used to restore a current grid variable (with the index tabvarsindic) to the input 3D-variable.
 !---------------------------------------------------------------------------------------------------
 subroutine Agrif_Save_ForRestore3D ( q, tabvarsindic )
 !---------------------------------------------------------------------------------------------------
-    real, dimension(:,:,:), intent(in)      :: q
-    integer,                intent(in)      :: tabvarsindic
+!
+real, dimension(:,:,:), intent(in) :: q !< input 3D-variable which should be saved
+integer, intent(in) :: tabvarsindic    !< index of the current grid variable we want to restore
 !
     type(Agrif_Variable),  pointer  :: root_var, save_var
     integer                         :: indic
 !
+print *,'CURRENTLY BROKEN'
+STOP
+
     indic = tabvarsindic
     if (tabvarsindic >= 0) then
@@ -641 +176 @@
 !===================================================================================================
 !  subroutine Agrif_Save_ForRestore4D
+!> This function is used to restore a current grid variable (with the index tabvarsindic) to the input 4D-variable.
 !---------------------------------------------------------------------------------------------------
 subroutine Agrif_Save_ForRestore4D ( q, tabvarsindic )
 !---------------------------------------------------------------------------------------------------
-    real, dimension(:,:,:,:), intent(in)    :: q
-    integer,                  intent(in)    :: tabvarsindic
+!
+real, dimension(:,:,:,:), intent(in) :: q !< input 4D-variable which should be saved
+integer, intent(in) :: tabvarsindic      !< index of the current grid variable we want to restore
+!
 !
     type(Agrif_Variable),  pointer  :: root_var, save_var
     integer                         :: indic
 !
+print *,'CURRENTLY BROKEN'
+STOP
     indic = tabvarsindic
     if (tabvarsindic >= 0) then

vendors/AGRIF/CMEMS_2020/AGRIF_FILES/modcluster.F90

@@ -29 +29 @@
 module Agrif_Clustering
 !
-    use Agrif_CurgridFunctions
+    !use Agrif_CurgridFunctions
+    !use Agrif_Init_Vars
+    !use Agrif_Save
     use Agrif_Init_Vars
     use Agrif_Save
+    use Agrif_Init
 !
     implicit none
@@ -54 +57 @@
     TYPE(Agrif_LRectangle), pointer  :: parcours
     TYPE(Agrif_Grid)      , pointer  :: newgrid
-    REAL                             :: g_eps
+    REAL(kind=8)                     :: g_eps
     INTEGER                          :: i
 !
@@ -131 +134 @@
     TYPE(Agrif_PGrid), pointer  :: parcours
 !
-    REAL                  :: g_eps, newgrid_eps, eps
-    REAL   , DIMENSION(3) :: newmin, newmax
-    REAL   , DIMENSION(3) :: gmin, gmax
-    REAL   , DIMENSION(3) :: xmin
+    REAL(kind=8)                  :: g_eps, newgrid_eps, eps
+    REAL(kind=8)   , DIMENSION(3) :: newmin, newmax
+    REAL(kind=8)   , DIMENSION(3) :: gmin, gmax
+    REAL(kind=8)   , DIMENSION(3) :: xmin
     INTEGER, DIMENSION(3) :: igmin, inewmin
     INTEGER, DIMENSION(3) :: inewmax

vendors/AGRIF/CMEMS_2020/AGRIF_FILES/modcurgridfunctions.F90

@@ -92 +92 @@
 !
     rhot = float(Agrif_IRhot())
+    
 !---------------------------------------------------------------------------------------------------
 end function Agrif_Rhot

vendors/AGRIF/CMEMS_2020/AGRIF_FILES/modgrids.F90

@@ -44 +44 @@
     type(Agrif_Variable_i), dimension(:), allocatable :: tabvars_i  !< List of integer   grid variables
 !
-    real   , dimension(3)              :: Agrif_x   !< global x, y and z position
-    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
+    real(kind=8), dimension(3)         :: Agrif_x   !< global x, y and z position
+    real(kind=8)   , 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)              :: ix        !< minimal position in the x, y and z direction

vendors/AGRIF/CMEMS_2020/AGRIF_FILES/modinit.F90

@@ -31 +31 @@
 !
     implicit none
+
+    abstract interface
+        subroutine step_proc()
+        end subroutine step_proc
+    end interface
+    
 !
 contains
 !
+
+
+subroutine Agrif_call_procname ( procname )
+    procedure(step_proc)  :: procname
+    call procname()
+end subroutine  Agrif_call_procname
+!===================================================================================================
+
+subroutine Agrif_call_procname1 ( procname1 )
+    procedure(typedef_proc) :: procname1 
+    call procname1()
+end subroutine  Agrif_call_procname1
+
 !===================================================================================================
 !  subroutine Agrif_Allocation

vendors/AGRIF/CMEMS_2020/AGRIF_FILES/modinterp.F90

@@ -26 +26 @@
 module Agrif_Interpolation
 !
-    use Agrif_InterpBasic
-    use Agrif_Arrays
-    use Agrif_Mask
-    use Agrif_CurgridFunctions
+  use Agrif_Init
+  use Agrif_Arrays
+  use Agrif_InterpBasic
+  use Agrif_User_Functions
+
 #if defined AGRIF_MPI
     use Agrif_Mpp
 #endif
+  
+    use Agrif_Mask
 !
     implicit none
@@ -66 +69 @@
     integer, dimension(6) :: ub_child
     integer, dimension(6) :: lb_parent
-    real   , dimension(6) :: s_child,   s_parent
-    real   , dimension(6) :: ds_child, ds_parent
+    real(kind=8)   , dimension(6) :: s_child,   s_parent
+    real(kind=8)   , dimension(6) :: ds_child, ds_parent
     integer, dimension(child % root_var % nbdim,2,2) :: childarray
 !
@@ -115 +118 @@
     INTEGER, DIMENSION(nbdim), INTENT(in)   :: pttab_Parent !< Index of the first point inside the domain
                                                             !<    for the parent grid variable
-    REAL,    DIMENSION(nbdim), INTENT(in)   :: s_Child,s_Parent   !< Positions of the parent and child grids
-    REAL,    DIMENSION(nbdim), INTENT(in)   :: ds_Child,ds_Parent !< Space steps of the parent and child grids
+    REAL(kind=8),    DIMENSION(nbdim), INTENT(in)   :: s_Child,s_Parent   !< Positions of the parent and child grids
+    REAL(kind=8),    DIMENSION(nbdim), INTENT(in)   :: ds_Child,ds_Parent !< Space steps of the parent and child grids
     TYPE(Agrif_Variable),      pointer      :: restore            !< Indicates points where interpolation
     LOGICAL,                   INTENT(in)   :: torestore          !< Indicates if the array restore is used
@@ -128 +131 @@
     INTEGER                       :: i,j,k,l,m,n
     INTEGER, DIMENSION(nbdim)     :: pttruetab,cetruetab
-    INTEGER, DIMENSION(nbdim)     :: indmin,     indmax
+    INTEGER, DIMENSION(nbdim)     :: indmin,     indmax, indmin_required_p, indmax_required_p
     INTEGER, DIMENSION(nbdim)     :: indminglob, indmaxglob
 #if defined AGRIF_MPI
     INTEGER, DIMENSION(nbdim)     :: indminglob2,indmaxglob2
+    INTEGER, DIMENSION(nbdim)     :: indminglob3,indmaxglob3
 #endif
     LOGICAL, DIMENSION(nbdim)     :: noraftab
-    REAL   , DIMENSION(nbdim)     :: s_Child_temp,s_Parent_temp
+    REAL(kind=8)   , DIMENSION(nbdim)     :: s_Child_temp,s_Parent_temp,s_Parent_temp_p
     INTEGER, DIMENSION(nbdim)     :: lowerbound, upperbound, coords
     INTEGER, DIMENSION(nbdim,2,2), INTENT(OUT) :: childarray
@@ -148 +152 @@
     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
@@ -167 +174 @@
             child % list_interp,                                    &
             pttab, petab, pttab_Child, pttab_Parent, nbdim,         &
-            indmin, indmax, indminglob, indmaxglob,                 &
+            indmin, indmax, indmin_required_p, indmax_required_p,   &
+            indminglob, indmaxglob,                                 &
             pttruetab, cetruetab, memberin                          &
 #if defined AGRIF_MPI
@@ -174 +182 @@
 #endif
         )
+
 !
     if (.not.find_list_interp) then
 !
+! output : lowerbound and upperbound are the (local) lower and upper bounds of the child arrays
+
         call Agrif_get_var_bounds_array(child, lowerbound, upperbound, nbdim)
+
+! input : pttab, petab : global indexes where the interpolation is required
+! output : pttruetab, cetruetab : global indexes restricted to the bounds of the current processor 
+! output : memberin is false if the current processor is not involved in the interpolation
+
         call Agrif_Childbounds(nbdim, lowerbound, upperbound,               &
                                pttab, petab, Agrif_Procrank, coords,        &
                                pttruetab, cetruetab, memberin)
+         
+
+
+! output : indminglob, indmaxglob : global indexes required on the parent grid for the interpolation
+! output : s_Parent_temp, s_Child_temp : local s_Parent, s_Child relatively to indmin ou pttab
         call Agrif_Parentbounds(type_interp,nbdim,indminglob,indmaxglob,    &
+                                indmin_required_p, indmax_required_p,           &
                                 s_Parent_temp,s_Child_temp,                 &
                                 s_Child,ds_Child,                           &
@@ -190 +212 @@
 #if defined AGRIF_MPI
         if (memberin) then
+
+! output : indmin, indmax : global indexes required on the parent grid for the interpolation on the current processor (i.e. on pttruetab, cetruetab)
+! output : s_Parent_temp, s_Child_temp : local s_Parent, s_Child relatively to indmin ou pttruetab
             call Agrif_Parentbounds(type_interp,nbdim,indmin,indmax,        &
+                                    indmin_required_p, indmax_required_p,       &
                                     s_Parent_temp,s_Child_temp,             &
                                     s_Child,ds_Child,                       &
@@ -200 +226 @@
 
         local_proc = Agrif_Procrank
+
+! output : lowerbound and upperbound are the (local) lower and upper bounds of the parent arrays
         call Agrif_get_var_bounds_array(parent,lowerbound,upperbound,nbdim)
         call Agrif_ChildGrid_to_ParentGrid()
-!
+
+! input : indminglob,indmaxglob : global indexes where data are required for the interpolation
+! output : indminglob2,indmaxglob2 : global indexes restricted to the bounds of the current processor 
+! output : member is false if the current processor does not need to send data
+! output : indminglob3,indmaxglob3 : global bounds on the current processor for the parent array
+
         call Agrif_Childbounds(nbdim,lowerbound,upperbound,                 &
                                indminglob,indmaxglob, local_proc, coords,   &
-                               indminglob2,indmaxglob2,member)
+                               indminglob2,indmaxglob2,member,              &
+                               indminglob3,indmaxglob3)
 !
         if (member) then
+
+! output : parentarray
+! output : parentarray (:,:,2) : indminglob2, indmaxglob2 in term of local indexes on current processor
+! output : parentarray (:,:,1) : indminglob2, indmaxglob2 restricted to the current processor (different from indminglob2 ???)
+! output : member is .false. is the current processor has not data to send
+
             call Agrif_GlobalToLocalBounds(parentarray,                     &
                                            lowerbound,  upperbound,         &
@@ -216 +256 @@
         call Agrif_ParentGrid_to_ChildGrid()
 #else
+
+! In the sequentiel case, the following lines ensure that the bounds needed on the parent grid in the interpolation 
+! do not exceed lower and upper bounds of the parent array
+
+! output : lowerbound and upperbound are the (local) lower and upper bounds of the parent arrays
+        call Agrif_get_var_bounds_array(parent,lowerbound,upperbound,nbdim)
+        call Agrif_ChildGrid_to_ParentGrid()
+
+! input : indminglob,indmaxglob : global indexes where data are required for the interpolation
+! output : indminglob2,indmaxglob2 : global indexes restricted to the bounds of the current processor 
+! output : member is false if the current processor does not need to send data
+
+        call Agrif_Childbounds(nbdim,lowerbound,upperbound,                 &
+                               indminglob,indmaxglob, Agrif_Procrank, coords,   &
+                               indmin,indmax,member)
+
+        call Agrif_ParentGrid_to_ChildGrid()
+
+        indminglob = indmin
+        indmaxglob = indmax
+
         parentarray(:,1,1) = indminglob
         parentarray(:,2,1) = indmaxglob
         parentarray(:,1,2) = indminglob
         parentarray(:,2,2) = indmaxglob
-        indmin = indminglob
-        indmax = indmaxglob
+ 
+!       indmin = indminglob
+!        indmax = indmaxglob
+
         member = .TRUE.
+        s_Parent_temp = s_Parent + (indminglob - pttab_Parent) * ds_Parent
+
 #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
@@ -231 +307 @@
         s_Child_temp  = s_Child + (pttruetab - pttab_Child) * ds_Child
 #else
+
+! In the sequentiel case, the following lines ensure that the bounds needed on the parent grid in the interpolation 
+! do not exceed lower and upper bounds of the parent array
+
+! output : lowerbound and upperbound are the (local) lower and upper bounds of the parent arrays
+        call Agrif_get_var_bounds_array(parent,lowerbound,upperbound,nbdim)
+        call Agrif_ChildGrid_to_ParentGrid()
+
+! input : indminglob,indmaxglob : global indexes where data are required for the interpolation
+! output : indminglob2,indmaxglob2 : global indexes restricted to the bounds of the current processor 
+! output : member is false if the current processor does not need to send data
+
+        call Agrif_Childbounds(nbdim,lowerbound,upperbound,                 &
+                               indminglob,indmaxglob, Agrif_Procrank, coords,   &
+                               indmin,indmax,member)
+
+        call Agrif_ParentGrid_to_ChildGrid()
+
+        indminglob = indmin
+        indmaxglob = indmax
+
         parentarray(:,1,1) = indminglob
         parentarray(:,2,1) = indmaxglob
         parentarray(:,1,2) = indminglob
         parentarray(:,2,2) = indmaxglob
-        indmin = indminglob
-        indmax = indmaxglob
+ !       indmin = indminglob
+ !       indmax = indmaxglob
         member = .TRUE.
         s_Parent_temp = s_Parent + (indminglob - pttab_Parent) * ds_Parent
@@ -246 +343 @@
         if (.not.associated(tempP)) allocate(tempP)
 !
+
         call Agrif_array_allocate(tempP,parentarray(:,1,1),parentarray(:,2,1),nbdim)
         call Agrif_var_set_array_tozero(tempP,nbdim)
@@ -286 +384 @@
                       parentarray(6,1,2),parentarray(6,2,2),.TRUE.,nb,ndir)
         end select
+
 !
         call Agrif_ParentGrid_to_ChildGrid()
@@ -298 +397 @@
         tab3(:,3) = indmin(:)
         tab3(:,4) = indmax(:)
+        tab5(:,1) = indminglob3(:)
+        tab5(:,2) = indmaxglob3(:)
 !
         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)
 
@@ -311 +412 @@
         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
+      
         memberin1(1) = memberin
         call MPI_ALLGATHER(memberin1,1,MPI_LOGICAL,memberinall,1,MPI_LOGICAL,Agrif_mpi_comm,code)
@@ -319 +428 @@
                                      sendtoproc1,recvfromproc1,         &
                                      tab4t(:,:,5),tab4t(:,:,6),         &
-                                     tab4t(:,:,7),tab4t(:,:,8) )
+                                     tab4t(:,:,7),tab4t(:,:,8),         &
+                                     tab5t(:,:,1),tab5t(:,:,2))
     endif
 
@@ -333 +443 @@
                 child%list_interp,pttab,petab,                  &
                 pttab_Child,pttab_Parent,indmin,indmax,         &
+                indmin_required_p, indmax_required_p,           &
                 indminglob,indmaxglob,                          &
                 pttruetab,cetruetab,                            &
@@ -345 +456 @@
     endif
 !
+
     if (memberin) then
 !
         if (.not.associated(tempC)) allocate(tempC)
 !
+
         call Agrif_array_allocate(tempC,pttruetab,cetruetab,nbdim)
+
 !
 !       Special values on the parent grid
@@ -357 +471 @@
 !
             if (.not.associated(parentvalues))  allocate(parentvalues)
-!
+!t
+
             call Agrif_array_allocate(parentvalues,indmin,indmax,nbdim)
             call Agrif_var_full_copy_array(parentvalues,tempPextend,nbdim)
 !
-            call Agrif_CheckMasknD(tempPextend,parentvalues,    &
-                    indmin(1:nbdim),indmax(1:nbdim),            &
-                    indmin(1:nbdim),indmax(1:nbdim),            &
+            call Agrif_CheckMasknD(tempPextend,parentvalues,                &
+                    indmin(1:nbdim),indmax(1:nbdim),                        &
+                    indmin(1:nbdim),indmax(1:nbdim),                        &
+                    indmin_required_p(1:nbdim),indmax_required_p(1:nbdim),  &
                     noraftab(1:nbdim),nbdim)
 !
@@ -391 +507 @@
                                                 ds_Child(1:2),    ds_Parent(1:2) )
             case(3)
-                call Agrif_Interp_3D_recursive( type_interp(1:3),                       &
-                                                tempPextend % array3,                   &
-                                                tempC       % array3,                   &
-                                                indmin(1:3), indmax(1:3),               &
-                                                pttruetab(1:3),    cetruetab(1:3),      &
-                                                s_Child_temp(1:3), s_Parent_temp(1:3),  &
+                s_Parent_temp_p = s_Parent + (indmin_required_p - pttab_Parent) * ds_Parent
+                call Agrif_Interp_3D_recursive( type_interp(1:3),                                 &
+                                                tempPextend % array3(                             &
+                                                indmin_required_p(1):indmax_required_p(1),        &
+                                                indmin_required_p(2):indmax_required_p(2),        &
+                                                indmin_required_p(3):indmax_required_p(3)),       &
+                                                tempC       % array3,                             &
+                                                indmin_required_p(1:3), indmax_required_p(1:3),   &
+                                                pttruetab(1:3),    cetruetab(1:3),                &
+                                                s_Child_temp(1:3), s_Parent_temp_p(1:3),          &
                                                 ds_Child(1:3),    ds_Parent(1:3) )
+
             case(4)
-                call Agrif_Interp_4D_recursive( type_interp(1:4),                       &
-                                                tempPextend % array4,                   &
-                                                tempC       % array4,                   &
-                                                indmin(1:4), indmax(1:4),               &
-                                                pttruetab(1:4),    cetruetab(1:4),      &
-                                                s_Child_temp(1:4), s_Parent_temp(1:4),  &
+                s_Parent_temp_p = s_Parent + (indmin_required_p - pttab_Parent) * ds_Parent
+                call Agrif_Interp_4D_recursive( type_interp(1:4),                                 &
+                                                tempPextend % array4(                             &
+                                                indmin_required_p(1):indmax_required_p(1),        &
+                                                indmin_required_p(2):indmax_required_p(2),        &
+                                                indmin_required_p(3):indmax_required_p(3),        &
+                                                indmin_required_p(4):indmax_required_p(4)),       &
+                                                tempC       % array4,                             &
+                                                indmin_required_p(1:4), indmax_required_p(1:4),   &
+                                                pttruetab(1:4),    cetruetab(1:4),                &
+                                                s_Child_temp(1:4), s_Parent_temp_p(1:4),          &
                                                 ds_Child(1:4),    ds_Parent(1:4) )
             case(5)
@@ -595 +721 @@
         else    ! .not.to_restore
 !
+
             if (memberin) then
     !
@@ -715 +842 @@
         endif
 
+
         call Agrif_array_deallocate(tempPextend,nbdim)
         call Agrif_array_deallocate(tempC,nbdim)
@@ -736 +864 @@
 !---------------------------------------------------------------------------------------------------
 subroutine Agrif_Parentbounds ( type_interp, nbdim, indmin, indmax, &
+                                indmin_required,indmax_required,    &
                                 s_Parent_temp, s_Child_temp,        &
                                 s_Child, ds_Child,                  &
@@ -745 +874 @@
     INTEGER,                   intent(in)  :: nbdim
     INTEGER, DIMENSION(nbdim), intent(out) :: indmin, indmax
-    REAL,    DIMENSION(nbdim), intent(out) :: s_Parent_temp, s_child_temp
-    REAL,    DIMENSION(nbdim), intent(in)  :: s_Child, ds_child
-    REAL,    DIMENSION(nbdim), intent(in)  :: s_Parent,ds_Parent
+    INTEGER, DIMENSION(nbdim), intent(out) :: indmin_required, indmax_required
+    REAL(kind=8),    DIMENSION(nbdim), intent(out) :: s_Parent_temp, s_child_temp
+    REAL(kind=8),    DIMENSION(nbdim), intent(in)  :: s_Child, ds_child
+    REAL(kind=8),    DIMENSION(nbdim), intent(in)  :: s_Parent,ds_Parent
     INTEGER, DIMENSION(nbdim), intent(in)  :: pttruetab, cetruetab
     INTEGER, DIMENSION(nbdim), intent(in)  :: pttab_Child, pttab_Parent
@@ -753 +883 @@
     INTEGER, DIMENSION(nbdim), intent(in)  :: coords
 !
+    REAL(kind=8) :: xpmin, xpmax
+    INTEGER :: coeffraf
     INTEGER :: i
-    REAL,DIMENSION(nbdim) :: dim_newmin, dim_newmax
+    REAL(kind=8),DIMENSION(nbdim) :: dim_newmin, dim_newmax
 !
     dim_newmin = s_Child + (pttruetab - pttab_Child) * ds_Child
@@ -763 +895 @@
         indmin(i) = pttab_Parent(i) + agrif_int((dim_newmin(i)-s_Parent(i))/ds_Parent(i))
         indmax(i) = pttab_Parent(i) + agrif_ceiling((dim_newmax(i)-s_Parent(i))/ds_Parent(i))
+
+        coeffraf = nint(ds_Parent(i)/ds_Child(i))
+        
+        indmin_required(i) = indmin(i)
+        indmax_required(i) = indmax(i)
 !
 !       Necessary for the Quadratic interpolation
 !
+
         if ( (pttruetab(i) == cetruetab(i)) .and. (posvar(i) == 1) ) then
+            if (Agrif_UseSpecialValue) then
+               indmin(i) = indmin(i)-MaxSearch
+               indmax(i) = indmax(i)+MaxSearch
+            endif
         elseif ( coords(i) == 0 ) then  ! (interptab == 'N')
         elseif ( (type_interp(i) == Agrif_ppm)     .or.     &
@@ -772 +914 @@
                  (type_interp(i) == Agrif_ppm_lim) .or.     &
                  (type_interp(i) == Agrif_weno) ) then
-            indmin(i) = indmin(i) - 2
-            indmax(i) = indmax(i) + 2
-
+                 
+            if ((mod(coeffraf,2) == 0).AND.(posvar(i)==2)) then
+            
+              xpmax = s_Parent(i)+(indmax(i)-pttab_Parent(i))*ds_Parent(i)
+              if (xpmax > dim_newmax(i)+ds_Child(i)) then
+                indmax(i) = indmax(i) + 1
+              else
+                indmax(i) = indmax(i) + 2
+              endif
+              
+              xpmin = s_Parent(i)+(indmin(i)-pttab_Parent(i))*ds_Parent(i)
+              if (xpmin < dim_newmin(i)-ds_Child(i)) then
+                indmin(i) = indmin(i) - 1
+              else
+                indmin(i) = indmin(i) - 2
+              endif
+              
+            else
+              indmin(i) = indmin(i) - 2
+              indmax(i) = indmax(i) + 2
+            endif
+
+            indmin_required(i) = indmin(i)
+            indmax_required(i) = indmax(i)
+        
             if (Agrif_UseSpecialValue) then
                indmin(i) = indmin(i)-MaxSearch
                indmax(i) = indmax(i)+MaxSearch
             endif
-
+        elseif (type_interp(i) == Agrif_linearconservlim) then
+        
+            if ((mod(coeffraf,2) == 0).AND.(posvar(i)==2)) then
+            
+              xpmax = s_Parent(i)+(indmax(i)-pttab_Parent(i))*ds_Parent(i)
+              if (xpmax > dim_newmax(i)+ds_Child(i)) then
+                indmax(i) = indmax(i)
+              else
+                indmax(i) = indmax(i) + 1
+              endif
+              
+              xpmin = s_Parent(i)+(indmin(i)-pttab_Parent(i))*ds_Parent(i)
+              if (xpmin < dim_newmin(i)-ds_Child(i)) then
+                indmin(i) = indmin(i)
+              else
+                indmin(i) = indmin(i) - 1
+              endif
+              
+            else
+              indmin(i) = indmin(i) - 1
+              indmax(i) = indmax(i) + 1
+            endif
+
+            indmin_required(i) = indmin(i)
+            indmax_required(i) = indmax(i)
+        
+            if (Agrif_UseSpecialValue) then
+               indmin(i) = indmin(i)-MaxSearch
+               indmax(i) = indmax(i)+MaxSearch
+            endif
+            
         elseif ( (type_interp(i) /= Agrif_constant) .and.   &
                  (type_interp(i) /= Agrif_linear) ) then
             indmin(i) = indmin(i) - 1
             indmax(i) = indmax(i) + 1
+            
+            indmin_required(i) = indmin(i)
+            indmax_required(i) = indmax(i)
 
             if (Agrif_UseSpecialValue) then
@@ -789 +986 @@
                indmax(i) = indmax(i)+MaxSearch
             endif
-
         elseif ( (type_interp(i) == Agrif_constant) .or.   &
                  (type_interp(i) == Agrif_linear) ) then
+            indmin_required(i) = indmin(i)
+            indmax_required(i) = indmax(i)
             if (Agrif_UseSpecialValue) then
                indmin(i) = indmin(i)-MaxSearch
                indmax(i) = indmax(i)+MaxSearch
             endif
-
         endif
+
 !
     enddo
@@ -822 +1020 @@
     integer,            intent(in)  :: indmin, indmax
     integer,            intent(in)  :: pttab_child, petab_child
-    real,               intent(in)  :: s_child, s_parent
-    real,               intent(in)  :: ds_child, ds_parent
+    real(kind=8),               intent(in)  :: s_child, s_parent
+    real(kind=8),               intent(in)  :: ds_child, ds_parent
     real, dimension(            &
         indmin:indmax           &
@@ -857 +1055 @@
     integer, dimension(2),              intent(in)  :: indmin, indmax
     integer, dimension(2),              intent(in)  :: pttab_child, petab_child
-    real,    dimension(2),              intent(in)  :: s_child, s_parent
-    real,    dimension(2),              intent(in)  :: ds_child, ds_parent
+    real(kind=8),    dimension(2),              intent(in)  :: s_child, s_parent
+    real(kind=8),    dimension(2),              intent(in)  :: ds_child, ds_parent
     real,    dimension(                 &
         indmin(1):indmax(1),            &
@@ -875 +1073 @@
         indmin(2):indmax(2),            &
         pttab_child(1):petab_child(1))  :: tabtemp_trsp
-    integer                             :: i, j, coeffraf
+    integer                             :: i, j, coeffraf, locind_child_left, ideb
 !---------------------------------------------------------------------------------------------------
 !
@@ -900 +1098 @@
                     s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
 !---CDIR NEXPAND
-        call PPM1dAfterCompute(tabin,tabtemp,size(tabin),size(tabtemp),1)
+        call PPM1dAfterCompute(tabin,tabtemp,size(tabin),size(tabtemp),1,indchildppm(:,1),tabppm(:,:,1))
+    else if (coeffraf == 1) then
+        locind_child_left = indmin(1) + agrif_int((s_child(1)-s_parent(1))/ds_parent(1))
+        
+            do j = indmin(2), indmax(2)
+            ideb = locind_child_left
+            do i = pttab_child(1), petab_child(1)
+                tabtemp(i,j) = tabin(ideb,j)
+                ideb = ideb + 1
+            enddo
+            enddo
+
     else
         do j = indmin(2),indmax(2)
@@ -941 +1150 @@
 !---CDIR NEXPAND
         call PPM1dAfterCompute(tabtemp_trsp, tabout_trsp,    &
-                               size(tabtemp_trsp), size(tabout_trsp), 2)
+                               size(tabtemp_trsp), size(tabout_trsp), 2, &
+                              indchildppm(:,2),tabppm(:,:,2))
     else
         do i = pttab_child(1), petab_child(1)
@@ -976 +1186 @@
     integer, dimension(3),              intent(in)  :: indmin, indmax
     integer, dimension(3),              intent(in)  :: pttab_child, petab_child
-    real,    dimension(3),              intent(in)  :: s_child, s_parent
-    real,    dimension(3),              intent(in)  :: ds_child, ds_parent
+    real(kind=8),    dimension(3),              intent(in)  :: s_child, s_parent
+    real(kind=8),    dimension(3),              intent(in)  :: ds_child, ds_parent
     real,    dimension(                 &
         indmin(1):indmax(1),            &
@@ -991 +1201 @@
         pttab_child(2):petab_child(2),  &
         indmin(3):indmax(3))            :: tabtemp
-    integer                             :: i, j, k, coeffraf
+    integer                             :: i, j, k, coeffraf,kp,kp1,kp2,kp3,kp4,kref
     integer                             :: locind_child_left, kdeb
+    real(kind=8)    :: ypos,globind_parent_left
+    real(kind=8)    :: deltax, invdsparent
+    real    :: t2,t3,t4,t5,t6,t7,t8
+    integer :: locind_parent_left
+
 !
     coeffraf = nint ( ds_parent(1) / ds_child(1) )
@@ -1051 +1266 @@
             enddo
         enddo
+    else if (type_interp(3) == Agrif_LAGRANGE) then
+      invdsparent = 1./ds_parent(3)
+      ypos = s_child(3)
+      do k=pttab_child(3), petab_child(3)
+        locind_parent_left = indmin(3)+agrif_int((ypos - s_parent(3))/ds_parent(3))
+        globind_parent_left = s_parent(3) + (locind_parent_left - indmin(3))*ds_parent(3)
+        deltax = invdsparent*(ypos-globind_parent_left)
+        deltax = nint(coeffraf*deltax)/real(coeffraf)
+        ypos = ypos + ds_child(3)
+
+        if (abs(deltax) <= 0.0001) then
+          do j = pttab_child(2), petab_child(2)
+          do i = pttab_child(1), petab_child(1)
+             tabout(i,j,k) = tabtemp(i,j,locind_parent_left)
+          enddo
+          enddo
+        else
+         t2 = deltax - 2.
+        t3 = deltax - 1.
+        t4 = deltax + 1.
+
+        t5 = -(1./6.)*deltax*t2*t3
+        t6 = 0.5*t2*t3*t4
+        t7 = -0.5*deltax*t2*t4
+        t8 = (1./6.)*deltax*t3*t4      
+          do j = pttab_child(2), petab_child(2)
+          do i = pttab_child(1), petab_child(1)
+             tabout(i,j,k) = t5*tabtemp(i,j,locind_parent_left-1) + t6*tabtemp(i,j,locind_parent_left)    &
+              +t7*tabtemp(i,j,locind_parent_left+1) + t8*tabtemp(i,j,locind_parent_left+2)
+          enddo
+          enddo
+
+        endif
+
+      enddo
+    else if (type_interp(3) == Agrif_PPM) then
+     call PPM1dPrecompute2d(1, &
+                               indmax(3)-indmin(3)+1,           &
+                               petab_child(3)-pttab_child(3)+1, &
+                               s_parent(3),s_child(3),ds_parent(3),ds_child(3),1)
+
+     do k=pttab_child(3),petab_child(3)
+        kref = k-pttab_child(3)+1
+        kp=indmin(3)+indparentppm(kref,1)-1
+        kp1 = kp + 1
+        kp2 = kp1 + 1
+        kp3 = kp2 + 1
+        kp4 = kp3 + 1
+        do j = pttab_child(2), petab_child(2)
+        do i = pttab_child(1), petab_child(1)
+         tabout(i,j,k) = tabppm(1,indchildppm(kref,1),1)*tabtemp(i,j,kp)   + &
+                         tabppm(2,indchildppm(kref,1),1)*tabtemp(i,j,kp1)  + &
+                         tabppm(3,indchildppm(kref,1),1)*tabtemp(i,j,kp2)  + &
+                         tabppm(4,indchildppm(kref,1),1)*tabtemp(i,j,kp3)  + &
+                         tabppm(5,indchildppm(kref,1),1)*tabtemp(i,j,kp4)
+        enddo
+        enddo
+     enddo
+
     else
+
         do j = pttab_child(2), petab_child(2)
         do i = pttab_child(1), petab_child(1)
@@ -1063 +1338 @@
         enddo
         enddo
+
     endif
 !---------------------------------------------------------------------------------------------------
@@ -1083 +1359 @@
     integer, dimension(4),              intent(in)  :: indmin, indmax
     integer, dimension(4),              intent(in)  :: pttab_child, petab_child
-    real,    dimension(4),              intent(in)  :: s_child, s_parent
-    real,    dimension(4),              intent(in)  :: ds_child, ds_parent
+    real(kind=8),    dimension(4),              intent(in)  :: s_child, s_parent
+    real(kind=8),    dimension(4),              intent(in)  :: ds_child, ds_parent
     real,    dimension(                 &
         indmin(1):indmax(1),            &
@@ -1102 +1378 @@
         indmin(4):indmax(4))            :: tabtemp
     integer                             :: i, j, k, l
+
+    real(kind=8)    :: ypos,globind_parent_left
+    real(kind=8)    :: deltax, invdsparent
+    real    :: t2,t3,t4,t5,t6,t7,t8
+    integer :: locind_parent_left, coeffraf
 !
     do l = indmin(4), indmax(4)
@@ -1117 +1398 @@
     enddo
 !
+     if (type_interp(4) == Agrif_LAGRANGE) then
+      coeffraf = nint(ds_parent(4)/ds_child(4))
+      invdsparent = 1./ds_parent(4)
+      ypos = s_child(4)
+      do l=pttab_child(4), petab_child(4)
+        locind_parent_left = indmin(4)+agrif_int((ypos - s_parent(4))/ds_parent(4))
+        globind_parent_left = s_parent(4) + (locind_parent_left - indmin(4))*ds_parent(4)
+        deltax = invdsparent*(ypos-globind_parent_left)
+        deltax = nint(coeffraf*deltax)/real(coeffraf)
+        ypos = ypos + ds_child(4)
+
+        if (abs(deltax) <= 0.0001) then
+          do k = pttab_child(3), petab_child(3)
+          do j = pttab_child(2), petab_child(2)
+          do i = pttab_child(1), petab_child(1)
+             tabout(i,j,k,l) = tabtemp(i,j,k,locind_parent_left)
+          enddo
+          enddo
+          enddo
+        else
+         t2 = deltax - 2.
+        t3 = deltax - 1.
+        t4 = deltax + 1.
+
+        t5 = -(1./6.)*deltax*t2*t3
+        t6 = 0.5*t2*t3*t4
+        t7 = -0.5*deltax*t2*t4
+        t8 = (1./6.)*deltax*t3*t4      
+          do k = pttab_child(3), petab_child(3)
+          do j = pttab_child(2), petab_child(2)
+          do i = pttab_child(1), petab_child(1)
+             tabout(i,j,k,l) = t5*tabtemp(i,j,k,locind_parent_left-1) + t6*tabtemp(i,j,k,locind_parent_left)    &
+              +t7*tabtemp(i,j,k,locind_parent_left+1) + t8*tabtemp(i,j,k,locind_parent_left+2)
+          enddo
+          enddo
+          enddo
+        endif
+
+      enddo
+    else
     do k = pttab_child(3), petab_child(3)
     do j = pttab_child(2), petab_child(2)
@@ -1130 +1451 @@
     enddo
     enddo
+    endif
 !---------------------------------------------------------------------------------------------------
 end subroutine Agrif_Interp_4D_recursive
@@ -1149 +1471 @@
     integer, dimension(5),              intent(in)  :: indmin, indmax
     integer, dimension(5),              intent(in)  :: pttab_child, petab_child
-    real,    dimension(5),              intent(in)  :: s_child, s_parent
-    real,    dimension(5),              intent(in)  :: ds_child, ds_parent
+    real(kind=8),    dimension(5),              intent(in)  :: s_child, s_parent
+    real(kind=8),    dimension(5),              intent(in)  :: ds_child, ds_parent
     real,    dimension(                 &
         indmin(1):indmax(1),            &
@@ -1222 +1544 @@
     integer, dimension(6),                  intent(in)  :: indmin, indmax
     integer, dimension(6),                  intent(in)  :: pttab_child, petab_child
-    real,    dimension(6),                  intent(in)  :: s_child, s_parent
-    real,    dimension(6),                  intent(in)  :: ds_child, ds_parent
+    real(kind=8),    dimension(6),                  intent(in)  :: s_child, s_parent
+    real(kind=8),    dimension(6),                  intent(in)  :: ds_child, ds_parent
     real,    dimension(                 &
         indmin(1):indmax(1),            &
@@ -1301 +1623 @@
     REAL, DIMENSION(indmin:indmax),           INTENT(IN)    :: parenttab
     REAL, DIMENSION(pttab_child:petab_child), INTENT(OUT)   :: childtab
-    REAL                                                    :: s_parent, s_child
-    REAL                                                    :: ds_parent,ds_child
+    REAL(kind=8)                                            :: s_parent, s_child
+    REAL(kind=8)                                            :: ds_parent,ds_child
 !
     if ( (indmin == indmax) .and. (pttab_child == petab_child) ) then
@@ -1371 +1693 @@
 !---------------------------------------------------------------------------------------------------
 function Agrif_Find_list_interp ( list_interp, pttab, petab, pttab_Child, pttab_Parent,     &
-                                    nbdim, indmin, indmax, indminglob,  indmaxglob,         &
+                                    nbdim, indmin, indmax, indmin_required_p, indmax_required_p, &
+                                    indminglob,  indmaxglob,         &
                                     pttruetab, cetruetab, memberin                          &
 #if defined AGRIF_MPI
@@ -1382 +1705 @@
     integer,                       intent(in)  :: nbdim
     integer, dimension(nbdim),     intent(in)  :: pttab, petab, pttab_Child, pttab_Parent
-    integer, dimension(nbdim),     intent(out) :: indmin, indmax
+    integer, dimension(nbdim),     intent(out) :: indmin, indmax, indmin_required_p, indmax_required_p
     integer, dimension(nbdim),     intent(out) :: indminglob, indmaxglob
     integer, dimension(nbdim),     intent(out) :: pttruetab, cetruetab
@@ -1421 +1744 @@
         indmin = pil % indmin(1:nbdim)
         indmax = pil % indmax(1:nbdim)
+        indmin_required_p = pil % indmin_required_p(1:nbdim)
+        indmax_required_p = pil % indmax_required_p(1:nbdim)
 
         pttruetab = pil % pttruetab(1:nbdim)
@@ -1452 +1777 @@
 !---------------------------------------------------------------------------------------------------
 subroutine Agrif_AddTo_list_interp ( list_interp, pttab, petab, pttab_Child, pttab_Parent,  &
-                                     indmin, indmax, indminglob, indmaxglob,                &
+                                     indmin, indmax, indmin_required_p, indmax_required_p,  &
+                                     indminglob, indmaxglob,                &
                                      pttruetab, cetruetab,                                  &
                                      memberin, nbdim                                        &
@@ -1466 +1792 @@
     integer                                 :: nbdim
     integer, dimension(nbdim)               :: pttab, petab, pttab_Child, pttab_Parent
-    integer, dimension(nbdim)               :: indmin,indmax
+    integer, dimension(nbdim)               :: indmin,indmax, indmin_required_p, indmax_required_p
     integer, dimension(nbdim)               :: indminglob, indmaxglob
     integer, dimension(nbdim)               :: pttruetab, cetruetab
@@ -1495 +1821 @@
     pil % indmin(1:nbdim) = indmin(1:nbdim)
     pil % indmax(1:nbdim) = indmax(1:nbdim)
+
+    pil % indmin_required_p(1:nbdim) = indmin_required_p(1:nbdim)
+    pil % indmax_required_p(1:nbdim) = indmax_required_p(1:nbdim)
 
     pil % memberin = memberin

vendors/AGRIF/CMEMS_2020/AGRIF_FILES/modinterpbasic.F90

@@ -41 +41 @@
     integer, dimension(:), allocatable      :: indparentppm_1d, indchildppm_1d
 !
+
     private :: Agrif_limiter_vanleer
 !
@@ -56 +57 @@
     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 +93 @@
 !
         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 +109 @@
     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
-    endif
+        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
+
 !---------------------------------------------------------------------------------------------------
 end subroutine Agrif_basicinterp_linear1D
@@ -120 +131 @@
 !---------------------------------------------------------------------------------------------------
     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 +138 @@
     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 +175 @@
         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
@@ -239 +250 @@
     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 +315 @@
     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 +353 @@
     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
@@ -429 +440 @@
     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
@@ -524 +535 @@
     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 +658 @@
 !---------------------------------------------------------------------------------------------------
     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
 !
@@ -655 +667 @@
     integer :: iparent,ipos,pos
     real    :: ypos
-    integer :: i1,jj
-    real :: xpmin,a
+    integer :: i1,jj,k,l,j
+    real(kind=8) :: xpmin
+    real :: a
 !
     integer :: diffmod
@@ -738 +751 @@
     enddo
 !
-    do i = 1,np2
-        indparentppm(1+(i-1)*nc:i*nc,dir) = indparentppm_1d(1:nc) + (i-1)*np
-        indchildppm (1+(i-1)*nc:i*nc,dir) = indchildppm_1d (1:nc)
+
+    k=1
+    l=0
+    do i=1,np2
+      do j=1,nc
+        indchildppm(k,dir) = indchildppm_1d(j)
+        indparentppm(k,dir) = indparentppm_1d(j) + l
+        k=k+1
+      enddo
+      l=l+np
     enddo
 !---------------------------------------------------------------------------------------------------
@@ -746 +766 @@
 !===================================================================================================
 !
-!===================================================================================================
-!subroutine PPM1dPrecompute(np,nc,&
-!                    s_parent,s_child,ds_parent,ds_child)
-!!
-!!CC   Description:
-!!CC   subroutine to compute coefficient and index for  a 1D interpolation
-!!CC   using piecewise parabolic method
-!!C    Method:
-!!
-!!     Declarations:
-!!
-!      Implicit none
-!!
-!!     Arguments
-!      Integer             :: np,nc
-!!      Real, Dimension(:),Allocatable :: ytemp
-!      Real                :: 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
-!      integer :: i1,jj
-!      Real :: xpmin,a
-!!
-!      Real :: xrmin,xrmax,am3,s2,s1
-!      Real, Dimension(np) :: xl,delta,a6,slope
-!!      Real, Dimension(:),Allocatable  :: diff,diff2,diff3
-!      INTEGER :: diffmod
-!      REAL :: invcoeffraf
-!!
-!      coeffraf = nint(ds_parent/ds_child)
-!!
-!      If (coeffraf == 1) Then
-!          return
-!      End If
-!      invcoeffraf = ds_child/ds_parent
-!!
-!
-!      if (.not.allocated(indparentppm)) then
-!      allocate(indparentppm(-2*coeffraf:nc+2*coeffraf,1),&
-!         indchildppm(-2*coeffraf:nc+2*coeffraf,1))
-!      else
-!      if (size(indparentppm,1)<nc+4*coeffraf+1) then
-!      deallocate(indparentppm,indchildppm)
-!      allocate(indparentppm(-2*coeffraf:nc+2*coeffraf,1),&
-!         indchildppm(-2*coeffraf:nc+2*coeffraf,1))
-!      endif
-!      endif
-!
-!      ypos = s_child
-!!
-!      locind_parent_left = 1 + agrif_int((ypos - s_parent)/ds_parent)
-!      locind_parent_last = 1 +&
-!      agrif_ceiling((ypos +(nc - 1)&
-!      *ds_child - s_parent)/ds_parent)
-!!
-!      xpmin = s_parent + (locind_parent_left-1)*ds_parent
-!      i1 = 1+agrif_int((xpmin-s_child)/ds_child)
-!!
-!!
-!
-!      Do i=1,coeffraf
-!        tabdiff2(i)=(real(i)-0.5)*invcoeffraf
-!      EndDo
-!
-!      a = invcoeffraf**2
-!      tabdiff3(1) = (1./3.)*a
-!      a=2.*a
-!!CDIR ALTCODE
-!!!!CDIR SHORTLOOP
-!      Do i=2,coeffraf
-!        tabdiff3(i) = tabdiff3(i-1)+(real(i)-1)*a
-!      EndDo
-!
-!!CDIR ALTCODE
-!!!!CDIR SHORTLOOP
-!      Do i=1,coeffraf
-!      tabppm(1,i,1) = 0.08333333333333*(-1.+4*tabdiff2(i)-3*tabdiff3(i))
-!      tabppm(2,i,1) = 0.08333333333333*&
-!              (7.-26.*tabdiff2(i)+18.*tabdiff3(i))
-!      tabppm(3,i,1) =0.08333333333333*(7.+30*tabdiff2(i)-30*tabdiff3(i))
-!      tabppm(4,i,1) = 0.08333333333333*&
-!              (-1.-10.*tabdiff2(i)+18.*tabdiff3(i))
-!      tabppm(5,i,1) = 0.08333333333333*(2*tabdiff2(i)-3*tabdiff3(i))
-!      End Do
-!!
-!!
-!        diffmod = 0
-!       IF (mod(coeffraf,2) == 0) diffmod = 1
-!!
-!        ipos = i1
-!!
-!        Do iparent = locind_parent_left,locind_parent_last
-!             pos=1
-!!CDIR ALTCODE
-!!CDIR SHORTLOOP
-!             Do jj = ipos - coeffraf/2+diffmod,ipos + coeffraf/2
-!         indparentppm(jj,1) = iparent-2
-!         indchildppm(jj,1) = pos
-!               pos = pos+1
-!             End do
-!             ipos = ipos + coeffraf
-!!
-!        End do
-!
-!      Return
-!      End subroutine ppm1dprecompute
+
 !===================================================================================================
 !
@@ -863 +776 @@
 ! Use precomputed coefficient and index.
 !---------------------------------------------------------------------------------------------------
-subroutine PPM1dAfterCompute ( x, y, np, nc, dir )
-!---------------------------------------------------------------------------------------------------
+subroutine PPM1dAfterCompute ( x, y, np, nc, dir, indchildppmloc, tabppmloc )
+!---------------------------------------------------------------------------------------------------
+    integer,             intent(in)     :: np, nc
     real, dimension(np), intent(in)     :: x
     real, dimension(nc), intent(out)    :: y
-    integer,             intent(in)     :: np, nc
     integer,             intent(in)     :: dir
-!
-    integer :: i
-!
+    integer, dimension(1:),intent(in) :: indchildppmloc
+    real, dimension(1:,1:),intent(in) :: tabppmloc
+!
+    integer :: i,j,jp1,jp2,jp3,jp4,k
+
+    
     do i = 1,nc
-        y(i) = tabppm(1,indchildppm(i,dir),dir) * x(indparentppm(i,dir)  ) + &
-               tabppm(2,indchildppm(i,dir),dir) * x(indparentppm(i,dir)+1) + &
-               tabppm(3,indchildppm(i,dir),dir) * x(indparentppm(i,dir)+2) + &
-               tabppm(4,indchildppm(i,dir),dir) * x(indparentppm(i,dir)+3) + &
-               tabppm(5,indchildppm(i,dir),dir) * x(indparentppm(i,dir)+4)
-    enddo
+        j = indparentppm(i,dir)
+        jp1=j+1
+        jp2=jp1+1
+        jp3=jp2+1
+        jp4=jp3+1
+        y(i) = tabppmloc(1,indchildppmloc(i)) * x(j) + &
+               tabppmloc(2,indchildppmloc(i)) * x(jp1) + &
+               tabppmloc(3,indchildppmloc(i)) * x(jp2) + &
+               tabppmloc(4,indchildppmloc(i)) * x(jp3) + &
+               tabppmloc(5,indchildppmloc(i)) * x(jp4)
+    enddo
+
 !---------------------------------------------------------------------------------------------------
 end subroutine PPM1dAfterCompute
+
 !===================================================================================================
 !
@@ -1069 +992 @@
     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 +1089 @@
     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 +1199 @@
       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/CMEMS_2020/AGRIF_FILES/modlinktomodel.F90

@@ -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/CMEMS_2020/AGRIF_FILES/modmask.F90

@@ -40 +40 @@
 !! when this one is equal to Agrif_SpecialValue.
 !---------------------------------------------------------------------------------------------------
-subroutine Agrif_CheckMasknD ( tempP, parent, pbtab, petab, ppbtab, ppetab, noraftab, nbdim )
+subroutine Agrif_CheckMasknD ( tempP, parent, pbtab, petab, ppbtab, ppetab, &
+             pbtab_required, petab_required, noraftab, nbdim )
 !---------------------------------------------------------------------------------------------------
     type(Agrif_Variable), pointer   :: tempP  !< Part of the parent grid used for the interpolation of the child grid
@@ -46 +47 @@
     integer, dimension(nbdim)       :: pbtab  !< limits of the parent grid used
     integer, dimension(nbdim)       :: petab  !< interpolation of the child grid
-    integer, dimension(nbdim)       :: ppbtab, ppetab
+    integer, dimension(nbdim)       :: ppbtab, ppetab, pbtab_required, petab_required
     logical, dimension(nbdim)       :: noraftab
     integer                         :: nbdim
 !
-    integer :: i0,j0,k0,l0,m0,n0
+    integer :: i0,j0,k0,l0,m0,n0,ll,kk
+    integer,dimension(:,:),allocatable :: trytoreplace
+    integer :: ilook, Nbvals
+    real :: xold
 !
     select case (nbdim)
@@ -77 +81 @@
                     parent%array3(ppbtab(1),ppbtab(2),ppbtab(3)), &
                     ppbtab,ppetab,noraftab,MaxSearch,Agrif_SpecialValue)
-
-!            Call CalculNewValTempP((/i0,j0,k0/),
-!     &                             tempP,parent,
-!     &                             ppbtab,ppetab,
-!     &                             noraftab,nbdim)
-
             endif
         enddo
@@ -88 +86 @@
         enddo
     case (4)
-        do l0 = pbtab(4),petab(4)
-        do k0 = pbtab(3),petab(3)
-        do j0 = pbtab(2),petab(2)
-        do i0 = pbtab(1),petab(1)
+
+        if (noraftab(1).AND.noraftab(2)) then
+          allocate(trytoreplace(pbtab_required(3):petab_required(3),pbtab_required(4):petab_required(4)))
+          trytoreplace = -1
+          i0 = pbtab_required(1)
+          j0 = pbtab_required(2)
+          do l0 = pbtab_required(4),petab_required(4)
+          do k0 = pbtab_required(3),petab_required(3)
             if (tempP%array4(i0,j0,k0,l0) == Agrif_SpecialValue) then
                 call CalculNewValTempP4D((/i0,j0,k0,l0/), &
                     tempP%array4(ppbtab(1),ppbtab(2),ppbtab(3),ppbtab(4)),  &
                     parent%array4(ppbtab(1),ppbtab(2),ppbtab(3),ppbtab(4)), &
-                    ppbtab,ppetab,noraftab,MaxSearch,Agrif_SpecialValue)
-            endif
-        enddo
-        enddo
-        enddo
-        enddo
+                    ppbtab,ppetab,noraftab,MaxSearch,Agrif_SpecialValue, &
+                    trytoreplace(k0,l0))
+            endif
+          enddo
+          enddo
+
+          do l0 = pbtab_required(4),petab_required(4)
+          do k0 = pbtab_required(3),petab_required(3)
+          if (trytoreplace(k0,l0) /= -1) then
+          do j0 = pbtab_required(2),petab_required(2)
+          do i0 = pbtab_required(1),petab_required(1)
+
+          if (tempP%array4(i0,j0,k0,l0) == Agrif_SpecialValue) then
+          tempP%array4(i0,j0,k0,l0) = 0.
+          Nbvals = 0
+          do ll=max(l0-trytoreplace(k0,l0),ppbtab(4)),min(l0+trytoreplace(k0,l0),ppetab(4))
+          do kk=max(k0-trytoreplace(k0,l0),ppbtab(3)),min(k0+trytoreplace(k0,l0),ppetab(3))
+           if (parent%array4(i0,j0,kk,ll) /= Agrif_SpecialValue) then
+             tempP%array4(i0,j0,k0,l0) = tempP%array4(i0,j0,k0,l0) + parent%array4(i0,j0,kk,ll)
+             Nbvals = Nbvals + 1
+           endif
+          enddo
+          enddo
+
+          tempP%array4(i0,j0,k0,l0) = tempP%array4(i0,j0,k0,l0) /Nbvals
+          endif
+          enddo
+          enddo
+          endif
+          enddo
+          enddo
+          deallocate(trytoreplace)
+
+        else
+
+        do l0 = pbtab_required(4),petab_required(4)
+        do k0 = pbtab_required(3),petab_required(3)
+        do j0 = pbtab_required(2),petab_required(2)
+        do i0 = pbtab_required(1),petab_required(1)
+            if (tempP%array4(i0,j0,k0,l0) == Agrif_SpecialValue) then
+                ilook = -1
+                call CalculNewValTempP4D((/i0,j0,k0,l0/), &
+                    tempP%array4(ppbtab(1),ppbtab(2),ppbtab(3),ppbtab(4)),  &
+                    parent%array4(ppbtab(1),ppbtab(2),ppbtab(3),ppbtab(4)), &
+                    ppbtab,ppetab,noraftab,MaxSearch,Agrif_SpecialValue,ilook)
+            endif
+        enddo
+        enddo
+        enddo
+        enddo
+
+        endif
     case (5)
         do m0 = pbtab(5),petab(5)
@@ -488 +536 @@
 !---------------------------------------------------------------------------------------------------
 subroutine CalculNewValTempP4D ( indic, tempP, parent, ppbtab, ppetab, noraftab, &
-                                 MaxSearch, Agrif_SpecialValue )
+                                 MaxSearch, Agrif_SpecialValue, ilook )
 !---------------------------------------------------------------------------------------------------
     integer, parameter          :: nbdim = 4
@@ -511 +559 @@
 !
     logical                     :: firsttest
+    integer :: ilook
 !
     ValMax = 1
@@ -528 +577 @@
     firsttest = .TRUE.
     idecal = indic
+
+    if (ilook /= -1) then
+       i = ilook
+    else
+       i = 1
+    endif
 !
     do while (i <= ValMax)
 !
-        if ((i == 1).AND.(firsttest)) i = Valmax
+!        if ((i == 1).AND.(firsttest)) i = Valmax
 
         do iii = 1,nbdim
@@ -537 +592 @@
                 imin(iii) = max(indic(iii) - i,ppbtab(iii))
                 imax(iii) = min(indic(iii) + i,ppetab(iii))
-                if (firsttest) then
-                    if (indic(iii) > ppbtab(iii)) then
-                        idecal(iii) = idecal(iii)-1
-                        if (tempP(idecal(1),idecal(2),idecal(3),idecal(4)) == Agrif_SpecialValue) then
-                            imin(iii) = imax(iii)
-                        endif
-                        idecal(iii) = idecal(iii)+1
-                    endif
-                endif
+ !               if (firsttest) then
+ !                   if (indic(iii) > ppbtab(iii)) then
+ !                       idecal(iii) = idecal(iii)-1
+ !                       if (tempP(idecal(1),idecal(2),idecal(3),idecal(4)) == Agrif_SpecialValue) then
+ !                           imin(iii) = imax(iii)
+ !                       endif
+ !                       idecal(iii) = idecal(iii)+1
+ !                   endif
+ !               endif
             endif
         enddo
@@ -567 +622 @@
 !
         if (Nbvals > 0) then
-            if (firsttest) then
-                firsttest = .FALSE.
-                i=1
-                cycle
-            endif
+!            if (firsttest) then
+!                firsttest = .FALSE.
+!                i=1
+!                cycle
+!            endif
 
             tempP(indic(1),indic(2),indic(3),indic(4)) = Res/Nbvals
+            ilook = i
             exit
         else
-            if (firsttest) exit
+!            if (firsttest) exit
             i = i + 1
         endif

vendors/AGRIF/CMEMS_2020/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
@@ -211 +212 @@
             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 +229 @@
             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.
@@ -248 +249 @@
         sendtoproc(k) = .true.
 !
+        IF ( .not. memberoutall(k) ) THEN
+            sendtoproc(k) = .false.
+        ELSE
 !CDIR SHORTLOOP
         do i = 1,nbdim
@@ -257 +261 @@
             endif
         enddo
-        IF ( .not. memberoutall(k) ) THEN
-            sendtoproc(k) = .false.
         ENDIF
     enddo

vendors/AGRIF/CMEMS_2020/AGRIF_FILES/modsauv.F90

@@ -27 +27 @@
 !
 module Agrif_Save
-!
+!   
     use Agrif_Types
     use Agrif_Link
     use Agrif_Arrays
-    use Agrif_Variables
+    use Agrif_User_Variables
 !
     implicit none
@@ -250 +250 @@
 !
     type(Agrif_PGrid), pointer  :: parcours ! Pointer for the recursive procedure
-    real    :: g_eps, eps, oldgrid_eps
+    real(kind=8)    :: g_eps, eps, oldgrid_eps
     integer :: out
     integer :: iii
@@ -331 +331 @@
 !
     type(Agrif_PGrid), pointer  :: parcours ! Pointer for the recursive procedure
-    real    :: g_eps,eps,oldgrid_eps
+    real(kind=8)    :: g_eps,eps,oldgrid_eps
     integer :: out
     integer :: iii
@@ -415 +415 @@
     integer, dimension(6) :: nbtabold  ! Number of cells in each direction
     integer, dimension(6) :: nbtabnew  ! Number of cells in each direction
-    real,    dimension(6) :: snew,sold
-    real,    dimension(6) :: dsnew,dsold
-    real    :: eps
+    real(kind=8),    dimension(6) :: snew,sold
+    real(kind=8),    dimension(6) :: dsnew,dsold
+    real(kind=8)    :: eps
     integer :: n
 !
@@ -531 +531 @@
     integer, dimension(nbdim),     intent(in)    :: pttabold
     integer, dimension(nbdim),     intent(in)    :: petabold
-    real,    dimension(nbdim),     intent(in)    :: snew, sold
-    real,    dimension(nbdim),     intent(in)    :: dsnew,dsold
+    real(kind=8),    dimension(nbdim),     intent(in)    :: snew, sold
+    real(kind=8),    dimension(nbdim),     intent(in)    :: dsnew,dsold
     integer,                       intent(in)    :: nbdim
 !
     integer :: i,j,k,l,m,n,i0,j0,k0,l0,m0,n0
 !
-    real,    dimension(nbdim) :: dim_gmin,   dim_gmax
-    real,    dimension(nbdim) :: dim_newmin, dim_newmax
-    real,    dimension(nbdim) :: dim_min
+    real(kind=8),    dimension(nbdim) :: dim_gmin,   dim_gmax
+    real(kind=8),    dimension(nbdim) :: dim_newmin, dim_newmax
+    real(kind=8),    dimension(nbdim) :: dim_min
     integer, dimension(nbdim) :: ind_gmin,ind_newmin, ind_newmax
 !

vendors/AGRIF/CMEMS_2020/AGRIF_FILES/modseq.F90

@@ -3 +3 @@
     use Agrif_Init
     use Agrif_Procs
-    use Agrif_Arrays
+    use Agrif_Grids
+    !use Agrif_Arrays
 !
     implicit none

vendors/AGRIF/CMEMS_2020/AGRIF_FILES/modtypes.F90

@@ -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
 !> @{
@@ -132 +159 @@
     integer, dimension(6)   :: ub
 
+    integer, dimension(6,2) :: lubglob
+
     logical,dimension(6,2) :: memberin
     integer,dimension(6,2,2,6,2) :: childarray
@@ -153 +182 @@
 !> \name Arrays containing the values of the grid variables (character)
 !> @{
-    character(2400)                             :: carray0
-    character(200), dimension(:)  , allocatable :: carray1
-    character(200), dimension(:,:), allocatable :: carray2
+    character(4000)                             :: carray0
+    character(400), dimension(:)  , allocatable :: carray1
+    character(400), dimension(:,:), allocatable :: carray2
 !> @}
 !---------------------------------------------------------------------------------------------------
@@ -218 +247 @@
 !> \name Arrays containing the values of the grid variables (logical)
 !> @{
-    logical                                      :: larray0
+    logical                                      :: larray0 = .FALSE.
     logical, dimension(:)          , allocatable :: larray1
     logical, dimension(:,:)        , allocatable :: larray2
@@ -242 +271 @@
 !> \name Arrays containing the values of the grid variables (integer)
 !> @{
-    integer                                      :: iarray0
+    integer                                      :: iarray0 = 0
     integer, dimension(:)          , allocatable :: iarray1
     integer, dimension(:,:)        , allocatable :: iarray2
@@ -259 +288 @@
     integer,dimension(6)              :: pttab, petab, pttab_Child, pttab_Parent = -99
     integer,dimension(6)              :: indmin, indmax
+    integer,dimension(6)              :: indmin_required_p, indmax_required_p
     integer,dimension(6)              :: pttruetab,cetruetab
     logical :: member, memberin
@@ -324 +354 @@
     real                  :: Agrif_Efficiency = 0.7
     integer               :: MaxSearch = 5
-    real, dimension(3)    :: Agrif_mind
+    real(kind=8), dimension(3)    :: Agrif_mind
 !> @}
 !> \name parameters for the interpolation of the child grids
@@ -388 +418 @@
 integer function Agrif_Ceiling ( x )
 !---------------------------------------------------------------------------------------------------
-    real,   intent(in) :: x
+    real(kind=8),intent(in) :: x
 !
     integer   :: i
@@ -408 +438 @@
     integer function Agrif_Int(x)
 !---------------------------------------------------------------------------------------------------
-    real,   intent(in) :: x
+    real(kind=8),intent(in) :: x
 !
     integer :: i

vendors/AGRIF/CMEMS_2020/AGRIF_FILES/modupdate.F90

@@ -27 +27 @@
 module Agrif_Update
 !
+!    use Agrif_UpdateBasic
+!    use Agrif_Arrays
+!    use Agrif_CurgridFunctions
+!    use Agrif_Mask
+#if defined AGRIF_MPI
+!    use Agrif_Mpp
+#endif
+!
     use Agrif_UpdateBasic
     use Agrif_Arrays
-    use Agrif_CurgridFunctions
+    use Agrif_User_Functions
+    use Agrif_Init
     use Agrif_Mask
+    
 #if defined AGRIF_MPI
     use Agrif_Mpp
@@ -58 +68 @@
     integer, dimension(6) :: ub_child
     integer, dimension(6) :: lb_parent
-    real   , dimension(6) ::  s_child           ! Child  grid position (s_root = 0)
-    real   , dimension(6) ::  s_parent          ! Parent grid position (s_root = 0)
-    real   , dimension(6) :: ds_child           ! Child  grid dx (ds_root = 1)
-    real   , dimension(6) :: ds_parent          ! Parent grid dx (ds_root = 1)
+    real(kind=8)   , dimension(6) ::  s_child           ! Child  grid position (s_root = 0)
+    real(kind=8)   , dimension(6) ::  s_parent          ! Parent grid position (s_root = 0)
+    real(kind=8)   , dimension(6) :: ds_child           ! Child  grid dx (ds_root = 1)
+    real(kind=8)   , dimension(6) :: ds_parent          ! Parent grid dx (ds_root = 1)
     logical, dimension(6) :: do_update          ! Indicates if we perform update for each dimension
     integer, dimension(6) :: posvar             ! Position of the variable on the cell (1 or 2)
@@ -160 +170 @@
     integer, dimension(nbdim), intent(in) :: posvar         !< Position of the variable on the cell (1 or 2)
     logical, dimension(nbdim), intent(in) :: do_update      !< Indicates if we update for each dimension
-    real,    dimension(nbdim), intent(in) :: s_child        !< Positions of the child grid
-    real,    dimension(nbdim), intent(in) :: s_parent       !< Positions of the parent grid
-    real,    dimension(nbdim), intent(in) :: ds_child       !< Space steps of the child grid
-    real,    dimension(nbdim), intent(in) :: ds_parent      !< Space steps of the parent grid
+    real(kind=8),    dimension(nbdim), intent(in) :: s_child        !< Positions of the child grid
+    real(kind=8),    dimension(nbdim), intent(in) :: s_parent       !< Positions of the parent grid
+    real(kind=8),    dimension(nbdim), intent(in) :: ds_child       !< Space steps of the child grid
+    real(kind=8),    dimension(nbdim), intent(in) :: ds_parent      !< Space steps of the parent grid
     procedure()                           :: procname       !< Data recovery procedure
 !
@@ -230 +240 @@
 ! lubglob(:,2) : global lbound for each dimension
 !
-    call Agrif_get_var_global_bounds(child, lubglob, nbdim)
+!     call Agrif_get_var_global_bounds(child, lubglob, nbdim)
+    lubglob = child % lubglob(1:nbdim,:)
 !
     indtruetab(1:nbdim,1,1) = max(indtab(1:nbdim,1,1), lubglob(1:nbdim,1))
@@ -274 +285 @@
     integer, dimension(nbdim), intent(in)   :: posvar       !< Position of the variable on the cell (1 or 2)
     logical, dimension(nbdim), intent(in)   :: do_update    !< Indicates if we update for each dimension
-    real,    dimension(nbdim), intent(in)   :: s_child      !< Positions of the child grid
-    real,    dimension(nbdim), intent(in)   :: s_parent     !< Positions of the parent grid
-    real,    dimension(nbdim), intent(in)   :: ds_child     !< Space steps of the child grid
-    real,    dimension(nbdim), intent(in)   :: ds_parent    !< Space steps of the parent grid
+    real(kind=8),    dimension(nbdim), intent(in)   :: s_child      !< Positions of the child grid
+    real(kind=8),    dimension(nbdim), intent(in)   :: s_parent     !< Positions of the parent grid
+    real(kind=8),    dimension(nbdim), intent(in)   :: ds_child     !< Space steps of the child grid
+    real(kind=8),    dimension(nbdim), intent(in)   :: ds_parent    !< Space steps of the parent grid
     procedure()                             :: procname     !< Data recovery procedure
 !
@@ -390 +401 @@
 #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
@@ -400 +411 @@
     integer, dimension(nbdim), intent(in)   :: lb_parent !< Index of the first point inside the domain for the parent
                                                             !!    grid variable
-    real,    dimension(nbdim), intent(in)   :: s_child      !< Positions of the child grid
-    real,    dimension(nbdim), intent(in)   :: s_parent     !< Positions of the parent grid
-    real,    dimension(nbdim), intent(in)   :: ds_child     !< Space steps of the child grid
-    real,    dimension(nbdim), intent(in)   :: ds_parent    !< Space steps of the parent grid
+    real(kind=8),    dimension(nbdim), intent(in)   :: s_child      !< Positions of the child grid
+    real(kind=8),    dimension(nbdim), intent(in)   :: s_parent     !< Positions of the parent grid
+    real(kind=8),    dimension(nbdim), intent(in)   :: ds_child     !< Space steps of the child grid
+    real(kind=8),    dimension(nbdim), intent(in)   :: ds_parent    !< Space steps of the parent grid
     procedure()                             :: procname     !< Data recovery procedure
     integer, optional,         intent(in)   :: nb, ndir
@@ -415 +426 @@
     integer, dimension(nbdim)       :: indmin, indmax
     integer, dimension(nbdim)       :: indminglob, indmaxglob
-    real   , dimension(nbdim)       :: s_Child_temp, s_Parent_temp
+    real(kind=8)   , dimension(nbdim)       :: s_Child_temp, s_Parent_temp
     integer, dimension(nbdim)       :: lowerbound,upperbound
     integer, dimension(nbdim)       :: pttruetabwhole, cetruetabwhole
@@ -450 +461 @@
     real :: coeff_multi
     integer :: nb_dimensions
+
 !
 !   Get local lower and upper bound of the child variable
@@ -506 +518 @@
 !
         call Agrif_array_allocate(tempC,pttruetab,cetruetab,nbdim)
+#if defined AGRIF_MPI
         call Agrif_var_set_array_tozero(tempC,nbdim)
+#endif
 
         SELECT CASE (nbdim)
@@ -582 +596 @@
                                      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
 
@@ -600 +615 @@
 !
         call Agrif_array_allocate(tempP,indmin,indmax,nbdim)
-!
+
+        IF (Agrif_UseSpecialValueInUpdate) THEN
+            allocate(tempC_indic)
+            allocate(tempP_indic)
+            call Agrif_array_allocate(tempC_indic,pttruetabwhole,cetruetabwhole,nbdim)
+            call Agrif_array_allocate(tempP_indic,indmin,indmax,nbdim)
+            call agrif_set_array_cond(tempCextend,tempC_indic,agrif_SpecialValueFineGrid,nbdim)
+        ELSE
+            tempC_indic=>tempCextend ! Just to associate tempC_indic to something ...
+        ENDIF
+!
+
+
         if ( nbdim == 1 ) then
             tempP % array1 = 0.
@@ -606 +633 @@
                                             tempP%array1,   &
                                             tempCextend%array1, &
+                                            tempC_indic%array1, &
                                             indmin(1), indmax(1),   &
                                             pttruetabwhole(1), cetruetabwhole(1),   &
@@ -612 +640 @@
                                             
             IF (Agrif_UseSpecialValueInUpdate) THEN
-            allocate(tempC_indic)
-            allocate(tempP_indic)
-            call Agrif_array_allocate(tempC_indic,lbound(tempCextend%array1),ubound(tempCextend%array1),nbdim)
-            call Agrif_array_allocate(tempP_indic,lbound(tempP%array1),ubound(tempP%array1),nbdim)
 
             compute_average = .FALSE.
@@ -629 +653 @@
                                             tempP_average%array1,       &
                                             tempCextend%array1, &
+                                            tempC_indic%array1, &
                                             indmin(1), indmax(1),   &
                                             pttruetabwhole(1), cetruetabwhole(1),   &
@@ -639 +664 @@
             ENDIF
             
-            WHERE (tempCextend%array1 == Agrif_SpecialValueFineGrid)
-              tempC_indic%array1 = 0.
-            ELSEWHERE
-              tempC_indic%array1 = 1.
-            END WHERE
-            
             Agrif_UseSpecialValueInUpdate = .FALSE.
             Agrif_Update_Weights = .TRUE.
@@ -650 +669 @@
              call Agrif_Update_1D_Recursive( type_update_temp(1),   &
                                             tempP_indic%array1,       &
+                                            tempC_indic%array1, &
                                             tempC_indic%array1, &
                                             indmin(1), indmax(1),   &
@@ -691 +711 @@
                                             tempP%array2,       &
                                             tempCextend%array2, &
+                                            tempC_indic%array2, &
                                             indmin(1:2), indmax(1:2),   &
                                             pttruetabwhole(1:2), cetruetabwhole(1:2),   &
@@ -697 +718 @@
 
             IF (Agrif_UseSpecialValueInUpdate) THEN
-            allocate(tempC_indic)
-            allocate(tempP_indic)
-            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.
@@ -714 +731 @@
                                             tempP_average%array2,       &
                                             tempCextend%array2, &
+                                            tempC_indic%array2, &
                                             indmin(1:2), indmax(1:2),   &
                                             pttruetabwhole(1:2), cetruetabwhole(1:2),   &
@@ -724 +742 @@
             ENDIF
             
-            WHERE (tempCextend%array2 == Agrif_SpecialValueFineGrid)
-              tempC_indic%array2 = 0.
-            ELSEWHERE
-              tempC_indic%array2 = 1.
-            END WHERE
-            
             Agrif_UseSpecialValueInUpdate = .FALSE.
             Agrif_Update_Weights = .TRUE.
@@ -735 +747 @@
             call Agrif_Update_2D_Recursive( type_update_temp(1:2),   &
                                             tempP_indic%array2,       &
+                                            tempC_indic%array2, &
                                             tempC_indic%array2, &
                                             indmin(1:2), indmax(1:2),   &
@@ -773 +786 @@
         endif
         if ( nbdim == 3 ) then
+
             call Agrif_Update_3D_Recursive( type_update(1:3),   &
                                             tempP%array3,       &
                                             tempCextend%array3, &
+                                            tempC_indic%array3, &
                                             indmin(1:3), indmax(1:3),   &
                                             pttruetabwhole(1:3), cetruetabwhole(1:3),   &
                                             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)
-            allocate(tempP_indic)
-            call Agrif_array_allocate(tempC_indic,lbound(tempCextend%array3),ubound(tempCextend%array3),nbdim)
-            call Agrif_array_allocate(tempP_indic,lbound(tempP%array3),ubound(tempP%array3),nbdim)
 
             compute_average = .FALSE.
@@ -796 +808 @@
                 type_update_temp(1:nbdim) = Agrif_Update_Average
               END WHERE
+
               call Agrif_Update_3D_Recursive( type_update_temp(1:3),   &
                                             tempP_average%array3,       &
                                             tempCextend%array3, &
+                                            tempC_indic%array3, &
                                             indmin(1:3), indmax(1:3),   &
                                             pttruetabwhole(1:3), cetruetabwhole(1:3),   &
@@ -808 +822 @@
               enddo
             ENDIF
-            
-            WHERE (tempCextend%array3 == Agrif_SpecialValueFineGrid)
-              tempC_indic%array3 = 0.
-            ELSEWHERE
-              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,       &
                                             tempC_indic%array3, &
+                                            tempCextend%array3, &
                                             indmin(1:3), indmax(1:3),   &
                                             pttruetabwhole(1:3), cetruetabwhole(1:3),   &
@@ -826 +836 @@
                                             ds_child(1:3), ds_parent(1:3) )
 
+
            Agrif_UseSpecialValueInUpdate = .TRUE.
            Agrif_Update_Weights = .FALSE.
 
+
            IF (compute_average) THEN
+         
                WHERE (tempP_indic%array3 == 0.)
                   tempP%array3 = Agrif_SpecialValueFineGrid
@@ -837 +850 @@
                   tempP%array3 = tempP_average%array3 /tempP_indic%array3
                END WHERE
-
+            
            ELSE
                WHERE (tempP_indic%array3 == 0.)
@@ -845 +858 @@
                END WHERE
             ENDIF
-           
+
             deallocate(tempP_indic%array3)
             deallocate(tempC_indic%array3)
@@ -855 +868 @@
             ENDIF
             ENDIF
-            
+
+         
         endif
         if ( nbdim == 4 ) then
+          
             call Agrif_Update_4D_Recursive( type_update(1:4),   &
                                             tempP%array4,       &
                                             tempCextend%array4, &
+                                            tempC_indic%array4, &
                                             indmin(1:4), indmax(1:4),   &
                                             pttruetabwhole(1:4), cetruetabwhole(1:4),   &
                                             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.
@@ -885 +896 @@
                                             tempP_average%array4,       &
                                             tempCextend%array4, &
+                                            tempC_indic%array4, &
                                             indmin(1:4), indmax(1:4),   &
                                             pttruetabwhole(1:4), cetruetabwhole(1:4),   &
@@ -895 +907 @@
             ENDIF
             
-            WHERE (tempCextend%array4 == Agrif_SpecialValueFineGrid)
-              tempC_indic%array4 = 0.
-            ELSEWHERE
-              tempC_indic%array4 = 1.
-            END WHERE
-            
             Agrif_UseSpecialValueInUpdate = .FALSE.
             Agrif_Update_Weights = .TRUE.
@@ -906 +912 @@
              call Agrif_Update_4D_Recursive( type_update_temp(1:4),   &
                                             tempP_indic%array4,       &
+                                            tempC_indic%array4, &
                                             tempC_indic%array4, &
                                             indmin(1:4), indmax(1:4),   &
@@ -940 +947 @@
             ENDIF
             ENDIF
-            
+                 
         endif
         if ( nbdim == 5 ) then
@@ -946 +953 @@
                                             tempP%array5,       &
                                             tempCextend%array5, &
+                                            tempC_indic%array5, &
                                             indmin(1:5), indmax(1:5),   &
                                             pttruetabwhole(1:5), cetruetabwhole(1:5),   &
@@ -952 +960 @@
                                             
             IF (Agrif_UseSpecialValueInUpdate) THEN
-            allocate(tempC_indic)
-            allocate(tempP_indic)
-            call Agrif_array_allocate(tempC_indic,lbound(tempCextend%array5),ubound(tempCextend%array5),nbdim)
-            call Agrif_array_allocate(tempP_indic,lbound(tempP%array5),ubound(tempP%array5),nbdim)
 
             compute_average = .FALSE.
@@ -969 +973 @@
                                             tempP_average%array5,       &
                                             tempCextend%array5, &
+                                            tempC_indic%array5, &
                                             indmin(1:5), indmax(1:5),   &
                                             pttruetabwhole(1:5), cetruetabwhole(1:5),   &
@@ -979 +984 @@
             ENDIF
             
-            WHERE (tempCextend%array5 == Agrif_SpecialValueFineGrid)
-              tempC_indic%array5 = 0.
-            ELSEWHERE
-              tempC_indic%array5 = 1.
-            END WHERE
-            
             Agrif_UseSpecialValueInUpdate = .FALSE.
             Agrif_Update_Weights = .TRUE.
@@ -990 +989 @@
              call Agrif_Update_5D_Recursive( type_update_temp(1:5),   &
                                             tempP_indic%array5,       &
+                                            tempC_indic%array5, &
                                             tempC_indic%array5, &
                                             indmin(1:5), indmax(1:5),   &
@@ -1031 +1031 @@
                                             tempP%array6,       &
                                             tempCextend%array6, &
+                                            tempC_indic%array6, &
                                             indmin(1:6), indmax(1:6),   &
                                             pttruetabwhole(1:6), cetruetabwhole(1:6),   &
                                             s_Child_temp(1:6), s_Parent_temp(1:6),      &
                                             ds_child(1:6), ds_parent(1:6) )
+
             IF (Agrif_UseSpecialValueInUpdate) THEN
-            allocate(tempC_indic)
-            allocate(tempP_indic)
-            call Agrif_array_allocate(tempC_indic,lbound(tempCextend%array6),ubound(tempCextend%array6),nbdim)
-            call Agrif_array_allocate(tempP_indic,lbound(tempP%array6),ubound(tempP%array6),nbdim)
 
             compute_average = .FALSE.
@@ -1054 +1052 @@
                                             tempP_average%array6,       &
                                             tempCextend%array6, &
+                                            tempC_indic%array6, &
                                             indmin(1:6), indmax(1:6),   &
                                             pttruetabwhole(1:6), cetruetabwhole(1:6),   &
@@ -1064 +1063 @@
             ENDIF
 
+            
+            Agrif_UseSpecialValueInUpdate = .FALSE.
+            Agrif_Update_Weights = .TRUE.
+ 
+             call Agrif_Update_6D_Recursive( type_update_temp(1:6),   &
+                                            tempP_indic%array6,       &
+                                            tempC_indic%array6, &
+                                            tempC_indic%array6, &
+                                            indmin(1:6), indmax(1:6),   &
+                                            pttruetabwhole(1:6), cetruetabwhole(1:6),   &
+                                            s_Child_temp(1:6), s_Parent_temp(1:6),      &
+                                            ds_child(1:6), ds_parent(1:6) )
+
+           Agrif_UseSpecialValueInUpdate = .TRUE.
+           Agrif_Update_Weights = .FALSE.
+           
            IF (compute_average) THEN
                WHERE (tempP_indic%array6 == 0.)
@@ -1080 +1095 @@
                END WHERE
             ENDIF
-            
-            Agrif_UseSpecialValueInUpdate = .FALSE.
-            Agrif_Update_Weights = .TRUE.
- 
-             call Agrif_Update_6D_Recursive( type_update_temp(1:6),   &
-                                            tempP_indic%array6,       &
-                                            tempC_indic%array6, &
-                                            indmin(1:6), indmax(1:6),   &
-                                            pttruetabwhole(1:6), cetruetabwhole(1:6),   &
-                                            s_Child_temp(1:6), s_Parent_temp(1:6),      &
-                                            ds_child(1:6), ds_parent(1:6) )
-
-           Agrif_UseSpecialValueInUpdate = .TRUE.
-           Agrif_Update_Weights = .FALSE.
-           
-            WHERE (tempP_indic%array6 == 0.)
-              tempP%array6 = Agrif_SpecialValueFineGrid
-            ELSEWHERE
-              tempP%array6 = tempP%array6 /tempP_indic%array6
-            END WHERE
            
             deallocate(tempP_indic%array6)
@@ -1154 +1149 @@
                                      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,      &
@@ -1323 +1319 @@
     integer,                   intent(in)   :: nbdim
     integer, dimension(nbdim), intent(out)  :: indmin, indmax
-    real,    dimension(nbdim), intent(out)  :: s_Parent_temp, s_Child_temp
-    real,    dimension(nbdim), intent(in)   :: s_child,  ds_child
-    real,    dimension(nbdim), intent(in)   :: s_parent, ds_parent
+    real(kind=8),    dimension(nbdim), intent(out)  :: s_Parent_temp, s_Child_temp
+    real(kind=8),    dimension(nbdim), intent(in)   :: s_child,  ds_child
+    real(kind=8),    dimension(nbdim), intent(in)   :: s_parent, ds_parent
     integer, dimension(nbdim), intent(in)   :: pttruetab, cetruetab
     integer, dimension(nbdim), intent(in)   :: lb_child, lb_parent
@@ -1335 +1331 @@
 #endif
 !
-    real,dimension(nbdim) :: dim_newmin,dim_newmax
+    real(kind=8),dimension(nbdim) :: dim_newmin,dim_newmax
     integer :: i
 #if defined AGRIF_MPI
-    real    :: positionmin, positionmax
+    real(kind=8)    :: positionmin, positionmax
     integer :: imin, imax
     integer :: coeffraf
@@ -1422 +1418 @@
 !> Updates a 1D grid variable on the parent grid
 !---------------------------------------------------------------------------------------------------
-subroutine Agrif_Update_1D_Recursive ( type_update,         &
-                                       tempP, tempC,        &
-                                       indmin, indmax,      &
-                                       lb_child, ub_child,  &
-                                       s_child,  s_parent,  &
+subroutine Agrif_Update_1D_Recursive ( type_update,                     &
+                                       tempP, tempC, tempC_indic,       &
+                                       indmin, indmax,                  &
+                                       lb_child, ub_child,              &
+                                       s_child,  s_parent,              &
                                        ds_child, ds_parent )
 !---------------------------------------------------------------------------------------------------
@@ -1432 +1428 @@
     integer,                            intent(in)  :: indmin, indmax
     integer,                            intent(in)  :: lb_child, ub_child
-    real,                               intent(in)  ::  s_child,  s_parent
-    real,                               intent(in)  :: ds_child, ds_parent
+    real(kind=8),                               intent(in)  ::  s_child,  s_parent
+    real(kind=8),                               intent(in)  :: ds_child, ds_parent
     real, dimension(indmin:indmax),     intent(out) :: tempP
-    real, dimension(lb_child:ub_child), intent(in)  :: tempC
+    real, dimension(lb_child:ub_child), intent(in)  :: tempC, tempC_indic
 !---------------------------------------------------------------------------------------------------
     call Agrif_UpdateBase(type_update,              &
@@ -1454 +1450 @@
 !! Calls #Agrif_Update_1D_Recursive and #Agrif_UpdateBase
 !---------------------------------------------------------------------------------------------------
-subroutine Agrif_Update_2D_Recursive ( type_update,         &
-                                       tempP, tempC,        &
-                                       indmin, indmax,      &
-                                       lb_child, ub_child,  &
-                                        s_child,  s_parent, &
+subroutine Agrif_Update_2D_Recursive ( type_update,                     &
+                                       tempP, tempC, tempC_indic,       &
+                                       indmin, indmax,                  &
+                                       lb_child, ub_child,              &
+                                       s_child,  s_parent,              &
                                        ds_child, ds_parent )
 !---------------------------------------------------------------------------------------------------
@@ -1464 +1460 @@
     integer, dimension(2),          intent(in)  :: indmin, indmax
     integer, dimension(2),          intent(in)  :: lb_child, ub_child
-    real,    dimension(2),          intent(in)  ::  s_child,  s_parent
-    real,    dimension(2),          intent(in)  :: ds_child, ds_parent
+    real(kind=8),    dimension(2),          intent(in)  ::  s_child,  s_parent
+    real(kind=8),    dimension(2),          intent(in)  :: ds_child, ds_parent
     real,    dimension(          &
         indmin(1):indmax(1),     &
         indmin(2):indmax(2)),       intent(out) :: tempP
-    real,    dimension(:,:),        intent(in)  :: tempC
+    real,    dimension(:,:),        intent(in)  :: tempC, tempC_indic
 !---------------------------------------------------------------------------------------------------
     real, dimension(indmin(1):indmax(1), lb_child(2):ub_child(2)) :: tabtemp
@@ -1475 +1471 @@
     real, dimension(lb_child(2):ub_child(2), indmin(1):indmax(1)) :: tabtemp_trsp
     integer :: i, j
-    integer :: coeffraf
-!
-    tabtemp = 0.
+    integer :: coeffraf, coeffraf_2
+   integer :: jmin,jmax
+    integer locind_child_left, locind_child_left_2,kuinf
+    logical :: to_transpose
+    real :: invcoeffraf
+    integer :: diffmod, jj,i1,j1
+
+
+    to_transpose = .TRUE.
+!
+    
     coeffraf = nint ( ds_parent(1) / ds_child(1) )
 !
@@ -1490 +1494 @@
         endif
 !---CDIR NEXPAND
+        tabtemp = 0.
         call Average1dAfterCompute( tabtemp, tempC, size(tabtemp), size(tempC), &
                     s_parent(1),s_child(1),ds_parent(1),ds_child(1),1)
@@ -1503 +1508 @@
         endif
 !---CDIR NEXPAND
+
         call Agrif_basicupdate_copy1d_after(tabtemp,tempC,size(tabtemp),size(tempC),1)
 !
+    ELSE IF ((coeffraf == 1).AND.(type_update(2) == Agrif_Update_Average)) THEN
+            locind_child_left = 1+agrif_int((s_parent(1)-s_child(1))/ds_child(1))
+            coeffraf_2 = nint ( ds_parent(2) / ds_child(2) )
+            invcoeffraf = 1./coeffraf_2
+            tempP = 0.
+            diffmod = 0
+            if (mod(coeffraf_2,2) == 0) diffmod = 1
+            locind_child_left_2 = 1+agrif_int((s_parent(2)-s_child(2))/ds_child(2))
+
+            if (Agrif_UseSpecialValueInUpdate) then
+              j1 = -coeffraf_2/2+locind_child_left_2+diffmod
+              do j=indmin(2),indmax(2)
+                do jj=j1,j1+coeffraf_2-1
+                  i1 = locind_child_left
+                  do i=indmin(1),indmax(1)
+                     tempP(i,j) = tempP(i,j) + tempC(i1,jj)*tempC_indic(i1,jj)
+                     i1 = i1 + 1
+                  enddo
+                enddo
+                j1 = j1 + coeffraf_2
+              enddo
+            else
+              j1 = -coeffraf_2/2+locind_child_left_2+diffmod
+              do j=indmin(2),indmax(2)
+                do jj=j1,j1+coeffraf_2-1
+                  do i=indmin(1),indmax(1)
+                       tempP(i,j) = tempP(i,j) + tempC(locind_child_left+i-indmin(1),jj)
+                  enddo
+                enddo
+                j1 = j1 + coeffraf_2
+              enddo
+              if (.not.Agrif_Update_Weights) tempP = tempP * invcoeffraf
+            endif
+            return
+!
+    ELSE IF ((coeffraf == 1).AND.(type_update(2) == Agrif_Update_Copy)) THEN
+
+            locind_child_left = 1 + agrif_int((s_parent(1)-s_child(1))/ds_child(1))
+!
+            locind_child_left_2 = 1+nint((s_parent(2)-s_child(2))/ds_child(2))
+            coeffraf_2 = nint ( ds_parent(2) / ds_child(2) )
+
+            do j=indmin(2),indmax(2)
+              do i=indmin(1),indmax(1)
+                tempP(i,j) = tempC(locind_child_left+i-indmin(1),locind_child_left_2)
+              enddo
+              locind_child_left_2 = locind_child_left_2 + coeffraf_2
+            enddo
+
+            return
+
+    ELSE IF (coeffraf == 1) THEN
+            locind_child_left = 1 + agrif_int((s_parent(1)-s_child(1))/ds_child(1))
+!
+            do j = lb_child(2),ub_child(2)
+!              tabtemp(indmin(1):indmax(1),j) = tempC(locind_child_left:locind_child_left+indmax(1)-indmin(1),j-lb_child(2)+1)
+              tabtemp_trsp(j,indmin(1):indmax(1)) = tempC(locind_child_left:locind_child_left+indmax(1)-indmin(1),j-lb_child(2)+1)
+            enddo
+            to_transpose = .FALSE.
     ELSE
         do j = lb_child(2),ub_child(2)
@@ -1512 +1577 @@
                                             tabtemp(:,j),               &
                                             tempC(:,j-lb_child(2)+1),   &
+                                            tempC_indic(:,j-lb_child(2)+1),   &
                                             indmin(1), indmax(1),       &
                                             lb_child(1),ub_child(1),    &
@@ -1519 +1585 @@
     ENDIF
 !
-    tabtemp_trsp = TRANSPOSE(tabtemp)
+
+    if (to_transpose) tabtemp_trsp = TRANSPOSE(tabtemp)
+
     coeffraf = nint(ds_parent(2)/ds_child(2))
 !
@@ -1564 +1632 @@
     ENDIF
 !
+
+   
     tempP = TRANSPOSE(tempP_trsp)
 !---------------------------------------------------------------------------------------------------
 end subroutine Agrif_Update_2D_Recursive
-!===================================================================================================
-!
-subroutine Agrif_Update_2D_Recursive_ok ( type_update, &
-                                        tempP, tempC, &
-                                        indmin, indmax,   &
-                                       lb_child, ub_child,                    &
-                                       s_child, s_parent, ds_child, ds_parent )
-!---------------------------------------------------------------------------------------------------
-    INTEGER, DIMENSION(2), intent(in)   :: type_update            !< Type of update (copy or average)
-    INTEGER, DIMENSION(2), intent(in)   :: indmin, indmax
-    INTEGER, DIMENSION(2), intent(in)   :: lb_child, ub_child
-    REAL,    DIMENSION(2), intent(in)   :: s_child,  s_parent
-    REAL,    DIMENSION(2), intent(in)   :: ds_child, ds_parent
-    REAL,    DIMENSION(                 &
-                indmin(1):indmax(1),    &
-                indmin(2):indmax(2)),           intent(out) :: tempP
-    REAL, DIMENSION(                            &
-                lb_child(1):ub_child(1),  &
-                lb_child(2):ub_child(2)), intent(in)  :: tempC
-!
-    REAL, DIMENSION(indmin(1):indmax(1), lb_child(2):ub_child(2)) :: tabtemp
-    INTEGER :: i
-!
-    do i = lb_child(2),ub_child(2)
-        call Agrif_Update_1D_Recursive(type_update(1),                              &
-                                       tabtemp(:, i),          &
-                                       tempC(:,i),  &
-                                       indmin(1),indmax(1),                 &
-                                       lb_child(1),ub_child(1),       &
-                                       s_child(1), s_parent(1),             &
-                                      ds_child(1),ds_parent(1))
-    enddo
-!
-    tempP = 0.
-!
-    do i = indmin(1),indmax(1)
-        call Agrif_UpdateBase(type_update(2),                                       &
-                              tempP(i,:),             &
-                              tabtemp(i,:), &
-                              indmin(2),indmax(2),                          &
-                              lb_child(2),ub_child(2),                &
-                              s_parent(2),s_child(2),                       &
-                             ds_parent(2),ds_child(2))
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Update_2D_Recursive_ok
 !===================================================================================================
 
@@ -1622 +1646 @@
 !! Calls #Agrif_Update_2D_Recursive and #Agrif_UpdateBase.
 !---------------------------------------------------------------------------------------------------
-subroutine Agrif_Update_3D_Recursive ( type_update,         &
-                                       tempP, tempC,        &
-                                       indmin, indmax,      &
-                                       lb_child, ub_child,  &
-                                        s_child,  s_parent, &
+subroutine Agrif_Update_3D_Recursive ( type_update,                     &
+                                       tempP, tempC, tempC_indic,       &
+                                       indmin, indmax,                  &
+                                       lb_child, ub_child,              &
+                                       s_child,  s_parent,              &
                                        ds_child, ds_parent )
 !---------------------------------------------------------------------------------------------------
@@ -1632 +1656 @@
     integer, dimension(3),          intent(in)  :: indmin, indmax
     integer, dimension(3),          intent(in)  :: lb_child, ub_child
-    real,    dimension(3),          intent(in)  ::  s_child,  s_parent
-    real,    dimension(3),          intent(in)  :: ds_child, ds_parent
+    real(kind=8),    dimension(3),          intent(in)  ::  s_child,  s_parent
+    real(kind=8),    dimension(3),          intent(in)  :: ds_child, ds_parent
     real,    dimension(          &
         indmin(1):indmax(1),     &
@@ -1641 +1665 @@
         lb_child(1):ub_child(1), &
         lb_child(2):ub_child(2), &
-        lb_child(3):ub_child(3)),   intent(in)  :: tempC
+        lb_child(3):ub_child(3)),   intent(in)  :: tempC, tempC_indic
 !---------------------------------------------------------------------------------------------------
     real, dimension(            &
@@ -1650 +1674 @@
     integer :: coeffraf,locind_child_left
     integer :: kuinf
+    REAL :: invcoeffraf
+    INTEGER :: diffmod, kk
 !
     coeffraf = nint ( ds_parent(1) / ds_child(1) )
@@ -1687 +1713 @@
     endif
 !
+ !   do k = lb_child(3),ub_child(3)
+ !       call Agrif_Update_2D_Recursive( type_update(1:2),tabtemp(:,:,k),tempC(:,:,k), &
+ !                                       indmin(1:2),indmax(1:2),                &
+ !                                       lb_child(1:2),ub_child(1:2),      &
+ !                                       s_child(1:2),s_parent(1:2),             &
+ !                                       ds_child(1:2),ds_parent(1:2) )
+ !   enddo
+
+
     do k = lb_child(3),ub_child(3)
-        call Agrif_Update_2D_Recursive( type_update(1:2),tabtemp(:,:,k),tempC(:,:,k), &
-                                        indmin(1:2),indmax(1:2),                &
-                                        lb_child(1:2),ub_child(1:2),      &
-                                        s_child(1:2),s_parent(1:2),             &
-                                        ds_child(1:2),ds_parent(1:2) )
+        call Agrif_Update_2D_Recursive( type_update,tabtemp(:,:,k),tempC(:,:,k),tempC_indic(:,:,k), &
+                                        indmin,indmax,                &
+                                        lb_child,ub_child,      &
+                                        s_child,s_parent,             &
+                                        ds_child,ds_parent)
     enddo
+
 !
     precomputedone(1) = .FALSE.
@@ -1711 +1747 @@
             enddo
         enddo
+    else if (type_update(3) == Agrif_Update_Copy) then
+    locind_child_left = lb_child(3) + nint((s_parent(3)-s_child(3))/ds_child(3))
+
+        do k=indmin(3),indmax(3)
+            do j = indmin(2),indmax(2)
+            do i = indmin(1),indmax(1)
+                tempP(i,j,k) = tabtemp(i,j,locind_child_left)
+            enddo
+            enddo
+            locind_child_left = locind_child_left + coeffraf
+        enddo
+    else if (type_update(3) == Agrif_Update_Average) then
+      invcoeffraf = 1./coeffraf
+      tempP = 0.
+      diffmod = 0
+      if (mod(coeffraf,2) == 0) diffmod=1 
+      locind_child_left = lb_child(3) + agrif_int((s_parent(3)-s_child(3))/ds_child(3))
+      if (Agrif_UseSpecialValueInUpdate) then
+        do k=indmin(3),indmax(3)
+          do kk=-coeffraf/2+locind_child_left+diffmod, &
+                   coeffraf/2+locind_child_left
+            do j=indmin(2),indmax(2)
+            do i=indmin(1),indmax(1)
+               if (tabtemp(i,j,kk) /= Agrif_SpecialValueFineGrid) then
+                  tempP(i,j,k) = tempP(i,j,k) + tabtemp(i,j,kk)
+               endif
+            enddo
+            enddo
+          enddo
+          locind_child_left = locind_child_left + coeffraf
+        enddo
+      else
+        do k=indmin(3),indmax(3)
+          do kk=-coeffraf/2+locind_child_left+diffmod, &
+                   coeffraf/2+locind_child_left
+            do j=indmin(2),indmax(2)
+            do i=indmin(1),indmax(1)
+                  tempP(i,j,k) = tempP(i,j,k) + tabtemp(i,j,kk)
+            enddo
+            enddo
+          enddo
+          locind_child_left = locind_child_left + coeffraf
+        enddo
+        if (.not.Agrif_Update_Weights) tempP = tempP * invcoeffraf
+      endif
     else
-        tempP = 0.
         do j = indmin(2),indmax(2)
         do i = indmin(1),indmax(1)
@@ -1720 +1800 @@
                                   s_parent(3),s_child(3),               &
                                   ds_parent(3),ds_child(3))
-!
+
         enddo
         enddo
+
+
     endif
 !---------------------------------------------------------------------------------------------------
@@ -1734 +1816 @@
 !! Calls #Agrif_Update_3D_Recursive and #Agrif_UpdateBase.
 !---------------------------------------------------------------------------------------------------
-subroutine Agrif_Update_4D_Recursive ( type_update,         &
-                                       tempP, tempC,        &
-                                       indmin, indmax,      &
-                                       lb_child, ub_child,  &
-                                        s_child,  s_parent, &
+subroutine Agrif_Update_4D_Recursive ( type_update,                     &
+                                       tempP, tempC, tempC_indic,       &
+                                       indmin, indmax,                  &
+                                       lb_child, ub_child,              &
+                                       s_child,  s_parent,              &
                                        ds_child, ds_parent )
 !---------------------------------------------------------------------------------------------------
@@ -1744 +1826 @@
     integer, dimension(4),          intent(in)  :: indmin, indmax
     integer, dimension(4),          intent(in)  :: lb_child, ub_child
-    real,    dimension(4),          intent(in)  ::  s_child,  s_parent
-    real,    dimension(4),          intent(in)  :: ds_child, ds_parent
+    real(kind=8),    dimension(4),          intent(in)  ::  s_child,  s_parent
+    real(kind=8),    dimension(4),          intent(in)  :: ds_child, ds_parent
     real,    dimension(          &
         indmin(1):indmax(1),     &
@@ -1755 +1837 @@
         lb_child(2):ub_child(2), &
         lb_child(3):ub_child(3), &
-        lb_child(4):ub_child(4)),   intent(in)  :: tempC
+        lb_child(4):ub_child(4)),   intent(in)  :: tempC, tempC_indic
 !---------------------------------------------------------------------------------------------------
     real, dimension(:,:,:,:), allocatable       :: tabtemp
@@ -1771 +1853 @@
                                                indmin(3):indmax(3), l),     &
                                        tempC(lb_child(1):ub_child(1),       &
+                                             lb_child(2):ub_child(2),       &
+                                             lb_child(3):ub_child(3), l),   &
+                                       tempC_indic(lb_child(1):ub_child(1),       &
                                              lb_child(2):ub_child(2),       &
                                              lb_child(3):ub_child(3), l),   &
@@ -1806 +1891 @@
 !! Calls #Agrif_Update_4D_Recursive and #Agrif_UpdateBase.
 !---------------------------------------------------------------------------------------------------
-subroutine Agrif_Update_5D_Recursive ( type_update,         &
-                                       tempP, tempC,        &
-                                       indmin, indmax,      &
-                                       lb_child, ub_child,  &
-                                        s_child,  s_parent, &
+subroutine Agrif_Update_5D_Recursive ( type_update,                     &
+                                       tempP, tempC, tempC_indic,       &
+                                       indmin, indmax,                  &
+                                       lb_child, ub_child,              &
+                                       s_child,  s_parent,              &
                                        ds_child, ds_parent )
 !---------------------------------------------------------------------------------------------------
@@ -1816 +1901 @@
     integer, dimension(5),          intent(in)  :: indmin, indmax
     integer, dimension(5),          intent(in)  :: lb_child, ub_child
-    real,    dimension(5),          intent(in)  ::  s_child,  s_parent
-    real,    dimension(5),          intent(in)  :: ds_child, ds_parent
+    real(kind=8),    dimension(5),          intent(in)  ::  s_child,  s_parent
+    real(kind=8),    dimension(5),          intent(in)  :: ds_child, ds_parent
     real,    dimension(          &
         indmin(1):indmax(1),     &
@@ -1829 +1914 @@
         lb_child(3):ub_child(3), &
         lb_child(4):ub_child(4), &
-        lb_child(5):ub_child(5)),   intent(in)  :: tempC
+        lb_child(5):ub_child(5)),   intent(in)  :: tempC, tempC_indic
 !---------------------------------------------------------------------------------------------------
     real, dimension(:,:,:,:,:), allocatable     :: tabtemp
@@ -1847 +1932 @@
                                                indmin(4):indmax(4), m),     &
                                        tempC(lb_child(1):ub_child(1),       &
+                                             lb_child(2):ub_child(2),       &
+                                             lb_child(3):ub_child(3),       &
+                                             lb_child(4):ub_child(4), m),   &
+                                       tempC_indic(lb_child(1):ub_child(1),       &
                                              lb_child(2):ub_child(2),       &
                                              lb_child(3):ub_child(3),       &
@@ -1885 +1974 @@
 !! Calls #Agrif_Update_5D_Recursive and #Agrif_UpdateBase.
 !---------------------------------------------------------------------------------------------------
-subroutine Agrif_Update_6D_Recursive ( type_update,         &
-                                       tempP, tempC,        &
-                                       indmin, indmax,      &
-                                       lb_child, ub_child,  &
-                                        s_child,  s_parent, &
+subroutine Agrif_Update_6D_Recursive ( type_update,                     &
+                                       tempP, tempC, tempC_indic,       &
+                                       indmin, indmax,                  &
+                                       lb_child, ub_child,              &
+                                       s_child,  s_parent,              &
                                        ds_child, ds_parent )
 !---------------------------------------------------------------------------------------------------
@@ -1895 +1984 @@
     integer, dimension(6),          intent(in)  :: indmin, indmax
     integer, dimension(6),          intent(in)  :: lb_child, ub_child
-    real,    dimension(6),          intent(in)  ::  s_child,  s_parent
-    real,    dimension(6),          intent(in)  :: ds_child, ds_parent
+    real(kind=8),    dimension(6),          intent(in)  ::  s_child,  s_parent
+    real(kind=8),    dimension(6),          intent(in)  :: ds_child, ds_parent
     real,    dimension(          &
         indmin(1):indmax(1),     &
@@ -1910 +1999 @@
         lb_child(4):ub_child(4), &
         lb_child(5):ub_child(5), &
-        lb_child(6):ub_child(6)),   intent(in)  :: tempC
+        lb_child(6):ub_child(6)),   intent(in)  :: tempC, tempC_indic
 !---------------------------------------------------------------------------------------------------
     real, dimension(:,:,:,:,:,:), allocatable   :: tabtemp
@@ -1930 +2019 @@
                                                indmin(5):indmax(5), n),     &
                                        tempC(lb_child(1):ub_child(1),       &
+                                             lb_child(2):ub_child(2),       &
+                                             lb_child(3):ub_child(3),       &
+                                             lb_child(4):ub_child(4),       &
+                                             lb_child(5):ub_child(5), n),   &
+                                       tempC_indic(lb_child(1):ub_child(1),       &
                                              lb_child(2):ub_child(2),       &
                                              lb_child(3):ub_child(3),       &
@@ -1982 +2076 @@
     real, dimension(indmin:indmax),     intent(out):: parent_tab
     real, dimension(lb_child:ub_child), intent(in) :: child_tab
-    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 :: np       ! Length of parent array

vendors/AGRIF/CMEMS_2020/AGRIF_FILES/modupdatebasic.F90

@@ -49 +49 @@
     integer,             intent(in)     :: np           !< Length of parent array
     integer,             intent(in)     :: nc           !< Length of child  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, locind_child_left, coeffraf
@@ -84 +84 @@
     integer,             intent(in)     :: np           !< Length of parent array
     integer,             intent(in)     :: nc           !< Length of child  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,             intent(in)     :: dir          !< Direction
 !---------------------------------------------------------------------------------------------------
@@ -157 +157 @@
     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
+    REAL(kind=8),        intent(in)     :: s_parent,  s_child
+    REAL(kind=8),        intent(in)     :: ds_parent, ds_child
 !
     INTEGER :: i, ii, locind_child_left, coeffraf
-    REAL    :: xpos, invcoeffraf
+    REAL(kind=8)    :: xpos
+    REAL ::  invcoeffraf
     INTEGER :: nbnonnuls
     INTEGER :: diffmod
@@ -229 +230 @@
 !---------------------------------------------------------------------------------------------------
     INTEGER, intent(in) :: nc2, 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
 !
     INTEGER, DIMENSION(:,:), ALLOCATABLE :: indchildaverage_tmp
     INTEGER :: i, locind_child_left, coeffraf
-    REAL    :: xpos
+    REAL(kind=8)    :: xpos
     INTEGER :: diffmod
 !
@@ -281 +282 @@
     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
+    REAL(kind=8),                intent(in)     :: s_parent,  s_child
+    REAL(kind=8),                intent(in)     :: ds_parent, ds_child
     INTEGER,             intent(in)     :: dir
 !
@@ -311 +312 @@
     ELSE
 !
-!CDIR NOLOOPCHG
-        do  j = 1,coeffraf
-!CDIR VECTOR
-            do i= 1,np
+
+        do i = 1,np
+        do j = 1,coeffraf
                 x(i) = x(i) + y(indchildaverage(i,dir) + j-1 )
-            enddo
+        enddo
         enddo
         IF (.not.Agrif_Update_Weights) THEN
@@ -338 +338 @@
     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
-!---------------------------------------------------------------------------------------------------
-    REAL    :: xpos, xposfin
+    real(kind=8),                intent(in)     :: s_parent,  s_child
+    real(kind=8),                intent(in)     :: ds_parent, ds_child
+!---------------------------------------------------------------------------------------------------
+    REAL(kind=8)    :: xpos, xposfin
     INTEGER :: i, ii, diffmod
     INTEGER :: it1, it2

vendors/AGRIF/CMEMS_2020/AGRIF_FILES/modutil.F90

@@ -2 +2 @@
 ! $Id$
 !
-!     Agrif (Adaptive Grid Refinement In Fortran)
+!     AGRIF (Adaptive Grid Refinement In Fortran)
 !
 !     Copyright (C) 2003 Laurent Debreu (Laurent.Debreu@imag.fr)
@@ -19 +19 @@
 !     You should have received a copy of the GNU General Public License
 !     along with this program; if not, write to the Free Software
-!     Foundation, Inc., 59 Temple Place-  Suite 330, Boston, MA 02111-1307, USA.
+!     Foundation, Inc., 59 Temple Place- Suite 330, Boston, MA 02111-1307, USA.
 !
 !> Module Agrif_Util
-!!
-!! This module contains the two procedures called in the main program :
-!! - #Agrif_Init_Grids allows the initialization of the root coarse grid
-!! - #Agrif_Step allows the creation of the grid hierarchy and the management of the time integration.
+!>
+!> 
+!
 !
 module Agrif_Util
 !
-    use Agrif_Clustering
-    use Agrif_BcFunction
-    use Agrif_seq
-    use Agrif_Link
+  use Agrif_User_Hierarchy
+  use Agrif_User_Variables
+  use Agrif_user_Functions
+  use Agrif_user_Interpolation
+  use Agrif_user_Update
+ 
 !
     implicit none
 !
-    abstract interface
-        subroutine step_proc()
-        end subroutine step_proc
-    end interface
-!
 contains
 !
-!===================================================================================================
-!  subroutine Agrif_Step
-!
-!> Creates the grid hierarchy and manages the time integration procedure.
-!> It is called in the main program.
-!> Calls subroutines #Agrif_Regrid and #Agrif_Integrate.
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Step ( procname )
-!---------------------------------------------------------------------------------------------------
-    procedure(step_proc)    :: procname     !< subroutine to call on each grid
-    type(agrif_grid), pointer :: ref_grid
-!
-! Set the clustering variables
-    call Agrif_clustering_def()
-!
-! Creation and initialization of the grid hierarchy
-    if ( Agrif_USE_ONLY_FIXED_GRIDS == 1 ) then
-!
-        if ( (Agrif_Mygrid % ngridstep == 0) .AND. (.not. Agrif_regrid_has_been_done) ) then
-            call Agrif_Regrid()
-            Agrif_regrid_has_been_done = .TRUE.
-        endif
-!
-    else
-!
-        if (mod(Agrif_Mygrid % ngridstep,Agrif_Regridding) == 0) then
-            call Agrif_Regrid()
-        endif
-!
-    endif
-!
-! Time integration of the grid hierarchy
-    if (agrif_coarse) then
-      ref_grid => agrif_coarsegrid
-    else
-      ref_grid => agrif_mygrid
-    endif
-    if ( Agrif_Parallel_sisters ) then
-        call Agrif_Integrate_Parallel(ref_grid,procname)
-    else
-        call Agrif_Integrate(ref_grid,procname)
-    endif
-!
-    if ( ref_grid%child_list%nitems > 0 ) call Agrif_Instance(ref_grid)
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Step
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Step_Child
-!
-!> Apply 'procname' to each grid of the hierarchy
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Step_Child ( procname )
-!---------------------------------------------------------------------------------------------------
-    procedure(step_proc)    :: procname     !< subroutine to call on each grid
-!
-    if ( Agrif_Parallel_sisters ) then
-        call Agrif_Integrate_Child_Parallel(Agrif_Mygrid,procname)
-    else
-        call Agrif_Integrate_Child(Agrif_Mygrid,procname)
-    endif
-!
-    if ( Agrif_Mygrid%child_list%nitems > 0 ) call Agrif_Instance(Agrif_Mygrid)
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Step_Child
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Regrid
-!
-!> Creates the grid hierarchy from fixed grids and adaptive mesh refinement.
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Regrid ( procname )
-!---------------------------------------------------------------------------------------------------
-    procedure(init_proc), optional    :: procname     !< Initialisation subroutine (Default: Agrif_InitValues)
-!
-    type(Agrif_Rectangle), pointer     :: coarsegrid_fixed
-    type(Agrif_Rectangle), pointer     :: coarsegrid_moving
-    integer                            :: i, j
-    integer :: nunit
-    logical :: BEXIST
-    TYPE(Agrif_Rectangle)            :: newrect    ! Pointer on a new grid
-    integer :: is_coarse, rhox, rhoy, rhoz, rhot
-!
-    if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) &
-        call Agrif_detect_all(Agrif_Mygrid)     ! Detection of areas to be refined
-!
-    allocate(coarsegrid_fixed)
-    allocate(coarsegrid_moving)
-!
-    if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) &
-        call Agrif_Cluster_All(Agrif_Mygrid,coarsegrid_moving) ! Clustering
-!
-    if ( Agrif_USE_FIXED_GRIDS == 1 .OR. Agrif_USE_ONLY_FIXED_GRIDS == 1 ) then
-!
-        if (Agrif_Mygrid % ngridstep == 0) then
-!            
-            nunit = Agrif_Get_Unit()
-            open(nunit, file='AGRIF_FixedGrids.in', form='formatted', status="old", ERR=99)
-            if (agrif_coarse) then ! SKIP the coarse grid declaration
-                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
-            endif
-!           Creation of the grid hierarchy from the Agrif_FixedGrids.in file
-            do i = 1,Agrif_Probdim
-                coarsegrid_fixed % imin(i) = 1
-                coarsegrid_fixed % imax(i) = Agrif_Mygrid % nb(i) + 1
-            enddo
-            j = 1
-            call Agrif_Read_Fix_Grd(coarsegrid_fixed,j,nunit)
-            close(nunit)
-!
-            call Agrif_gl_clear(Agrif_oldmygrid)
-!
-!           Creation of the grid hierarchy from coarsegrid_fixed
-            call Agrif_Create_Grids(Agrif_Mygrid,coarsegrid_fixed)
-            
-        else
-            call Agrif_gl_copy(Agrif_oldmygrid, Agrif_Mygrid % child_list)
-        endif
-    else
-        call Agrif_gl_copy(Agrif_oldmygrid, Agrif_Mygrid % child_list)
-        call Agrif_gl_clear(Agrif_Mygrid % child_list)
-    endif
-!
-    if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) then
-!
-        call Agrif_Save_All(Agrif_oldmygrid)
-        call Agrif_Free_before_All(Agrif_oldmygrid)
-!
-!       Creation of the grid hierarchy from coarsegrid_moving
-        call Agrif_Create_Grids(Agrif_Mygrid,coarsegrid_moving)
-!
-    endif
-!
-!   Initialization of the grid hierarchy by copy or interpolation
-!
-#if defined AGRIF_MPI
-    if ( Agrif_Parallel_sisters ) then
-        call Agrif_Init_Hierarchy_Parallel_1(Agrif_Mygrid)
-        call Agrif_Init_Hierarchy_Parallel_2(Agrif_Mygrid,procname)
-    else
-        call Agrif_Init_Hierarchy(Agrif_Mygrid,procname)
-    endif
-#else
-        call Agrif_Init_Hierarchy(Agrif_Mygrid,procname)
-#endif
-!
-    if ( Agrif_USE_ONLY_FIXED_GRIDS == 0 ) call Agrif_Free_after_All(Agrif_oldmygrid)
-!
-    Agrif_regrid_has_been_done = .TRUE.
-!
-    call Agrif_Instance( Agrif_Mygrid )
-!
-    deallocate(coarsegrid_fixed)
-    deallocate(coarsegrid_moving)
-!
-    return
-!
-!     Opening error
-!
-99  INQUIRE(FILE='AGRIF_FixedGrids.in',EXIST=BEXIST)
-    if (.not. BEXIST) then
-        print*,'ERROR : File AGRIF_FixedGrids.in not found.'
-        STOP
-    else
-        print*,'Error opening file AGRIF_FixedGrids.in'
-        STOP
-    endif
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Regrid
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_detect_All
-!
-!> Detects areas to be refined.
-!---------------------------------------------------------------------------------------------------
-recursive subroutine Agrif_detect_all ( g )
-!---------------------------------------------------------------------------------------------------
-    TYPE(Agrif_Grid),  pointer  :: g        !< Pointer on the current grid
-!
-    Type(Agrif_PGrid), pointer  :: parcours ! Pointer for the recursive procedure
-    integer, DIMENSION(3)       :: size
-    integer                     :: i
-    real                        :: g_eps
-!
-    parcours => g % child_list % first
-!
-!   To be positioned on the finer grids of the grid hierarchy
-!
-    do while (associated(parcours))
-        call Agrif_detect_all(parcours % gr)
-        parcours => parcours % next
-    enddo
-!
-    g_eps = huge(1.)
-    do i = 1,Agrif_Probdim
-        g_eps = min(g_eps, g % Agrif_dx(i))
-    enddo
-!
-    g_eps = g_eps / 100.
-!
-    if ( Agrif_Probdim == 1 ) g%tabpoint1D = 0
-    if ( Agrif_Probdim == 2 ) g%tabpoint2D = 0
-    if ( Agrif_Probdim == 3 ) g%tabpoint3D = 0
-!
-    do i = 1,Agrif_Probdim
-        if ( g%Agrif_dx(i)/Agrif_coeffref(i) < (Agrif_mind(i)-g_eps) ) return
-    enddo
-!
-    call Agrif_instance(g)
-!
-!   Detection (Agrif_detect is a users routine)
-!
-    do i = 1,Agrif_Probdim
-        size(i) = g % nb(i) + 1
-    enddo
-!
-    SELECT CASE (Agrif_Probdim)
-    CASE (1)
-        call Agrif_detect(g%tabpoint1D,size)
-    CASE (2)
-        call Agrif_detect(g%tabpoint2D,size)
-    CASE (3)
-        call Agrif_detect(g%tabpoint3D,size)
-    END SELECT
-!
-!   Addition of the areas detected on the child grids
-!
-    parcours => g % child_list % first
-!
-    do while (associated(parcours))
-        call Agrif_Add_detected_areas(g,parcours % gr)
-        parcours => parcours % next
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_detect_all
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Add_detected_areas
-!
-!> Adds on the parent grid the areas detected on its child grids
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Add_detected_areas ( parentgrid, childgrid )
-!---------------------------------------------------------------------------------------------------
-    Type(Agrif_Grid), pointer   :: parentgrid
-    Type(Agrif_Grid), pointer   :: childgrid
-!
-    integer :: i,j,k
-!
-    do i = 1,childgrid%nb(1)+1
-        if ( Agrif_Probdim == 1 ) then
-            if (childgrid%tabpoint1D(i)==1) then
-                parentgrid%tabpoint1D(childgrid%ix(1)+(i-1)/Agrif_Coeffref(1)) = 1
-            endif
-        else
-            do j=1,childgrid%nb(2)+1
-                if (Agrif_Probdim==2) then
-                    if (childgrid%tabpoint2D(i,j)==1) then
-                        parentgrid%tabpoint2D(                       &
-                            childgrid%ix(1)+(i-1)/Agrif_Coeffref(1), &
-                            childgrid%ix(2)+(j-1)/Agrif_Coeffref(2)) = 1
-                    endif
-                else
-                    do k=1,childgrid%nb(3)+1
-                        if (childgrid%tabpoint3D(i,j,k)==1) then
-                            parentgrid%tabpoint3D(                       &
-                                childgrid%ix(1)+(i-1)/Agrif_Coeffref(1), &
-                                childgrid%ix(2)+(j-1)/Agrif_Coeffref(2), &
-                                childgrid%ix(3)+(k-1)/Agrif_Coeffref(3)) = 1
-                        endif
-                    enddo
-                endif
-            enddo
-        endif
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Add_detected_areas
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Free_before_All
-!---------------------------------------------------------------------------------------------------
-recursive subroutine Agrif_Free_before_All ( gridlist )
-!---------------------------------------------------------------------------------------------------
-    Type(Agrif_Grid_List), intent(inout)    :: gridlist !< Grid list
-!
-    Type(Agrif_PGrid), pointer   :: parcours ! Pointer for the recursive procedure
-!
-    parcours => gridlist % first
-!
-    do while (associated(parcours))
-!
-        if (.not. parcours%gr%fixed) then
-            call Agrif_Free_data_before(parcours%gr)
-            parcours % gr % oldgrid = .TRUE.
-        endif
-!
-        call Agrif_Free_before_all (parcours % gr % child_list)
-!
-        parcours => parcours % next
-!
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Free_before_All
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Save_All
-!---------------------------------------------------------------------------------------------------
-recursive subroutine Agrif_Save_All ( gridlist )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Grid_List), intent(inout)    :: gridlist !< Grid list
-!
-    type(Agrif_PGrid), pointer   :: parcours ! Pointer for the recursive procedure
-!
-    parcours => gridlist % first
-!
-    do while (associated(parcours))
-!
-        if (.not. parcours%gr%fixed) then
-            call Agrif_Instance(parcours%gr)
-            call Agrif_Before_Regridding()
-            parcours % gr % oldgrid = .TRUE.
-        endif
-!
-        call Agrif_Save_All(parcours % gr % child_list)
-!
-        parcours => parcours % next
-!
-      enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Save_All
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Free_after_All
-!---------------------------------------------------------------------------------------------------
-recursive subroutine Agrif_Free_after_All ( gridlist )
-!---------------------------------------------------------------------------------------------------
-    Type(Agrif_Grid_List), intent(inout)    :: gridlist       !< Grid list to free
-!
-    Type(Agrif_PGrid), pointer  :: parcours ! Pointer for the recursive proced
-    Type(Agrif_PGrid), pointer  :: preparcours
-    Type(Agrif_PGrid), pointer  :: preparcoursini
-!
-    allocate(preparcours)
-!
-    preparcoursini => preparcours
-!
-    nullify(preparcours % gr)
-!
-    preparcours % next => gridlist % first
-    parcours => gridlist % first
-!
-    do while (associated(parcours))
-!
-        if ( (.NOT. parcours%gr % fixed) .AND. (parcours%gr % oldgrid) ) then
-            call Agrif_Free_data_after(parcours%gr)
-        endif
-!
-        call Agrif_Free_after_all( parcours%gr % child_list )
-!
-        if (parcours % gr % oldgrid) then
-            deallocate(parcours % gr)
-            preparcours % next => parcours % next
-            deallocate(parcours)
-            parcours => preparcours % next
-        else
-            preparcours => preparcours % next
-            parcours => parcours % next
-        endif
-!
-    enddo
-!
-    deallocate(preparcoursini)
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Free_after_All
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Integrate
-!
-!> Manages the time integration of the grid hierarchy.
-!! Recursive subroutine and call on subroutines Agrif_Init::Agrif_Instance and #Agrif_Step
-!---------------------------------------------------------------------------------------------------
-recursive subroutine Agrif_Integrate ( g, procname )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Grid), pointer   :: g        !< Pointer on the current grid
-    procedure(step_proc)        :: procname !< Subroutine to call on each grid
-!
-    type(Agrif_PGrid), pointer  :: parcours ! Pointer for the recursive procedure
-    integer                     :: nbt      ! Number of time steps of the current grid
-    integer                     :: i, k
-!
-!   Instanciation of the variables of the current grid
-!    if ( g % fixedrank /= 0 ) then
-        call Agrif_Instance(g)
-!    endif
-!
-!   One step on the current grid
-!
-    call procname ()
-!
-!   Number of time steps on the current grid
-!
-    g%ngridstep = g % ngridstep + 1
-    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)
-!
-!       Number of time steps
-        nbt = 1
-        do i = 1,Agrif_Probdim
-            nbt = max(nbt, parcours % gr % timeref(i))
-        enddo
-!
-        do k = 1,nbt
-            call Agrif_Integrate(parcours % gr, procname)
-        enddo
-!
-        parcours => parcours % next
-!
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Integrate
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Integrate_Parallel
-!
-!> Manages the time integration of the grid hierarchy in parallel
-!! Recursive subroutine and call on subroutines Agrif_Init::Agrif_Instance and #Agrif_Step
-!---------------------------------------------------------------------------------------------------
-recursive subroutine Agrif_Integrate_Parallel ( g, procname )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Grid), pointer   :: g        !< Pointer on the current grid
-    procedure(step_proc)        :: procname !< Subroutine to call on each grid
-!
-#if defined AGRIF_MPI
-    type(Agrif_PGrid), pointer  :: gridp    ! Pointer for the recursive procedure
-    integer                     :: nbt      ! Number of time steps of the current grid
-    integer                     :: i, k, is
-!
-!   Instanciation of the variables of the current grid
-    if ( g % fixedrank /= 0 ) then
-        call Agrif_Instance(g)
-    endif
-!
-! One step on the current grid
-    call procname ()
-!
-! Number of time steps on the current grid
-    g % ngridstep = g % ngridstep + 1
-!
-! Continue only if the grid has defined sequences of child integrations.
-    if ( .not. associated(g % child_seq) ) return
-!
-    do is = 1, g % child_seq % nb_seqs
-!
-!     For each sequence, a given processor does integrate only on grid.
-        gridp => Agrif_seq_select_child(g,is)
-!
-!     Instanciation of the variables of the current grid
-        call Agrif_Instance(gridp % gr)
-!
-!     Number of time steps
-        nbt = 1
-        do i = 1,Agrif_Probdim
-            nbt = max(nbt, gridp % gr % timeref(i))
-        enddo
-!
-        do k = 1,nbt
-            call Agrif_Integrate_Parallel(gridp % gr, procname)
-        enddo
-!
-    enddo
-#else
-    call Agrif_Integrate( g, procname )
-#endif
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Integrate_Parallel
-!===================================================================================================
-!
-!
-!===================================================================================================
-!  subroutine Agrif_Integrate_ChildGrids
-!
-!> Manages the time integration of the grid hierarchy.
-!! Call the subroutine procname on each child grid of the current grid
-!---------------------------------------------------------------------------------------------------
-recursive subroutine Agrif_Integrate_ChildGrids ( procname )
-!---------------------------------------------------------------------------------------------------
-    procedure(step_proc)        :: procname !< Subroutine to call on each grid
-!
-    type(Agrif_PGrid), pointer  :: parcours ! Pointer for the recursive procedure
-    integer                     :: nbt      ! Number of time steps of the current grid
-    integer                     :: i, k, is
-    type(Agrif_Grid)                    , pointer :: save_grid
-    type(Agrif_PGrid), pointer  :: gridp    ! Pointer for the recursive procedure
-    
-    save_grid => Agrif_Curgrid
 
-! Number of time steps on the current grid
-    save_grid % ngridstep = save_grid % ngridstep + 1
-    
-#ifdef AGRIF_MPI
-    if ( .not. Agrif_Parallel_sisters ) then
-#endif
-    parcours => save_grid % 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)
-!
-!       Number of time steps
-        nbt = 1
-        do i = 1,Agrif_Probdim
-            nbt = max(nbt, parcours % gr % timeref(i))
-        enddo
-!
-        do k = 1,nbt
-            call procname()
-        enddo
-!
-        parcours => parcours % next
-!
-    enddo
-
-#ifdef AGRIF_MPI
-    else
-! Continue only if the grid has defined sequences of child integrations.
-    if ( .not. associated(save_grid % child_seq) ) return
-!
-    do is = 1, save_grid % child_seq % nb_seqs
-!
-!     For each sequence, a given processor does integrate only on grid.
-        gridp => Agrif_seq_select_child(save_grid,is)
-!
-!     Instanciation of the variables of the current grid
-        call Agrif_Instance(gridp % gr)
-!
-!     Number of time steps
-        nbt = 1
-        do i = 1,Agrif_Probdim
-            nbt = max(nbt, gridp % gr % timeref(i))
-        enddo
-!
-        do k = 1,nbt
-            call procname()
-        enddo
-!
-    enddo
-    endif
-#endif 
-
-    call Agrif_Instance(save_grid)
-    
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Integrate_ChildGrids
-!===================================================================================================
-!===================================================================================================
-!  subroutine Agrif_Integrate_Child
-!
-!> Manages the time integration of the grid hierarchy.
-!! Recursive subroutine and call on subroutines Agrif_Instance & Agrif_Step.
-!---------------------------------------------------------------------------------------------------
-recursive subroutine Agrif_Integrate_Child ( g, procname )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Grid), pointer   :: g        !< Pointer on the current grid
-    procedure(step_proc)        :: procname !< Subroutine to call on each grid
-!
-    type(Agrif_PGrid), pointer  :: parcours ! Pointer for the recursive procedure
-!
-!   One step on the current grid
-!
-    call procname ()
-!
-!   Number of time steps on the current grid
-!
-    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)
-        call Agrif_Integrate_Child (parcours % gr, procname)
-        parcours => parcours % next
-!
-    enddo
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Integrate_Child
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Integrate_Child_Parallel
-!
-!> Manages the time integration of the grid hierarchy.
-!! Recursive subroutine and call on subroutines Agrif_Instance & Agrif_Step.
-!---------------------------------------------------------------------------------------------------
-recursive subroutine Agrif_Integrate_Child_Parallel ( g, procname )
-!---------------------------------------------------------------------------------------------------
-    type(Agrif_Grid), pointer   :: g        !< Pointer on the current grid
-    procedure(step_proc)        :: procname !< Subroutine to call on each grid
-!
-#if defined AGRIF_MPI
-    type(Agrif_PGrid), pointer  :: gridp    ! Pointer for the recursive procedure
-    integer                     :: is
-!
-! Instanciation of the variables of the current grid
-    call Agrif_Instance(g)
-!
-! One step on the current grid
-    call procname ()
-!
-! Continue only if the grid has defined sequences of child integrations.
-    if ( .not. associated(g % child_seq) ) return
-!
-    do is = 1, g % child_seq % nb_seqs
-!
-!     For each sequence, a given processor does integrate only on grid.
-        gridp => Agrif_seq_select_child(g,is)
-        call Agrif_Integrate_Child_Parallel(gridp % gr, procname)
-!
-    enddo
-!
-    call Agrif_Instance(g)
-#else
-    call Agrif_Integrate_Child( g, procname )
-#endif
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Integrate_Child_Parallel
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Init_Grids
-!
-!> Initializes the root coarse grid pointed by Agrif_Mygrid. It is called in the main program.
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Init_Grids ( procname1, procname2 )
-!---------------------------------------------------------------------------------------------------
-    procedure(typedef_proc), optional   :: procname1 !< (Default: Agrif_probdim_modtype_def)
-    procedure(alloc_proc),   optional   :: procname2 !< (Default: Agrif_Allocationcalls)
-!
-    integer :: i, ierr_allocate, nunit
-    integer :: is_coarse, rhox,rhoy,rhoz,rhot
-    logical :: BEXIST
-!
-    if (present(procname1)) Then
-        call procname1()
-    else
-        call Agrif_probdim_modtype_def()
-    endif
-!
-
-! TEST FOR COARSE GRID (GRAND MOTHER GRID) in AGRIF_FixedGrids.in
-    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
-    if (is_coarse == -1) then
-       agrif_coarse = .TRUE.
-       if (Agrif_Probdim == 3) then
-          coarse_spaceref(1:3)=(/rhox,rhoy,rhoz/)
-       elseif (Agrif_Probdim == 2) then
-          coarse_spaceref(1:2)=(/rhox,rhoy/)
-       elseif (Agrif_Probdim == 2) then
-          coarse_spaceref(1:1)=(/rhox/)
-       endif
-       coarse_timeref(1:Agrif_Probdim) = rhot
-    endif
-    close(nunit)
-    
-    Agrif_UseSpecialValue = .FALSE.
-    Agrif_UseSpecialValueFineGrid = .FALSE.
-    Agrif_SpecialValue = 0.
-    Agrif_SpecialValueFineGrid = 0.
-!
-    allocate(Agrif_Mygrid)
-    allocate(Agrif_OldMygrid)
-!
-!   Space and time refinement factors are set to 1 on the root grid
-!
-    do i = 1,Agrif_Probdim
-        Agrif_Mygrid % spaceref(i) = coarse_spaceref(i)
-        Agrif_Mygrid % timeref(i)  = coarse_timeref(i)
-    enddo
-!
-!   Initialization of the number of time steps
-    Agrif_Mygrid % ngridstep = 0
-    Agrif_Mygrid % grid_id   = 0
-!
-!   No parent grid for the root coarse grid
-    nullify(Agrif_Mygrid % parent)
-!
-!   Initialization of the minimum positions, global abscissa and space steps
-    do i = 1, Agrif_Probdim
-        Agrif_Mygrid % ix(i) = 1
-        Agrif_Mygrid % Agrif_x(i)  = 0.
-        Agrif_Mygrid % Agrif_dx(i) = 1./Agrif_Mygrid % spaceref(i)
-        Agrif_Mygrid % Agrif_dt(i) = 1./Agrif_Mygrid % timeref(i)
-!       Borders of the root coarse grid
-        Agrif_Mygrid % NearRootBorder(i) = .true.
-        Agrif_Mygrid % DistantRootBorder(i) = .true.
-    enddo
-!
-!   The root coarse grid is a fixed grid
-    Agrif_Mygrid % fixed = .TRUE.
-!   Level of the root grid
-    Agrif_Mygrid % level = 0
-!   Maximum level in the hierarchy
-    Agrif_MaxLevelLoc = 0
-!
-!   Number of the grid pointed by Agrif_Mygrid (root coarse grid)
-    Agrif_Mygrid % rank = 1
-!
-!   Number of the root grid as a fixed grid
-    Agrif_Mygrid % fixedrank = 0
-!
-!   Initialization of some fields of the root grid variables
-    ierr_allocate = 0
-    if( Agrif_NbVariables(0) > 0 ) allocate(Agrif_Mygrid % tabvars(Agrif_NbVariables(0)),stat=ierr_allocate)
-    if( Agrif_NbVariables(1) > 0 ) allocate(Agrif_Mygrid % tabvars_c(Agrif_NbVariables(1)),stat=ierr_allocate)
-    if( Agrif_NbVariables(2) > 0 ) allocate(Agrif_Mygrid % tabvars_r(Agrif_NbVariables(2)),stat=ierr_allocate)
-    if( Agrif_NbVariables(3) > 0 ) allocate(Agrif_Mygrid % tabvars_l(Agrif_NbVariables(3)),stat=ierr_allocate)
-    if( Agrif_NbVariables(4) > 0 ) allocate(Agrif_Mygrid % tabvars_i(Agrif_NbVariables(4)),stat=ierr_allocate)
-    if (ierr_allocate /= 0) THEN
-      STOP "*** ERROR WHEN ALLOCATING TABVARS ***"
-    endif
-!
-!   Initialization of the other fields of the root grid variables (number of
-!   cells, positions, number and type of its dimensions, ...)
-    call Agrif_Instance(Agrif_Mygrid)
-    call Agrif_Set_numberofcells(Agrif_Mygrid)
-!
-!   Allocation of the array containing the values of the grid variables
-    call Agrif_Allocation(Agrif_Mygrid, procname2)
-    call Agrif_initialisations(Agrif_Mygrid)
-!
-!   Total number of fixed grids
-    Agrif_nbfixedgrids = 0
-    
-! If a grand mother grid is declared
-
-    if (agrif_coarse) then
-      allocate(Agrif_Coarsegrid)
-
-      Agrif_Coarsegrid % ngridstep = 0
-      Agrif_Coarsegrid % grid_id   = -9999
-      
-    do i = 1, Agrif_Probdim
-        Agrif_Coarsegrid%spaceref(i) = coarse_spaceref(i)
-        Agrif_Coarsegrid%timeref(i) = coarse_timeref(i)
-        Agrif_Coarsegrid % ix(i) = 1
-        Agrif_Coarsegrid % Agrif_x(i)  = 0.
-        Agrif_Coarsegrid % Agrif_dx(i) = 1.
-        Agrif_Coarsegrid % Agrif_dt(i) = 1.
-!       Borders of the root coarse grid
-        Agrif_Coarsegrid % NearRootBorder(i) = .true.
-        Agrif_Coarsegrid % DistantRootBorder(i) = .true.
-        Agrif_Coarsegrid % nb(i) =Agrif_mygrid%nb(i) / coarse_spaceref(i)
-    enddo      
-
-!   The root coarse grid is a fixed grid
-    Agrif_Coarsegrid % fixed = .TRUE.
-!   Level of the root grid
-    Agrif_Coarsegrid % level = -1
-    
-    Agrif_Coarsegrid % grand_mother_grid = .true.
-
-!   Number of the grid pointed by Agrif_Mygrid (root coarse grid)
-    Agrif_Coarsegrid % rank = -9999
-!
-!   Number of the root grid as a fixed grid
-    Agrif_Coarsegrid % fixedrank = -9999
-    
-      Agrif_Mygrid%parent => Agrif_Coarsegrid
-      
-! Not used but required to prevent seg fault
-      Agrif_Coarsegrid%parent => Agrif_Mygrid
-      
-      call Agrif_Create_Var(Agrif_Coarsegrid)
-
-! Reset to null
-      Nullify(Agrif_Coarsegrid%parent)
-      
-      Agrif_Coarsegrid%child_list%nitems = 1
-      allocate(Agrif_Coarsegrid%child_list%first)
-      allocate(Agrif_Coarsegrid%child_list%last)
-      Agrif_Coarsegrid%child_list%first%gr => Agrif_Mygrid
-      Agrif_Coarsegrid%child_list%last%gr => Agrif_Mygrid
-
-    endif
-    
-    return
-
-98  INQUIRE(FILE='AGRIF_FixedGrids.in',EXIST=BEXIST)
-    if (.not. BEXIST) then
-        print*,'ERROR : File AGRIF_FixedGrids.in not found.'
-        STOP
-    else
-        print*,'Error opening file AGRIF_FixedGrids.in'
-        STOP
-    endif
-    
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Init_Grids
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Deallocation
-!
-!> Deallocates all data arrays.
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Deallocation
-!---------------------------------------------------------------------------------------------------
-    integer                         :: nb
-    type(Agrif_Variable), pointer   :: var
-    type(Agrif_Variable_c), pointer   :: var_c
-    type(Agrif_Variable_l), pointer   :: var_l
-    type(Agrif_Variable_i), pointer   :: var_i
-!
-    do nb = 1,Agrif_NbVariables(0)
-!
-        var => Agrif_Mygrid % tabvars(nb)
-!
-        if ( allocated(var % array1) ) deallocate(var % array1)
-        if ( allocated(var % array2) ) deallocate(var % array2)
-        if ( allocated(var % array3) ) deallocate(var % array3)
-        if ( allocated(var % array4) ) deallocate(var % array4)
-        if ( allocated(var % array5) ) deallocate(var % array5)
-        if ( allocated(var % array6) ) deallocate(var % array6)
-!
-        if ( allocated(var % sarray1) ) deallocate(var % sarray1)
-        if ( allocated(var % sarray2) ) deallocate(var % sarray2)
-        if ( allocated(var % sarray3) ) deallocate(var % sarray3)
-        if ( allocated(var % sarray4) ) deallocate(var % sarray4)
-        if ( allocated(var % sarray5) ) deallocate(var % sarray5)
-        if ( allocated(var % sarray6) ) deallocate(var % sarray6)
-!
-        if ( allocated(var % darray1) ) deallocate(var % darray1)
-        if ( allocated(var % darray2) ) deallocate(var % darray2)
-        if ( allocated(var % darray3) ) deallocate(var % darray3)
-        if ( allocated(var % darray4) ) deallocate(var % darray4)
-        if ( allocated(var % darray5) ) deallocate(var % darray5)
-        if ( allocated(var % darray6) ) deallocate(var % darray6)
-!
-    enddo
-!
-    do nb = 1,Agrif_NbVariables(1)
-!
-        var_c => Agrif_Mygrid % tabvars_c(nb)
-!
-        if ( allocated(var_c % carray1) ) deallocate(var_c % carray1)
-        if ( allocated(var_c % carray2) ) deallocate(var_c % carray2)
-!
-    enddo
-
-    do nb = 1,Agrif_NbVariables(3)
-!
-        var_l => Agrif_Mygrid % tabvars_l(nb)
-!
-        if ( allocated(var_l % larray1) ) deallocate(var_l % larray1)
-        if ( allocated(var_l % larray2) ) deallocate(var_l % larray2)
-        if ( allocated(var_l % larray3) ) deallocate(var_l % larray3)
-        if ( allocated(var_l % larray4) ) deallocate(var_l % larray4)
-        if ( allocated(var_l % larray5) ) deallocate(var_l % larray5)
-        if ( allocated(var_l % larray6) ) deallocate(var_l % larray6)
-!
-    enddo
-!
-    do nb = 1,Agrif_NbVariables(4)
-!
-        var_i => Agrif_Mygrid % tabvars_i(nb)
-!
-        if ( allocated(var_i % iarray1) ) deallocate(var_i % iarray1)
-        if ( allocated(var_i % iarray2) ) deallocate(var_i % iarray2)
-        if ( allocated(var_i % iarray3) ) deallocate(var_i % iarray3)
-        if ( allocated(var_i % iarray4) ) deallocate(var_i % iarray4)
-        if ( allocated(var_i % iarray5) ) deallocate(var_i % iarray5)
-        if ( allocated(var_i % iarray6) ) deallocate(var_i % iarray6)
-!
-    enddo
-!
-    if ( allocated(Agrif_Mygrid % tabvars) )   deallocate(Agrif_Mygrid % tabvars)
-    if ( allocated(Agrif_Mygrid % tabvars_c) ) deallocate(Agrif_Mygrid % tabvars_c)
-    if ( allocated(Agrif_Mygrid % tabvars_r) ) deallocate(Agrif_Mygrid % tabvars_r)
-    if ( allocated(Agrif_Mygrid % tabvars_l) ) deallocate(Agrif_Mygrid % tabvars_l)
-    if ( allocated(Agrif_Mygrid % tabvars_i) ) deallocate(Agrif_Mygrid % tabvars_i)
-    deallocate(Agrif_Mygrid)
-!---------------------------------------------------------------------------------------------------
-end subroutine Agrif_Deallocation
-!===================================================================================================
-!
-!===================================================================================================
-!  subroutine Agrif_Step_adj
-!
-!> creates the grid hierarchy and manages the backward time integration procedure.
-!> It is called in the main program.
-!> calls subroutines #Agrif_Regrid and #Agrif_Integrate_adj.
-!---------------------------------------------------------------------------------------------------
-subroutine Agrif_Step_adj ( procname )
-!---------------------------------------------------------------------------------------------------
-    procedure(step_proc)    :: procname     !< Subroutine to call on each grid
-!
-!   Creation and initialization of the grid hierarchy
-!
-!   Set the clustering variables
-    call Agrif_clustering_def()
-!
-    if ( Agrif_USE_ONLY_FIXED_GRIDS .EQ. 1 ) then
-!
-        if (Agrif_Mygrid % ngridstep == 0) then
-            if (.not.Agrif_regrid_has_been_done ) then
-                call Agrif_Regrid()
-            endif
-            call Agrif_Instance(Agrif_Mygrid)
-        endif
-!
-    else
-!
-        if (mod(Agrif_Mygrid % ngridstep, Agrif_Regridding) == 0) then
-            call Agrif_Regrid()
-            call Agrif_Instance(Agrif_Mygrid)
-        endif
-!
-    endif
-!
-!   Time integration of the grid hierarchy
-!
-    call Agrif_Integrate_adj (Agrif_Mygrid,procname)
-!
-    if ( Agrif_Mygrid % child_list % nitems > 0 ) call Agrif_Instance(Agrif_Mygrid)
-!
-!------------------------------------