Program s30ndfe

!     S30NDF Example Program Text

!     Mark 30.1 Release. NAG Copyright 2024.

!     .. Use Statements ..
      Use nag_library, Only: nag_wp, s30ndf
!     .. Implicit None Statement ..
      Implicit None
!     .. Parameters ..
      Integer, Parameter               :: nin = 5, nout = 6
!     .. Local Scalars ..
      Real (Kind=nag_wp)               :: corr, eta, grisk, kappa, s, sigmav,  &
                                          var0
      Integer                          :: i, ifail, j, ldp, m, n
      Character (1)                    :: calput
!     .. Local Arrays ..
      Real (Kind=nag_wp), Allocatable  :: charm(:,:), delta(:,:),              &
                                          dp_dcorr(:,:), dp_deta(:,:),         &
                                          dp_dgrisk(:,:), dp_dkappa(:,:),      &
                                          dp_dq(:,:), dp_dsigmav(:,:),         &
                                          dp_dx(:,:), gamma(:,:), p(:,:),      &
                                          q(:), r(:), rho(:,:), speed(:,:),    &
                                          t(:), theta(:,:), vanna(:,:),        &
                                          vega(:,:), vomma(:,:), x(:),         &
                                          zomma(:,:)
!     .. Executable Statements ..

      Write (nout,*) 'S30NDF Example Program Results'

!     Skip heading in data file
      Read (nin,*)
      Read (nin,*) calput
      Read (nin,*) s
      Read (nin,*) kappa, eta, var0, sigmav, corr, grisk
      Read (nin,*) m, n

      ldp = m
      Allocate (charm(ldp,n),delta(ldp,n),gamma(ldp,n),p(ldp,n),rho(ldp,n),    &
        speed(ldp,n),t(n),theta(ldp,n),vanna(ldp,n),vega(ldp,n),vomma(ldp,n),  &
        x(m),zomma(ldp,n),r(n),q(n),dp_dx(ldp,n),dp_dq(ldp,n),dp_deta(ldp,n),  &
        dp_dkappa(ldp,n),dp_dsigmav(ldp,n),dp_dcorr(ldp,n),dp_dgrisk(ldp,n))

      Read (nin,*)(x(i),i=1,m)
      Read (nin,*)(t(i),i=1,n)
      Read (nin,*)(r(i),i=1,n)
      Read (nin,*)(q(i),i=1,n)

      ifail = 0

      Call s30ndf(calput,m,n,x,s,t,sigmav,kappa,corr,var0,eta,grisk,r,q,p,ldp, &
        delta,gamma,vega,theta,rho,vanna,charm,speed,zomma,vomma,dp_dx,dp_dq,  &
        dp_deta,dp_dkappa,dp_dsigmav,dp_dcorr,dp_dgrisk,ifail)

      Write (nout,*)
      Write (nout,*) 'Heston''s Stochastic volatility Model'

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

      Write (nout,99997) '  Spot                   = ', s
      Write (nout,99997) '  Volatility of vol      = ', sigmav
      Write (nout,99997) '  Mean reversion         = ', kappa
      Write (nout,99997) '  Correlation            = ', corr
      Write (nout,99997) '  Variance               = ', var0
      Write (nout,99997) '  Mean of variance       = ', eta
      Write (nout,99997) '  Risk aversion          = ', grisk

      Write (nout,*)

      Do j = 1, n
        Write (nout,99999) t(j)

        Do i = 1, m
          Write (nout,*) '    Strike     Price      Rate       Dividend'
          Write (nout,99998) x(i), p(i,j), r(j), q(j)
          Write (nout,*) '    Delta      Gamma      Vega       Theta      Rho'
          Write (nout,99998) delta(i,j), gamma(i,j), vega(i,j), theta(i,j),    &
            rho(i,j)
          Write (nout,*)                                                       &
            '    Vanna      Charm      Speed      Zomma      Vomma'
          Write (nout,99998) vanna(i,j), charm(i,j), speed(i,j), zomma(i,j),   &
            vomma(i,j)
          Write (nout,*) '    dp_dx      dp_dq      dp_deta    ' //            &
            'dp_dkappa  dp_dsigmav dp_dcorr   dp_dgrisk'
          Write (nout,99998) dp_dx(i,j), dp_dq(i,j), dp_deta(i,j),             &
            dp_dkappa(i,j), dp_dsigmav(i,j), dp_dcorr(i,j), dp_dgrisk(i,j)
        End Do
      End Do

99999 Format (1X,'Time to Expiry : ',1X,F8.4)
99998 Format (1X,9(F10.4,1X))
99997 Format (A,1X,F10.4)
    End Program s30ndfe