!   D05BAF Example Program Text
!   Mark 23 Release. NAG Copyright 2011.
    MODULE d05bafe_mod

!      D05BAF Example Program Module:
!             Parameters and User-defined Routines

!      .. Use Statements ..
       USE nag_library, ONLY : nag_wp
!      .. Implicit None Statement ..
       IMPLICIT NONE
!      .. Parameters ..
       INTEGER, PARAMETER                  :: nmesh = 6, nout = 6
    CONTAINS
       FUNCTION sol(t)

!         .. Implicit None Statement ..
          IMPLICIT NONE
!         .. Function Return Value ..
          REAL (KIND=nag_wp)                  :: sol
!         .. Scalar Arguments ..
          REAL (KIND=nag_wp), INTENT (IN)     :: t
!         .. Intrinsic Functions ..
          INTRINSIC                              exp, log
!         .. Executable Statements ..
          sol = log(t+exp(1.0_nag_wp))

          RETURN

       END FUNCTION sol
       FUNCTION cf(t)

!         .. Implicit None Statement ..
          IMPLICIT NONE
!         .. Function Return Value ..
          REAL (KIND=nag_wp)                  :: cf
!         .. Scalar Arguments ..
          REAL (KIND=nag_wp), INTENT (IN)     :: t
!         .. Intrinsic Functions ..
          INTRINSIC                              exp
!         .. Executable Statements ..
          cf = exp(-t)

          RETURN

       END FUNCTION cf
       FUNCTION ck(t)

!         .. Implicit None Statement ..
          IMPLICIT NONE
!         .. Function Return Value ..
          REAL (KIND=nag_wp)                  :: ck
!         .. Scalar Arguments ..
          REAL (KIND=nag_wp), INTENT (IN)     :: t
!         .. Intrinsic Functions ..
          INTRINSIC                              exp
!         .. Executable Statements ..
          ck = exp(-t)

          RETURN

       END FUNCTION ck
       FUNCTION cg(s,y)

!         .. Implicit None Statement ..
          IMPLICIT NONE
!         .. Function Return Value ..
          REAL (KIND=nag_wp)                  :: cg
!         .. Scalar Arguments ..
          REAL (KIND=nag_wp), INTENT (IN)     :: s, y
!         .. Intrinsic Functions ..
          INTRINSIC                              exp
!         .. Executable Statements ..
          cg = y + exp(-y)

          RETURN

       END FUNCTION cg
    END MODULE d05bafe_mod
    PROGRAM d05bafe

!      D05BAF Example Main Program

!      .. Use Statements ..
       USE nag_library, ONLY : d05baf, nag_wp, x02ajf
       USE d05bafe_mod, ONLY : cf, cg, ck, nmesh, nout, sol
!      .. Implicit None Statement ..
       IMPLICIT NONE
!      .. Local Scalars ..
       REAL (KIND=nag_wp)                  :: alim, h, hi, si, thresh, tlim, tol
       INTEGER                             :: i, ifail, iorder, lwk
       CHARACTER (1)                       :: method
!      .. Local Arrays ..
       REAL (KIND=nag_wp)                  :: errest(nmesh), yn(nmesh)
       REAL (KIND=nag_wp), ALLOCATABLE     :: work(:)
!      .. Intrinsic Functions ..
       INTRINSIC                              abs, int, real
!      .. Executable Statements ..
       WRITE (nout,*) 'D05BAF Example Program Results'

       method = 'A'
       iorder = 6
       alim = 0.0_nag_wp
       tlim = 20.0_nag_wp
       h = (tlim-alim)/real(nmesh,kind=nag_wp)
       tol = 1.E-3_nag_wp
       thresh = x02ajf()
       lwk = 10*nmesh + 6
       ALLOCATE (work(lwk))

!      Loop until the supplied workspace is big enough

LOOP:  DO

          ifail = 1
          CALL d05baf(ck,cg,cf,method,iorder,alim,tlim,yn,errest,nmesh,tol, &
             thresh,work,lwk,ifail)

          SELECT CASE (ifail)
          CASE (5,6)
             lwk = 2*lwk
             DEALLOCATE (work)
             ALLOCATE (work(lwk))
          CASE DEFAULT
             EXIT LOOP
          END SELECT

       END DO LOOP

       IF (ifail/=0) THEN
          WRITE (nout,99996) 'D05BAF exited with IFAIL =', ifail
          GO TO 20
       END IF

       WRITE (nout,*)
       WRITE (nout,99999) 'Size of workspace =', lwk
       WRITE (nout,99998) 'Tolerance         =', tol
       WRITE (nout,*)
       WRITE (nout,*) &
          '   T        Approx. Sol.  True Sol.    Est. Error    Actual Error'
       DO i = 1, nmesh
          hi = real(i,kind=nag_wp)*h
          si = sol(hi)
          WRITE (nout,99997) alim + hi, yn(i), si, errest(i), &
             abs((yn(i)-si)/si)
       END DO

20     CONTINUE

99999  FORMAT (1X,A,I12)
99998  FORMAT (1X,A,E12.4)
99997  FORMAT (F7.2,2F14.5,2E15.5)
99996  FORMAT (1X,A,I5)
    END PROGRAM d05bafe