Program e01eafe

!     Mark 25 Release. NAG Copyright 2014.

!     .. Use Statements ..
      Use nag_library, Only: e01eaf, e01ebf, nag_wp
!     .. Implicit None Statement ..
      Implicit None
!     .. Parameters ..
      Integer, Parameter               :: nin = 5, nout = 6
      Logical, Parameter               :: pr_tr = .False.
!     .. Local Scalars ..
      Integer                          :: i, ifail, m, n
!     .. Local Arrays ..
      Real (Kind=nag_wp), Allocatable  :: f(:), pf(:), px(:), py(:), x(:), y(:)
      Integer, Allocatable             :: triang(:)
!     .. Executable Statements ..

      Write (nout,*) 'E01EAF Example Program Results'

!     Skip heading in data file
      Read (nin,*)

      Read (nin,*) n
      Allocate (x(n),y(n),f(n),triang(7*n))
      Read (nin,*)(x(i),y(i),f(i),i=1,n)

!     Triangulate data
      ifail = 0
      Call e01eaf(n,x,y,triang,ifail)

      Read (nin,*) m
      Allocate (px(m),py(m),pf(m))
      Read (nin,*)(px(i),py(i),i=1,m)

!     Interpolate data
      ifail = 0
      Call e01ebf(m,n,x,y,f,triang,px,py,pf,ifail)

!     Display results
      Write (nout,*)
      Write (nout,99999) 'px', 'py', 'Interpolated Value'
      Write (nout,99998)(px(i),py(i),pf(i),i=1,m)

      If (pr_tr) Then
        Call print_triang
      End If

99999 Format (2X,A4,4X,A4,4X,A19)
99998 Format (1X,F7.4,1X,F7.4,8X,F7.4)

    Contains
      Subroutine print_triang

!       .. Implicit None Statement ..
        Implicit None
!       .. Local Scalars ..
        Integer                          :: i_k, j, j_k, k
!       .. Executable Statements ..

!       Print a sequence of unique line segments for plotting triangulation
        Write (nout,*)
        Write (nout,*) '  Triangulation as a set of line segments'
        Write (nout,*)
        j_k = 0
        Do k = 1, n
          i_k = j_k + 1
          j_k = triang(6*n+k)
          Do j = i_k, j_k
            If (triang(j)>k) Then
              Write (nout,99999) x(k), y(k)
              Write (nout,99999) x(triang(j)), y(triang(j))
              Write (nout,*)
            End If
          End Do
        End Do
        Return
99999   Format (1X,F7.4,1X,F7.4)
      End Subroutine print_triang

    End Program e01eafe