!   D02KEF Example Program Text
!   Mark 30.3 Release. nAG Copyright 2024.

    Module d02kefe_mod

!     Data for D02KEF example program

!     .. Use Statements ..
      Use nag_library, Only: nag_wp
!     .. Implicit None Statement ..
      Implicit None
!     .. Accessibility Statements ..
      Private
      Public                           :: bdyval, coeffn, monit, report
!     .. 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, Public       :: nin = 5, nout = 6
    Contains
      Subroutine coeffn(p,q,dqdl,x,elam,jint)

!       .. 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)

!       .. Scalar Arguments ..
        Real (Kind=nag_wp), Intent (In) :: elam, xl, xr
!       .. Array Arguments ..
        Real (Kind=nag_wp), Intent (Out) :: yl(3), yr(3)
!       .. Intrinsic Procedures ..
        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
!       .. 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 Procedures ..
        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)

!       .. 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 d02kefe_mod, Only: bdyval, coeffn, monit, nin, nout, report
      Use nag_library, Only: d02kef, nag_wp
!     .. 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
      Call d02kef(xpoint,m,match,coeffn,bdyval,k,tol,elam,delam,hmax,maxit,    &
        maxfun,monit,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