C FREQP		MH-ICD,MN.		07/31/75.
C
C PRINT OUT "FREQ" DATA TO EITHER SYS:SCR.DA OR LPT:.
C
C
C AT PAUSE AC=77, ENTER FIRST BLOCK OF SOUND DATA TO READ IN
C THE RIGHT SWITCHES.
C
C SWITCHES SW0, SW4, SW5 SET AT PAUSE AC=0007 AND SHOULD
C REMAIN SET TILL END OF RUN.
C
C SW0	ON	FULL FREQ DATA PRINTOUT.
C	OFF	BLOCK OF 64 AVERAGES PRINTED.
C		UNLESS SW5 ON.
C
C SW4	ON	PRINTOUT TO LINE PRINTER.
C	OFF	PRINTOUT SENT TO FILE SYS:SCR.DA
C
C SW5	ON	SKIP BLOCK AVERAGES.
C	OFF	PRINT BLOCK AVERAGES.
C
C
C .FORT
C *FREQP/L/O$
C
C
C = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
C
C
	COMMON IBUF
	DIMENSION IBUF(256,8)
	DIMENSION G(1)
	DIMENSION IG(3)
	EQUIVALENCE (G,IG)
C
C TINT = TIME INTERVAL OF SOUND SEGMENTS
C FHI  = HIGH FREQUENCY CUTOFF FOR AVERAGING.
C FLO  = LOW FREQUENCY CUTOFF FOR AVERAGING.
C
	TINT=.05
	FHI=450.
	FLO=70.
C
	PAUSE 63
	IBFI=IRDSW(0)
	TIMI=TINT*64.
	KHI=FHI*2.*TINT
	KLO=FLO*2.*TINT
	V80DB=0.
	IDV=3
	MO=0
	PAUSE 7
	IF(ISENS(4))525,524,525
524	CALL OOPEN('SYS','SCR')
	IDV=4
	MO=1
525	IB=IRDSW(0)-1
	IF(ISENS(5))509,520,509
C
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C
520	WRITE(IDV,101)
	WRITE(1,101)
	T=0.
	DO 531 I=IBFI,IB
	CALL RLINC(1,I,1,IBUF,256)
	T=T+3.2
	NTM=T/60.
	NTS=T-FLOAT(NTM)*60.
	FB=0.
	VXDB=0.
	FIC=0.
	IC=0
	JFIC=0
	JFB=0
	DB=0.
	DO 503 J=1,256,4
	IT=IBUF(J)
	IF(IT-KLO)503,503,500
500	IF(KHI-IT)503,503,507
C
507	IS=IBUF(J+1)
	IF(IS-150)503,503,532
532	AT=IS
	IG(1)=1240
	IG(2)=IBUF(J+2)
	IG(3)=IBUF(J+3)
	G=G/AT
	IF(G)503,503,502
502	IC=IC+1
	FB=FB+FLOAT(IT)
	VXDB=VXDB+G
	FIC=FIC+AT
503	CONTINUE
C
	IF(IC)505,505,504
504	AT=IC
	JFB=FB/AT/2./.05
	VXDB=VXDB/AT/1024.
	JFIC=FIC/AT
	IF(V80DB)526,526,527
526	DB=0.
	T=0.
S	TAD (1 ; JMS OUTPUT
	READ(1,104) V80DB
	GOTO 505
527	DB=80.+20.*.4343*ALOG(VXDB/V80DB)
S\505,	TAD \IDV ; JMS OUTPUT
531	CONTINUE
C
C - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
C
	IF(ISENS(0))509,508,509
509	LN=8
	DO 514 I=IBFI,IB,8
	IF(I+LN-IB)511,511,510
510	LN=IB-I+1
511	CALL RLINC(1,I,LN,IBUF,256)
	WRITE(IDV,103) I
	DO 513 J=1,256,4
S	CALL 2,WRITE ; ARG \IDV ; ARG \102
	DO 512 II=1,LN
	NS=IBUF(J+1,II)
	IF(NS)522,522,521
521	NF=FLOAT(IBUF(J,II))/2./.05
	IG(1)=1240
	IG(2)=IBUF(J+2,II)
	IG(3)=IBUF(J+3,II)
	G=G/FLOAT(NS)/1024.
	GOTO 523
522	NF=0
	G=0.
523	CONTINUE
S	CALL 1,IOH ; ARG \NF
S	CALL 1,IOH ; ARG \NS
S	CALL 1,IOH ; ARG \G
512	CONTINUE
S	CALL 1,IOH ; ARG 0
513	CONTINUE
514	CONTINUE
C
508	CONTINUE
	IF(MO)533,534,533
533	CALL OCLOSE
534	STOP
C
C = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
C
SOUTPUT, 0
S	DCA \IT
	WRITE(IT,100) I,NTM,NTS,JFB,VXDB,DB,JFIC,IC
S	JMP I OUTPUT
C
C = = = = = = = = = = = = = = = = = = = = = = = = = = = = =
C
100	FORMAT(2I4'.'I2,I6,F6.3,F6.1,I5,I5)
101	FORMAT('1  #   TIME FREQB VOLTS  DB   SAMPL COUNT')
102	FORMAT(2X,8(I5,I4,F6.3))
103	FORMAT('1:'I3' F  #S   VOLT',7('   F  #S  VOLT '))
104	FORMAT('V 80 DB? 'F5.3)
	END