Program: Mmx.bas

Implementation Select: Implementation
Operation Select: Program: MMX.BAS

  DEFINT I-K
  DEFDBL A-H, O-Z
'                       MMX.BAS
'       Revision 1.0    Original                         22 DEC 2000
  SCREEN 12
  DIM SHARED array%(170, 170)
  isize = 170
  pi = 4 * ATN(1)
  vmax = 0
  xoffset = 1
  itypeold = 0
  LOCATE 1, 20: PRINT "MICHELSON and MORLEY'S EXPERIMENT"

astr:
  COLOR 15
  INPUT "Type -7 to -1, 1 to 7 "; itype
  IF itype > 0 THEN
    tdilution = 0
    IF lcontract = 0 OR itype <> itypeold THEN
      lcontract = 1
    ELSE
      lcontract = 0
    END IF
    itypeold = itype
  ELSE
    tdilution = 1
    IF lcontract = 1 OR itype <> itypeold THEN
      lcontract = 0
    ELSE
      lcontract = 1
    END IF
    itypeold = itype
    itype = -itype
  END IF
  vmax = 0
  CLS
  COLOR 7
  LOCATE 1, 20: PRINT "MICHELSON and MORLEY'S EXPERIMENT";
  COLOR 15
  LOCATE 1, 55:
  PRINT "LENGTH CONTRACTION ";
  IF lcontract = 1 THEN PRINT "ON" ELSE PRINT "OFF"
  LOCATE 2, 55:
  PRINT "TIME DILUTION ";
  IF tdilution = 1 THEN PRINT "ON" ELSE PRINT "OFF"
  SELECT CASE itype
  CASE IS = 1
    cyclecount = 10
    c = 100
    v = 0:
    dspiegel = 100
    dispf = 5
    labda = 4
    xoffset = 1
  CASE IS = 2
    cyclecount = 10
    c = 100
    v = 15:
    dspiegel = 100
    dispf = 5
    labda = 4
    xoffset = 1
  CASE IS = 3
    cyclecount = 10
    c = 100
    v = 15:
    dspiegel = 100
    dispf = 5
    labda = 4
    xoffset = 0
  CASE IS = 4
    c = 30000000000#       '300000 km   300000 00000 cm/sec
    v = 6000000            '60 km = 60 000000 cm/sec
    dspiegel = 1100
    dispf = 800000
    labda = .000059#     ' cm
    cyclecount = 20
    xoffset = 1
  CASE IS = 5
    c = 30000000000#       '300000 km   300000 00000 cm/sec
    v = 6000000            '60 km = 60 000000 cm/sec
    vmax = v
    dspiegel = 1100
    dispf = 800000
    labda = .000059#     ' cm
    cyclecount = 10
    xoffset = 1
  CASE IS = 6
    c = 30000000000#       '300000 km   300000 00000 cm/sec
    v = 60 * 100000        '60 km = 60 000000 cm/sec
    vmax = v
    dspiegel = 1100
    dispf = 200
    labda = .000059#     ' cm
    labda = labda * 1000
    cyclecount = 5
    xoffset = 0
  CASE IS = 7
    c = 30000000000#       '300000 km   300000 00000 cm/sec
    v = 2000000000#         '60 km = 60 000000 cm/sec
    dspiegel = 1100
    dispf = 400 / dspiegel
    labda = .000059#     ' cm
    cyclecount = 10
    xoffset = 1
    IF itype = 7 THEN GOTO MMX100
  CASE ELSE
    END
  END SELECT
 
  x = 60 / (dspiegel * dispf)
  alpha1 = ATN(x) * 180 / pi
  dt = labda / c
 
  xbase = 300: ybase = 280
 
  COLOR 14
  x0 = xbase + x
  y0 = ybase - y
    
  dalpha = alpha1 / 150
  dt = labda / c
  l = 3 * dspiegel * SIN(alpha1 * pi / 180)
  dtbase = l / c
 
  LOCATE 4, 60
  IF vmax = 0 THEN
     ivmax = 0
     PRINT SPACE$(10)
  ELSE
     ivmax = 6
     COLOR 7: PRINT "Movie"
  END IF
 
  ' Start simulation as a function of speed
 
  FOR iv = 0 TO ivmax
    COLOR 15
    LOCATE 2, 1
    IF vmax <> 0 THEN v = iv * vmax / 6
    Beta = v / c
    COLOR 7: PRINT "labda "; labda; "  "
    COLOR 15: LOCATE 2, 16: PRINT USING "Beta #.########"; Beta
    LOCATE 3, 60: PRINT "type "; itype
    COLOR 7: LOCATE 3, 1: PRINT "c "; c / 100000;
    COLOR 15: LOCATE 3, 16: PRINT "v "; v / 100000; "km/sec"
    IF vmax <> 0 THEN
      LOCATE 4, 60
      COLOR 7: PRINT "Movie frame "; iv + 1
    END IF
    l100 = 0
    dspiegelx = dspiegel
    dspiegely = dspiegel

    IF xoffset = 0 THEN l100 = v * dispf * 2 * dspiegel / c
    '  hoek1 = ATN(x/y)
    hoek1 = ATN((v * dspiegelx / c) / dspiegely)
    hoek1 = 180 * hoek1 / pi
     
    ' dspiegel + v * tv = c * tv
    ' v * tw + c * tw = dspiegel
    dspiegelxx = dspiegelx
    IF lcontract = 1 THEN dspiegelxx = dspiegelx * SQR(1 - v * v / (c * c))
    tv = dspiegelxx / (c - v)
    tw = dspiegelxx / (c + v)
    tvw = tv + tw
   
    t1 = (2 * dspiegelx / c) * (1 / SQR(1 - v * v / (c * c)))
    t2 = dspiegelx / (c - v) + dspiegelx / (c + v)
    COLOR 7
    LOCATE 29, 70: PRINT USING "#.####"; c * (t2 - t1) / labda;
   
    ' Perform simulation for different phases

    FOR count = 0 TO cyclecount - 1
      COLOR 7
      tbase = 2 * dspiegely / c
      tstr0 = tbase - dtbase: tend0 = tbase + dtbase
      tstr = tstr0 + count * dt / cyclecount
      tend = tend0 + count * dt / cyclecount

      ' Vertical ray - Horizontal mirror

      FOR alpha = 90 - hoek1 - alpha1 TO 90 - hoek1 + alpha1 STEP dalpha
        FOR t = tstr TO tend STEP dt
          r = c * t
          a = (alpha / 360) * 2 * pi
          x = r * COS(a): y = r * SIN(a)
          delta = dspiegely - y                     ' mirror y
          IF delta < 0 THEN y = dspiegely + delta
          IF xoffset = 1 THEN x = x - v * t
          x = x * dispf
          y = y * dispf
          ix = x - l100 + isize / 2
          iy = y + isize / 2
          IF ix >= 0 AND ix <= isize AND iy >= 0 AND iy <= isize THEN
            IF array%(ix, iy) = 0 THEN array%(ix, iy) = 7
          END IF
          xdisp = xbase + x
          ydisp = ybase - y
          IF ABS(t - t1) < .5 * dt / cyclecount THEN
            COLOR 15
            IF ix >= 0 AND ix <= isize AND iy >= 0 AND iy <= isize THEN
              array%(ix, iy) = 15
            END IF
          ELSE
            COLOR 7
          END IF
          IF iv = 0 THEN PSET (xdisp, ydisp)
        NEXT t
      NEXT alpha
    
      ' Horizontal ray - Verical mirror

      tbase = 2 * dspiegelx / c
      tstr0 = tbase - dtbase: tend0 = tbase + dtbase
      tstr = tstr0 + count * dt / cyclecount
      tend = tend0 + count * dt / cyclecount
 
      FOR alpha = -alpha1 TO alpha1 STEP dalpha
        FOR t = tstr TO tend STEP dt
          t0 = t
          IF tdilution = 1 THEN t0 = t / SQR(1 - v * v / (c * c))
          r = c * t0
          a = (alpha / 360) * 2 * pi
          x = r * COS(a): y = r * SIN(a)
          d0 = dspiegelxx
          c1al = y / x
          Betax = 1 + c1al
          aa = c * c - Betax * v * v
          B = -2 * Betax * d0 * v
          cc = -Betax * d0 * d0
          w = SQR(B * B - 4 * aa * cc)
          tv1 = (-B + w) / (2 * aa)
          ' tv2 = (-B - w) / (2 * aa)
          dspiegel1 = d0 + v * tv1
          ' dspiegel2 = d0 + v * tv2
          delta = dspiegel1 - x
          IF delta < 0 THEN x = dspiegel1 + delta
          IF xoffset = 1 THEN x = x - v * t0           ' From current origin
          x = x * dispf
          y = y * dispf
          ix = x - l100 + isize / 2
          iy = y + isize / 2
          IF ix >= 0 AND ix <= isize AND iy >= 0 AND iy <= isize THEN
            IF array%(ix, iy) = 7 THEN array%(ix, iy) = 15
          END IF
          xdisp = xbase + x
          ydisp = ybase - y
          IF ABS(t - t1) < .5 * dt / cyclecount THEN
            COLOR 15
            IF ix >= 0 AND ix <= isize AND iy >= 0 AND iy <= isize THEN
              array%(ix, iy) = 15
            END IF
          ELSE
            COLOR 7
          END IF
          IF iv = 0 THEN PSET (xdisp, ydisp)
        NEXT t
      NEXT alpha
     
      ' Clear interference pattern for all gray points
     
      FOR ix = 0 TO isize
        FOR iy = 0 TO isize
          IF array%(ix, iy) <> 15 THEN array%(ix, iy) = 0
        NEXT iy
      NEXT ix
 
      COLOR 4
      x0 = xbase
      IF xoffset = 0 THEN x0 = xbase + v * dispf * 2 * dspiegel / c
      y0 = ybase
      PSET (x0, y0)
  
    NEXT count

    ' Display interference pattern
   
    FOR ix = 0 TO isize
      FOR iy = 0 TO isize
        x = ix - isize / 2
        y = iy - isize / 2
        xdisp = xbase + x
        ydisp = ybase - y
        IF itype = 6 AND iv > 0 AND ix = 0 AND iy = 0 THEN
          LINE (xdisp - 15 + l100, ydisp)-(xdisp + l100, ybase + y), 0, BF
        END IF
        IF array%(ix, iy) = 15 THEN
          COLOR 15   ' array%(ix, iy)
        ELSE
          COLOR 0
        END IF
        PSET (xdisp + l100, ydisp)
        array%(ix, iy) = 0
      NEXT iy
    NEXT ix
 
    COLOR 4
    x0 = xbase
      IF xoffset = 0 THEN x0 = xbase + v * dispf * 2 * dspiegel / c
    y0 = ybase
    PSET (x0, y0)

  NEXT iv
 
  IF vmax > 0 THEN
    LOCATE 4, 60
    COLOR 15
    COLOR 7: PRINT "Movie end"; SPACE$(5)
  END IF
  LOCATE 4, 1
  GOTO astr

MMX100:
  xbase = 150: ybase = 450
      dspiegelx = dspiegel
      dspiegely = dspiegel
      tref = dspiegel / c
      dspiegelxx = dspiegelx
      IF lcontract = 1 THEN dspiegelxx = dspiegelx * SQR(1 - v * v / (c * c))
      tv = dspiegelxx / (c - v)
      tw = dspiegelxx / (c + v)
      tvw = tv + tw
   
    hoek1 = ATN((v * dspiegelx / c) / dspiegely)
    hoek1 = 180 * hoek1 / pi
 
  FOR it = 0 TO 120
    t = tvw * it / 120
    FOR alpha = 0 TO 90 STEP 1
          r = c * t
          a = (alpha / 360) * 2 * pi
          x = dspiegel * COS(a): y = dspiegel * SIN(a)
          x1 = x + tref * v
          'PRINT x, x1, y: END
          IF x1 > 0 THEN
            phi = ATN(y / x1)
          ELSE
            phi = 0
          END IF
          y1 = y
          d1 = SQR(x1 * x1 + y1 * y1)
          IF r <= d1 THEN
            x2 = r * COS(phi)
            y2 = r * SIN(phi)
            COLOR 7
          ELSE
            delta = r - d1
            x1 = x - tref * v
            'PRINT x, x1, y: END
            IF x1 = 0 THEN
              phi = pi / 2
            ELSE
              phi = ATN(y / x1)
              IF x1 > 0 THEN
                phi = phi
              ELSE
                phi = pi + phi
              END IF
            END IF
            y1 = y
            d1 = SQR(x1 * x1 + y1 * y1)
            d1 = d1 - delta
            x2 = 2 * tref * v + d1 * COS(phi)
            y2 = d1 * SIN(phi)
            COLOR 14
          END IF
          ' x2 = x2 - v * t
          x2 = x2 * dispf
          y2 = y2 * dispf
          xdisp = xbase + x2
          ydisp = ybase - y2
          PSET (xdisp, ydisp)
    NEXT alpha
  NEXT it
  GOTO astr


Back to my home page: Contents of This Document