!   D03NCF Example Program Text
!   Mark 24 Release. NAG Copyright 2012.

    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
!     .. Parameters ..
      Integer, Parameter                   :: 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 nag_library, Only: d03ncf, nag_wp
      Use d03ncfe_mod, Only: nin, nout, print_greek
!     .. 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)) Call print_greek(ns,ntkeep,nt,s,t,'Theta',theta)
      If (gprnt(2)) Call print_greek(ns,ntkeep,nt,s,t,'Delta',delta)
      If (gprnt(3)) Call print_greek(ns,ntkeep,nt,s,t,'Gamma',gamma)
      If (gprnt(4)) Call print_greek(ns,ntkeep,nt,s,t,'Lambda',lambda)
      If (gprnt(5)) Call print_greek(ns,ntkeep,nt,s,t,'Rho',rho)

    End Program d03ncfe
