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

    Module d03ndfe_mod

!     D03NDF 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,nt,tmat,s,t,grname,greek)

!       .. Scalar Arguments ..
        Real (Kind=nag_wp), Intent (In) :: tmat
        Integer, Intent (In)           :: ns, nt
        Character (*), Intent (In)     :: grname
!       .. Array Arguments ..
        Real (Kind=nag_wp), Intent (In) :: greek(ns,nt), 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*(tmat-t(i)),i=1,nt)
        Write (nout,*) ' -----------------', ('------------',i=1,nt)
        Do i = 1, ns
          Write (nout,99998) s(i), '|', (greek(i,j),j=1,nt)
        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 d03ndfe_mod

    Program d03ndfe

!     D03NDF Example Main Program

!     .. Use Statements ..
      Use d03ndfe_mod, Only: nin, nout, print_greek
      Use nag_library, Only: d03ndf, nag_wp
!     .. Implicit None Statement ..
      Implicit None
!     .. Parameters ..
      Logical, Parameter               :: gprnt(5) = .True.
!     .. Local Scalars ..
      Real (Kind=nag_wp)               :: ds, dt, tmat, x
      Integer                          :: i, ifail, j, kopt, ns, nt
!     .. Local Arrays ..
      Real (Kind=nag_wp), Allocatable  :: delta(:,:), f(:,:), gamma(:,:),      &
                                          lambda(:,:), rho(:,:), s(:), t(:),   &
                                          theta(:,:)
      Real (Kind=nag_wp)               :: q(3), r(3), sigma(3)
      Logical                          :: tdpar(3)
!     .. Intrinsic Procedures ..
      Intrinsic                        :: real
!     .. Executable Statements ..
      Write (nout,*) 'D03NDF Example Program Results'
      Write (nout,*)

!     Skip heading in data file
      Read (nin,*)
      Read (nin,*) ns, nt

      Allocate (delta(ns,nt),f(ns,nt),gamma(ns,nt),lambda(ns,nt),rho(ns,nt),   &
        s(ns),t(nt),theta(ns,nt))

!     Read problem parameters

      Read (nin,*) kopt
      Read (nin,*) x
      Read (nin,*) tmat
      Read (nin,*) q(1), r(1), sigma(1)
      Read (nin,*) s(1), s(ns)
      Read (nin,*) t(1), t(nt)
      Read (nin,*) tdpar(1:3)

      If (ns<2) Then
        Write (nout,*) 'NS invalid.'
      Else If (nt<2) Then
        Write (nout,*) 'NT invalid.'
      Else

        ds = (s(ns)-s(1))/real(ns-1,kind=nag_wp)
        dt = (t(nt)-t(1))/real(nt-1,kind=nag_wp)

!       Loop over times
        Do j = 1, nt
          t(j) = t(1) + real(j-1,kind=nag_wp)*dt

!         Loop over stock prices
          Do i = 1, ns
            s(i) = s(1) + real(i-1,kind=nag_wp)*ds

!           Call Black-Scholes solver
            ifail = 0
            Call d03ndf(kopt,x,s(i),t(j),tmat,tdpar,r,q,sigma,f(i,j),          &
              theta(i,j),delta(i,j),gamma(i,j),lambda(i,j),rho(i,j),ifail)

          End Do
        End Do

!       Output option values and possibly Greeks.

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

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

      End If

    End Program d03ndfe