C -+-+-+-+-+  H A E P F L . F T  -+-+-+-+-+ C C HERE WE PLOT THE SUMMED POWER SPECTRUM (INTENSITY) TO THE FREQUENCY C OF THE FFT DATA STORED ON UNIT 5 C C * UP 26-JAN-83 C SUBROUTINE PFLOT INCLUDE HAEBUF.FI INCLUDE HAEGSA.FI INCLUDE HAEPTI.FI INCLUDE HABRK.FI INCLUDE HAEI85.FI INCLUDE HAECSZ.FI INCLUDE HAPPEN.FI INCLUDE HAETTY.FI C C REAL COND INTEGER NCOND EXTERNAL COND,NCOND C REAL FFTX(85), @ PART OF THE FFT BUFFER * ORD,ABZ, * TE1,TE2,TE3, @ TEMPORARY STORAGE * INTFAC,ORDMAX, @ FACTOR TO SCALE THE INTENSITY OF EACH BAND, MAXIMUM OF THE ORDINATE * SUMM, @ SUMM OF ALL INTENSITIES * TEMSET @ TEMP Y OFFSET FOR OPTION '1' PLOTTS (OVERPLOT) INTEGER I,J,K,INCR2,PNT,BAND, * RELABS @ ABS INTENSITY =1, REL INTENSITY =2 LOGICAL F1, @ SAMPLE BUFFER IS EMPTY FLAG * L1 @ TEMPORARY STORAGE INTEGER PENPOS @ TEMPORARY PEN STATUS C C C C OPEN THE INPUT DATA FILE UNIT 5 C READ THE FILE HEADER FIRST BLOCK AND C THE DATA HEADER, THE SECOND BLOCK OF UNIT 5 C INSERT THE COMMON CEGESA FROM THE DATA FILE C IF (REC5.LT.1) DEFINE FILE5(MAXBL5,85,U,REC5) REC5=1 F1=SAMCNT.EQ.0 .OR. .NOT. COMP @ HEADER OF FILE 5 DOES NOT MATCH THE HEADER OF THE ACTUAL SAMPLE BUFFER READ (5'REC5) (RCRD0(I),I=1,85) @ READ THE FILE HEADER IF (F1) SAMCNT=0 @ CLEAR THE ACTUAL SAMPLE BUFFER IF (F1) COMP=.FALSE. @ AND THE COMPUTATIONS FLAG TOO IF (REDVAL.NE.6H2DPWLD) GOTO 20 @ RECORD IS EMPTY REDVAL=0 @ FOR SAVETY ONLY READ (5'REC5) LCEGSA(1),(LCEGSA(I),I=2,LCEGSA(1)) @ READ THE DATA HEADER BLOCK ( COMMON CEGESA) SETNUM=SETNU5 CHANEL=CHANE5 C HERE WE PLOT THE LAST POWER SPECTRUM STORED ON UNIT 5 REC 3 TO STSCAN C INCR2=INCR/2 @ NUMBER OF DATA POINTS IN POWER SPECTRUM PLTEND=NCOND(PLTEND,PLTEND,SAMRAT/2) @ DEFAULT END OF FREQUENCY SCALE C C READ THE FREQUENCY AND INTENSITY RANGE OF THE PLOT IF (OPTION.EQ.12) GOTO 34 @ PF* TAKES THE DEFAULT VALUES AND DOESNT ASK QUESTIONS 32 WRITE (TTO,4) PLTEND,PLTBEG READ (TTI,6) I,J @ ASK FOR THE FREQUENCY WINDOW TO PLOT IF BREAK(11) RETURN @ USER ABORTS PROGRAM PLTEND=NCOND(I,I,PLTEND) @ NO INPUT LOADS DEFAULT VALUES PLTBEG=NCOND(J,J,PLTBEG) 34 IF (PLTEND-PLTBEG .LE.0) GOTO 32 @ UPPER AND LOWER LIMITS MIXED, USER HAS TO RETYPE C C C COMPUTE THE WHOLE SUMM OF ALL INTENSITIES C XMAXI=0 @ THIS HOLDS THE SUMM DO 40 I=1,INCR/2 J=MOD(I-1,85) IF (J.EQ.0) READ (5'REC5) FFTX 40 XMAXI=FFTX(J+1)+XMAXI C IF (OPTION.EQ.12) GOTO 30 @ PF* TAKES THE DEFAULT VALUES AND DOESNT ASK QUESTIONS 33 WRITE (TTO,5) XMAXI @ ASK FOR THE SIZE OF INTENSITY SCALE READ (TTI,7) TE1 IF BREAK(11) RETURN @ USER SWITCHED OFF THE TASK TE1=COND(TE1.LT.100.,TE1*XMAXI*.01,TE1) XMAXI=COND(TE1,TE1,XMAXI) @ NO INPUT MEANS THE ACTUAL MAXIMUM IF (XMAXI.LE.0) GOTO 33 @ NEGATIVE POWER SPECRUM INTENSITY IS NOT VALID 30 CONTINUE C CXCX XMAXI=ALOG(XMAXI) @ CXCX DISABLES LOG INTENSITY VERSION OF HAEPLO CALL STPLT @ OPEN THE PLOTTER ( CALL PLOTS) NUMCN=NCOND(OPTION.NE.1,1,2) CALL XYPLOT (XOFSET,YOFSET,-PENUP) TEMSET=(NUMCN-(CHANEL+1))* * YLEN/FLOAT(NUMCN)+(NUMCN-(CHANEL+1))*.5 @ SEE HAESPL FOR DETAILS! IF (OPTION.EQ.1) CALL XYPLOT(0,TEMSET,-PENUP) @ SET NEW OFFSET FOR OVERPLOT OPTION IF (OPTION.NE.1) CALL FACTOR (XLEN/(SPAN*(PLTEND-PLTBEG)), * YLEN/XMAXI) @ FACTOR FOR NORMAL PLOT (ONE PER PAGE) IF (OPTION.EQ.1) CALL FACTOR (XLEN/(SPAN*(PLTEND-PLTBEG)), * ((YLEN-NUMCN*.5+COND(NUMCN-1,.5))/FLOAT(NUMCN)/XMAXI)) @ SIZE OF DIAGRAM C L1=.FALSE. REC5=3 SUMM=0 PENPOS=PENUP DO 10 I=PLTBEG*SPAN,PLTEND*SPAN,1 IF (BREAK(11)) GOTO 11 @ USER GETS RID OF PROGRAM, RESET TEMSET OFFSET AND THEN WE ABORT J=MOD(I,85) IF (J.EQ.0) READ (5'REC5) FFTX ABZ=I SUMM=FFTX(J+1)+SUMM ORD=SUMM CXCX ORD=AMIN1(ALOG(AMAX1(.1,FFTX(J+1))),XMAXI) L1=ORD.GT.XMAXI .AND. L1 @ TRUNCATE SUCH POINTS WHICH ARE TOO LARGE FOR THIS INTENSITY SCALE PENPOS=NCOND(L1,PENUP,PENPOS) L1=ORD.GT.XMAXI ORD=AMIN1(ORD,XMAXI) @ PLOT TO THE BOUNDER OF THIS DIAGRAM CALL XYPLOT (ABZ,ORD,PENPOS) PENPOS=PENDWN 10 CONTINUE 11 CONTINUE @ WORK DONE, RESET ORIGIN CALL FACTOR (1.) IF (OPTION.EQ.1) CALL XYPLOT (0,-TEMSET,-PENUP) @ RESET OVERPLOTT OFFSET C C MAKE A SCALE C C FREQUENCY SCALE FROM PLTBEG TO PLTEND HERTZ C IF (BREAK(11)) GOTO 15 IF (OPTION.EQ.1) GOTO 15 @ OVERPLOT OPTION - NO SCALE CALL FACTOR (XLEN/(PLTEND-PLTBEG),1.) CALL XYPLOT (0,-.5,-PENUP) DO 12 I=PLTBEG,PLTEND @ 1 HERTZ STEP SIZE TE1=FLOAT(I-PLTBEG) CALL XYPLOT (TE1,0,PENDWN) J=MOD(I,NCOND(PLTEND.GT.30,10, PLTEND.GT.15,5, * PLTEND.GT.6,2,1)) TE2=COND(J.EQ.0,-.7, J.EQ.5,-.5, -.3) CALL XYPLOT (TE1,TE2,PENDWN) IF (J.NE.0) GOTO 12 CALL WHERE (TE2,TE2,TE2,TE3) @ GET THE X FACTOR CALL FACTOR (1.) CALL NUMBER (TE1*TE2-INT(ALOG10(AMAX1(1.,TE1)) * +.01)*YN/2.-YN*.3, * -1.3,YN,TE1,0,-1) CALL FACTOR (TE2,TE3) CALL XYPLOT (TE1,0,PENUP) 12 CALL XYPLOT (TE1,0,PENDWN) CALL XYPLOT (0,.5,-PENUP) CALL FACTOR (1.) IF (.NOT. BREAK(9)) * CALL SYMBOL (XLEN/2.,-YOFSET,YZ, * 'FREQUENCY [HZ]',0,14) C C INTENSITY SCALE LINEAR FROM 0 TO XMAXI C IF BREAK(11) GOTO 15 CALL FACTOR (1.,YLEN/XMAXI) CALL XYPLOT (-.5,0,-PENUP) TE2=XMAXI/10. DO 14 I=0,10 TE1=TE2*I CALL XYPLOT (0,TE1,PENDWN) J=MOD(I,10) TE3=COND(J.EQ.0,-.7, J.EQ.5,-.5, -.3) CALL XYPLOT (TE3,TE1,PENDWN) 14 CALL XYPLOT (0,TE1,PENDWN) C INSERT THE INTENSITY SCALE MAXIMUM CALL WHERE (TE2,TE2,TE2,TE3) CALL FACTOR (1.) CALL ENUMBR (-1.1,TE1*TE3-4.*YN,YN,XMAXI,90.,1) CALL FACTOR (TE2,TE3) CALL XYPLOT (.5,0,-PENUP) CALL FACTOR (1.) IF (.NOT. BREAK(9)) * CALL SYMBOL (-XOFSET,0,YZ, * ' INTENSITY SUMM [ARB. UNITS]',90.,30) C C 15 CONTINUE @ ENTRY HERE IF USER SWITCHED OFF PLOTTING CALL FACTOR (1.) IF (OPTION.EQ.1) GOTO 50 @ '1' OPTION, NO COMMENT AT ALL! CALL SYMBOL (YZ,YLEN+YZ,YZ,LABEL,0,MIN0(42,LABCNT*6)) IF (LABCNT.GT.7) * CALL SYMBOL (3.*YZ,YLENYZ,YZ,LABEL(8),0,LABCNT*6-42) C IF (.NOT. BREAK(9)) * CALL LABPLT (0.,-YOFSET,BEGIN+SPAN) @ INSERT CHANNEL AND TIME 50 CONTINUE @ WE COME HERE IF '1' OPTION ON CALL XYPLOT(38.,25.,PENUP) CALL EXPLT @ CLOSE THE PLOTTER RETURN C C 20 CONTINUE @ FILE 5 IS EMPTY COMPUT=0 SAMCNT=0 WRITE (TTO,1) @ NO DATA TO PLOT RETURN C C 1 FORMAT (' KEINE DATEN IN DER DATEI 5') 2 FORMAT (' SUMME DER LEISTUNGSSPEKTREN UEBER ',F4.1,' -->', * F5.1,' GEZEICHNET.') 4 FORMAT (' FREQUENZSKALA ENDE, ANFANG? (',I2,1H,,I2, * ') ? ',$) 5 FORMAT (' ORDINATEN MAXIMUM? (',1P,E8.1,') ? ',$) 6 FORMAT (I2,1X,I2) 7 FORMAT (E8.1) END