hecmw_adapt_cell_comm_table.f90

Go to the documentation of this file.

!-------------------------------------------------------------------------------
! Copyright (c) 2019 FrontISTR Commons
! This software is released under the MIT License, see LICENSE.txt
!-------------------------------------------------------------------------------
 
!C
!C***
!C*** hecmw_adapt_cell_comm_table
!C***
!C
!C    cell-based communication table
!C
subroutine hecmw_adapt_cell_comm_table (hecMESH)
 
  use  hecmw_util
  use  hecmw_adapt_stack_sr
  use  hecmw_adapt_item_sr
 
  implicit real*8 (a-h,o-z)
 
  integer(kind=kint ), pointer :: wSI(:), wSE(:), wiI(:), wiE(:)
  integer(kind=kint ), dimension(:), allocatable :: IW1, IW2
 
  type (hecmwST_local_mesh) :: hecMESH
 
  !C
  !C-- init.
  allocate (iw1(hecmesh%n_neighbor_pe))
  allocate (wse(0:hecmesh%n_neighbor_pe),                           &
    &          wsi(0:hecmesh%n_neighbor_pe))
  iw1 = 0
  wse = 0
  wsi = 0
 
  !C
  !C-- search IMPORT items
  do icel= 1, hecmesh%n_elem
    ih= hecmesh%elem_ID(2*icel)
    if (ih.ne.hecmesh%my_rank) then
      ihr = hecmesh%rev_neighbor_pe(ih)
      wsi(ihr)= wsi(ihr) + 1
    endif
  enddo
  !C
  !C-- exchange INFO. on IMPORT item #
  stime0= mpi_wtime()
  call hecmw_adapt_stack_send_recv                                  &
    &   ( hecmesh%n_neighbor_pe, hecmesh%neighbor_pe,                  &
    &     wsi, wse, hecmesh%MPI_COMM, hecmesh%my_rank)
  etime0= mpi_wtime()
  commtime= commtime + etime0 - stime0
 
  !C
  !C-- IMPORT/EXPORT item #
  do neib= 1, hecmesh%n_neighbor_pe
    wsi(neib)= wsi(neib-1) + wsi(neib)
    wse(neib)= wse(neib-1) + wse(neib)
  enddo
 
  !C
  !C-- send as IMPORT/recv. as EXPORT
  allocate (wii(wsi(hecmesh%n_neighbor_pe)))
  allocate (wie(wse(hecmesh%n_neighbor_pe)))
  ! JF
  wii = 0
  wie = 0
 
  do icel= 1, hecmesh%n_elem
    ih= hecmesh%elem_ID(2*icel)
    if (ih.ne.hecmesh%my_rank) then
      ihr             = hecmesh%rev_neighbor_pe(ih)
      iw1(ihr  )          = iw1(ihr) + 1
      wii(wsi(ihr-1)+iw1(ihr))= hecmesh%elem_ID(2*icel-1)
    endif
  enddo
 
  len= max( wsi(hecmesh%n_neighbor_pe), wse(hecmesh%n_neighbor_pe),&
    &           hecmesh%n_elem)
  deallocate (iw1)
  allocate (iw1(len), iw2(len))
  ! JF
  iw1 = 0
  iw2 = 0
 
  stime0= mpi_wtime()
  call hecmw_adapt_item_send_recv                                   &
    &    (len, hecmesh%n_neighbor_pe, hecmesh%neighbor_pe,             &
    &     wsi, wii, wse, wie, iw1, iw2,                                &
    &     hecmesh%MPI_COMM, hecmesh%my_rank, 1)
  etime0= mpi_wtime()
  commtime= commtime + etime0 - stime0
 
  !C
  !C-- find LOCAL CELL ID at DESTINY
  do neib= 1, hecmesh%n_neighbor_pe
    is= wse(neib-1)+1
    ie= wse(neib  )
    ip= hecmesh%neighbor_pe(neib)
    do k= is, ie
      icel= wie(k)
      call hecmw_adapt_local_cell_info (icel, icel0)
      wie(k)= icel0
    enddo
  enddo
 
  !C
  !C-- reconstruct IMPORT table
  deallocate (iw1)
  allocate (iw1(hecmesh%n_neighbor_pe))
 
  iw1= 0
  do icel= 1, hecmesh%n_elem
    ih= hecmesh%elem_ID(2*icel)
    if (ih.ne.hecmesh%my_rank) then
      ihr             = hecmesh%rev_neighbor_pe(ih)
      iw1(ihr  )          = iw1(ihr) + 1
      wii(wsi(ihr-1)+iw1(ihr))= icel
    endif
  enddo
 
  !C
  !C-- new ARRAY
  allocate (hecmesh%adapt_import_elem_index(0:hecmesh%n_neighbor_pe))
  allocate (hecmesh%adapt_export_elem_index(0:hecmesh%n_neighbor_pe))
 
  do neib= 0, hecmesh%n_neighbor_pe
    hecmesh%adapt_import_elem_index(neib)= wsi(neib)
    hecmesh%adapt_export_elem_index(neib)= wse(neib)
  enddo
 
  maximport= wsi(hecmesh%n_neighbor_pe)
  maxexport= wse(hecmesh%n_neighbor_pe)
 
  allocate (hecmesh%adapt_import_elem_item(maximport))
  allocate (hecmesh%adapt_export_elem_item(maxexport))
  do k= 1, maximport
    hecmesh%adapt_import_elem_item(k)= wii(k)
  enddo
  do k= 1, maxexport
    hecmesh%adapt_export_elem_item(k)= wie(k)
  enddo
 
  deallocate (iw1,iw2)
  deallocate (wse,wsi,wie,wii)
 
  !C===
contains
  subroutine hecmw_adapt_local_cell_info (icel, in0)
    do i0= 1, hecmesh%ne_internal
      i= hecmesh%elem_internal_list(i0)
      if (icel.eq.hecmesh%elem_ID(2*i-1)) then
        in0= i
        return
      endif
    enddo
  end subroutine hecmw_adapt_local_cell_info
end subroutine hecmw_adapt_cell_comm_table