Changeset 13027 for vendors/AGRIF/dev_r12970_AGRIF_CMEMS/AGRIF_FILES/modarrays.F90

Timestamp:

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

Author:

rblod

Message:

New AGRIF library, see ticket #2129

File:

• vendors/AGRIF/dev_r12970_AGRIF_CMEMS/AGRIF_FILES/modarrays.F90 (modified) (15 diffs)

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