!   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
!dec$ attributes offload : mic :: k
       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
!dec$ attributes offload : mic :: k
       END FUNCTION k
!dec$ attributes offload : mic :: g
       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
!dec$ attributes offload : mic :: g
       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
