! D05AAF Example Program Text ! Mark 23 Release. NAG Copyright 2011. 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 ! .. Parameters .. REAL (KIND=nag_wp), PARAMETER :: a = 0.0_nag_wp REAL (KIND=nag_wp), PARAMETER :: b = 1.0_nag_wp REAL (KIND=nag_wp), PARAMETER :: lambda = 1.0_nag_wp REAL (KIND=nag_wp), PARAMETER :: xval = 0.1_nag_wp INTEGER, PARAMETER :: ind = 2, n = 5, nout = 6 INTEGER, PARAMETER :: ldw1 = n INTEGER, PARAMETER :: ldw2 = 2*n + 2 CONTAINS FUNCTION k1(x,s) ! .. Implicit None Statement .. IMPLICIT NONE ! .. 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) ! .. Implicit None Statement .. IMPLICIT NONE ! .. 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 ! .. Implicit None Statement .. IMPLICIT NONE ! .. 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 Functions .. 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 nag_library, ONLY : c06dcf, d05aaf USE d05aafe_mod, ONLY : a, b, g, ind, k1, k2, lambda, ldw1, ldw2, n, & nag_wp, nout, xval ! .. 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