Program d03eafe
! D03EAF Example Program Text
! Mark 27.0 Release. NAG Copyright 2019.
! .. Use Statements ..
Use nag_library, Only: d03eaf, nag_wp
! .. Implicit None Statement ..
Implicit None
! .. Parameters ..
Integer, Parameter :: nin = 5, nout = 6
! .. Local Scalars ..
Real (Kind=nag_wp) :: alpha, alpha0, alpsav, p, q
Integer :: i, ifail, j, ldc, m, n, n1, n1p1, &
np1, np4, npts
Logical :: dorm, ext, stage1
! .. Local Arrays ..
Real (Kind=nag_wp), Allocatable :: c(:,:), phi(:), phid(:), x(:), y(:)
Integer, Allocatable :: icint(:)
! .. Executable Statements ..
Write (nout,*) 'D03EAF Example Program Results'
! Skip heading in data file
Read (nin,*)
Read (nin,*) m, n
n1 = 2*(n+m) - 2
n1p1 = n1 + 1
np1 = n + 1
np4 = n + 4
ldc = n + 1
Allocate (c(ldc,np4),phi(n),phid(n),x(n1p1),y(n1p1),icint(np1))
Read (nin,*) ext, dorm
If (.Not. dorm) Then
Read (nin,*) alpha0
alpha = alpha0
End If
Read (nin,*)(x(i),y(i),i=1,n1+1)
Read (nin,*)(phi(i),phid(i),i=1,n)
stage1 = .True.
! ifail: behaviour on error exit
! =0 for hard exit, =1 for quiet-soft, =-1 for noisy-soft
ifail = 0
Call d03eaf(stage1,ext,dorm,n,p,q,x,y,n1p1,phi,phid,alpha,c,ldc,np4, &
icint,np1,ifail)
alpsav = alpha
Write (nout,*)
If (.Not. dorm) Then
If (ext) Then
Write (nout,*) 'Exterior Neumann problem'
Write (nout,*)
Write (nout,99998) 'C=', alpha0
Else
Write (nout,*) 'Interior Neumann problem'
Write (nout,*)
Write (nout,99999) 'Total integral =', alpha0
End If
Else If (ext) Then
Write (nout,*)
Write (nout,*) 'Exterior problem'
Write (nout,*)
Write (nout,99999) 'Computed C =', alpsav
End If
j = 2
Write (nout,*)
Write (nout,*) 'Nodes'
Write (nout,99996) 'X', 'Y', 'PHI', 'PHID'
Do i = 1, n
If (x(j)==x(j-1) .And. y(j)==y(j-1)) Then
j = j + 2
End If
Write (nout,99997) x(j), y(j), phi(i), phid(i)
j = j + 2
End Do
stage1 = .False.
Write (nout,*)
Write (nout,*) 'Selected points'
Write (nout,*) ' X Y PHI'
Read (nin,*) npts
Do i = 1, npts
Read (nin,*) p, q
alpha = alpsav
ifail = 0
Call d03eaf(stage1,ext,dorm,n,p,q,x,y,n1p1,phi,phid,alpha,c,ldc,np4, &
icint,np1,ifail)
Write (nout,99997) p, q, alpha
End Do
99999 Format (1X,A,F15.2)
99998 Format (1X,A,E15.4)
99997 Format (1X,4F15.2)
99996 Format (1X,A12,A15,A17,A16)
End Program d03eafe