1 REM Ins{nd av Nils Hammar <4341>    1988-08-13 13.47.23 (SEND)
10 ; CHR$(12) : EXTEND : DOUBLE 
20 DIM Sc$(12),M(12),C$(12),S$(36),Ls(36),Ss$(36),Sm(36),Mp(15),R(15)
30 RESTORE 
40 FOR I%=1% TO 12%
50   READ Sc$(I%),M(I%),C$(I%)
60 NEXT I% 
70 FOR I%=1% TO 17%
80   READ S$(I%),Ss$(I%),Sm(I%)
90   Ls(I%)=Sm(I%)^3.5
100 NEXT I% 
110 FOR I%=18% TO 36%
120   READ S$(I%),Ss$(I%),Ls(I%)
130   Sm(I%)=Ls(I%)^(1%/3.5)
140 NEXT I% 
150 DATA W,500,Ljusbl}
160 DATA O,100,Bl},B,17,Gr|nbl},A,3.2,Vit,F,1.54,Gulvit
170 DATA G,1.02,Gul,K,.75,Orange,M,.38,Oranger|d,D,.1,R|d
180 DATA R,.75,Orange,N,.38,Oranger|d,S,.38,Oranger|d
190 DATA SOLEN,G2,1,"ALPHA CENTAURI A",G4,1.08,"ALPHA CENTAURI B",K1,.88
200 DATA "EPSILON ERIDIANI",K2,.8,"TAU CETI",G8,.82,"70 OPHIUCHI A",K1,.9
210 DATA "70 OPHIUCHI B",K5,.65,"ETA CASSIOPEIA A",F9,.94,"ETA CASSIOPEIA B",K6,.58
220 DATA "SIGMA DRACONIS",G9,.82,"36 OPHIUCHI A",K2,.77,"36 OPHIUCHI B",K1,.76
230 DATA "HR 7703",K2,.76,"DELTA PAVONIS",G7,.98,"82 ERIDIANI",G5,.91
240 DATA "BETA HYDRI",G1,1.23,"HR 8832",K3,.74
250 DATA "SIRIUS",A1,23,CANOPUS,F0,130,VEGA,A0,52,ARCTURUS,K2,100
260 DATA RIGEL,B8,52000,CAPELLA,G8,145,PROCYON,F5,7.6,ACHERNAR,B5,1000
270 DATA ALTAIR,A7,10,BETELGEUSE,M2,8300
280 DATA ALDEBARAN,K5,160,SPICA,B1,760,ANTARES,M1,830,POLLUX,K0,33
290 DATA FORMALHAUT,A3,13,"BETA CRUCIS",B0,8300,DENEB,A2,52000,REGULUS,B7,160
300 DATA "BARNARD'S STJ[RNA",M5,.00044
310 ; TAB(36%) 'V[RLDSBYGGAREN'
320 ; : ; TAB(30%) '1. - K{nd stj{rna'
330 ; TAB(30%) '2. - Ej k{nd stj{rna'
340 ; TAB(30%) '3. - Visa k{nda stj{rnor'
350 ; TAB(30%) '4. - Sluta'
360 ; 
370 INPUT Z$
380 ON ERROR GOTO 370
390 A%=VAL(Z$)
400 IF A%<1% AND A%>4% GOTO 370
410 ON A% GOTO 500,710,430,420
420 END 
430 ON ERROR GOTO 
440 FOR I%=1% TO 18%
450   ; CUR(23%,0%) LEFT$(S$(I%)+'                  ',18%);Ss$(I%) '  ';
460   ; USING '######.####' Ls(I%);
470   ; CUR(23%,40%) LEFT$(S$(I%+18%)+'                  ',18%);Ss$(I%+18%) '  ';
480   ; USING '######.####' Ls(I%+18%)
490 NEXT I% 
500 ON ERROR GOTO 
510 INPUT 'STJ[RNANS NAMN : 'S$
520 FOR I%=1% TO LEN(S$)
530   Ssx$=MID$(S$,I%,1%)
540   IF ASCII(Ssx$)<64 GOTO 560
550   MID$(S$,I%,1%)=CHR$(ASCII(Ssx$) AND 223%)
560 NEXT I% 
570 ; S$
580 IF S$='' GOTO 310
590 FOR I%=1% TO 36%
600   IF S$=S$(I%) Sk%=I% : GOTO 630
610 NEXT I% 
620 GOTO 440
630 Sc=VAL(RIGHT$(Ss$(Sk%),2%))/10%
640 S1$=LEFT$(Ss$(Sk%),1%)
650 FOR I%=1% TO 7% : IF S1$=Sc$(I%) J=I% : GOTO 670
660 NEXT I% 
670 Ms=Sm(Sk%) : L=Ls(Sk%) : As=(Ms^(1/(-2.5)))*10%
680 P=(1.25-Ms/(L^(1/3.5)))/.005
690 IF P/100%*As>10% P=1000%*As
700 GOTO 910
710 ON ERROR GOTO 
720 INPUT 'STJ[RNANS NAMN :'S$
730 INPUT 'SPEKTRALKLASS  :'S1$
740 IF S1$='' GOTO 730
750 Sc=VAL(RIGHT$(S1$,2%))/10%
760 S1$=LEFT$(S1$,1)
770 FOR I%=1 TO 12
780   IF S1$=Sc$(I%) J=I% : GOTO 810
790 NEXT I% 
800 GOTO 730
810 Ms=(Sc*M(I%)/10+M(I%))*.96116878
820 INPUT 'ABSOLUT MAGNITUD (SOLEN =4.79)'M
830 L=2.512^(-M)*82.43167
840 Ms=Ms*L^(1/3)
850 ! 
860 As=(Ms^(1/(-2.5)))*10
870 ; S$ ' HAR EN LIVSL[NGD P] '; : ; USING '####.####' As; : ; ' MILJARDER ]R'
880 INPUT 'Hur m}nga procent av stj{rnans livstid har g}tt : 'P
890 IF P/100*As>12 ; 'BIG bang skedde f|r 12 miljoner }r sedan' : INPUT 'Vill du {nd} forts{tta? 'A$ : IF A$<>'j' AND A$<>'J' GOTO 870
900 Ms=Ms*(1.25-.005*P)
910 Ts=5800*Ms
920 Ds=Ms^(1/3)*SQR(L)
930 A$='N' ! INPUT 'Skrivarutskrift av data 'A$
940 IF A$='j' OR A$='J' OPEN 'pr:' AS FILE 1 : \=1 ELSE \=0
950 ; CHR$(12) : ; #\ 'STJ[RNDATA : '
960 ; #\ 'Den utvalda stj{rnan ' S$ ' {r en ' S1$ INT(Sc*10) ' stj{rna.'
970 ; #\ '{r ' C$(J)
980 ; #\ 'har '; : ; USING '#####.###' Ms; : ; ' solmassor'
990 ; #\ 'den har '; : ; USING '#####.###' L; : ; ' g}nger solens luminositet'
1000 ; #\ 'Stj{rnan har en f|rv{ntad livsl{ngd p} '; : ; USING '####.####' As; : ; ' miljarder }r.'
1010 ; #\ ' av vilka den har levt ' INT(P) '% av sin livsl{ngd.'
1020 IF P>95 ; #\ '   stj{rnan {r i sin d|dsfas.'
1030 ; #\ 'stj{rnan har en yttemperatur p} '; : ; USING '#########' Ts; : ; ' K.'
1040 IF J+Sc<2.5 OR J+Sc>7 ; #\ 'Den har sannolikt inga planeter.' : GOTO 1060
1050 ; #\ 'Den kan ha planeter.'
1060 ; #\ 'Den kommer att d| som ';
1070 IF Ms<1.5 ; #\ 'en vit dv{rg.' : GOTO 1110
1080 IF Ms<4 ; #\ 'en neutronstj{rna.' : GOTO 1110
1090 IF Ms<10 ; #\ 'en neutronstj{rna efter ett novautbrott.' : GOTO 1110
1100 ; #\ 'som svart h}l efter ett supernovautbrott.'
1110 ; : INPUT 'En annan stj{rna ?'A$
1120 IF A$<>'N' AND A$<>'n' GOTO 310
1130 P=P/100
1140 ; 'Den intressanta planeten :'
1150 ; 'Tellus har en medeltemperatur p} 15 grader celcius.'
1160 INPUT 'Vilken medeltemperatur |nskar du 'Tp : Tp=Tp+273.15
1170 INPUT 'Vilken gravitation i G :'G
1180 IF G<=0 ; 'f|r l}g gravitation.' : GOTO 1170
1190 Rp=(L*Ts/Tp/20.1284053)^2
1200 IF Rp<Ms/5 ; 'Den h{r planeten {r f|r n{ra f|r att vara stabil.' : GOTO 1150
1210 Pp=SQR(Rp^3/Ms)
1220 Is=L/Rp^2
1230 Rm=SQR(L*Ts/5800)*.9
1240 Rx=SQR(L*Ts/5800)*1.1
1250 Sa=Ds/Rp
1260 INPUT 'Hur stor skall planeten vara j{mf|rt med jorden 'D
1270 M=G*D^2
1280 IF M<.055 ; 'Syrerik atmosf{r kommer att saknas'
1290 IF M>17.6 ; 'Planeten kommer att ha f|r mycket v{te i atmosf{ren'
1300 ; 'Tellus bana har en excentritet p} .01672'
1310 INPUT 'Vilken excentritet |nskas (<1) 'Ec
1320 IF Ec>1 GOTO 1310
1330 Ca=(1-Ec)*Rp : Fa=(1+Ec)*Rp
1340 INPUT 'Vilken lutning p} axeln (Tellus=23.5 grader) 'Ti
1350 IF Ti<0 OR Ti>90 GOTO 1340
1360 INPUT 'hur m}nga m}nar har planeten 'Mn
1370 IF Mn>10 ; 'f|r komplicerat max 10 ' : GOTO 1360
1380 Mm=1000 : H=0 : R=56*G
1390 IF Mn<=0 GOTO 1490
1400 FOR I=1 TO Mn
1410   ; 'Massa f|r m}ne ' I ' (v}r m}ne=1) '; : INPUT Mn(I)
1420   INPUT 'Banradie (v}r m}ne=30)'Mr(I)
1430   IF Mr(I)<3*G ; 'm}nen kommer att brytas s|nder' : GOTO 1420
1440   IF Mr(I)>56*G ; 'm}nen kommer att driva iv{g' : GOTO 1420
1450   Mp(I)=SQR(Mr(I)^3/M)*4
1460   IF Mr(I)<R Mm=Mp(I) : R=Mr(I)
1470   H=Mn(I)*.1235/(Mr(I)^3)+H
1480 NEXT I 
1490 H2=.85*D^4/M*(Ms*333500/(11759*Rp)^3+H)
1500 Da=3.443216E+06*H2+10
1510 IF Da>Mm Da=Mm
1520 Dax=INT(Da)
1530 Dab=60*(Da-Dax)
1540 ; #\ 'Planetens dygn b|r bli cirka '; : ; #\ Dax;':';INT(Dab) ' timmar l}ngt.'
1550 ; #\ 'Detta g|r att planetens }r blir cirka ' INT(876140/Da*Pp)/100 ' dagar l}ngt'
1560 Hi=INT((1+.025*Da/24)*Tp-273.15) : Lo=INT((1-.025*Da/24)*Tp-273.15)
1570 IF Lo<-273.15 Lo=-273.15
1580 ; #\ 'Dagens h|gsta temperatur {r ' Hi ' grader Celcius'
1590 ; #\ 'och dess l{gsta temperatur {r ' Lo ' grader Celcius'
1600 Exc2=Tp*(1-Ec)^2
1610 Exc1=Tp/(1-Ec)^2
1620 Exc1=Exc1-Tp : Exc2=Exc2-Tp
1630 Sh=INT(Hi+15*SIN(Ti*PI/180)+Exc1) : Ll=INT(Lo-15*SIN(Ti*PI/180)+Exc2)
1640 Sll=INT(Lo+15*SIN(Ti*PI/180)+Exc1) : Llh=INT(Hi-15*SIN(Ti*PI/180)+Exc2)
1650 IF Ll<-273.15 Ll=-273.15
1660 ; #\ 'Max sommartemperatur {r ' Sh ' grader.'
1670 ; #\ 'Min sommartemperatur {r ' Sll ' grader.'
1680 ; #\ 'Min vintertemperatur {r ' Ll ' grader.'
1690 ; #\ 'Max vintertemperatur {r ' Llh ' grader.'
1700 IF Sh>100 OR Ll<0 ; #\ 'Vissa }rstider fins vattnet ej i flytande form'
1710 IF Mn<=0 GOTO 1850
1720 IF Mn=1 GOTO 1820
1730 FOR I=1 TO Mn : F=0 : FOR K=1 TO Mn-1
1740     IF Mr(K+1)>Mr(K) GOTO 1790
1750     T=Mr(K) : Mr(K)=Mr(K+1) : Mr(K+1)=T
1760     T=Mn(K) : Mn(K)=Mn(K+1) : Mn(K+1)=T
1770     T=Mp(K) : Mp(K)=Mp(K+1) : Mp(K+1)=T
1780     F=1
1790   NEXT K 
1800   IF F=0 GOTO 1820
1810 NEXT I 
1820 ; #\ 'Planetens m}nsystem :'
1830 ; #\ 'Bana','Massa','Period'
1840 ; #\ : ; #\ : ; #\ : FOR I=1 TO Mn : ; #\ INT(Mr(I)),INT(Mn(I)*100)/100,INT(Mp(I)) ' Timmar ' INT(Mp(I)/Da) ' dagar' : NEXT I 
1850 INPUT 'Vill du ha en annan ups{ttning m}nar'A$
1860 IF A$<>'n' AND A$<>'N' GOTO 1360
1870 ; CHR$(12) : ; #\ 'PLANETDATA :'
1880 ; #\ 'Medeltemperatur : '; : ; USING ' ####.##' (Tp-273.15); : ; ' Grader C'
1890 ; #\ 'Banradie        : '; : ; USING ' ####.##' Rp; : ; ' AE.'
1900 ; #\ 'Peregium        : '; : ; USING ' ####.##' Ca; : ; ' AE.'
1910 ; #\ 'Apogeum         : '; : ; USING ' ####.##' Fa; : ; ' AE.'
1920 ; #\ ']rsl{ngd        : '; : ; USING '#####.##' Pp; : ; ' Tellus}r.'
1930 ; #\ 'Stj{rnstorleken : '; : ; USING ' ####.# ' Sa; : ; ' Solytor.'
1940 ; #\ 'Inre biozon     : '; : ; USING ' ####.##' Rm; : ; ' AE.'
1950 ; #\ 'Yttre biozon    : '; : ; USING ' ####.##' Rx; : ; ' AE.'
1960 ; #\ 'Gravitation     : '; : ; USING '   ##.# ' G; : ; ' G.'
1970 ; #\ 'Din vikt (78kg) : '; : ; USING '   ##   ' 78*G; : ; ' kg.'
1980 INPUT '{r gravitationen godk{nd 'A$
1990 IF A$<>'j' AND A$<>'J' GOTO 1170
2000 IF M<.055 OR M>17.6 ; #\ 'P} grund av den d}liga atmosf{ren' : GOTO 2040
2010 IF Rp>Rx ; #\ 'p} grund av den svaga str}lningen' : GOTO 2040
2020 IF Rp<Rm ; #\ 'p} grund av den starka str}lningen' : GOTO 2040
2030 GOTO 2050
2040 ; #\ 'finns det inget liv p} denna planet'
2050 IF Ll<-196 AND Sh>-196 ; #\ 'Kv{vet i planetens atmosf{r kommer periodvis att vara i flytande form.'
2060 IF Ll<-196 AND Sh<-196 ; #\ 'Kv{vet i planetens atmosf{r kommer att vara i flytande form.'
2070 IF Ll<-162 AND Sh>-162 ; #\ 'Sj|ar med metan kommer periodvis att finnas'
2080 IF Ll<-162 AND Sh<-162 ; #\ 'Sj|ar med metan kommer att finnas'
2090 IF Ll<-182 AND Sh>=-182 ; #\ 'Planetens yta kommer periodvis att vara t{ckt av metanis.'
2100 IF Sh<-182 ; #\ 'Planetens yta kommer att vara t{ckt av metanis.'
2110 IF Ll<-107 AND Sh>-107 ; #\ 'V{te kan periodvis finnas i flytande form.'
2120 IF Sh<=-107 ; #\ 'V{te finns i flytande form.'
2130 IF Ll<-259 AND Sh>=-259 ; #\ 'V{te finns periodvis i fast form.'
2140 IF Sh<-259 ; #\ 'V{te finns i fast form.'
2150 IF Ll<-183 AND Sh>=-183 ; #\ 'Syre finns periodvis i flytande form.'
2160 IF Sh<-183 ; #\ 'Syre finns i flytande form.'
2170 IF Ll<-218 AND Sh>=-218 ; #\ 'Syre finns periodvis i fast form.'
2180 IF Sh<-218 ; #\ 'Syre finns i fast form.'
2190 IF Ll>59 ; #\ 'Eftersom l{gsta temperaturen {r h|gre {n 59 grader kan atmosf{ren' : ; #\ 'vara f|rgiftad av brom.'
2200 IF Sh<0 OR Ll>100 ; #\ 'Eftersom vatten i v{tskeform saknas' : GOTO 2480
2210 IF As*P<1.5 ; #\ 'Eftersom planeten {r f|r ung' : GOTO 2480
2220 IF P>.95 ; #\ 'Eftersom stj{rnan {r i sina d|dsryckningar' : GOTO 2480
2230 ; #\ 'D{r kan finnas :'
2240 IF As*P<2*G ; #\ 'Bakterier och bl}gr|na alger' : GOTO 2460
2250 IF As*P<3*G ; #\ 'Encelligt liv' : GOTO 2460
2260 IF As*P<4*G ; #\ 'Enkla flercelliga organismer' : GOTO 2460
2270 IF As*P<4.4*G ; #\ 'Vattendjur och landv{xter' : GOTO 2460
2280 IF As*P<4.52*G ; #\ 'Vattendjur,landdjur och m|jligen flygande djur.' : GOTO 2460
2290 IF As*P<4.7*G ; #\ 'Landdjur och m|jligtvis intelligens'
2300 ; #\ 'Landdjur och troligen n}gon h|gre intelligens'
2310 IF As*P>6*G ; 'Planeten kan ha n}gon form av mycket h|g intelligens.'
2320 IF G<.95 GOTO 2380
2330 IF G<1.05 GOTO 2420
2340 ; #\ 'h|gre gravitation inneb{r t{tare atmosf{r. Detta inneb{r att djurlivet {r kraftigare byggt och att {ven korta fall kan vara farliga.'
2350 IF G>1.25 ; #\ 'Det finns sannolikt inga djur som g}r p} tv} ben.'
2360 ; #\ 'Den tjocka atmosf{ren |kar ljudutbytet, och h{rigenom kommer djuren att ha mindre |ron.'
2370 GOTO 2440
2380 ; #\ 'L{gre gravitation inneb{r tunnare atmosf{r. Om det finns f}glar kommer dessa att ha st|rre vingar.'
2390 ; #\ ' Alla livsformer kommer att vara klenare {n jorddjuren.'
2400 ; #\ 'M}nga livsformer kommer att vara tv}benta.'
2410 ; #\ ' den tunna atmosf{ren g|r att h|rselorganen kan vara kraftigt utvecklade eller saknas hos djuren.'
2420 IF Tp>300 ; #\ ' N}gon form av str}lningsskydd kommer att vara n|dv{ndigt.'
2430 IF Sa<.75 ; #\ 'P} grund av det svaga solskenet kommer djuren att ha stora |gon, eller vara beroende av andra sinnen.'
2440 IF Sa>1.5 ; #\ 'P} grund av det starka solljuset {r synen ett av de fr{msta sinnena, samtidigt som |gonen {r sm}'
2450 IF Hi-Lo>50 ; #\ 'Extrema temperaturvariationer g|r att vattendjur och underjordiska djur fr{mjas.'
2460 IF (Tp-273.15)<0 OR (Tp-273.15)>100 OR G>1.5 OR G<.68 OR M<.4 OR M>2.35 OR Da>96 OR Sh>60 OR Ll<-70 OR Hi>50 OR Lo<-20 THEN Hm=0 ELSE Hm=1
2470 GOTO 2490
2480 ; #\ 'finns det inget liv p} denna planet'
2490 ; #\ 'Denna planet kan '; : IF Hm=0 ; #\ 'inte ';
2500 ; #\ 'vara beboelig f|r m{nniskor.'
2510 INPUT 'Vill du ha en annan planet 'A$
2520 IF A$<>'n' AND A$<>'N' GOTO 1140
2530 ; CHR$(12) '\vriga planeter :'
2540 ; 
2550 INPUT 'Hur m}nga planeter skall systemet inneh}lla 'Np
2560 IF Np>15 ; 'f|r komplext ' : GOTO 2550
2570 IF Np<=1 GOTO 2880
2580 Am=1180/SQR(Ms)-M*SQR(Rp)
2590 R(1)=Rp : Mp(1)=M
2600 FOR I=2 TO Np
2610   ; CHR$(12) : ; #\ '\vriga planeter '
2620   ; 'Massa f|r planet ' I ' i jordmassor '; : INPUT Mp(I)
2630   IF Mp(I)>1000 ; 'f|r stor' : GOTO 2620
2640   INPUT 'Avst}nd fr}n stj{rnan (AE)'R(I)
2650   IF R(I)<Ms/5 ; 'F|r n{ra stj{rnan ' : GOTO 2640
2660   IF R(I)>56*Ms ; 'F|r l}ngt bort ' : GOTO 2640
2670   FOR K=1 TO I-1 : IF R(K)>.9*R(I) AND R(K)<1.1*R(I) GOTO 2640
2680   NEXT K 
2690   A1=Mp(I)*SQR(R(I))
2700   IF A1>Am ; 'PLANETENS MASSA [R F\R STOR F\R SYSTEMET' : GOTO 2610
2710   Am=Am-A1
2720 NEXT I 
2730 FOR I=1 TO Np : F=0 : FOR K=1 TO Np-I
2740     IF R(K+1)>=R(K) GOTO 2780
2750     T=R(K) : R(K)=R(K+1) : R(K+1)=T
2760     T=Mp(K) : Mp(K)=Mp(K+1) : Mp(K+1)=T
2770     F=1
2780   NEXT K 
2790   IF F=0 GOTO 2810
2800 NEXT I 
2810 ; #\ 'PLANET','MASSA','BANA'
2820 FOR I=1 TO Np
2830   ; #\,I,INT(Mp(I)*100)/100,INT(R(I)*100)/100,
2840   IF R(I)>Rm AND R(I)<Rx AND Mp(I)>.055 AND Mp(I)<17.6 ; #\ 'Liv ?' ELSE ; #\
2850 NEXT I 
2860 INPUT 'Vill du f|rs|ka med ett annat system 'A$
2870 IF A$='j' OR A$='J' GOTO 2530
2880 INPUT 'Vill du f|rs|ka med en annan stj{rna 'A$
2890 IF A$='j' OR A$='J' GOTO 10
2900 END