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

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