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 PLOTI 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$INI CALL PL$SCL(3.0) CALL PL$PU PEN=0 PENX=0 RETURN END C SUBROUTINE BLACK INTEGER PEN,PENX COMMON /PENSTA/PEN,PENX CALL PL$R IF (PEN.EQ.0) CALL PL$PD PEN=1 CALL PL$U CALL PL$R CALL PL$D PENX=PENX+2 RETURN END C SUBROUTINE WHITE INTEGER PEN,PENX COMMON /PENSTA/PEN,PENX IF (PEN.EQ.1) CALL PL$PU PEN=0 CALL PL$R CALL PL$R PENX=PENX+2 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 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 = 100 MAXI = 50 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 = 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