语音压缩

开发平台：
Unix_Linux

intsynth.f：源码内容
							c==========================================================================
c
c ROUTINE
c		intsynth
c
c FUNCTION
c		Linearly interpolate between transmitted LSPs
c		to generate nn (=4) intermediate sets of LSP
c		frequencies for subframe synthesis. 
c		
c
c SYNOPSIS
c		subroutine intsynth(lspnew, nn, lsp, twoerror, syndavg, predgain
c					delta, avg, mini)
c
c   formal 
c
c                       data    I/O
c       name            type    type    function
c       -------------------------------------------------------------------
c	lspnew		real	i/o	new frequency array
c	nn		int	i	number of segments/frame
c	lsp		real	o	interpolated frequency matrix
c	twoerror	log	i	flag for occurrence of two errors
c					  in Hamming protected bits.
c	syndavg		real	i	bit error estimation parameter
c	predgain		real	o	prediction predgain
c	delta		real	o	delta from last frame pred. predgain
c	avg		real	o	average predition predgain
c	mini		real	o	minimum lsp separation
c
c   global 
c                       data    I/O
c       name            type    type    function
c       -------------------------------------------------------------------
c 	/ccsub/       see description include file
c
c==========================================================================
c
c DESCRIPTION
c		This routine interpolates lsp's for subframe synthesis.
c	This version is only for use with absolute scalar LSP coding!
c	The interpolated LSPs are identical to the interpolated set in 
c	transmitter provided there are no transmission errors.  If the 
c	LSP's are nonmonotonic, then LSP errors have occured and an 
c	attempt is made to "fix" them by repeating previous LSP values. 
c	If this correction fails (the vector is still nonomonotonic), 
c	then the entire previous LSP vector is repeated.  (This version 
c	ignores twoerror and syndavg.)
c
c**************************************************************************
c
	subroutine intsynth(lspnew, nn, lsp, twoerror, syndavg, predgain,
     &				delta, avg, mini)
c
	implicit undefined(a-z)
	include 'ccsub.com'
convex	#include "ccsub.com"
	integer nn
	real lspnew(no), lsp(maxno, nn), syndavg
	integer i, j, jj, index
	logical twoerror, nonmono
	real lspold(maxno), w(2, 4)
c
	data w/0.875, 0.125,
     &         0.625, 0.375, 
     &         0.375, 0.625, 
     &         0.125, 0.875/
c
	save lspold, oldpredgain
cSAVE	save avg {if not passing to main routine}
	real temp(maxno+1),rc(maxno),predgain,oldpredgain
	real delta,avg,dlsp(maxno+1),mini
c
	data lspold  /.03,.05,.09,.13,.19,.23,.29,.33,.39,.44/
c
c			*try to fix any nonmonotonic LSPs by repeating pair
	do 10 i = 2, no
	   if (lspnew(i) .le. lspnew(i-1)) then
	      print *,' intsynth:  try to fix any nonmonotonic LSPs'
	      lspnew(i) = lspold(i)
	      lspnew(i-1) = lspold(i-1)
	   end if
10	continue
c
c			*check fixed LSPs (also check for pairs too close?)
	nonmono = .false.
	do 20 i = 2, no
	   if (lspnew(i) .le. lspnew(i-1)) nonmono = .true.
20	continue
c
c			*if fix fails, repeat entire LSP vector
	if (nonmono) then
	   print *,' intsynth:  repeat entire LSP vector'
	   print *,' syndavg=',syndavg,' twoerror=',twoerror,' frame=',frame
	   print *,' lspold       ', ' lspnew'
	   do 30 i = 1, no
	      print *, lspold(i), lspnew(i)
30	   continue
	   do 40 i = 1, no
	      lspnew(i) = lspold(i)
40	   continue
	end if
c.......................*OPTIONAL (and not finished):
c			*if large prediction gain then
c			*repeat close LSP pair(s)
	j=0
69	j = j+1
	call lsptopc(lspnew,temp)
	call pctorc(temp,rc,no)
	predgain = 1.
	do 55 i = 1, no
	   predgain = predgain*(1.-rc(i)**2)
55	continue
	delta = predgain-oldpredgain
c			*check predgain & delta predgain
CCCC	if (predgain .gt. ---- .or. delta .gt. ...
c			*find index to minimum lsp difference
	   do 56 i = 2, no
	      dlsp(i)=lspnew(i)-lspnew(i-1)
56	   continue
	   dlsp(1)=lspnew(1)
	   dlsp(no+1)=0.5-lspnew(no)
	   mini=1.
	   do 58 i = 1, no+1
	      if(dlsp(i) .lt. mini) then
	         mini=dlsp(i)
	         index=i
	      end if
58	   continue
CCCC	   print *,' repeating close LSPs of index',index,'at frame',frame,j
CCCC	   if (index .eq. 1 .or. index .eq. no+1) then
CCCC	      lspnew(index) = lspold(index)
CCCC	   else 	   
CCCC	      lspnew(index) = lspold(index)
CCCC	      lspnew(index-1) = lspold(index-1)
c			*recheck
CCCC	   if (j .lt. no) goto 69
CCCC	end if
	avg = .95*avg + .05*predgain
	oldpredgain = predgain
c.......................
c
c			*interpolate lsp's
	do 100 i = 1, nn
	   do 50 j = 1, no
	      lsp(j,i) = w(1,i)*lspold(j)+w(2,i)*lspnew(j)
50	   continue
c
c.......................*OPTIONAL bug checker
c			*check for monotonically increasing lsp's
	   nonmono = .false.
	   do 60 j = 2, no
	      if (lsp(j,i) .le. lsp(j-1,i)) nonmono = .true.
60	   continue
	   if (nonmono) then
	      print *,' intsynth:  nonmono LSPs@frame',frame,'CANN''T HAPPEN'
	      print *,'LSPs=',(lsp(jj,i),jj=1,no)
	   end if
100	continue
c.......................
c
c			*update lsp history
	do 200 i = 1, no
	      lspold(i)  = lspnew(i)
200	continue
	return 
	end

						