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

C    APFELMAENNCHEN-PROGRAMM, 06.FEBRUARY.2007 PHILIPP HACHTMANN
C    INTERMEDIATE VERSION
C
C    THIS VERSION SHOULD RUN A BIT FASTER BECAUSE THE SQUARE
C    ROOT IS OMMITTED.
C
C    SWITCH SETTINGS:
C    SENSE-SWITCH 1: IF SET, ASK FOR PARAMETERS
C    SENSE-SWITCH 2: IF SET, DON'T PRINT PARAMETERS ON START
C    SENSE-SWITCH 3: IF SET, RESTORE PARAMETERS TO DEFAULT VALUES
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                        COMMON BLOCK DECLARATIONS
C
       INTEGER        MAXI,WIDTH,CR,LF,POSI,NEGA
       COMMON /PARAM2/MAXI,WIDTH,CR,LF,POSI,NEGA
C
       REAL           LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
       COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
C
       INTEGER INIT
       COMMON /PARAM3/INIT
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                        START MESSAGE
  100  WRITE (1,10)
   10  FORMAT (46HMANDELBROT-DEMO 4 06.01.2007, PH. HACHTMANN,
     + 20H - PRELIMIMARY ISSUE)
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                        CONFIGURATION
CCCCCC RESET DO DEFAULT VALUES?
  110  CALL SSWTCH(3,I)
       IF (I.EQ.1) CALL RST
C    
CCCCCC ON THE FIRST START OR IF DESIRED
       IF(INIT.EQ.0) CALL STVAL
C
CCCCCC DO WE HAVE TO ASK FOR PARAMETERS?
       CALL SSWTCH(1,I)
       IF (I.EQ.1) CALL GETCFG
C
CCCCCC OUTPUT SETTINGS?      
       CALL SSWTCH(2,I)
       IF(I.EQ.2) CALL OUTCFG
C
       WRITE  (1,55)
   55  FORMAT (1H0)
C
       CALL CALC2
C
       WRITE(1, 60)
   60  FORMAT (5HREADY)
C
CCCCCC BREAK WITH 7 in A REG, THEN START OVER
C       CALL PWAIT
       PAUSE 7
       GO TO 100
       END
C      END OF MAIN PROGRAM
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCC THE MANDELBROT SET CALCULATION
       SUBROUTINE CALC2
C            
       INTEGER        MAXI,WIDTH,CR,LF
       COMMON /PARAM2/MAXI,WIDTH,CR,LF
       REAL           LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
       COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
       REAL CMPAVL
       REAL ZR,ZI,ZRN
       REAL X,Y
       INTEGER COUNT
C
CCCCCC ENTER THE CALCULATION
  299  CMPVAL=MAXVAL*MAXVAL
       X=LOWX
       Y=HIGHY
C     
CCCCCC EINSTIEG IN DEN AKTUELLEN PUNKT
  300  COUNT=0
       ZR=0.0
       ZI=0.0
C
CCCCCC HIER DER ITERIERTE TEIL
C
  400 ZRN=ZR*ZR-ZI*ZI+X
      ZI=2.0*ZR*ZI+Y
      ZR=ZRN
C
       IF ((ZR*ZR+ZI*ZI).GE.CMPVAL) GO TO 410
       COUNT=COUNT+1
       IF (COUNT.GE.MAXI)     GO TO 410
       GO TO 400
C
CCCCCC PUNKT FERTIG
  410  NOUT=32
C       IF (COUNT.GE.8) NOUT=46
C       IF (COUNT.GE.23) NOUT=43
C       IF (COUNT.EQ.MAXI) NOUT=64
       IF (COUNT.GE.8) NOUT=46
       IF (COUNT.GE.23) NOUT=43
       IF (COUNT.EQ.MAXI) NOUT=64

  411  CALL PCHAR(NOUT)
       GO TO 500
C
CCCCCC NEUEN PUNKT MACHEN
  500  X = X + XSTEP
CCCCCC ZEILE NOCH NICHT VOLL?
       IF (X.LE.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.GE.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
       COMMON /PARAM2/MAXI,WIDTH,CR,LF
       REAL           LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
       COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
       INTEGER INIT
       COMMON /PARAM3/INIT
C
       CR      = 13 
       LF      = 10
       WIDTH   = 68
       MAXI    = 60
       MAXVAL  = 2.0
       LOWX    =-1.48
       HIGHX   = 0.5
       LOWY    =-1.2
       HIGHY   = 1.2
       INIT    =  1
C  
CCCCCC SCHRITTWEITEN AUSRECHNEN
       XSTEP = (HIGHX-LOWX)/FLOAT(WIDTH)
       YSTEP = 2.0 * XSTEP
C
       WRITE (1,1500)
 1500  FORMAT (20HDEFAULT VALUES USED.)
       RETURN
       END
C
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
CCCCCC EINSTELLUNGEN EINLESEN
       SUBROUTINE GETCFG
C
       INTEGER        MAXI,WIDTH,CR,LF
       COMMON /PARAM2/MAXI,WIDTH,CR,LF
       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
       COMMON /PARAM2/MAXI,WIDTH,CR,LF
       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
       COMMON /PARAM2/MAXI,WIDTH,CR,LF
C
       WRITE(1,245)
  245  FORMAT(25HPARAMETER RESET REQUESTED)
       INIT=0
       RETURN
       END
C
C       
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                        PRELOAD VALUE OF INIT
       BLOCK DATA
       INTEGER INIT
       COMMON /PARAM3/INIT
       DATA INIT/0/ 
       END
CCCCCCCCCCCCCCCCCCCCCCCC
$0
Commit	Line	Data
0b8fa875	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 START MESSAGE
	26	100 WRITE (1,10)
1f281d48	27	10 FORMAT (46HMANDELBROT-DEMO 4 06.01.2007, PH. HACHTMANN,
0b8fa875	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=ZRZR-ZIZI+X
	88	ZI=2.0ZRZI+Y
	89	ZR=ZRN
	90	C
	91	IF ((ZRZR+ZIZI).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