[h316.git] / programs / mandelbrot / src / apfel2.f

C    APFELMAENNCHEN-PROGRAMM, 29.DEC.2004 PHILIPP HACHTMANN
C
C    SENSE-SWITCH 1: WENN GESETZT, KONFIGURATION
C    SENSE-SWITCH 2: WENN GESETZT, KEINE AUSGABE DER EINSTELLUNGEN
C    SENSE-SWITCH 3: WENN GESETZT, STARTWERTE WIEDERHERSTELLEN
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                        COMMON BLOCK DEKLARATIONEN
C
       INTEGER        MAXI,WIDTH,CR,LF,POSI,NEGA,INIT
       COMMON /PARAM2/MAXI,WIDTH,CR,LF,POSI,NEGA,INIT
C
       REAL           LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
       COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
C
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                        STARTMELDUNG
  100  WRITE (1,10)
       WRITE (1,11)
   10  FORMAT (45HMANDELBROT-DEMO NO.2, 29.DEC.2004 HACHTI :-)  )
   11  FORMAT (26HSEE HTTP://H316.HACHTI.DE  )
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                        KONFIGURATION
CCCCCC RUECKSETZEN AUF DEFAULTWERTE?      
       CALL SSWTCH(3,I)
       IF (I.EQ.1) CALL RST
C
C    
CCCCCC BEIM ERSTEN START ODER WENN VERLANGT
       IF(INIT.EQ.0) CALL STVAL
C       
C
CCCCCC EINGABEN VERARBEITEN?
       CALL SSWTCH(1,I)
       IF (I.EQ.1) CALL GETCFG
C 
C
CCCCCC AUSGABE?      
       CALL SSWTCH(2,I)
       IF(I.EQ.2) CALL OUTCFG
C
       WRITE  (1,55)
   55  FORMAT (1H0)
C
       CALL CALC
C
       WRITE(1, 60)
   60  FORMAT (6HFERTIG)
C
CCCCCC KURZE PAUSE, DANN NEUSTART
       PAUSE 7
       GO TO 100
       END
C
C
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                        EIGENTLICHE BERECHNUNG
       SUBROUTINE CALC
C            
       INTEGER        MAXI,WIDTH,CR,LF,POSI,NEGA,INIT
       COMMON /PARAM2/MAXI,WIDTH,CR,LF,POSI,NEGA,INIT
       REAL           LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
       COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
C
       COMPLEX C,Z
       REAL X,Y
       INTEGER COUNT
C
CCCCCC EINSTIEG IN BERECHNUNG
  299  X=LOWX
       Y=HIGHY
C     
CCCCCC EINSTIEG IN DEN AKTUELLEN PUNKT
  300  C=CMPLX(X,Y)
       COUNT=0
       Z=(0.0,0.0)
C
CCCCCC HIER DER ITERIERTE TEIL
C
  400  Z=Z*Z+C
C
       IF ((CABS(Z)).GE.MAXVAL) GO TO 410
       COUNT=COUNT+1
       IF (COUNT.GE.MAXI)     GO TO 420
       GO TO 400
C
CCCCCC PUNKT DURCHGEFALLEN       
  410   CALL PCHAR(NEGA)
        GO TO 500
C
CCCCCC PUNKT HAT MAXI ERREICHT
  420   CALL PCHAR(POSI)
C
CCCCCC NEUEN PUNKT MACHEN
  500  X = X + XSTEP
CCCCCC ZEILE NOCH NICHT VOLL?
       IF (X.LT.HIGHX) GO TO 300
CCCCCC X AN ANFANG SETZTEN, CR+LF DRUCKEN
       X = LOWX
       CALL PCHAR(CR)
       CALL PCHAR(LF)
CCCCCC Y WEITERRUECKEN - NEGATIV WEIL WIR VON OBEN KOMMEN
       Y=Y-YSTEP
       IF (Y.GT.LOWY) GO TO 300
C
CCCCCC HIER IST DAS BILD FERTIG.       
       RETURN
       END 
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCC STARTWERTE AUSFUELLEN
       SUBROUTINE STVAL
C
       INTEGER        MAXI,WIDTH,CR,LF,POSI,NEGA,INIT
       COMMON /PARAM2/MAXI,WIDTH,CR,LF,POSI,NEGA,INIT
       REAL           LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
       COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
C
       CR      = 13 
       LF      = 10
       POSI    = 79
       NEGA    = 32
       WIDTH   = 70
       MAXI    = 60
       MAXVAL  = 2.0
       LOWX    =-1.45
       HIGHX   = 0.45
       LOWY    =-1.00
       HIGHY   = 1.00
       INIT    =  1
C  
CCCCCC SCHRITTWEITEN AUSRECHNEN
       XSTEP = (HIGHX-LOWX)/FLOAT(WIDTH)
       YSTEP = 2.0 * XSTEP
C
       WRITE (1,1500)
 1500  FORMAT (19HSTARTWERTE GESETZT.)
       RETURN
       END
C
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCC EINSTELLUNGEN EINLESEN
       SUBROUTINE GETCFG
C
       INTEGER        MAXI,WIDTH,CR,LF,POSI,NEGA,INIT
       COMMON /PARAM2/MAXI,WIDTH,CR,LF,POSI,NEGA,INIT
       REAL           LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
       COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
C
       REAL XIN1,XIN2,YIN1,YIN2
C
       WRITE(1,11)
       READ (1,16) XIN1
       WRITE(1,12)
       READ (1,16) XIN2
       WRITE(1,13)
       READ (1,16) YIN1
       WRITE(1,14)
       READ (1,16) YIN2
       WRITE(1,15)
       READ (1,17) MAXI
C
   11  FORMAT(14H X FROM     : )
   12  FORMAT(14H     TO     : )       
   13  FORMAT(14H Y FROM     : )
   14  FORMAT(14H     TO     : )
   15  FORMAT(14H  MAXIT (I3): )
   16  FORMAT(F12.0)
   17  FORMAT(I3)
C
CCCCCC EVENTUELL STARTWERTE TAUSCHEN:
CCCCCC WENN XIN2 GROESSER IST OK, ANSONSTEN TAUSCHEN
  150  I F(XIN2.GT.XIN1) GO TO 200
       TEMP = XIN1
       XIN1 = XIN2
       XIN2 = TEMP
C       
CCCCCC WENN YIN2 GROESSER IST OK, ANSONSTEN TAUSCHEN
  200  IF(YIN2.GT.YIN1) GO TO 201
       TEMP = YIN1
       YIN1 = YIN2
       YIN2 = TEMP
C
CCCCCC WERTE UEBERNEHMEN
  201  LOWX  = XIN1
       HIGHX = XIN2
       LOWY  = YIN1
       HIGHY = YIN2
C
CCCCCC SCHRITTWEITEN AUSRECHNEN
       XSTEP = (HIGHX-LOWX)/FLOAT(WIDTH)
       YSTEP = 2.0 * XSTEP
C
       RETURN
       END       
C
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCC EINSTELLUNGEN AUSGEBEN
       SUBROUTINE OUTCFG
C
       INTEGER        MAXI,WIDTH,CR,LF,POSI,NEGA,INIT
       COMMON /PARAM2/MAXI,WIDTH,CR,LF,POSI,NEGA,INIT
       REAL           LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
       COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
C
       WRITE  (1,20)
  20   FORMAT (9HSETTINGS:)
       WRITE  (1,30) LOWX, HIGHX
  30   FORMAT (12HX-WERTE VON ,1F8.5,5H BIS ,1F8.5)
       WRITE  (1,40) LOWY, HIGHY
   40  FORMAT (12HY-WERTE VON ,F8.5,5H BIS ,F8.5)     
       WRITE  (1,50) MAXI, MAXVAL, XSTEP, YSTEP, WIDTH
   50  FORMAT (   4HMAX:,I3,
     +        8H MAXVAL:,F8.5,
     +         7H XSTEP:,F8.5,
     +         7H YSTEP:,F8.5,
     +         7H WIDTH:,I2)
       RETURN
       END
C
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCC RUECKSETZEN
       SUBROUTINE RST
C
       INTEGER        MAXI,WIDTH,CR,LF,POSI,NEGA,INIT
       COMMON /PARAM2/MAXI,WIDTH,CR,LF,POSI,NEGA,INIT
C
       WRITE(1,245)
  245  FORMAT(24HRUECKSETZUNG GEWUENSCHT )
       INIT=0
       RETURN
       END
C
C       
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                        KONSTANTE WERTE
       BLOCK DATA
       INTEGER        MAXI,WIDTH,CR,LF,POSI,NEGA,INIT
       COMMON /PARAM2/MAXI,WIDTH,CR,LF,POSI,NEGA,INIT
       DATA INIT/0/ 
       END
CCCCCCCCCCCCCCCCCCCCCCCC
$0
Commit	Line	Data
c08e22bb	1	C APFELMAENNCHEN-PROGRAMM, 29.DEC.2004 PHILIPP HACHTMANN
	2	C
	3	C SENSE-SWITCH 1: WENN GESETZT, KONFIGURATION
	4	C SENSE-SWITCH 2: WENN GESETZT, KEINE AUSGABE DER EINSTELLUNGEN
	5	C SENSE-SWITCH 3: WENN GESETZT, STARTWERTE WIEDERHERSTELLEN
	6	C
	7	CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
	8	C COMMON BLOCK DEKLARATIONEN
	9	C
	10	INTEGER MAXI,WIDTH,CR,LF,POSI,NEGA,INIT
	11	COMMON /PARAM2/MAXI,WIDTH,CR,LF,POSI,NEGA,INIT
	12	C
	13	REAL LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
	14	COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
	15	C
	16	C
	17	CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
	18	C STARTMELDUNG
	19	100 WRITE (1,10)
	20	WRITE (1,11)
	21	10 FORMAT (45HMANDELBROT-DEMO NO.2, 29.DEC.2004 HACHTI :-) )
	22	11 FORMAT (26HSEE HTTP://H316.HACHTI.DE )
	23	C
	24	CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
	25	C KONFIGURATION
	26	CCCCCC RUECKSETZEN AUF DEFAULTWERTE?
	27	CALL SSWTCH(3,I)
	28	IF (I.EQ.1) CALL RST
	29	C
	30	C
	31	CCCCCC BEIM ERSTEN START ODER WENN VERLANGT
	32	IF(INIT.EQ.0) CALL STVAL
	33	C
	34	C
	35	CCCCCC EINGABEN VERARBEITEN?
	36	CALL SSWTCH(1,I)
	37	IF (I.EQ.1) CALL GETCFG
	38	C
	39	C
	40	CCCCCC AUSGABE?
	41	CALL SSWTCH(2,I)
	42	IF(I.EQ.2) CALL OUTCFG
	43	C
	44	WRITE (1,55)
	45	55 FORMAT (1H0)
	46	C
	47	CALL CALC
	48	C
	49	WRITE(1, 60)
	50	60 FORMAT (6HFERTIG)
	51	C
	52	CCCCCC KURZE PAUSE, DANN NEUSTART
	53	PAUSE 7
	54	GO TO 100
	55	END
	56	C
	57	C
	58	C
	59	CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
	60	C EIGENTLICHE BERECHNUNG
	61	SUBROUTINE CALC
	62	C
	63	INTEGER MAXI,WIDTH,CR,LF,POSI,NEGA,INIT
	64	COMMON /PARAM2/MAXI,WIDTH,CR,LF,POSI,NEGA,INIT
65	REAL LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
66	COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
67	C
68	COMPLEX C,Z
69	REAL X,Y
70	INTEGER COUNT
71	C
72	CCCCCC EINSTIEG IN BERECHNUNG
73	299 X=LOWX
74	Y=HIGHY
75	C
76	CCCCCC EINSTIEG IN DEN AKTUELLEN PUNKT
77	300 C=CMPLX(X,Y)
78	COUNT=0
79	Z=(0.0,0.0)
80	C
81	CCCCCC HIER DER ITERIERTE TEIL
82	C
83	400 Z=Z*Z+C
84	C
85	IF ((CABS(Z)).GE.MAXVAL) GO TO 410
86	COUNT=COUNT+1
87	IF (COUNT.GE.MAXI) GO TO 420
88	GO TO 400
89	C
90	CCCCCC PUNKT DURCHGEFALLEN
91	410 CALL PCHAR(NEGA)
92	GO TO 500
93	C
94	CCCCCC PUNKT HAT MAXI ERREICHT
95	420 CALL PCHAR(POSI)
96	C
97	CCCCCC NEUEN PUNKT MACHEN
98	500 X = X + XSTEP
99	CCCCCC ZEILE NOCH NICHT VOLL?
100	IF (X.LT.HIGHX) GO TO 300
101	CCCCCC X AN ANFANG SETZTEN, CR+LF DRUCKEN
102	X = LOWX
103	CALL PCHAR(CR)
104	CALL PCHAR(LF)
105	CCCCCC Y WEITERRUECKEN - NEGATIV WEIL WIR VON OBEN KOMMEN
106	Y=Y-YSTEP
107	IF (Y.GT.LOWY) GO TO 300
108	C
109	CCCCCC HIER IST DAS BILD FERTIG.
110	RETURN
111	END
112	CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
113	CCCCCC STARTWERTE AUSFUELLEN
114	SUBROUTINE STVAL
115	C
116	INTEGER MAXI,WIDTH,CR,LF,POSI,NEGA,INIT
117	COMMON /PARAM2/MAXI,WIDTH,CR,LF,POSI,NEGA,INIT
118	REAL LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
119	COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
120	C
121	CR = 13
122	LF = 10
123	POSI = 79
124	NEGA = 32
125	WIDTH = 70
126	MAXI = 60
127	MAXVAL = 2.0
128	LOWX =-1.45
129	HIGHX = 0.45
130	LOWY =-1.00
131	HIGHY = 1.00
132	INIT = 1
133	C
134	CCCCCC SCHRITTWEITEN AUSRECHNEN
135	XSTEP = (HIGHX-LOWX)/FLOAT(WIDTH)
136	YSTEP = 2.0 * XSTEP
137	C
138	WRITE (1,1500)
139	1500 FORMAT (19HSTARTWERTE GESETZT.)
140	RETURN
141	END
142	C
143	C
144	CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
145	CCCCCC EINSTELLUNGEN EINLESEN
146	SUBROUTINE GETCFG
147	C
148	INTEGER MAXI,WIDTH,CR,LF,POSI,NEGA,INIT
149	COMMON /PARAM2/MAXI,WIDTH,CR,LF,POSI,NEGA,INIT
150	REAL LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
151	COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
152	C
153	REAL XIN1,XIN2,YIN1,YIN2
154	C
155	WRITE(1,11)
156	READ (1,16) XIN1
157	WRITE(1,12)
158	READ (1,16) XIN2
159	WRITE(1,13)
160	READ (1,16) YIN1
161	WRITE(1,14)
162	READ (1,16) YIN2
163	WRITE(1,15)
164	READ (1,17) MAXI
165	C
166	11 FORMAT(14H X FROM : )
167	12 FORMAT(14H TO : )
168	13 FORMAT(14H Y FROM : )
169	14 FORMAT(14H TO : )
170	15 FORMAT(14H MAXIT (I3): )
171	16 FORMAT(F12.0)
172	17 FORMAT(I3)
173	C
174	CCCCCC EVENTUELL STARTWERTE TAUSCHEN:
175	CCCCCC WENN XIN2 GROESSER IST OK, ANSONSTEN TAUSCHEN
176	150 I F(XIN2.GT.XIN1) GO TO 200
177	TEMP = XIN1
178	XIN1 = XIN2
179	XIN2 = TEMP
180	C
181	CCCCCC WENN YIN2 GROESSER IST OK, ANSONSTEN TAUSCHEN
182	200 IF(YIN2.GT.YIN1) GO TO 201
183	TEMP = YIN1
184	YIN1 = YIN2
185	YIN2 = TEMP
186	C
187	CCCCCC WERTE UEBERNEHMEN
188	201 LOWX = XIN1
189	HIGHX = XIN2
190	LOWY = YIN1
191	HIGHY = YIN2
192	C
193	CCCCCC SCHRITTWEITEN AUSRECHNEN
194	XSTEP = (HIGHX-LOWX)/FLOAT(WIDTH)
195	YSTEP = 2.0 * XSTEP
196	C
197	RETURN
198	END
199	C
200	C
201	CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
202	CCCCCC EINSTELLUNGEN AUSGEBEN
203	SUBROUTINE OUTCFG
204	C
205	INTEGER MAXI,WIDTH,CR,LF,POSI,NEGA,INIT
206	COMMON /PARAM2/MAXI,WIDTH,CR,LF,POSI,NEGA,INIT
207	REAL LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
208	COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
209	C
210	WRITE (1,20)
211	20 FORMAT (9HSETTINGS:)
212	WRITE (1,30) LOWX, HIGHX
213	30 FORMAT (12HX-WERTE VON ,1F8.5,5H BIS ,1F8.5)
214	WRITE (1,40) LOWY, HIGHY
215	40 FORMAT (12HY-WERTE VON ,F8.5,5H BIS ,F8.5)
216	WRITE (1,50) MAXI, MAXVAL, XSTEP, YSTEP, WIDTH
217	50 FORMAT ( 4HMAX:,I3,
218	+ 8H MAXVAL:,F8.5,
219	+ 7H XSTEP:,F8.5,
220	+ 7H YSTEP:,F8.5,
221	+ 7H WIDTH:,I2)
222	RETURN
223	END
224	C
225	C
226	CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
227	CCCCCC RUECKSETZEN
228	SUBROUTINE RST
229	C
230	INTEGER MAXI,WIDTH,CR,LF,POSI,NEGA,INIT
231	COMMON /PARAM2/MAXI,WIDTH,CR,LF,POSI,NEGA,INIT
232	C
233	WRITE(1,245)
234	245 FORMAT(24HRUECKSETZUNG GEWUENSCHT )
235	INIT=0
236	RETURN
237	END
238	C
239	C
240	CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
241	C KONSTANTE WERTE
242	BLOCK DATA
243	INTEGER MAXI,WIDTH,CR,LF,POSI,NEGA,INIT
244	COMMON /PARAM2/MAXI,WIDTH,CR,LF,POSI,NEGA,INIT
245	DATA INIT/0/
246	END
247	CCCCCCCCCCCCCCCCCCCCCCCC
248	$0