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

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