programs/plotter/src/plotapfel2.f

   1 C     APFELMAENNCHEN-PROGRAMM, 06.FEBRUARY.2007 PHILIPP HACHTMANN
   2 C    INTERMEDIATE VERSION
   3 C
   4 C    THIS VERSION SHOULD RUN A BIT FASTER BECAUSE THE SQUARE
   5 C    ROOT IS OMMITTED.
   6 C
   7 C    SWITCH SETTINGS:
   8 C    SENSE-SWITCH 1: IF SET, ASK FOR PARAMETERS
   9 C    SENSE-SWITCH 2: IF SET, DON'T PRINT PARAMETERS ON START
  10 C    SENSE-SWITCH 3: IF SET, RESTORE PARAMETERS TO DEFAULT VALUES
  11 C
  12 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  13 C                        COMMON BLOCK DECLARATIONS
  14 C
  15        INTEGER        MAXI,WIDTH,CR,LF,POSI,NEGA
  16        COMMON /PARAM2/MAXI,WIDTH,CR,LF,POSI,NEGA
  17 C
  18        REAL           LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
  19        COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
  20 C
  21        INTEGER INIT
  22        COMMON /PARAM3/INIT
  23 C
  24 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  25 C                        CONFIGURATION
  26 CCCCCC RESET DO DEFAULT VALUES?
  27   110  CALL SSWTCH(3,I)
  28        IF (I.EQ.1) CALL RST
  29 C
  30 CCCCCC ON THE FIRST START OR IF DESIRED
  31        IF(INIT.EQ.0) CALL STVAL
  32 C
  33 CCCCCC DO WE HAVE TO ASK FOR PARAMETERS?
  34        CALL SSWTCH(1,I)
  35        IF (I.EQ.1) CALL GETCFG
  36 C
  37 CCCCCC OUTPUT SETTINGS?
  38        CALL SSWTCH(2,I)
  39        IF(I.EQ.2) CALL OUTCFG
  40 C
  41        WRITE  (1,55)
  42  55    FORMAT (1H0)
  43 C
  44        CALL PLOTI
  45        CALL CALC2
  46 C
  47        WRITE(1, 60)
  48    60  FORMAT (5HREADY)
  49 C
  50        PAUSE 7
  51        GO TO 110
  52        END
  53 C      END OF MAIN PROGRAM
  54 C
  55 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
  56 CCCCCC THE MANDELBROT SET CALCULATION
  57        SUBROUTINE CALC2
  58 C
  59        INTEGER        MAXI,WIDTH,CR,LF
  60        COMMON /PARAM2/MAXI,WIDTH,CR,LF
  61        REAL           LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
  62        COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
  63        REAL CMPAVL
  64        REAL ZR,ZI,ZRN
  65        REAL X,Y
  66        INTEGER COUNT
  67 C
  68 CCCCCC ENTER THE CALCULATION
  69   299  CMPVAL=MAXVAL*MAXVAL
  70        X=LOWX
  71        Y=HIGHY
  72 C
  73 CCCCCC EINSTIEG IN DEN AKTUELLEN PUNKT
  74   300  COUNT=0
  75        ZR=0.0
  76        ZI=0.0
  77 C
  78 CCCCCC HIER DER ITERIERTE TEIL
  79 C
  80   400 ZRN=ZR*ZR-ZI*ZI+X
  81       ZI=2.0*ZR*ZI+Y
  82       ZR=ZRN
  83 C
  84        IF ((ZR*ZR+ZI*ZI).GE.CMPVAL) GO TO 410
  85        COUNT=COUNT+1
  86        IF (COUNT.GE.MAXI)     GO TO 410
  87        GO TO 400
  88 C
  89 CCCCCC PUNKT FERTIG
  90  410   IF (COUNT.EQ.MAXI) CALL BLACK
  91        IF (COUNT.LT.MAXI) CALL WHITE
  92 CCCCCC NEUEN PUNKT MACHEN
  93   500  X = X + XSTEP
  94 CCCCCC ZEILE NOCH NICHT VOLL?
  95        IF (X.LE.HIGHX) GO TO 300
  96 CCCCCC X AN ANFANG SETZTEN, CR+LF DRUCKEN
  97        X = LOWX
  98        CALL PLOTR
  99 C
 100 C
 101 CCCCCC Y WEITERRUECKEN - NEGATIV WEIL WIR VON OBEN KOMMEN
 102        Y=Y-YSTEP
 103        IF (Y.GE.LOWY) GO TO 300
 104 C
 105 CCCCCC HIER IST DAS BILD FERTIG.
 106       RETURN
 107       END
 108 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
 109       SUBROUTINE PLOTI
 110       INTEGER PEN,PENX
 111       COMMON /PENSTA/PEN,PENX
 112       CALL PL$INI
 113       CALL PL$SCL(3.0)
 114       CALL PL$PU
 115       PEN=0
 116       PENX=0
 117       RETURN
 118       END
 119 C
 120       SUBROUTINE BLACK
 121       INTEGER PEN,PENX
 122       COMMON /PENSTA/PEN,PENX
 123       CALL PL$R
 124       IF (PEN.EQ.0) CALL PL$PD
 125       PEN=1
 126       CALL PL$U
 127       CALL PL$R
 128       CALL PL$D
 129       PENX=PENX+2
 130       RETURN
 131       END
 132 C
 133       SUBROUTINE WHITE
 134       INTEGER PEN,PENX
 135       COMMON /PENSTA/PEN,PENX
 136       IF (PEN.EQ.1) CALL PL$PU
 137       PEN=0
 138       CALL PL$R
 139       CALL PL$R
 140       PENX=PENX+2
 141       RETURN
 142       END
 143 C
 144       SUBROUTINE PLOTR
 145       INTEGER PEN,PENX
 146       COMMON /PENSTA/PEN,PENX
 147       CALL WHITE
 148  8000 IF (PENX.EQ.0) GO TO 8100
 149       CALL PL$L
 150       PENX=PENX-1
 151       GO TO 8000
 152  8100 CONTINUE
 153       CALL PL$D
 154       CALL PL$D
 155       RETURN
 156       END
 157 C
 158 CCCCCC STARTWERTE AUSFUELLEN
 159       SUBROUTINE STVAL
 160 C
 161       INTEGER        MAXI,WIDTH,CR,LF
 162       COMMON /PARAM2/MAXI,WIDTH,CR,LF
 163       REAL           LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
 164       COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
 165       INTEGER INIT
 166       COMMON /PARAM3/INIT
 167 C
 168        CR      = 13
 169        LF      = 10
 170        WIDTH   = 100
 171        MAXI    = 50
 172        MAXVAL  = 2.0
 173        LOWX    =-1.48
 174        HIGHX   = 0.5
 175        LOWY    =-1.2
 176        HIGHY   = 1.2
 177        INIT    =  1
 178 C
 179 CCCCCC SCHRITTWEITEN AUSRECHNEN
 180        XSTEP = (HIGHX-LOWX)/FLOAT(WIDTH)
 181        YSTEP =  XSTEP
 182 C
 183        WRITE (1,1500)
 184  1500  FORMAT (20HDEFAULT VALUES USED.)
 185        RETURN
 186        END
 187 C
 188 C
 189 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
 190 CCCCCC EINSTELLUNGEN EINLESEN
 191        SUBROUTINE GETCFG
 192 C
 193        INTEGER        MAXI,WIDTH,CR,LF
 194        COMMON /PARAM2/MAXI,WIDTH,CR,LF
 195        REAL           LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
 196        COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
 197 C
 198        REAL XIN1,XIN2,YIN1,YIN2
 199 C
 200        WRITE(1,11)
 201        READ (1,16) XIN1
 202        WRITE(1,12)
 203        READ (1,16) XIN2
 204        WRITE(1,13)
 205        READ (1,16) YIN1
 206        WRITE(1,14)
 207        READ (1,16) YIN2
 208        WRITE(1,15)
 209        READ (1,17) MAXI
 210 C
 211    11  FORMAT(14H X FROM     : )
 212    12  FORMAT(14H     TO     : )
 213    13  FORMAT(14H Y FROM     : )
 214    14  FORMAT(14H     TO     : )
 215    15  FORMAT(14H  MAXIT (I3): )
 216    16  FORMAT(F12.0)
 217    17  FORMAT(I3)
 218 C
 219 CCCCCC EVENTUELL STARTWERTE TAUSCHEN:
 220 CCCCCC WENN XIN2 GROESSER IST OK, ANSONSTEN TAUSCHEN
 221   150  I F(XIN2.GT.XIN1) GO TO 200
 222        TEMP = XIN1
 223        XIN1 = XIN2
 224        XIN2 = TEMP
 225 C
 226 CCCCCC WENN YIN2 GROESSER IST OK, ANSONSTEN TAUSCHEN
 227   200  IF(YIN2.GT.YIN1) GO TO 201
 228        TEMP = YIN1
 229        YIN1 = YIN2
 230        YIN2 = TEMP
 231 C
 232 CCCCCC WERTE UEBERNEHMEN
 233   201  LOWX  = XIN1
 234        HIGHX = XIN2
 235        LOWY  = YIN1
 236        HIGHY = YIN2
 237 C
 238 CCCCCC SCHRITTWEITEN AUSRECHNEN
 239        XSTEP = (HIGHX-LOWX)/FLOAT(WIDTH)
 240        YSTEP = 2.0 * XSTEP
 241 C
 242        RETURN
 243        END
 244 C
 245 C
 246 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
 247 CCCCCC EINSTELLUNGEN AUSGEBEN
 248        SUBROUTINE OUTCFG
 249 C
 250        INTEGER        MAXI,WIDTH,CR,LF
 251        COMMON /PARAM2/MAXI,WIDTH,CR,LF
 252        REAL           LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
 253        COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
 254 C
 255        WRITE  (1,20)
 256   20   FORMAT (9HSETTINGS:)
 257        WRITE  (1,30) LOWX, HIGHX
 258   30   FORMAT (12HX-WERTE VON ,1F8.5,5H BIS ,1F8.5)
 259        WRITE  (1,40) LOWY, HIGHY
 260    40  FORMAT (12HY-WERTE VON ,F8.5,5H BIS ,F8.5)
 261        WRITE  (1,50) MAXI, MAXVAL, XSTEP, YSTEP, WIDTH
 262    50  FORMAT (   4HMAX:,I3,
 263      +        8H MAXVAL:,F8.5,
 264      +         7H XSTEP:,F8.5,
 265      +         7H YSTEP:,F8.5,
 266      +         7H WIDTH:,I2)
 267        RETURN
 268        END
 269 C
 270 C
 271 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
 272 CCCCCC RUECKSETZEN
 273        SUBROUTINE RST
 274 C
 275        INTEGER        MAXI,WIDTH,CR,LF
 276        COMMON /PARAM2/MAXI,WIDTH,CR,LF
 277 C
 278        WRITE(1,245)
 279   245  FORMAT(25HPARAMETER RESET REQUESTED)
 280        INIT=0
 281        RETURN
 282        END
 283 C
 284 C
 285 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
 286 C                        PRELOAD VALUE OF INIT
 287        BLOCK DATA
 288        INTEGER INIT
 289        COMMON /PARAM3/INIT
 290        DATA INIT/0/
 291        END
 292 CCCCCCCCCCCCCCCCCCCCCCCC
 293 $0