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_LEVEL1_ROT_TCC
 34 #define CXXBLAS_LEVEL1_ROT_TCC 1
 35 
 36 #include <cmath>
 37 
 38 namespace cxxblas {
 39 
 40 template <typename IndexType, typename X, typename Y, typename T>
 41 void
 42 rot_generic(IndexType n, X *x, IndexType incX, Y *y, IndexType incY, T c, T s)
 43 {
 44     CXXBLAS_DEBUG_OUT("rot_generic");
 45 
 46     for (IndexType i=0, iX=0, iY=0; i<n; ++i, iX+=incX, iY+=incY) {
 47         X _x =  c*x[iX] + s*y[iY];
 48         Y _y = -s*x[iX] + c*y[iY];
 49         x[iX] = _x;
 50         y[iY] = _y;
 51     }
 52 }
 53 
 54 template <typename IndexType, typename X, typename Y, typename T>
 55 void
 56 rot(IndexType n, X *x, IndexType incX, Y *y, IndexType incY, T c, T s)
 57 {
 58     if (incX<0) {
 59         x -= incX*(n-1);
 60     }
 61     if (incY<0) {
 62         y -= incY*(n-1);
 63     }
 64     rot_generic(n, x, incX, y, incY, c, s);
 65 }
 66 
 67 template <typename A, typename B, typename T>
 68 void
 69 rotg(A &a, B &b, T &c, T &s)
 70 {
 71     CXXBLAS_DEBUG_OUT("rotg (generic)");
 72 
 73     using std::abs;
 74     using std::sqrt;
 75 
 76     A absA = abs(a);
 77     B absB = abs(b);
 78 
 79     T scale = absA + absB;
 80     T roe = (absA > absB) ? a : b;
 81     if (scale==0) {
 82         c = 1;
 83         s = 0;
 84         a = 0;
 85         b = 0;
 86         return;
 87     }
 88     A aScaled = absA / scale;
 89     B bScaled = absB / scale;
 90     T r = scale*sqrt(aScaled*aScaled + bScaled*bScaled);
 91     if (roe<0) {
 92         r = -r;
 93     }
 94     c = a / r;
 95     s = b / r;
 96 
 97     B z = 1;
 98     if (absA > absB) {
 99         z = s;
100     }
101     if ((absA < absB) && (c != 0)) {
102         z = T(1)/c;
103     }
104     a = r;
105     b = z;
106 }
107 
108 #ifdef HAVE_CBLAS
109 // srot
110 template <typename IndexType>
111 typename If<IndexType>::isBlasCompatibleInteger
112 rot(IndexType n, float *x, IndexType incX, float *y, IndexType incY,
113     float c, float s)
114 {
115     CXXBLAS_DEBUG_OUT("[" BLAS_IMPL "] cblas_srot");
116 
117     cblas_srot(n, x, incX, y, incY, c, s);
118 }
119 
120 // drot
121 template <typename IndexType>
122 typename If<IndexType>::isBlasCompatibleInteger
123 rot(IndexType n, double *x, IndexType incX, double *y, IndexType incY,
124     double c, double s)
125 {
126     CXXBLAS_DEBUG_OUT("[" BLAS_IMPL "] cblas_drot");
127 
128     cblas_drot(n, x, incX, y, incY, c, s);
129 }
130 
131 // srotg
132 template <typename IndexType>
133 typename If<IndexType>::isBlasCompatibleInteger
134 rotg(float &a, float &b, float &c, float &s)
135 {
136     CXXBLAS_DEBUG_OUT("[" BLAS_IMPL "] cblas_srotg");
137 
138     cblas_srotg(&a, &b, &c, &s);
139 }
140 
141 // drotg
142 template <typename IndexType>
143 typename If<IndexType>::isBlasCompatibleInteger
144 rotg(double &a, double &b, double &c, double &s)
145 {
146     CXXBLAS_DEBUG_OUT("[" BLAS_IMPL "] cblas_drotg");
147 
148     cblas_drotg(&a, &b, &c, &s);
149 }
150 
151 #endif // HAVE_CBLAS
152 
153 // namespace cxxblas
154 
155 #endif // CXXBLAS_LEVEL1_ROT_TCC