--- /dev/null
+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
projects / pdp8.git / blobdiff