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

    MODULE d02gbfe_mod

!      Data for D02GBF example program

!      .. Use Statements ..
       USE nag_library, ONLY : nag_wp
!      .. Implicit None Statement ..
       IMPLICIT NONE
!      .. Parameters ..
       REAL (KIND=nag_wp), PARAMETER       :: one = 1.0_nag_wp
       REAL (KIND=nag_wp), PARAMETER       :: zero = 0.0_nag_wp
       INTEGER, PARAMETER                  :: iset = 1, n = 2, nin = 5, nout = 6
!      .. Local Scalars ..
       REAL (KIND=nag_wp)                  :: eps
    CONTAINS
       SUBROUTINE fcnf(x,f)

!         .. Implicit None Statement ..
          IMPLICIT NONE
!         .. Scalar Arguments ..
          REAL (KIND=nag_wp), INTENT (IN)     :: x
!         .. Array Arguments ..
          REAL (KIND=nag_wp), INTENT (OUT)    :: f(*)
!         .. Executable Statements ..
          f(1:2) = 0.0E0_nag_wp
          f(3) = 1.0E0_nag_wp
          f(4) = -1.0E0_nag_wp/eps
          RETURN
       END SUBROUTINE fcnf
       SUBROUTINE fcng(x,g)

!         .. Implicit None Statement ..
          IMPLICIT NONE
!         .. Scalar Arguments ..
          REAL (KIND=nag_wp), INTENT (IN)     :: x
!         .. Array Arguments ..
          REAL (KIND=nag_wp), INTENT (OUT)    :: g(*)
!         .. Executable Statements ..
          g(1:2) = 0.0E0_nag_wp
          RETURN
       END SUBROUTINE fcng
    END MODULE d02gbfe_mod
    PROGRAM d02gbfe

!      D02GBF Example Main Program

!      .. Use Statements ..
       USE nag_library, ONLY : d02gbf, nag_wp, x04abf
       USE d02gbfe_mod, ONLY : eps, fcnf, fcng, iset, n, nin, nout, one, zero
!      .. Implicit None Statement ..
       IMPLICIT NONE
!      .. Local Scalars ..
       REAL (KIND=nag_wp)                  :: a, b, tol
       INTEGER                             :: i, ifail, j, liw, lw, mnp, np,   &
                                              outchn
!      .. Local Arrays ..
       REAL (KIND=nag_wp), ALLOCATABLE     :: c(:,:), d(:,:), gam(:), w(:),    &
                                              x(:), y(:,:)
       INTEGER, ALLOCATABLE                :: iw(:)
!      .. Executable Statements ..
       WRITE (nout,*) 'D02GBF Example Program Results'
!      Skip heading in data file
       READ (nin,*)
!      mnp: maximum permitted number of mesh points.
       READ (nin,*) mnp
       liw = mnp*(2*n+1) + n
       lw = mnp*(3*n*n+5*n+2) + 3*n*n + 5*n
       ALLOCATE (iw(liw),c(n,n),d(n,n),gam(n),w(lw),x(mnp),y(n,mnp))
!      tol: positive absolute error tolerance
!      np : determines whether a default or user-supplied mesh is used. 
!      a  : left-hand boundary point, b: right-hand boundary point.
       READ (nin,*) tol
       READ (nin,*) np
       READ (nin,*) a, b
       outchn = nout
       CALL x04abf(iset,outchn)
       gam(1:n) = zero
       c(1:n,1:n) = zero
       d(1:n,1:n) = zero
       c(1,1) = one
       d(2,1) = one
       gam(2) = one
LOOP:  DO i = 1, 2
          eps = 10.0E0_nag_wp**(-i)
          WRITE (nout,*)
!         ifail: behaviour on error exit
!                =1 for quiet-soft exit
!         * Set ifail to 111 to obtain monitoring information *
          ifail = 1
          CALL d02gbf(a,b,n,tol,fcnf,fcng,c,d,gam,mnp,x,y,np,w,lw,iw,liw, &
             ifail)

          IF (ifail>=0) WRITE (nout,99999) 'Problem with epsilon = ', eps
          IF (ifail==0) THEN
             WRITE (nout,99998) np
             WRITE (nout,*) '       X(I)     Y(1,I)'
             WRITE (nout,99997) (x(j),y(1,j),j=1,np)
          ELSE
             WRITE (nout,99996) ifail
             EXIT LOOP
          END IF
       END DO LOOP

99999  FORMAT (1X,A,E10.2)
99998  FORMAT (/1X,'Approximate solution on final mesh of ',I2,' points')
99997  FORMAT (1X,2F11.4)
99996  FORMAT (1X/1X,' ** D02GBF returned with IFAIL = ',I5)
    END PROGRAM d02gbfe