!   D05BDF Example Program Text
!   Mark 23 Release. NAG Copyright 2011.
    MODULE d05bdfe_mod

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

!      .. Use Statements ..
       USE nag_library, ONLY : nag_wp
!      .. Implicit None Statement ..
       IMPLICIT NONE
!      .. Parameters ..
       INTEGER, PARAMETER                  :: iorder = 4
       INTEGER, PARAMETER                  :: nmesh = 2**6 + 2*iorder - 1
       INTEGER, PARAMETER                  :: nout = 6
       INTEGER, PARAMETER                  :: lct = nmesh/32 + 1
       INTEGER, PARAMETER                  ::                                  &
                     lwk = (2*iorder+6)*nmesh + 8*iorder*iorder - 16*iorder + 1
    CONTAINS
!dec$ attributes offload : mic :: ck1
       FUNCTION ck1(t)

!         .. Use Statements ..
          USE nag_library, ONLY : x01aaf
!         .. Implicit None Statement ..
          IMPLICIT NONE
!         .. Function Return Value ..
          REAL (KIND=nag_wp)                  :: ck1
!         .. Scalar Arguments ..
          REAL (KIND=nag_wp), INTENT (IN)     :: t
!         .. Local Scalars ..
          REAL (KIND=nag_wp)                  :: pi
!         .. Intrinsic Functions ..
          INTRINSIC                              sqrt
!         .. Executable Statements ..
          ck1 = -sqrt(x01aaf(pi))

          RETURN

!dec$ attributes offload : mic :: ck1
       END FUNCTION ck1
!dec$ attributes offload : mic :: cf1
       FUNCTION cf1(t)

!         .. Use Statements ..
          USE nag_library, ONLY : x01aaf
!         .. Implicit None Statement ..
          IMPLICIT NONE
!         .. Function Return Value ..
          REAL (KIND=nag_wp)                  :: cf1
!         .. Scalar Arguments ..
          REAL (KIND=nag_wp), INTENT (IN)     :: t
!         .. Local Scalars ..
          REAL (KIND=nag_wp)                  :: pi
!         .. Intrinsic Functions ..
          INTRINSIC                              sqrt
!         .. Executable Statements ..
          cf1 = sqrt(t) + (3.0_nag_wp/8.0_nag_wp)*t*t*x01aaf(pi)

          RETURN

!dec$ attributes offload : mic :: cf1
       END FUNCTION cf1
!dec$ attributes offload : mic :: cg1
       FUNCTION cg1(s,y)

!         .. Implicit None Statement ..
          IMPLICIT NONE
!         .. Function Return Value ..
          REAL (KIND=nag_wp)                  :: cg1
!         .. Scalar Arguments ..
          REAL (KIND=nag_wp), INTENT (IN)     :: s, y
!         .. Executable Statements ..
          cg1 = y*y*y

          RETURN

!dec$ attributes offload : mic :: cg1
       END FUNCTION cg1
!dec$ attributes offload : mic :: ck2
       FUNCTION ck2(t)

!         .. Use Statements ..
          USE nag_library, ONLY : x01aaf
!         .. Implicit None Statement ..
          IMPLICIT NONE
!         .. Function Return Value ..
          REAL (KIND=nag_wp)                  :: ck2
!         .. Scalar Arguments ..
          REAL (KIND=nag_wp), INTENT (IN)     :: t
!         .. Local Scalars ..
          REAL (KIND=nag_wp)                  :: pi
!         .. Intrinsic Functions ..
          INTRINSIC                              sqrt
!         .. Executable Statements ..
          ck2 = -sqrt(x01aaf(pi))

          RETURN

!dec$ attributes offload : mic :: ck2
       END FUNCTION ck2
!dec$ attributes offload : mic :: cf2
       FUNCTION cf2(t)

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

          RETURN

!dec$ attributes offload : mic :: cf2
       END FUNCTION cf2
!dec$ attributes offload : mic :: cg2
       FUNCTION cg2(s,y)

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

          RETURN

!dec$ attributes offload : mic :: cg2
       END FUNCTION cg2
    END MODULE d05bdfe_mod
    PROGRAM d05bdfe

!      D05BDF Example Main Program

!      .. Use Statements ..
       USE nag_library, ONLY : d05bdf, x02ajf
       USE d05bdfe_mod, ONLY : cf1, cf2, cg1, cg2, ck1, ck2, iorder, lct, lwk, &
                               nag_wp, nmesh, nout
!      .. Implicit None Statement ..
       IMPLICIT NONE
!      .. Local Scalars ..
       REAL (KIND=nag_wp)                  :: h, t, tlim, tolnl
       INTEGER                             :: i, ifail
!      .. Local Arrays ..
       REAL (KIND=nag_wp)                  :: work(lwk), yn(nmesh)
       INTEGER                             :: nct(lct)
!      .. Intrinsic Functions ..
       INTRINSIC                              mod, real, sqrt
!      .. Executable Statements ..
       WRITE (nout,*) 'D05BDF Example Program Results'

       tlim = 7.0_nag_wp
       tolnl = sqrt(x02ajf())
       h = tlim/real(nmesh-1,kind=nag_wp)

       ifail = 0
       CALL d05bdf(ck1,cf1,cg1,'Initial',iorder,tlim,tolnl,nmesh,yn,work,lwk, &
          nct,ifail)

       WRITE (nout,*)
       WRITE (nout,*) 'Example 1'
       WRITE (nout,*)
       WRITE (nout,99998) h
       WRITE (nout,*)
       WRITE (nout,*) '     T        Approximate'
       WRITE (nout,*) '                Solution '
       WRITE (nout,*)

       DO i = 1, nmesh
          t = real(i-1,kind=nag_wp)*h

          IF (mod(i,5)==1) THEN
             WRITE (nout,99999) t, yn(i)
          END IF

       END DO

       tlim = 5.0_nag_wp
       h = tlim/real(nmesh-1,kind=nag_wp)

       ifail = 0
       CALL d05bdf(ck2,cf2,cg2,'Subsequent',iorder,tlim,tolnl,nmesh,yn,work, &
          lwk,nct,ifail)

       WRITE (nout,*)
       WRITE (nout,*) 'Example 2'
       WRITE (nout,*)
       WRITE (nout,99998) h
       WRITE (nout,*)
       WRITE (nout,*) '     T        Approximate'
       WRITE (nout,*) '                Solution '
       WRITE (nout,*)

       DO i = 1, nmesh
          t = real(i-1,kind=nag_wp)*h

          IF (mod(i,7)==1) THEN
             WRITE (nout,99999) t, yn(i)
          END IF

       END DO

99999  FORMAT (1X,F8.4,F15.4)
99998  FORMAT (' The stepsize h = ',F8.4)
    END PROGRAM d05bdfe
