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