Changeset 13027

Timestamp:

2020-06-03T16:36:09+02:00 (3 years ago)

Author:

rblod

Message:

New AGRIF library, see ticket #2129

Location:

vendors/AGRIF/dev_r12970_AGRIF_CMEMS

Files:

• AGRIF_FILES/modarrays.F90 (modified) (15 diffs)
• AGRIF_FILES/modbc.F90 (modified) (1 diff)
• AGRIF_FILES/modbcfunction.F90 (modified) (18 diffs)
• AGRIF_FILES/modcurgridfunctions.F90 (modified) (4 diffs)
• AGRIF_FILES/modgrids.F90 (modified) (3 diffs)
• AGRIF_FILES/modinterp.F90 (modified) (28 diffs)
• AGRIF_FILES/modinterpbasic.F90 (modified) (1 diff)
• AGRIF_FILES/modlinktomodel.F90 (modified) (4 diffs)
• AGRIF_FILES/modmpp.F90 (modified) (8 diffs)
• AGRIF_FILES/modtypes.F90 (modified) (11 diffs)
• AGRIF_FILES/modupdate.F90 (modified) (50 diffs)
• AGRIF_FILES/modupdatebasic.F90 (modified) (1 diff)
• AGRIF_FILES/modutil.F90 (modified) (6 diffs)
• AGRIF_FILES/modvariables.F90 (modified) (1 diff)
• LEX/Makefile.lex (modified) (2 diffs)
• LEX/convert.y (modified) (4 diffs)
• LEX/fortran.lex (modified) (8 diffs)
• LEX/fortran.y (modified) (48 diffs)
• LIB/DiversListe.c (modified) (3 diffs)
• LIB/Makefile (modified) (3 diffs)
• LIB/SubLoopCreation.c (modified) (21 diffs)
• LIB/UtilAgrif.c (modified) (1 diff)
• LIB/UtilFortran.c (modified) (5 diffs)
• LIB/UtilListe.c (modified) (10 diffs)
• LIB/WorkWithlistdatavariable.c (modified) (5 diffs)
• LIB/WorkWithlistvarindoloop.c (modified) (16 diffs)
• LIB/WriteInFile.c (modified) (1 diff)
• LIB/Writedeclarations.c (modified) (25 diffs)
• LIB/decl.h (modified) (13 diffs)
• LIB/fortran.c (modified) (92 diffs)
• LIB/main.c (modified) (64 diffs)
• LIB/toamr.c (modified) (17 diffs)
• Makefile (added)

vendors/AGRIF/dev_r12970_AGRIF_CMEMS/AGRIF_FILES/modarrays.F90

@@ -55 +55 @@
                                proc_id,         &
                                coords,          &
-                               lb_tab_true, ub_tab_true, memberin )
+                               lb_tab_true, ub_tab_true, memberin,  &
+                               indminglob3,indmaxglob3,check_perio)
 !---------------------------------------------------------------------------------------------------
     integer,                   intent(in)  :: nbdim         !< Number of dimensions
@@ -61 +62 @@
     integer, dimension(nbdim), intent(in)  :: ub_var        !< Local upper boundary on the current processor
     integer, dimension(nbdim), intent(in)  :: lb_tab        !< Global lower boundary of the variable
+    integer, dimension(nbdim),OPTIONAL     :: indminglob3,indmaxglob3 !< True bounds for MPI USE
     integer, dimension(nbdim), intent(in)  :: ub_tab        !< Global upper boundary of the variable
     integer,                   intent(in)  :: proc_id       !< Current processor
@@ -67 +69 @@
     integer, dimension(nbdim), intent(out) :: ub_tab_true   !< Global value of ub_var on the current processor
     logical,                   intent(out) :: memberin
+    logical,optional,          intent(in)  :: check_perio   !< check for periodicity
+    logical :: check_perio_local
 !
     integer :: i, coord_i
     integer :: lb_glob_index, ub_glob_index ! Lower and upper global indices
+    
+    if (present(check_perio)) then
+       check_perio_local=check_perio
+    else
+       check_perio_local = .FALSE.
+    endif
 !
     do i = 1, nbdim
@@ -78 +88 @@
         call Agrif_InvLoc( lb_var(i), proc_id, coord_i, lb_glob_index )
         call Agrif_InvLoc( ub_var(i), proc_id, coord_i, ub_glob_index )
+        if (agrif_debug_interp .or. agrif_debug_update) then
+        print *,'direction ',i,' lblogb ubglob = ',lb_glob_index,ub_glob_index
+        endif
+        if (check_perio_local .AND. agrif_curgrid%periodicity(i)) then
+          if (lb_tab(i)>=lb_glob_index) then
+          else if (lb_tab(i)<ub_glob_index-agrif_curgrid%periodicity_decal(i)) then
+            lb_glob_index = lb_glob_index - agrif_curgrid%periodicity_decal(i)
+            ub_glob_index = ub_glob_index - agrif_curgrid%periodicity_decal(i)
+          endif
+        endif
+        
+        if (present(indminglob3)) then
+          indminglob3(i)=lb_glob_index
+          indmaxglob3(i)=ub_glob_index
+        endif
 #else
         lb_glob_index = lb_var(i)
+        if (check_perio_local .AND. agrif_curgrid%periodicity(i)) then
+          lb_glob_index = lb_tab(i)
+        endif
         ub_glob_index = ub_var(i)
 #endif
         lb_tab_true(i) = max(lb_tab(i), lb_glob_index)
         ub_tab_true(i) = min(ub_tab(i), ub_glob_index)
+        if (agrif_debug_interp .or. agrif_debug_update) then
+        print *,'childbounds = ',i,lb_tab(i),lb_glob_index,lb_tab_true(i), &
+        ub_tab(i),ub_glob_index,ub_tab_true(i)
+        endif
     enddo
 !
@@ -93 +125 @@
         endif
     enddo
+    if (agrif_debug_interp) then
+    print *,'memberin = ',memberin
+    endif
 !---------------------------------------------------------------------------------------------------
 end subroutine Agrif_Childbounds
@@ -123 +158 @@
 !
     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
@@ -659 +695 @@
         case('x')
 !
-            lb_child(n)  = root_var % point(n)
-            lb_parent(n) = root_var % point(n)
+            lb_child(n)  = child%point(n)
+            lb_parent(n) = child%parent_var%point(n)
             nb_child(n)  = Agrif_Child_Gr % nb(1)
             s_child(n)   = Agrif_Child_Gr  % Agrif_x(1)
@@ -666 +702 @@
             ds_child(n)  = Agrif_Child_Gr  % Agrif_dx(1)
             ds_parent(n) = Agrif_Parent_Gr % Agrif_dx(1)
+            ! Take into account potential difference of first points
+            s_parent(n) = s_parent(n) + (lb_parent(n)-lb_child(n))*ds_parent(n)
 !
             if ( root_var % posvar(n) == 1 ) then
@@ -677 +715 @@
         case('y')
 !
-            lb_child(n)  = root_var % point(n)
-            lb_parent(n) = root_var % point(n)
+            lb_child(n)  = child%point(n)
+            lb_parent(n) = child%parent_var%point(n)
             nb_child(n)  = Agrif_Child_Gr % nb(2)
             s_child(n)   = Agrif_Child_Gr  % Agrif_x(2)
@@ -684 +722 @@
             ds_child(n)  = Agrif_Child_Gr  % Agrif_dx(2)
             ds_parent(n) = Agrif_Parent_Gr % Agrif_dx(2)
+            ! Take into account potential difference of first points
+            s_parent(n) = s_parent(n) + (lb_parent(n)-lb_child(n))*ds_parent(n)
 !
             if (root_var % posvar(n)==1) then
@@ -695 +735 @@
         case('z')
 !
-            lb_child(n)  = root_var % point(n)
-            lb_parent(n) = root_var % point(n)
+            lb_child(n)  = child%point(n)
+            lb_parent(n) = child%parent_var%point(n)
             nb_child(n)  = Agrif_Child_Gr % nb(3)
             s_child(n)   = Agrif_Child_Gr  % Agrif_x(3)
@@ -702 +742 @@
             ds_child(n)  = Agrif_Child_Gr  % Agrif_dx(3)
             ds_parent(n) = Agrif_Parent_Gr % Agrif_dx(3)
+            ! Take into account potential difference of first points
+            s_parent(n) = s_parent(n) + (lb_parent(n)-lb_child(n))*ds_parent(n)
 !
             if (root_var % posvar(n)==1) then
@@ -781 +823 @@
 !---------------------------------------------------------------------------------------------------
 subroutine Agrif_GlobalToLocalBounds ( locbounds, lb_var, ub_var, lb_glob, ub_glob,    &
-                                       coords, nbdim, rank, member )
+                                       coords, nbdim, rank, member,check_perio )
 !---------------------------------------------------------------------------------------------------
     integer, dimension(nbdim,2,2), intent(out)   :: locbounds   !< Local values of \b lb_glob and \b ub_glob
@@ -792 +834 @@
     integer,                       intent(in)    :: rank        !< Rank of the processor
     logical,                       intent(out)   :: member
-!
-    integer     :: i, i1, k
+    logical,optional,          intent(in)  :: check_perio   !< check for periodicity
+    logical :: check_perio_local
+!
+    integer     :: i, i1, k, idecal
     integer     :: nbloc(nbdim)
+    
+    if (present(check_perio)) then
+       check_perio_local=check_perio
+    else
+       check_perio_local = .FALSE.
+    endif
+!
+
 !
     locbounds(:,1,:) =  HUGE(1)
@@ -803 +855 @@
     do i = 1,nbdim
 !
+     if (coords(i) == 0) then
+       nbloc(i) = 1
+       locbounds(i,1,1) = lb_glob(i)
+       locbounds(i,2,1) = ub_glob(i)
+       locbounds(i,1,2) = lb_glob(i)
+       locbounds(i,2,2) = ub_glob(i)
+     else
         call Agrif_InvLoc(lb_var(i), rank, coords(i), i1)
+        if ((i1>ub_glob(i)).AND.check_perio_local) then
+          idecal = agrif_curgrid%periodicity_decal(i)
+        else
+          idecal = 0
+        endif
 !
         do k = lb_glob(i)+lb_var(i)-i1,ub_glob(i)+lb_var(i)-i1
 !
-            if ( (k >= lb_var(i)) .AND. (k <= ub_var(i)) ) then
+            if ( (k + idecal >= lb_var(i)) .AND. (k + idecal <= ub_var(i)) ) then
+!            if ((k<=ub_var(i)).AND.((k>=lb_var(i).OR.check_perio_local))) then
                 nbloc(i) = 1
                 locbounds(i,1,1) = min(locbounds(i,1,1),k-lb_var(i)+i1)
                 locbounds(i,2,1) = max(locbounds(i,2,1),k-lb_var(i)+i1)
 
-                locbounds(i,1,2) = min(locbounds(i,1,2),k)
-                locbounds(i,2,2) = max(locbounds(i,2,2),k)
-            endif
-        enddo
+                locbounds(i,1,2) = min(locbounds(i,1,2),k + idecal)
+                locbounds(i,2,2) = max(locbounds(i,2,2),k + idecal)
+            endif
+        enddo
+     endif
     enddo
 

vendors/AGRIF/dev_r12970_AGRIF_CMEMS/AGRIF_FILES/modbc.F90

@@ -73 +73 @@
     Agrif_Parent_Gr => Agrif_Curgrid % parent
 !
-    loctab_child(:) = 0
+    loctab_child(1:nbdim) = 0
     posvartab_child(1:nbdim) = root_var % posvar(1:nbdim)
 !

vendors/AGRIF/dev_r12970_AGRIF_CMEMS/AGRIF_FILES/modbcfunction.F90

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

vendors/AGRIF/dev_r12970_AGRIF_CMEMS/AGRIF_FILES/modcurgridfunctions.F90

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

vendors/AGRIF/dev_r12970_AGRIF_CMEMS/AGRIF_FILES/modgrids.F90

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

vendors/AGRIF/dev_r12970_AGRIF_CMEMS/AGRIF_FILES/modinterp.F90

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

vendors/AGRIF/dev_r12970_AGRIF_CMEMS/AGRIF_FILES/modinterpbasic.F90

@@ -220 +220 @@
 !CDIR ALTCODE
 !CDIR NODEP
+    if (associated(agrif_external_linear_interp)) then
+    do i = 1,nc
+        y(i)=agrif_external_linear_interp(x(MAX(indparent(i,dir),1)), &
+              x(indparent(i,dir)+1),coeffparent(i,dir))
+    enddo
+    else
     do i = 1,nc
         y(i) = coeffparent(i,dir)  * x(MAX(indparent(i,dir),1)) + &
            (1.-coeffparent(i,dir)) * x(indparent(i,dir)+1)
     enddo
+    endif
 !---------------------------------------------------------------------------------------------------
 end subroutine Linear1dAfterCompute

vendors/AGRIF/dev_r12970_AGRIF_CMEMS/AGRIF_FILES/modlinktomodel.F90

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

vendors/AGRIF/dev_r12970_AGRIF_CMEMS/AGRIF_FILES/modmpp.F90

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

vendors/AGRIF/dev_r12970_AGRIF_CMEMS/AGRIF_FILES/modtypes.F90

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

vendors/AGRIF/dev_r12970_AGRIF_CMEMS/AGRIF_FILES/modupdate.F90

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

vendors/AGRIF/dev_r12970_AGRIF_CMEMS/AGRIF_FILES/modupdatebasic.F90

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

vendors/AGRIF/dev_r12970_AGRIF_CMEMS/AGRIF_FILES/modutil.F90

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

vendors/AGRIF/dev_r12970_AGRIF_CMEMS/AGRIF_FILES/modvariables.F90

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

vendors/AGRIF/dev_r12970_AGRIF_CMEMS/LEX/Makefile.lex

@@ -1 +1 @@
 LEX      = flex -i
-YACC  = bison -t -v -g
+YACC  = /usr/bin/bison -t -v -g --graph
+#YACC = byacc -t -v
 
 all: main.c fortran.c
 
 main.c : convert.tab.c convert.yy.c
-   cat   convert.tab.c convert.yy.c > ../LIB/main.c
+   cat   convert.tab.c convert.yy.c > main.c
    $(RM) convert.tab.c convert.yy.c
 
 fortran.c : fortran.tab.c fortran.yy.c
-   cat   fortran.tab.c fortran.yy.c > ../LIB/fortran.c
+   cat   fortran.tab.c fortran.yy.c > fortran.c
    $(RM) fortran.tab.c fortran.yy.c
 
@@ -29 +30 @@
 
 clean-all: clean
-   $(RM) ../LIB/main.c ../LIB/fortran.c
+   $(RM) main.c fortran.c

vendors/AGRIF/dev_r12970_AGRIF_CMEMS/LEX/convert.y

@@ -130 +130 @@
     int infreegiven ;
     int infixedgiven ;
-    int lengthmainfile;
 
     char filetoparse[LONG_FNAME];
@@ -160 +159 @@
     tmpuselocallist = (listusemodule *) NULL;
     List_ContainsSubroutine = (listnom *) NULL;
+    List_Do_labels = (listname *) NULL;
     oldfortran_out = (FILE *) NULL;
 
-    if (argc < 2) print_usage();
-    
+    if ( argc < 2 )
+        print_usage();
+
     strcpy(config_file, argv[1]);
     strcpy(work_dir, ".");
@@ -257 +258 @@
             strcpy(filetoparse, argv[i+1]);
             i++;
-            lengthmainfile = strlen(filetoparse);
-            if (!strcasecmp(&filetoparse[lengthmainfile-4], ".f90"))
-            {
-                infixed = 0;
-                infree = 1;
-            }
-            else
-            {
-                infixed = 1;
-                infree = 0;
-            }
+            infree  = (strstr(filetoparse, ".f90") != NULL) || (strstr(filetoparse, ".F90") != NULL);
+            infixed = ! infree;
         }
         else if (!strcasecmp(argv[i], "-free"))
@@ -400 +392 @@
     /* Build new subroutines                                                   */
     firstpass = 0;
+    /*
+    printf("**********************************\n");
+    printf("SECOND PASSES \n");
+    printf("**********************************\n");
+    */
     process_fortran(filetoparse);
 

vendors/AGRIF/dev_r12970_AGRIF_CMEMS/LEX/fortran.lex

@@ -39 +39 @@
 %s character
 %x donottreat
+%x donottreat_interface
+%x includestate
 %s fortran77style
 %s fortran90style
@@ -47 +49 @@
 extern FILE * yyin;
 #define MAX_INCLUDE_DEPTH 30
+#define YY_BUF_SIZE 64000
 YY_BUFFER_STATE include_stack[MAX_INCLUDE_DEPTH];
-int line_num_input = 1;
+int line_num_input = 0;
 int newlinef90 = 0;
-char tmpc;
-#define PRINT_LINE_NUM()     // { fprintf(stderr,"== Parsing l.%4d...\n", line_num_input); }
-#define INCREMENT_LINE_NUM() { line_num_input++; PRINT_LINE_NUM(); }
-
-/******************************************************************************/
-/**************PETITS PB NON PREVUS *******************************************/
-/******************************************************************************/
-/* NEXTLINF77 un ligne fortran 77 peut commencer par -      &a=b or on        */
-/*            a prevu seulement       & a=b avec l'espace entre le symbole    */
-/*            de la 7eme et le debut de la ligne de commande                  */
-/*            le ! est aussi interdit comme symbole de la 7 eme colonne       */
-/*            Normalement NEXTLINEF77 \n+[ ]{5}[^ ]                           */
-/******************************************************************************/
-#define YY_USER_ACTION  if (firstpass == 0) ECHO;
+int tmpc;
+
+int lastwasendofstmt = 1;
+
+extern char linebuf1[1024];
+extern char linebuf2[1024];
+
+int count_newlines(const char* str_in)
+{
+    int k, i = 0;
+    for( k=0 ; k<strlen(str_in) ; k++)
+        if (str_in[k] == '\n') i++;
+    return i;
+}
+
+#define PRINT_LINE_NUM()   //  { fprintf(stderr,"== Parsing l.%4d...\n", line_num_input); }
+#define INCREMENT_LINE_NUM() { line_num_input+=count_newlines(fortran_text) ; PRINT_LINE_NUM(); }
+#define YY_USER_ACTION       { if (increment_nbtokens !=0) token_since_endofstmt++; increment_nbtokens = 1; if (token_since_endofstmt>=1) lastwasendofstmt=0; /*printf("VALLIJSDFLSD = %d %d %s \n",lastwasendofstmt,token_since_endofstmt,fortran_text); */ if (firstpass) { strcpy(linebuf1, linebuf2); strncpy(linebuf2, fortran_text,80);} \
+                               else {my_position_before=setposcur();/*printf("muposition = %d\n",my_position_before);*/ECHO;} }
+#define YY_BREAK {/*printf("VALL = %d %d\n",lastwasendofstmt,token_since_endofstmt);*/if (token_since_endofstmt>=1) lastwasendofstmt=0; break;}
 
 void out_of_donottreat(void);
@@ -69 +78 @@
 %}
 
-REAL8 "real*8"[ \t]*"(a-h,o-z)"
-
 SLASH       "/"
-DSLASH      "/"[ \t]*"/"
 HEXA        Z\'[0-9a-fA-F]+\'
-NAME        [a-zA-Z\_][a-zA-Z0-9\_]*
 INTEGER     [0-9]+
-
+NAME        [a-zA-Z][a-zA-Z0-9\_]*
 EXPONENT    [edq][-+]?{INTEGER}
 
-BEG_DNT         ^[C!]"$AGRIF_DO_NOT_TREAT"[ \t]*\n
-END_DNT         ^[C!]"$AGRIF_END_DO_NOT_TREAT"[ \t]*\n
+BEG_DNT         ^[C!]"$AGRIF_DO_NOT_TREAT"[ \t]*([ \t\n]*(!.*\n)*)+\n
+END_DNT         ^[C!]"$AGRIF_END_DO_NOT_TREAT"[ \t]*([ \t\n]*(!.*\n)*)+\n
 
 BEG_INTERFACE   ^[ \t]*interface
@@ -87 +92 @@
 ASSIGNTYPE      "assignment"[ \t]*"("[ \t]*[-+=]+[ \t]*")"
 
-COMM_F77        ^([Cc*](([ \t]*\n)|([^AaHhOo\n].*\n)))
-COMM_F90        ^[ \t]*!.*\n
+COMM_F77        ^[c*].*\n
+COMM_F90_1      ^([ \t\n]*(!.*\n)*)+\n
 COMM_F90_2      !.*
-NEXTLINEF90     "&".*\n+
-NEXTLINEF77     [\n \t]*\n[ \t]{5}("&"|"+"|"$"|"*"|"1"|"2"|"3"|"4"|"5"|"6"|"7"|"8"|"9"|"."|"#")
-
-LABEL           ^(((" "|[0-9]){1,5})|([ \t]{1,5}))[ &]+
+NEXTLINEF90     &([ \t\n]|(!.*\n))*
+NEXTLINEF77     \n(([c*].*\n)|(([ \t]{0,4}|[ \t]{6,})!.*\n)|[\n])*[ ]{5}([a-z0-9&+$*.#/!;])
+LABEL           ^[ 0-9]{1,5}[ \t]+
 
 %%
@@ -99 +103 @@
   if (infree)  BEGIN(fortran90style) ;
 
-{REAL8}                     { return TOK_REAL8; }
 subroutine                  { return TOK_SUBROUTINE; }
 program                     { return TOK_PROGRAM; }
 allocate                    { inallocate = 1; return TOK_ALLOCATE; }
+continue                    { return TOK_CONTINUE; }
 nullify                    { return TOK_NULLIFY; }
-null[ ]*\([ ]*\)            { return TOK_NULL_PTR; }
 deallocate                  { inallocate = 1; return TOK_DEALLOCATE; }
 result                      { return TOK_RESULT; }
 function                    { return TOK_FUNCTION; }
-end[ \t]*program            { strcpy(yylval.na,fortran_text); return TOK_ENDPROGRAM;}
-end[ \t]*module             { strcpy(yylval.na,fortran_text); return TOK_ENDMODULE; }
-end[ \t]*subroutine         { strcpy(yylval.na,fortran_text); return TOK_ENDSUBROUTINE;}
-end[ \t]*function           { strcpy(yylval.na,fortran_text); return TOK_ENDFUNCTION;}
 end                         { strcpy(yylval.na,fortran_text); return TOK_ENDUNIT;}
-include                     { pos_curinclude = setposcur()-9; return TOK_INCLUDE;}
-^[ \t]*use[ ]+              { strcpy(yylval.na,fortran_text);
-                              tmpc = (char) input(); unput(tmpc);
-                              if ( ( tmpc >= 'a' && tmpc <= 'z' ) ||
-                                   ( tmpc >= 'A' && tmpc <= 'Z' )  )  return TOK_USE;
-                              else                                    return TOK_NAME;
-                            }
+include                     { pos_curinclude = setposcur()-9; BEGIN(includestate); }
+use                         { return TOK_USE;}
 rewind                      { return TOK_REWIND; }
 implicit                    { return TOK_IMPLICIT; }
 none                        { return TOK_NONE; }
 call                        { return TOK_CALL; }
-.true.                      { return TOK_TRUE; }
-.false.                     { return TOK_FALSE; }
+.true.                      { strcpy(yylval.na,fortran_text); return TOK_TRUE; }
+.false.                     { strcpy(yylval.na,fortran_text); return TOK_FALSE; }
 \=\>                        { return TOK_POINT_TO; }
 {ASSIGNTYPE}                { strcpy(yylval.na,fortran_text); return TOK_ASSIGNTYPE;}
 \*\*                        { strcpy(yylval.na,fortran_text); return TOK_DASTER; }
-\.[ \t]*eqv\.               { strcpy(yylval.na,fortran_text); return TOK_EQV; }
-\.[ \t]*eq\.                { strcpy(yylval.na,fortran_text); return TOK_EQ;  }
-\.[ \t]*gt\.                { strcpy(yylval.na,fortran_text); return TOK_GT;  }
-\.[ \t]*ge\.                { strcpy(yylval.na,fortran_text); return TOK_GE;  }
-\.[ \t]*lt\.                { strcpy(yylval.na,fortran_text); return TOK_LT;  }
-\.[ \t]*le\.                { strcpy(yylval.na,fortran_text); return TOK_LE;  }
-\.[ \t]*neqv\.              { strcpy(yylval.na,fortran_text); return TOK_NEQV;}
-\.[ \t]*ne\.                { strcpy(yylval.na,fortran_text); return TOK_NE;  }
-\.[ \t]*not\.               { strcpy(yylval.na,fortran_text); return TOK_NOT; }
-\.[ \t]*or\.                { strcpy(yylval.na,fortran_text); return TOK_OR;  }
+\.eqv\.               { strcpy(yylval.na,fortran_text); return TOK_EQV; }
+\.[ \t]*eq[ \t]*\.                { strcpy(yylval.na,fortran_text); return TOK_EQ;  }
+\.gt\.                { strcpy(yylval.na,fortran_text); return TOK_GT;  }
+\.ge\.                { strcpy(yylval.na,fortran_text); return TOK_GE;  }
+\.lt\.                { strcpy(yylval.na,fortran_text); return TOK_LT;  }
+\.le\.                { strcpy(yylval.na,fortran_text); return TOK_LE;  }
+\.neqv\.              { strcpy(yylval.na,fortran_text); return TOK_NEQV;}
+\.[ \t]*ne[ \t]*\.                { strcpy(yylval.na,fortran_text); return TOK_NE;  }
+\.not\.               { strcpy(yylval.na,fortran_text); return TOK_NOT; }
+\.or\.                { strcpy(yylval.na,fortran_text); return TOK_OR;  }
 \.[ \t]*xor\.               { strcpy(yylval.na,fortran_text); return TOK_XOR; }
-\.[ \t]*and\.               { strcpy(yylval.na,fortran_text); return TOK_AND; }
+\.and\.               { strcpy(yylval.na,fortran_text); return TOK_AND; }
+\=\=                  { strcpy(yylval.na,fortran_text); return TOK_EQUALEQUAL; }
+\/\=                  { strcpy(yylval.na,fortran_text); return TOK_SLASHEQUAL; }
+\<\=                  { strcpy(yylval.na,fortran_text); return TOK_INFEQUAL; }
+\>\=                  { strcpy(yylval.na,fortran_text); return TOK_SUPEQUAL; }
 module                      { return TOK_MODULE; }
 while                       { return TOK_WHILE; }
 concurrent                  { return TOK_CONCURRENT; }
 end[ \t]*do                 { return TOK_ENDDO; }
-do                          { return TOK_PLAINDO;}
+do[\ t]+{INTEGER}           { strcpy(yylval.na,&fortran_text[2]);
+                              if (testandextractfromlist(&List_Do_labels,&fortran_text[2]) == 1)
+                              {
+                              return TOK_PLAINDO_LABEL_DJVIEW;
+                              }
+                              else
+                              {
+                              List_Do_labels=Insertname(List_Do_labels,yylval.na,1);
+                              return TOK_PLAINDO_LABEL;
+                             }
+                             }
+do                          { increment_nbtokens = 0; return TOK_PLAINDO;}
 real                        { strcpy(yylval.na,fortran_text); return TOK_REAL; }
 integer                     { strcpy(yylval.na,fortran_text); return TOK_INTEGER; }
@@ -153 +162 @@
 double[ \t]*precision       { strcpy(yylval.na,fortran_text); return TOK_DOUBLEPRECISION; }
 double[ \t]*complex         { strcpy(yylval.na,fortran_text); return TOK_DOUBLECOMPLEX; }
-complex                     { return TOK_COMPLEX; }
+complex                     { strcpy(yylval.na,fortran_text); return TOK_COMPLEX; }
 allocatable                 { return TOK_ALLOCATABLE; }
 close                       { return TOK_CLOSE; }
@@ -172 +181 @@
 ^[ \t]*global[ \t]+         { return TOK_GLOBAL; }
 external                    { return TOK_EXTERNAL; }
-intent                      { return TOK_INTENT; }
+intent                      { intent_spec = 1; return TOK_INTENT; }
 pointer                     { return TOK_POINTER; }
 optional                    { return TOK_OPTIONAL; }
 save                        { return TOK_SAVE; }
-^[ \t]*type[ \t]*\(         { pos_cur_decl = setposcur()-5; return TOK_TYPEPAR; }
-^[ \t]*type[ \t\,]+         { return TOK_TYPE; }
+^[ \t]*type[ \t]*\(         { pos_cur_decl = setposcur()-strlen(fortran_text); return TOK_TYPEPAR; }
+^[ \t]*type/[ \t\,:]+       { return TOK_TYPE; }
 end[ \t]*type               { return TOK_ENDTYPE; }
 stat                        { if (inallocate == 1) return TOK_STAT; else { strcpy(yylval.na,fortran_text); return TOK_NAME; } }
 open                        { return TOK_OPEN; }
 return                      { return TOK_RETURN; }
-exit[^(]                    { return TOK_EXIT; }
+exit                        { return TOK_EXIT; }
 print                       { return TOK_PRINT; }
 module[ \t]*procedure       { return TOK_PROCEDURE; }
+read[ \t]*\(                { in_io_control_spec = 1; return TOK_READ_PAR; }
 read                        { return TOK_READ; }
 namelist                    { return TOK_NAMELIST; }
+write[ \t]*\(               { in_io_control_spec = 1; return TOK_WRITE_PAR; }
 write                       { return TOK_WRITE; }
-flush                       { return TOK_FLUSH; }
+flush                       { strcpy(yylval.na,fortran_text); return TOK_FLUSH; }
 target                      { return TOK_TARGET; }
 public                      { return TOK_PUBLIC; }
 private                     { return TOK_PRIVATE; }
-in                          { strcpy(yylval.na,fortran_text); return TOK_IN; }
-^[ \t]*data[ \t]+           { pos_curdata = setposcur()-strlen(fortran_text); Init_List_Data_Var(); return TOK_DATA; }
-continue                    { return TOK_CONTINUE; }
+in                          { strcpy(yylval.na,fortran_text);
+                               if (intent_spec==1)
+                                {return TOK_IN; }
+                              else
+                              {
+                              return TOK_NAME;
+                              }
+                            }
+^[ \t]*data[ \t]+           { pos_curdata = setposcur()-strlen(fortran_text); /*Init_List_Data_Var();*/ return TOK_DATA; }
 go[ \t]*to                  { return TOK_PLAINGOTO; }
-out                         { strcpy(yylval.na,fortran_text); return TOK_OUT; }
-inout                       { strcpy(yylval.na,fortran_text); return TOK_INOUT; }
+out                         { strcpy(yylval.na,fortran_text);
+                               if (intent_spec==1)
+                                {return TOK_OUT; }
+                              else
+                              {
+                              return TOK_NAME;
+                              }
+                            }
+inout                       { strcpy(yylval.na,fortran_text);
+                               if (intent_spec==1)
+                                {return TOK_IN; }
+                              else
+                              {
+                              return TOK_INOUT;
+                              }
+                            }
 intrinsic                   { return TOK_INTRINSIC; }
 then                        { return TOK_THEN; }
@@ -203 +234 @@
 else                        { return TOK_ELSE; }
 end[ \t]*if                 { return TOK_ENDIF; }
-if                          { return TOK_LOGICALIF; }
-sum[ \t]*\(                 { return TOK_SUM; }
-max[ \t]*\(                 { return TOK_MAX; }
-tanh                        { return TOK_TANH; }
-maxval                      { return TOK_MAXVAL; }
-trim                        { return TOK_TRIM; }
-sqrt\(                      { return TOK_SQRT; }
+if[ \t]*\(/(.*\)[ \t]*[\=|\+|\-]+.*\))   {strcpy(yylval.na,fortran_text);
+                            return TOK_LOGICALIF_PAR;
+                            }
+if/([ \t]*\([^(]*\)[ \t]*[\=|\+|\-]+)   {strcpy(yylval.na,fortran_text);
+                            return TOK_NAME;
+                            }
+if[ \t]*\(                 {strcpy(yylval.na,fortran_text);
+                            return TOK_LOGICALIF_PAR;
+                            }
 select[ \t]*case            { return TOK_SELECTCASE; }
-^[ \t]*case[ \t]*           { return TOK_CASE; }
+^[ \t]*case[ \t]*           { if (in_select_case_stmt > 0) return TOK_CASE ; else return TOK_NAME;}
 default                     { return TOK_DEFAULT; }
 end[ \t]*select             { return TOK_ENDSELECT; }
 file[ \t]*\=                { return TOK_FILE; }
+access[ \t]*\=                { return TOK_ACCESS; }
+action[ \t]*\=                { return TOK_ACTION; }
+iolength[ \t]*\=                { return TOK_IOLENGTH; }
 unit[ \t]*\=                { return TOK_UNIT; }
+opened[ \t]*\=                { return TOK_OPENED; }
 fmt[ \t]*\=                 { return TOK_FMT; }
 nml[ \t]*\=                 { return TOK_NML; }
 end[ \t]*\=                 { return TOK_END; }
 eor[ \t]*\=                 { return TOK_EOR; }
+len/([ \t]*\=)                 {
+                            if (in_char_selector ==1)
+                               return TOK_LEN;
+                            else
+                            {
+                            strcpy(yylval.na,fortran_text); return TOK_NAME;
+                            }
+                            }
+kind/([ \t]*\=)            {
+                            if ((in_char_selector==1) || (in_kind_selector == 1))
+                               return TOK_KIND;
+                            else
+                            {
+                            strcpy(yylval.na,fortran_text); return TOK_NAME;
+                            }
+                            }
+errmsg[ \t]*\=              { return TOK_ERRMSG; }
+mold[ \t]*\=              { return TOK_MOLD; }
+source[ \t]*\=              { return TOK_SOURCE; }
+position[ \t]*\=            { return TOK_POSITION; }
+iomsg[ \t]*\=               { return TOK_IOMSG; }
+iostat[ \t]*\=              { return TOK_IOSTAT; }
 err[ \t]*\=                 { return TOK_ERR; }
+form[ \t]*\=                { return TOK_FORM; }
+name/([ \t]*\=)             {
+                            if (in_inquire==1)
+                               return TOK_NAME_EQ;
+                            else
+                            {
+                            strcpy(yylval.na,fortran_text); return TOK_NAME;
+                            }
+                            }
+recl[ \t]*\=                { return TOK_RECL; }
+rec/([ \t]*\=)              { if (in_io_control_spec == 1)
+                              return TOK_REC;
+                             else
+                             {
+                             strcpy(yylval.na,fortran_text); return TOK_NAME;
+                             }
+                             }
+status/([ \t]*\=)           { if (close_or_connect == 1)
+                              return TOK_STATUS;
+                             else
+                             {
+                             strcpy(yylval.na,fortran_text); return TOK_NAME;
+                             }
+                             }
+status                      { strcpy(yylval.na,fortran_text); return TOK_NAME;}
 exist[ \t]*\=               { return TOK_EXIST; }
-min[ \t]*\(                 { return TOK_MIN; }
-nint                        { return TOK_NINT; }
-float                       { return TOK_FLOAT; }
-exp                         { return TOK_EXP; }
-cos                         { return TOK_COS; }
-cosh                        { return TOK_COSH; }
-acos                        { return TOK_ACOS; }
-sin                         { return TOK_SIN; }
-sinh                        { return TOK_SINH; }
-asin                        { return TOK_ASIN; }
-log                         { return TOK_LOG; }
-tan                         { return TOK_TAN; }
-atan                        { return TOK_ATAN; }
 cycle                       { return TOK_CYCLE; }
-abs[ \t]*\(                 { return TOK_ABS; }
-mod                         { return TOK_MOD; }
-sign[ \t]*\(                { return TOK_SIGN; }
-minloc                      { return TOK_MINLOC; }
-maxloc                      { return TOK_MAXLOC; }
-minval                      { return TOK_MINVAL; }
 backspace                   { return TOK_BACKSPACE; }
 ::                          { return TOK_FOURDOTS;  }
+\/[ \t]*({NEXTLINEF90}|{NEXTLINEF77})*[ \t]*\/  { strcpy(yylval.na,fortran_text); return TOK_DSLASH; }
 \({SLASH}                   { return TOK_LEFTAB; }
 {SLASH}\)                   { return TOK_RIGHTAB; }
-format[ \t]*\((.|{NEXTLINEF90}|{NEXTLINEF77})*\)  {
-                              return TOK_FORMAT; }
 {SLASH}                     { strcpy(yylval.na,fortran_text); return TOK_SLASH; }
-DSLASH                      { strcpy(yylval.na,fortran_text); return TOK_DSLASH; }
-(\')[^']*&{0,1}\n[ \t]*&{0,1}[^']*(\') {
-                              strcpy(yylval.na,fortran_text); return TOK_CHAR_CUT; }
-(\')[^']*(\')             { strcpy(yylval.na,fortran_text);return TOK_CHAR_CONSTANT; }
-(\")[^"]*(\")             { strcpy(yylval.na,fortran_text);return TOK_CHAR_MESSAGE; }
-{BEG_INTERFACE}             { BEGIN(donottreat); }
-<donottreat>{END_INTERFACE} { out_of_donottreat(); return '\n'; }
+((\')[^']*&{0,1}\n[ \t]*&{0,1}[^']*(\'))+ {
+                              INCREMENT_LINE_NUM() ; strcpy(yylval.na,fortran_text); return TOK_CHAR_CUT; }
+<includestate>((\')[^']*(\'))+ {Add_Include_1(fortran_text);}
+<includestate>[ \t]* {}
+<includestate>\n {
+                  if (inmoduledeclare == 0 )
+                  {
+                  pos_end=setposcur();
+                  RemoveWordSET_0(fortran_out,pos_curinclude,pos_end-pos_curinclude);
+                  }
+                  out_of_donottreat();
+                  }
+((\')[^']*(\'))+               { strcpy(yylval.na,fortran_text);return TOK_CHAR_CONSTANT; }
+((\")[^"]*(\"))+               { strcpy(yylval.na,fortran_text);return TOK_CHAR_MESSAGE; }
+{BEG_INTERFACE}             { BEGIN(donottreat_interface); }
+<donottreat_interface>{END_INTERFACE} { out_of_donottreat(); return '\n'; }
+<donottreat_interface>.*\n            {INCREMENT_LINE_NUM() ; }
+<fortran77style>{NAME}{NEXTLINEF77}[a-zA-Z0-9\_]+ {strcpy(yylval.na,fortran_text); removenewline(yylval.na);
+                            return TOK_NAME; }
 {NAME}                      { strcpy(yylval.na,fortran_text); return TOK_NAME; }
+{INTEGER}\.[0-9]+           {strcpy(yylval.na,fortran_text); return TOK_CSTREAL; }
 ({INTEGER}\.[0-9]*)/[^"and."|"false."|"true."|"eq."|"or."|"gt."|"ge."|"lt."|"le."|"not."|"ne."] {  // REAL1
                               strcpy(yylval.na,fortran_text); return TOK_CSTREAL; }
 (({INTEGER}\.[0-9]+|[0-9]*\.{INTEGER}){EXPONENT}?)|{INTEGER}(\.)?{EXPONENT}                     {  // REAL2
                               strcpy(yylval.na,fortran_text); return TOK_CSTREAL; }
-{INTEGER}                   { strcpy(yylval.na,fortran_text); return TOK_CSTINT; }
+{INTEGER}                   { strcpy(yylval.na,fortran_text);
+                             if (lastwasendofstmt == 0)
+                              return TOK_CSTINT;
+                             else
+                              if (testandextractfromlist(&List_Do_labels,fortran_text) == 1)
+                              {
+                              removefromlist(&List_Do_labels,yylval.na);
+                              return TOK_LABEL_DJVIEW;
+                              }
+                              else
+                              {
+                              return TOK_LABEL;
+                              }
+                             }
 \$                          {}
 \.                          {}
-\(|\)|:|\[|\]|\+|\-|\*      { strcpy(yylval.na,fortran_text); return (int) *fortran_text; }
+\(/([ \t]*[\+\-]?[a-zA-Z0-9]+[\.]*[0-9]*(\_({INTEGER}|{NAME}))?[ \t]*\,[ \t]*[\+\-]?[a-zA-Z0-9]+[\.]*[0-9]*(\_({INTEGER}|{NAME}))?[ \t]*\)) {
+                            in_complex_literal = -1;
+                            return (int) *fortran_text;
+                            }
+\(|\)|:|\[|\]|\+|\-|\*|\_   { strcpy(yylval.na,fortran_text); return (int) *fortran_text; }
 \%                          { strcpy(yylval.na,fortran_text); return (int) *fortran_text; }
-\;                          { return TOK_SEMICOLON; }
-\,                          { return (int) *fortran_text; }
+\;                          { lastwasendofstmt=1; token_since_endofstmt = 0; return TOK_SEMICOLON; }
+\,                          { if (in_complex_literal==-1) {return TOK_COMMACOMPLEX; in_complex_literal=0;} else; return (int) *fortran_text; }
 \=                          { return (int) *fortran_text; }
 \<                          { return (int) *fortran_text; }
 \>                          { return (int) *fortran_text; }
-\n                          { INCREMENT_LINE_NUM() ; return '\n'; }
-^[ ]*$                      {}
-[ \t]+                      {}
-{LABEL}                     { if (newlinef90 == 0) return TOK_LABEL; else newlinef90 = 0; }
+\n                          { INCREMENT_LINE_NUM() ; lastwasendofstmt=1; token_since_endofstmt = 0; increment_nbtokens = 0; return '\n'; }
+[ \t]+                      {increment_nbtokens = 0;}
+<fortran77style>{LABEL}[ \t]*format[ \t]*\((.|{NEXTLINEF90}|{NEXTLINEF77})*\)  {
+                              return TOK_LABEL_FORMAT; }
+<fortran90style>^[ \t]*{INTEGER}[ \t]*format[ \t]*\((.|{NEXTLINEF90})*\) {return TOK_LABEL_FORMAT; }
 {NEXTLINEF90}               { INCREMENT_LINE_NUM() ; newlinef90=1; }
-{NEXTLINEF77}               { INCREMENT_LINE_NUM() ; }
-
-{BEG_DNT}                   { INCREMENT_LINE_NUM() ; BEGIN(donottreat); }
-<donottreat>{END_DNT}       { out_of_donottreat(); return '\n'; }
-<donottreat>.*\n            { INCREMENT_LINE_NUM() ; }
-<fortran77style>{COMM_F77}  { INCREMENT_LINE_NUM() ; }
-{COMM_F90}                  { INCREMENT_LINE_NUM() ; }
-{COMM_F90_2}                {}
+<fortran77style>{NEXTLINEF77}               { INCREMENT_LINE_NUM() ;}
+
+{BEG_DNT}                   {INCREMENT_LINE_NUM() ; BEGIN(donottreat); }
+<donottreat>{END_DNT}       {out_of_donottreat(); return '\n'; }
+<donottreat>.*\n            {INCREMENT_LINE_NUM() ; }
+<fortran77style>{COMM_F77}  {INCREMENT_LINE_NUM() ; increment_nbtokens = 0;}
+{COMM_F90_1}                {INCREMENT_LINE_NUM() ; increment_nbtokens = 0;}
+{COMM_F90_2}                {increment_nbtokens = 0;}
+<<EOF>>                     {endoffile = 1; yyterminate();}
 %%
 

vendors/AGRIF/dev_r12970_AGRIF_CMEMS/LEX/fortran.y

@@ -42 +42 @@
 
 extern int line_num_input;
-extern char *fortran_text;
 
 char c_selectorname[LONG_M];
@@ -50 +49 @@
 int c_selectorgiven=0;
 listvar *curlistvar;
+int in_select_case_stmt=0;
 typedim c_selectordim;
 listcouple *coupletmp;
 int removeline=0;
+int token_since_endofstmt = 0;
+int increment_nbtokens = 1;
+int in_complex_literal = 0;
+int close_or_connect = 0;
+int in_io_control_spec = 0;
+int intent_spec = 0;
+long int my_position;
+long int my_position_before;
+int suborfun = 0;
+int indeclaration = 0;
+int endoffile = 0;
+int in_inquire = 0;
+int in_char_selector = 0;
+int in_kind_selector =0;
+int char_length_toreset = 0;
+
+typedim my_dim;
+
 listvar *test;
+
+char linebuf1[1024];
+char linebuf2[1024];
 
 int fortran_error(const char *s)
 {
-    printf("%s line %d, file %s motclef = |%s|\n", s, line_num_input, cur_filename, fortran_text);
+  if (endoffile == 1) 
+  {
+  endoffile = 0;
+  return 0;
+  }
+    printf("%s line %d, file %s culprit = |%s|\n", s, line_num_input, cur_filename, strcat(linebuf1, linebuf2));
     exit(1);
 }
@@ -94 +120 @@
 %token TOK_PROGRAM
 %token TOK_FUNCTION
-%token TOK_FORMAT
+%token TOK_LABEL_FORMAT
+%token TOK_LABEL_CONTINUE
+%token TOK_LABEL_END_DO
 %token TOK_MAX
 %token TOK_TANH
+%token TOK_COMMENT
 %token TOK_WHERE
 %token TOK_ELSEWHEREPAR
@@ -109 +138 @@
 %token TOK_SELECTCASE
 %token TOK_FILE
+%token TOK_REC
+%token TOK_NAME_EQ
+%token TOK_IOLENGTH
+%token TOK_ACCESS
+%token TOK_ACTION
+%token TOK_FORM
+%token TOK_RECL
+%token TOK_STATUS
 %token TOK_UNIT
+%token TOK_OPENED
 %token TOK_FMT
 %token TOK_NML
 %token TOK_END
 %token TOK_EOR
+%token TOK_EOF
 %token TOK_ERR
+%token TOK_POSITION
+%token TOK_IOSTAT
+%token TOK_IOMSG
 %token TOK_EXIST
 %token TOK_MIN
 %token TOK_FLOAT
 %token TOK_EXP
+%token TOK_LEN
 %token TOK_COS
 %token TOK_COSH
@@ -139 +182 @@
 %token TOK_MAXLOC
 %token TOK_EXIT
+%token TOK_KIND
+%token TOK_MOLD
+%token TOK_SOURCE
+%token TOK_ERRMSG
 %token TOK_MINVAL
 %token TOK_PUBLIC
@@ -150 +197 @@
 %token TOK_PRINT
 %token TOK_PLAINGOTO
-%token TOK_LOGICALIF
+%token <na> TOK_LOGICALIF
+%token <na> TOK_LOGICALIF_PAR
 %token TOK_PLAINDO
 %token TOK_CONTAINS
@@ -162 +210 @@
 %token TOK_CLOSE
 %token TOK_INQUIRE
+%token TOK_WRITE_PAR
 %token TOK_WRITE
-%token TOK_FLUSH
+%token <na> TOK_FLUSH
+%token TOK_READ_PAR
 %token TOK_READ
 %token TOK_REWIND
@@ -192 +242 @@
 %token TOK_PROCEDURE
 %token TOK_STOP
-%token TOK_REAL8
 %token TOK_FOURDOTS
 %token <na> TOK_HEXA
@@ -214 +263 @@
 %token <na> TOK_NOT
 %token <na> TOK_AND
+%token <na> TOK_EQUALEQUAL
+%token <na> TOK_SLASHEQUAL
+%token <na> TOK_INFEQUAL
+%token <na> TOK_SUPEQUAL
 %token <na> TOK_TRUE
 %token <na> TOK_FALSE
 %token <na> TOK_LABEL
+%token <na> TOK_LABEL_DJVIEW
+%token <na> TOK_PLAINDO_LABEL_DJVIEW
+%token <na> TOK_PLAINDO_LABEL
 %token <na> TOK_TYPE
 %token <na> TOK_TYPEPAR
 %token <na> TOK_ENDTYPE
+%token TOK_COMMACOMPLEX
 %token <na> TOK_REAL
 %token <na> TOK_INTEGER
@@ -246 +303 @@
 %token '>'
 %type <l> dcl
-%type <l> after_type
 %type <l> dimension
+%type <l> array-name-spec-list
 %type <l> paramlist
 %type <l> args
+%type <na> declaration-type-spec
 %type <l> arglist
 %type <lc> only_list
+%type <lc> only-list
+%type <lc> opt-only-list
+%type <lc> only
 %type <lc> only_name
-%type <lc> rename_list
-%type <lc> rename_name
+%type <lc> rename-list
+%type <lc> opt-rename-list
+%type <lc> rename
 %type <d> dims
 %type <d> dimlist
@@ -261 +323 @@
 %type <na> comblock
 %type <na> name_routine
+%type <na> type-param-value
 %type <na> opt_name
+%type <na> constant-expr
+%type <na> ac-implied-do
+%type <na> subroutine-name
+%type <l> opt-dummy-arg-list-par
+%type <l> opt-dummy-arg-list
+%type <l> dummy-arg-list
+%type <l> named-constant-def-list
+%type <v> named-constant-def
+%type <na> ac-do-variable
+%type <na> data-i-do-variable
+%type <na> data-stmt-constant
+%type <na> do-variable
+%type <na> ac-implied-do-control
+%type <na> label
+%type <na> opt-label
+%type <na> label-djview
+%type <na> opt-label-djview
 %type <na> type
-%type <na> word_endsubroutine
-%type <na> word_endfunction
-%type <na> word_endprogram
-%type <na> word_endunit
+%type <na> real-literal-constant
+%type <l> type-declaration-stmt
+%type <d> array-spec
+%type <d> assumed-shape-spec-list
+%type <d> deferred-shape-spec-list
+%type <d> assumed-size-spec
+%type <d> implied-shape-spec-list
 %type <na> typespec
+%type <na> null-init
+%type <na> initial-data-target
+%type <na> intent-spec
 %type <na> string_constant
+%type <na> access-id
+%type <na> dummy-arg-name
+%type <na> common-block-name
+%type <na> function-name
+%type <na> dummy-arg
+%type <na> lower-bound
+%type <na> upper-bound
+%type <na> scalar-constant-subobject
+%type <na> opt-data-stmt-star
 %type <na> simple_const
+%type <na> opt-char-selector
+%type <na> char-selector
 %type <na> ident
 %type <na> intent_spec
+%type <na> kind-param
 %type <na> signe
+%type <na> scalar-int-constant-expr
 %type <na> opt_signe
+%type <dim1> explicit-shape-spec
+%type <d> explicit-shape-spec-list
+%type <dim1> assumed-shape-spec
+%type <dim1> deferred-shape-spec
 %type <na> filename
 %type <na> attribute
@@ -279 +382 @@
 %type <na> begin_array
 %type <na> clause
+%type <na> only-use-name
+%type <na> generic-spec
 %type <na> arg
+%type <d> opt-array-spec-par
+%type <d> opt-explicit-shape-spec-list-comma
+%type <d> explicit-shape-spec-list-comma
 %type <na> uexpr
+%type <na> section_subscript_ambiguous
 %type <na> minmaxlist
+%type <na> subscript
+%type <na> subscript-triplet
+%type <na> vector-subscript
 %type <na> lhs
-%type <na> vec
 %type <na> outlist
 %type <na> other
+%type <na> int-constant-expr
 %type <na> dospec
 %type <na> expr_data
@@ -298 +410 @@
 %type <na> opt_expr
 %type <na> optexpr
+%type <v> entity-decl
+%type <l> entity-decl-list
 %type <lnn> data_stmt_value_list
+%type <lnn> data-stmt-value-list
+%type <lnn> access-id-list
+%type <lnn> opt-access-id-list
+%type <na> data-stmt-value
+%type <l> data-stmt-object-list
+%type <l> data-i-do-object-list
+%type <v> data-stmt-object
+%type <v> data-i-do-object
 %type <lnn> datanamelist
 %type <na> after_slash
 %type <na> after_equal
 %type <na> predefinedfunction
+%type <na> equiv-op
+%type <na> or-op
+%type <na> and-op
+%type <na> not-op
+%type <na> equiv-operand
+%type <na> or-operand
+%type <na> and-operand
+%type <na> mult-operand
+%type <na> rel-op
+%type <na> concat-op
+%type <na> add-operand
+%type <na> add-op
+%type <na> power-op
+%type <na> section-subscript-list
+%type <na> opt-lower-bound-2points
+%type <na> mult-op
+%type <na> array-constructor
 %type <na> expr
+%type <na> function-reference
+%type <na> literal-constant
+%type <na> named-constant
+%type <na> ac-value-list
+%type <na> ac-value
+%type <na> intrinsic-type-spec
+%type <na> opt-kind-selector
+%type <na> char-literal-constant
+%type <na> logical-literal-constant
+%type <na> real-part
+%type <na> imag-part
+%type <na> sign
+%type <na> signed-int-literal-constant
+%type <na> int-literal-constant
+%type <na> signed-real-literal-constant
+%type <na> complex-literal-constant
+%type <na> actual-arg-spec-list
+%type <na> procedure-designator
+%type <na> constant
+%type <na> data-ref
+%type <v> structure-component
+%type <v> scalar-structure-component
+%type <na> int-expr
+%type <na> ac-spec
+%type <na> type-spec
+%type <na> derived-type-spec
+%type <v> part-ref
+%type <na> opt-part-ref
+%type <na> actual-arg-spec
+%type <na> kind-selector
+%type <na> actual-arg
+%type <na> section-subscript
+%type <na> keyword
+%type <na> primary
+%type <na> specification-expr
+%type <v> variable
+%type <v> data-implied-do
+%type <na> substring-range
+%type <v> designator
+%type <na> object-name
+%type <na> object-name-noident
+%type <na> array-element
+%type <na> array-section
+%type <na> scalar-variable-name
+%type <na> scalar-constant
+%type <na> variable-name
+%type <na> opt-subscript 
+%type <na> stride
+%type <na> opt-scalar-int-expr
+%type <na> scalar-int-expr
+%type <na> level-1-expr
+%type <na> level-2-expr
+%type <na> level-3-expr
+%type <na> level-4-expr
+%type <na> level-5-expr
 %type <na> ubound
 %type <na> operation
@@ -311 +505 @@
 
 %%
-input :
+/* R201 : program */
+/*program: line-break
+     | program-unit
+     | program program-unit
+     ;
+*/
+
+input:
       | input line
       ;
-line :  line-break
+line:  line-break
       | suite_line_list
-      | TOK_LABEL suite_line_list
       | error {yyerrok;yyclearin;}
       ;
-line-break:
-        '\n' fin_line
+line-break: '\n' fin_line
+      {token_since_endofstmt = 0; increment_nbtokens = 0;}
       | TOK_SEMICOLON
+      | TOK_EOF
       | line-break '\n' fin_line
       | line-break TOK_SEMICOLON
-      | line-break TOK_LABEL
       ;
 suite_line_list :
@@ -331 +531 @@
       | suite_line_list TOK_SEMICOLON suite_line
       ;
-suite_line :
-        entry fin_line     /* subroutine, function, module                    */
-      | spec fin_line      /* declaration                                     */
+suite_line:program-unit
       | TOK_INCLUDE filename fin_line
         {
@@ -342 +540 @@
             }
         }
+      | TOK_COMMENT
+      ;
+/*
+suite_line:
+        entry fin_line     subroutine, function, module                    
+      | spec fin_line       declaration                                     
+      | TOK_INCLUDE filename fin_line
+        {
+            if (inmoduledeclare == 0 )
+            {
+                pos_end = setposcur();
+                RemoveWordSET_0(fortran_out,pos_curinclude,pos_end-pos_curinclude);
+            }
+        }
       | execution-part-construct
       ;
-
-fin_line : { pos_cur = setposcur(); }
-      ;
-
+*/
+
+fin_line: { pos_cur = setposcur(); }
+      ;
+
+/* R202 : program-unit */
+program-unit: main-program
+     | external-subprogram
+     | module
+     ;
+ 
+/*R203 : external-subprogram */
+external-subprogram: function-subprogram
+     | subroutine-subprogram
+     ;
+     
 opt_recursive :         { isrecursive = 0; }
       | TOK_RECURSIVE   { isrecursive = 1; }
@@ -356 +580 @@
       ;
 
-entry : opt_recursive TOK_SUBROUTINE name_routine arglist
-        {
-            insubroutinedeclare = 1;
-            if ( firstpass )
-                Add_SubroutineArgument_Var_1($4);
-            else
-                WriteBeginof_SubLoop();
-        }
-      | TOK_PROGRAM name_routine
-        {
-            insubroutinedeclare = 1;
-            inprogramdeclare = 1;
-            /* in the second step we should write the head of       */
-            /*    the subroutine sub_loop_<subroutinename>          */
-            if ( ! firstpass )
-                WriteBeginof_SubLoop();
-        }
-      | opt_recursive TOK_FUNCTION name_routine arglist opt_result
-        {
-            insubroutinedeclare = 1;
-            strcpy(DeclType, "");
-            /* we should to list of the subroutine argument the  */
-            /*    name of the function which has to be defined   */
-            if ( firstpass )
-            {
-                Add_SubroutineArgument_Var_1($4);
-                if ( ! is_result_present )
-                    Add_FunctionType_Var_1($3);
-            }
-            else
-            /* in the second step we should write the head of    */
-            /*    the subroutine sub_loop_<subroutinename>       */
-                WriteBeginof_SubLoop();
-        }
-      | TOK_MODULE TOK_NAME
-        {
-            GlobalDeclaration = 0;
-            strcpy(curmodulename,$2);
-            strcpy(subroutinename,"");
-            Add_NameOfModule_1($2);
-            if ( inmoduledeclare == 0 )
-            {
-                /* To know if there are in the module declaration    */
-                inmoduledeclare = 1;
-                /* to know if a module has been met                  */
-                inmodulemeet = 1;
-                /* to know if we are after the keyword contains      */
-                aftercontainsdeclare = 0 ;
-            }
-        }
-      ;
-
-/* R312 : label */
-label: TOK_CSTINT
-     | label TOK_CSTINT
-     ;
-
 name_routine :  TOK_NAME    { strcpy($$, $1); strcpy(subroutinename, $1); }
       ;
@@ -419 +586 @@
 arglist :               { if ( firstpass ) $$=NULL; }
       | '(' ')'         { if ( firstpass ) $$=NULL; }
-      | '(' args ')'    { if ( firstpass ) $$=$2; }
+      | '(' {in_complex_literal=0;} args ')'    { if ( firstpass ) $$=$3; }
       ;
 arglist_after_result:
       | '(' ')'
-      | '(' args ')'    { if ( firstpass ) Add_SubroutineArgument_Var_1($2); }
+      | '(' {in_complex_literal=0;} args ')'    { if ( firstpass ) Add_SubroutineArgument_Var_1($3); }
       ;
 args :  arg
@@ -452 +619 @@
       | '*'     { strcpy($$,"*"); }
       ;
-spec :  type after_type
-      | TOK_TYPE opt_spec opt_sep opt_name  { inside_type_declare = 1; }
-      | TOK_ENDTYPE opt_name                { inside_type_declare = 0; }
-      | TOK_POINTER list_couple
-      | before_parameter '(' paramlist ')'
-        {
-            if ( ! inside_type_declare )
-            {
-                if ( firstpass )
-                {
-                    if ( insubroutinedeclare )  Add_Parameter_Var_1($3);
-                    else                        Add_GlobalParameter_Var_1($3);
-                }
-                else
-                {
-                    pos_end = setposcur();
-                    RemoveWordSET_0(fortran_out, pos_cur_decl, pos_end-pos_cur_decl);
-                }
-            }
-            VariableIsParameter =  0 ;
-        }
-      | before_parameter paramlist
-        {
-            if ( ! inside_type_declare )
-            {
-                if ( firstpass )
-                {
-                    if ( insubroutinedeclare )  Add_Parameter_Var_1($2);
-                    else                        Add_GlobalParameter_Var_1($2);
-                }
-                else
-                {
-                    pos_end = setposcur();
-                    RemoveWordSET_0(fortran_out,pos_cur_decl,pos_end-pos_cur_decl);
-                }
-            }
-            VariableIsParameter =  0 ;
-        }
-      | common
-      | save
-        {
-            pos_end = setposcur();
-            RemoveWordSET_0(fortran_out,pos_cursave,pos_end-pos_cursave);
-        }
-      | implicit
-      | dimension
-        {
-            /* if the variable is a parameter we can suppose that is   */
-            /*    value is the same on each grid. It is not useless to */
-            /*    create a copy of it on each grid                     */
-            if ( ! inside_type_declare )
-            {
-                if ( firstpass )
-                {
-                    Add_Globliste_1($1);
-                    /* if variableparamlists has been declared in a subroutine   */
-                    if ( insubroutinedeclare )     Add_Dimension_Var_1($1);
-                }
-                else
-                {
-                    pos_end = setposcur();
-                    RemoveWordSET_0(fortran_out,pos_curdimension,pos_end-pos_curdimension);
-                }
-            }
-            PublicDeclare = 0;
-            PrivateDeclare = 0;
-            ExternalDeclare = 0;
-            strcpy(NamePrecision,"");
-            c_star = 0;
-            InitialValueGiven = 0 ;
-            strcpy(IntentSpec,"");
-            VariableIsParameter =  0 ;
-            Allocatabledeclare = 0 ;
-            Targetdeclare = 0 ;
-            SaveDeclare = 0;
-            pointerdeclare = 0;
-            optionaldeclare = 0 ;
-            dimsgiven=0;
-            c_selectorgiven=0;
-            strcpy(nameinttypename,"");
-            strcpy(c_selectorname,"");
-        }
-      | public
-        {
-            if (firstpass == 0)
-            {
-                if ($1)
-                {
-                    removeglobfromlist(&($1));
-                    pos_end = setposcur();
-                    RemoveWordSET_0(fortran_out,pos_cur,pos_end-pos_cur);
-                    writelistpublic($1);
-                }
-            }
-        }
-      | private
-      | use_stat
-      | module_proc_stmt
-      | namelist
-      | TOK_BACKSPACE '(' expr ')'
-      | TOK_EXTERNAL opt_sep use_name_list
-      | TOK_INTRINSIC opt_sep use_intrinsic_list
-      | TOK_EQUIVALENCE list_expr_equi
-      | data_stmt '\n'
-        {
-            /* we should remove the data declaration                */
-            pos_end = setposcur();
-            RemoveWordSET_0(fortran_out,pos_curdata,pos_end-pos_curdata);
-
-            if ( aftercontainsdeclare == 1  && firstpass == 0 )
-            {
-                ReWriteDataStatement_0(fortran_out);
-                pos_end = setposcur();
-            }
-        }
-      ;
+
 opt_spec :
       | access_spec
@@ -619 +671 @@
       | list_expr_equi1 ',' ident dims
       ;
-list_expr :
+list_expr:
                       expr
       | list_expr ',' expr
       ;
-opt_sep :
+opt_sep:
       | TOK_FOURDOTS
       ;
-after_type :
-        dcl nodimsgiven
-        {
-            /* if the variable is a parameter we can suppose that is*/
-            /*    value is the same on each grid. It is not useless */
-            /*    to create a copy of it on each grid               */
-            if ( ! inside_type_declare )
-            {
-                pos_end = setposcur();
-                RemoveWordSET_0(fortran_out,pos_cur_decl,pos_end-pos_cur_decl);
-                ReWriteDeclarationAndAddTosubroutine_01($1);
-                pos_cur_decl = setposcur();
-                if ( firstpass == 0 && GlobalDeclaration == 0
-                                    && insubroutinedeclare == 0 )
-                {
-                    fprintf(fortran_out,"\n#include \"Module_Declar_%s.h\"\n", curmodulename);
-                    sprintf(ligne, "Module_Declar_%s.h", curmodulename);
-                    module_declar = open_for_write(ligne);
-                    GlobalDeclaration = 1 ;
-                    pos_cur_decl = setposcur();
-                }
-                $$ = $1;
-
-                if ( firstpass )
-                {
-                    Add_Globliste_1($1);
-                    if ( insubroutinedeclare )
-                    {
-                        if ( pointerdeclare ) Add_Pointer_Var_From_List_1($1);
-                        Add_Parameter_Var_1($1);
-                    }
-                    else
-                        Add_GlobalParameter_Var_1($1);
-
-                    /* If there's a SAVE declaration in module's subroutines we should    */
-                    /*    remove it from the subroutines declaration and add it in the    */
-                    /*    global declarations                                             */
-                    if ( aftercontainsdeclare && SaveDeclare )
-                    {
-                        if ( inmodulemeet ) Add_SubroutineDeclarationSave_Var_1($1);
-                        else                Add_Save_Var_dcl_1($1);
-                    }
-                }
-            }
-            else
-            {
-                $$ = (listvar *) NULL;
-            }
-            PublicDeclare = 0;
-            PrivateDeclare = 0;
-            ExternalDeclare = 0;
-            strcpy(NamePrecision,"");
-            c_star = 0;
-            InitialValueGiven = 0 ;
-            strcpy(IntentSpec,"");
-            VariableIsParameter =  0 ;
-            Allocatabledeclare = 0 ;
-            Targetdeclare = 0 ;
-            SaveDeclare = 0;
-            pointerdeclare = 0;
-            optionaldeclare = 0 ;
-            dimsgiven=0;
-            c_selectorgiven=0;
-            strcpy(nameinttypename,"");
-            strcpy(c_selectorname,"");
-            GlobalDeclarationType = 0;
-        }
-      | before_function name_routine arglist
-        {
-            insubroutinedeclare = 1;
-
-            if ( firstpass )
-            {
-                Add_SubroutineArgument_Var_1($3);
-                Add_FunctionType_Var_1($2);
-            }
-            else
-                WriteBeginof_SubLoop();
-
-            strcpy(nameinttypename,"");
-        }
-      ;
+
 before_function :   TOK_FUNCTION    { functiondeclarationisdone = 1; }
       ;
-before_parameter :  TOK_PARAMETER   { VariableIsParameter = 1; pos_curparameter = setposcur()-9; }
+before_parameter :  TOK_PARAMETER   {VariableIsParameter = 1; pos_curparameter = setposcur()-9; }
       ;
 
@@ -750 +721 @@
       ;
 
-save :  before_save varsave
+save:  before_save varsave
       | before_save comblock varsave
       | save opt_comma comblock opt_comma varsave
       | save ',' varsave
       ;
-before_save :
+before_save:
         TOK_SAVE        { pos_cursave = setposcur()-4; }
       ;
@@ -896 +867 @@
             strcpy(curvar->v_subroutinename,subroutinename);
             strcpy(curvar->v_modulename,curmodulename);
-            strcpy(curvar->v_initialvalue,$3);
+            curvar->v_initialvalue=Insertname(curvar->v_initialvalue,$3,0);
             strcpy(curvar->v_commoninfile,cur_filename);
             Save_Length($3,14);
@@ -919 +890 @@
             }
         }
-      | TOK_IMPLICIT TOK_REAL8
-      ;
-dcl :   options TOK_NAME dims lengspec initial_value
+      ;
+dcl:   options TOK_NAME dims lengspec initial_value
         {
             if ( ! inside_type_declare )
@@ -970 +940 @@
 nodimsgiven : { dimsgiven = 0; }
       ;
-type :  typespec selector               { strcpy(DeclType,$1);  }
+type:  typespec selector               { strcpy(DeclType,$1);}
       | before_character c_selector     { strcpy(DeclType,"character");  }
       | typespec '*' TOK_CSTINT         { strcpy(DeclType,$1); strcpy(nameinttypename,$3);  }
@@ -993 +963 @@
       | TOK_COMPLEX         { strcpy($$,"complex"); pos_cur_decl = setposcur()-7; }
       | TOK_DOUBLECOMPLEX   { strcpy($$,"double complex"); pos_cur_decl = setposcur()-14; }
-      | TOK_DOUBLEPRECISION { pos_cur_decl = setposcur()-16; strcpy($$,"real"); strcpy(nameinttypename,"8"); }
+      | TOK_DOUBLEPRECISION { pos_cur_decl = setposcur()-16; strcpy($$,"real"); strcpy(nameinttypename,"8"); printf("OK1\n");}
       ;
 lengspec :
@@ -1033 +1003 @@
       | ',' TOK_NAME clause
       ;
-options :
+options:
       | TOK_FOURDOTS
       | ',' attr_spec_list TOK_FOURDOTS
       ;
-attr_spec_list : attr_spec
+attr_spec_list: attr_spec
       | attr_spec_list ',' attr_spec
       ;
@@ -1047 +1017 @@
       | TOK_EXTERNAL        { ExternalDeclare = 1; }
       | TOK_INTENT '(' intent_spec ')'
-                            { strcpy(IntentSpec,$3); }
+                            { strcpy(IntentSpec,$3); intent_spec = 0;}
       | TOK_INTRINSIC
       | TOK_OPTIONAL        { optionaldeclare = 1 ; }
@@ -1064 +1034 @@
       ;
 dims :  { $$ = (listdim*) NULL; }
-      | '(' dimlist ')'
+      | '(' {in_complex_literal=0;} dimlist ')'
         {
             $$ = (listdim*) NULL;
             if ( inside_type_declare ) break;
-            if ( created_dimensionlist == 1 || agrif_parentcall == 1 )  $$=$2;
+            if ( created_dimensionlist == 1 || agrif_parentcall == 1 )  $$=$3;
         }
       ;
@@ -1095 +1065 @@
       | expr                { strcpy($$,$1);  }
       ;
-expr :  uexpr               { strcpy($$,$1); }
+/*
+expr:  uexpr               { strcpy($$,$1); }
       | complex_const       { strcpy($$,$1); }
       | predefinedfunction  { strcpy($$,$1); }
       | '(' expr ')'        { sprintf($$,"(%s)",$2); }
       ;
-
+*/
 predefinedfunction :
         TOK_SUM minmaxlist ')'          { sprintf($$,"SUM(%s)",$2);}
@@ -1134 +1105 @@
 uexpr : lhs                     { strcpy($$,$1); }
       | simple_const            { strcpy($$,$1); }
-      | vec                     { strcpy($$,$1); }
       | expr operation          { sprintf($$,"%s%s",$1,$2); }
       | signe expr %prec '*'    { sprintf($$,"%s%s",$1,$2); }
@@ -1195 +1165 @@
         begin_array                                         { strcpy($$,$1); if ( incalldeclare == 0 ) inagrifcallargument = 0;   }
       | begin_array substring                               { sprintf($$," %s %s ",$1,$2); }
-      | structure_component '(' funarglist ')'              { sprintf($$," %s ( %s )",$1,$3); }
-      | structure_component '(' funarglist ')' substring    { sprintf($$," %s ( %s ) %s ",$1,$3,$5); }
-      ;
-begin_array :
-        ident '(' funarglist ')'
+      | structure_component '(' {in_complex_literal=0;} funarglist ')'              { sprintf($$," %s ( %s )",$1,$4); }
+      | structure_component '(' {in_complex_literal=0;} funarglist ')' substring    { sprintf($$," %s ( %s ) %s ",$1,$4,$6); }
+      ;
+begin_array : TOK_LOGICALIF
+      |  ident '(' {in_complex_literal=0;} funarglist ')'
         {
             if ( inside_type_declare ) break;
-            sprintf($$," %s ( %s )",$1,$3);
-            ModifyTheAgrifFunction_0($3);
+            sprintf($$," %s ( %s )",$1,$4);
+            ModifyTheAgrifFunction_0($4);
             agrif_parentcall = 0;
         }
@@ -1214 +1184 @@
         }
       ;
+/*
 vec :
         TOK_LEFTAB outlist TOK_RIGHTAB   { sprintf($$,"(/%s/)",$2); }
       ;
+*/
 funarglist :
         beforefunctionuse           { strcpy($$," "); }
@@ -1238 +1210 @@
       | ':'                     {  sprintf($$,":");}
       ;
-ident : TOK_NAME
-        {
+ident: TOK_NAME
+        {
+       //  if (indeclaration == 1) break;
             if ( afterpercent == 0 )
             {
@@ -1303 +1276 @@
       | substring   { strcpy($$,$1);}
       ;
+/*
 substring :
         '(' optexpr ':' optexpr ')' { sprintf($$,"(%s :%s)",$2,$4);}
       ;
+*/
 optexpr :           { strcpy($$," ");}
       | expr        { strcpy($$,$1);}
       ;
-opt_expr :
-        '\n'        { strcpy($$," ");}
+opt_expr :          { strcpy($$," ");}
       | expr        { strcpy($$,$1);}
       ;
-initial_value :     { InitialValueGiven = 0; }
+initial_value:     { InitialValueGiven = 0; }
       | '=' expr
         {
@@ -1330 +1304 @@
         '(' uexpr ',' uexpr ')' {sprintf($$,"(%s,%s)",$2,$4); }
       ;
-use_stat :
-        word_use TOK_NAME
-        {
-            /* if variables has been declared in a subroutine       */
-            sprintf(charusemodule, "%s", $2);
-            if ( firstpass )
-            {
-                Add_NameOfModuleUsed_1($2);
+
+only_list :
+        only_name   {  $$ = $1; }
+      | only_list ',' only_name
+        {
+            /* insert the variable in the list $1                 */
+            $3->suiv = $1;
+            $$ = $3;
+        }
+      ;
+only_name :
+        TOK_NAME TOK_POINT_TO TOK_NAME
+        {
+            coupletmp = (listcouple *)calloc(1,sizeof(listcouple));
+            strcpy(coupletmp->c_namevar,$1);
+            strcpy(coupletmp->c_namepointedvar,$3);
+            coupletmp->suiv = NULL;
+            $$ = coupletmp;
+            pointedvar = 1;
+            Add_UsedInSubroutine_Var_1($1);
+        }
+      | TOK_NAME
+        {
+            coupletmp = (listcouple *)calloc(1,sizeof(listcouple));
+            strcpy(coupletmp->c_namevar,$1);
+            strcpy(coupletmp->c_namepointedvar,"");
+            coupletmp->suiv = NULL;
+            $$ = coupletmp;
+        }
+      ;
+
+/* R204 : specification-part */
+/* opt-implicit-part removed but implicit-stmt and format-stmt added to declaration-construct */
+specification-part: opt-use-stmt-list opt-declaration-construct-list
+     ;
+
+opt-use-stmt-list:
+     |use-stmt-list
+     ;
+     
+opt-implicit-part:
+     |implicit-part
+     ;
+
+implicit-part: opt-implicit-part-stmt-list implicit-stmt
+     ;
+     
+opt-implicit-part-stmt-list:
+     | implicit-part-stmt-list
+     ;
+     
+implicit-part-stmt-list: implicit-part-stmt
+     | implicit-part-stmt-list implicit-part-stmt
+     ;
+     
+/* R206: implicit-part-stmt */
+implicit-part-stmt: implicit-stmt
+     | parameter-stmt
+     | format-stmt
+     ;
+
+
+opt-declaration-construct-list:
+     |declaration-construct-list
+     ;
+     
+declaration-construct-list:
+        declaration-construct
+      | declaration-construct-list declaration-construct
+      ;
+     
+/* R207 : declaration-construct */
+/* stmt-function-stmt replaced by assignment-stmt due to reduce conflicts */
+/* because assignment-stmt has been added  */
+/* Every statement that begins with a variable should be added */
+/* This include : */
+/* pointer-assignment-stmt, do-construct */
+/* implicit-stmt and format-stmt added since implicit-part-stmt has been removed due to conflicts (see R204) */
+/* ANOTHER SOLUTION TO THE PROBLEM OF STMT-FUNCTION IS NEEDED !!!! */
+/* BECAUSE ALMOST ALL ACTION-STMT SHOULD BE INCLUDED HERE !!! */
+
+declaration-construct: derived-type-def
+     | parameter-stmt
+     | format-stmt
+     | implicit-stmt
+     | other-specification-stmt
+     | type-declaration-stmt
+     | assignment-stmt
+     | pointer-assignment-stmt
+     | do-construct
+     | if-construct
+     | continue-stmt
+     | return-stmt
+     | print-stmt
+     ;
+
+opt-execution-part:
+     | execution-part
+     ;
+
+/* R208 : execution-part */
+execution-part: executable-construct opt-execution-part-construct-list
+     ;
+
+opt-execution-part-construct-list:
+     |execution-part-construct-list
+     ;
+
+execution-part-construct-list:
+        execution-part-construct
+      | execution-part-construct-list execution-part-construct
+      ;
+
+/* R209 : execution-part-construct */
+execution-part-construct: executable-construct
+      | format-stmt
+      ;
+
+opt-internal-subprogram-part:
+     | internal-subprogram-part
+     ;
+     
+/* R120 : internal-subprogram-part */
+internal-subprogram-part: TOK_CONTAINS line-break
+      opt-internal-subprogram
+     ;
+
+opt-internal-subprogram:
+     | internal-subprogram-list
+     ;
+
+internal-subprogram-list: internal-subprogram
+     | internal-subprogram-list internal-subprogram
+     ;
+
+/* R211 : internal-subprogram */
+internal-subprogram: function-subprogram
+     | subroutine-subprogram
+     ;
+
+/* R212 : other-specification-stmt */
+other-specification-stmt: access-stmt
+     | common-stmt
+     | data-stmt
+     | dimension-stmt
+     | equivalence-stmt
+     | external-stmt
+     | intrinsic-stmt
+     | namelist-stmt
+     | save-stmt
+     ;
+
+/* R213 : executable-construct */
+executable-construct:
+        action-stmt
+      | do-construct
+      | case-construct
+      | if-construct
+      | where-construct
+      ;
+
+/* R214 : action-stmt */
+
+/* normal action-stmt */
+
+action-stmt:
+      allocate-stmt
+      | assignment-stmt
+      | call-stmt
+      | close-stmt
+      | continue-stmt
+      | cycle-stmt
+      | deallocate-stmt
+      | goto-stmt
+      | exit-stmt
+      | flush-stmt
+      | TOK_CYCLE opt_expr
+      | TOK_NULLIFY '(' pointer_name_list ')'
+      | TOK_ENDMODULE opt_name
+        {
+            /* if we never meet the contains keyword               */
+            if ( firstpass == 0 )
+            {
+                RemoveWordCUR_0(fortran_out, strlen($2)+11);    // Remove word "end module"
+                if ( inmoduledeclare && ! aftercontainsdeclare )
+                {
+                    Write_Closing_Module(1);
+                }
+                fprintf(fortran_out,"\n      end module %s\n", curmodulename);
+                if ( module_declar && insubroutinedeclare == 0 )
+                {
+                    fclose(module_declar);
+                }
+            }
+            inmoduledeclare = 0 ;
+            inmodulemeet = 0 ;
+            aftercontainsdeclare = 1;
+            strcpy(curmodulename, "");
+            GlobalDeclaration = 0 ;
+        }
+      | if-stmt
+      | inquire-stmt
+      | open-stmt
+      | pointer-assignment-stmt
+      | print-stmt
+      | read-stmt
+      | return-stmt
+      | rewind-stmt
+      | stop-stmt
+      | where-stmt
+      | write-stmt
+      | arithmetic-if-stmt
+      ;
+
+/* R215 : keyword */
+keyword: ident
+     ;
+
+scalar-constant: constant
+    ;
+
+/* R304 : constant */
+
+constant: literal-constant
+     | named-constant
+     ;
+     
+/* R305 : literal-constant */
+literal-constant: int-literal-constant
+     | real-literal-constant
+     | logical-literal-constant
+     | complex-literal-constant
+     {in_complex_literal=0;}
+     | char-literal-constant
+     ;
+     
+/* R306 : named-constant */
+named-constant: ident
+     ;
+
+scalar-int-constant:int-constant
+     ;
+
+/* R307 : int-constant */
+int-constant: int-literal-constant
+     | named-constant
+     ;
+     
+/*
+constant: TOK_CSTINT
+     | TOK_CSTREAL
+     | ident
+     ;
+*/
+
+opt-label:
+     {strcpy($$,"");}
+     | label
+     ;
+
+/* R312 : label */
+label: TOK_LABEL
+     | TOK_CSTINT
+     ;
+
+opt-label-djview:
+     {strcpy($$,"");}
+     | label-djview
+     {strcpy($$,$1);}
+     ;
+     
+label-djview: TOK_LABEL_DJVIEW
+     ;
+
+/* R401 : type-param-value */
+type-param-value: scalar-int-expr
+     | '*'
+     | ':'
+     ;
+
+/* R402: type-spec */
+type-spec: intrinsic-type-spec
+     {strcpy($$,$1);}
+     | derived-type-spec
+     {strcpy($$,$1);}
+     ;
+
+/* R403 : declaration-type-spec */
+declaration-type-spec: {pos_cur_decl=my_position_before;} intrinsic-type-spec
+     {strcpy($$,$2);}
+     | TOK_TYPEPAR intrinsic-type-spec ')'
+     | TOK_TYPEPAR derived-type-spec ')'
+     {strcpy(DeclType,"type"); GlobalDeclarationType = 1;  }
+     ;
+
+/* R404 : intrinsic-type-spec */
+intrinsic-type-spec: TOK_INTEGER {in_kind_selector = 1;} opt-kind-selector
+     {sprintf($$,"%s%s",$1,$[opt-kind-selector]);strcpy(DeclType,$1); in_kind_selector =0;}
+     | TOK_REAL {in_kind_selector = 1;} opt-kind-selector
+     {sprintf($$,"%s%s",$1,$[opt-kind-selector]);strcpy(DeclType,$1);in_kind_selector =0;}
+     | TOK_DOUBLEPRECISION {in_kind_selector = 1;} opt-kind-selector
+     {sprintf($$,"%s%s",$1,$[opt-kind-selector]);strcpy(DeclType,"real"); strcpy(NamePrecision,"8");in_kind_selector =0;}
+     | TOK_COMPLEX {in_kind_selector = 1;} opt-kind-selector
+     {sprintf($$,"%s%s",$1,$[opt-kind-selector]);strcpy(DeclType,$1);in_kind_selector =0;}
+     | TOK_CHARACTER {in_char_selector = 1;} opt-char-selector
+     {sprintf($$,"%s%s",$1,$[opt-char-selector]);strcpy(DeclType,$1);in_char_selector = 0;}
+     | TOK_LOGICAL {in_kind_selector = 1;} opt-kind-selector
+     {sprintf($$,"%s%s",$1,$[opt-kind-selector]);strcpy(DeclType,$1);in_kind_selector =0;}
+     ;
+
+opt-kind-selector:
+     {strcpy($$,"");strcpy(NamePrecision,"");}
+     |kind-selector
+     {strcpy($$,$1);}
+     ;
+     
+/* R405 : kind-selector */
+/* Nonstandard extension : * INT */
+kind-selector: '(' scalar-int-constant-expr ')'
+     {sprintf($$,"(%s)",$2); strcpy(NamePrecision,$2);}
+     | '(' TOK_KIND '=' scalar-int-constant-expr ')'
+     {sprintf($$,"(KIND=%s)",$4); strcpy(NamePrecision,$4);}
+     | '*' TOK_CSTINT