语音压缩

开发平台：
Unix_Linux

psearch.F：源码内容
							C==========================================================================
C
C ROUTINE
C               psearch
C
C FUNCTION
C               find pitch VQ parameters
C
C SYNOPSIS
C               subroutine psearch(s, l)
C
C   formal 
C
C                       data    I/O
C       name            type    type    function
C       -------------------------------------------------------------------
C       s               real    i       data segment
C       l               int     i       dimension of s
C
C   global 
C                       data    I/O
C       name            type    type    function
C       -------------------------------------------------------------------
C 	/ccsub/       see description include file
#ifdef SUNGRAPH
C 	/sungraph_var/
#endif
C
C==========================================================================
C	
C DESCRIPTION
C
C  Pitch search is performed by closed-loop analysis using a modification
C  of what is commonly called any one of the following: "self-excited",
C  "adaptive code book" or "VQ" method.  This method was found to be
C  superior to the conventional "filtering approach", especially for high
C  pitched speakers.  The filtering and VQ methods are identical except when
C  the delay is less than the frame length.  The pitch delay ranges from mmin
C  to mmax (i.e., 20 to 147 including noninteger) lags every odd subframe
C  while even subframes are searched and coded within 2**pbits(2) lags
C  relative to the previous subframe.  This delta search greatly reduces
C  the computational complexity and data rate while causing no percievable
C  loss in speech quality.
C
C  The minimum squared prediction error (MSPE) search criteria is modified
C  to check the error at submultiples of the delay to determine if it is
C  within 1 dB of the MSPE.  The submultiple delay is selected if its error
C  satisfies our modified criteria.  This results in a smooth "pitch" delay
C  contour which produces higher quality speech and is crucial to the
C  synthesizer's smoother in the presence of bit errors. 
C  	
C==========================================================================
C
C CALLED BY
C
C       csub
C
C CALLS
C
C	movfr, pgain, delay, pitchencode
C
C==========================================================================
C
C REFERENCES
C
C	Tremain, Thomas E., Joseph P. Campbell, Jr and Vanoy C. Welch,
C	"A 4.8 kbps Code Excited Linear Predictive Coder," Proceedings
C	of the Mobile Satellite Conference, 3-5 May 1988, pp. 491-496.
C
C	Campbell, Joseph P. Jr., Vanoy C. Welch and Thomas E. Tremain,
C	"An Expandable Error-Protected 4800 bps CELP Coder (U.S. Federal
C	Standard 4800 bps Voice Coder)," Proceedings of ICASSP, 1989.
C	(and Proceedings of Speech Tech, 1989.)
C
C	Kroon, Peter and Bishnu Atal, "On Improving the Performance of
C	Pitch Predictions in Speech Coding Systems," IEEE Speech Coding
C	Workshop, September 1989.
C
C	Marques, J.S., et al., "Pitch Prediction with Fractional Delays
C	in CELP Coding," European Conference on Speech Communication and
C	Technology, September, 1989.
C
C**************************************************************************
C*-
	subroutine psearch(s, l)
	implicit undefined (a-z)
	integer l
	real s(l)
	include 'ccsub.com'
convex	#include "ccsub.com"
#ifdef SUNGRAPH
	include 'sungraph_var.com'
convex	#include "sungraph_var.com"
	integer saveindex
#endif
	real g(0:maxpd-1), match(0:maxpd-1), emax, pgain, pitchencode
	integer submult(0:maxpd-1,0:3), bigptr, subptr, topptr, maxptr, oldptr
	integer maxbufptr, bufptr, lag, i, j, m, len, start, nrange
	logical first, whole, fraction, sub, neigh
c			*see warning below - / max (maxl, maxlp)
	parameter (maxbufptr = mmax+maxno+2*maxlp+maxnp-1)
	real v0(maxbufptr), v0shift(maxlp), frac
c			*length of truncated impulse response
	parameter (len = 30)
c
c	Choose type of pitch delay search:
c
c			*two stage hierarchical search of
c			*integer and neighboring noninteger delays
	if (pstype .eq. 'hier') then
	   whole=.true.
	   fraction=.false.
	   sub=.true.
	   neigh=.true.
	   nrange = 3
c
c			*integer only search
	else if (pstype .eq. 'intg') then
	   whole=.true.
	   fraction=.false.
	   sub=.true.
	   neigh=.false.
c
c			*full exhaustive search
	else if (pstype .eq. 'full') then
	   whole=.true.
	   fraction=.true.
	   sub=.true.
	   neigh=.false.
c
	else 
	   stop ' psearch: incorrect pitch search type (pstype)'
	end if
c
	save oldptr, submult
c
	data oldptr/1/
c
c
	if (len .gt. l) stop ' psearch:  impulse response too long'
c
	bufptr = mmax+no+2*l+maxnp-1
	if (maxlp .lt. maxl) stop ' psearch:  maxlp < maxl'
#ifdef SUNGRAPH
c			*save impulse response in file 'pitch'
	call save_sg(pitch_ir_vid,h,l,'save pitch_ir_vid')
#endif
c
c			*clear match array
	do 10 i = 0, plevel1-1
	   match(i) = 0.0
10	continue
c
c			*update adaptive code book (pitch memory)
	call movefr(idb,d1b,v0(bufptr-idb-l+1))
c
c			*initial conditions
	if (nseg .eq. 1) then
	   bb(3) = 0.0
	   bb(1) = mmin
c			*load pitch submultiple delay table
	   open(unit=8, file='./submult.h', status='old', err=22)
	   do 20 i = 0, maxpd-1
	      read(8, *, err=22) (submult(i,j), j=0,3)
20	   continue
	   close(8)
	   goto 25
22	      stop ' celp:  Problem with file "submult.h"'
25	   continue
	   goto 999
	end if
#ifdef SUNGRAPH
	saveindex = bufptr-idb-l+1
c
c			*save fndpp_v0 in file 'error'
	call save_sg(fndpp_v0_vid, v0(saveindex), l,'save fndpp_v0_vid')
#endif
c
c			*find allowable pointer range (minptr to maxptr)
	if (mod(nseg,2) .eq. 0) then
c			*delta delay coding on even subframes
	   minptr = oldptr - (plevel2/2-1)
	   maxptr = oldptr + (plevel2/2)
	   if (minptr .lt. 0) then
	      minptr = 0
	      maxptr = plevel2 - 1
	   end if
	   if (maxptr .gt. plevel1-1) then
	      maxptr = plevel1 - 1
	      minptr = plevel1 - plevel2
	   end if
	else
c			*full range coding on odd subframes
	   minptr = 0
	   maxptr = plevel1 - 1
	end if
c
	start = bufptr-l+1
c
c			*find gain and match score for integer pitch delays
c			*(using end-point correction on unity spaced delays)
	if (whole) then
	   first = .true.
	   do 30 i = minptr, maxptr
	      m    = int(pdelay(i))
	      frac = pdelay(i) - m
	      if (abs(frac) .lt. 1.e-4) then
	         lag   = start - m
	         g(i)  = pgain(v0(lag), l, first, m, len, match(i))
	         first = .false.
	      else
	         match(i) = 0.0
	      end if
30	   continue
	end if
c
c			*find gain and match score for fractional delays
c			*(beware of combining this loop with above loop!)
c			*(could use end-point correction on unity spaced delays)
	if (fraction) then
	   do 40 i = minptr, maxptr
	      m    = int(pdelay(i))
	      frac = pdelay(i) - m
	      if (abs(frac) .ge. 1.e-4) then
	         call delay(v0, bufptr, start, l, frac, m, v0shift)
	         g(i) = pgain(v0shift, l, .true., 69, len, match(i))
	      end if
40	   continue
	end if
c
c			*find pointer to top (MSPE) match score (topptr)
c			*search for best match score (max -error term)
	topptr= minptr
	emax  = match(topptr)
	do 50 i = minptr, maxptr
	   if (match(i) .gt. emax) then
	      topptr= i
	      emax  = match(topptr)
	   end if
50	continue
c
c			*for full search (odd) subframes:
c			*select shortest delay of 2, 3, or 4 submultiples
c			*if its match is within 1 dB of MSPE to favor
c			*smooth "pitch"
	tauptr = topptr
	if (sub) then
	   if (mod(nseg,2) .ne. 0) then
c			*for each submultiple {2, 3 & 4}
	      do 70 i = 1, submult(topptr,0)
c			*find best neighborhood match for given submultiple
	         bigptr = submult(topptr,i)
	         do 60 subptr = max(submult(topptr,i) - 8, minptr),
     &	                        min(submult(topptr,i) + 8, maxptr)
	               if (match(subptr) .gt. match(bigptr)) bigptr = subptr
60	         continue
c			*select submultiple match if within 1 dB MSPE match
	         if (match(bigptr) .ge. 0.88*match(topptr)) then
	            tauptr = bigptr
	         end if
70	      continue
	   end if
	end if
c			*search tauptr's neighboring delays
c			*(to be used with earlier stages of searching)
c			*find gain and match score for neighboring delays
c			*and find best neighborhood match
c			*(could use end-point correction on unity spaced delays)
	if (neigh) then
	   bigptr = tauptr
	   do 90 i = max(tauptr - nrange, minptr), min(tauptr + nrange, maxptr)
	      if (i .ne. tauptr) then
	         m    = int(pdelay(i))
	         frac = pdelay(i) - m
	         lag  = start - m
	         if (abs(frac) .lt. 1.e-4) then
	            g(i) = pgain(v0(lag), l, .true., m, len, match(i))
	         else
	            call delay(v0, bufptr, start, l, frac, m, v0shift)
	            g(i) = pgain(v0shift, l, .true., 69, len, match(i))
	         end if
	         if (match(i) .gt. match(tauptr)) bigptr = i
	      end if
90	   continue
	   tauptr = bigptr
	end if
c
c			*OPTIONAL (may be useful for integer DSPs)
c			*given chosen pointer to delay (tauptr), recompute its
c			*gain to correct errors accumulated in recursions
c			*and errors due to truncation
	m    = int(pdelay(tauptr))
	frac = pdelay(tauptr) - m
	lag  = start - m
	if (abs(frac) .lt. 1.e-4) then
c	   integer delay:
	   g(tauptr) = pgain(v0(lag), l, .true., m, l, match(tauptr))
	else
c	   fractional delay:
	   call delay(v0, bufptr, start, l, frac, m, v0shift)
	   g(tauptr) = pgain(v0shift, l, .true., 69, l, match(tauptr))
	end if
c
c			*place pitch parameters in common bb "structure"
	bb(3)   = g(tauptr)
	bb(1)   = pdelay(tauptr)
c
c			*save pitch pointer to determine delta delay
	oldptr = tauptr
#ifdef SUNGRAPH
c			*save pitch match score function in file 'pitch'
	call save_sg(pitch_match_vid, match, plevel1,'save pitch_error_vid')
#endif
c
999	continue
#ifdef SUNGRAPH
c
c			*save unquantized pitch gain in file 'pitch'
	call save_sg(pitch_gain_vid,bb(3),1,'save pitch_gain_vid')
#endif
c
c			*write clamped pitch gain file for quantizer design
copt	write (21,*) max(min(bb(3), 2.0), -1.0)
c	
c			*pitch quantization bb(3)
	if (ptype .ne. 'none') then
	   bb(3) = pitchencode(bb(3),pbits(3),ptype,pindex)
	else
	   print *, ' psearch:  no pitch quantization!'
	end if
#ifdef SUNGRAPH
c			*save quantized pitch gain in file 'pitch'
	call save_sg(pitch_qgain_vid,bb(3),1,'save pitch_qgain_vid')
#endif
c
	return
	end

						