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

    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
!dec$ attributes offload : mic :: print_greek
       SUBROUTINE print_greek(ns,ntkeep,nt,s,t,grname,greek)

!         .. Implicit None Statement ..
          IMPLICIT NONE
!         .. 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 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*(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))
!dec$ attributes offload : mic :: print_greek
       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
