programs/mandelbrot/src/apfel2.f

   1 C    APFELMAENNCHEN-PROGRAMM, 29.DEC.2004 PHILIPP HACHTMANN
   2 C
   3 C    SENSE-SWITCH 1: WENN GESETZT, KONFIGURATION
   4 C    SENSE-SWITCH 2: WENN GESETZT, KEINE AUSGABE DER EINSTELLUNGEN
   5 C    SENSE-SWITCH 3: WENN GESETZT, STARTWERTE WIEDERHERSTELLEN
   6 C
   7 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
   8 C                        COMMON BLOCK DEKLARATIONEN
   9 C
  10        INTEGER        MAXI,WIDTH,CR,LF,POSI,NEGA,INIT
  11        COMMON /PARAM2/MAXI,WIDTH,CR,LF,POSI,NEGA,INIT
  12 C
  13        REAL           LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
  14        COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
  15 C
  16 C
  17 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  18 C                        STARTMELDUNG
  19   100  WRITE (1,10)
  20        WRITE (1,11)
  21    10  FORMAT (45HMANDELBROT-DEMO NO.2, 29.DEC.2004 HACHTI :-)  )
  22    11  FORMAT (26HSEE HTTP://H316.HACHTI.DE  )
  23 C
  24 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  25 C                        KONFIGURATION
  26 CCCCCC RUECKSETZEN AUF DEFAULTWERTE?
  27        CALL SSWTCH(3,I)
  28        IF (I.EQ.1) CALL RST
  29 C
  30 C
  31 CCCCCC BEIM ERSTEN START ODER WENN VERLANGT
  32        IF(INIT.EQ.0) CALL STVAL
  33 C
  34 C
  35 CCCCCC EINGABEN VERARBEITEN?
  36        CALL SSWTCH(1,I)
  37        IF (I.EQ.1) CALL GETCFG
  38 C
  39 C
  40 CCCCCC AUSGABE?
  41        CALL SSWTCH(2,I)
  42        IF(I.EQ.2) CALL OUTCFG
  43 C
  44        WRITE  (1,55)
  45    55  FORMAT (1H0)
  46 C
  47        CALL CALC
  48 C
  49        WRITE(1, 60)
  50    60  FORMAT (6HFERTIG)
  51 C
  52 CCCCCC KURZE PAUSE, DANN NEUSTART
  53        PAUSE 7
  54        GO TO 100
  55        END
  56 C
  57 C
  58 C
  59 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  60 C                        EIGENTLICHE BERECHNUNG
  61        SUBROUTINE CALC
  62 C
  63        INTEGER        MAXI,WIDTH,CR,LF,POSI,NEGA,INIT
  64        COMMON /PARAM2/MAXI,WIDTH,CR,LF,POSI,NEGA,INIT
  65        REAL           LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
  66        COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
  67 C
  68        COMPLEX C,Z
  69        REAL X,Y
  70        INTEGER COUNT
  71 C
  72 CCCCCC EINSTIEG IN BERECHNUNG
  73   299  X=LOWX
  74        Y=HIGHY
  75 C
  76 CCCCCC EINSTIEG IN DEN AKTUELLEN PUNKT
  77   300  C=CMPLX(X,Y)
  78        COUNT=0
  79        Z=(0.0,0.0)
  80 C
  81 CCCCCC HIER DER ITERIERTE TEIL
  82 C
  83   400  Z=Z*Z+C
  84 C
  85        IF ((CABS(Z)).GE.MAXVAL) GO TO 410
  86        COUNT=COUNT+1
  87        IF (COUNT.GE.MAXI)     GO TO 420
  88        GO TO 400
  89 C
  90 CCCCCC PUNKT DURCHGEFALLEN
  91   410   CALL PCHAR(NEGA)
  92         GO TO 500
  93 C
  94 CCCCCC PUNKT HAT MAXI ERREICHT
  95   420   CALL PCHAR(POSI)
  96 C
  97 CCCCCC NEUEN PUNKT MACHEN
  98   500  X = X + XSTEP
  99 CCCCCC ZEILE NOCH NICHT VOLL?
 100        IF (X.LT.HIGHX) GO TO 300
 101 CCCCCC X AN ANFANG SETZTEN, CR+LF DRUCKEN
 102        X = LOWX
 103        CALL PCHAR(CR)
 104        CALL PCHAR(LF)
 105 CCCCCC Y WEITERRUECKEN - NEGATIV WEIL WIR VON OBEN KOMMEN
 106        Y=Y-YSTEP
 107        IF (Y.GT.LOWY) GO TO 300
 108 C
 109 CCCCCC HIER IST DAS BILD FERTIG.
 110        RETURN
 111        END
 112 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
 113 CCCCCC STARTWERTE AUSFUELLEN
 114        SUBROUTINE STVAL
 115 C
 116        INTEGER        MAXI,WIDTH,CR,LF,POSI,NEGA,INIT
 117        COMMON /PARAM2/MAXI,WIDTH,CR,LF,POSI,NEGA,INIT
 118        REAL           LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
 119        COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
 120 C
 121        CR      = 13
 122        LF      = 10
 123        POSI    = 79
 124        NEGA    = 32
 125        WIDTH   = 70
 126        MAXI    = 60
 127        MAXVAL  = 2.0
 128        LOWX    =-1.45
 129        HIGHX   = 0.45
 130        LOWY    =-1.00
 131        HIGHY   = 1.00
 132        INIT    =  1
 133 C
 134 CCCCCC SCHRITTWEITEN AUSRECHNEN
 135        XSTEP = (HIGHX-LOWX)/FLOAT(WIDTH)
 136        YSTEP = 2.0 * XSTEP
 137 C
 138        WRITE (1,1500)
 139  1500  FORMAT (19HSTARTWERTE GESETZT.)
 140        RETURN
 141        END
 142 C
 143 C
 144 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
 145 CCCCCC EINSTELLUNGEN EINLESEN
 146        SUBROUTINE GETCFG
 147 C
 148        INTEGER        MAXI,WIDTH,CR,LF,POSI,NEGA,INIT
 149        COMMON /PARAM2/MAXI,WIDTH,CR,LF,POSI,NEGA,INIT
 150        REAL           LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
 151        COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
 152 C
 153        REAL XIN1,XIN2,YIN1,YIN2
 154 C
 155        WRITE(1,11)
 156        READ (1,16) XIN1
 157        WRITE(1,12)
 158        READ (1,16) XIN2
 159        WRITE(1,13)
 160        READ (1,16) YIN1
 161        WRITE(1,14)
 162        READ (1,16) YIN2
 163        WRITE(1,15)
 164        READ (1,17) MAXI
 165 C
 166    11  FORMAT(14H X FROM     : )
 167    12  FORMAT(14H     TO     : )
 168    13  FORMAT(14H Y FROM     : )
 169    14  FORMAT(14H     TO     : )
 170    15  FORMAT(14H  MAXIT (I3): )
 171    16  FORMAT(F12.0)
 172    17  FORMAT(I3)
 173 C
 174 CCCCCC EVENTUELL STARTWERTE TAUSCHEN:
 175 CCCCCC WENN XIN2 GROESSER IST OK, ANSONSTEN TAUSCHEN
 176   150  I F(XIN2.GT.XIN1) GO TO 200
 177        TEMP = XIN1
 178        XIN1 = XIN2
 179        XIN2 = TEMP
 180 C
 181 CCCCCC WENN YIN2 GROESSER IST OK, ANSONSTEN TAUSCHEN
 182   200  IF(YIN2.GT.YIN1) GO TO 201
 183        TEMP = YIN1
 184        YIN1 = YIN2
 185        YIN2 = TEMP
 186 C
 187 CCCCCC WERTE UEBERNEHMEN
 188   201  LOWX  = XIN1
 189        HIGHX = XIN2
 190        LOWY  = YIN1
 191        HIGHY = YIN2
 192 C
 193 CCCCCC SCHRITTWEITEN AUSRECHNEN
 194        XSTEP = (HIGHX-LOWX)/FLOAT(WIDTH)
 195        YSTEP = 2.0 * XSTEP
 196 C
 197        RETURN
 198        END
 199 C
 200 C
 201 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
 202 CCCCCC EINSTELLUNGEN AUSGEBEN
 203        SUBROUTINE OUTCFG
 204 C
 205        INTEGER        MAXI,WIDTH,CR,LF,POSI,NEGA,INIT
 206        COMMON /PARAM2/MAXI,WIDTH,CR,LF,POSI,NEGA,INIT
 207        REAL           LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
 208        COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
 209 C
 210        WRITE  (1,20)
 211   20   FORMAT (9HSETTINGS:)
 212        WRITE  (1,30) LOWX, HIGHX
 213   30   FORMAT (12HX-WERTE VON ,1F8.5,5H BIS ,1F8.5)
 214        WRITE  (1,40) LOWY, HIGHY
 215    40  FORMAT (12HY-WERTE VON ,F8.5,5H BIS ,F8.5)
 216        WRITE  (1,50) MAXI, MAXVAL, XSTEP, YSTEP, WIDTH
 217    50  FORMAT (   4HMAX:,I3,
 218      +        8H MAXVAL:,F8.5,
 219      +         7H XSTEP:,F8.5,
 220      +         7H YSTEP:,F8.5,
 221      +         7H WIDTH:,I2)
 222        RETURN
 223        END
 224 C
 225 C
 226 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
 227 CCCCCC RUECKSETZEN
 228        SUBROUTINE RST
 229 C
 230        INTEGER        MAXI,WIDTH,CR,LF,POSI,NEGA,INIT
 231        COMMON /PARAM2/MAXI,WIDTH,CR,LF,POSI,NEGA,INIT
 232 C
 233        WRITE(1,245)
 234   245  FORMAT(24HRUECKSETZUNG GEWUENSCHT )
 235        INIT=0
 236        RETURN
 237        END
 238 C
 239 C
 240 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
 241 C                        KONSTANTE WERTE
 242        BLOCK DATA
 243        INTEGER        MAXI,WIDTH,CR,LF,POSI,NEGA,INIT
 244        COMMON /PARAM2/MAXI,WIDTH,CR,LF,POSI,NEGA,INIT
 245        DATA INIT/0/
 246        END
 247 CCCCCCCCCCCCCCCCCCCCCCCC
 248 $0