sw/rescue/lab8e_goettingen/disk2_11/rkb/paroff/haefir.ft

   1 C       -+-+-+-+-+ \ e  H A E F I R . F T  \ e -+-+-+-+-+
   2 C
   3 C       PLOT THE DATA POINTS
   4 C
   5         SUBROUTINE FIRPLT
   6         INCLUDE HAEPTI.FI
   7         INCLUDE HAEBUF.FI
   8         INCLUDE HAEGSA.FI
   9         INCLUDE HAETTY.FI
  10         INCLUDE HABRK.FI
  11         INCLUDE HAECSZ.FI
  12         INCLUDE HAPPEN.FI
  13         REAL XYSAM,COND
  14         INTEGER NCOND,TOASCI
  15         EXTERNAL XYSAM,NCOND,COND,TOASCI
  16 C
  17 \fC
  18         LOGICAL TIMABZ,TIMORD,          @ ABZISSE / ORDINATE IS TIME SCALE
  19      *  ABISMI                          @ IF THE ABZISSA SCALE EXCEEDS 5 MINUTES THEN .TRUE. ELSE .FALSE.
  20         INTEGER I,K,J,PENPOS,
  21      *  STEP,                           @ INCREMENT IN SAMBUF SCAN
  22      *  CA,CO,                          @ CHANNEL OF ABZISSE, ORDINATE
  23      *  PLBEG,PLEND,                    @ START/END OF TIME SCALE
  24      *  NUMCN,                          @ NUMBER OF CHANNELS TO SCAN (NO MEANING IF TIMABZ IS SET .FALSE.)
  25      *  EXPAND                          @ IF THE TIME SCALE .LE. 5 SECONDS THEN WE MARK EACH 1/10 SECOND ELSE EACH SECOND
  26         REAL TEMSET,                    @ DIFFERENCE PLOTTER 0,0 AND PICTURE 0,0 (NO MEANING IF TIMABZ IS SET TO .FALSE.)
  27      *  LEFT,RIGHT,UP,DOWN,             @ PLOT SCALES ABZISSE/ ORDINATE
  28      *  TE1,TE2,TE3                     @ TEMPS
  29         REAL OMAX,OMIN,                 @ MAXIMUM AND MINIMUM OF ORDINATE DATA
  30      *  THRU,THRL                       @ UPPER, LOWER THRESHOLD
  31         INTEGER TEXT0(4)                @ DIMENSION OF THE TIME AXIS (MIN OR SEC)
  32         DATA CA,CO,NUMCN,STEP /0,8,2,3/,
  33      *  TEXT0 /'TIME [MIN]  TIME [SEC]'/
  34 C
  35 C       STATEMENT FUNCTIONS ARE:
  36 C
  37         BETW(AP0,BP0,CP0)=AP0.LE.BP0.AND.BP0.LT.CP0
  38         LOGICAL BETW
  39         FIR(IP0)=-XYSAM(IP0-4,0)-XYSAM(IP0-3,0)+
  40      *  XYSAM(IP0-1,0)+2*XYSAM(IP0,0)+XYSAM(IP0+1,0)-
  41      *  XYSAM(IP0+3,0)-XYSAM(IP0+4,0) @ SAMCNT FINITE IMPULSE RESPONSE FILTER
  42 C
  43         XF(IP1)=XYSAM(IP1,CA)-LEFT      @ RETURNS THE VALUE OF THE ABZISSA WITH CORRECT OFFSET
  44         DFIR(IP2)=COND(BETW(THRL,FIR(IP2),THRU),0,120.)
  45         YF(IP1)=COND(CO.EQ.0,FIR(IP1),DFIR(IP1))
  46 C
  47         IF (SAMCNT.EQ.0) RETURN         @ NO SAMPLE, NOTHING TO DO
  48 C
  49 C       COMPUTE THE DEFAULT VALUES FOR THE PLOT
  50 C
  51         IF (OPTION.EQ.11) GOTO 15       @ SP- SKIPS QUESTIONS AND TAKES THE LAST VALUES USED
  52         CO=0                            @ THE ORDINATE IS CHANNEL 0
  53         CA=8                            @ THE ABZISSA IS THE TIME SCALE
  54         NUMCN=CHNLS-CO                  @ ALL CHANNELS TO PLOT
  55         STEP=3                          @ WE PLOT EACH THIRD POINT OF THE DATA
  56         IF (OPTION.NE.12) CALL ASKHIM (2) @ SP* DOES NOT ASK SILLY QUESTIONS
  57         WRITE (TTO,1) CA,CO,STEP        @ READ CHANNEL ##
  58         READ (TTI,2) I,J,K              @   AND STEP INCREMENTS
  59         IF BREAK(11) RETURN
  60         CA=NCOND(I,I,CA)
  61         CO=NCOND(J,J,CO)
  62         STEP=NCOND(K,K,STEP)            @ STEP DEFAULTS TO "STEP"
  63         TIMABZ=CA.GT.7                  @ ABZISSE IS THE TIME SCALE
  64         TIMORD=CO.GT.7                  @ ORDINATE IS THE TIME SCALE
  65         IF (.NOT.TIMABZ) GOTO 15        @ ABZISSA IS NO TIME SCALE: ONLY TWO CHANNELS (CO,CO+1) TO PLOT
  66         NUMCN=MIN0(NUMCN,CHNLS-CO)      @ COMPUTE CORRECT NUMBER OF CHANNELS
  67         WRITE (TTO,3) NUMCN             @ READ THE NUMBER OF CHANNELS TO SCAN
  68         READ (TTI,2) I
  69         NUMCN=MIN0(CHNLS-CO,NCOND(I,I,NUMCN)) @ NO INPUT MEANS CHNLS-CO
  70         WRITE (TTO,5)
  71         READ (TTI,6) THRL,THRU
  72 15      CONTINUE
  73 \fC
  74 C       COMPUTE THE SCALING LIMITS
  75 C
  76         S0=BEGIN*SAMRAT                 @ HERE WE START THE OUTPUT PLOT
  77         S1=ENDS*SAMRAT                  @ AND HERE WE END THE PLOT
  78         PLBEG=BEGIN
  79         PLEND=ENDS
  80 C
  81         IF (S1.LE.SAMCNT) GOTO 17       @ IF THE INTERVALL TO PLOT EXCEEDS THE
  82         TE1=SAMCNT/SAMRAT               @  DATA POINTS THEN
  83         TE2=S1/SAMRAT
  84         WRITE (TTO,4) TE1,TE2           @  WE PRINT THE OVERFLOW MSG AND
  85         PLEND=TE1                       @  COMPUTE A NEW PLEND VALUE
  86         S1=PLEND*SAMRAT-1               @ TAKE CARE FOR TRUNCATION ERRORS
  87 17      CONTINUE                        @ INTERVALL OK, COMPUTE UPPER AND LOWER MARGIN OF PLOT DATA
  88         RIGHT=COND(TIMABZ,FLOAT(S1),512.) @ ABZISSE MARGIN EITHER TIME OR 10 BIT CONVERTER
  89         LEFT =COND(TIMABZ,FLOAT(S0),-512.)
  90         UP   =COND(TIMORD,FLOAT(S1),512.) @ ORDINATE MARGIN
  91         DOWN =COND(TIMORD,FLOAT(S0),-512.)
  92         IF BREAK(11) RETURN             @ USER GETS RID OF PRGRM
  93         CALL STPLT                      @ START THE PLOTTER ( CALL PLOTS)
  94         CALL XYPLOT (XOFSET,YOFSET,-PENUP) @ DRIVE PEN TO PICTURE ZERO
  95 C
  96 C       LOOP TO PLOT EACH CHANNEL WITH CORRECT OFFSET, FACTOR AND SCALE
  97 C       TEMSET HOLDS THE ORIGIN FOR EACH CHANNEL
  98 C       TEMSET=0  PLOT ONE CHANNEL/TIME OR X/Y
  99 C       TEMSET=YLEN/NUMCN FOR MORE THAN ONE CHANNEL
 100 C       THE TEMSET ORIGIN OFFSET IS RESET AT THE END OF THE LOOP ( ST. 25)
 101 C
 102 C
 103         TEMSET=0
 104         DO 20 K=1,NCOND(TIMABZ,NUMCN,1) @ SCAN NUMCN CHANNELS
 105         IF (NUMCN.EQ.1 .OR. .NOT.TIMABZ) GOTO 51
 106         TEMSET=FLOAT(NUMCN-K)*YLEN/FLOAT(NUMCN)+(NUMCN-K)*.5 @ TEMPORARY Y OFFSET
 107         CALL XYPLOT (0,TEMSET,-PENUP)   @ SWITCH TO CORRECT PART OF PICTURE
 108 C
 109 C       COMPUTE THE FACTOR TO GET A PRETTY PLOT
 110 C
 111         OMAX=-999.
 112         OMIN=-OMAX
 113         DO 50 J=S0,S1                   @ FETCH MIN & MAX OF THE DATA
 114         IF (BREAK(11)) GOTO 25          @ IF THE USER GETS RID OF PLOT THEN WE EXIT VIA 25
 115         TE1=YF(J)                       @ COMPUTE FILTER
 116         OMAX=AMAX1(OMAX,TE1)            @ MAXIMUM --> OMAX
 117 50      OMIN=AMIN1(OMIN,TE1)            @ MINIMUM --> OMIN
 118         DOWN=COND(OMIN.LT.-255.,-512.,OMIN.LT.0,-255.,OMIN.LT.256.,0,
 119      *   255.)                          @ MAKE 255 STEPS INCREMENT
 120         UP=COND(OMAX.GT.255.,512.,OMAX.GT.0,255.,OMAX.GT.-255.,0,
 121      *   -255.)                         @ 255 STEPS INCREMENT
 122 C
 123 51      CONTINUE                        @ HERE WE COMPUTE THE FACTOR FOR ONE LINE
 124         IF (TIMABZ) CALL FACTOR (XLEN/(RIGHT-LEFT),
 125      *   (YLEN-NUMCN*.5+.5)/FLOAT(NUMCN)/(UP-DOWN))
 126         IF (.NOT.TIMABZ) CALL FACTOR (AMIN1(XLEN,YLEN)/(RIGHT-LEFT),
 127      *   AMIN1(XLEN,YLEN)/(UP-DOWN))
 128         IF BREAK(11) GOTO 25            @ USER GETS RID OF PRGRM
 129         PENPOS=PENUP
 130         DO 10 I=S0,S1                   @ HERE WE PLOT THE
 131         CALL XYPLOT (XF(I),YF(I)-DOWN,PENPOS) @ DATA POINTS ONE BY ONE
 132         PENPOS=PENDWN
 133         IF BREAK(11) GOTO 25            @ USER GETS RID OF PROGRAM
 134 10      CONTINUE
 135         IF (.NOT. TIMABZ) GOTO 25       @ WORK DONE FOR X-Y GRAPHICS
 136 C
 137 C       MAKE A SCALE FOR THE ORDINATE ( INPUT VOLTAGE )
 138 C
 139         CALL WHERE (TE1,TE1,TE1,TE2)
 140         CALL FACTOR (1.,TE2)
 141         CALL XYPLOT (-.5,0,-PENUP)
 142         PENPOS=PENUP
 143         DO 55 I=0,10
 144         TE1=DOWN+I*(UP-DOWN)/10.
 145         CALL XYPLOT (0,TE1-DOWN,PENPOS)
 146         PENPOS=PENDWN
 147         J=MOD(I,5)
 148         TE3=COND(J.EQ.0,-.5,-.3)
 149         CALL XYPLOT (TE3,TE1-DOWN,PENDWN)
 150         CALL XYPLOT (0,TE1-DOWN,PENDWN)
 151         IF (MOD(I,10).NE.0) GOTO 55
 152         CALL FACTOR (1.,1.)             @ WRITE LOWER AND UPPER LIMIT ONTO THE
 153         CALL NUMBER (-XOFSET+2.*YZ,(TE1-DOWN)*TE2-YN*.38,YN*.75,TE1,0,
 154      *   -1) @ AXIS
 155         CALL FACTOR (1.,TE2)
 156         CALL XYPLOT (0,TE1-DOWN,PENUP)
 157 55      CONTINUE
 158         CALL XYPLOT (.5,0,-PENUP)
 159         CALL FACTOR (1.,1.)
 160         CALL SYMBOL (-XOFSET+YZ,YLEN/NUMCN*.33,YZ,'CH ',90.,3)
 161         CALL NUMBER (999.,999.,YZ,CO,90.,-1)
 162 C
 163 C
 164         CO=CO+1
 165 25      CALL FACTOR (1.,1.)
 166         CALL XYPLOT (0.,-TEMSET,-PENUP) @ RESET CORRECT ORIGIN OF DIAGRAM
 167         IF BREAK(11) GOTO 40
 168 20      CONTINUE
 169 \fC
 170 C       IF ABZISSA IS TIME SCALE THEN DRAW A TIME SCALE
 171 C
 172         IF (.NOT.TIMABZ) GOTO 40
 173         ABISMI=PLEND-PLBEG.GT.300       @ ABZISSE EXCEEDS 5 MINUTES SO WE DRAW A MINUTE SCALING
 174         CALL FACTOR (XLEN/(PLEND-PLBEG),1.)
 175         CALL XYPLOT (0.,-.5,-PENUP)
 176 C       HERE WE PLOT THE LITTLE BAR INDICATING A SECOND OR MINUTE
 177         EXPAND=NCOND(PLEND-PLBEG.LE.5,10,1) @ IF THE TIME SCALE IS .LE. 5 SECONDS THEN WE MARK EACH 1/10 SEC
 178         DO 30 I=PLBEG*EXPAND,PLEND*EXPAND @ 1 SEC INCREMENTS
 179         TE1=I-PLBEG*EXPAND
 180         CALL XYPLOT (TE1/EXPAND,0,PENDWN)
 181         IF (.NOT.ABISMI) TE2=COND(MOD(I,10).EQ.0,-.7, MOD(I,5).EQ.0,-.5,
 182      *   -.3)
 183         IF (ABISMI) TE2=COND(MOD(I,600).EQ.0,-.7,
 184      *    MOD(I,300).EQ.0,-.5,
 185      *     MOD(I/EXPAND,60).EQ.0,-.3)
 186         CALL XYPLOT (TE1/EXPAND,TE2,PENDWN)
 187 C       HERE WE COMPUTE WHERE TO WRITE A NUMBER ONTO THE TIME AXIS
 188         TE2=PLEND-PLBEG                 @  COMPUTE THE SIZE OF THE TIME AXIS
 189         IF (.NOT.ABISMI) GOTO 31        @ IF WE PLOT A SECONDS AXIS THEN GOTO 31
 190         IF (MOD(I,
 191      *   NCOND(TE2.GT.5400,1800,TE2.GE.1800,600,TE2.GT.900,300,
 192      *   TE2.GT.300,120,60)).GT.0) GOTO 30 @ COMPUTE THE MINUTE WHERE TO PLOT THE NUMBER
 193         GOTO 32
 194 31      IF (MOD(I,NCOND(TE2.GT.180,30,TE2.GT.60,20,TE2.GT.30,10,
 195      *   TE2.GT.10,5,TE2.GT.5,2,10)).GT.0) @ WE ASSUME: TE2.LE.5 THEN EXPAND:=10 ELSE EXPAND:=1 !!!
 196      *   GOTO 30
 197 C
 198 C       HERE WE PLOT THE NUMBER ONTO THE AXIS
 199 C
 200 32      CONTINUE
 201         CALL WHERE (TE2,TE2,TE2,TE3)    @ GET THE X FACTOR
 202         CALL FACTOR (1.,1.)             @ RESET TO THE NORMAL FACTOR FOR SYMBOL
 203         CALL NUMBER (TE1/EXPAND*TE2-INT(ALOG10(AMAX0(I/EXPAND,1))+.01)
 204      *   *YN/2.-YN*.3,
 205      *   -1.3,YN,COND(ABISMI,I/60.,I/EXPAND),0,-1)
 206         CALL FACTOR (TE2,TE3)
 207         CALL XYPLOT (TE1/EXPAND,0,PENUP)
 208 30      CALL XYPLOT (TE1/EXPAND,0,PENDWN)
 209         CALL FACTOR (1.,1.)
 210         CALL XYPLOT (0,.5,-PENUP)
 211         CALL SYMBOL (XLEN/1.5,-YOFSET,YZ,TEXT0(NCOND(ABISMI,1,3)),0,10)
 212 C
 213 C
 214 40      CALL FACTOR (1.,1.)
 215         IF (BREAK(11)) GOTO 60          @ USER SWITCHED OFF THE PLOTTER
 216         CALL LABPLT (0,-YOFSET,PLEND)
 217         IF (BREAK(11)) GOTO 60
 218         CALL SYMBOL (YZ,YLEN+YZ,YZ,LABEL,0,MIN0(42,LABCNT*6)) @ PLOT 42 CHARACTERS INTO THE FIRST LINE OF LABEL
 219         IF (LABCNT.GT.7)
 220      *  CALL SYMBOL (YZ,YLEN,YZ,LABEL(8),0,LABCNT*6-42) @ AND THE REMAINING INTO THE NEXT LINE
 221 60      CONTINUE
 222         CALL XYPLOT (38.,25.,PENUP)
 223         CALL EXPLT
 224         RETURN
 225 1       FORMAT (' KANAL ABZISSE/ORDINATE (ZEITBASIS=8), SCHRITTWEITE',
 226      *  ' (2I1,I3) (',
 227      *  2I1,I3,')? ',$)
 228 2       FORMAT (2I1,I3)
 229 3       FORMAT (' ANZAHL DER DARZUSTELLENDEN KANAELE (I1) (',I1,
 230      *  ') ? ',$)
 231 4       FORMAT (' NUR FUER',F6.1,' SEK. MESSDATEN JEDOCH',F6.1,
 232      *  ' SEC. ANGEFORDERT. ')
 233 5       FORMAT (' UNTERE, OBERE SCHWELLE? F5.0/F5.0: ')
 234 6       FORMAT (F5.0/F5.0)
 235         END
 236 \1a