programs/plotter/src/plotapfel.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       IF (PEN.EQ.0) CALL PL$PD
 121       PEN=1
 122       CALL PL$R
 123       PENX=PENX+1
 124       RETURN
 125       END
 126 C
 127       SUBROUTINE WHITE
 128       INTEGER PEN,PENX
 129       COMMON /PENSTA/PEN,PENX
 130       IF (PEN.EQ.1) CALL PL$PU
 131       PEN=0
 132       CALL PL$R
 133       PENX=PENX+1
 134       RETURN
 135       END
 136 C
 137       SUBROUTINE PLOTR
 138       INTEGER PEN,PENX
 139       COMMON /PENSTA/PEN,PENX
 140       CALL WHITE
 141  8000 IF (PENX.EQ.0) GO TO 8100
 142       CALL PL$L
 143       PENX=PENX-1
 144       GO TO 8000
 145  8100 CONTINUE
 146       CALL PL$DN
 147       RETURN
 148       END
 149 C
 150 CCCCCC STARTWERTE AUSFUELLEN
 151       SUBROUTINE STVAL
 152 C
 153       INTEGER        MAXI,WIDTH,CR,LF
 154       COMMON /PARAM2/MAXI,WIDTH,CR,LF
 155       REAL           LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
 156       COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
 157       INTEGER INIT
 158       COMMON /PARAM3/INIT
 159 C
 160        CR      = 13
 161        LF      = 10
 162        WIDTH   = 500
 163        MAXI    = 50
 164        MAXVAL  = 2.0
 165        LOWX    =-1.48
 166        HIGHX   = 0.5
 167        LOWY    =-1.2
 168        HIGHY   = 1.2
 169        INIT    = 1
 170 C
 171 CCCCCC SCHRITTWEITEN AUSRECHNEN
 172        XSTEP = (HIGHX-LOWX)/FLOAT(WIDTH)
 173        YSTEP =  XSTEP
 174 C
 175        WRITE (1,1500)
 176  1500  FORMAT (20HDEFAULT VALUES USED.)
 177        RETURN
 178        END
 179 C
 180 C
 181 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
 182 CCCCCC EINSTELLUNGEN EINLESEN
 183        SUBROUTINE GETCFG
 184 C
 185        INTEGER        MAXI,WIDTH,CR,LF
 186        COMMON /PARAM2/MAXI,WIDTH,CR,LF
 187        REAL           LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
 188        COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
 189 C
 190        REAL XIN1,XIN2,YIN1,YIN2
 191 C
 192        WRITE(1,11)
 193        READ (1,16) XIN1
 194        WRITE(1,12)
 195        READ (1,16) XIN2
 196        WRITE(1,13)
 197        READ (1,16) YIN1
 198        WRITE(1,14)
 199        READ (1,16) YIN2
 200        WRITE(1,15)
 201        READ (1,17) MAXI
 202 C
 203    11  FORMAT(14H X FROM     : )
 204    12  FORMAT(14H     TO     : )
 205    13  FORMAT(14H Y FROM     : )
 206    14  FORMAT(14H     TO     : )
 207    15  FORMAT(14H  MAXIT (I3): )
 208    16  FORMAT(F12.0)
 209    17  FORMAT(I3)
 210 C
 211 CCCCCC EVENTUELL STARTWERTE TAUSCHEN:
 212 CCCCCC WENN XIN2 GROESSER IST OK, ANSONSTEN TAUSCHEN
 213   150  I F(XIN2.GT.XIN1) GO TO 200
 214        TEMP = XIN1
 215        XIN1 = XIN2
 216        XIN2 = TEMP
 217 C
 218 CCCCCC WENN YIN2 GROESSER IST OK, ANSONSTEN TAUSCHEN
 219   200  IF(YIN2.GT.YIN1) GO TO 201
 220        TEMP = YIN1
 221        YIN1 = YIN2
 222        YIN2 = TEMP
 223 C
 224 CCCCCC WERTE UEBERNEHMEN
 225   201  LOWX  = XIN1
 226        HIGHX = XIN2
 227        LOWY  = YIN1
 228        HIGHY = YIN2
 229 C
 230 CCCCCC SCHRITTWEITEN AUSRECHNEN
 231        XSTEP = (HIGHX-LOWX)/FLOAT(WIDTH)
 232        YSTEP = 2.0 * XSTEP
 233 C
 234        RETURN
 235        END
 236 C
 237 C
 238 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
 239 CCCCCC EINSTELLUNGEN AUSGEBEN
 240        SUBROUTINE OUTCFG
 241 C
 242        INTEGER        MAXI,WIDTH,CR,LF
 243        COMMON /PARAM2/MAXI,WIDTH,CR,LF
 244        REAL           LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
 245        COMMON /PARAM1/LOWX,LOWY,HIGHX,HIGHY,MAXVAL,XSTEP,YSTEP
 246 C
 247        WRITE  (1,20)
 248   20   FORMAT (9HSETTINGS:)
 249        WRITE  (1,30) LOWX, HIGHX
 250   30   FORMAT (12HX-WERTE VON ,1F8.5,5H BIS ,1F8.5)
 251        WRITE  (1,40) LOWY, HIGHY
 252    40  FORMAT (12HY-WERTE VON ,F8.5,5H BIS ,F8.5)
 253        WRITE  (1,50) MAXI, MAXVAL, XSTEP, YSTEP, WIDTH
 254    50  FORMAT (   4HMAX:,I3,
 255      +        8H MAXVAL:,F8.5,
 256      +         7H XSTEP:,F8.5,
 257      +         7H YSTEP:,F8.5,
 258      +         7H WIDTH:,I2)
 259        RETURN
 260        END
 261 C
 262 C
 263 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
 264 CCCCCC RUECKSETZEN
 265        SUBROUTINE RST
 266 C
 267        INTEGER        MAXI,WIDTH,CR,LF
 268        COMMON /PARAM2/MAXI,WIDTH,CR,LF
 269 C
 270        WRITE(1,245)
 271   245  FORMAT(25HPARAMETER RESET REQUESTED)
 272        INIT=0
 273        RETURN
 274        END
 275 C
 276 C
 277 CCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCCC
 278 C                        PRELOAD VALUE OF INIT
 279        BLOCK DATA
 280        INTEGER INIT
 281        COMMON /PARAM3/INIT
 282        DATA INIT/0/
 283        END
 284 CCCCCCCCCCCCCCCCCCCCCCCC
 285 $0