htswanalysis/MACS/lib/gsl/gsl-1.11/cblas/source_hpr.h

   1 /* blas/source_hpr.h
   2  *
   3  * Copyright (C) 1996, 1997, 1998, 1999, 2000 Gerard Jungman
   4  *
   5  * This program is free software; you can redistribute it and/or modify
   6  * it under the terms of the GNU General Public License as published by
   7  * the Free Software Foundation; either version 3 of the License, or (at
   8  * your option) any later version.
   9  *
  10  * This program is distributed in the hope that it will be useful, but
  11  * WITHOUT ANY WARRANTY; without even the implied warranty of
  12  * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the GNU
  13  * General Public License for more details.
  14  *
  15  * You should have received a copy of the GNU General Public License
  16  * along with this program; if not, write to the Free Software
  17  * Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301, USA.
  18  */
  19
  20 {
  21   const int conj = (order == CblasColMajor) ? -1 : 1;
  22   INDEX i, j;
  23
  24   if (alpha == 0.0)
  25     return;
  26
  27   if ((order == CblasRowMajor && Uplo == CblasUpper)
  28       || (order == CblasColMajor && Uplo == CblasLower)) {
  29     INDEX ix = OFFSET(N, incX);
  30     for (i = 0; i < N; i++) {
  31       const BASE tmp_real = alpha * CONST_REAL(X, ix);
  32       const BASE tmp_imag = alpha * conj * CONST_IMAG(X, ix);
  33       INDEX jx = ix;
  34
  35       {
  36         const BASE X_real = CONST_REAL(X, jx);
  37         const BASE X_imag = -conj * CONST_IMAG(X, jx);
  38         REAL(Ap, TPUP(N, i, i)) += X_real * tmp_real - X_imag * tmp_imag;
  39         IMAG(Ap, TPUP(N, i, i)) = 0;
  40         jx += incX;
  41       }
  42
  43       for (j = i + 1; j < N; j++) {
  44         const BASE X_real = CONST_REAL(X, jx);
  45         const BASE X_imag = -conj * CONST_IMAG(X, jx);
  46         REAL(Ap, TPUP(N, i, j)) += X_real * tmp_real - X_imag * tmp_imag;
  47         IMAG(Ap, TPUP(N, i, j)) += X_imag * tmp_real + X_real * tmp_imag;
  48         jx += incX;
  49       }
  50       ix += incX;
  51     }
  52   } else if ((order == CblasRowMajor && Uplo == CblasLower)
  53              || (order == CblasColMajor && Uplo == CblasUpper)) {
  54     INDEX ix = OFFSET(N, incX);
  55     for (i = 0; i < N; i++) {
  56       const BASE tmp_real = alpha * CONST_REAL(X, ix);
  57       const BASE tmp_imag = alpha * conj * CONST_IMAG(X, ix);
  58       INDEX jx = OFFSET(N, incX);
  59       for (j = 0; j < i; j++) {
  60         const BASE X_real = CONST_REAL(X, jx);
  61         const BASE X_imag = -conj * CONST_IMAG(X, jx);
  62         REAL(Ap, TPLO(N, i, j)) += X_real * tmp_real - X_imag * tmp_imag;
  63         IMAG(Ap, TPLO(N, i, j)) += X_imag * tmp_real + X_real * tmp_imag;
  64         jx += incX;
  65       }
  66
  67       {
  68         const BASE X_real = CONST_REAL(X, jx);
  69         const BASE X_imag = -conj * CONST_IMAG(X, jx);
  70         REAL(Ap, TPLO(N, i, i)) += X_real * tmp_real - X_imag * tmp_imag;
  71         IMAG(Ap, TPLO(N, i, i)) = 0;
  72         jx += incX;
  73       }
  74
  75       ix += incX;
  76     }
  77   } else {
  78     BLAS_ERROR("unrecognized operation");
  79   }
  80 }