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