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