c------------------------------------------------------------------------------
c                Constant Volatility American Call Binomial Model
c------------------------------------------------------------------------------
c     Routine name    - binomc 
c------------------------------------------------------------------------------
c     Purpose         - This subroutine calculates the value of an American 
c                       call with 1 dividend using the binomial numerical
c                       procedure of Cox and Ross, and escrowed dividends. 
c------------------------------------------------------------------------------
c     Arguments: 
c         sp --- initial stock price        sk --- exercise(striking) price
c         r  --- risk-free rate             t  --- time to maturity
c         v  --- initial volatility       tdiv --- time to dividend 
c         div --- dividend amount   reps --- number of discreted time steps
c         cval  --- call price (output)
c------------------------------------------------------------------------------
c     Required routines - None
c------------------------------------------------------------------------------
      subroutine binomc(sp,sk,r,t,v,tdiv,div,reps,cval)
      implicit none
      integer MAXSIZE
      real P
      parameter (MAXSIZE = 1000, P = 0.5)

      real sp,sk,r,t,v,tdiv,div,cval
      integer reps

      real r1,u,d,a1,a2,s0,escrow,xx,dt,tmp1,tmp2,pvdiv
      real c(MAXSIZE)
      integer i,j,n1,n2
      real EXP
      external EXP

c     ---  set formula parameters
      dt    = t/float(reps)
      r1    = (r + 1.0)**dt
      tmp1  = (r - 0.5*v*v)*dt
      tmp2  = v*SQRT(dt)
      u     = tmp1 + tmp2
      d     = tmp1 - tmp2
      n2    = INT(tdiv*365.0)
      pvdiv = div/(r1**(tdiv*float(reps)/t))
      s0    = LOG(sp - pvdiv)

c     ---  calculate binomial call value
      do 950 i = 0, reps
         
c     ---  calculate reduction in stock price due to dividends
         n1 = INT(FLOAT(reps-i)*t*365.0/FLOAT(reps))
         if (n1 .ge. n2) then
            escrow = 0.0
         else
            escrow = pvdiv*(r1**(reps-i))
         endif
         
c     ---  evaluate binomial call formula recursively
         do 900 j = 0, reps - i
            xx = FLOAT(j)*u + FLOAT(reps-i-j)*d + s0
            xx = AMIN1(xx,20.0)
            a1 = EXP(xx) + escrow - sk
            
            if (i .eq. 0) then 
               a2 = 0.0
            else
               a2 = (P*c(j+2) + (1.0-P) * c(j+1))/r1
            endif
            c(j+1) = AMAX1(a1,a2)
 900     continue
         
 950  continue

      cval = c(1)
   
      return
      end
