--- /dev/null
+C -+-+-+-+-+ \ e H A E P A L . F T \ e -+-+-+-+-+\r
+C\r
+C HERE WE PLOT THE ABSOLUT INTENSITIES OF THE 5 FREQUENCY BANDS\r
+C FROM THE POWER SPECTRA STORED ON SCRATCH UNIT 5.\r
+C\r
+ SUBROUTINE PALOT\r
+ INCLUDE HAEBUF.FI\r
+ INCLUDE HAEGSA.FI\r
+ INCLUDE HAEPTI.FI\r
+ INCLUDE HABRK.FI\r
+ INCLUDE HAEI85.FI\r
+ INCLUDE HAECSZ.FI\r
+ INCLUDE HAETTY.FI\r
+ INCLUDE HAPPEN.FI\r
+C\r
+\fC\r
+ LOGICAL MLTPLE\r
+ REAL COND\r
+ INTEGER NCOND\r
+ EXTERNAL MLTPLE,COND,NCOND\r
+C\r
+ REAL ORD,ABZ,TEMSET,\r
+ * ABMAX(2,5), @ ABSOLUT/ RELATIVE MAXIMUM OF THE BAND INTENSITY DATA\r
+ * TE1,TE2,TE3, @ TEMPORARY STORAGE\r
+ * INTFAC,ORDMAX @ FACTOR TO SCALE THE INTENSITY OF EACH BAND, MAXIMUM OF THE ORDINATE\r
+ INTEGER I,BAND,N,\r
+ * RELABS, @ ABS INTENSITY =1, REL INTENSITY =2\r
+ * PNT, @ MOD(I,4)+1 TEMP STORAGE\r
+ * SKIPIT @ STARTING LOCATION OF THE DATA SET WANTED\r
+ LOGICAL F1, @ SAMPLE BUFFER IS EMPTY FLAG\r
+ * L1, @ TEMPORARY STORAGE\r
+ * ABISMI @ TIME AXIS SCALING IS IF ABISMI THEN MINUTES ELSE SECONDS FI\r
+ INTEGER PENPOS @ TEMPORARY PEN STATUS\r
+C\r
+C STATEMENT FUNCTIONS ARE:\r
+C\r
+ INTEGER DATTIM @ STARTING TIME OF THIS POWER SPECTRUM DATA RECORD WITHIN THE SAMPLE\r
+ DATTIM(IP1)=INTE(3,1,MOD(IP1,4)+1)\r
+ LOGICAL MUSTRD @ MUSTRD DECIDES IF WE HAVE TO READ THE NEXT INTE RECORD\r
+ MUSTRD(IP1)=MOD(IP1,4).EQ.0\r
+C\r
+C OPEN THE INPUT DATA FILE UNIT 5\r
+C READ THE FIRST BLOCK OF THE FILE HEADER AND\r
+C THE DATA HEADER I.E. COMMON CEGSA THE SECOND BLOCK OF UNIT 5\r
+C\r
+ IF (REC5.LT.1) DEFINE FILE5(MAXBL5,85,U,REC5)\r
+ REC5=1\r
+ F1=SAMCNT.EQ.0 .OR. .NOT. COMP @ HEADER OF FILE 5 DOES NOT MATCH THE HEADER OF THE ACTUAL SAMPLE BUFFER\r
+ READ (5'REC5) (RCRD0(I),I=1,85) @ READ THE FILE HEADER\r
+ IF (F1) SAMCNT=0 @ CLEAR THE ACTUAL SAMPLE BUFFER\r
+ IF (F1) COMP=.FALSE. @ AND THE COMPUTATIONS FLAG TOO\r
+ IF (REDVAL.NE.6H2DPWLD) GOTO 20 @ RECORD IS EMPTY\r
+ REDVAL=0 @ FOR SAVETY ONLY\r
+ WRITE (TTO,3) (LABEL(I),I=1,LABCNT) @ TYPE OUT THE LABEL OF THIS DATA SET\r
+ READ (5'REC5) LCEGSA(1),(LCEGSA(I),I=2,LCEGSA(1)) @ READ THE DATA HEADER BLOCK ( COMMON CEGESA)\r
+ SETNUM=SETNU5 @ INSERT THE NUMBER OF THE ACTUAL DATA SET\r
+ CHANEL=CHANE5 @ AND THE NUMBER OF THE CHANNEL INVESTIGATED TOO\r
+C\r
+\fC HERE WE PLOT THE INTENSITY / TIME\r
+C\r
+ BEGIN=NCOND(PZBEG,PZBEG,BEGIN)\r
+ ENDS=NCOND(PZEND,PZEND,BEGFFT+SPAN)\r
+ IF (OPTION.NE.12) CALL ASKHIM(2) @ ASK FOR BEGIN AND ENDS\r
+ PZBEG=BEGIN\r
+ PZEND=ENDS\r
+C\r
+C COMPUTE THE MAXIMA OF THE ORDINATE (INTENSITIES)\r
+C\r
+ DO 33 BAND=1,5\r
+33 ABMAX(1,BAND)=0\r
+ N=0\r
+C READ THE STARTING TIME OF THE INTENSITY DATA COMPUTED AND \r
+C THEN WE COMPUTE THE RECORD NUMBER OF THE INTENSITY DATA WE WANT TO PLOT\r
+ REC5=STSCAN @ READ THE FIRST INTENSITY DATA RECORD\r
+ READ (5'REC5) INTE85\r
+ SKIPIT=(BEGIN-INTE(3,1,1))/OVRLAP @ THE NUMBER OF DATA POINT TO SKIP --> SKIPIT\r
+ IF (SKIPIT.LT.DATCNT) GOTO 25 @ IF THE PLOT EXCEEDS THE DATA COMPUTED\r
+ REC5=STSCAN+(DATCNT-1)/4 @ THEN WE PRINT AN ERROR MSG ELSE WE CONTINUE AT 25\r
+ READ (5'REC5) INTE85 @ READ THE LAST RECORD OF THE UNIT 5\r
+ WRITE (TTO,2) PZBEG,PZEND,INTE(3,1,MOD(DATCNT-1,4)) @ AND TYPE THE ERROR MSG\r
+C\r
+25 CONTINUE\r
+ REC5=STSCAN+SKIPIT/4 @ READ THE FIRST RECORD WANTED\r
+ READ (5'REC5) INTE85 @ \r
+C\r
+C COMPUTE THE MAXIMUM OF EACH BAND\r
+C\r
+ DO 35 I=0,DATCNT-1 @ LOOP FOR EACH POWER SPECTRUM\r
+ IF (BREAK(11)) RETURN\r
+ REC5=STSCAN+I/4\r
+ IF (MUSTRD(I)) READ (5'REC5) INTE85\r
+ IF (DATTIM(I).LT.BEGIN) GOTO 35 @ GO AND FETCH THE NEXT DATA WORDS\r
+ IF (DATTIM(I).GT.ENDS) GOTO 34 @ WE MAY LEAVE THIS LOOP - WORK IS DONE\r
+ N=N+1\r
+ PNT=MOD(I,4)+1 @ TEMP STORAGE\r
+ DO 30 BAND=1,5 @ LOOP FOR EACH BAND\r
+30 ABMAX(1,BAND)=ABMAX(1,BAND)+INTE(1,BAND,PNT)\r
+35 CONTINUE\r
+34 CONTINUE\r
+ DO 36 BAND=1,5\r
+36 ABMAX(1,BAND)=ABMAX(1,BAND)/N*2.\r
+C\r
+C CHECK THE MAXIMUM\r
+C\r
+ DO 40 BAND=1,5\r
+43 TE1=0 @ COUNTS ALL POINTS PLOTTED\r
+ TE2=0 @ COUNTS ALL POINTS .GT. MAXIMUM OF PLOT\r
+ DO 45 I=0,DATCNT-1 @ WE SCAN ALL DATA ENTRIES\r
+ IF (BREAK(11)) RETURN\r
+ REC5=STSCAN+I/4\r
+ IF (MUSTRD(I)) READ (5'REC5) INTE85\r
+ IF (DATTIM(I).LT.BEGIN) GOTO 45 @ FETCH THE NEXT DATA WORDS\r
+ IF (DATTIM(I).GT.ENDS) GOTO 44 @ THE WORK IS DONE, SO WE LEAVE THE LOOP\r
+ TE1=TE1+1. @ COUNTS ALL POINTS HERE\r
+ IF (INTE(1,BAND,MOD(I,4)+1).GT.ABMAX(1,BAND)) TE2=TE2+1. @ COUNT ALL POINTS .GT. MAXIMUM\r
+45 CONTINUE\r
+44 CONTINUE\r
+CX WRITE (4,49) TE1,TE2,ABMAX(1,BAND) @ PRINT SOME DIAGNOSTIC MSG\r
+CX49 FORMAT (' TE1:',1P,E8.1,' TE2:',E8.1,' ABMAX:',E8.1)\r
+ IF (TE2/TE1.LT.0.02) GOTO 40 @ IF 98% OF ALL POINTS ARE PLOTTED THEN WE PROCEED TO THE NEXT BAND\r
+ ABMAX(1,BAND)=ABMAX(1,BAND)*SQRT(2.)\r
+ GOTO 43 @ CHECK AGAIN\r
+40 CONTINUE\r
+\fC\r
+C OPEN THE PLOTTER\r
+C\r
+ CALL STPLT @ START THE PLOTTER ( CALL PLOTS)\r
+ CALL XYPLOT (XOFSET,YOFSET,-PENUP)\r
+C\r
+C THE LOOP FOR EACH BAND AND THE TOTAL INTENSITY\r
+C\r
+ DO 120 BAND=1,5\r
+ IF BREAK(11) GOTO 140\r
+ TEMSET=(YLEN+YSTEP)/5.*FLOAT(5-BAND)\r
+ CALL XYPLOT (0,TEMSET,-PENUP) @ SET THE NEW ORIGIN FOR THIS STAMP HERE\r
+ RELABS=1 @ WE PLOT THE ABSOLUT INTENSITIES\r
+ TE1=ABMAX(RELABS,1)\r
+ INTFAC=COND(ABMAX(RELABS,BAND).GT.TE1/2.,1.,\r
+ * ABMAX(RELABS,BAND).GT.TE1/5., 0.5,\r
+ * ABMAX(RELABS,BAND).GT.TE1/10.,0.2 ,0.1) @ NORM TO NEW MAXIMUM \r
+ ORDMAX=ABMAX(RELABS,1)*INTFAC @ COMPUTE MAXIMUM OF ORDINATE\r
+ CALL FACTOR (XLEN/(ENDS-BEGIN),(YLEN-4.*YSTEP)/5./ORDMAX)\r
+C\r
+C THE LOOP FOR EACH POWER SPECTRUM\r
+C\r
+ PENPOS=PENUP\r
+ L1=.FALSE.\r
+ DO 130 I=0,DATCNT-1\r
+ IF BREAK(11) GOTO 131 @ IF THE USER GETS RID OF THIS TASK THEN EXIT VIA 131\r
+ REC5=STSCAN+I/4 @ COMPUTE THE NUMBER OF THE NEXT RECORD WHERE TO READ INTE85 (4 DATA SETS PER RECORD)\r
+ IF (MUSTRD(I)) READ (5'REC5) INTE85\r
+ ORD=INTE(1,BAND,MOD(I,4)+1) @ THE INTENSITY OF THIS BAND --> ORD\r
+ PENPOS=NCOND(ORD.GT.ORDMAX.AND.L1,PENUP,PENPOS) @ WE DON'T PLOT POINTS .GT. ORDMAX\r
+ L1=ORD.GT.ORDMAX\r
+ ORD=AMIN1(ORD,ORDMAX)\r
+C @ THE TIME AXIS STARTS AT BEGIN+SPAN/2. SO WE\r
+ ABZ=DATTIM(I) @ INSERT THE TIME SCALE [SECONDS] --> ABZ\r
+ IF (ABZ.LT.BEGIN) GOTO 130 @ SKIP ALL THE POINTS BEFORE THE BEGIN TIME\r
+ IF (ABZ.GT.ENDS) GOTO 131 @ IF WE PASSED THE END OF THE PLOT THEN WE TERMINATE THE LOOP\r
+\r
+ ABZ=ABZ-BEGIN @ ELSE WE PLOT THIS DATA POINT ( THE FIRST ONE WITH PEN UP) RELATIVE TO THE BEGIN OF THE PLOT\r
+ CALL XYPLOT (ABZ,ORD,PENPOS)\r
+ PENPOS=PENDWN @ 'PEN DOWN' FROM NOW ON\r
+\r
+130 CONTINUE @ LOOP TO FETCH THE NEXT DATA POINT\r
+131 CONTINUE @ ALL THE WORK DONE FOR THE ACTUAL BAND\r
+C\r
+C PLOT THE INTENSITY SCALE\r
+C\r
+ IF (BREAK(11)) GOTO 140 @ IF THE USER GET'S RID OF PLOT THEN WE EXIT\r
+ CALL WHERE (TE1,TE1,TE1,TE1) @ GET THE ACTUAL Y FACTOR\r
+ CALL FACTOR (1.,TE1) @ AND SWITCH X FACTOR TO 1.\r
+ CALL XYPLOT (-.5,0,-PENUP) @ LOWER LEFT CORNER\r
+ PENPOS=PENUP\r
+ DO 132 I=0,10\r
+ TE1=ORDMAX/INTFAC*I/10.\r
+ IF (TE1.GT.ORDMAX+ORDMAX/500.) GOTO 133 @ AXIS IS COMPLETE\r
+ CALL XYPLOT (0,TE1,PENPOS)\r
+ IF (.NOT.(I.EQ.INT(10.*INTFAC+.5) .OR.\r
+ * I.EQ.0)) GOTO 110\r
+C MARK THE START AND THE END OF THE SCALE\r
+ CALL WHERE (TE2,TE2,TE2,TE3) @ GET THE X AND Y FACTOR\r
+ CALL FACTOR (1.,1.)\r
+ CALL NUMBER (-.7-YN*INT(I/10),TE3*TE1-YN*.3,YN,I,0,-1)\r
+ CALL FACTOR (TE2,TE3)\r
+ CALL XYPLOT (0,TE1,PENUP)\r
+110 PENPOS=PENDWN\r
+ TE2=COND(INTFAC.EQ.1. .AND. I.EQ.5,-0.5,-0.3) @ A SMALL BAR TO THE LEFT\r
+ CALL XYPLOT (TE2,TE1,PENDWN)\r
+132 CALL XYPLOT (0,TE1,PENDWN)\r
+133 CALL XYPLOT (.5,0,-PENUP) @ RESET CORRECT LOWER LEFT CORNER\r
+C\r
+ CALL FACTOR (1.,1.) @ RESET ORIGIN TO XOFSET,YOFSET\r
+ CALL SYMBOL (-XOFSET,YLEN*.1,YN,'P',0,1)\r
+ IF (GENAM(BAND).NE.2H )\r
+ * CALL GREEK(-XOFSET+YN*.3,YLEN*0.1-.3,YN*0.75,GENAM(BAND),0)\r
+C\r
+C PLOT THE FREQUENCY RANGE OF THIS BAND\r
+C\r
+ CALL NUMBER (XLEN+YN*.6,0,YN*.5,FREQU(BAND,1),90.,1)\r
+ CALL SYMBOL (999.,999.,YN*.5,'-',90.,1)\r
+ CALL NUMBER (999.,999.,YN*.5,FREQU(BAND,2),90.,1)\r
+C\r
+ CALL XYPLOT (0.,-TEMSET,-PENUP)\r
+120 CONTINUE\r
+\fC\r
+ CALL PLALRL @ AND NOW WE PLOT THE TIME AXIS\r
+ RETURN\r
+C\r
+140 CONTINUE @ USER ABORTS THE PLOT\r
+ CALL FACTOR (1.)\r
+ CALL XYPLOT (38.,25.,PENUP) @ DRIVE PEN INTO THE UPPER RIGHT CORNER\r
+ CALL EXPLT\r
+ RETURN\r
+C\r
+20 CONTINUE @ FILE 5 IS EMPTY\r
+ COMPUT=0\r
+ SAMCNT=0\r
+ WRITE (TTO,1) @ NO DATA TO PLOT\r
+ RETURN\r
+C\r
+1 FORMAT (' KEINE DATEN IN DER DATEI 5')\r
+2 FORMAT (' DER PLOT SOLL VON',I5,' BIS',I5,' SEK. DAMIT UEBER ',\r
+ * 'DAS DATENENDE',I5,' SEK. HINAUSGEHEN.')\r
+3 FORMAT (1X,14A6)\r
+ END\r
+\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
\ No newline at end of file
projects / pdp8.git / blobdiff