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

   1 C       -+-+-+-+-+ \ e  H A E P A L . F T  \ e -+-+-+-+-+
   2 C
   3 C       HERE WE PLOT THE ABSOLUT INTENSITIES OF THE 5 FREQUENCY BANDS
   4 C        FROM THE POWER SPECTRA STORED ON SCRATCH UNIT 5.
   5 C
   6         SUBROUTINE PALOT
   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,                    @ 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 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(1,BAND)=0
  71         N=0
  72 C       READ THE STARTING TIME OF THE INTENSITY DATA COMPUTED AND
  73 C       THEN WE COMPUTE THE RECORD NUMBER OF THE INTENSITY DATA WE WANT TO PLOT
  74         REC5=STSCAN                     @ READ THE FIRST INTENSITY DATA RECORD
  75         READ (5'REC5) INTE85
  76         SKIPIT=(BEGIN-INTE(3,1,1))/OVRLAP @  THE NUMBER OF DATA POINT TO SKIP --> SKIPIT
  77         IF (SKIPIT.LT.DATCNT) GOTO 25   @ IF THE PLOT EXCEEDS THE DATA COMPUTED
  78         REC5=STSCAN+(DATCNT-1)/4        @  THEN WE PRINT AN ERROR MSG ELSE WE CONTINUE AT 25
  79         READ (5'REC5) INTE85            @ READ THE LAST RECORD OF THE UNIT 5
  80         WRITE (TTO,2) PZBEG,PZEND,INTE(3,1,MOD(DATCNT-1,4)) @ AND TYPE THE ERROR MSG
  81 C
  82 25      CONTINUE
  83         REC5=STSCAN+SKIPIT/4            @ READ THE FIRST RECORD WANTED
  84         READ (5'REC5) INTE85            @
  85 C
  86 C       COMPUTE THE MAXIMUM OF EACH BAND
  87 C
  88         DO 35 I=0,DATCNT-1              @ LOOP FOR EACH POWER SPECTRUM
  89         IF (BREAK(11)) RETURN
  90         REC5=STSCAN+I/4
  91         IF (MUSTRD(I)) READ (5'REC5) INTE85
  92         IF (DATTIM(I).LT.BEGIN) GOTO 35 @ GO AND FETCH THE NEXT DATA WORDS
  93         IF (DATTIM(I).GT.ENDS) GOTO 34 @ WE MAY LEAVE THIS LOOP - WORK IS DONE
  94         N=N+1
  95         PNT=MOD(I,4)+1                  @ TEMP STORAGE
  96         DO 30 BAND=1,5                  @ LOOP FOR EACH BAND
  97 30      ABMAX(1,BAND)=ABMAX(1,BAND)+INTE(1,BAND,PNT)
  98 35      CONTINUE
  99 34      CONTINUE
 100         DO 36 BAND=1,5
 101 36      ABMAX(1,BAND)=ABMAX(1,BAND)/N*2.
 102 C
 103 C       CHECK THE MAXIMUM
 104 C
 105         DO 40 BAND=1,5
 106 43      TE1=0                           @ COUNTS ALL POINTS PLOTTED
 107         TE2=0                           @ COUNTS ALL POINTS .GT. MAXIMUM OF PLOT
 108         DO 45 I=0,DATCNT-1              @ WE SCAN ALL DATA ENTRIES
 109         IF (BREAK(11)) RETURN
 110         REC5=STSCAN+I/4
 111         IF (MUSTRD(I)) READ (5'REC5) INTE85
 112         IF (DATTIM(I).LT.BEGIN) GOTO 45 @ FETCH THE NEXT DATA WORDS
 113         IF (DATTIM(I).GT.ENDS) GOTO 44 @ THE WORK IS DONE, SO WE LEAVE THE LOOP
 114         TE1=TE1+1.                      @ COUNTS ALL POINTS HERE
 115         IF (INTE(1,BAND,MOD(I,4)+1).GT.ABMAX(1,BAND)) TE2=TE2+1. @ COUNT ALL POINTS .GT. MAXIMUM
 116 45      CONTINUE
 117 44      CONTINUE
 118 CX      WRITE (4,49) TE1,TE2,ABMAX(1,BAND) @ PRINT SOME DIAGNOSTIC MSG
 119 CX49    FORMAT (' TE1:',1P,E8.1,' TE2:',E8.1,' ABMAX:',E8.1)
 120         IF (TE2/TE1.LT.0.02) GOTO 40    @ IF 98% OF ALL POINTS ARE PLOTTED THEN WE PROCEED TO THE NEXT BAND
 121         ABMAX(1,BAND)=ABMAX(1,BAND)*SQRT(2.)
 122         GOTO 43                         @ CHECK AGAIN
 123 40      CONTINUE
 124 \fC
 125 C       OPEN THE PLOTTER
 126 C
 127         CALL STPLT                      @ START THE PLOTTER ( CALL PLOTS)
 128         CALL XYPLOT (XOFSET,YOFSET,-PENUP)
 129 C
 130 C       THE LOOP FOR EACH BAND AND THE TOTAL INTENSITY
 131 C
 132         DO 120 BAND=1,5
 133         IF BREAK(11) GOTO 140
 134         TEMSET=(YLEN+YSTEP)/5.*FLOAT(5-BAND)
 135         CALL XYPLOT (0,TEMSET,-PENUP) @ SET THE NEW ORIGIN FOR THIS STAMP HERE
 136         RELABS=1                        @ WE PLOT THE ABSOLUT INTENSITIES
 137         TE1=ABMAX(RELABS,1)
 138         INTFAC=COND(ABMAX(RELABS,BAND).GT.TE1/2.,1.,
 139      *   ABMAX(RELABS,BAND).GT.TE1/5., 0.5,
 140      *   ABMAX(RELABS,BAND).GT.TE1/10.,0.2 ,0.1) @ NORM TO NEW MAXIMUM
 141         ORDMAX=ABMAX(RELABS,1)*INTFAC   @ COMPUTE MAXIMUM OF ORDINATE
 142         CALL FACTOR (XLEN/(ENDS-BEGIN),(YLEN-4.*YSTEP)/5./ORDMAX)
 143 C
 144 C       THE LOOP FOR EACH POWER SPECTRUM
 145 C
 146         PENPOS=PENUP
 147         L1=.FALSE.
 148         DO 130 I=0,DATCNT-1
 149         IF BREAK(11) GOTO 131           @ IF THE USER GETS RID OF THIS TASK THEN EXIT VIA 131
 150         REC5=STSCAN+I/4                 @ COMPUTE THE NUMBER OF THE NEXT RECORD WHERE TO READ INTE85 (4 DATA SETS PER RECORD)
 151         IF (MUSTRD(I)) READ (5'REC5) INTE85
 152         ORD=INTE(1,BAND,MOD(I,4)+1)     @ THE INTENSITY OF THIS BAND --> ORD
 153         PENPOS=NCOND(ORD.GT.ORDMAX.AND.L1,PENUP,PENPOS) @ WE DON'T PLOT POINTS .GT. ORDMAX
 154         L1=ORD.GT.ORDMAX
 155         ORD=AMIN1(ORD,ORDMAX)
 156 C                                       @ THE TIME AXIS STARTS AT BEGIN+SPAN/2. SO WE
 157         ABZ=DATTIM(I)                   @  INSERT THE TIME SCALE [SECONDS] --> ABZ
 158         IF (ABZ.LT.BEGIN) GOTO 130      @  SKIP ALL THE POINTS BEFORE THE BEGIN  TIME
 159         IF (ABZ.GT.ENDS) GOTO 131       @ IF WE PASSED THE END OF THE PLOT THEN WE TERMINATE THE LOOP
 160
 161         ABZ=ABZ-BEGIN                   @  ELSE WE PLOT THIS DATA POINT ( THE FIRST ONE WITH PEN UP) RELATIVE TO THE BEGIN OF THE PLOT
 162         CALL XYPLOT (ABZ,ORD,PENPOS)
 163         PENPOS=PENDWN                   @ 'PEN DOWN' FROM NOW ON
 164
 165 130     CONTINUE                        @ LOOP TO FETCH THE NEXT DATA POINT
 166 131     CONTINUE                        @  ALL THE WORK DONE FOR THE ACTUAL BAND
 167 C
 168 C       PLOT THE INTENSITY SCALE
 169 C
 170         IF (BREAK(11)) GOTO 140         @ IF THE USER GET'S RID OF PLOT THEN WE EXIT
 171         CALL WHERE (TE1,TE1,TE1,TE1)    @ GET THE ACTUAL Y FACTOR
 172         CALL FACTOR (1.,TE1)            @ AND SWITCH X FACTOR TO 1.
 173         CALL XYPLOT (-.5,0,-PENUP)      @ LOWER LEFT CORNER
 174         PENPOS=PENUP
 175         DO 132 I=0,10
 176         TE1=ORDMAX/INTFAC*I/10.
 177         IF (TE1.GT.ORDMAX+ORDMAX/500.) GOTO 133 @ AXIS IS COMPLETE
 178         CALL XYPLOT (0,TE1,PENPOS)
 179         IF (.NOT.(I.EQ.INT(10.*INTFAC+.5) .OR.
 180      *   I.EQ.0)) GOTO 110
 181 C       MARK THE START AND THE END OF THE SCALE
 182         CALL WHERE (TE2,TE2,TE2,TE3)    @ GET THE X AND Y FACTOR
 183         CALL FACTOR (1.,1.)
 184         CALL NUMBER (-.7-YN*INT(I/10),TE3*TE1-YN*.3,YN,I,0,-1)
 185         CALL FACTOR (TE2,TE3)
 186         CALL XYPLOT (0,TE1,PENUP)
 187 110     PENPOS=PENDWN
 188         TE2=COND(INTFAC.EQ.1. .AND. I.EQ.5,-0.5,-0.3)   @ A SMALL BAR TO THE LEFT
 189         CALL XYPLOT (TE2,TE1,PENDWN)
 190 132     CALL XYPLOT (0,TE1,PENDWN)
 191 133     CALL XYPLOT (.5,0,-PENUP)       @ RESET CORRECT LOWER LEFT CORNER
 192 C
 193         CALL FACTOR (1.,1.)             @ RESET ORIGIN TO XOFSET,YOFSET
 194         CALL SYMBOL (-XOFSET,YLEN*.1,YN,'P',0,1)
 195         IF (GENAM(BAND).NE.2H  )
 196      *   CALL GREEK(-XOFSET+YN*.3,YLEN*0.1-.3,YN*0.75,GENAM(BAND),0)
 197 C
 198 C       PLOT THE FREQUENCY RANGE OF THIS BAND
 199 C
 200         CALL NUMBER (XLEN+YN*.6,0,YN*.5,FREQU(BAND,1),90.,1)
 201         CALL SYMBOL (999.,999.,YN*.5,'-',90.,1)
 202         CALL NUMBER (999.,999.,YN*.5,FREQU(BAND,2),90.,1)
 203 C
 204         CALL XYPLOT (0.,-TEMSET,-PENUP)
 205 120     CONTINUE
 206 \fC
 207         CALL PLALRL                     @ AND NOW WE PLOT THE TIME AXIS
 208         RETURN
 209 C
 210 140     CONTINUE                        @ USER ABORTS THE PLOT
 211         CALL FACTOR (1.)
 212         CALL XYPLOT (38.,25.,PENUP)     @ DRIVE PEN INTO THE UPPER RIGHT CORNER
 213         CALL EXPLT
 214         RETURN
 215 C
 216 20      CONTINUE                        @ FILE 5 IS EMPTY
 217         COMPUT=0
 218         SAMCNT=0
 219         WRITE (TTO,1)                   @ NO DATA TO PLOT
 220         RETURN
 221 C
 222 1       FORMAT (' KEINE DATEN IN DER DATEI 5')
 223 2       FORMAT (' DER PLOT SOLL VON',I5,' BIS',I5,' SEK. DAMIT UEBER ',
 224      *  'DAS DATENENDE',I5,' SEK. HINAUSGEHEN.')
 225 3       FORMAT (1X,14A6)
 226         END
 227 \1a