home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Education Sampler 1992 [NeXTSTEP]
/
Education_1992_Sampler.iso
/
SoundAndMusic
/
cmix
/
lpc
/
stabilization
/
xnewstable.f
< prev
Wrap
Text File
|
1990-02-03
|
1KB
|
42 lines
subroutine correct(frame,npoles,a)
dimension frame(1)
dimension a(1)
implicit double precision (a-h, o-z)
double precision y(97),rootr(96),rooti(96)
double complex zero,one
real * 4 a(90)
double precision r(37),th(37)
double complex ww, w(37)
zero = (0.d0,0.d0)
one = (1.d0,0.d0)
k4 = npoles + 1
k4m = k4 -1
nall = k4 + 4
do 1601 ii=1,k4m
1601 y(ii)= -frame(ii+4)
y(k4)=1.
eps=10.d0**(-8)
303 call factor(y,k4,rootr,rooti,kinsid,kprint,eps)
do 100 j=1,k4m
r(j) = dsqrt(rootr(j) **2 + rooti(j)**2)
th(j) = datan2(rooti(j),rootr(j))
if(r(j).ge.1.) r(j)= 1./r(j)
100 continue
do 10 k=1,k4m
10 w(k) = zero
w(k4)=one
do 20 k=1,k4m
c ww=dcmplx(rootr(k),rooti(k))
ww=dcmplx(r(k)*dcos(th(k)),r(k)*dsin(th(k)))
l1=k4-k
do 12 j=l1,k4m
12 w(j)=w(j+1)-ww*w(j)
20 w(k4)=-ww*w(k4)
do 30 j=2,k4
zz=real(w(j))
a(k4+ndata+1-j) = -zz
30 continue
return
end