! D05AAF Example Program Text
! Mark 30.1 Release. NAG Copyright 2024.
Module d05aafe_mod
! D05AAF Example Program Module:
! Parameters and User-defined Routines
! .. Use Statements ..
Use nag_library, Only: nag_wp
! .. Implicit None Statement ..
Implicit None
! .. Accessibility Statements ..
Private
Public :: g, k1, k2
! .. Parameters ..
Real (Kind=nag_wp), Parameter, Public :: a = 0.0_nag_wp
Real (Kind=nag_wp), Parameter, Public :: b = 1.0_nag_wp
Real (Kind=nag_wp), Parameter, Public :: lambda = 1.0_nag_wp
Real (Kind=nag_wp), Parameter, Public :: xval = 0.1_nag_wp
Integer, Parameter, Public :: ind = 2, n = 5, nout = 6
Integer, Parameter, Public :: ldw1 = n
Integer, Parameter, Public :: ldw2 = 2*n + 2
Contains
Function k1(x,s)
! .. Function Return Value ..
Real (Kind=nag_wp) :: k1
! .. Scalar Arguments ..
Real (Kind=nag_wp), Intent (In) :: s, x
! .. Executable Statements ..
k1 = s*(1.0_nag_wp-x)
Return
End Function k1
Function k2(x,s)
! .. Function Return Value ..
Real (Kind=nag_wp) :: k2
! .. Scalar Arguments ..
Real (Kind=nag_wp), Intent (In) :: s, x
! .. Executable Statements ..
k2 = x*(1.0_nag_wp-s)
Return
End Function k2
Function g(x)
! .. Use Statements ..
Use nag_library, Only: x01aaf
! .. Function Return Value ..
Real (Kind=nag_wp) :: g
! .. Scalar Arguments ..
Real (Kind=nag_wp), Intent (In) :: x
! .. Local Scalars ..
Real (Kind=nag_wp) :: pi
! .. Intrinsic Procedures ..
Intrinsic :: sin
! .. Executable Statements ..
pi = x01aaf(pi)
g = sin(pi*x)*(1.0_nag_wp-1.0_nag_wp/(pi*pi))
Return
End Function g
End Module d05aafe_mod
Program d05aafe
! D05AAF Example Main Program
! .. Use Statements ..
Use d05aafe_mod, Only: a, b, g, ind, k1, k2, lambda, ldw1, ldw2, n, &
nout, xval
Use nag_library, Only: c06dcf, d05aaf, nag_wp
! .. Implicit None Statement ..
Implicit None
! .. Local Scalars ..
Integer :: ifail, is
! .. Local Arrays ..
Real (Kind=nag_wp) :: ans(1), x(1)
Real (Kind=nag_wp), Allocatable :: c(:), f(:), w1(:,:), w2(:,:), wd(:)
! .. Executable Statements ..
Write (nout,*) 'D05AAF Example Program Results'
Allocate (c(n),f(n),w1(ldw1,ldw2),w2(ldw2,4),wd(ldw2))
ifail = 0
Call d05aaf(lambda,a,b,k1,k2,g,f,c,n,ind,w1,w2,wd,ldw1,ldw2,ifail)
Write (nout,99999)
Write (nout,99998) c(1:n)
x(1) = xval
Select Case (ind)
Case (1)
is = 3
Case (2)
is = 2
Case Default
is = 1
End Select
ifail = 0
Call c06dcf(x,1,a,b,c,n,is,ans,ifail)
Write (nout,99997) 'X=', x, ' ANS=', ans
99999 Format (/,1X,'Kernel is centro-symmetric and G is even so the ', &
'solution is even',/,/,1X,'Chebyshev coefficients',/)
99998 Format (1X,5E14.4,/)
99997 Format (1X,A,F5.2,A,1F10.4)
End Program d05aafe