string_2d.f90

subroutine string_2d ( nvec, p1, p2, string_num, order, string )

!*****************************************************************************80
!
!! STRING_2D groups line segments into connected lines in 2D.
!
!  Discussion:
!
!    The routine receives an unordered set of line segments, described by
!    pairs of coordinates P1 and P2, and tries to group them
!    into ordered lists that constitute connected jagged lines.
!
!    This routine will not match two endpoints unless they are exactly equal.
!
!    On input, line segment I has endpoints P1(I), P2(I).
!
!    On output, the order of the components may have been switched.
!    That is, for some I, P1(I) and P2(I) may have been swapped.
!
!    More importantly, both points P1(I) and P2(I) may have been swapped
!    with another pair P1(J), P2(J).
!
!    The resulting coordinates will have been sorted in order
!    of the string to which they belong, and then by the order
!    of their traversal within that string.
!
!    The array STRING(I) identifies the string to which segment I belongs.
!
!    If two segments I and J have the same value of STRING, then
!    ORDER(I) and ORDER(J) give the relative order of the two segments 
!    in the string.  Thus if ORDER(I) = -3 and ORDER(J) = 2, then when 
!    the string is traversed, segment I is traversed first, then four other
!    segments are traversed, and then segment J is traversed.
!
!    For each string, the segment with ORDER(I) = 0 is the initial segment 
!    from which the entire string was "grown" (with growth possible to both the
!    left and the right).
!
!  Licensing:
!
!    This code is distributed under the GNU LGPL license. 
!
!  Modified:
!
!    23 February 2005
!
!  Author:
!
!    John Burkardt
!
!  Parameters:
!
!    Input, integer NVEC, the number of line segments to be 
!    analyzed.
!
!    Input/output, double precision P1(2,NVEC), P2VEC(2,NVEC), the 
!    line segments.
!
!    Output, integer ORDER(NVEC), the order vector.
!
!    Output, integer STRING(NVEC), the string to which each 
!    segment belongs.
!
!    Output, integer STRING_NUM, the number of strings created.
!
  implicit none

  integer, parameter :: dim_num = 2
  integer nvec

  integer i
  integer indx
  integer isgn
  integer j
  integer jval
  integer kval
  integer match
  integer order(nvec)
  double precision p1(dim_num,nvec)
  double precision p2(dim_num,nvec)
  integer seed
  integer string(nvec)
  integer string_num
  double precision x1val
  double precision x2val
  double precision y1val
  double precision y2val
!
!  Mark STRING so that each segment is alone.
!
  order(1:nvec) = 0
  string(1:nvec) = nvec + i
!
!  Starting with the lowest numbered group of line segments,
!  see if any higher numbered groups belong.
!
  seed = 1
  string_num = 1
  string(seed) = string_num

  do

    x1val = p1(1,seed)
    y1val = p1(2,seed)

    x2val = p2(1,seed)
    y2val = p2(2,seed)

    jval = order(seed)
    kval = order(seed)

    do

      match = 0

      do j = 1, nvec

        if ( string_num < string(j) ) then

          if ( x1val == p1(1,j) .and. y1val == p1(2,j) ) then

            jval = jval - 1
            order(j) = jval
            string(j) = string_num
            x1val = p2(1,j)
            y1val = p2(2,j)
            match = match + 1

            call r8_swap ( p1(1,j), p2(1,j) )
            call r8_swap ( p1(2,j), p2(2,j) )

          else if ( x1val == p2(1,j) .and. y1val == p2(2,j) ) then

            jval = jval - 1
            order(j) = jval
            string(j) = string_num
            x1val = p1(1,j)
            y1val = p1(2,j)
            match = match + 1

          else if ( x2val == p1(1,j) .and. y2val == p1(2,j) ) then

            kval = kval + 1
            order(j) = kval
            string(j) = string_num
            x2val = p2(1,j)
            y2val = p2(2,j)
            match = match + 1

          else if ( x2val == p2(1,j) .and. y2val == p2(2,j) ) then

            kval = kval + 1
            order(j) = kval
            string(j) = string_num
            x2val = p1(1,j)
            y2val = p1(2,j)
            match = match + 1

            call r8_swap ( p1(1,j), p2(1,j) )
            call r8_swap ( p1(2,j), p2(2,j) )

          end if

        end if

      end do
!
!  If the string has closed on itself, then we don't want to
!  look for any more matches for this string.
!
      if ( x1val == x2val .and. y1val == y2val ) then
        exit
      end if
!
!  If we made no matches this pass, we're done.
!
      if ( match <= 0 ) then
        exit
      end if

    end do
!
!  This string is "exhausted".  Are there any line segments we
!  haven't looked at yet?
!
    seed = 0

    do i = 1, nvec
      if ( string_num < string(i) ) then
        seed = i
        string_num = string_num + 1
        string(i) = string_num
        exit
      end if
    end do

    if ( seed == 0 ) then
      exit
    end if

  end do
!
!  There are no more line segments to look at.  Renumber the
!  isolated segments.
!
!  Question: Can this ever happen?
!
  do i = 1, nvec
    if ( nvec < string(i) ) then
      string_num = string_num + 1
      string(i) = string_num
    end if
  end do
!
!  Now sort the line segments by string and by order of traversal.
!
  i = 0
  isgn = 0
  j = 0

  indx = 0

  do

    call sort_heap_external ( nvec, indx, i, j, isgn )

    if ( 0 < indx ) then

      call i4_swap ( order(i), order(j) )
      call i4_swap ( string(i), string(j) )
      call r8_swap ( p1(1,i), p1(1,j) )
      call r8_swap ( p1(2,i), p1(2,j) )
      call r8_swap ( p2(1,i), p2(1,j) )
      call r8_swap ( p2(2,i), p2(2,j) )

    else if ( indx < 0 ) then

      if ( ( string(i) < string(j) ) .or. &
           ( string(i) == string(j) .and. order(i) < order(j) ) ) then

        isgn = -1

      else

        isgn = + 1

      end if

    else if ( indx == 0 ) then

      exit

    end if

  end do

  return
end