subroutine contng (ndp,xd,yd,ntr,ipt,nli,ipl,iwl,iwp,wk)
  use gcont_interfaces, except_this=>contng
  use gcont_contour
  use gbl_message
  !---------------------------------------------------------------------
  ! @ public
  !	This subroutine performs triangulation.  It divides the X-Y
  !	plane into a number of triangles according to given data
  !	points in the plane, determines line segments that form the
  !	border of data area, and determines the triangle numbers
  !	corresponding to the border line segments.
  !	At completion, point numbers of the vertexes of each triangle
  !	are listed counter-clockwise.  Point numbers of the end points
  !	of each border line segment are listed counter-clockwise,
  !	listing order of the line segments being counter-clockwise.
  ! Arguments :
  !	NDP 	I	Number of data points			Input
  !	XD  	R*4 (*)	Array of dimension NDP containing the
  !			X coordinates of the data points	Input
  !	YD  	R*4 (*) Array of Y coordinates			Input
  !	NTR  	I	Number of triangles			Output
  !	IPT 	I (*)	Array of dimension 6*NDP-15, where the
  !			point numbers of the vertexes of the
  !			(IT)th triangle are to be stored as the
  !			(3*IT-2)nd, (3*IT-1)st, and (3*IT)th
  !			elements, IT=1,2,...,NTR		Output
  !	NLI  	I	Number of border line segments		Output
  !	IPL 	I (*)	Array of dimension 6*NDP, where the point
  !			numbers of the end points of the (IL)th
  !			border line segment and its respective
  !			triangle number are to be stored as the
  !			(3*IL-2)nd, (3*IL-1)st, and (3*IL)th
  !			elements, IL=1,2,..., NLI.		Output
  !	IWL 	I (*)	Array of dimension 18*NDP used
  !			internally as a work area
  !	IWP 	I (*)	Array of dimension NDP used
  !			internally as a work area
  !	WK  	R*4 (*)	Array of dimension NDP used
  !			internally as a work area.
  ! No subroutine referenced
  !---------------------------------------------------------------------
  integer :: ndp                    !
  real :: xd(*)                     !
  real :: yd(*)                     !
  integer :: ntr                    !
  integer :: ipt(*)                 !
  integer :: nli                    !
  integer :: ipl(*)                 !
  integer :: iwl(*)                 !
  integer :: iwp(*)                 !
  real :: wk(*)                     !
  ! Local
  character(len=*), parameter :: rname='RANDOM'
  ! real dsqf,u1,v1,u2,v2,u3,v3,side
  character(len=72) :: messag
  integer :: itf(2)
  integer :: nrep, ndpm1, ipmn1, ipmn2, ip1, ip1p1, ip2
  real :: ratio, dsqmn, x1, y1, dsqi, dsq12, xdmp, ydmp, dsqmx
  integer :: jp1, jpmn, jp2, its, jp, ip, jpmx, jpc, ip3
  integer :: nt0, ntt3, nl0, nlt3, nsh, nsht3, jp2t3
  real :: ar, dx21, dy21, dxmn, dymn, armn, dxmx, dymx, armx
  integer :: jp3t3, jwl, ipl1, ipl2, it, nln, nlnt3, itt3
  real :: dx, dy
  integer :: ipti, nlf, ntt3p3, irep, ilf, ilft2, ntf
  integer :: itt3r, ipt1, ipt2, ipt3, it1t3, ipti1, it2t3, ipti2
  integer :: jlt3, iplj1, iplj2, nlfc, jwl1mn, nlft2, jwl1
  ! Data
  data ratio /1.0e-6/, nrep/100/
  !
  ! Statement functions
  !      DSQF(U1,V1,U2,V2) = (U2-U1)**2+(V2-V1)**2
  !      SIDE(U1,V1,U2,V2,U3,V3) = (V3-V1)*(U2-U1)-(U3-U1)*(V2-V1)
  !
  ! Preliminary processing
  ndpm1 = ndp-1
  !
  ! Determines the closest pair of data points and their midpoint.
  dsqmn = dsqf(xd(1),yd(1),xd(2),yd(2))
  ipmn1 = 1
  ipmn2 = 2
  do ip1=1,ndpm1
    x1 = xd(ip1)
    y1 = yd(ip1)
    ip1p1 = ip1+1
    do ip2=ip1p1,ndp
      dsqi = dsqf(x1,y1,xd(ip2),yd(ip2))
      if (dsqi .ne. 0.) go to  120
      !
      ! Error, identical input data points
      write(messag,1000) ip1,ip2
      call gcont_message(seve%e,rname,messag)
      irec = 4
      return
      !
120   continue
      if (dsqi .ge. dsqmn) go to  130
      dsqmn = dsqi
      ipmn1 = ip1
      ipmn2 = ip2
130   continue
    enddo                      ! 130
  enddo
  dsq12 = dsqmn
  xdmp = (xd(ipmn1)+xd(ipmn2))/2.0
  ydmp = (yd(ipmn1)+yd(ipmn2))/2.0
  !
  ! Sorts the other (NDP-2) data points in ascending order of
  ! distance from the midpoint and stores the sorted data point
  ! numbers in the IWP array.
  jp1 = 2
  do ip1=1,ndp
    if (ip1.eq.ipmn1 .or. ip1.eq.ipmn2)  go to 150
    jp1 = jp1+1
    iwp(jp1) = ip1
    wk(jp1) = dsqf(xdmp,ydmp,xd(ip1),yd(ip1))
150 continue
  enddo
  do jp1=3,ndpm1
    dsqmn = wk(jp1)
    jpmn = jp1
    do jp2=jp1,ndp
      if (wk(jp2) .ge. dsqmn)  go to 160
      dsqmn = wk(jp2)
      jpmn = jp2
160   continue
    enddo
    its = iwp(jp1)
    iwp(jp1) = iwp(jpmn)
    iwp(jpmn) = its
    wk(jpmn) = wk(jp1)
  enddo
  !
  ! If necessary, modifies the ordering in such a way that the
  ! first three data points are not collinear.
  ar = dsq12*ratio
  x1 = xd(ipmn1)
  y1 = yd(ipmn1)
  dx21 = xd(ipmn2)-x1
  dy21 = yd(ipmn2)-y1
  do jp=3,ndp
    ip = iwp(jp)
    if (abs((yd(ip)-y1)*dx21-(xd(ip)-x1)*dy21) .gt. ar) then
      jpmx = jp
      go to 190
    endif
  enddo
  !
  ! Error: Collinear data points
  call gcont_message(seve%e,rname,'All data points are collinear')
  irec = 3
190 continue
  if (jpmx.eq.3)  go to 210
  !      jpmx = jp
  jp = jpmx+1
  do jpc=4,jpmx
    jp = jp-1
    iwp(jp) = iwp(jp-1)
  enddo
  iwp(3) = ip
  !
  ! Forms the first triangle.  stores point numbers of the ver-
  ! texes of the triangle in the IPT array, and stores point num-
  ! bers of the border line segments and the triangle number in
  ! the IPL array.
210 ip1 = ipmn1
  ip2 = ipmn2
  ip3 = iwp(3)
  if (side(xd(ip1),yd(ip1),xd(ip2),yd(ip2),xd(ip3),yd(ip3)).ge.0.0)  go to 220
  ip1 = ipmn2
  ip2 = ipmn1
220 nt0 = 1
  ntt3 = 3
  ipt(1) = ip1
  ipt(2) = ip2
  ipt(3) = ip3
  nl0 = 3
  nlt3 = 9
  ipl(1) = ip1
  ipl(2) = ip2
  ipl(3) = 1
  ipl(4) = ip2
  ipl(5) = ip3
  ipl(6) = 1
  ipl(7) = ip3
  ipl(8) = ip1
  ipl(9) = 1
  !
  ! Adds the remaining (NDP-3) data points, one by one.
  do jp1=4,ndp                 ! DO 400
    ip1 = iwp(jp1)
    x1 = xd(ip1)
    y1 = yd(ip1)
    !
    ! Determines the visible border line segments.
    ip2 = ipl(1)
    jpmn = 1
    dxmn = xd(ip2)-x1
    dymn = yd(ip2)-y1
    dsqmn = dxmn*dxmn+dymn*dymn
    armn = dsqmn*ratio
    jpmx = 1
    dxmx = dxmn
    dymx = dymn
    dsqmx = dsqmn
    armx = armn
    do jp2=2,nl0               ! DO 240
      ip2 = ipl(3*jp2-2)
      dx = xd(ip2)-x1
      dy = yd(ip2)-y1
      ar = dy*dxmn-dx*dymn
      if (ar.gt.armn)  go to 230
      dsqi = dx*dx+dy*dy
      if (ar.ge.(-armn) .and. dsqi.ge.dsqmn)  go to 230
      jpmn = jp2
      dxmn = dx
      dymn = dy
      dsqmn = dsqi
      armn = dsqmn*ratio
230   ar = dy*dxmx-dx*dymx
      if (ar.lt.(-armx))  go to 240
      dsqi = dx*dx+dy*dy
      if (ar.le.armx .and. dsqi.ge.dsqmx)  go to 240
      jpmx = jp2
      dxmx = dx
      dymx = dy
      dsqmx = dsqi
      armx = dsqmx*ratio
240   continue
    enddo
    if (jpmx .lt. jpmn) jpmx = jpmx+nl0
    nsh = jpmn-1
    if (nsh .le. 0)  go to 270
    !
    ! Shifts (rotates) the IPL array to have the invisible border
    ! line segments contained in the first part of the IPL array.
    nsht3 = nsh*3
    do  jp2t3=3,nsht3,3
      jp3t3 = jp2t3+nlt3
      ipl(jp3t3-2) = ipl(jp2t3-2)
      ipl(jp3t3-1) = ipl(jp2t3-1)
      ipl(jp3t3) = ipl(jp2t3)
    enddo
    do  jp2t3=3,nlt3,3
      jp3t3 = jp2t3+nsht3
      ipl(jp2t3-2) = ipl(jp3t3-2)
      ipl(jp2t3-1) = ipl(jp3t3-1)
      ipl(jp2t3) = ipl(jp3t3)
    enddo
    jpmx = jpmx-nsh
    !
    ! Adds triangles to the IPT array, updates border line
    ! segments in the IPL array, and sets flags for the border
    ! line segments to be reexamined in the IWL array.
270 jwl = 0
    do jp2=jpmx,nl0
      jp2t3 = jp2*3
      ipl1 = ipl(jp2t3-2)
      ipl2 = ipl(jp2t3-1)
      it = ipl(jp2t3)
      !
      ! Adds a triangle to the IPT array.
      nt0 = nt0+1
      ntt3 = ntt3+3
      ipt(ntt3-2) = ipl2
      ipt(ntt3-1) = ipl1
      ipt(ntt3) = ip1
      !
      ! Updates border line segments in the IPL array.
      if (jp2 .ne. jpmx)  go to 280
      ipl(jp2t3-1) = ip1
      ipl(jp2t3) = nt0
280   continue
      if (jp2 .ne. nl0)  go to 290
      nln = jpmx+1
      nlnt3 = nln*3
      ipl(nlnt3-2) = ip1
      ipl(nlnt3-1) = ipl(1)
      ipl(nlnt3) = nt0
      !
      ! Determines the vertex that does not lie on the border
      ! line segments.
290   itt3 = it*3
      ipti = ipt(itt3-2)
      if (ipti.ne.ipl1 .and. ipti.ne.ipl2)  go to 300
      ipti = ipt(itt3-1)
      if (ipti.ne.ipl1 .and. ipti.ne.ipl2)  go to 300
      ipti = ipt(itt3)
      !
      ! Checks if the exchange is necessary.
300   continue
      if (conxch(xd,yd,ip1,ipti,ipl1,ipl2).eq.0)  go to 310
      !
      ! Modifies the IPT array when necessary.
      ipt(itt3-2) = ipti
      ipt(itt3-1) = ipl1
      ipt(itt3) = ip1
      ipt(ntt3-1) = ipti
      if (jp2 .eq. jpmx) ipl(jp2t3) = it
      if (jp2.eq.nl0 .and. ipl(3).eq.it) ipl(3) = nt0
      !
      ! Sets flags in the IWL array.
      jwl = jwl+4
      iwl(jwl-3) = ipl1
      iwl(jwl-2) = ipti
      iwl(jwl-1) = ipti
      iwl(jwl) = ipl2
310   continue
    enddo
    nl0 = nln
    nlt3 = nlnt3
    nlf = jwl/2
    if (nlf .eq. 0)  go to 400
    !
    ! Improves triangulation.
    ntt3p3 = ntt3+3
    do irep=1,nrep
      do ilf=1,nlf
        ilft2 = ilf*2
        ipl1 = iwl(ilft2-1)
        ipl2 = iwl(ilft2)
        !
        ! Locates in the IPT array two triangles on both sides of
        ! the flagged line segment.
        ntf = 0
        do itt3r=3,ntt3,3
          itt3 = ntt3p3-itt3r
          ipt1 = ipt(itt3-2)
          ipt2 = ipt(itt3-1)
          ipt3 = ipt(itt3)
          if (ipl1.ne.ipt1 .and. ipl1.ne.ipt2 .and. ipl1.ne.ipt3)  go to 320
          if (ipl2.ne.ipt1 .and. ipl2.ne.ipt2 .and. ipl2.ne.ipt3)  go to 320
          ntf = ntf+1
          itf(ntf) = itt3/3
          if (ntf.eq.2)  go to 330
320       continue
        enddo
        if (ntf.lt.2) go to 370
        !
        ! Determines the vertexes of the triangles that do not lie
        ! on the line segment.
330     it1t3 = itf(1)*3
        ipti1 = ipt(it1t3-2)
        if (ipti1.ne.ipl1 .and. ipti1.ne.ipl2) go to  340
        ipti1 = ipt(it1t3-1)
        if (ipti1.ne.ipl1 .and. ipti1.ne.ipl2) go to  340
        ipti1 = ipt(it1t3)
340     it2t3 = itf(2)*3
        ipti2 = ipt(it2t3-2)
        if (ipti2.ne.ipl1 .and. ipti2.ne.ipl2) go to  350
        ipti2 = ipt(it2t3-1)
        if (ipti2.ne.ipl1 .and. ipti2.ne.ipl2) go to  350
        ipti2 = ipt(it2t3)
        !
        ! Checks if the exchange is necessary.
350     continue
        if (conxch(xd,yd,ipti1,ipti2,ipl1,ipl2).eq.0)  go to 370
        !
        ! Modifies the IPT array when necessary.
        ipt(it1t3-2) = ipti1
        ipt(it1t3-1) = ipti2
        ipt(it1t3) = ipl1
        ipt(it2t3-2) = ipti2
        ipt(it2t3-1) = ipti1
        ipt(it2t3) = ipl2
        !
        ! Sets new flags.
        jwl = jwl+8
        iwl(jwl-7) = ipl1
        iwl(jwl-6) = ipti1
        iwl(jwl-5) = ipti1
        iwl(jwl-4) = ipl2
        iwl(jwl-3) = ipl2
        iwl(jwl-2) = ipti2
        iwl(jwl-1) = ipti2
        iwl(jwl) = ipl1
        do jlt3=3,nlt3,3
          iplj1 = ipl(jlt3-2)
          iplj2 = ipl(jlt3-1)
          if ((iplj1.eq.ipl1 .and. iplj2.eq.ipti2) .or.  &
              (iplj2.eq.ipl1 .and. iplj1.eq.ipti2))  ipl(jlt3) = itf(1)
          if ((iplj1.eq.ipl2 .and. iplj2.eq.ipti1) .or.  &
              (iplj2.eq.ipl2 .and. iplj1.eq.ipti1))  ipl(jlt3) = itf(2)
        enddo
370     continue
      enddo
      nlfc = nlf
      nlf = jwl/2
      if (nlf.eq.nlfc)  go to 400
      !
      ! Resets the IWL array for the next round.
      !
      jwl = 0
      jwl1mn = (nlfc+1)*2
      nlft2 = nlf*2
      do jwl1=jwl1mn,nlft2,2
        jwl = jwl+2
        iwl(jwl-1) = iwl(jwl1-1)
        iwl(jwl) = iwl(jwl1)
      enddo
      nlf = jwl/2
    enddo
400 continue
  enddo
  !
  ! Rearrange the IPT array so that the vertexes of each triangle
  ! are listed counter-clockwise.
  do  itt3=3,ntt3,3
    ip1 = ipt(itt3-2)
    ip2 = ipt(itt3-1)
    ip3 = ipt(itt3)
    if (side(xd(ip1),yd(ip1),xd(ip2),yd(ip2),xd(ip3),yd(ip3)).ge.0.0)  go to 410
    ipt(itt3-2) = ip2
    ipt(itt3-1) = ip1
410 continue
  enddo
  ntr = nt0
  nli = nl0
  return
1000 format('Identical input data points found at ',i5,' and ',i5)
  !
contains
  real function dsqf(u1,v1,u2,v2)
    real :: u1                      !
    real :: v1                      !
    real :: u2                      !
    real :: v2                      !
    dsqf  = (u2-u1)**2+(v2-v1)**2
  end function dsqf
  !
  real function side(u1,v1,u2,v2,u3,v3)
    real :: u1                      !
    real :: v1                      !
    real :: u2                      !
    real :: v2                      !
    real :: u3                      !
    real :: v3                      !
    side = (v3-v1)*(u2-u1)-(u3-u1)*(v2-v1)
  end function side
  !
end subroutine contng
