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

    Module d03ncfe_mod

!     D03NCF 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                           :: print_greek
!     .. Parameters ..
      Integer, Parameter, Public       :: nin = 5, nout = 6
    Contains
      Subroutine print_greek(ns,ntkeep,nt,s,t,grname,greek)

!       .. Scalar Arguments ..
        Integer, Intent (In)           :: ns, nt, ntkeep
        Character (*), Intent (In)     :: grname
!       .. Array Arguments ..
        Real (Kind=nag_wp), Intent (In) :: greek(ns,ntkeep), s(ns), t(nt)
!       .. Local Scalars ..
        Integer                        :: i, j
!       .. Intrinsic Procedures ..
        Intrinsic                      :: len
!       .. Executable Statements ..
        Write (nout,*)
        Write (nout,*) grname
        Write (nout,*)('-',i=1,len(grname))
        Write (nout,*) '  Stock Price  |   Time to Maturity (months)'
        Write (nout,99999) '|', (12.0_nag_wp*(t(nt)-t(i)),i=1,ntkeep)
        Write (nout,*) ' -----------------', ('------------',i=1,ntkeep)
        Do i = 1, ns
          Write (nout,99998) s(i), '|', (greek(i,j),j=1,ntkeep)
        End Do

        Return

99999   Format (16X,A,1X,12(1P,E12.4))
99998   Format (1X,1P,E12.4,3X,A,1X,12(1P,E12.4))
      End Subroutine print_greek
    End Module d03ncfe_mod

    Program d03ncfe

!     D03NCF Example Main Program

!     .. Use Statements ..
      Use d03ncfe_mod, Only: nin, nout, print_greek
      Use nag_library, Only: d03ncf, nag_wp
!     .. Implicit None Statement ..
      Implicit None
!     .. Parameters ..
      Logical, Parameter               :: gprnt(5) = .True.
!     .. Local Scalars ..
      Real (Kind=nag_wp)               :: alpha, x
      Integer                          :: ifail, kopt, ldf, ns, nt, ntkeep
      Character (1)                    :: mesh
!     .. Local Arrays ..
      Real (Kind=nag_wp), Allocatable  :: delta(:,:), f(:,:), gamma(:,:),      &
                                          lambda(:,:), rho(:,:), s(:), t(:),   &
                                          theta(:,:), work(:)
      Real (Kind=nag_wp)               :: q(3), r(3), sigma(3)
      Integer, Allocatable             :: iwork(:)
      Logical                          :: tdpar(3)
!     .. Executable Statements ..
      Write (nout,*) 'D03NCF Example Program Results'
      Write (nout,*)
!     Skip heading in data file
      Read (nin,*)
      Read (nin,*) ns, nt, ntkeep
      ldf = ns

      Allocate (delta(ldf,ntkeep),f(ldf,ntkeep),gamma(ldf,ntkeep),             &
        lambda(ldf,ntkeep),rho(ldf,ntkeep),s(ldf),t(nt),theta(ldf,ntkeep),     &
        work(4*ns),iwork(ns))

!     Read problem parameters

      Read (nin,*) kopt
      Read (nin,*) x
      Read (nin,*) mesh
      Read (nin,*) s(1), s(ns)
      Read (nin,*) t(1), t(nt)
      Read (nin,*) alpha

!     Set up input parameters for D03NCF

      Read (nin,*) tdpar(1:3)
      Read (nin,*) q(1), r(1), sigma(1)

!     Call Black-Scholes solver
      ifail = 0
      Call d03ncf(kopt,x,mesh,ns,s,nt,t,tdpar,r,q,sigma,alpha,ntkeep,f,theta,  &
        delta,gamma,lambda,rho,ldf,work,iwork,ifail)

!     Output option values and possibly Greeks.

      Call print_greek(ns,ntkeep,nt,s,t,'Option Values',f)

      If (gprnt(1)) Then
        Call print_greek(ns,ntkeep,nt,s,t,'Theta',theta)
      End If
      If (gprnt(2)) Then
        Call print_greek(ns,ntkeep,nt,s,t,'Delta',delta)
      End If
      If (gprnt(3)) Then
        Call print_greek(ns,ntkeep,nt,s,t,'Gamma',gamma)
      End If
      If (gprnt(4)) Then
        Call print_greek(ns,ntkeep,nt,s,t,'Lambda',lambda)
      End If
      If (gprnt(5)) Then
        Call print_greek(ns,ntkeep,nt,s,t,'Rho',rho)
      End If

    End Program d03ncfe