hecmw_adapt_repro_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_REPRO_COMM_TABLE
!C***
!C
!C    reproduce COMMUNICATION table
!C
subroutine hecmw_adapt_repro_comm_table (hecMESH)
 
  use  hecmw_util
  use  hecmw_adapt_stack_sr
  use  hecmw_adapt_item_sr
  use  hecmw_adapt_int_sr
 
  integer(kind=kint ), pointer     :: wSI(:), wSE(:), wiI(:), wiE(:)
  integer(kind=kint ), allocatable :: IW1(:), IW2(:)
 
  type (hecmwST_local_mesh) :: hecMESH
 
  !C
  !C-- init.
  allocate (iw1(hecmesh%n_neighbor_pe))
  iw1 = 0
 
  allocate (wse(0:hecmesh%n_neighbor_pe), wsi(0:hecmesh%n_neighbor_pe))
  wse = 0
  wsi = 0
 
  !C
  !C-- search IMPORT items
  do in= 1, hecmesh%n_adapt_node_cur
    is= hecmesh%adapt_NEWtoOLD_node(in)
    ih= hecmesh%node_ID(2*is)
    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 #
  call hecmw_adapt_stack_send_recv                                  &
    &   ( hecmesh%n_neighbor_pe, hecmesh%neighbor_pe, wsi, wse,        &
    &     hecmesh%MPI_COMM, hecmesh%my_rank)
 
  !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)))
  wii = 0
  wie = 0
 
  do in= 1, hecmesh%n_adapt_node_cur
    is= hecmesh%adapt_NEWtoOLD_node(in)
    ih= hecmesh%node_ID(2*is)
    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%node_ID(2*is-1)
    endif
  enddo
  deallocate (iw1)
 
  n= hecmesh%n_adapt_node_cur
  len= max(wsi(hecmesh%n_neighbor_pe),wse(hecmesh%n_neighbor_pe),n)
  allocate (iw1(len), iw2(len))
  iw1 = 0
  iw2 = 0
 
  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)
 
  !C
  !C-- reconstruct IMPORT table
 
  deallocate (iw1)
  allocate (iw1(hecmesh%n_neighbor_pe))
  iw1 = 0
 
  do in= 1, hecmesh%n_adapt_node_cur
    is= hecmesh%adapt_NEWtoOLD_node(in)
    ih= hecmesh%node_ID(2*is)
    if (ih.ne.hecmesh%my_rank) then
      ihr             = hecmesh%rev_neighbor_pe(ih)
      iw1(ihr  )          = iw1(ihr) + 1
      wii(wsi(ihr-1)+iw1(ihr))= in
    endif
  enddo
 
  !C
  !C-- new ARRAY
  allocate (hecmesh%adapt_import_new_index(0:hecmesh%n_neighbor_pe))
  allocate (hecmesh%adapt_export_new_index(0:hecmesh%n_neighbor_pe))
 
  do neib= 0, hecmesh%n_neighbor_pe
    hecmesh%adapt_import_new_index(neib)= wsi(neib)
    hecmesh%adapt_export_new_index(neib)= wse(neib)
  enddo
 
  maximport= wsi(hecmesh%n_neighbor_pe)
  maxexport= wse(hecmesh%n_neighbor_pe)
 
  allocate (hecmesh%adapt_import_new_item(maximport))
  allocate (hecmesh%adapt_export_new_item(maxexport))
 
  do k= 1, maximport
    hecmesh%adapt_import_new_item(k)= wii(k)
  enddo
  do k= 1, maxexport
    hecmesh%adapt_export_new_item(k)= wie(k)
  enddo
 
  deallocate (iw1,iw2)
  deallocate (wse,wsi,wie,wii)
  !C===
 
end subroutine hecmw_adapt_repro_comm_table