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

    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
!      .. Parameters ..
       INTEGER, PARAMETER                  :: nin = 5, nout = 6
    CONTAINS
!dec$ attributes offload : mic :: print_greek
       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))
!dec$ attributes offload : mic :: print_greek
       END SUBROUTINE print_greek
    END MODULE d03nefe_mod

    PROGRAM d03nefe

!      D03NEF Example Main Program

!      .. Use Statements ..
       USE nag_library, ONLY : d03ndf, d03nef, nag_wp
       USE d03nefe_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, 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 Functions ..
       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)) 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 d03nefe
