! 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