	PROGRAM American_node

        COMMON /XPRESS/ NOCARE, NORDER, NONODE, IHOST, IALNOD, IALPRC
        parameter (MAXSIZE = 524288)
c        parameter (MAXSIZE = 1048576)
c        implicit none
      
        real sl(MAXSIZE),vl(MAXSIZE),eexerval(MAXSIZE)
        real u,d,xval,ux,dx,sig,dt,divadj,tmp1,tmp2
        real sk, r, rx, div
        integer i,j,j1,reps,iexer
      
	INTEGER ENV(5)
	INTEGER STATUS
        real*4 data(9)
	INTEGER TYPE, dummy
	DATA TYPE/123/

C-- Start up EXPRESS. This MUST be the first EXPRESS system call used.

	CALL KXINIT

C-- Set up the communication profiler.
        CALL KCPON

C-- Read system parameters, number of nodes etc......

	STATUS = KXPARA(ENV)

 999    continue

c     --- read parameters from host
	STATUS = KXBROD(data, IHOST, 36, IALNOD, DUMMY, TYPE)
        u = data(1)
        d = data(2)
        r = data(3)
        dt = data(4)
        reps = INT(data(5))
        sk = data(6)
        iexer = INT(data(7))
        rx = data(8)
        div = data(9)

c     --- read initial stock and valatility values from host
        status = KXREAD(sl(1), 4, IHOST, type)
        status = KXREAD(vl(1), 4, IHOST, type)        

c     --- calculate binomial lattice
        do 3000 i = 1, reps 
           if (i.eq.iexer) then
              divadj = div
           else
              divadj = 0.0
           endif         
           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)
              if (divadj .gt. 0.0) then
                 xval = sl(j1) - sk
                 eexerval(j1) = AMAX1(xval,0.0)
              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                      
 2000      continue
 3000   continue                                

c     ---  calculate call values at expiration
      
      do 4000 i = 1, 2**reps
         xval = sl(i) - sk
         sl(i) = AMAX1(xval,0.0)
 4000 continue

c     --- sum final values in the binomial lattice
        do 6000 i = reps, 1, -1
           do 5000 j = 2, 2**i, 2
              j1 = j/2
              sl(j1) = (0.5*(sl(j) + sl(j-1)))/rx
              if (i .eq. iexer) sl(j1) = AMAX1(sl(j1),eexerval(j1))
 5000      continue
 6000   continue

c        call KXSYNC

c     --- send the lattice values to host
        status = KXWRIT(sl(1), 4, IHOST, type)

c     --- for communication profiler (ctool) 
        CALL KCPELT('exprof.prc')

        goto 999

        end




