!   D02KEF Example Program Text
!   Mark 23 Release. NAG Copyright 2011.

    MODULE d02kefe_mod

!      Data for D02KEF example program

!      .. Use Statements ..
       USE nag_library, ONLY : nag_wp
!      .. Implicit None Statement ..
       IMPLICIT NONE
!      .. Parameters ..
       REAL (KIND=nag_wp), PARAMETER       :: one = 1.0_nag_wp
       REAL (KIND=nag_wp), PARAMETER       :: two = 2.0_nag_wp
       REAL (KIND=nag_wp), PARAMETER       :: zero = 0.0_nag_wp
       INTEGER, PARAMETER                  :: nin = 5, nout = 6
    CONTAINS
       SUBROUTINE coeffn(p,q,dqdl,x,elam,jint)

!         .. Implicit None Statement ..
          IMPLICIT NONE
!         .. Scalar Arguments ..
          REAL (KIND=nag_wp), INTENT (OUT)    :: dqdl, p, q
          REAL (KIND=nag_wp), INTENT (IN)     :: elam, x
          INTEGER, INTENT (IN)                :: jint
!         .. Executable Statements ..
          p = one
          q = elam - x - two/(x*x)
          dqdl = one
          RETURN
       END SUBROUTINE coeffn
       SUBROUTINE bdyval(xl,xr,elam,yl,yr)

!         .. Implicit None Statement ..
          IMPLICIT NONE
!         .. Scalar Arguments ..
          REAL (KIND=nag_wp), INTENT (IN)     :: elam, xl, xr
!         .. Array Arguments ..
          REAL (KIND=nag_wp), INTENT (OUT)    :: yl(3), yr(3)
!         .. Intrinsic Functions ..
          INTRINSIC                              sqrt
!         .. Executable Statements ..
          yl(1) = xl
          yl(2) = two
          yr(1) = one
          yr(2) = -sqrt(xr-elam)
          RETURN
       END SUBROUTINE bdyval
       SUBROUTINE report(x,v,jint)

!         .. Use Statements ..
          USE nag_library, ONLY : x02amf
!         .. Implicit None Statement ..
          IMPLICIT NONE
!         .. Scalar Arguments ..
          REAL (KIND=nag_wp), INTENT (IN)     :: x
          INTEGER, INTENT (IN)                :: jint
!         .. Array Arguments ..
          REAL (KIND=nag_wp), INTENT (IN)     :: v(3)
!         .. Local Scalars ..
          REAL (KIND=nag_wp)                  :: pyp, r, sqrtb, y
!         .. Intrinsic Functions ..
          INTRINSIC                              cos, exp, log, sin, sqrt
!         .. Executable Statements ..
          IF (jint==0) THEN
             WRITE (nout,*)
             WRITE (nout,*) ' Eigenfunction values'
             WRITE (nout,*) '       X          Y           PYP'
          END IF
          sqrtb = sqrt(v(1))
!         Avoid underflow in call of EXP
          IF (0.5_nag_wp*v(3)>=log(x02amf())) THEN
             r = exp(0.5_nag_wp*v(3))
          ELSE
             r = zero
          END IF
          pyp = r*sqrtb*cos(0.5_nag_wp*v(2))
          y = r/sqrtb*sin(0.5_nag_wp*v(2))
          WRITE (nout,99999) x, y, pyp
          RETURN

99999     FORMAT (1X,F10.3,1P,2F12.4)
       END SUBROUTINE report
       SUBROUTINE monit(nit,iflag,elam,finfo)

!         .. Implicit None Statement ..
          IMPLICIT NONE
!         .. Scalar Arguments ..
          REAL (KIND=nag_wp), INTENT (IN)     :: elam
          INTEGER, INTENT (IN)                :: iflag, nit
!         .. Array Arguments ..
          REAL (KIND=nag_wp), INTENT (IN)     :: finfo(15)
!         .. Executable Statements ..
          IF (nit==-1) THEN
             WRITE (nout,*)
             WRITE (nout,*) 'Output from MONIT'
          END IF
          WRITE (nout,99999) nit, iflag, elam, finfo(1:4)
          RETURN

99999     FORMAT (1X,2I4,F10.3,2E12.2,2F8.1)
       END SUBROUTINE monit
    END MODULE d02kefe_mod
    PROGRAM d02kefe

!      D02KEF Example Main Program

!      .. Use Statements ..
       USE nag_library, ONLY : d02kay, d02kef, nag_wp
       USE d02kefe_mod, ONLY : bdyval, coeffn, nin, nout, report
!      .. Implicit None Statement ..
       IMPLICIT NONE
!      .. Local Scalars ..
       REAL (KIND=nag_wp)                  :: delam, elam, tol
       INTEGER                             :: ifail, k, m, match, maxfun, maxit
!      .. Local Arrays ..
       REAL (KIND=nag_wp), ALLOCATABLE     :: hmax(:,:), xpoint(:)
!      .. Executable Statements ..
       WRITE (nout,*) 'D02KEF Example Program Results'
       WRITE (nout,*)
       WRITE (nout,*) 'A singular problem'
!      Skip heading in data file
       READ (nin,*)
!      m: number of points in xpoint
       READ (nin,*) m
       ALLOCATE (hmax(2,m),xpoint(m))
!      xpoint: points where the boundary conditions are to be imposed 
!              and any break points,
!      tol: tolerance parameter which determines the accuracy of the 
!           computed eigenvalue,
!      k: index of the required eigenvalue,  hmax: maximum step size,
!      elam: initial estimate of the eigenvalue,  delam: initial search step,
!      maxit: number of root-finding iterations allowed,
!      maxfun: number of calls to coeffn in any one root-finding iteration,
!      match: index of the break point.
       READ (nin,*) xpoint(1:m)
       READ (nin,*) tol
       READ (nin,*) k
       READ (nin,*) elam, delam
       READ (nin,*) hmax(1,1:m-3)
       READ (nin,*) maxit, maxfun, match

!      ifail: behaviour on error exit   
!             =0 for hard exit, =1 for quiet-soft, =-1 for noisy-soft
       ifail = 0

!      * To obtain monitoring information from the supplied
!      subroutine MONIT replace the name D02KAY by MONIT in
!      the next statement and USE MONIT from d02kefe_mod *

       CALL d02kef(xpoint,m,match,coeffn,bdyval,k,tol,elam,delam,hmax,maxit, &
          maxfun,d02kay,report,ifail)

       WRITE (nout,*)
       WRITE (nout,*) 'Final results'
       WRITE (nout,*)
       WRITE (nout,99999) k, elam, delam
       WRITE (nout,99998) hmax(1,m-1), hmax(1,m)

99999  FORMAT (1X,'K =',I3,'  ELAM =',F12.3,'  DELAM =',E12.2)
99998  FORMAT (1X,'HMAX(1,M-1) =',F10.3,'    HMAX(1,M) =',F10.3)
    END PROGRAM d02kefe