c ------------------------------------------------------------------------
c Model parameters:  meaning (name = typical value)
c
c     initial stock price (sp = 90)    
c     exercise (striking) price (sk = 100)   
c     risk-free rate (r = 0.15)   
c     time to maturity (t = 0.25)   
c     time to dividend (early exercise) (tdiv = 0.125)
c     initial volatility (v = estimated)    
c     variance of stock volatility (psi = estimated)
c     correlation between stock price and its volatility (cor = estimated)
c     drift of the variance (xmu = 0)
c     dividend amount (div = 1.1)
c     number of discreted time steps (reps = 17)
c
c ************************************************************************

c----------------------------------------------------------------------------
c             Stochastic Volatility European Call Binomial Model
c----------------------------------------------------------------------------
c       Routine name       - svcorp2 
c----------------------------------------------------------------------------
c       Purpose           - This subroutine calculates the value of a          
c                           european call with stochastic volatility     
c                           and a correlation with the stock price by  
c                           using a binomial approx. to the lognormal   
c                           volatility distribution. (full lattice)       
c---------------------------------------------------------------------------- 
c       Arguments: 
c         sp --- initia stock price    sk --- exercise (striking) price
c         r  --- risk-free rate        t  --- time to maturity
c         v  --- initial volatility    psi --- variance of stock volatility
c         cor --- correlation between stock price(sp) and its volatility(v)
c         xmu --- drift of the variance  
c         reps --- number of discreted time steps
c         cval  --- call price (output)
c----------------------------------------------------------------------------
c       Required routines - None
c----------------------------------------------------------------------------
      subroutine svcorp2(sp,sk,r,t,v,psi,xmu,cor,reps,cval)                    
      real sp,sk,r,t,v,psi,xmu,cor,cval
      integer reps

      parameter (MAXSIZE = 524288)
      implicit none
   
      real sl(MAXSIZE),vl(MAXSIZE)
      real u,d,rx,xval,ux,dx,sig,dt,tmp1,tmp2
      integer i,j,j1

c     ---  initilize parameters
      dt   = t/float(reps)
      tmp1 = (xmu-0.5*(psi*psi))*dt
      tmp2 = cor*psi*SQRT(dt)
      u    = exp(tmp1 + tmp2)
      d    = exp(tmp1 - tmp2)
                                                                           
c     ---  create stock price lattice (sl)     
      vl(1) = v * v                           
      sl(1) = sp             
      do 3000 i = 1, reps                 
         do 2000 j = 2**i,1,-2                  
            j1 = j/2                             
            sig = vl(j1)  
            tmp1 = (r-0.5*sig)*dt
            tmp2 = SQRT(sig*dt)
            ux = EXP(tmp1 + tmp2)
            dx = EXP(tmp1 - tmp2)

            sl(j)   = sl(j1)*dx             
            sl(j-1) = sl(j1)*ux            
            vl(j)   = vl(j1)*d                       
            vl(j-1) = vl(j1)*u                      
 2000    continue
 3000 continue                                                               
   
c     ---  set rx (periodic 1+rf) to risk free rate + 1   
      rx = (r + 1.0)**(t/float(reps))   

c     ---  calculate call price                            
      tmp1 = rx**FLOAT(reps)
      do 4000 i = 1, 2**reps
         xval = sl(i) - sk
         if (xval .gt. 0.0) cval = cval + xval/tmp1
 4000 continue
      
      cval = cval/float(2**reps)
      
      return                                                                    
      end    
