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