home *** CD-ROM | disk | FTP | other *** search
/ Education Sampler 1992 [NeXTSTEP] / Education_1992_Sampler.iso / SoundAndMusic / cmix / lpc / stabilization / xnewstable.f < prev   
Text File  |  1990-02-03  |  1KB  |  42 lines
  1.     subroutine correct(frame,npoles,a)
  2.     dimension frame(1)
  3.     dimension a(1)
  4.  
  5.       implicit double precision (a-h, o-z)
  6.       double precision y(97),rootr(96),rooti(96)
  7.       double complex zero,one
  8.       real * 4 a(90)
  9.       double precision r(37),th(37)
  10.       double complex ww, w(37)
  11.       zero = (0.d0,0.d0)
  12.       one = (1.d0,0.d0)
  13.       k4 = npoles + 1
  14.       k4m = k4 -1
  15.       nall = k4 + 4
  16.       do 1601 ii=1,k4m
  17. 1601  y(ii)= -frame(ii+4)
  18.       y(k4)=1.
  19.       eps=10.d0**(-8)
  20. 303   call factor(y,k4,rootr,rooti,kinsid,kprint,eps)
  21.       do 100 j=1,k4m
  22.       r(j) = dsqrt(rootr(j) **2 + rooti(j)**2)
  23.       th(j) = datan2(rooti(j),rootr(j))
  24.       if(r(j).ge.1.) r(j)= 1./r(j) 
  25. 100   continue 
  26.       do 10 k=1,k4m
  27. 10    w(k) = zero
  28.       w(k4)=one
  29.       do 20 k=1,k4m
  30. c    ww=dcmplx(rootr(k),rooti(k))
  31.     ww=dcmplx(r(k)*dcos(th(k)),r(k)*dsin(th(k)))
  32.     l1=k4-k
  33.     do 12 j=l1,k4m
  34. 12           w(j)=w(j+1)-ww*w(j)
  35. 20      w(k4)=-ww*w(k4)
  36.     do 30 j=2,k4 
  37.     zz=real(w(j))
  38.     a(k4+ndata+1-j) = -zz
  39. 30    continue
  40.     return
  41.       end
  42.