hecmw_adapt_new_node.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_NEW_NODE
!C***
!C
!C    create NEW NODEs in TETRAHEDRAL REGION
!C
subroutine hecmw_adapt_new_node (hecMESH)
 
  use hecmw_util
  use hecmw_adapt_int_sr
  implicit real*8 (a-h,o-z)
 
  integer(kind=kint), dimension(:), allocatable :: WR, WS, IW1, IW2
 
  type (hecmwST_local_mesh) :: hecMESH
 
  !C
  !C-- INIT.
 
  !C
  !C +----------------+
  !C | mid-edge POINT |
  !C +----------------+
  !C===
  hecmesh%n_adapt_node_cur= hecmesh%n_node
  hecmesh%n_adapt_node_old= hecmesh%n_node
  intcount                = hecmesh%nn_internal
 
  icou= 0
  do ie= 1, hecmesh%n_adapt_edge
    n1= hecmesh%adapt_edge_node(2*ie-1)
    n2= hecmesh%adapt_edge_node(2*ie  )
 
    if ( hecmesh%adapt_iemb(ie) .eq. 1) then
      hecmesh%n_adapt_node_cur= hecmesh%n_adapt_node_cur + 1
      if (hecmesh%n_adapt_node_cur.gt.hecmesh%nn_array) then
        call hecmw_adapt_error_exit (hecmesh, 62)
      endif
 
      ieh= hecmesh%adapt_edge_home(ie)
      nod= hecmesh%n_adapt_node_cur
 
      hecmesh%node_ID(2*nod)= ieh
      if (ieh.eq.hecmesh%my_rank) then
        intcount= intcount + 1
        hecmesh%adapt_mid_edge(ie)= intcount
        hecmesh%node_ID(2*nod-1)  = intcount
      else
        hecmesh%adapt_mid_edge(ie)= nod
        hecmesh%node_ID (2*nod-1) = nod
      endif
 
      hecmesh%when_i_was_refined_node(nod)= hecmesh%n_adapt
      hecmesh%adapt_IWK(ie)               = nod
 
      if (ieh.eq.hecmesh%my_rank) icou= icou + 1
 
      hecmesh%node(3*nod-2)= 0.5d0 * ( hecmesh%node(3*n1-2) +       &
        &                                     hecmesh%node(3*n2-2) )
      hecmesh%node(3*nod-1)= 0.5d0 * ( hecmesh%node(3*n1-1) +       &
        &                                     hecmesh%node(3*n2-1) )
      hecmesh%node(3*nod  )= 0.5d0 * ( hecmesh%node(3*n1  ) +       &
        &                                     hecmesh%node(3*n2  ) )
    endif
  enddo
 
  call mpi_barrier  (hecmesh%MPI_COMM,ierr)
 
  hecmesh%nn_adapt_internal_cur= hecmesh%nn_internal + icou
  !C===
 
  !C
  !C +---------------+
  !C | GLOBAL node # |
  !C +---------------+
  !C===
 
  !C
  !C-- OLD/NEW global NODE #
  nodtotg_old= 0
  nodtotg_cur= 0
 
  call mpi_allreduce (hecmesh%nn_internal, nodtotg_old, 1,          &
    &                    mpi_integer, mpi_sum, hecmesh%MPI_COMM, ierr)
  call mpi_allreduce (hecmesh%nn_adapt_internal_cur, nodtotg_cur, 1,&
    &                    mpi_integer, mpi_sum, hecmesh%MPI_COMM, ierr)
 
  if (hecmesh%my_rank.eq.0) then
    write (*,'("  total node number (before)", i8  )') nodtotg_old
    write (*,'("  total node number (curr. )", i8,/)') nodtotg_cur
  endif
 
  hecmesh%n_node          = hecmesh%n_adapt_node_cur
  hecmesh%nn_internal     = hecmesh%nn_adapt_internal_cur
 
  !C
  !C-- exchange MIDEDG
  allocate (iw1(hecmesh%n_adapt_edge))
 
  iw1= hecmesh%adapt_mid_edge
 
  n1= hecmesh%adapt_import_edge_index(hecmesh%n_neighbor_pe)
  n2= hecmesh%adapt_export_edge_index(hecmesh%n_neighbor_pe)
  m = max(n1, n2)
  allocate (ws(m), wr(m))
 
  ws= 0
  wr= 0
  call hecmw_adapt_int_send_recv                                    &
    &   ( hecmesh%n_adapt_edge,                                        &
    &     hecmesh%n_neighbor_pe, hecmesh%neighbor_pe,                  &
    &     hecmesh%adapt_import_edge_index,                             &
    &     hecmesh%adapt_import_edge_item ,                             &
    &     hecmesh%adapt_export_edge_index,                             &
    &     hecmesh%adapt_export_edge_item ,                             &
    &     ws, wr, hecmesh%adapt_mid_edge, hecmesh%MPI_COMM,            &
    &     hecmesh%my_rank, 1, m)
  deallocate (ws, wr)
 
  do ie= 1, hecmesh%n_adapt_edge
    if (hecmesh%adapt_iemb(ie).eq.1 .and.                           &
        &      hecmesh%adapt_edge_home(ie).ne.hecmesh%my_rank) then
      ing= hecmesh%adapt_mid_edge(ie)
      inl= iw1(ie)
      hecmesh%node_ID(2*inl  )= hecmesh%adapt_edge_home(ie)
      hecmesh%node_ID(2*inl-1)= ing
    endif
  enddo
 
  do ie= 1, hecmesh%n_adapt_edge
    if (hecmesh%adapt_iemb(ie).eq.1) then
      inl= iw1(ie)
      hecmesh%adapt_mid_edge(ie)= inl
    endif
  enddo
  deallocate (iw1)
  !C===
 
  !C
  !C +-------------+
  !C | RE-ORDERING |
  !C +-------------+
  !C===
  allocate (iw1(-1:hecmesh%n_neighbor_pe),                          &
    &          iw2(-1:hecmesh%n_neighbor_pe))
  allocate (hecmesh%adapt_NEWtoOLD_node(hecmesh%n_node),            &
    &          hecmesh%adapt_OLDtoNEW_node(hecmesh%n_node))
 
  iw1= 0
  iw2= 0
  hecmesh%adapt_NEWtoOLD_node= 0
  hecmesh%adapt_OLDtoNEW_node= 0
 
  do in= 1, hecmesh%n_node
    ih  = hecmesh%node_ID(2*in)
    ihr = hecmesh%rev_neighbor_pe(ih)
    iw1(ihr)= iw1(ihr) + 1
  enddo
 
  do neib= 0, hecmesh%n_neighbor_pe
    iw2(neib)= iw2(neib-1) + iw1(neib)
  enddo
 
  iw1= 0
  do in= 1, hecmesh%n_node
    ih  = hecmesh%node_ID(2*in)
    ihr = hecmesh%rev_neighbor_pe(ih)
    iw1(ihr)= iw1(ihr) + 1
    is  = iw2(ihr-1) + iw1(ihr)
    hecmesh%adapt_OLDtoNEW_node(in)= is
    hecmesh%adapt_NEWtoOLD_node(is)= in
  enddo
  !C===
 
  deallocate (iw1, iw2)
 
  return
end