sw/src/mandel_screen/CALC2.FT

   1 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
   2 CCCCCC THE MANDELBROT SET CALCULATION
   3        SUBROUTINE CALC2
   4 C
   5        INTEGER        MAXI,WIDTH,CR,LF
   6        COMMON /PARAM2/MAXI,WIDTH,CR,LF
   7        REAL           LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
   8        COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
   9        REAL CMPVAL
  10        REAL ZR,ZI,ZRN
  11        REAL X,Y
  12        REAL PX,PY
  13        DIMENSION PX(1),PY(1)
  14        INTEGER COUNT
  15 C
  16        CALL SCALE(LOWX,LOWY,HIGHX,HIGHY)
  17 C
  18 CCCCCC ENTER THE CALCULATION
  19   299  CMPVAL=MAXVAL*MAXVAL
  20        X=LOWX
  21        Y=HIGHY
  22 C
  23 CCCCCC EINSTIEG IN DEN AKTUELLEN PUNKT
  24   300  COUNT=0
  25        ZR=0.0
  26        ZI=0.0
  27 C
  28 CCCCCC HIER DER ITERIERTE TEIL
  29 C
  30   400 ZRN=ZR*ZR-ZI*ZI+X
  31       ZI=2.0*ZR*ZI+Y
  32       ZR=ZRN
  33 C
  34        IF ((ZR*ZR+ZI*ZI).GE.CMPVAL) GO TO 410
  35        COUNT=COUNT+1
  36        IF (COUNT.GE.MAXI)     GO TO 410
  37        GO TO 400
  38 C
  39 CCCCCC PUNKT FERTIG
  40   410  NOUT=32
  41 C       IF (COUNT.GE.8) NOUT=46
  42 C       IF (COUNT.GE.23) NOUT=43
  43 C       IF (COUNT.EQ.MAXI) NOUT=64
  44        IF (COUNT.GE.8) NOUT=46
  45        IF (COUNT.GE.23) NOUT=43
  46        IF (COUNT.EQ.MAXI) NOUT=64
  47       PX(1)=X
  48       PY(1)=Y
  49       CALL RSW(8,I)
  50       IF (COUNT.EQ.MAXI) CALL PLOT(1,PX,PY)
  51       IF(I.EQ.1) GO TO 500
  52 C
  53 CC  411  CALL PCHAR(NOUT)
  54 C
  55 CCCCCC NEUEN PUNKT MACHEN
  56   500  X = X + XSTEP
  57 CCCCCC ZEILE NOCH NICHT VOLL?
  58        IF (X.LE.HIGHX) GO TO 300
  59 CCCCCC X AN ANFANG SETZTEN, CR+LF DRUCKEN
  60        X = LOWX
  61 CC     CALL PCHAR(13)
  62        IF(I.EQ.1) GO TO 501
  63 CC     CALL PCHAR(10)
  64 CCCCCC Y WEITERRUECKEN - NEGATIV WEIL WIR VON OBEN KOMMEN
  65 501    Y=Y-YSTEP
  66        IF (Y.GE.LOWY) GO TO 300
  67 C
  68 CCCCCC HIER IST DAS BILD FERTIG.
  69        RETURN
  70        END