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

    Module d03nefe_mod

!     D03NEF 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 d03nefe_mod

    Program d03nefe

!     D03NEF Example Main Program

!     .. Use Statements ..
      Use d03nefe_mod, Only: nin, nout, print_greek
      Use nag_library, Only: d03ndf, d03nef, 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, lwork, ns, nt,    &
                                          ntd
!     .. Local Arrays ..
      Real (Kind=nag_wp), Allocatable  :: delta(:,:), f(:,:), gamma(:,:),      &
                                          lambda(:,:), rd(:), rho(:,:), s(:),  &
                                          sigd(:), t(:), td(:), theta(:,:),    &
                                          work(:)
      Real (Kind=nag_wp)               :: q(3), ra(3), siga(3)
      Logical                          :: tdpar(3)
!     .. Intrinsic Procedures ..
      Intrinsic                        :: real
!     .. Executable Statements ..
      Write (nout,*) 'D03NEF Example Program Results'
      Write (nout,*)

!     Skip heading in data file
      Read (nin,*)
      Read (nin,*) ns, nt, ntd
      lwork = 9*ntd + 24

      Allocate (delta(ns,nt),f(ns,nt),gamma(ns,nt),lambda(ns,nt),rd(ntd),      &
        rho(ns,nt),s(ns),sigd(ntd),t(nt),td(ntd),theta(ns,nt),work(lwork))

!     Read problem parameters

      Read (nin,*) kopt
      Read (nin,*) x
      Read (nin,*) tmat
      Read (nin,*) s(1), s(ns)
      Read (nin,*) t(1), t(nt)
      Read (nin,*) td(1:ntd)
      Read (nin,*) rd(1:ntd)
      Read (nin,*) sigd(1:ntd)
      Read (nin,*) tdpar(1:3)
      Read (nin,*) q(1)

      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

!         Find average values of r and sigma
          ifail = 0
          Call d03nef(t(j),tmat,ntd,td,rd,ra,work,lwork,ifail)

          ifail = 0
          Call d03nef(t(j),tmat,ntd,td,sigd,siga,work,lwork,ifail)

!         Loop over stock prices

          Do i = 1, ns

            s(i) = s(1) + real(i-1,kind=nag_wp)*ds

!           Evaluate analytic solution of Black-Scholes equation
            ifail = 0
            Call d03ndf(kopt,x,s(i),t(j),tmat,tdpar,ra,q,siga,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 d03nefe