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