100 T1$="PROGRAM 'FUNTIME.BAS' COMPUTES RETARDATION OF TIME CAUSED BY " 110 T2$="PROXIMITY TO A MASSIVE OBJECT, AND ALSO SHOWS HOW THIS VARIES " 120 T3$="WITH INCREASING DENSITY AS THE OBJECT SHRINKS (THE MASS STAYS " 130 T4$="THE SAME). INVOKE BASIC WITH 'BASICA /D' FOR DOUBLE PRECISION," 140 T5$="OR SQR FUNCTIONS WILL FAIL. SCREEN 1 SHOWS DATA FOR A STATIC " 150 T6$="UNSHRINKING OBJECT. SCREEN 2+MORE SHRINKS THE OBJECTS RADIUS." 160 DEFDBL A-H: DEFDBL O-Z: REM DOUBLE PRECISION 170 DEF FNA(X)=INT(X*10+.5)/10: REM ROUND TO 1 DECIMAL PLACE 180 DEF FNB(X)=INT(X*100+.5)/100: REM ROUND TO 2 DECIMAL PLACES 190 DEF FNC(X)=INT(X*1000+.5)/1000: REM ROUND TO 3 DECIMAL PLACES 200 DEF FND(X)=INT(X*10000+.5)/10000: REM ROUND TO 4 DECIMAL PLACES 210 DEF FNE(X)=INT(X*100000!+.5)/100000!: REM ROUND TO 5 DECIMAL PLACES 220 DEF FNF(X)=INT(X*1000000!+.5)/1000000!: REM ROUND TO 6 DECIMAL PLACES 230 OPEN "FUNTIME.TXT" FOR OUTPUT AS #1: REM CREATE TEXT FILE TOO 240 PI=4#*ATN(1#): REM PI (3.141592653589793) 250 RCK=100000#: REM RATIO OF CM/KM 260 C=29979245800#: REM SPEED OF LIGHT, CM/SEC 270 G=.00000006668#: REM GRAVITATIONAL CONSTANT 280 SOL=1.991294255039313D+33: REM 1 SOLAR MASS IN GRAMS 290 NU=8: DIM U$(NU): REM UNITS OF MEASUREMENT 300 DATA "GM","CM","KM","SEC","KM/SEC","KM^3","M/SEC^2","GM/CM^3" 310 LX=0: FOR I=1 TO NU: READ U$(I): NEXT I 320 L=13: DIM SD(L): REM SCALE FOR SHRINKING 330 DATA .5,.9,.99,.999,.9999,.99999,.999999,.9999999,.99999999 340 DATA .999999999,.9999999999,.99999999999,.999999999999 350 FOR I=1 TO L: READ SD(I): NEXT I: REM READ SCALE FACTORS 360 NE=6: DIM OBJ$(NE),SM(NE),DD(NE),RR(NE): REM # OF OBJECTS TO EXAMINE 370 T7$ =" MEAN FINAL OR " 380 T8$ =" DENSITY STARTING " 390 T9$ =" # OBJECT SOLAR MASS (GM/CM^3) RADIUS(KM)" 400 T10$=" -- ------------------ ---------- --------- ----------" 410 F1$ =" ## & ##.###^^^^ ##.###^^^^ #######.##" 420 DATA " MOON ",3.691D-08, 3.34200, 1738.00 430 DATA " EARTH ",2.998D-06, 5.51079, 6371.22 440 DATA " SUN ",1.000D+00, 1.41000, 696000.00 450 DATA " SMALL NEUTRON STAR",1.400D+00, 7.1E+14, 9.78 460 DATA " LARGE NEUTRON STAR",3.000D+00, 7.1E+14, 12.61 470 DATA " SMALL BLACK HOLE ",4.000D+00, 8.5E+14, 13.07 480 FOR I=1 TO NE: READ OBJ$(I),SM(I),DD(I),RR(I): NEXT I 490 REM CONTINUE -------------- OUTPUT TO USER STARTS HERE -------------- 500 KEY OFF: CLS: LX=LX+1 510 IF LX=1 THEN PRINT T1$:PRINT T2$:PRINT T3$:PRINT T4$:PRINT T5$:PRINT T6$ 520 PRINT:PRINT T7$:PRINT T8$:PRINT T9$:PRINT T10$ 530 FOR I=1 TO NE: PRINT USING F1$;I;OBJ$(I);SM(I);DD(I);RR(I): NEXT I 540 REM CONTINUE 550 PRINT" . . . . . SELECT AN OBJECT 1 THRU";NE;:INPUT J 560 IF J<1 THEN PRINT"INVALID: TYPE A NUMBER FROM 1 THRU";NE: GOTO 540 570 IF J>NE THEN PRINT"INVALID: TYPE A NUMBER FROM 1 THRU";NE: GOTO 540 580 NAM$=OBJ$(J):S=SM(J):D=DD(J):R=RR(J)*RCK: REM USE NON-ARRAY VARIABLES 590 Y=S*SOL: REM CALCULATE MASS W/ SOLAR M 600 V=Y/D: REM CALCULATE VOLUME SAME WAY 610 R=(V/((4#/3#)*PI))^(1#/3#): REM RADIUS OF OBJECT, CM 620 RY=Y/SOL: REM RATIO (MASS/SOLAR MASS) 630 GA=(G*Y)/(R*R): REM GRAV. ACCEL. OF OBJECT 640 OV=SQR(G*(Y/R)): REM ORBITAL VELOCITY 650 EV=SQR(2#*(G*(Y/R))): REM ESCAPE VELOCITY 660 SR=((2#*G*Y)/(C*C))/RCK: REM SWARTSCHILD RADIUS, KM 670 TR=SQR(1#-(2#*((G*Y)/(R*(C*C))))): REM TIME RETARDATION, RATE 680 TRD=(1#-TR)*86400#: REM RETARD TOTAL, SEC/24 HRS 690 TRY=(1#-TR)*86400#*365.25: REM RETARD TOTAL, SEC/YEAR 700 RC3=FNA(RCK*RCK*RCK): REM VOLUME CONVERSION FACTOR 710 KV=INT(V/RC3): REM CONVERT VOLUME 720 IY=INT(Y): REM CONVERT MASS 730 PRINT"NAME OF OBJECT = ";NAM$ 740 PRINT"RADIUS OF OBJECT = ";FNB(R/RCK); U$(3) 750 PRINT"SWARTSCHILD RADIUS = ";FNC(SR); U$(3) 760 PRINT"SWARTSCHILD RADIUS = ";FNC(SR*RCK); U$(2) 770 PRINT"VOLUME OF OBJECT = ";INT(KV); U$(6) 780 PRINT"MEAN DENSITY OF OBJECT = ";FNB(D); U$(8) 790 PRINT"TOTAL MASS OF OBJECT = ";INT(IY); U$(1) 800 PRINT"SOLAR MASS OF OBJECT = ";RY 810 PRINT"GRAVITATIONAL ACCELERATION ON OBJECT = ";FNC(GA/100#); U$(7) 820 PRINT"ORBITAL VELOCITY AT OBJECT'S SURFACE = ";FNC(OV/RCK); U$(5) 830 PRINT"ESCAPE VELOCITY FROM OBJECT'S CENTER = ";FNC(EV/RCK); U$(5) 840 TF$="F": IF TR >.9999999999999998# THEN TF$="T": TG$=" ALMOST 1" 850 IF TF$="F" THEN PRINT"TIME RETARD. RATE ON OBJECT'S SURFACE = ";TR 860 IF TF$="T" THEN PRINT"TIME RETARD. RATE ON OBJECT'S SURFACE = ";TG$ 870 PRINT"TIME RETARD. TOTAL IN 24 HRS ON OBJECT = ";FNF(TRD); U$(4) 880 PRINT"TIME RETARD. TOTAL IN 1 YEAR ON OBJECT = ";FNF(TRY); U$(4) 890 GOSUB 1550: REM WRITE TO FUNTIME.TXT 900 IF TRD < (1#-.9999999999999998#) THEN GOSUB 940 910 INPUT". . . . . . . . . . . . . PRESS ENTER KEY TO CONTINUE";CR$ 920 GOSUB 1010: REM SHRINK OBJECT 930 GOTO 490: REM SELECT AN OBJECT 940 REM --- ROUTINE TO PRINT MESSAGE IF SQUARE ROOT FUNCTION FAILS 950 PRINT"----------------------------------------------------------" 960 PRINT"YOU MUST USE DOUBLE PRECISION SQUARE ROOT FUNCTIONS OR THE" 970 PRINT"PROGRAM CANNOT CALCULATE SQUARE ROOTS. THIS IS DONE IN 2 " 980 PRINT"STEPS. TYPE: BASICA /D, THEN IN BASIC TYPE: LOAD FUNTIME." 990 PRINT"----------------------------------------------------------" 1000 RETURN 1010 REM --- CALCULATE AND PRINT DATA FOR THE SHRINKING OBJECT 1020 RKM=2: REM USE KM BEFORE USING CM 1030 SS$="ENTER TO SHRINK OBJECT; 'S' TO CHANGE SCALE " 1040 H1$=" SHRINKING THE"+NAM$ 1050 H2$=" ----------------------------------------------------------- SECONDS " 1060 H3$=" RADIUS OF THE DENSITY: GRAVITATIONAL ACCELERATION: OF TIME " 1070 H4$=" OBJECT: (KM) (GM/CM^3) (KM/SEC^2) & (% SPEED LIGHT) LOST/SEC" 1080 H5$=" OBJECT: (CM) (GM/CM^3) (KM/SEC^2) & (% SPEED LIGHT) LOST/SEC" 1090 H6$=" --------------------------------------------------------------------" 1100 F9$="##.#######^^^^ ##.#########^^^^ ##.#########^^^^ ###.##### .########" 1110 M=1: REM SCALE FACTOR INDEX 1120 VCM=Y/D: REM ORIGINAL VOLUME, CM^3 1130 REM ------- PRINT INITIAL LINE OF DATA WITH NO SHRINKING. A SCALE FAC-" 1140 REM ------- TOR OF .5 MEANS SHRINK BY 50%, .9 MEANS SHRINK BY 10%; ETC." 1150 LP=0: LL=18: REM PAGE & LINE COUNTERS 1160 REM CONTINUE --------------- COME BACK HERE AFTER SHRINKING THE OBJECT 1170 IF LL<18 THEN GOTO 1230: REM PRINT HEADING IF REQ'D 1180 IF RKM>1# THEN PRINT H1$:PRINT H2$:PRINT H3$:PRINT H4$:PRINT H6$:LL=5 1190 IF RKM=1# THEN PRINT H1$:PRINT H2$:PRINT H3$:PRINT H4$:PRINT H6$:LL=5 1200 IF RKM<1# THEN PRINT H1$:PRINT H2$:PRINT H3$:PRINT H5$:PRINT H6$:LL=5 1210 IF LP=0 THEN PRINT USING F9$;(R/RCK);D;(GA/RCK);(100#*(1#-TR));(1#-TR) 1220 GOSUB 1780 1230 REM CONTINUE --------------- ABOVE LINE PRINTS ORIGINAL UNSHRUNK DATA 1240 LOCATE 25,4: PRINT SS$: REM USE NON-SCROLL AREA 1250 REM ------------------------ s OR S WILL SLOW DOWN SHRINKAGE RATE 1260 LOCATE 25,52: INPUT CR$: IF CR$="s" THEN CR$="S" 1270 IF CR$="S" THEN M=M+1: REM USE NEXT SMALLER FACTOR 1280 SF=SD(M): REM DEFINE SCALE FACTOR 1290 VCM=VCM*SF: REM NEW VOLUME AFTER SHRINKING 1300 RCM=(VCM/((4#/3#)*PI))^(1#/3#): REM NEW RADIUS OF OBJECT (CM) 1310 GAK=((G*Y)/(RCM*RCM))/RCK: REM NEW GRAV. ACCEL. (KM/SEC^2) 1320 TR=SQR(1#-(2#*((G*Y)/(RCM*(C*C))))): REM NEW TIME RETARDATION RATE 1330 PSL=100#*(1#-TR): REM NEW GRAV. ACCEL. (% OF LIGHT) 1340 TRD=(1#-TR): REM NEW TIME RETARD. (SEC/SEC) 1350 D=Y/VCM: REM NEW DENSITY (MASS=Y=SAME !!!) 1360 RKM=RCM/RCK: REM NEW RADIUS OF OBJECT (KM) 1370 IF RKM>1# THEN PRINT USING F9$;RKM;D;GAK;PSL;TRD: LL=LL+1: LP=LP+1 1380 IF RKM=1# THEN PRINT USING F9$;RKM;D;GAK;PSL;TRD: LL=LL+1: LP=LP+1 1390 IF RKM<1# THEN PRINT USING F9$;RCM;D;GAK;PSL;TRD: LL=LL+1: LP=LP+1 1400 GOSUB 1840: REM PRINT LINE TO FUNTIME.TXT 1410 ON ERROR GOTO 1430 1420 GOTO 1160 1430 RESUME 1440 1440 LOCATE 25,4: PRINT" " 1450 PRINT" /////////////////////////////////////////////////////////////////" 1460 PRINT" // THE ACCELERATION OF GRAVITY IS NOW = OR > THAN THE SPEED OF //" 1470 PRINT" // LIGHT TO WITHIN THE ARITHMETIC PRECISION OF THIS COMPUTER. //" 1480 PRINT" /////////////////////////////////////////////////////////////////" 1490 INPUT" ENTER TO RETURN TO THE MAIN MENU ";CR$ 1500 GOSUB 1890: REM WRITE MESSAGE TO FUNTIME.TXT 1510 GOTO 490 1520 SAVE"FUNTIME.BAS",A: REM SAVE TO HARD DRIVE AS ASCII; TYPE: RUN 1520 1530 SAVE"A:FUNTIME.BAS",A: REM SAVE TO 'A' DRIVE AS ASCII; TYPE: RUN 1530 1540 END 1550 REM SUBROUTINES TO PRINT OUTPUT DATA TO TEXT FILE 'FUNTIME.TXT' 1560 PRINT #1,"NAME OF OBJECT = ";NAM$ 1570 PRINT #1,"RADIUS OF OBJECT = ";FNB(R/RCK); U$(3) 1580 PRINT #1,"SWARTSCHILD RADIUS = ";FNC(SR); U$(3) 1590 PRINT #1,"SWARTSCHILD RADIUS = ";FNC(SR*RCK); U$(2) 1600 PRINT #1,"VOLUME OF OBJECT = ";INT(KV); U$(6) 1610 PRINT #1,"MEAN DENSITY OF OBJECT = ";FNB(D); U$(8) 1620 PRINT #1,"TOTAL MASS OF OBJECT = ";INT(IY); U$(1) 1630 PRINT #1,"SOLAR MASS OF OBJECT = ";RY 1640 PRINT #1,"GRAVITATIONAL ACCELERATION ON OBJECT = ";FNC(GA/100#); U$(7) 1650 PRINT #1,"ORBITAL VELOCITY AT OBJECT'S SURFACE = ";FNC(OV/RCK); U$(5) 1660 PRINT #1,"ESCAPE VELOCITY FROM OBJECT'S CENTER = ";FNC(EV/RCK); U$(5) 1670 IF TF$="F" THEN PRINT #1,"TIME RETARD. RATE ON OBJECT'S SURFACE = ";TR 1680 IF TF$="T" THEN PRINT #1,"TIME RETARD. RATE ON OBJECT'S SURFACE = ";TG$ 1690 PRINT #1,"TIME RETARD. TOTAL IN 24 HRS ON OBJECT = ";FNF(TRD); U$(4) 1700 PRINT #1,"TIME RETARD. TOTAL IN 1 YEAR ON OBJECT = ";FNF(TRY); U$(4) 1710 IF TRD > (1#-.9999999999999998#) THEN RETURN 1720 PRINT #1,"----------------------------------------------------------" 1730 PRINT #1,"YOU MUST USE DOUBLE PRECISION SQUARE ROOT FUNCTIONS OR THE" 1740 PRINT #1,"PROGRAM CANNOT CALCULATE SQUARE ROOTS. THIS IS DONE IN 2 " 1750 PRINT #1,"STEPS. TYPE: BASICA /D, THEN IN BASIC TYPE: LOAD FUNTIME." 1760 PRINT #1,"----------------------------------------------------------" 1770 RETURN 1780 REM MORE PRINTING TO UNIT #1 1790 IF RKM>1# THEN PRINT#1,H1$:PRINT#1,H2$:PRINT#1,H3$:PRINT#1,H4$:PRINT#1,H6$ 1800 IF RKM=1# THEN PRINT#1,H1$:PRINT#1,H2$:PRINT#1,H3$:PRINT#1,H4$:PRINT#1,H6$ 1810 IF RKM<1# THEN PRINT#1,H1$:PRINT#1,H2$:PRINT#1,H3$:PRINT#1,H5$:PRINT#1,H6$ 1820 IF LP=0 THEN PRINT #1,USING F9$;(R/RCK);D;(GA/RCK);(100#*(1#-TR));(1#-TR) 1830 RETURN 1840 REM MORE PRINTING TO UNIT #1 1850 IF RKM>1# THEN PRINT #1,USING F9$;RKM;D;GAK;PSL;TRD 1860 IF RKM=1# THEN PRINT #1,USING F9$;RKM;D;GAK;PSL;TRD 1870 IF RKM<1# THEN PRINT #1,USING F9$;RCM;D;GAK;PSL;TRD 1880 RETURN 1890 REM MORE PRINTING TO UNIT #1 1900 PRINT #1,"///////////////////////////////////////////////////////////////" 1910 PRINT #1,"/ THE ACCELERATION OF GRAVITY IS NOW = OR > THAN THE SPEED OF /" 1920 PRINT #1,"/ LIGHT TO WITHIN THE ARITHMETIC PRECISION OF THIS COMPUTER. /" 1930 PRINT #1,"///////////////////////////////////////////////////////////////" 1940 PRINT #1," " 1950 RETURN