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

   1 C       -+-+-+-+-+ \ e  H A E P F L . F T  \ e -+-+-+-+-+
   2 C
   3 C       HERE WE PLOT THE SUMMED POWER SPECTRUM (INTENSITY) TO THE FREQUENCY
   4 C       OF THE FFT DATA STORED ON UNIT 5
   5 C
   6 C       * UP 26-JAN-83
   7 C
   8         SUBROUTINE PFLOT
   9         INCLUDE HAEBUF.FI
  10         INCLUDE HAEGSA.FI
  11         INCLUDE HAEPTI.FI
  12         INCLUDE HABRK.FI
  13         INCLUDE HAEI85.FI
  14         INCLUDE HAECSZ.FI
  15         INCLUDE HAPPEN.FI
  16         INCLUDE HAETTY.FI
  17 C
  18 \fC
  19         REAL COND
  20         INTEGER NCOND
  21         EXTERNAL COND,NCOND
  22 C
  23         REAL FFTX(85),                  @ PART OF THE FFT BUFFER
  24      *  ORD,ABZ,
  25      *  TE1,TE2,TE3,                    @ TEMPORARY STORAGE
  26      *  INTFAC,ORDMAX,                  @ FACTOR TO SCALE THE INTENSITY OF EACH BAND, MAXIMUM OF THE ORDINATE
  27      *   SUMM,                          @ SUMM OF ALL INTENSITIES
  28      *   TEMSET                         @ TEMP Y OFFSET FOR OPTION '1' PLOTTS (OVERPLOT)
  29         INTEGER I,J,K,INCR2,PNT,BAND,
  30      *  RELABS                          @ ABS INTENSITY =1, REL INTENSITY =2
  31         LOGICAL F1,                     @ SAMPLE BUFFER IS EMPTY FLAG
  32      *  L1                              @ TEMPORARY STORAGE
  33         INTEGER PENPOS                  @ TEMPORARY PEN STATUS
  34 C
  35 C
  36 C
  37 C       OPEN THE INPUT DATA FILE UNIT 5
  38 C        READ THE FILE HEADER FIRST BLOCK AND
  39 C        THE DATA HEADER, THE SECOND BLOCK OF UNIT 5
  40 C        INSERT THE COMMON CEGESA FROM THE DATA FILE
  41 C
  42         IF (REC5.LT.1) DEFINE FILE5(MAXBL5,85,U,REC5)
  43         REC5=1
  44         F1=SAMCNT.EQ.0 .OR. .NOT. COMP @ HEADER OF FILE 5 DOES NOT MATCH THE HEADER OF THE ACTUAL SAMPLE BUFFER
  45         READ (5'REC5) (RCRD0(I),I=1,85) @ READ THE FILE HEADER
  46         IF (F1) SAMCNT=0                @ CLEAR THE ACTUAL SAMPLE BUFFER
  47         IF (F1) COMP=.FALSE.            @ AND THE COMPUTATIONS FLAG TOO
  48         IF (REDVAL.NE.6H2DPWLD) GOTO 20 @ RECORD IS EMPTY
  49         REDVAL=0                        @ FOR SAVETY ONLY
  50         READ (5'REC5) LCEGSA(1),(LCEGSA(I),I=2,LCEGSA(1)) @ READ THE DATA HEADER BLOCK ( COMMON CEGESA)
  51         SETNUM=SETNU5
  52         CHANEL=CHANE5
  53 C       HERE WE PLOT THE LAST POWER SPECTRUM STORED ON UNIT 5 REC 3 TO STSCAN
  54 C
  55         INCR2=INCR/2                    @ NUMBER OF DATA POINTS IN POWER SPECTRUM
  56         PLTEND=NCOND(PLTEND,PLTEND,SAMRAT/2) @ DEFAULT END OF FREQUENCY SCALE
  57 C
  58 C       READ THE FREQUENCY AND INTENSITY RANGE OF THE PLOT
  59         IF (OPTION.EQ.12) GOTO 34       @ PF* TAKES THE DEFAULT VALUES AND DOESNT ASK QUESTIONS
  60 32      WRITE (TTO,4) PLTEND,PLTBEG
  61         READ (TTI,6) I,J                @ ASK FOR THE FREQUENCY WINDOW TO PLOT
  62         IF BREAK(11) RETURN             @ USER ABORTS PROGRAM
  63         PLTEND=NCOND(I,I,PLTEND)        @ NO INPUT LOADS DEFAULT VALUES
  64         PLTBEG=NCOND(J,J,PLTBEG)
  65 34      IF (PLTEND-PLTBEG .LE.0) GOTO 32 @ UPPER AND LOWER LIMITS MIXED, USER HAS TO RETYPE
  66 C
  67 C
  68 C       COMPUTE THE WHOLE SUMM OF ALL INTENSITIES
  69 C
  70         XMAXI=0                         @ THIS HOLDS THE SUMM
  71         DO 40 I=1,INCR/2
  72         J=MOD(I-1,85)
  73         IF (J.EQ.0) READ (5'REC5) FFTX
  74 40      XMAXI=FFTX(J+1)+XMAXI
  75 C
  76         IF (OPTION.EQ.12) GOTO 30       @ PF* TAKES THE DEFAULT VALUES AND DOESNT ASK QUESTIONS
  77 33      WRITE (TTO,5) XMAXI             @ ASK FOR THE SIZE OF INTENSITY SCALE
  78         READ (TTI,7) TE1
  79         IF BREAK(11) RETURN             @ USER SWITCHED OFF THE TASK
  80         TE1=COND(TE1.LT.100.,TE1*XMAXI*.01,TE1)
  81         XMAXI=COND(TE1,TE1,XMAXI)       @ NO INPUT MEANS THE ACTUAL MAXIMUM
  82         IF (XMAXI.LE.0) GOTO 33         @ NEGATIVE POWER SPECRUM INTENSITY IS NOT VALID
  83 30      CONTINUE
  84 C
  85 CXCX    XMAXI=ALOG(XMAXI)               @ CXCX DISABLES LOG INTENSITY VERSION OF HAEPLO
  86         CALL STPLT                      @ OPEN THE PLOTTER ( CALL PLOTS)
  87         NUMCN=NCOND(OPTION.NE.1,1,2)
  88         CALL XYPLOT (XOFSET,YOFSET,-PENUP)
  89         TEMSET=(NUMCN-(CHANEL+1))*
  90      *   YLEN/FLOAT(NUMCN)+(NUMCN-(CHANEL+1))*.5 @ SEE HAESPL FOR DETAILS!
  91         IF (OPTION.EQ.1) CALL XYPLOT(0,TEMSET,-PENUP) @ SET NEW OFFSET FOR OVERPLOT OPTION
  92         IF (OPTION.NE.1) CALL FACTOR (XLEN/(SPAN*(PLTEND-PLTBEG)),
  93      *   YLEN/XMAXI)                    @ FACTOR FOR NORMAL PLOT (ONE PER PAGE)
  94         IF (OPTION.EQ.1) CALL FACTOR (XLEN/(SPAN*(PLTEND-PLTBEG)),
  95      *   ((YLEN-NUMCN*.5+COND(NUMCN-1,.5))/FLOAT(NUMCN)/XMAXI)) @ SIZE OF DIAGRAM
  96 C
  97         L1=.FALSE.
  98         REC5=3
  99         SUMM=0
 100         PENPOS=PENUP
 101         DO 10 I=PLTBEG*SPAN,PLTEND*SPAN,1
 102         IF (BREAK(11)) GOTO 11          @ USER GETS RID OF PROGRAM, RESET TEMSET OFFSET AND THEN WE ABORT
 103         J=MOD(I,85)
 104         IF (J.EQ.0) READ (5'REC5) FFTX
 105         ABZ=I
 106         SUMM=FFTX(J+1)+SUMM
 107         ORD=SUMM
 108 CXCX    ORD=AMIN1(ALOG(AMAX1(.1,FFTX(J+1))),XMAXI)
 109         L1=ORD.GT.XMAXI .AND. L1        @ TRUNCATE SUCH POINTS WHICH ARE TOO LARGE FOR THIS INTENSITY SCALE
 110         PENPOS=NCOND(L1,PENUP,PENPOS)
 111         L1=ORD.GT.XMAXI
 112         ORD=AMIN1(ORD,XMAXI)            @ PLOT TO THE BOUNDER OF THIS DIAGRAM
 113         CALL XYPLOT (ABZ,ORD,PENPOS)
 114         PENPOS=PENDWN
 115 10      CONTINUE
 116 11      CONTINUE                        @ WORK DONE, RESET ORIGIN
 117         CALL FACTOR (1.)
 118         IF (OPTION.EQ.1) CALL XYPLOT (0,-TEMSET,-PENUP) @ RESET OVERPLOTT OFFSET
 119 \fC
 120 C       MAKE A SCALE
 121 C
 122 C       FREQUENCY SCALE FROM PLTBEG TO PLTEND HERTZ
 123 C
 124         IF (BREAK(11)) GOTO 15
 125         IF (OPTION.EQ.1) GOTO 15        @ OVERPLOT OPTION - NO SCALE
 126         CALL FACTOR (XLEN/(PLTEND-PLTBEG),1.)
 127         CALL XYPLOT (0,-.5,-PENUP)
 128         DO 12 I=PLTBEG,PLTEND           @ 1 HERTZ STEP SIZE
 129         TE1=FLOAT(I-PLTBEG)
 130         CALL XYPLOT (TE1,0,PENDWN)
 131         J=MOD(I,NCOND(PLTEND.GT.30,10, PLTEND.GT.15,5,
 132      *   PLTEND.GT.6,2,1))
 133         TE2=COND(J.EQ.0,-.7, J.EQ.5,-.5, -.3)
 134         CALL XYPLOT (TE1,TE2,PENDWN)
 135         IF (J.NE.0) GOTO 12
 136         CALL WHERE (TE2,TE2,TE2,TE3)    @ GET THE X FACTOR
 137         CALL FACTOR (1.)
 138         CALL NUMBER (TE1*TE2-INT(ALOG10(AMAX1(1.,TE1))
 139      *   +.01)*YN/2.-YN*.3,
 140      *   -1.3,YN,TE1,0,-1)
 141         CALL FACTOR (TE2,TE3)
 142         CALL XYPLOT (TE1,0,PENUP)
 143 12      CALL XYPLOT (TE1,0,PENDWN)
 144         CALL XYPLOT (0,.5,-PENUP)
 145         CALL FACTOR (1.)
 146         IF (.NOT. BREAK(9))
 147      *   CALL SYMBOL (XLEN/2.,-YOFSET,YZ,
 148      *  'FREQUENCY [HZ]',0,14)
 149 C
 150 C       INTENSITY SCALE LINEAR FROM 0 TO XMAXI
 151 C
 152         IF BREAK(11) GOTO 15
 153         CALL FACTOR (1.,YLEN/XMAXI)
 154         CALL XYPLOT (-.5,0,-PENUP)
 155         TE2=XMAXI/10.
 156         DO 14 I=0,10
 157         TE1=TE2*I
 158         CALL XYPLOT (0,TE1,PENDWN)
 159         J=MOD(I,10)
 160         TE3=COND(J.EQ.0,-.7, J.EQ.5,-.5, -.3)
 161         CALL XYPLOT (TE3,TE1,PENDWN)
 162 14      CALL XYPLOT (0,TE1,PENDWN)
 163 C       INSERT THE INTENSITY SCALE MAXIMUM
 164         CALL WHERE (TE2,TE2,TE2,TE3)
 165         CALL FACTOR (1.)
 166         CALL ENUMBR (-1.1,TE1*TE3-4.*YN,YN,XMAXI,90.,1)
 167         CALL FACTOR (TE2,TE3)
 168         CALL XYPLOT (.5,0,-PENUP)
 169         CALL FACTOR (1.)
 170         IF (.NOT. BREAK(9))
 171      *   CALL SYMBOL (-XOFSET,0,YZ,
 172      *  ' INTENSITY SUMM [ARB. UNITS]',90.,30)
 173 C
 174 C
 175 15      CONTINUE                        @ ENTRY HERE IF USER SWITCHED OFF PLOTTING
 176         CALL FACTOR (1.)
 177         IF (OPTION.EQ.1) GOTO 50        @ '1' OPTION, NO COMMENT AT ALL!
 178         CALL SYMBOL (YZ,YLEN+YZ,YZ,LABEL,0,MIN0(42,LABCNT*6))
 179         IF (LABCNT.GT.7)
 180      *  CALL SYMBOL (3.*YZ,YLENYZ,YZ,LABEL(8),0,LABCNT*6-42)
 181 C
 182         IF (.NOT. BREAK(9))
 183      *   CALL LABPLT (0.,-YOFSET,BEGIN+SPAN) @ INSERT CHANNEL AND TIME
 184 50      CONTINUE                        @ WE COME HERE IF '1' OPTION ON
 185         CALL XYPLOT(38.,25.,PENUP)
 186         CALL EXPLT                      @ CLOSE THE PLOTTER
 187         RETURN
 188 C
 189 C
 190 20      CONTINUE                        @ FILE 5 IS EMPTY
 191         COMPUT=0
 192         SAMCNT=0
 193         WRITE (TTO,1)                   @ NO DATA TO PLOT
 194         RETURN
 195 C
 196 \fC
 197 1       FORMAT (' KEINE DATEN IN DER DATEI 5')
 198 2       FORMAT (' SUMME DER LEISTUNGSSPEKTREN UEBER ',F4.1,' -->',
 199      *  F5.1,' GEZEICHNET.')
 200 4       FORMAT (' FREQUENZSKALA ENDE, ANFANG? (',I2,1H,,I2,
 201      *  ') ? ',$)
 202 5       FORMAT (' ORDINATEN MAXIMUM?       (',1P,E8.1,') ? ',$)
 203 6       FORMAT (I2,1X,I2)
 204 7       FORMAT (E8.1)
 205         END
 206 \1a