From: hachti Date: Tue, 6 Feb 2007 22:50:11 +0000 (+0000) Subject: *** empty log message *** X-Git-Url: http://gitweb.hachti.de/?a=commitdiff_plain;h=0b8fa8754893006b8a88448dbd32ac21ce911731;p=h316.git *** empty log message *** --- diff --git a/programs/mandelbrot/Makefile b/programs/mandelbrot/Makefile index 06f5dd1..b1bd6d8 100644 --- a/programs/mandelbrot/Makefile +++ b/programs/mandelbrot/Makefile @@ -3,10 +3,17 @@ ASM=$(H316)/bin/asm FRTN=$(H316)/bin/frtn +default: build/apfel3.obj build/apfel4.obj + build/apfel3.obj : src/apfel3.f @if [ ! -d build ]; then mkdir build; fi $(FRTN) src/apfel3.f && mv apfel3.obj build + +build/apfel4.obj : src/apfel4.f + @if [ ! -d build ]; then mkdir build; fi + $(FRTN) src/apfel4.f && mv apfel4.obj build + clean : @rm -rf *.obj build/ *.lst *.go *.par diff --git a/programs/mandelbrot/src/apfel4.f b/programs/mandelbrot/src/apfel4.f new file mode 100644 index 0000000..cadee73 --- /dev/null +++ b/programs/mandelbrot/src/apfel4.f @@ -0,0 +1,259 @@ +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 3RC1 02.04.2006, 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