function angle ( xa, ya, xb, yb, xc, yc )

!*****************************************************************************80
!
!! angle() computes the interior angle at a vertex defined by 3 points.
!
!  Discussion:
!
!    ANGLE computes the interior angle, in radians, at vertex
!    (XB,YB) of the chain formed by the directed edges from
!    (XA,YA) to (XB,YB) to (XC,YC).  The interior is to the
!    left of the two directed edges.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, real ( kind = rk8 ) XA, YA, XB, YB, XC, YC, the coordinates of the 
!    vertices.
!
!    Output, real ( kind = rk8 ) ANGLE, the interior angle formed by
!    the vertex, in radians, between 0 and 2*PI.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  real ( kind = rk8 ) angle
  real ( kind = rk8 ), parameter :: pi = 3.141592653589793D+00
  real ( kind = rk8 ) t
  real ( kind = rk8 ) x1
  real ( kind = rk8 ) x2
  real ( kind = rk8 ) xa
  real ( kind = rk8 ) xb
  real ( kind = rk8 ) xc
  real ( kind = rk8 ) y1
  real ( kind = rk8 ) y2
  real ( kind = rk8 ) ya
  real ( kind = rk8 ) yb
  real ( kind = rk8 ) yc

  x1 = xa - xb
  y1 = ya - yb
  x2 = xc - xb
  y2 = yc - yb

  t = sqrt ( ( x1 * x1 + y1 * y1 ) * ( x2 * x2 + y2 * y2 ) )

  if ( t == 0.0D+00 ) then
    angle = pi
    return
  end if

  t = ( x1 * x2 + y1 * y2 ) / t

  if ( t < -1.0D+00 ) then
    t = -1.0D+00
  else if ( 1.0D+00 < t ) then
    t = 1.0D+00
  end if

  angle = acos ( t )

  if ( x2 * y1 - y2 * x1 < 0.0D+00 ) then
    angle = 2.0D+00 * pi - angle
  end if

  return
end
function areapg ( nvrt, xc, yc )

!*****************************************************************************80
!
!! areapg() computes twice the signed area of a simple polygon.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, integer NVRT, the number of vertices on the boundary of 
!    the polygon.  N must be at least 3.
!
!    Input, real ( kind = rk8 ) XC(NVRT), YC(NVRT), the X and Y coordinates 
!    of the vertices.
!
!    Output, real ( kind = rk8 ) AREAPG, twice the signed area of the polygon,
!    which will be positive if the vertices were listed in counter clockwise
!    order, and negative otherwise.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  integer nvrt

  real ( kind = rk8 ) areapg
  integer i
  real ( kind = rk8 ) sum2
  real ( kind = rk8 ) xc(nvrt)
  real ( kind = rk8 ) yc(nvrt)

  sum2 = xc(1) * ( yc(2) - yc(nvrt) )

  do i = 2, nvrt-1
    sum2 = sum2 + xc(i) * ( yc(i+1) - yc(i-1) )
  end do

  sum2 = sum2 + xc(nvrt) * ( yc(1) - yc(nvrt-1) )

  areapg = sum2

  return
end
function areatr ( xa, ya, xb, yb, xc, yc )

!*****************************************************************************80
!
!! areatr() computes twice the signed area of a triangle.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, real ( kind = rk8 ) XA, YA, XB, YB, XC, YC, the coordinates of the 
!    vertices.
!
!    Output, real ( kind = rk8 ) AREATR, twice the signed area of the triangle.
!    This will be positive if the vertices are listed in counter clockwise 
!    order.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  real ( kind = rk8 ) areatr 
  real ( kind = rk8 ) xa
  real ( kind = rk8 ) xb
  real ( kind = rk8 ) xc
  real ( kind = rk8 ) ya
  real ( kind = rk8 ) yb
  real ( kind = rk8 ) yc

  areatr = ( xb - xa ) * ( yc - ya ) - ( xc - xa ) * ( yb - ya )

  return
end
subroutine bedgmv ( nvc, npolg, nvert, maxvc, h, vcl, hvl, pvl, vstart, vnum, &
  ierror )

!*****************************************************************************80
!
!! bedgmv() generates boundary edge mesh vertices.
!
!  Discussion: 
!
!    Generate mesh vertices on boundary of convex polygons
!    of decomposition with spacing determined by H array.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input/output, integer NVC, the number of coordinates or 
!    positions used in VCL array.
!
!    Input, integer NPOLG, the number of polygons or positions used 
!    in HVL array.
!
!    Input, integer NVERT, the number of vertices or positions 
!    used in PVL array.
!
!    Input, integer MAXVC, the maximum size available for 
!    VCL array.
!
!    Input, real ( kind = rk8 ) H(1:NPOLG), the spacing of mesh vertices for 
!    convex polygons.
!
!    Input/output, real ( kind = rk8 ) VCL(1:2,1:NVC), the vertex coordinate list.
!
!    Input, integer HVL(1:NPOLG, the head vertex list.
!
!    Input, integer PVL(1:4,1:NVERT), the polygon vertex list.
!
!    Output, integer VSTART(1:NVERT), the start location in VCL 
!    for mesh vertices on each edge in PVL if there are any, else 0.
!
!    Output, integer VNUM(1:NVERT), the number of mesh vertices 
!    on interior of each edge in PVL; entry is negated if mesh vertices are 
!    listed in backward order in VCL.
!
!    Output, integer IERROR, is set to 3 on error.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  integer maxvc
  integer npolg
  integer nvert

  real ( kind = rk8 ) dx
  real ( kind = rk8 ) dy
  integer, parameter :: edgv = 4
  real ( kind = rk8 ) h(npolg)
  real ( kind = rk8 ) hh
  integer hvl(npolg)
  integer i
  integer ia
  integer ierror
  integer j
  integer k
  integer l
  real ( kind = rk8 ) leng
  integer, parameter :: loc = 1
  integer m
  integer nvc
  integer, parameter :: polg = 2
  integer pvl(4,nvert)
  integer, parameter :: succ = 3
  integer u
  integer v
  integer vstart(nvert)
  integer vnum(nvert)
  real ( kind = rk8 ) vcl(2,maxvc)
  real ( kind = rk8 ) x
  real ( kind = rk8 ) y

  ierror = 0
  vstart(1:nvert) = -1

  do k = 1, npolg

    i = hvl(k)

    do

      j = pvl(succ,i)

      if ( vstart(i) == -1 ) then

        u = pvl(loc,i)
        v = pvl(loc,j)
        x = vcl(1,u)
        y = vcl(2,u)
        leng = sqrt ( ( vcl(1,v) - x )**2 + ( vcl(2,v) - y )**2 )
        ia = pvl(edgv,i)

        if ( ia <= 0 ) then
          hh = h(k)
        else
          hh = sqrt ( h(k) * h(pvl(polg,ia)) )
        end if

        if ( hh == 0.0D+00 ) then
          write ( *, '(a)' ) ' '
          write ( *, '(a)' ) 'BEDGMV - Fatal error!'
          write ( *, '(a)' ) '  HH = 0.'
          stop
        end if

        l = int ( leng / hh )

        if ( real ( l, kind = rk8 ) / real ( 2 * l + 1, kind = rk8 ) &
          < ( leng / hh ) - real ( l, kind = rk8 ) ) then
          l = l + 1
        end if

        if ( l <= 1 ) then

          vstart(i) = 0
          vnum(i) = 0

        else

          dx = ( vcl(1,v) - x ) / real ( l, kind = rk8 )
          dy = ( vcl(2,v) - y ) / real ( l, kind = rk8 )
          l = l - 1

          if ( maxvc < nvc + l ) then
            write ( *, '(a)' ) ' '
            write ( *, '(a)' ) 'BEDGMV - Fatal error!'
            write ( *, '(a)' ) '  MAXVC < NVC + L.'
            ierror = 3
            return
          end if

          vstart(i) = nvc + 1
          vnum(i) = l

          do m = 1, l
            x = x + dx
            y = y + dy
            nvc = nvc + 1
            vcl(1,nvc) = x
            vcl(2,nvc) = y
          end do

        end if

        if ( 0 < ia ) then
          vstart(ia) = vstart(i)
          vnum(ia) = -vnum(i)
        end if

      end if

      i = j

      if ( i == hvl(k) ) then
        exit
      end if

    end do

  end do

  return
end
subroutine bnsrt2 ( binexp, n, a, map, bin, iwk )

!*****************************************************************************80
!
!! bnsrt2() bin sorts N points in 2D into increasing bin order.
!
!  Discussion: 
!
!    Use a bin sort to obtain the permutation of N 2D
!    points so that points are in increasing bin
!    order, where the N points are assigned to about N**BINEXP bins.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, integer BINEXP, the exponent for the number of bins.
!
!    Input, integer N, the number of points.
!
!    Input, real ( kind = rk8 ) A(2,*), the points to be binned.
!
!    Input/output, integer MAP(N); on input, the points of A with
!    indices MAP(1), MAP(2), ..., MAP(N) are to be sorted.  On output, MAP has
!    been permuted so bin of MAP(1) <= bin of MAP(2) <= ... <= bin of MAP(N).
!
!    Workspace, integer BIN(N), used for bin numbers and permutation of 1 to N.
!
!    Workspace, integer IWK(N), used for copy of MAP array.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  integer n

  real ( kind = rk8 ) a(2,*)
  integer bin(n)
  real ( kind = rk8 ) binexp
  real ( kind = rk8 ) dx
  real ( kind = rk8 ) dy
  integer i
  integer iwk(n)
  integer j
  integer k
  integer l
  integer map(n)
  integer nside
  real ( kind = rk8 ) xmax
  real ( kind = rk8 ) xmin
  real ( kind = rk8 ) ymax
  real ( kind = rk8 ) ymin

  nside = int ( real ( n, kind = rk8 )**( binexp / 2.0D+00 ) + 0.5D+00 )

  if ( nside <= 1 ) then
    return
  end if

  xmin = a(1,map(1))
  ymin = a(2,map(1))
  xmax = xmin
  ymax = ymin
  do i = 2, n
    j = map(i)
    xmin = min ( xmin, a(1,j) )
    xmax = max ( xmax, a(1,j) )
    ymin = min ( ymin, a(2,j) )
    ymax = max ( ymax, a(2,j) )
  end do

  dx = 1.0001D+00 * ( xmax - xmin ) / real ( nside, kind = rk8 )
  dy = 1.0001D+00 * ( ymax - ymin ) / real ( nside, kind = rk8 )

  if ( dx == 0.0D+00 ) then
    dx = 1.0D+00
  end if

  if ( dy == 0.0D+00 ) then
    dy = 1.0D+00
  end if

  do i = 1, n
    j = map(i)
    iwk(i) = j
    map(i) = i
    k = int ( ( a(1,j) - xmin ) / dx )
    l = int ( ( a(2,j) - ymin ) / dy )
    if ( mod ( k, 2 ) == 0 ) then
      bin(i) = k * nside + l
    else
      bin(i) = ( k + 1 ) * nside - l - 1
    end if
  end do

  call ihpsrt ( 1, n, 1, bin, map )

  bin(1:n) = map(1:n)

  do i = 1, n
    map(i) = iwk(bin(i))
  end do

  return
end
function cmcirc ( x0, y0, x1, y1, x2, y2, x3, y3 )

!*****************************************************************************80
!
!! cmcirc() determines whether a point lies within a circle through 3 points.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, real ( kind = rk8 ) X0, Y0, the coordinates of the point to
!    be tested.
!
!    Input, real ( kind = rk8 ) X1, Y1, X2, Y2, X3, Y3, the coordinates of
!    three points that define a circle.
!
!    Output, integer CMCIRC, reports the test results:
!     2, if the three vertices are collinear,
!     1, if (X0,Y0) is inside the circle,
!     0, if (X0,Y0) is on the circle,
!    -1, if (X0,Y0) is outside the circle.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  real ( kind = rk8 ) a11
  real ( kind = rk8 ) a12
  real ( kind = rk8 ) a21
  real ( kind = rk8 ) a22
  real ( kind = rk8 ) b1
  real ( kind = rk8 ) b2
  integer cmcirc
  real ( kind = rk8 ) det
  real ( kind = rk8 ) diff
  real ( kind = rk8 ) rsq
  real ( kind = rk8 ) tol
  real ( kind = rk8 ) tolabs
  real ( kind = rk8 ) xc
  real ( kind = rk8 ) yc
  real ( kind = rk8 ) x0
  real ( kind = rk8 ) x1
  real ( kind = rk8 ) x2
  real ( kind = rk8 ) x3
  real ( kind = rk8 ) y0
  real ( kind = rk8 ) y1
  real ( kind = rk8 ) y2
  real ( kind = rk8 ) y3

  tol = 100.0D+00 * epsilon ( tol )
  cmcirc = 2
  a11 = x2 - x1
  a12 = y2 - y1
  a21 = x3 - x1
  a22 = y3 - y1
  tolabs = tol * max ( abs ( a11), abs ( a12), abs ( a21), abs ( a22) )
  det = a11 * a22 - a21 * a12

  if ( abs ( det ) <= tolabs ) then
    return
  end if

  b1 = a11 * a11 + a12 * a12
  b2 = a21 * a21 + a22 * a22
  det = 2.0D+00 * det
  xc = ( b1 * a22 - b2 * a12 ) / det
  yc = ( b2 * a11 - b1 * a21 ) / det
  rsq = xc * xc + yc * yc
  diff = ( ( x0 - x1 - xc)**2 + ( y0 - y1 - yc )**2 ) - rsq
  tolabs = tol * rsq

  if ( diff < - tolabs ) then
    cmcirc = 1
  else if ( tolabs < diff ) then
    cmcirc = -1
  else
    cmcirc = 0
  end if

  return
end
subroutine cvdec2 ( angspc, angtol, nvc, npolg, nvert, maxvc, maxhv, &
  maxpv, maxiw, maxwk, vcl, regnum, hvl, pvl, iang, iwk, wk, ierror )

!*****************************************************************************80
!
!! cvdec2() decomposes a polygonal region into convex polygons.
!
!  Discussion: 
!
!    Decompose general polygonal region (which is decomposed
!    into simple polygons on input) into convex polygons using
!    vertex coordinate list, head vertex list, and polygon vertex
!    list data structures.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, real ( kind = rk8 ) ANGSPC, the angle spacing parameter in radians 
!    used in controlling vertices to be considered as an endpoint of a
!    separator.
!
!    Input, real ( kind = rk8 ) ANGTOL, the angle tolerance parameter in radians 
!    used in accepting separator(s).
!
!    Input/output, integer NVC, the number of vertex coordinates 
!    or positions used in VCL.
!
!    Input/output, integer NPOLG, the number of polygonal 
!    subregions or positions used in HVL array.
!
!    Input/output, integer NVERT, the number of polygon vertices 
!    or positions used in PVL array.
!
!    Input, integer MAXVC, the maximum size available for VCL 
!    array, should be greater than or equal to the number of vertex coordinates
!    required for decomposition.
!
!    Input, integer MAXHV, the maximum size available for HVL, 
!    REGNUM arrays, should be greater than or equal to the number of polygons 
!    required for decomposition.
!
!    Input, integer MAXPV, the maximum size available for PVL, 
!    IANG arrays; should be greater than or equal to the number of polygon 
!    vertices required for decomposition.
!
!    Input, integer MAXIW, the maximum size available for IWK 
!    array; should be about 3 times maximum number of vertices in any polygon.
!
!    Input, integer MAXWK, the maximum size available for WK 
!    array; should be about 5 times maximum number of vertices in any polygon.
!
!    Input/output, real ( kind = rk8 ) VCL(1:2,1:NVC), the vertex coordinate list.
!
!    Input/output, integer REGNUM(1:NPOLG), region numbers.
!
!    Input/output, integer HVL(1:NPOLG), the head vertex list.
!
!    Input/output, integer PVL(1:4,1:NVERT), real ( kind = rk8 ) 
!    IANG(1:NVERT), the polygon vertex list and interior angles; see routine 
!    DSPGDC for more details.  Note that the data structures should be as 
!    output from routine SPDEC2.
!
!    Workspace, integer IWK(1:MAXIW).
!
!    Workspace, real ( kind = rk8 ) WK(1:MAXWK).
!
!    Output, integer IERROR, error flag.  For abnormal return,
!    IERROR is set to 3, 4, 5, 6, 7, 206, 207, 208, 209, 210, or 212.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  integer maxhv
  integer maxiw
  integer maxpv
  integer maxvc
  integer maxwk

  real ( kind = rk8 ) angspc
  real ( kind = rk8 ) angtol
  integer hvl(maxhv)
  real ( kind = rk8 ) iang(maxpv)
  integer ierror
  integer iwk(maxiw)
  integer npolg
  integer nvc
  integer nvert
  real ( kind = rk8 ), parameter :: pi = 3.141592653589793D+00
  real ( kind = rk8 ) piptol
  integer pvl(4,maxpv)
  integer regnum(maxhv)
  real ( kind = rk8 ) tol
  integer v
  real ( kind = rk8 ) vcl(2,maxvc)
  integer w1
  integer w2
  real ( kind = rk8 ) wk(maxwk)

  ierror = 0
  tol = 100.0D+00 * epsilon ( tol )
!
!  For each reflex vertex, resolve it with one or two separators
!  and update VCL, HVL, PVL, IANG.
!
  piptol = pi + tol
  v = 1

  do

    if ( nvert < v ) then
      exit
    end if

    if ( piptol < iang(v) ) then

      call resvrt ( v, angspc, angtol, nvc, nvert, maxvc, maxpv, maxiw, &
        maxwk, vcl, pvl, iang, w1, w2, iwk, wk, ierror )

      if ( ierror /= 0 ) then
        return
      end if

      call insed2 ( v ,w1, npolg, nvert, maxhv, maxpv, vcl, regnum, hvl, &
        pvl, iang, ierror )

      if ( ierror /= 0 ) then
        return
      end if

      if ( 0 < w2 ) then
        call insed2 ( v, w2, npolg, nvert, maxhv, maxpv, vcl, regnum, hvl, &
          pvl, iang, ierror )
      end if

      if ( ierror /= 0 ) then
        return
      end if

    end if

    v = v + 1

  end do

  return
end
subroutine cvdtri ( inter, ldv, nt, vcl, til, tedg, sptr, ierror )

!*****************************************************************************80
!
!! cvdtri() converts boundary triangles to Delaunay triangles.
!
!  Discussion: 
!
!    Convert triangles in strip near boundary of polygon
!    or inside polygon to Delaunay triangles.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, logical INTER, is .TRUE. if and only if there is at least 
!    one interior mesh vertex.
!
!    Input, integer LDV, the leading dimension of VCL in calling 
!    routine.
!
!    Input, integer NT, the number of triangles in strip or 
!    polygon.
!
!    Input, VCL(1:2,1:*), the vertex coordinate list.
!
!    Input/output, integer TIL(1:3,1:NT), the triangle incidence
!    list.
!
!    Input/output, integer TEDG(1:3,1:NT) - TEDG(J,I) refers to 
!    edge with vertices TIL(J:J+1,I) and contains index of merge edge or
!    a value greater than NT for edge of chains.
!
!    Workspace, SPTR(1:NT) - SPTR(I) = -1 if merge edge I is not in LOP stack,
!    else greater than or equal to 0 and pointer (index of SPTR) to next 
!    edge in stack (0 indicates bottom of stack).
!
!    Output, integer IERROR, error flag.  On abnormal return:
!    IERROR is set to 231.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  integer ldv
  integer nt

  integer e
  integer ierror
  integer ind(2)
  logical inter
  integer itr(2)
  integer k
  integer mxtr
  logical sflag
  integer sptr(nt)
  integer tedg(3,nt)
  integer til(3,nt)
  integer top
  real ( kind = rk8 ) vcl(ldv,*)

  ierror = 0
  sflag = .true.
  sptr(1:nt) = -1

  do k = 1, nt

    mxtr = k + 1

    if ( k == nt ) then
      if ( .not. inter ) then
        return
      end if
      mxtr = nt
      sflag = .false.
    end if

    top = k
    sptr(k) = 0

    do

      e = top
      top = sptr(e)

      call fndtri ( e, mxtr, sflag, tedg, itr, ind, ierror )

      if ( ierror /= 0 ) then
        return
      end if

      call lop ( itr, ind, k, top, ldv, vcl, til, tedg, sptr )

      if ( top <= 0 ) then
        exit
      end if

    end do

  end do

  return
end
function degrees_to_radians ( angle )

!*****************************************************************************80
!
!! degrees_to_radians() converts an angle from degrees to radians.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    John Burkardt
!
!  Parameters:
!
!    Input, real ( kind = rk8 ) ANGLE, an angle in degrees.
!
!    Output, real ( kind = rk8 ) DEGREES_TO_RADIANS, the equivalent angle
!    in radians.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  real ( kind = rk8 ) angle
  real ( kind = rk8 ) degrees_to_radians
  real ( kind = rk8 ), parameter :: pi = 3.141592653589793D+00

  degrees_to_radians = ( angle / 180.0D+00 ) * pi

  return
end
subroutine delaunay_print ( num_pts, xc, num_tri, nodtri, tnbr )

!*****************************************************************************80
!
!! delaunay_print() prints out information defining a Delaunay triangulation.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    John Burkardt
!
!  Parameters:
!
!    Input, integer NUM_PTS, the number of points.
!
!    Input, real ( kind = rk8 ) XC(2,NUM_PTS), the point coordinates.
!
!    Input, integer NUM_TRI, the number of triangles.
!
!    Input, integer NODTRI(3,NUM_TRI), the nodes that make up 
!    the triangles.
!
!    Input, integer TNBR(3,NUM_TRI), the triangle neighbors on 
!    each side.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  integer num_pts
  integer num_tri

  integer i
  integer i4_wrap
  integer j
  integer k
  integer n1
  integer n2
  integer nodtri(3,num_tri)
  integer s
  integer t
  integer tnbr(3,num_tri)
  real ( kind = rk8 ) xc(2,num_pts)

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) 'DELAUNAY_PRINT'
  write ( *, '(a)' ) '  Information defining a Delaunay triangulation.'
  write ( *, '(a)' ) ' '
  write ( *, '(a,i6)' ) '  The number of points is ', num_pts

  call r8mat_print ( num_pts, num_pts, 2, transpose ( xc ), &
    '  Point coordinates (transpose of internal array)' )

  write ( *, '(a)' ) ' '
  write ( *, '(a,i6)' ) '  The number of triangles is ', num_tri
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  Sets of three points are used as vertices of'
  write ( *, '(a)' ) '  the triangles.  For each triangle, the points'
  write ( *, '(a)' ) '  are listed in counterclockwise order.'

  call i4mat_print ( num_tri, num_tri, 3, transpose ( nodtri ), &
    '  Nodes that make up triangles (transpose of internal array)' )

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  On each side of a given triangle, there is either'
  write ( *, '(a)' ) '  another triangle, or a piece of the convex hull.'
  write ( *, '(a)' ) '  For each triangle, we list the indices of the three'
  write ( *, '(a)' ) '  neighbors, or (if negative) the codes of the'
  write ( *, '(a)' ) '  segments of the convex hull.'

  call i4mat_print ( num_tri, num_tri, 3, transpose ( tnbr ), &
    '  Indices of neighboring triangles (transpose of internal array)' )

  write ( *, '(a)' ) ' '
  write ( *, '(a,i6)' ) '  The number of boundary points (and segments) is ', &
    2 * num_pts - num_tri - 2

  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  The segments that make up the convex hull can be'
  write ( *, '(a)' ) '  determined from the negative entries of the triangle'
  write ( *, '(a)' ) '  neighbor list.'
  write ( *, '(a)' ) ' '
  write ( *, '(a)' ) '  # Tri Side  N1  N2'
  write ( *, '(a)' ) ' '
  k = 0

  do i = 1, num_tri
    do j = 1, 3
      if ( tnbr(j,i) < 0 ) then
        s = - tnbr(j,i)
        t = s / 3
        s = mod ( s, 3 ) + 1
        k = k + 1
        n1 = nodtri(s,t)
        n2 = nodtri(i4_wrap(s+1,1,3),t)
        write ( *, '(5i4)' ) k, t, s, n1, n2
      end if
    end do
  end do

  return
end
subroutine dhpsrt ( k, n, lda, a, map )

!*****************************************************************************80
!
!! dhpsrt() sorts points into lexicographic order using heap sort
!
!  Discussion:
!
!    This routine uses heapsort to obtain the permutation of N K-dimensional
!    points so that the points are in lexicographic increasing order.
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Parameters:
!
!    Input, integer K, the dimension of the points (for instance, 2
!    for points in the plane).
!
!    Input, integer N, the number of points.
!
!    Input, integer LDA, the leading dimension of array A in the 
!    calling routine; LDA should be at least K.
!
!    Input, real ( kind = rk8 ) A(LDA,N); A(I,J) contains the I-th coordinate
!    of point J.
!
!    Input/output, integer MAP(N).
!    On input, the points of A with indices MAP(1), MAP(2), ...,
!    MAP(N) are to be sorted.
!
!    On output, MAP contains a permutation of its input values, with the
!    property that, lexicographically,
!      A(*,MAP(1)) <= A(*,MAP(2)) <= ... <= A(*,MAP(N)).
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  integer lda
  integer n

  real ( kind = rk8 ) a(lda,*)
  integer i
  integer k
  integer map(n)

  do i = n / 2, 1, -1
    call dsftdw ( i, n, k, lda, a, map )
  end do

  do i = n, 2, -1
    call i4_swap ( map(1), map(i) )
    call dsftdw ( 1, i-1, k, lda, a, map )
  end do

  return
end
function diaedg ( x0, y0, x1, y1, x2, y2, x3, y3 )

!*****************************************************************************80
!
!! diaedg() triangulates 4 points using the circumcircle criterion.
!
!  Diagram:
!
!    3---2      3---2
!    |\  |      |  /|
!    | \ |  or  | / |
!    |  \|      |/  |
!    0---1      0---1
!
!  Discussion:
!
!    Given four points, to be organized into two triangles, the routine
!    chooses 0--2 or 1--3 as the diagonal edge, based on the circumcircle
!    criterion.  
!
!    The points may be regarded as the vertices of a simple quadrilateral,
!    and should be listed in counterclockwise order.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, real ( kind = rk8 ) X0, Y0, X1, Y1, X2, Y2, X3, Y3, the points.
!
!    Output, integer DIAEDG, chooses a diagonal:
!    +1, choose edge 0--2;
!    -1, choose edge 1--3;
!     0, the four vertices are essentially cocircular.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  real ( kind = rk8 ) ca
  real ( kind = rk8 ) cb
  integer diaedg
  real ( kind = rk8 ) dx10
  real ( kind = rk8 ) dx12
  real ( kind = rk8 ) dx30
  real ( kind = rk8 ) dx32
  real ( kind = rk8 ) dy10
  real ( kind = rk8 ) dy12
  real ( kind = rk8 ) dy30
  real ( kind = rk8 ) dy32
  real ( kind = rk8 ) s
  real ( kind = rk8 ) tol
  real ( kind = rk8 ) tola
  real ( kind = rk8 ) tolb
  real ( kind = rk8 ) x0
  real ( kind = rk8 ) x1
  real ( kind = rk8 ) x2
  real ( kind = rk8 ) x3
  real ( kind = rk8 ) y0
  real ( kind = rk8 ) y1
  real ( kind = rk8 ) y2
  real ( kind = rk8 ) y3

  tol = 100.0D+00 * epsilon ( tol )

  dx10 = x1 - x0
  dy10 = y1 - y0
  dx12 = x1 - x2
  dy12 = y1 - y2
  dx30 = x3 - x0
  dy30 = y3 - y0
  dx32 = x3 - x2
  dy32 = y3 - y2

  tola = tol * max ( abs ( dx10 ), abs ( dy10 ), abs ( dx30 ), abs ( dy30 ) )
  tolb = tol * max ( abs ( dx12 ), abs ( dy12 ), abs ( dx32 ), abs ( dy32 ) )

  ca = dx10 * dx30 + dy10 * dy30
  cb = dx12 * dx32 + dy12 * dy32
!
!  If both angles 301 and 123 are acute, choose 1-3 as the edge.
!
  if ( tola < ca .and. tolb < cb ) then

    diaedg = -1
!
!  If both angles 301 and 123 are obtuse, choose 0-2 as the edge.
!
  else if ( ca < -tola .and. cb < -tolb ) then

    diaedg = 1
 
  else

    tola = max ( tola, tolb )
    s = ( dx10 * dy30 - dx30 * dy10 ) * cb + ( dx32 * dy12 - dx12 * dy32 ) * ca

    if ( tola < s ) then
      diaedg = -1
    else if ( s < -tola ) then
      diaedg = 1
    else
      diaedg = 0
    end if

  end if

  return
end
subroutine diam2 ( nvrt, xc, yc, i1, i2, diamsq, ierror )

!*****************************************************************************80
!
!! diam2() finds the diameter of a convex polygon.
!
!  Discussion: 
!
!    Find the diameter of a convex polygon with vertices
!    given in counter clockwise order and with all interior angles < PI.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, integer NVRT, the number of vertices.
!
!    Input, real ( kind = rk8 ) XC(NVRT),YC(NVRT), the vertex coordinates in 
!    counter-clockwise order.
!
!    Output, integer I1, I2 , indices in XC, YC of the diameter 
!    edge; the diameter is from (XC(I1),YC(I1)) to (XC(I2),YC(I2)).
!
!    Output, real ( kind = rk8 ) DIAMSQ, the square of the diameter.
!
!    Output, integer IERROR, an error flag.
!    0, no error was detected.
!    200, an error was detected.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  integer nvrt

  real ( kind = rk8 ) area1
  real ( kind = rk8 ) area2
  real ( kind = rk8 ) areatr
  real ( kind = rk8 ) c1mtol
  real ( kind = rk8 ) c1ptol
  real ( kind = rk8 ) diamsq
  real ( kind = rk8 ) dist
  integer i1
  integer i2
  integer ierror
  integer j
  integer jp1
  integer k
  integer kp1
  integer m
  real ( kind = rk8 ) tol
  real ( kind = rk8 ) xc(nvrt)
  real ( kind = rk8 ) yc(nvrt)
!
  ierror = 0
  tol = 100.0D+00 * epsilon ( tol )
!
!  Find the first vertex which is farthest from the edge connecting
!  vertices with indices NVRT, 1.
!
  c1mtol = 1.0D+00 - tol
  c1ptol = 1.0D+00 + tol
  j = nvrt
  jp1 = 1
  k = 2
  area1 = areatr ( xc(j), yc(j), xc(jp1), yc(jp1), xc(k), yc(k) )

  do

    area2 = areatr ( xc(j), yc(j), xc(jp1), yc(jp1), xc(k+1), yc(k+1) )

    if ( area2 <= area1 * c1ptol ) then
      exit
    end if

    area1 = area2
    k = k + 1

  end do

  m = k
  diamsq = 0.0D+00
!
!  Find diameter = maximum distance of antipodal pairs.
!
  area1 = areatr ( xc(j), yc(j), xc(jp1), yc(jp1), xc(k), yc(k) )

  do

    kp1 = k + 1
    if ( nvrt < kp1 ) then
      kp1 = 1
    end if

    area2 = areatr ( xc(j), yc(j), xc(jp1), yc(jp1), xc(kp1), yc(kp1) )

    if ( area1 * c1ptol < area2 ) then
      k = k + 1
      area1 = area2
    else if ( area2 < area1 * c1mtol ) then
      j = jp1
      jp1 = j + 1
      area1 = areatr ( xc(j), yc(j), xc(jp1), yc(jp1), xc(k), yc(k) )
    else
      k = k + 1
      j = jp1
      jp1 = j + 1
      area1 = areatr ( xc(j), yc(j), xc(jp1), yc(jp1), xc(k), yc(k) )
    end if

    if ( m < j .or. nvrt < k ) then
      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) 'DIAM2 - Fatal error!'
      write ( *, '(a)' ) '  M < J or NVRT < K.'
      ierror = 200
      return
    end if

    dist = ( xc(j) - xc(k) )**2 + ( yc(j) - yc(k) )**2

    if ( diamsq < dist ) then
      diamsq = dist
      i1 = j
      i2 = k
    end if

    if ( j == m .and. k == nvrt ) then
      exit
    end if

  end do

  return
end
function dless ( k, p, q )

!*****************************************************************************80
!
!! dless() determine whether P is lexicographically less than Q.
!
!  Discussion:
!
!    P and Q are K-dimensional points.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, integer K, the spatial dimension of the points.
!
!    Input, real ( kind = rk8 ) P(K), Q(K), the points to be compared.
!
!    Output, logical RLESS, is TRUE if P < Q, FALSE otherwise.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  integer k

  real ( kind = rk8 ) cmax
  logical dless
  integer i
  real ( kind = rk8 ) p(k)
  real ( kind = rk8 ) q(k)
  real ( kind = rk8 ) tol

  tol = 100.0D+00 * epsilon ( tol )

  do i = 1, k

    cmax = max ( abs ( p(i) ), abs ( q(i) ) )

    if ( tol * cmax < abs ( p(i) - q(i) ) .and. tol < cmax ) then

      if ( p(i) < q(i) ) then
        dless = .true.
      else
        dless = .false.
      end if

      return
    end if

  end do

  dless = .false.

  return
end
subroutine dsftdw ( l, u, k, lda, a, map )

!*****************************************************************************80
!
!! dsftdw() sifts A(*,MAP(L)) down a heap of size U.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, integer L, U, the lower and upper indices of part of 
!    the heap.
!
!    Input, integer K, the spatial dimension of the points.
!
!    Input, integer LDA, the leading dimension of A in the calling
!    routine.
!
!    Input, real ( kind = rk8 ) A(LDA,N); A(I,J) contains the I-th coordinate
!    of point J.
!
!    Input/output, integer MAP(N).
!    On input, the points of A with indices MAP(1), MAP(2), ...,
!    MAP(N) are to be sorted.
!
!    On output, MAP contains a permutation of its input values, with the
!    property that, lexicographically,
!      A(*,MAP(1)) <= A(*,MAP(2)) <= ... <= A(*,MAP(N)).
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  integer lda

  real ( kind = rk8 ) a(lda,*)
  logical dless
  integer i
  integer j
  integer k
  integer l
  integer map(*)
  integer t
  integer u

  i = l
  j = 2 * i
  t = map(i)

  do while ( j <= u )

    if ( j < u ) then
      if ( dless ( k, a(1,map(j)), a(1,map(j+1)) ) ) then
        j = j + 1
      end if
    end if

    if ( dless ( k, a(1,map(j)), a(1,t) ) ) then
      exit
    end if

    map(i) = map(j)
    i = j
    j = 2 * i

  end do

  map(i) = t

  return
end
subroutine dsmcpr ( nhole, nvbc, vcl, maxhv, maxpv, maxho, nvc, npolg, &
  nvert, nhola, regnum, hvl, pvl, iang, holv, ierror )

!*****************************************************************************80
!
!! dsmcpr() initializes the polygonal decomposition data structure.
!
!  Discussion: 
!
!    Initialize the polygonal decomposition data structure
!    given a multiply-connected polygonal region with 1 outer
!    boundary curve and 0 or more inner boundary curves of holes.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, integer NHOLE, the number of holes in the region.
!
!    Input, integer NVBC(1:NHOLE+1), the number of vertices per 
!    boundary curve; first boundary curve is the outer boundary of the region.
!
!    Input, real ( kind = rk8 ) VCL(1:2,1:NVC), the vertex coordinates of 
!    boundary curves in counter clockwise order; 
!    NVC = NVBC(1) + ... + NVBC(NHOLE+1); 
!    positions 1 to NVBC(1) of VCL contain the vertex coordinates of the
!    outer boundary in counter clockwise order; positions NVBC(1)+1 to
!    NVBC(1)+NVBC(2) contain the vertex coordinates of the
!    first hole boundary in counter clockwise order, etc.
!
!    Input, integer MAXHV, the maximum size available for HVL, 
!    REGNUM arrays, should be greater than or equal to NHOLE + 1.
!
!    Input, integer MAXPV, the maximum size available for PVL, 
!    IANG arrays; should be greater than or equal to NVC.
!
!    Input, integer MAXHO, the maximum size available for HOLV 
!    array; should be greater than or equal to NHOLE*2.
!
!    Output, integer NVC, the number of vertex coordinates,
!    set to sum of NVBC(I).
!
!    Output, integer NPOLG, the number of polygonal subregions, 
!    set to 1.  For consistency with DSPGDC.
!
!    Output, integer NVERT, the number of vertices in PVL, set to
!    NVC.  For consistency with DSPGDC.
!
!    Output, integer NHOLA, number of attached holes, set to 0.
!    For consistency with DSPGDC.
!
!    Output, integer REGNUM(1:1), region number of only subregion,
!    set to 1.  For consistency with DSPGDC.
!
!    Output, integer HVL(1:NHOLE+1), the head vertex list; first 
!    entry is the head vertex (index in PVL) of outer boundary curve; next
!    NHOLE entries contain the head vertex of a hole.
!
!    Output, integer PVL(1:4,1:NVC), IANG(1:NVC), the polygon 
!    vertex list and interior angles; vertices of outer boundary curve are in 
!    counter clockwise order followed by vertices of each hole in CW hole; 
!    vertices of each polygon are in a circular linked list; see
!    routine DSPGDC for more details of this data structure.
!
!    Output, integer HOLV(1:NHOLE*2), the indices in PVL of top 
!    and bottom vertices of holes; first (last) NHOLE entries are for top
!    (bottom) vertices; top (bottom) vertices are sorted in decreasing
!    (increasing) lexicographic (y,x) order of coordinates.
!
!    Output, integer IERROR, error flag.
!    For abnormal return, IERROR is set to 2, 4, or 5.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  integer maxho
  integer maxpv
  integer nhole

  real ( kind = rk8 ) angle
  integer, parameter :: edgv = 4
  integer i
  real ( kind = rk8 ) iang(maxpv)
  integer ierror
  integer iv
  integer ivs
  integer j
  integer, parameter :: loc = 1
  integer lv
  integer lvp
  integer lvs
  integer maxhv
  integer nhola
  integer npolg
  integer nv
  integer nvc
  integer nvert
  integer nvs
  integer hvl(nhole+1)
  integer holv(maxho)
  integer nvbc(nhole+1)
  integer, parameter :: polg = 2
  integer pvl(4,maxpv)
  integer regnum(1)
  integer, parameter :: succ = 3
  real ( kind = rk8 ) vcl(2,*)

  ierror = 0
  nvc = sum ( nvbc(1:nhole+1) )
  npolg = 1
  nvert = nvc
  nhola = 0
  regnum(1) = 1

  if ( maxhv < nhole + 1 ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'DSMCPR - Fatal error!'
    write ( *, '(a)' ) '  MAXHV < NHOLE + 1.'
    ierror = 4
    return
  end if

  if ( maxpv < nvc ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'DSMCPR - Fatal error!'
    write ( *, '(a)' ) '  MAXPV < NVC.'
    ierror = 5
    return
  end if

  if ( maxho < 2 * nhole ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'DSMCPR - Fatal error!'
    write ( *, '(a)' ) '  MAXHO < 2 * NHOLE.'
    ierror = 2
    return
  end if
!
!  Initialize the HVL and PVL arrays.
!
  hvl(1) = 1
  nv = nvbc(1)

  do i = 1, nv
    pvl(loc,i) = i
    pvl(polg,i) = 1
    pvl(succ,i) = i + 1
    pvl(edgv,i) = 0
  end do

  pvl(succ,nv) = 1

  do j = 1, nhole
    hvl(j+1) = nv + 1
    nvs = nv + nvbc(j+1)
    do i = nv+1, nvs
      pvl(loc,i) = i
      pvl(polg,i) = 1
      pvl(succ,i) = i - 1
      pvl(edgv,i) = 0
    end do
    pvl(succ,nv+1) = nvs
    nv = nvs
  end do
!
!  Initialize the IANG array.
!
  do i = 1, nhole+1

    j = hvl(i)
    lvp = pvl(loc,j)
    iv = pvl(succ,j)
    lv = pvl(loc,iv)

    do

      ivs = pvl(succ,iv)
      lvs = pvl(loc,ivs)
      iang(iv) = angle ( vcl(1,lvp), vcl(2,lvp), vcl(1,lv), vcl(2,lv), &
        vcl(1,lvs), vcl(2,lvs) )

      if ( iv == j ) then
        exit
      end if

      lvp = lv
      iv = ivs
      lv = lvs

    end do

  end do
!
!  Initialize the HOLV array.
!
  if ( 0 < nhole ) then
    call holvrt ( nhole, vcl, hvl(2), pvl, holv )
  end if

  return
end
subroutine dsmdf2 ( hflag, nvc, npolg, maxwk, vcl, hvl, pvl, iang, ivrt, &
  xivrt, widsq, edgval, vrtval, area, wk, ierror )

!*****************************************************************************80
!
!! dsmdf2() sets up a data structure for a heuristic mesh distribution.
!
!  Discussion: 
!
!    Set up the data structure for heuristic mesh distribution
!    function from data structure for convex polygon decomposition
!    if HFLAG is .TRUE., else set up only IVRT and XIVRT.
!
!    Also compute areas of convex polygons.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, logical HFLAG, set to .TRUE. if data structure is to be constructed,
!    .FALSE. if only IVRT, XIVRT, AREA are to be computed.
!
!    Input, integer NVC, the number of vertex coordinates in VCL 
!    array.
!
!    Input, integer NPOLG, the number of polygonal subregions in 
!    HVL array.
!
!    Input, integer MAXWK, the maximum size available for WK 
!    array; should be 2 times maximum number of vertices in any polygon.
!
!    Input, VCL(1:2,1:NVC), the vertex coordinate list.
!
!    Input, integer HVL(1:NPOLG), the head vertex list.
!
!    Input, integer PVL(1:4,1:*), real ( kind = rk8 ) IANG(1:*), the 
!    polygon vertex list, interior angles.
!
!    Output, integer IVRT(1:*), the indices of polygon vertices in
!    VCL, ordered by polygon; same size as PVL.  For heuristic MDF data
!    structure.
!
!    Output, XIVRT(1:NPOLG+1), the pointer to first vertex of each polygon
!    in IVRT; vertices of polygon K are IVRT(I) for I from
!    XIVRT(K) to XIVRT(K+1)-1.  For heuristic MDF data structure.
!
!    Output, real ( kind = rk8 ) WIDSQ(1:NPOLG), the square of width of convex 
!    polygons.  For heuristic MDF data structure.
!
!    Output, real ( kind = rk8 ) EDGVAL(1:*), the value associated with each 
!    edge of decomposition; same size as PVL.  For heuristic MDF data structure.
!
!    Output, real ( kind = rk8 ) VRTVAL(1:NVC), the value associated with each 
!    vertex of decomposition.  For heuristic MDF data structure.
!
!    Output, real ( kind = rk8 ) AREA(1:NPOLG), the area of convex polygons.
!
!    Workspace, real ( kind = rk8 ) WK(1:MAXWK).
!
!    Output, integer IERROR, error flag.  On abnormal return,
!    IERROR is set to 7 or 201.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  integer maxwk
  integer npolg
  integer nvc

  real ( kind = rk8 ) area(npolg)
  real ( kind = rk8 ) areapg
  integer, parameter :: edgv = 4
  real ( kind = rk8 ) edgval(*)
  logical hflag
  integer hvl(npolg)
  integer i
  real ( kind = rk8 ) iang(*)
  integer ierror
  integer il
  integer ivrt(*)
  integer j
  integer jl
  integer k
  integer l
  integer, parameter :: loc = 1
  integer m
  integer nvrt
  real ( kind = rk8 ), parameter :: pi = 3.141592653589793D+00
  real ( kind = rk8 ) pimtol
  integer, parameter :: polg = 2
  integer pvl(4,*)
  real ( kind = rk8 ) s
  integer, parameter :: succ = 3
  real ( kind = rk8 ) tol
  real ( kind = rk8 ) vcl(2,nvc)
  real ( kind = rk8 ) vrtval(nvc)
  real ( kind = rk8 ) widsq(npolg)
  real ( kind = rk8 ) wk(maxwk)
  integer xc
  integer xivrt(npolg+1)
  integer yc

  ierror = 0
  tol = 100.0D+00 * epsilon ( tol )
!
!  Compute area and square of width of polygons.
!
  pimtol = pi - tol

  do k = 1, npolg

    nvrt = 0
    i = hvl(k)

    do

      if ( iang(i) < pimtol ) then
        nvrt = nvrt + 1
      end if

      i = pvl(succ,i)

      if ( i == hvl(k) ) then
        exit
      end if

    end do

    if ( maxwk < 2 * nvrt ) then
      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) 'DSMDF2 - Fatal error!'
      write ( *, '(a)' ) '  MAXWK < 2 * NVRT.'
      write ( *, '(a,i6)' ) '  NVRT = ', nvrt
      write ( *, '(a,i6)' ) '  MAXWK = ', maxwk
      ierror = 7
      return
    end if

    xc = 0

    do

      if ( iang(i) < pimtol ) then
        j = pvl(loc,i)
        xc = xc + 1
        wk(xc) = vcl(1,j)
        wk(xc+nvrt) = vcl(2,j)
      end if

      i = pvl(succ,i)

      if ( i == hvl(k) ) then
        exit
      end if

    end do

    xc = 1
    yc = xc + nvrt
    area(k) = areapg ( nvrt, wk(xc), wk(yc) ) * 0.5D+00

    if ( hflag ) then

      call width2 ( nvrt, wk(xc), wk(yc), i, j, widsq(k), ierror )

      if ( ierror /= 0 ) then
        write ( *, '(a)' ) ' '
        write ( *, '(a)' ) 'DSMDF2 - Fatal error!'
        write ( *, '(a)' ) '  WIDTH2 returns an error condition.'
        return
      end if

    end if

  end do
!
!  Set up IVRT, XIVRT, EDGVAL, VRTVAL arrays.
!
  l = 1

  do k = 1, npolg

    xivrt(k) = l
    i = hvl(k)
    il = pvl(loc,i)

    do

      ivrt(l) = il
      j = pvl(succ,i)
      jl = pvl(loc,j)

      if ( hflag ) then

        s = min ( (vcl(1,jl) - vcl(1,il) )**2 + ( vcl(2,jl) - vcl(2,il) )**2, &
          widsq(k) )

        m = pvl(edgv,i)
        if ( 0 < m ) then
          s = min ( s, widsq(pvl(polg,m) ) )
        end if

        edgval(l) = s

      end if

      l = l + 1
      i = j
      il = jl

      if ( i == hvl(k) ) then
        exit
      end if

    end do

  end do

  xivrt(npolg+1) = l

  if ( .not. hflag ) then
    return
  end if

  vrtval(1:nvc) = 0.0D+00

  do k = 1, npolg

    j = xivrt(k+1) - 1
    l = j

    do i = xivrt(k),l

      il = ivrt(i)

      if ( vrtval(il) == 0.0D+00 ) then
        vrtval(il) = min ( edgval(i), edgval(j) )
      else
        vrtval(il) = min ( vrtval(il), edgval(i), edgval(j) )
      end if

      j = i

    end do

  end do

  return
end
subroutine dspgdc ( nvc, vcl, incr, ncur, nvbc, icur, ivrt, maxhv, maxpv,  &
  maxho, npolg, nvert, nhole, nhola, regnum, hvl, pvl, iang, holv, htsiz,  &
  maxedg, ht, edge, map, ierror )

!*****************************************************************************80
!
!! dspgdc() initializes the polygonal decomposition data structure.
!
!  Discussion: 
!
!    Initialize the polygonal decomposition data structure
!    given an initial decomposition of a polygonal region which
!    may have holes and/or cut, separator, and hole interfaces.
!    Holes and hole interfaces must be simple polygons.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, integer NVC, the number of distinct vertex coordinates in region.
!
!    Input, real ( kind = rk8 ) VCL(1:2,1:NVC), the vertex coordinates of 
!    boundary curves in arbitrary order.
!
!    Input, integer INCR, a positive integer greater than or equal to NVC, 
!    e.g. 10000, added to some elements of IVRT array.
!
!    Input, integer NCUR, the number of boundary curves (includes outer boundary
!    curves of subregions and boundary curves of holes
!    and hole interfaces).
!
!    Input, integer NVBC(1:NCUR), the number of vertices per boundary curve.
!
!    Input, integer ICUR(1:NCUR), indicates type and location of the curves:
!    ICUR(I) = 0 if Ith curve is outer boundary curve,
!    ICUR(I) = K if Ith curve is a hole and is inside
!      the subregion to the left of Kth curve,
!    ICUR(I) = -K if Ith curve is a hole interface and is
!      inside the subregion to the left of Kth curve.
!    K must be the index of an outer or hole interface
!    boundary curve (hole interfaces may be nested).
!    If the Ith curve is inside more than one subregion
!    due to nesting of hole interfaces, then the subregion
!    to the left of Kth curve must be the smallest
!    subregion containing the Ith curve.
!
!    Input, integer IVRT(1:NV), indices in VCL of vertices of boundary curves;
!    NV = NVBC(1) + ... + NVBC(NCUR); the vertices of each
!    boundary curve must be in counter clockwise order; the first NVBC(1)
!    positions of IVRT are used for the first curve; the
!    next NVBC(2) positions are used for second curve, etc.
!    If the Ith curve is the outer boundary of a subregion
!    determined from cut and separator interfaces, then the
!    elements of IVRT which correspond to this curve are used
!    both for an index in VCL and indicating the type of the
!    edge joining a vertex and its successor as follows.
!    Let J be in range of positions used for the Ith curve
!    and K be the index in VCL of the coordinates of a vertex
!    of the Ith curve. Consider the edge originating from this
!    vertex. IVRT(J) = -K if the edge is part of a cut or
!    separator interface (i.e. there is a subregion to right
!    of edge). IVRT(J) = K if the edge is part of the outer
!    boundary of the region (i.e. the unbounded exterior of
!    the region is to the right of edge). IVRT(J) = K + INCR
!    if the edge is part of the boundary of a hole (i.e.
!    there is a bounded area to the right of edge which is
!    not in the region. If the Ith curve is the boundary of
!    a hole or hole interface, then only IVRT(J) = K is used.
!
!    Input, integer MAXHV, the maximum size available for HVL, REGNUM arrays, 
!    should be greater than or equal to NCUR + (number of hole interfaces).
!
!    Input, integer MAXPV, the maximum size available for PVL, IANG arrays; 
!    should be greater than or equal to NVERT (see below).
!
!    Input, integer MAXHO, the maximum size available for HOLV array; should be
!    greater than or equal to NHOLE*2 + NHOLA (see below).
!
!    Input, integer HTSIZ, the size of hash table HT; should be a prime number 
!    which is about NSC/2 where NSC is number of separator and cut
!    interface edges.
!
!    Input, integer MAXEDG, the maximum size available for EDGE array; should 
!    be at least NSC.
!
!    Output, integer NPOLG, the number of polygonal subregions, set to number 
!    of outer subregion boundaries plus number of hole interfaces.
!
!    Output, integer NVERT, the number of vertices in PVL, set to NV plus number
!    of vertices in holes and hole interfaces (< 2*NV).
!
!    Output, integer NHOLE, the number of holes and hole interfaces.
!
!    Output, integer NHOLA, the number of 'attached' holes; these holes are 
!    attached to the outer boundary of a subregion through vertices
!    or cut interfaces and have their edges in consecutive
!    order on the boundary (<= NV/4).
!
!    Output, integer REGNUM(1:NPOLG). region numbers to left of outer and hole
!    interface boundary curves, which are set to the indices
!    of ICUR or NVBC; this array may be useful in some
!    applications for identifying which original region a
!    subpolygon belongs to.
!
!    Output, HVL(1:NPOLG+NHOLE), the head vertex list; the first NPOLG
!    positions contain the head vertex (index in PVL) of an
!    outer or hole interface boundary curve in which the
!    vertices of the curve are in counter clockwise order in PVL; next
!    NHOLE positions contain the head vertex of a hole or
!    hole interface in which vertices are in CW order in PVL.
!
!    Output, PVL(1:4,1:NVERT), real ( kind = rk8 ) IANG(1:NVERT), the polygon 
!    vertex list and interior angles; contains the 5 'arrays' LOC, POLG, SUCC
!    EDGV, IANG (the first 4 are integer arrays, the last
!    is a real array); the vertices of each
!    polygon (except for holes) are stored in counter clockwise order in a
!    circular linked list. PVL(LOC,V) is the location in VCL
!    of the coordinates of 'vertex' (index) V. IANG(V) is
!    the interior angle at vertex V. PVL(POLG,V) is polygon
!    number (index of HVL) of subregion containing vertex V
!    (this entry is different from the polygon index only
!    for holes). PVL(SUCC,V) is index in PVL of successor
!    vertex of vertex V. PVL(EDGV,V) gives information about
!    the edge joining vertices V and its successor - if the
!    edge is part of 1 polygon then PVL(EDGV,V) = 0; if the
!    edge is common to 2 polygons then 0 < PVL(EDGV,V) and
!    is equal to the index in PVL of the successor vertex
!    as represented in the other polygon; i.e. in latter
!    case, PVL(LOC,PVL(EDGV,V)) = PVL(LOC,PVL(SUCC,V)) and
!    PVL(EDGV,PVL(EDGV,V)) = V.
!
!    Output, integer HOLV(1:NHOLE*2+NHOLA), indices in PVL of top or bottom 
!    vertex of holes; first (next) NHOLE entries are for top (bottom)
!    vertices of holes and hole interfaces, with top (bottom)
!    vertices sorted in decreasing (increasing) lexicographic
!    (y,x) order of coord; last NHOLA entries are for attached
!    holes; if bottom vertex of attached hole is a simple
!    vertex of boundary curve containing the hole then entry
!    contains index of bottom vertex otherwise entry contains
!    index of top vertex (which is simple).
!
!    Workspace, integer MAP(1:NCUR), used for mapping input boundary curve 
!    numbers to polygon numbers.
!
!    Workspace, HT(0:HTSIZ-1), EDGE(1:4,1:MAXEDG) - hash table and edge records
!    used to determine matching occurrences of separator or
!    cut interface edges by calling routine EDGHT.
!
!    Output, integer IERROR, error flag.  On abnormal return,
!    IERROR is set to 1, 2, 4, 5, 215, or 216.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  integer htsiz
  integer maxedg
  integer maxho
  integer maxhv
  integer maxpv
  integer ncur

  real ( kind = rk8 ) angle
  integer edge(4,maxedg)
  integer, parameter :: edgv = 4
  logical first
  integer hdfree
  integer holv(maxho)
  integer ht(0:htsiz-1)
  integer hvl(maxhv)
  integer i
  real ( kind = rk8 ) iang(maxpv)
  integer icur(ncur)
  integer ierror
  integer incr
  integer ipoly
  integer iv
  integer ivrt(*)
  integer ivs
  integer j
  integer j1
  integer j2
  integer jend
  integer jstr
  integer k
  integer kmax
  integer kmin
  integer kpoly
  integer l
  integer last
  integer, parameter :: loc = 1
  integer lv
  integer lvp
  integer lvs
  integer map(ncur)
  integer mpoly
  integer nh2
  integer nhola
  integer nhole
  integer nholi
  integer nht
  integer npolg
  integer nv
  integer nvbc(ncur)
  integer nvc
  integer nvert
  integer, parameter :: polg = 2
  integer pvl(4,maxpv)
  integer regnum(maxhv)
  integer, parameter :: succ = 3
  real ( kind = rk8 ) vcl(2,nvc)
  real ( kind = rk8 ) x
  real ( kind = rk8 ) xmax
  real ( kind = rk8 ) xmin
  real ( kind = rk8 ) y
  real ( kind = rk8 ) ymax
  real ( kind = rk8 ) ymin

  ierror = 0
  nhola = 0
  nhole = 0
  nholi = 0
  nvert = 0

  do i = 1, ncur

    nvert = nvert + nvbc(i)

    if ( 0 < icur(i) ) then
      nhole = nhole + 1
    else if ( icur(i) < 0 ) then
      nholi = nholi + 1
      nvert = nvert + nvbc(i)
    end if

  end do

  npolg = ncur - nhole
  ipoly = 0
  iv = 0
  nv = 0
  hdfree = 0
  last = 0
  nht = 0

  ht(0:htsiz-1) = 0

  if ( maxhv < ncur + nholi ) then
    ierror = 4
    return
  else if ( maxpv < nvert ) then
    ierror = 5
    return
  else if ( maxho < ( nhole + nholi ) * 2 ) then
    ierror = 2
    return
  end if
!
!  Initialize REGNUM, HVL, PVL arrays for outer boundary curves.
!
  do i = 1, ncur

    if ( icur(i) /= 0 ) then
      map(i) = 0
      nv = nv + nvbc(i)
      cycle
    end if

    ipoly = ipoly + 1
    regnum(ipoly) = i
    hvl(ipoly) = iv + 1
    map(i) = ipoly
    jstr = nv + 1
    jend = nv + nvbc(i)

    do j = jstr, jend

      iv = iv + 1
      pvl(loc,iv) = abs ( ivrt(j) )
      pvl(polg,iv) = ipoly
      pvl(succ,iv) = iv + 1

      if ( 0 < ivrt(j) ) then
        pvl(edgv,iv) = 0
      else
!
!  The edge originating from current vertex is on a cut or
!  separator interface. Search in hash table for edge, and
!  insert or delete edge.  Set EDGV value if possible.
!
         lv = abs ( ivrt(j) )
         if ( incr < lv ) then
           lv = lv - incr
         end if

         if ( j < jend ) then
           lvs = abs ( ivrt(j+1) )
         else
           lvs = abs ( ivrt(jstr) )
         end if

         if ( incr < lvs ) then
           lvs = lvs - incr
         end if

         call edght ( lv, lvs, iv, nvc, htsiz, maxedg, hdfree, last, ht, &
           edge, ivs, ierror )

         if ( ierror /= 0 ) then
           return
         end if

         if ( 0 < ivs ) then
           pvl(edgv,iv) = ivs
           pvl(edgv,ivs) = iv
           nht = nht - 1
         else
           nht = nht + 1
         end if

       end if

     end do

     pvl(succ,iv) = hvl(ipoly)

     nv = nv + nvbc(i)

  end do

  if ( nht /= 0 ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'DSPGDC - Fatal error!'
    write ( *, '(a)' ) '  NHT /= 0.'
    ierror = 215
    return
  end if
!
!  Initialize REGNUM, HVL, PVL arrays for the hole interfaces.
!
  if ( nholi == 0 ) then
    go to 100
  end if

  do i = 1, ncur

    if ( icur(i) < 0 ) then
      ipoly = ipoly + 1
      map(i) = ipoly
    end if

  end do

  nv = 0

  do i = 1, ncur

    if ( icur(i) < 0 ) then

      ipoly = ipoly + 1
      kpoly = ipoly - nholi
      mpoly = map(-icur(i))
      regnum(kpoly) = i
      hvl(kpoly) = iv + 1
      hvl(ipoly) = iv + 2
      jstr = nv + 1
      jend = nv + nvbc(i)

      do j = jstr, jend
        iv = iv + 2
        pvl(loc,iv-1) = ivrt(j)
        pvl(polg,iv-1) = kpoly
        pvl(succ,iv-1) = iv + 1
        pvl(edgv,iv-1) = iv + 2
        pvl(loc,iv) = ivrt(j)
        pvl(polg,iv) = mpoly
        pvl(succ,iv) = iv - 2
        pvl(edgv,iv) = iv - 3
      end do

      pvl(succ,iv-1) = hvl(kpoly)
      pvl(edgv,iv-1) = hvl(ipoly)
      pvl(succ,hvl(ipoly)) = iv
      pvl(edgv,hvl(ipoly)) = iv - 1

    end if

    nv = nv + nvbc(i)
   
  end do
!
!  Initialize HVL, PVL arrays for the ordinary holes.
!
100 continue

  if ( nhole /= 0 ) then

    nv = 0

    do i = 1, ncur

      if ( 0 < icur(i) ) then

        ipoly = ipoly + 1
        mpoly = map(icur(i))
        hvl(ipoly) = iv + 1
        jstr = nv + 1
        jend = nv + nvbc(i)

        do j = jstr, jend
          iv = iv + 1
          pvl(loc,iv) = ivrt(j)
          pvl(polg,iv) = mpoly
          pvl(succ,iv) = iv - 1
          pvl(edgv,iv) = 0
        end do

        pvl(succ,hvl(ipoly)) = iv

      end if

      nv = nv + nvbc(i)

    end do

  end if
!
!  Determine bottom or top simple vertex of attached holes.
!
  nhole = nhole + nholi
  nh2 = nhole + nhole
  j1 = 0
  j2 = 0

  do i = 1, npolg-nholi

   j = hvl(i)

  150    continue

      if ( incr < pvl(loc,j) ) then
         j = pvl(succ,j)
         if ( j /= hvl(i) ) then
          go to 150
         else
          ierror = 216
          return
         end if
      end if

   first = .true.

  160    continue

      lv = pvl(loc,j)

      if ( 0 < j1 ) then
        if ( lv <= incr ) then
          j2 = j
        else if ( lv - incr == lvs ) then
          j2 = j
        else
          pvl(loc,j) = lv - incr
        end if
      else if ( incr < lv ) then
        j1 = j
        lvs = lv - incr
        pvl(loc,j) = lvs
      end if

      if ( 0 < j2 ) then
!
!  (Part of) hole starts at vertex J1 and ends at J2.
!
         if ( lv <= incr .and. lv /= lvs ) then
           go to 180
         end if

         k = j1

  170          continue

          if ( k == j1 ) then
            kmin = k
            kmax = k
            xmin = vcl(1,lvs)
            ymin = vcl(2,lvs)
            xmax = xmin
            ymax = ymin

          else

            l = pvl(loc,k)
            x = vcl(1,l)
            y = vcl(2,l)

            if ( y < ymin .or. y == ymin .and. x < xmin ) then
              kmin = k
              xmin = x
              ymin = y
            else if ( ymax < y .or. y == ymax .and. xmax < x ) then
              kmax = k
              xmax = x
              ymax = y
            end if

          end if

          k = pvl(succ,k)
         if ( k /= j2 ) then
           go to 170
         end if

         if ( kmin == j1 ) then
           kmin = kmax
         end if

         nhola = nhola + 1

         if ( maxho < nh2 + nhola ) then
          ierror = 2
          return
         end if

         holv(nh2+nhola) = kmin

180      continue

         j1 = 0
         j2 = 0

         if ( incr < lv ) then
           j1 = j
           pvl(loc,j) = lvs
         end if

      end if
      j = pvl(succ,j)

   if ( first ) then
     first = .false.
     jend = j
     go to 160
   else if ( j /= jend ) then
     go to 160
   end if

  end do
!
!  Initialize the IANG array.
!
  do i = 1, npolg+nhole

    j = hvl(i)
    lvp = pvl(loc,j)
    iv = pvl(succ,j)
    lv = pvl(loc,iv)

    do

      ivs = pvl(succ,iv)
      lvs = pvl(loc,ivs)
      iang(iv) = angle ( vcl(1,lvp), vcl(2,lvp), vcl(1,lv), vcl(2,lv), &
        vcl(1,lvs), vcl(2,lvs) )

      if ( iv == j ) then
        exit
      end if

      lvp = lv
      iv = ivs
      lv = lvs

    end do

  end do
!
!  Initialize HOLV array.
!
  if ( 0 < nhole ) then
    call holvrt ( nhole, vcl, hvl(npolg+1), pvl, holv )
  end if

  return
end
subroutine dtris2 ( npt, vcl, ind, ntri, til, tnbr, ierror )

!*****************************************************************************80
!
!! dtris2() constructs a Delaunay triangulation of 2D vertices.
!
!  Discussion:
!
!    The routine constructs the Delaunay triangulation of a set of 2D vertices
!    using an incremental approach and diagonal edge swaps.  Vertices are
!    first sorted in lexicographically increasing (X,Y) order, and
!    then are inserted one at a time from outside the convex hull.
!
!    Note that DTRIS2 or RTRIS2, the fundamental routine for constructing
!    the Delaunay triangulation, alters the input coordinate data by
!    sorting it.  This has caused me so many problems that I finally 
!    wrote a modified version of DTRIS2/RTRIS2 that undoes the sorting
!    before return.  In all other programs that use DTRIS2/RTRIS2, I
!    use the modified version, but I have left the original here in this
!    package.
!
!    On abnormal return, IERROR is set to 8, 224, or 225.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, integer NPT, the number of vertices.
!
!    Input, real ( kind = rk8 ) VCL(2,NPT), the coordinates of the vertices.
!
!    Input/output, integer IND(NPT), the indices in VCL of the vertices 
!    to be triangulated.  On output, IND has been permuted by the sort.
!
!    Output, integer NTRI, the number of triangles in the triangulation; 
!    NTRI is equal to 2*NPT - NB - 2, where NB is the number of boundary 
!    vertices.
!
!    Output, integer TIL(3,NTRI), the nodes that make up each triangle.
!    The elements are indices of VCL.  The vertices of the triangles are 
!    in counter clockwise order.
!
!    Output, integer TNBR(3,NTRI), the triangle neighbor list.
!    Positive elements are indices of TIL; negative elements are used for links
!    of a counter clockwise linked list of boundary edges; LINK = -(3*I + J-1)
!    where I, J = triangle, edge index; TNBR(J,I) refers to
!    the neighbor along edge from vertex J to J+1 (mod 3).
!
!    Output, integer IERROR, an error flag, nonzero if an error occurred.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  integer npt

  real ( kind = rk8 ) cmax
  integer e
  integer i
  integer ierror
  integer ind(npt)
  integer j
  integer k
  integer l
  integer ledg
  integer lr
  integer lrline
  integer ltri
  integer m
  integer m1
  integer m2
  integer maxst
  integer, parameter :: msglvl = 0
  integer n
  integer ntri
  integer redg
  integer rtri
  integer stack(npt)
  integer t
  integer til(3,npt*2)
  integer tnbr(3,npt*2)
  real ( kind = rk8 ) tol
  integer top
  real ( kind = rk8 ) vcl(2,npt)

  maxst = npt

  ierror = 0
  tol = 100.0D+00 * epsilon ( tol )

  ierror = 0
!
!  Sort the vertices.
!
  call dhpsrt ( 2, npt, 2, vcl, ind )
!
!  Ensure that no two consecutive points are too close.
!
  m1 = ind(1)

  do i = 2, npt

    m = m1
    m1 = ind(i)

    k = 0
    do j = 1, 2

      cmax = max ( abs ( vcl(j,m) ), abs ( vcl(j,m1) ) )

      if ( tol * cmax < abs ( vcl(j,m) - vcl(j,m1) ) .and. tol < cmax ) then
        k = j
        exit
      end if

    end do

    if ( k == 0 ) then
      ierror = 224
      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) 'DTRIS2 - Fatal error!'
      write ( *, '(a)' ) '  Consecutive points are too close.'
      return
    end if

  end do
!
!  Take the first two points, M1 and M2, and find a suitable non-collinear
!  third, M.  All points between M2 and M are very close to collinear
!  with M1 and M2.
!
  m1 = ind(1)
  m2 = ind(2)
  j = 3

  do

    if ( npt < j ) then
      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) 'DTRIS2 - Fatal error!'
      write ( *, '(a)' ) '  Could not find a noncollinear third point.'
      ierror = 225
      return
    end if

    m = ind(j)
    lr = lrline ( vcl(1,m), vcl(2,m), vcl(1,m1), vcl(2,m1), vcl(1,m2), &
      vcl(2,m2), 0.0D+00 )

    if ( lr /= 0 ) then
      exit
    end if

    j = j + 1
  
  end do

  ntri = j - 2
!
!  Depending on the orientation of M1, M2, and M, set up the initial
!  triangle data.
!
  if ( lr == -1 ) then

    til(1,1) = m1
    til(2,1) = m2
    til(3,1) = m
    tnbr(3,1) = -3

    do i = 2, ntri

      m1 = m2
      m2 = ind(i+1)
      til(1,i) = m1
      til(2,i) = m2
      til(3,i) = m
      tnbr(1,i-1) = -3 * i
      tnbr(2,i-1) = i
      tnbr(3,i) = i - 1

    end do

    tnbr(1,ntri) = -3 * ntri - 1
    tnbr(2,ntri) = -5
    ledg = 2
    ltri = ntri

  else

    til(1,1) = m2
    til(2,1) = m1
    til(3,1) = m
    tnbr(1,1) = -4

    do i = 2, ntri
      m1 = m2
      m2 = ind(i+1)
      til(1,i) = m2
      til(2,i) = m1
      til(3,i) = m
      tnbr(3,i-1) = i
      tnbr(1,i) = -3 * i - 3
      tnbr(2,i) = i - 1
    end do

    tnbr(3,ntri) = -3 * ntri
    tnbr(2,1) = -3 * ntri - 2
    ledg = 2
    ltri = 1

  end if

  if ( msglvl == 4 ) then

    m2 = ind(1)
    write ( *, '(i7,4f15.7)' ) 1,vcl(1,m2),vcl(2,m2),vcl(1,m),vcl(2,m)

    do i = 2, j-1
      m1 = m2
      m2 = ind(i)
      write ( *, '(i7,4f15.7)' ) 1,vcl(1,m1),vcl(2,m1),vcl(1,m2),vcl(2,m2)
      write ( *, '(i7,4f15.7)' ) 1,vcl(1,m2),vcl(2,m2),vcl(1,m),vcl(2,m)
    end do

  end if
!
!  Insert vertices one at a time from outside the convex hull, determine
!  the visible boundary edges, and apply diagonal edge swaps until
!  the Delaunay triangulation of the vertices (so far) is obtained.
!
  top = 0

  do i = j+1, npt

    if ( msglvl == 4 ) then
      write ( *, '(a)' ) ' '
      write ( *, '(i7)' ) i
    end if

    m = ind(i)
    m1 = til(ledg,ltri)

    if ( ledg <= 2 ) then
      m2 = til(ledg+1,ltri)
    else
      m2 = til(1,ltri)
    end if

    lr = lrline ( vcl(1,m), vcl(2,m), vcl(1,m1), vcl(2,m1), vcl(1,m2), &
      vcl(2,m2), 0.0D+00 )

    if ( 0 < lr ) then
      rtri = ltri
      redg = ledg
      ltri = 0
    else
      l = -tnbr(ledg,ltri)
      rtri = l / 3
      redg = mod ( l, 3 ) + 1
    end if

    call vbedg ( vcl(1,m), vcl(2,m), vcl, til, tnbr, ltri, ledg, rtri, redg )

    n = ntri + 1
    l = -tnbr(ledg,ltri)

    do

      t = l / 3
      e = mod ( l, 3 ) + 1
      l = -tnbr(e,t)
      m2 = til(e,t)

      if ( e <= 2 ) then
        m1 = til(e+1,t)
      else
        m1 = til(1,t)
      end if

      ntri = ntri + 1
      tnbr(e,t) = ntri
      til(1,ntri) = m1
      til(2,ntri) = m2
      til(3,ntri) = m
      tnbr(1,ntri) = t
      tnbr(2,ntri) = ntri - 1
      tnbr(3,ntri) = ntri + 1
      top = top + 1

      if ( maxst < top ) then
        write ( *, '(a)' ) ' '
        write ( *, '(a)' ) 'DTRIS2 - Fatal error!'
        write ( *, '(a)' ) '  Ran out of stack space.'
        write ( *, '(a,i6)' ) '  MAXST = ', maxst
        write ( *, '(a,i6)' ) '  TOP =   ', top
        ierror = 8
        return
      end if

      stack(top) = ntri

      if ( msglvl == 4 ) then
        write ( *, '(i7,4f15.7)' ) 1,vcl(1,m),vcl(2,m),vcl(1,m2),vcl(2,m2)
      end if

      if ( t == rtri .and. e == redg ) then
        exit
      end if

    end do

    if ( msglvl == 4 ) then
      write ( *, '(i7,4f15.7)' ) 1,vcl(1,m),vcl(2,m),vcl(1,m1),vcl(2,m1)
    end if

    tnbr(ledg,ltri) = -3 * n - 1
    tnbr(2,n) = -3 * ntri - 2
    tnbr(3,ntri) = -l
    ltri = n
    ledg = 2

    call swapec ( m, top, maxst, ltri, ledg, vcl, til, tnbr, stack, ierror )

    if ( ierror /= 0 ) then
      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) 'DTRIS2 - Fatal error!'
      write ( *, '(a,i6)' ) '  SWAPEC returned IERROR = ', ierror
      return
    end if

  end do

  if ( msglvl == 4 ) then
    write ( *, '(i7)' ) npt + 1
  end if

  return
end
subroutine dtriw2 ( npt, maxst, vcl, ind, ntri, til, tnbr, stack, ierror )

!*****************************************************************************80
!
!! dtriw2() constructs an incremental Delaunay triangulation in 2D.
!
!  Discussion: 
!
!    Construct the Delaunay triangulation of 2D vertices using
!    incremental approach and diagonal edge swaps. Vertices are
!    inserted one at a time in order given by IND array. The initial
!    triangles created due to a new vertex are obtained by a walk
!    through the triangulation until location of vertex is known.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, integer NPT, the number of 2D points (vertices).
!
!    Input, integer MAXST, the maximum size available for STACK array; should 
!    be about NPT to be safe, but MAX(10,2*LOG2(NPT)) usually enough.
!
!    Input, real ( kind = rk8 ) VCL(1:2,1:*), the coordinates of 2D vertices.
!
!    Input, integer IND(1:NPT), indices in VCL of vertices to be triangulated;
!    vertices are inserted in order given by this array.
!
!    Output, integer NTRI, the number of triangles in triangulation; equal to
!    2*NPT - NB - 2 where NB = number of boundary vertices.
!
!    Output, integer TIL(1:3,1:NTRI), the triangle incidence list; elements 
!    are indices of VCL; vertices of triangles are in counter clockwise order.
!
!    Output, integer TNBR(1:3,1:NTRI), the triangle neighbor list; positive 
!    elements are indices of TIL; negative elements are used for links
!    of counter clockwise linked list of boundary edges; LINK = -(3*I + J-1)
!    where I, J = triangle, edge index; TNBR(J,I) refers to
!    the neighbor along edge from vertex J to J+1 (mod 3).
!
!    Workspace, integer STACK(1:MAXST), used for stack of triangles for which
!    circumcircle test must be made.
!
!    Output, integer IERROR, error flag. For abnormal return,
!    IERROR is set to 8, 224, 225, or 226.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  integer maxst
  integer npt

  integer bedg
  integer btri
  real ( kind = rk8 ) cmax
  integer e
  integer em1
  integer ep1
  integer ntri
  integer i
  integer i3
  integer ierror
  integer ind(npt)
  integer j
  integer l
  integer ledg
  integer lr
  integer lrline
  integer ltri
  integer m
  integer m1
  integer m2
  integer m3
  integer, parameter :: msglvl = 0
  integer n
  integer redg
  integer rtri
  integer stack(maxst)
  integer t
  integer til(3,npt*2)
  integer tnbr(3,npt*2)
  integer top
  real ( kind = rk8 ) tol
  real ( kind = rk8 ) vcl(2,*)

  ierror = 0
  tol = 100.0D+00 * epsilon ( tol )
!
!  Determine the initial triangle.
!
  m1 = ind(1)
  m2 = ind(2)

  do j = 1, 2
    cmax = max ( abs ( vcl(j,m1) ), abs ( vcl(j,m2) ) )
    if ( tol * cmax < abs ( vcl(j,m1) - vcl(j,m2) ) .and. tol < cmax ) then
      go to 20
    end if
  end do

  ierror = 224
  return

20 continue

  i3 = 3

30 continue

  if ( npt < i3 ) then
    ierror = 225
    return
  end if

  m = ind(i3)
  lr = lrline ( vcl(1,m), vcl(2,m), vcl(1,m1), vcl(2,m1), vcl(1,m2), &
    vcl(2,m2), 0.0D+00 )

  if ( lr == 0 ) then
    i3 = i3 + 1
    go to 30
  end if

  if ( i3 /= 3 ) then
    ind(i3) = ind(3)
    ind(3) = m
  end if

  ntri = 1

  if ( lr == -1 ) then
    til(1,1) = m1
    til(2,1) = m2
  else
    til(1,1) = m2
    til(2,1) = m1
  end if

  til(3,1) = m
  tnbr(1,1) = -4
  tnbr(2,1) = -5
  tnbr(3,1) = -3

  if ( msglvl == 4 ) then
    write ( *,600) 1,vcl(1,m1),vcl(2,m1),vcl(1,m2),vcl(2,m2)
    write ( *,600) 1,vcl(1,m2),vcl(2,m2),vcl(1,m),vcl(2,m)
    write ( *,600) 1,vcl(1,m),vcl(2,m),vcl(1,m1),vcl(2,m1)
  end if
!
!  Insert vertices one at a time from anywhere.
!  Walk through the triangulation to determine the location of the new vertex.
!  Apply diagonal edge swaps until Delaunay triangulation of vertices
!  (so far) is obtained.
!
  top = 0

  do i = 4, npt

    if ( msglvl == 4 ) then
      write ( *,600) i
    end if

    m = ind(i)
    rtri = ntri

    call walkt2 ( vcl(1,m), vcl(2,m), ntri, vcl, til, tnbr, rtri, redg, ierror )

    if ( redg == 0 ) then

      m1 = til(1,rtri)
      m2 = til(2,rtri)
      m3 = til(3,rtri)
      til(3,rtri) = m

      if ( 0 < tnbr(1,rtri) ) then
        top = 1
        stack(top) = rtri
      end if

      ntri = ntri + 1
      til(1,ntri) = m2
      til(2,ntri) = m3
      til(3,ntri) = m
      n = tnbr(2,rtri)
      tnbr(1,ntri) = n

      if ( 0 < n ) then
        if ( tnbr(1,n) == rtri ) then
          tnbr(1,n) = ntri
        else if ( tnbr(2,n) == rtri ) then
          tnbr(2,n) = ntri
        else
          tnbr(3,n) = ntri
        end if
        top = top + 1
        stack(top) = ntri
      end if

      ntri = ntri + 1
      til(1,ntri) = m3
      til(2,ntri) = m1
      til(3,ntri) = m
      n = tnbr(3,rtri)
      tnbr(1,ntri) = n

      if ( 0 < n ) then
        if ( tnbr(1,n) == rtri ) then
          tnbr(1,n) = ntri
        else if ( tnbr(2,n) == rtri ) then
          tnbr(2,n) = ntri
        else
          tnbr(3,n) = ntri
        end if
        top = top + 1
        stack(top) = ntri
      end if

      tnbr(2,rtri) = ntri - 1
      tnbr(3,rtri) = ntri
      tnbr(2,ntri-1) = ntri
      tnbr(3,ntri-1) = rtri
      tnbr(2,ntri) = rtri
      tnbr(3,ntri) = ntri - 1

      if ( tnbr(1,ntri-1) <= 0 ) then

        t = rtri
        e = 1

        do

          if ( tnbr(e,t) <= 0 ) then
            exit
          end if

          t = tnbr(e,t)

          if ( til(1,t) == m2 ) then
            e = 3
          else if ( til(2,t) == m2 ) then
            e = 1
          else
            e = 2
          end if

        end do

        tnbr(e,t) = -3 * ntri + 3

      end if

      if ( tnbr(1,ntri) <= 0 ) then

        t = ntri - 1
        e = 1

        do

          if ( tnbr(e,t) <= 0 ) then
            exit
          end if

          t = tnbr(e,t)
          if ( til(1,t) == m3 ) then
            e = 3
          else if ( til(2,t) == m3 ) then
            e = 1
          else
            e = 2
          end if

        end do

        tnbr(e,t) = -3 * ntri

      end if

      if ( msglvl == 4 ) then
        write ( *,600) 1,vcl(1,m),vcl(2,m),vcl(1,m1),vcl(2,m1)
        write ( *,600) 1,vcl(1,m),vcl(2,m),vcl(1,m2),vcl(2,m2)
        write ( *,600) 1,vcl(1,m),vcl(2,m),vcl(1,m3),vcl(2,m3)
      end if

   else if ( redg < 0 ) then

      redg = -redg
      ltri = 0
      call vbedg ( vcl(1,m), vcl(2,m), vcl, til, tnbr, ltri, ledg, rtri, redg )
      n = ntri + 1
      l = -tnbr(ledg,ltri)

60    continue

         t = l / 3
         e = mod ( l, 3 ) + 1
         l = -tnbr(e,t)
         m2 = til(e,t)

         if ( e <= 2 ) then
           m1 = til(e+1,t)
         else
           m1 = til(1,t)
         end if

         ntri = ntri + 1
         tnbr(e,t) = ntri
         til(1,ntri) = m1
         til(2,ntri) = m2
         til(3,ntri) = m
         tnbr(1,ntri) = t
         tnbr(2,ntri) = ntri - 1
         tnbr(3,ntri) = ntri + 1
         top = top + 1

         if ( maxst < top ) then
           ierror = 8
           go to 100
         end if
 
        stack(top) = ntri

         if ( msglvl == 4 ) then
           write (*,600) 1,vcl(1,m),vcl(2,m),vcl(1,m2),vcl(2,m2)
         end if

      if ( t /= rtri .or. e /= redg ) then
        go to 60
      end if

      if ( msglvl == 4 ) then
        write (*,600) 1,vcl(1,m),vcl(2,m),vcl(1,m1),vcl(2,m1)
      end if

      tnbr(ledg,ltri) = -3*n - 1
      tnbr(2,n) = -3*ntri - 2
      tnbr(3,ntri) = -l

   else if ( redg <= 3 ) then

      m1 = til(redg,rtri)

      if ( redg == 1 ) then
        e = 2
        ep1 = 3
      else if ( redg == 2 ) then
        e = 3
        ep1 = 1
      else
        e = 1
        ep1 = 2
      end if

      m2 = til(e,rtri)
      til(e,rtri) = m
      m3 = til(ep1,rtri)

      if ( 0 < tnbr(ep1,rtri) ) then
        top = 1
        stack(top) = rtri
      end if

      ntri = ntri + 1
      til(1,ntri) = m
      til(2,ntri) = m2
      til(3,ntri) = m3
      n = tnbr(e,rtri)
      tnbr(2,ntri) = n
      tnbr(3,ntri) = rtri
      tnbr(e,rtri) = ntri

      if ( 0 < n ) then
        if ( tnbr(1,n) == rtri ) then
          tnbr(1,n) = ntri
        else if ( tnbr(2,n) == rtri ) then
          tnbr(2,n) = ntri
        else
          tnbr(3,n) = ntri
        end if
        top = top + 1
        stack(top) = ntri
      end if

      if ( msglvl == 4 ) then
        write ( *,600) 1,vcl(1,m),vcl(2,m),vcl(1,m3),vcl(2,m3)
      end if

      ltri = tnbr(redg,rtri)

      if ( ltri <= 0 ) then
        tnbr(1,ntri) = ltri
        tnbr(redg,rtri) = -3*ntri
        if ( tnbr(2,ntri) <= 0 ) then
          tnbr(1,ntri) = -3*ntri - 1
        end if

      else

        tnbr(1,ntri) = ntri + 1
        tnbr(redg,rtri) = ltri

        if ( til(1,ltri) == m2 ) then
          ledg = 1
          em1 = 2
          e = 3
        else if ( til(2,ltri) == m2 ) then
          ledg = 2
          em1 = 3
          e = 1
        else
          ledg = 3
          em1 = 1
          e = 2
        end if

        til(ledg,ltri) = m
        m3 = til(e,ltri)
        if ( 0 < tnbr(em1,ltri) ) then
          top = top + 1
          stack(top) = ltri
        end if
        ntri = ntri + 1
        til(1,ntri) = m2
        til(2,ntri) = m
        til(3,ntri) = m3
        tnbr(1,ntri) = ntri - 1
        tnbr(2,ntri) = ltri
        n = tnbr(e,ltri)
        tnbr(3,ntri) = n
        tnbr(e,ltri) = ntri

        if ( 0 < n ) then
          if ( tnbr(1,n) == ltri ) then
            tnbr(1,n) = ntri
          else if ( tnbr(2,n) == ltri ) then
            tnbr(2,n) = ntri
          else
            tnbr(3,n) = ntri
          end if
          top = top + 1
          stack(top) = ntri
        end if

        if ( msglvl == 4 ) then
          write ( *,600) 1,vcl(1,m),vcl(2,m),vcl(1,m3),vcl(2,m3)
        end if

        if ( tnbr(2,ntri-1) <= 0 ) then

          t = ntri
          e = 3

          do

            if ( tnbr(e,t) <= 0 ) then
              exit
            end if

            t = tnbr(e,t)
            if ( til(1,t) == m2 ) then
              e = 3
            else if ( til(2,t) == m2 ) then
              e = 1
            else
              e = 2
            end if

          end do

          tnbr(e,t) = -3 * ntri + 2

        end if

         if ( tnbr(3,ntri) <= 0 ) then

          t = ltri

          if ( ledg <= 2 ) then
             e = ledg + 1
          else
             e = 1
          end if

          do

            if ( tnbr(e,t) <= 0 ) then
              exit
            end if

            t = tnbr(e,t)
            if ( til(1,t) == m3 ) then
              e = 3
            else if ( til(2,t) == m3 ) then
              e = 1
            else
              e = 2
            end if

          end do

          tnbr(e,t) = -3 * ntri - 2

         end if

      end if

    else
      ierror = 224
      go to 100
    end if

    btri = 0
    bedg = 0

    call swapec ( m, top, maxst, btri, bedg, vcl, til, tnbr, stack, ierror )

    if ( ierror /= 0 ) then
      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) 'DTRIW2 - Fatal error!'
      write ( *, '(a,i6)' ) '  SWAPEC returned error flag IERROR = ', ierror
      exit
    end if

  end do

100 continue

  if ( i3 /= 3 ) then
    t = ind(i3)
    ind(i3) = ind(3)
    ind(3) = t
  end if

  if ( msglvl == 4 ) then
    write ( *,600) npt+1
  end if

600 format (1x,i7,4f15.7)

  return
end
subroutine edght ( a, b, v, n, htsiz, maxedg, hdfree, last, ht, edge, w, &
  ierror )

!*****************************************************************************80
!
!! edght() searches a hash table for a record in EDGE containing key (A,B).
!
!  Discussion: 
!
!    Search in hash table HT for record in EDGE containing
!    key (A,B).
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, integer A, B, vertex indices, greater than 0, of edge (also 
!    key of hash table).
!
!    Input, integer V, value associated with edge.
!
!    Input, integer N, upper bound on A, B.
!
!    Input, integer HTSIZ, the size of hash table HT.
!
!    Input, integer MAXEDG, the maximum size available for EDGE array.
!
!    Input/output, integer HDFREE, head pointer to linked list of free entries 
!    of EDGE array due to deletions.  Before first call to this routine, HDFREE
!    should be set to 0.
!
!    Input/output, integer LAST, index of last entry used in EDGE array.  
!    Before first call to this routine, LAST should be set to 0.
!
!    Input/output, integer HT(0:HTSIZ-1), hash table of head pointers (direct 
!    chaining with ordered lists is used).  Before first call to this routine, 
!    entries of HT should be set to 0.  If key with A,B is found then this 
!    record is deleted from hash table, else record is inserted in hash table.
!
!    Input/output, integer EDGE(1:4,1:MAXEDG), entries of hash table records;
!      EDGE(1,I) = MIN(A,B); EDGE(2,I) = MAX(A,B);
!      EDGE(3,I) = V; EDGE(4,I) = link
!    If key with A,B is found then this record is deleted
!    from hash table, else record is inserted in hash table.
!
!    Output, integer W, EDGE(3,INDEX), where INDEX is index of record, if found;
!    else 0.
!
!    Output, integer IERROR, error flag.  For abnormal return,
!    IERROR is set to 1
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  integer htsiz
  integer maxedg

  integer a
  integer aa
  integer b
  integer bb
  integer bptr
  integer edge(4,maxedg)
  integer hdfree
  integer ht(0:htsiz-1)
  integer ierror
  integer k
  integer last
  integer n
  integer newp
  integer ptr
  integer v
  integer w

  ierror = 0

  if ( a < b ) then
    aa = a
    bb = b
  else
    aa = b
    bb = a
  end if

  k = mod ( aa*n + bb, htsiz )
  bptr = -1
  ptr = ht(k)

10 continue

  if ( ptr /= 0 ) then

    if ( aa < edge(1,ptr) ) then

      go to 20

    else if ( edge(1,ptr) == aa ) then

      if ( bb < edge(2,ptr) ) then

        go to 20

      else if ( edge(2,ptr) == bb ) then

        if ( bptr == -1 ) then
          ht(k) = edge(4,ptr)
        else
          edge(4,bptr) = edge(4,ptr)
        end if

        edge(4,ptr) = hdfree
        hdfree = ptr
        w = edge(3,ptr)
        return

      end if

    end if

    bptr = ptr
    ptr = edge(4,ptr)
    go to 10

  end if

20 continue

  if ( 0 < hdfree ) then

    newp = hdfree
    hdfree = edge(4,hdfree)

  else

    last = last + 1
    newp = last

    if ( maxedg < last ) then
      ierror = 1
      return
    end if

  end if

  if ( bptr == -1 ) then
    ht(k) = newp
  else
    edge(4,bptr) = newp
  end if

  edge(1,newp) = aa
  edge(2,newp) = bb
  edge(3,newp) = v
  edge(4,newp) = ptr
  w = 0

  return
end
subroutine eqdis2 ( hflag, umdf, kappa, angspc, angtol, dmin, nmin, ntrid,  &
  nvc, npolg, nvert, maxvc, maxhv, maxpv, maxiw, maxwk, vcl, regnum, hvl,  &
  pvl, iang, area, psi, h, iwk, wk, ierror )

!*****************************************************************************80
!
!! eqdis2() further subdivides convex polygons for mesh equidistribution.
!
!  Discussion: 
!
!    Further subdivide convex polygons so that an approximately
!    equidistributing triangular mesh can be constructed with
!    respect to a heuristic or a user-supplied mesh distribution
!    function (MDF), and determine triangle size for each polygon of
!    decomposition.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, logical HFLAG, is .TRUE. if heuristic mdf, .FALSE. if
!    user-supplied mdf.
!
!    Input, external UMDF, a user-supplied mesh distribution function 
!    of the form:
!      function umdf ( x, y )
!      real ( kind = rk8 ) umdf
!      real ( kind = rk8 ) x
!      real ( kind = rk8 ) y
!
!    Input, real ( kind = rk8 ) KAPPA, the mesh smoothness parameter in 
!    the interval [0.0,1.0].
!
!    Input, real ( kind = rk8 ) ANGSPC, the angle spacing parameter in radians
!    used to determine extra points as possible endpoints of separators.
!
!    Input, real ( kind = rk8 ) ANGTOL, the angle tolerance parameter in radians
!    used in accepting separators.
!
!    Input, real ( kind = rk8 ) DMIN, a parameter used to determine if variation 
!    of mdf in polygon is 'sufficiently high'.
!
!    Input, integer NMIN, a parameter used to determine if 'sufficiently large'
!    number of triangles in polygon.
!
!    Input, integer NTRID, the desired number of triangles in mesh.
!
!    Input/output, integer NVC, the number of vertex coordinates or 
!    positions used in VCL array.
!
!    Input/output, integer NPOLG, the number of polygonal subregions or 
!    positions used in HVL array.
!
!    Input/output, integer NVERT, the number of polygon vertices or positions 
!    used in PVL array.
!
!    Input, integer MAXVC, the maximum size available for VCL array, should 
!    be greater than or equal to the number of vertex coordinates required
!    for decomposition (approximately NVC + 2*NS where NS is expected number 
!    of new separators).
!
!    Input, integer MAXHV, the maximum size available for HVL, REGNUM, AREA, 
!    PSI, H arrays; should be greater than or equal to the number of polygons
!    required for decomposition (approximately NPOLG + NS).
!
!    Input, integer MAXPV, the maximum size available for PVL, IANG arrays; 
!    should be greater than or equal to the number of polygon vertices 
!    required for decomposition (approximately NVERT + 5*NS).
!
!    Input, integer MAXIW, the maximum size available for IWK array; should 
!    be greater than or equal to 
!      MAX(2*NP, NVERT + NPOLG + 3*NVRT + INT(2*PI/ANGSPC))
!    where NVRT is maximum number of vertices in a convex
!    polygon of the (input) decomposition, NP is expected
!    value of NPOLG on output.
!
!    Input, integer MAXWK, the maximum size available for WK array; should
!    be greater than or equal to 
!      NVC + NVERT + 2*NPOLG + 3*(NVRT + INT(2*PI/ANGSPC)).
!
!    Input/output, real ( kind = rk8 ) VCL(1:2,1:NVC), the vertex coordinate list.
!
!    Input/output, integer REGNUM(1:NPOLG), the region numbers.
!
!    Input/output, real ( kind = rk8 ) HVL(1:NPOLG), head vertex list.
!
!    Input/output, integer PVL(1:4,1:NVERT), real ( kind = rk8 ) IANG(1:NVERT), 
!    the polygon vertex list and interior angles; see routine DSPGDC for more 
!    details.  Note that the data structures should be as output from routine
!    CVDEC2.
!
!    Output, real ( kind = rk8 ) AREA(1:NPOLG), the area of convex polygons 
!    in the decomposition.
!
!    Output, real ( kind = rk8 ) PSI(1:NPOLG), the smoothed mean mdf 
!    values in the convex polygons.
!
!    Output, real ( kind = rk8 ) H(1:NPOLG), the triangle size for convex
!    polygons.
!
!    Workspace, integer IWK(1:MAXIW).
!
!    Workspace, real ( kind = rk8 ) WK(1:MAXWK).
!
!    Output, integer IERROR, error flag.  For abnormal return,
!    IERROR is set to 3, 4, 5, 6, 7, 200, 201, or 222.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  integer maxhv
  integer maxiw
  integer maxpv
  integer maxvc
  integer maxwk

  real ( kind = rk8 ) angspc
  real ( kind = rk8 ) angtol
  real ( kind = rk8 ) area(maxhv)
  real ( kind = rk8 ) dmin
  integer edgval
  real ( kind = rk8 ) h(maxhv)
  logical hflag
  integer hvl(maxhv)
  real ( kind = rk8 ) iang(maxpv)
  integer ierror
  integer ivrt
  integer iwk(maxiw)
  real ( kind = rk8 ) kappa
  integer m
  integer n
  integer nmin
  integer npolg
  integer ntrid
  integer nvc
  integer nvert
  real ( kind = rk8 ) psi(maxhv)
  integer pvl(4,maxpv)
  integer regnum(maxhv)
  real ( kind = rk8 ) umdf
  external umdf
  real ( kind = rk8 ) vcl(2,maxvc)
  integer vrtval
  integer widsq
  real ( kind = rk8 ) wk(maxwk)
  integer xivrt

  ierror = 0
  ivrt = 1
  xivrt = ivrt + nvert
  m = xivrt + npolg

  if ( maxiw < m ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'EQDIS2 - Fatal error!'
    write ( *, '(a)' ) '  MAXIW < M'
    ierror = 6
    return
  end if

  widsq = 1

  if ( hflag ) then

    edgval = widsq + npolg
    vrtval = edgval + nvert
    n = npolg + nvert + nvc

    if ( maxwk < n ) then
      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) 'EQDIS2 - Fatal error!'
      write ( *, '(a)' ) '  MAXWK < N'
      ierror = 7
      return
    end if

  else

    edgval = 1
    vrtval = 1
    n = 0

  end if

  call dsmdf2 ( hflag, nvc, npolg, maxwk-n, vcl, hvl, pvl, iang, iwk(ivrt), &
    iwk(xivrt), wk(widsq), wk(edgval), wk(vrtval), area, wk(n+1), ierror )

  if ( ierror /= 0 ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'EQDIS2 - Fatal error!'
    write ( *, '(a)' ) '  DSMDF2 returns error condition.'
    return
  end if

  call mfdec2 ( hflag, umdf, kappa, angspc, angtol, dmin, nmin, ntrid, nvc, &
    npolg, nvert, maxvc, maxhv, maxpv, maxiw-m, maxwk-n, vcl, regnum, hvl, &
    pvl, iang, iwk(ivrt), iwk(xivrt), wk(widsq), wk(edgval), wk(vrtval), &
    area, psi, iwk(m+1), wk(n+1), ierror )

  if ( ierror /= 0 ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'EQDIS2 - Fatal error!'
    write ( *, '(a)' ) '  MFDEC2 returns error condition.'
    return
  end if

  if ( maxiw < 2 * npolg ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'EQDIS2 - Fatal error!'
    write ( *, '(a)' ) '  MAXIW < 2 * NPOLG.'
    ierror = 6
    return
  end if

  call trisiz ( ntrid, npolg, hvl, pvl, area, psi, h, iwk, iwk(npolg+1) )

  return
end
subroutine fndsep ( angac1, xr, yr, nvrt, xc, yc, ivis, theta, nv, iv,  &
  vcl, pvl, iang, angsep, i1, i2, wkang )

!*****************************************************************************80
!
!! fndsep() finds separators to resolve a reflex vertex.
!
!  Discussion: 
!
!    Find 1 or 2 separators which can resolve a reflex vertex
!    (XR,YR) using a max-min angle criterion from list of vertices
!    in increasing polar angle with respect to the reflex vertex.
!
!    Preference is given to 1 separator.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, real ( kind = rk8 ) ANGAC1, the angle tolerance parameter used 
!    for preference in accepting one separator.
!
!    Input, real ( kind = rk8 ) XR, YR, the coordinates of reflex vertex.
!
!    Input, integer NVRT, (number of vertices) - 1.
!
!    Input, real ( kind = rk8 ) XC(0:NVRT), YC(0:NVRT), the vertex coordinates 
!    of possible endpoints of a separator.
!
!    Input, integer IVIS(0:NVRT), contains information about the vertices of
!    XC, YC arrays with respect to the polygon vertex list; if
!    0 < IVIS(I) then vertex (XC(I),YC(I)) has index IVIS(I)
!    in PVL; if IVIS(I) < 0 then vertex (XC(I),YC(I)) is on
!    the edge joining vertices with indices -IVIS(I) and
!    SUCC(-IVIS(I)) in PVL.
!
!    Input, real ( kind = rk8 ) THETA(0:NVRT), the polar angles of vertices 
!    in increasing order; THETA(NVRT) is the interior angle of reflex vertex;
!    THETA(I), 0 <= I, is the polar angle of (XC(I),YC(I))
!    with respect to reflex vertex.
!
!    Input, integer NV, (number of vertices to be considered as endpoint of a
!    separator) - 1.
!
!    Input, integer IV(0:NV), the indices of vertices in XC, YC arrays to be
!    considered as endpoint of a separator; angle between
!    consecutive vertices is assumed to be < 180 degrees.
!
!    Input, real ( kind = rk8 ) VCL(1:2,1:*), the vertex coordinate list.
!
!    Input, integer PVL(1:4,1:*), real ( kind = rk8 ) IANG(1:*), the polygon 
!    vertex list, interior angles.
!
!    Output, real ( kind = rk8 ) ANGSEP, the minimum of the 4 or 7 angles at the
!    boundary resulting from 1 or 2 separators, respectively.
!
!    Output, integer I1, I2, the indices of endpoints of separators in XC, 
!    YC arrays; I2 = -1 if there is only one separator, else I1 < I2.
!
!    Workspace, real ( kind = rk8 ) WKANG(0:NV).
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  real ( kind = rk8 ) ang
  real ( kind = rk8 ) angac1
  real ( kind = rk8 ) angsep
  real ( kind = rk8 ) angsp2
  integer i
  integer i1
  integer i2
  real ( kind = rk8 ) iang(*)
  integer ii
  integer k
  integer l
  integer m
  integer nl
  integer nr
  integer nv
  integer nvrt
  integer iv(0:nv)
  integer ivis(0:nvrt)
  real ( kind = rk8 ) minang
  integer p
  real ( kind = rk8 ) phi
  real ( kind = rk8 ), parameter :: pi = 3.141592653589793D+00
  integer pvl(4,*)
  integer q
  integer r
  real ( kind = rk8 ) theta(0:nvrt)
  real ( kind = rk8 ) tol
  real ( kind = rk8 ) vcl(2,*)
  real ( kind = rk8 ) wkang(0:nv)
  real ( kind = rk8 ) xc(0:nvrt)
  real ( kind = rk8 ) xr
  real ( kind = rk8 ) yc(0:nvrt)
  real ( kind = rk8 ) yr

  tol = 100.0D+00 * epsilon ( tol )
!
!  Determine the vertices in the inner cone - indices P to Q.
!
  i = 0
  p = -1
  phi = theta(nvrt) - pi + tol

  do while ( p < 0 )

    if ( phi <= theta(iv(i)) ) then
      p = i
    else
      i = i + 1
    end if

  end do

  i = nv
  q = -1
  phi = pi - tol

  do while ( q < 0 )

    if ( theta(iv(i)) <= phi ) then
      q = i
    else
      i = i - 1
    end if

  end do
!
!  Use the max-min angle criterion to find the best separator
!  in inner cone.
!
  angsep = 0.0

  do i = p, q

    k = iv(i)
    ang = minang ( xr, yr, xc(k), yc(k), ivis(k), theta(k), theta(nvrt), &
      vcl, pvl, iang )

    if ( angsep < ang ) then
      angsep = ang
      ii = iv(i)
    end if

  end do

  angsp2 = angsep
  if ( angac1 <= angsep ) then
    go to 110
  end if
!
!  If the best separator in inner cone is not 'good' enough,
!  use max-min angle criterion to try to find a better pair
!  of separators from the right and left cones.
!
  nr = 0
  nl = 0

  do r = 0, p - 1

    wkang(r) = 0.0D+00

    if ( angsep < theta(iv(r)) ) then

      k = iv(r)

      ang = minang ( xr, yr, xc(k), yc(k), ivis(k), theta(k), theta(nvrt), &
        vcl, pvl, iang )

      if ( angsep < ang ) then
        nr = nr + 1
        wkang(r) = ang
      end if

    end if

  end do

  if ( nr == 0 ) then
    go to 110
  end if

  phi = theta(nvrt) - angsep

  do l = q+1, nv

    wkang(l) = 0.0D+00

    if ( theta(iv(l)) < phi ) then

      k = iv(l)
      ang = minang ( xr, yr, xc(k), yc(k), ivis(k), theta(k), theta(nvrt), &
        vcl, pvl, iang )

      if ( angsep < ang ) then
        nl = nl + 1
        wkang(l) = ang
      end if

    end if

  end do

  if ( nl == 0 ) then
    go to 110
  end if
!
!  Check all possible pairs for the best pair of separators
!  in the right and left cones.
!
  m = nv

  do r = p-1, 0, -1

     if ( q < m .and. angsp2 < wkang(r) ) then

      phi = theta(iv(r))

80    continue

      if ( q < m .and. &
           ( wkang(m) <= angsp2 .or. &
             pi - tol < theta(iv(m)) - phi ) ) then
        m = m - 1
        go to 80
      end if

      do l = q+1, m

         if ( angsp2 < wkang(l) ) then

            ang = min ( theta(iv(l)) - phi, wkang(r), wkang(l) )

            if ( angsp2 < ang ) then
             angsp2 = ang
             i1 = iv(r)
             i2 = iv(l)
            end if

         end if

       end do

     end if

  end do
!
!  Choose 1 or 2 separators based on max-min angle criterion or
!  ANGAC1 parameter.
!
  110 continue

  if ( angsp2 <= angsep ) then
    i1 = ii
    i2 = -1
  else
    angsep = angsp2
  end if

  return
end
subroutine fndtri ( iedg, mxtr, sflag, tedg, itr, ind, ierror )

!*****************************************************************************80
!
!! fndtri() finds two triangles containing a given edge.
!
!  Discussion: 
!
!    Find two triangles containing edge with index IEDG in array TEDG.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, integer IEDG, the index of edge to be searched in TEDG.
!
!    Input, integer MXTR, the maximum index of triangle to be searched in TEDG.
!
!    Input, logical SFLAG, is .TRUE. if and only if the second triangle is to be 
!    searched from end of array.
!
!    Input, integer TEDG(1:3,1:MXTR), triangle edge indices; see routine CVDTRI.
!
!    Output, integer ITR(1:2), IND(1:2), indices such that IEDG =
!    TEDG(IND(1),ITR(1)) = TEDG(IND(2),ITR(2)).
!
!    Output, integer IERROR, error flag.  On abnormal return,
!    IERROR is set to 231.
!
  implicit none

  integer mxtr

  integer i
  integer iedg
  integer ierror
  integer ind(2)
  integer itr(2)
  integer j
  integer k
  logical sflag
  integer tedg(3,mxtr)
!
!  Search from end of array TEDG.
!
  ierror = 0
  k = 1
  j = 1
  i = mxtr

10 continue

  do

    if ( tedg(j,i) == iedg ) then
      exit
    end if

    j = j + 1

    if ( 3 < j ) then
      j = 1
      i = i - 1
      if ( i <= 0 ) then
        ierror = 231
        return
      end if
    end if

  end do

  itr(k) = i
  ind(k) = j

  if ( k == 2 ) then
    return
  end if

  k = 2

  if ( sflag ) then

    j = 1
    i = i - 1

    if ( i <= 0 ) then
      ierror = 231
      return
    end if

    go to 10

  end if
!
!  Search from beginning of array TEDG for second triangle.
!
  j = 1
  i = 1

20 continue

  if ( itr(1) <= i ) then
    ierror = 231
    return
  end if

30 continue

  if ( tedg(j,i) /= iedg ) then
    j = j + 1
    if ( 3 < j ) then
      j = 1
      i = i + 1
      go to 20
    else
      go to 30
    end if
  end if

  itr(2) = i
  ind(2) = j

  return
end
subroutine get_unit ( iunit )

!*****************************************************************************80
!
!! get_unit() returns a free FORTRAN unit number.
!
!  Discussion:
!
!    A "free" FORTRAN unit number is an integer between 1 and 99 which
!    is not currently associated with an I/O device.  A free FORTRAN unit
!    number is needed in order to open a file with the OPEN command.
!
!    If IUNIT = 0, then no free FORTRAN unit could be found, although
!    all 99 units were checked (except for units 5, 6 and 9, which
!    are commonly reserved for console I/O).
!
!    Otherwise, IUNIT is an integer between 1 and 99, representing a
!    free FORTRAN unit.  Note that GET_UNIT assumes that units 5 and 6
!    are special, and will never return those values.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    John Burkardt
!
!  Parameters:
!
!    Output, integer IUNIT, the free unit number.
!
  implicit none

  integer i
  integer ios
  integer iunit
  logical lopen

  iunit = 0

  do i = 1, 99

    if ( i /= 5 .and. i /= 6 .and. i /= 9 ) then

      inquire ( unit = i, opened = lopen, iostat = ios )

      if ( ios == 0 ) then
        if ( .not. lopen ) then
          iunit = i
          return
        end if
      end if

    end if

  end do

  return
end
subroutine gtime ( time )

!*****************************************************************************80
!
!! gtime() gets the current CPU time in seconds.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    John Burkardt
!
!  Parameters:
!
!    Output, real ( kind = rk8 ) TIME, the current reading of the CPU clock
!    in seconds.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  integer clock_count
  integer clock_max
  integer clock_rate
  real ( kind = rk8 ) time

  call system_clock ( clock_count, clock_rate, clock_max )

  time = real ( clock_count, kind = rk8 ) / real ( clock_rate, kind = rk8 )

  return
end
subroutine holvrt ( nhole, vcl, hvl, pvl, holv )

!*****************************************************************************80
!
!! holvrt() determines top and bottom vertices of holes in polygonal regions.
!
!  Discussion: 
!
!    Determine top and bottom vertices of holes in polygonal
!    regions, and sort top vertices in decreasing (y,x) order
!    and bottom vertices in increasing (y,x) order.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, integer NHOLE, the number of holes in region(s).
!
!    Input, real ( kind = rk8 ) VCL(1:2,1:*), the vertex coordinate list.
!
!    Input, integer HVL(1:NHOLE), the head vertex list; HVL(I) is index in 
!    PVL of head vertex of Ith hole.
!
!    Input, integer PVL(1:4,1:*), the polygon vertex list; see routine DSPGDC.
!
!    Output, integer HOLV(1:NHOLE*2), the indices in PVL of top and bottom 
!    vertices of holes; first (last) NHOLE entries are for top (bottom)
!    vertices; top (bottom) vertices are sorted in decreasing
!    (increasing) lexicographic (y,x) order of coordinates.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  integer nhole

  integer holv(nhole*2)
  integer hv
  integer hvl(nhole)
  integer i
  integer imax
  integer imin
  integer iv
  integer j
  integer, parameter :: loc = 1
  integer lv
  integer nhp1
  integer pvl(4,*)
  integer, parameter :: succ = 3
  real ( kind = rk8 ) vcl(2,*)
  real ( kind = rk8 ) x
  real ( kind = rk8 ) xmax
  real ( kind = rk8 ) xmin
  real ( kind = rk8 ) y
  real ( kind = rk8 ) ymax
  real ( kind = rk8 ) ymin
!
!  Determine top and bottom vertices of holes.
!
  do i = 1, nhole

    hv = hvl(i)
    iv = hv

    do

      lv = pvl(loc,iv)

      if ( iv == hv ) then

        imin = iv
        imax = iv
        xmin = vcl(1,lv)
        ymin = vcl(2,lv)
        xmax = xmin
        ymax = ymin

      else

        x = vcl(1,lv)
        y = vcl(2,lv)

        if ( y < ymin .or. y == ymin .and. x < xmin ) then
          imin = iv
          xmin = x
          ymin = y
        else if ( ymax < y .or. y == ymax .and. xmax < x ) then
          imax = iv
          xmax = x
          ymax = y
        end if

      end if

      iv = pvl(succ,iv)

      if ( iv == hv) then
        exit
      end if

    end do

    holv(i) = imax
    holv(i+nhole) = imin

  end do
!
!  Use linear insertion sort to sort the top vertices of the holes
!  in decreasing (y,x) order, then bottom vertices in increasing
!  (y,x) order.  It is assumed that NHOLE is small.
!
  do i = 2, nhole

    hv = holv(i)
    lv = pvl(loc,hv)
    x = vcl(1,lv)
    y = vcl(2,lv)
    j = i

30  continue

    iv = holv(j-1)
    lv = pvl(loc,iv)

    if ( vcl(2,lv) < y .or. ( y == vcl(2,lv) .and. vcl(1,lv) < x ) ) then
      holv(j) = iv
      j = j - 1
      if ( 1 < j ) then
        go to 30
      end if
    end if

    holv(j) = hv

  end do

  nhp1 = nhole + 1

  do i = nhp1+1, nhole+nhole

    hv = holv(i)
    lv = pvl(loc,hv)
    x = vcl(1,lv)
    y = vcl(2,lv)
    j = i

50  continue

    iv = holv(j-1)
    lv = pvl(loc,iv)

    if ( y < vcl(2,lv) .or. y == vcl(2,lv) .and. x < vcl(1,lv) ) then

      holv(j) = iv
      j = j - 1

      if ( nhp1 < j ) then
        go to 50
      end if

    end if

    holv(j) = hv

  end do

  return
end
function i4_modp ( i, j )

!*****************************************************************************80
!
!! i4_modp() returns the nonnegative remainder of integer division.
!
!  Formula:
!
!    If
!      NREM = I4_MODP ( I, J )
!      NMULT = ( I - NREM ) / J
!    then
!      I = J * NMULT + NREM
!    where NREM is always nonnegative.
!
!  Discussion:
!
!    The MOD function computes a result with the same sign as the
!    quantity being divided.  Thus, suppose you had an angle A,
!    and you wanted to ensure that it was between 0 and 360.
!    Then mod(A,360) would do, if A was positive, but if A
!    was negative, your result would be between -360 and 0.
!
!    On the other hand, I4_MODP(A,360) is between 0 and 360, always.
!
!  Examples:
!
!        I     J     MOD  I4_MODP    Factorization
!
!      107    50       7       7    107 =  2 *  50 + 7
!      107   -50       7       7    107 = -2 * -50 + 7
!     -107    50      -7      43   -107 = -3 *  50 + 43
!     -107   -50      -7      43   -107 =  3 * -50 + 43
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    John Burkardt
!
!  Parameters:
!
!    Input, integer I, the number to be divided.
!
!    Input, integer J, the number that divides I.
!
!    Output, integer I4_MODP, the nonnegative remainder when I is
!    divided by J.
!
  implicit none

  integer i
  integer i4_modp
  integer j

  if ( j == 0 ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'I4_MODP - Fatal error!'
    write ( *, '(a,i6)' ) '  I4_MODP ( I, J ) called with J = ', j
    stop
  end if

  i4_modp = mod ( i, j )

  if ( i4_modp < 0 ) then
    i4_modp = i4_modp + abs ( j )
  end if

  return
end
subroutine i4_swap ( i, j )

!*****************************************************************************80
!
!! i4_swap() swaps two integer values.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    John Burkardt
!
!  Parameters:
!
!    Input/output, integer I, J.  On output, the values of I and
!    J have been interchanged.
!
  implicit none

  integer i
  integer j
  integer k

  k = i
  i = j
  j = k

  return
end
function i4_wrap ( ival, ilo, ihi )

!*****************************************************************************80
!
!! i4_wrap() forces an integer to lie between given limits by wrapping.
!
!  Example:
!
!    ILO = 4, IHI = 8
!
!    I  I4_WRAP
!
!    -2     8
!    -1     4
!     0     5
!     1     6
!     2     7
!     3     8
!     4     4
!     5     5
!     6     6
!     7     7
!     8     8
!     9     4
!    10     5
!    11     6
!    12     7
!    13     8
!    14     4
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    John Burkardt
!
!  Parameters:
!
!    Input, integer IVAL, an integer value.
!
!    Input, integer ILO, IHI, the desired bounds for the integer value.
!
!    Output, integer I4_WRAP, a "wrapped" version of IVAL.
!
  implicit none

  integer i4_modp
  integer i4_wrap
  integer ihi
  integer ilo
  integer ival
  integer wide

  wide = ihi + 1 - ilo

  if ( wide == 0 ) then
    i4_wrap = ilo
  else
    i4_wrap = ilo + i4_modp ( ival-ilo, wide )
  end if

  return
end
subroutine ihpsrt ( k, n, lda, a, map )

!*****************************************************************************80
!
!! ihpsrt() uses heapsort on integer points in K-dimension.
!
!  Discussion:
!
!    Use heapsort to obtain the permutation of N K-dimensional
!    integer points so that the points are in lexicographic
!    increasing order.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, integer K, the dimension of points.
!
!    Input, integer N, the number of points.
!
!    Input, integer LDA, the leading dimension of array A in calling 
!    routine; K <= LDA.
!
!    Input, integer A(1:K,1:*), the array of at least N K-dimensional 
!    integer points.
!
!    Input/output, integer MAP(1:N), the points of A with indices MAP(1), 
!    MAP(2), ..., MAP(N) are to be sorted.
!    On output, elements are permuted so that A(*,MAP(1)) <=
!    A(*,MAP(2)) <= ... <= A(*,MAP(N)).
!
  implicit none

  integer lda
  integer n

  integer a(lda,*)
  integer i
  integer k
  integer map(n)
  integer t

  do i = n/2, 1, -1
    call isftdw ( i, n, k, lda, a, map )
  end do

  do i = n, 2, -1
    t = map(1)
    map(1) = map(i)
    map(i) = t
    call isftdw ( 1, i-1, k, lda, a, map )
  end do

  return
end
function iless ( k, p, q )

!*****************************************************************************80
!
!! iless() determines whether a K-dimensional point P is lexically less than Q.
!
!  Discussion: 
!
!    Determine whether P is lexicographically less than Q.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, integer K, the dimension of points.
!
!    Input, integer P(1:K), Q(1:K), two points to compare.
!
!    Output, logical ILESS, is .TRUE. if P < Q, .FALSE. otherwise.
!
  implicit none

  integer k

  integer i
  logical iless
  integer p(k)
  integer q(k)

  do i = 1, k

    if ( p(i) /= q(i) ) then

      if ( p(i) < q(i) ) then
        iless = .true.
      else
        iless = .false.
      end if

      return

    end if

  end do

  iless = .false.

  return
end
subroutine i4mat_print ( lda, m, n, a, title )

!*****************************************************************************80
!
!! i4mat_print() prints an I4MAT.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    John Burkardt
!
!  Parameters:
!
!    Input, integer LDA, the leading dimension of A.
!
!    Input, integer M, the number of rows in A.
!
!    Input, integer N, the number of columns in A.
!
!    Input, integer A(LDA,N), the matrix to be printed.
!
!    Input, character ( len = * ) TITLE, a title.
!
  implicit none

  integer lda
  integer n

  integer a(lda,n)
  integer i
  integer j
  integer jhi
  integer jlo
  integer m
  character ( len = * ) title

  if ( title /= ' ' ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) trim ( title )
  end if

  do jlo = 1, n, 10
    jhi = min ( jlo + 9, n )
    write ( *, '(a)' ) ' '
    write ( *, '(6x,10(i7))' ) ( j, j = jlo, jhi )
    write ( *, '(a)' ) ' '
    do i = 1, m
      write ( *, '(i6,10i7)' ) i, a(i,jlo:jhi)
    end do
  end do

  return
end
subroutine insed2 ( v, w, npolg, nvert, maxhv, maxpv, vcl, regnum, &
  hvl, pvl, iang, ierror )

!*****************************************************************************80
!
!! insed2() inserts an edge into the head and polygon vertex lists.
!
!  Discussion: 
!
!    Insert the edge joining vertices V, W into the head vertex
!    list and polygon vertex list data structures.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, integer V, W, indices in PVL of vertices which are the endpoints
!    of an edge to be added to decomposition.
!
!    Input, integer NPOLG, the number of positions used in HVL array.
!
!    Input, integer NVERT, the number of positions used in PVL array.
!
!    Input, integer MAXHV, the maximum size available for HVL array.
!
!    Input, integer MAXPV, the maximum size available for PVL array.
!
!    Input, real ( kind = rk8 ) VCL(1:2,1:*), the vertex coordinate list.
!
!    Input/output, integer REGNUM(1:NPOLG), the region numbers.
!
!    Input/output, integer HVL(1:NPOLG), the head vertex list.
!
!    Input/output, integer PVL(1:4,1:NVERT), real ( kind = rk8 ) IANG(1:NVERT), 
!    the polygon vertex list and interior angles.
!
!    Output, integer IERROR, error flag.  On abnormal return,
!    IERROR is set to 4 or 5.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  integer maxhv
  integer maxpv

  real ( kind = rk8 ) angle
  integer, parameter :: edgv = 4
  integer hvl(maxhv)
  integer i
  real ( kind = rk8 ) iang(maxpv)
  integer ierror
  integer l
  integer, parameter :: loc = 1
  integer lv
  integer lw
  integer, parameter :: msglvl = 0
  integer npolg
  integer nvert
  integer, parameter :: polg = 2
  integer pvl(4,maxpv)
  integer regnum(maxhv)
  integer, parameter :: succ = 3
  integer v
  real ( kind = rk8 ) vcl(2,*)
  integer vv
  integer w
  integer ww

  ierror = 0

  if ( maxhv <= npolg ) then
    ierror = 4
    return
  else if ( maxpv < nvert + 2 ) then
    ierror = 5
    return
  end if
!
!  Split linked list of vertices of the polygon containing vertices
!  V and W into two linked list of vertices of polygons with common
!  edge joining V and W.
!
  nvert = nvert + 2
  vv = nvert - 1
  ww = nvert
  lv = pvl(loc,v)
  lw = pvl(loc,w)
  pvl(loc,vv) = lv
  pvl(loc,ww) = lw
  pvl(polg,ww) = pvl(polg,v)
  pvl(succ,vv) = pvl(succ,v)
  pvl(succ,ww) = pvl(succ,w)
  pvl(succ,v) = ww
  pvl(succ,w) = vv
  pvl(edgv,vv) = pvl(edgv,v)
  pvl(edgv,ww) = pvl(edgv,w)
  pvl(edgv,v) = w
  pvl(edgv,w) = v

  if ( 0 < pvl(edgv,vv) ) then
    pvl(edgv,pvl(edgv,vv)) = vv
  end if

  if ( 0 < pvl(edgv,ww) ) then
    pvl(edgv,pvl(edgv,ww)) = ww
  end if

  l = pvl(loc,pvl(succ,vv))

  iang(vv) = angle ( vcl(1,lw), vcl(2,lw), vcl(1,lv), vcl(2,lv), vcl(1,l), &
    vcl(2,l) )

  iang(v) = iang(v) - iang(vv)
  l = pvl(loc,pvl(succ,ww))
  iang(ww) = angle ( vcl(1,lv), vcl(2,lv), vcl(1,lw), vcl(2,lw), vcl(1,l), &
    vcl(2,l) )

  iang(w) = iang(w) - iang(ww)
  npolg = npolg + 1
  i = vv

  do

    pvl(polg,i) = npolg
    i = pvl(succ,i)

    if ( i == vv ) then
      exit
    end if

  end do

  hvl(pvl(polg,v)) = v
  hvl(npolg) = vv
  regnum(npolg) = regnum(pvl(polg,v))

  if ( msglvl == 2 ) then
    write ( *, '(2i6,4f15.7)' ) v, w, vcl(1:2,lv), vcl(1:2,lw)
  end if

  return
end
subroutine insvr2 ( xi, yi, wp, nvc, nvert, maxvc, maxpv, vcl, pvl, &
  iang, w, ierror )

!*****************************************************************************80
!
!! insvr2() inserts a point into the vertex coordinate and polygon vertex lists.
!
!  Discussion: 
!
!    Insert point (XI,YI) into vertex coordinate list and
!    polygon vertex list data structures.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, real ( kind = rk8 ) XI, YI, the coordinates of point to be inserted.
!
!    Input, integer WP, the index of vertex in PVL which is to be the
!    predecessor vertex of the inserted vertex.
!
!    Input/output, integer NVC, the number of positions used in VCL array.
!
!    Input/output, integer NVERT, the number of positions used in PVL array.
!
!    Input, integer MAXVC, the maximum size available for VCL array.
!
!    Input, integer MAXPV, the maximum size available for PVL array.
!
!    Input/output, real ( kind = rk8 ) VCL(1:2,1:NVC), the vertex coordinate list.
!
!    Input/output, integer PVL(1:4,1:NVERT), real ( kind = rk8 ) IANG(1:NVERT),
!    the polygon vertex list and interior angles.
!
!    Output, integer W, the index of inserted vertex in PVL.
!
!    Output, integer IERROR, error flag.  On abnormal return,
!    IERROR is set to 3 or 5.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  integer maxpv
  integer maxvc

  integer, parameter :: edgv = 4
  real ( kind = rk8 ) iang(maxpv)
  integer ierror
  integer, parameter :: loc = 1
  integer nvc
  integer nvert
  real ( kind = rk8 ), parameter :: pi = 3.141592653589793D+00
  integer, parameter :: polg = 2
  integer pvl(4,maxpv)
  integer, parameter :: succ = 3
  real ( kind = rk8 ) tol
  real ( kind = rk8 ) vcl(2,maxvc)
  integer w
  integer wp
  integer ws
  integer ww
  integer wwp
  integer wws
  real ( kind = rk8 ) xi
  real ( kind = rk8 ) yi

  ierror = 0
  tol = 100.0D+00 * epsilon ( tol )

  if ( maxvc <= nvc ) then
    ierror = 3
    return
  end if

  if ( maxpv < nvert + 2 ) then
    ierror = 5
    return
  end if
!
!  Update linked list of vertices of polygon containing vertex WP.
!
  nvc = nvc + 1
  vcl(1,nvc) = xi
  vcl(2,nvc) = yi
  ws = pvl(succ,wp)
  nvert = nvert + 1
  w = nvert
  pvl(loc,w) = nvc
  pvl(polg,w) = pvl(polg,wp)
  pvl(succ,wp) = w
  pvl(succ,w) = ws
  iang(w) = pi
  pvl(edgv,w) = pvl(edgv,wp)
!
!  If edge containing (XI,YI) is shared by another polygon,
!  then also update linked list of vertices of that polygon.
!
  if ( 0 < pvl(edgv,wp) ) then
    wws = pvl(edgv,wp)
    wwp = pvl(succ,wws)
    nvert = nvert + 1
    ww = nvert
    pvl(loc,ww) = nvc
    pvl(polg,ww) = pvl(polg,wws)
    pvl(succ,wws) = ww
    pvl(succ,ww) = wwp
    iang(ww) = pi
    pvl(edgv,wp) = ww
    pvl(edgv,ww) = wp
    pvl(edgv,wws) = w
  end if

  return
end
subroutine intpg ( nvrt, xc, yc, ctrx, ctry, arpoly, hflag, umdf, wsq, nev, &
  ifv, listev, ivrt, edgval, vrtval, vcl, mdfint, mean, stdv, mdftr )

!*****************************************************************************80
!
!! intpg() integrates the mesh distribution function in a convex polygon.
!
!  Discussion: 
!
!    Compute integral of MDF2(X,Y) [heuristic mdf] or
!    UMDF(X,Y) [user-supplied mdf] in convex polygon.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, integer NVRT, the number of vertices in polygon.
!
!    Input, real ( kind = rk8 ) XC(0:NVRT), YC(0:NVRT), the coordinates of 
!    polygon vertices in counter clockwise order, translated so that 
!    centroid is at origin; (XC(0),YC(0)) = (XC(NVRT),YC(NVRT)).
!
!    Input, real ( kind = rk8 ) CTRX, CTRY, the coordinates of centroid 
!    before translation.
!
!    Input, real ( kind = rk8 ) ARPOLY, the area of polygon.
!
!    Input, logical HFLAG, is .TRUE. if heuristic mdf, .FALSE. if 
!    user-supplied mdf.
!
!    Input, external UMDF, the name of the user supplied MDF routine, of 
!    the form:
!      function umdf ( x, y )
!      real ( kind = rk8 ) umdf
!      real ( kind = rk8 ) x
!      real ( kind = rk8 ) y
!
!    Input, real ( kind = rk8 ) WSQ, the square of width of original polygon 
!    of decomposition.
!
!    Input, integer NEV, integer IFV, integer LISTEV(1:NEV), output from 
!    routine PRMDF2.
!
!    Input, IVRT(1:*), real ( kind = rk8 ) EDGVAL(1:*), 
!    real ( kind = rk8 ) VRTVAL(1:*), arrays output from DSMDF2;
!    if .NOT. HFLAG then only first array exists.
!
!    Input, real ( kind = rk8 ) VCL(1:2,1:*), the vertex coordinate list.
!
!    Output, real ( kind = rk8 ) MDFINT, the integral of MDF in polygon.
!
!    Output, real ( kind = rk8 ) MEAN, the mean MDF value in polygon.
!
!    Output, real ( kind = rk8 ) STDV, the standard deviation of MDF in polygon.
!
!    Output, real ( kind = rk8 ) MDFTR(0:NVRT-1), the mean MDF value in each 
!    triangle of polygon;  triangles are determined by polygon vertices 
!    and centroid.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  integer nev
  integer, parameter :: nqpt = 3
  integer nvrt

  real ( kind = rk8 ) areatr
  real ( kind = rk8 ) arpoly
  real ( kind = rk8 ) ctrx
  real ( kind = rk8 ) ctry
  real ( kind = rk8 ) d
  real ( kind = rk8 ) edgval(*)
  logical hflag
  integer i
  integer ifv
  integer ivrt(*)
  integer j
  integer k
  integer kp1
  integer l
  integer listev(nev)
  integer m
  real ( kind = rk8 ) mdfint
  real ( kind = rk8 ) mdfsqi
  real ( kind = rk8 ) mdftr(0:nvrt-1)
  real ( kind = rk8 ) mean
  real ( kind = rk8 ), save, dimension ( 3, nqpt ) :: qc = reshape ( (/ &
    0.6666666666666666D+00, 0.1666666666666667D+00, 0.1666666666666667D+00, &
    0.1666666666666667D+00, 0.6666666666666666D+00, 0.1666666666666667D+00, &
    0.1666666666666667D+00, 0.1666666666666667D+00, 0.6666666666666666D+00/), &
    (/ 3, nqpt /) )
  real ( kind = rk8 ) s
  real ( kind = rk8 ) stdv
  real ( kind = rk8 ) sum1
  real ( kind = rk8 ) sum2
  real ( kind = rk8 ) temp
  real ( kind = rk8 ) umdf
  real ( kind = rk8 ) val
  real ( kind = rk8 ) vcl(2,*)
  real ( kind = rk8 ) vrtval(*)
  real ( kind = rk8 ) wsq
  real ( kind = rk8 ), save, dimension ( nqpt ) :: wt = &
    (/ 0.3333333333333333D+00, 0.3333333333333333D+00, 0.3333333333333333D+00 /)
  real ( kind = rk8 ) x
  real ( kind = rk8 ) x0
  real ( kind = rk8 ) x1
  real ( kind = rk8 ) xc(0:nvrt)
  real ( kind = rk8 ) xx
  real ( kind = rk8 ) y
  real ( kind = rk8 ) y0
  real ( kind = rk8 ) y1
  real ( kind = rk8 ) yc(0:nvrt)
  real ( kind = rk8 ) yy

  external umdf
!
!  NQPT is number of quadrature points for numerical integration in triangle.
!  WT(I) is weight of Ith quadrature point.
!  QC(1:3,I) are barycentric coordinates of Ith quadrature point.
!
  mdfint = 0.0D+00
  mdfsqi = 0.0D+00

  do l = 0, nvrt-1

    areatr = 0.5D+00 * ( xc(l) * yc(l+1) - xc(l+1) * yc(l) )
    sum1 = 0.0D+00
    sum2 = 0.0D+00

    do m = 1, nqpt

      xx = qc(1,m) * xc(l) + qc(2,m) * xc(l+1)
      yy = qc(1,m) * yc(l) + qc(2,m) * yc(l+1)
      if ( hflag ) then
!
!             VAL = MDF2(XX+CTRX,YY+CTRY,WSQ,NEV,IFV,LISTEV,IVRT, &
!               EDGVAL,VRTVAL,VCL)
!
!  Insert code for function MDF2 to reduce number of calls.
!
         x = xx + ctrx
         y = yy + ctry
           s = wsq
           do i = 1, nev
            k = listev(i)
            if ( k < 0 ) then
               k = -k
               d = ( vcl(1,k) - x )**2 + ( vcl(2,k) - y )**2
               d = max ( 0.25D+00 * d, vrtval(k) )
               s = min ( s, d )
            else
               kp1 = k + 1
               if ( i == nev .and. 0 < ifv ) then
                 kp1 = ifv
               end if
               j = ivrt(kp1)
               x0 = x - vcl(1,j)
               y0 = y - vcl(2,j)
               x1 = vcl(1,ivrt(k)) - vcl(1,j)
               y1 = vcl(2,ivrt(k)) - vcl(2,j)

               if ( x0 * x1 + y0 * y1 <= 0.0D+00 ) then
                 d = x0**2 + y0**2
               else
                 x0 = x0 - x1
                 y0 = y0 - y1
                 if ( 0.0D+00 <= x0 * x1 + y0 * y1 ) then
                   d = x0**2 + y0**2
                 else
                   d = ( x1 * y0 - y1 * x0 )**2 / ( x1**2 + y1**2 )
                 end if
               end if

               d = max ( 0.25D+00 * d, edgval(k) )
               s = min ( s, d )
            end if
           end do
           val = 1.0D+00 / s
      else
        val = umdf ( xx+ctrx, yy+ctry )
      end if

      temp = wt(m) * val
      sum1 = sum1 + temp
      sum2 = sum2 + temp * val

    end do

    mdftr(l) = sum1
    mdfint = mdfint + sum1 * areatr
    mdfsqi = mdfsqi + sum2 * areatr

  end do

  mean = mdfint / arpoly
  stdv = mdfsqi / arpoly - mean**2
  stdv = sqrt ( max ( stdv, 0.0D+00 ) )

  return
end
subroutine inttri ( nvrt, xc, yc, h, ibot, costh, sinth, ldv, nvc, ntri,  &
  maxvc, maxti, maxcw, vcl, til, ncw, cwalk, ierror )

!*****************************************************************************80
!
!! inttri() generates triangles inside a convex polygon.
!
!  Discussion: 
!
!    Generate triangles inside convex polygon using quasi-uniform grid of
!    spacing H.  It is assumed that the diameter of the polygon is parallel 
!    to the Y axis.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, integer NVRT, the number of vertices on the boundary of
!    convex polygon.
!
!    Input, real ( kind = rk8 ) XC(0:NVRT), YC(0:NVRT), the vertex coordinates 
!    in counter clockwise order; (XC(0),YC(0)) = (XC(NVRT),YC(NVRT)).
!
!    Input, real ( kind = rk8 ) H, the spacing of mesh vertices in polygon.
!
!    Input, integer IBOT, the index of bottom vertex; diameter contains vertices
!    (XC(0),YC(0)) and (XC(IBOT),YC(IBOT)).
!
!    Input, real ( kind = rk8 ) COSTH, SINTH; COS(THETA), SIN(THETA) where 
!    THETA in [-PI,PI] is rotation angle to get diameter parallel to y-axis.
!
!    Input, integer LDV, the leading dimension of VCL in calling routine.
!
!    Input/output, integer NVC, the number of coordinates or positions 
!    used in VCL array.
!
!    Input/output, integer NTRI, the number of triangles or positions 
!    used in TIL.
!
!    Input, integer MAXVC, the maximum size available for VCL array.
!
!    Input, integer MAXTI, the maximum size available for TIL array.
!
!    Input, integer MAXCW, the maximum size available for CWALK array; 
!    assumed to be at least 6*(1 + INT((YC(0) - YC(IBOT))/H)).
!
!    Input/output, real ( kind = rk8 ) VCL(1:2,1:NVC), the vertex coordinate list.
!
!    Input/output, integer TIL(1:3,1:NTRI), the triangle incidence list.
!
!    Output, integer NCW, the number of mesh vertices in closed walk, 
!    except NCW = 0 for 1 vertex.
!
!    Output, integer CWALK(0:NCW), indices in VCL of mesh vertices of closed
!    walk; CWALK(0) = CWALK(NCW)
!
!    Output, integer IERROR, error flag.  On abnormal return,
!    IERROR is set to 3, 9, or 10
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  integer ldv
  integer maxcw
  integer maxti
  integer maxvc
  integer nvrt

  real ( kind = rk8 ) a
  real ( kind = rk8 ) b
  real ( kind = rk8 ) costh
  integer cwalk(0:maxcw)
  real ( kind = rk8 ) cy
  real ( kind = rk8 ) h
  integer i
  integer ibot
  integer ierror
  integer il
  integer im1l
  integer im1r
  integer ir
  integer j
  integer k
  integer l
  integer l0
  integer l1
  integer lw
  integer m
  integer n
  integer ncw
  integer ntri
  integer nvc
  integer p
  integer r
  integer r0
  integer r1
  integer rw
  real ( kind = rk8 ) sinth
  real ( kind = rk8 ) sy
  integer til(3,maxti)
  real ( kind = rk8 ) tol
  real ( kind = rk8 ) vcl(ldv,maxvc)
  real ( kind = rk8 ) x
  real ( kind = rk8 ) xc(0:nvrt)
  real ( kind = rk8 ) xj
  real ( kind = rk8 ) xk
  real ( kind = rk8 ) xl
  real ( kind = rk8 ) xm1l
  real ( kind = rk8 ) xm1r
  real ( kind = rk8 ) xr
  real ( kind = rk8 ) y
  real ( kind = rk8 ) yc(0:nvrt)

  ierror = 0
  tol = 100.0D+00 * epsilon ( tol )

  n = int ( ( yc(0) - yc(ibot) ) / h )
  y = yc(0) - 0.5D+00 * ( yc(0) - yc(ibot ) - real ( n, kind = rk8 ) * h )
  l = 0
  r = nvrt

  do i = 0, n
!
!  Determine left and right x-coordinates of polygon for
!  scan line with y-coordinate Y, and generate mesh vertices.
!
    do while ( y < yc(l+1) )
      l = l + 1
    end do

    do while ( y < yc(r-1) )
      r = r - 1
    end do

    xl = xc(l) + ( xc(l+1) - xc(l) ) * ( y - yc(l) ) / ( yc(l+1) - yc(l) )
    xr = xc(r) + ( xc(r-1) - xc(r) ) * ( y - yc(r) ) / ( yc(r-1) - yc(r) )
    m = int ( ( xr - xl ) / h )
    x = xl + 0.5D+00 * ( xr - xl - real ( m, kind = rk8 ) * h )

    if ( maxvc < nvc + m + 1 ) then
      ierror = 3
      return
    end if

    cy = costh * y
    sy = sinth * y
    il = nvc + 1
    xl = x

    do j = 0, m
      nvc = nvc + 1
      vcl(1,nvc) = costh * x + sy
      vcl(2,nvc) = cy - sinth * x
      x = x + h
    end do

    ir = nvc
    xr = x - h

    if ( n == 0 ) then

      ncw = 0
      cwalk(0) = nvc
      return

    else if ( i == 0 ) then

      lw = 0
      cwalk(lw) = il
      rw = maxcw + 1

      do j = il, ir
        rw = rw - 1
        cwalk(rw) = j
      end do

      go to 100

    end if
!
!  Generate triangles between scan lines Y+H and Y.
!
    a = max ( xl, xm1l )
    b = min ( xr, xm1r )

    if ( xm1l == a ) then
      l0 = im1l
      x = ( xm1l - xl ) / h
      j = int(x + tol)
      if ( abs ( x - real ( j, kind = rk8 ) ) <= tol ) then
        j = j - 1
      end if
      if ( j < 0 ) then
        j = 0
      end if
      l1 = il + j
    else
      l1 = il
      x = ( xl - xm1l ) / h
      j = int ( x + tol )
      if ( abs ( x - real ( j, kind = rk8 ) ) <= tol ) then
        j = j - 1
      end if
      if ( j < 0 ) then
        j = 0
      end if
      l0 = im1l + j
    end if

    if ( xm1r == b ) then
      r0 = im1r
      x = ( xr - xm1r ) / h
      j = int ( x + tol )
      if ( abs ( x - real ( j, kind = rk8 ) ) <= tol ) then
        j = j - 1
      end if
      if ( j < 0 ) then
        j = 0
      end if
      r1 = ir - j
    else
      r1 = ir
      x = ( xm1r - xr ) / h
      j = int ( x + tol )
      if ( abs ( x - real ( j, kind = rk8 ) ) <= tol ) then
        j = j - 1
      end if
      if ( j < 0 ) then
        j = 0
      end if
      r0 = im1r - j
    end if

    if ( l0 < r0 .or. l1 < r1 ) then

      j = l0
      k = l1
      xj = xm1l + real ( j-im1l, kind = rk8 ) * h
      xk = xl + real ( k - il, kind = rk8 ) * h

      do

        if ( k < r1 .and. ( xk <= xj .or. j == r0 ) ) then
          p = k
          k = k + 1
          xk = xk + h
        else
          p = j
          j = j + 1
          xj = xj + h
        end if

        ntri = ntri + 1

        if ( maxti < ntri ) then
          ierror = 9
          return
        end if

        til(1,ntri) = j
        til(2,ntri) = p
        til(3,ntri) = k

        if ( r0 <= j .and. r1 <= k ) then
          exit
        end if

      end do

    end if
!
!  Generate paths of closed walk between scan lines Y+H and Y.
!
    if ( xm1l < xl ) then
      do j = im1l+1, l0
        lw = lw + 1
        cwalk(lw) = j
      end do
      lw = lw + 1
      cwalk(lw) = il
    else
      do j = l1, il, -1
        lw = lw + 1
        cwalk(lw) = j
      end do
    end if

    if ( xr < xm1r ) then
      do j = im1r-1, r0, -1
        rw = rw - 1
        cwalk(rw) = j
      end do
      rw = rw - 1
      cwalk(rw) = ir
    else
      do j = r1, ir
        rw = rw - 1
        cwalk(rw) = j
      end do
    end if

100 continue

    y = y - h
    im1l = il
    im1r = ir
    xm1l = xl
    xm1r = xr

  end do
!
!  Add last path of left walk and shift indices of right walk.
!
  if ( m == 0 ) then
    rw = rw + 1
  else
    do j = il+1, ir-1
      lw = lw + 1
      cwalk(lw) = j
    end do
  end if

  if ( rw <= lw ) then
    ierror = 10
    return
  end if

  do j = rw, maxcw
    lw = lw + 1
    cwalk(lw) = cwalk(j)
  end do

  ncw = lw

  return
end
subroutine isftdw ( l, u, k, lda, a, map )

!*****************************************************************************80
!
!! isftdw() sifts A(*,MAP(L)) down a heap of size U.
!
!  Discussion: 
!
!    Sift A(*,MAP(L)) down a heap of size U.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, integer L, U, the lower and upper index of part of heap.
!
!    Input, integer K, the dimension of points.
!
!    Input, integer LDA, the leading dimension of array A in calling routine.
!
!    Input, integer A(1:K,1:*); see routine IHPSRT.
!
!    Input/output, integer MAP(1:*); see routine IHPSRT.
!
  implicit none

  integer lda

  integer a(lda,*)
  integer i
  logical iless
  integer j
  integer k
  integer l
  integer map(*)
  integer u
  integer t

  i = l
  j = 2 * i
  t = map(i)

  do while ( j <= u )

    if ( j < u ) then
      if ( iless ( k, a(1,map(j)), a(1,map(j+1)) ) ) then
        j = j + 1
      end if
    end if

    if ( iless ( k, a(1,map(j)), a(1,t) ) ) then
      exit
    end if

    map(i) = map(j)
    i = j
    j = 2 * i

  end do

  map(i) = t

  return
end
subroutine i4vec_indicator ( n, a )

!*****************************************************************************80
!
!! i4vec_indicator() sets an I4VEC to the indicator vector.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Parameters:
!
!    Input, integer N, the number of elements of A.
!
!    Output, integer A(N), the array to be initialized.
!
  implicit none

  integer n

  integer a(n)
  integer i

  do i = 1, n
    a(i) = i
  end do

  return
end
subroutine jnhole ( itophv, angspc, angtol, nvc, nvert, maxvc, maxpv,  &
  maxiw, maxwk, vcl, hvl, pvl, iang, iwk, wk, ierror )

!*****************************************************************************80
!
!! jnhole() joins a hole boundary to the boundary of a polygon.
!
!  Discussion: 
!
!    Join hole boundary to boundary of polygon containing hole
!    by finding a cut edge originating from the top vertex of hole
!    to a point on outer polygon boundary above it.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, integer ITOPHV, the index in PVL of top vertex of hole.
!
!    Input, real ( kind = rk8 ) ANGSPC, the angle spacing parameter used in 
!    controlling the vertices to be considered as an endpoint of a separator.
!
!    Input, real ( kind = rk8 ) ANGTOL, the angle tolerance parameter used 
!    in accepting separator(s).
!
!    Input/output, integer NVC, the number of positions used in VCL array.
!
!    Input/output, integer NVERT, the number of positions used in PVL array.
!
!    Input, integer MAXVC, the maximum size available for VCL array.
!
!    Input, integer MAXPV, the maximum size available for PVL array.
!
!    Input, integer MAXIW, the maximum size available for IWK array; should 
!    be about 3 times number of vertices in outer polygon.
!
!    Input, integer MAXWK, the maximum size available for WK array; should 
!    be about 5 times number of vertices in outer polygon.
!
!    Input/output, real ( kind = rk8 ) VCL(1:2,1:NVC),the vertex coordinate list.
!
!    Input, integer HVL(1:*), the head vertex list.
!
!    Input/output, integer PVL(1:4,1:NVERT), real ( kind = rk8 ) IANG(1:NVERT), 
!    the polygon vertex list and interior angles.
!
!    Workspace, integer IWK(1:MAXIW).
!
!    Workspace, real ( kind = rk8 ) WK(1:MAXWK).
!
!    Output, integer IERROR, error flag.  On abnormal return,
!    IERROR is set to 3, 5, 6, 7, 206 to 210, 212, 218, or 219.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  integer maxiw
  integer maxpv
  integer maxvc
  integer maxwk

  real ( kind = rk8 ) angle
  real ( kind = rk8 ) angspc
  real ( kind = rk8 ) angtol
  real ( kind = rk8 ) dy
  integer, parameter :: edgv = 4
  integer hv
  integer hvl(*)
  real ( kind = rk8 ) iang(maxpv)
  integer ierror
  integer ilft
  integer ipoly
  integer irgt
  integer itophv
  integer iv
  integer ivs
  integer iwk(maxiw)
  integer l
  integer, parameter :: loc = 1
  integer lv
  integer lw
  integer, parameter :: msglvl = 0
  integer nvc
  integer nvert
  real ( kind = rk8 ), parameter :: pi = 3.141592653589793D+00
  integer, parameter :: polg = 2
  integer pvl(4,maxpv)
  real ( kind = rk8 ) s
  real ( kind = rk8 ) slft
  real ( kind = rk8 ) srgt
  integer, parameter :: succ = 3
  integer succil
  integer succir
  real ( kind = rk8 ) tol
  real ( kind = rk8 ) vcl(2,maxvc)
  integer vp
  integer vr
  integer vs
  integer vv
  integer w
  real ( kind = rk8 ) wk(maxwk)
  integer ww
  real ( kind = rk8 ) xint
  real ( kind = rk8 ) xlft
  real ( kind = rk8 ) xrgt
  real ( kind = rk8 ) xt
  real ( kind = rk8 ) xv
  real ( kind = rk8 ) xvs
  real ( kind = rk8 ) ylft
  real ( kind = rk8 ) yrgt
  real ( kind = rk8 ) yt
  real ( kind = rk8 ) ytmtol
  real ( kind = rk8 ) ytptol
  real ( kind = rk8 ) yv
  real ( kind = rk8 ) yvs
!
  ierror = 0
  tol = 100.0D+00 * epsilon ( tol )

  if ( maxvc < nvc + 3 ) then
    ierror = 3
    return
  end if

  if ( maxpv < nvert+5 ) then
    ierror = 5
    return
  end if
!
!  Determine 'closest' vertices on outer boundary which are to the
!  left and right of top vertex of hole and on the horizontal line
!  through top vertex. The two closest vertices must be on edges
!  which intersect the horizontal line and are partially above the
!  line. Ties are broken (in the case of a vertex on a cut edge)
!  by choosing the vertex on the edge of maximum or minimum dx/dy
!  slope depending on whether the vertex is to the left or right
!  of top vertex, respectively.
!
  ipoly = pvl(polg,itophv)
  lv = pvl(loc,itophv)
  xt = vcl(1,lv)
  yt = vcl(2,lv)
  dy = 0.0D+00
  hv = hvl(ipoly)
  iv = hv
  yv = vcl(2,pvl(loc,iv))

  do

    iv = pvl(succ,iv)
    yvs = vcl(2,pvl(loc,iv))
    dy = max ( dy, abs ( yvs - yv ) )
    yv = yvs

    if ( iv == hv ) then
      exit
    end if

  end do

  ytmtol = yt - tol * dy
  ytptol = yt + tol * dy
  ilft = 0
  irgt = 0
  xlft = 0.0D+00
  xrgt = 0.0D+00
  hv = hvl(ipoly)
  iv = hv
  lv = pvl(loc,iv)
  xv = vcl(1,lv)
  yv = vcl(2,lv)

20 continue

  ivs = pvl(succ,iv)
  lv = pvl(loc,ivs)
  xvs = vcl(1,lv)
  yvs = vcl(2,lv)

  if ( yv <= ytptol .and. ytptol < yvs ) then

    if ( ytmtol <= yv ) then
      if ( xt < xv ) then
        if ( xv < xrgt .or. irgt == 0 ) then
          irgt = iv
          xrgt = xv
          yrgt = yv
          srgt = (xvs - xv ) / ( yvs - yv )
        else if ( xv == xrgt ) then
          s = ( xvs - xv ) / ( yvs - yv )
          if ( s < srgt ) then
            irgt = iv
            yrgt = yv
            srgt = s
          end if
        end if
      end if
    else
      xint = ( yt - yv ) * ( xvs - xv ) / ( yvs - yv ) + xv
      if ( xt < xint ) then
        if ( xint < xrgt .or. irgt == 0 ) then
          irgt = iv
          xrgt = xint
          yrgt = yt
        end if
      end if
    end if

  else if ( ytptol < yv .and. yvs <= ytptol ) then

    if ( ytmtol <= yvs ) then
      if ( xvs < xt ) then
        if ( xlft < xvs .or. ilft == 0 ) then
          ilft = iv
          xlft = xvs
          ylft = yvs
          slft = ( xvs - xv ) / ( yvs - yv )
        else if ( xvs == xlft ) then
          s = ( xvs - xv ) / ( yvs - yv )
          if ( slft < s ) then
            ilft = iv
            ylft = yvs
            slft = s
          end if
        end if
      end if
    else
      xint = ( yt - yv ) * ( xvs - xv ) / ( yvs - yv ) + xv
      if ( xint < xt ) then
        if ( xlft < xint .or. ilft == 0 ) then
          ilft = iv
          xlft = xint
          ylft = yt
        end if
      end if
    end if
  end if

  iv = ivs
  xv = xvs
  yv = yvs

  if ( iv /= hv ) then
    go to 20
  end if

  if ( ilft == 0 .or. irgt  ==  0 ) then
   ierror = 218
   return
  end if
!
!  Temporarily modify PVL to pass the subregion 'above' top vertex
!  of hole to routine RESVRT. The top vertex is the reflex vertex
!  passed to RESVRT (in the temporary subregion, it has interior
!  angle PI). This causes one separator to be chosen by RESVRT
!  and its other endpoint is above the top vertex.
!
  succil = pvl(succ,ilft)
  succir = pvl(succ,irgt)
  vcl(1,nvc+2) = xlft
  vcl(2,nvc+2) = ylft
  vcl(1,nvc+3) = xrgt
  vcl(2,nvc+3) = yrgt
  vp = nvert + 3
  vr = nvert + 4
  vs = nvert + 5

  iang(vr) = angle ( xlft, ylft, xt, yt, xrgt, yrgt )

  if ( iang(vr) < pi - tol .or. pi + tol < iang(vr) ) then
    ierror = 219
    return
  end if

  pvl(loc,vp) = nvc + 2
  pvl(polg,vp) = ipoly
  pvl(succ,vp) = vr
  pvl(edgv,vp) = 0
  pvl(loc,vr) = pvl(loc,itophv)
  pvl(polg,vr) = ipoly
  pvl(succ,vr) = vs
  pvl(edgv,vr) = 0
  pvl(loc,vs) = nvc + 3
  pvl(polg,vs) = ipoly
  pvl(succ,vs) = succir
  pvl(edgv,vs) = pvl(edgv,irgt)
  pvl(succ,ilft) = vp
  lv = pvl(loc,ilft)
  iang(vp) = angle ( vcl(1,lv), vcl(2,lv), xlft, ylft, xt, yt )
  lv = pvl(loc,succir)
  iang(vs) = angle ( xt, yt, xrgt, yrgt, vcl(1,lv), vcl(2,lv) )
  w = 0

  call resvrt ( vr, angspc, angtol, nvc, nvert, maxvc, maxpv, maxiw, maxwk, &
    vcl, pvl, iang, w, ww, iwk, wk, ierror )
!
!  Remove temporary modification to PVL. There are three cases
!  depending on where the endpoint of separator is located:
!  successor of closest vertex to the right of top vertex,
!  predecessor of closest vertex to the left of top vertex,
!  or neither of these.
!
  if ( pvl(succ,vs) == w ) then
    pvl(succ,ilft) = succil
    pvl(succ,irgt) = w
    pvl(edgv,irgt) = pvl(edgv,vs)
    if ( 0 < pvl(edgv,irgt) ) then
      pvl(edgv,pvl(edgv,irgt)) = irgt
    end if
  else if ( pvl(succ,ilft) == w ) then
    pvl(succ,w) = succil
  else
    pvl(succ,ilft) = succil
  end if

  if ( ierror /= 0 ) then
    return
  end if
!
!  Update PVL with cut edge, i.e. join linked lists of vertices
!  of the hole polygon and the outer boundary polygon into one
!  linked list of vertices by adding the cut edge from the top
!  vertex of hole to the vertex on the outer boundary.
!
  nvert = nvert + 2
  vv = nvert - 1
  ww = nvert
  lv = pvl(loc,itophv)
  lw = pvl(loc,w)
  pvl(loc,vv) = lv
  pvl(loc,ww) = lw
  pvl(polg,vv) = ipoly
  pvl(polg,ww) = ipoly
  pvl(succ,vv) = pvl(succ,itophv)
  pvl(succ,ww) = pvl(succ,w)
  pvl(succ,itophv) = ww
  pvl(succ,w) = vv
  pvl(edgv,vv) = pvl(edgv,itophv)
  pvl(edgv,ww) = pvl(edgv,w)
  pvl(edgv,itophv) = w
  pvl(edgv,w) = itophv

  if ( 0 < pvl(edgv,vv) ) then
    pvl(edgv,pvl(edgv,vv)) = vv
  end if

  if ( 0 < pvl(edgv,ww) ) then
    pvl(edgv,pvl(edgv,ww)) = ww
  end if

  l = pvl(loc,pvl(succ,vv))
  iang(vv) = angle ( vcl(1,lw), vcl(2,lw), vcl(1,lv), vcl(2,lv), vcl(1,l), &
    vcl(2,l) )
  iang(itophv) = iang(itophv) - iang(vv)
  l = pvl(loc,pvl(succ,ww))
  iang(ww) = angle ( vcl(1,lv), vcl(2,lv), vcl(1,lw), vcl(2,lw), vcl(1,l), &
    vcl(2,l) )
  iang(w) = iang(w) - iang(ww)

  if ( msglvl == 2 ) then
    write ( *,600) itophv,w,vcl(1,lv),vcl(2,lv),vcl(1,lw),vcl(2,lw)
  end if

600 format (1x,2i7,4f15.7)

  return
end
subroutine lop ( itr, ind, mxedg, top, ldv, vcl, til, tedg, sptr )

!*****************************************************************************80
!
!! lop() applies the local optimization procedure to two triangles.
!
!  Discussion: 
!
!    Apply local optimization procedure to two triangles
!    indicated by ITR(1) and ITR(2). This may result in swapping
!    diagonal edge of quadrilateral.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, integer ITR(1:2), the indices of triangles for LOP.
!
!    Input, integer IND(1:2), indices indicating common edge of triangles.
!
!    Input, integer MXEDG, the maximum index of edge to be considered for LOP.
!
!    Input/output, integer TOP, the index of SPTR indicating top of stack.
!
!    Input, integer LDV, the leading dimension of VCL in calling routine.
!
!    Input, real ( kind = rk8 ) VCL(1:2,1:*), the vertex coordinate list.
!
!    Input/output, integer TIL(1:3,1:*), the triangle incidence list.
!
!    Input/output, integer TEDG(1:3,1:*), the triangle edge indices; 
!    see routine CVDTRI.
!
!    Input/output, integer SPTR(1:*), stack pointers; see routine CVDTRI.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  integer ldv

  integer a
  integer b
  integer c
  integer d
  integer diaedg
  integer i
  integer i4_wrap
  integer iedg
  integer in
  integer ind(2)
  integer ind1m1
  integer ind1p1
  integer ind2m1
  integer ind2p1
  integer itr(2)
  integer j
  integer mxedg
  integer top
  integer sptr(*)
  integer tedg(3,*)
  integer til(3,*)
  real ( kind = rk8 ) vcl(ldv,*)
!
!  Common edge is BC, other two vertices are A and D.
!
  iedg = tedg(ind(1),itr(1))
  sptr(iedg) = -1

  ind1m1 = i4_wrap ( ind(1) - 1, 1, 3 )
  ind1p1 = i4_wrap ( ind(1) + 1, 1, 3 )
  ind2m1 = i4_wrap ( ind(2) - 1, 1, 3 )
  ind2p1 = i4_wrap ( ind(2) + 1, 1, 3 )

  b = til(ind(1),itr(1))
  c = til(ind1p1,itr(1))
  a = til(ind1m1,itr(1))
  d = til(ind2m1,itr(2))

  in = diaedg ( vcl(1,d), vcl(2,d), vcl(1,c), vcl(2,c), vcl(1,a), vcl(2,a), &
    vcl(1,b), vcl(2,b) )

  if ( in == 1 ) then
!
!  Check if four edges of quadrilateral should be put on LOP
!  stack, and swap edge BC for AD.
!
   i = tedg(ind1m1,itr(1))

   do j = 1, 4

      if ( j == 2 ) then
        i = tedg(ind1p1,itr(1))
      else if ( j == 3 ) then
        i = tedg(ind2m1,itr(2))
      else if ( j == 4 ) then
        i = tedg(ind2p1,itr(2))
      end if

      if ( i <= mxedg ) then
        if ( sptr(i) == -1 ) then
          sptr(i) = top
          top = i
        end if
      end if

    end do

    til(ind1p1,itr(1)) = d
    til(ind2p1,itr(2)) = a
    tedg(ind(1),itr(1)) = tedg(ind2p1,itr(2))
    tedg(ind(2),itr(2)) = tedg(ind1p1,itr(1))
    tedg(ind1p1,itr(1)) = iedg
    tedg(ind2p1,itr(2)) = iedg

  end if

  return
end
function lrline ( xu, yu, xv1, yv1, xv2, yv2, dv )

!*****************************************************************************80
!
!! lrline() determines if a point is left of, right or, or on a directed line.
!
!  Discussion:
!
!    The directed line is parallel to, and at a signed distance DV from
!    a directed base line from (XV1,YV1) to (XV2,YV2).
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, real ( kind = rk8 ) XU, YU, the coordinates of the point whose
!    position relative to the directed line is to be determined.
!
!    Input, real ( kind = rk8 ) XV1, YV1, XV2, YV2, the coordinates of two points
!    that determine the directed base line.
!
!    Input, real ( kind = rk8 ) DV, the signed distance of the directed line 
!    from the directed base line through the points (XV1,YV1) and (XV2,YV2).  
!    DV is positive for a line to the left of the base line.
! 
!    Output, integer LRLINE, the result:
!    +1, the point is to the right of the directed line;
!     0, the point is on the directed line;
!    -1, the point is to the left of the directed line.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  real ( kind = rk8 ) dv
  real ( kind = rk8 ) dx
  real ( kind = rk8 ) dxu
  real ( kind = rk8 ) dy
  real ( kind = rk8 ) dyu
  integer lrline
  real ( kind = rk8 ) t
  real ( kind = rk8 ) tol
  real ( kind = rk8 ) tolabs
  real ( kind = rk8 ) xu
  real ( kind = rk8 ) xv1
  real ( kind = rk8 ) xv2
  real ( kind = rk8 ) yu
  real ( kind = rk8 ) yv1
  real ( kind = rk8 ) yv2

  tol = 100.0D+00 * epsilon ( tol )

  dx = xv2 - xv1
  dy = yv2 - yv1
  dxu = xu - xv1
  dyu = yu - yv1

  tolabs = tol * max ( abs ( dx ), abs ( dy ), abs ( dxu ), &
    abs ( dyu ), abs ( dv ) )

  t = dy * dxu - dx * dyu + dv * sqrt ( dx * dx + dy * dy )

  if ( tolabs < t ) then
    lrline = 1
  else if ( -tolabs <= t ) then
    lrline = 0
  else
    lrline = -1
  end if

  return
end
subroutine lufac ( a, lda, n, tol, ipvt, singlr )

!*****************************************************************************80
!
!! lufac() computes the LU factorization of a matrix.
!
!  Discussion: 
!
!    Obtain LU factorization of matrix A, i.e. apply Gaussian
!    elimination with partial pivoting to A.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input/output, real ( kind = rk8 ) A(1:N,1:N), the matrix.  On input, 
!    the N by N matrix to be factored.  On output, the upper triangular 
!    matrix U and multipliers of unit lower triangular matrix L (if matrix 
!    A is nonsingular).
!
!    Input, integer LDA, the leading dimension of array A in calling routine.
!
!    Input, integer N, the order of matrix A.
!
!    Input, real ( kind = rk8 ) TOL, the relative tolerance for detecting 
!    singularity of A.
!
!    Output, integer IPVT(1:N-1), the pivot indices.
!
!    Output, logical SINGLR, is .TRUE. if matrix is singular; this occurs 
!    when the magnitude of a pivot element is <= TOL*MAX(|A(I,J)|).
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  integer lda
  integer n

  real ( kind = rk8 ) a(lda,n)
  integer i
  integer ipvt(n-1)
  integer j
  integer k
  integer kp1
  integer m
  logical singlr
  real ( kind = rk8 ) t
  real ( kind = rk8 ) tol
  real ( kind = rk8 ) tolabs

  if ( n < 1 ) then
    return
  end if

  singlr = .true.

  t = 0.0D+00
  do j = 1, n
    do i = 1, n
      t = max ( t, abs ( a(i,j) ) )
    end do
  end do

  tolabs = tol * t

  do k = 1, n-1

    kp1 = k + 1
    m = k

    do i = k+1, n
      if ( abs ( a(m,k) ) < abs ( a(i,k) ) ) then
        m = i
      end if
    end do

    ipvt(k) = m
    t = a(m,k)
    a(m,k) = a(k,k)
    a(k,k) = t

    if ( abs ( t) <= tolabs ) then
      return
    end if

    do i = k+1, n
      a(i,k) = a(i,k) / t
    end do

    do j = k+1, n

      t = a(m,j)
      a(m,j) = a(k,j)
      a(k,j) = t

      if ( t /= 0.0E+00 ) then

        do i = k+1, n
          a(i,j) = a(i,j) - a(i,k) * t
        end do

      end if

    end do

  end do

  if ( tolabs < abs ( a(n,n) ) ) then
    singlr = .false.
  end if

  return
end
subroutine lusol ( a, lda, n, ipvt, b )

!*****************************************************************************80
!
!! lusol() solves a linear system with an LU factored matrix.
!
!  Discussion: 
!
!    Solve linear system A*X = B given LU factorization of A.
!    It is assumed that A is nonsingular.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, real ( kind = rk8 ) A(1:N,1:N), contains factors L, U output 
!    from routine LUFAC.
!
!    Input, integer LDA, the leading dimension of array A in calling routine.
!
!    Input, integer N, the order of matrix A.
!
!    Input, integer IPVT(1:N-1), the pivot indices from routine LUFAC.
!
!    Input/output, B(1:N).  On input, the right hand side vector.
!    On output, the solution vector X.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  integer lda
  integer n

  real ( kind = rk8 ) a(lda,n)
  real ( kind = rk8 ) b(n)
  integer ipvt(n-1)
  integer i
  integer k
  integer m
  real ( kind = rk8 ) t
!
!  Forward elimination
!
  do k = 1, n-1

    m = ipvt(k)
    t = b(m)
    b(m) = b(k)
    b(k) = t

    do i = k+1, n
      b(i) = b(i) - a(i,k) * t
    end do

  end do
!
!  Back substitution
!
  do k = n, 2, -1

    t = b(k) / a(k,k)
    b(k) = t

    do i = 1, k-1
      b(i) = b(i) - a(i,k) * t
    end do

  end do

  b(1) = b(1) / a(1,1)

  return
end
function mdf2 ( x, y, wsq, nev, ifv, listev, ivrt, edgval, vrtval, vcl )

!*****************************************************************************80
!
!! mdf2() evaluates the heuristic mesh distribution function at (X,Y).
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, real ( kind = rk8 ) X, Y, the coordinates of point.
!
!    Input, real ( kind = rk8 ) WSQ, the square of the width of the polygon 
!    containing (X,Y).
!
!    Input, integer NEV, IFV, LISTEV(1:NEV), output from routine PRMDF2.
!
!    Input, integer IVRT(1:*), output from DSMDF2.
!
!    Input, real ( kind = rk8 ) EDGVAL(1:*), output from DSMDF2.
!
!    Input, real ( kind = rk8 ) VRTVAL(1:*), output from DSMDF2.
!
!    Input, real ( kind = rk8 ) VCL(1:2,1:*), the vertex coordinate list.
!
!    Output, real ( kind = rk8 ) MDF2, the reciprocal of square of length 
!    scale at (X,Y).
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  integer nev

  real ( kind = rk8 ) d
  real ( kind = rk8 ) edgval(*)
  integer i
  integer ifv
  integer ivrt(*)
  integer j
  integer k
  integer kp1
  integer listev(nev)
  real ( kind = rk8 ) mdf2
  real ( kind = rk8 ) s
  real ( kind = rk8 ) vcl(2,*)
  real ( kind = rk8 ) vrtval(*)
  real ( kind = rk8 ) wsq
  real ( kind = rk8 ) x
  real ( kind = rk8 ) x0
  real ( kind = rk8 ) x1
  real ( kind = rk8 ) y
  real ( kind = rk8 ) y0
  real ( kind = rk8 ) y1

  s = wsq

  do i = 1, nev

    k = listev(i)

    if ( k < 0 ) then
      k = -k
      d = ( vcl(1,k) - x )**2 + ( vcl(2,k) - y )**2
      d = max ( 0.25D+00 * d, vrtval(k) )
      s = min ( s, d )
    else
      kp1 = k + 1
      if ( i == nev .and. 0 < ifv ) then
        kp1 = ifv
      end if
      j = ivrt(kp1)
      x0 = x - vcl(1,j)
      y0 = y - vcl(2,j)
      x1 = vcl(1,ivrt(k)) - vcl(1,j)
      y1 = vcl(2,ivrt(k)) - vcl(2,j)

      if ( x0 * x1 + y0 * y1 <= 0.0D+00 ) then
        d = x0**2 + y0**2
      else
        x0 = x0 - x1
        y0 = y0 - y1
        if ( 0.0D+00 <= x0 * x1 + y0 * y1 ) then
          d = x0**2 + y0**2
        else
          d = ( x1 * y0 - y1 * x0 )**2 / ( x1**2 + y1**2 )
        end if
      end if

      d = max ( 0.25D+00 * d, edgval(k) )
      s = min ( s, d )

    end if

  end do

  mdf2 = 1.0D+00 / s

  return
end
subroutine mfdec2 ( hflag, umdf, kappa, angspc, angtol, dmin, nmin, ntrid,  &
  nvc, npolg, nvert, maxvc, maxhv, maxpv, maxiw, maxwk, vcl, regnum, hvl,  &
  pvl, iang, ivrt, xivrt, widsq, edgval, vrtval, area, psi, iwk, wk, ierror )

!*****************************************************************************80
!
!! mfdec2() subdivides polygons to decrease mesh distribution variation.
!
!  Discussion: 
!
!    Further subdivide convex polygons so that the variation
!    of heuristic or user-supplied mesh distribution function in
!    each polygon is limited.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, logical HFLAG, is .TRUE. if heuristic mdf, .FALSE. if 
!    user-supplied mdf.
!
!    Input, external UMDF, a user-supplied mdf, of the form
!
!      function umdf ( x, y )
!      real ( kind = rk8 ) umdf
!      real ( kind = rk8 ) x
!      real ( kind = rk8 ) y
!
!    Input, real ( kind = rk8 ) KAPPA, the mesh smoothness parameter in 
!    interval [0.0,1.0].
!
!    Input, real ( kind = rk8 ) ANGSPC, the angle spacing parameter in radians 
!    used to determine extra points as possible endpoints of separators.
!
!    Input, real ( kind = rk8 ) ANGTOL, the angle tolerance parameter in 
!    radians used in accepting separators.
!
!    Input, real ( kind = rk8 ) DMIN, a parameter used to determine if 
!    variation of mdf in polygon is 'sufficiently high'.
!
!    Input, integer NMIN, a parameter used to determine if 'sufficiently large'
!    number of triangles in polygon.
!
!    Input, integer NTRID, the desired number of triangles in mesh.
!
!    Input/output, integer NVC, the number of vertex coordinates or 
!    positions used in VCL array.
!
!    Input/output, integer NPOLG, the number of polygonal subregions or 
!    positions used in HVL array.
!
!    Input/output, integer NVERT, the number of polygon vertices or positions 
!    used in PVL array.
!
!    Input, integer MAXVC, the maximum size available for VCL array.
!
!    Input, integer MAXHV, the maximum size available for HVL, REGNUM, AREA, 
!    PSI arrays.
!
!    Input, integer MAXPV, the maximum size available for PVL, IANG arrays.
!
!    Input, integer MAXIW, the maximum size available for IWK array; should 
!    be about 3*NVRT + INT(2*PI/ANGSPC) where NVRT is maximum number of
!    vertices in a convex polygon of the (input) decomposition.
!
!    Input, integer MAXWK, the maximum size available for WK array; should 
!    be about NPOLG + 3*(NVRT + INT(2*PI/ANGSPC)) + 2.
!
!    Input/output, real ( kind = rk8 ) VCL(1:2,1:NVC), the vertex coordinate list.
!
!    Input/output, integer REGNUM(1:NPOLG), the region numbers.
!
!    Input/output, HVL(1:NPOLG), the head vertex list.
!
!    Input/output, PVL(1:4,1:NVERT), IANG(1:NVERT), the polygon vertex list and
!    interior angles.
!
!    Input, integer IVRT(1:NVERT), integer XIVRT(1:NPOLG+1), 
!    real ( kind = rk8 ) WIDSQ(1:NPOLG), real ( kind = rk8 ) EDGVAL(1:NVERT),
!    real ( kind = rk8 ) VRTVAL(1:NVC), arrays output from routine DSMDF2;
!    if .NOT. HFLAG then only first two arrays exist.
!
!    Input/output, real ( kind = rk8 ) AREA(1:NPOLG), the area of convex polygons 
!    in decomposition.
!
!    Output, real ( kind = rk8 ) PSI(1:NPOLG), the mean mdf values in the
!    convex polygons
!
!    Workspace, integer IWK(1:MAXIW).
!
!    Workspace, real ( kind = rk8 ) WK(1:MAXWK).
!
!    Output, integer IERROR, error flag.  On abnormal return,
!    IERROR is set to 3, 4, 5, 6, 7, 200, or 222.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  integer maxhv
  integer maxiw
  integer maxpv
  integer maxvc
  integer maxwk
  integer nvc
  integer nvert

  real ( kind = rk8 ) alpha
  real ( kind = rk8 ) angsp2
  real ( kind = rk8 ) angspc
  real ( kind = rk8 ) angtol
  real ( kind = rk8 ) area(maxhv)
  real ( kind = rk8 ) areapg
  real ( kind = rk8 ) arearg
  real ( kind = rk8 ) c1
  real ( kind = rk8 ) c2
  real ( kind = rk8 ) cosalp
  real ( kind = rk8 ) ctrx
  real ( kind = rk8 ) ctry
  real ( kind = rk8 ) delta
  real ( kind = rk8 ) dmin
  real ( kind = rk8 ) dx
  real ( kind = rk8 ) dy
  real ( kind = rk8 ) edgval(nvert)
  logical hflag
  integer hvl(maxhv)
  integer i
  integer i1
  integer i2
  real ( kind = rk8 ) iang(maxpv)
  integer ierror
  integer ifv
  integer ii
  integer inc
  integer indpvl
  real ( kind = rk8 ) intreg
  integer ivrt(nvert)
  integer iwk(maxiw)
  integer j
  integer k
  real ( kind = rk8 ) kappa
  integer l
  integer listev
  integer, parameter :: loc = 1
  integer m
  integer maxn
  real ( kind = rk8 ) mdfint
  integer mdftr
  real ( kind = rk8 ) mean
  integer nev
  integer nmin
  integer np
  integer npolg
  integer ntrid
  real ( kind = rk8 ) numer
  integer nvrt
  real ( kind = rk8 ) nwarea
  integer p
  real ( kind = rk8 ), parameter :: pi = 3.141592653589793D+00
  real ( kind = rk8 ) pi2
  real ( kind = rk8 ) psi(maxhv)
  integer pvl(4,maxpv)
  real ( kind = rk8 ) r
  integer regnum(maxhv)
  real ( kind = rk8 ) sinalp
  real ( kind = rk8 ) stdv
  integer, parameter :: succ = 3
  real ( kind = rk8 ) sumx
  real ( kind = rk8 ) sumy
  real ( kind = rk8 ) theta1
  real ( kind = rk8 ) theta2
  real ( kind = rk8 ) tol
  real ( kind = rk8 ) umdf
  integer v
  real ( kind = rk8 ) vcl(2,maxvc)
  real ( kind = rk8 ) vrtval(nvc)
  integer w
  real ( kind = rk8 ) widsq(npolg)
  real ( kind = rk8 ) wk(maxwk)
  real ( kind = rk8 ) wsq
  real ( kind = rk8 ) x1
  real ( kind = rk8 ) x2
  integer xc
  integer xivrt(npolg+1)
  real ( kind = rk8 ) y1
  real ( kind = rk8 ) y2
  integer yc

  external umdf

  ierror = 0
  tol = 100.0D+00 * epsilon ( tol )
!
!  WK(1:NPOLG) is used for MDF standard deviation in polygons.
!  Compute AREARG = area of region and INTREG = estimated integral
!  of MDF2(X,Y) or UMDF(X,Y).
!
  nvrt = 0
  do i = 1, npolg
    nvrt = max ( nvrt, xivrt(i+1) - xivrt(i) )
  end do

  if ( hflag .and. maxiw < 2 * nvrt ) then
    ierror = 6
    return
  end if

  if ( maxwk < npolg + 3 * nvrt + 2 ) then
    ierror = 7
    return
  end if

  listev = 1
  xc = npolg + 1
  yc = xc + nvrt + 1
  mdftr = yc + nvrt + 1
  arearg = 0.0D+00
  intreg = 0.0D+00
  nev = -1

  do i = 1, npolg

    if ( hflag ) then
      wsq = widsq(i)
      call prmdf2 ( i, wsq, ivrt, xivrt, edgval, vrtval, nev, ifv, iwk(listev) )
    end if

    if ( nev == 0 ) then
      psi(i) = 1.0D+00 / wsq
      wk(i) = 0.0D+00
      mdfint = psi(i) * area(i)
    else

      nvrt = xivrt(i+1) - xivrt(i)
      k = xivrt(i)

      sumx = 0.0D+00
      sumy = 0.0D+00
      do j = 0, nvrt-1
        l = ivrt(k)
        wk(xc+j) = vcl(1,l)
        wk(yc+j) = vcl(2,l)
        sumx = sumx + wk(xc+j)
        sumy = sumy + wk(yc+j)
        k = k + 1
      end do

      ctrx = sumx / real ( nvrt, kind = rk8 )
      ctry = sumy / real ( nvrt, kind = rk8 )

      do j = 0, nvrt-1
        wk(xc+j) = wk(xc+j) - ctrx
        wk(yc+j) = wk(yc+j) - ctry
      end do

      wk(xc+nvrt) = wk(xc)
      wk(yc+nvrt) = wk(yc)

      call intpg ( nvrt, wk(xc), wk(yc), ctrx, ctry, area(i), hflag, umdf, &
        wsq, nev, ifv, iwk(listev), ivrt, edgval, vrtval, vcl, mdfint, &
        psi(i), wk(i), wk(mdftr) )

    end if

    arearg = arearg + area(i)
    intreg = intreg + mdfint

  end do
!
!  If HFLAG, compute mean mdf values from KAPPA, etc. Scale PSI(I)'s
!  so that integral in region is 1. Determine which polygons need to
!  be further subdivided (indicated by negative PSI(I) value).
!
  if ( hflag ) then
    c1 = ( 1.0D+00 - kappa ) / intreg
    c2 = kappa / arearg
  else
    c1 = 1.0D+00 / intreg
    c2 = 0.0D+00
  end if

  do i = 1, npolg

    psi(i) = psi(i) * c1 + c2

    if ( psi(i) * dmin < c1 * wk(i) ) then
      if ( nmin < ntrid * psi(i) * area(i) ) then
        psi(i) = -psi(i)
      end if
    end if

  end do
!
!  Further subdivide polygons for which DMIN < STDV/MEAN and
!  NMIN < (estimated number of triangles).
!
  angsp2 = 2.0D+00 * angspc
  pi2 = 2.0D+00 * pi
  inc = int ( pi2 / angspc )
  nev = 0
  np = npolg
  xc = 1

  do i = 1, np

    if ( psi(i) < 0.0D+00 ) then

      if ( hflag ) then
        wsq = widsq(i)
        call prmdf2 ( i, wsq, ivrt, xivrt, edgval, vrtval, nev, ifv, &
          iwk(listev) )

      end if

      l = npolg + 1
      k = i

60    continue

      if ( npolg < k ) then
        go to 130
      end if

70       continue

         if ( 0.0D+00 <= psi(k) ) then
           go to 120
         end if

          nvrt = 0
          sumx = 0.0D+00
          sumy = 0.0D+00
          j = hvl(k)

          do

            nvrt = nvrt + 1
            m = pvl(loc,j)
            sumx = sumx + vcl(1,m)
            sumy = sumy + vcl(2,m)
            j = pvl(succ,j)

            if ( j == hvl(k) ) then
              exit
            end if

          end do

          ctrx = sumx / real ( nvrt, kind = rk8 )
          ctry = sumy / real ( nvrt, kind = rk8 )
          maxn = nvrt + inc

          if ( maxiw < nev + maxn + 1 ) then
            ierror = 6
            return
          else if ( maxwk < 3*maxn + 2 ) then
            ierror = 7
            return
          end if

          yc = xc + maxn + 1
          mdftr = yc + maxn + 1
          indpvl = listev + nev
          nvrt = 0
          m = pvl(loc,j)
          x1 = vcl(1,m) - ctrx
          y1 = vcl(2,m) - ctry
          wk(xc) = x1
          wk(yc) = y1
          theta1 = atan2(y1,x1)
          p = j
          iwk(indpvl) = j

90        continue

             j = pvl(succ,j)
             m = pvl(loc,j)
             x2 = vcl(1,m) - ctrx
             y2 = vcl(2,m) - ctry

             theta2 = atan2 ( y2, x2 )
             if ( theta2 < theta1 ) then
               theta2 = theta2 + pi2
             end if

             delta = theta2 - theta1

             if ( angsp2 <= delta ) then

               m = int ( delta / angspc )
               delta = delta / real ( m, kind = rk8 )
               dx = x2 - x1
               dy = y2 - y1
               numer = x1 * dy - y1 * dx
               alpha = theta1

               do ii = 1, m-1
                 alpha = alpha + delta
                 cosalp = cos(alpha)
                 sinalp = sin(alpha)
                 r = numer / ( dy * cosalp - dx * sinalp )
                 nvrt = nvrt + 1
                 wk(xc+nvrt) = r * cosalp
                 wk(yc+nvrt) = r * sinalp
                 iwk(indpvl+nvrt) = -p
               end do

             end if

             nvrt = nvrt + 1
             wk(xc+nvrt) = x2
             wk(yc+nvrt) = y2
             x1 = x2
             y1 = y2
             theta1 = theta2
             p = j
             iwk(indpvl+nvrt) = j

          if ( j /= hvl(k) ) then
            go to 90
          end if


            call intpg ( nvrt, wk(xc), wk(yc), ctrx, ctry, area(k), hflag, &
              umdf, wsq, nev, ifv, iwk(listev), ivrt, edgval, vrtval, &
              vcl, mdfint, mean, stdv, wk(mdftr) )

            psi(k) = mean * c1 + c2

            if ( psi(k) * dmin < c1 * stdv ) then

               if ( nmin < ntrid * psi(k) * area(k) ) then

              call sepmdf ( angtol, nvrt, wk(xc), wk(yc), area(k), &
                          mean, wk(mdftr), iwk(indpvl), iang, i1, i2 )

              if ( i1 < 0 ) then

                if ( maxwk < yc + 3*nvrt ) then
                  ierror = 7
                  return
                end if

                call sepshp ( angtol, nvrt, wk(xc), wk(yc), &
                  iwk(indpvl), iang, i1, i2, wk(yc+nvrt+1), ierror )

                if ( ierror /= 0 ) then
                  return
                end if

              end if

              if ( i1 < 0 ) then
                ierror = 222
                return
              end if

              v = iwk(indpvl+i1)

              if ( v < 0 ) then
                 call insvr2 ( wk(xc+i1)+ctrx, wk(yc+i1)+ctry, -v, &
                   nvc, nvert, maxvc, maxpv, vcl, pvl, iang, v, ierror )
                 if ( ierror /= 0 ) then
                   return
                 end if
              end if

              w = iwk(indpvl+i2)

              if ( w < 0 ) then
                 call insvr2 ( wk(xc+i2)+ctrx, wk(yc+i2)+ctry, -w, &
                   nvc, nvert, maxvc, maxpv, vcl, pvl, iang, w, ierror )
                 if ( ierror /= 0 ) then
                   return
                 end if
              end if

          call insed2 ( v, w, npolg, nvert, maxhv, maxpv, vcl, &
            regnum, hvl, pvl, iang, ierror )

          if ( ierror /= 0 ) then
            return
          end if

          nvrt = 0
          j = hvl(k)

          do

            m = pvl(loc,j)
            wk(xc+nvrt) = vcl(1,m)
            wk(yc+nvrt) = vcl(2,m)
            nvrt = nvrt + 1
            j = pvl(succ,j)

            if ( j == hvl(k) ) then
              exit
            end if

          end do

          nwarea = areapg ( nvrt, wk(xc), wk(yc) ) * 0.5D+00
          area(npolg) = area(k) - nwarea
          area(k) = nwarea
          psi(k) = -psi(k)
          psi(npolg) = psi(k)

        end if

      end if

      go to 70

120   continue

      if ( k == i ) then
        k = l
      else
        k = k + 1
      end if

      go to 60

130   continue

    end if

  end do

  return
end
function minang ( xr, yr, xs, ys, ind, alpha, theta, vcl, pvl, iang )

!*****************************************************************************80
!
!! minang() determines the minimum of the boundary angles for a separator.
!
!  Discussion: 
!
!    Determine the minimum of the 4 angles at the boundary
!    resulting from using edge joining vertices (XR,YR) and
!    (XS,YS) as a separator.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, real ( kind = rk8 ) XR, YR, the coordinates of the reflex vertex.
!
!    Input, real ( kind = rk8 ) XS, YS, the coordinates of other endpoint of 
!    possible separator.
!
!    Input, integer IND, if positive then (XS,YS) has index IND in PVL; else
!    (XS,YS) is on edge joining vertices with indices -IND
!    and SUCC(-IND) in PVL.
!
!    Input, real ( kind = rk8 ) ALPHA, the polar angle of (XS,YS) with respect
!    to (XR,YR).
!
!    Input, real ( kind = rk8 ) THETA, the interior angle at reflex vertex.
!
!    Input, real ( kind = rk8 ) VCL(1:2,1:*), the vertex coordinate list.
!
!    Input, integer PVL(1:4,1:*), real ( kind = rk8 ) IANG(1:*), the polygon 
!    vertex list, interior angles.
!
!    Output, real ( kind = rk8 ) MINANG, the minimum of the 4 angles in radians.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  real ( kind = rk8 ) alpha
  real ( kind = rk8 ) ang
  real ( kind = rk8 ) angle
  real ( kind = rk8 ) beta1
  real ( kind = rk8 ) iang(*)
  integer ind
  integer j
  integer l
  integer, parameter :: loc = 1
  real ( kind = rk8 ) minang
  real ( kind = rk8 ), parameter :: pi = 3.141592653589793D+00
  integer pvl(4,*)
  integer, parameter :: succ = 3
  real ( kind = rk8 ) theta
  real ( kind = rk8 ) vcl(2,*)
  real ( kind = rk8 ) xr
  real ( kind = rk8 ) xs
  real ( kind = rk8 ) yr
  real ( kind = rk8 ) ys

  if ( 0 < ind ) then
    j = pvl(succ,ind)
    ang = iang(ind)
  else
    j = pvl(succ,-ind)
    ang = pi
  end if

  l = pvl(loc,j)
  beta1 = angle ( xr, yr, xs, ys, vcl(1,l), vcl(2,l) )

  minang = min ( alpha, theta - alpha, ang - beta1, beta1 )

  return
end
subroutine mmasep ( angtol, xc, yc, indpvl, iang, v, w, i1, i2 )

!*****************************************************************************80
!
!! mmasep() chooses the best of four separators by the max-min angle criterion.
!
!  Discussion: 
!
!    Find best of four possible separators according to
!    max-min angle criterion.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, real ( kind = rk8 ) ANGTOL, the angle tolerance parameter (in 
!    radians) for accepting separator.
!
!    Input, real ( kind = rk8 ) XC(0:NVRT), YC(0:NVRT), the coordinates of 
!    polygon vertices in counter clockwise order where NVRT is number of 
!    vertices; (XC(0),YC(0)) = (XC(NVRT),YC(NVRT)).
!
!    Input, integer INDPVL(0:NVRT), indices in PVL of vertices; INDPVL(I) = -K
!    if (XC(I),YC(I)) is extra vertex inserted on edge from K to PVL(SUCC,K).
!
!    Input, real ( kind = rk8 ) IANG(1:*), the interior angle array.
!
!    Input, integer V(1:2), W(1:2), indices in XC, YC in range 0 to NVRT-1; 
!    four possible separators are V(I),W(J), I,J = 1,2.
!
!    Output, integer I1, I2, indices in range 0 to NVRT-1 of best separator
!    according to max-min angle criterion; I1 = -1
!    if no satisfactory separator is found.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  real ( kind = rk8 ) alpha
  real ( kind = rk8 ) angle
  real ( kind = rk8 ) angmax
  real ( kind = rk8 ) angmin
  real ( kind = rk8 ) angtol
  real ( kind = rk8 ) beta
  real ( kind = rk8 ) delta
  real ( kind = rk8 ) gamma
  integer i
  integer i1
  integer i2
  real ( kind = rk8 ) iang(*)
  integer indpvl(0:*)
  integer j
  integer k
  integer l
  integer m
  real ( kind = rk8 ), parameter :: pi = 3.141592653589793D+00
  real ( kind = rk8 ) tol
  integer v(2)
  integer w(2)
  real ( kind = rk8 ) xc(0:*)
  real ( kind = rk8 ) yc(0:*)

  tol = 100.0D+00 * epsilon ( tol )
  angmax = 0.0D+00

  do i = 1, 2

    l = v(i)
    k = indpvl(l)

    if ( 0 < k ) then
      alpha = iang(k)
    else
      alpha = pi
    end if

    do j = 1, 2

      m = w(j)

      if ( l /= m ) then

        k = indpvl(m)

        if ( 0 < k ) then
          beta = iang(k)
        else
          beta = pi
        end if

        gamma = angle ( xc(m), yc(m), xc(l), yc(l), xc(l+1), yc(l+1) )

        delta = angle ( xc(l), yc(l), xc(m), yc(m), xc(m+1), yc(m+1) )

        angmin = min ( gamma, alpha-gamma, delta, beta-delta )

        if ( angmax < angmin ) then
          angmax = angmin
          i1 = l
          i2 = m
        end if

      end if

    end do

  end do

  if ( angmax < angtol ) then
    i1 = -1
  end if

  return
end
subroutine mtredg ( utype, i1, i2, i3, ibndry, nt, til, tedg )

!*****************************************************************************80
!
!! mtredg() sets fields for a triangle as needed by routine TMERGE.
!
!  Discussion: 
!
!    Set fields for triangle as needed by routine TMERGE.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, logical UTYPE, is .TRUE. iff triangle contains two 'U' vertices.
!
!    Input, integer I1, I2, I3, the indices of 3 triangle vertices in VCL; 
!    the first two indices also belong to the next merge edge.
!
!    Input, integer IBNDRY, the index of boundary edge for TEDG.
!
!    Input/output, integer NT, the number of entries in TIL, TEDG so far.
!
!    Input/output, integer TIL(1:NT), the triangle incidence list.
!
!    Input/output, TEDG(1:NT), the triangle edge indices; see routine TMERGE.
!
  implicit none

  integer i1
  integer i2
  integer i3
  integer ibndry
  integer nt
  integer tedg(3,*)
  integer til(3,*)
  logical utype

  nt = nt + 1
  til(1,nt) = i1
  til(2,nt) = i2
  til(3,nt) = i3
  tedg(1,nt) = nt

  if ( utype ) then
    tedg(2,nt) = nt - 1
    tedg(3,nt) = ibndry
  else
    tedg(2,nt) = ibndry
    tedg(3,nt) = nt - 1
  end if

  return
end
function prime ( k )

!*****************************************************************************80
!
!! prime() returns a prime greater than a given integer K.
!
!  Discussion: 
!
!    Return a prime greater than or equal to K (if possible) from internal 
!    array of primes.  More primes can be added if desired.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, integer K, a positive integer.
!
!    Output, integer PRIME, the smallest prime greater than or equal to
!    K from internal array (or largest in array).
!
  implicit none

  integer, parameter :: nprime = 150

  integer k
  integer l
  integer m
  integer prime
  integer, save, dimension ( nprime ) :: primes = (/ &
    17,31,47,61,79,97,113,127,149,163,179,193,211,227,241, &
    257,271,293,307,331,353,379,401,431,457,479,503,541,563,587, &
    613,641,673,701,727,751,773,797,821,853,877,907,929,953,977, &
    1009,1049,1087,1123,1163,1201,1237,1277,1319,1361,1399,1433, &
    1471,1511,1543,1579,1613,1657,1699,1741,1783,1831,1873,1931, &
    1973,2017,2069,2129,2203,2267,2333,2389,2441,2503,2557,2609, &
    2663,2719,2789,2851,2917,2999,3061,3137,3209,3299,3371,3449, &
    3527,3613,3697,3779,3863,3947,4049,4211,4421,4621,4813,5011, &
    5227,5413,5623,5813,6011,6211,6421,6619,6823,7013,7211,7411, &
    7621,7817,8011,8219,8419,8623,8819,9011,9221,9413,9613,9811, &
    10037,10211,10427,10613,10831,11027,11213,11411,11617,11813, &
    12011,12211,12413,12611,12821,13033,13217,13411,13613,13829, &
    14011 /)
  integer u

  if ( k <= primes(1) ) then
    prime = primes(1)
    return
  else if ( primes(nprime) <= k ) then
    prime = primes(nprime)
    return
  end if
!
!  Use binary search to find prime greater than or equal to K.
!
  l = 1
  u = nprime

  do

    m = ( l + u ) / 2

    if ( k < primes(m) ) then
      u = m - 1
    else if ( primes(m) < k ) then
      l = m + 1
    else
      prime = primes(m)
      return
    end if

    if ( u < l ) then
      exit
    end if

  end do

  prime = primes(u+1)

  return
end
subroutine prmdf2 ( ipoly, wsq, ivrt, xivrt, edgval, vrtval, nev, ifv, listev )

!*****************************************************************************80
!
!! prmdf2() preprocesses a mesh distribution function evaluation.
!
!  Discussion: 
!
!    Preprocessing step for evaluating mesh distribution
!    function in polygon IPOLY.  The edges and vertices for
!    which distances must be computed are determined.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, integer IPOLY, the index of the polygon.
!
!    Input, real ( kind = rk8 ) WSQ, the square of the width of polygon IPOLY.
!
!    Input, integer IVRT(1:*), the indices of polygon vertices in 
!    VCL, ordered by polygon.
!
!    Input, integer XIVRT(1:*), pointers to first vertex of each polygon 
!    in IVRT; vertices of polygon IPOLY are IVRT(I) for I from
!    XIVRT(IPOLY) to XIVRT(IPOLY+1)-1.
!
!    Input, real ( kind = rk8 ) EDGVAL(1:*), a value associated with each edge 
!    of the decomposition.
!
!    Input, real ( kind = rk8 ) VRTVAL(1:*), a value associated with each vertex 
!    of the decomposition.
!
!    Output, integer NEV, the number of edges and vertices for which distances
!    must be evaluated.
!
!    Output, integer IFV, the index of first vertex XIVRT(IPOLY) if LISTEV(NEV)
!    = XIVRT(IPOLY+1) - 1; 0 otherwise.
!
!    Output, integer LISTEV(1:*), an array of length 
!    <= [XIVRT(IPOLY+1)-XIVRT(IPOLY)]*2, containing indices of edges and 
!    vertices mentioned above; indices of vertices are negated.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  real ( kind = rk8 ) edgval(*)
  integer i
  integer ifv
  integer im1
  integer ipoly
  integer ivrt(*)
  integer j
  integer l
  integer listev(*)
  integer nev
  real ( kind = rk8 ) vrtval(*)
  real ( kind = rk8 ) wsq
  integer xivrt(*)

  ifv = 0
  nev = 0
  im1 = xivrt(ipoly+1) - 1
  l = im1

  do i = xivrt(ipoly), l

    j = ivrt(i)

    if ( vrtval(j) < min ( edgval(i), edgval(im1) ) ) then
      nev = nev + 1
      listev(nev) = -j
    end if

    if ( edgval(i) < wsq ) then
      nev = nev + 1
      listev(nev) = i
    end if

    im1 = i

  end do

  if ( 0 < nev ) then
    if ( listev(nev) == l ) then
      ifv = xivrt(ipoly)
    end if
  end if

  return
end
subroutine ptpolg ( dim, ldv, nv, inc, pgind, vcl, pt, nrml, dtol, inout )

!*****************************************************************************80
!
!! ptpolg() determines if a point is in, on or outside a polygon.
!
!  Discussion: 
!
!    Determine whether a point lies inside, outside, or on
!    boundary of a planar polygon in 2 or 3 dimensional space.
!    It is assumed that point lies in plane of polygon.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, integer DIM, the dimension of the polygon (2 or 3).
!
!    Input, integer LDV, the leading dimension of VCL array in calling routine.
!
!    Input, integer NV, the number of vertices in polygon.
!
!    Input, integer INC, the increment for PGIND indicating indices of polygon.
!
!    Input, integer PGIND(0:NV*INC), indices in VCL of polygon vertices are in
!    PGIND(0), PGIND(INC), ..., PGIND(NV*INC) with first and
!    last vertices identical.
!
!    Input, real ( kind = rk8 ) VCL(1:DIM,1:*), the vertex coordinate list.
!
!    Input, real ( kind = rk8 ) PT(1:DIM), the point for which in/out test is
!    applied.
!
!    Input, real ( kind = rk8 ) NRML(1:3), the unit normal vector of plane 
!    containing polygon, with vertices oriented counter clockwise with
!    respect to the normal (used iff DIM = 3);
!    The normal is assumed to be (0,0,1) if DIM = 2.
!
!    Input, real ( kind = rk8 ) DTOL, an absolute tolerance to determine 
!    whether a point is on a line or plane.
!
!    Output, integer INOUT, point PT is:
!    +1, inside the polygon, 
!     0, on boundary of polygon, 
!    -1, outside polygon;
!    -2 if error in input parameters.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  integer dim
  integer ldv

  real ( kind = rk8 ) cp(3)
  real ( kind = rk8 ) de(3)
  real ( kind = rk8 ) dir(3)
  real ( kind = rk8 ) dist
  real ( kind = rk8 ) dotp
  real ( kind = rk8 ) dtol
  integer i
  integer inc
  integer inout
  integer j
  integer k
  integer l
  integer la
  integer lb
  real ( kind = rk8 ) len1
  real ( kind = rk8 ) len2
  integer m
  integer n
  real ( kind = rk8 ) nr(4)
  real ( kind = rk8 ) nrml(3)
  integer nv
  integer pgind(0:*)
  real ( kind = rk8 ) pt(dim)
  real ( kind = rk8 ) rhs(3)
  integer s
  integer sa
  integer sb
  real ( kind = rk8 ) t
  real ( kind = rk8 ) ta
  real ( kind = rk8 ) tol
  real ( kind = rk8 ) vcl(ldv,*)

  tol = 100.0D+00 * epsilon ( tol )

  inout = -2

  if ( dim < 2 .or. 3 < dim ) then
    return
  end if
!
!  Direction of ray is from PT through midpoint of first edge
!  such that PT is not collinear with edge. NR is normal of plane
!  containing ray, which is also orthogonal to NRML.
!
  i = 0
  lb = pgind(0)

10 continue

    i = i + 1

    if ( nv <= i ) then
      return
    end if

    la = lb
    lb = pgind(i*inc)

    do j = 1, dim
      de(j) = vcl(j,lb) - vcl(j,la)
      dir(j) = pt(j) - vcl(j,la)
    end do

    if ( dim == 2 ) then
      len1 = de(1)**2 + de(2)**2
      len2 = dir(1)**2 + dir(2)**2
    else
      len1 = de(1)**2 + de(2)**2 + de(3)**2
      len2 = dir(1)**2 + dir(2)**2 + dir(3)**2
    end if

    if ( len1 == 0.0D+00 ) then
      go to 10
    else if ( len2 == 0.0D+00 ) then
      inout = 0
      return
    end if

    if ( dim == 2 ) then
      dotp = abs ( de(1) * dir(1) + de(2) * dir(2)) / sqrt(len1*len2)
    else if ( dim == 3 ) then
      dotp = abs ( de(1) * dir(1) + de(2) * dir(2) + de(3) * dir(3) ) &
        / sqrt(len1*len2)
    end if

    if ( 1.0D+00 - tol <= dotp ) then
      go to 10
    end if

    if ( dim == 2 ) then
      dir(1) = 0.5D+00 * ( vcl(1,la) + vcl(1,lb) ) - pt(1)
      dir(2) = 0.5D+00 * ( vcl(2,la) + vcl(2,lb) ) - pt(2)
      dist = sqrt ( dir(1)**2 + dir(2)**2 )
      dir(1) = dir(1) / dist
      dir(2) = dir(2) / dist
      dir(3) = 0.0D+00
      nr(1) = -dir(2)
      nr(2) = dir(1)
      nr(3) = 0.0D+00
      nr(4) = nr(1) * pt(1) + nr(2) * pt(2)
      dist = nr(1) * vcl(1,lb) + nr(2) * vcl(2,lb) - nr(4)
    else if ( dim == 3 ) then
      dir(1) = 0.5D+00 * ( vcl(1,la) + vcl(1,lb) ) - pt(1)
      dir(2) = 0.5D+00 * ( vcl(2,la) + vcl(2,lb) ) - pt(2)
      dir(3) = 0.5D+00 * ( vcl(3,la) + vcl(3,lb) ) - pt(3)
      dist = sqrt ( dir(1)**2 + dir(2)**2 + dir(3)**2 )

      dir(1) = dir(1) / dist
      dir(2) = dir(2) / dist
      dir(3) = dir(3) / dist

      nr(1) = nrml(2)*dir(3) - nrml(3)*dir(2)
      nr(2) = nrml(3)*dir(1) - nrml(1)*dir(3)
      nr(3) = nrml(1)*dir(2) - nrml(2)*dir(1)
      nr(4) = nr(1)*pt(1) + nr(2)*pt(2) + nr(3)*pt(3)
      dist = nr(1)*vcl(1,lb)+nr(2)*vcl(2,lb)+nr(3)*vcl(3,lb) - nr(4)
    end if

    if ( 0.0D+00 < dist ) then
      sb = 1
    else
      sb = -1
    end if

    m = 1
    if ( abs ( dir(1) ) < abs ( dir(2) ) ) then
      m = 2
    end if

    if ( abs ( dir(m) ) < abs ( dir(3) ) ) then
      m = 3
    end if

    k = 1
!
!  For remaining edges of polygon, check whether ray intersects edge.
!  Vertices or edges lying on ray are handled by looking at preceding
!  and succeeding edges not lying on ray.
!
  n = i
  i = i + 1

30 continue

   la = lb
   lb = pgind(i*inc)
   sa = sb

   if ( dim == 2 ) then
     dist = nr(1) * vcl(1,lb) + nr(2)*vcl(2,lb) - nr(4)
   else if ( dim == 3 ) then
     dist = nr(1) * vcl(1,lb) + nr(2)*vcl(2,lb) + nr(3)*vcl(3,lb)- nr(4)
   end if

   if ( abs ( dist) <= dtol ) then
     sb = 0
   else if ( 0.0D+00 < dist ) then
     sb = 1
   else
     sb = -1
   end if

   s = sa * sb

   if ( s < 0 ) then

      if ( dim == 2 ) then
         de(1) = vcl(1,la) - vcl(1,lb)
         de(2) = vcl(2,la) - vcl(2,lb)
         rhs(1) = vcl(1,la) - pt(1)
         rhs(2) = vcl(2,la) - pt(2)
         t = ( rhs(1) * de(2) - rhs(2) * de(1) ) &
           / ( dir(1) * de(2) - dir(2) * de(1) )
      else if ( dim == 3 ) then
         de(1) = vcl(1,la) - vcl(1,lb)
         de(2) = vcl(2,la) - vcl(2,lb)
         de(3) = vcl(3,la) - vcl(3,lb)
         rhs(1) = vcl(1,la) - pt(1)
         rhs(2) = vcl(2,la) - pt(2)
         rhs(3) = vcl(3,la) - pt(3)
         cp(1) = dir(2) * de(3) - dir(3) * de(2)
         cp(2) = dir(3) * de(1) - dir(1) * de(3)
         cp(3) = dir(1) * de(2) - dir(2) * de(1)

         l = 1
         if ( abs ( cp(1) ) < abs ( cp(2) ) ) then
           l = 2
         end if
         if ( abs ( cp(l) ) < abs ( cp(3) ) ) then
           l = 3
         end if

         if ( l == 1 ) then
           t = ( rhs(2) * de(3) - rhs(3) * de(2) ) / cp(1)
         else if ( l == 2 ) then
           t = ( rhs(3) * de(1) - rhs(1) * de(3) ) / cp(2)
         else
           t = ( rhs(1) * de(2) - rhs(2) * de(1) ) / cp(3)
         end if

      end if

      if ( dtol < t ) then
         k = k + 1
      else if ( -dtol <= t ) then
         inout = 0
         return
      end if

   else if ( s == 0 ) then

      l = lb
40    continue
      i = i + 1

      if ( nv < i ) then
        i = 1
      end if

      if ( i == n) then
        return
      end if

      la = lb
      lb = pgind(i*inc)

    if ( dim == 2 ) then
      dist = nr(1) * vcl(1,lb) + nr(2) * vcl(2,lb) - nr(4)
    else
      dist = nr(1) * vcl(1,lb) + nr(2) * vcl(2,lb) + nr(3) * vcl(3,lb) - nr(4)
    end if

    if ( abs ( dist) <= dtol ) then
      go to 40
    else if ( 0.0D+00 < dist ) then
      sb = 1
    else
      sb = -1
    end if

    t = ( vcl(m,l) - pt(m) ) / dir(m)

    if ( abs ( t) <= dtol ) then
      inout = 0
      return
    end if

    if ( la /= l ) then
      ta = ( vcl(m,la) - pt(m) ) / dir(m)
      if ( abs ( ta ) <= dtol .or. t * ta < 0.0D+00 ) then
        inout = 0
        return
      end if
    end if

    if ( sa * sb < 0 .and. 0.0D+00 < t ) then
      k = k + 1
    end if

  end if

  i = i + 1

  if ( nv < i ) then
    i = 1
  end if

  if ( i /= n ) then
    go to 30
  end if
!
!  Point lies inside polygon if number of intersections K is odd.
!
  if ( mod ( k, 2 ) == 1 ) then
    inout = 1
  else
    inout = -1
  end if

  return
end
subroutine r8mat_print ( lda, m, n, a, title )

!*****************************************************************************80
!
!! r8mat_print() prints an R8MAT.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    John Burkardt
!
!  Parameters:
!
!    Input, integer LDA, the leading dimension of A.
!
!    Input, integer M, the number of rows in A.
!
!    Input, integer N, the number of columns in A.
!
!    Input, real ( kind = rk8 ) A(LDA,N), the matrix to be printed.
!
!    Input, character ( len = * ) TITLE, a title to be printed first.
!    TITLE may be blank.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  integer lda
  integer n

  real ( kind = rk8 ) a(lda,n)
  integer i
  integer j
  integer jhi
  integer jlo
  integer m
  character ( len = * ) title

  if ( title /= ' ' ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) trim ( title )
  end if

  do jlo = 1, n, 5
    jhi = min ( jlo + 4, n )
    write ( *, '(a)' ) ' '
    write ( *, '(6x,5(i7,7x))' ) ( j, j = jlo, jhi )
    write ( *, '(a)' ) ' '
    do i = 1, m
      write ( *, '(i6,5g14.6)' ) i, a(i,jlo:jhi)
    end do
  end do

  return
end
function radians_to_degrees ( angle )

!*****************************************************************************80
!
!! radians_to_degrees() converts an angle from radians to degrees.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    John Burkardt
!
!  Parameters:
!
!    Input, real ( kind = rk8 ) ANGLE, an angle in radians.
!
!    Output, real ( kind = rk8 ) RADIANS_TO_DEGREES, the equivalent angle
!    in degrees.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  real ( kind = rk8 ) angle
  real ( kind = rk8 ), parameter :: pi = 3.141592653589793D+00
  real ( kind = rk8 ) radians_to_degrees

  radians_to_degrees = ( angle / pi ) * 180.0D+00

  return
end
subroutine randpt ( k, n, seed, axis, nptav, scale, trans, lda, a )

!*****************************************************************************80
!
!! randpt() generates N random K-dimensional points from the uniform distribution.
!
!  Discussion: 
!
!    Generate N random K-dimensional points from the uniform distribution.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, integer K, the dimension of points.
!
!    Input, integer N, the number of random points.
!
!    Input/output, integer SEED, a seed for pseudo random number generator.
!
!    Input, integer AXIS, integer NPTAV; if AXIS < 1 or K < AXIS, then uniform 
!    random points are generated; if 1 <= AXIS <= K, then an average of NPTAV
!    uniform random points are generated with the same AXIS
!    coordinate on about N/NPTAV random parallel hyperplanes.
!
!    Input, real ( kind = rk8 ) SCALE(K), TRANS(K), the scale and 
!    translation factors for coordinates 1 to K; the I-th coordinate of 
!    random point is R*SCALE(I) + TRANS(I) where 0 < R < 1.
!
!    Input, integer LDA, the leading dimension of array A in calling
!    routine; should be at least K.
!
!    Output, real ( kind = rk8 ) A(LDA,N), an array of N uniform random 
!    K-dimensional points.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  integer k
  integer lda
  integer n

  real ( kind = rk8 ) a(lda,n)
  integer axis
  integer i
  integer j
  integer m
  integer nptav
  real ( kind = rk8 ) r
  real ( kind = rk8 ) scale(k)
  integer seed
  real ( kind = rk8 ) trans(k)
  real ( kind = rk8 ) urand

  if ( axis < 1 .or. k < axis ) then

    do j = 1, n
      do i = 1, k
        a(i,j) = trans(i) + scale(i) * urand ( seed )
      end do
    end do

  else

    m = int ( urand ( seed ) * 2.0D+00 * nptav + 0.5D+00 )
    r = urand ( seed ) * scale(axis) + trans(axis)

    do j = 1, n

      do i = 1, k
        if ( i == axis ) then
          a(i,j) = r
        else
          a(i,j) = urand ( seed ) * scale(i) + trans(i)
        end if
      end do

      m = m - 1

      if ( m <= 0 ) then
        m = int ( urand ( seed ) * 2.0D+00 * nptav + 0.5D+00 )
        r = urand ( seed ) * scale(axis) + trans(axis)
      end if

    end do

  end if

  return
end
subroutine resvrt ( vr, angspc, angtol, nvc, nvert, maxvc, maxpv, maxiw,  &
  maxwk, vcl, pvl, iang, w1, w2, iwk, wk, ierror )

!*****************************************************************************80
!
!! resvrt() resolves a reflex vertex of a simply connected polygon.
!
!  Discussion: 
!
!    Resolve a reflex vertex of a simply connected polygon with
!    one or two separators. 
!
!    The reflex vertex must be a 'simple' vertex of the polygon.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, integer VR, the index in PVL of reflex vertex.
!
!    Input, real ( kind = rk8 ) ANGSPC, the angle spacing parameter used in
!    controlling the vertices to be considered as an endpoint of a separator.
!
!    Input, real ( kind = rk8 ) ANGTOL, the angle tolerance parameter used in 
!    accepting separator(s).
!
!    Input/output, integer NVC, the number of positions used 
!    in VCL array.
!
!    Input/output, integer NVERT, the number of positions used in PVL array.
!
!    Input, integer MAXVC, the maximum size available for VCL array.
!
!    Input, integer MAXPV, the maximum size available for PVL array.
!
!    Input, integer MAXIW, the maximum size available for IWK array; should 
!    be about 3 times number of vertices in polygon.
!
!    Input, integer MAXWK, the maximum size available for WK array; should 
!    be about 5 times number of vertices in polygon.
!
!    Input/output, real ( kind = rk8 ) VCL(1:2,1:NVC), the vertex coordinate list.
!
!    Input/output, integer PVL(1:4,1:NVERT), real ( kind = rk8 ) IANG(1:NVERT),
!    the polygon vertex list and interior angles.
!
!    Output, integer W1, the index in PVL of vertex which is the endpoint 
!    of separator in inner cone or right cone with respect to the reflex vertex.
!
!    Output, integer W2, is 0 if there is only one separator; else index 
!    in PVL of vertex which is endpoint of second separator in left cone.
!
!    Workspace, integer IWK(1:MAXIW).
!
!    Workspace, real ( kind = rk8 ) WK(1:MAXWK).
!
!    Output, integer IERROR, error flag.  On abnormal return,
!    IERROR is set to 3, 5, 6, 7, 206, 207, 208, 209, 210, or 212
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  integer maxiw
  integer maxpv
  integer maxvc
  integer maxwk

  real ( kind = rk8 ) angsep
  real ( kind = rk8 ) angspc
  real ( kind = rk8 ) angtol
  real ( kind = rk8 ) iang(maxpv)
  integer ierror
  integer i
  integer i1
  integer i2
  integer ivis
  integer ivor
  integer ivrt
  integer iwk(maxiw)
  integer l
  integer, parameter :: loc = 1
  integer maxn
  integer nvc
  integer nvert
  integer nvis
  integer nvor
  integer nvrt
  integer nvsvrt
  integer pvl(4,maxpv)
  integer, parameter :: succ = 3
  integer theta
  integer v
  real ( kind = rk8 ) vcl(2,maxvc)
  integer vr
  integer w1
  integer w2
  real ( kind = rk8 ) wk(maxwk)
  integer wkang
  integer xc
  real ( kind = rk8 ) xr
  integer xvor
  integer yc
  real ( kind = rk8 ) yr
  integer yvor
!
!  Determine number of vertices in polygon containing reflex vertex.
!
  ierror = 0
  nvrt = 0
  v = vr

  do

    v = pvl(succ,v)

    if ( v == vr ) then
      exit
    end if

    nvrt = nvrt + 1

  end do

  maxn = nvrt + int ( iang(vr) / angspc )
  l = pvl(loc,vr)
  xr = vcl(1,l)
  yr = vcl(2,l)
!
!  Set up work arrays for routine VISPOL, and determine whether there
!  is enough workspace. XC, YC are d.p. arrays of length NVRT in WK,
!  used for the coordinates of the polygon containing the reflex
!  vertex. MAXN positions are reserved for XC, YC since this is the
!  maximum space required by routine VISVRT. IVIS is an integer array
!  of length MAXN in IWK. IVRT is an integer array of length NVRT in
!  IWK used temporarily for storing indices of vertices in PVL.
!
  if ( maxiw < maxn + nvrt ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'RESVRT - Fatal error!'
    write ( *, '(a)' ) '  MAXIW < MAXN + NVRT.'
    ierror = 6
    return
  end if

  if ( maxwk < maxn + maxn ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'RESVRT - Fatal error!'
    write ( *, '(a)' ) '  MAXWK < MAXN + MAXN.'
    ierror = 7
    return
  end if

  ivis = 1
  ivrt = ivis + maxn
  xc = 1
  yc = xc + maxn
  v = pvl(succ,vr)

  do i = 0, nvrt-1
    l = pvl(loc,v)
    wk(xc+i) = vcl(1,l)
    wk(yc+i) = vcl(2,l)
    iwk(ivrt+i) = v
    v = pvl(succ,v)
  end do

  call vispol ( xr, yr, nvrt-1, wk(xc), wk(yc), nvis, iwk(ivis), ierror )

  if ( ierror /= 0 ) then
    return
  end if
!
!  XC, YC now contain visibility polygon coordinates. Update MAXN
!  and set up d.p. array THETA of length MAXN in WK for routine
!  VISVRT. Elements of IVIS are changed to indices of PVL after call.
!
  maxn = maxn - nvrt + nvis + 1
  theta = yc + maxn

  if ( maxwk < theta + maxn - 1 ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'RESVRT - Fatal error!'
    write ( *, '(a)' ) '  MAXWK < THETA + MAXN - 1.'
    ierror = 7
    return
  end if

  call visvrt ( angspc, xr, yr, nvis, wk(xc), wk(yc), iwk(ivis), maxn-1, &
    nvsvrt, wk(theta) )

  wk(theta+nvsvrt) = iang(vr)

  do i = ivis, ivis+nvsvrt
    l = iwk(i)
    if ( 0 <= l ) then
      iwk(i) = iwk(ivrt+l)
    else
      iwk(i) = -iwk(ivrt-l-1)
    end if
  end do
!
!  XC, YC now contain coordinates of visible vertices to be considered
!  as an endpoint of a separator. Set up work arrays for routine
!  VORNBR. Integer array IVOR and d.p. arrays XVOR, YVOR, each of
!  length NVSVRT+1, are added at the end of IWK and WK arrays.
!
  ivor = ivis + nvsvrt + 1
  xvor = theta + nvsvrt + 1
  yvor = xvor + nvsvrt + 1

  if ( maxiw < ivor + nvsvrt ) then
    ierror = 6
    return
  end if

  if ( maxwk < yvor + nvsvrt ) then
    ierror = 7
    return
  end if

  call vornbr ( xr, yr, nvsvrt, wk(xc), wk(yc), nvor, iwk(ivor), wk(xvor), &
    wk(yvor), ierror )

  if ( ierror /= 0 ) then
    return
  end if
!
!  Set up the array WKANG of length NVOR+1 <= NVSVRT+1 in WK for
!  routine FNDSEP. Only Voronoi neighbors are considered as an
!  endpoint of a separator in the first call to FNDSEP. If the
!  minimum angle created at the boundary by the separator(s) is too
!  small, then a second call is made to FNDSEP in which all visible
!  vertices are considered as an endpoint of a separator.
!
  wkang = xvor
  if ( iwk(ivor+nvor) == nvsvrt ) then
    nvor = nvor - 1
  end if

  if ( iwk(ivor) == 0 ) then
    ivor = ivor + 1
    nvor = nvor - 1
  end if

  call fndsep ( angtol+angtol, xr, yr, nvsvrt, wk(xc), wk(yc), iwk(ivis), &
    wk(theta), nvor, iwk(ivor), vcl, pvl, iang, angsep, i1, i2, wk(wkang) )

  if ( angsep < angtol ) then

    ivrt = ivis + nvsvrt + 1

    do i = 1, nvsvrt-1
      iwk(ivrt+i-1) = i
    end do

    call fndsep ( angtol+angtol, xr, yr, nvsvrt, wk(xc), wk(yc), iwk(ivis), &
      wk(theta), nvsvrt-2, iwk(ivrt), vcl, pvl, iang, angsep, i1, i2, &
      wk(wkang) )

  end if
!
!  Insert endpoint(s) of separator(s) in vertex coordinate list and
!  polygon vertex list data structures, if they are not yet there.
!
  if ( i2 == -1 ) then
    w2 = 0
  else if ( iwk(ivis+i2) < 0 ) then
    call insvr2 ( wk(xc+i2), wk(yc+i2), -iwk(ivis+i2), nvc, nvert, maxvc, &
      maxpv, vcl, pvl, iang, w2, ierror )
    if ( ierror /= 0 ) then
      return
    end if
  else
    w2 = iwk(ivis+i2)
  end if

  if ( iwk(ivis+i1) < 0 ) then
    call insvr2 ( wk(xc+i1), wk(yc+i1), -iwk(ivis+i1), nvc, nvert, maxvc, &
      maxpv, vcl, pvl, iang, w1, ierror )
    if ( ierror /= 0 ) then
      return
    end if
  else
    w1 = iwk(ivis+i1)
  end if

  return
end
subroutine rotiar ( n, arr, shift )

!*****************************************************************************80
!
!! rotiar() rotates the elements of an integer array.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, integer N, the number of elements of array.
!
!    Input/output, integer ARR(0:N-1), the array to be shifted.
!
!    Input, integer SHIFT, the amount of (left) shift or rotation; 
!    ARR(SHIFT) on input becomes ARR(0) on output.
!
  implicit none

  integer n

  integer a
  integer arr(0:n-1)
  integer b
  integer i
  integer j
  integer k
  integer l
  integer m
  integer r
  integer sh
  integer shift
  integer t

  sh = mod ( shift, n )

  if ( sh < 0 ) then
    sh = sh + n
  end if

  if ( sh == 0 ) then
    return
  end if

  a = n
  b = sh

  do
    r = mod ( a, b )
    a = b
    b = r
    if ( r <= 0 ) then
      exit
    end if
  end do

  m = n / a - 1

  do i = 0, a-1

    t = arr(i)
    k = i

    do j = 1, m
      l = k + sh
      if ( n <= l ) then
        l = l - n
      end if
      arr(k) = arr(l)
      k = l
    end do

    arr(k) = t

  end do

  return
end
subroutine rotipg ( xeye, yeye, nvrt, xc, yc, ierror )

!*****************************************************************************80
!
!! rotipg() rotates the vertex indices of a simple polygon.
!
!  Discussion: 
!
!    Rotate the indices of the vertices of a simple polygon
!    and possibly insert one vertex so that (XC(0),YC(0)) is the
!    point on the horizontal line through (XEYE,YEYE) and on the
!    boundary of the polygon which is closest to and to the right
!    of (XEYE,YEYE). (XEYE,YEYE) is an eyepoint in the interior or
!    blocked exterior of the polygon. In the former (latter) case,
!    the vertices must be in counter clockwise (CW) order.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, real ( kind = rk8 ) XEYE, YEYE, the coordinates of eyepoint.
!
!    Input/output, integer NVRT, the number of vertices on boundary of simple 
!    polygon.  On output, NVRT is increased by 1 if the closest vertex
!    is a new vertex.
!
!    Input/output, real ( kind = rk8 ) XC(0:NVRT), YC(0:NVRT), the vertices 
!    of polygon in counter clockwise (or clockwise) order if eyepoint is 
!    interior (or blocked exterior);
!      (XC(0),YC(0)) = (XC(NVRT),YC(NVRT))
!    On output, the polygon vertices in same orientation
!    as input but with indices rotated and possibly
!      (XC(0),YC(0)) = (XC(NVRT),YC(NVRT)) has been added.
!
!    Output, integer IERROR, error flag.  On abnormal return,
!    IERROR is set to 205.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  integer nvrt

  integer a
  integer b
  real ( kind = rk8 ) dy
  integer i
  integer ierror
  integer irgt
  integer j
  integer k
  integer l
  integer m
  integer n
  integer r
  real ( kind = rk8 ) tol
  real ( kind = rk8 ) xc(0:nvrt+1)
  real ( kind = rk8 ) xeye
  real ( kind = rk8 ) xint
  real ( kind = rk8 ) xrgt
  real ( kind = rk8 ) xt
  real ( kind = rk8 ) yc(0:nvrt+1)
  real ( kind = rk8 ) yeye
  real ( kind = rk8 ) yeyemt
  real ( kind = rk8 ) yeyept
  real ( kind = rk8 ) yt

  ierror = 0
  tol = 100.0D+00 * epsilon ( tol )

  dy = 0.0D+00
  do i = 0, nvrt-1
    dy = max ( dy, abs ( yc(i+1) - yc(i) ) )
  end do

  yeyemt = yeye - tol * dy
  yeyept = yeye + tol * dy
  n = nvrt + 1
  irgt = n
  xrgt = 0.0D+00
!
!  Determine closest point on boundary which is to the right of
!  (XEYE,YEYE) and on the horizontal line through (XEYE,YEYE).
!  The closest point must be on an edge which intersects the
!  horizontal line and has (XEYE,YEYE) to its left.
!
  do i = 0, nvrt-1

    if ( yeyept < yc(i) .or. yc(i+1) < yeyemt ) then
      cycle
    end if

    if ( yc(i) < yeyemt .and. yeyept < yc(i+1) ) then
      xint = ( yeye - yc(i) ) * ( xc(i+1) - xc(i) ) &
        / ( yc(i+1) - yc(i) ) + xc(i)
      if ( xeye < xint ) then
         if ( xint < xrgt .or. irgt == n ) then
            irgt = -(i + 1)
            xrgt = xint
         end if
      end if
    else if ( yeyemt <= yc(i) .and. yeyept < yc(i+1) ) then
      if ( xeye < xc(i) ) then
         if ( xc(i) < xrgt .or. irgt == n ) then
            irgt = i
            xrgt = xc(i)
         end if
      end if
    else if ( yc(i) < yeyemt .and. yc(i+1) <= yeyept ) then
      if ( xeye < xc(i+1) ) then
         if ( xc(i+1) < xrgt .or. irgt == n ) then
            irgt = i + 1
            xrgt = xc(i+1)
         end if
      end if
    end if

  end do

  if ( irgt == n ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'ROTIPG - Fatal error!'
    write ( *, '(a)' ) '  IRGT == N.'
    ierror = 205
    return
  end if

  if ( irgt == 0 .or. irgt == nvrt ) then
    return
  end if

  if ( irgt < 0 ) then
    irgt = -irgt
    do i = nvrt, irgt, -1
      xc(i+1) = xc(i)
      yc(i+1) = yc(i)
    end do
    xc(irgt) = xrgt
    yc(irgt) = yeye
    nvrt = nvrt + 1
  end if
!
!  Rotate the indices of the vertices so that (XC(IRGT),YC(IRGT))
!  becomes (XC(0),YC(0)). Compute A = GCD(NVRT,IRGT).
!
  a = nvrt
  b = irgt

  do

    r = mod ( a, b )
    a = b
    b = r

    if ( r <= 0 ) then
      exit
    end if

  end do

  m = nvrt / a - 1

  do i = 0, a-1

    xt = xc(i)
    yt = yc(i)
    k = i

    do j = 1, m
      l = k + irgt
      if ( nvrt <= l ) then
        l = l - nvrt
      end if
      xc(k) = xc(l)
      yc(k) = yc(l)
      k = l
    end do

    xc(k) = xt
    yc(k) = yt

  end do

  xc(nvrt) = xc(0)
  yc(nvrt) = yc(0)

  return
end
subroutine rotpg ( nvrt, xc, yc, i1, i2, ibot, costh, sinth )

!*****************************************************************************80
!
!! rotpg() rotates a convex polygon.
!
!  Discussion: 
!
!    Rotate convex polygon so that a line segment joining two
!    of its vertices is parallel to y-axis.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, integer NVRT, the number of vertices on the boundary of
!    the convex polygon.
!
!    Input/output, real ( kind = rk8 ) XC(0:NVRT), YC(0:NVRT).  The vertex 
!    coordinates in counter clockwise order;
!      (XC(0),YC(0)) = (XC(NVRT),YC(NVRT)).
!    On output, the rotated vertex coordinates; indices are
!    also rotated so that (XC(0),YC(0)) = (XC(NVRT),YC(NVRT))
!    is top vertex and (XC(IBOT),YC(IBOT)) is bottom vertex.
!
!    Input, integer I1, I2, the index of vertices of line segment; 
!    I1, I2 must be positive.
!
!    Output, integer IBOT, the index of bottom vertex.
!
!    Output, real ( kind = rk8 ) COSTH, SINTH, the values COS(THETA) and 
!    SIN(THETA) where THETA in [-PI,PI] is the rotation angle.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  integer nvrt

  integer a
  integer b
  real ( kind = rk8 ) costh
  integer i
  integer i1
  integer i2
  integer ibot
  integer itop
  integer j
  integer k
  integer l
  integer m
  real ( kind = rk8 ), parameter :: pi = 3.141592653589793D+00
  integer r
  real ( kind = rk8 ) sinth
  real ( kind = rk8 ) theta
  real ( kind = rk8 ) tol
  real ( kind = rk8 ) x0
  real ( kind = rk8 ) xc(0:nvrt)
  real ( kind = rk8 ) y0
  real ( kind = rk8 ) yc(0:nvrt)

  tol = 100.0D+00 * epsilon ( tol )

  itop = i1
  ibot = i2

  if ( yc(i1) == yc(i2) ) then
    if ( xc(i1) < xc(i2) ) then
      theta = -pi / 2.0D+00
    else
      theta = pi / 2.0D+00
    end if
  else
    if ( yc(i1) < yc(i2) ) then
      itop = i2
      ibot = i1
    end if
    theta = pi / 2.0D+00 &
      - atan2 ( yc(itop) - yc(ibot), xc(itop) - xc(ibot) )
  end if

  costh = cos(theta)
  sinth = sin(theta)

  do i = 1, nvrt
    x0 = xc(i)
    xc(i) = costh * x0 - sinth * yc(i)
    yc(i) = sinth * x0 + costh * yc(i)
  end do
!
!  Rotate indices.
!
  if ( itop /= nvrt ) then

    a = nvrt
    b = itop

    do

      r = mod ( a, b )
      a = b
      b = r

      if ( r <= 0 ) then
        exit
      end if

    end do

    m = nvrt / a - 1

    do i = 1, a

      x0 = xc(i)
      y0 = yc(i)
      k = i

      do j = 1, m
        l = k + itop
        if ( nvrt < l ) then
          l = l - nvrt
        end if
        xc(k) = xc(l)
        yc(k) = yc(l)
        k = l
      end do

      xc(k) = x0
      yc(k) = y0

    end do

    ibot = ibot - itop
    if ( ibot < 0 ) then
      ibot = ibot + nvrt
    end if

  end if

  xc(0) = xc(nvrt)
  yc(0) = yc(nvrt)

  return
end
subroutine sepmdf ( angtol, nvrt, xc, yc, arpoly, mean, mdftr, indpvl, &
  iang, i1, i2 )

!*****************************************************************************80
!
!! sepmdf() splits a polygon according to the mesh distribution function.
!
!  Discussion: 
!
!    Determine separator to split convex polygon into two
!    parts based on mesh distribution function.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, real ( kind = rk8 ) ANGTOL, the angle tolerance parameter
!    (in radians).
!
!    Input, integer NVRT, the number of vertices in polygon.
!
!    Input, real ( kind = rk8 ) XC(0:NVRT),YC(0:NVRT), the coordinates of polygon
!    vertices in counter clockwise order, translated so that centroid is at 
!    origin; (XC(0),YC(0)) = (XC(NVRT),YC(NVRT)).
!
!    Input, real ( kind = rk8 ) ARPOLY, the area of polygon.
!
!    Input, real ( kind = rk8 ) MEAN, the mean mdf value in polygon.
!
!    Input, real ( kind = rk8 ) MDFTR(0:NVRT-1), the mean mdf value in each 
!    triangle of polygon; triangles are determined by polygon vertices 
!    and centroid.
!
!    Input, integer INDPVL(0:NVRT), the indices in PVL of vertices; 
!    INDPVL(I) = -K if (XC(I),YC(I)) is extra vertex inserted on edge from
!    K to PVL(SUCC,K).
!
!    Input, real ( kind = rk8 ) IANG(1:*), the interior angle array.
!
!    Output, integer I1, I2, indices in range 0 to NVRT-1 of best separator
!    according to MDF and max-min angle criterion; I1 = -1
!    if no satisfactory separator is found.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  integer nvrt

  real ( kind = rk8 ) angle
  real ( kind = rk8 ) angtol
  real ( kind = rk8 ) areatr
  real ( kind = rk8 ) arpoly
  integer hi
  integer i
  integer i1
  integer i2
  real ( kind = rk8 ) iang(*)
  integer indpvl(0:nvrt)
  integer l
  integer m
  real ( kind = rk8 ) mdftr(0:nvrt-1)
  real ( kind = rk8 ) mean
  real ( kind = rk8 ), parameter :: pi = 3.141592653589793D+00
  real ( kind = rk8 ) sum2
  real ( kind = rk8 ) tol
  integer v(2)
  integer w(2)
  real ( kind = rk8 ) xc(0:nvrt)
  real ( kind = rk8 ) yc(0:nvrt)

  tol = 100.0D+00 * epsilon ( tol )
!
!  Determine triangle with highest mean mesh density; then determine
!  triangles adjacent to this triangle with mesh density at least MEAN
!  such that the area of these triangles is <= ARPOLY/2.
!  Note that twice the triangle area is computed.
!
  hi = 0
  do i = 1, nvrt-1
    if ( mdftr(hi) < mdftr(i) ) then
      hi = i
    end if
  end do

  sum2 = xc(hi) * yc(hi+1) - xc(hi+1) * yc(hi)

  l = hi - 1
  if ( l < 0 ) then
    l = nvrt - 1
  end if

  m = hi + 1
  if ( nvrt <= m ) then
    m = 0
  end if

  do

    if ( mdftr(m) <= mdftr(l) ) then
      i = l
    else
      i = m
    end if

    if ( mdftr(i) < mean ) then
      exit
    end if

    areatr = xc(i) * yc(i+1) - xc(i+1) * yc(i)
    sum2 = sum2 + areatr

    if ( arpoly < sum2 ) then
      exit
    end if

    if ( i == l ) then
      l = l - 1
      if ( l < 0 ) then
        l = nvrt - 1
      end if
    else
      m = m + 1
      if ( nvrt <= m ) then
        m = 0
      end if
    end if

  end do

  l = l + 1

  if ( nvrt <= l ) then
    l = 0
  end if
!
!  Interchange role of L and M depending on angle determined by
!  (XC(M),YC(M)), (0,0), and (XC(L),YC(L)).
!  Possible separators are L,M; L,M+1; L+1,M; L+1,M+1.
!
  if ( pi < angle ( xc(m), yc(m), 0.0D+00, 0.0D+00, xc(l), yc(l) ) ) then
    i = l
    l = m
    m = i
  end if

  v(1) = l
  v(2) = l - 1
  if ( v(2) < 0 ) then 
    v(2) = nvrt - 1
  end if

  w(1) = m
  w(2) = m + 1
  if ( nvrt <= w(2) ) then
    w(2) = 0
  end if

  call mmasep ( angtol, xc, yc, indpvl, iang, v, w, i1, i2 )

  return
end
subroutine sepshp ( angtol, nvrt, xc, yc, indpvl, iang, i1, i2, wk, ierror )

!*****************************************************************************80
!
!! sepshp() splits a convex polygon according to shape.
!
!  Discussion: 
!
!    Determine separator to split convex polygon into two
!    parts based on shape (diameter) of polygon.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, real ( kind = rk8 ) ANGTOL, the angle tolerance parameter
!    (in radians).
!
!    Input, integer NVRT, the number of vertices in polygon.
!
!    Input, real ( kind = rk8 ) XC(0:NVRT), YC(0:NVRT), the coordinates of 
!    polygon vertices in counter clockwise order, translated so that 
!    centroid is at origin;
!    (XC(0),YC(0)) = (XC(NVRT),YC(NVRT)).
!
!    Input, integer INDPVL(0:NVRT), the indices in PVL of vertices;
!    INDPVL(I) = -K if (XC(I),YC(I)) is extra vertex inserted on edge from
!    K to PVL(SUCC,K).
!
!    Input, real ( kind = rk8 ) IANG(1:*), the interior angle array.
!
!    Output, integer I1, I2, the indices in range 0 to NVRT-1 of best separator
!    according to shape and max-min angle criterion; I1 = -1
!    if no satisfactory separator is found.
!
!    Workspace, real ( kind = rk8 ) WK(1:2*NVRT).
!
!    Output, integer IERROR, error flag.  For abnormal return,
!    IERROR is set to 200.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  integer nvrt

  real ( kind = rk8 ) angtol
  real ( kind = rk8 ) dist
  real ( kind = rk8 ) dx
  real ( kind = rk8 ) dy
  integer i
  integer i1
  integer i2
  real ( kind = rk8 ) iang(*)
  integer ierror
  integer indpvl(0:nvrt)
  integer k
  integer n
  real ( kind = rk8 ), parameter :: pi = 3.141592653589793D+00
  real ( kind = rk8 ) pimtol
  real ( kind = rk8 ) tol
  integer v(2)
  integer w(2)
  real ( kind = rk8 ) wk(2*nvrt)
  real ( kind = rk8 ) xa
  real ( kind = rk8 ) xc(0:nvrt)
  real ( kind = rk8 ) ya
  real ( kind = rk8 ) yc(0:nvrt)

  ierror = 0
  tol = 100.0D+00 * epsilon ( tol )
!
!  Determine diameter of polygon. Possible separators endpoints (two
!  on each side of polygon) are nearest to perpendicular bisector of
!  diameter. (XA,YA) and (XA+DX,YA+DY) are on bisector. Distance to
!  bisector is proportional to two times triangle area.
!
  pimtol = pi - tol
  n = 0
  do i = 0, nvrt-1
    k = indpvl(i)
    if ( 0 < k ) then
      if ( iang(k) < pimtol ) then
         n = n + 1
         wk(n) = xc(i)
         wk(n+nvrt) = yc(i)
      end if
    end if
  end do

  call diam2 ( n, wk, wk(nvrt+1), i1, i2, dist, ierror )

  if ( ierror /= 0 ) then
    return
  end if

  if ( i2 < i1 ) then
    i = i1
    i1 = i2
    i2 = i
  end if

  dx = wk(i2+nvrt) - wk(i1+nvrt)
  dy = wk(i1) - wk(i2)
  xa = 0.5D+00 * ( wk(i1) + wk(i2) - dx )
  ya = 0.5D+00 * ( wk(i1+nvrt) + wk(i2+nvrt) - dy )

  i = i1 - 1

20 continue

  if ( xc(i) == wk(i1) .and. yc(i) == wk(i1+nvrt) ) then
    i1 = i
  else
    i = i + 1
    go to 20
  end if

  i = max ( i2-1, i1+1 )

30 continue

  if ( xc(i) == wk(i2) .and. yc(i)  ==  wk(i2+nvrt) ) then
    i2 = i
  else
    i = i + 1
    go to 30
  end if

  i = i1 + 1

40 continue

  dist = dx * ( yc(i) - ya ) - dy * ( xc(i) - xa )

  if ( 0.0D+00 <= dist ) then
    v(1) = i - 1
    v(2) = i
  else
    i = i + 1
    go to 40
  end if

  i = i2 + 1

50 continue

  if ( nvrt <= i ) then
    i = 0
  end if

  dist = dx * ( yc(i) - ya ) - dy * ( xc(i) - xa )

  if ( dist <= 0.0D+00 ) then
    w(1) = i - 1
    w(2) = i
    if ( i <= 0 ) then
      w(1) = nvrt - 1
    end if
  else
    i = i + 1
    go to 50
  end if

  call mmasep ( angtol, xc, yc, indpvl, iang, v, w, i1, i2 )

  return
end
subroutine sfdwmf ( l, r, psi, indp, loch )

!*****************************************************************************80
!
!! sfdwmf() sifts PSI(INDP(L)) down a heap.
!
!  Discussion: 
!
!    Sift PSI(INDP(L)) down heap which has maximum PSI value
!    at root of heap and is maintained by pointers in INDP.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, integer L, the element of heap to be sifted down.
!
!    Input, integer R, the upper bound of heap.
!
!    Input, real ( kind = rk8 ) PSI(1:*), the key values for heap.
!
!    Input/output, integer INDP(1:R), the indices of PSI which are 
!    maintained in heap.
!
!    Input/output, integer LOCH(1:*), the location of indices in
!    heap (inverse of INDP).
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  integer r

  integer i
  integer indp(r)
  integer j
  integer k
  integer l
  integer loch(*)
  real ( kind = rk8 ) psi(*)
  real ( kind = rk8 ) t

  i = l
  j = 2 * i
  k = indp(i)
  t = psi(k)

  do while ( j <= r )

    if ( j < r ) then
      if ( psi(indp(j)) < psi(indp(j+1)) ) then
        j = j + 1
      end if
    end if

    if ( psi(indp(j)) <= t ) then
      exit
    end if

    indp(i) = indp(j)
    loch(indp(i)) = i
    i = j
    j = 2 * i

  end do

  indp(i) = k
  loch(k) = i

  return
end
subroutine sfupmf ( r, psi, indp, loch )

!*****************************************************************************80
!
!! sfupmf() sifts PSI(INDP(R)) up a heap.
!
!  Discussion: 
!
!    Sift PSI(INDP(R)) up heap which has maximum PSI value
!    at root of heap and is maintained by pointers in INDP.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, integer R, the element of heap to be sifted up.
!
!    Input, real ( kind = rk8 ) PSI(1:*), the key values for heap.
!
!    Input/output, integer INDP(1:R), the indices of PSI which are 
!    maintained in heap.
!
!    Input/output, integer LOCH(1:*), the location of indices in
!    heap (inverse of INDP).
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  integer r

  integer i
  integer indp(r)
  integer j
  integer k
  integer loch(*)
  real ( kind = rk8 ) psi(*)
  real ( kind = rk8 ) t

  i = r
  j = int ( i / 2 )
  k = indp(i)
  t = psi(k)

  do

    if ( i <= 1 ) then
      exit
    end if

    if ( t <= psi(indp(j)) ) then
      exit
    end if

    indp(i) = indp(j)
    loch(indp(i)) = i
    i = j
    j = int ( i / 2 )

  end do

  indp(i) = k
  loch(k) = i

  return
end
subroutine shrnk2 ( nvrt, xc, yc, sdist, nshr, xs, ys, iedge, ierror )

!*****************************************************************************80
!
!! shrnk2() shrinks a convex polygon.
!
!  Discussion: 
!
!    Shrink a convex polygon, with vertices given in counter clockwise
!    order and with all interior angles < PI, by distance SDIST(I)
!    for Ith edge, I = 0,...,NVRT-1.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, integer NVRT, the number of vertices on the boundary
!    of convex polygon.
!
!    Input, real ( kind = rk8 ) XC(0:NVRT), YC(0:NVRT), the vertex coordinates 
!    in counter clockwise order;
!    (XC(0),YC(0)) = (XC(NVRT),YC(NVRT)).
!
!    Input, real ( kind = rk8 ) SDIST(0:NVRT-1), the nonnegative shrink 
!    distances for edges.
!
!    Output, integer NSHR, the number of vertices on boundary of
!    shrunken polygon; 0 if shrunken polygon is empty else 3 <= NSHR <= NVRT.
!
!    Output, real ( kind = rk8 ) XS(0:NSHR), YS(0:NSHR), the coordinates of
!    shrunken polygon in counter clockwise order if NSHR is greater than 0; 
!    (XS(0),YS(0)) = (XS(NSHR),YS(NSHR)).
!
!    Output, integer IEDGE(0:NVRT), the indices of edges of 
!    shrunken polygon in range from 0 to NVRT-1.
!
!    Output, integer IERROR, error flag.  On abnormal return,
!    IERROR is set to 202.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  integer nvrt

  real ( kind = rk8 ) alpha
  logical first
  integer i
  integer iedge(0:nvrt)
  integer ierror
  integer j
  integer k
  integer lr
  integer lrline
  integer nshr
  logical parall
  real ( kind = rk8 ), parameter :: pi = 3.141592653589793D+00
  real ( kind = rk8 ) pi2
  real ( kind = rk8 ) sdist(0:nvrt-1)
  real ( kind = rk8 ) theta
  real ( kind = rk8 ) tol
  real ( kind = rk8 ) xc(0:nvrt)
  real ( kind = rk8 ) xs(0:nvrt)
  real ( kind = rk8 ) yc(0:nvrt)
  real ( kind = rk8 ) ys(0:nvrt)

  ierror = 0
  tol = 100.0D+00 * epsilon ( tol )

  pi2 = 2.0D+00 * pi
  alpha = atan2 ( yc(1)-yc(0), xc(1)-xc(0) )

  call xline ( xc(0), yc(0), xc(1), yc(1), xc(1), yc(1), xc(2), yc(2), &
    sdist(0), sdist(1), xs(1), ys(1), parall )

  if ( parall ) then
    ierror = 202
    go to 90
  end if

  iedge(0) = 0
  iedge(1) = 1
  i = 2
  j = 0
  nshr = 1
  first = .true.
!
!  First while loop processes edges subtending angle <= PI
!  with respect to first edge.
!
10 continue

  theta = atan2 ( yc(i+1)-yc(i), xc(i+1)-xc(i) ) - alpha
  if ( theta < 0.0D+00 ) then
    theta = theta + pi2
  end if

  if ( pi + tol < theta ) then
    go to 40
  end if

20 continue

  lr = lrline ( xs(nshr), ys(nshr), xc(i), yc(i), xc(i+1), yc(i+1), &
    sdist(i) )

  if ( lr < 0 ) then
    go to 30
  end if

  nshr = nshr - 1
  if ( 1 <= nshr ) then
    go to 20
  end if

30 continue

  if ( nshr < 1 .and. abs ( theta - pi ) <= tol ) then
    go to 90
  end if

  k = iedge(nshr)
  nshr = nshr + 1

  call xline ( xc(k), yc(k), xc(k+1), yc(k+1), xc(i), yc(i), xc(i+1), &
    yc(i+1), sdist(k), sdist(i), xs(nshr), ys(nshr), parall )

  if ( parall ) then
    ierror = 202
    go to 90
  end if

  iedge(nshr) = i
  i = i + 1
  go to 10
!
!  Second while loop processes remaining edges.
!
40 continue

  if ( first ) then
    first = .false.
    go to 50
  end if

  lr = lrline ( xs(j), ys(j), xc(i), yc(i), xc(i+1), yc(i+1), sdist(i) )

  if ( lr <= 0 ) then
    go to 70
  end if

50 continue

  if ( nshr <= j ) then
    go to 90
  end if

  lr = lrline ( xs(nshr), ys(nshr), xc(i), yc(i), xc(i+1), yc(i+1), sdist(i) )

  if ( 0 <= lr ) then
    nshr = nshr - 1
    go to 50
  end if

  k = iedge(nshr)
  nshr = nshr + 1

  call xline ( xc(k), yc(k), xc(k+1), yc(k+1), xc(i), yc(i), xc(i+1), &
    yc(i+1), sdist(k), sdist(i), xs(nshr), ys(nshr), parall )

  if ( parall ) then
    ierror = 202
    go to 90
  end if

  iedge(nshr) = i

60 continue

  lr = lrline ( xs(j+1), ys(j+1), xc(i), yc(i), xc(i+1), yc(i+1), sdist(i) )

  if ( 0 <= lr ) then
    j = j + 1
    go to 60
  end if

  k = iedge(j)
  call xline ( xc(k), yc(k), xc(k+1), yc(k+1), xc(i), yc(i), xc(i+1), &
    yc(i+1), sdist(k), sdist(i), xs(j), ys(j), parall )

  if ( parall ) then
    ierror = 202
    go to 90
  end if

  xs(nshr+1) = xs(j)
  ys(nshr+1) = ys(j)
  iedge(nshr+1) = iedge(j)

70 continue

  i = i + 1

  if ( i < nvrt ) then
    go to 40
  end if

  if ( 0 < j ) then
    do i = 0, nshr+1-j
      xs(i) = xs(i+j)
      ys(i) = ys(i+j)
      iedge(i) = iedge(i+j)
    end do
  end if

  nshr = nshr + 1 - j
  return

90 continue

  nshr = 0

  return
end
subroutine spdec2 ( angspc, angtol, nvc, npolg, nvert, nhole, nhola, maxvc,  &
  maxhv, maxpv, maxiw, maxwk, holv, vcl, regnum, hvl, pvl, iang, iwk, &
  wk, ierror )

!*****************************************************************************80
!
!! spdec2() decomposes a polygonal region with holes into simple polygons.
!
!  Discussion: 
!
!    Decompose general polygonal region with interfaces and
!    holes into simple polygons using vertex coordinate list,
!    head vertex list, and polygon vertex list data structures.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, real ( kind = rk8 ) ANGSPC, the angle spacing parameter in radians 
!    used in controlling vertices to be considered as an endpoint of 
!    a separator.
!
!    Input, real ( kind = rk8 ) ANGTOL, the angle tolerance parameter in radians 
!    used in accepting separator(s).
!
!    Input/output, integer NVC, the number of vertex coordinates 
!    or positions used in the VCL array.
!
!    Input/output, integer NPOLG, the number of polygonal 
!    subregions or positions used in HVL array.
!
!    Input/output, integer NVERT, the number of polygon vertices 
!    or positions used in PVL array.
!
!    Input, integer NHOLE, the number of holes and hole interfaces.
!
!    Input, integer NHOLA, the number of 'attached' holes; these
!    holes are attached to the outer boundary of a subregion through vertices
!    or cut interfaces and have their edges in consecutive order on 
!    the boundary.
!
!    Input, integer MAXVC, the maximum size available for VCL 
!    array, should be at least the number of vertex coordinates required 
!    for decomposition.
!
!    Input, integer MAXHV, the maximum size available for HVL, 
!    REGNUM arrays, should be at least the number of polygons required for 
!    decomposition.
!
!    Input, integer MAXPV, the maximum size available for PVL, 
!    IANG arrays; should be at least the number of polygon vertices required for
!    decomposition.
!
!    Input, integer MAXIW, the maximum size available for IWK 
!    array; should be about 3 times maximum number of vertices in any polygon.
!
!    Input, integer MAXWK, the maximum size available for WK 
!    array; should be about 5 times maximum number of vertices in any polygon.
!
!    Input, integer HOLV(1:NHOLE*2+NHOLA), the indices in PVL of 
!    bottom or top vertex of holes; first (next) NHOLE entries are for top 
!    (bottom) vertices of holes and hole interfaces, with top (bottom)
!    vertices sorted in decreasing (increasing) lexicographic
!    (y,x) order of coord; last NHOLA entries are for attached
!    holes; if bottom vertex of attached hole is a simple
!    vertex of boundary curve containing the hole then entry
!    contains index of bottom vertex otherwise entry contains
!    index of top vertex (which is simple).
!
!    Input/output, real ( kind = rk8 ) VCL(1:2,1:NVC), the vertex coordinate list.
!
!    Input/output, integer REGNUM(1:NPOLG), the region numbers.
!
!    Input/output, integer HVL(1:NPOLG), the head vertex list.
!
!    Input/output, integer PVL(1:4,1:NVERT), 
!    real ( kind = rk8 ) IANG(1:NVERT), the polygon vertex list and interior 
!    angles; see routine DSPGDC for more details.  Note that the data 
!    structures should be as output from routines DSMCPR or DSPGDC.
!
!    Workspace, integer IWK(1:MAXIW).
!
!    Workspace, real ( kind = rk8 ) WK(1:MAXWK).
!
!    Output, integer IERROR, error flag.  On abnormal return,
!    IERROR is set to 3, 4, 5, 6, 7, 206 to 210, 212, 218, or 219.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  integer maxhv
  integer maxiw
  integer maxpv
  integer maxvc
  integer maxwk

  real ( kind = rk8 ) angspc
  real ( kind = rk8 ) angtol
  logical ci
  logical cj
  integer, parameter :: edgv = 4
  integer holv(*)
  integer hvl(maxhv)
  integer i
  real ( kind = rk8 ) iang(maxpv)
  integer ierror
  integer iwk(maxiw)
  integer j
  integer nhola
  integer nhole
  integer npolg
  integer nvc
  integer nvert
  integer p
  real ( kind = rk8 ), parameter :: pi = 3.141592653589793D+00
  real ( kind = rk8 ) piptol
  integer, parameter :: polg = 2
  integer pvl(4,maxpv)
  integer regnum(maxhv)
  integer, parameter :: succ = 3
  real ( kind = rk8 ) tol
  real ( kind = rk8 ) vcl(2,maxvc)
  integer vr
  integer w1
  integer w2
  real ( kind = rk8 ) wk(maxwk)

  ierror = 0
  tol = 100.0D+00 * epsilon ( tol )
!
!  For each simple hole, find cut edge from top vertex of hole to
!  a point on the outer boundary above top vertex, and update
!  VCL, HVL, PVL, IANG.
!
  piptol = pi + tol

  do i = 1, nhole

    call jnhole ( holv(i), angspc, angtol, nvc, nvert, maxvc, maxpv, maxiw, &
      maxwk, vcl, hvl, pvl, iang, iwk, wk, ierror )

    if ( ierror /= 0 ) then
      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) 'SPDEC2 - Fatal error!'
      write ( *, '(a)' ) '  JNHOLE returned an error condition.'
      return
    end if

  end do
!
!  Resolve remaining vertices in HOLV array if they are reflex
!  vertices. These vertices may no longer be reflex if they are the
!  endpoint of a cut edge from the top vertex of another hole or
!  of a previous separator.
!
  do i = nhole+1, nhole+nhole+nhola

    vr = holv(i)

    if ( piptol < iang(vr) ) then

      call resvrt ( vr, angspc, angtol, nvc, nvert, maxvc, maxpv, maxiw, &
        maxwk, vcl, pvl, iang, w1, w2, iwk, wk, ierror )

      if ( ierror /= 0 ) then
        return
      end if

      call insed2 ( vr, w1, npolg, nvert, maxhv, maxpv, vcl, regnum, hvl, &
        pvl, iang, ierror )

      if ( ierror /= 0 ) then
        return
      end if

      if ( 0 < w2 ) then
        call insed2 ( vr, w2, npolg, nvert, maxhv, maxpv, &
          vcl, regnum, hvl, pvl, iang, ierror )
        if ( ierror /= 0 ) then
          return
        end if
      end if

    end if

  end do

  if ( nhola == 0 ) then
    return
  end if
!
!  Check that polygons are simple. If polygon is simply-connected and
!  not simple then find a simple reflex vertex in polygon to resolve.
!
  p = 1

30 continue

  if ( npolg < p ) then
    return
  end if

  i = hvl(p)

  do

    if ( pvl(polg,pvl(edgv,i)) == p ) then
      go to 50
    end if

    i = pvl(succ,i)

    if ( i == hvl(p) ) then
      exit
    end if

  end do

  p = p + 1
  go to 30

50 continue

  ci = .true.

  do

    j = pvl(succ,i)
    cj = ( pvl(polg,pvl(edgv,j)) == p )

    if ( .not. ci .and. .not. cj .and. piptol < iang(j) ) then
      exit
    end if

    i = j
    ci = cj

  end do

  vr = j
  call resvrt ( vr, angspc, angtol, nvc, nvert, maxvc, maxpv, maxiw, &
    maxwk, vcl, pvl, iang, w1, w2, iwk, wk, ierror )

  if ( ierror /= 0 ) then
    return
  end if

  call insed2 ( vr, w1, npolg, nvert, maxhv, maxpv, vcl, regnum, hvl, &
    pvl, iang, ierror )

  if ( ierror /= 0 ) then
    return
  end if

  if ( 0 < w2 ) then

    call insed2 ( vr, w2, npolg, nvert, maxhv, maxpv, &
      vcl, regnum, hvl, pvl, iang, ierror )

    if ( ierror /= 0 ) then
      return
    end if

  end if

  go to 30

end
subroutine swapec ( i, top, maxst, btri, bedg, vcl, til, tnbr, stack, ierror )

!*****************************************************************************80
!
!! swapec() swaps diagonal edges until all triangles are Delaunay.
!
!  Discussion:
!
!    The routine swaps diagonal edges in a 2D triangulation, based on
!    the empty circumcircle criterion, until all triangles are Delaunay,
!    given that I is the index of the new vertex added to triangulation.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, integer I, the index in VCL of the new vertex.
!
!    Input/output, integer TOP, the index of the top of the stack.
!    On output, TOP is zero.
!
!    Input, integer MAXST, the maximum size available for the 
!    STACK array.
!
!    Input/output, integer BTRI, BEDG; on input, if positive, are the
!    triangle and edge indices of a boundary edge whose updated indices
!    must be recorded.  On output, these may be updated because of swaps.
!
!    Input, real ( kind = rk8 ) VCL(2,*), the coordinates of the vertices.
!
!    Input/output, integer TIL(3,*), the triangle incidence list.  
!    May be updated on output because of swaps.
!
!    Input/output, integer TNBR(3,*), the triangle neighbor list; negative 
!    values are used for links of the counter-clockwise linked list of boundary 
!    edges; May be updated on output because of swaps.
!
!      LINK = -(3*I + J-1) where I, J = triangle, edge index.
!
!    Workspace, integer STACK(1:MAXST); on input, entries 1 through TOP
!    contain the indices of initial triangles (involving vertex I)
!    put in stack; the edges opposite I should be in interior;  entries
!    TOP+1 through MAXST are used as a stack.
!
!    Output, integer IERROR is set to 8 for abnormal return.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  integer maxst

  integer a
  integer b
  integer bedg
  integer btri
  integer c
  integer diaedg
  integer e
  integer ee
  integer em1
  integer ep1
  integer f
  integer fm1
  integer fp1
  integer i
  integer i4_wrap
  integer ierror
  integer l
  integer r
  integer s
  integer stack(maxst)
  integer swap
  integer t
  integer til(3,*)
  integer tnbr(3,*)
  integer top
  integer tt
  integer u
  real ( kind = rk8 ) vcl(2,*)
  real ( kind = rk8 ) x
  real ( kind = rk8 ) y
!
!  Determine whether the triangles in the stack are Delaunay.
!  Ifnot, swap the diagonal edge of the convex quadrilateral.
!
  ierror = 0
  x = vcl(1,i)
  y = vcl(2,i)

  do

    if ( top <= 0 ) then
      exit
    end if

    t = stack(top)
    top = top - 1

    if ( til(1,t) == i ) then
      e = 2
      b = til(3,t)
    else if ( til(2,t) == i ) then
      e = 3
      b = til(1,t)
    else
      e = 1
      b = til(2,t)
    end if

    a = til(e,t)
    u = tnbr(e,t)

    if ( tnbr(1,u) == t ) then
      f = 1
      c = til(3,u)
    else if ( tnbr(2,u) == t ) then
      f = 2
      c = til(1,u)
    else
      f = 3
      c = til(2,u)
    end if

    swap = diaedg ( x, y, vcl(1,a), vcl(2,a), vcl(1,c), vcl(2,c), &
      vcl(1,b), vcl(2,b) )

    if ( swap == 1 ) then

      em1 = i4_wrap ( e - 1, 1, 3 )
      ep1 = i4_wrap ( e + 1, 1, 3 )
      fm1 = i4_wrap ( f - 1, 1, 3 )
      fp1 = i4_wrap ( f + 1, 1, 3 )
      
      til(ep1,t) = c
      til(fp1,u) = i
      r = tnbr(ep1,t)
      s = tnbr(fp1,u)
      tnbr(ep1,t) = u
      tnbr(fp1,u) = t
      tnbr(e,t) = s
      tnbr(f,u) = r

      if ( 0 < tnbr(fm1,u) ) then
        top = top + 1
        stack(top) = u
      end if

      if ( 0 < s ) then

        if ( tnbr(1,s) == u ) then
          tnbr(1,s) = t
        else if ( tnbr(2,s) == u ) then
          tnbr(2,s) = t
        else
          tnbr(3,s) = t
        end if

        top = top + 1

        if ( maxst < top ) then
          write ( *, '(a)' ) ' '
          write ( *, '(a)' ) 'SWAPEC - Fatal error!'
          write ( *, '(a)' ) '  Ran out of stack storage.'
          write ( *, '(a,i6)' ) '  MAXST = ', maxst
          write ( *, '(a,i6)' ) '  TOP =   ', top
          ierror = 8
          return
        end if

        stack(top) = t

      else

        if ( u == btri .and. fp1 == bedg ) then
          btri = t
          bedg = e
        end if

        l = - ( 3 * t + e - 1 )
        tt = t
        ee = em1

        do while ( 0 < tnbr(ee,tt) )

          tt = tnbr(ee,tt)

          if ( til(1,tt) == a ) then
            ee = 3
          else if ( til(2,tt) == a ) then
            ee = 1
          else
            ee = 2
          end if

        end do

        tnbr(ee,tt) = l

      end if

      if ( 0 < r ) then

        if ( tnbr(1,r) == t ) then
          tnbr(1,r) = u
        else if ( tnbr(2,r) == t ) then
          tnbr(2,r) = u
        else
          tnbr(3,r) = u
        end if

      else

        if ( t == btri .and. ep1 == bedg ) then
          btri = u
          bedg = f
        end if

        l = - ( 3 * u + f - 1 )
        tt = u
        ee = fm1

        do while ( 0 < tnbr(ee,tt) )

          tt = tnbr(ee,tt)

          if ( til(1,tt) == b ) then
            ee = 3
          else if ( til(2,tt) == b ) then
            ee = 1
          else
            ee = 2
          end if

        end do

        tnbr(ee,tt) = l

      end if

    end if

  end do

  return
end
subroutine tmerge ( inter, nbl, ncr, chbl, chcr, ldv, vcl, til, tedg, &
  ierror )

!*****************************************************************************80
!
!! tmerge() forms triangles near the boundary by merging vertex chains.
!
!  Discussion: 
!
!    Form triangles in strip near boundary of polygon or
!    inside polygon by merging two chains of vertices.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, logical INTER, is .TRUE. iff at least one interior mesh vertex.
!
!    Input, integer NBL, the number of vertices on boundary 
!    cycle if INTER, otherwise on left boundary chain.
!
!    Input, integer NCR, the number of vertices on closed walk 
!    if INTER, otherwise on right boundary chain.
!
!    Input, integer CHBL(0:NBL), the indices in VCL of vertices
!    on boundary cycle or left boundary chain; if INTER, CHBL(NBL) = CHBL(0).
!
!    Input, integer CHCR(0:NCR), the indices in VCL of vertices 
!    on closed walk or right boundary chain; if INTER, CHCR(NCR) = CHCR(0),
!    otherwise CHCR(0) is not referenced.
!
!    Input, integer LDV, the leading dimension of VCL in 
!    calling routine.
!
!    Input, real ( kind = rk8 ) VCL(1:2,1:*), the vertex coordinate list.
!
!    Output, integer TIL(1:3,1:NT), the triangle incidence list,
!    where NT = NBL + NCR - K where K = 0 if INTER, else K = 2.
!
!    Output, integer TEDG(1:3,1:NT), the TEDG(J,I) refers to 
!    edge with vertices TIL(J:J+1,I) and contains index of merge edge or 
!    NBL+NCR+1 for edge of chains.  Note: It is assumed there is enough space 
!    in 2 arrays.
!
!    Output, integer IERROR, error flag.  On abnormal return,
!    IERROR is set to 230.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  integer ldv
  integer nbl
  integer ncr

  integer chbl(0:nbl)
  integer chcr(0:ncr)
  integer diaedg
  integer i
  integer ibndry
  integer ierror
  integer in
  logical inter
  integer j
  integer lri
  integer lrip1
  integer lrline
  integer nl
  integer nr
  integer nt
  integer tedg(3,nbl+ncr)
  integer til(3,nbl+ncr)
  real ( kind = rk8 ) vcl(ldv,*)
  real ( kind = rk8 ) xi
  real ( kind = rk8 ) xip1
  real ( kind = rk8 ) xj
  real ( kind = rk8 ) xjp1
  real ( kind = rk8 ) yi
  real ( kind = rk8 ) yip1
  real ( kind = rk8 ) yj
  real ( kind = rk8 ) yjp1

  ierror = 0
  ibndry = nbl + ncr + 1
  nt = 0

  if ( inter ) then

    nl = nbl
    nr = ncr
    i = 0
    j = 0

  else

    call mtredg ( .true., chbl(1), chcr(1), chbl(0), ibndry, nt, til, tedg )

    tedg(2,1) = ibndry
    if ( nbl + ncr <= 3 ) then
      return
    end if

    nl = nbl - 1
    nr = ncr - 1
    i = 1
    j = 1
    lri = 1
    lrip1 = 1

  end if
!
!  Main while loop for determining next triangle and edge.
!
10 continue

  if ( nl <= i .or. nr <= j ) then
    go to 20
  end if

   xi = vcl(1,chbl(i))
   yi = vcl(2,chbl(i))
   xip1 = vcl(1,chbl(i+1))
   yip1 = vcl(2,chbl(i+1))
   xj = vcl(1,chcr(j))
   yj = vcl(2,chcr(j))
   xjp1 = vcl(1,chcr(j+1))
   yjp1 = vcl(2,chcr(j+1))
   in = diaedg ( xjp1, yjp1, xj, yj, xi, yi, xip1, yip1 )

   if ( inter ) then
     lri = lrline ( xi, yi, xj, yj, xjp1, yjp1, 0.0D+00 )
     lrip1 = lrline ( xip1, yip1, xj, yj, xjp1, yjp1, 0.0D+00 )
   end if

   if ( in <= 0 .or. lri <= 0 .and. lrip1 <= 0 ) then

     call mtredg ( .true., chbl(i+1), chcr(j), chbl(i), ibndry, nt, til, tedg )
     i = i + 1

   else

     call mtredg ( .false., chbl(i), chcr(j+1), chcr(j), ibndry, nt, til, tedg )
     j = j + 1

   end if

  go to 10
!
!  Add remaining triangles at end of strip or bottom of polygon.
!
20 continue

  if ( i < nl ) then

    if ( .not. inter .and. j == nr ) then
      nl = nl + 1
    end if

    do

      call mtredg ( .true., chbl(i+1), chcr(j), chbl(i), ibndry, nt, til, tedg )
      i = i + 1

      if ( nl <= i ) then
        exit
      end if

    end do

  else
!
!  J < NR .OR. I = NL = J = NR = 1
!
    if ( .not. inter .and. i == nl ) then
      nr = nr + 1
    end if

40  continue

    call mtredg ( .false., chbl(i), chcr(j+1), chcr(j), ibndry, nt, til, tedg )

    if ( inter ) then

      lri = lrline ( vcl(1,chbl(i)), vcl(2,chbl(i)), &
        vcl(1,chcr(j+1)), vcl(2,chcr(j+1)), vcl(1,chcr(j)), &
        vcl(2,chcr(j)), 0.0D+00 )

      if ( 0 <= lri ) then
        ierror = 230
        return
      end if

    end if

    j = j + 1

    if ( j < nr ) then
      go to 40
    end if

  end if

  if ( inter ) then
    if ( tedg(2,1) == 0 ) then
      tedg(2,1) = nbl + ncr
    else
      tedg(3,1) = nbl + ncr
    end if
  end if

  return
end
subroutine triangulation_plot_eps ( file_name, g_num, g_xy, tri_num, nod_tri )

!*****************************************************************************80
!
!! triangulation_plot_eps() plots a triangulation of a pointset.
!
!  Discussion:
!
!    The triangulation is most usually a Delaunay triangulation,
!    but this is not necessary.
!
!    The data can be generated by calling RTRIS2, but this is not
!    necessary.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    John Burkardt
!
!  Parameters:
!
!    Input, character ( len = * ) FILE_NAME, the name of the output file.
!
!    Input, integer G_NUM, the number of points.
!
!    Input, real ( kind = rk8 ) G_XY(2,G_NUM), the coordinates of the points.
!
!    Input, integer TRI_NUM, the number of triangles.
!
!    Input, integer NOD_TRI(3,TRI_NUM), lists, for each triangle,
!    the indices of the points that form the vertices of the triangle.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  integer g_num
  integer tri_num

  integer e
  character ( len = * ) file_name
  integer file_unit
  integer g
  real ( kind = rk8 ) g_xy(2,g_num)
  integer i4_wrap
  integer j
  integer k
  integer nod_tri(3,tri_num)
  integer t
  real ( kind = rk8 ) x_max
  real ( kind = rk8 ) x_min
  integer x_ps
  integer :: x_ps_max = 576
  integer :: x_ps_max_clip = 594
  integer :: x_ps_min = 36
  integer :: x_ps_min_clip = 18
  real ( kind = rk8 ) y_max
  real ( kind = rk8 ) y_min
  integer y_ps
  integer :: y_ps_max = 666
  integer :: y_ps_max_clip = 684
  integer :: y_ps_min = 126
  integer :: y_ps_min_clip = 108

  x_max = maxval ( g_xy(1,1:g_num) )
  x_min = minval ( g_xy(1,1:g_num) )
  y_max = maxval ( g_xy(2,1:g_num) )
  y_min = minval ( g_xy(2,1:g_num) )
!
!  Plot the Delaunay triangulation.
!
! call get_unit ( file_unit )
  file_unit = 1

  open ( unit = file_unit, file = file_name, status = 'replace' )

  write ( file_unit, '(a)' ) '%!PS-Adobe-3.0 EPSF-3.0'
  write ( file_unit, '(a)' ) '%%Creator: triangulation_plot_eps.f90'
  write ( file_unit, '(a)' ) '%%Title: ' // trim ( file_name )
  write ( file_unit, '(a)' ) '%%Pages: 1'
  write ( file_unit, '(a,i3,2x,i3,2x,i3,2x,i3)' ) '%%Bounding Box: ', &
    x_ps_min, y_ps_min, x_ps_max, y_ps_max
  write ( file_unit, '(a)' ) '%%Document-Fonts: Times-Roman'
  write ( file_unit, '(a)' ) '%%LanguageLevel: 1'
  write ( file_unit, '(a)' ) '%%EndComments'
  write ( file_unit, '(a)' ) '%%BeginProlog'
  write ( file_unit, '(a)' ) '/inch {72 mul} def'
  write ( file_unit, '(a)' ) '%%EndProlog'
  write ( file_unit, '(a)' ) '%%Page: 1 1'
  write ( file_unit, '(a)' ) 'save'
  write ( file_unit, '(a)' ) '%'
  write ( file_unit, '(a)' ) '%  Set the RGB line color to very light gray.'
  write ( file_unit, '(a)' ) '%'
  write ( file_unit, '(a)' ) '0.900  0.900  0.900 setrgbcolor'
  write ( file_unit, '(a)' ) '%'
  write ( file_unit, '(a)' ) '%  Draw a gray border around the page.'
  write ( file_unit, '(a)' ) '%'
  write ( file_unit, '(a)' ) 'newpath'
  write ( file_unit, '(a,i3,2x,i3,2x,a)' ) '  ', x_ps_min, y_ps_min, ' moveto'
  write ( file_unit, '(a,i3,2x,i3,2x,a)' ) '  ', x_ps_max, y_ps_min, ' lineto'
  write ( file_unit, '(a,i3,2x,i3,2x,a)' ) '  ', x_ps_max, y_ps_max, ' lineto'
  write ( file_unit, '(a,i3,2x,i3,2x,a)' ) '  ', x_ps_min, y_ps_max, ' lineto'
  write ( file_unit, '(a,i3,2x,i3,2x,a)' ) '  ', x_ps_min, y_ps_min, ' lineto'
  write ( file_unit, '(a)' ) 'stroke'
  write ( file_unit, '(a)' ) '%'
  write ( file_unit, '(a)' ) '%  Set the RGB line color to black.'
  write ( file_unit, '(a)' ) '%'
  write ( file_unit, '(a)' ) '0.000  0.000  0.000 setrgbcolor'
  write ( file_unit, '(a)' ) '%'
  write ( file_unit, '(a)' ) '%  Set the font and its size.'
  write ( file_unit, '(a)' ) '%'
  write ( file_unit, '(a)' ) '/Times-Roman findfont'
  write ( file_unit, '(a)' ) '0.50 inch scalefont'
  write ( file_unit, '(a)' ) 'setfont'
  write ( file_unit, '(a)' ) '%'
  write ( file_unit, '(a)' ) '%  Print a title.'
  write ( file_unit, '(a)' ) '%'
  write ( file_unit, '(a)' ) '210  702  moveto'
  write ( file_unit, '(a)' ) '(Triangulation)  show'
  write ( file_unit, '(a)' ) '%'
  write ( file_unit, '(a)' ) '%  Define a clipping polygon.'
  write ( file_unit, '(a)' ) '%'
  write ( file_unit, '(a)' ) 'newpath'
  write ( file_unit, '(a,i3,2x,i3,2x,a)' ) '  ', &
    x_ps_min_clip, y_ps_min_clip, ' moveto'
  write ( file_unit, '(a,i3,2x,i3,2x,a)' ) '  ', &
    x_ps_max_clip, y_ps_min_clip, ' lineto'
  write ( file_unit, '(a,i3,2x,i3,2x,a)' ) '  ', &
    x_ps_max_clip, y_ps_max_clip, ' lineto'
  write ( file_unit, '(a,i3,2x,i3,2x,a)' ) '  ', &
    x_ps_min_clip, y_ps_max_clip, ' lineto'
  write ( file_unit, '(a,i3,2x,i3,2x,a)' ) '  ', &
    x_ps_min_clip, y_ps_min_clip, ' lineto'
  write ( file_unit, '(a)' ) 'clip newpath'
  write ( file_unit, '(a)' ) '%'
  write ( file_unit, '(a)' ) '%  Set the RGB line color to green.'
  write ( file_unit, '(a)' ) '%'
  write ( file_unit, '(a)' ) '0.000  0.750  0.150 setrgbcolor'
  write ( file_unit, '(a)' ) '%'
  write ( file_unit, '(a)' ) '%  Draw the nodes.'
  write ( file_unit, '(a)' ) '%'

  do g = 1, g_num
    x_ps = int ( &
      ( ( x_max - g_xy(1,g) ) * real ( x_ps_min, kind = rk8 ) &
      + ( g_xy(1,g) - x_min ) * real ( x_ps_max, kind = rk8 ) ) &
      / ( x_max - x_min ) )
    y_ps = int ( &
      ( ( y_max - g_xy(2,g) ) * real ( y_ps_min, kind = rk8 ) &
      + ( g_xy(2,g) - y_min ) * real ( y_ps_max, kind = rk8 ) ) &
      / ( y_max - y_min ) )
    write ( file_unit, '(a,i3,2x,i3,2x,a)' ) 'newpath ', x_ps, y_ps, &
      ' 5 0 360 arc closepath fill'
  end do

  write ( file_unit, '(a)' ) '%'
  write ( file_unit, '(a)' ) '%  Set the RGB line color to red.'
  write ( file_unit, '(a)' ) '%'
  write ( file_unit, '(a)' ) '0.900  0.200  0.100 setrgbcolor'
  write ( file_unit, '(a)' ) '%'
  write ( file_unit, '(a)' ) '%  Draw the triangles.'
  write ( file_unit, '(a)' ) '%'

  do t = 1, tri_num

    write ( file_unit, '(a)' ) 'newpath'

    do j = 1, 4

      e = i4_wrap ( j, 1, 3 )

      k = nod_tri(e,t)

      x_ps = int ( &
        ( ( x_max - g_xy(1,k) ) * real ( x_ps_min, kind = rk8 ) &
        + ( g_xy(1,k) - x_min ) * real ( x_ps_max, kind = rk8 ) ) &
        / ( x_max - x_min ) )

      y_ps = int ( &
        ( ( y_max - g_xy(2,k) ) * real ( y_ps_min, kind = rk8 ) &
        + ( g_xy(2,k) - y_min ) * real ( y_ps_max, kind = rk8 ) ) &
        / ( y_max - y_min ) )

      if ( j == 1 ) then
        write ( file_unit, '(i3,2x,i3,2x,a)' ) x_ps, y_ps, ' moveto'
      else
        write ( file_unit, '(i3,2x,i3,2x,a)' ) x_ps, y_ps, ' lineto'
      end if

    end do

    write ( file_unit, '(a)' ) 'stroke'

  end do

  write ( file_unit, '(a)' ) 'restore  showpage'
  write ( file_unit, '(a)' ) '%'
  write ( file_unit, '(a)' ) '%  End of page.'
  write ( file_unit, '(a)' ) '%'
  write ( file_unit, '(a)' ) '%%Trailer'
  write ( file_unit, '(a)' ) '%%EOF'
  close ( unit = file_unit )

  return
end
subroutine trinbr ( nvc, ntri, til, tnbr, htsiz, maxedg, ht, edge, ierror )

!*****************************************************************************80
!
!! trinbr() determines the neighboring triangles of every triangle.
!
!  Discussion: 
!
!    Determine the neighboring triangle, if any, along each edge
!    of every triangle of triangulation of polygonal region.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, integer NVC, the number of vertices in triangulation.
!
!    Input, integer NTRI, the number of triangles in triangulation.
!
!    Input, integer TIL(1:3,1:NTRI), the triangle incidence list; TIL(1:3,I) 
!    contains indices in VCL of 3 vertices of Ith triangle in counter 
!    clockwise order.
!
!    Input, integer HTSIZ, the size of hash table HT; should be a prime number
!    which is about NB where NB is number of boundary edges.
!
!    Input, integer MAXEDG, the maximum size available for EDGE array; should
!    be about 2*NB.
!
!    Output, integer TNBR(1:3,1:NTRI), the triangle neighbor list; positive 
!    elements are indices of TIL; zero elements indicate boundary edges.
!
!    Workspace, integer HT(0:HTSIZ-1), EDGE(1:4,1:MAXEDG), the hash table 
!    and edge records used to determine matching occurrences of triangle edges
!    by calling routine EDGHT.
!
!    Output, integer IERROR, error flag.  On abnormal return,
!    IERROR is set to 1.
!
  implicit none

  integer htsiz
  integer maxedg
  integer ntri

  integer e
  integer edge(4,maxedg)
  integer hdfree
  integer ht(0:htsiz-1)
  integer i
  integer i3
  integer ierror
  integer j
  integer, save, dimension ( 3 ) :: jp1 = (/ 2, 3, 1 /)
  integer last
  integer nvc
  integer t
  integer til(3,ntri)
  integer tnbr(3,ntri)
  integer w

  ierror = 0
  hdfree = 0
  last = 0
  ht(0:htsiz-1) = 0

  do i = 1, ntri

    i3 = i * 3

    do j = 1, 3

      call edght ( til(j,i), til(jp1(j),i), i3+j-1, nvc, htsiz, maxedg, &
        hdfree, last, ht, edge, w, ierror )

      if ( ierror /= 0 ) then
        return
      end if

      if ( 0 < w ) then
        t = w / 3
        e = mod ( w, 3 ) + 1
        tnbr(e,t) = i
        tnbr(j,i) = t
      end if

    end do

  end do

  do while ( hdfree /= 0 )
    edge(1,hdfree) = 0
    hdfree = edge(4,hdfree)
  end do

  do i = 1, last

    if ( edge(1,i) /= 0 ) then
      t = edge(3,i)/3
      e = mod ( edge(3,i), 3 ) + 1
      tnbr(e,t) = 0
    end if

  end do

  return
end
subroutine tripr2 ( nvc, npolg, nvert, maxvc, maxti, maxiw, maxwk, h, vcl,  &
  hvl, pvl, iang, ntri, til, vstart, vnum, tstart, iwk, wk, ierror )

!*****************************************************************************80
!
!! tripr2() generates triangles inside each convex polygon of a decomposition.
!
!  Discussion: 
!
!    Generate mesh vertices and triangles inside each convex
!    polygon of decomposition according to mesh spacings in H array
!    to get a triangulation of a polygonal region.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input/output, integer NVC, the number of vertex coordinates or positions
!    used in VCL array.
!
!    Input, integer NPOLG, the number of polygonal subregions or positions 
!    used in HVL array.
!
!    Input, integer NVERT, the number of polygon vertices or positions used 
!    in PVL array.
!
!    Input, integer MAXVC, the maximum size available for VCL array, should 
!    be greater than or equal to the number of mesh vertices in the 
!    triangulation of the region.
!
!    Input, integer MAXTI, the maximum size available for TIL array, should 
!    be greater than or equal to the number of triangles in the triangulation 
!    of region.
!
!    Input, integer MAXIW, the maximum size available for IWK array, should 
!    be greater than or equal to 5*(NBC+NCW)+2, where NBC is maximum number 
!    of mesh edges on boundary of a polygon, NCW is maximum number of edges
!    on boundary of interior triangulation.
!
!    Input, integer MAXWK, the maximum size available for WK array, should 
!    be at least 5*NVRT+4 where NVRT is max no. of vertices in a polygon.
!
!    Input, real ( kind = rk8 ) H(1:NPOLG), the mesh spacings for the polygons 
!    of the decomposition.
!
!    Input/output, real ( kind = rk8 ) VCL(2,MAXVC), the vertex coordinates.
!
!    Input, integer HVL(1:NPOLG), the head vertex list.
!
!    Input, integer PVL(1:4,1:NVERT), real ( kind = rk8 ) IANG(1:NVERT), the 
!    polygon vertex list and interior angles; see routine DSPGDC for 
!    more details.
!
!    Output, integer NTRI, the number of triangles in triangulation of region.
!
!    Output, integer TIL(1:3,1:NTRI), the triangle incidence list; TIL(1:3,I) 
!    contains indices in VCL of 3 vertices of Ith triangle in counter
!    clockwise order.
!
!    Output, integer VSTART(1:NVERT), the start location in VCL for mesh 
!    vertices on each edge in PVL if there are any, else 0.
!
!    Output, integer VNUM(1:NVERT), the number of mesh vertices on interior
!    of each edge in PVL; entry is negated if mesh vertices are
!    listed in backward order in VCL.
!
!    Output, integer TSTART(1:NPOLG), the start location in TIL of triangles in
!    each polygon; TIL(1:3,I) for I=TSTRT(K),...,TSTRT(K+1)-1
!    are the triangles in the K-th polygon.
!
!    Workspace, integer IWK(1:MAXIW).
!
!    Workspace, real ( kind = rk8 ) WK(1:MAXWK).
!
!    Output, integer IERROR, error flag.  On abnormal return,
!    IERROR is set to 3, 6, 7, 9, 10, 200, 202, 230, or 231
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  integer maxiw
  integer maxti
  integer maxvc
  integer maxwk
  integer npolg
  integer nvert

  integer bndcyc
  real ( kind = rk8 ) h(npolg)
  integer hvl(npolg)
  integer i
  real ( kind = rk8 ) iang(nvert)
  integer ierror
  integer iwk(maxiw)
  integer j
  integer k
  integer, parameter :: loc = 1
  integer nbc
  integer ntri
  integer nvc
  integer nvrt
  real ( kind = rk8 ), parameter :: pi = 3.141592653589793D+00
  real ( kind = rk8 ) pimtol
  integer pvl(4,nvert)
  integer, parameter :: succ = 3
  integer til(3,maxti)
  real ( kind = rk8 ) tol
  integer tstart(npolg)
  real ( kind = rk8 ) vcl(2,maxvc)
  integer vnum(nvert)
  integer vstart(nvert)
  real ( kind = rk8 ) wk(maxwk)
  integer xc
  integer yc

  ierror = 0
  tol = 100.0D+00 * epsilon ( tol )

  ntri = 0
  pimtol = pi - tol


  call bedgmv ( nvc, npolg, nvert, maxvc, h, vcl, hvl, pvl, vstart, vnum, &
    ierror )

  if ( ierror /= 0 ) then
    write ( *, '(a)' ) ' '
    write ( *, '(a)' ) 'TRIPR2 - Fatal error!'
    write ( *, '(a)' ) '  Error return from BEDGMV.'
    return
  end if

  do k = 1, npolg

    nvrt = 0
    nbc = 0
    i = hvl(k)

    do

      if ( iang(i) < pimtol ) then
        nvrt = nvrt + 1
      endif

      nbc = nbc + 1 + abs ( vnum(i))
      i = pvl(succ,i)

      if ( i == hvl(k) ) then
        exit
      end if

    end do

    if ( maxiw < nbc + 1 ) then
      ierror = 6
      return
    end if

    if ( maxwk < 2*nvrt + 2  ) then
      ierror = 7
      return
    end if

    xc = 1
    yc = xc + nvrt + 1
    bndcyc = 1

    do

      j = pvl(loc,i)

      if ( iang(i) < pimtol ) then
        wk(xc) = vcl(1,j)
        wk(yc) = vcl(2,j)
        xc = xc + 1
        yc = yc + 1
      end if

      iwk(bndcyc) = j
      bndcyc = bndcyc + 1

      if ( 0 <= vnum(i) ) then
        do j = vstart(i), vstart(i)+vnum(i)-1
          iwk(bndcyc) = j
          bndcyc = bndcyc + 1
        end do
      else
        do j = vstart(i)-vnum(i)-1, vstart(i),-1
          iwk(bndcyc) = j
          bndcyc = bndcyc + 1
        end do
      end if

      i = pvl(succ,i)

      if ( i == hvl(k) ) then
        exit
      end if

    end do

    wk(xc) = wk(1)
    wk(yc) = wk(nvrt+2)
    iwk(bndcyc) = iwk(1)
    xc = 1
    yc = xc + nvrt + 1
    bndcyc = 1
    tstart(k) = ntri + 1
!
!  Generate a Delaunay triangulation inside a convex polygon.
!
    call trpolg ( nvrt, wk(xc), wk(yc), h(k), nbc, iwk(bndcyc), 2, nvc, ntri, &
      maxvc, maxti, maxiw-nbc-1, maxwk-2*nvrt-2, vcl, til, iwk(nbc+2), &
      wk(2*nvrt+3), ierror )

    if ( ierror /= 0 ) then
      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) 'TRIPR2 - Fatal error!'
      write ( *, '(a)' ) '  Error return from TRPOLG.'
      write ( *, '(a,i6)' ) '  IERROR = ', ierror
      return
    end if

  end do

  return
end
subroutine trisiz ( ntrid, npolg, hvl, pvl, area, psi, h, indp, loch )

!*****************************************************************************80
!
!! trisiz() smooths the mean mesh distribution function.
!
!  Discussion: 
!
!    Smooth PSI (mean mesh distribution function) values using
!    heap so that they differ by a factor of at most 4 in adjacent
!    polygons and then compute triangle sizes for each polygon.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, integer NTRID, the desired number of triangles in mesh.
!
!    Input, integer NPOLG, the number of polygons or positions used in
!    HVL array.
!
!    Input, integer HVL(1:NPOLG), the head vertex list.
!
!    Input, integer PVL(1:4,1:*), the polygon vertex list.
!
!    Input, real ( kind = rk8 ) AREA(1:NPOLG), the area of convex polygons 
!    in decomposition.
!
!    Input/output, real ( kind = rk8 ) PSI(1:NPOLG), the mean mdf values in 
!    the convex polygons.
!
!    Output, real ( kind = rk8 ) H(1:NPOLG), the triangle size for
!    convex polygons.
!
!    Workspace, integer INDP(1:NPOLG), the indices of polygon or PSI which 
!    are maintained in heap according to PSI values.
!
!    Workspace, integer LOCH(1:NPOLG), the location of polygon indices in heap.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  integer npolg

  real ( kind = rk8 ) area(npolg)
  integer, parameter :: edgv = 4
  real ( kind = rk8 ) factor
  real ( kind = rk8 ) h(npolg)
  integer hvl(npolg)
  integer i
  integer indp(npolg)
  integer j
  integer k
  integer l
  integer loch(npolg)
  integer ntrid
  integer, parameter :: polg = 2
  real ( kind = rk8 ) psi(npolg)
  integer pvl(4,*)
  integer r
  integer, parameter :: succ = 3

  factor = 0.25D+00

  call i4vec_indicator ( npolg, indp )
  call i4vec_indicator ( npolg, loch )

  k = int ( npolg / 2 )

  do l = k, 1, -1
    call sfdwmf ( l, npolg, psi, indp, loch )
  end do

  do r = npolg, 2, -1

    j = indp(1)
    indp(1) = indp(r)
    loch(indp(1)) = 1
    call sfdwmf ( 1, r-1, psi, indp, loch )
    i = hvl(j)

    do

      k = pvl(edgv,i)

      if ( 0 < k ) then

        k = pvl(polg,k)

        if ( psi(k) < psi(j) * factor ) then
          psi(k) = psi(j) * factor
          call sfupmf ( loch(k), psi, indp, loch )
        end if

      end if

      i = pvl(succ,i)

      if ( i == hvl(j) ) then
        exit
      end if

    end do

  end do

  psi(1:npolg) = psi(1:npolg) / dot_product ( psi(1:npolg), area(1:npolg) )

  h(1:npolg) = sqrt ( 2.0D+00  / ( real ( ntrid, kind = rk8 ) * psi(1:npolg) ) )

  return
end
subroutine trpolg ( nvrt, xc, yc, h, nbc, bndcyc, ldv, nvc, ntri, maxvc,  &
  maxti, maxiw, maxwk, vcl, til, iwk, wk, ierror )

!*****************************************************************************80
!
!! trpolg() generates a Delaunay triangular mesh inside a convex polygon.
!
!  Discussion:
!
!    A quasi-uniform grid of spacing H is used.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, integer NVRT, the number of vertices on the boundary of
!    convex polygon.
!
!    Input, real ( kind = rk8 ) XC(0:NVRT), YC(0:NVRT), the vertex coordinates 
!    in counter clockwise order; (XC(0),YC(0)) = (XC(NVRT),YC(NVRT)); it is 
!    assumed that all interior angles are < PI.
!
!    Input, real ( kind = rk8 ) H, the spacing of mesh vertices in polygon.
!
!    Input, integer NBC, the size of BNDCYC.
!
!    Input/output, integer BNDCYC(0:NBC), the indices in VCL of mesh 
!    vertices of boundary cycle; BNDCYC(0) = BNDCYC(NBC); 
!    contains (XC(I),YC(I)).
!
!    Input, integer LDV, the leading dimension of VCL in calling routine.
!
!    Input/output, integer NVC, the number of coordinates or positions used 
!    in VCL array.
!
!    Input/output, integer NTRI, the number of triangles or positions used 
!    in TIL.
!
!    Input, integer MAXVC, the maximum size available for VCL array.
!
!    Input, integer MAXTI, the maximum size available for TIL array.
!
!    Input, integer MAXIW, the maximum size available for IWK array, should 
!    be at least 6*(1 + INT(DIAM/H)) + 4*(NBC + NCW) where DIAM is
!    diameter of polygon, NCW is number of edges on boundary
!    of interior triangulation.
!
!    Input, integer MAXWK, the maximum size available for WK array, should 
!    be at least 3*NVRT+2.
!
!    Input/output, real ( kind = rk8 ) VCL(1:2,1:NVC), the vertex coordinate list.
!
!    Input/output, integer TIL(1:3,1:NTRI), the triangle incidence list.
!
!    Workspace, integer IWK(1:MAXIW).
!
!    Workspace, real ( kind = rk8 ) WK(1:MAXWK).
!
!    Output, integer IERROR, error flag.  On abnormal return,
!    IERROR is set to 3, 6, 7, 9, 10, 200, 202, 230, or 231.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  integer ldv
  integer maxiw
  integer maxti
  integer maxvc
  integer maxwk
  integer nbc
  integer nvrt

  integer bndcyc(0:nbc)
  real ( kind = rk8 ) costh
  integer cwalk
  real ( kind = rk8 ) dist
  real ( kind = rk8 ) h
  real ( kind = rk8 ) hs
  integer i
  integer i1
  integer i2
  integer ibot
  integer iedge
  integer ierror
  integer ind
  logical inter
  integer iwk(maxiw)
  integer maxcw
  integer mbc
  integer ncw
  integer nshr
  integer nt
  integer ntri
  integer nvc
  integer sdist
  real ( kind = rk8 ) sinth
  real ( kind = rk8 ) smdist
  integer sptr
  integer tedg
  integer til(3,maxti)
  real ( kind = rk8 ) vcl(ldv,maxvc)
  real ( kind = rk8 ) wk(maxwk)
  real ( kind = rk8 ) x0
  real ( kind = rk8 ) xc(0:nvrt)
  real ( kind = rk8 ) xi
  integer xs
  real ( kind = rk8 ) y0
  real ( kind = rk8 ) yc(0:nvrt)
  real ( kind = rk8 ) yi
  real ( kind = rk8 ) yr
  integer ys

  ierror = 0

  if ( maxiw < nvrt + 1 ) then
    ierror = 6
    return
  end if

  if ( maxwk < 3*nvrt + 2 ) then
    ierror = 7
    return
  end if

  xs = 1
  ys = xs + nvrt + 1
  sdist = ys + nvrt + 1
  iedge = 1
  hs = h / sqrt ( 2.0D+00 )
  wk(sdist:sdist+nvrt-1) = hs

  call shrnk2 ( nvrt, xc, yc, wk(sdist), nshr, wk(xs), wk(ys), iwk(iedge), &
    ierror )

  if ( ierror /= 0 ) then
    return
  end if

  inter = ( 0 < nshr )

  if ( inter ) then

    call diam2 ( nshr, wk(xs+1), wk(ys+1), i1, i2, dist, ierror )

    if ( ierror /= 0 ) then
      return
    end if

    call rotpg ( nshr, wk(xs), wk(ys), i1, i2, ibot, costh, sinth )

    maxcw = 6 * ( 1 + int ( ( wk(ys) - wk(ys+ibot) ) / h ) )

    if ( maxiw < maxcw + 1 ) then
      ierror = 6
      return
    end if

    cwalk = 1

    call inttri ( nshr, wk(xs), wk(ys), h, ibot, costh, sinth, ldv, nvc, ntri, &
      maxvc, maxti, maxcw, vcl, til, ncw, iwk(cwalk), ierror )

    if ( ierror /= 0 ) then
      return
    end if
!
!  Determine the mesh vertex which should be moved to front of
!  BNDCYC - closest to CWALK(0) and also with y-coordinate
!  greater than that of CWALK(0) when rotated if 0 < NCW.
!
    x0 = vcl(1,iwk(cwalk))
    y0 = vcl(2,iwk(cwalk))

    if ( 0 < ncw ) then
      yr = sinth * x0 + costh * y0
    end if

    smdist = 100000.0D+00 * h**2

    do i = 0, nbc-1

      xi = vcl(1,bndcyc(i))
      yi = vcl(2,bndcyc(i))

      if ( 0 < ncw ) then
        if ( sinth * xi + costh * yi <= yr ) then
          cycle
        end if
      end if

      dist = ( xi - x0 )**2 + ( yi - y0 )**2

      if ( dist < smdist ) then
        smdist = dist
        ind = i
      end if

    end do

    call rotiar ( nbc, bndcyc, ind )
    bndcyc(nbc) = bndcyc(0)
    nt = nbc + ncw
    tedg = cwalk + ncw + 1

  else

    call diam2 ( nvrt, xc(1), yc(1), i1, i2, dist, ierror )

    if ( ierror /= 0 ) then
      return
    end if

    ind = 0

    do

      if ( nbc <= ind ) then
        exit
      end if

      if ( xc(i1) == vcl(1,bndcyc(ind)) .and. &
           yc(i1) == vcl(2,bndcyc(ind)) ) then
        exit
      end if

      ind = ind + 1

    end do

    call rotiar ( nbc, bndcyc, ind )
    bndcyc(nbc) = bndcyc(0)
    mbc = 1

    do

      if ( nbc <= mbc ) then
        exit
      end if

      if ( xc(i2) == vcl(1,bndcyc(mbc)) .and. &
           yc(i2) == vcl(2,bndcyc(mbc)) ) then
        exit
      end if

      mbc = mbc + 1

    end do

    ind = nbc

    do i = mbc+1, mbc+(nbc-mbc-1)/2
      ind = ind - 1
      i1 = bndcyc(i)
      bndcyc(i) = bndcyc(ind)
      bndcyc(ind) = i1
    end do

    bndcyc(nbc) = bndcyc(mbc)
    nt = nbc - 2
    tedg = 1
!
!  Left boundary chain contains mesh vertices BNDCYC(0:MBC)
!  and right chain contains BNDCYC(0,MBC+1:NBC); MBC < NBC.
!
  end if

  if ( maxti < ntri + nt ) then
    ierror = 9
    return
  else if ( maxiw < tedg + 4*nt - 1 ) then
    ierror = 6
    return
  end if

  if ( inter ) then
    call tmerge ( inter, nbc, ncw, bndcyc, iwk(cwalk), ldv, vcl, &
      til(1,ntri+1), iwk(tedg), ierror )
  else
    call tmerge ( inter, mbc, nbc-mbc, bndcyc, bndcyc(mbc), ldv, vcl, &
      til(1,ntri+1), iwk(tedg), ierror )
  end if

  if ( ierror /= 0 ) then
    return
  end if

  sptr = tedg + 3 * nt

  call cvdtri ( inter, ldv, nt, vcl, til(1,ntri+1), iwk(tedg), iwk(sptr), &
    ierror )

  ntri = ntri + nt

  return
end
function umdf2 ( x, y )

!*****************************************************************************80
!
!! umdf2() is a dummy mesh distribution function.
!
!  Discussion: 
!
!    Dummy user-supplied mesh distribution function which
!    is provided if heuristic mesh distribution function is used.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe,
!    GEOMPACK - a software package for the generation of meshes
!    using geometric algorithms,
!    Advances in Engineering Software,
!    Volume 13, pages 325-331, 1991.
!
!  Parameters:
!
!    Input, real ( kind = rk8 ) X, Y, the coordinates of a point.
!
!    Output, real ( kind = rk8 ) UMDF2, the mesh distribution function value 
!    at (X,Y)
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  real ( kind = rk8 ) umdf2
  real ( kind = rk8 ) x
  real ( kind = rk8 ) y

  umdf2 = ( x + 1.0D+00 ) * ( y + 1.0D+00 )

  return
end
function urand ( iy )

!*****************************************************************************80
!
!! urand() is a uniform random number generator.
!
!  Discussion:
!
!    URAND is a uniform random number generator based on theory and
!    suggestions given in D. E. Knuth (1969), Vol. 2. The integer IY
!    should be initialized to an arbitrary integer prior to the first
!    call to URAND. The calling program should not alter the value of
!    IY between subsequent calls to URAND. Values of URAND will be
!    returned in the interval (0,1).
!
!  Reference:
!
!    Forsythe, Malcolm, Moler, 
!    page 246.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Parameters:
!
!    Input, integer IY, the seed value.
!
!    Output, real ( kind = rk8 ) URAND, the random value.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  real ( kind = rk8 ) halfm
  integer, save :: ia = 0
  integer, save :: ic = 0
  integer, parameter :: itwo = 2
  integer iy
  integer m
  integer, save :: m2 = 0
  integer, save :: mic = 0
  real ( kind = rk8 ), save :: s = 0.0D+00
  real ( kind = rk8 ) urand
!
!  If first entry, compute machine integer word length.
!
  if ( m2 == 0 ) then

    m = 1

    do

      m2 = m
      m = itwo * m2

      if ( m <= m2 ) then
        exit
      end if

    end do

    halfm = m2
!
!  Compute multiplier and increment for linear congruential method.
!
    ia = 8 * int ( halfm * atan ( 1.0D+00 ) / 8.0D+00 ) + 5
    ic = 2 * int ( halfm * ( 0.5D+00 - sqrt ( 3.0D+00 ) / 6.0D+00 ) ) + 1
    mic = ( m2 - ic ) + m2
!
!  S is the scale factor for converting to floating point.
!
    s = 0.5D+00 / halfm

  end if
!
!  Compute next random number.
!
  iy = iy * ia
!
!  The following statement is for computers which do not allow
!  integer overflow on addition.
!
  if ( mic < iy ) then
    iy = ( iy - m2 ) - m2
  end if

  iy = iy + ic
!
!  The following statement is for computers where the word
!  length for addition is greater than for multiplication.
!
  if ( m2 < iy / 2 ) then
    iy = (iy - m2) - m2
  end if
!
!  The following statement is for computers where integer
!  overflow affects the sign bit.
!
  if ( iy < 0 ) then
    iy = ( iy + m2 ) + m2
  end if

  urand = real ( iy, kind = rk8 ) * s

  return
end
subroutine vbedg ( x, y, vcl, til, tnbr, ltri, ledg, rtri, redg )

!*****************************************************************************80
!
!! vbedg() determines visible boundary edges of a 2D triangulation.
!
!  Discussion: 
!
!    Determine boundary edges of 2D triangulation which are
!    visible from point (X,Y) outside convex hull.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Parameters:
!
!    Input, real ( kind = rk8 ) X, Y, the coordinates of a 2D point outside
!    the convex hull.
!
!    Input, real ( kind = rk8 ) VCL(1:2,1:*), the coordinates of 2D vertices.
!
!    Input, integer TIL(1:3,1:*), the triangle incidence list.
!
!    Input, integer TNBR(1:3,1:*), the triangle neighbor list; negative 
!    values are used for links of counter clockwise linked list of boundary
!    edges; LINK = -(3*I + J-1) where I, J = triangle, edge index.
!
!    Input/output, integer LTRI, LEDG.  On input, if LTRI /= 0 then they 
!    are assumed to be as defined below and are not changed, else they are 
!    updated.  On output, LTRI is the index of the boundary triangle to the
!    left of leftmost boundary triangle visible from (X,Y), and LEDG is the
!    boundary edge of triangle LTRI to left of leftmost
!    boundary edge visible from (X,Y).  1 <= LEDG <= 3.
!
!    Input/output, integer RTRI, on input, the index of boundary triangle 
!    to begin search at.  On output, the index of rightmost boundary triangle 
!    visible from (X,Y).
!
!    Input/output, integer REDG.  On input, the edge of triangle RTRI that 
!    is visible from (X,Y).  On output, REDG has been updated so that this
!    is still true. 1 <= REDG <= 3.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  integer a
  integer b
  integer e
  integer i4_wrap
  integer l
  logical ldone
  integer ledg
  integer lr
  integer lrline
  integer ltri
  integer redg
  integer rtri
  integer t
  integer til(3,*)
  integer tnbr(3,*)
  real ( kind = rk8 ) vcl(2,*)
  real ( kind = rk8 ) x
  real ( kind = rk8 ) y
!
!  Find rightmost visible boundary edge using links, then possibly
!  leftmost visible boundary edge using triangle neighbor information.
!
  if ( ltri == 0 ) then
    ldone = .false.
    ltri = rtri
    ledg = redg
  else
    ldone = .true.
  end if

  do

    l = -tnbr(redg,rtri)
    t = l / 3
    e = mod ( l, 3 ) + 1
    a = til(e,t)

    if ( e <= 2 ) then
      b = til(e+1,t)
    else
      b = til(1,t)
    end if

    lr = lrline ( x, y, vcl(1,a), vcl(2,a), vcl(1,b), vcl(2,b), 0.0D+00 )

    if ( lr <= 0 ) then
      exit
    end if

    rtri = t
    redg = e
 
  end do

  if ( ldone ) then
    return
  end if

  t = ltri
  e = ledg

  do

    b = til(e,t)
    e = i4_wrap ( e-1, 1, 3 )

    do while ( 0 < tnbr(e,t) )

      t = tnbr(e,t)

      if ( til(1,t) == b ) then
        e = 3
      else if ( til(2,t) == b ) then
        e = 1
      else
        e = 2
      end if

    end do

    a = til(e,t)
    lr = lrline ( x, y, vcl(1,a), vcl(2,a), vcl(1,b), vcl(2,b), 0.0D+00 )

    if ( lr <= 0 ) then
      exit
    end if

  end do

  ltri = t
  ledg = e

  return
end
subroutine vispol ( xeye, yeye, nvrt, xc, yc, nvis, ivis, ierror )

!*****************************************************************************80
!
!! vispol() computes the visibility polygon.
!
!  Discussion: 
!
!    Compute the visibility polygon VP from an eyepoint in
!    the interior or blocked exterior of a simple polygon P or
!    on the boundary of a simply connected polygonal region P.
!    In the latter case, the interior angles at all vertices must
!    be strictly between 0 and 2*PI.
!
!  Discussion:
!
!    On input, XC and YC contain vertex coordinates of P. During
!    the algorithm, part of XC, YC is used as a stack, which, on
!    output, contains the vertex coordinates of VP. The stack
!    vertices overwrite the input vertices as the input vertices
!    are scanned. Elements of IVIS are set when vertices are added
!    to the stack; these values may have +NV or -NV added to them
!    to indicate that stack point has same angle as previous one.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Reference:
!
!    Barry Joe, R. B. Simpson, 
!    BIT 27 (1987), pages 458-473.
!
!  Parameters:
!
!    Input, real ( kind = rk8 ) XEYE, YEYE, the coordinates of eyepoint; must 
!    be a simple vertex if it lies on the boundary (i.e. occurs only once).
!
!    Input, integer NVRT, the upper subscript of XC, YC (approximate
!    number of vertices).
!
!    Input/output, real ( kind = rk8 ) XC(0:NVRT), YC(0:NVRT).  On input, if 
!    eyepoint is interior or blocked exterior then arrays contain coordinates 
!    in counter clockwise or clockwise order, respectively, with 
!    (XC(0),YC(0)) = (XC(NVRT),YC(NVRT)); (XC(0),YC(0)) is a vertex visible from
!    (XEYE,YEYE), e.g. as computed by routine ROTIPG.  If eyepoint is a vertex
!    of P then arrays contain coordinates in counter clockwise order; 
!    (XC(0),YC(0)) is successor vertex of (XEYE,YEYE); (XC(NVRT),YC(NVRT)) is
!    predecessor vertex of (XEYE,YEYE).
!    On output, XC and YC contain the vertices of VP in counter clockwise order;
!    if eyepoint is interior or blocked exterior then
!    (XC(0),YC(0)) = (XC(NVIS),YC(NVIS)), else (XC(0),YC(0))
!    and (XC(NVIS),YC(NVIS)) are the successor and
!    predecessor vertices of (XEYE,YEYE) in VP.
!
!    Output, integer NVIS, the upper subscript of XC, YC on output (approximate
!    number of vertices of VP); NVIS <= NVRT.
!
!    Output, integer IVIS(0:NVIS), contains information about the vertices 
!    of VP with respect to the vertices of P; IVIS(I) = K if (XC(I),YC(I))
!    is the vertex of index K in the input polygon; IVIS(I) = -K if 
!    (XC(I),YC(I)) is on the interior of the edge joining vertices of index 
!    K-1 and K in input polygon
!
!    Output, integer IERROR, error flag.  On abnormal return,
!    IERROR is set to 206, 207, 208, 209, or 210
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  integer nvrt

  logical beye
  integer cur
  integer i
  integer ierror
  integer ivis(0:nvrt)
  integer lr
  integer lrline
  integer nv
  integer nvis
  integer oper
  integer top
  real ( kind = rk8 ) xc(0:nvrt)
  real ( kind = rk8 ) xe
  real ( kind = rk8 ) xeye
  real ( kind = rk8 ) xw
  real ( kind = rk8 ) yc(0:nvrt)
  real ( kind = rk8 ) ye
  real ( kind = rk8 ) yeye
  real ( kind = rk8 ) yw

  common /gvpvar/ nv,oper,cur,top,xe,ye,xw,yw,beye
  save /gvpvar/
!
!     Variables in common block GVPVAR:
!        NV - NVRT
!        OPER - operation code 1 to 7 for LEFT, RIGHT, SCANA, SCANB,
!              SCANC, SCAND, FINISH
!        CUR - index of current vertex of P in XC, YC arrays
!        TOP - index of top vertex of stack in XC, YC arrays
!              (TOP <= CUR is always satisfied)
!        XE,YE - XEYE,YEYE
!        XW,YW - coordinates of point on last or second-last edge
!              processed (needed for routines VPSCNB, VPSCNC, VPSCND)
!        BEYE - .TRUE. iff eyepoint is on boundary
!
  ierror = 0
  beye = xc(0) /= xc(nvrt) .or. yc(0) /= yc(nvrt)
  nv = nvrt
  xe = xeye
  ye = yeye
  ivis(0) = 0
  cur = 1

  if ( beye ) then

    do

      lr = lrline ( xc(nv-1), yc(nv-1), xe, ye, xc(nv), yc(nv), 0.0D+00 )

      if ( lr /= 0 ) then
        exit
      end if
      nv = nv - 1

    end do

  end if

  do

    lr = lrline ( xc(cur), yc(cur), xe, ye, xc(0), yc(0), 0.0D+00 )

    if ( lr /= 0 ) then
      exit
    end if

    cur = cur + 1

  end do

  if ( lr == -1 ) then
    oper = 1
    if ( cur == 1 ) then
      top = 1
      ivis(1) = cur
    else if ( beye ) then
      top = 1
      xc(0) = xc(cur-1)
      yc(0) = yc(cur-1)
      ivis(0) = cur - 1
      xc(1) = xc(cur)
      yc(1) = yc(cur)
      ivis(1) = cur
    else
      top = 2
      xc(1) = xc(cur-1)
      yc(1) = yc(cur-1)
      ivis(1) = cur - 1 + nv
      xc(2) = xc(cur)
      yc(2) = yc(cur)
      ivis(2) = cur
    end if
  else
    oper = 3
    top = 0
    if ( beye .and. 1 < cur ) then
      xc(0) = xc(cur-1)
      yc(0) = yc(cur-1)
      ivis(0) = cur - 1
    end if
  end if
!
!  Angular displacement of stack points are in nondecreasing order,
!  with at most two consecutive points having the same displacement.
!
  do

    if ( oper == 1 ) then
      call vpleft ( xc, yc, ivis )
    else if ( oper == 2 ) then
      call vprght ( xc, yc, ivis, ierror )
    else if ( oper == 3 ) then
      call vpscna ( xc, yc, ivis, ierror )
    else if ( oper == 4 ) then
      call vpscnb ( xc, yc, ivis, ierror )
    else if ( oper == 5 ) then
      call vpscnc ( xc, yc, ivis, ierror )
    else
      call vpscnd ( xc, yc, ivis, ierror )
    end if

    if ( ierror /= 0 ) then
      nvis = top
      return
    end if

    if ( 6 < oper ) then
      exit
    end if

  end do
!
!  Add or subtract NV from those IVIS values which are used to
!  indicate that stack point has same angle as previous one.
!
  do i = 1, top

    if ( nv < ivis(i) ) then
      ivis(i) = ivis(i) - nv
    else if ( ivis(i) < -nv ) then
      ivis(i) = ivis(i) + nv
    end if

  end do

  nvis = top

  return
end
subroutine visvrt ( angspc, xeye, yeye, nvis, xc, yc, ivis, maxn, nvsvrt, &
  theta )

!*****************************************************************************80
!
!! visvrt() determines a list of visible vertices.
!
!  Discussion: 
!
!    Determine a list of visible vertices, ordered by
!    increasing "polar angle", on the boundary of the visibilty
!    polygon from boundary eyepoint (XEYE,YEYE).  This list
!    includes the vertices of visibility polygon such that a
!    line segment from (XEYE,YEYE) to vertex lies in interior
!    of polygon, as well as extra points on edges which subtend
!    an angle greater than or equal to 2*ANGSPC at (XEYE,YEYE).  
!
!    These extra points are at an equal angular spacing of at 
!    least ANGSPC and less than 2*ANGSPC.  The successor and predecessor 
!    of eyepoint are included in list.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Parameters:
!
!    Input, real ( kind = rk8 ) ANGSPC, the angle spacing parameter in radians 
!    which controls how many extra points become visible vertices.
!
!    Input, real ( kind = rk8 ) XEYE, YEYE, the coordinates of boundary eyepoint.
!
!    Input, integer NVIS, (number of vertices of visibility polygon) - 2.
!
!    Input/output, real ( kind = rk8 ) XC(0:NVIS), YC(0:NVIS), on input, the 
!    coordinates of the vertices of visibility polygon in counter clockwise 
!    order; (XC(0),YC(0)) and (XC(NVIS),YC(NVIS)) are the successor and 
!    predecessor vertices of eyepoint in visibility polygon; at most 2
!    consecutive vertices have same polar angle with respect to eyepoint.
!    On output, coordinates of visible vertices which overwrite the 
!    input coordinates.
!
!    Input/output, IVIS(0:NVIS), on input, contains information about the 
!    vertices of XC, YC arrays with respect to the original polygon from
!    which visibility polygon is computed; if IVIS(I) is nonnegative
!    then (XC(I),YC(I)) has index I in original polygon;
!    if IVIS(I) < 0 then (XC(I),YC(I)) is on the edge
!    ending at vertex of index -IVIS(I) in original polygon;
!    indexing starts at 0 from successor of eyepoint.
!    On output, coordinates of visible vertices
!    which overwrite the input coordinates.
!
!    Input, integer MAXN, the upper bound on NVSVRT; should be at least
!    NVIS + INT(PHI/ANGSPC) where PHI is the interior angle at (XEYE,YEYE).
!
!    Output, integer NVSVRT, (number of visible vertices) - 1.
!
!    Output, real ( kind = rk8 ) THETA(0:NVSVRT), the polar angles of visible 
!    vertices with respect to (XEYE,YEYE) at origin and (XC(0),YC(0))
!    on positive x-axis.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  integer maxn

  real ( kind = rk8 ) alpha
  real ( kind = rk8 ) ang
  real ( kind = rk8 ) ang1
  real ( kind = rk8 ) ang2
  real ( kind = rk8 ) angdif
  real ( kind = rk8 ) angle
  real ( kind = rk8 ) angsp2
  real ( kind = rk8 ) angspc
  real ( kind = rk8 ) cosang
  integer cur
  real ( kind = rk8 ) diff
  real ( kind = rk8 ) dx
  real ( kind = rk8 ) dy
  integer i
  integer ind
  integer ivis(0:maxn)
  integer k
  integer lr
  integer lrline
  integer n
  real ( kind = rk8 ) numer
  integer nvis
  integer nvsvrt
  real ( kind = rk8 ) r
  real ( kind = rk8 ) sinang
  real ( kind = rk8 ) theta(0:maxn)
  real ( kind = rk8 ) tol
  integer top
  real ( kind = rk8 ) xc(0:maxn)
  real ( kind = rk8 ) xeye
  real ( kind = rk8 ) yc(0:maxn)
  real ( kind = rk8 ) yeye

  tol = 100.0D+00 * epsilon ( tol )
!
!  Shift input vertices right, and possibly remove first and last
!  vertices due to collinearity with eyepoint.
!
  angsp2 = 2.0D+00 * angspc
  cur = maxn + 1
  n = maxn

  do i = nvis, 0, -1
    cur = cur - 1
    xc(cur) = xc(i)
    yc(cur) = yc(i)
    ivis(cur) = ivis(i)
  end do

  lr = lrline ( xc(cur+1), yc(cur+1), xeye, yeye, xc(cur), yc(cur), 0.0D+00 )

  if ( 0 <= lr ) then
    cur = cur + 1
    xc(0) = xc(cur)
    yc(0) = yc(cur)
    ivis(0) = ivis(cur)
  end if

  lr = lrline ( xc(n-1), yc(n-1), xeye, yeye, xc(n), yc(n), 0.0D+00 )

  if ( lr <= 0 ) then
    n = n - 1
  end if

  alpha = atan2 ( yc(0)-yeye, xc(0)-xeye )
  ang2 = 0.0D+00
  theta(0) = 0.0D+00
  top = 0
  cur = cur + 1
!
!  Process edge from vertices of indices CUR-1, CUR.
!
  do

    ang1 = ang2
    ang2 = angle ( xc(cur), yc(cur), xeye, yeye, xc(0), yc(0) )
    angdif = ang2 - ang1

    if ( angdif <= tol ) then
 
      diff = ( ( xc(cur) - xeye )**2 + ( yc(cur) - yeye)**2 ) - &
             ( ( xc(cur-1) - xeye )**2 + ( yc(cur-1) - yeye )**2 )

      if ( diff < 0.0D+00 ) then
        xc(top) = xc(cur)
        yc(top) = yc(cur)
        ivis(top) = ivis(cur)
        theta(top) = ang2
      end if

    else

      if ( angsp2 <= angdif ) then

        k = int ( angdif / angspc )
        ind = -abs ( ivis(cur))
        angdif = angdif / real ( k, kind = rk8 )
        dx = xc(cur) - xc(cur-1)
        dy = yc(cur) - yc(cur-1)
        numer = ( xc(cur) - xeye ) * dy - ( yc(cur) - yeye ) * dx

        do i = 1, k-1
          top = top + 1
          theta(top) = ang1 + real ( i, kind = rk8 ) * angdif
          ang = theta(top) + alpha
          cosang = cos(ang)
          sinang = sin(ang)
          r = numer / ( dy * cosang - dx * sinang )
          xc(top) = r * cosang + xeye
          yc(top) = r * sinang + yeye
          ivis(top) = ind
        end do
 
      end if

      top = top + 1
      xc(top) = xc(cur)
      yc(top) = yc(cur)
      ivis(top) = ivis(cur)
      theta(top) = ang2

    end if

    cur = cur + 1

    if ( n < cur ) then
      exit
    end if

  end do

  nvsvrt = top

  return
end
subroutine vornbr ( xeye, yeye, nvrt, xc, yc, nvor, ivor, xvor, yvor, ierror )

!*****************************************************************************80
!
!! vornbr() determines the Voronoi neighbors of an eyepoint.
!
!  Discussion: 
!
!    Determine the Voronoi neighbors of (XEYE,YEYE) from a list of vertices 
!    which are in increasing "polar angle" order.
!
!    The Voronoi neighbors are a sublist of this list.  The
!    Voronoi polygon is restricted to the sector formed from 
!    the edges joining (XEYE,YEYE) to the first and last vertices
!    of this list.  Each Voronoi neighbor corresponds to an edge
!    of the Voronoi polygon.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Parameters:
!
!    Input, real ( kind = rk8 ) XEYE, YEYE, the coordinates of the eyepoint.
!
!    Input, integer NVRT, (number of vertices in list) minus 1.
!
!    Input, real ( kind = rk8 ) XC(0:NVRT), YC(0:NVRT), the vertex 
!    coordinates from which Voronoi neighbors are determined; (XC(0),YC(0)),...,
!    (XC(NVRT),YC(NVRT)) are in increasing angular
!    displacement order with respect to (XEYE,YEYE).
!
!    Output, integer NVOR, (number of Voronoi neighbors) minus 1 [<= NVRT].
!
!    Output, integer IVOR(0:NVOR), the indices of Voronoi neighbors in XC, YC
!    arrays; 0 <= IVOR(0) < ... < IVOR(NVOR) <= NVRT.
!
!    Workspace, real ( kind = rk8 ) XVOR(0:NVRT), YVOR(0:NVRT), arrays for
!    storing the vertex coordinates of the Voronoi polygon.
!
!    Output, integer IERROR, set to 212 if an error occurred.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  integer nvrt

  real ( kind = rk8 ) a11
  real ( kind = rk8 ) a12
  real ( kind = rk8 ) a21
  real ( kind = rk8 ) a22
  real ( kind = rk8 ) b1
  real ( kind = rk8 ) b2
  real ( kind = rk8 ) det
  integer ierror
  integer im
  integer ivor(0:nvrt)
  integer k
  integer lr
  integer lrline
  integer m
  integer nvor
  real ( kind = rk8 ) tol
  real ( kind = rk8 ) tolabs
  real ( kind = rk8 ) xc(0:nvrt)
  real ( kind = rk8 ) xeye
  real ( kind = rk8 ) xi
  real ( kind = rk8 ) xvor(0:nvrt)
  real ( kind = rk8 ) yc(0:nvrt)
  real ( kind = rk8 ) yeye
  real ( kind = rk8 ) yi
  real ( kind = rk8 ) yvor(0:nvrt)

  ierror = 0
  tol = 100.0D+00 * epsilon ( tol )

  k = 1
  m = 0
  ivor(0) = 0
  xvor(0) = ( xeye + xc(0) ) * 0.5D+00
  yvor(0) = ( yeye + yc(0) ) * 0.5D+00
!
!  Beginning of main loop
!
  do while ( k <= nvrt )
!
!  Determine the intersection of the perpendicular bisectors of edges 
!  from (XEYE,YEYE) to (XC(K),YC(K)) and 
!  from (XEYE,YEYE) to (XC(IM),YC(IM)).
!
     im = ivor(m)

     a11 = xc(k) - xeye
     a12 = yc(k) - yeye
     a21 = xc(im) - xeye
     a22 = yc(im) - yeye

     tolabs = tol * max ( abs ( a11 ), abs ( a12 ), abs ( a21 ), abs ( a22 ) )
     det = a11 * a22 - a21 * a12

     if ( abs ( det ) <= tolabs ) then
       ierror = 212
       return
     end if

     b1 = ( a11**2 + a12**2 ) * 0.5D+00
     b2 = ( a21**2 + a22**2 ) * 0.5D+00

     xi = ( b1 * a22 - b2 * a12 ) / det
     yi = ( b2 * a11 - b1 * a21 ) / det
!
!  Determine whether (XVOR(M+1),YVOR(M+1)) is to the left of or
!  on the directed line from (XEYE,YEYE) to (XVOR(M),YVOR(M)).
!
     xvor(m+1) = xi + xeye
     yvor(m+1) = yi + yeye
     lr = lrline ( xvor(m+1), yvor(m+1), xeye, yeye, xvor(m), yvor(m), 0.0D+00 )

     if ( lr <= 0 ) then
       m = m + 1
       ivor(m) = k
       k = k + 1
     else if ( 0 < m ) then
       m = m - 1
     else
!
!  Determine the intersection of edge from (XEYE,YEYE) to
!  (XC(0),YC(0)) and the perpendicular bisector of the edge
!  from (XEYE,YEYE) to (XC(K),YC(K)).
!
      a11 = xc(k) - xeye
      a12 = yc(k) - yeye
      a21 = yc(0) - yeye
      a22 = xeye - xc(0)
      tolabs = tol * max ( abs ( a11 ), abs ( a12 ), abs ( a21 ), abs ( a22 ) )
      det = a11 * a22 - a21 * a12

      if ( abs ( det) <= tolabs ) then
        ierror = 212
        return
      end if

      b1 = ( a11**2 + a12**2 ) * 0.5D+00
      b2 = 0.0D+00
      xi = ( b1 * a22 - b2 * a12 ) / det
      yi = ( b2 * a11 - b1 * a21 ) / det
      xvor(m) = xi + xeye
      yvor(m) = yi + yeye
      ivor(m) = k
      k = k + 1

    end if

  end do
!
!  The following short loop determines which vertices at the end
!  of list are not Voronoi neighbors.
!
  do

    lr = lrline ( xvor(m), yvor(m), xeye, yeye, xc(nvrt), yc(nvrt), 0.0D+00 )

    if ( 0 <= lr ) then
      exit
    end if

    m = m - 1
    if ( m < 0 ) then
      exit
    end if

  end do

  nvor = m

  return
end
subroutine vpleft ( xc, yc, ivis )

!*****************************************************************************80
!
!! vpleft() is called by routine VISPOL for the LEFT operation (OPER = 1).
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Parameters:
!
!     Input and updated parameters:
!
!        XC,YC,IVIS - see comments in routine VISPOL
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  logical beye
  integer cur
  logical intsct
  integer ivis(0:*)
  integer j
  integer lr
  integer lr1
  integer lr2
  integer lrline
  integer nv
  integer oper
  integer top
  real ( kind = rk8 ) xc(0:*)
  real ( kind = rk8 ) xe
  real ( kind = rk8 ) xu
  real ( kind = rk8 ) xw
  real ( kind = rk8 ) yc(0:*)
  real ( kind = rk8 ) ye
  real ( kind = rk8 ) yu
  real ( kind = rk8 ) yw

  common /gvpvar/ nv,oper,cur,top,xe,ye,xw,yw,beye
  save /gvpvar/
!
!  EYE-V(CUR-1)-V(CUR) is a left turn, S(TOP) = V(CUR), TOP <= CUR,
!  S(TOP-1) = V(CUR-1) or on interior of edge V(CUR-1)-V(CUR).
!
10 continue

  if ( cur == nv ) then
    oper = 7
    return
  end if

  if ( .not. beye .and. top <= 2 ) then
    go to 20
  end if
!
!  Check if angular displacement of stack chain is greater than or equal
!  to 2*PI or interior angle at boundary viewpoint.
!
  call xedge ( 1, xe, ye, xc(nv), yc(nv), xc(top-1), yc(top-1), xc(top), &
    yc(top), xu, yu, intsct )

  if ( intsct ) then

    oper = 4
    xw = xc(cur)
    yw = yc(cur)
    lr = lrline ( xc(top), yc(top), xe, ye, xc(nv), yc(nv), 0.0D+00 )

    if ( lr == -1 ) then
      xc(top) = xu
      yc(top) = yu
      ivis(top) = -cur
    end if

    return

  end if
!
!  Process next edge.
!
20 continue

  lr = lrline ( xc(cur+1), yc(cur+1), xe, ye, xc(cur), yc(cur), 0.0D+00 )

  if ( lr == -1 ) then

    cur = cur + 1
    top = top + 1
    xc(top) = xc(cur)
    yc(top) = yc(cur)
    ivis(top) = cur

  else

    j = cur + 1
    lr1 = lrline ( xc(j), yc(j), xc(top-1), yc(top-1), xc(cur), yc(cur), &
      0.0D+00 )

    if ( lr1 == 1 ) then

      oper = 3
      cur = j

    else

      if ( lr == 1 ) then
        lr2 = 1
        go to 40
      end if

      do

        j = j + 1
        lr2 = lrline ( xc(j), yc(j), xe, ye, xc(cur), yc(cur), 0.0D+00 )

        if ( lr2 /= 0 ) then
          exit
        end if

      end do

40    continue

      if ( lr2 == -1 ) then
        top = top + 1
        xc(top) = xc(j-1)
        yc(top) = yc(j-1)
        ivis(top) = j - 1 + nv
        top = top + 1
        xc(top) = xc(j)
        yc(top) = yc(j)
        ivis(top) = j
      else
        oper = 2
      end if

      cur = j

    end if

  end if
!
!  This test avoids extra subroutine calls.
!
  if ( oper == 1 ) then
    go to 10
  end if

  return
end
subroutine vprght ( xc, yc, ivis, ierror )

!*****************************************************************************80
!
!! vprght() is called by routine VISPOL for the RIGHT operation (OPER = 2).
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Parameters:
!
!     Input and updated parameters:
!        XC,YC,IVIS - see comments in routine VISPOL
!
!    Output, integer IERROR, error flag.  On abnormal return,
!    IERROR is set to 206.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  logical beye
  integer case
  integer cur
  integer ierror
  logical intsct
  integer ivis(0:*)
  integer j
  integer lr
  integer lr1
  integer lr2
  integer lrline
  integer nv
  integer oper
  integer top
  real ( kind = rk8 ) xc(0:*)
  real ( kind = rk8 ) xe
  real ( kind = rk8 ) xu
  real ( kind = rk8 ) xw
  real ( kind = rk8 ) yc(0:*)
  real ( kind = rk8 ) ye
  real ( kind = rk8 ) yu
  real ( kind = rk8 ) yw

  common /gvpvar/ nv,oper,cur,top,xe,ye,xw,yw,beye
  save /gvpvar/
!
!  EYE-V(CUR-1)-V(CUR) is a right turn, EYE-S(TOP)-V(CUR) is a right
!  turn, EYE-S(TOP-1)-S(TOP) is a left turn, TOP < CUR, S(TOP) =
!  V(CUR-1) and S(TOP-1)-S(TOP)-V(CUR) is a left turn or S(TOP) is
!  not on edge V(CUR-1)-V(CUR) and V(CUR-1)-V(CUR) intersects
!  EYE-S(TOP).
!  Pop points from stack. If BEYE, it is not possible for
!  (XC(CUR),YC(CUR)) to be identical to any stack points.
!
  ierror = 0

10 continue

  case = 0
  j = top

20 continue

  if ( abs ( ivis(j)) <= nv ) then

    lr = lrline ( xc(cur), yc(cur), xe, ye, xc(j-1), yc(j-1), 0.0D+00 )

    if ( lr == -1 ) then

      case = 1

    else if ( lr == 0 ) then

      if ( abs ( ivis(j-1)) <= nv ) then
        j = j - 1
        case = 2
      else if ( (xc(j-1) - xe)**2 + (yc(j-1) - ye)**2 <= &
                (xc(j-2) - xe)**2 + (yc(j-2) - ye)**2 ) then
        j = j - 2
        case = 2
      else
        case = -1
      end if

    end if

  else if ( case == -1 ) then

    if ( ( xc(cur) - xe )**2 + ( yc(cur) - ye )**2 <= &
         ( xc(j-1) - xe )**2 + ( yc(j-1) - ye )**2 ) then
      j = j - 1
      case = 2
    else
      xw = xc(cur)
      yw = yc(cur)
      case = 3
    end if

  else

    call xedge ( 0, xc(cur-1), yc(cur-1), xc(cur), yc(cur), &
      xc(j-1), yc(j-1), xc(j), yc(j), xw, yw, intsct )

    if ( intsct ) then
      case = 3
    end if

  end if

  if ( 0 < case ) then
    go to 30
  end if

  j = j - 1
  if ( 1 <= j ) then
    go to 20
  end if
!
!  Error from no more edges in stack.
!
  ierror = 206
  return
!
!  Process next edge.
!
30 continue

  if ( case == 3 ) then

    oper = 6
    top = j - 1

  else

    top = j
    xw = xc(cur-1)
    yw = yc(cur-1)

    if ( case == 1 ) then
      call xedge ( 1, xe, ye, xc(cur), yc(cur), xc(top-1), yc(top-1), &
            xc(top), yc(top), xu, yu, intsct )
      xc(top) = xu
      yc(top) = yu
      ivis(top) = -abs ( ivis(top))
    end if

    lr = lrline ( xc(cur+1), yc(cur+1), xe, ye, xc(cur), yc(cur), 0.0D+00 )

    if ( lr == 1 ) then

      cur = cur + 1

    else

      j = cur + 1
      lr1 = lrline ( xc(j), yc(j), xw, yw, xc(cur), yc(cur), 0.0D+00 )

      if ( lr1 == -1 ) then

        oper = 5
        cur = j

      else

        if ( lr == -1 ) then
          lr2 = -1
          go to 50
        end if

        do

          j = j + 1
          lr2 = lrline ( xc(j), yc(j), xe, ye, xc(cur), yc(cur), 0.0D+00 )

          if ( lr2 /= 0 ) then
            exit
          end if

        end do

50      continue

        if ( lr2 == -1 ) then
          oper = 1
          top = top + 1
          xc(top) = xc(j-1)
          yc(top) = yc(j-1)
          ivis(top) = j - 1 + nv
          top = top + 1
          xc(top) = xc(j)
          yc(top) = yc(j)
          ivis(top) = j
        end if

        cur = j

      end if

    end if

  end if
!
!  This test avoids extra subroutine calls.
!
  if ( oper == 2 ) then
    go to 10
  end if

  return
end
subroutine vpscna ( xc, yc, ivis, ierror )

!*****************************************************************************80
!
!! vpscna() is called by routine VISPOL for the SCANA operation (OPER = 3).
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Parameters:
!
!    Input and updated parameters:
!    XC,YC,IVIS - see comments in routine VISPOL
!
!    Output, integer IERROR, error flag.  On abnormal return,
!    IERROR is set to 207.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  logical beye
  integer case
  integer cur
  integer ierror
  logical intsct
  integer ivis(0:*)
  integer j
  integer k
  integer lr
  integer lr1
  integer lr2
  integer lr3
  integer lrline
  integer nv
  integer oper
  integer top
  real ( kind = rk8 ) xc(0:*)
  real ( kind = rk8 ) xe
  real ( kind = rk8 ) xw
  real ( kind = rk8 ) yc(0:*)
  real ( kind = rk8 ) ye
  real ( kind = rk8 ) yw

  common /gvpvar/ nv,oper,cur,top,xe,ye,xw,yw,beye
  save /gvpvar/
!
!  EYE-V(CUR-1)-V(CUR) is a right turn or forward move, S(TOP) =
!  V(CUR-1) or EYE-S(TOP)-V(CUR-1) is a forward move and TOP = 0,
!  TOP < CUR; S(TOP-1)-S(TOP)-V(CUR) is a right turn if TOP is at least 1
!  or EYE-S(TOP)-V(CUR) is a right turn if TOP = 0.
!  If BEYE, it is possible that (XC(TOP),YC(TOP)) is a non-simple
!  vertex but any edge incident on this vertex encountered during
!  scan must be invisible from (XE,YE).
!
  ierror = 0
  k = cur

10 continue

  if ( xc(k+1) == xc(top) .and. yc(k+1)  ==  yc(top) ) then

    k = k + 2

  else

    call xedge ( 1, xe, ye, xc(top), yc(top), xc(k), yc(k), xc(k+1), &
      yc(k+1), xw, yw, intsct )

    if ( intsct ) then

      lr = lrline ( xc(k+1), yc(k+1), xe, ye, xc(k), yc(k), 0.0D+00 )

      if ( lr == 1 ) then

        if ( ( xw      - xe )**2 + ( yw      - ye )**2 <= &
             ( xc(top) - xe )**2 + ( yc(top) - ye )**2 ) then

          if ( 0 < top ) then
            case = 1
            go to 20
          end if

        else

          lr1 = lrline ( xc(k), yc(k), xe, ye, xc(top), yc(top), 0.0D+00 )

          if ( lr1 == -1 ) then
            case = 2
            go to 20
          end if

        end if

      else

        lr1 = lrline ( xc(k+1), yc(k+1), xe, ye, xc(top), yc(top), 0.0D+00 )

        if ( lr1 == -1 ) then
          case = 3
          go to 20
        end if

      end if

    end if

    k = k + 1

  end if

  if ( k < nv ) then
    go to 10
  end if
!
!  Error from unsuccessful scan.
!
  ierror = 207
  return
!
!  Process current edge.
!
20 continue

  if ( case == 3 ) then

    oper = 1
    cur = k + 1
    lr = lrline ( xc(k), yc(k), xe, ye, xc(top), yc(top), 0.0D+00 )
    top = top + 1

    if ( lr == 0 ) then
      xc(top) = xc(k)
      yc(top) = yc(k)
      ivis(top) = k + nv
    else
      xc(top) = xw
      yc(top) = yw
      ivis(top) = -(k + 1 + nv)
    end if

    top = top + 1
    xc(top) = xc(cur)
    yc(top) = yc(cur)
    ivis(top) = cur

  else if ( case == 1 ) then

    cur = k + 1
    lr = lrline ( xc(cur), yc(cur), xe, ye, xc(top), yc(top), 0.0D+00 )

    if ( lr == 1 ) then

      oper = 2

    else

      j = cur + 1
      lr1 = lrline ( xc(j), yc(j), xe, ye, xc(cur), yc(cur), 0.0D+00 )
      lr2 = lrline ( xc(j), yc(j), xc(k), yc(k), xc(cur), yc(cur), 0.0D+00 )

      if ( lr1 <= 0 .and. lr2 == -1 ) then

        oper = 5
        xw = xc(k)
        yw = yc(k)
        cur = j

      else

        if ( lr1 /= 0 ) then
          lr3 = lr1
          go to 40
        end if

        do

          j = j + 1
          lr3 = lrline ( xc(j), yc(j), xe, ye, xc(cur), yc(cur), 0.0D+00 )
 
          if ( lr3 /= 0 ) then
            exit
          end if

        end do

40      continue

        if ( lr3 == 1 ) then
          oper = 2
        else
          oper = 1
          top = top + 1
          xc(top) = xc(j-1)
          yc(top) = yc(j-1)
          ivis(top) = j - 1 + nv
          top = top + 1
          xc(top) = xc(j)
          yc(top) = yc(j)
          ivis(top) = j
        end if

        cur = j

      end if

    end if

  else

    oper = 6
    cur = k + 1
    lr = lrline ( xc(cur), yc(cur), xe, ye, xc(top), yc(top), 0.0D+00 )

    if ( lr == 0 ) then
      xw = xc(cur)
      yw = yc(cur)
    end if

  end if

  return
end
subroutine vpscnb ( xc, yc, ivis, ierror )

!*****************************************************************************80
!
!! vpscnb() is called by routine VISPOL for the SCANB operation (OPER = 4).
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Parameters:
!
!     Input and updated parameters:
!        XC,YC,IVIS - see comments in routine VISPOL
!
!    Output, integer IERROR, error flag.  On abnormal return,
!    IERROR is set to 208.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  logical beye
  integer cur
  integer ierror
  logical intsct
  integer ivis(0:*)
  integer k
  integer lr
  integer lr1
  integer lrline
  integer nv
  integer oper
  real ( kind = rk8 ) tol
  real ( kind = rk8 ) tolabs
  integer top
  real ( kind = rk8 ) xc(0:*)
  real ( kind = rk8 ) xe
  real ( kind = rk8 ) xu
  real ( kind = rk8 ) xw
  real ( kind = rk8 ) yc(0:*)
  real ( kind = rk8 ) ye
  real ( kind = rk8 ) yu
  real ( kind = rk8 ) yw

  common /gvpvar/ nv,oper,cur,top,xe,ye,xw,yw,beye
  save /gvpvar/

  ierror = 0
  tol = 100.0D+00 * epsilon ( tol )
!
!  EYE-V(CUR-1)-V(CUR) is a left turn, S(TOP) = V(CUR) or S(TOP) is
!  on interior of edge V(CUR-1)-V(CUR), TOP <= CUR, S(TOP) has
!  angular displacement of 2*PI or interior angle at boundary eye.
!  (XW,YW) is the input version of (XC(CUR),YC(CUR)).
!  If BEYE, it is possible that (XC(TOP),YC(TOP)) is a non-simple
!  point but any edge containing this point encountered during scan
!  must be invisible from (XE,YE), except for 1 case where K = CUR.
!
  tolabs = tol * ( ( xc(nv) - xc(top) )**2 + ( yc(nv) - yc(top))**2 )
  k = cur

  if ( ivis(top) < 0 .or. k + 1 == nv ) then
    go to 10
  end if

  lr = lrline ( xc(k+1), yc(k+1), xe, ye, xc(top), yc(top), 0.0D+00 )

  lr1 = lrline ( xc(k+1), yc(k+1), xc(top-1), yc(top-1), xc(top), yc(top), &
    0.0D+00 )

  if ( lr == 1 .and. lr1  ==  -1 ) then
    oper = 2
    cur = k + 1
    return
  else
    k = k + 1
  end if

10 continue

  if ( k + 1 == nv ) then

    oper = 7
    cur = nv
    top = top + 1
    xc(top) = xc(nv)
    yc(top) = yc(nv)
    ivis(top) = nv
    return

  else

      if ( k == cur ) then
         call xedge ( 0, xc(nv), yc(nv), xc(top), yc(top), xw, yw, &
           xc(k+1), yc(k+1), xu, yu, intsct )
      else
         call xedge ( 0, xc(nv), yc(nv), xc(top), yc(top), xc(k), yc(k), &
           xc(k+1), yc(k+1), xu, yu, intsct )
      end if

      if ( intsct ) then
         if ( ( xc(top) - xu )**2 + ( yc(top) - yu )**2 <= tolabs ) then
           go to 20
         end if
         lr = lrline ( xc(k+1), yc(k+1), xe, ye, xc(nv), yc(nv), 0.0D+00 )
         if ( lr == 1 ) then
           oper = 2
           cur = k + 1
           return
         end if
      end if

20    continue

      k = k + 1

   end if

  if ( k < nv ) then
    go to 10
  end if
!
!  Error from unsuccessful scan.
!
  ierror = 208

  return
end
subroutine vpscnc ( xc, yc, ivis, ierror )

!*****************************************************************************80
!
!! vpscnc() is called by routine VISPOL for the SCANC operation (OPER = 5).
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Parameters:
!
!    Input/output, XC, YC, IVIS - see comments in routine VISPOL
!
!    Output, integer IERROR, error flag.  On abnormal return,
!    IERROR is set to 209.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  logical beye
  integer cur
  integer ierror
  logical intsct
  integer ivis(0:*)
  integer j
  integer k
  integer lr
  integer lr1
  integer lr2
  integer lrline
  integer nv
  integer oper
  integer top
  real ( kind = rk8 ) xc(0:*)
  real ( kind = rk8 ) xe
  real ( kind = rk8 ) xp
  real ( kind = rk8 ) xu
  real ( kind = rk8 ) xw
  real ( kind = rk8 ) yc(0:*)
  real ( kind = rk8 ) ye
  real ( kind = rk8 ) yp
  real ( kind = rk8 ) yu
  real ( kind = rk8 ) yw

  common /gvpvar/ nv,oper,cur,top,xe,ye,xw,yw,beye
  save /gvpvar/
!
!  EYE-V(CUR-1)-V(CUR) is a left turn or forward move, EYE-V(CUR-2)-
!  V(CUR-1) is a right turn, V(CUR-2)-V(CUR-1)-V(CUR) is a left turn,
!  TOP < CUR-1, W = V(CUR-2), S(TOP) is not on V(CUR-1)-V(CUR), EYE-
!  S(TOP)-V(CUR-1) is a backward move, EYE-S(TOP-1)-S(TOP) is a left
!  turn. If BEYE, it is possible that V(CUR-1) is a non-simple point,
!  but intersection at (XC(TOP),YC(TOP)) cannot occur.
!
  ierror = 0
  xp = xc(cur-1)
  yp = yc(cur-1)
  k = cur

10 continue

  if ( xc(k+1) == xp .and. yc(k+1) == yp ) then

    go to 40

  else if ( xc(k) == xp .and. yc(k) == yp ) then

      j = k + 1
      lr = lrline ( xc(j), yc(j), xe, ye, xp, yp, 0.0D+00 )
      lr1 = lrline ( xc(j), yc(j), xw, yw, xp, yp, 0.0D+00 )

      if ( lr <= 0 .and. lr1 == -1 ) then
        go to 40
      end if

      if ( lr /= 0 ) then

        lr2 = lr

      else

        do

          j = j + 1
          lr2 = lrline ( xc(j), yc(j), xe, ye, xp, yp, 0.0D+00 )
 
          if ( lr2 /= 0 ) then
            exit
          end if

        end do

      end if

      if ( lr2 == 1 ) then
        oper = 2
      else
        oper = 1
        top = top + 1
        xc(top) = xc(j-1)
        yc(top) = yc(j-1)
        ivis(top) = j - 1 + nv
        top = top + 1
        xc(top) = xc(j)
        yc(top) = yc(j)
        ivis(top) = j
      end if

      cur = j
      return

   else

      call xedge ( 0, xp, yp, xc(top), yc(top), xc(k), yc(k), xc(k+1), &
        yc(k+1), xu, yu, intsct )

      if ( intsct ) then
        lr = lrline ( xc(k+1), yc(k+1), xe, ye, xp, yp, 0.0D+00 )
        if ( lr == 1 ) then
          oper = 2
          cur = k + 1
          return
        end if
      end if

   end if

40    continue

   k = k + 1

  if ( k < nv ) then
    go to 10
  end if
!
!  Error from unsuccessful scan.
!
  ierror = 209

  return
end
subroutine vpscnd ( xc, yc, ivis, ierror )

!*****************************************************************************80
!
!! vpscnd() is called by routine VISPOL for the SCAND operation (OPER = 6).
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Parameters:
!
!    Input/output, XC,YC,IVIS - see comments in routine VISPOL
!
!    Output, integer IERROR, error flag.  On abnormal return,
!    IERROR is set to 210
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  logical beye
  integer cur
  integer ierror
  logical intsct
  integer ivis(0:*)
  integer k
  integer lr
  integer lr1
  integer lr2
  integer lrline
  integer nv
  integer oper
  integer top
  real ( kind = rk8 ) xc(0:*)
  real ( kind = rk8 ) xe
  real ( kind = rk8 ) xp
  real ( kind = rk8 ) xu
  real ( kind = rk8 ) xw
  real ( kind = rk8 ) yc(0:*)
  real ( kind = rk8 ) ye
  real ( kind = rk8 ) yp
  real ( kind = rk8 ) yu
  real ( kind = rk8 ) yw

  common /gvpvar/ nv,oper,cur,top,xe,ye,xw,yw,beye
  save /gvpvar/
!
!  EYE-V(CUR-1)-V(CUR) is a right turn, S(TOP) is a V vertex not on
!  V(CUR-1)-V(CUR), TOP < CUR, W is intersection of V(CUR-1)-V(CUR)
!  and ray EYE-S(TOP), EYE-S(TOP)-W is a forward move, and
!  EYE-S(TOP-1)-S(TOP) is a left turn if TOP is at least 1.
!  If BEYE, it is possible that (XW,YW) is a non-simple point,
!  but intersection at (XC(TOP),YC(TOP)) cannot occur.
!
  ierror = 0
  xp = xc(cur-1)
  yp = yc(cur-1)
  k = cur

10 continue

  call xedge ( 0, xw, yw, xc(top), yc(top), xc(k), yc(k), xc(k+1), yc(k+1), &
    xu, yu, intsct )

  if ( intsct ) then

    lr = lrline ( xc(k+1), yc(k+1), xe, ye, xc(k), yc(k), 0.0D+00 )
    lr1 = lrline ( xc(k+1), yc(k+1), xe, ye, xc(top), yc(top), 0.0D+00 )

    if ( lr == -1 .and. lr1  ==  -1 ) then

      if ( xc(k) /= xw .or. yc(k) /= yw ) then
        go to 20
      end if

      lr2 = lrline ( xc(k+1), yc(k+1), xp, yp, xw, yw, 0.0D+00 )

      if ( lr2 == -1 ) then
        go to 30
      end if

20    continue

         oper = 1
         cur = k + 1
         lr2 = lrline ( xc(k), yc(k), xe, ye, xc(top), yc(top), 0.0D+00 )
         top = top + 1
         if ( lr2 == 0 ) then
          xc(top) = xc(k)
          yc(top) = yc(k)
          ivis(top) = k + nv
         else
          xc(top) = xu
          yc(top) = yu
          ivis(top) = -(k + 1 + nv)
         end if
         top = top + 1
         xc(top) = xc(cur)
         yc(top) = yc(cur)
         ivis(top) = cur
         return
      end if

  end if

30 continue

  k = k + 1

  if ( k < nv ) then
    go to 10
  end if
!
!  Error from unsuccessful scan.
!
  ierror = 210

  return
end
subroutine walkt2 ( x, y, ntri, vcl, til, tnbr, itri, iedg, ierror )

!*****************************************************************************80
!
!! walkt2() searches for a triangle containing a point.
!
!  Discussion: 
!
!    Walk through neighboring triangles of a 2D Delaunay
!    triangulation until a triangle is found containing point (X,Y)
!    or (X,Y) is found to be outside the convex hull.  Search is
!    guaranteed to terminate for a Delaunay triangulation, else a
!    cycle may occur.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Parameters:
!
!    Input, real ( kind = rk8 ) X, Y, the coordinates of a 2D point.
!
!    Input, integer NTRI, the number of triangles in the triangulation; used 
!    to detect cycle.
!
!    Input, real ( kind = rk8 ) VCL(2,1:*), the coordinates of 2D vertices.
!
!    Input, integer TIL(3,NTRI), the triangle incidence list.
!
!    Input, integer TNBR(3,NTRI), the triangle neighbor list.
!
!    Input/output, integer ITRI.  On input, the index of triangle to begin 
!    search at.  On output, the index of triangle that search ends at.
!
!    Output, integer IEDG, indicates the position of the point (X,Y) in
!    triangle ITRI.  A small tolerance is allowed in positions:
!    0, the interior of the triangle; 
!    1, interior of edge 1;
!    2, interior of edge 2;
!    3, interior or edge 3;
!    4, vertex 1;
!    5, vertex 2;
!    6, vertex 3;
!    -1, outside convex hull, past edge 1;
!    -2, outside convex hull, past edge 2;
!    -3, outside convex hull, past edge 3.
!
!    Output, integer IERROR, error flag.  On abnormal return,
!    IERROR is set to 226.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  integer ntri

  integer a
  real ( kind = rk8 ) alpha
  integer b
  real ( kind = rk8 ) beta
  integer c
  integer cnt
  real ( kind = rk8 ) det
  real ( kind = rk8 ) dx
  real ( kind = rk8 ) dxa
  real ( kind = rk8 ) dxb
  real ( kind = rk8 ) dy
  real ( kind = rk8 ) dya
  real ( kind = rk8 ) dyb
  real ( kind = rk8 ) gamma
  integer i
  integer iedg
  integer ierror
  integer itri
  integer til(3,ntri)
  integer tnbr(3,ntri)
  real ( kind = rk8 ) tol
  real ( kind = rk8 ) vcl(2,*)
  real ( kind = rk8 ) x
  real ( kind = rk8 ) y

  ierror = 0
  tol = 100.0D+00 * epsilon ( tol )

  cnt = 0
  iedg = 0
  ierror = 0

  do

    cnt = cnt + 1

    if ( ntri < cnt ) then
      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) 'WALKT2 - Fatal error!'
      write ( *, '(a)' ) '  All triangles have been searched.'
      ierror = 226
      return
    end if
!
!  Get the vertices of triangle ITRI.
!
    a = til(1,itri)
    b = til(2,itri)
    c = til(3,itri)
!
!  Using vertex C as a base, compute the distances to vertices A and B,
!  and the point (X,Y).
!
    dxa = vcl(1,a) - vcl(1,c)
    dya = vcl(2,a) - vcl(2,c)

    dxb = vcl(1,b) - vcl(1,c)
    dyb = vcl(2,b) - vcl(2,c)

    dx = x - vcl(1,c)
    dy = y - vcl(2,c)

    det = dxa * dyb - dya * dxb
!
!  Compute the barycentric coordinates of the point (X,Y) with respect
!  to this triangle.
!
    alpha = ( dx * dyb - dy * dxb ) / det
    beta = ( dxa * dy - dya * dx ) / det
    gamma = 1.0D+00 - alpha - beta
!
!  If the barycentric coordinates are all positive, then the point
!  is inside the triangle.
!
    if ( tol < alpha .and. tol < beta .and. tol < gamma ) then
      exit
    end if
!
!  If any barycentric coordinate is (strongly) negative with respect to
!  a side, and if that side is on the convex hull, the point is outside
!  the triangles, and we are done.
!
    if ( alpha < -tol ) then
      i = tnbr(2,itri)
      if ( i <= 0 ) then
        iedg = -2
        exit
      end if
    else if ( beta < -tol ) then
      i = tnbr(3,itri)
      if ( i <= 0 ) then
        iedg = -3
        exit
      end if
    else if ( gamma < -tol ) then
      i = tnbr(1,itri)
      if ( i <= 0 ) then
        iedg = -1
        exit
      end if
!
!  At least one barycentric coordinate is between -TOL and TOL,
!  and no barycentric coordinate is less than -TOL.  We are going
!  to assign the position to an edge or vertex.
!
    else if ( alpha <= tol ) then
      if ( beta <= tol ) then
        iedg = 6
      else if ( gamma <= tol ) then
        iedg = 5
      else
        iedg = 2
      end if
      exit
    else if ( beta <= tol ) then
      if ( gamma <= tol ) then
        iedg = 4
      else
        iedg = 3
      end if
      exit
    else
      iedg = 1
      exit
    end if
!
!  If we fell through, then at least one barycentric coordinate was negative
!  for a side of the current triangle, and that side has a neighboring
!  triangle I.  Let's go there.
!
    itri = i

  end do

  return
end
subroutine width2 ( nvrt, xc, yc, i1, i2, widsq, ierror )

!*****************************************************************************80
!
!! width2() finds the minimum breadth of a convex polygon.
!
!  Discussion:
!
!    WIDTH2 finds the width (minimum breadth) of a convex polygon with
!    vertices given in counter-clockwise order and with all interior 
!    angles < PI.
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Parameters:
!
!    Input, integer NVRT, the number of vertices.
!
!    Input, real ( kind = rk8 ) XC(1:NVRT), YC(1:NVRT), the vertex coordinates, in
!    counter-clockwise order.
!
!    Output, integer I1, I2, indices in XC, YC such that the width is 
!    the distance from vertex (XC(I1),YC(I1)) to the line joining 
!    (XC(I2),YC(I2)) and (XC(I2+1),YC(I2+1)), where index NVRT+1 
!    is same as 1.
!
!    Output, real ( kind = rk8 ) WIDSQ, the square of the width of the polygon.
!
!    Output, integer IERROR, the error flag.
!    0, no error was detected.
!    201, an error was detected.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  integer nvrt

  integer a
  real ( kind = rk8 ) area1
  real ( kind = rk8 ) area2
  real ( kind = rk8 ) areatr
  integer b
  integer c
  real ( kind = rk8 ) c1mtol
  real ( kind = rk8 ) c1ptol
  real ( kind = rk8 ) dist
  real ( kind = rk8 ) dx
  real ( kind = rk8 ) dy
  integer i4_wrap
  integer i1
  integer i2
  integer ierror
  integer j
  integer jp1
  integer k
  integer kp1
  integer m
  real ( kind = rk8 ) tol
  real ( kind = rk8 ) widsq
  real ( kind = rk8 ) xc(nvrt)
  real ( kind = rk8 ) yc(nvrt)

  ierror = 0
  tol = 100.0D+00 * epsilon ( tol )
!
!  Find the first vertex which is farthest from the edge connecting
!  vertices NVRT and 1.
!
  c1mtol = 1.0D+00 - tol
  c1ptol = 1.0D+00 + tol
  j = nvrt
  jp1 = 1
  k = 2
  area1 = areatr ( xc(j), yc(j), xc(jp1), yc(jp1), xc(k), yc(k) )

  do

    area2 = areatr ( xc(j), yc(j), xc(jp1), yc(jp1), xc(k+1), yc(k+1) )

    if ( area2 <= area1 * c1ptol ) then
      exit
    end if

    area1 = area2
    k = k + 1

  end do

  m = k
  widsq = 0.0D+00
!
!  Find width = minimum distance of antipodal edge-vertex pairs.
!
  area1 = areatr ( xc(j), yc(j), xc(jp1), yc(jp1), xc(k), yc(k) )

  do

    kp1 = i4_wrap ( k+1, 1, nvrt )

    area2 = areatr ( xc(j), yc(j), xc(jp1), yc(jp1), xc(kp1), yc(kp1) )

    if ( area1 * c1ptol < area2 ) then

      a = j
      b = k
      k = k + 1
      c = k
      if ( nvrt < c ) then
        c = 1
      end if
      area1 = area2

    else if ( area2 < area1 * c1mtol ) then

      a = k
      b = j
      c = jp1
      j = jp1
      jp1 = j + 1
      area1 = areatr ( xc(j), yc(j), xc(jp1), yc(jp1), xc(k), yc(k) )

    else

      a = k
      b = j
      c = jp1
      k = k + 1
      j = jp1
      jp1 = j + 1
      area1 = areatr ( xc(j), yc(j), xc(jp1), yc(jp1), xc(k), yc(k) )

    end if

    if ( m < j .or. nvrt < k ) then
      write ( *, '(a)' ) ' '
      write ( *, '(a)' ) 'WIDTH2 - Fatal error!'
      write ( *, '(a)' ) '  M < J or NVRT < K'
      write ( *, '(a,i6)' ) '  J = ', j
      write ( *, '(a,i6)' ) '  M = ', m
      write ( *, '(a,i6)' ) '  K = ', k
      write ( *, '(a,i6)' ) '  NVRT = ', nvrt
      ierror = 201
      return
    end if

    dx = xc(c) - xc(b)
    dy = yc(c) - yc(b)
    dist = ( ( yc(a) - yc(b) ) * dx - ( xc(a) - xc(b) ) * dy )**2 &
      / ( dx**2 + dy**2 )

    if ( dist < widsq .or. widsq <= 0.0D+00 ) then
      widsq = dist
      i1 = a
      i2 = b
    end if

    if ( j == m .and. k == nvrt ) then
      exit
    end if

  end do

  return
end
subroutine xedge ( mode, xv1, yv1, xv2, yv2, xw1, yw1, xw2, yw2, xu, yu, &
  intsct )

!*****************************************************************************80
!
!! xedge() determines if an edge intersects another edge or ray.
!
!  Discussion:
!
!    An edge is a finite line segment.  A ray is a semi-infinite line
!    segment.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Parameters:
!
!    Input, integer MODE, is 0 for two edges, 1 (or nonzero) for a ray 
!    and an edge.
!
!    Input, real ( kind = rk8 ) XV1, YV1, XV2, YV2, XW1, YW1, XW2, YW2, the
!    vertex coordinates;  an edge (ray) is from (XV1,YV1) to (thru) (XV2,YV2);
!    an edge joins vertices (XW1,YW1) and (XW2,YW2).
!
!    Output, real ( kind = rk8 ) XU, YU, the coordinates of the point of 
!    intersection iff INTSCT is .TRUE.
!
!    Output, logical INTSCT, .TRUE. if the edges/ray are nondegenerate, not
!    parallel, and intersect, .FALSE. otherwise.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  real ( kind = rk8 ) denom
  real ( kind = rk8 ) dxv
  real ( kind = rk8 ) dxw
  real ( kind = rk8 ) dyv
  real ( kind = rk8 ) dyw
  logical intsct
  integer mode
  real ( kind = rk8 ) t
  real ( kind = rk8 ) tol
  real ( kind = rk8 ) tolabs
  real ( kind = rk8 ) xu
  real ( kind = rk8 ) xv1
  real ( kind = rk8 ) xv2
  real ( kind = rk8 ) xw1
  real ( kind = rk8 ) xw2
  real ( kind = rk8 ) yu
  real ( kind = rk8 ) yv1
  real ( kind = rk8 ) yv2
  real ( kind = rk8 ) yw1
  real ( kind = rk8 ) yw2

  tol = 100.0D+00 * epsilon ( tol )

  intsct = .false.
  dxv = xv2 - xv1
  dyv = yv2 - yv1
  dxw = xw2 - xw1
  dyw = yw2 - yw1
  tolabs = tol * max ( abs ( dxv ), abs ( dyv ), abs ( dxw ), abs ( dyw ) )
  denom = dyv * dxw - dxv * dyw

  if ( abs ( denom ) <= tolabs ) then
    return
  end if

  t = ( dyv * ( xv1 - xw1 ) - dxv * ( yv1 - yw1 ) ) / denom

  if ( t < -tol .or. 1.0D+00 + tol < t ) then
    return
  end if

  xu = xw1 + t * dxw
  yu = yw1 + t * dyw

  if ( abs ( dyv ) <= abs ( dxv ) ) then
    t = ( xu - xv1 ) / dxv
  else
    t = ( yu - yv1 ) / dyv
  end if

  if ( mode == 0 ) then
    if ( -tol <= t .and. t <= 1.0D+00 + tol ) then
      intsct = .true.
    end if
  else
    if ( -tol <= t ) then
      intsct = .true.
    end if
  end if

  return
end
subroutine xline ( xv1, yv1, xv2, yv2, xw1, yw1, xw2, yw2, dv, dw, xu, &
  yu, parall )

!*****************************************************************************80
!
!! xline() finds the intersection of lines parallel to two other lines.
!
!  Licensing:
!
!    This code is distributed under the MIT license.
!
!  Modified:
!
!    12 December 2025
!
!  Author:
!
!    Original FORTRAN77 version by Barry Joe.
!    This version by John Burkardt.
!
!  Parameters:
!
!    Input, real ( kind = rk8 ) XV1, YV1, XV2, YV2, XW1, YW1, XW2, YW2, the 
!    vertex coordinates; the first line is parallel to and at signed distance 
!    DV to the left of directed line from (XV1,YV1) to (XV2,YV2);
!    second line is parallel to and at signed distance DW to
!    left of directed line from (XW1,YW1) to (XW2,YW2)
!
!    Input, real ( kind = rk8 ) DV, DW, the signed distances (positive for left).
!
!    Output, real ( kind = rk8 ) XU, YU, the coordinates of the point of
!    intersection, if PARALL is .FALSE.
!
!    Output, logical PARALL, is .TRUE. if the lines are parallel, or two 
!    points for a line are identical, .FALSE. otherwise.
!
  implicit none

  integer, parameter :: rk8 = kind ( 1.0D+00 )

  real ( kind = rk8 ) a11
  real ( kind = rk8 ) a12
  real ( kind = rk8 ) a21
  real ( kind = rk8 ) a22
  real ( kind = rk8 ) b1
  real ( kind = rk8 ) b2
  real ( kind = rk8 ) det
  real ( kind = rk8 ) dv
  real ( kind = rk8 ) dw
  logical parall
  real ( kind = rk8 ) tol
  real ( kind = rk8 ) tolabs
  real ( kind = rk8 ) xu
  real ( kind = rk8 ) xv1
  real ( kind = rk8 ) xv2
  real ( kind = rk8 ) xw1
  real ( kind = rk8 ) xw2
  real ( kind = rk8 ) yu
  real ( kind = rk8 ) yv1
  real ( kind = rk8 ) yv2
  real ( kind = rk8 ) yw1
  real ( kind = rk8 ) yw2

  tol = 100.0D+00 * epsilon ( tol )

  parall = .true.

  a11 = yv2 - yv1
  a12 = xv1 - xv2
  a21 = yw2 - yw1
  a22 = xw1 - xw2
  tolabs = tol * max ( abs ( a11), abs ( a12), abs ( a21), abs ( a22) )
  det = a11 * a22 - a21 * a12

  if ( abs ( det ) <= tolabs ) then
    return
  end if

  b1 = xv1 * a11 + yv1 * a12 - dv * sqrt ( a11**2 + a12**2 )
  b2 = xw1 * a21 + yw1 * a22 - dw * sqrt ( a21**2 + a22**2 )

  xu = ( b1 * a22 - b2 * a12 ) / det
  yu = ( b2 * a11 - b1 * a21 ) / det

  parall = .false.

  return
end