!   D03NDF Example Program Text
!   Mark 23 Release. NAG Copyright 2011.

    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
!      .. Parameters ..
       INTEGER, PARAMETER                  :: nin = 5, nout = 6
    CONTAINS
       SUBROUTINE print_greek(ns,nt,tmat,s,t,grname,greek)

!         .. Implicit None Statement ..
          IMPLICIT NONE
!         .. 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 Functions ..
          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 nag_library, ONLY : d03ndf, nag_wp
       USE d03ndfe_mod, ONLY : nin, nout, print_greek
!      .. 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 Functions ..
       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)) CALL print_greek(ns,nt,tmat,s,t,'Theta',theta)
          IF (gprnt(2)) CALL print_greek(ns,nt,tmat,s,t,'Delta',delta)
          IF (gprnt(3)) CALL print_greek(ns,nt,tmat,s,t,'Gamma',gamma)
          IF (gprnt(4)) CALL print_greek(ns,nt,tmat,s,t,'Lambda',lambda)
          IF (gprnt(5)) CALL print_greek(ns,nt,tmat,s,t,'Rho',rho)

       END IF

    END PROGRAM d03ndfe