1 /*
  2  *   Copyright (c) 2009, Michael Lehn
  3  *
  4  *   All rights reserved.
  5  *
  6  *   Redistribution and use in source and binary forms, with or without
  7  *   modification, are permitted provided that the following conditions
  8  *   are met:
  9  *
 10  *   1) Redistributions of source code must retain the above copyright
 11  *      notice, this list of conditions and the following disclaimer.
 12  *   2) Redistributions in binary form must reproduce the above copyright
 13  *      notice, this list of conditions and the following disclaimer in
 14  *      the documentation and/or other materials provided with the
 15  *      distribution.
 16  *   3) Neither the name of the FLENS development group nor the names of
 17  *      its contributors may be used to endorse or promote products derived
 18  *      from this software without specific prior written permission.
 19  *
 20  *   THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS
 21  *   "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT
 22  *   LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR
 23  *   A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT
 24  *   OWNER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL,
 25  *   SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT
 26  *   LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE,
 27  *   DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY
 28  *   THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT
 29  *   (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE
 30  *   OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.
 31  */
 32 
 33 #ifndef CXXBLAS_LEVEL2_HPR_TCC
 34 #define CXXBLAS_LEVEL2_HPR_TCC 1
 35 
 36 #include <complex>
 37 #include <cxxblas/level1/level1.h>
 38 
 39 namespace cxxblas {
 40 
 41 template <typename IndexType, typename ALPHA, typename VX, typename MA>
 42 void
 43 hpr_generic(StorageOrder order, StorageUpLo upLo, Transpose conjugateA,
 44             IndexType n,
 45             const ALPHA &alpha,
 46             const VX *x, IndexType incX,
 47             MA *A)
 48 {
 49     if (alpha==ALPHA(0)) {
 50         return;
 51     }
 52     if (order==ColMajor) {
 53         upLo = (upLo==Upper) ? Lower : Upper;
 54         conjugateA = Transpose(conjugateA^Conj);
 55     }
 56     #ifdef CXXBLAS_USE_XERBLA
 57         // insert error check here
 58     #endif
 59     if (upLo==Upper) {
 60         if (conjugateA==Conj) {
 61             for (IndexType i=0, iX=0; i<n; ++i, iX+=incX) {
 62                 axpy_generic(n-i, alpha*conjugate(x[iX]),
 63                                   x+iX, incX,
 64                                   A+i*(2*n-i+1)/2, IndexType(1));
 65             }
 66         } else {
 67             for (IndexType i=0, iX=0; i<n; ++i, iX+=incX) {
 68                 acxpy_generic(n-i, alpha*x[iX],
 69                                    x+iX, incX,
 70                                    A+i*(2*n-i+1)/2, IndexType(1));
 71             }
 72         }
 73         for (IndexType i=0; i<n; ++i) {
 74             A[i+i*(2*n-i-1)/2] = cxxblas::real(A[i+i*(2*n-i-1)/2]);
 75         }
 76     } else {
 77         if (conjugateA==Conj) {
 78             for (IndexType i=0, iX=0; i<n; ++i, iX+=incX) {
 79                 axpy_generic(i+1, alpha*conjugate(x[iX]),
 80                                   x, incX,
 81                                   A+i*(i+1)/2, IndexType(1));
 82             }
 83         } else {
 84             for (IndexType i=0, iX=0; i<n; ++i, iX+=incX) {
 85                 acxpy_generic(i+1, alpha*x[iX],
 86                                    x, incX,
 87                                    A+i*(i+1)/2, IndexType(1));
 88             }
 89         }
 90         for (IndexType i=0; i<n; ++i) {
 91             A[i+i*(i+1)/2] = cxxblas::real(A[i+i*(i+1)/2]);
 92         }
 93     }
 94 }
 95 
 96 template <typename IndexType, typename ALPHA, typename VX, typename MA>
 97 void
 98 hpr(StorageOrder order, StorageUpLo upLo,
 99     IndexType n,
100     const ALPHA &alpha,
101     const VX *x, IndexType incX,
102     MA *A)
103 {
104     CXXBLAS_DEBUG_OUT("hpr_generic");
105 
106     if (incX<0) {
107         x -= incX*(n-1);
108     }
109     hpr_generic(order, upLo, NoTrans, n, alpha, x, incX, A);
110 }
111 
112 // namespace cxxblas
113 
114 #endif // CXXBLAS_LEVEL2_HPR_TCC