fcb7b340 |
1 | C APFELMAENNCHEN-PROGRAMM, 06.FEBRUARY.2007 PHILIPP HACHTMANN |
2 | C INTERMEDIATE VERSION |
3 | C |
4 | C THIS VERSION SHOULD RUN A BIT FASTER BECAUSE THE SQUARE |
5 | C ROOT IS OMMITTED. |
6 | C |
7 | C SWITCH SETTINGS: |
8 | C SENSE-SWITCH 1: IF SET, ASK FOR PARAMETERS |
9 | C SENSE-SWITCH 2: IF SET, DON'T PRINT PARAMETERS ON START |
10 | C SENSE-SWITCH 3: IF SET, RESTORE PARAMETERS TO DEFAULT VALUES |
11 | C |
12 | CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC |
13 | C COMMON BLOCK DECLARATIONS |
14 | C |
15 | INTEGER MAXI,WIDTH,CR,LF,POSI,NEGA |
16 | COMMON /PARAM2/MAXI,WIDTH,CR,LF,POSI,NEGA |
17 | C |
18 | REAL LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP |
19 | COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP |
20 | C |
21 | INTEGER INIT |
22 | COMMON /PARAM3/INIT |
23 | C |
24 | CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC |
25 | C CONFIGURATION |
26 | CCCCCC RESET DO DEFAULT VALUES? |
27 | 110 CALL SSWTCH(3,I) |
28 | IF (I.EQ.1) CALL RST |
29 | C |
30 | CCCCCC ON THE FIRST START OR IF DESIRED |
31 | IF(INIT.EQ.0) CALL STVAL |
32 | C |
33 | CCCCCC DO WE HAVE TO ASK FOR PARAMETERS? |
34 | CALL SSWTCH(1,I) |
35 | IF (I.EQ.1) CALL GETCFG |
36 | C |
37 | CCCCCC OUTPUT SETTINGS? |
38 | CALL SSWTCH(2,I) |
39 | IF(I.EQ.2) CALL OUTCFG |
40 | C |
41 | WRITE (1,55) |
42 | 55 FORMAT (1H0) |
43 | C |
c6301d07 |
44 | CALL PLOTI |
fcb7b340 |
45 | CALL CALC2 |
46 | C |
47 | WRITE(1, 60) |
48 | 60 FORMAT (5HREADY) |
49 | C |
50 | PAUSE 7 |
51 | GO TO 110 |
52 | END |
53 | C END OF MAIN PROGRAM |
54 | C |
55 | CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC |
56 | CCCCCC THE MANDELBROT SET CALCULATION |
57 | SUBROUTINE CALC2 |
58 | C |
59 | INTEGER MAXI,WIDTH,CR,LF |
60 | COMMON /PARAM2/MAXI,WIDTH,CR,LF |
61 | REAL LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP |
62 | COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP |
63 | REAL CMPAVL |
64 | REAL ZR,ZI,ZRN |
65 | REAL X,Y |
66 | INTEGER COUNT |
67 | C |
68 | CCCCCC ENTER THE CALCULATION |
69 | 299 CMPVAL=MAXVAL*MAXVAL |
70 | X=LOWX |
71 | Y=HIGHY |
72 | C |
73 | CCCCCC EINSTIEG IN DEN AKTUELLEN PUNKT |
74 | 300 COUNT=0 |
75 | ZR=0.0 |
76 | ZI=0.0 |
77 | C |
78 | CCCCCC HIER DER ITERIERTE TEIL |
79 | C |
80 | 400 ZRN=ZR*ZR-ZI*ZI+X |
81 | ZI=2.0*ZR*ZI+Y |
82 | ZR=ZRN |
83 | C |
84 | IF ((ZR*ZR+ZI*ZI).GE.CMPVAL) GO TO 410 |
85 | COUNT=COUNT+1 |
86 | IF (COUNT.GE.MAXI) GO TO 410 |
87 | GO TO 400 |
88 | C |
89 | CCCCCC PUNKT FERTIG |
90 | 410 IF (COUNT.EQ.MAXI) CALL BLACK |
91 | IF (COUNT.LT.MAXI) CALL WHITE |
92 | CCCCCC NEUEN PUNKT MACHEN |
93 | 500 X = X + XSTEP |
94 | CCCCCC ZEILE NOCH NICHT VOLL? |
95 | IF (X.LE.HIGHX) GO TO 300 |
96 | CCCCCC X AN ANFANG SETZTEN, CR+LF DRUCKEN |
97 | X = LOWX |
98 | CALL PLOTR |
99 | C |
100 | C |
101 | CCCCCC Y WEITERRUECKEN - NEGATIV WEIL WIR VON OBEN KOMMEN |
102 | Y=Y-YSTEP |
103 | IF (Y.GE.LOWY) GO TO 300 |
104 | C |
105 | CCCCCC HIER IST DAS BILD FERTIG. |
106 | RETURN |
107 | END |
108 | CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC |
109 | SUBROUTINE PLOTI |
110 | INTEGER PEN,PENX |
111 | COMMON /PENSTA/PEN,PENX |
c6301d07 |
112 | CALL PL$INI |
113 | CALL PL$SCL(3.0) |
114 | CALL PL$PU |
fcb7b340 |
115 | PEN=0 |
116 | PENX=0 |
117 | RETURN |
118 | END |
119 | C |
120 | SUBROUTINE BLACK |
121 | INTEGER PEN,PENX |
122 | COMMON /PENSTA/PEN,PENX |
123 | CALL PL$R |
124 | IF (PEN.EQ.0) CALL PL$PD |
125 | PEN=1 |
c6301d07 |
126 | CALL PL$U |
fcb7b340 |
127 | CALL PL$R |
c6301d07 |
128 | CALL PL$D |
fcb7b340 |
129 | PENX=PENX+2 |
130 | RETURN |
131 | END |
132 | C |
133 | SUBROUTINE WHITE |
134 | INTEGER PEN,PENX |
135 | COMMON /PENSTA/PEN,PENX |
136 | IF (PEN.EQ.1) CALL PL$PU |
137 | PEN=0 |
138 | CALL PL$R |
139 | CALL PL$R |
140 | PENX=PENX+2 |
141 | RETURN |
142 | END |
143 | C |
144 | SUBROUTINE PLOTR |
145 | INTEGER PEN,PENX |
146 | COMMON /PENSTA/PEN,PENX |
147 | CALL WHITE |
148 | 8000 IF (PENX.EQ.0) GO TO 8100 |
149 | CALL PL$L |
150 | PENX=PENX-1 |
151 | GO TO 8000 |
152 | 8100 CONTINUE |
c6301d07 |
153 | CALL PL$D |
154 | CALL PL$D |
fcb7b340 |
155 | RETURN |
156 | END |
157 | C |
158 | CCCCCC STARTWERTE AUSFUELLEN |
159 | SUBROUTINE STVAL |
160 | C |
161 | INTEGER MAXI,WIDTH,CR,LF |
162 | COMMON /PARAM2/MAXI,WIDTH,CR,LF |
163 | REAL LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP |
164 | COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP |
165 | INTEGER INIT |
166 | COMMON /PARAM3/INIT |
167 | C |
168 | CR = 13 |
169 | LF = 10 |
170 | WIDTH = 100 |
171 | MAXI = 50 |
172 | MAXVAL = 2.0 |
173 | LOWX =-1.48 |
174 | HIGHX = 0.5 |
175 | LOWY =-1.2 |
176 | HIGHY = 1.2 |
177 | INIT = 1 |
178 | C |
179 | CCCCCC SCHRITTWEITEN AUSRECHNEN |
180 | XSTEP = (HIGHX-LOWX)/FLOAT(WIDTH) |
181 | YSTEP = XSTEP |
182 | C |
183 | WRITE (1,1500) |
184 | 1500 FORMAT (20HDEFAULT VALUES USED.) |
185 | RETURN |
186 | END |
187 | C |
188 | C |
189 | CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC |
190 | CCCCCC EINSTELLUNGEN EINLESEN |
191 | SUBROUTINE GETCFG |
192 | C |
193 | INTEGER MAXI,WIDTH,CR,LF |
194 | COMMON /PARAM2/MAXI,WIDTH,CR,LF |
195 | REAL LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP |
196 | COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP |
197 | C |
198 | REAL XIN1,XIN2,YIN1,YIN2 |
199 | C |
200 | WRITE(1,11) |
201 | READ (1,16) XIN1 |
202 | WRITE(1,12) |
203 | READ (1,16) XIN2 |
204 | WRITE(1,13) |
205 | READ (1,16) YIN1 |
206 | WRITE(1,14) |
207 | READ (1,16) YIN2 |
208 | WRITE(1,15) |
209 | READ (1,17) MAXI |
210 | C |
211 | 11 FORMAT(14H X FROM : ) |
212 | 12 FORMAT(14H TO : ) |
213 | 13 FORMAT(14H Y FROM : ) |
214 | 14 FORMAT(14H TO : ) |
215 | 15 FORMAT(14H MAXIT (I3): ) |
216 | 16 FORMAT(F12.0) |
217 | 17 FORMAT(I3) |
218 | C |
219 | CCCCCC EVENTUELL STARTWERTE TAUSCHEN: |
220 | CCCCCC WENN XIN2 GROESSER IST OK, ANSONSTEN TAUSCHEN |
221 | 150 I F(XIN2.GT.XIN1) GO TO 200 |
222 | TEMP = XIN1 |
223 | XIN1 = XIN2 |
224 | XIN2 = TEMP |
225 | C |
226 | CCCCCC WENN YIN2 GROESSER IST OK, ANSONSTEN TAUSCHEN |
227 | 200 IF(YIN2.GT.YIN1) GO TO 201 |
228 | TEMP = YIN1 |
229 | YIN1 = YIN2 |
230 | YIN2 = TEMP |
231 | C |
232 | CCCCCC WERTE UEBERNEHMEN |
233 | 201 LOWX = XIN1 |
234 | HIGHX = XIN2 |
235 | LOWY = YIN1 |
236 | HIGHY = YIN2 |
237 | C |
238 | CCCCCC SCHRITTWEITEN AUSRECHNEN |
239 | XSTEP = (HIGHX-LOWX)/FLOAT(WIDTH) |
240 | YSTEP = 2.0 * XSTEP |
241 | C |
242 | RETURN |
243 | END |
244 | C |
245 | C |
246 | CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC |
247 | CCCCCC EINSTELLUNGEN AUSGEBEN |
248 | SUBROUTINE OUTCFG |
249 | C |
250 | INTEGER MAXI,WIDTH,CR,LF |
251 | COMMON /PARAM2/MAXI,WIDTH,CR,LF |
252 | REAL LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP |
253 | COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP |
254 | C |
255 | WRITE (1,20) |
256 | 20 FORMAT (9HSETTINGS:) |
257 | WRITE (1,30) LOWX, HIGHX |
258 | 30 FORMAT (12HX-WERTE VON ,1F8.5,5H BIS ,1F8.5) |
259 | WRITE (1,40) LOWY, HIGHY |
260 | 40 FORMAT (12HY-WERTE VON ,F8.5,5H BIS ,F8.5) |
261 | WRITE (1,50) MAXI, MAXVAL, XSTEP, YSTEP, WIDTH |
262 | 50 FORMAT ( 4HMAX:,I3, |
263 | + 8H MAXVAL:,F8.5, |
264 | + 7H XSTEP:,F8.5, |
265 | + 7H YSTEP:,F8.5, |
266 | + 7H WIDTH:,I2) |
267 | RETURN |
268 | END |
269 | C |
270 | C |
271 | CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC |
272 | CCCCCC RUECKSETZEN |
273 | SUBROUTINE RST |
274 | C |
275 | INTEGER MAXI,WIDTH,CR,LF |
276 | COMMON /PARAM2/MAXI,WIDTH,CR,LF |
277 | C |
278 | WRITE(1,245) |
279 | 245 FORMAT(25HPARAMETER RESET REQUESTED) |
280 | INIT=0 |
281 | RETURN |
282 | END |
283 | C |
284 | C |
285 | CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC |
286 | C PRELOAD VALUE OF INIT |
287 | BLOCK DATA |
288 | INTEGER INIT |
289 | COMMON /PARAM3/INIT |
290 | DATA INIT/0/ |
291 | END |
292 | CCCCCCCCCCCCCCCCCCCCCCCC |
293 | $0 |