[pdp8.git] / sw / src / f4 / MANDEL.FT

C    APFELMAENNCHEN-PROGRAMM, 02.APRIL.2006 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
       INTEGER PBUFF
       DIMENSION PBUFF(4000)
       DIMENSION PX(1),PY(1)
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                        START MESSAGE
  100  WRITE (4,10)
   10  FORMAT (48H MANDELBROT-DEMO 3RC1) XX.XX.2009, PH. HACHTMANN)
C
C
       CALL CLRPLT(4096,PBUFF)
C
CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
C                        CONFIGURATION
CCCCCC RESET DO DEFAULT VALUES?
C  110  CALL SSWTCH(3,I)
C       IF (I.EQ.1) CALL RST
        CALL RST
C    
CCCCCC ON THE FIRST START OR IF DESIRED
C      IF(INIT.EQ.0) CALL STVAL
C
CCCCCC DO WE HAVE TO ASK FOR PARAMETERS?
C       CALL SSWTCH(1,I)
C       IF (I.EQ.1) CALL GETCFG
C
CCCCCC OUTPUT SETTINGS?      
C       CALL SSWTCH(2,I)
C       IF(I.EQ.2) CALL OUTCFG
      CALL OUTCFG
C
       WRITE (4,55)
   55  FORMAT (1H0)
C
       CALL CALC2
C
       WRITE (4, 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
       SCALE(LOWX,LOWY,HIGHX,HIGHY)
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
      PX(1)=X
      PY(1)=Y
      IF (COUNT.EQ.MAXI) CALL PLOT(1,PX,PY)

  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 (4,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 (4,11)
       READ (1,16) XIN1
       WRITE (4,12)
       READ (1,16) XIN2
       WRITE (4,13)
       READ (1,16) YIN1
       WRITE (4,14)
       READ (1,16) YIN2
       WRITE (4,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 (4,20)
  20   FORMAT (9HSETTINGS:)
       WRITE (4,30) LOWX, HIGHX
  30   FORMAT (12HX-WERTE VON ,1F8.5,5H BIS ,1F8.5)
       WRITE (4,40) LOWY, HIGHY
   40  FORMAT (12HY-WERTE VON ,F8.5,5H BIS ,F8.5)     
       WRITE (4,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 (4,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
C
       SUBROUTINE SSWTCH(INUM,ITARG)
       ITARG=0
       RETURN
       END
C
C
$0
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=ZRZR-ZIZI+X
98	ZI=2.0ZRZI+Y
99	ZR=ZRN
100	C
101	IF ((ZRZR+ZIZI).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