! D05ABF Example Program Text ! Mark 23 Release. NAG Copyright 2011. MODULE d05abfe_mod ! D05ABF Example Program Module: ! Parameters and User-defined Routines ! .. Use Statements .. USE nag_library, ONLY : nag_wp ! .. Implicit None Statement .. IMPLICIT NONE ! .. Parameters .. INTEGER, PARAMETER :: nmax = 10, nout = 6 CONTAINS FUNCTION k(x,s) ! .. Implicit None Statement .. IMPLICIT NONE ! .. Function Return Value .. REAL (KIND=nag_wp) :: k ! .. Parameters .. REAL (KIND=nag_wp), PARAMETER :: alpha = 1.0_nag_wp REAL (KIND=nag_wp), PARAMETER :: w = alpha**2 ! .. Scalar Arguments .. REAL (KIND=nag_wp), INTENT (IN) :: s, x ! .. Executable Statements .. k = alpha/(w+(x-s)*(x-s)) RETURN END FUNCTION k FUNCTION g(x) ! .. Implicit None Statement .. IMPLICIT NONE ! .. Function Return Value .. REAL (KIND=nag_wp) :: g ! .. Scalar Arguments .. REAL (KIND=nag_wp), INTENT (IN) :: x ! .. Executable Statements .. g = 1.0_nag_wp RETURN END FUNCTION g END MODULE d05abfe_mod PROGRAM d05abfe ! D05ABF Example Main Program ! .. Use Statements .. USE nag_library, ONLY : c06dcf, d05abf, nag_wp, x01aaf USE d05abfe_mod, ONLY : g, k, nmax, nout ! .. Implicit None Statement .. IMPLICIT NONE ! .. Local Scalars .. REAL (KIND=nag_wp) :: a, b, lambda, x0 INTEGER :: i, ifail, ldcm, lx, n, nt2p1, ss LOGICAL :: ev, odorev ! .. Local Arrays .. REAL (KIND=nag_wp), ALLOCATABLE :: c(:), chebr(:), cm(:,:), f(:), & f1(:,:), wk(:,:), x(:) ! .. Intrinsic Functions .. INTRINSIC cos, int, real ! .. Executable Statements .. WRITE (nout,*) 'D05ABF Example Program Results' odorev = .TRUE. ev = .TRUE. lambda = -0.3183_nag_wp a = -1.0_nag_wp b = 1.0_nag_wp IF (odorev) THEN WRITE (nout,*) IF (ev) THEN WRITE (nout,*) 'Solution is even' ss = 2 ELSE WRITE (nout,*) 'Solution is odd' ss = 3 END IF x0 = 0.5_nag_wp*(a+b) ELSE ss = 1 x0 = a END IF ! Set up uniform grid to evaluate Chebyshev polynomials. lx = int(4.000001_nag_wp*(b-x0)) + 1 ALLOCATE (x(lx),chebr(lx)) x(1) = x0 DO i = 2, lx x(i) = x(i-1) + 0.25_nag_wp END DO DO n = 5, nmax, 5 ldcm = n nt2p1 = 2*n + 1 ALLOCATE (c(n),cm(ldcm,ldcm),f(n),f1(ldcm,1),wk(2,nt2p1)) ifail = -1 CALL d05abf(k,g,lambda,a,b,odorev,ev,n,cm,f1,wk,ldcm,nt2p1,f,c, & ifail) IF (ifail==0) THEN WRITE (nout,*) WRITE (nout,99999) 'Results for N =', n WRITE (nout,*) WRITE (nout,99996) 'Solution on first ', n, & ' Chebyshev points and Chebyshev coefficients' WRITE (nout,*) ' I X F(I) C(I)' WRITE (nout,99998) (i,cos(x01aaf(a)*real(i, & kind=nag_wp)/real(2*n-1,kind=nag_wp)),f(i),c(i),i=1,n) ! Evaluate and print solution on uniform grid. ifail = 0 CALL c06dcf(x,lx,a,b,c,n,ss,chebr,ifail) WRITE (nout,*) WRITE (nout,*) 'Solution on evenly spaced grid' WRITE (nout,*) ' X F(X)' WRITE (nout,99997) (x(i),chebr(i),i=1,lx) END IF DEALLOCATE (c,cm,f,f1,wk) END DO DEALLOCATE (x,chebr) 99999 FORMAT (1X,A,I3) 99998 FORMAT (1X,I3,2F15.5,E15.5) 99997 FORMAT (1X,F8.4,F15.5) 99996 FORMAT (1X,A,I2,A) END PROGRAM d05abfe