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

    MODULE d02bhfe_mod

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

!      .. Use Statements ..
       USE nag_library, ONLY : nag_wp
!      .. Implicit None Statement ..
       IMPLICIT NONE
!      .. Parameters ..
       INTEGER, PARAMETER                  :: n = 3, nin = 5, nout = 6
!   n: number of differential equations
    CONTAINS
       SUBROUTINE fcn(x,y,f)

!         .. Implicit None Statement ..
          IMPLICIT NONE
!         .. Parameters ..
          REAL (KIND=nag_wp), PARAMETER       :: alpha = -0.032E0_nag_wp
          REAL (KIND=nag_wp), PARAMETER       :: beta = -0.02E0_nag_wp
!         .. Scalar Arguments ..
          REAL (KIND=nag_wp), INTENT (IN)     :: x
!         .. Array Arguments ..
          REAL (KIND=nag_wp), INTENT (OUT)    :: f(*)
          REAL (KIND=nag_wp), INTENT (IN)     :: y(*)
!         .. Intrinsic Functions ..
          INTRINSIC                              cos, tan
!         .. Executable Statements ..
          f(1) = tan(y(3))
          f(2) = alpha*tan(y(3))/y(2) + beta*y(2)/cos(y(3))
          f(3) = alpha/y(2)**2
          RETURN
       END SUBROUTINE fcn

       FUNCTION g(x,y)

!         .. Implicit None Statement ..
          IMPLICIT NONE
!         .. Function Return Value ..
          REAL (KIND=nag_wp)                  :: g
!         .. Scalar Arguments ..
          REAL (KIND=nag_wp), INTENT (IN)     :: x
!         .. Array Arguments ..
          REAL (KIND=nag_wp), INTENT (IN)     :: y(*)
!         .. Executable Statements ..
          g = y(1)
          RETURN
       END FUNCTION g
    END MODULE d02bhfe_mod

    PROGRAM d02bhfe

!      D02BHF Example Main Program

!      .. Use Statements ..
       USE nag_library, ONLY : d02bhf
       USE d02bhfe_mod, ONLY : fcn, g, n, nag_wp, nin, nout
!      .. Implicit None Statement ..
       IMPLICIT NONE
!      .. Local Scalars ..
       REAL (KIND=nag_wp)                  :: hmax, tol, x, xend, xinit
       INTEGER                             :: i, ifail, irelab, j
!      .. Local Arrays ..
       REAL (KIND=nag_wp), ALLOCATABLE     :: w(:,:), y(:), yinit(:)
!      .. Executable Statements ..
       WRITE (nout,*) 'D02BHF Example Program Results'
       ALLOCATE (w(n,7),y(n),yinit(n))
!      Skip heading in data file
       READ (nin,*)
!      xinit: initial x value,         xend  : final x value.
!      yinit: initial solution values, irelab: type of error control.
       READ (nin,*) xinit
       READ (nin,*) xend
       READ (nin,*) yinit(1:n)
       READ (nin,*) irelab
       hmax = 0.0E0_nag_wp
       DO i = 4, 5
          tol = 10.0E0_nag_wp**(-i)
          x = xinit
          y(1:n) = yinit(1:n)

!         ifail: behaviour on error exit   
!                =0 for hard exit, =1 for quiet-soft, =-1 for noisy-soft
          ifail = 0
          CALL d02bhf(x,xend,n,y,tol,irelab,hmax,fcn,g,w,ifail)

          WRITE (nout,*)
          WRITE (nout,99999) 'Calculation with TOL =', tol
          WRITE (nout,99998) ' Root of Y(1) at', x
          WRITE (nout,99997) ' Solution is', (y(j),j=1,n)
          IF (tol<0.0E0_nag_wp) THEN
             WRITE (nout,*) ' Over one-third steps controlled by HMAX'
          END IF
       END DO

99999  FORMAT (1X,A,E8.1)
99998  FORMAT (1X,A,F7.4)
99997  FORMAT (1X,A,3F13.5)
    END PROGRAM d02bhfe