hecmw_adapt_edge_info.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_EDGE_INFO
!C***
 
subroutine hecmw_adapt_edge_info (hecMESH, nod1, nod2, iedge, NFLAG)
  use  hecmw_util
 
  integer(kind=4), save :: INITflag, nbuckets
  integer(kind=4), dimension(:), allocatable, save :: ieaddrs
 
  data initflag/0/
  type      (hecmwST_local_mesh) :: hecMESH
 
  !C
  !C-- init.
  if (initflag.eq.0) then
    initflag= 1
    nbuckets= 2*max(hecmesh%n_elem,hecmesh%n_node)
    allocate (ieaddrs(-nbuckets:+nbuckets))
    ieaddrs=   0
  endif
 
  !C
  !C    NFALG= 0 : CREATE NEW EDGEs
  !C    NFLAG= 1 : REFER  the EDGE INFORMATION
  !C    NFLAG= 2 : DEALLOCATE ieaddrs
  !C
 
  if (nflag.eq.2) then
    initflag = 0
    deallocate( ieaddrs )
    return
  endif
 
  iedge= 0
 
  nn1 = mod(nod1, nbuckets) * mod(nod2, nbuckets)
  iarg= mod( nn1, nbuckets)
 
  if (nflag.eq.0) then
    if (ieaddrs(iarg).gt.hecmesh%n_adapt_edge) then
      ieaddrs(iarg)= 0
    endif
  endif
 
  50 continue
 
 
  !C
  !C-- NEW EDGE
 
  if (ieaddrs(iarg).eq.0) then
    hecmesh%n_adapt_edge= hecmesh%n_adapt_edge + 1
    iedge= hecmesh%n_adapt_edge
    hecmesh%adapt_edge_node (2*iedge-1)= nod1
    hecmesh%adapt_edge_node (2*iedge  )= nod2
 
    !      if (iarg.gt.nbuckets) write (*,*) nod1,nod2,iarg
    ieaddrs(iarg)= hecmesh%n_adapt_edge
    return
  else
 
    !      if (iarg.gt.nbuckets) write (*,*) nod1,nod2,iarg
    iedge= ieaddrs(iarg)
    in1= hecmesh%adapt_edge_node (2*iedge-1)
    in2= hecmesh%adapt_edge_node (2*iedge  )
 
    !C
    !C-- EXISTING EDGE
    if (in1.eq.nod1 .and. in2.eq.nod2  .or.                         &
      &      in1.eq.nod2 .and. in2.eq.nod1) return
 
    incr= 1
    ioldadd= iarg
    100   continue
    inewadd= mod(ioldadd + incr**3, nbuckets)
 
    if (inewadd .eq. ioldadd) then
      icount= icount+ 1
      ioldadd= ioldadd + 1
      inewadd= ioldadd
    endif
 
    if (nflag .eq. 0) then
      if (ieaddrs(inewadd).gt.hecmesh%n_adapt_edge) then
        ieaddrs(inewadd)= 0
        goto 50
      endif
    endif
 
    if (ieaddrs(inewadd) .ne. 0) then
      iedge= ieaddrs(inewadd)
      in1= hecmesh%adapt_edge_node (2*iedge-1)
      in2= hecmesh%adapt_edge_node (2*iedge  )
      !C
      !C-- EXISTING EDGE
      if (in1.eq.nod1 .and. in2.eq.nod2  .or.                       &
        &        in1.eq.nod2 .and. in2.eq.nod1) return
      incr= incr + 1
      go to 100
 
    else
      !C
      !C-- NEW EDGE
      hecmesh%n_adapt_edge= hecmesh%n_adapt_edge + 1
      iedge= hecmesh%n_adapt_edge
      hecmesh%adapt_edge_node (2*iedge-1)= nod1
      hecmesh%adapt_edge_node (2*iedge  )= nod2
 
      !      if (inewadd.gt.nbuckets) write (*,*) nod1,nod2,inewadd
      ieaddrs(inewadd)= iedge
      return
    endif
  endif
 
  return
end