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