ccccccccc Last date of change: 4/10/92  "Compare Models"

      program finance     

c        implicit none
        PARAMETER (NREP0=200, NREPB=100,NREPN2=17, NREPP2=17)
        PARAMETER (INFILE0=1,INFILE1=2,INFILE2=3)
        PARAMETER (OUTFILE1=9,OUTFILE2=10)      
        PARAMETER (IOfile = 'file.io') 
                  
c      include 'models.h'
      real psi,rho
      real k,mcall1,mcall2,sz,rate1,rate2,rate,oldrate,div1,div2,div3
      integer mtime,flag,ifdiv1,ifdiv2,ifdiv3,reps1
      character*22 string1
      character*12 string2
      real t,mcall,tdiv1,szdiv
      real biasbscall,biaseur,biasamc,biasams
      real ceur,cams,camc,cbscall,xmu
      character*40 fname                                 
      real v(4)
      integer reps(4),ii,i
      logical strange
      real data1(5000), data2(5000), data3(5000), data4(5000)

CMPF  ONFE reps
CMPF  ONFE v,data1,data2,data3,data4          

      call init(psi,rho)
      reps(1) = 0
      reps(2) = NREPB
      reps(3) = NREPP2
      reps(4) = NREPP2
      xmu = 0.0 
      strange = .false.
      ii = 1

2000  continue

      read(INFILE1,'(A22,I3,F7.2,2(F7.2),F7.2,A12,I2,F6.2,
     & F8.4,3(I4,F8.4))',END=1000,ERR=999) string1,
     & mtime ,k,mcall1,mcall2,sz,string2,
     & flag,rate1,rate2,ifdiv1,div1,ifdiv2,div2,ifdiv3,div3

      if (mtime.eq.0) goto 2000
      
      if (rate2.eq.0.0) then
         rate2 = oldrate
      else
         oldrate = rate2
      endif     

      mcall = 0.5*(mcall1 + mcall2)
      t = float(mtime)/365.0
      tdiv1 = float(ifdiv1)/365.0
c      reps1 = INT(NREPP2*tdiv1/t) + 1

555   continue
      if ((ifdiv2.ne.0).or.(div2.ne.0.0).or.((k+mcall).le.sz)
     & .or. (strange.and.flag.ne.1)) then
c     & (div1.ne.0.and.(reps1.eq.1.or.reps1.eq.NREPP2))) then

           biasbscall = 0.0
           biaseur = 0.0
           biasamc = 0.0
           biasams = 0.0
           if (flag.eq.1) strange = .true.

      else
           rate = rate2/100.0
           t = float(mtime)/365.0
           tdiv1 = float(ifdiv1)/365.0
 
           if ((ifdiv1.eq.0.0).or.(div1.eq.0.0)) then
              szdiv = 0.0
              tdiv1 = t
           else 
              szdiv = div1/EXP(rate*tdiv1)
           endif
              
           if (flag.eq.1) then
              call implied_vol(sz,k,rate,t,mcall,
     &         tdiv1,div1,psi,xmu,rho,reps,v)
c              print *,v(1),v(2),v(3),v(4)
              if (v(1).le.0.0) then
                  mcall = -2000.0
                  goto 555
              endif
              strange = .false.
           endif
       
c ---  Black-Scholes Model

           call bscall(sz-szdiv,k,rate,t,v(1),cbscall)

c --- stochastic volatility European Model
c           call svcorp2(sz-szdiv,k,rate,t,v(3),psi,xmu,rho,REPP2,ceur)
           CALL SVCORP2(sz-szdiv,k,rate,t,v(3),psi,xmu,rho,17,ceur)

c --- constant volatility American Model
           CALL BINOMC(sz,k,rate,T,v(2),tdiv1,div1,NREPB,camc)

c --- stochastic volatility American Model
           if (szdiv.ne.0.0) then
            reps1 = INT(REPP2*tdiv1/t) + 1
            if (reps1.gt.REPP2) reps1 = REPP2
c           call asvcorp2(sz,k,rate,t,v(4),psi,
c     &          xmu,rho,reps1,REPP2,div1,cams)
           CALL asvcorp2(sz,k,rate,t,v(4),tdiv1,div1,
     &          psi,xmu,rho,17,cams)
         else
            cams = ceur
         endif

           biasbscall = cbscall - mcall
           biaseur = ceur - mcall
           biasamc = camc - mcall
           biasams = cams - mcall
 
           if (biasbscall.ne.0.0) then
             data1(ii) =  biasbscall
             data2(ii) = biasamc
             data3(ii) = biaseur 
             data4(ii) = biasams 
             ii = ii + 1
           endif

      endif

      write(OUTFILE1,'(A22,I3,F7.2,2(F7.2),F7.2,A12,I2,F6.2,
     & F8.4,3(I4,F8.4),4(1X,F9.4))',ERR=999) string1,mtime,k,
     & mcall1,mcall2,sz,string2,flag,rate1,rate2,ifdiv1,div1,
     & ifdiv2,div2,ifdiv3,div3,biasbscall,biasamc,biaseur,biasams

      goto 2000     

1000  close(INFILE1)
      close(OUTFILE1)
      read(INFILE0,55,ERR=998) fname
      open(UNIT=OUTFILE2,FILE=fname,STATUS='UNKNOWN',
     &     ACCESS='SEQUENTIAL',ERR=998)
      close(INFILE0) 
      
      WRITE(OUTFILE2,*) 'TitleText: Model comparisons',
     &  ' run on SUN4 workstation'
      WRITE(OUTFILE2,*) 'Ticks: false'
      WRITE(OUTFILE2,*) 'BoundBox: on'
      WRITE(OUTFILE2,*) 'YUnitText: Model Bias '
      WRITE(OUTFILE2,*) 'XUnitText: Record     '
c      WRITE(OUTFILE2,*) 'Markers: on'
c      WRITE(OUTFILE2,*) 'StyleMarkers: on'
      WRITE(OUTFILE2,*) 'NoLines: false'
      WRITE(OUTFILE2,*) 'Markers: on'
      WRITE(OUTFILE2,*) 
       ii = ii - 1
      WRITE(OUTFILE2,*) 
      WRITE(OUTFILE2,*) '"B-S Model'
      do 441 i=1,ii
       if (data1(i).ne.0.0)            
     &  write(OUTFILE2,'(I5,1X,F9.4)',ERR=998) i,data1(i)
441   continue

      WRITE(OUTFILE2,*) 
      WRITE(OUTFILE2,*) '"American Constant Model'
      do 442 i=1,ii
       if (data2(i).ne.0.0)         
     &  write(OUTFILE2,'(I5,1X,F9.4)',ERR=998) i,data2(i)
442   continue

      WRITE(OUTFILE2,*) 
      WRITE(OUTFILE2,*) '"European Stochastic Model'
      do 443 i=1, ii
      if (data3(i).ne.0.0)        
     &  write(OUTFILE2,'(I5,1X,F9.4)',ERR=998) i,data3(i)
443   continue

      WRITE(OUTFILE2,*) 
      WRITE(OUTFILE2,*) '"American Stochastic Model'
      do 444 i=1, ii
        write(OUTFILE2,'(I5,1X,F9.4)',ERR=998) i,data4(i)
444   continue

      close(OUTFILE2)

      stop 
       
999   print *, 'read or write file error!'
      goto 2000

998   stop 'open or read file error!'

55    format (A40)

      end
 

      SUBROUTINE init(psi,rho)
c      include 'models.h'
c        implicit none
        PARAMETER (REP0=200, REPB=100,REPN2=17, REPP2=17)
        PARAMETER (INFILE0=1,INFILE1=2,INFILE2=3)
        PARAMETER (OUTFILE1=9,OUTFILE2=10)      
        PARAMETER (IOfile = 'file.io') 
                  
      real psi,rho  
      character*40 fname1,fname2,fname3

      open(UNIT=INFILE0,FILE='file.io',STATUS='OLD',
     &     ACCESS='SEQUENTIAL',ERR=999)
      read(INFILE0,55,ERR=999) fname1
      read(INFILE0,55,ERR=999) fname2
      read(INFILE0,55,ERR=999) fname3

      open(UNIT=INFILE2,FILE=fname2,STATUS='OLD',
     &     ACCESS='SEQUENTIAL',ERR=999)
      read(INFILE2,FMT='(F9.6,F9.6)',ERR=999) psi,rho
      close(INFILE2)

      open(UNIT=INFILE1,FILE=fname1,STATUS='OLD',
     &     ACCESS='SEQUENTIAL',ERR=999)

      open(UNIT=OUTFILE1,FILE=fname3,STATUS='UNKNOWN',
     &     ACCESS='SEQUENTIAL',ERR=999)

      goto 6666

55    format (A40)
66    format (F9.6,F9.6)
     
     

999   stop 'Open or read file error!'

6666  return
       END      

                                     




