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

   1 C       -+-+-+-+-+ \ e  H A E P R L . F T  \ e -+-+-+-+-+
   2 C
   3 C       HERE WE PLOT THE RELATIVE [P(I)/P] INTENSITIES OF THE 5 FREQUENCY BANDS
   4 C        FROM THE POWER SPECTRA STORED ON SCRATCH UNIT 5
   5 C
   6         SUBROUTINE PRLOT
   7         INCLUDE HAEBUF.FI
   8         INCLUDE HAEGSA.FI
   9         INCLUDE HAEPTI.FI
  10         INCLUDE HABRK.FI
  11         INCLUDE HAEI85.FI
  12         INCLUDE HAECSZ.FI
  13         INCLUDE HAETTY.FI
  14         INCLUDE HAPPEN.FI
  15 C
  16 \fC
  17         LOGICAL MLTPLE
  18         REAL COND
  19         INTEGER NCOND
  20         EXTERNAL MLTPLE,COND,NCOND
  21 C
  22         REAL ORD,ABZ,TEMSET,
  23      *  ABMAX(2,5),                     @ ABSOLUT/ RELATIVE MAXIMUM OF THE BAND INTENSITY DATA
  24      *  TE1,TE2,TE3,TE4,                @ TEMPORARY STORAGE
  25      *  INTFAC,ORDMAX                   @ FACTOR TO SCALE THE INTENSITY OF EACH BAND, MAXIMUM OF THE ORDINATE
  26         INTEGER I,BAND,N,
  27      *  RELABS,                         @ ABS INTENSITY =1, REL INTENSITY =2
  28      *  PNT,                            @ MOD(I,4)+1 TEMP STORAGE
  29      *  SKIPIT                          @ STARTING LOCATION OF THE DATA SET WANTED
  30         LOGICAL F1,                     @ SAMPLE BUFFER IS EMPTY FLAG
  31      *  L1,                             @ TEMPORARY STORAGE
  32      *  ABISMI                          @ TIME AXIS SCALING IS IF ABISMI THEN MINUTES ELSE SECONDS FI
  33         INTEGER PENPOS                  @ TEMPORARY PEN STATUS
  34 C
  35 C       STATEMENT FUNCTIONS ARE:
  36 C
  37         INTEGER DATTIM                  @ STARTING TIME OF THIS POWER SPECTRUM DATA RECORD WITHIN THE SAMPLE
  38         DATTIM(IP1)=INTE(3,1,MOD(IP1,4)+1)
  39         LOGICAL MUSTRD                  @ MUSTRD DECIDES IF WE HAVE TO READ THE NEXT INTE RECORD
  40         MUSTRD(IP1)=MOD(IP1,4).EQ.0
  41 C
  42 C       OPEN THE INPUT DATA FILE UNIT 5
  43 C       READ THE FIRST BLOCK OF THE FILE HEADER AND
  44 C        THE DATA HEADER I.E. COMMON CEGSA THE SECOND BLOCK OF UNIT 5
  45 C
  46         IF (REC5.LT.1) DEFINE FILE5(MAXBL5,85,U,REC5)
  47         REC5=1
  48         F1=SAMCNT.EQ.0 .OR. .NOT. COMP @ HEADER OF FILE 5 DOES NOT MATCH THE HEADER OF THE ACTUAL SAMPLE BUFFER
  49         READ (5'REC5) (RCRD0(I),I=1,85) @ READ THE FILE HEADER
  50         IF (F1) SAMCNT=0                @ CLEAR THE ACTUAL SAMPLE BUFFER
  51         IF (F1) COMP=.FALSE.            @ AND THE COMPUTATIONS FLAG TOO
  52         IF (REDVAL.NE.6H2DPWLD) GOTO 20 @ RECORD IS EMPTY
  53         REDVAL=0                        @ FOR SAVETY ONLY
  54         WRITE (TTO,3) (LABEL(I),I=1,LABCNT) @ TYPE OUT THE LABEL OF THIS DATA SET
  55         READ (5'REC5) LCEGSA(1),(LCEGSA(I),I=2,LCEGSA(1)) @ READ THE DATA HEADER BLOCK ( COMMON CEGESA)
  56         SETNUM=SETNU5                   @ INSERT THE NUMBER OF THE ACTUAL DATA SET
  57         CHANEL=CHANE5                   @ AND THE NUMBER OF THE CHANNEL INVESTIGATED TOO
  58 C
  59 \fC      HERE WE PLOT THE RELATIVE INTENSITY / TIME
  60 C
  61         BEGIN=NCOND(PZBEG,PZBEG,BEGIN)
  62         ENDS=NCOND(PZEND,PZEND,BEGFFT+SPAN)
  63         IF (OPTION.NE.12) CALL ASKHIM(2) @ ASK FOR BEGIN AND ENDS
  64         PZBEG=BEGIN
  65         PZEND=ENDS
  66 C
  67 C       COMPUTE THE MAXIMA OF THE ORDINATE (INTENSITIES)
  68 C
  69         DO 33 BAND=1,5
  70 33      ABMAX(2,BAND)=0
  71         ABMAX(1,1)=0
  72         N=0
  73 C       READ THE STARTING TIME OF THE INTENSITY DATA COMPUTED AND
  74 C       THEN WE COMPUTE THE RECORD NUMBER OF THE INTENSITY DATA WE WANT TO PLOT
  75         REC5=STSCAN                     @ READ THE FIRST INTENSITY DATA RECORD
  76         READ (5'REC5) INTE85
  77         SKIPIT=(BEGIN-INTE(3,1,1))/OVRLAP @  THE NUMBER OF DATA POINT TO SKIP --> SKIPIT
  78         SKIPIT=0                @ CXCXCXCXCXCXCXCX
  79         IF (SKIPIT.LT.DATCNT) GOTO 25   @ IF THE PLOT EXCEEDS THE DATA COMPUTED
  80         REC5=STSCAN+(DATCNT-1)/4        @  THEN WE PRINT AN ERROR MSG ELSE WE CONTINUE AT 25
  81         READ (5'REC5) INTE85            @ READ THE LAST RECORD OF THE UNIT 5
  82         WRITE (TTO,2) PZBEG,PZEND,INTE(3,1,MOD(DATCNT-1,4)) @ AND TYPE THE ERROR MSG
  83 C
  84 25      CONTINUE
  85         REC5=STSCAN+SKIPIT/4            @ READ THE FIRST RECORD WANTED
  86         READ (5'REC5) INTE85            @
  87 C
  88 C       COMPUTE THE MAXIMUM OF EACH BAND
  89 C
  90         DO 35 I=0,DATCNT-1              @ LOOP FOR EACH POWER SPECTRUM
  91         IF (BREAK(11)) RETURN
  92         REC5=STSCAN+I/4
  93         IF (MUSTRD(I)) READ (5'REC5) INTE85
  94         IF (DATTIM(I).LT.BEGIN) GOTO 35 @ GO AND FETCH THE NEXT DATA WORDS
  95         IF (DATTIM(I).GT.ENDS) GOTO 34 @ WE MAY LEAVE THIS LOOP - WORK IS DONE
  96         PNT=MOD(I,4)+1                  @ TEMP STORAGE
  97         ABMAX(1,1)=ABMAX(1,1)+INTE(1,1,PNT)
  98         N=N+1
  99         DO 30 BAND=2,5                  @ LOOP FOR EACH BAND
 100 30      ABMAX(2,BAND)=AMAX1(ABMAX(2,BAND),INTE(4,BAND,PNT))
 101 35      CONTINUE
 102 34      CONTINUE
 103         ABMAX(1,1)=ABMAX(1,1)/N*2.
 104         ABMAX(2,1)=1.                   @ DON'T FORGET THE 100% LINE P/P
 105 C
 106 C       CHECK THE MAXIMUM FOR THE ABSOLUTE INTENSITY BAND # 1
 107 C
 108         DO 40 BAND=1,1
 109 43      TE1=1.                          @ COUNTS ALL POINTS PLOTTED
 110         TE2=0                           @ COUNTS ALL POINTS .GT. MAXIMUM OF PLOT
 111         DO 45 I=SKIPIT,DATCNT-1         @ WE SCAN ALL DATA ENTRIES
 112         IF (BREAK(11)) RETURN
 113         REC5=STSCAN+I/4
 114         IF (MUSTRD(I)) READ (5'REC5) INTE85
 115         IF (DATTIM(I).LT.BEGIN) GOTO 45 @ FETCH THE NEXT DATA WORDS
 116         IF (DATTIM(I).GT.ENDS) GOTO 44 @ THE WORK IS DONE, SO WE LEAVE THE LOOP
 117         TE1=TE1+1.                      @ COUNTS ALL POINTS HERE
 118         IF (INTE(1,BAND,MOD(I,4)+1).GT.ABMAX(1,BAND)) TE2=TE2+1. @ COUNT ALL POINTS .GT. MAXIMUM
 119 45      CONTINUE
 120 44      CONTINUE
 121 CX      WRITE (4,49) TE1,TE2,ABMAX(1,BAND) @ PRINT SOME DIAGNOSTIC MSG
 122 CX49    FORMAT (' TE1:',1P,E8.1,' TE2:',E8.1,' ABMAX:',E8.1)
 123         IF (TE2/TE1.LT.0.02 .OR. TE1.LT.13.) GOTO 40 @ IF 90% OF ALL POINTS ARE PLOTTED THEN WE PROCEED TO THE NEXT BAND
 124         ABMAX(1,BAND)=ABMAX(1,BAND)*SQRT(2.)
 125         GOTO 43                         @ CHECK AGAIN
 126 40      CONTINUE
 127 \fC
 128 C       OPEN THE PLOTTER
 129 C
 130         CALL STPLT                      @ START THE PLOTTER ( CALL PLOTS)
 131         CALL XYPLOT (XOFSET,YOFSET,-PENUP)
 132 C
 133 C       THE LOOP FOR EACH BAND AND THE TOTAL INTENSITY
 134 C
 135         DO 120 BAND=1,5
 136         IF BREAK(11) GOTO 140
 137         TEMSET=(YLEN+YSTEP)/5.*FLOAT(5-BAND)
 138         CALL XYPLOT (0,TEMSET,-PENUP) @ SET THE NEW ORIGIN FOR THIS STAMP HERE
 139         RELABS=NCOND(BAND-1,2,1)        @ IF 2 TO 4 THEN WE PLOT THE RELATIVE INTENSITIES ELSE THE ABSOLUTE ONE
 140         TE1=ABMAX(RELABS,1)
 141         INTFAC=COND(ABMAX(RELABS,BAND).GT.TE1/2.,1.,
 142      *   ABMAX(RELABS,BAND).GT.TE1/5., 0.5,
 143      *   ABMAX(RELABS,BAND).GT.TE1/10.,0.2 ,0.1) @ NORM TO NEW MAXIMUM
 144         ORDMAX=ABMAX(RELABS,1)*INTFAC   @ COMPUTE MAXIMUM OF ORDINATE
 145         CALL FACTOR (XLEN/(ENDS-BEGIN),(YLEN-4.*YSTEP)/5./ORDMAX)
 146 C
 147 C       THE LOOP FOR EACH POWER SPECTRUM
 148 C
 149         PENPOS=PENUP
 150         L1=.FALSE.
 151         DO 130 I=SKIPIT,DATCNT-1
 152         IF BREAK(11) GOTO 131           @ IF THE USER GETS RID OF THIS TASK THEN EXIT VIA 131
 153         REC5=STSCAN+I/4                 @ COMPUTE THE NUMBER OF THE NEXT RECORD WHERE TO READ INTE85 (4 DATA SETS PER RECORD)
 154         IF (MUSTRD(I)) READ (5'REC5) INTE85
 155         ORD=INTE(NCOND(RELABS-1,4,1),BAND,MOD(I,4)+1) @ THE INTENSITY OF THIS BAND --> ORD (BAND #1 IS THE ABSOLUTE ONE)
 156         PENPOS=NCOND(ORD.GT.ORDMAX.AND.L1,PENUP,PENPOS) @ WE DON'T PLOT POINTS .GT. ORDMAX
 157         L1=ORD.GT.ORDMAX
 158         ORD=AMIN1(ORD,ORDMAX)
 159 C                                       @ THE TIME AXIS STARTS AT BEGIN+SPAN/2. SO WE
 160         ABZ=DATTIM(I)                   @  INSERT THE TIME SCALE [SECONDS] --> ABZ
 161         IF (ABZ.LT.BEGIN) GOTO 130      @  SKIP ALL THE POINTS BEFORE THE BEGIN  TIME
 162         IF (ABZ.GT.ENDS) GOTO 131       @ IF WE PASSED THE END OF THE PLOT THEN WE TERMINATE THE LOOP
 163
 164         ABZ=ABZ-BEGIN                   @  ELSE WE PLOT THIS DATA POINT ( THE FIRST ONE WITH PEN UP) RELATIVE TO THE BEGIN OF THE PLOT
 165         CALL XYPLOT (ABZ,ORD,PENPOS)
 166         PENPOS=PENDWN                   @ 'PEN DOWN' FROM NOW ON
 167
 168 130     CONTINUE                        @ LOOP TO FETCH THE NEXT DATA POINT
 169 131     CONTINUE                        @  ALL THE WORK DONE FOR THE ACTUAL BAND
 170 C
 171 C       PLOT THE INTENSITY SCALE
 172 C
 173         IF (BREAK(11)) GOTO 140         @ IF THE USER GET'S RID OF PLOT THEN WE EXIT
 174         CALL WHERE (TE1,TE1,TE1,TE1)    @ GET THE ACTUAL Y FACTOR
 175         CALL FACTOR (1.,TE1)            @ AND SWITCH X FACTOR TO 1.
 176         CALL XYPLOT (-.5,0,-PENUP)      @ LOWER LEFT CORNER
 177         PENPOS=PENUP
 178         DO 132 I=0,10
 179         TE1=ORDMAX/INTFAC*I/10.
 180         IF (TE1.GT.ORDMAX+ORDMAX/500.) GOTO 133 @ AXIS IS COMPLETE
 181         CALL XYPLOT (0,TE1,PENPOS)
 182         IF (.NOT.(I.EQ.INT(10.*INTFAC+.5) .OR.
 183      *   I.EQ.0)) GOTO 110
 184 C       MARK THE START AND THE END OF THE SCALE
 185         CALL WHERE (TE2,TE2,TE2,TE3)    @ GET THE X AND Y FACTOR
 186         CALL FACTOR (1.,1.)
 187         TE4=COND(RELABS-1,I*.1,FLOAT(I))
 188         CALL NUMBER (-.7-COND(TE4.EQ.0,0,
 189      *   TE4.LT. 0.9,2*YN, TE4.GT.9.,YN),
 190      *   TE3*TE1-YN*.3,YN,TE4,0,NCOND(TE4.EQ.0.OR.TE4.GE.1.,-1,1))
 191         CALL FACTOR (TE2,TE3)
 192         CALL XYPLOT (0,TE1,PENUP)
 193 110     PENPOS=PENDWN
 194         TE2=COND(INTFAC.EQ.1. .AND. I.EQ.5,-0.5,-0.3)   @ A SMALL BAR TO THE LEFT
 195         CALL XYPLOT (TE2,TE1,PENDWN)
 196 132     CALL XYPLOT (0,TE1,PENDWN)
 197 133     CALL XYPLOT (.5,0,-PENUP)       @ RESET CORRECT LOWER LEFT CORNER
 198 C
 199         CALL FACTOR (1.,1.)             @ RESET ORIGIN TO XOFSET,YOFSET
 200         CALL SYMBOL (-XOFSET,YLEN*.1,YN,'P',0,1)
 201         IF (GENAM(BAND).NE.2H  )
 202      *   CALL GREEK(-XOFSET+YN*.3,YLEN*0.1-.3,YN*0.75,GENAM(BAND),0)
 203         IF (BAND.GE.2)
 204      *   CALL SYMBOL (-XOFSET+YN*1.2,YLEN*.1,YN,'/P',0,2) @ MARK THE RELATIVE INTENSITY
 205 C
 206 C       PLOT THE FREQUENCY RANGE OF THIS BAND
 207 C
 208         CALL NUMBER (XLEN+YN*.6,0,YN*.5,FREQU(BAND,1),90.,1)
 209         CALL SYMBOL (999.,999.,YN*.5,'-',90.,1)
 210         CALL NUMBER (999.,999.,YN*.5,FREQU(BAND,2),90.,1)
 211 C
 212         CALL XYPLOT (0.,-TEMSET,-PENUP)
 213 120     CONTINUE
 214 \fC
 215         CALL PLALRL                     @ AND NOW WE PLOT THE TIME AXIS
 216         RETURN
 217 C
 218 140     CONTINUE                        @ USER ABORTS THE PLOT
 219         CALL FACTOR (1.)
 220         CALL XYPLOT (38.,25.,PENUP)     @ DRIVE PEN INTO THE UPPER RIGHT CORNER
 221         CALL EXPLT
 222         RETURN
 223 C
 224 20      CONTINUE                        @ FILE 5 IS EMPTY
 225         COMPUT=0
 226         SAMCNT=0
 227         WRITE (TTO,1)                   @ NO DATA TO PLOT
 228         RETURN
 229 C
 230 1       FORMAT (' KEINE DATEN IN DER DATEI 5')
 231 2       FORMAT (' DER PLOT SOLL VON',I5,' BIS',I5,' SEK. DAMIT UEBER ',
 232      *  'DAS DATENENDE',I5,' SEK. HINAUSGEHEN.')
 233 3       FORMAT (1X,14A6)
 234         END
 235 \1a