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