Program s30ncfe

!     S30NCF Example Program Text

!     Mark 30.1 Release. NAG Copyright 2024.

!     .. Use Statements ..
      Use nag_library, Only: nag_wp, s30ncf
!     .. Implicit None Statement ..
      Implicit None
!     .. Parameters ..
      Integer, Parameter               :: nin = 5, nout = 6
!     .. Local Scalars ..
      Real (Kind=nag_wp)               :: disc, fwd, t, var0
      Integer                          :: i, ifail, m, numts
      Character (1)                    :: calput
!     .. Local Arrays ..
      Real (Kind=nag_wp), Allocatable  :: alpha(:), corr(:), lambda(:), p(:),  &
                                          sigmat(:), ts(:), x(:)
!     .. Executable Statements ..
      Write (nout,*) 'S30NCF Example Program Results'

!     Skip heading in data file

      Read (nin,*)

      Read (nin,*) calput
      Read (nin,*) m, numts

      Allocate (p(m),ts(numts),x(m),alpha(numts),corr(numts),lambda(numts),    &
        sigmat(numts))

      Read (nin,*) fwd, disc, var0
      Read (nin,*) x(1:m)
      Read (nin,*) ts(1:numts)
      Read (nin,*) t
      Read (nin,*) alpha(1:numts)
      Read (nin,*) corr(1:numts)
      Read (nin,*) lambda(1:numts)
      Read (nin,*) sigmat(1:numts)

      ifail = 0
      Call s30ncf(calput,m,numts,x,fwd,disc,ts,t,alpha,lambda,corr,sigmat,     &
        var0,p,ifail)

      If (ifail/=0) Then
        Go To 100
      End If

      Write (nout,*)
      Write (nout,*)                                                           &
        'Heston''s Stochastic volatility Model with Term Structure'

      Select Case (calput)
      Case ('C','c')
        Write (nout,*) 'European Call :'
      Case ('P','p')
        Write (nout,*) 'European Put :'
      End Select

      Write (nout,99998) '  Forward                = ', fwd
      Write (nout,99998) '  Discount Factor        = ', disc
      Write (nout,99998) '  Variance               = ', var0

      Write (nout,*) '   ts        alpha     lambda    corr      sigmat'
      Do i = 1, numts
        Write (nout,99997) ts(i), alpha(i), lambda(i), corr(i), sigmat(i)
      End Do

      Write (nout,*)
      Write (nout,*) '   Strike    Expiry       Option Price'

      Do i = 1, m
        Write (nout,99999) x(i), t, p(i)
      End Do

100   Continue

99999 Format (1X,2(F9.4,1X),3X,F9.4)
99998 Format (A,1X,F8.4)
99997 Format (1X,5(F9.4,1X))
    End Program s30ncfe