      program main
   
      real a1,a2,xmu,rho              
      real s,k,r,t,v,vic(3),hedge                          
      real cl(4),clp,cl0,cln,biasp,bias0,biasn  
      real sz,kz,tz,cz                           
      real er(4),clb,bias,biasx                  
      real emax(4),emin(4),ser(4),varm(75,4),mean(4)  
      real sd(4),en,sz2,k2                               
      real ksh,ksl,vh,vl,cdvh(3),cdvl(3),cv0(3),kl,kh
      real clba,va,ksa,ka,ks               
      real pdvh(3),pdvl(3)                    
      real clbl,clbh,psi,none,pone,cor
      real early,earlyn,earlyp,sig,sign,sigp

      real vv(200),hh(200),ccl(200)
      
      integer reps,errst,nt,srep,rep0,repn,repp,reps1       
      integer repp2,repn2,bmethd,smethd,j1,j2,j3,j4               
                  real timediff,timearray(2)
                                                 
                                                       
c     bmethd=0 - forced recombination binomial (repp,repn)    
c     bmethd=1 - full binomial                 (repp2,pepn2)
c     smethd=0 - control variate simulation                     
c     smethd=1 - no control variates in simulation          
                                                         
c   set initial values                          


      bmethd=1
      smethd=0                                                   
      s=100.00                                                     
      sz=s-10.00                                                          
      sz2=s+10.00                                   
      sz = 110
      rep0=100
      repn=200
      repp=200                                                  
      repp2=19
      repn2=19                                                      
      srep=1024
      nt=90                                                   
      psi=1.0
      xmu=0.0                                                    

      rho=-1.0                                                     
      if (sz .lt. 106.0) rho = 0.6
      rho = -1.0
      none=-1.0                                                
      pone=1.0                                                        
      iflg=0                                                   
      k=100.00                                                   
      r=0.0                                                             
      t=.25                                                      
      v=0.15            
      div = 1.0
      tdiv = 0.125

cccc repeat for a range of values of stock price (sz)


  200 continue                                         

ccccc generate tables                  

      do 99999 sz=90., 110., 5.

ccc    print headers                      

      write(*,9050)                                
      write(*,9100)                                                         
      write(*,9120)                                                         
      write(*,9150) sz                                                      
      write(*,9160) k                                                       
      write(*,9180) r                                                       
      write(*,9200) t                                                       
      write(*,9220) v                                                       
      write(*,9225) psi                                                     
      write(*,9228) xmu                                                     
      write(*,9233) tdiv
      write(*,9277) div
      write(*,9229) rep0,repp,repn                 
      write(*,9235) repp2,repn2  
      write(*,9230) srep,nt    
      write(*,9320)             
      write(*,9340)    
      write(*,9360)     

          timediff = dtime(timearray)

      CALL SVCORP2(SZ,K,R,T,V,TDIV,DIV,PSI,XMU,-1.0,REPn2,CLn)

          timediff = dtime(timearray)
          write(6,40) timediff
      print *,'call value(-1)=',cln




          timediff = dtime(timearray)

      CALL SVCORP2(SZ,K,R,T,V,TDIV,DIV,PSI,XMU,1.0,REPP2,CLP)      
      print *,'call value(+1)=',clp
 
          timediff = dtime(timearray)
          write(6,40) timediff
40        format(//,'time took:',f6.3,'seconds'/)
 
99999 continue
      
 9050 format(1h /)
 9100 format(1h ,'American Call Option Pricing Errors by Correlation')
 9120 format(1h ,61(1h-))
 9140 format(1h ,'base values  : ')
 9150 format(1h ,19x,'Stock price       :  ',f7.3)
 9160 format(1h ,19x,'Striking price    :  ',f7.3)
 9180 format(1h ,19x,'Interest rate     :  ',f7.3)
 9200 format(1h ,19x,'Time to maturity  :  ',f7.3)
 9220 format(1h ,19x,'Volatility        :  ',f7.3)
 9225 format(1h ,19x,'Psi               :  ',f7.3)
 9227 format(1h ,19x,'Rho               :  ',f7.3)
 9228 format(1h ,19x,'Mu                :  ',f7.3)
 9229 format(1h ,19x,'rep0,repp,repn    :  ',3(i5,','))
 9230 format(1h ,19x,'Srep, nt          :  ',i5,',',i5)
 9235 format(1h ,19x,'repp2,repn2       :  ',2(i5,','))
 9233 format(1h ,19x,'time to dividend  :  ',f7.3)   
 9277 format(1h ,19x,'dividend amount   :  ',f7.3)   
 9234 format(1h ,19x,'simulation method :  ',i3)   
 9280 format(1h ,19x,'option value      :  ',f9.5/)
 9300 format(1h ///1h ,'         ',3x,'stoch vol',6x,' b-s  ',
     1       8x,'stoch vol')
 9320 format(1h ///1h ,'  rho',4x,'simulated',5x,'F-B',5x,
     1       'standard',4x,'% early')
 9340 format(1h ,11x,'price',6x,'price',6x,'error',5x,
     1 'exercise')
 9360 format(1h ,7(1h-),2x,4(9(1h-),2x)/)
 9380 format(1h ,1x,f5.2,2x,f9.5,2x,f9.5,2x,f8.6,2x,f9.2)
 9400 FORMAT(1H ,'Mean Error :',7X,F9.5,2X)   
 9420 FORMAT(1H ,'Std. Deviation :',3X,F9.5,2X)
 9440 FORMAT(1H ,'Minimum Error :',4X,F9.5,2X)
 9460 FORMAT(1H ,'Maximum Error :',4X,F9.5,2X)
 9480 FORMAT(1H ,19X,2(9(1H-),2X)/)


      stop
      end
ccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccccc

C
C
C       ROUTINE NAME       - SVCORP2
C
C----------------------------------------------------------------------
C
C       PURPOSE           - THIS SUBROUTINE CALCULATES THE VALUE OF A
C                           EUROPEAN CALL WITH STOCHASTIC VOLATILITY
C                           AND A CORRELATION OF 1 OR -1 WITH THE STOCK
C                           PRICE BY USING A BINOMIAL APPROX. TO THE
C                           LOGNORMAL VOLATILITY DISTRIBUTION.
C                           (FULL LATTICE)
C       REQUIRED ROUTINES - FACT, BSCALL
C
C----------------------------------------------------------------------
C
      SUBROUTINE SVCORP2(S,X,R,T,V,TDIV,DIV,PSI,XMU,COR,REPS,CVAL)
      REAL S,X,R,T,V0,TDIV,DIV,PSI,XMU,CVAL,V,U,D
      REAL RX,XVAL,COR,UX,DX,SIG,DT
      REAL SL(262500),VL(262500),EEXERVAL(262500)
      REAL TI,TITDIV,DIVADJ
      INTEGER REPS,J,I1,J1,I,IEXER,IR,JLAST
C
CCCC  NOTE: V AND VBAR ARE STD DEVIATIONS, V1 AND V2 ARE VARIANCES
C
      IEXER=0
C
CCCC  CHECK FOR REASONABLE PARAMETERS
C
      CVAL=0.0
      V0=V*V
      DT=T/FLOAT(REPS)
      U=EXP((XMU-0.5*(PSI**2.0))*(DT)+COR*PSI*SQRT(DT))
      D=EXP((XMU-0.5*(PSI**2.0))*(DT)-COR*PSI*SQRT(DT))
C
CCCC  SET RX (PERIODIC 1+RF) TO RISK FREE RATE + 1
C
      RX=(R+1.0)**(T/FLOAT(REPS))
C
CCCC  CREATE STOCK PRICE LATTICE (SL)
C
      VL(1)=V0
      SL(1)=S
      DO 3000 I=1,REPS
      TI=FLOAT(I)*DT
      TITDIV=TI-TDIV
      IF ((TI .GT. TDIV) .AND. (TDIV .LT. T) .AND. (TITDIV .LT. DT))
     1   THEN
          DIVADJ=DIV
      ELSE
          DIVADJ=0.0
      ENDIF
      J=2**I
 1000 J1=J/2
      SIG=VL(J1)
      UX=EXP((XMU-0.5*(SIG))*(DT)+SQRT(SIG)*SQRT(DT))
      DX=EXP((XMU-0.5*(SIG))*(DT)-SQRT(SIG)*SQRT(DT))
    
      IF (DIVADJ .GT. 0.0) THEN
       XVAL=SL(J1)-X
       EEXERVAL(J1)=AMAX1(XVAL,0.0)
       IEXER=I
      ENDIF

      SL(J)=SL(J1)*DX-DIVADJ
      SL(J-1)=SL(J1)*UX-DIVADJ
           VL(J)=VL(J1)*D
      VL(J-1)=VL(J1)*U  
      J=J-2
      IF (J .GT. 0) GOTO 1000
 3000 CONTINUE
C
CCCC  CALCULATE CALL VALUES AT EXPIRATION

      I1=2**REPS
      DO 4000 I=1,I1
      XVAL=SL(I)-X
      SL(I)=AMAX1(XVAL,0.0)
 4000 CONTINUE

CCCC  CALCULATE CALL PRICE RECURSIVELYC
      IR=REPS
      DO WHILE (IR .GT. 0)
      J=2
      JLAST=2**IR
      DO WHILE (J .LE. JLAST)
        J1=J/2
        SL(J1)=(.5*(SL(J)+SL(J-1)))/RX
        IF (IR .EQ. IEXER) THEN
          SL(J1)=AMAX1(SL(J1),EEXERVAL(J1))
        ENDIF
        J=J+2
      END DO
      IR=IR-1
      END DO
      CVAL=SL(1)
      RETURN
      END

 

 American Call Option Pricing Errors by Correlation
 -------------------------------------------------------------
                    Stock price       :   90.000
                    Striking price    :  100.000
                    Interest rate     :    0.000
                    Time to maturity  :    0.250
                    Volatility        :    0.150
                    Psi               :    1.000
                    Mu                :    0.000
                    time to dividend  :    0.125
                    dividend amount   :    1.000
                    rep0,repp,repn    :    100,  200,  200,
                    repp2,repn2       :     17,   17,
                    Srep, nt          :   1024,   90
 


   rho    simulated     F-B     standard    % early
            price      price      error     exercise
 -------  ---------  ---------  ---------  ---------

call value(-1)=    4.57664E-02


time took:13.760seconds

call value(+1)=   0.365107


time took:13.320seconds

 

 American Call Option Pricing Errors by Correlation
 -------------------------------------------------------------
                    Stock price       :   95.000
                    Striking price    :  100.000
                    Interest rate     :    0.000
                    Time to maturity  :    0.250
                    Volatility        :    0.150
                    Psi               :    1.000
                    Mu                :    0.000
                    time to dividend  :    0.125
                    dividend amount   :    1.000
                    rep0,repp,repn    :    100,  200,  200,
                    repp2,repn2       :     17,   17,
                    Srep, nt          :   1024,   90
 


   rho    simulated     F-B     standard    % early
            price      price      error     exercise
 -------  ---------  ---------  ---------  ---------

call value(-1)=   0.622219


time took:14.210seconds

call value(+1)=    1.06068


time took:14.340seconds

 

 American Call Option Pricing Errors by Correlation
 -------------------------------------------------------------
                    Stock price       :  100.000
                    Striking price    :  100.000
                    Interest rate     :    0.000
                    Time to maturity  :    0.250
                    Volatility        :    0.150
                    Psi               :    1.000
                    Mu                :    0.000
                    time to dividend  :    0.125
                    dividend amount   :    1.000
                    rep0,repp,repn    :    100,  200,  200,
                    repp2,repn2       :     17,   17,
                    Srep, nt          :   1024,   90
 


   rho    simulated     F-B     standard    % early
            price      price      error     exercise
 -------  ---------  ---------  ---------  ---------

call value(-1)=    2.57536


time took:14.670seconds

call value(+1)=    2.61425


time took:13.570seconds

 

 American Call Option Pricing Errors by Correlation
 -------------------------------------------------------------
                    Stock price       :  105.000
                    Striking price    :  100.000
                    Interest rate     :    0.000
                    Time to maturity  :    0.250
                    Volatility        :    0.150
                    Psi               :    1.000
                    Mu                :    0.000
                    time to dividend  :    0.125
                    dividend amount   :    1.000
                    rep0,repp,repn    :    100,  200,  200,
                    repp2,repn2       :     17,   17,
                    Srep, nt          :   1024,   90
 


   rho    simulated     F-B     standard    % early
            price      price      error     exercise
 -------  ---------  ---------  ---------  ---------

call value(-1)=    5.99116


time took:13.130seconds

call value(+1)=    5.66103


time took:13.690seconds

 

 American Call Option Pricing Errors by Correlation
 -------------------------------------------------------------
                    Stock price       :  110.000
                    Striking price    :  100.000
                    Interest rate     :    0.000
                    Time to maturity  :    0.250
                    Volatility        :    0.150
                    Psi               :    1.000
                    Mu                :    0.000
                    time to dividend  :    0.125
                    dividend amount   :    1.000
                    rep0,repp,repn    :    100,  200,  200,
                    repp2,repn2       :     17,   17,
                    Srep, nt          :   1024,   90
 


   rho    simulated     F-B     standard    % early
            price      price      error     exercise
 -------  ---------  ---------  ---------  ---------

call value(-1)=   10.31986


time took:13.280seconds

call value(+1)=   10.04130


time took:13.160seconds

