-
Notifications
You must be signed in to change notification settings - Fork 0
/
Copy pathCORIOLIS.BAS
261 lines (261 loc) · 8.89 KB
/
CORIOLIS.BAS
1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
133
134
135
136
137
138
139
140
141
142
143
144
145
146
147
148
149
150
151
152
153
154
155
156
157
158
159
160
161
162
163
164
165
166
167
168
169
170
171
172
173
174
175
176
177
178
179
180
181
182
183
184
185
186
187
188
189
190
191
192
193
194
195
196
197
198
199
200
201
202
203
204
205
206
207
208
209
210
211
212
213
214
215
216
217
218
219
220
221
222
223
224
225
226
227
228
229
230
231
232
233
234
235
236
237
238
239
240
241
242
243
244
245
246
247
248
249
250
251
252
253
254
255
256
257
258
259
260
261
1 GO TO 55
10 'Program name :CORIOLIS
11 'Edited April 1988
50 'handling program ******************
55 SCREEN 1: COLOR 0,2: KEY OFF: CLS :
60 LOCATE 5,10
100 INPUT "EXERCISE NUMBER";E$
111 IF E$ = "1-1" THEN GOTO 5000
112 IF E$ = "1-2" THEN GOTO 6000
121 IF E$ = "2-1" THEN GOTO 10000
122 IF E$ = "2-2" THEN GOTO 11000
123 IF E$ = "2-3" THEN GOTO 13000
124 IF E$ = "2-4" THEN GOTO 14000
131 IF E$ = "3-1" THEN GOTO 15000
132 IF E$ = "3-2" THEN GOTO 16000
133 IF E$ = "3-3" THEN GOTO 17000
134 IF E$ = "3-4" THEN GOTO 18000
141 IF E$ = "4-1" THEN GOTO 20000
151 IF E$ = "5-1" THEN GOTO 25000
152 IF E$ = "5-2" THEN GOTO 26000
153 IF E$ = "5-3" THEN GOTO 27000
154 IF E$ = "5-4" THEN GOTO 28000
155 IF E$ = "5-5" THEN GOTO 29000
156 IF E$ = "5-6" THEN GOTO 24000
157 IF E$ = "5-7" THEN GOTO 24500
165 IF E$ = "6-5" THEN GOTO 34000
166 IF E$ = "6-6" THEN GOTO 33000
171 IF E$ = "7-1" THEN GOTO 30000
172 IF E$ = "7-2" THEN GOTO 31000
173 IF E$ = "7-3" THEN GOTO 32000
181 IF E$ = "8-1" THEN GOTO 35000
182 IF E$ = "8-2" THEN GOTO 36000
183 IF E$ = "8-3" THEN GOTO 37000
184 IF E$ = "8-4" THEN GOTO 38000
191 IF E$ = "9-1" THEN GOTO 47000
192 IF E$ = "9-2" THEN GOTO 48000
193 IF E$ = "9-3" THEN GOTO 49000
194 IF E$ = "9-4" THEN GOTO 54000
195 IF E$ = "A-1" THEN GOTO 55000
196 IF E$ = "a-1" THEN GOTO 55000
300 GOTO 55
5000 'EXERCISE 1-1 **********************
5005 SCREEN 1: KEY OFF: CLS: COLOR 0,2
5010 DT=1 : FAC=10: FFF=10: FFC=10
5020 CLS
5030 X=0: Y=0: XD=FFC*(RND-1/2)
5031 YD=FFC*(RND-1/2): T=0: CA=3
5040 FX0=FFF*(RND-1/2): FY0=FFF*(RND-1/2)
5050 XDD=FX: YDD=FY
5060 XD=XDD*DT+XD: YD=YDD*DT+YD
5070 X=XD*DT+X: Y=YD*DT+Y
5080 PSET (150+X, 100-Y),2
5090 T=T+DT: FX=FX0: FY=FY0
5100 IF T<(11*DT) THEN FX=0
5110 IF T<(11*DT) THEN FY=0
5120 AX=150: AY=80: LX=FAC*FX
5121 LY=FAC*FY: AL=.4: LH=4
5130 IF T<(11*DT) THEN LH=0 ELSE LH=4
5140 GOSUB 60000
5150 IF X^2+Y^2 > 10000 THEN CLS: GOTO 5020
5160 GOTO 5050
25000 'Exercise 5-1: Three surfaces of revol**
25010 'Indices (1) simple harmonic motion
25011 '(2) paraboloid
25012 '(3) concave up hemisphere
25020 SCREEN 1: COLOR 0,2: KEY OFF: CLS
25030 DT = .04: G=1: D=1
25040 K=1: K2=K^2: C=K2/2: A=K2/G
25050 MU = 0.2
25055 GOSUB 25500: GOSUB 25600
25060 FOR I=1 TO 3: R(I)=0.5: NEXT
25070 FOR I=1 TO 3: RD(I)=0: NEXT
25090 RDD(1)=MU^2/(R(1)^3)-K^2*R(1)
25091 AAA=(1+(2*C*R(2))^2)
25092 CCC=MU^2/(R(2)^3)
25093 BBB=-2*G*R(2)-R(2)*(2*C*RD(2))^2
25100 RDD(2)=(BBB+CCC)/AAA
25105 AA=-G*R(3)/(SQR(A^2-R(3)^2))
25106 CC=-RD(3)^2*(A^2*R(3)/((A^2-R(3)^2)^2))
25107 DD=1+R(3)^2/(A^2*R(3)^2)
25108 BB=MU^2/(R(3)^3)
25110 RDD(3)=(AA+BB+CC)/DD
25140 FOR I=1 TO 3: RD(I)=RDD(I)*DT+RD(I)
25141 R(I)=RD(I)*DT+R(I): NEXT
25150 FOR I=1 TO 3: PD(I)=MU/(R(I)^2)
25151 P(I)=PD(I)*DT+P(I): NEXT
25160 FOR I=1 TO 3: X(I)=R(I)*COS(P(I))
25161 Y(I)=R(I)*SIN(P(I)): NEXT
25170 FOR I=1 TO 3
25171 PSET (50*X(I)+70+80*(I-1),60-50*Y(I)),I
25172 NEXT
25180 GOTO 25090
25500 FOR I=0 TO 2: CIRCLE(70+80*I,60),30,1
25501 NEXT
25505 LOCATE 23,5
25506 PRINT " plane parabol sphere";
25507 LOCATE 1,6
25508 PRINT "Three surfaces of revolution ";
25510 RETURN
25600 FOR I=-0.7 to 0.7 STEP 0.02:'side view
25610 L(1)=50*I+70+80*0: M(1)=170
25620 L(2)=50*I+70+80*1: M(2)=170-50*C*I^2
25625 IF (A^2-I^2)=<0 THEN GOTO 25700
25630 L(3)=50*I+70+80*2
25631 M(3)=170-50*(A-SQR(A^2-I^2))
25700 PSET(L(1),M(1)),1
25701 PSET(L(2),M(2)),1: PSET (L(3),M(3)),1
25725 NEXT
25750 RETURN
26000 'Exercise 5-2: 3 surf rev PLANE PERIODS*
26010 'Indices (1) simple harmonic motion
26011 'Indices (2) paraboloid
26012 'Indices (3) concave up hemisphere
26020 SCREEN 1: COLOR 0,2: KEY OFF: CLS
26030 DT=0.01: G=1: D=1
26040 K=1: K2=K^2: C=K2/2: A=K2/G
26050 MU=0
26060 GOSUB 26320: GOSUB 26370
26070 FOR I=1 TO 3: R(I)=.5: NEXT
26080 FOR I=1 TO 3: RD(I)=0: NEXT
26100 RDD(1)=MU^2/(R(1)^3)-K^2*R(1)
26105 AAA=(1+(2*C*R(2))^2)
26106 BBB=-2*G*C*R(2)-R(2)*(2*C*RD(2))^2
26107 CCC=MU^2/(R(2)^3)
26110 RDD(2)=(BBB+CCC)/AAA
26120 AA=-G*R(3)/SQR((A^2-R(3)^2))
26121 BB=MU^2/(R(3)^3)
26130 CC=-RD(3)^2*(A^2*R(3)/((A^2-R(3)^2)^2))
26140 DD=1+R(3)^2/(A^2-R(3)^2)
26150 RDD(3)=(AA+BB+CC)/DD
26220 FOR I=1 TO 3: RD(I)=RDD(I)*DT+RD(I)
26221 R(I)=RD(I)*DT+R(I): NEXT
26230 FOR I=1 TO 3: PD(I)=MU/(R(I)^2)
26231 P(I)=PD(I)*DT+P(I): NEXT
26240 FOR I=1 TO 3: X(I)=R(I)*COS(P(I))
26241 Y(I)=R(I)*SIN(P(I)): NEXT
26250 FOR I=1 TO 3
26251 PSET (50*X(I)+70+80*(I-1),60-50*Y(I)),I
26252 NEXT
26260 FOR I=1 TO 3: LOCATE 15+I,5
26261 IF FLAG(I)=1 THEN GOTO 26280
26265 ZZZ=RD(I)*RDL(I)
26270 IF ZZZ<0 THEN GOTO 26271 ELSE GOTO 26280
26271 FLAG(I)=1
26272 PRINT USING "t(#)=##.##"; I,2*T
26280 RDL(I)=RD(I)
26290 NEXT
26300 T=T+DT
26310 GOTO 26100
26320 FOR I=0 TO 2
26321 CIRCLE(70+80*I,60),30,1: NEXT
26330 LOCATE 23,5
26331 PRINT " plane parabol sphere";
26340 LOCATE 1,5
26341 PRINT " Three surfaces of revolution";
26350 LOCATE 2,5
26351 PRiNT "PERIODS FOR PLANE OSCILLATIONS";
26360 RETURN
26370 FOR I=-0.7 TO 0.7 STEP 0.02: 'side view
26380 L(1)=50*I+70+80*0: M(1)=170
26390 L(2)=50*I+70+80*1: M(2)=170-50*C*I^2
26400 IF (A^2-I^2)=<0 THEN GOTO 26420
26410 L(3)=50*I+70+80*2
26411 M(3)=170-50*(A-SQR(A^2-I^2))
26420 PSET(L(1),M(1)),1: PSET(L(2),M(2)),1
26421 PSET(L(3),M(3)),1
26430 NEXT
26440 RETURN
30000 'Exer 7-1; particle on spheroid earth **
30010 SCREEN 1: COLOR 0,2: KEY OFF: CLS
30020 'absolute 1 and 2, relative 3 and 4
30021 'expert odd, novice even # expert means that particle moves at the same rate as the rotation of the planet
30030 PRINT "TWO VIEWS" ' novice means that the particle moves at a different rate than the rotation of the planet
30031 PRINT"expert":PRINT"novice"
30040 LOCATE 2,30:PRINT"on back"
30050 PSET(292,12),1
30060 LOCATE 21,6:PRINT"absolute" ' this refers to the frame of reference
30070 LOCATE 21,24:PRINT"relative"
30080 PSET(80,12),2:PSET(80,20),3
3090 PI = 3.14159: W=10: W2=W^2 ' set all the constants, W = rotation rate of the planet
30091 DT=0.005: FACT = 60:INC=PI/16
30100 GOSUB 30360
30110 LOCATE 23,1:INPUT "lat";LA ' ask for user to enter a latitude
30120 FOR I=1 TO 4:LA(I)=LA*PI/180 ' start all particles at the chosen latitude
30121 LO(I) = -PI/2 :NEXT ' set the same starting longitude
30130 LAD(1)=0: LAD(3)=0 ' set the time derivatives for lat and lon for experts
30131 LAD(2)=V:LAD(4)=LAD(2) ' set the time derivatives for lat and lon for novices
30140 LOCATE 23,20:INPUT "u,v";U,V ' ask for user to enter the starting velocity, relative to rotating planet
30150 LAD(1)=0: LAD(3)=0
30151 LAD(2)=V:LAD(4)=LAD(2)
30160 LOD(2)=U/COS(LA(1))+W : LOD(4)=LOD(2)
30170 LODD(2)=2*TAN(LA(2))*LAD(2)*LOD(2) ' integration in absolute frame
30178 AAA=SIN(LA(2))*COS(LA(2))
30179 BBB=(W2-(LOD(2))^2)
30180 LADD(2)=AAA*BBB
30190 LOD(2)=LOD(2)+DT*LODD(2)
30191 LAD(2)=LAD(2)+LADD(2)*DT
30200 T=T+DT:A$=INKEY$:IF A$= "S" THEN WS=0
30201 'LOCATE 3,15:PRINT "BULGE GONE":BEEP
30210 LA(2)=LA(2)+DT*LAD(2)
30211 LO(2)=LO(2)+DT*LOD(2):LO(4)=LO(2)-W*T
30220 LA(4)=LA(2): LO(1)=LO(1)+W*DT ' integration in relative frame
30230 FOR I=1 TO 4: RHO(I)=COS(LA(I)) ' convert to x,y coordinates
30240 X(I) = RHO(I)*COS(LO(I))
30241 Y(I) = RHO(I)*SIN(LO(I))*SIN(INC)
30250 Z(I)=Y(I)+SIN(LA(I))*COS(INC)
30260 IF Y(1)<0 THEN C(1)=2 ELSE C(1)=1 ' set color of particles depending on position
30270 IF Y(2)<0 THEN C(2)=3 ELSE C(2)=1
30280 IF Y(3)<0 THEN C(3)=2 ELSE C(3)=1
30290 IF Y(4)<0 THEN C(4)=3 ELSE C(4)=2
30300 IF I=1 THEN GOTO 30301 ELSE GOTO 30310 ' plot position of four points on the spheres
30301 PSET(70+FACT*X(1),90-FACT*Z(1)),C(1)
30312 GOTO 30340
30310 IF I=2 THEN GOTO 30311 ELSE GOTO 30320
30311 PSET(70+FACT*X(2),90-FACT*Z(2)),C(2)
30312 GOTO 30340
30320 IF I=3 THEN GOTO 30321 ELSE GOTO 30330
30321 PSET(220+FACT*X(3),90-FACT*Z(3)),C(3)
30322 GOTO 30340
30330 IF I=4 THEN GOTO 30331 ELSE GOTO 30340
30331 PSET(220+FACT*X(4),90-FACT*Z(4)),C(4)
30332 GOTO 30340
30340 NEXT
30350 GOTO 30170
30360 J=INC: 'PLOT THE TWO SPHERES"
30370 FOR I=0 TO 1
30380 CIRCLE (220-150*I,90),60,1,0,2*PI,1 ' CIRCLE (x,y), radius, color, start, end, aspect
30390 CIRCLE (220-150*I,90),60,1,0,2*PI,SIN(J)
30400 C9=60*SIN(PI/6)*COS(J)
30405 AN=SIN(J)
30410 K9=60*COS(PI/6)
30420 CIRCLE(220-150*I,90-C9),K9,1,0,2*PI,AN
30430 CIRCLE(220-150*I,90+C9),K9,1,0,2*PI,AN
30440 C9=60*SIN(PI/3)*COS(J)
30450 K9 = 60*COS(PI/3)
30460 CIRCLE(220-150*I,90-C9),K9,1,0,2*PI,AN
30470 CIRCLE(220-150*I,90+C9),K9,1,0,2*PI,AN
30470 NEXT
30490 RETURN
60000 'Subroutine 1 *********************
60005 PI=3.14159:' arrow subroutine
60010 LINE(AX, 200-AY)-(AX+LX, 200-AY-LY), CA
60020 IF LX=0 THEN TH=SGN(LY)*PI/2
60030 IF LX=0 THEN GOTO 60060
60040 TH=ATN(LY/LX)
60050 IF LX>0 THEN TH=THE ELSE TH=TH+PI
60060 XZ=AX+LX-LH*COS(TH+AL)
60061 YZ=200-(AY+LY-LH*SIN(TH+AL))
60062 LINE(AX+LX, 200-(AY+LY)) - (XZ,YZ),CA
60070 XZ=AX+LX-LH*COS(TH-AL)
60071 YZ=200-(AY+LY-LH*SIN(TH-AL))
60072 LINE(AX+LX, 200-(AY+LY)) - (XZ,YZ),CA
60080 RETURN
61000 'SUBROUTINE 2; Draw star ***********
61010 PSET(XLS,YLS),0: GOSUB 61040
61020 PSET(XS,YS),3: GOSUB 61040
61030 RETURN
61040 FOR D=0 TO 360 STEP 72
61050 DRAW "ta=d;u3
61060 NEXT D
61070 RETURN