You can not select more than 25 topics Topics must start with a letter or number, can include dashes ('-') and can be up to 35 characters long.

210 lines
7.3 KiB

  1. // This file is part of Eigen, a lightweight C++ template library
  2. // for linear algebra.
  3. //
  4. // Copyright (C) 2009-2010 Gael Guennebaud <gael.guennebaud@inria.fr>
  5. //
  6. // This Source Code Form is subject to the terms of the Mozilla
  7. // Public License v. 2.0. If a copy of the MPL was not distributed
  8. // with this file, You can obtain one at http://mozilla.org/MPL/2.0/.
  9. #include "common.h"
  10. // y = alpha*A*x + beta*y
  11. int EIGEN_BLAS_FUNC(symv) (char *uplo, int *n, RealScalar *palpha, RealScalar *pa, int *lda, RealScalar *px, int *incx, RealScalar *pbeta, RealScalar *py, int *incy)
  12. {
  13. Scalar* a = reinterpret_cast<Scalar*>(pa);
  14. Scalar* x = reinterpret_cast<Scalar*>(px);
  15. Scalar* y = reinterpret_cast<Scalar*>(py);
  16. Scalar alpha = *reinterpret_cast<Scalar*>(palpha);
  17. Scalar beta = *reinterpret_cast<Scalar*>(pbeta);
  18. // check arguments
  19. int info = 0;
  20. if(UPLO(*uplo)==INVALID) info = 1;
  21. else if(*n<0) info = 2;
  22. else if(*lda<std::max(1,*n)) info = 5;
  23. else if(*incx==0) info = 7;
  24. else if(*incy==0) info = 10;
  25. if(info)
  26. return xerbla_(SCALAR_SUFFIX_UP"SYMV ",&info,6);
  27. if(*n==0)
  28. return 0;
  29. Scalar* actual_x = get_compact_vector(x,*n,*incx);
  30. Scalar* actual_y = get_compact_vector(y,*n,*incy);
  31. if(beta!=Scalar(1))
  32. {
  33. if(beta==Scalar(0)) vector(actual_y, *n).setZero();
  34. else vector(actual_y, *n) *= beta;
  35. }
  36. // TODO performs a direct call to the underlying implementation function
  37. if(UPLO(*uplo)==UP) vector(actual_y,*n).noalias() += matrix(a,*n,*n,*lda).selfadjointView<Upper>() * (alpha * vector(actual_x,*n));
  38. else if(UPLO(*uplo)==LO) vector(actual_y,*n).noalias() += matrix(a,*n,*n,*lda).selfadjointView<Lower>() * (alpha * vector(actual_x,*n));
  39. if(actual_x!=x) delete[] actual_x;
  40. if(actual_y!=y) delete[] copy_back(actual_y,y,*n,*incy);
  41. return 1;
  42. }
  43. // C := alpha*x*x' + C
  44. int EIGEN_BLAS_FUNC(syr)(char *uplo, int *n, RealScalar *palpha, RealScalar *px, int *incx, RealScalar *pc, int *ldc)
  45. {
  46. // typedef void (*functype)(int, const Scalar *, int, Scalar *, int, Scalar);
  47. // static functype func[2];
  48. // static bool init = false;
  49. // if(!init)
  50. // {
  51. // for(int k=0; k<2; ++k)
  52. // func[k] = 0;
  53. //
  54. // func[UP] = (internal::selfadjoint_product<Scalar,ColMajor,ColMajor,false,UpperTriangular>::run);
  55. // func[LO] = (internal::selfadjoint_product<Scalar,ColMajor,ColMajor,false,LowerTriangular>::run);
  56. // init = true;
  57. // }
  58. Scalar* x = reinterpret_cast<Scalar*>(px);
  59. Scalar* c = reinterpret_cast<Scalar*>(pc);
  60. Scalar alpha = *reinterpret_cast<Scalar*>(palpha);
  61. int info = 0;
  62. if(UPLO(*uplo)==INVALID) info = 1;
  63. else if(*n<0) info = 2;
  64. else if(*incx==0) info = 5;
  65. else if(*ldc<std::max(1,*n)) info = 7;
  66. if(info)
  67. return xerbla_(SCALAR_SUFFIX_UP"SYR ",&info,6);
  68. if(*n==0 || alpha==Scalar(0)) return 1;
  69. // if the increment is not 1, let's copy it to a temporary vector to enable vectorization
  70. Scalar* x_cpy = get_compact_vector(x,*n,*incx);
  71. Matrix<Scalar,Dynamic,Dynamic> m2(matrix(c,*n,*n,*ldc));
  72. // TODO check why this is not accurate enough for lapack tests
  73. // if(UPLO(*uplo)==LO) matrix(c,*n,*n,*ldc).selfadjointView<Lower>().rankUpdate(vector(x_cpy,*n), alpha);
  74. // else if(UPLO(*uplo)==UP) matrix(c,*n,*n,*ldc).selfadjointView<Upper>().rankUpdate(vector(x_cpy,*n), alpha);
  75. if(UPLO(*uplo)==LO)
  76. for(int j=0;j<*n;++j)
  77. matrix(c,*n,*n,*ldc).col(j).tail(*n-j) += alpha * x_cpy[j] * vector(x_cpy+j,*n-j);
  78. else
  79. for(int j=0;j<*n;++j)
  80. matrix(c,*n,*n,*ldc).col(j).head(j+1) += alpha * x_cpy[j] * vector(x_cpy,j+1);
  81. if(x_cpy!=x) delete[] x_cpy;
  82. return 1;
  83. }
  84. // C := alpha*x*y' + alpha*y*x' + C
  85. int EIGEN_BLAS_FUNC(syr2)(char *uplo, int *n, RealScalar *palpha, RealScalar *px, int *incx, RealScalar *py, int *incy, RealScalar *pc, int *ldc)
  86. {
  87. // typedef void (*functype)(int, const Scalar *, int, const Scalar *, int, Scalar *, int, Scalar);
  88. // static functype func[2];
  89. //
  90. // static bool init = false;
  91. // if(!init)
  92. // {
  93. // for(int k=0; k<2; ++k)
  94. // func[k] = 0;
  95. //
  96. // func[UP] = (internal::selfadjoint_product<Scalar,ColMajor,ColMajor,false,UpperTriangular>::run);
  97. // func[LO] = (internal::selfadjoint_product<Scalar,ColMajor,ColMajor,false,LowerTriangular>::run);
  98. //
  99. // init = true;
  100. // }
  101. Scalar* x = reinterpret_cast<Scalar*>(px);
  102. Scalar* y = reinterpret_cast<Scalar*>(py);
  103. Scalar* c = reinterpret_cast<Scalar*>(pc);
  104. Scalar alpha = *reinterpret_cast<Scalar*>(palpha);
  105. int info = 0;
  106. if(UPLO(*uplo)==INVALID) info = 1;
  107. else if(*n<0) info = 2;
  108. else if(*incx==0) info = 5;
  109. else if(*incy==0) info = 7;
  110. else if(*ldc<std::max(1,*n)) info = 9;
  111. if(info)
  112. return xerbla_(SCALAR_SUFFIX_UP"SYR2 ",&info,6);
  113. if(alpha==Scalar(0))
  114. return 1;
  115. Scalar* x_cpy = get_compact_vector(x,*n,*incx);
  116. Scalar* y_cpy = get_compact_vector(y,*n,*incy);
  117. // TODO perform direct calls to underlying implementation
  118. if(UPLO(*uplo)==LO) matrix(c,*n,*n,*ldc).selfadjointView<Lower>().rankUpdate(vector(x_cpy,*n), vector(y_cpy,*n), alpha);
  119. else if(UPLO(*uplo)==UP) matrix(c,*n,*n,*ldc).selfadjointView<Upper>().rankUpdate(vector(x_cpy,*n), vector(y_cpy,*n), alpha);
  120. if(x_cpy!=x) delete[] x_cpy;
  121. if(y_cpy!=y) delete[] y_cpy;
  122. // int code = UPLO(*uplo);
  123. // if(code>=2 || func[code]==0)
  124. // return 0;
  125. // func[code](*n, a, *inca, b, *incb, c, *ldc, alpha);
  126. return 1;
  127. }
  128. /** DSBMV performs the matrix-vector operation
  129. *
  130. * y := alpha*A*x + beta*y,
  131. *
  132. * where alpha and beta are scalars, x and y are n element vectors and
  133. * A is an n by n symmetric band matrix, with k super-diagonals.
  134. */
  135. // int EIGEN_BLAS_FUNC(sbmv)( char *uplo, int *n, int *k, RealScalar *alpha, RealScalar *a, int *lda,
  136. // RealScalar *x, int *incx, RealScalar *beta, RealScalar *y, int *incy)
  137. // {
  138. // return 1;
  139. // }
  140. /** DSPMV performs the matrix-vector operation
  141. *
  142. * y := alpha*A*x + beta*y,
  143. *
  144. * where alpha and beta are scalars, x and y are n element vectors and
  145. * A is an n by n symmetric matrix, supplied in packed form.
  146. *
  147. */
  148. // int EIGEN_BLAS_FUNC(spmv)(char *uplo, int *n, RealScalar *alpha, RealScalar *ap, RealScalar *x, int *incx, RealScalar *beta, RealScalar *y, int *incy)
  149. // {
  150. // return 1;
  151. // }
  152. /** DSPR performs the symmetric rank 1 operation
  153. *
  154. * A := alpha*x*x' + A,
  155. *
  156. * where alpha is a real scalar, x is an n element vector and A is an
  157. * n by n symmetric matrix, supplied in packed form.
  158. */
  159. // int EIGEN_BLAS_FUNC(spr)(char *uplo, int *n, Scalar *alpha, Scalar *x, int *incx, Scalar *ap)
  160. // {
  161. // return 1;
  162. // }
  163. /** DSPR2 performs the symmetric rank 2 operation
  164. *
  165. * A := alpha*x*y' + alpha*y*x' + A,
  166. *
  167. * where alpha is a scalar, x and y are n element vectors and A is an
  168. * n by n symmetric matrix, supplied in packed form.
  169. */
  170. // int EIGEN_BLAS_FUNC(spr2)(char *uplo, int *n, RealScalar *alpha, RealScalar *x, int *incx, RealScalar *y, int *incy, RealScalar *ap)
  171. // {
  172. // return 1;
  173. // }