X-Git-Url: http://gitweb.hachti.de/?a=blobdiff_plain;f=sw%2Fsrc%2Ff4%2FMANDEL.FT;fp=sw%2Fsrc%2Ff4%2FMANDEL.FT;h=fd0d970ab3b0e4e7bb1545c41a7d72e3363816f5;hb=81e70d488b71bf995c459ca3a02c025993460ffa;hp=0000000000000000000000000000000000000000;hpb=07ec0278333ed187ac242dedcff13c56cf1b0b91;p=pdp8.git diff --git a/sw/src/f4/MANDEL.FT b/sw/src/f4/MANDEL.FT new file mode 100644 index 0000000..fd0d970 --- /dev/null +++ b/sw/src/f4/MANDEL.FT @@ -0,0 +1,279 @@ +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