语音压缩

开发平台：
Unix_Linux

cli.f：源码内容
							C==========================================================================
C
C ROUTINE
C               cli (Will not work with DOS)
C
C FUNCTION
C               UNIX Command line interface.
C		Read and check the UNIX command line.
C		Report and log job characteristics and performance.
C 
C SYNOPSIS
C	subroutine cli (ifile, ofile, l, ll, lp, np, scale, descale, 
C    +                 ber, mask, stype, eccbits, sbits)
C
C   formal 
C
C			data	I/O
C	name		type	type	function
C       -------------------------------------------------------------------
C	ifile		char	o	input file name
C	ofile		char	o	output file name
C	l		i	i/o	Code word length
C	ll		i	i/o	LPC analysis frame size
C	lp		i	i/o	Pitch analysis frame size
C	np		i	i/o	Pitch order
C	scale		i	i/o	Input speech scaling factor
C	descale		i	i/o	Output speech scaling factor
C	ber		r	i/o	% bit error rate
C	mask		i	o	Error mask
C	stype		char	i/o	Spectrum quantizer type
C	sbits		i	i/o	Spectrum bit allocation
C	eccbits		i	i/o	Error control bits/frame
C	ssum		i	i/o	Sum of spectrum bit allocation
C
C   global common 
C                       data    I/O
C       name            type    type    function
C       -------------------------------------------------------------------
C	 /ccsub/       see description include file
C	ncsize
C	no
C	gamma
C
C==========================================================================
c			CELP COMMAND
cNAME:
c     celp - execute the CELP coder
c
c     The celp command generates a code-excited-linear-prediction
c     processed output file from an input file.
c
cSYNOPSIS:
c     celp [-i ifile] [-c chan] [-o ofile] 
c                [-p pfile] [-q qfile] [-m mfile] [-l lfile]
c
cARGUMENTS:
c     -i      Input file i*2 direct access format (unformatted, consecutive
c             16-bit signed samples).
c             For defaults, see celp.f data statements.
c 
c     -c      Input channel file (.chan) hexadecimal format.  Channel
c	      files generated from previous analysis runs are used as
c	      inputs to a "synthesis only" run.  During this mode, the
c	      -i switch is invalid.  
c
c     -o      Speech output file (.spd) i*2 direct access format
c             (unformatted, consecutive 16-bit signed samples) and
c             bit stream channel file (.chan) hexadecimal format.
c             For defaults, see celp.f data statements.
c
c     -p      Parameter file specifying celp characteristics.
c             For defaults, see celp.f data statements.
c             Parameters are stored in a ascii text file in the order below
c             with one number per line i.e.,:
c
c		512       [ncsize  = Code book size]
c		60        [l       = Code word length]
c		240       [ll      = LPC analysis frame size]
c		10        [no      = LPC filter order]
c		60        [lp      = Pitch analysis frame size]
c		1         [np      = Pitch order]
c		0.8       [gamma   = Noise weighting factor]
c		1.0       [scale   = Input speech scaling factor]
c		1.0       [descale = Output speech scaling factor]
c		0.0       [ber     = % bit error rate]
c		1	  [mxsw    = modified excitation switch (1=ON)]
c		0.0       [prewt   = prefilter logical switch]
c		hier      [pstype  = type of fractional pitch search]
c
c     -q      Quantization characteristics file.
c             For defaults, see celp.f data statements.
c             The file has 3 sections: cbgain, pitch, and spectrum.
c             Each section type is followed by a quantization type,
c             which can be one of the following:  "max", "uniform", "vq",
c             "log", "opt", or "none".  If the quantization type is not 
c	      "none", then the next line is the bit allocation; i.e.:
c
c             cbgain
c             none			[unquantized cbgain]
c             pitch
c             max			[Max quantization]
c             8 6 5		[8 bit delay, 6 bit delta delay, 5 bit gain]
c             spectrum
c             kang			[Kang's quantization]
c             3 4 4 4 4 3 3 3 3 3	[lsp1=3,...,lsp10=3]
c
c     -m      Mask file specifying bit protection when introducing bit
c	      errors to the unpermuted bit stream.  (Note, this protection
c	      is separate from the Hamming FEC.)  Each line of the mfile
c	      corresponds to a bit (i.e., 144 lines) where each line is a
c	      1 (protected) or 0 (not protected).
c	      See description in biterror.f.  
c
c     -l      Log file output containing run time information.
c             Defaults to appending to a file called "celp.log".
c             If the file name "none" is specified, no log file
c             is generated.
c
cEXAMPLES:
c
c     celp
c             This causes celp to process ifile.spd into ofile.spd (and a
c             nonpostfiltered output in ofilenpf.spd) using the defaults 
c             specified by the FORTRAN data statements in celp.f,
c             writes the bit stream file ofile.chan and generates a log
c             appended to the file "celp.log".  (If SUNGRAPH is enabled,
c             a set of files, with .sg_data extension, as defined in
c             sungraph_open.com is generated.)
c
c     celp -i speech/dam27.spd -o dam27_48 -p celp48.p -q celp48.q -l log
c
c             celp processes speech/dam27.spd into the normal, highpassed
c             and nonpostfiltered output, dam27_48.spd,dam27_48hpf.spd
c             and dam27_48npf.spd, respectively, writes the bit 
c             stream file dam27_48.chan and appends log information to
c             a file called log.  The celp parameters specified by
c             celp48.p and quantization characteristics of celp48.q are
c             used.  (If SUNGRAPH is enabled, a set of files, with .sg_data
c             extension, as defined in sungraph_open.com is generated.)
c
c     celp -c speech/512_dam27.chan -o 512_dam27b
c
c             celp synthesizes speech/512_dam27.chan channel file into
c	      the normal, highpassed and nonpostfiltered output,
c	      512_dam27b.spd, 512_dam27bhpf.spd and 512_dam27bnpf.spd,
c	      respectively.
c
C**************************************************************************
C*-
	subroutine cli (ifile, ofile, l, ll, lp, np, scale, descale,
     +              ber, mask, stype, sbits, eccbits, ssum, analy)
c
c	note:  ncsize, no, and gamma are passed through common
c
	implicit undefined(a-z)
	include 'ccsub.com'
convex  #include "ccsub.com"
	character*80 ifile, ofile, stype*10
	integer l, ll, lp, np, mask(172), sbits(maxno), eccbits, ssum
	logical analy
	real scale, descale, ber
c
	real etime, time, t(2), realerror, sumsnr, sumdm(10), sumdm2(10)
	integer framesnr, framedm, framedm2, statb(12), lnblnk
	integer psum, rate, bits, rate2, i, j, mxsw2
	integer iargc, maxarg, maxtype, maxqtype
	parameter (maxarg = 14)
	parameter (maxtype = 3)
	parameter (maxqtype = 5)
	character*80 arg(maxarg), type(maxtype), qtype(maxqtype)
	character*80 pfile, qfile, lfile, prog, dir, mfile
	character*10 getlog, host, temp, fdate*24, ctime*24
	character*2  switch(maxarg/2)
	logical flag, qflag
c
	data switch /'-i','-o', '-p', '-q', '-m', '-l', '-c'/
	data pfile /''/, qfile /''/, mfile /''/, lfile /'celp.log'/
	data type /'cbgain', 'pitch', 'spectrum'/
	data qtype /'kang','log','max2','arcsin','none'/
c
c	*** parse the command line:
c	celp [-i ifile] [-c chan] [-o ofile] 
c	     [-p pfile] [-q qfile] [-m mfile] [-l lfile] 
c
	if (iargc() .gt. maxarg) then
	   print *, ' cli:  Too many arguments',iargc()
	   stop 'celp [-i ifile] [-c chan] [-o ofile] [-p pfile]
     +      [-q qfile][-m mfile] [-l lfile]'
	end if
	if (iargc() .gt. 1) then
	   if (mod(iargc(), 2) .eq. 1) then
	      print *, ' cli:  Odd number of arguments',iargc()
	      stop 'celp [-i ifile] [-c chan] [-o ofile] [-p pfile]
     +         [-q qfile] [-m mfile] [-l lfile]'
	   end if
	end if
	call getarg(0, prog)
	do 100 i = 1, iargc()
	   call getarg(i, arg(i))
100	continue
	do 200 i = 1, iargc(), 2
	   flag = .true.
	   do 110 j = 1, maxarg/2
	      if (arg(i) .eq. switch(j)) then
	         flag = .false.
	         if (j .eq. 1) ifile = arg(i+1)
	         if (j .eq. 2) ofile = arg(i+1)
	         if (j .eq. 3) pfile = arg(i+1)
	         if (j .eq. 4) qfile = arg(i+1)
	         if (j .eq. 5) mfile = arg(i+1)
	         if (j .eq. 6) lfile = arg(i+1)
	         if (j .eq. 7) then
	           ifile = arg(i+1)
	           analy = .false.
	         endif
	      end if
110	   continue
	      if (flag) then
	         print *, ' cli:  Bad switch',arg(i)
	         stop 'celp [-i ifile] [-c chan] [-o ofile] [-p pfile]
     +            [-q qfile][-m mfile] [-l lfile]'
	      end if
200	continue
c
c	*** read input parameter file if requested
c           (all parameters are required)
c
	if (pfile .ne. '') then
	   open(unit=69, file=pfile)
	   read(69, *) ncsize 
	   read(69, *) l
	   read(69, *) ll
	   read(69, *) no
	   read(69, *) lp
	   read(69, *) np
	   read(69, *) gamma
	   read(69, *) scale
	   read(69, *) descale
	   read(69, *) ber
	   read(69, *) mxsw2
c
c				*for compatibility with 3.2C par files:
	   if (mxsw2 .ne. 1) mxsw = .false.
c
	   read(69, *) prewt
	   read(69, *) pstype
	   close(unit=69)
	end if
c
c	*** read quantization characteristics file if requested
c           (not all parameters are required)
c
	if (qfile .ne. '') then
	   open(unit=70, file=qfile)
	   do 300 i = 1, maxtype
	      read(70, 69) temp
69	      format(a)
	      if (temp .eq. type(i)) then
	         if (i .eq. 1) then
	            read(70, 69) cbgtype
	            if (cbgtype .ne. 'none') read(70,  *) cbgbits
	         else if (i .eq. 2) then
	            read(70, 69) ptype
	            if (ptype .ne. 'none')
     +              read(70,  *) (pbits(j), j = 1, np+2)
	         else if (i .eq. 3) then
	            read(70, 69) stype
	            if (stype .ne. 'none' .and. stype .ne. 'opt')
     +              read(70,  *) (sbits(j), j = 1, no)
	         end if
	      end if
300	   continue
	   close(unit=70)
	end if
c
c	*** calculate data rate if fully quantized
c
c	    (assuming spectrum update rate (ll) = spectrum analysis rate)
c	    (assuming pitch update rate (lp) = pitch analysis rate)
c	    (assuming 8kHz sampling rate)
c
	qflag = .false.
	if (cbgtype.ne.'none'.and.ptype.ne.'none'.and.stype.ne.'none') then
	   qflag = .true.
	   psum = 2*(pbits(1)+pbits(2))
	   psum = psum + 4*(pbits(3))
	   ssum = 0
	   do 401 i = 1, no
	      ssum = ssum + sbits(i)
401	   continue
	   bits = nint((ll/l)*log10(float(ncsize))/log10(2.)
     +                + (ll/l)*cbgbits + psum + ssum + eccbits)
	   rate = nint(bits*8000./ll)
c
c	   1 bit for sync:
c
	   rate2 = rate + nint(1.*8000./ll)
	end if
c
c	*** read bit error characteristics file if requested
c
	if (mfile .ne. '') then
	   open(unit=72, file=mfile)
	   do 74 i = 1, bits
	      read(72, 73) mask(i)
73	      format(i1)
74	   continue
	   close(unit=72)
	end if	   
C
C	*** echo out parameters
C
	call hostnm(host)
	call getcwd(dir)
	call stat (prog, statb)
	print *, getlog(), host, fdate()
	print *,'          Program: '//prog(1:lnblnk(prog))
	print *,'         Modified: '//ctime(statb(10))
	print *,'        Directory: '//dir(1:lnblnk(dir))
	if (.not.analy) then
	print *,'     Channel file: '//ifile(1:lnblnk(ifile))
	print *,'      Output file: '//ofile(1:lnblnk(ofile))
        else
        print *,'       Input file: '//ifile(1:lnblnk(ifile))
	print *,'      Output file: '//ofile(1:lnblnk(ofile))
	print *,'   Parameter file: '//pfile(1:max(1,lnblnk(pfile)))
	print *,'Quantization file: '//qfile(1:max(1,lnblnk(qfile)))
	print *,'BER and mask file: '//mfile(1:max(1,lnblnk(mfile)))
	print *,'         Log file: '//lfile(1:lnblnk(lfile))
	print *,'            Code book size (ncsize)=',ncsize
	print *,'               Code word length (l)=',l
	print *,'       LPC analysis frame size (ll)=',ll
	print *,'              LPC filter order (no)=',no
	print *,'     Pitch analysis frame size (lp)=',lp
	print *,'          Pitch analysis order (np)=',np
	print *,'  Modified Excitation switch (mxsw)=',mxsw
	print *,' Fractional pitch analysis (pstype)= ',pstype
	print *,' Prefilter weighting factor (prewt)=',prewt
	print *,'     Noise weighting factor (gamma)=',gamma
	print *,'       Input scaling factor (scale)=',scale
	print *,'    Output scaling factor (descale)=',descale
	print *,'             % bit error rate (BER)=',ber
	if (cbgtype .ne. 'none') print 80, cbgtype, cbgbits
80	format('  CB Gain:  ',a8,'quantizer, bit allocation;',i2)
	if (ptype .ne. 'none') print 81, ptype, (pbits(j),j=1,np+2)
81	format('    Pitch:  ',a8,'quantizer, bit allocation;',4(i2))
	if (stype .ne. 'none') print 82, stype, (sbits(j),j=1,no)
82	format(' Spectrum:  ',a8,'quantizer, bit allocation;',10(i2))
	if (qflag) print 83, rate, bits, rate2
83	format(' Data rate = ',i4, ' bps ',i3,' bpf',' (',
     1  i4,' bps with 1 bit sync)')
c
c	*** verify parameters
c
	if (ncsize .gt. maxncsize) stop 'Error:  ncsize too big'
	if (l .gt. maxl)           stop 'Error:  l too big'
	if (ll .gt. maxll)         stop 'Error:  ll too big'
	if (no .gt. maxno)         stop 'Error:  no too big'
	if (lp .gt. maxlp)         stop 'Error:  lp too big'
	if (np .gt. maxnp)         stop 'Error:  np too big'
	if (gamma .gt. 1.0)        stop 'Error:  gamma > 1'
	if (scale .lt. 0.0)        stop 'Error:  scale < 0'
	if (ber .lt. 0.0)	   stop 'Error:  ber < 0'
	if (mod(ll, l) .ne. 0)
     +  stop '*** Error:  ll & l are inconsistent'
	if (mod(ll, lp) .ne. 0)
     +  stop '*** Error:  ll & lp are inconsistent'
	if (cbgbits .lt. 5 .or. cbgbits .gt. 7)
     +  stop 'Error:  bad cbgbits (not implemented)'
	if (pbits(1) .gt. 8)
     +  stop '*** Error:  bad pbits(1) (not implemented)'
	if (pbits(2).gt.7 .or. pbits(2).lt.3)
     +  stop '*** Error:  bad pbits(2) (not implemented)'
	do 500 i = 3, np+2
	   if (pbits(i) .lt. 3 .or. pbits(i) .gt. 5)
     +     stop '*** Error:  bad pbits (not implemented)'
500	continue
	flag = .true.
	do 501 j = 1, maxqtype
	   if (cbgtype .eq. qtype(j)) flag = .false.
501	continue
	if (flag) stop '*** Error:  bad cbgain quantizer type'
	flag = .true.
	do 502 j = 1, maxqtype
	   if (ptype .eq. qtype(j)) flag = .false.
502	continue
	if (flag) stop '*** Error:  bad pitch quantizer type'
	flag = .true.
	do 503 j = 1, maxqtype
	   if (stype .eq. qtype(j)) flag = .false.
503	continue
	if (flag) stop '*** Error:  bad spectrum quantizer type'
	
c
c	*** generate log file if requested
c
	if (lfile .ne. 'none') then  
	   if (lfile .eq. 'celp.log') then
cvax	      open(unit=71, file=lfile, access='append')
	      open(unit=71, file=lfile)
601	      read(71, 69, end=602) temp
	      goto 601
602	      continue	
	   else
	      open(unit=71, file=lfile)
	   end if
	   write(71, *) getlog(), host, fdate()
	   write(71, *)'          Program: '//prog(1:lnblnk(prog))
	   write(71, *)'         Modified: '//ctime(statb(10))
	   write(71, *)'        Directory: '//dir(1:lnblnk(dir))
	   write(71, *)'       Input file: '//ifile(1:lnblnk(ifile))
	   write(71, *)'      Output file: '//ofile(1:lnblnk(ofile))
	   write(71, *)'   Parameter file: '//pfile(1:max(1,lnblnk(pfile)))
	   write(71, *)'Quantization file: '//qfile(1:max(1,lnblnk(qfile)))
	   write(71, *)'BER and mask file: '//mfile(1:max(1,lnblnk(mfile)))
	   write(71, *)'         Log file: '//lfile(1:lnblnk(lfile))
	   write(71, *)'            Code book size (ncsize)=',ncsize
	   write(71, *)'               Code word length (l)=',l
	   write(71, *)'       LPC analysis frame size (ll)=',ll
	   write(71, *)'              LPC filter order (no)=',no
	   write(71, *)'     Pitch analysis frame size (lp)=',lp
	   write(71, *)'          Pitch analysis order (np)=',np
	   write(71, *)'  Modified Excitation switch (mxsw)=',mxsw
	   write(71, *)' Fractional pitch analysis (pstype)= ',pstype
	   write(71, *)' Prefilter weighting factor (prewt)=',prewt
	   write(71, *)'     Noise weighting factor (gamma)=',gamma
	   write(71, *)'       Input scaling factor (scale)=',scale
	   write(71, *)'    Output scaling factor (descale)=',descale
	   write(71, *)'             % bit error rate (BER)=',ber
	   if (cbgtype .ne. 'none') write(71, 80) cbgtype, cbgbits
	   if (ptype .ne. 'none') write(71, 81)ptype,(pbits(j),j=1,np+2)
	   if (stype .ne. 'none') write(71, 82)stype,(sbits(j),j=1,no)
	   if (qflag) write(71, 83) rate, bits, rate2
	end if
	endif
	return
C==========================================================================
C
C ROUTINE
C               cliend
C
C FUNCTION
C               End of command line interface entry.
C		Report and log job characteristics and performance.
C 
C SYNOPSIS
c
c	entry cliend(frame, sumsnr, framesnr, realerror,
c     &	            sumdm, framedm, sumdm2, framedm2)
C
C   formal 
C
C			data	I/O
C	name		type	type	function
C       -------------------------------------------------------------------
c	frame		i	i	frame counter
c					 (=total frames processed at end)
c	sumsnr		i	r	sum of segmental signal-to-noise
c	framesnr	i	i	count of frames used for snr sum
c	realerror	i	r	bit error rate
c	sumdm		i	r	sum of speech distortion measures
c						(see dist.f)
c	framedm		i	i	count of frames used for sumdm
c	sumdm2		i	r	sum of spectral distortion measures
c						(see dist.f)
c	framedm2	i	i	count of frames used for sumdm2
C
C==========================================================================
c
	entry cliend(sumsnr, framesnr, realerror,
     +	            sumdm, framedm, sumdm2, framedm2, analy)
c
c			*calculate run time, print time & date
	time = etime(t)
	print 90, frame, fdate()
c
c			*actual bit error rate
        if (analy) then
	print 92, realerror
c
c			*average segmental signal-to-noise
	if (framesnr .le. 0) framesnr=1
	if (sumsnr/framesnr .gt. 0.) then
	   print 93, 10*log10(sumsnr/framesnr),framesnr
	else 
	   print 94,sumsnr/framesnr,framesnr
	end if
c
c			*speech distortion
	if (framedm .ne. 0.0) print 95, (sumdm(i)/framedm, i = 1, 10)
	print 96, framedm
c
c			*spectral distortion
	if (framedm2 .ne. 0.0) print 97, (sumdm2(i)/framedm2, i = 1, 10)
	print 98, framedm2
	endif
c
c			*print runtime, etc. (& ring bell)
	print 91, t(1), t(2), time, char(7)
c
c			*write above to log file
        if (analy) then
	if (lfile .ne. 'none') then
	   write(71, 90) frame, fdate()
	   write(71, 92) realerror
	   if (sumsnr/framesnr .gt. 0) then
	      write(71, 93) 10*log10(sumsnr/framesnr),framesnr
	   else
	      write(71, 94) sumsnr/framesnr,framesnr
	   end if
	   if (framedm.ne.0.0) write(71, 95) (sumdm(i)/framedm, i=1,10)
	   write(71, 96) framedm
	   if (framedm2.ne.0.0) write(71, 97) (sumdm2(i)/framedm2, i=1,10)
	   write(71, 98) framedm2
	   write(71, 91) t(1), t(2), time
	   write(71, 99)
99	   format(1x, 70('.'))
	   close(unit=71)
	end if
	endif
90	format(' Finished processing', i8, ' frames of data on ', a)
92	format(' Overall bit error rate =',f8.4,' %')
93	format(' Segmental SNR =',f8.4,' dB (',i6,
     +  ' subframes averaged for SNR)')
94	format(' Segmental SNR =',f8.4,'    (',i6,
     +  ' subframes averaged for SNR)')
95	format(' Speech distortion:',/,
     +  ' likelihood measures   ',2f11.4,/,
     +  ' cosh measures      dB ',4f11.4,/,
     +  ' cepstral distance  dB ',3f11.4,/,
     +  ' average distance   dB ',f11.4)
96	format(i6,' subframes averaged for distance measures')
97	format(' Spectral distortion:',/,
     +  ' likelihood measures   ',2f11.4,/,
     +  ' cosh measures      dB ',4f11.4,/,
     +  ' cepstral distance  dB ',3f11.4,/,
     +  ' average distance   dB ',f11.4)
98	format(i6,' subframes averaged for distance measures')
91	format(' Elapsed times (s):', f9.1, ' user,',
     +  f5.1,' system,', f9.1, ' total', a)
	return
	end

						