!   D02GBF Example Program Text
!   Mark 30.3 Release. nAG Copyright 2024.

    Module d02gbfe_mod

!     Data for D02GBF example program

!     .. Use Statements ..
      Use nag_library, Only: nag_wp
!     .. Implicit None Statement ..
      Implicit None
!     .. Accessibility Statements ..
      Private
      Public                           :: fcnf, fcng
!     .. Parameters ..
      Real (Kind=nag_wp), Parameter, Public :: one = 1.0_nag_wp
      Real (Kind=nag_wp), Parameter, Public :: zero = 0.0_nag_wp
      Integer, Parameter, Public       :: iset = 1, n = 2, nin = 5, nout = 6
!     .. Local Scalars ..
      Real (Kind=nag_wp), Public, Save :: eps
    Contains
      Subroutine fcnf(x,f)

!       .. 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)

!       .. 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 d02gbfe_mod, Only: eps, fcnf, fcng, iset, n, nin, nout, one, zero
      Use nag_library, Only: d02gbf, nag_wp, x04abf
!     .. 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) Then
          Write (nout,99999) 'Problem with epsilon = ', eps
        End If
        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