!   D02JBF Example Program Text
!   Mark 30.1 Release. NAG Copyright 2024.

    Module d02jbfe_mod

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

!     .. Use Statements ..
      Use nag_library, Only: nag_wp
!     .. Implicit None Statement ..
      Implicit None
!     .. Accessibility Statements ..
      Private
      Public                           :: bc, cf
!     .. Parameters ..
      Integer, Parameter, Public       :: nin = 5, nout = 6
    Contains
      Function cf(i,j,x)

!       .. Function Return Value ..
        Real (Kind=nag_wp)             :: cf
!       .. Parameters ..
        Integer, Parameter             :: n = 2
        Real (Kind=nag_wp), Parameter  :: a(n,n) = reshape((/0.0E0_nag_wp,     &
                                          -1.0E0_nag_wp,1.0E0_nag_wp,          &
                                          0.0E0_nag_wp/),(/n,n/))
        Real (Kind=nag_wp), Parameter  :: r(n) = (/0.0E0_nag_wp,1.0E0_nag_wp/)
!       .. Scalar Arguments ..
        Real (Kind=nag_wp), Intent (In) :: x
        Integer, Intent (In)           :: i, j
!       .. Intrinsic Procedures ..
        Intrinsic                      :: reshape
!       .. Executable Statements ..
        If (j>0) Then
          cf = a(i,j)
        End If
        If (j==0) Then
          cf = r(i)
        End If
        Return
      End Function cf

      Subroutine bc(i,j,rhs)

!       .. Scalar Arguments ..
        Real (Kind=nag_wp), Intent (Out) :: rhs
        Integer, Intent (In)           :: i
        Integer, Intent (Out)          :: j
!       .. Executable Statements ..
        rhs = 0.0E0_nag_wp
        If (i>1) Then
          j = -1
        Else
          j = 1
        End If
        Return
      End Subroutine bc
    End Module d02jbfe_mod

    Program d02jbfe

!     D02JBF Example Main Program

!     .. Use Statements ..
      Use d02jbfe_mod, Only: bc, cf, nin, nout
      Use nag_library, Only: d02jbf, e02akf, nag_wp
!     .. Implicit None Statement ..
      Implicit None
!     .. Local Scalars ..
      Real (Kind=nag_wp)               :: dx, x, x0, x1
      Integer                          :: i, ia1, ifail, j, k1, k1max, kp,     &
                                          kpmax, ldc, liw, lw, m, n
!     .. Local Arrays ..
      Real (Kind=nag_wp), Allocatable  :: c(:,:), w(:), y(:)
      Integer, Allocatable             :: iw(:)
!     .. Intrinsic Procedures ..
      Intrinsic                        :: real
!     .. Executable Statements ..
      Write (nout,*) 'D02JBF Example Program Results'
!     Skip heading in data file
      Read (nin,*)
!     n: order of the system of differential equations
!     k1: number of coefficients to be returned
!     kp: number of collocation points
      Read (nin,*) n, k1max, kpmax
      ldc = k1max
      liw = n*(k1max+2)
      lw = 2*n*(kpmax+1)*(n*k1max+1) + 7*n*k1max
      Allocate (iw(liw),c(ldc,n),w(lw),y(n))
!     x0: left-hand boundary, x1: right-hand boundary.
      Read (nin,*) x0, x1
      Write (nout,*)
      Write (nout,*) ' KP  K1   Chebyshev coefficients'
      Do kp = 10, kpmax, 5
        Do k1 = 4, k1max, 2

!         ifail: behaviour on error exit
!                =0 for hard exit, =1 for quiet-soft, =-1 for noisy-soft
          ifail = 0
          Call d02jbf(n,cf,bc,x0,x1,k1,kp,c,ldc,w,lw,iw,liw,ifail)

          Write (nout,99999) kp, k1, c(1:k1,1)
          Write (nout,99998)(c(1:k1,j),j=2,n)
          Write (nout,*)
        End Do
      End Do
      k1 = 8
      m = 9
      ia1 = 1
      Write (nout,99997) 'Last computed solution evaluated at', m,             &
        '  equally spaced points'
      Write (nout,*)
      Write (nout,99996) '      X ', (j,j=1,n)
      dx = (x1-x0)/real(m-1,kind=nag_wp)
      x = x0
      Do i = 1, m
        Do j = 1, n

          ifail = 0
          Call e02akf(k1,x0,x1,c(1,j),ia1,ldc,x,y(j),ifail)

        End Do
        Write (nout,99995) x, y(1:n)
        x = x + dx
      End Do

99999 Format (1X,2(I3,1X),8F8.4)
99998 Format (9X,8F8.4)
99997 Format (1X,A,I5,A)
99996 Format (1X,A,2('      Y(',I1,')'))
99995 Format (1X,3F10.4)
    End Program d02jbfe