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