C APFELMAENNCHEN-PROGRAMM, 29.DEC.2004 PHILIPP HACHTMANN C C SENSE-SWITCH 1: WENN GESETZT, KONFIGURATION C SENSE-SWITCH 2: WENN GESETZT, KEINE AUSGABE DER EINSTELLUNGEN C SENSE-SWITCH 3: WENN GESETZT, STARTWERTE WIEDERHERSTELLEN C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C COMMON BLOCK DEKLARATIONEN C INTEGER MAXI,WIDTH,CR,LF,POSI,NEGA,INIT COMMON /PARAM2/MAXI,WIDTH,CR,LF,POSI,NEGA,INIT C REAL LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C STARTMELDUNG 100 WRITE (1,10) WRITE (1,11) 10 FORMAT (45HMANDELBROT-DEMO NO.2, 29.DEC.2004 HACHTI :-) ) 11 FORMAT (26HSEE HTTP://H316.HACHTI.DE ) C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C KONFIGURATION CCCCCC RUECKSETZEN AUF DEFAULTWERTE? CALL SSWTCH(3,I) IF (I.EQ.1) CALL RST C C CCCCCC BEIM ERSTEN START ODER WENN VERLANGT IF(INIT.EQ.0) CALL STVAL C C CCCCCC EINGABEN VERARBEITEN? CALL SSWTCH(1,I) IF (I.EQ.1) CALL GETCFG C C CCCCCC AUSGABE? CALL SSWTCH(2,I) IF(I.EQ.2) CALL OUTCFG C WRITE (1,55) 55 FORMAT (1H0) C CALL CALC C WRITE(1, 60) 60 FORMAT (6HFERTIG) C CCCCCC KURZE PAUSE, DANN NEUSTART PAUSE 7 GO TO 100 END C C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C EIGENTLICHE BERECHNUNG SUBROUTINE CALC C INTEGER MAXI,WIDTH,CR,LF,POSI,NEGA,INIT COMMON /PARAM2/MAXI,WIDTH,CR,LF,POSI,NEGA,INIT REAL LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP C COMPLEX C,Z REAL X,Y INTEGER COUNT C CCCCCC EINSTIEG IN BERECHNUNG 299 X=LOWX Y=HIGHY C CCCCCC EINSTIEG IN DEN AKTUELLEN PUNKT 300 C=CMPLX(X,Y) COUNT=0 Z=(0.0,0.0) C CCCCCC HIER DER ITERIERTE TEIL C 400 Z=Z*Z+C C IF ((CABS(Z)).GE.MAXVAL) GO TO 410 COUNT=COUNT+1 IF (COUNT.GE.MAXI) GO TO 420 GO TO 400 C CCCCCC PUNKT DURCHGEFALLEN 410 CALL PCHAR(NEGA) GO TO 500 C CCCCCC PUNKT HAT MAXI ERREICHT 420 CALL PCHAR(POSI) C CCCCCC NEUEN PUNKT MACHEN 500 X = X + XSTEP CCCCCC ZEILE NOCH NICHT VOLL? IF (X.LT.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.GT.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,POSI,NEGA,INIT COMMON /PARAM2/MAXI,WIDTH,CR,LF,POSI,NEGA,INIT REAL LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP C CR = 13 LF = 10 POSI = 79 NEGA = 32 WIDTH = 70 MAXI = 60 MAXVAL = 2.0 LOWX =-1.45 HIGHX = 0.45 LOWY =-1.00 HIGHY = 1.00 INIT = 1 C CCCCCC SCHRITTWEITEN AUSRECHNEN XSTEP = (HIGHX-LOWX)/FLOAT(WIDTH) YSTEP = 2.0 * XSTEP C WRITE (1,1500) 1500 FORMAT (19HSTARTWERTE GESETZT.) RETURN END C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC CCCCCC EINSTELLUNGEN EINLESEN SUBROUTINE GETCFG C INTEGER MAXI,WIDTH,CR,LF,POSI,NEGA,INIT COMMON /PARAM2/MAXI,WIDTH,CR,LF,POSI,NEGA,INIT 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,POSI,NEGA,INIT COMMON /PARAM2/MAXI,WIDTH,CR,LF,POSI,NEGA,INIT 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,POSI,NEGA,INIT COMMON /PARAM2/MAXI,WIDTH,CR,LF,POSI,NEGA,INIT C WRITE(1,245) 245 FORMAT(24HRUECKSETZUNG GEWUENSCHT ) INIT=0 RETURN END C C CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC C KONSTANTE WERTE BLOCK DATA INTEGER MAXI,WIDTH,CR,LF,POSI,NEGA,INIT COMMON /PARAM2/MAXI,WIDTH,CR,LF,POSI,NEGA,INIT DATA INIT/0/ END CCCCCCCCCCCCCCCCCCCCCCCC $0