      PROGRAM ASVCORP2
      PARAMETER (nproc0 = 2)
      REAL s, x, r, t, v, psi, xmu, cor, div, call
      INTEGER reps, reps1
      REAL ss1 (4096, 31), vv1 (8192, 31)
      REAL cearly_big (4096, 31)
      REAL aatmp1 (4096), aatmp2 (4096), uux (4096), ddx (4096)
      REAL cearly (4096), cback (4096)
      REAL u, d, dt, r1, tmp1, tmp2, rx, xreps
      INTEGER i, n, nreps1, start, end, repsdiv, reps2, nreps2, j
C     DECOMPOSITION dd (100)
C     DISTRIBUTE dd (BLOCK)
C     ALIGN ss1 (i, :) WITH dd (i)
C     ALIGN vv11 (i, :) WITH dd (i)
C     ALIGN cearly_big (i, :) WITH dd (i)
C     ALIGN uux (i) WITH dd (i)
C     ALIGN ddx (i) WITH dd (i)
C     ALIGN aatmp1 (i) WITH dd (i)
C     ALIGN aatmp2 (i) WITH dd (i)
C     ALIGN cearly (i) WITH dd (i)
C     ALIGN cback (i) WITH dd (i)
      INTEGER Ti1
      INTEGER Tllb1
      INTEGER Tlub1
      INTEGER minLoc1, maxLoc1, minLoc2, maxLoc2, coord(3)
      COMMON /g_to_l/minLoc1, maxLoc1, minLoc2, maxLoc2, coord
      INTEGER proclist(8)
      INTEGER TT0temp
      CALL EXP_init_1 (2, 4096)
      proclist(1)=-1
      s = 100.0
      x = 110.
      r = 2.5
      t = 0.25
      v = 0.9
      rsi = 0.7
      xmu = 0.0
      cor = 0.8
      reps1 = 13
      reps = 17
      xreps = float (reps)
      dt = t / xreps
      rx = (r + 1.0) ** dt
      tmp1 = (xmu - 0.5 * psi * psi) * dt
      tmp2 = cor * psi * sqrt (dt)
      u = exp (tmp1 + tmp2)
      d = exp (tmp1 - tmp2)
      TT0temp = 1
      DO Ti1 = 1, 8192
      vv1 (Ti1, 1) = 0.0
      END DO
      TT0temp = 1
      DO Ti1 = 1, 4096
      ss1 (Ti1, 1) = 0.0
      END DO
      vv1 (1, 1) = v * v
      ss1 (1, 1) = s
      n = 1
      DO 7000 i = 1, 13
      TT0temp = 1
      DO Ti1 = 1, 4096
      aatmp1 (Ti1) = (r - 0.5 * vv1 (Ti1, 1)) * dt
      END DO
      TT0temp = 1
      DO Ti1 = 1, 4096
      aatmp2 (Ti1) = sqrt (vv1 (1 + Ti1, 1) * dt)
      END DO
      TT0temp = 1
      DO Ti1 = 1, 4096
      uux (Ti1) = exp (aatmp1 (1 + Ti1) + aatmp2 (1 + Ti1))
      END DO
      TT0temp = 1
      DO Ti1 = 1, 4096
      ddx (Ti1) = exp (aatmp1 (1 + Ti1) - aatmp2 (1 + Ti1))
      END DO
      TT0temp = 1
      DO Ti1 = 1, 8192
      vv1 (Ti1, 1) = u * vv1 (Ti1, 1)
      END DO
      TT0temp = 1
      DO Ti1 = 1, 4096
      ss1 (Ti1, 1) = uux (Ti1) * ss1 (Ti1, 1)
      END DO
      IF (i .EQ. reps1) THEN
      TT0temp = 1
      DO Ti1 = 1, 4096
      cearly (Ti1) = ss1 (Ti1, 1) - x
      END DO
      CALL adjust_local_bounds (1, 2 ** i, Tllb1, Tlub1, 1, 4096)
      TT0temp = 1
      DO Ti1 = Tllb1, Tlub1
      ss1 (Ti1, 1) = ss1 (Ti1, 1) - div
      END DO
      END IF
      n = 2 * n
7000  CONTINUE
      IF (reps .GT. 13) THEN
      reps2 = reps - 13
      nreps1 = 2 ** (reps2 + 1) - 1
      repsdiv = reps1 - 14
      start = 2 ** repsdiv
      end = 2 * start - 1
      DO 7002 i = 1, nreps1 / 2
      TT0temp = 1
      DO Ti1 = 1, 4096
      aatmp1 (Ti1) = (r - 0.5 * vv1 (Ti1, i)) * dt
      END DO
      TT0temp = 1
      DO Ti1 = 1, 4096
      aatmp2 (Ti1) = sqrt (vv1 (1 + Ti1, i) * dt)
      END DO
      TT0temp = 1
      DO Ti1 = 1, 4096
      uux (Ti1) = exp (aatmp1 (1 + Ti1) + aatmp2 (1 + Ti1))
      END DO
      TT0temp = 1
      DO Ti1 = 1, 4096
      ddx (Ti1) = exp (aatmp1 (1 + Ti1) - aatmp2 (1 + Ti1))
      END DO
      TT0temp = 1
      DO Ti1 = 1, 8192
      vv1 (Ti1, 2 * i) = u * vv1 (Ti1, i)
      END DO
      TT0temp = 1
      DO Ti1 = 1, 8192
      vv1 (Ti1, (2 * i + 1)) = d * vv1 (Ti1, i)
      END DO
      IF (i .GE. start .AND. i .LE. end) THEN
      TT0temp = 1
      DO Ti1 = 1, 4096
      aatmp1 (Ti1) = uux (Ti1) * ss1 (Ti1, i)
      END DO
      TT0temp = 1
      DO Ti1 = 1, 4096
      aatmp2 (Ti1) = ddx (Ti1) * ss1 (Ti1, i)
      END DO
      TT0temp = 1
      DO Ti1 = 1, 4096
      cearly_big (Ti1, 2 * (i - start) + 1) = aatmp1 (Ti1) - x
      END DO
      TT0temp = 1
      DO Ti1 = 1, 4096
      cearly_big (Ti1, 2 * (i - start + 1)) = aatmp2 (Ti1) - x
      END DO
      TT0temp = 1
      DO Ti1 = 1, 4096
      ss1 (Ti1, 2 * i) = aatmp1 (Ti1) - div
      END DO
      ELSE
      TT0temp = 1
      DO Ti1 = 1, 4096
      ss1 (Ti1, 2 * i) = uux (Ti1) * ss1 (Ti1, i)
      END DO
      END IF
      TT0temp = 1
      DO Ti1 = 1, 4096
      ss1 (Ti1, i) = 0.0
      END DO
7002  CONTINUE
      END IF
      END
