NAG Library Manual, Mark 30
Interfaces:  FL   CL   CPP   AD 

NAG FL Interface Introduction
Example description
!   D02KDF Example Program Text
!   Mark 30.0 Release. NAG Copyright 2024.

    Module d02kdfe_mod

!     Data for D02KDF example program

!     .. Use Statements ..
      Use nag_library, Only: nag_wp
!     .. Implicit None Statement ..
      Implicit None
!     .. Accessibility Statements ..
      Private
      Public                           :: bdyval, coeffn, monit
!     .. Parameters ..
      Real (Kind=nag_wp), Parameter    :: one = 1.0_nag_wp
      Real (Kind=nag_wp), Parameter    :: two = 2.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 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 d02kdfe_mod
    Program d02kdfe

!     D02KDF Example Main Program

!     .. Use Statements ..
      Use d02kdfe_mod, Only: bdyval, coeffn, monit, nin, nout
      Use nag_library, Only: d02kdf, nag_wp
!     .. Implicit None Statement ..
      Implicit None
!     .. Local Scalars ..
      Real (Kind=nag_wp)               :: delam, elam, tol
      Integer                          :: ifail, k, m, maxfun, maxit
!     .. Local Arrays ..
      Real (Kind=nag_wp), Allocatable  :: hmax(:,:), xpoint(:)
!     .. Executable Statements ..
      Write (nout,*) 'D02KDF Example Program Results'
      Write (nout,*)
!     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.
      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

!     ifail: behaviour on error exit
!             =0 for hard exit, =1 for quiet-soft, =-1 for noisy-soft
      ifail = 0
      Call d02kdf(xpoint,m,coeffn,bdyval,k,tol,elam,delam,hmax,maxit,maxfun,   &
        monit,ifail)

      Write (nout,*) 'A singular problem'
      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 d02kdfe