Changeset 965 for codes/icosagcm/trunk/src/parallel/transfert_requests.F90

Timestamp:

07/25/19 19:53:31 (5 years ago)

Author:

adurocher

Message:

trunk : Implemented req_z1_scal in new transfert_mpi

File:

• codes/icosagcm/trunk/src/parallel/transfert_requests.F90 (modified) (15 diffs)

codes/icosagcm/trunk/src/parallel/transfert_requests.F90

@@ -2 +2 @@
 module transfert_request_mod
   use abort_mod
-  use field_mod, only : t_field, field_T, field_U
+  use field_mod, only : t_field, field_T, field_U, field_Z
   use domain_mod, only : ndomain, ndomain_glo, domain, domain_glo, domloc_glo_ind, domglo_rank, domglo_loc_ind
   implicit none
@@ -9 +9 @@
   ! Points for t_request : list of points coordinates in a domain
   type t_points
-    integer, allocatable :: i(:), j(:), edge(:)
+    integer, allocatable :: i(:), j(:)
+    integer, allocatable :: elt(:) ! Element : cell edge or cell point
     integer :: npoints
   end type
@@ -26 +27 @@
   type(t_request),save,pointer :: req_e1_scal(:) ! Halos for U fields
   type(t_request),save,pointer :: req_e1_vect(:) ! Halos for U fields (with sign change)
-  type(t_request),save,pointer :: req_z1_scal(:) => null() ! DO NOT USE : not initialized
+  type(t_request),save,pointer :: req_z1_scal(:) ! Halos for Z fields
 
   type(t_request),save,pointer :: req_i0(:) ! Duplicated cells for T fields
@@ -42 +43 @@
   subroutine init_all_requests
     use dimensions, only : swap_dimensions, ii_begin, ii_end, jj_begin, jj_end
-    use metric, only : right, rdown, ldown, left, lup, rup
+    use metric, only : right, rdown, ldown, left, lup, rup, vdown, vlup, vrdown, vrup, vup
     integer :: ind, i, j
 
@@ -131 +132 @@
     req_e1_vect = req_e1_scal
     req_e1_vect%vector = .true.
+
+    call request_init(req_z1_scal, field_z)
+    do ind=1,ndomain
+      call swap_dimensions(ind)
+      do i=ii_begin,ii_end
+        call request_add_point(req_z1_scal,ind,i,jj_begin-1,vrup)
+        call request_add_point(req_z1_scal,ind,i+1,jj_begin-1,vup)
+      enddo
+      do j=jj_begin,jj_end
+        call request_add_point(req_z1_scal,ind,ii_end+1,j,vlup)
+      enddo
+      do j=jj_begin,jj_end
+        call request_add_point(req_z1_scal,ind,ii_end+1,j-1,vup)
+      enddo
+      do i=ii_begin,ii_end
+        call request_add_point(req_z1_scal,ind,i,jj_end+1,vdown)
+        call request_add_point(req_z1_scal,ind,i-1,jj_end+1,vrdown)
+      enddo
+      do j=jj_begin,jj_end
+        call request_add_point(req_z1_scal,ind,ii_begin-1,j,vrup)
+      enddo
+      do j=jj_begin,jj_end
+        call request_add_point(req_z1_scal,ind,ii_begin-1,j,vrdown)
+      enddo
+    enddo
+    call request_exchange(req_z1_scal)
   contains
 
     ! ---- Points ----
     ! Initialize (allocate) points
-    subroutine points_init(points, has_edges)
+    subroutine points_init(points, has_elt)
       type(t_points):: points
-      logical :: has_edges
+      logical :: has_elt
       integer, parameter :: INITIAL_ALLOC_SIZE = 10
 
       allocate(points%i(INITIAL_ALLOC_SIZE))
       allocate(points%j(INITIAL_ALLOC_SIZE))
-      if(has_edges) allocate(points%edge(INITIAL_ALLOC_SIZE))
+      if(has_elt) allocate(points%elt(INITIAL_ALLOC_SIZE))
       points%npoints = 0
     end subroutine
 
-    ! Append point (i, j [,edge]) to point list
-    subroutine points_append(points, i, j, edge)
+    ! Append point (i, j [,elt]) to point list
+    subroutine points_append(points, i, j, elt)
       type(t_points), intent(inout):: points
       integer, intent(in) :: i, j
-      integer, intent(in), optional :: edge
+      integer, intent(in), optional :: elt
       integer :: begin_size
 
@@ -157 +184 @@
       begin_size=points%npoints
       call array_append( points%j, begin_size, j )
-      if(present(edge)) then
+      if(present(elt)) then
         begin_size=points%npoints
-        call array_append( points%edge, begin_size, edge )
+        call array_append( points%elt, begin_size, elt )
       end if
 
       points%npoints = points%npoints + 1
     end subroutine
-    
+
     ! Add element to array, and reallocate if necessary
     subroutine array_append( a, a_size, elt )
@@ -172 +199 @@
       integer, allocatable :: a_tmp(:)
       integer, parameter :: GROW_FACTOR = 2
-      
+
       if( size( a ) <= a_size ) then
         allocate( a_tmp ( a_size * GROW_FACTOR ) )
@@ -192 +219 @@
 
       displs = (points%i-1) + (points%j-1)*iim
-      if(allocated(points%edge)) displs = displs + (points%edge-1)*iim*jjm
+      if(allocated(points%elt)) displs = displs + (points%elt-1)*iim*jjm
 
       last=0
@@ -210 +237 @@
         points%j(k) = mod((displs(k)-(points%i(k)-1))/iim, jjm)+1
       end do
-      if(allocated(points%edge)) then
-        deallocate(points%edge); allocate(points%edge(last))
-        points%edge(:) = displs(1:last)/(iim*jjm) + 1
+      if(allocated(points%elt)) then
+        deallocate(points%elt); allocate(points%elt(last))
+        points%elt(:) = displs(1:last)/(iim*jjm) + 1
       end if
 
@@ -231 +258 @@
         allocate(request(ind)%points_HtoB(ndomain_glo))
         do remote_ind_glo = 1, ndomain_glo
-          call points_init(request(ind)%points_BtoH(remote_ind_glo), field_type == field_U)
+          call points_init(request(ind)%points_BtoH(remote_ind_glo), field_type /= field_T)
           !call points_init(request(ind)%points_HtoB(remote_ind_glo)) ! Initialized before MPI communication in request_exchange
         end do
@@ -238 +265 @@
 
     ! Append local point (ind_glo,i,j) to the point list of domain ind, where ind_glo is the domain owning the point
-    subroutine request_add_point(req, ind, i, j, edge)
+    subroutine request_add_point(req, ind, i, j, elt)
       type(t_request), intent(inout) :: req(:)
       integer :: ind, i, j
-      integer, optional :: edge
-
-      if( present(edge) ) then ! U field
-        if(domain(ind)%edge_assign_domain(edge-1,i,j) /= domloc_glo_ind(ind) ) & ! Add only if remote domain != local domain
-        call points_append(req(ind)%points_BtoH(domain(ind)%edge_assign_domain(edge-1,i,j)), i, j, edge )
+      integer, optional :: elt
+
+      if( req(ind)%field_type == field_U ) then
+        if(domain(ind)%edge_assign_domain(elt-1,i,j) /= domloc_glo_ind(ind) ) & ! Add only if remote domain != local domain
+        call points_append(req(ind)%points_BtoH(domain(ind)%edge_assign_domain(elt-1,i,j)), i, j, elt )
+      else if( req(ind)%field_type == field_Z ) then
+        if(domain(ind)%vertex_assign_domain(elt-1,i,j) /= domloc_glo_ind(ind) ) & ! Add only if remote domain != local domain
+        call points_append(req(ind)%points_BtoH(domain(ind)%vertex_assign_domain(elt-1,i,j)), i, j, elt )
       else ! T field
         if(domain(ind)%assign_domain(i,j) /= domloc_glo_ind(ind) ) &
@@ -262 +292 @@
 
       integer :: ind_loc, remote_ind_glo, k
-      integer :: i, j, edge
+      integer :: i, j, elt
       integer :: reqs(ndomain, ndomain_glo, 2), reqs2(ndomain, ndomain_glo, 2), reqs3(ndomain, ndomain_glo, 3), ierr
 
@@ -271 +301 @@
           points => req(ind_loc)%points_BtoH(remote_ind_glo)
           call points_sort(points)
-          call points_init( points_send(ind_loc,remote_ind_glo), req(ind_loc)%field_type == field_U )
+          call points_init( points_send(ind_loc,remote_ind_glo), req(ind_loc)%field_type /= field_T )
           do k = 1, points%npoints
             i = points%i(k)
             j = points%j(k)
-            if(req(ind_loc)%field_type == field_T) then
+            if( req(ind_loc)%field_type == field_U ) then
+              elt = points%elt(k) - 1 ! WARNING : domain%edge_assign_* use index in 0:5 instead of 1:6 everywhere else
+              call points_append(points_send(ind_loc,remote_ind_glo), domain(ind_loc)%edge_assign_i(elt,i,j), &
+                domain(ind_loc)%edge_assign_j(elt,i,j), &
+                domain(ind_loc)%edge_assign_pos(elt,i,j)+1)
+            else if( req(ind_loc)%field_type == field_Z ) then
+              elt = points%elt(k) - 1 ! WARNING : domain%vertex_assign_* use index in 0:5 instead of 1:6 everywhere else
+              call points_append(points_send(ind_loc,remote_ind_glo), domain(ind_loc)%vertex_assign_i(elt,i,j), &
+                domain(ind_loc)%vertex_assign_j(elt,i,j), &
+                domain(ind_loc)%vertex_assign_pos(elt,i,j)+1)
+            else ! T field
               call points_append(points_send(ind_loc,remote_ind_glo), domain(ind_loc)%assign_i(i,j), &
                 domain(ind_loc)%assign_j(i,j))
-            else
-              edge = points%edge(k) - 1 ! WARNING : domain%edge_assign_* use index in 0:5 instead of 1:6 everywhere else
-              call points_append(points_send(ind_loc,remote_ind_glo), domain(ind_loc)%edge_assign_i(edge,i,j), &
-                domain(ind_loc)%edge_assign_j(edge,i,j), &
-                domain(ind_loc)%edge_assign_pos(edge,i,j)+1)
-            end if
+            endif
           end do
         end do
@@ -317 +352 @@
             domloc_glo_ind(ind_loc)+ndomain_glo*remote_ind_glo, comm_icosa, reqs2(ind_loc,remote_ind_glo,2), ierr)
 
-          if(req(1)%field_type == field_U) then
-            call MPI_Isend( points_send(ind_loc,remote_ind_glo)%edge, points_send(ind_loc,remote_ind_glo)%npoints, MPI_INT, &
+          if(req(1)%field_type /= field_T) then
+            call MPI_Isend( points_send(ind_loc,remote_ind_glo)%elt, points_send(ind_loc,remote_ind_glo)%npoints, MPI_INT, &
               domglo_rank(remote_ind_glo), remote_ind_glo+ndomain_glo*domloc_glo_ind(ind_loc), &
               comm_icosa, reqs3(ind_loc,remote_ind_glo,1), ierr  )
-            allocate( points%edge( points%npoints ) )
-            call MPI_Irecv( points%edge, points%npoints, MPI_INT, &
+            allocate( points%elt( points%npoints ) )
+            call MPI_Irecv( points%elt, points%npoints, MPI_INT, &
               domglo_rank(remote_ind_glo), domloc_glo_ind(ind_loc)+ndomain_glo*remote_ind_glo, &
               comm_icosa, reqs3(ind_loc,remote_ind_glo,2), ierr )
@@ -330 +365 @@
       call waitall(reqs,ndomain*ndomain_glo*2)
       call waitall(reqs2,ndomain*ndomain_glo*2)
-      if(req(1)%field_type == field_U) call waitall(reqs3,ndomain*ndomain_glo*2)
+      if(req(1)%field_type /= field_T) call waitall(reqs3,ndomain*ndomain_glo*2)
     end subroutine