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