*** empty log message ***
[h316.git] / programs / mandelbrot / src / apfel3.f
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
56 C CALL PWAIT
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
98 C IF (COUNT.GE.8) NOUT=46
99 C IF (COUNT.GE.23) NOUT=43
100 C IF (COUNT.EQ.MAXI) NOUT=64
101 IF (COUNT.GE.8) NOUT=46
102 IF (COUNT.GE.23) NOUT=43
103 IF (COUNT.EQ.MAXI) NOUT=64
104
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
136 WIDTH = 68
137 MAXI = 60
138 MAXVAL = 2.0
139 LOWX =-1.48
140 HIGHX = 0.5
141 LOWY =-1.2
142 HIGHY = 1.2
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