zmachine.c 4.8 KB

123456789101112131415161718192021222324252627282930313233343536373839404142434445464748495051525354555657585960616263646566676869707172737475767778798081828384858687888990919293949596979899100101102103104105106107108109110111112113114115116117118119120121122123124125126127128129130131132133134135136137138139140141142143144145146147148149150151152153154155156157158159160161162163164165166167168169170171172173174175176177178179180181182183184185186187188189190191192193194195196197198199200201202203
  1. /**************************************************************************
  2. **
  3. ** Copyright (C) 1993 David E. Steward & Zbigniew Leyk, all rights reserved.
  4. **
  5. ** Meschach Library
  6. **
  7. ** This Meschach Library is provided "as is" without any express
  8. ** or implied warranty of any kind with respect to this software.
  9. ** In particular the authors shall not be liable for any direct,
  10. ** indirect, special, incidental or consequential damages arising
  11. ** in any way from use of the software.
  12. **
  13. ** Everyone is granted permission to copy, modify and redistribute this
  14. ** Meschach Library, provided:
  15. ** 1. All copies contain this copyright notice.
  16. ** 2. All modified copies shall carry a notice stating who
  17. ** made the last modification and the date of such modification.
  18. ** 3. No charge is made for this software or works derived from it.
  19. ** This clause shall not be construed as constraining other software
  20. ** distributed on the same medium as this software, nor is a
  21. ** distribution fee considered a charge.
  22. **
  23. ***************************************************************************/
  24. /*
  25. This file contains basic routines which are used by the functions
  26. involving complex vectors.
  27. These are the routines that should be modified in order to take
  28. full advantage of specialised architectures (pipelining, vector
  29. processors etc).
  30. */
  31. static char *rcsid = "$Id: zmachine.c,v 1.1 1994/01/13 04:25:41 des Exp $";
  32. #include <math.h>
  33. #include "machine.h"
  34. #include "zmatrix.h"
  35. /* __zconj__ -- complex conjugate */
  36. #ifndef ANSI_C
  37. void __zconj__(zp,len)
  38. complex *zp;
  39. int len;
  40. #else
  41. void __zconj__(complex zp[], int len)
  42. #endif
  43. {
  44. int i;
  45. for ( i = 0; i < len; i++ )
  46. zp[i].im = - zp[i].im;
  47. }
  48. /* __zip__ -- inner product
  49. -- computes sum_i zp1[i].zp2[i] if flag == 0
  50. sum_i zp1[i]*.zp2[i] if flag != 0 */
  51. #ifndef ANSI_C
  52. complex __zip__(zp1,zp2,len,flag)
  53. complex *zp1, *zp2;
  54. int flag, len;
  55. #else
  56. complex __zip__(const complex *zp1, const complex *zp2, int len, int flag)
  57. #endif
  58. {
  59. complex sum;
  60. int i;
  61. sum.re = sum.im = 0.0;
  62. if ( flag )
  63. {
  64. for ( i = 0; i < len; i++ )
  65. {
  66. sum.re += zp1[i].re*zp2[i].re + zp1[i].im*zp2[i].im;
  67. sum.im += zp1[i].re*zp2[i].im - zp1[i].im*zp2[i].re;
  68. }
  69. }
  70. else
  71. {
  72. for ( i = 0; i < len; i++ )
  73. {
  74. sum.re += zp1[i].re*zp2[i].re - zp1[i].im*zp2[i].im;
  75. sum.im += zp1[i].re*zp2[i].im + zp1[i].im*zp2[i].re;
  76. }
  77. }
  78. return sum;
  79. }
  80. /* __zmltadd__ -- scalar multiply and add i.e. complex saxpy
  81. -- computes zp1[i] += s.zp2[i] if flag == 0
  82. -- computes zp1[i] += s.zp2[i]* if flag != 0 */
  83. #ifndef ANSI_C
  84. void __zmltadd__(zp1,zp2,s,len,flag)
  85. complex *zp1, *zp2, s;
  86. int flag, len;
  87. #else
  88. void __zmltadd__(complex *zp1, const complex *zp2, complex s,
  89. int len, int flag)
  90. #endif
  91. {
  92. int i;
  93. LongReal t_re, t_im;
  94. if ( ! flag )
  95. {
  96. for ( i = 0; i < len; i++ )
  97. {
  98. t_re = zp1[i].re + s.re*zp2[i].re - s.im*zp2[i].im;
  99. t_im = zp1[i].im + s.re*zp2[i].im + s.im*zp2[i].re;
  100. zp1[i].re = t_re;
  101. zp1[i].im = t_im;
  102. }
  103. }
  104. else
  105. {
  106. for ( i = 0; i < len; i++ )
  107. {
  108. t_re = zp1[i].re + s.re*zp2[i].re + s.im*zp2[i].im;
  109. t_im = zp1[i].im - s.re*zp2[i].im + s.im*zp2[i].re;
  110. zp1[i].re = t_re;
  111. zp1[i].im = t_im;
  112. }
  113. }
  114. }
  115. /* __zmlt__ scalar complex multiply array c.f. sv_mlt() */
  116. #ifndef ANSI_C
  117. void __zmlt__(zp,s,out,len)
  118. complex *zp, s, *out;
  119. register int len;
  120. #else
  121. void __zmlt__(const complex *zp, complex s, complex *out, int len)
  122. #endif
  123. {
  124. int i;
  125. LongReal t_re, t_im;
  126. for ( i = 0; i < len; i++ )
  127. {
  128. t_re = s.re*zp[i].re - s.im*zp[i].im;
  129. t_im = s.re*zp[i].im + s.im*zp[i].re;
  130. out[i].re = t_re;
  131. out[i].im = t_im;
  132. }
  133. }
  134. /* __zadd__ -- add complex arrays c.f. v_add() */
  135. #ifndef ANSI_C
  136. void __zadd__(zp1,zp2,out,len)
  137. complex *zp1, *zp2, *out;
  138. int len;
  139. #else
  140. void __zadd__(const complex *zp1, const complex *zp2, complex *out, int len)
  141. #endif
  142. {
  143. int i;
  144. for ( i = 0; i < len; i++ )
  145. {
  146. out[i].re = zp1[i].re + zp2[i].re;
  147. out[i].im = zp1[i].im + zp2[i].im;
  148. }
  149. }
  150. /* __zsub__ -- subtract complex arrays c.f. v_sub() */
  151. #ifndef ANSI_C
  152. void __zsub__(zp1,zp2,out,len)
  153. complex *zp1, *zp2, *out;
  154. int len;
  155. #else
  156. void __zsub__(const complex *zp1, const complex *zp2, complex *out, int len)
  157. #endif
  158. {
  159. int i;
  160. for ( i = 0; i < len; i++ )
  161. {
  162. out[i].re = zp1[i].re - zp2[i].re;
  163. out[i].im = zp1[i].im - zp2[i].im;
  164. }
  165. }
  166. /* __zzero__ -- zeros an array of complex numbers */
  167. #ifndef ANSI_C
  168. void __zzero__(zp,len)
  169. complex *zp;
  170. int len;
  171. #else
  172. void __zzero__(complex *zp, int len)
  173. #endif
  174. {
  175. /* if a Real precision zero is equivalent to a string of nulls */
  176. MEM_ZERO((char *)zp,len*sizeof(complex));
  177. /* else, need to zero the array entry by entry */
  178. /******************************
  179. while ( len-- )
  180. {
  181. zp->re = zp->im = 0.0;
  182. zp++;
  183. }
  184. ******************************/
  185. }