home *** CD-ROM | disk | FTP | other *** search
/ Education Sampler 1992 [NeXTSTEP] / Education_1992_Sampler.iso / SoundAndMusic / cmix / lpc / stabilization / newstable.c < prev    next >
C/C++ Source or Header  |  1990-02-03  |  3KB  |  124 lines
  1. /* newstable.f -- translated by f2c (version of 26 January 1990  18:57:16).
  2.    You must link the resulting object file with the libraries:
  3.     -lF77 -lI77 -lm -lc   (in that order)
  4. */
  5.  
  6. #include "f2c.h"
  7.  
  8. /* Subroutine */ int correct_(frame, npoles, a)
  9. /*
  10. doublereal *frame; 
  11. */
  12. float *frame;
  13. integer *npoles;
  14. real *a;
  15. {
  16.     /* System generated locals */
  17.     integer i,i_1, i_2, i_3, i_4, i_5;
  18.     doublereal d_1, d_2;
  19.     doublecomplex z_1, z_2;
  20.  
  21.     /* Builtin functions */
  22.     double sqrt(), atan2(), cos(), sin();
  23.  
  24.     /* Local variables */
  25.     static integer nall;
  26.     static doublecomplex zero;
  27.     static integer j, k;
  28.     static doublereal r[37];
  29.     static doublecomplex w[37];
  30.     static integer ndata;
  31.     static doublereal y[97], rooti[96];
  32.     static integer l1, k4;
  33.     static doublereal rootr[96];
  34.     static integer ii;
  35.     static doublereal th[37];
  36.     static doublecomplex ww;
  37.     extern /* Subroutine */ int factor_();
  38.     static integer kinsid;
  39.     static doublereal zz;
  40.     static integer kprint, k4m;
  41.     static doublecomplex one;
  42.     static doublereal eps;
  43.  
  44. /*
  45. printf("\nin correct npoles = %d \n",*npoles);
  46. for(i=0; i<36; i++) printf(" %g ",frame[i]);
  47. */
  48.     /* Parameter adjustments */
  49.     --frame; 
  50.     --a;
  51.     /* Function Body */
  52.     zero.r = 0., zero.i = 0.;
  53.     one.r = 1., one.i = 0.;
  54.     k4 = *npoles + 1;
  55.     k4m = k4 - 1;
  56.     nall = k4 + 4;
  57.     i_1 = k4m;
  58.     for (ii = 1; ii <= i_1; ++ii) {
  59. /* L1601: */
  60.     y[ii - 1] = -frame[ii + 4];
  61.     }
  62.     y[k4 - 1] = (float)1.;
  63.     eps = 1.0000000000000008e-8;
  64. /* L303: */
  65.     factor_(y, &k4, rootr, rooti, &kinsid, &kprint, &eps);
  66.     i_1 = k4m;
  67.     for (j = 1; j <= i_1; ++j) {
  68. /* Computing 2nd power */
  69.     d_1 = rootr[j - 1];
  70. /* Computing 2nd power */
  71.     d_2 = rooti[j - 1];
  72.     r[j - 1] = sqrt(d_1 * d_1 + d_2 * d_2);
  73.     th[j - 1] = atan2(rooti[j - 1], rootr[j - 1]);
  74.     if (r[j - 1] >= 1.) {
  75.         r[j - 1] = (float)1. / r[j - 1];
  76.     }
  77. /* L100: */
  78.     }
  79.     i_1 = k4m;
  80.     for (k = 1; k <= i_1; ++k) {
  81. /* L10: */
  82.     i_2 = k - 1;
  83.     w[i_2].r = zero.r, w[i_2].i = zero.i;
  84.     }
  85.     i_2 = k4 - 1;
  86.     w[i_2].r = one.r, w[i_2].i = one.i;
  87.     i_2 = k4m;
  88.     for (k = 1; k <= i_2; ++k) {
  89. /*     ww=dcmplx(rootr(k),rooti(k)) */
  90.     d_1 = r[k - 1] * cos(th[k - 1]);
  91.     d_2 = r[k - 1] * sin(th[k - 1]);
  92.     z_1.r = d_1, z_1.i = d_2;
  93.     ww.r = z_1.r, ww.i = z_1.i;
  94.     l1 = k4 - k;
  95.     i_1 = k4m;
  96.     for (j = l1; j <= i_1; ++j) {
  97. /* L12: */
  98.         i_3 = j - 1;
  99.         i_4 = j;
  100.         i_5 = j - 1;
  101.         z_2.r = ww.r * w[i_5].r - ww.i * w[i_5].i, z_2.i = ww.r * w[i_5]
  102.             .i + ww.i * w[i_5].r;
  103.         z_1.r = w[i_4].r - z_2.r, z_1.i = w[i_4].i - z_2.i;
  104.         w[i_3].r = z_1.r, w[i_3].i = z_1.i;
  105.     }
  106. /* L20: */
  107.     i_3 = k4 - 1;
  108.     z_2.r = -ww.r, z_2.i = -ww.i;
  109.     i_4 = k4 - 1;
  110.     z_1.r = z_2.r * w[i_4].r - z_2.i * w[i_4].i, z_1.i = z_2.r * w[i_4].i 
  111.         + z_2.i * w[i_4].r;
  112.     w[i_3].r = z_1.r, w[i_3].i = z_1.i;
  113.     }
  114.     i_3 = k4;
  115.     for (j = 2; j <= i_3; ++j) {
  116.     i_4 = j - 1;
  117.     zz = w[i_4].r;
  118.     a[k4 + ndata + 1 - j] = -zz;
  119. /* L30: */
  120.     }
  121.     return 0;
  122. } /* correct_ */
  123.  
  124.