home *** CD-ROM | disk | FTP | other *** search
/ ARM Club 1 / ARM_CLUB_CD.iso / contents / apps / clib / progs / meschach / !Meschach / c / zmachine < prev    next >
Encoding:
Text File  |  1994-01-12  |  4.2 KB  |  163 lines
  1.  
  2. /**************************************************************************
  3. **
  4. ** Copyright (C) 1993 David E. Steward & Zbigniew Leyk, all rights reserved.
  5. **
  6. **                 Meschach Library
  7. ** 
  8. ** This Meschach Library is provided "as is" without any express 
  9. ** or implied warranty of any kind with respect to this software. 
  10. ** In particular the authors shall not be liable for any direct, 
  11. ** indirect, special, incidental or consequential damages arising 
  12. ** in any way from use of the software.
  13. ** 
  14. ** Everyone is granted permission to copy, modify and redistribute this
  15. ** Meschach Library, provided:
  16. **  1.  All copies contain this copyright notice.
  17. **  2.  All modified copies shall carry a notice stating who
  18. **      made the last modification and the date of such modification.
  19. **  3.  No charge is made for this software or works derived from it.  
  20. **      This clause shall not be construed as constraining other software
  21. **      distributed on the same medium as this software, nor is a
  22. **      distribution fee considered a charge.
  23. **
  24. ***************************************************************************/
  25.  
  26.  
  27. /*
  28.   This file contains basic routines which are used by the functions
  29.   involving complex vectors.
  30.   These are the routines that should be modified in order to take
  31.   full advantage of specialised architectures (pipelining, vector
  32.   processors etc).
  33.   */
  34. static    char    *rcsid = "$Id: zmachine.c,v 1.1 1994/01/13 04:25:41 des Exp $";
  35.  
  36. #include    <math.h>
  37. #include    "machine.h"
  38. #include        "zmatrix.h"
  39.  
  40.  
  41. /* __zconj__ -- complex conjugate */
  42. void    __zconj__(zp,len)
  43. complex    *zp;
  44. int    len;
  45. {
  46.     int        i;
  47.  
  48.     for ( i = 0; i < len; i++ )
  49.     zp[i].im = - zp[i].im;
  50. }
  51.  
  52. /* __zip__ -- inner product
  53.     -- computes sum_i zp1[i].zp2[i] if flag == 0
  54.             sum_i zp1[i]*.zp2[i] if flag != 0 */
  55. complex    __zip__(zp1,zp2,len,flag)
  56. complex    *zp1, *zp2;
  57. int    flag, len;
  58. {
  59.     complex    sum;
  60.     int        i;
  61.  
  62.     sum.re = sum.im = 0.0;
  63.     if ( flag )
  64.     {
  65.     for ( i = 0; i < len; i++ )
  66.     {
  67.         sum.re += zp1[i].re*zp2[i].re + zp1[i].im*zp2[i].im;
  68.         sum.im += zp1[i].re*zp2[i].im - zp1[i].im*zp2[i].re;
  69.     }
  70.     }
  71.     else
  72.     {
  73.     for ( i = 0; i < len; i++ )
  74.     {
  75.         sum.re += zp1[i].re*zp2[i].re - zp1[i].im*zp2[i].im;
  76.         sum.im += zp1[i].re*zp2[i].im + zp1[i].im*zp2[i].re;
  77.     }
  78.     }
  79.  
  80.     return sum;
  81. }
  82.  
  83. /* __zmltadd__ -- scalar multiply and add i.e. complex saxpy
  84.     -- computes zp1[i] += s.zp2[i]  if flag == 0
  85.     -- computes zp1[i] += s.zp2[i]* if flag != 0 */
  86. void    __zmltadd__(zp1,zp2,s,len,flag)
  87. complex    *zp1, *zp2, s;
  88. int    flag, len;
  89. {
  90.     int        i;
  91.     LongReal    t_re, t_im;
  92.  
  93.     if ( ! flag )
  94.     {
  95.     for ( i = 0; i < len; i++ )
  96.     {
  97.         t_re = zp1[i].re + s.re*zp2[i].re - s.im*zp2[i].im;
  98.         t_im = zp1[i].im + s.re*zp2[i].im + s.im*zp2[i].re;
  99.         zp1[i].re = t_re;
  100.         zp1[i].im = t_im;
  101.     }
  102.     }
  103.     else
  104.     {
  105.     for ( i = 0; i < len; i++ )
  106.     {
  107.         t_re = zp1[i].re + s.re*zp2[i].re + s.im*zp2[i].im;
  108.         t_im = zp1[i].im - s.re*zp2[i].im + s.im*zp2[i].re;
  109.         zp1[i].re = t_re;
  110.         zp1[i].im = t_im;
  111.     }
  112.     }
  113. }
  114.  
  115. /* __zmlt__ scalar complex multiply array c.f. sv_mlt() */
  116. void    _ 0; j < H->m; j++ )
  117.             tmp1->ve[j].re = tmp1->ve[j].im = 0.0;
  118.         tmp1->ve[i].re = 1.0;
  119.         
  120.         /* apply H/h transforms in reverse order */
  121.         for ( j = limit-1; j >= 0; j-- )
  122.         {
  123.             zget_col(HQ,j,tmp2);
  124.             r_ii = zabs(tmp2->ve[j+1]);
  125.             tmp2->ve[j+1] = diag->ve[j];
  126.             tmp_val = (r_ii*zabs(diag->ve[j]));
  127.             beta = ( tmp_val == 0.0 ) ? 0.0 : 1.0/tmp_val;
  128.             /* printf("zHQunpack: j = %d, beta = %g, tmp2 =\n",
  129.                j,beta);
  130.             zv_output(tmp2); */
  131.             zhhtrvec(tmp2,beta,j+1,tmp1,tmp1);
  132.         }
  133.         
  134.         /* insert into Q */
  135.         zset_col(Q,i,tmp1);
  136.         }
  137.     }
  138.  
  139.     if ( H != ZMNULL )
  140.     {
  141.         H = zm_copy(HQ,H);
  142.         
  143.         limit = H->m;
  144.         for ( i = 1; i < limit; i++ )
  145.         for ( j = 0; j < i-1; j++ )
  146.             H->me[i][j].re = H->me[i][j].im = 0.0;
  147.     }
  148.  
  149.     return HQ;
  150. }
  151.  
  152.  
  153.  
  154. FileDataŵzhsehldr†EÿÿÿLmBTF
  155. /**************************************************************************
  156. **
  157. ** Copyright (C) 1993 David E. Steward & Zbigniew Leyk, all rights reserved.
  158. **
  159. **                 Meschach Library
  160. ** 
  161. ** This Meschach Library is provided "as is" without any express 
  162. ** or implied warranty of any kind with respect to this software. 
  163. ** In particular the authors shall not be l