include make.conf
include $(MAKEINC)
-LIB = dot-lib sum-lib axpby-lib waxpby-lib gemv-lib ge_sum_mv-lib gbmv-lib symv-lib spmv-lib sbmv-lib hemv-lib hpmv-lib hbmv-lib trmv-lib tpmv-lib trsv-lib tbsv-lib gemm-lib symm-lib hemm-lib gemv2-lib symv2-lib
-TESTS = dot-test sum-test axpby-test waxpby-test gemv-test ge_sum_mv-test gbmv-test symv-test spmv-test sbmv-test hemv-test hpmv-test hbmv-test trmv-test tpmv-test trsv-test tbsv-test gemm-test symm-test hemm-test gemv2-test symv2-test
-TEST_LIB = dot-test-lib sum-test-lib axpby-test-lib waxpby-test-lib gemv-test-lib ge_sum_mv-test-lib gbmv-test-lib symv-test-lib spmv-test-lib sbmv-test-lib hemv-test-lib hpmv-test-lib hbmv-test-lib trmv-test-lib tpmv-test-lib trsv-test-lib tbsv-test-lib gemm-test-lib symm-test-lib hemm-test-lib gemv2-test-lib symv2-test-lib
-CLEAN = dot-clean sum-clean axpby-clean waxpby-clean gemv-clean ge_sum_mv-clean gbmv-clean symv-clean spmv-clean sbmv-clean hemv-clean hpmv-clean hbmv-clean trmv-clean tpmv-clean trsv-clean tbsv-clean gemm-clean symm-clean hemm-clean gemv2-clean symv2-clean dot2-clean
+LIB = dot-lib sum-lib axpby-lib waxpby-lib gemv-lib ge_sum_mv-lib gbmv-lib symv-lib spmv-lib sbmv-lib hemv-lib hpmv-lib hbmv-lib trmv-lib tpmv-lib trsv-lib tbsv-lib gemm-lib symm-lib hemm-lib gemv2-lib symv2-lib hemv2-lib
+TESTS = dot-test sum-test axpby-test waxpby-test gemv-test ge_sum_mv-test gbmv-test symv-test spmv-test sbmv-test hemv-test hpmv-test hbmv-test trmv-test tpmv-test trsv-test tbsv-test gemm-test symm-test hemm-test gemv2-test symv2-test hemv2-test
+TEST_LIB = dot-test-lib sum-test-lib axpby-test-lib waxpby-test-lib gemv-test-lib ge_sum_mv-test-lib gbmv-test-lib symv-test-lib spmv-test-lib sbmv-test-lib hemv-test-lib hpmv-test-lib hbmv-test-lib trmv-test-lib tpmv-test-lib trsv-test-lib tbsv-test-lib gemm-test-lib symm-test-lib hemm-test-lib gemv2-test-lib symv2-test-lib hemv2-test-lib
+CLEAN = dot-clean sum-clean axpby-clean waxpby-clean gemv-clean ge_sum_mv-clean gbmv-clean symv-clean spmv-clean sbmv-clean hemv-clean hpmv-clean hbmv-clean trmv-clean tpmv-clean trsv-clean tbsv-clean gemm-clean symm-clean hemm-clean gemv2-clean symv2-clean hemv2-clean dot2-clean
SRC_DIR = src
TEST_DIR = testing
cat $(TEST_DIR)/test-hemm/hemm.results >> testall.result
cat $(TEST_DIR)/test-gemv2/gemv2.results >> testall.result
cat $(TEST_DIR)/test-symv2/symv2.results >> testall.result
+ cat $(TEST_DIR)/test-hemv2/hemv2.results >> testall.result
grep 'FAIL/TOTAL' testall.result >testall.summary
cat testall.summary
cd $(SRC_DIR)/hemm && $(MAKE) lib
cd $(SRC_DIR)/gemv2 && $(MAKE) lib
cd $(SRC_DIR)/symv2 && $(MAKE) lib
+ cd $(SRC_DIR)/hemv2 && $(MAKE) lib
# custom test-dot2 stuff
cd $(TEST_DIR)/test-symv2 && $(MAKE) clean
+# hemv2 stuff
+
+hemv2: hemv2-test
+
+
+hemv2-lib: common-lib
+ cd $(SRC_DIR)/hemv2 && $(MAKE)
+
+hemv2-test-lib: lib common-test-lib
+ cd $(TEST_DIR)/test-hemv2 && $(MAKE) do_test_hemv2
+
+hemv2-test: hemv2-test-lib
+ cd $(TEST_DIR)/test-hemv2 && $(MAKE)
+
+hemv2-clean:
+ cd $(SRC_DIR)/hemv2 && $(MAKE) clean
+ cd $(TEST_DIR)/test-hemv2 && $(MAKE) clean
+
+
# Test library dependencies
sum-test-lib: dot-test-lib
enum blas_prec_type prec);
+void BLAS_zhemv2_z_c(enum blas_order_type order, enum blas_uplo_type uplo,
+ int n, const void *alpha, const void *a, int lda,
+ const void *x_head, const void *x_tail, int incx,
+ const void *beta, const void *y, int incy);
+void BLAS_zhemv2_c_z(enum blas_order_type order, enum blas_uplo_type uplo,
+ int n, const void *alpha, const void *a, int lda,
+ const void *x_head, const void *x_tail, int incx,
+ const void *beta, const void *y, int incy);
+void BLAS_zhemv2_c_c(enum blas_order_type order, enum blas_uplo_type uplo,
+ int n, const void *alpha, const void *a, int lda,
+ const void *x_head, const void *x_tail, int incx,
+ const void *beta, const void *y, int incy);
+void BLAS_chemv2_c_s(enum blas_order_type order, enum blas_uplo_type uplo,
+ int n, const void *alpha, const void *a, int lda,
+ const float *x_head, const float *x_tail, int incx,
+ const void *beta, const float *y, int incy);
+void BLAS_zhemv2_z_d(enum blas_order_type order, enum blas_uplo_type uplo,
+ int n, const void *alpha, const void *a, int lda,
+ const double *x_head, const double *x_tail, int incx,
+ const void *beta, const double *y, int incy);
+void BLAS_chemv2_x(enum blas_order_type order, enum blas_uplo_type uplo,
+ int n, const void *alpha, const void *a, int lda,
+ const void *x_head, const void *x_tail, int incx,
+ const void *beta, const void *y, int incy,
+ enum blas_prec_type prec);
+void BLAS_zhemv2_x(enum blas_order_type order, enum blas_uplo_type uplo,
+ int n, const void *alpha, const void *a, int lda,
+ const void *x_head, const void *x_tail, int incx,
+ const void *beta, const void *y, int incy,
+ enum blas_prec_type prec);
+void BLAS_zhemv2_z_c_x(enum blas_order_type order, enum blas_uplo_type uplo,
+ int n, const void *alpha, const void *a, int lda,
+ const void *x_head, const void *x_tail, int incx,
+ const void *beta, const void *y, int incy,
+ enum blas_prec_type prec);
+void BLAS_zhemv2_c_z_x(enum blas_order_type order, enum blas_uplo_type uplo,
+ int n, const void *alpha, const void *a, int lda,
+ const void *x_head, const void *x_tail, int incx,
+ const void *beta, const void *y, int incy,
+ enum blas_prec_type prec);
+void BLAS_zhemv2_c_c_x(enum blas_order_type order, enum blas_uplo_type uplo,
+ int n, const void *alpha, const void *a, int lda,
+ const void *x_head, const void *x_tail, int incx,
+ const void *beta, const void *y, int incy,
+ enum blas_prec_type prec);
+void BLAS_chemv2_c_s_x(enum blas_order_type order, enum blas_uplo_type uplo,
+ int n, const void *alpha, const void *a, int lda,
+ const float *x_head, const float *x_tail, int incx,
+ const void *beta, const float *y, int incy,
+ enum blas_prec_type prec);
+void BLAS_zhemv2_z_d_x(enum blas_order_type order, enum blas_uplo_type uplo,
+ int n, const void *alpha, const void *a, int lda,
+ const double *x_head, const double *x_tail, int incx,
+ const void *beta, const double *y, int incy,
+ enum blas_prec_type prec);
+
+
int BLAS_fpinfo_x(enum blas_cmach_type cmach, enum blas_prec_type prec);
void BLAS_error(const char *rname, int iflag, int ival, char *form, ...);
--- /dev/null
+
+#include "f2c-bridge.h"
+#include "blas_enum.h"
+void BLAS_chemv2_c_s(enum blas_order_type order, enum blas_uplo_type uplo,
+ int n, const void *alpha, const void *a, int lda,
+ const float *x_head, const float *x_tail, int incx,
+ const void *beta, const float *y, int incy);
+
+
+extern void FC_FUNC_(blas_chemv2_c_s, BLAS_CHEMV2_C_S)
+
+ (int *uplo, int *n, const void *alpha, const void *a, int *lda,
+ const float *x_head, const float *x_tail, int *incx, const void *beta,
+ const float *y, int *incy) {
+ BLAS_chemv2_c_s(blas_colmajor, (enum blas_uplo_type) *uplo, *n, alpha, a,
+ *lda, x_head, x_tail, *incx, beta, y, *incy);
+}
--- /dev/null
+#include <blas_extended.h>
+#include <blas_extended_private.h>
+#include <blas_fpu.h>
+void BLAS_chemv2_c_s(enum blas_order_type order, enum blas_uplo_type uplo,
+ int n, const void *alpha, const void *a, int lda,
+ const float *x_head, const float *x_tail, int incx,
+ const void *beta, const float *y, int incy)
+
+/*
+ * Purpose
+ * =======
+ *
+ * This routines computes the matrix product:
+ *
+ * y <- alpha * A * (x_head + x_tail) + beta * y
+ *
+ * where A is a complex Hermitian matrix.
+ *
+ * Arguments
+ * =========
+ *
+ * order (input) enum blas_order_type
+ * Storage format of input symmetric matrix A.
+ *
+ * uplo (input) enum blas_uplo_type
+ * Determines which half of matrix A (upper or lower triangle)
+ * is accessed.
+ *
+ * n (input) int
+ * Dimension of A and size of vectors x, y.
+ *
+ * alpha (input) const void*
+ *
+ * a (input) void*
+ * Matrix A.
+ *
+ * lda (input) int
+ * Leading dimension of matrix A.
+ *
+ * x_head (input) float*
+ * Vector x_head
+ *
+ * x_tail (input) float*
+ * Vector x_tail
+ *
+ * incx (input) int
+ * Stride for vector x.
+ *
+ * beta (input) const void*
+ *
+ * y (input) float*
+ * Vector y.
+ *
+ * incy (input) int
+ * Stride for vector y.
+ *
+ */
+{
+ /* Routine name */
+ const char routine_name[] = "BLAS_chemv2_c_s";
+
+ int i, j;
+ int xi, yi, xi0, yi0;
+ int aij, ai;
+ int incai;
+ int incaij, incaij2;
+
+ const float *a_i = (float *) a;
+ const float *x_head_i = x_head;
+ const float *x_tail_i = x_tail;
+ float *y_i = (float *) y;
+ float *alpha_i = (float *) alpha;
+ float *beta_i = (float *) beta;
+ float a_elem[2];
+ float x_elem;
+ float y_elem[2];
+ float diag_elem;
+ float prod1[2];
+ float prod2[2];
+ float sum1[2];
+ float sum2[2];
+ float tmp1[2];
+ float tmp2[2];
+ float tmp3[2];
+
+
+
+ /* Test for no-op */
+ if (n <= 0) {
+ return;
+ }
+ if (alpha_i[0] == 0.0 && alpha_i[1] == 0.0
+ && (beta_i[0] == 1.0 && beta_i[1] == 0.0)) {
+ return;
+ }
+
+ /* Check for error conditions. */
+ if (n < 0) {
+ BLAS_error(routine_name, -3, n, NULL);
+ }
+ if (lda < n) {
+ BLAS_error(routine_name, -6, n, NULL);
+ }
+ if (incx == 0) {
+ BLAS_error(routine_name, -9, incx, NULL);
+ }
+ if (incy == 0) {
+ BLAS_error(routine_name, -12, incy, NULL);
+ }
+
+ if ((order == blas_colmajor && uplo == blas_upper) ||
+ (order == blas_rowmajor && uplo == blas_lower)) {
+ incai = lda;
+ incaij = 1;
+ incaij2 = lda;
+ } else {
+ incai = 1;
+ incaij = lda;
+ incaij2 = 1;
+ }
+
+
+ incy *= 2;
+ incai *= 2;
+ incaij *= 2;
+ incaij2 *= 2;
+ xi0 = (incx > 0) ? 0 : ((-n + 1) * incx);
+ yi0 = (incy > 0) ? 0 : ((-n + 1) * incy);
+
+
+
+ /* The most general form, y <--- alpha * A * (x_head + x_tail) + beta * y */
+ if (uplo == blas_lower) {
+ for (i = 0, yi = yi0, ai = 0; i < n; i++, yi += incy, ai += incai) {
+ sum1[0] = sum1[1] = 0.0;
+ sum2[0] = sum2[1] = 0.0;
+ for (j = 0, aij = ai, xi = xi0; j < i; j++, aij += incaij, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ x_elem = x_head_i[xi];
+ {
+ prod1[0] = a_elem[0] * x_elem;
+ prod1[1] = a_elem[1] * x_elem;
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem = x_tail_i[xi];
+ {
+ prod2[0] = a_elem[0] * x_elem;
+ prod2[1] = a_elem[1] * x_elem;
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+
+ diag_elem = a_i[aij];
+ x_elem = x_head_i[xi];
+ prod1[0] = x_elem * diag_elem;
+ prod1[1] = 0.0;
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem = x_tail_i[xi];
+ prod2[0] = x_elem * diag_elem;
+ prod2[1] = 0.0;
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ j++;
+ aij += incaij2;
+ xi += incx;
+
+ for (; j < n; j++, aij += incaij2, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ a_elem[1] = -a_elem[1];
+ x_elem = x_head_i[xi];
+ {
+ prod1[0] = a_elem[0] * x_elem;
+ prod1[1] = a_elem[1] * x_elem;
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem = x_tail_i[xi];
+ {
+ prod2[0] = a_elem[0] * x_elem;
+ prod2[1] = a_elem[1] * x_elem;
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+ sum1[0] = sum1[0] + sum2[0];
+ sum1[1] = sum1[1] + sum2[1];
+ {
+ tmp1[0] = sum1[0] * alpha_i[0] - sum1[1] * alpha_i[1];
+ tmp1[1] = sum1[0] * alpha_i[1] + sum1[1] * alpha_i[0];
+ }
+
+ y_elem[0] = y_i[yi];
+ y_elem[1] = y_i[yi + 1];
+ {
+ tmp2[0] = y_elem[0] * beta_i[0] - y_elem[1] * beta_i[1];
+ tmp2[1] = y_elem[0] * beta_i[1] + y_elem[1] * beta_i[0];
+ }
+
+ tmp3[0] = tmp1[0] + tmp2[0];
+ tmp3[1] = tmp1[1] + tmp2[1];
+ y_i[yi] = tmp3[0];
+ y_i[yi + 1] = tmp3[1];
+ }
+ } else {
+ /* uplo == blas_upper */
+ for (i = 0, yi = yi0, ai = 0; i < n; i++, yi += incy, ai += incai) {
+ sum1[0] = sum1[1] = 0.0;
+ sum2[0] = sum2[1] = 0.0;
+
+ for (j = 0, aij = ai, xi = xi0; j < i; j++, aij += incaij, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ a_elem[1] = -a_elem[1];
+ x_elem = x_head_i[xi];
+ {
+ prod1[0] = a_elem[0] * x_elem;
+ prod1[1] = a_elem[1] * x_elem;
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem = x_tail_i[xi];
+ {
+ prod2[0] = a_elem[0] * x_elem;
+ prod2[1] = a_elem[1] * x_elem;
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+
+ diag_elem = a_i[aij];
+ x_elem = x_head_i[xi];
+ prod1[0] = x_elem * diag_elem;
+ prod1[1] = 0.0;
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem = x_tail_i[xi];
+ prod2[0] = x_elem * diag_elem;
+ prod2[1] = 0.0;
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ j++;
+ aij += incaij2;
+ xi += incx;
+
+ for (; j < n; j++, aij += incaij2, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ x_elem = x_head_i[xi];
+ {
+ prod1[0] = a_elem[0] * x_elem;
+ prod1[1] = a_elem[1] * x_elem;
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem = x_tail_i[xi];
+ {
+ prod2[0] = a_elem[0] * x_elem;
+ prod2[1] = a_elem[1] * x_elem;
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+ sum1[0] = sum1[0] + sum2[0];
+ sum1[1] = sum1[1] + sum2[1];
+ {
+ tmp1[0] = sum1[0] * alpha_i[0] - sum1[1] * alpha_i[1];
+ tmp1[1] = sum1[0] * alpha_i[1] + sum1[1] * alpha_i[0];
+ }
+
+ y_elem[0] = y_i[yi];
+ y_elem[1] = y_i[yi + 1];
+ {
+ tmp2[0] = y_elem[0] * beta_i[0] - y_elem[1] * beta_i[1];
+ tmp2[1] = y_elem[0] * beta_i[1] + y_elem[1] * beta_i[0];
+ }
+
+ tmp3[0] = tmp1[0] + tmp2[0];
+ tmp3[1] = tmp1[1] + tmp2[1];
+ y_i[yi] = tmp3[0];
+ y_i[yi + 1] = tmp3[1];
+ }
+ }
+
+
+
+} /* end BLAS_chemv2_c_s */
--- /dev/null
+
+#include "f2c-bridge.h"
+#include "blas_enum.h"
+void BLAS_chemv2_c_s_x(enum blas_order_type order, enum blas_uplo_type uplo,
+ int n, const void *alpha, const void *a, int lda,
+ const float *x_head, const float *x_tail, int incx,
+ const void *beta, const float *y, int incy,
+ enum blas_prec_type prec);
+
+
+extern void FC_FUNC_(blas_chemv2_c_s_x, BLAS_CHEMV2_C_S_X)
+
+ (int *uplo, int *n, const void *alpha, const void *a, int *lda,
+ const float *x_head, const float *x_tail, int *incx, const void *beta,
+ const float *y, int *incy, int *prec) {
+ BLAS_chemv2_c_s_x(blas_colmajor, (enum blas_uplo_type) *uplo, *n, alpha, a,
+ *lda, x_head, x_tail, *incx, beta, y, *incy,
+ (enum blas_prec_type) *prec);
+}
--- /dev/null
+#include <blas_extended.h>
+#include <blas_extended_private.h>
+#include <blas_fpu.h>
+void BLAS_chemv2_c_s_x(enum blas_order_type order, enum blas_uplo_type uplo,
+ int n, const void *alpha, const void *a, int lda,
+ const float *x_head, const float *x_tail, int incx,
+ const void *beta, const float *y, int incy,
+ enum blas_prec_type prec)
+
+/*
+ * Purpose
+ * =======
+ *
+ * This routines computes the matrix product:
+ *
+ * y <- alpha * A * (x_head + x_tail) + beta * y
+ *
+ * where A is a complex Hermitian matrix.
+ *
+ * Arguments
+ * =========
+ *
+ * order (input) enum blas_order_type
+ * Storage format of input symmetric matrix A.
+ *
+ * uplo (input) enum blas_uplo_type
+ * Determines which half of matrix A (upper or lower triangle)
+ * is accessed.
+ *
+ * n (input) int
+ * Dimension of A and size of vectors x, y.
+ *
+ * alpha (input) const void*
+ *
+ * a (input) void*
+ * Matrix A.
+ *
+ * lda (input) int
+ * Leading dimension of matrix A.
+ *
+ * x_head (input) float*
+ * Vector x_head
+ *
+ * x_tail (input) float*
+ * Vector x_tail
+ *
+ * incx (input) int
+ * Stride for vector x.
+ *
+ * beta (input) const void*
+ *
+ * y (input) float*
+ * Vector y.
+ *
+ * incy (input) int
+ * Stride for vector y.
+ *
+ * prec (input) enum blas_prec_type
+ * Specifies the internal precision to be used.
+ * = blas_prec_single: single precision.
+ * = blas_prec_double: double precision.
+ * = blas_prec_extra : anything at least 1.5 times as accurate
+ * than double, and wider than 80-bits.
+ * We use double-double in our implementation.
+ *
+ */
+{
+ /* Routine name */
+ const char routine_name[] = "BLAS_chemv2_c_s_x";
+ switch (prec) {
+
+ case blas_prec_single:{
+
+ int i, j;
+ int xi, yi, xi0, yi0;
+ int aij, ai;
+ int incai;
+ int incaij, incaij2;
+
+ const float *a_i = (float *) a;
+ const float *x_head_i = x_head;
+ const float *x_tail_i = x_tail;
+ float *y_i = (float *) y;
+ float *alpha_i = (float *) alpha;
+ float *beta_i = (float *) beta;
+ float a_elem[2];
+ float x_elem;
+ float y_elem[2];
+ float diag_elem;
+ float prod1[2];
+ float prod2[2];
+ float sum1[2];
+ float sum2[2];
+ float tmp1[2];
+ float tmp2[2];
+ float tmp3[2];
+
+
+
+ /* Test for no-op */
+ if (n <= 0) {
+ return;
+ }
+ if (alpha_i[0] == 0.0 && alpha_i[1] == 0.0
+ && (beta_i[0] == 1.0 && beta_i[1] == 0.0)) {
+ return;
+ }
+
+ /* Check for error conditions. */
+ if (n < 0) {
+ BLAS_error(routine_name, -3, n, NULL);
+ }
+ if (lda < n) {
+ BLAS_error(routine_name, -6, n, NULL);
+ }
+ if (incx == 0) {
+ BLAS_error(routine_name, -9, incx, NULL);
+ }
+ if (incy == 0) {
+ BLAS_error(routine_name, -12, incy, NULL);
+ }
+
+ if ((order == blas_colmajor && uplo == blas_upper) ||
+ (order == blas_rowmajor && uplo == blas_lower)) {
+ incai = lda;
+ incaij = 1;
+ incaij2 = lda;
+ } else {
+ incai = 1;
+ incaij = lda;
+ incaij2 = 1;
+ }
+
+
+ incy *= 2;
+ incai *= 2;
+ incaij *= 2;
+ incaij2 *= 2;
+ xi0 = (incx > 0) ? 0 : ((-n + 1) * incx);
+ yi0 = (incy > 0) ? 0 : ((-n + 1) * incy);
+
+
+
+ /* The most general form, y <--- alpha * A * (x_head + x_tail) + beta * y */
+ if (uplo == blas_lower) {
+ for (i = 0, yi = yi0, ai = 0; i < n; i++, yi += incy, ai += incai) {
+ sum1[0] = sum1[1] = 0.0;
+ sum2[0] = sum2[1] = 0.0;
+ for (j = 0, aij = ai, xi = xi0; j < i;
+ j++, aij += incaij, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ x_elem = x_head_i[xi];
+ {
+ prod1[0] = a_elem[0] * x_elem;
+ prod1[1] = a_elem[1] * x_elem;
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem = x_tail_i[xi];
+ {
+ prod2[0] = a_elem[0] * x_elem;
+ prod2[1] = a_elem[1] * x_elem;
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+
+ diag_elem = a_i[aij];
+ x_elem = x_head_i[xi];
+ prod1[0] = x_elem * diag_elem;
+ prod1[1] = 0.0;
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem = x_tail_i[xi];
+ prod2[0] = x_elem * diag_elem;
+ prod2[1] = 0.0;
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ j++;
+ aij += incaij2;
+ xi += incx;
+
+ for (; j < n; j++, aij += incaij2, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ a_elem[1] = -a_elem[1];
+ x_elem = x_head_i[xi];
+ {
+ prod1[0] = a_elem[0] * x_elem;
+ prod1[1] = a_elem[1] * x_elem;
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem = x_tail_i[xi];
+ {
+ prod2[0] = a_elem[0] * x_elem;
+ prod2[1] = a_elem[1] * x_elem;
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+ sum1[0] = sum1[0] + sum2[0];
+ sum1[1] = sum1[1] + sum2[1];
+ {
+ tmp1[0] = sum1[0] * alpha_i[0] - sum1[1] * alpha_i[1];
+ tmp1[1] = sum1[0] * alpha_i[1] + sum1[1] * alpha_i[0];
+ }
+
+ y_elem[0] = y_i[yi];
+ y_elem[1] = y_i[yi + 1];
+ {
+ tmp2[0] = y_elem[0] * beta_i[0] - y_elem[1] * beta_i[1];
+ tmp2[1] = y_elem[0] * beta_i[1] + y_elem[1] * beta_i[0];
+ }
+
+ tmp3[0] = tmp1[0] + tmp2[0];
+ tmp3[1] = tmp1[1] + tmp2[1];
+ y_i[yi] = tmp3[0];
+ y_i[yi + 1] = tmp3[1];
+ }
+ } else {
+ /* uplo == blas_upper */
+ for (i = 0, yi = yi0, ai = 0; i < n; i++, yi += incy, ai += incai) {
+ sum1[0] = sum1[1] = 0.0;
+ sum2[0] = sum2[1] = 0.0;
+
+ for (j = 0, aij = ai, xi = xi0; j < i;
+ j++, aij += incaij, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ a_elem[1] = -a_elem[1];
+ x_elem = x_head_i[xi];
+ {
+ prod1[0] = a_elem[0] * x_elem;
+ prod1[1] = a_elem[1] * x_elem;
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem = x_tail_i[xi];
+ {
+ prod2[0] = a_elem[0] * x_elem;
+ prod2[1] = a_elem[1] * x_elem;
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+
+ diag_elem = a_i[aij];
+ x_elem = x_head_i[xi];
+ prod1[0] = x_elem * diag_elem;
+ prod1[1] = 0.0;
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem = x_tail_i[xi];
+ prod2[0] = x_elem * diag_elem;
+ prod2[1] = 0.0;
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ j++;
+ aij += incaij2;
+ xi += incx;
+
+ for (; j < n; j++, aij += incaij2, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ x_elem = x_head_i[xi];
+ {
+ prod1[0] = a_elem[0] * x_elem;
+ prod1[1] = a_elem[1] * x_elem;
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem = x_tail_i[xi];
+ {
+ prod2[0] = a_elem[0] * x_elem;
+ prod2[1] = a_elem[1] * x_elem;
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+ sum1[0] = sum1[0] + sum2[0];
+ sum1[1] = sum1[1] + sum2[1];
+ {
+ tmp1[0] = sum1[0] * alpha_i[0] - sum1[1] * alpha_i[1];
+ tmp1[1] = sum1[0] * alpha_i[1] + sum1[1] * alpha_i[0];
+ }
+
+ y_elem[0] = y_i[yi];
+ y_elem[1] = y_i[yi + 1];
+ {
+ tmp2[0] = y_elem[0] * beta_i[0] - y_elem[1] * beta_i[1];
+ tmp2[1] = y_elem[0] * beta_i[1] + y_elem[1] * beta_i[0];
+ }
+
+ tmp3[0] = tmp1[0] + tmp2[0];
+ tmp3[1] = tmp1[1] + tmp2[1];
+ y_i[yi] = tmp3[0];
+ y_i[yi + 1] = tmp3[1];
+ }
+ }
+
+
+
+ break;
+ }
+
+ case blas_prec_double:
+ case blas_prec_indigenous:{
+
+ int i, j;
+ int xi, yi, xi0, yi0;
+ int aij, ai;
+ int incai;
+ int incaij, incaij2;
+
+ const float *a_i = (float *) a;
+ const float *x_head_i = x_head;
+ const float *x_tail_i = x_tail;
+ float *y_i = (float *) y;
+ float *alpha_i = (float *) alpha;
+ float *beta_i = (float *) beta;
+ float a_elem[2];
+ float x_elem;
+ float y_elem[2];
+ float diag_elem;
+ double prod1[2];
+ double prod2[2];
+ double sum1[2];
+ double sum2[2];
+ double tmp1[2];
+ double tmp2[2];
+ double tmp3[2];
+
+
+
+ /* Test for no-op */
+ if (n <= 0) {
+ return;
+ }
+ if (alpha_i[0] == 0.0 && alpha_i[1] == 0.0
+ && (beta_i[0] == 1.0 && beta_i[1] == 0.0)) {
+ return;
+ }
+
+ /* Check for error conditions. */
+ if (n < 0) {
+ BLAS_error(routine_name, -3, n, NULL);
+ }
+ if (lda < n) {
+ BLAS_error(routine_name, -6, n, NULL);
+ }
+ if (incx == 0) {
+ BLAS_error(routine_name, -9, incx, NULL);
+ }
+ if (incy == 0) {
+ BLAS_error(routine_name, -12, incy, NULL);
+ }
+
+ if ((order == blas_colmajor && uplo == blas_upper) ||
+ (order == blas_rowmajor && uplo == blas_lower)) {
+ incai = lda;
+ incaij = 1;
+ incaij2 = lda;
+ } else {
+ incai = 1;
+ incaij = lda;
+ incaij2 = 1;
+ }
+
+
+ incy *= 2;
+ incai *= 2;
+ incaij *= 2;
+ incaij2 *= 2;
+ xi0 = (incx > 0) ? 0 : ((-n + 1) * incx);
+ yi0 = (incy > 0) ? 0 : ((-n + 1) * incy);
+
+
+
+ /* The most general form, y <--- alpha * A * (x_head + x_tail) + beta * y */
+ if (uplo == blas_lower) {
+ for (i = 0, yi = yi0, ai = 0; i < n; i++, yi += incy, ai += incai) {
+ sum1[0] = sum1[1] = 0.0;
+ sum2[0] = sum2[1] = 0.0;
+ for (j = 0, aij = ai, xi = xi0; j < i;
+ j++, aij += incaij, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ x_elem = x_head_i[xi];
+ {
+ prod1[0] = (double) a_elem[0] * x_elem;
+ prod1[1] = (double) a_elem[1] * x_elem;
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem = x_tail_i[xi];
+ {
+ prod2[0] = (double) a_elem[0] * x_elem;
+ prod2[1] = (double) a_elem[1] * x_elem;
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+
+ diag_elem = a_i[aij];
+ x_elem = x_head_i[xi];
+ prod1[0] = (double) x_elem *diag_elem;
+ prod1[1] = 0.0;
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem = x_tail_i[xi];
+ prod2[0] = (double) x_elem *diag_elem;
+ prod2[1] = 0.0;
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ j++;
+ aij += incaij2;
+ xi += incx;
+
+ for (; j < n; j++, aij += incaij2, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ a_elem[1] = -a_elem[1];
+ x_elem = x_head_i[xi];
+ {
+ prod1[0] = (double) a_elem[0] * x_elem;
+ prod1[1] = (double) a_elem[1] * x_elem;
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem = x_tail_i[xi];
+ {
+ prod2[0] = (double) a_elem[0] * x_elem;
+ prod2[1] = (double) a_elem[1] * x_elem;
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+ sum1[0] = sum1[0] + sum2[0];
+ sum1[1] = sum1[1] + sum2[1];
+ {
+ tmp1[0] =
+ (double) sum1[0] * alpha_i[0] - (double) sum1[1] * alpha_i[1];
+ tmp1[1] =
+ (double) sum1[0] * alpha_i[1] + (double) sum1[1] * alpha_i[0];
+ }
+ y_elem[0] = y_i[yi];
+ y_elem[1] = y_i[yi + 1];
+ {
+ tmp2[0] =
+ (double) y_elem[0] * beta_i[0] - (double) y_elem[1] * beta_i[1];
+ tmp2[1] =
+ (double) y_elem[0] * beta_i[1] + (double) y_elem[1] * beta_i[0];
+ }
+ tmp3[0] = tmp1[0] + tmp2[0];
+ tmp3[1] = tmp1[1] + tmp2[1];
+ y_i[yi] = tmp3[0];
+ y_i[yi + 1] = tmp3[1];
+ }
+ } else {
+ /* uplo == blas_upper */
+ for (i = 0, yi = yi0, ai = 0; i < n; i++, yi += incy, ai += incai) {
+ sum1[0] = sum1[1] = 0.0;
+ sum2[0] = sum2[1] = 0.0;
+
+ for (j = 0, aij = ai, xi = xi0; j < i;
+ j++, aij += incaij, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ a_elem[1] = -a_elem[1];
+ x_elem = x_head_i[xi];
+ {
+ prod1[0] = (double) a_elem[0] * x_elem;
+ prod1[1] = (double) a_elem[1] * x_elem;
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem = x_tail_i[xi];
+ {
+ prod2[0] = (double) a_elem[0] * x_elem;
+ prod2[1] = (double) a_elem[1] * x_elem;
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+
+ diag_elem = a_i[aij];
+ x_elem = x_head_i[xi];
+ prod1[0] = (double) x_elem *diag_elem;
+ prod1[1] = 0.0;
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem = x_tail_i[xi];
+ prod2[0] = (double) x_elem *diag_elem;
+ prod2[1] = 0.0;
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ j++;
+ aij += incaij2;
+ xi += incx;
+
+ for (; j < n; j++, aij += incaij2, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ x_elem = x_head_i[xi];
+ {
+ prod1[0] = (double) a_elem[0] * x_elem;
+ prod1[1] = (double) a_elem[1] * x_elem;
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem = x_tail_i[xi];
+ {
+ prod2[0] = (double) a_elem[0] * x_elem;
+ prod2[1] = (double) a_elem[1] * x_elem;
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+ sum1[0] = sum1[0] + sum2[0];
+ sum1[1] = sum1[1] + sum2[1];
+ {
+ tmp1[0] =
+ (double) sum1[0] * alpha_i[0] - (double) sum1[1] * alpha_i[1];
+ tmp1[1] =
+ (double) sum1[0] * alpha_i[1] + (double) sum1[1] * alpha_i[0];
+ }
+ y_elem[0] = y_i[yi];
+ y_elem[1] = y_i[yi + 1];
+ {
+ tmp2[0] =
+ (double) y_elem[0] * beta_i[0] - (double) y_elem[1] * beta_i[1];
+ tmp2[1] =
+ (double) y_elem[0] * beta_i[1] + (double) y_elem[1] * beta_i[0];
+ }
+ tmp3[0] = tmp1[0] + tmp2[0];
+ tmp3[1] = tmp1[1] + tmp2[1];
+ y_i[yi] = tmp3[0];
+ y_i[yi + 1] = tmp3[1];
+ }
+ }
+
+
+
+ break;
+ }
+
+ case blas_prec_extra:{
+
+ int i, j;
+ int xi, yi, xi0, yi0;
+ int aij, ai;
+ int incai;
+ int incaij, incaij2;
+
+ const float *a_i = (float *) a;
+ const float *x_head_i = x_head;
+ const float *x_tail_i = x_tail;
+ float *y_i = (float *) y;
+ float *alpha_i = (float *) alpha;
+ float *beta_i = (float *) beta;
+ float a_elem[2];
+ float x_elem;
+ float y_elem[2];
+ float diag_elem;
+ double head_prod1[2], tail_prod1[2];
+ double head_prod2[2], tail_prod2[2];
+ double head_sum1[2], tail_sum1[2];
+ double head_sum2[2], tail_sum2[2];
+ double head_tmp1[2], tail_tmp1[2];
+ double head_tmp2[2], tail_tmp2[2];
+ double head_tmp3[2], tail_tmp3[2];
+
+ FPU_FIX_DECL;
+
+ /* Test for no-op */
+ if (n <= 0) {
+ return;
+ }
+ if (alpha_i[0] == 0.0 && alpha_i[1] == 0.0
+ && (beta_i[0] == 1.0 && beta_i[1] == 0.0)) {
+ return;
+ }
+
+ /* Check for error conditions. */
+ if (n < 0) {
+ BLAS_error(routine_name, -3, n, NULL);
+ }
+ if (lda < n) {
+ BLAS_error(routine_name, -6, n, NULL);
+ }
+ if (incx == 0) {
+ BLAS_error(routine_name, -9, incx, NULL);
+ }
+ if (incy == 0) {
+ BLAS_error(routine_name, -12, incy, NULL);
+ }
+
+ if ((order == blas_colmajor && uplo == blas_upper) ||
+ (order == blas_rowmajor && uplo == blas_lower)) {
+ incai = lda;
+ incaij = 1;
+ incaij2 = lda;
+ } else {
+ incai = 1;
+ incaij = lda;
+ incaij2 = 1;
+ }
+
+
+ incy *= 2;
+ incai *= 2;
+ incaij *= 2;
+ incaij2 *= 2;
+ xi0 = (incx > 0) ? 0 : ((-n + 1) * incx);
+ yi0 = (incy > 0) ? 0 : ((-n + 1) * incy);
+
+ FPU_FIX_START;
+
+ /* The most general form, y <--- alpha * A * (x_head + x_tail) + beta * y */
+ if (uplo == blas_lower) {
+ for (i = 0, yi = yi0, ai = 0; i < n; i++, yi += incy, ai += incai) {
+ head_sum1[0] = head_sum1[1] = tail_sum1[0] = tail_sum1[1] = 0.0;
+ head_sum2[0] = head_sum2[1] = tail_sum2[0] = tail_sum2[1] = 0.0;
+ for (j = 0, aij = ai, xi = xi0; j < i;
+ j++, aij += incaij, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ x_elem = x_head_i[xi];
+ {
+ head_prod1[0] = (double) a_elem[0] * x_elem;
+ tail_prod1[0] = 0.0;
+ head_prod1[1] = (double) a_elem[1] * x_elem;
+ tail_prod1[1] = 0.0;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum1[0];
+ tail_a = tail_sum1[0];
+ head_b = head_prod1[0];
+ tail_b = tail_prod1[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[0] = head_t;
+ tail_sum1[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum1[1];
+ tail_a = tail_sum1[1];
+ head_b = head_prod1[1];
+ tail_b = tail_prod1[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[1] = head_t;
+ tail_sum1[1] = tail_t;
+ }
+ x_elem = x_tail_i[xi];
+ {
+ head_prod2[0] = (double) a_elem[0] * x_elem;
+ tail_prod2[0] = 0.0;
+ head_prod2[1] = (double) a_elem[1] * x_elem;
+ tail_prod2[1] = 0.0;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum2[0];
+ tail_a = tail_sum2[0];
+ head_b = head_prod2[0];
+ tail_b = tail_prod2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[0] = head_t;
+ tail_sum2[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum2[1];
+ tail_a = tail_sum2[1];
+ head_b = head_prod2[1];
+ tail_b = tail_prod2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[1] = head_t;
+ tail_sum2[1] = tail_t;
+ }
+ }
+
+ diag_elem = a_i[aij];
+ x_elem = x_head_i[xi];
+ head_prod1[0] = (double) x_elem *diag_elem;
+ head_prod1[1] = 0.0;
+ tail_prod1[0] = tail_prod1[1] = 0.0;
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum1[0];
+ tail_a = tail_sum1[0];
+ head_b = head_prod1[0];
+ tail_b = tail_prod1[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[0] = head_t;
+ tail_sum1[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum1[1];
+ tail_a = tail_sum1[1];
+ head_b = head_prod1[1];
+ tail_b = tail_prod1[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[1] = head_t;
+ tail_sum1[1] = tail_t;
+ }
+ x_elem = x_tail_i[xi];
+ head_prod2[0] = (double) x_elem *diag_elem;
+ head_prod2[1] = 0.0;
+ tail_prod2[0] = tail_prod2[1] = 0.0;
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum2[0];
+ tail_a = tail_sum2[0];
+ head_b = head_prod2[0];
+ tail_b = tail_prod2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[0] = head_t;
+ tail_sum2[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum2[1];
+ tail_a = tail_sum2[1];
+ head_b = head_prod2[1];
+ tail_b = tail_prod2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[1] = head_t;
+ tail_sum2[1] = tail_t;
+ }
+ j++;
+ aij += incaij2;
+ xi += incx;
+
+ for (; j < n; j++, aij += incaij2, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ a_elem[1] = -a_elem[1];
+ x_elem = x_head_i[xi];
+ {
+ head_prod1[0] = (double) a_elem[0] * x_elem;
+ tail_prod1[0] = 0.0;
+ head_prod1[1] = (double) a_elem[1] * x_elem;
+ tail_prod1[1] = 0.0;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum1[0];
+ tail_a = tail_sum1[0];
+ head_b = head_prod1[0];
+ tail_b = tail_prod1[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[0] = head_t;
+ tail_sum1[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum1[1];
+ tail_a = tail_sum1[1];
+ head_b = head_prod1[1];
+ tail_b = tail_prod1[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[1] = head_t;
+ tail_sum1[1] = tail_t;
+ }
+ x_elem = x_tail_i[xi];
+ {
+ head_prod2[0] = (double) a_elem[0] * x_elem;
+ tail_prod2[0] = 0.0;
+ head_prod2[1] = (double) a_elem[1] * x_elem;
+ tail_prod2[1] = 0.0;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum2[0];
+ tail_a = tail_sum2[0];
+ head_b = head_prod2[0];
+ tail_b = tail_prod2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[0] = head_t;
+ tail_sum2[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum2[1];
+ tail_a = tail_sum2[1];
+ head_b = head_prod2[1];
+ tail_b = tail_prod2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[1] = head_t;
+ tail_sum2[1] = tail_t;
+ }
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum1[0];
+ tail_a = tail_sum1[0];
+ head_b = head_sum2[0];
+ tail_b = tail_sum2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[0] = head_t;
+ tail_sum1[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum1[1];
+ tail_a = tail_sum1[1];
+ head_b = head_sum2[1];
+ tail_b = tail_sum2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[1] = head_t;
+ tail_sum1[1] = tail_t;
+ }
+ {
+ double cd[2];
+ cd[0] = (double) alpha_i[0];
+ cd[1] = (double) alpha_i[1];
+ {
+ /* Compute complex-extra = complex-extra * complex-double. */
+ double head_a0, tail_a0;
+ double head_a1, tail_a1;
+ double head_t1, tail_t1;
+ double head_t2, tail_t2;
+ head_a0 = head_sum1[0];
+ tail_a0 = tail_sum1[0];
+ head_a1 = head_sum1[1];
+ tail_a1 = tail_sum1[1];
+ /* real part */
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_a0 * split;
+ a11 = con - head_a0;
+ a11 = con - a11;
+ a21 = head_a0 - a11;
+ con = cd[0] * split;
+ b1 = con - cd[0];
+ b1 = con - b1;
+ b2 = cd[0] - b1;
+
+ c11 = head_a0 * cd[0];
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_a0 * cd[0];
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_a1 * split;
+ a11 = con - head_a1;
+ a11 = con - a11;
+ a21 = head_a1 - a11;
+ con = cd[1] * split;
+ b1 = con - cd[1];
+ b1 = con - b1;
+ b2 = cd[1] - b1;
+
+ c11 = head_a1 * cd[1];
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_a1 * cd[1];
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_t2 = t1 + t2;
+ tail_t2 = t2 - (head_t2 - t1);
+ }
+ head_t2 = -head_t2;
+ tail_t2 = -tail_t2;
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_tmp1[0] = head_t1;
+ tail_tmp1[0] = tail_t1;
+ /* imaginary part */
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_a1 * split;
+ a11 = con - head_a1;
+ a11 = con - a11;
+ a21 = head_a1 - a11;
+ con = cd[0] * split;
+ b1 = con - cd[0];
+ b1 = con - b1;
+ b2 = cd[0] - b1;
+
+ c11 = head_a1 * cd[0];
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_a1 * cd[0];
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_a0 * split;
+ a11 = con - head_a0;
+ a11 = con - a11;
+ a21 = head_a0 - a11;
+ con = cd[1] * split;
+ b1 = con - cd[1];
+ b1 = con - b1;
+ b2 = cd[1] - b1;
+
+ c11 = head_a0 * cd[1];
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_a0 * cd[1];
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_t2 = t1 + t2;
+ tail_t2 = t2 - (head_t2 - t1);
+ }
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_tmp1[1] = head_t1;
+ tail_tmp1[1] = tail_t1;
+ }
+
+ }
+ y_elem[0] = y_i[yi];
+ y_elem[1] = y_i[yi + 1];
+ {
+ double head_e1, tail_e1;
+ double d1;
+ double d2;
+ /* Real part */
+ d1 = (double) y_elem[0] * beta_i[0];
+ d2 = (double) -y_elem[1] * beta_i[1];
+ {
+ /* Compute double-double = double + double. */
+ double e, t1, t2;
+
+ /* Knuth trick. */
+ t1 = d1 + d2;
+ e = t1 - d1;
+ t2 = ((d2 - e) + (d1 - (t1 - e)));
+
+ /* The result is t1 + t2, after normalization. */
+ head_e1 = t1 + t2;
+ tail_e1 = t2 - (head_e1 - t1);
+ }
+ head_tmp2[0] = head_e1;
+ tail_tmp2[0] = tail_e1;
+ /* imaginary part */
+ d1 = (double) y_elem[0] * beta_i[1];
+ d2 = (double) y_elem[1] * beta_i[0];
+ {
+ /* Compute double-double = double + double. */
+ double e, t1, t2;
+
+ /* Knuth trick. */
+ t1 = d1 + d2;
+ e = t1 - d1;
+ t2 = ((d2 - e) + (d1 - (t1 - e)));
+
+ /* The result is t1 + t2, after normalization. */
+ head_e1 = t1 + t2;
+ tail_e1 = t2 - (head_e1 - t1);
+ }
+ head_tmp2[1] = head_e1;
+ tail_tmp2[1] = tail_e1;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_tmp1[0];
+ tail_a = tail_tmp1[0];
+ head_b = head_tmp2[0];
+ tail_b = tail_tmp2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_tmp3[0] = head_t;
+ tail_tmp3[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_tmp1[1];
+ tail_a = tail_tmp1[1];
+ head_b = head_tmp2[1];
+ tail_b = tail_tmp2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_tmp3[1] = head_t;
+ tail_tmp3[1] = tail_t;
+ }
+ y_i[yi] = head_tmp3[0];
+ y_i[yi + 1] = head_tmp3[1];
+ }
+ } else {
+ /* uplo == blas_upper */
+ for (i = 0, yi = yi0, ai = 0; i < n; i++, yi += incy, ai += incai) {
+ head_sum1[0] = head_sum1[1] = tail_sum1[0] = tail_sum1[1] = 0.0;
+ head_sum2[0] = head_sum2[1] = tail_sum2[0] = tail_sum2[1] = 0.0;
+
+ for (j = 0, aij = ai, xi = xi0; j < i;
+ j++, aij += incaij, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ a_elem[1] = -a_elem[1];
+ x_elem = x_head_i[xi];
+ {
+ head_prod1[0] = (double) a_elem[0] * x_elem;
+ tail_prod1[0] = 0.0;
+ head_prod1[1] = (double) a_elem[1] * x_elem;
+ tail_prod1[1] = 0.0;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum1[0];
+ tail_a = tail_sum1[0];
+ head_b = head_prod1[0];
+ tail_b = tail_prod1[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[0] = head_t;
+ tail_sum1[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum1[1];
+ tail_a = tail_sum1[1];
+ head_b = head_prod1[1];
+ tail_b = tail_prod1[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[1] = head_t;
+ tail_sum1[1] = tail_t;
+ }
+ x_elem = x_tail_i[xi];
+ {
+ head_prod2[0] = (double) a_elem[0] * x_elem;
+ tail_prod2[0] = 0.0;
+ head_prod2[1] = (double) a_elem[1] * x_elem;
+ tail_prod2[1] = 0.0;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum2[0];
+ tail_a = tail_sum2[0];
+ head_b = head_prod2[0];
+ tail_b = tail_prod2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[0] = head_t;
+ tail_sum2[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum2[1];
+ tail_a = tail_sum2[1];
+ head_b = head_prod2[1];
+ tail_b = tail_prod2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[1] = head_t;
+ tail_sum2[1] = tail_t;
+ }
+ }
+
+ diag_elem = a_i[aij];
+ x_elem = x_head_i[xi];
+ head_prod1[0] = (double) x_elem *diag_elem;
+ head_prod1[1] = 0.0;
+ tail_prod1[0] = tail_prod1[1] = 0.0;
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum1[0];
+ tail_a = tail_sum1[0];
+ head_b = head_prod1[0];
+ tail_b = tail_prod1[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[0] = head_t;
+ tail_sum1[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum1[1];
+ tail_a = tail_sum1[1];
+ head_b = head_prod1[1];
+ tail_b = tail_prod1[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[1] = head_t;
+ tail_sum1[1] = tail_t;
+ }
+ x_elem = x_tail_i[xi];
+ head_prod2[0] = (double) x_elem *diag_elem;
+ head_prod2[1] = 0.0;
+ tail_prod2[0] = tail_prod2[1] = 0.0;
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum2[0];
+ tail_a = tail_sum2[0];
+ head_b = head_prod2[0];
+ tail_b = tail_prod2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[0] = head_t;
+ tail_sum2[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum2[1];
+ tail_a = tail_sum2[1];
+ head_b = head_prod2[1];
+ tail_b = tail_prod2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[1] = head_t;
+ tail_sum2[1] = tail_t;
+ }
+ j++;
+ aij += incaij2;
+ xi += incx;
+
+ for (; j < n; j++, aij += incaij2, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ x_elem = x_head_i[xi];
+ {
+ head_prod1[0] = (double) a_elem[0] * x_elem;
+ tail_prod1[0] = 0.0;
+ head_prod1[1] = (double) a_elem[1] * x_elem;
+ tail_prod1[1] = 0.0;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum1[0];
+ tail_a = tail_sum1[0];
+ head_b = head_prod1[0];
+ tail_b = tail_prod1[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[0] = head_t;
+ tail_sum1[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum1[1];
+ tail_a = tail_sum1[1];
+ head_b = head_prod1[1];
+ tail_b = tail_prod1[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[1] = head_t;
+ tail_sum1[1] = tail_t;
+ }
+ x_elem = x_tail_i[xi];
+ {
+ head_prod2[0] = (double) a_elem[0] * x_elem;
+ tail_prod2[0] = 0.0;
+ head_prod2[1] = (double) a_elem[1] * x_elem;
+ tail_prod2[1] = 0.0;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum2[0];
+ tail_a = tail_sum2[0];
+ head_b = head_prod2[0];
+ tail_b = tail_prod2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[0] = head_t;
+ tail_sum2[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum2[1];
+ tail_a = tail_sum2[1];
+ head_b = head_prod2[1];
+ tail_b = tail_prod2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[1] = head_t;
+ tail_sum2[1] = tail_t;
+ }
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum1[0];
+ tail_a = tail_sum1[0];
+ head_b = head_sum2[0];
+ tail_b = tail_sum2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[0] = head_t;
+ tail_sum1[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum1[1];
+ tail_a = tail_sum1[1];
+ head_b = head_sum2[1];
+ tail_b = tail_sum2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[1] = head_t;
+ tail_sum1[1] = tail_t;
+ }
+ {
+ double cd[2];
+ cd[0] = (double) alpha_i[0];
+ cd[1] = (double) alpha_i[1];
+ {
+ /* Compute complex-extra = complex-extra * complex-double. */
+ double head_a0, tail_a0;
+ double head_a1, tail_a1;
+ double head_t1, tail_t1;
+ double head_t2, tail_t2;
+ head_a0 = head_sum1[0];
+ tail_a0 = tail_sum1[0];
+ head_a1 = head_sum1[1];
+ tail_a1 = tail_sum1[1];
+ /* real part */
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_a0 * split;
+ a11 = con - head_a0;
+ a11 = con - a11;
+ a21 = head_a0 - a11;
+ con = cd[0] * split;
+ b1 = con - cd[0];
+ b1 = con - b1;
+ b2 = cd[0] - b1;
+
+ c11 = head_a0 * cd[0];
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_a0 * cd[0];
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_a1 * split;
+ a11 = con - head_a1;
+ a11 = con - a11;
+ a21 = head_a1 - a11;
+ con = cd[1] * split;
+ b1 = con - cd[1];
+ b1 = con - b1;
+ b2 = cd[1] - b1;
+
+ c11 = head_a1 * cd[1];
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_a1 * cd[1];
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_t2 = t1 + t2;
+ tail_t2 = t2 - (head_t2 - t1);
+ }
+ head_t2 = -head_t2;
+ tail_t2 = -tail_t2;
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_tmp1[0] = head_t1;
+ tail_tmp1[0] = tail_t1;
+ /* imaginary part */
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_a1 * split;
+ a11 = con - head_a1;
+ a11 = con - a11;
+ a21 = head_a1 - a11;
+ con = cd[0] * split;
+ b1 = con - cd[0];
+ b1 = con - b1;
+ b2 = cd[0] - b1;
+
+ c11 = head_a1 * cd[0];
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_a1 * cd[0];
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_a0 * split;
+ a11 = con - head_a0;
+ a11 = con - a11;
+ a21 = head_a0 - a11;
+ con = cd[1] * split;
+ b1 = con - cd[1];
+ b1 = con - b1;
+ b2 = cd[1] - b1;
+
+ c11 = head_a0 * cd[1];
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_a0 * cd[1];
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_t2 = t1 + t2;
+ tail_t2 = t2 - (head_t2 - t1);
+ }
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_tmp1[1] = head_t1;
+ tail_tmp1[1] = tail_t1;
+ }
+
+ }
+ y_elem[0] = y_i[yi];
+ y_elem[1] = y_i[yi + 1];
+ {
+ double head_e1, tail_e1;
+ double d1;
+ double d2;
+ /* Real part */
+ d1 = (double) y_elem[0] * beta_i[0];
+ d2 = (double) -y_elem[1] * beta_i[1];
+ {
+ /* Compute double-double = double + double. */
+ double e, t1, t2;
+
+ /* Knuth trick. */
+ t1 = d1 + d2;
+ e = t1 - d1;
+ t2 = ((d2 - e) + (d1 - (t1 - e)));
+
+ /* The result is t1 + t2, after normalization. */
+ head_e1 = t1 + t2;
+ tail_e1 = t2 - (head_e1 - t1);
+ }
+ head_tmp2[0] = head_e1;
+ tail_tmp2[0] = tail_e1;
+ /* imaginary part */
+ d1 = (double) y_elem[0] * beta_i[1];
+ d2 = (double) y_elem[1] * beta_i[0];
+ {
+ /* Compute double-double = double + double. */
+ double e, t1, t2;
+
+ /* Knuth trick. */
+ t1 = d1 + d2;
+ e = t1 - d1;
+ t2 = ((d2 - e) + (d1 - (t1 - e)));
+
+ /* The result is t1 + t2, after normalization. */
+ head_e1 = t1 + t2;
+ tail_e1 = t2 - (head_e1 - t1);
+ }
+ head_tmp2[1] = head_e1;
+ tail_tmp2[1] = tail_e1;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_tmp1[0];
+ tail_a = tail_tmp1[0];
+ head_b = head_tmp2[0];
+ tail_b = tail_tmp2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_tmp3[0] = head_t;
+ tail_tmp3[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_tmp1[1];
+ tail_a = tail_tmp1[1];
+ head_b = head_tmp2[1];
+ tail_b = tail_tmp2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_tmp3[1] = head_t;
+ tail_tmp3[1] = tail_t;
+ }
+ y_i[yi] = head_tmp3[0];
+ y_i[yi + 1] = head_tmp3[1];
+ }
+ }
+
+ FPU_FIX_STOP;
+
+ break;
+ }
+ }
+} /* end BLAS_chemv2_c_s_x */
--- /dev/null
+
+#include "f2c-bridge.h"
+#include "blas_enum.h"
+void BLAS_chemv2_x(enum blas_order_type order, enum blas_uplo_type uplo,
+ int n, const void *alpha, const void *a, int lda,
+ const void *x_head, const void *x_tail, int incx,
+ const void *beta, const void *y, int incy,
+ enum blas_prec_type prec);
+
+
+extern void FC_FUNC_(blas_chemv2_x, BLAS_CHEMV2_X)
+
+ (int *uplo, int *n, const void *alpha, const void *a, int *lda,
+ const void *x_head, const void *x_tail, int *incx, const void *beta,
+ const void *y, int *incy, int *prec) {
+ BLAS_chemv2_x(blas_colmajor, (enum blas_uplo_type) *uplo, *n, alpha, a,
+ *lda, x_head, x_tail, *incx, beta, y, *incy,
+ (enum blas_prec_type) *prec);
+}
--- /dev/null
+#include <blas_extended.h>
+#include <blas_extended_private.h>
+#include <blas_fpu.h>
+void BLAS_chemv2_x(enum blas_order_type order, enum blas_uplo_type uplo,
+ int n, const void *alpha, const void *a, int lda,
+ const void *x_head, const void *x_tail, int incx,
+ const void *beta, const void *y, int incy,
+ enum blas_prec_type prec)
+
+/*
+ * Purpose
+ * =======
+ *
+ * This routines computes the matrix product:
+ *
+ * y <- alpha * A * (x_head + x_tail) + beta * y
+ *
+ * where A is a complex Hermitian matrix.
+ *
+ * Arguments
+ * =========
+ *
+ * order (input) enum blas_order_type
+ * Storage format of input symmetric matrix A.
+ *
+ * uplo (input) enum blas_uplo_type
+ * Determines which half of matrix A (upper or lower triangle)
+ * is accessed.
+ *
+ * n (input) int
+ * Dimension of A and size of vectors x, y.
+ *
+ * alpha (input) const void*
+ *
+ * a (input) void*
+ * Matrix A.
+ *
+ * lda (input) int
+ * Leading dimension of matrix A.
+ *
+ * x_head (input) void*
+ * Vector x_head
+ *
+ * x_tail (input) void*
+ * Vector x_tail
+ *
+ * incx (input) int
+ * Stride for vector x.
+ *
+ * beta (input) const void*
+ *
+ * y (input) void*
+ * Vector y.
+ *
+ * incy (input) int
+ * Stride for vector y.
+ *
+ * prec (input) enum blas_prec_type
+ * Specifies the internal precision to be used.
+ * = blas_prec_single: single precision.
+ * = blas_prec_double: double precision.
+ * = blas_prec_extra : anything at least 1.5 times as accurate
+ * than double, and wider than 80-bits.
+ * We use double-double in our implementation.
+ *
+ */
+{
+ /* Routine name */
+ const char routine_name[] = "BLAS_chemv2_x";
+ switch (prec) {
+
+ case blas_prec_single:{
+
+ int i, j;
+ int xi, yi, xi0, yi0;
+ int aij, ai;
+ int incai;
+ int incaij, incaij2;
+
+ const float *a_i = (float *) a;
+ const float *x_head_i = (float *) x_head;
+ const float *x_tail_i = (float *) x_tail;
+ float *y_i = (float *) y;
+ float *alpha_i = (float *) alpha;
+ float *beta_i = (float *) beta;
+ float a_elem[2];
+ float x_elem[2];
+ float y_elem[2];
+ float diag_elem;
+ float prod1[2];
+ float prod2[2];
+ float sum1[2];
+ float sum2[2];
+ float tmp1[2];
+ float tmp2[2];
+ float tmp3[2];
+
+
+
+ /* Test for no-op */
+ if (n <= 0) {
+ return;
+ }
+ if (alpha_i[0] == 0.0 && alpha_i[1] == 0.0
+ && (beta_i[0] == 1.0 && beta_i[1] == 0.0)) {
+ return;
+ }
+
+ /* Check for error conditions. */
+ if (n < 0) {
+ BLAS_error(routine_name, -3, n, NULL);
+ }
+ if (lda < n) {
+ BLAS_error(routine_name, -6, n, NULL);
+ }
+ if (incx == 0) {
+ BLAS_error(routine_name, -9, incx, NULL);
+ }
+ if (incy == 0) {
+ BLAS_error(routine_name, -12, incy, NULL);
+ }
+
+ if ((order == blas_colmajor && uplo == blas_upper) ||
+ (order == blas_rowmajor && uplo == blas_lower)) {
+ incai = lda;
+ incaij = 1;
+ incaij2 = lda;
+ } else {
+ incai = 1;
+ incaij = lda;
+ incaij2 = 1;
+ }
+
+ incx *= 2;
+ incy *= 2;
+ incai *= 2;
+ incaij *= 2;
+ incaij2 *= 2;
+ xi0 = (incx > 0) ? 0 : ((-n + 1) * incx);
+ yi0 = (incy > 0) ? 0 : ((-n + 1) * incy);
+
+
+
+ /* The most general form, y <--- alpha * A * (x_head + x_tail) + beta * y */
+ if (uplo == blas_lower) {
+ for (i = 0, yi = yi0, ai = 0; i < n; i++, yi += incy, ai += incai) {
+ sum1[0] = sum1[1] = 0.0;
+ sum2[0] = sum2[1] = 0.0;
+ for (j = 0, aij = ai, xi = xi0; j < i;
+ j++, aij += incaij, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] = a_elem[0] * x_elem[0] - a_elem[1] * x_elem[1];
+ prod1[1] = a_elem[0] * x_elem[1] + a_elem[1] * x_elem[0];
+ }
+
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] = a_elem[0] * x_elem[0] - a_elem[1] * x_elem[1];
+ prod2[1] = a_elem[0] * x_elem[1] + a_elem[1] * x_elem[0];
+ }
+
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+
+ diag_elem = a_i[aij];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] = x_elem[0] * diag_elem;
+ prod1[1] = x_elem[1] * diag_elem;
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] = x_elem[0] * diag_elem;
+ prod2[1] = x_elem[1] * diag_elem;
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ j++;
+ aij += incaij2;
+ xi += incx;
+
+ for (; j < n; j++, aij += incaij2, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ a_elem[1] = -a_elem[1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] = a_elem[0] * x_elem[0] - a_elem[1] * x_elem[1];
+ prod1[1] = a_elem[0] * x_elem[1] + a_elem[1] * x_elem[0];
+ }
+
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] = a_elem[0] * x_elem[0] - a_elem[1] * x_elem[1];
+ prod2[1] = a_elem[0] * x_elem[1] + a_elem[1] * x_elem[0];
+ }
+
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+ sum1[0] = sum1[0] + sum2[0];
+ sum1[1] = sum1[1] + sum2[1];
+ {
+ tmp1[0] = sum1[0] * alpha_i[0] - sum1[1] * alpha_i[1];
+ tmp1[1] = sum1[0] * alpha_i[1] + sum1[1] * alpha_i[0];
+ }
+
+ y_elem[0] = y_i[yi];
+ y_elem[1] = y_i[yi + 1];
+ {
+ tmp2[0] = y_elem[0] * beta_i[0] - y_elem[1] * beta_i[1];
+ tmp2[1] = y_elem[0] * beta_i[1] + y_elem[1] * beta_i[0];
+ }
+
+ tmp3[0] = tmp1[0] + tmp2[0];
+ tmp3[1] = tmp1[1] + tmp2[1];
+ y_i[yi] = tmp3[0];
+ y_i[yi + 1] = tmp3[1];
+ }
+ } else {
+ /* uplo == blas_upper */
+ for (i = 0, yi = yi0, ai = 0; i < n; i++, yi += incy, ai += incai) {
+ sum1[0] = sum1[1] = 0.0;
+ sum2[0] = sum2[1] = 0.0;
+
+ for (j = 0, aij = ai, xi = xi0; j < i;
+ j++, aij += incaij, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ a_elem[1] = -a_elem[1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] = a_elem[0] * x_elem[0] - a_elem[1] * x_elem[1];
+ prod1[1] = a_elem[0] * x_elem[1] + a_elem[1] * x_elem[0];
+ }
+
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] = a_elem[0] * x_elem[0] - a_elem[1] * x_elem[1];
+ prod2[1] = a_elem[0] * x_elem[1] + a_elem[1] * x_elem[0];
+ }
+
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+
+ diag_elem = a_i[aij];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] = x_elem[0] * diag_elem;
+ prod1[1] = x_elem[1] * diag_elem;
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] = x_elem[0] * diag_elem;
+ prod2[1] = x_elem[1] * diag_elem;
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ j++;
+ aij += incaij2;
+ xi += incx;
+
+ for (; j < n; j++, aij += incaij2, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] = a_elem[0] * x_elem[0] - a_elem[1] * x_elem[1];
+ prod1[1] = a_elem[0] * x_elem[1] + a_elem[1] * x_elem[0];
+ }
+
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] = a_elem[0] * x_elem[0] - a_elem[1] * x_elem[1];
+ prod2[1] = a_elem[0] * x_elem[1] + a_elem[1] * x_elem[0];
+ }
+
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+ sum1[0] = sum1[0] + sum2[0];
+ sum1[1] = sum1[1] + sum2[1];
+ {
+ tmp1[0] = sum1[0] * alpha_i[0] - sum1[1] * alpha_i[1];
+ tmp1[1] = sum1[0] * alpha_i[1] + sum1[1] * alpha_i[0];
+ }
+
+ y_elem[0] = y_i[yi];
+ y_elem[1] = y_i[yi + 1];
+ {
+ tmp2[0] = y_elem[0] * beta_i[0] - y_elem[1] * beta_i[1];
+ tmp2[1] = y_elem[0] * beta_i[1] + y_elem[1] * beta_i[0];
+ }
+
+ tmp3[0] = tmp1[0] + tmp2[0];
+ tmp3[1] = tmp1[1] + tmp2[1];
+ y_i[yi] = tmp3[0];
+ y_i[yi + 1] = tmp3[1];
+ }
+ }
+
+
+
+ break;
+ }
+
+ case blas_prec_double:
+ case blas_prec_indigenous:{
+
+ int i, j;
+ int xi, yi, xi0, yi0;
+ int aij, ai;
+ int incai;
+ int incaij, incaij2;
+
+ const float *a_i = (float *) a;
+ const float *x_head_i = (float *) x_head;
+ const float *x_tail_i = (float *) x_tail;
+ float *y_i = (float *) y;
+ float *alpha_i = (float *) alpha;
+ float *beta_i = (float *) beta;
+ float a_elem[2];
+ float x_elem[2];
+ float y_elem[2];
+ float diag_elem;
+ double prod1[2];
+ double prod2[2];
+ double sum1[2];
+ double sum2[2];
+ double tmp1[2];
+ double tmp2[2];
+ double tmp3[2];
+
+
+
+ /* Test for no-op */
+ if (n <= 0) {
+ return;
+ }
+ if (alpha_i[0] == 0.0 && alpha_i[1] == 0.0
+ && (beta_i[0] == 1.0 && beta_i[1] == 0.0)) {
+ return;
+ }
+
+ /* Check for error conditions. */
+ if (n < 0) {
+ BLAS_error(routine_name, -3, n, NULL);
+ }
+ if (lda < n) {
+ BLAS_error(routine_name, -6, n, NULL);
+ }
+ if (incx == 0) {
+ BLAS_error(routine_name, -9, incx, NULL);
+ }
+ if (incy == 0) {
+ BLAS_error(routine_name, -12, incy, NULL);
+ }
+
+ if ((order == blas_colmajor && uplo == blas_upper) ||
+ (order == blas_rowmajor && uplo == blas_lower)) {
+ incai = lda;
+ incaij = 1;
+ incaij2 = lda;
+ } else {
+ incai = 1;
+ incaij = lda;
+ incaij2 = 1;
+ }
+
+ incx *= 2;
+ incy *= 2;
+ incai *= 2;
+ incaij *= 2;
+ incaij2 *= 2;
+ xi0 = (incx > 0) ? 0 : ((-n + 1) * incx);
+ yi0 = (incy > 0) ? 0 : ((-n + 1) * incy);
+
+
+
+ /* The most general form, y <--- alpha * A * (x_head + x_tail) + beta * y */
+ if (uplo == blas_lower) {
+ for (i = 0, yi = yi0, ai = 0; i < n; i++, yi += incy, ai += incai) {
+ sum1[0] = sum1[1] = 0.0;
+ sum2[0] = sum2[1] = 0.0;
+ for (j = 0, aij = ai, xi = xi0; j < i;
+ j++, aij += incaij, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod1[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod2[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+
+ diag_elem = a_i[aij];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] = (double) x_elem[0] * diag_elem;
+ prod1[1] = (double) x_elem[1] * diag_elem;
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] = (double) x_elem[0] * diag_elem;
+ prod2[1] = (double) x_elem[1] * diag_elem;
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ j++;
+ aij += incaij2;
+ xi += incx;
+
+ for (; j < n; j++, aij += incaij2, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ a_elem[1] = -a_elem[1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod1[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod2[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+ sum1[0] = sum1[0] + sum2[0];
+ sum1[1] = sum1[1] + sum2[1];
+ {
+ tmp1[0] =
+ (double) sum1[0] * alpha_i[0] - (double) sum1[1] * alpha_i[1];
+ tmp1[1] =
+ (double) sum1[0] * alpha_i[1] + (double) sum1[1] * alpha_i[0];
+ }
+ y_elem[0] = y_i[yi];
+ y_elem[1] = y_i[yi + 1];
+ {
+ tmp2[0] =
+ (double) y_elem[0] * beta_i[0] - (double) y_elem[1] * beta_i[1];
+ tmp2[1] =
+ (double) y_elem[0] * beta_i[1] + (double) y_elem[1] * beta_i[0];
+ }
+ tmp3[0] = tmp1[0] + tmp2[0];
+ tmp3[1] = tmp1[1] + tmp2[1];
+ y_i[yi] = tmp3[0];
+ y_i[yi + 1] = tmp3[1];
+ }
+ } else {
+ /* uplo == blas_upper */
+ for (i = 0, yi = yi0, ai = 0; i < n; i++, yi += incy, ai += incai) {
+ sum1[0] = sum1[1] = 0.0;
+ sum2[0] = sum2[1] = 0.0;
+
+ for (j = 0, aij = ai, xi = xi0; j < i;
+ j++, aij += incaij, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ a_elem[1] = -a_elem[1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod1[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod2[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+
+ diag_elem = a_i[aij];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] = (double) x_elem[0] * diag_elem;
+ prod1[1] = (double) x_elem[1] * diag_elem;
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] = (double) x_elem[0] * diag_elem;
+ prod2[1] = (double) x_elem[1] * diag_elem;
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ j++;
+ aij += incaij2;
+ xi += incx;
+
+ for (; j < n; j++, aij += incaij2, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod1[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod2[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+ sum1[0] = sum1[0] + sum2[0];
+ sum1[1] = sum1[1] + sum2[1];
+ {
+ tmp1[0] =
+ (double) sum1[0] * alpha_i[0] - (double) sum1[1] * alpha_i[1];
+ tmp1[1] =
+ (double) sum1[0] * alpha_i[1] + (double) sum1[1] * alpha_i[0];
+ }
+ y_elem[0] = y_i[yi];
+ y_elem[1] = y_i[yi + 1];
+ {
+ tmp2[0] =
+ (double) y_elem[0] * beta_i[0] - (double) y_elem[1] * beta_i[1];
+ tmp2[1] =
+ (double) y_elem[0] * beta_i[1] + (double) y_elem[1] * beta_i[0];
+ }
+ tmp3[0] = tmp1[0] + tmp2[0];
+ tmp3[1] = tmp1[1] + tmp2[1];
+ y_i[yi] = tmp3[0];
+ y_i[yi + 1] = tmp3[1];
+ }
+ }
+
+
+
+ break;
+ }
+
+ case blas_prec_extra:{
+
+ int i, j;
+ int xi, yi, xi0, yi0;
+ int aij, ai;
+ int incai;
+ int incaij, incaij2;
+
+ const float *a_i = (float *) a;
+ const float *x_head_i = (float *) x_head;
+ const float *x_tail_i = (float *) x_tail;
+ float *y_i = (float *) y;
+ float *alpha_i = (float *) alpha;
+ float *beta_i = (float *) beta;
+ float a_elem[2];
+ float x_elem[2];
+ float y_elem[2];
+ float diag_elem;
+ double head_prod1[2], tail_prod1[2];
+ double head_prod2[2], tail_prod2[2];
+ double head_sum1[2], tail_sum1[2];
+ double head_sum2[2], tail_sum2[2];
+ double head_tmp1[2], tail_tmp1[2];
+ double head_tmp2[2], tail_tmp2[2];
+ double head_tmp3[2], tail_tmp3[2];
+
+ FPU_FIX_DECL;
+
+ /* Test for no-op */
+ if (n <= 0) {
+ return;
+ }
+ if (alpha_i[0] == 0.0 && alpha_i[1] == 0.0
+ && (beta_i[0] == 1.0 && beta_i[1] == 0.0)) {
+ return;
+ }
+
+ /* Check for error conditions. */
+ if (n < 0) {
+ BLAS_error(routine_name, -3, n, NULL);
+ }
+ if (lda < n) {
+ BLAS_error(routine_name, -6, n, NULL);
+ }
+ if (incx == 0) {
+ BLAS_error(routine_name, -9, incx, NULL);
+ }
+ if (incy == 0) {
+ BLAS_error(routine_name, -12, incy, NULL);
+ }
+
+ if ((order == blas_colmajor && uplo == blas_upper) ||
+ (order == blas_rowmajor && uplo == blas_lower)) {
+ incai = lda;
+ incaij = 1;
+ incaij2 = lda;
+ } else {
+ incai = 1;
+ incaij = lda;
+ incaij2 = 1;
+ }
+
+ incx *= 2;
+ incy *= 2;
+ incai *= 2;
+ incaij *= 2;
+ incaij2 *= 2;
+ xi0 = (incx > 0) ? 0 : ((-n + 1) * incx);
+ yi0 = (incy > 0) ? 0 : ((-n + 1) * incy);
+
+ FPU_FIX_START;
+
+ /* The most general form, y <--- alpha * A * (x_head + x_tail) + beta * y */
+ if (uplo == blas_lower) {
+ for (i = 0, yi = yi0, ai = 0; i < n; i++, yi += incy, ai += incai) {
+ head_sum1[0] = head_sum1[1] = tail_sum1[0] = tail_sum1[1] = 0.0;
+ head_sum2[0] = head_sum2[1] = tail_sum2[0] = tail_sum2[1] = 0.0;
+ for (j = 0, aij = ai, xi = xi0; j < i;
+ j++, aij += incaij, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ double head_e1, tail_e1;
+ double d1;
+ double d2;
+ /* Real part */
+ d1 = (double) a_elem[0] * x_elem[0];
+ d2 = (double) -a_elem[1] * x_elem[1];
+ {
+ /* Compute double-double = double + double. */
+ double e, t1, t2;
+
+ /* Knuth trick. */
+ t1 = d1 + d2;
+ e = t1 - d1;
+ t2 = ((d2 - e) + (d1 - (t1 - e)));
+
+ /* The result is t1 + t2, after normalization. */
+ head_e1 = t1 + t2;
+ tail_e1 = t2 - (head_e1 - t1);
+ }
+ head_prod1[0] = head_e1;
+ tail_prod1[0] = tail_e1;
+ /* imaginary part */
+ d1 = (double) a_elem[0] * x_elem[1];
+ d2 = (double) a_elem[1] * x_elem[0];
+ {
+ /* Compute double-double = double + double. */
+ double e, t1, t2;
+
+ /* Knuth trick. */
+ t1 = d1 + d2;
+ e = t1 - d1;
+ t2 = ((d2 - e) + (d1 - (t1 - e)));
+
+ /* The result is t1 + t2, after normalization. */
+ head_e1 = t1 + t2;
+ tail_e1 = t2 - (head_e1 - t1);
+ }
+ head_prod1[1] = head_e1;
+ tail_prod1[1] = tail_e1;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum1[0];
+ tail_a = tail_sum1[0];
+ head_b = head_prod1[0];
+ tail_b = tail_prod1[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[0] = head_t;
+ tail_sum1[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum1[1];
+ tail_a = tail_sum1[1];
+ head_b = head_prod1[1];
+ tail_b = tail_prod1[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[1] = head_t;
+ tail_sum1[1] = tail_t;
+ }
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ double head_e1, tail_e1;
+ double d1;
+ double d2;
+ /* Real part */
+ d1 = (double) a_elem[0] * x_elem[0];
+ d2 = (double) -a_elem[1] * x_elem[1];
+ {
+ /* Compute double-double = double + double. */
+ double e, t1, t2;
+
+ /* Knuth trick. */
+ t1 = d1 + d2;
+ e = t1 - d1;
+ t2 = ((d2 - e) + (d1 - (t1 - e)));
+
+ /* The result is t1 + t2, after normalization. */
+ head_e1 = t1 + t2;
+ tail_e1 = t2 - (head_e1 - t1);
+ }
+ head_prod2[0] = head_e1;
+ tail_prod2[0] = tail_e1;
+ /* imaginary part */
+ d1 = (double) a_elem[0] * x_elem[1];
+ d2 = (double) a_elem[1] * x_elem[0];
+ {
+ /* Compute double-double = double + double. */
+ double e, t1, t2;
+
+ /* Knuth trick. */
+ t1 = d1 + d2;
+ e = t1 - d1;
+ t2 = ((d2 - e) + (d1 - (t1 - e)));
+
+ /* The result is t1 + t2, after normalization. */
+ head_e1 = t1 + t2;
+ tail_e1 = t2 - (head_e1 - t1);
+ }
+ head_prod2[1] = head_e1;
+ tail_prod2[1] = tail_e1;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum2[0];
+ tail_a = tail_sum2[0];
+ head_b = head_prod2[0];
+ tail_b = tail_prod2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[0] = head_t;
+ tail_sum2[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum2[1];
+ tail_a = tail_sum2[1];
+ head_b = head_prod2[1];
+ tail_b = tail_prod2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[1] = head_t;
+ tail_sum2[1] = tail_t;
+ }
+ }
+
+ diag_elem = a_i[aij];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ head_prod1[0] = (double) x_elem[0] * diag_elem;
+ tail_prod1[0] = 0.0;
+ head_prod1[1] = (double) x_elem[1] * diag_elem;
+ tail_prod1[1] = 0.0;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum1[0];
+ tail_a = tail_sum1[0];
+ head_b = head_prod1[0];
+ tail_b = tail_prod1[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[0] = head_t;
+ tail_sum1[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum1[1];
+ tail_a = tail_sum1[1];
+ head_b = head_prod1[1];
+ tail_b = tail_prod1[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[1] = head_t;
+ tail_sum1[1] = tail_t;
+ }
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ head_prod2[0] = (double) x_elem[0] * diag_elem;
+ tail_prod2[0] = 0.0;
+ head_prod2[1] = (double) x_elem[1] * diag_elem;
+ tail_prod2[1] = 0.0;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum2[0];
+ tail_a = tail_sum2[0];
+ head_b = head_prod2[0];
+ tail_b = tail_prod2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[0] = head_t;
+ tail_sum2[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum2[1];
+ tail_a = tail_sum2[1];
+ head_b = head_prod2[1];
+ tail_b = tail_prod2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[1] = head_t;
+ tail_sum2[1] = tail_t;
+ }
+ j++;
+ aij += incaij2;
+ xi += incx;
+
+ for (; j < n; j++, aij += incaij2, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ a_elem[1] = -a_elem[1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ double head_e1, tail_e1;
+ double d1;
+ double d2;
+ /* Real part */
+ d1 = (double) a_elem[0] * x_elem[0];
+ d2 = (double) -a_elem[1] * x_elem[1];
+ {
+ /* Compute double-double = double + double. */
+ double e, t1, t2;
+
+ /* Knuth trick. */
+ t1 = d1 + d2;
+ e = t1 - d1;
+ t2 = ((d2 - e) + (d1 - (t1 - e)));
+
+ /* The result is t1 + t2, after normalization. */
+ head_e1 = t1 + t2;
+ tail_e1 = t2 - (head_e1 - t1);
+ }
+ head_prod1[0] = head_e1;
+ tail_prod1[0] = tail_e1;
+ /* imaginary part */
+ d1 = (double) a_elem[0] * x_elem[1];
+ d2 = (double) a_elem[1] * x_elem[0];
+ {
+ /* Compute double-double = double + double. */
+ double e, t1, t2;
+
+ /* Knuth trick. */
+ t1 = d1 + d2;
+ e = t1 - d1;
+ t2 = ((d2 - e) + (d1 - (t1 - e)));
+
+ /* The result is t1 + t2, after normalization. */
+ head_e1 = t1 + t2;
+ tail_e1 = t2 - (head_e1 - t1);
+ }
+ head_prod1[1] = head_e1;
+ tail_prod1[1] = tail_e1;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum1[0];
+ tail_a = tail_sum1[0];
+ head_b = head_prod1[0];
+ tail_b = tail_prod1[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[0] = head_t;
+ tail_sum1[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum1[1];
+ tail_a = tail_sum1[1];
+ head_b = head_prod1[1];
+ tail_b = tail_prod1[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[1] = head_t;
+ tail_sum1[1] = tail_t;
+ }
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ double head_e1, tail_e1;
+ double d1;
+ double d2;
+ /* Real part */
+ d1 = (double) a_elem[0] * x_elem[0];
+ d2 = (double) -a_elem[1] * x_elem[1];
+ {
+ /* Compute double-double = double + double. */
+ double e, t1, t2;
+
+ /* Knuth trick. */
+ t1 = d1 + d2;
+ e = t1 - d1;
+ t2 = ((d2 - e) + (d1 - (t1 - e)));
+
+ /* The result is t1 + t2, after normalization. */
+ head_e1 = t1 + t2;
+ tail_e1 = t2 - (head_e1 - t1);
+ }
+ head_prod2[0] = head_e1;
+ tail_prod2[0] = tail_e1;
+ /* imaginary part */
+ d1 = (double) a_elem[0] * x_elem[1];
+ d2 = (double) a_elem[1] * x_elem[0];
+ {
+ /* Compute double-double = double + double. */
+ double e, t1, t2;
+
+ /* Knuth trick. */
+ t1 = d1 + d2;
+ e = t1 - d1;
+ t2 = ((d2 - e) + (d1 - (t1 - e)));
+
+ /* The result is t1 + t2, after normalization. */
+ head_e1 = t1 + t2;
+ tail_e1 = t2 - (head_e1 - t1);
+ }
+ head_prod2[1] = head_e1;
+ tail_prod2[1] = tail_e1;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum2[0];
+ tail_a = tail_sum2[0];
+ head_b = head_prod2[0];
+ tail_b = tail_prod2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[0] = head_t;
+ tail_sum2[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum2[1];
+ tail_a = tail_sum2[1];
+ head_b = head_prod2[1];
+ tail_b = tail_prod2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[1] = head_t;
+ tail_sum2[1] = tail_t;
+ }
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum1[0];
+ tail_a = tail_sum1[0];
+ head_b = head_sum2[0];
+ tail_b = tail_sum2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[0] = head_t;
+ tail_sum1[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum1[1];
+ tail_a = tail_sum1[1];
+ head_b = head_sum2[1];
+ tail_b = tail_sum2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[1] = head_t;
+ tail_sum1[1] = tail_t;
+ }
+ {
+ double cd[2];
+ cd[0] = (double) alpha_i[0];
+ cd[1] = (double) alpha_i[1];
+ {
+ /* Compute complex-extra = complex-extra * complex-double. */
+ double head_a0, tail_a0;
+ double head_a1, tail_a1;
+ double head_t1, tail_t1;
+ double head_t2, tail_t2;
+ head_a0 = head_sum1[0];
+ tail_a0 = tail_sum1[0];
+ head_a1 = head_sum1[1];
+ tail_a1 = tail_sum1[1];
+ /* real part */
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_a0 * split;
+ a11 = con - head_a0;
+ a11 = con - a11;
+ a21 = head_a0 - a11;
+ con = cd[0] * split;
+ b1 = con - cd[0];
+ b1 = con - b1;
+ b2 = cd[0] - b1;
+
+ c11 = head_a0 * cd[0];
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_a0 * cd[0];
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_a1 * split;
+ a11 = con - head_a1;
+ a11 = con - a11;
+ a21 = head_a1 - a11;
+ con = cd[1] * split;
+ b1 = con - cd[1];
+ b1 = con - b1;
+ b2 = cd[1] - b1;
+
+ c11 = head_a1 * cd[1];
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_a1 * cd[1];
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_t2 = t1 + t2;
+ tail_t2 = t2 - (head_t2 - t1);
+ }
+ head_t2 = -head_t2;
+ tail_t2 = -tail_t2;
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_tmp1[0] = head_t1;
+ tail_tmp1[0] = tail_t1;
+ /* imaginary part */
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_a1 * split;
+ a11 = con - head_a1;
+ a11 = con - a11;
+ a21 = head_a1 - a11;
+ con = cd[0] * split;
+ b1 = con - cd[0];
+ b1 = con - b1;
+ b2 = cd[0] - b1;
+
+ c11 = head_a1 * cd[0];
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_a1 * cd[0];
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_a0 * split;
+ a11 = con - head_a0;
+ a11 = con - a11;
+ a21 = head_a0 - a11;
+ con = cd[1] * split;
+ b1 = con - cd[1];
+ b1 = con - b1;
+ b2 = cd[1] - b1;
+
+ c11 = head_a0 * cd[1];
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_a0 * cd[1];
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_t2 = t1 + t2;
+ tail_t2 = t2 - (head_t2 - t1);
+ }
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_tmp1[1] = head_t1;
+ tail_tmp1[1] = tail_t1;
+ }
+
+ }
+ y_elem[0] = y_i[yi];
+ y_elem[1] = y_i[yi + 1];
+ {
+ double head_e1, tail_e1;
+ double d1;
+ double d2;
+ /* Real part */
+ d1 = (double) y_elem[0] * beta_i[0];
+ d2 = (double) -y_elem[1] * beta_i[1];
+ {
+ /* Compute double-double = double + double. */
+ double e, t1, t2;
+
+ /* Knuth trick. */
+ t1 = d1 + d2;
+ e = t1 - d1;
+ t2 = ((d2 - e) + (d1 - (t1 - e)));
+
+ /* The result is t1 + t2, after normalization. */
+ head_e1 = t1 + t2;
+ tail_e1 = t2 - (head_e1 - t1);
+ }
+ head_tmp2[0] = head_e1;
+ tail_tmp2[0] = tail_e1;
+ /* imaginary part */
+ d1 = (double) y_elem[0] * beta_i[1];
+ d2 = (double) y_elem[1] * beta_i[0];
+ {
+ /* Compute double-double = double + double. */
+ double e, t1, t2;
+
+ /* Knuth trick. */
+ t1 = d1 + d2;
+ e = t1 - d1;
+ t2 = ((d2 - e) + (d1 - (t1 - e)));
+
+ /* The result is t1 + t2, after normalization. */
+ head_e1 = t1 + t2;
+ tail_e1 = t2 - (head_e1 - t1);
+ }
+ head_tmp2[1] = head_e1;
+ tail_tmp2[1] = tail_e1;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_tmp1[0];
+ tail_a = tail_tmp1[0];
+ head_b = head_tmp2[0];
+ tail_b = tail_tmp2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_tmp3[0] = head_t;
+ tail_tmp3[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_tmp1[1];
+ tail_a = tail_tmp1[1];
+ head_b = head_tmp2[1];
+ tail_b = tail_tmp2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_tmp3[1] = head_t;
+ tail_tmp3[1] = tail_t;
+ }
+ y_i[yi] = head_tmp3[0];
+ y_i[yi + 1] = head_tmp3[1];
+ }
+ } else {
+ /* uplo == blas_upper */
+ for (i = 0, yi = yi0, ai = 0; i < n; i++, yi += incy, ai += incai) {
+ head_sum1[0] = head_sum1[1] = tail_sum1[0] = tail_sum1[1] = 0.0;
+ head_sum2[0] = head_sum2[1] = tail_sum2[0] = tail_sum2[1] = 0.0;
+
+ for (j = 0, aij = ai, xi = xi0; j < i;
+ j++, aij += incaij, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ a_elem[1] = -a_elem[1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ double head_e1, tail_e1;
+ double d1;
+ double d2;
+ /* Real part */
+ d1 = (double) a_elem[0] * x_elem[0];
+ d2 = (double) -a_elem[1] * x_elem[1];
+ {
+ /* Compute double-double = double + double. */
+ double e, t1, t2;
+
+ /* Knuth trick. */
+ t1 = d1 + d2;
+ e = t1 - d1;
+ t2 = ((d2 - e) + (d1 - (t1 - e)));
+
+ /* The result is t1 + t2, after normalization. */
+ head_e1 = t1 + t2;
+ tail_e1 = t2 - (head_e1 - t1);
+ }
+ head_prod1[0] = head_e1;
+ tail_prod1[0] = tail_e1;
+ /* imaginary part */
+ d1 = (double) a_elem[0] * x_elem[1];
+ d2 = (double) a_elem[1] * x_elem[0];
+ {
+ /* Compute double-double = double + double. */
+ double e, t1, t2;
+
+ /* Knuth trick. */
+ t1 = d1 + d2;
+ e = t1 - d1;
+ t2 = ((d2 - e) + (d1 - (t1 - e)));
+
+ /* The result is t1 + t2, after normalization. */
+ head_e1 = t1 + t2;
+ tail_e1 = t2 - (head_e1 - t1);
+ }
+ head_prod1[1] = head_e1;
+ tail_prod1[1] = tail_e1;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum1[0];
+ tail_a = tail_sum1[0];
+ head_b = head_prod1[0];
+ tail_b = tail_prod1[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[0] = head_t;
+ tail_sum1[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum1[1];
+ tail_a = tail_sum1[1];
+ head_b = head_prod1[1];
+ tail_b = tail_prod1[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[1] = head_t;
+ tail_sum1[1] = tail_t;
+ }
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ double head_e1, tail_e1;
+ double d1;
+ double d2;
+ /* Real part */
+ d1 = (double) a_elem[0] * x_elem[0];
+ d2 = (double) -a_elem[1] * x_elem[1];
+ {
+ /* Compute double-double = double + double. */
+ double e, t1, t2;
+
+ /* Knuth trick. */
+ t1 = d1 + d2;
+ e = t1 - d1;
+ t2 = ((d2 - e) + (d1 - (t1 - e)));
+
+ /* The result is t1 + t2, after normalization. */
+ head_e1 = t1 + t2;
+ tail_e1 = t2 - (head_e1 - t1);
+ }
+ head_prod2[0] = head_e1;
+ tail_prod2[0] = tail_e1;
+ /* imaginary part */
+ d1 = (double) a_elem[0] * x_elem[1];
+ d2 = (double) a_elem[1] * x_elem[0];
+ {
+ /* Compute double-double = double + double. */
+ double e, t1, t2;
+
+ /* Knuth trick. */
+ t1 = d1 + d2;
+ e = t1 - d1;
+ t2 = ((d2 - e) + (d1 - (t1 - e)));
+
+ /* The result is t1 + t2, after normalization. */
+ head_e1 = t1 + t2;
+ tail_e1 = t2 - (head_e1 - t1);
+ }
+ head_prod2[1] = head_e1;
+ tail_prod2[1] = tail_e1;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum2[0];
+ tail_a = tail_sum2[0];
+ head_b = head_prod2[0];
+ tail_b = tail_prod2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[0] = head_t;
+ tail_sum2[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum2[1];
+ tail_a = tail_sum2[1];
+ head_b = head_prod2[1];
+ tail_b = tail_prod2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[1] = head_t;
+ tail_sum2[1] = tail_t;
+ }
+ }
+
+ diag_elem = a_i[aij];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ head_prod1[0] = (double) x_elem[0] * diag_elem;
+ tail_prod1[0] = 0.0;
+ head_prod1[1] = (double) x_elem[1] * diag_elem;
+ tail_prod1[1] = 0.0;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum1[0];
+ tail_a = tail_sum1[0];
+ head_b = head_prod1[0];
+ tail_b = tail_prod1[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[0] = head_t;
+ tail_sum1[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum1[1];
+ tail_a = tail_sum1[1];
+ head_b = head_prod1[1];
+ tail_b = tail_prod1[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[1] = head_t;
+ tail_sum1[1] = tail_t;
+ }
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ head_prod2[0] = (double) x_elem[0] * diag_elem;
+ tail_prod2[0] = 0.0;
+ head_prod2[1] = (double) x_elem[1] * diag_elem;
+ tail_prod2[1] = 0.0;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum2[0];
+ tail_a = tail_sum2[0];
+ head_b = head_prod2[0];
+ tail_b = tail_prod2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[0] = head_t;
+ tail_sum2[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum2[1];
+ tail_a = tail_sum2[1];
+ head_b = head_prod2[1];
+ tail_b = tail_prod2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[1] = head_t;
+ tail_sum2[1] = tail_t;
+ }
+ j++;
+ aij += incaij2;
+ xi += incx;
+
+ for (; j < n; j++, aij += incaij2, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ double head_e1, tail_e1;
+ double d1;
+ double d2;
+ /* Real part */
+ d1 = (double) a_elem[0] * x_elem[0];
+ d2 = (double) -a_elem[1] * x_elem[1];
+ {
+ /* Compute double-double = double + double. */
+ double e, t1, t2;
+
+ /* Knuth trick. */
+ t1 = d1 + d2;
+ e = t1 - d1;
+ t2 = ((d2 - e) + (d1 - (t1 - e)));
+
+ /* The result is t1 + t2, after normalization. */
+ head_e1 = t1 + t2;
+ tail_e1 = t2 - (head_e1 - t1);
+ }
+ head_prod1[0] = head_e1;
+ tail_prod1[0] = tail_e1;
+ /* imaginary part */
+ d1 = (double) a_elem[0] * x_elem[1];
+ d2 = (double) a_elem[1] * x_elem[0];
+ {
+ /* Compute double-double = double + double. */
+ double e, t1, t2;
+
+ /* Knuth trick. */
+ t1 = d1 + d2;
+ e = t1 - d1;
+ t2 = ((d2 - e) + (d1 - (t1 - e)));
+
+ /* The result is t1 + t2, after normalization. */
+ head_e1 = t1 + t2;
+ tail_e1 = t2 - (head_e1 - t1);
+ }
+ head_prod1[1] = head_e1;
+ tail_prod1[1] = tail_e1;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum1[0];
+ tail_a = tail_sum1[0];
+ head_b = head_prod1[0];
+ tail_b = tail_prod1[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[0] = head_t;
+ tail_sum1[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum1[1];
+ tail_a = tail_sum1[1];
+ head_b = head_prod1[1];
+ tail_b = tail_prod1[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[1] = head_t;
+ tail_sum1[1] = tail_t;
+ }
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ double head_e1, tail_e1;
+ double d1;
+ double d2;
+ /* Real part */
+ d1 = (double) a_elem[0] * x_elem[0];
+ d2 = (double) -a_elem[1] * x_elem[1];
+ {
+ /* Compute double-double = double + double. */
+ double e, t1, t2;
+
+ /* Knuth trick. */
+ t1 = d1 + d2;
+ e = t1 - d1;
+ t2 = ((d2 - e) + (d1 - (t1 - e)));
+
+ /* The result is t1 + t2, after normalization. */
+ head_e1 = t1 + t2;
+ tail_e1 = t2 - (head_e1 - t1);
+ }
+ head_prod2[0] = head_e1;
+ tail_prod2[0] = tail_e1;
+ /* imaginary part */
+ d1 = (double) a_elem[0] * x_elem[1];
+ d2 = (double) a_elem[1] * x_elem[0];
+ {
+ /* Compute double-double = double + double. */
+ double e, t1, t2;
+
+ /* Knuth trick. */
+ t1 = d1 + d2;
+ e = t1 - d1;
+ t2 = ((d2 - e) + (d1 - (t1 - e)));
+
+ /* The result is t1 + t2, after normalization. */
+ head_e1 = t1 + t2;
+ tail_e1 = t2 - (head_e1 - t1);
+ }
+ head_prod2[1] = head_e1;
+ tail_prod2[1] = tail_e1;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum2[0];
+ tail_a = tail_sum2[0];
+ head_b = head_prod2[0];
+ tail_b = tail_prod2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[0] = head_t;
+ tail_sum2[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum2[1];
+ tail_a = tail_sum2[1];
+ head_b = head_prod2[1];
+ tail_b = tail_prod2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[1] = head_t;
+ tail_sum2[1] = tail_t;
+ }
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum1[0];
+ tail_a = tail_sum1[0];
+ head_b = head_sum2[0];
+ tail_b = tail_sum2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[0] = head_t;
+ tail_sum1[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum1[1];
+ tail_a = tail_sum1[1];
+ head_b = head_sum2[1];
+ tail_b = tail_sum2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[1] = head_t;
+ tail_sum1[1] = tail_t;
+ }
+ {
+ double cd[2];
+ cd[0] = (double) alpha_i[0];
+ cd[1] = (double) alpha_i[1];
+ {
+ /* Compute complex-extra = complex-extra * complex-double. */
+ double head_a0, tail_a0;
+ double head_a1, tail_a1;
+ double head_t1, tail_t1;
+ double head_t2, tail_t2;
+ head_a0 = head_sum1[0];
+ tail_a0 = tail_sum1[0];
+ head_a1 = head_sum1[1];
+ tail_a1 = tail_sum1[1];
+ /* real part */
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_a0 * split;
+ a11 = con - head_a0;
+ a11 = con - a11;
+ a21 = head_a0 - a11;
+ con = cd[0] * split;
+ b1 = con - cd[0];
+ b1 = con - b1;
+ b2 = cd[0] - b1;
+
+ c11 = head_a0 * cd[0];
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_a0 * cd[0];
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_a1 * split;
+ a11 = con - head_a1;
+ a11 = con - a11;
+ a21 = head_a1 - a11;
+ con = cd[1] * split;
+ b1 = con - cd[1];
+ b1 = con - b1;
+ b2 = cd[1] - b1;
+
+ c11 = head_a1 * cd[1];
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_a1 * cd[1];
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_t2 = t1 + t2;
+ tail_t2 = t2 - (head_t2 - t1);
+ }
+ head_t2 = -head_t2;
+ tail_t2 = -tail_t2;
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_tmp1[0] = head_t1;
+ tail_tmp1[0] = tail_t1;
+ /* imaginary part */
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_a1 * split;
+ a11 = con - head_a1;
+ a11 = con - a11;
+ a21 = head_a1 - a11;
+ con = cd[0] * split;
+ b1 = con - cd[0];
+ b1 = con - b1;
+ b2 = cd[0] - b1;
+
+ c11 = head_a1 * cd[0];
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_a1 * cd[0];
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_a0 * split;
+ a11 = con - head_a0;
+ a11 = con - a11;
+ a21 = head_a0 - a11;
+ con = cd[1] * split;
+ b1 = con - cd[1];
+ b1 = con - b1;
+ b2 = cd[1] - b1;
+
+ c11 = head_a0 * cd[1];
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_a0 * cd[1];
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_t2 = t1 + t2;
+ tail_t2 = t2 - (head_t2 - t1);
+ }
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_tmp1[1] = head_t1;
+ tail_tmp1[1] = tail_t1;
+ }
+
+ }
+ y_elem[0] = y_i[yi];
+ y_elem[1] = y_i[yi + 1];
+ {
+ double head_e1, tail_e1;
+ double d1;
+ double d2;
+ /* Real part */
+ d1 = (double) y_elem[0] * beta_i[0];
+ d2 = (double) -y_elem[1] * beta_i[1];
+ {
+ /* Compute double-double = double + double. */
+ double e, t1, t2;
+
+ /* Knuth trick. */
+ t1 = d1 + d2;
+ e = t1 - d1;
+ t2 = ((d2 - e) + (d1 - (t1 - e)));
+
+ /* The result is t1 + t2, after normalization. */
+ head_e1 = t1 + t2;
+ tail_e1 = t2 - (head_e1 - t1);
+ }
+ head_tmp2[0] = head_e1;
+ tail_tmp2[0] = tail_e1;
+ /* imaginary part */
+ d1 = (double) y_elem[0] * beta_i[1];
+ d2 = (double) y_elem[1] * beta_i[0];
+ {
+ /* Compute double-double = double + double. */
+ double e, t1, t2;
+
+ /* Knuth trick. */
+ t1 = d1 + d2;
+ e = t1 - d1;
+ t2 = ((d2 - e) + (d1 - (t1 - e)));
+
+ /* The result is t1 + t2, after normalization. */
+ head_e1 = t1 + t2;
+ tail_e1 = t2 - (head_e1 - t1);
+ }
+ head_tmp2[1] = head_e1;
+ tail_tmp2[1] = tail_e1;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_tmp1[0];
+ tail_a = tail_tmp1[0];
+ head_b = head_tmp2[0];
+ tail_b = tail_tmp2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_tmp3[0] = head_t;
+ tail_tmp3[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_tmp1[1];
+ tail_a = tail_tmp1[1];
+ head_b = head_tmp2[1];
+ tail_b = tail_tmp2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_tmp3[1] = head_t;
+ tail_tmp3[1] = tail_t;
+ }
+ y_i[yi] = head_tmp3[0];
+ y_i[yi + 1] = head_tmp3[1];
+ }
+ }
+
+ FPU_FIX_STOP;
+
+ break;
+ }
+ }
+} /* end BLAS_chemv2_x */
--- /dev/null
+
+#include "f2c-bridge.h"
+#include "blas_enum.h"
+void BLAS_zhemv2_c_c(enum blas_order_type order, enum blas_uplo_type uplo,
+ int n, const void *alpha, const void *a, int lda,
+ const void *x_head, const void *x_tail, int incx,
+ const void *beta, const void *y, int incy);
+
+
+extern void FC_FUNC_(blas_zhemv2_c_c, BLAS_ZHEMV2_C_C)
+
+ (int *uplo, int *n, const void *alpha, const void *a, int *lda,
+ const void *x_head, const void *x_tail, int *incx, const void *beta,
+ const void *y, int *incy) {
+ BLAS_zhemv2_c_c(blas_colmajor, (enum blas_uplo_type) *uplo, *n, alpha, a,
+ *lda, x_head, x_tail, *incx, beta, y, *incy);
+}
--- /dev/null
+#include <blas_extended.h>
+#include <blas_extended_private.h>
+#include <blas_fpu.h>
+void BLAS_zhemv2_c_c(enum blas_order_type order, enum blas_uplo_type uplo,
+ int n, const void *alpha, const void *a, int lda,
+ const void *x_head, const void *x_tail, int incx,
+ const void *beta, const void *y, int incy)
+
+/*
+ * Purpose
+ * =======
+ *
+ * This routines computes the matrix product:
+ *
+ * y <- alpha * A * (x_head + x_tail) + beta * y
+ *
+ * where A is a complex Hermitian matrix.
+ *
+ * Arguments
+ * =========
+ *
+ * order (input) enum blas_order_type
+ * Storage format of input symmetric matrix A.
+ *
+ * uplo (input) enum blas_uplo_type
+ * Determines which half of matrix A (upper or lower triangle)
+ * is accessed.
+ *
+ * n (input) int
+ * Dimension of A and size of vectors x, y.
+ *
+ * alpha (input) const void*
+ *
+ * a (input) void*
+ * Matrix A.
+ *
+ * lda (input) int
+ * Leading dimension of matrix A.
+ *
+ * x_head (input) void*
+ * Vector x_head
+ *
+ * x_tail (input) void*
+ * Vector x_tail
+ *
+ * incx (input) int
+ * Stride for vector x.
+ *
+ * beta (input) const void*
+ *
+ * y (input) void*
+ * Vector y.
+ *
+ * incy (input) int
+ * Stride for vector y.
+ *
+ */
+{
+ /* Routine name */
+ const char routine_name[] = "BLAS_zhemv2_c_c";
+
+ int i, j;
+ int xi, yi, xi0, yi0;
+ int aij, ai;
+ int incai;
+ int incaij, incaij2;
+
+ const float *a_i = (float *) a;
+ const float *x_head_i = (float *) x_head;
+ const float *x_tail_i = (float *) x_tail;
+ double *y_i = (double *) y;
+ double *alpha_i = (double *) alpha;
+ double *beta_i = (double *) beta;
+ float a_elem[2];
+ float x_elem[2];
+ double y_elem[2];
+ float diag_elem;
+ double prod1[2];
+ double prod2[2];
+ double sum1[2];
+ double sum2[2];
+ double tmp1[2];
+ double tmp2[2];
+ double tmp3[2];
+
+
+
+ /* Test for no-op */
+ if (n <= 0) {
+ return;
+ }
+ if (alpha_i[0] == 0.0 && alpha_i[1] == 0.0
+ && (beta_i[0] == 1.0 && beta_i[1] == 0.0)) {
+ return;
+ }
+
+ /* Check for error conditions. */
+ if (n < 0) {
+ BLAS_error(routine_name, -3, n, NULL);
+ }
+ if (lda < n) {
+ BLAS_error(routine_name, -6, n, NULL);
+ }
+ if (incx == 0) {
+ BLAS_error(routine_name, -9, incx, NULL);
+ }
+ if (incy == 0) {
+ BLAS_error(routine_name, -12, incy, NULL);
+ }
+
+ if ((order == blas_colmajor && uplo == blas_upper) ||
+ (order == blas_rowmajor && uplo == blas_lower)) {
+ incai = lda;
+ incaij = 1;
+ incaij2 = lda;
+ } else {
+ incai = 1;
+ incaij = lda;
+ incaij2 = 1;
+ }
+
+ incx *= 2;
+ incy *= 2;
+ incai *= 2;
+ incaij *= 2;
+ incaij2 *= 2;
+ xi0 = (incx > 0) ? 0 : ((-n + 1) * incx);
+ yi0 = (incy > 0) ? 0 : ((-n + 1) * incy);
+
+
+
+ /* The most general form, y <--- alpha * A * (x_head + x_tail) + beta * y */
+ if (uplo == blas_lower) {
+ for (i = 0, yi = yi0, ai = 0; i < n; i++, yi += incy, ai += incai) {
+ sum1[0] = sum1[1] = 0.0;
+ sum2[0] = sum2[1] = 0.0;
+ for (j = 0, aij = ai, xi = xi0; j < i; j++, aij += incaij, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] =
+ (double) a_elem[0] * x_elem[0] - (double) a_elem[1] * x_elem[1];
+ prod1[1] =
+ (double) a_elem[0] * x_elem[1] + (double) a_elem[1] * x_elem[0];
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] =
+ (double) a_elem[0] * x_elem[0] - (double) a_elem[1] * x_elem[1];
+ prod2[1] =
+ (double) a_elem[0] * x_elem[1] + (double) a_elem[1] * x_elem[0];
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+
+ diag_elem = a_i[aij];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] = (double) x_elem[0] * diag_elem;
+ prod1[1] = (double) x_elem[1] * diag_elem;
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] = (double) x_elem[0] * diag_elem;
+ prod2[1] = (double) x_elem[1] * diag_elem;
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ j++;
+ aij += incaij2;
+ xi += incx;
+
+ for (; j < n; j++, aij += incaij2, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ a_elem[1] = -a_elem[1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] =
+ (double) a_elem[0] * x_elem[0] - (double) a_elem[1] * x_elem[1];
+ prod1[1] =
+ (double) a_elem[0] * x_elem[1] + (double) a_elem[1] * x_elem[0];
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] =
+ (double) a_elem[0] * x_elem[0] - (double) a_elem[1] * x_elem[1];
+ prod2[1] =
+ (double) a_elem[0] * x_elem[1] + (double) a_elem[1] * x_elem[0];
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+ sum1[0] = sum1[0] + sum2[0];
+ sum1[1] = sum1[1] + sum2[1];
+ {
+ tmp1[0] =
+ (double) sum1[0] * alpha_i[0] - (double) sum1[1] * alpha_i[1];
+ tmp1[1] =
+ (double) sum1[0] * alpha_i[1] + (double) sum1[1] * alpha_i[0];
+ }
+ y_elem[0] = y_i[yi];
+ y_elem[1] = y_i[yi + 1];
+ {
+ tmp2[0] =
+ (double) y_elem[0] * beta_i[0] - (double) y_elem[1] * beta_i[1];
+ tmp2[1] =
+ (double) y_elem[0] * beta_i[1] + (double) y_elem[1] * beta_i[0];
+ }
+ tmp3[0] = tmp1[0] + tmp2[0];
+ tmp3[1] = tmp1[1] + tmp2[1];
+ y_i[yi] = tmp3[0];
+ y_i[yi + 1] = tmp3[1];
+ }
+ } else {
+ /* uplo == blas_upper */
+ for (i = 0, yi = yi0, ai = 0; i < n; i++, yi += incy, ai += incai) {
+ sum1[0] = sum1[1] = 0.0;
+ sum2[0] = sum2[1] = 0.0;
+
+ for (j = 0, aij = ai, xi = xi0; j < i; j++, aij += incaij, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ a_elem[1] = -a_elem[1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] =
+ (double) a_elem[0] * x_elem[0] - (double) a_elem[1] * x_elem[1];
+ prod1[1] =
+ (double) a_elem[0] * x_elem[1] + (double) a_elem[1] * x_elem[0];
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] =
+ (double) a_elem[0] * x_elem[0] - (double) a_elem[1] * x_elem[1];
+ prod2[1] =
+ (double) a_elem[0] * x_elem[1] + (double) a_elem[1] * x_elem[0];
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+
+ diag_elem = a_i[aij];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] = (double) x_elem[0] * diag_elem;
+ prod1[1] = (double) x_elem[1] * diag_elem;
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] = (double) x_elem[0] * diag_elem;
+ prod2[1] = (double) x_elem[1] * diag_elem;
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ j++;
+ aij += incaij2;
+ xi += incx;
+
+ for (; j < n; j++, aij += incaij2, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] =
+ (double) a_elem[0] * x_elem[0] - (double) a_elem[1] * x_elem[1];
+ prod1[1] =
+ (double) a_elem[0] * x_elem[1] + (double) a_elem[1] * x_elem[0];
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] =
+ (double) a_elem[0] * x_elem[0] - (double) a_elem[1] * x_elem[1];
+ prod2[1] =
+ (double) a_elem[0] * x_elem[1] + (double) a_elem[1] * x_elem[0];
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+ sum1[0] = sum1[0] + sum2[0];
+ sum1[1] = sum1[1] + sum2[1];
+ {
+ tmp1[0] =
+ (double) sum1[0] * alpha_i[0] - (double) sum1[1] * alpha_i[1];
+ tmp1[1] =
+ (double) sum1[0] * alpha_i[1] + (double) sum1[1] * alpha_i[0];
+ }
+ y_elem[0] = y_i[yi];
+ y_elem[1] = y_i[yi + 1];
+ {
+ tmp2[0] =
+ (double) y_elem[0] * beta_i[0] - (double) y_elem[1] * beta_i[1];
+ tmp2[1] =
+ (double) y_elem[0] * beta_i[1] + (double) y_elem[1] * beta_i[0];
+ }
+ tmp3[0] = tmp1[0] + tmp2[0];
+ tmp3[1] = tmp1[1] + tmp2[1];
+ y_i[yi] = tmp3[0];
+ y_i[yi + 1] = tmp3[1];
+ }
+ }
+
+
+
+} /* end BLAS_zhemv2_c_c */
--- /dev/null
+
+#include "f2c-bridge.h"
+#include "blas_enum.h"
+void BLAS_zhemv2_c_c_x(enum blas_order_type order, enum blas_uplo_type uplo,
+ int n, const void *alpha, const void *a, int lda,
+ const void *x_head, const void *x_tail, int incx,
+ const void *beta, const void *y, int incy,
+ enum blas_prec_type prec);
+
+
+extern void FC_FUNC_(blas_zhemv2_c_c_x, BLAS_ZHEMV2_C_C_X)
+
+ (int *uplo, int *n, const void *alpha, const void *a, int *lda,
+ const void *x_head, const void *x_tail, int *incx, const void *beta,
+ const void *y, int *incy, int *prec) {
+ BLAS_zhemv2_c_c_x(blas_colmajor, (enum blas_uplo_type) *uplo, *n, alpha, a,
+ *lda, x_head, x_tail, *incx, beta, y, *incy,
+ (enum blas_prec_type) *prec);
+}
--- /dev/null
+#include <blas_extended.h>
+#include <blas_extended_private.h>
+#include <blas_fpu.h>
+void BLAS_zhemv2_c_c_x(enum blas_order_type order, enum blas_uplo_type uplo,
+ int n, const void *alpha, const void *a, int lda,
+ const void *x_head, const void *x_tail, int incx,
+ const void *beta, const void *y, int incy,
+ enum blas_prec_type prec)
+
+/*
+ * Purpose
+ * =======
+ *
+ * This routines computes the matrix product:
+ *
+ * y <- alpha * A * (x_head + x_tail) + beta * y
+ *
+ * where A is a complex Hermitian matrix.
+ *
+ * Arguments
+ * =========
+ *
+ * order (input) enum blas_order_type
+ * Storage format of input symmetric matrix A.
+ *
+ * uplo (input) enum blas_uplo_type
+ * Determines which half of matrix A (upper or lower triangle)
+ * is accessed.
+ *
+ * n (input) int
+ * Dimension of A and size of vectors x, y.
+ *
+ * alpha (input) const void*
+ *
+ * a (input) void*
+ * Matrix A.
+ *
+ * lda (input) int
+ * Leading dimension of matrix A.
+ *
+ * x_head (input) void*
+ * Vector x_head
+ *
+ * x_tail (input) void*
+ * Vector x_tail
+ *
+ * incx (input) int
+ * Stride for vector x.
+ *
+ * beta (input) const void*
+ *
+ * y (input) void*
+ * Vector y.
+ *
+ * incy (input) int
+ * Stride for vector y.
+ *
+ * prec (input) enum blas_prec_type
+ * Specifies the internal precision to be used.
+ * = blas_prec_single: single precision.
+ * = blas_prec_double: double precision.
+ * = blas_prec_extra : anything at least 1.5 times as accurate
+ * than double, and wider than 80-bits.
+ * We use double-double in our implementation.
+ *
+ */
+{
+ /* Routine name */
+ const char routine_name[] = "BLAS_zhemv2_c_c_x";
+ switch (prec) {
+
+ case blas_prec_single:{
+
+ int i, j;
+ int xi, yi, xi0, yi0;
+ int aij, ai;
+ int incai;
+ int incaij, incaij2;
+
+ const float *a_i = (float *) a;
+ const float *x_head_i = (float *) x_head;
+ const float *x_tail_i = (float *) x_tail;
+ double *y_i = (double *) y;
+ double *alpha_i = (double *) alpha;
+ double *beta_i = (double *) beta;
+ float a_elem[2];
+ float x_elem[2];
+ double y_elem[2];
+ float diag_elem;
+ double prod1[2];
+ double prod2[2];
+ double sum1[2];
+ double sum2[2];
+ double tmp1[2];
+ double tmp2[2];
+ double tmp3[2];
+
+
+
+ /* Test for no-op */
+ if (n <= 0) {
+ return;
+ }
+ if (alpha_i[0] == 0.0 && alpha_i[1] == 0.0
+ && (beta_i[0] == 1.0 && beta_i[1] == 0.0)) {
+ return;
+ }
+
+ /* Check for error conditions. */
+ if (n < 0) {
+ BLAS_error(routine_name, -3, n, NULL);
+ }
+ if (lda < n) {
+ BLAS_error(routine_name, -6, n, NULL);
+ }
+ if (incx == 0) {
+ BLAS_error(routine_name, -9, incx, NULL);
+ }
+ if (incy == 0) {
+ BLAS_error(routine_name, -12, incy, NULL);
+ }
+
+ if ((order == blas_colmajor && uplo == blas_upper) ||
+ (order == blas_rowmajor && uplo == blas_lower)) {
+ incai = lda;
+ incaij = 1;
+ incaij2 = lda;
+ } else {
+ incai = 1;
+ incaij = lda;
+ incaij2 = 1;
+ }
+
+ incx *= 2;
+ incy *= 2;
+ incai *= 2;
+ incaij *= 2;
+ incaij2 *= 2;
+ xi0 = (incx > 0) ? 0 : ((-n + 1) * incx);
+ yi0 = (incy > 0) ? 0 : ((-n + 1) * incy);
+
+
+
+ /* The most general form, y <--- alpha * A * (x_head + x_tail) + beta * y */
+ if (uplo == blas_lower) {
+ for (i = 0, yi = yi0, ai = 0; i < n; i++, yi += incy, ai += incai) {
+ sum1[0] = sum1[1] = 0.0;
+ sum2[0] = sum2[1] = 0.0;
+ for (j = 0, aij = ai, xi = xi0; j < i;
+ j++, aij += incaij, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod1[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod2[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+
+ diag_elem = a_i[aij];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] = (double) x_elem[0] * diag_elem;
+ prod1[1] = (double) x_elem[1] * diag_elem;
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] = (double) x_elem[0] * diag_elem;
+ prod2[1] = (double) x_elem[1] * diag_elem;
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ j++;
+ aij += incaij2;
+ xi += incx;
+
+ for (; j < n; j++, aij += incaij2, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ a_elem[1] = -a_elem[1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod1[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod2[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+ sum1[0] = sum1[0] + sum2[0];
+ sum1[1] = sum1[1] + sum2[1];
+ {
+ tmp1[0] =
+ (double) sum1[0] * alpha_i[0] - (double) sum1[1] * alpha_i[1];
+ tmp1[1] =
+ (double) sum1[0] * alpha_i[1] + (double) sum1[1] * alpha_i[0];
+ }
+ y_elem[0] = y_i[yi];
+ y_elem[1] = y_i[yi + 1];
+ {
+ tmp2[0] =
+ (double) y_elem[0] * beta_i[0] - (double) y_elem[1] * beta_i[1];
+ tmp2[1] =
+ (double) y_elem[0] * beta_i[1] + (double) y_elem[1] * beta_i[0];
+ }
+ tmp3[0] = tmp1[0] + tmp2[0];
+ tmp3[1] = tmp1[1] + tmp2[1];
+ y_i[yi] = tmp3[0];
+ y_i[yi + 1] = tmp3[1];
+ }
+ } else {
+ /* uplo == blas_upper */
+ for (i = 0, yi = yi0, ai = 0; i < n; i++, yi += incy, ai += incai) {
+ sum1[0] = sum1[1] = 0.0;
+ sum2[0] = sum2[1] = 0.0;
+
+ for (j = 0, aij = ai, xi = xi0; j < i;
+ j++, aij += incaij, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ a_elem[1] = -a_elem[1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod1[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod2[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+
+ diag_elem = a_i[aij];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] = (double) x_elem[0] * diag_elem;
+ prod1[1] = (double) x_elem[1] * diag_elem;
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] = (double) x_elem[0] * diag_elem;
+ prod2[1] = (double) x_elem[1] * diag_elem;
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ j++;
+ aij += incaij2;
+ xi += incx;
+
+ for (; j < n; j++, aij += incaij2, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod1[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod2[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+ sum1[0] = sum1[0] + sum2[0];
+ sum1[1] = sum1[1] + sum2[1];
+ {
+ tmp1[0] =
+ (double) sum1[0] * alpha_i[0] - (double) sum1[1] * alpha_i[1];
+ tmp1[1] =
+ (double) sum1[0] * alpha_i[1] + (double) sum1[1] * alpha_i[0];
+ }
+ y_elem[0] = y_i[yi];
+ y_elem[1] = y_i[yi + 1];
+ {
+ tmp2[0] =
+ (double) y_elem[0] * beta_i[0] - (double) y_elem[1] * beta_i[1];
+ tmp2[1] =
+ (double) y_elem[0] * beta_i[1] + (double) y_elem[1] * beta_i[0];
+ }
+ tmp3[0] = tmp1[0] + tmp2[0];
+ tmp3[1] = tmp1[1] + tmp2[1];
+ y_i[yi] = tmp3[0];
+ y_i[yi + 1] = tmp3[1];
+ }
+ }
+
+
+
+ break;
+ }
+
+ case blas_prec_double:
+ case blas_prec_indigenous:{
+
+ int i, j;
+ int xi, yi, xi0, yi0;
+ int aij, ai;
+ int incai;
+ int incaij, incaij2;
+
+ const float *a_i = (float *) a;
+ const float *x_head_i = (float *) x_head;
+ const float *x_tail_i = (float *) x_tail;
+ double *y_i = (double *) y;
+ double *alpha_i = (double *) alpha;
+ double *beta_i = (double *) beta;
+ float a_elem[2];
+ float x_elem[2];
+ double y_elem[2];
+ float diag_elem;
+ double prod1[2];
+ double prod2[2];
+ double sum1[2];
+ double sum2[2];
+ double tmp1[2];
+ double tmp2[2];
+ double tmp3[2];
+
+
+
+ /* Test for no-op */
+ if (n <= 0) {
+ return;
+ }
+ if (alpha_i[0] == 0.0 && alpha_i[1] == 0.0
+ && (beta_i[0] == 1.0 && beta_i[1] == 0.0)) {
+ return;
+ }
+
+ /* Check for error conditions. */
+ if (n < 0) {
+ BLAS_error(routine_name, -3, n, NULL);
+ }
+ if (lda < n) {
+ BLAS_error(routine_name, -6, n, NULL);
+ }
+ if (incx == 0) {
+ BLAS_error(routine_name, -9, incx, NULL);
+ }
+ if (incy == 0) {
+ BLAS_error(routine_name, -12, incy, NULL);
+ }
+
+ if ((order == blas_colmajor && uplo == blas_upper) ||
+ (order == blas_rowmajor && uplo == blas_lower)) {
+ incai = lda;
+ incaij = 1;
+ incaij2 = lda;
+ } else {
+ incai = 1;
+ incaij = lda;
+ incaij2 = 1;
+ }
+
+ incx *= 2;
+ incy *= 2;
+ incai *= 2;
+ incaij *= 2;
+ incaij2 *= 2;
+ xi0 = (incx > 0) ? 0 : ((-n + 1) * incx);
+ yi0 = (incy > 0) ? 0 : ((-n + 1) * incy);
+
+
+
+ /* The most general form, y <--- alpha * A * (x_head + x_tail) + beta * y */
+ if (uplo == blas_lower) {
+ for (i = 0, yi = yi0, ai = 0; i < n; i++, yi += incy, ai += incai) {
+ sum1[0] = sum1[1] = 0.0;
+ sum2[0] = sum2[1] = 0.0;
+ for (j = 0, aij = ai, xi = xi0; j < i;
+ j++, aij += incaij, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod1[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod2[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+
+ diag_elem = a_i[aij];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] = (double) x_elem[0] * diag_elem;
+ prod1[1] = (double) x_elem[1] * diag_elem;
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] = (double) x_elem[0] * diag_elem;
+ prod2[1] = (double) x_elem[1] * diag_elem;
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ j++;
+ aij += incaij2;
+ xi += incx;
+
+ for (; j < n; j++, aij += incaij2, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ a_elem[1] = -a_elem[1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod1[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod2[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+ sum1[0] = sum1[0] + sum2[0];
+ sum1[1] = sum1[1] + sum2[1];
+ {
+ tmp1[0] =
+ (double) sum1[0] * alpha_i[0] - (double) sum1[1] * alpha_i[1];
+ tmp1[1] =
+ (double) sum1[0] * alpha_i[1] + (double) sum1[1] * alpha_i[0];
+ }
+ y_elem[0] = y_i[yi];
+ y_elem[1] = y_i[yi + 1];
+ {
+ tmp2[0] =
+ (double) y_elem[0] * beta_i[0] - (double) y_elem[1] * beta_i[1];
+ tmp2[1] =
+ (double) y_elem[0] * beta_i[1] + (double) y_elem[1] * beta_i[0];
+ }
+ tmp3[0] = tmp1[0] + tmp2[0];
+ tmp3[1] = tmp1[1] + tmp2[1];
+ y_i[yi] = tmp3[0];
+ y_i[yi + 1] = tmp3[1];
+ }
+ } else {
+ /* uplo == blas_upper */
+ for (i = 0, yi = yi0, ai = 0; i < n; i++, yi += incy, ai += incai) {
+ sum1[0] = sum1[1] = 0.0;
+ sum2[0] = sum2[1] = 0.0;
+
+ for (j = 0, aij = ai, xi = xi0; j < i;
+ j++, aij += incaij, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ a_elem[1] = -a_elem[1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod1[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod2[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+
+ diag_elem = a_i[aij];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] = (double) x_elem[0] * diag_elem;
+ prod1[1] = (double) x_elem[1] * diag_elem;
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] = (double) x_elem[0] * diag_elem;
+ prod2[1] = (double) x_elem[1] * diag_elem;
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ j++;
+ aij += incaij2;
+ xi += incx;
+
+ for (; j < n; j++, aij += incaij2, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod1[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod2[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+ sum1[0] = sum1[0] + sum2[0];
+ sum1[1] = sum1[1] + sum2[1];
+ {
+ tmp1[0] =
+ (double) sum1[0] * alpha_i[0] - (double) sum1[1] * alpha_i[1];
+ tmp1[1] =
+ (double) sum1[0] * alpha_i[1] + (double) sum1[1] * alpha_i[0];
+ }
+ y_elem[0] = y_i[yi];
+ y_elem[1] = y_i[yi + 1];
+ {
+ tmp2[0] =
+ (double) y_elem[0] * beta_i[0] - (double) y_elem[1] * beta_i[1];
+ tmp2[1] =
+ (double) y_elem[0] * beta_i[1] + (double) y_elem[1] * beta_i[0];
+ }
+ tmp3[0] = tmp1[0] + tmp2[0];
+ tmp3[1] = tmp1[1] + tmp2[1];
+ y_i[yi] = tmp3[0];
+ y_i[yi + 1] = tmp3[1];
+ }
+ }
+
+
+
+ break;
+ }
+
+ case blas_prec_extra:{
+
+ int i, j;
+ int xi, yi, xi0, yi0;
+ int aij, ai;
+ int incai;
+ int incaij, incaij2;
+
+ const float *a_i = (float *) a;
+ const float *x_head_i = (float *) x_head;
+ const float *x_tail_i = (float *) x_tail;
+ double *y_i = (double *) y;
+ double *alpha_i = (double *) alpha;
+ double *beta_i = (double *) beta;
+ float a_elem[2];
+ float x_elem[2];
+ double y_elem[2];
+ float diag_elem;
+ double head_prod1[2], tail_prod1[2];
+ double head_prod2[2], tail_prod2[2];
+ double head_sum1[2], tail_sum1[2];
+ double head_sum2[2], tail_sum2[2];
+ double head_tmp1[2], tail_tmp1[2];
+ double head_tmp2[2], tail_tmp2[2];
+ double head_tmp3[2], tail_tmp3[2];
+
+ FPU_FIX_DECL;
+
+ /* Test for no-op */
+ if (n <= 0) {
+ return;
+ }
+ if (alpha_i[0] == 0.0 && alpha_i[1] == 0.0
+ && (beta_i[0] == 1.0 && beta_i[1] == 0.0)) {
+ return;
+ }
+
+ /* Check for error conditions. */
+ if (n < 0) {
+ BLAS_error(routine_name, -3, n, NULL);
+ }
+ if (lda < n) {
+ BLAS_error(routine_name, -6, n, NULL);
+ }
+ if (incx == 0) {
+ BLAS_error(routine_name, -9, incx, NULL);
+ }
+ if (incy == 0) {
+ BLAS_error(routine_name, -12, incy, NULL);
+ }
+
+ if ((order == blas_colmajor && uplo == blas_upper) ||
+ (order == blas_rowmajor && uplo == blas_lower)) {
+ incai = lda;
+ incaij = 1;
+ incaij2 = lda;
+ } else {
+ incai = 1;
+ incaij = lda;
+ incaij2 = 1;
+ }
+
+ incx *= 2;
+ incy *= 2;
+ incai *= 2;
+ incaij *= 2;
+ incaij2 *= 2;
+ xi0 = (incx > 0) ? 0 : ((-n + 1) * incx);
+ yi0 = (incy > 0) ? 0 : ((-n + 1) * incy);
+
+ FPU_FIX_START;
+
+ /* The most general form, y <--- alpha * A * (x_head + x_tail) + beta * y */
+ if (uplo == blas_lower) {
+ for (i = 0, yi = yi0, ai = 0; i < n; i++, yi += incy, ai += incai) {
+ head_sum1[0] = head_sum1[1] = tail_sum1[0] = tail_sum1[1] = 0.0;
+ head_sum2[0] = head_sum2[1] = tail_sum2[0] = tail_sum2[1] = 0.0;
+ for (j = 0, aij = ai, xi = xi0; j < i;
+ j++, aij += incaij, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ double head_e1, tail_e1;
+ double d1;
+ double d2;
+ /* Real part */
+ d1 = (double) a_elem[0] * x_elem[0];
+ d2 = (double) -a_elem[1] * x_elem[1];
+ {
+ /* Compute double-double = double + double. */
+ double e, t1, t2;
+
+ /* Knuth trick. */
+ t1 = d1 + d2;
+ e = t1 - d1;
+ t2 = ((d2 - e) + (d1 - (t1 - e)));
+
+ /* The result is t1 + t2, after normalization. */
+ head_e1 = t1 + t2;
+ tail_e1 = t2 - (head_e1 - t1);
+ }
+ head_prod1[0] = head_e1;
+ tail_prod1[0] = tail_e1;
+ /* imaginary part */
+ d1 = (double) a_elem[0] * x_elem[1];
+ d2 = (double) a_elem[1] * x_elem[0];
+ {
+ /* Compute double-double = double + double. */
+ double e, t1, t2;
+
+ /* Knuth trick. */
+ t1 = d1 + d2;
+ e = t1 - d1;
+ t2 = ((d2 - e) + (d1 - (t1 - e)));
+
+ /* The result is t1 + t2, after normalization. */
+ head_e1 = t1 + t2;
+ tail_e1 = t2 - (head_e1 - t1);
+ }
+ head_prod1[1] = head_e1;
+ tail_prod1[1] = tail_e1;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum1[0];
+ tail_a = tail_sum1[0];
+ head_b = head_prod1[0];
+ tail_b = tail_prod1[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[0] = head_t;
+ tail_sum1[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum1[1];
+ tail_a = tail_sum1[1];
+ head_b = head_prod1[1];
+ tail_b = tail_prod1[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[1] = head_t;
+ tail_sum1[1] = tail_t;
+ }
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ double head_e1, tail_e1;
+ double d1;
+ double d2;
+ /* Real part */
+ d1 = (double) a_elem[0] * x_elem[0];
+ d2 = (double) -a_elem[1] * x_elem[1];
+ {
+ /* Compute double-double = double + double. */
+ double e, t1, t2;
+
+ /* Knuth trick. */
+ t1 = d1 + d2;
+ e = t1 - d1;
+ t2 = ((d2 - e) + (d1 - (t1 - e)));
+
+ /* The result is t1 + t2, after normalization. */
+ head_e1 = t1 + t2;
+ tail_e1 = t2 - (head_e1 - t1);
+ }
+ head_prod2[0] = head_e1;
+ tail_prod2[0] = tail_e1;
+ /* imaginary part */
+ d1 = (double) a_elem[0] * x_elem[1];
+ d2 = (double) a_elem[1] * x_elem[0];
+ {
+ /* Compute double-double = double + double. */
+ double e, t1, t2;
+
+ /* Knuth trick. */
+ t1 = d1 + d2;
+ e = t1 - d1;
+ t2 = ((d2 - e) + (d1 - (t1 - e)));
+
+ /* The result is t1 + t2, after normalization. */
+ head_e1 = t1 + t2;
+ tail_e1 = t2 - (head_e1 - t1);
+ }
+ head_prod2[1] = head_e1;
+ tail_prod2[1] = tail_e1;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum2[0];
+ tail_a = tail_sum2[0];
+ head_b = head_prod2[0];
+ tail_b = tail_prod2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[0] = head_t;
+ tail_sum2[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum2[1];
+ tail_a = tail_sum2[1];
+ head_b = head_prod2[1];
+ tail_b = tail_prod2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[1] = head_t;
+ tail_sum2[1] = tail_t;
+ }
+ }
+
+ diag_elem = a_i[aij];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ head_prod1[0] = (double) x_elem[0] * diag_elem;
+ tail_prod1[0] = 0.0;
+ head_prod1[1] = (double) x_elem[1] * diag_elem;
+ tail_prod1[1] = 0.0;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum1[0];
+ tail_a = tail_sum1[0];
+ head_b = head_prod1[0];
+ tail_b = tail_prod1[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[0] = head_t;
+ tail_sum1[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum1[1];
+ tail_a = tail_sum1[1];
+ head_b = head_prod1[1];
+ tail_b = tail_prod1[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[1] = head_t;
+ tail_sum1[1] = tail_t;
+ }
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ head_prod2[0] = (double) x_elem[0] * diag_elem;
+ tail_prod2[0] = 0.0;
+ head_prod2[1] = (double) x_elem[1] * diag_elem;
+ tail_prod2[1] = 0.0;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum2[0];
+ tail_a = tail_sum2[0];
+ head_b = head_prod2[0];
+ tail_b = tail_prod2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[0] = head_t;
+ tail_sum2[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum2[1];
+ tail_a = tail_sum2[1];
+ head_b = head_prod2[1];
+ tail_b = tail_prod2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[1] = head_t;
+ tail_sum2[1] = tail_t;
+ }
+ j++;
+ aij += incaij2;
+ xi += incx;
+
+ for (; j < n; j++, aij += incaij2, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ a_elem[1] = -a_elem[1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ double head_e1, tail_e1;
+ double d1;
+ double d2;
+ /* Real part */
+ d1 = (double) a_elem[0] * x_elem[0];
+ d2 = (double) -a_elem[1] * x_elem[1];
+ {
+ /* Compute double-double = double + double. */
+ double e, t1, t2;
+
+ /* Knuth trick. */
+ t1 = d1 + d2;
+ e = t1 - d1;
+ t2 = ((d2 - e) + (d1 - (t1 - e)));
+
+ /* The result is t1 + t2, after normalization. */
+ head_e1 = t1 + t2;
+ tail_e1 = t2 - (head_e1 - t1);
+ }
+ head_prod1[0] = head_e1;
+ tail_prod1[0] = tail_e1;
+ /* imaginary part */
+ d1 = (double) a_elem[0] * x_elem[1];
+ d2 = (double) a_elem[1] * x_elem[0];
+ {
+ /* Compute double-double = double + double. */
+ double e, t1, t2;
+
+ /* Knuth trick. */
+ t1 = d1 + d2;
+ e = t1 - d1;
+ t2 = ((d2 - e) + (d1 - (t1 - e)));
+
+ /* The result is t1 + t2, after normalization. */
+ head_e1 = t1 + t2;
+ tail_e1 = t2 - (head_e1 - t1);
+ }
+ head_prod1[1] = head_e1;
+ tail_prod1[1] = tail_e1;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum1[0];
+ tail_a = tail_sum1[0];
+ head_b = head_prod1[0];
+ tail_b = tail_prod1[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[0] = head_t;
+ tail_sum1[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum1[1];
+ tail_a = tail_sum1[1];
+ head_b = head_prod1[1];
+ tail_b = tail_prod1[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[1] = head_t;
+ tail_sum1[1] = tail_t;
+ }
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ double head_e1, tail_e1;
+ double d1;
+ double d2;
+ /* Real part */
+ d1 = (double) a_elem[0] * x_elem[0];
+ d2 = (double) -a_elem[1] * x_elem[1];
+ {
+ /* Compute double-double = double + double. */
+ double e, t1, t2;
+
+ /* Knuth trick. */
+ t1 = d1 + d2;
+ e = t1 - d1;
+ t2 = ((d2 - e) + (d1 - (t1 - e)));
+
+ /* The result is t1 + t2, after normalization. */
+ head_e1 = t1 + t2;
+ tail_e1 = t2 - (head_e1 - t1);
+ }
+ head_prod2[0] = head_e1;
+ tail_prod2[0] = tail_e1;
+ /* imaginary part */
+ d1 = (double) a_elem[0] * x_elem[1];
+ d2 = (double) a_elem[1] * x_elem[0];
+ {
+ /* Compute double-double = double + double. */
+ double e, t1, t2;
+
+ /* Knuth trick. */
+ t1 = d1 + d2;
+ e = t1 - d1;
+ t2 = ((d2 - e) + (d1 - (t1 - e)));
+
+ /* The result is t1 + t2, after normalization. */
+ head_e1 = t1 + t2;
+ tail_e1 = t2 - (head_e1 - t1);
+ }
+ head_prod2[1] = head_e1;
+ tail_prod2[1] = tail_e1;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum2[0];
+ tail_a = tail_sum2[0];
+ head_b = head_prod2[0];
+ tail_b = tail_prod2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[0] = head_t;
+ tail_sum2[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum2[1];
+ tail_a = tail_sum2[1];
+ head_b = head_prod2[1];
+ tail_b = tail_prod2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[1] = head_t;
+ tail_sum2[1] = tail_t;
+ }
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum1[0];
+ tail_a = tail_sum1[0];
+ head_b = head_sum2[0];
+ tail_b = tail_sum2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[0] = head_t;
+ tail_sum1[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum1[1];
+ tail_a = tail_sum1[1];
+ head_b = head_sum2[1];
+ tail_b = tail_sum2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[1] = head_t;
+ tail_sum1[1] = tail_t;
+ }
+ {
+ /* Compute complex-extra = complex-extra * complex-double. */
+ double head_a0, tail_a0;
+ double head_a1, tail_a1;
+ double head_t1, tail_t1;
+ double head_t2, tail_t2;
+ head_a0 = head_sum1[0];
+ tail_a0 = tail_sum1[0];
+ head_a1 = head_sum1[1];
+ tail_a1 = tail_sum1[1];
+ /* real part */
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_a0 * split;
+ a11 = con - head_a0;
+ a11 = con - a11;
+ a21 = head_a0 - a11;
+ con = alpha_i[0] * split;
+ b1 = con - alpha_i[0];
+ b1 = con - b1;
+ b2 = alpha_i[0] - b1;
+
+ c11 = head_a0 * alpha_i[0];
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_a0 * alpha_i[0];
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_a1 * split;
+ a11 = con - head_a1;
+ a11 = con - a11;
+ a21 = head_a1 - a11;
+ con = alpha_i[1] * split;
+ b1 = con - alpha_i[1];
+ b1 = con - b1;
+ b2 = alpha_i[1] - b1;
+
+ c11 = head_a1 * alpha_i[1];
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_a1 * alpha_i[1];
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_t2 = t1 + t2;
+ tail_t2 = t2 - (head_t2 - t1);
+ }
+ head_t2 = -head_t2;
+ tail_t2 = -tail_t2;
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_tmp1[0] = head_t1;
+ tail_tmp1[0] = tail_t1;
+ /* imaginary part */
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_a1 * split;
+ a11 = con - head_a1;
+ a11 = con - a11;
+ a21 = head_a1 - a11;
+ con = alpha_i[0] * split;
+ b1 = con - alpha_i[0];
+ b1 = con - b1;
+ b2 = alpha_i[0] - b1;
+
+ c11 = head_a1 * alpha_i[0];
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_a1 * alpha_i[0];
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_a0 * split;
+ a11 = con - head_a0;
+ a11 = con - a11;
+ a21 = head_a0 - a11;
+ con = alpha_i[1] * split;
+ b1 = con - alpha_i[1];
+ b1 = con - b1;
+ b2 = alpha_i[1] - b1;
+
+ c11 = head_a0 * alpha_i[1];
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_a0 * alpha_i[1];
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_t2 = t1 + t2;
+ tail_t2 = t2 - (head_t2 - t1);
+ }
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_tmp1[1] = head_t1;
+ tail_tmp1[1] = tail_t1;
+ }
+
+ y_elem[0] = y_i[yi];
+ y_elem[1] = y_i[yi + 1];
+ {
+ /* Compute complex-extra = complex-double * complex-double. */
+ double head_t1, tail_t1;
+ double head_t2, tail_t2;
+ /* Real part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = y_elem[0] * split;
+ a1 = con - y_elem[0];
+ a1 = con - a1;
+ a2 = y_elem[0] - a1;
+ con = beta_i[0] * split;
+ b1 = con - beta_i[0];
+ b1 = con - b1;
+ b2 = beta_i[0] - b1;
+
+ head_t1 = y_elem[0] * beta_i[0];
+ tail_t1 = (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = y_elem[1] * split;
+ a1 = con - y_elem[1];
+ a1 = con - a1;
+ a2 = y_elem[1] - a1;
+ con = beta_i[1] * split;
+ b1 = con - beta_i[1];
+ b1 = con - b1;
+ b2 = beta_i[1] - b1;
+
+ head_t2 = y_elem[1] * beta_i[1];
+ tail_t2 = (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_t2 = -head_t2;
+ tail_t2 = -tail_t2;
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_tmp2[0] = head_t1;
+ tail_tmp2[0] = tail_t1;
+ /* Imaginary part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = y_elem[1] * split;
+ a1 = con - y_elem[1];
+ a1 = con - a1;
+ a2 = y_elem[1] - a1;
+ con = beta_i[0] * split;
+ b1 = con - beta_i[0];
+ b1 = con - b1;
+ b2 = beta_i[0] - b1;
+
+ head_t1 = y_elem[1] * beta_i[0];
+ tail_t1 = (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = y_elem[0] * split;
+ a1 = con - y_elem[0];
+ a1 = con - a1;
+ a2 = y_elem[0] - a1;
+ con = beta_i[1] * split;
+ b1 = con - beta_i[1];
+ b1 = con - b1;
+ b2 = beta_i[1] - b1;
+
+ head_t2 = y_elem[0] * beta_i[1];
+ tail_t2 = (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_tmp2[1] = head_t1;
+ tail_tmp2[1] = tail_t1;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_tmp1[0];
+ tail_a = tail_tmp1[0];
+ head_b = head_tmp2[0];
+ tail_b = tail_tmp2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_tmp3[0] = head_t;
+ tail_tmp3[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_tmp1[1];
+ tail_a = tail_tmp1[1];
+ head_b = head_tmp2[1];
+ tail_b = tail_tmp2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_tmp3[1] = head_t;
+ tail_tmp3[1] = tail_t;
+ }
+ y_i[yi] = head_tmp3[0];
+ y_i[yi + 1] = head_tmp3[1];
+ }
+ } else {
+ /* uplo == blas_upper */
+ for (i = 0, yi = yi0, ai = 0; i < n; i++, yi += incy, ai += incai) {
+ head_sum1[0] = head_sum1[1] = tail_sum1[0] = tail_sum1[1] = 0.0;
+ head_sum2[0] = head_sum2[1] = tail_sum2[0] = tail_sum2[1] = 0.0;
+
+ for (j = 0, aij = ai, xi = xi0; j < i;
+ j++, aij += incaij, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ a_elem[1] = -a_elem[1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ double head_e1, tail_e1;
+ double d1;
+ double d2;
+ /* Real part */
+ d1 = (double) a_elem[0] * x_elem[0];
+ d2 = (double) -a_elem[1] * x_elem[1];
+ {
+ /* Compute double-double = double + double. */
+ double e, t1, t2;
+
+ /* Knuth trick. */
+ t1 = d1 + d2;
+ e = t1 - d1;
+ t2 = ((d2 - e) + (d1 - (t1 - e)));
+
+ /* The result is t1 + t2, after normalization. */
+ head_e1 = t1 + t2;
+ tail_e1 = t2 - (head_e1 - t1);
+ }
+ head_prod1[0] = head_e1;
+ tail_prod1[0] = tail_e1;
+ /* imaginary part */
+ d1 = (double) a_elem[0] * x_elem[1];
+ d2 = (double) a_elem[1] * x_elem[0];
+ {
+ /* Compute double-double = double + double. */
+ double e, t1, t2;
+
+ /* Knuth trick. */
+ t1 = d1 + d2;
+ e = t1 - d1;
+ t2 = ((d2 - e) + (d1 - (t1 - e)));
+
+ /* The result is t1 + t2, after normalization. */
+ head_e1 = t1 + t2;
+ tail_e1 = t2 - (head_e1 - t1);
+ }
+ head_prod1[1] = head_e1;
+ tail_prod1[1] = tail_e1;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum1[0];
+ tail_a = tail_sum1[0];
+ head_b = head_prod1[0];
+ tail_b = tail_prod1[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[0] = head_t;
+ tail_sum1[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum1[1];
+ tail_a = tail_sum1[1];
+ head_b = head_prod1[1];
+ tail_b = tail_prod1[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[1] = head_t;
+ tail_sum1[1] = tail_t;
+ }
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ double head_e1, tail_e1;
+ double d1;
+ double d2;
+ /* Real part */
+ d1 = (double) a_elem[0] * x_elem[0];
+ d2 = (double) -a_elem[1] * x_elem[1];
+ {
+ /* Compute double-double = double + double. */
+ double e, t1, t2;
+
+ /* Knuth trick. */
+ t1 = d1 + d2;
+ e = t1 - d1;
+ t2 = ((d2 - e) + (d1 - (t1 - e)));
+
+ /* The result is t1 + t2, after normalization. */
+ head_e1 = t1 + t2;
+ tail_e1 = t2 - (head_e1 - t1);
+ }
+ head_prod2[0] = head_e1;
+ tail_prod2[0] = tail_e1;
+ /* imaginary part */
+ d1 = (double) a_elem[0] * x_elem[1];
+ d2 = (double) a_elem[1] * x_elem[0];
+ {
+ /* Compute double-double = double + double. */
+ double e, t1, t2;
+
+ /* Knuth trick. */
+ t1 = d1 + d2;
+ e = t1 - d1;
+ t2 = ((d2 - e) + (d1 - (t1 - e)));
+
+ /* The result is t1 + t2, after normalization. */
+ head_e1 = t1 + t2;
+ tail_e1 = t2 - (head_e1 - t1);
+ }
+ head_prod2[1] = head_e1;
+ tail_prod2[1] = tail_e1;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum2[0];
+ tail_a = tail_sum2[0];
+ head_b = head_prod2[0];
+ tail_b = tail_prod2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[0] = head_t;
+ tail_sum2[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum2[1];
+ tail_a = tail_sum2[1];
+ head_b = head_prod2[1];
+ tail_b = tail_prod2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[1] = head_t;
+ tail_sum2[1] = tail_t;
+ }
+ }
+
+ diag_elem = a_i[aij];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ head_prod1[0] = (double) x_elem[0] * diag_elem;
+ tail_prod1[0] = 0.0;
+ head_prod1[1] = (double) x_elem[1] * diag_elem;
+ tail_prod1[1] = 0.0;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum1[0];
+ tail_a = tail_sum1[0];
+ head_b = head_prod1[0];
+ tail_b = tail_prod1[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[0] = head_t;
+ tail_sum1[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum1[1];
+ tail_a = tail_sum1[1];
+ head_b = head_prod1[1];
+ tail_b = tail_prod1[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[1] = head_t;
+ tail_sum1[1] = tail_t;
+ }
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ head_prod2[0] = (double) x_elem[0] * diag_elem;
+ tail_prod2[0] = 0.0;
+ head_prod2[1] = (double) x_elem[1] * diag_elem;
+ tail_prod2[1] = 0.0;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum2[0];
+ tail_a = tail_sum2[0];
+ head_b = head_prod2[0];
+ tail_b = tail_prod2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[0] = head_t;
+ tail_sum2[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum2[1];
+ tail_a = tail_sum2[1];
+ head_b = head_prod2[1];
+ tail_b = tail_prod2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[1] = head_t;
+ tail_sum2[1] = tail_t;
+ }
+ j++;
+ aij += incaij2;
+ xi += incx;
+
+ for (; j < n; j++, aij += incaij2, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ double head_e1, tail_e1;
+ double d1;
+ double d2;
+ /* Real part */
+ d1 = (double) a_elem[0] * x_elem[0];
+ d2 = (double) -a_elem[1] * x_elem[1];
+ {
+ /* Compute double-double = double + double. */
+ double e, t1, t2;
+
+ /* Knuth trick. */
+ t1 = d1 + d2;
+ e = t1 - d1;
+ t2 = ((d2 - e) + (d1 - (t1 - e)));
+
+ /* The result is t1 + t2, after normalization. */
+ head_e1 = t1 + t2;
+ tail_e1 = t2 - (head_e1 - t1);
+ }
+ head_prod1[0] = head_e1;
+ tail_prod1[0] = tail_e1;
+ /* imaginary part */
+ d1 = (double) a_elem[0] * x_elem[1];
+ d2 = (double) a_elem[1] * x_elem[0];
+ {
+ /* Compute double-double = double + double. */
+ double e, t1, t2;
+
+ /* Knuth trick. */
+ t1 = d1 + d2;
+ e = t1 - d1;
+ t2 = ((d2 - e) + (d1 - (t1 - e)));
+
+ /* The result is t1 + t2, after normalization. */
+ head_e1 = t1 + t2;
+ tail_e1 = t2 - (head_e1 - t1);
+ }
+ head_prod1[1] = head_e1;
+ tail_prod1[1] = tail_e1;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum1[0];
+ tail_a = tail_sum1[0];
+ head_b = head_prod1[0];
+ tail_b = tail_prod1[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[0] = head_t;
+ tail_sum1[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum1[1];
+ tail_a = tail_sum1[1];
+ head_b = head_prod1[1];
+ tail_b = tail_prod1[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[1] = head_t;
+ tail_sum1[1] = tail_t;
+ }
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ double head_e1, tail_e1;
+ double d1;
+ double d2;
+ /* Real part */
+ d1 = (double) a_elem[0] * x_elem[0];
+ d2 = (double) -a_elem[1] * x_elem[1];
+ {
+ /* Compute double-double = double + double. */
+ double e, t1, t2;
+
+ /* Knuth trick. */
+ t1 = d1 + d2;
+ e = t1 - d1;
+ t2 = ((d2 - e) + (d1 - (t1 - e)));
+
+ /* The result is t1 + t2, after normalization. */
+ head_e1 = t1 + t2;
+ tail_e1 = t2 - (head_e1 - t1);
+ }
+ head_prod2[0] = head_e1;
+ tail_prod2[0] = tail_e1;
+ /* imaginary part */
+ d1 = (double) a_elem[0] * x_elem[1];
+ d2 = (double) a_elem[1] * x_elem[0];
+ {
+ /* Compute double-double = double + double. */
+ double e, t1, t2;
+
+ /* Knuth trick. */
+ t1 = d1 + d2;
+ e = t1 - d1;
+ t2 = ((d2 - e) + (d1 - (t1 - e)));
+
+ /* The result is t1 + t2, after normalization. */
+ head_e1 = t1 + t2;
+ tail_e1 = t2 - (head_e1 - t1);
+ }
+ head_prod2[1] = head_e1;
+ tail_prod2[1] = tail_e1;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum2[0];
+ tail_a = tail_sum2[0];
+ head_b = head_prod2[0];
+ tail_b = tail_prod2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[0] = head_t;
+ tail_sum2[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum2[1];
+ tail_a = tail_sum2[1];
+ head_b = head_prod2[1];
+ tail_b = tail_prod2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[1] = head_t;
+ tail_sum2[1] = tail_t;
+ }
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum1[0];
+ tail_a = tail_sum1[0];
+ head_b = head_sum2[0];
+ tail_b = tail_sum2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[0] = head_t;
+ tail_sum1[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum1[1];
+ tail_a = tail_sum1[1];
+ head_b = head_sum2[1];
+ tail_b = tail_sum2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[1] = head_t;
+ tail_sum1[1] = tail_t;
+ }
+ {
+ /* Compute complex-extra = complex-extra * complex-double. */
+ double head_a0, tail_a0;
+ double head_a1, tail_a1;
+ double head_t1, tail_t1;
+ double head_t2, tail_t2;
+ head_a0 = head_sum1[0];
+ tail_a0 = tail_sum1[0];
+ head_a1 = head_sum1[1];
+ tail_a1 = tail_sum1[1];
+ /* real part */
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_a0 * split;
+ a11 = con - head_a0;
+ a11 = con - a11;
+ a21 = head_a0 - a11;
+ con = alpha_i[0] * split;
+ b1 = con - alpha_i[0];
+ b1 = con - b1;
+ b2 = alpha_i[0] - b1;
+
+ c11 = head_a0 * alpha_i[0];
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_a0 * alpha_i[0];
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_a1 * split;
+ a11 = con - head_a1;
+ a11 = con - a11;
+ a21 = head_a1 - a11;
+ con = alpha_i[1] * split;
+ b1 = con - alpha_i[1];
+ b1 = con - b1;
+ b2 = alpha_i[1] - b1;
+
+ c11 = head_a1 * alpha_i[1];
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_a1 * alpha_i[1];
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_t2 = t1 + t2;
+ tail_t2 = t2 - (head_t2 - t1);
+ }
+ head_t2 = -head_t2;
+ tail_t2 = -tail_t2;
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_tmp1[0] = head_t1;
+ tail_tmp1[0] = tail_t1;
+ /* imaginary part */
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_a1 * split;
+ a11 = con - head_a1;
+ a11 = con - a11;
+ a21 = head_a1 - a11;
+ con = alpha_i[0] * split;
+ b1 = con - alpha_i[0];
+ b1 = con - b1;
+ b2 = alpha_i[0] - b1;
+
+ c11 = head_a1 * alpha_i[0];
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_a1 * alpha_i[0];
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_a0 * split;
+ a11 = con - head_a0;
+ a11 = con - a11;
+ a21 = head_a0 - a11;
+ con = alpha_i[1] * split;
+ b1 = con - alpha_i[1];
+ b1 = con - b1;
+ b2 = alpha_i[1] - b1;
+
+ c11 = head_a0 * alpha_i[1];
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_a0 * alpha_i[1];
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_t2 = t1 + t2;
+ tail_t2 = t2 - (head_t2 - t1);
+ }
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_tmp1[1] = head_t1;
+ tail_tmp1[1] = tail_t1;
+ }
+
+ y_elem[0] = y_i[yi];
+ y_elem[1] = y_i[yi + 1];
+ {
+ /* Compute complex-extra = complex-double * complex-double. */
+ double head_t1, tail_t1;
+ double head_t2, tail_t2;
+ /* Real part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = y_elem[0] * split;
+ a1 = con - y_elem[0];
+ a1 = con - a1;
+ a2 = y_elem[0] - a1;
+ con = beta_i[0] * split;
+ b1 = con - beta_i[0];
+ b1 = con - b1;
+ b2 = beta_i[0] - b1;
+
+ head_t1 = y_elem[0] * beta_i[0];
+ tail_t1 = (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = y_elem[1] * split;
+ a1 = con - y_elem[1];
+ a1 = con - a1;
+ a2 = y_elem[1] - a1;
+ con = beta_i[1] * split;
+ b1 = con - beta_i[1];
+ b1 = con - b1;
+ b2 = beta_i[1] - b1;
+
+ head_t2 = y_elem[1] * beta_i[1];
+ tail_t2 = (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_t2 = -head_t2;
+ tail_t2 = -tail_t2;
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_tmp2[0] = head_t1;
+ tail_tmp2[0] = tail_t1;
+ /* Imaginary part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = y_elem[1] * split;
+ a1 = con - y_elem[1];
+ a1 = con - a1;
+ a2 = y_elem[1] - a1;
+ con = beta_i[0] * split;
+ b1 = con - beta_i[0];
+ b1 = con - b1;
+ b2 = beta_i[0] - b1;
+
+ head_t1 = y_elem[1] * beta_i[0];
+ tail_t1 = (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = y_elem[0] * split;
+ a1 = con - y_elem[0];
+ a1 = con - a1;
+ a2 = y_elem[0] - a1;
+ con = beta_i[1] * split;
+ b1 = con - beta_i[1];
+ b1 = con - b1;
+ b2 = beta_i[1] - b1;
+
+ head_t2 = y_elem[0] * beta_i[1];
+ tail_t2 = (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_tmp2[1] = head_t1;
+ tail_tmp2[1] = tail_t1;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_tmp1[0];
+ tail_a = tail_tmp1[0];
+ head_b = head_tmp2[0];
+ tail_b = tail_tmp2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_tmp3[0] = head_t;
+ tail_tmp3[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_tmp1[1];
+ tail_a = tail_tmp1[1];
+ head_b = head_tmp2[1];
+ tail_b = tail_tmp2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_tmp3[1] = head_t;
+ tail_tmp3[1] = tail_t;
+ }
+ y_i[yi] = head_tmp3[0];
+ y_i[yi + 1] = head_tmp3[1];
+ }
+ }
+
+ FPU_FIX_STOP;
+
+ break;
+ }
+ }
+} /* end BLAS_zhemv2_c_c_x */
--- /dev/null
+
+#include "f2c-bridge.h"
+#include "blas_enum.h"
+void BLAS_zhemv2_c_z(enum blas_order_type order, enum blas_uplo_type uplo,
+ int n, const void *alpha, const void *a, int lda,
+ const void *x_head, const void *x_tail, int incx,
+ const void *beta, const void *y, int incy);
+
+
+extern void FC_FUNC_(blas_zhemv2_c_z, BLAS_ZHEMV2_C_Z)
+
+ (int *uplo, int *n, const void *alpha, const void *a, int *lda,
+ const void *x_head, const void *x_tail, int *incx, const void *beta,
+ const void *y, int *incy) {
+ BLAS_zhemv2_c_z(blas_colmajor, (enum blas_uplo_type) *uplo, *n, alpha, a,
+ *lda, x_head, x_tail, *incx, beta, y, *incy);
+}
--- /dev/null
+#include <blas_extended.h>
+#include <blas_extended_private.h>
+#include <blas_fpu.h>
+void BLAS_zhemv2_c_z(enum blas_order_type order, enum blas_uplo_type uplo,
+ int n, const void *alpha, const void *a, int lda,
+ const void *x_head, const void *x_tail, int incx,
+ const void *beta, const void *y, int incy)
+
+/*
+ * Purpose
+ * =======
+ *
+ * This routines computes the matrix product:
+ *
+ * y <- alpha * A * (x_head + x_tail) + beta * y
+ *
+ * where A is a complex Hermitian matrix.
+ *
+ * Arguments
+ * =========
+ *
+ * order (input) enum blas_order_type
+ * Storage format of input symmetric matrix A.
+ *
+ * uplo (input) enum blas_uplo_type
+ * Determines which half of matrix A (upper or lower triangle)
+ * is accessed.
+ *
+ * n (input) int
+ * Dimension of A and size of vectors x, y.
+ *
+ * alpha (input) const void*
+ *
+ * a (input) void*
+ * Matrix A.
+ *
+ * lda (input) int
+ * Leading dimension of matrix A.
+ *
+ * x_head (input) void*
+ * Vector x_head
+ *
+ * x_tail (input) void*
+ * Vector x_tail
+ *
+ * incx (input) int
+ * Stride for vector x.
+ *
+ * beta (input) const void*
+ *
+ * y (input) void*
+ * Vector y.
+ *
+ * incy (input) int
+ * Stride for vector y.
+ *
+ */
+{
+ /* Routine name */
+ const char routine_name[] = "BLAS_zhemv2_c_z";
+
+ int i, j;
+ int xi, yi, xi0, yi0;
+ int aij, ai;
+ int incai;
+ int incaij, incaij2;
+
+ const float *a_i = (float *) a;
+ const double *x_head_i = (double *) x_head;
+ const double *x_tail_i = (double *) x_tail;
+ double *y_i = (double *) y;
+ double *alpha_i = (double *) alpha;
+ double *beta_i = (double *) beta;
+ float a_elem[2];
+ double x_elem[2];
+ double y_elem[2];
+ float diag_elem;
+ double prod1[2];
+ double prod2[2];
+ double sum1[2];
+ double sum2[2];
+ double tmp1[2];
+ double tmp2[2];
+ double tmp3[2];
+
+
+
+ /* Test for no-op */
+ if (n <= 0) {
+ return;
+ }
+ if (alpha_i[0] == 0.0 && alpha_i[1] == 0.0
+ && (beta_i[0] == 1.0 && beta_i[1] == 0.0)) {
+ return;
+ }
+
+ /* Check for error conditions. */
+ if (n < 0) {
+ BLAS_error(routine_name, -3, n, NULL);
+ }
+ if (lda < n) {
+ BLAS_error(routine_name, -6, n, NULL);
+ }
+ if (incx == 0) {
+ BLAS_error(routine_name, -9, incx, NULL);
+ }
+ if (incy == 0) {
+ BLAS_error(routine_name, -12, incy, NULL);
+ }
+
+ if ((order == blas_colmajor && uplo == blas_upper) ||
+ (order == blas_rowmajor && uplo == blas_lower)) {
+ incai = lda;
+ incaij = 1;
+ incaij2 = lda;
+ } else {
+ incai = 1;
+ incaij = lda;
+ incaij2 = 1;
+ }
+
+ incx *= 2;
+ incy *= 2;
+ incai *= 2;
+ incaij *= 2;
+ incaij2 *= 2;
+ xi0 = (incx > 0) ? 0 : ((-n + 1) * incx);
+ yi0 = (incy > 0) ? 0 : ((-n + 1) * incy);
+
+
+
+ /* The most general form, y <--- alpha * A * (x_head + x_tail) + beta * y */
+ if (uplo == blas_lower) {
+ for (i = 0, yi = yi0, ai = 0; i < n; i++, yi += incy, ai += incai) {
+ sum1[0] = sum1[1] = 0.0;
+ sum2[0] = sum2[1] = 0.0;
+ for (j = 0, aij = ai, xi = xi0; j < i; j++, aij += incaij, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] =
+ (double) a_elem[0] * x_elem[0] - (double) a_elem[1] * x_elem[1];
+ prod1[1] =
+ (double) a_elem[0] * x_elem[1] + (double) a_elem[1] * x_elem[0];
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] =
+ (double) a_elem[0] * x_elem[0] - (double) a_elem[1] * x_elem[1];
+ prod2[1] =
+ (double) a_elem[0] * x_elem[1] + (double) a_elem[1] * x_elem[0];
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+
+ diag_elem = a_i[aij];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] = x_elem[0] * diag_elem;
+ prod1[1] = x_elem[1] * diag_elem;
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] = x_elem[0] * diag_elem;
+ prod2[1] = x_elem[1] * diag_elem;
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ j++;
+ aij += incaij2;
+ xi += incx;
+
+ for (; j < n; j++, aij += incaij2, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ a_elem[1] = -a_elem[1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] =
+ (double) a_elem[0] * x_elem[0] - (double) a_elem[1] * x_elem[1];
+ prod1[1] =
+ (double) a_elem[0] * x_elem[1] + (double) a_elem[1] * x_elem[0];
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] =
+ (double) a_elem[0] * x_elem[0] - (double) a_elem[1] * x_elem[1];
+ prod2[1] =
+ (double) a_elem[0] * x_elem[1] + (double) a_elem[1] * x_elem[0];
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+ sum1[0] = sum1[0] + sum2[0];
+ sum1[1] = sum1[1] + sum2[1];
+ {
+ tmp1[0] =
+ (double) sum1[0] * alpha_i[0] - (double) sum1[1] * alpha_i[1];
+ tmp1[1] =
+ (double) sum1[0] * alpha_i[1] + (double) sum1[1] * alpha_i[0];
+ }
+ y_elem[0] = y_i[yi];
+ y_elem[1] = y_i[yi + 1];
+ {
+ tmp2[0] =
+ (double) y_elem[0] * beta_i[0] - (double) y_elem[1] * beta_i[1];
+ tmp2[1] =
+ (double) y_elem[0] * beta_i[1] + (double) y_elem[1] * beta_i[0];
+ }
+ tmp3[0] = tmp1[0] + tmp2[0];
+ tmp3[1] = tmp1[1] + tmp2[1];
+ y_i[yi] = tmp3[0];
+ y_i[yi + 1] = tmp3[1];
+ }
+ } else {
+ /* uplo == blas_upper */
+ for (i = 0, yi = yi0, ai = 0; i < n; i++, yi += incy, ai += incai) {
+ sum1[0] = sum1[1] = 0.0;
+ sum2[0] = sum2[1] = 0.0;
+
+ for (j = 0, aij = ai, xi = xi0; j < i; j++, aij += incaij, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ a_elem[1] = -a_elem[1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] =
+ (double) a_elem[0] * x_elem[0] - (double) a_elem[1] * x_elem[1];
+ prod1[1] =
+ (double) a_elem[0] * x_elem[1] + (double) a_elem[1] * x_elem[0];
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] =
+ (double) a_elem[0] * x_elem[0] - (double) a_elem[1] * x_elem[1];
+ prod2[1] =
+ (double) a_elem[0] * x_elem[1] + (double) a_elem[1] * x_elem[0];
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+
+ diag_elem = a_i[aij];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] = x_elem[0] * diag_elem;
+ prod1[1] = x_elem[1] * diag_elem;
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] = x_elem[0] * diag_elem;
+ prod2[1] = x_elem[1] * diag_elem;
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ j++;
+ aij += incaij2;
+ xi += incx;
+
+ for (; j < n; j++, aij += incaij2, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] =
+ (double) a_elem[0] * x_elem[0] - (double) a_elem[1] * x_elem[1];
+ prod1[1] =
+ (double) a_elem[0] * x_elem[1] + (double) a_elem[1] * x_elem[0];
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] =
+ (double) a_elem[0] * x_elem[0] - (double) a_elem[1] * x_elem[1];
+ prod2[1] =
+ (double) a_elem[0] * x_elem[1] + (double) a_elem[1] * x_elem[0];
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+ sum1[0] = sum1[0] + sum2[0];
+ sum1[1] = sum1[1] + sum2[1];
+ {
+ tmp1[0] =
+ (double) sum1[0] * alpha_i[0] - (double) sum1[1] * alpha_i[1];
+ tmp1[1] =
+ (double) sum1[0] * alpha_i[1] + (double) sum1[1] * alpha_i[0];
+ }
+ y_elem[0] = y_i[yi];
+ y_elem[1] = y_i[yi + 1];
+ {
+ tmp2[0] =
+ (double) y_elem[0] * beta_i[0] - (double) y_elem[1] * beta_i[1];
+ tmp2[1] =
+ (double) y_elem[0] * beta_i[1] + (double) y_elem[1] * beta_i[0];
+ }
+ tmp3[0] = tmp1[0] + tmp2[0];
+ tmp3[1] = tmp1[1] + tmp2[1];
+ y_i[yi] = tmp3[0];
+ y_i[yi + 1] = tmp3[1];
+ }
+ }
+
+
+
+} /* end BLAS_zhemv2_c_z */
--- /dev/null
+
+#include "f2c-bridge.h"
+#include "blas_enum.h"
+void BLAS_zhemv2_c_z_x(enum blas_order_type order, enum blas_uplo_type uplo,
+ int n, const void *alpha, const void *a, int lda,
+ const void *x_head, const void *x_tail, int incx,
+ const void *beta, const void *y, int incy,
+ enum blas_prec_type prec);
+
+
+extern void FC_FUNC_(blas_zhemv2_c_z_x, BLAS_ZHEMV2_C_Z_X)
+
+ (int *uplo, int *n, const void *alpha, const void *a, int *lda,
+ const void *x_head, const void *x_tail, int *incx, const void *beta,
+ const void *y, int *incy, int *prec) {
+ BLAS_zhemv2_c_z_x(blas_colmajor, (enum blas_uplo_type) *uplo, *n, alpha, a,
+ *lda, x_head, x_tail, *incx, beta, y, *incy,
+ (enum blas_prec_type) *prec);
+}
--- /dev/null
+#include <blas_extended.h>
+#include <blas_extended_private.h>
+#include <blas_fpu.h>
+void BLAS_zhemv2_c_z_x(enum blas_order_type order, enum blas_uplo_type uplo,
+ int n, const void *alpha, const void *a, int lda,
+ const void *x_head, const void *x_tail, int incx,
+ const void *beta, const void *y, int incy,
+ enum blas_prec_type prec)
+
+/*
+ * Purpose
+ * =======
+ *
+ * This routines computes the matrix product:
+ *
+ * y <- alpha * A * (x_head + x_tail) + beta * y
+ *
+ * where A is a complex Hermitian matrix.
+ *
+ * Arguments
+ * =========
+ *
+ * order (input) enum blas_order_type
+ * Storage format of input symmetric matrix A.
+ *
+ * uplo (input) enum blas_uplo_type
+ * Determines which half of matrix A (upper or lower triangle)
+ * is accessed.
+ *
+ * n (input) int
+ * Dimension of A and size of vectors x, y.
+ *
+ * alpha (input) const void*
+ *
+ * a (input) void*
+ * Matrix A.
+ *
+ * lda (input) int
+ * Leading dimension of matrix A.
+ *
+ * x_head (input) void*
+ * Vector x_head
+ *
+ * x_tail (input) void*
+ * Vector x_tail
+ *
+ * incx (input) int
+ * Stride for vector x.
+ *
+ * beta (input) const void*
+ *
+ * y (input) void*
+ * Vector y.
+ *
+ * incy (input) int
+ * Stride for vector y.
+ *
+ * prec (input) enum blas_prec_type
+ * Specifies the internal precision to be used.
+ * = blas_prec_single: single precision.
+ * = blas_prec_double: double precision.
+ * = blas_prec_extra : anything at least 1.5 times as accurate
+ * than double, and wider than 80-bits.
+ * We use double-double in our implementation.
+ *
+ */
+{
+ /* Routine name */
+ const char routine_name[] = "BLAS_zhemv2_c_z_x";
+ switch (prec) {
+
+ case blas_prec_single:{
+
+ int i, j;
+ int xi, yi, xi0, yi0;
+ int aij, ai;
+ int incai;
+ int incaij, incaij2;
+
+ const float *a_i = (float *) a;
+ const double *x_head_i = (double *) x_head;
+ const double *x_tail_i = (double *) x_tail;
+ double *y_i = (double *) y;
+ double *alpha_i = (double *) alpha;
+ double *beta_i = (double *) beta;
+ float a_elem[2];
+ double x_elem[2];
+ double y_elem[2];
+ float diag_elem;
+ double prod1[2];
+ double prod2[2];
+ double sum1[2];
+ double sum2[2];
+ double tmp1[2];
+ double tmp2[2];
+ double tmp3[2];
+
+
+
+ /* Test for no-op */
+ if (n <= 0) {
+ return;
+ }
+ if (alpha_i[0] == 0.0 && alpha_i[1] == 0.0
+ && (beta_i[0] == 1.0 && beta_i[1] == 0.0)) {
+ return;
+ }
+
+ /* Check for error conditions. */
+ if (n < 0) {
+ BLAS_error(routine_name, -3, n, NULL);
+ }
+ if (lda < n) {
+ BLAS_error(routine_name, -6, n, NULL);
+ }
+ if (incx == 0) {
+ BLAS_error(routine_name, -9, incx, NULL);
+ }
+ if (incy == 0) {
+ BLAS_error(routine_name, -12, incy, NULL);
+ }
+
+ if ((order == blas_colmajor && uplo == blas_upper) ||
+ (order == blas_rowmajor && uplo == blas_lower)) {
+ incai = lda;
+ incaij = 1;
+ incaij2 = lda;
+ } else {
+ incai = 1;
+ incaij = lda;
+ incaij2 = 1;
+ }
+
+ incx *= 2;
+ incy *= 2;
+ incai *= 2;
+ incaij *= 2;
+ incaij2 *= 2;
+ xi0 = (incx > 0) ? 0 : ((-n + 1) * incx);
+ yi0 = (incy > 0) ? 0 : ((-n + 1) * incy);
+
+
+
+ /* The most general form, y <--- alpha * A * (x_head + x_tail) + beta * y */
+ if (uplo == blas_lower) {
+ for (i = 0, yi = yi0, ai = 0; i < n; i++, yi += incy, ai += incai) {
+ sum1[0] = sum1[1] = 0.0;
+ sum2[0] = sum2[1] = 0.0;
+ for (j = 0, aij = ai, xi = xi0; j < i;
+ j++, aij += incaij, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod1[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod2[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+
+ diag_elem = a_i[aij];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] = x_elem[0] * diag_elem;
+ prod1[1] = x_elem[1] * diag_elem;
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] = x_elem[0] * diag_elem;
+ prod2[1] = x_elem[1] * diag_elem;
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ j++;
+ aij += incaij2;
+ xi += incx;
+
+ for (; j < n; j++, aij += incaij2, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ a_elem[1] = -a_elem[1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod1[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod2[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+ sum1[0] = sum1[0] + sum2[0];
+ sum1[1] = sum1[1] + sum2[1];
+ {
+ tmp1[0] =
+ (double) sum1[0] * alpha_i[0] - (double) sum1[1] * alpha_i[1];
+ tmp1[1] =
+ (double) sum1[0] * alpha_i[1] + (double) sum1[1] * alpha_i[0];
+ }
+ y_elem[0] = y_i[yi];
+ y_elem[1] = y_i[yi + 1];
+ {
+ tmp2[0] =
+ (double) y_elem[0] * beta_i[0] - (double) y_elem[1] * beta_i[1];
+ tmp2[1] =
+ (double) y_elem[0] * beta_i[1] + (double) y_elem[1] * beta_i[0];
+ }
+ tmp3[0] = tmp1[0] + tmp2[0];
+ tmp3[1] = tmp1[1] + tmp2[1];
+ y_i[yi] = tmp3[0];
+ y_i[yi + 1] = tmp3[1];
+ }
+ } else {
+ /* uplo == blas_upper */
+ for (i = 0, yi = yi0, ai = 0; i < n; i++, yi += incy, ai += incai) {
+ sum1[0] = sum1[1] = 0.0;
+ sum2[0] = sum2[1] = 0.0;
+
+ for (j = 0, aij = ai, xi = xi0; j < i;
+ j++, aij += incaij, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ a_elem[1] = -a_elem[1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod1[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod2[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+
+ diag_elem = a_i[aij];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] = x_elem[0] * diag_elem;
+ prod1[1] = x_elem[1] * diag_elem;
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] = x_elem[0] * diag_elem;
+ prod2[1] = x_elem[1] * diag_elem;
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ j++;
+ aij += incaij2;
+ xi += incx;
+
+ for (; j < n; j++, aij += incaij2, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod1[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod2[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+ sum1[0] = sum1[0] + sum2[0];
+ sum1[1] = sum1[1] + sum2[1];
+ {
+ tmp1[0] =
+ (double) sum1[0] * alpha_i[0] - (double) sum1[1] * alpha_i[1];
+ tmp1[1] =
+ (double) sum1[0] * alpha_i[1] + (double) sum1[1] * alpha_i[0];
+ }
+ y_elem[0] = y_i[yi];
+ y_elem[1] = y_i[yi + 1];
+ {
+ tmp2[0] =
+ (double) y_elem[0] * beta_i[0] - (double) y_elem[1] * beta_i[1];
+ tmp2[1] =
+ (double) y_elem[0] * beta_i[1] + (double) y_elem[1] * beta_i[0];
+ }
+ tmp3[0] = tmp1[0] + tmp2[0];
+ tmp3[1] = tmp1[1] + tmp2[1];
+ y_i[yi] = tmp3[0];
+ y_i[yi + 1] = tmp3[1];
+ }
+ }
+
+
+
+ break;
+ }
+
+ case blas_prec_double:
+ case blas_prec_indigenous:{
+
+ int i, j;
+ int xi, yi, xi0, yi0;
+ int aij, ai;
+ int incai;
+ int incaij, incaij2;
+
+ const float *a_i = (float *) a;
+ const double *x_head_i = (double *) x_head;
+ const double *x_tail_i = (double *) x_tail;
+ double *y_i = (double *) y;
+ double *alpha_i = (double *) alpha;
+ double *beta_i = (double *) beta;
+ float a_elem[2];
+ double x_elem[2];
+ double y_elem[2];
+ float diag_elem;
+ double prod1[2];
+ double prod2[2];
+ double sum1[2];
+ double sum2[2];
+ double tmp1[2];
+ double tmp2[2];
+ double tmp3[2];
+
+
+
+ /* Test for no-op */
+ if (n <= 0) {
+ return;
+ }
+ if (alpha_i[0] == 0.0 && alpha_i[1] == 0.0
+ && (beta_i[0] == 1.0 && beta_i[1] == 0.0)) {
+ return;
+ }
+
+ /* Check for error conditions. */
+ if (n < 0) {
+ BLAS_error(routine_name, -3, n, NULL);
+ }
+ if (lda < n) {
+ BLAS_error(routine_name, -6, n, NULL);
+ }
+ if (incx == 0) {
+ BLAS_error(routine_name, -9, incx, NULL);
+ }
+ if (incy == 0) {
+ BLAS_error(routine_name, -12, incy, NULL);
+ }
+
+ if ((order == blas_colmajor && uplo == blas_upper) ||
+ (order == blas_rowmajor && uplo == blas_lower)) {
+ incai = lda;
+ incaij = 1;
+ incaij2 = lda;
+ } else {
+ incai = 1;
+ incaij = lda;
+ incaij2 = 1;
+ }
+
+ incx *= 2;
+ incy *= 2;
+ incai *= 2;
+ incaij *= 2;
+ incaij2 *= 2;
+ xi0 = (incx > 0) ? 0 : ((-n + 1) * incx);
+ yi0 = (incy > 0) ? 0 : ((-n + 1) * incy);
+
+
+
+ /* The most general form, y <--- alpha * A * (x_head + x_tail) + beta * y */
+ if (uplo == blas_lower) {
+ for (i = 0, yi = yi0, ai = 0; i < n; i++, yi += incy, ai += incai) {
+ sum1[0] = sum1[1] = 0.0;
+ sum2[0] = sum2[1] = 0.0;
+ for (j = 0, aij = ai, xi = xi0; j < i;
+ j++, aij += incaij, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod1[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod2[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+
+ diag_elem = a_i[aij];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] = x_elem[0] * diag_elem;
+ prod1[1] = x_elem[1] * diag_elem;
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] = x_elem[0] * diag_elem;
+ prod2[1] = x_elem[1] * diag_elem;
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ j++;
+ aij += incaij2;
+ xi += incx;
+
+ for (; j < n; j++, aij += incaij2, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ a_elem[1] = -a_elem[1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod1[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod2[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+ sum1[0] = sum1[0] + sum2[0];
+ sum1[1] = sum1[1] + sum2[1];
+ {
+ tmp1[0] =
+ (double) sum1[0] * alpha_i[0] - (double) sum1[1] * alpha_i[1];
+ tmp1[1] =
+ (double) sum1[0] * alpha_i[1] + (double) sum1[1] * alpha_i[0];
+ }
+ y_elem[0] = y_i[yi];
+ y_elem[1] = y_i[yi + 1];
+ {
+ tmp2[0] =
+ (double) y_elem[0] * beta_i[0] - (double) y_elem[1] * beta_i[1];
+ tmp2[1] =
+ (double) y_elem[0] * beta_i[1] + (double) y_elem[1] * beta_i[0];
+ }
+ tmp3[0] = tmp1[0] + tmp2[0];
+ tmp3[1] = tmp1[1] + tmp2[1];
+ y_i[yi] = tmp3[0];
+ y_i[yi + 1] = tmp3[1];
+ }
+ } else {
+ /* uplo == blas_upper */
+ for (i = 0, yi = yi0, ai = 0; i < n; i++, yi += incy, ai += incai) {
+ sum1[0] = sum1[1] = 0.0;
+ sum2[0] = sum2[1] = 0.0;
+
+ for (j = 0, aij = ai, xi = xi0; j < i;
+ j++, aij += incaij, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ a_elem[1] = -a_elem[1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod1[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod2[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+
+ diag_elem = a_i[aij];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] = x_elem[0] * diag_elem;
+ prod1[1] = x_elem[1] * diag_elem;
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] = x_elem[0] * diag_elem;
+ prod2[1] = x_elem[1] * diag_elem;
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ j++;
+ aij += incaij2;
+ xi += incx;
+
+ for (; j < n; j++, aij += incaij2, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod1[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod2[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+ sum1[0] = sum1[0] + sum2[0];
+ sum1[1] = sum1[1] + sum2[1];
+ {
+ tmp1[0] =
+ (double) sum1[0] * alpha_i[0] - (double) sum1[1] * alpha_i[1];
+ tmp1[1] =
+ (double) sum1[0] * alpha_i[1] + (double) sum1[1] * alpha_i[0];
+ }
+ y_elem[0] = y_i[yi];
+ y_elem[1] = y_i[yi + 1];
+ {
+ tmp2[0] =
+ (double) y_elem[0] * beta_i[0] - (double) y_elem[1] * beta_i[1];
+ tmp2[1] =
+ (double) y_elem[0] * beta_i[1] + (double) y_elem[1] * beta_i[0];
+ }
+ tmp3[0] = tmp1[0] + tmp2[0];
+ tmp3[1] = tmp1[1] + tmp2[1];
+ y_i[yi] = tmp3[0];
+ y_i[yi + 1] = tmp3[1];
+ }
+ }
+
+
+
+ break;
+ }
+
+ case blas_prec_extra:{
+
+ int i, j;
+ int xi, yi, xi0, yi0;
+ int aij, ai;
+ int incai;
+ int incaij, incaij2;
+
+ const float *a_i = (float *) a;
+ const double *x_head_i = (double *) x_head;
+ const double *x_tail_i = (double *) x_tail;
+ double *y_i = (double *) y;
+ double *alpha_i = (double *) alpha;
+ double *beta_i = (double *) beta;
+ float a_elem[2];
+ double x_elem[2];
+ double y_elem[2];
+ float diag_elem;
+ double head_prod1[2], tail_prod1[2];
+ double head_prod2[2], tail_prod2[2];
+ double head_sum1[2], tail_sum1[2];
+ double head_sum2[2], tail_sum2[2];
+ double head_tmp1[2], tail_tmp1[2];
+ double head_tmp2[2], tail_tmp2[2];
+ double head_tmp3[2], tail_tmp3[2];
+
+ FPU_FIX_DECL;
+
+ /* Test for no-op */
+ if (n <= 0) {
+ return;
+ }
+ if (alpha_i[0] == 0.0 && alpha_i[1] == 0.0
+ && (beta_i[0] == 1.0 && beta_i[1] == 0.0)) {
+ return;
+ }
+
+ /* Check for error conditions. */
+ if (n < 0) {
+ BLAS_error(routine_name, -3, n, NULL);
+ }
+ if (lda < n) {
+ BLAS_error(routine_name, -6, n, NULL);
+ }
+ if (incx == 0) {
+ BLAS_error(routine_name, -9, incx, NULL);
+ }
+ if (incy == 0) {
+ BLAS_error(routine_name, -12, incy, NULL);
+ }
+
+ if ((order == blas_colmajor && uplo == blas_upper) ||
+ (order == blas_rowmajor && uplo == blas_lower)) {
+ incai = lda;
+ incaij = 1;
+ incaij2 = lda;
+ } else {
+ incai = 1;
+ incaij = lda;
+ incaij2 = 1;
+ }
+
+ incx *= 2;
+ incy *= 2;
+ incai *= 2;
+ incaij *= 2;
+ incaij2 *= 2;
+ xi0 = (incx > 0) ? 0 : ((-n + 1) * incx);
+ yi0 = (incy > 0) ? 0 : ((-n + 1) * incy);
+
+ FPU_FIX_START;
+
+ /* The most general form, y <--- alpha * A * (x_head + x_tail) + beta * y */
+ if (uplo == blas_lower) {
+ for (i = 0, yi = yi0, ai = 0; i < n; i++, yi += incy, ai += incai) {
+ head_sum1[0] = head_sum1[1] = tail_sum1[0] = tail_sum1[1] = 0.0;
+ head_sum2[0] = head_sum2[1] = tail_sum2[0] = tail_sum2[1] = 0.0;
+ for (j = 0, aij = ai, xi = xi0; j < i;
+ j++, aij += incaij, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ double cd[2];
+ cd[0] = (double) a_elem[0];
+ cd[1] = (double) a_elem[1];
+ {
+ /* Compute complex-extra = complex-double * complex-double. */
+ double head_t1, tail_t1;
+ double head_t2, tail_t2;
+ /* Real part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = x_elem[0] * split;
+ a1 = con - x_elem[0];
+ a1 = con - a1;
+ a2 = x_elem[0] - a1;
+ con = cd[0] * split;
+ b1 = con - cd[0];
+ b1 = con - b1;
+ b2 = cd[0] - b1;
+
+ head_t1 = x_elem[0] * cd[0];
+ tail_t1 =
+ (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = x_elem[1] * split;
+ a1 = con - x_elem[1];
+ a1 = con - a1;
+ a2 = x_elem[1] - a1;
+ con = cd[1] * split;
+ b1 = con - cd[1];
+ b1 = con - b1;
+ b2 = cd[1] - b1;
+
+ head_t2 = x_elem[1] * cd[1];
+ tail_t2 =
+ (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_t2 = -head_t2;
+ tail_t2 = -tail_t2;
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_prod1[0] = head_t1;
+ tail_prod1[0] = tail_t1;
+ /* Imaginary part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = x_elem[1] * split;
+ a1 = con - x_elem[1];
+ a1 = con - a1;
+ a2 = x_elem[1] - a1;
+ con = cd[0] * split;
+ b1 = con - cd[0];
+ b1 = con - b1;
+ b2 = cd[0] - b1;
+
+ head_t1 = x_elem[1] * cd[0];
+ tail_t1 =
+ (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = x_elem[0] * split;
+ a1 = con - x_elem[0];
+ a1 = con - a1;
+ a2 = x_elem[0] - a1;
+ con = cd[1] * split;
+ b1 = con - cd[1];
+ b1 = con - b1;
+ b2 = cd[1] - b1;
+
+ head_t2 = x_elem[0] * cd[1];
+ tail_t2 =
+ (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_prod1[1] = head_t1;
+ tail_prod1[1] = tail_t1;
+ }
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum1[0];
+ tail_a = tail_sum1[0];
+ head_b = head_prod1[0];
+ tail_b = tail_prod1[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[0] = head_t;
+ tail_sum1[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum1[1];
+ tail_a = tail_sum1[1];
+ head_b = head_prod1[1];
+ tail_b = tail_prod1[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[1] = head_t;
+ tail_sum1[1] = tail_t;
+ }
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ double cd[2];
+ cd[0] = (double) a_elem[0];
+ cd[1] = (double) a_elem[1];
+ {
+ /* Compute complex-extra = complex-double * complex-double. */
+ double head_t1, tail_t1;
+ double head_t2, tail_t2;
+ /* Real part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = x_elem[0] * split;
+ a1 = con - x_elem[0];
+ a1 = con - a1;
+ a2 = x_elem[0] - a1;
+ con = cd[0] * split;
+ b1 = con - cd[0];
+ b1 = con - b1;
+ b2 = cd[0] - b1;
+
+ head_t1 = x_elem[0] * cd[0];
+ tail_t1 =
+ (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = x_elem[1] * split;
+ a1 = con - x_elem[1];
+ a1 = con - a1;
+ a2 = x_elem[1] - a1;
+ con = cd[1] * split;
+ b1 = con - cd[1];
+ b1 = con - b1;
+ b2 = cd[1] - b1;
+
+ head_t2 = x_elem[1] * cd[1];
+ tail_t2 =
+ (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_t2 = -head_t2;
+ tail_t2 = -tail_t2;
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_prod2[0] = head_t1;
+ tail_prod2[0] = tail_t1;
+ /* Imaginary part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = x_elem[1] * split;
+ a1 = con - x_elem[1];
+ a1 = con - a1;
+ a2 = x_elem[1] - a1;
+ con = cd[0] * split;
+ b1 = con - cd[0];
+ b1 = con - b1;
+ b2 = cd[0] - b1;
+
+ head_t1 = x_elem[1] * cd[0];
+ tail_t1 =
+ (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = x_elem[0] * split;
+ a1 = con - x_elem[0];
+ a1 = con - a1;
+ a2 = x_elem[0] - a1;
+ con = cd[1] * split;
+ b1 = con - cd[1];
+ b1 = con - b1;
+ b2 = cd[1] - b1;
+
+ head_t2 = x_elem[0] * cd[1];
+ tail_t2 =
+ (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_prod2[1] = head_t1;
+ tail_prod2[1] = tail_t1;
+ }
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum2[0];
+ tail_a = tail_sum2[0];
+ head_b = head_prod2[0];
+ tail_b = tail_prod2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[0] = head_t;
+ tail_sum2[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum2[1];
+ tail_a = tail_sum2[1];
+ head_b = head_prod2[1];
+ tail_b = tail_prod2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[1] = head_t;
+ tail_sum2[1] = tail_t;
+ }
+ }
+
+ diag_elem = a_i[aij];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ double dt = (double) diag_elem;
+ {
+ /* Compute complex-extra = complex-double * real. */
+ double head_t, tail_t;
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = dt * split;
+ a1 = con - dt;
+ a1 = con - a1;
+ a2 = dt - a1;
+ con = x_elem[0] * split;
+ b1 = con - x_elem[0];
+ b1 = con - b1;
+ b2 = x_elem[0] - b1;
+
+ head_t = dt * x_elem[0];
+ tail_t = (((a1 * b1 - head_t) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_prod1[0] = head_t;
+ tail_prod1[0] = tail_t;
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = dt * split;
+ a1 = con - dt;
+ a1 = con - a1;
+ a2 = dt - a1;
+ con = x_elem[1] * split;
+ b1 = con - x_elem[1];
+ b1 = con - b1;
+ b2 = x_elem[1] - b1;
+
+ head_t = dt * x_elem[1];
+ tail_t = (((a1 * b1 - head_t) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_prod1[1] = head_t;
+ tail_prod1[1] = tail_t;
+ }
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum1[0];
+ tail_a = tail_sum1[0];
+ head_b = head_prod1[0];
+ tail_b = tail_prod1[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[0] = head_t;
+ tail_sum1[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum1[1];
+ tail_a = tail_sum1[1];
+ head_b = head_prod1[1];
+ tail_b = tail_prod1[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[1] = head_t;
+ tail_sum1[1] = tail_t;
+ }
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ double dt = (double) diag_elem;
+ {
+ /* Compute complex-extra = complex-double * real. */
+ double head_t, tail_t;
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = dt * split;
+ a1 = con - dt;
+ a1 = con - a1;
+ a2 = dt - a1;
+ con = x_elem[0] * split;
+ b1 = con - x_elem[0];
+ b1 = con - b1;
+ b2 = x_elem[0] - b1;
+
+ head_t = dt * x_elem[0];
+ tail_t = (((a1 * b1 - head_t) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_prod2[0] = head_t;
+ tail_prod2[0] = tail_t;
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = dt * split;
+ a1 = con - dt;
+ a1 = con - a1;
+ a2 = dt - a1;
+ con = x_elem[1] * split;
+ b1 = con - x_elem[1];
+ b1 = con - b1;
+ b2 = x_elem[1] - b1;
+
+ head_t = dt * x_elem[1];
+ tail_t = (((a1 * b1 - head_t) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_prod2[1] = head_t;
+ tail_prod2[1] = tail_t;
+ }
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum2[0];
+ tail_a = tail_sum2[0];
+ head_b = head_prod2[0];
+ tail_b = tail_prod2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[0] = head_t;
+ tail_sum2[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum2[1];
+ tail_a = tail_sum2[1];
+ head_b = head_prod2[1];
+ tail_b = tail_prod2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[1] = head_t;
+ tail_sum2[1] = tail_t;
+ }
+ j++;
+ aij += incaij2;
+ xi += incx;
+
+ for (; j < n; j++, aij += incaij2, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ a_elem[1] = -a_elem[1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ double cd[2];
+ cd[0] = (double) a_elem[0];
+ cd[1] = (double) a_elem[1];
+ {
+ /* Compute complex-extra = complex-double * complex-double. */
+ double head_t1, tail_t1;
+ double head_t2, tail_t2;
+ /* Real part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = x_elem[0] * split;
+ a1 = con - x_elem[0];
+ a1 = con - a1;
+ a2 = x_elem[0] - a1;
+ con = cd[0] * split;
+ b1 = con - cd[0];
+ b1 = con - b1;
+ b2 = cd[0] - b1;
+
+ head_t1 = x_elem[0] * cd[0];
+ tail_t1 =
+ (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = x_elem[1] * split;
+ a1 = con - x_elem[1];
+ a1 = con - a1;
+ a2 = x_elem[1] - a1;
+ con = cd[1] * split;
+ b1 = con - cd[1];
+ b1 = con - b1;
+ b2 = cd[1] - b1;
+
+ head_t2 = x_elem[1] * cd[1];
+ tail_t2 =
+ (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_t2 = -head_t2;
+ tail_t2 = -tail_t2;
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_prod1[0] = head_t1;
+ tail_prod1[0] = tail_t1;
+ /* Imaginary part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = x_elem[1] * split;
+ a1 = con - x_elem[1];
+ a1 = con - a1;
+ a2 = x_elem[1] - a1;
+ con = cd[0] * split;
+ b1 = con - cd[0];
+ b1 = con - b1;
+ b2 = cd[0] - b1;
+
+ head_t1 = x_elem[1] * cd[0];
+ tail_t1 =
+ (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = x_elem[0] * split;
+ a1 = con - x_elem[0];
+ a1 = con - a1;
+ a2 = x_elem[0] - a1;
+ con = cd[1] * split;
+ b1 = con - cd[1];
+ b1 = con - b1;
+ b2 = cd[1] - b1;
+
+ head_t2 = x_elem[0] * cd[1];
+ tail_t2 =
+ (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_prod1[1] = head_t1;
+ tail_prod1[1] = tail_t1;
+ }
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum1[0];
+ tail_a = tail_sum1[0];
+ head_b = head_prod1[0];
+ tail_b = tail_prod1[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[0] = head_t;
+ tail_sum1[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum1[1];
+ tail_a = tail_sum1[1];
+ head_b = head_prod1[1];
+ tail_b = tail_prod1[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[1] = head_t;
+ tail_sum1[1] = tail_t;
+ }
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ double cd[2];
+ cd[0] = (double) a_elem[0];
+ cd[1] = (double) a_elem[1];
+ {
+ /* Compute complex-extra = complex-double * complex-double. */
+ double head_t1, tail_t1;
+ double head_t2, tail_t2;
+ /* Real part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = x_elem[0] * split;
+ a1 = con - x_elem[0];
+ a1 = con - a1;
+ a2 = x_elem[0] - a1;
+ con = cd[0] * split;
+ b1 = con - cd[0];
+ b1 = con - b1;
+ b2 = cd[0] - b1;
+
+ head_t1 = x_elem[0] * cd[0];
+ tail_t1 =
+ (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = x_elem[1] * split;
+ a1 = con - x_elem[1];
+ a1 = con - a1;
+ a2 = x_elem[1] - a1;
+ con = cd[1] * split;
+ b1 = con - cd[1];
+ b1 = con - b1;
+ b2 = cd[1] - b1;
+
+ head_t2 = x_elem[1] * cd[1];
+ tail_t2 =
+ (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_t2 = -head_t2;
+ tail_t2 = -tail_t2;
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_prod2[0] = head_t1;
+ tail_prod2[0] = tail_t1;
+ /* Imaginary part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = x_elem[1] * split;
+ a1 = con - x_elem[1];
+ a1 = con - a1;
+ a2 = x_elem[1] - a1;
+ con = cd[0] * split;
+ b1 = con - cd[0];
+ b1 = con - b1;
+ b2 = cd[0] - b1;
+
+ head_t1 = x_elem[1] * cd[0];
+ tail_t1 =
+ (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = x_elem[0] * split;
+ a1 = con - x_elem[0];
+ a1 = con - a1;
+ a2 = x_elem[0] - a1;
+ con = cd[1] * split;
+ b1 = con - cd[1];
+ b1 = con - b1;
+ b2 = cd[1] - b1;
+
+ head_t2 = x_elem[0] * cd[1];
+ tail_t2 =
+ (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_prod2[1] = head_t1;
+ tail_prod2[1] = tail_t1;
+ }
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum2[0];
+ tail_a = tail_sum2[0];
+ head_b = head_prod2[0];
+ tail_b = tail_prod2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[0] = head_t;
+ tail_sum2[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum2[1];
+ tail_a = tail_sum2[1];
+ head_b = head_prod2[1];
+ tail_b = tail_prod2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[1] = head_t;
+ tail_sum2[1] = tail_t;
+ }
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum1[0];
+ tail_a = tail_sum1[0];
+ head_b = head_sum2[0];
+ tail_b = tail_sum2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[0] = head_t;
+ tail_sum1[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum1[1];
+ tail_a = tail_sum1[1];
+ head_b = head_sum2[1];
+ tail_b = tail_sum2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[1] = head_t;
+ tail_sum1[1] = tail_t;
+ }
+ {
+ /* Compute complex-extra = complex-extra * complex-double. */
+ double head_a0, tail_a0;
+ double head_a1, tail_a1;
+ double head_t1, tail_t1;
+ double head_t2, tail_t2;
+ head_a0 = head_sum1[0];
+ tail_a0 = tail_sum1[0];
+ head_a1 = head_sum1[1];
+ tail_a1 = tail_sum1[1];
+ /* real part */
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_a0 * split;
+ a11 = con - head_a0;
+ a11 = con - a11;
+ a21 = head_a0 - a11;
+ con = alpha_i[0] * split;
+ b1 = con - alpha_i[0];
+ b1 = con - b1;
+ b2 = alpha_i[0] - b1;
+
+ c11 = head_a0 * alpha_i[0];
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_a0 * alpha_i[0];
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_a1 * split;
+ a11 = con - head_a1;
+ a11 = con - a11;
+ a21 = head_a1 - a11;
+ con = alpha_i[1] * split;
+ b1 = con - alpha_i[1];
+ b1 = con - b1;
+ b2 = alpha_i[1] - b1;
+
+ c11 = head_a1 * alpha_i[1];
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_a1 * alpha_i[1];
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_t2 = t1 + t2;
+ tail_t2 = t2 - (head_t2 - t1);
+ }
+ head_t2 = -head_t2;
+ tail_t2 = -tail_t2;
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_tmp1[0] = head_t1;
+ tail_tmp1[0] = tail_t1;
+ /* imaginary part */
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_a1 * split;
+ a11 = con - head_a1;
+ a11 = con - a11;
+ a21 = head_a1 - a11;
+ con = alpha_i[0] * split;
+ b1 = con - alpha_i[0];
+ b1 = con - b1;
+ b2 = alpha_i[0] - b1;
+
+ c11 = head_a1 * alpha_i[0];
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_a1 * alpha_i[0];
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_a0 * split;
+ a11 = con - head_a0;
+ a11 = con - a11;
+ a21 = head_a0 - a11;
+ con = alpha_i[1] * split;
+ b1 = con - alpha_i[1];
+ b1 = con - b1;
+ b2 = alpha_i[1] - b1;
+
+ c11 = head_a0 * alpha_i[1];
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_a0 * alpha_i[1];
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_t2 = t1 + t2;
+ tail_t2 = t2 - (head_t2 - t1);
+ }
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_tmp1[1] = head_t1;
+ tail_tmp1[1] = tail_t1;
+ }
+
+ y_elem[0] = y_i[yi];
+ y_elem[1] = y_i[yi + 1];
+ {
+ /* Compute complex-extra = complex-double * complex-double. */
+ double head_t1, tail_t1;
+ double head_t2, tail_t2;
+ /* Real part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = y_elem[0] * split;
+ a1 = con - y_elem[0];
+ a1 = con - a1;
+ a2 = y_elem[0] - a1;
+ con = beta_i[0] * split;
+ b1 = con - beta_i[0];
+ b1 = con - b1;
+ b2 = beta_i[0] - b1;
+
+ head_t1 = y_elem[0] * beta_i[0];
+ tail_t1 = (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = y_elem[1] * split;
+ a1 = con - y_elem[1];
+ a1 = con - a1;
+ a2 = y_elem[1] - a1;
+ con = beta_i[1] * split;
+ b1 = con - beta_i[1];
+ b1 = con - b1;
+ b2 = beta_i[1] - b1;
+
+ head_t2 = y_elem[1] * beta_i[1];
+ tail_t2 = (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_t2 = -head_t2;
+ tail_t2 = -tail_t2;
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_tmp2[0] = head_t1;
+ tail_tmp2[0] = tail_t1;
+ /* Imaginary part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = y_elem[1] * split;
+ a1 = con - y_elem[1];
+ a1 = con - a1;
+ a2 = y_elem[1] - a1;
+ con = beta_i[0] * split;
+ b1 = con - beta_i[0];
+ b1 = con - b1;
+ b2 = beta_i[0] - b1;
+
+ head_t1 = y_elem[1] * beta_i[0];
+ tail_t1 = (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = y_elem[0] * split;
+ a1 = con - y_elem[0];
+ a1 = con - a1;
+ a2 = y_elem[0] - a1;
+ con = beta_i[1] * split;
+ b1 = con - beta_i[1];
+ b1 = con - b1;
+ b2 = beta_i[1] - b1;
+
+ head_t2 = y_elem[0] * beta_i[1];
+ tail_t2 = (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_tmp2[1] = head_t1;
+ tail_tmp2[1] = tail_t1;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_tmp1[0];
+ tail_a = tail_tmp1[0];
+ head_b = head_tmp2[0];
+ tail_b = tail_tmp2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_tmp3[0] = head_t;
+ tail_tmp3[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_tmp1[1];
+ tail_a = tail_tmp1[1];
+ head_b = head_tmp2[1];
+ tail_b = tail_tmp2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_tmp3[1] = head_t;
+ tail_tmp3[1] = tail_t;
+ }
+ y_i[yi] = head_tmp3[0];
+ y_i[yi + 1] = head_tmp3[1];
+ }
+ } else {
+ /* uplo == blas_upper */
+ for (i = 0, yi = yi0, ai = 0; i < n; i++, yi += incy, ai += incai) {
+ head_sum1[0] = head_sum1[1] = tail_sum1[0] = tail_sum1[1] = 0.0;
+ head_sum2[0] = head_sum2[1] = tail_sum2[0] = tail_sum2[1] = 0.0;
+
+ for (j = 0, aij = ai, xi = xi0; j < i;
+ j++, aij += incaij, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ a_elem[1] = -a_elem[1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ double cd[2];
+ cd[0] = (double) a_elem[0];
+ cd[1] = (double) a_elem[1];
+ {
+ /* Compute complex-extra = complex-double * complex-double. */
+ double head_t1, tail_t1;
+ double head_t2, tail_t2;
+ /* Real part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = x_elem[0] * split;
+ a1 = con - x_elem[0];
+ a1 = con - a1;
+ a2 = x_elem[0] - a1;
+ con = cd[0] * split;
+ b1 = con - cd[0];
+ b1 = con - b1;
+ b2 = cd[0] - b1;
+
+ head_t1 = x_elem[0] * cd[0];
+ tail_t1 =
+ (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = x_elem[1] * split;
+ a1 = con - x_elem[1];
+ a1 = con - a1;
+ a2 = x_elem[1] - a1;
+ con = cd[1] * split;
+ b1 = con - cd[1];
+ b1 = con - b1;
+ b2 = cd[1] - b1;
+
+ head_t2 = x_elem[1] * cd[1];
+ tail_t2 =
+ (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_t2 = -head_t2;
+ tail_t2 = -tail_t2;
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_prod1[0] = head_t1;
+ tail_prod1[0] = tail_t1;
+ /* Imaginary part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = x_elem[1] * split;
+ a1 = con - x_elem[1];
+ a1 = con - a1;
+ a2 = x_elem[1] - a1;
+ con = cd[0] * split;
+ b1 = con - cd[0];
+ b1 = con - b1;
+ b2 = cd[0] - b1;
+
+ head_t1 = x_elem[1] * cd[0];
+ tail_t1 =
+ (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = x_elem[0] * split;
+ a1 = con - x_elem[0];
+ a1 = con - a1;
+ a2 = x_elem[0] - a1;
+ con = cd[1] * split;
+ b1 = con - cd[1];
+ b1 = con - b1;
+ b2 = cd[1] - b1;
+
+ head_t2 = x_elem[0] * cd[1];
+ tail_t2 =
+ (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_prod1[1] = head_t1;
+ tail_prod1[1] = tail_t1;
+ }
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum1[0];
+ tail_a = tail_sum1[0];
+ head_b = head_prod1[0];
+ tail_b = tail_prod1[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[0] = head_t;
+ tail_sum1[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum1[1];
+ tail_a = tail_sum1[1];
+ head_b = head_prod1[1];
+ tail_b = tail_prod1[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[1] = head_t;
+ tail_sum1[1] = tail_t;
+ }
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ double cd[2];
+ cd[0] = (double) a_elem[0];
+ cd[1] = (double) a_elem[1];
+ {
+ /* Compute complex-extra = complex-double * complex-double. */
+ double head_t1, tail_t1;
+ double head_t2, tail_t2;
+ /* Real part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = x_elem[0] * split;
+ a1 = con - x_elem[0];
+ a1 = con - a1;
+ a2 = x_elem[0] - a1;
+ con = cd[0] * split;
+ b1 = con - cd[0];
+ b1 = con - b1;
+ b2 = cd[0] - b1;
+
+ head_t1 = x_elem[0] * cd[0];
+ tail_t1 =
+ (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = x_elem[1] * split;
+ a1 = con - x_elem[1];
+ a1 = con - a1;
+ a2 = x_elem[1] - a1;
+ con = cd[1] * split;
+ b1 = con - cd[1];
+ b1 = con - b1;
+ b2 = cd[1] - b1;
+
+ head_t2 = x_elem[1] * cd[1];
+ tail_t2 =
+ (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_t2 = -head_t2;
+ tail_t2 = -tail_t2;
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_prod2[0] = head_t1;
+ tail_prod2[0] = tail_t1;
+ /* Imaginary part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = x_elem[1] * split;
+ a1 = con - x_elem[1];
+ a1 = con - a1;
+ a2 = x_elem[1] - a1;
+ con = cd[0] * split;
+ b1 = con - cd[0];
+ b1 = con - b1;
+ b2 = cd[0] - b1;
+
+ head_t1 = x_elem[1] * cd[0];
+ tail_t1 =
+ (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = x_elem[0] * split;
+ a1 = con - x_elem[0];
+ a1 = con - a1;
+ a2 = x_elem[0] - a1;
+ con = cd[1] * split;
+ b1 = con - cd[1];
+ b1 = con - b1;
+ b2 = cd[1] - b1;
+
+ head_t2 = x_elem[0] * cd[1];
+ tail_t2 =
+ (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_prod2[1] = head_t1;
+ tail_prod2[1] = tail_t1;
+ }
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum2[0];
+ tail_a = tail_sum2[0];
+ head_b = head_prod2[0];
+ tail_b = tail_prod2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[0] = head_t;
+ tail_sum2[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum2[1];
+ tail_a = tail_sum2[1];
+ head_b = head_prod2[1];
+ tail_b = tail_prod2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[1] = head_t;
+ tail_sum2[1] = tail_t;
+ }
+ }
+
+ diag_elem = a_i[aij];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ double dt = (double) diag_elem;
+ {
+ /* Compute complex-extra = complex-double * real. */
+ double head_t, tail_t;
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = dt * split;
+ a1 = con - dt;
+ a1 = con - a1;
+ a2 = dt - a1;
+ con = x_elem[0] * split;
+ b1 = con - x_elem[0];
+ b1 = con - b1;
+ b2 = x_elem[0] - b1;
+
+ head_t = dt * x_elem[0];
+ tail_t = (((a1 * b1 - head_t) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_prod1[0] = head_t;
+ tail_prod1[0] = tail_t;
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = dt * split;
+ a1 = con - dt;
+ a1 = con - a1;
+ a2 = dt - a1;
+ con = x_elem[1] * split;
+ b1 = con - x_elem[1];
+ b1 = con - b1;
+ b2 = x_elem[1] - b1;
+
+ head_t = dt * x_elem[1];
+ tail_t = (((a1 * b1 - head_t) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_prod1[1] = head_t;
+ tail_prod1[1] = tail_t;
+ }
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum1[0];
+ tail_a = tail_sum1[0];
+ head_b = head_prod1[0];
+ tail_b = tail_prod1[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[0] = head_t;
+ tail_sum1[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum1[1];
+ tail_a = tail_sum1[1];
+ head_b = head_prod1[1];
+ tail_b = tail_prod1[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[1] = head_t;
+ tail_sum1[1] = tail_t;
+ }
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ double dt = (double) diag_elem;
+ {
+ /* Compute complex-extra = complex-double * real. */
+ double head_t, tail_t;
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = dt * split;
+ a1 = con - dt;
+ a1 = con - a1;
+ a2 = dt - a1;
+ con = x_elem[0] * split;
+ b1 = con - x_elem[0];
+ b1 = con - b1;
+ b2 = x_elem[0] - b1;
+
+ head_t = dt * x_elem[0];
+ tail_t = (((a1 * b1 - head_t) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_prod2[0] = head_t;
+ tail_prod2[0] = tail_t;
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = dt * split;
+ a1 = con - dt;
+ a1 = con - a1;
+ a2 = dt - a1;
+ con = x_elem[1] * split;
+ b1 = con - x_elem[1];
+ b1 = con - b1;
+ b2 = x_elem[1] - b1;
+
+ head_t = dt * x_elem[1];
+ tail_t = (((a1 * b1 - head_t) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_prod2[1] = head_t;
+ tail_prod2[1] = tail_t;
+ }
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum2[0];
+ tail_a = tail_sum2[0];
+ head_b = head_prod2[0];
+ tail_b = tail_prod2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[0] = head_t;
+ tail_sum2[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum2[1];
+ tail_a = tail_sum2[1];
+ head_b = head_prod2[1];
+ tail_b = tail_prod2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[1] = head_t;
+ tail_sum2[1] = tail_t;
+ }
+ j++;
+ aij += incaij2;
+ xi += incx;
+
+ for (; j < n; j++, aij += incaij2, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ double cd[2];
+ cd[0] = (double) a_elem[0];
+ cd[1] = (double) a_elem[1];
+ {
+ /* Compute complex-extra = complex-double * complex-double. */
+ double head_t1, tail_t1;
+ double head_t2, tail_t2;
+ /* Real part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = x_elem[0] * split;
+ a1 = con - x_elem[0];
+ a1 = con - a1;
+ a2 = x_elem[0] - a1;
+ con = cd[0] * split;
+ b1 = con - cd[0];
+ b1 = con - b1;
+ b2 = cd[0] - b1;
+
+ head_t1 = x_elem[0] * cd[0];
+ tail_t1 =
+ (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = x_elem[1] * split;
+ a1 = con - x_elem[1];
+ a1 = con - a1;
+ a2 = x_elem[1] - a1;
+ con = cd[1] * split;
+ b1 = con - cd[1];
+ b1 = con - b1;
+ b2 = cd[1] - b1;
+
+ head_t2 = x_elem[1] * cd[1];
+ tail_t2 =
+ (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_t2 = -head_t2;
+ tail_t2 = -tail_t2;
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_prod1[0] = head_t1;
+ tail_prod1[0] = tail_t1;
+ /* Imaginary part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = x_elem[1] * split;
+ a1 = con - x_elem[1];
+ a1 = con - a1;
+ a2 = x_elem[1] - a1;
+ con = cd[0] * split;
+ b1 = con - cd[0];
+ b1 = con - b1;
+ b2 = cd[0] - b1;
+
+ head_t1 = x_elem[1] * cd[0];
+ tail_t1 =
+ (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = x_elem[0] * split;
+ a1 = con - x_elem[0];
+ a1 = con - a1;
+ a2 = x_elem[0] - a1;
+ con = cd[1] * split;
+ b1 = con - cd[1];
+ b1 = con - b1;
+ b2 = cd[1] - b1;
+
+ head_t2 = x_elem[0] * cd[1];
+ tail_t2 =
+ (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_prod1[1] = head_t1;
+ tail_prod1[1] = tail_t1;
+ }
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum1[0];
+ tail_a = tail_sum1[0];
+ head_b = head_prod1[0];
+ tail_b = tail_prod1[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[0] = head_t;
+ tail_sum1[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum1[1];
+ tail_a = tail_sum1[1];
+ head_b = head_prod1[1];
+ tail_b = tail_prod1[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[1] = head_t;
+ tail_sum1[1] = tail_t;
+ }
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ double cd[2];
+ cd[0] = (double) a_elem[0];
+ cd[1] = (double) a_elem[1];
+ {
+ /* Compute complex-extra = complex-double * complex-double. */
+ double head_t1, tail_t1;
+ double head_t2, tail_t2;
+ /* Real part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = x_elem[0] * split;
+ a1 = con - x_elem[0];
+ a1 = con - a1;
+ a2 = x_elem[0] - a1;
+ con = cd[0] * split;
+ b1 = con - cd[0];
+ b1 = con - b1;
+ b2 = cd[0] - b1;
+
+ head_t1 = x_elem[0] * cd[0];
+ tail_t1 =
+ (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = x_elem[1] * split;
+ a1 = con - x_elem[1];
+ a1 = con - a1;
+ a2 = x_elem[1] - a1;
+ con = cd[1] * split;
+ b1 = con - cd[1];
+ b1 = con - b1;
+ b2 = cd[1] - b1;
+
+ head_t2 = x_elem[1] * cd[1];
+ tail_t2 =
+ (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_t2 = -head_t2;
+ tail_t2 = -tail_t2;
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_prod2[0] = head_t1;
+ tail_prod2[0] = tail_t1;
+ /* Imaginary part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = x_elem[1] * split;
+ a1 = con - x_elem[1];
+ a1 = con - a1;
+ a2 = x_elem[1] - a1;
+ con = cd[0] * split;
+ b1 = con - cd[0];
+ b1 = con - b1;
+ b2 = cd[0] - b1;
+
+ head_t1 = x_elem[1] * cd[0];
+ tail_t1 =
+ (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = x_elem[0] * split;
+ a1 = con - x_elem[0];
+ a1 = con - a1;
+ a2 = x_elem[0] - a1;
+ con = cd[1] * split;
+ b1 = con - cd[1];
+ b1 = con - b1;
+ b2 = cd[1] - b1;
+
+ head_t2 = x_elem[0] * cd[1];
+ tail_t2 =
+ (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_prod2[1] = head_t1;
+ tail_prod2[1] = tail_t1;
+ }
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum2[0];
+ tail_a = tail_sum2[0];
+ head_b = head_prod2[0];
+ tail_b = tail_prod2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[0] = head_t;
+ tail_sum2[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum2[1];
+ tail_a = tail_sum2[1];
+ head_b = head_prod2[1];
+ tail_b = tail_prod2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[1] = head_t;
+ tail_sum2[1] = tail_t;
+ }
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum1[0];
+ tail_a = tail_sum1[0];
+ head_b = head_sum2[0];
+ tail_b = tail_sum2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[0] = head_t;
+ tail_sum1[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum1[1];
+ tail_a = tail_sum1[1];
+ head_b = head_sum2[1];
+ tail_b = tail_sum2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[1] = head_t;
+ tail_sum1[1] = tail_t;
+ }
+ {
+ /* Compute complex-extra = complex-extra * complex-double. */
+ double head_a0, tail_a0;
+ double head_a1, tail_a1;
+ double head_t1, tail_t1;
+ double head_t2, tail_t2;
+ head_a0 = head_sum1[0];
+ tail_a0 = tail_sum1[0];
+ head_a1 = head_sum1[1];
+ tail_a1 = tail_sum1[1];
+ /* real part */
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_a0 * split;
+ a11 = con - head_a0;
+ a11 = con - a11;
+ a21 = head_a0 - a11;
+ con = alpha_i[0] * split;
+ b1 = con - alpha_i[0];
+ b1 = con - b1;
+ b2 = alpha_i[0] - b1;
+
+ c11 = head_a0 * alpha_i[0];
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_a0 * alpha_i[0];
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_a1 * split;
+ a11 = con - head_a1;
+ a11 = con - a11;
+ a21 = head_a1 - a11;
+ con = alpha_i[1] * split;
+ b1 = con - alpha_i[1];
+ b1 = con - b1;
+ b2 = alpha_i[1] - b1;
+
+ c11 = head_a1 * alpha_i[1];
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_a1 * alpha_i[1];
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_t2 = t1 + t2;
+ tail_t2 = t2 - (head_t2 - t1);
+ }
+ head_t2 = -head_t2;
+ tail_t2 = -tail_t2;
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_tmp1[0] = head_t1;
+ tail_tmp1[0] = tail_t1;
+ /* imaginary part */
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_a1 * split;
+ a11 = con - head_a1;
+ a11 = con - a11;
+ a21 = head_a1 - a11;
+ con = alpha_i[0] * split;
+ b1 = con - alpha_i[0];
+ b1 = con - b1;
+ b2 = alpha_i[0] - b1;
+
+ c11 = head_a1 * alpha_i[0];
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_a1 * alpha_i[0];
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_a0 * split;
+ a11 = con - head_a0;
+ a11 = con - a11;
+ a21 = head_a0 - a11;
+ con = alpha_i[1] * split;
+ b1 = con - alpha_i[1];
+ b1 = con - b1;
+ b2 = alpha_i[1] - b1;
+
+ c11 = head_a0 * alpha_i[1];
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_a0 * alpha_i[1];
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_t2 = t1 + t2;
+ tail_t2 = t2 - (head_t2 - t1);
+ }
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_tmp1[1] = head_t1;
+ tail_tmp1[1] = tail_t1;
+ }
+
+ y_elem[0] = y_i[yi];
+ y_elem[1] = y_i[yi + 1];
+ {
+ /* Compute complex-extra = complex-double * complex-double. */
+ double head_t1, tail_t1;
+ double head_t2, tail_t2;
+ /* Real part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = y_elem[0] * split;
+ a1 = con - y_elem[0];
+ a1 = con - a1;
+ a2 = y_elem[0] - a1;
+ con = beta_i[0] * split;
+ b1 = con - beta_i[0];
+ b1 = con - b1;
+ b2 = beta_i[0] - b1;
+
+ head_t1 = y_elem[0] * beta_i[0];
+ tail_t1 = (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = y_elem[1] * split;
+ a1 = con - y_elem[1];
+ a1 = con - a1;
+ a2 = y_elem[1] - a1;
+ con = beta_i[1] * split;
+ b1 = con - beta_i[1];
+ b1 = con - b1;
+ b2 = beta_i[1] - b1;
+
+ head_t2 = y_elem[1] * beta_i[1];
+ tail_t2 = (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_t2 = -head_t2;
+ tail_t2 = -tail_t2;
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_tmp2[0] = head_t1;
+ tail_tmp2[0] = tail_t1;
+ /* Imaginary part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = y_elem[1] * split;
+ a1 = con - y_elem[1];
+ a1 = con - a1;
+ a2 = y_elem[1] - a1;
+ con = beta_i[0] * split;
+ b1 = con - beta_i[0];
+ b1 = con - b1;
+ b2 = beta_i[0] - b1;
+
+ head_t1 = y_elem[1] * beta_i[0];
+ tail_t1 = (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = y_elem[0] * split;
+ a1 = con - y_elem[0];
+ a1 = con - a1;
+ a2 = y_elem[0] - a1;
+ con = beta_i[1] * split;
+ b1 = con - beta_i[1];
+ b1 = con - b1;
+ b2 = beta_i[1] - b1;
+
+ head_t2 = y_elem[0] * beta_i[1];
+ tail_t2 = (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_tmp2[1] = head_t1;
+ tail_tmp2[1] = tail_t1;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_tmp1[0];
+ tail_a = tail_tmp1[0];
+ head_b = head_tmp2[0];
+ tail_b = tail_tmp2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_tmp3[0] = head_t;
+ tail_tmp3[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_tmp1[1];
+ tail_a = tail_tmp1[1];
+ head_b = head_tmp2[1];
+ tail_b = tail_tmp2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_tmp3[1] = head_t;
+ tail_tmp3[1] = tail_t;
+ }
+ y_i[yi] = head_tmp3[0];
+ y_i[yi + 1] = head_tmp3[1];
+ }
+ }
+
+ FPU_FIX_STOP;
+
+ break;
+ }
+ }
+} /* end BLAS_zhemv2_c_z_x */
--- /dev/null
+
+#include "f2c-bridge.h"
+#include "blas_enum.h"
+void BLAS_zhemv2_x(enum blas_order_type order, enum blas_uplo_type uplo,
+ int n, const void *alpha, const void *a, int lda,
+ const void *x_head, const void *x_tail, int incx,
+ const void *beta, const void *y, int incy,
+ enum blas_prec_type prec);
+
+
+extern void FC_FUNC_(blas_zhemv2_x, BLAS_ZHEMV2_X)
+
+ (int *uplo, int *n, const void *alpha, const void *a, int *lda,
+ const void *x_head, const void *x_tail, int *incx, const void *beta,
+ const void *y, int *incy, int *prec) {
+ BLAS_zhemv2_x(blas_colmajor, (enum blas_uplo_type) *uplo, *n, alpha, a,
+ *lda, x_head, x_tail, *incx, beta, y, *incy,
+ (enum blas_prec_type) *prec);
+}
--- /dev/null
+#include <blas_extended.h>
+#include <blas_extended_private.h>
+#include <blas_fpu.h>
+void BLAS_zhemv2_x(enum blas_order_type order, enum blas_uplo_type uplo,
+ int n, const void *alpha, const void *a, int lda,
+ const void *x_head, const void *x_tail, int incx,
+ const void *beta, const void *y, int incy,
+ enum blas_prec_type prec)
+
+/*
+ * Purpose
+ * =======
+ *
+ * This routines computes the matrix product:
+ *
+ * y <- alpha * A * (x_head + x_tail) + beta * y
+ *
+ * where A is a complex Hermitian matrix.
+ *
+ * Arguments
+ * =========
+ *
+ * order (input) enum blas_order_type
+ * Storage format of input symmetric matrix A.
+ *
+ * uplo (input) enum blas_uplo_type
+ * Determines which half of matrix A (upper or lower triangle)
+ * is accessed.
+ *
+ * n (input) int
+ * Dimension of A and size of vectors x, y.
+ *
+ * alpha (input) const void*
+ *
+ * a (input) void*
+ * Matrix A.
+ *
+ * lda (input) int
+ * Leading dimension of matrix A.
+ *
+ * x_head (input) void*
+ * Vector x_head
+ *
+ * x_tail (input) void*
+ * Vector x_tail
+ *
+ * incx (input) int
+ * Stride for vector x.
+ *
+ * beta (input) const void*
+ *
+ * y (input) void*
+ * Vector y.
+ *
+ * incy (input) int
+ * Stride for vector y.
+ *
+ * prec (input) enum blas_prec_type
+ * Specifies the internal precision to be used.
+ * = blas_prec_single: single precision.
+ * = blas_prec_double: double precision.
+ * = blas_prec_extra : anything at least 1.5 times as accurate
+ * than double, and wider than 80-bits.
+ * We use double-double in our implementation.
+ *
+ */
+{
+ /* Routine name */
+ const char routine_name[] = "BLAS_zhemv2_x";
+ switch (prec) {
+
+ case blas_prec_single:{
+
+ int i, j;
+ int xi, yi, xi0, yi0;
+ int aij, ai;
+ int incai;
+ int incaij, incaij2;
+
+ const double *a_i = (double *) a;
+ const double *x_head_i = (double *) x_head;
+ const double *x_tail_i = (double *) x_tail;
+ double *y_i = (double *) y;
+ double *alpha_i = (double *) alpha;
+ double *beta_i = (double *) beta;
+ double a_elem[2];
+ double x_elem[2];
+ double y_elem[2];
+ double diag_elem;
+ double prod1[2];
+ double prod2[2];
+ double sum1[2];
+ double sum2[2];
+ double tmp1[2];
+ double tmp2[2];
+ double tmp3[2];
+
+
+
+ /* Test for no-op */
+ if (n <= 0) {
+ return;
+ }
+ if (alpha_i[0] == 0.0 && alpha_i[1] == 0.0
+ && (beta_i[0] == 1.0 && beta_i[1] == 0.0)) {
+ return;
+ }
+
+ /* Check for error conditions. */
+ if (n < 0) {
+ BLAS_error(routine_name, -3, n, NULL);
+ }
+ if (lda < n) {
+ BLAS_error(routine_name, -6, n, NULL);
+ }
+ if (incx == 0) {
+ BLAS_error(routine_name, -9, incx, NULL);
+ }
+ if (incy == 0) {
+ BLAS_error(routine_name, -12, incy, NULL);
+ }
+
+ if ((order == blas_colmajor && uplo == blas_upper) ||
+ (order == blas_rowmajor && uplo == blas_lower)) {
+ incai = lda;
+ incaij = 1;
+ incaij2 = lda;
+ } else {
+ incai = 1;
+ incaij = lda;
+ incaij2 = 1;
+ }
+
+ incx *= 2;
+ incy *= 2;
+ incai *= 2;
+ incaij *= 2;
+ incaij2 *= 2;
+ xi0 = (incx > 0) ? 0 : ((-n + 1) * incx);
+ yi0 = (incy > 0) ? 0 : ((-n + 1) * incy);
+
+
+
+ /* The most general form, y <--- alpha * A * (x_head + x_tail) + beta * y */
+ if (uplo == blas_lower) {
+ for (i = 0, yi = yi0, ai = 0; i < n; i++, yi += incy, ai += incai) {
+ sum1[0] = sum1[1] = 0.0;
+ sum2[0] = sum2[1] = 0.0;
+ for (j = 0, aij = ai, xi = xi0; j < i;
+ j++, aij += incaij, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod1[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod2[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+
+ diag_elem = a_i[aij];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] = x_elem[0] * diag_elem;
+ prod1[1] = x_elem[1] * diag_elem;
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] = x_elem[0] * diag_elem;
+ prod2[1] = x_elem[1] * diag_elem;
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ j++;
+ aij += incaij2;
+ xi += incx;
+
+ for (; j < n; j++, aij += incaij2, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ a_elem[1] = -a_elem[1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod1[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod2[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+ sum1[0] = sum1[0] + sum2[0];
+ sum1[1] = sum1[1] + sum2[1];
+ {
+ tmp1[0] =
+ (double) sum1[0] * alpha_i[0] - (double) sum1[1] * alpha_i[1];
+ tmp1[1] =
+ (double) sum1[0] * alpha_i[1] + (double) sum1[1] * alpha_i[0];
+ }
+ y_elem[0] = y_i[yi];
+ y_elem[1] = y_i[yi + 1];
+ {
+ tmp2[0] =
+ (double) y_elem[0] * beta_i[0] - (double) y_elem[1] * beta_i[1];
+ tmp2[1] =
+ (double) y_elem[0] * beta_i[1] + (double) y_elem[1] * beta_i[0];
+ }
+ tmp3[0] = tmp1[0] + tmp2[0];
+ tmp3[1] = tmp1[1] + tmp2[1];
+ y_i[yi] = tmp3[0];
+ y_i[yi + 1] = tmp3[1];
+ }
+ } else {
+ /* uplo == blas_upper */
+ for (i = 0, yi = yi0, ai = 0; i < n; i++, yi += incy, ai += incai) {
+ sum1[0] = sum1[1] = 0.0;
+ sum2[0] = sum2[1] = 0.0;
+
+ for (j = 0, aij = ai, xi = xi0; j < i;
+ j++, aij += incaij, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ a_elem[1] = -a_elem[1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod1[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod2[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+
+ diag_elem = a_i[aij];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] = x_elem[0] * diag_elem;
+ prod1[1] = x_elem[1] * diag_elem;
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] = x_elem[0] * diag_elem;
+ prod2[1] = x_elem[1] * diag_elem;
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ j++;
+ aij += incaij2;
+ xi += incx;
+
+ for (; j < n; j++, aij += incaij2, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod1[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod2[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+ sum1[0] = sum1[0] + sum2[0];
+ sum1[1] = sum1[1] + sum2[1];
+ {
+ tmp1[0] =
+ (double) sum1[0] * alpha_i[0] - (double) sum1[1] * alpha_i[1];
+ tmp1[1] =
+ (double) sum1[0] * alpha_i[1] + (double) sum1[1] * alpha_i[0];
+ }
+ y_elem[0] = y_i[yi];
+ y_elem[1] = y_i[yi + 1];
+ {
+ tmp2[0] =
+ (double) y_elem[0] * beta_i[0] - (double) y_elem[1] * beta_i[1];
+ tmp2[1] =
+ (double) y_elem[0] * beta_i[1] + (double) y_elem[1] * beta_i[0];
+ }
+ tmp3[0] = tmp1[0] + tmp2[0];
+ tmp3[1] = tmp1[1] + tmp2[1];
+ y_i[yi] = tmp3[0];
+ y_i[yi + 1] = tmp3[1];
+ }
+ }
+
+
+
+ break;
+ }
+
+ case blas_prec_double:
+ case blas_prec_indigenous:{
+
+ int i, j;
+ int xi, yi, xi0, yi0;
+ int aij, ai;
+ int incai;
+ int incaij, incaij2;
+
+ const double *a_i = (double *) a;
+ const double *x_head_i = (double *) x_head;
+ const double *x_tail_i = (double *) x_tail;
+ double *y_i = (double *) y;
+ double *alpha_i = (double *) alpha;
+ double *beta_i = (double *) beta;
+ double a_elem[2];
+ double x_elem[2];
+ double y_elem[2];
+ double diag_elem;
+ double prod1[2];
+ double prod2[2];
+ double sum1[2];
+ double sum2[2];
+ double tmp1[2];
+ double tmp2[2];
+ double tmp3[2];
+
+
+
+ /* Test for no-op */
+ if (n <= 0) {
+ return;
+ }
+ if (alpha_i[0] == 0.0 && alpha_i[1] == 0.0
+ && (beta_i[0] == 1.0 && beta_i[1] == 0.0)) {
+ return;
+ }
+
+ /* Check for error conditions. */
+ if (n < 0) {
+ BLAS_error(routine_name, -3, n, NULL);
+ }
+ if (lda < n) {
+ BLAS_error(routine_name, -6, n, NULL);
+ }
+ if (incx == 0) {
+ BLAS_error(routine_name, -9, incx, NULL);
+ }
+ if (incy == 0) {
+ BLAS_error(routine_name, -12, incy, NULL);
+ }
+
+ if ((order == blas_colmajor && uplo == blas_upper) ||
+ (order == blas_rowmajor && uplo == blas_lower)) {
+ incai = lda;
+ incaij = 1;
+ incaij2 = lda;
+ } else {
+ incai = 1;
+ incaij = lda;
+ incaij2 = 1;
+ }
+
+ incx *= 2;
+ incy *= 2;
+ incai *= 2;
+ incaij *= 2;
+ incaij2 *= 2;
+ xi0 = (incx > 0) ? 0 : ((-n + 1) * incx);
+ yi0 = (incy > 0) ? 0 : ((-n + 1) * incy);
+
+
+
+ /* The most general form, y <--- alpha * A * (x_head + x_tail) + beta * y */
+ if (uplo == blas_lower) {
+ for (i = 0, yi = yi0, ai = 0; i < n; i++, yi += incy, ai += incai) {
+ sum1[0] = sum1[1] = 0.0;
+ sum2[0] = sum2[1] = 0.0;
+ for (j = 0, aij = ai, xi = xi0; j < i;
+ j++, aij += incaij, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod1[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod2[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+
+ diag_elem = a_i[aij];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] = x_elem[0] * diag_elem;
+ prod1[1] = x_elem[1] * diag_elem;
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] = x_elem[0] * diag_elem;
+ prod2[1] = x_elem[1] * diag_elem;
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ j++;
+ aij += incaij2;
+ xi += incx;
+
+ for (; j < n; j++, aij += incaij2, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ a_elem[1] = -a_elem[1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod1[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod2[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+ sum1[0] = sum1[0] + sum2[0];
+ sum1[1] = sum1[1] + sum2[1];
+ {
+ tmp1[0] =
+ (double) sum1[0] * alpha_i[0] - (double) sum1[1] * alpha_i[1];
+ tmp1[1] =
+ (double) sum1[0] * alpha_i[1] + (double) sum1[1] * alpha_i[0];
+ }
+ y_elem[0] = y_i[yi];
+ y_elem[1] = y_i[yi + 1];
+ {
+ tmp2[0] =
+ (double) y_elem[0] * beta_i[0] - (double) y_elem[1] * beta_i[1];
+ tmp2[1] =
+ (double) y_elem[0] * beta_i[1] + (double) y_elem[1] * beta_i[0];
+ }
+ tmp3[0] = tmp1[0] + tmp2[0];
+ tmp3[1] = tmp1[1] + tmp2[1];
+ y_i[yi] = tmp3[0];
+ y_i[yi + 1] = tmp3[1];
+ }
+ } else {
+ /* uplo == blas_upper */
+ for (i = 0, yi = yi0, ai = 0; i < n; i++, yi += incy, ai += incai) {
+ sum1[0] = sum1[1] = 0.0;
+ sum2[0] = sum2[1] = 0.0;
+
+ for (j = 0, aij = ai, xi = xi0; j < i;
+ j++, aij += incaij, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ a_elem[1] = -a_elem[1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod1[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod2[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+
+ diag_elem = a_i[aij];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] = x_elem[0] * diag_elem;
+ prod1[1] = x_elem[1] * diag_elem;
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] = x_elem[0] * diag_elem;
+ prod2[1] = x_elem[1] * diag_elem;
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ j++;
+ aij += incaij2;
+ xi += incx;
+
+ for (; j < n; j++, aij += incaij2, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod1[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod2[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+ sum1[0] = sum1[0] + sum2[0];
+ sum1[1] = sum1[1] + sum2[1];
+ {
+ tmp1[0] =
+ (double) sum1[0] * alpha_i[0] - (double) sum1[1] * alpha_i[1];
+ tmp1[1] =
+ (double) sum1[0] * alpha_i[1] + (double) sum1[1] * alpha_i[0];
+ }
+ y_elem[0] = y_i[yi];
+ y_elem[1] = y_i[yi + 1];
+ {
+ tmp2[0] =
+ (double) y_elem[0] * beta_i[0] - (double) y_elem[1] * beta_i[1];
+ tmp2[1] =
+ (double) y_elem[0] * beta_i[1] + (double) y_elem[1] * beta_i[0];
+ }
+ tmp3[0] = tmp1[0] + tmp2[0];
+ tmp3[1] = tmp1[1] + tmp2[1];
+ y_i[yi] = tmp3[0];
+ y_i[yi + 1] = tmp3[1];
+ }
+ }
+
+
+
+ break;
+ }
+
+ case blas_prec_extra:{
+
+ int i, j;
+ int xi, yi, xi0, yi0;
+ int aij, ai;
+ int incai;
+ int incaij, incaij2;
+
+ const double *a_i = (double *) a;
+ const double *x_head_i = (double *) x_head;
+ const double *x_tail_i = (double *) x_tail;
+ double *y_i = (double *) y;
+ double *alpha_i = (double *) alpha;
+ double *beta_i = (double *) beta;
+ double a_elem[2];
+ double x_elem[2];
+ double y_elem[2];
+ double diag_elem;
+ double head_prod1[2], tail_prod1[2];
+ double head_prod2[2], tail_prod2[2];
+ double head_sum1[2], tail_sum1[2];
+ double head_sum2[2], tail_sum2[2];
+ double head_tmp1[2], tail_tmp1[2];
+ double head_tmp2[2], tail_tmp2[2];
+ double head_tmp3[2], tail_tmp3[2];
+
+ FPU_FIX_DECL;
+
+ /* Test for no-op */
+ if (n <= 0) {
+ return;
+ }
+ if (alpha_i[0] == 0.0 && alpha_i[1] == 0.0
+ && (beta_i[0] == 1.0 && beta_i[1] == 0.0)) {
+ return;
+ }
+
+ /* Check for error conditions. */
+ if (n < 0) {
+ BLAS_error(routine_name, -3, n, NULL);
+ }
+ if (lda < n) {
+ BLAS_error(routine_name, -6, n, NULL);
+ }
+ if (incx == 0) {
+ BLAS_error(routine_name, -9, incx, NULL);
+ }
+ if (incy == 0) {
+ BLAS_error(routine_name, -12, incy, NULL);
+ }
+
+ if ((order == blas_colmajor && uplo == blas_upper) ||
+ (order == blas_rowmajor && uplo == blas_lower)) {
+ incai = lda;
+ incaij = 1;
+ incaij2 = lda;
+ } else {
+ incai = 1;
+ incaij = lda;
+ incaij2 = 1;
+ }
+
+ incx *= 2;
+ incy *= 2;
+ incai *= 2;
+ incaij *= 2;
+ incaij2 *= 2;
+ xi0 = (incx > 0) ? 0 : ((-n + 1) * incx);
+ yi0 = (incy > 0) ? 0 : ((-n + 1) * incy);
+
+ FPU_FIX_START;
+
+ /* The most general form, y <--- alpha * A * (x_head + x_tail) + beta * y */
+ if (uplo == blas_lower) {
+ for (i = 0, yi = yi0, ai = 0; i < n; i++, yi += incy, ai += incai) {
+ head_sum1[0] = head_sum1[1] = tail_sum1[0] = tail_sum1[1] = 0.0;
+ head_sum2[0] = head_sum2[1] = tail_sum2[0] = tail_sum2[1] = 0.0;
+ for (j = 0, aij = ai, xi = xi0; j < i;
+ j++, aij += incaij, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ /* Compute complex-extra = complex-double * complex-double. */
+ double head_t1, tail_t1;
+ double head_t2, tail_t2;
+ /* Real part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[0] * split;
+ a1 = con - a_elem[0];
+ a1 = con - a1;
+ a2 = a_elem[0] - a1;
+ con = x_elem[0] * split;
+ b1 = con - x_elem[0];
+ b1 = con - b1;
+ b2 = x_elem[0] - b1;
+
+ head_t1 = a_elem[0] * x_elem[0];
+ tail_t1 =
+ (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[1] * split;
+ a1 = con - a_elem[1];
+ a1 = con - a1;
+ a2 = a_elem[1] - a1;
+ con = x_elem[1] * split;
+ b1 = con - x_elem[1];
+ b1 = con - b1;
+ b2 = x_elem[1] - b1;
+
+ head_t2 = a_elem[1] * x_elem[1];
+ tail_t2 =
+ (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_t2 = -head_t2;
+ tail_t2 = -tail_t2;
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_prod1[0] = head_t1;
+ tail_prod1[0] = tail_t1;
+ /* Imaginary part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[1] * split;
+ a1 = con - a_elem[1];
+ a1 = con - a1;
+ a2 = a_elem[1] - a1;
+ con = x_elem[0] * split;
+ b1 = con - x_elem[0];
+ b1 = con - b1;
+ b2 = x_elem[0] - b1;
+
+ head_t1 = a_elem[1] * x_elem[0];
+ tail_t1 =
+ (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[0] * split;
+ a1 = con - a_elem[0];
+ a1 = con - a1;
+ a2 = a_elem[0] - a1;
+ con = x_elem[1] * split;
+ b1 = con - x_elem[1];
+ b1 = con - b1;
+ b2 = x_elem[1] - b1;
+
+ head_t2 = a_elem[0] * x_elem[1];
+ tail_t2 =
+ (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_prod1[1] = head_t1;
+ tail_prod1[1] = tail_t1;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum1[0];
+ tail_a = tail_sum1[0];
+ head_b = head_prod1[0];
+ tail_b = tail_prod1[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[0] = head_t;
+ tail_sum1[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum1[1];
+ tail_a = tail_sum1[1];
+ head_b = head_prod1[1];
+ tail_b = tail_prod1[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[1] = head_t;
+ tail_sum1[1] = tail_t;
+ }
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ /* Compute complex-extra = complex-double * complex-double. */
+ double head_t1, tail_t1;
+ double head_t2, tail_t2;
+ /* Real part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[0] * split;
+ a1 = con - a_elem[0];
+ a1 = con - a1;
+ a2 = a_elem[0] - a1;
+ con = x_elem[0] * split;
+ b1 = con - x_elem[0];
+ b1 = con - b1;
+ b2 = x_elem[0] - b1;
+
+ head_t1 = a_elem[0] * x_elem[0];
+ tail_t1 =
+ (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[1] * split;
+ a1 = con - a_elem[1];
+ a1 = con - a1;
+ a2 = a_elem[1] - a1;
+ con = x_elem[1] * split;
+ b1 = con - x_elem[1];
+ b1 = con - b1;
+ b2 = x_elem[1] - b1;
+
+ head_t2 = a_elem[1] * x_elem[1];
+ tail_t2 =
+ (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_t2 = -head_t2;
+ tail_t2 = -tail_t2;
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_prod2[0] = head_t1;
+ tail_prod2[0] = tail_t1;
+ /* Imaginary part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[1] * split;
+ a1 = con - a_elem[1];
+ a1 = con - a1;
+ a2 = a_elem[1] - a1;
+ con = x_elem[0] * split;
+ b1 = con - x_elem[0];
+ b1 = con - b1;
+ b2 = x_elem[0] - b1;
+
+ head_t1 = a_elem[1] * x_elem[0];
+ tail_t1 =
+ (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[0] * split;
+ a1 = con - a_elem[0];
+ a1 = con - a1;
+ a2 = a_elem[0] - a1;
+ con = x_elem[1] * split;
+ b1 = con - x_elem[1];
+ b1 = con - b1;
+ b2 = x_elem[1] - b1;
+
+ head_t2 = a_elem[0] * x_elem[1];
+ tail_t2 =
+ (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_prod2[1] = head_t1;
+ tail_prod2[1] = tail_t1;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum2[0];
+ tail_a = tail_sum2[0];
+ head_b = head_prod2[0];
+ tail_b = tail_prod2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[0] = head_t;
+ tail_sum2[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum2[1];
+ tail_a = tail_sum2[1];
+ head_b = head_prod2[1];
+ tail_b = tail_prod2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[1] = head_t;
+ tail_sum2[1] = tail_t;
+ }
+ }
+
+ diag_elem = a_i[aij];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ /* Compute complex-extra = complex-double * real. */
+ double head_t, tail_t;
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = diag_elem * split;
+ a1 = con - diag_elem;
+ a1 = con - a1;
+ a2 = diag_elem - a1;
+ con = x_elem[0] * split;
+ b1 = con - x_elem[0];
+ b1 = con - b1;
+ b2 = x_elem[0] - b1;
+
+ head_t = diag_elem * x_elem[0];
+ tail_t = (((a1 * b1 - head_t) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_prod1[0] = head_t;
+ tail_prod1[0] = tail_t;
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = diag_elem * split;
+ a1 = con - diag_elem;
+ a1 = con - a1;
+ a2 = diag_elem - a1;
+ con = x_elem[1] * split;
+ b1 = con - x_elem[1];
+ b1 = con - b1;
+ b2 = x_elem[1] - b1;
+
+ head_t = diag_elem * x_elem[1];
+ tail_t = (((a1 * b1 - head_t) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_prod1[1] = head_t;
+ tail_prod1[1] = tail_t;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum1[0];
+ tail_a = tail_sum1[0];
+ head_b = head_prod1[0];
+ tail_b = tail_prod1[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[0] = head_t;
+ tail_sum1[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum1[1];
+ tail_a = tail_sum1[1];
+ head_b = head_prod1[1];
+ tail_b = tail_prod1[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[1] = head_t;
+ tail_sum1[1] = tail_t;
+ }
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ /* Compute complex-extra = complex-double * real. */
+ double head_t, tail_t;
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = diag_elem * split;
+ a1 = con - diag_elem;
+ a1 = con - a1;
+ a2 = diag_elem - a1;
+ con = x_elem[0] * split;
+ b1 = con - x_elem[0];
+ b1 = con - b1;
+ b2 = x_elem[0] - b1;
+
+ head_t = diag_elem * x_elem[0];
+ tail_t = (((a1 * b1 - head_t) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_prod2[0] = head_t;
+ tail_prod2[0] = tail_t;
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = diag_elem * split;
+ a1 = con - diag_elem;
+ a1 = con - a1;
+ a2 = diag_elem - a1;
+ con = x_elem[1] * split;
+ b1 = con - x_elem[1];
+ b1 = con - b1;
+ b2 = x_elem[1] - b1;
+
+ head_t = diag_elem * x_elem[1];
+ tail_t = (((a1 * b1 - head_t) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_prod2[1] = head_t;
+ tail_prod2[1] = tail_t;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum2[0];
+ tail_a = tail_sum2[0];
+ head_b = head_prod2[0];
+ tail_b = tail_prod2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[0] = head_t;
+ tail_sum2[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum2[1];
+ tail_a = tail_sum2[1];
+ head_b = head_prod2[1];
+ tail_b = tail_prod2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[1] = head_t;
+ tail_sum2[1] = tail_t;
+ }
+ j++;
+ aij += incaij2;
+ xi += incx;
+
+ for (; j < n; j++, aij += incaij2, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ a_elem[1] = -a_elem[1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ /* Compute complex-extra = complex-double * complex-double. */
+ double head_t1, tail_t1;
+ double head_t2, tail_t2;
+ /* Real part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[0] * split;
+ a1 = con - a_elem[0];
+ a1 = con - a1;
+ a2 = a_elem[0] - a1;
+ con = x_elem[0] * split;
+ b1 = con - x_elem[0];
+ b1 = con - b1;
+ b2 = x_elem[0] - b1;
+
+ head_t1 = a_elem[0] * x_elem[0];
+ tail_t1 =
+ (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[1] * split;
+ a1 = con - a_elem[1];
+ a1 = con - a1;
+ a2 = a_elem[1] - a1;
+ con = x_elem[1] * split;
+ b1 = con - x_elem[1];
+ b1 = con - b1;
+ b2 = x_elem[1] - b1;
+
+ head_t2 = a_elem[1] * x_elem[1];
+ tail_t2 =
+ (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_t2 = -head_t2;
+ tail_t2 = -tail_t2;
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_prod1[0] = head_t1;
+ tail_prod1[0] = tail_t1;
+ /* Imaginary part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[1] * split;
+ a1 = con - a_elem[1];
+ a1 = con - a1;
+ a2 = a_elem[1] - a1;
+ con = x_elem[0] * split;
+ b1 = con - x_elem[0];
+ b1 = con - b1;
+ b2 = x_elem[0] - b1;
+
+ head_t1 = a_elem[1] * x_elem[0];
+ tail_t1 =
+ (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[0] * split;
+ a1 = con - a_elem[0];
+ a1 = con - a1;
+ a2 = a_elem[0] - a1;
+ con = x_elem[1] * split;
+ b1 = con - x_elem[1];
+ b1 = con - b1;
+ b2 = x_elem[1] - b1;
+
+ head_t2 = a_elem[0] * x_elem[1];
+ tail_t2 =
+ (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_prod1[1] = head_t1;
+ tail_prod1[1] = tail_t1;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum1[0];
+ tail_a = tail_sum1[0];
+ head_b = head_prod1[0];
+ tail_b = tail_prod1[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[0] = head_t;
+ tail_sum1[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum1[1];
+ tail_a = tail_sum1[1];
+ head_b = head_prod1[1];
+ tail_b = tail_prod1[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[1] = head_t;
+ tail_sum1[1] = tail_t;
+ }
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ /* Compute complex-extra = complex-double * complex-double. */
+ double head_t1, tail_t1;
+ double head_t2, tail_t2;
+ /* Real part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[0] * split;
+ a1 = con - a_elem[0];
+ a1 = con - a1;
+ a2 = a_elem[0] - a1;
+ con = x_elem[0] * split;
+ b1 = con - x_elem[0];
+ b1 = con - b1;
+ b2 = x_elem[0] - b1;
+
+ head_t1 = a_elem[0] * x_elem[0];
+ tail_t1 =
+ (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[1] * split;
+ a1 = con - a_elem[1];
+ a1 = con - a1;
+ a2 = a_elem[1] - a1;
+ con = x_elem[1] * split;
+ b1 = con - x_elem[1];
+ b1 = con - b1;
+ b2 = x_elem[1] - b1;
+
+ head_t2 = a_elem[1] * x_elem[1];
+ tail_t2 =
+ (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_t2 = -head_t2;
+ tail_t2 = -tail_t2;
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_prod2[0] = head_t1;
+ tail_prod2[0] = tail_t1;
+ /* Imaginary part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[1] * split;
+ a1 = con - a_elem[1];
+ a1 = con - a1;
+ a2 = a_elem[1] - a1;
+ con = x_elem[0] * split;
+ b1 = con - x_elem[0];
+ b1 = con - b1;
+ b2 = x_elem[0] - b1;
+
+ head_t1 = a_elem[1] * x_elem[0];
+ tail_t1 =
+ (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[0] * split;
+ a1 = con - a_elem[0];
+ a1 = con - a1;
+ a2 = a_elem[0] - a1;
+ con = x_elem[1] * split;
+ b1 = con - x_elem[1];
+ b1 = con - b1;
+ b2 = x_elem[1] - b1;
+
+ head_t2 = a_elem[0] * x_elem[1];
+ tail_t2 =
+ (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_prod2[1] = head_t1;
+ tail_prod2[1] = tail_t1;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum2[0];
+ tail_a = tail_sum2[0];
+ head_b = head_prod2[0];
+ tail_b = tail_prod2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[0] = head_t;
+ tail_sum2[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum2[1];
+ tail_a = tail_sum2[1];
+ head_b = head_prod2[1];
+ tail_b = tail_prod2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[1] = head_t;
+ tail_sum2[1] = tail_t;
+ }
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum1[0];
+ tail_a = tail_sum1[0];
+ head_b = head_sum2[0];
+ tail_b = tail_sum2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[0] = head_t;
+ tail_sum1[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum1[1];
+ tail_a = tail_sum1[1];
+ head_b = head_sum2[1];
+ tail_b = tail_sum2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[1] = head_t;
+ tail_sum1[1] = tail_t;
+ }
+ {
+ /* Compute complex-extra = complex-extra * complex-double. */
+ double head_a0, tail_a0;
+ double head_a1, tail_a1;
+ double head_t1, tail_t1;
+ double head_t2, tail_t2;
+ head_a0 = head_sum1[0];
+ tail_a0 = tail_sum1[0];
+ head_a1 = head_sum1[1];
+ tail_a1 = tail_sum1[1];
+ /* real part */
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_a0 * split;
+ a11 = con - head_a0;
+ a11 = con - a11;
+ a21 = head_a0 - a11;
+ con = alpha_i[0] * split;
+ b1 = con - alpha_i[0];
+ b1 = con - b1;
+ b2 = alpha_i[0] - b1;
+
+ c11 = head_a0 * alpha_i[0];
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_a0 * alpha_i[0];
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_a1 * split;
+ a11 = con - head_a1;
+ a11 = con - a11;
+ a21 = head_a1 - a11;
+ con = alpha_i[1] * split;
+ b1 = con - alpha_i[1];
+ b1 = con - b1;
+ b2 = alpha_i[1] - b1;
+
+ c11 = head_a1 * alpha_i[1];
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_a1 * alpha_i[1];
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_t2 = t1 + t2;
+ tail_t2 = t2 - (head_t2 - t1);
+ }
+ head_t2 = -head_t2;
+ tail_t2 = -tail_t2;
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_tmp1[0] = head_t1;
+ tail_tmp1[0] = tail_t1;
+ /* imaginary part */
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_a1 * split;
+ a11 = con - head_a1;
+ a11 = con - a11;
+ a21 = head_a1 - a11;
+ con = alpha_i[0] * split;
+ b1 = con - alpha_i[0];
+ b1 = con - b1;
+ b2 = alpha_i[0] - b1;
+
+ c11 = head_a1 * alpha_i[0];
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_a1 * alpha_i[0];
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_a0 * split;
+ a11 = con - head_a0;
+ a11 = con - a11;
+ a21 = head_a0 - a11;
+ con = alpha_i[1] * split;
+ b1 = con - alpha_i[1];
+ b1 = con - b1;
+ b2 = alpha_i[1] - b1;
+
+ c11 = head_a0 * alpha_i[1];
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_a0 * alpha_i[1];
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_t2 = t1 + t2;
+ tail_t2 = t2 - (head_t2 - t1);
+ }
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_tmp1[1] = head_t1;
+ tail_tmp1[1] = tail_t1;
+ }
+
+ y_elem[0] = y_i[yi];
+ y_elem[1] = y_i[yi + 1];
+ {
+ /* Compute complex-extra = complex-double * complex-double. */
+ double head_t1, tail_t1;
+ double head_t2, tail_t2;
+ /* Real part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = y_elem[0] * split;
+ a1 = con - y_elem[0];
+ a1 = con - a1;
+ a2 = y_elem[0] - a1;
+ con = beta_i[0] * split;
+ b1 = con - beta_i[0];
+ b1 = con - b1;
+ b2 = beta_i[0] - b1;
+
+ head_t1 = y_elem[0] * beta_i[0];
+ tail_t1 = (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = y_elem[1] * split;
+ a1 = con - y_elem[1];
+ a1 = con - a1;
+ a2 = y_elem[1] - a1;
+ con = beta_i[1] * split;
+ b1 = con - beta_i[1];
+ b1 = con - b1;
+ b2 = beta_i[1] - b1;
+
+ head_t2 = y_elem[1] * beta_i[1];
+ tail_t2 = (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_t2 = -head_t2;
+ tail_t2 = -tail_t2;
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_tmp2[0] = head_t1;
+ tail_tmp2[0] = tail_t1;
+ /* Imaginary part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = y_elem[1] * split;
+ a1 = con - y_elem[1];
+ a1 = con - a1;
+ a2 = y_elem[1] - a1;
+ con = beta_i[0] * split;
+ b1 = con - beta_i[0];
+ b1 = con - b1;
+ b2 = beta_i[0] - b1;
+
+ head_t1 = y_elem[1] * beta_i[0];
+ tail_t1 = (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = y_elem[0] * split;
+ a1 = con - y_elem[0];
+ a1 = con - a1;
+ a2 = y_elem[0] - a1;
+ con = beta_i[1] * split;
+ b1 = con - beta_i[1];
+ b1 = con - b1;
+ b2 = beta_i[1] - b1;
+
+ head_t2 = y_elem[0] * beta_i[1];
+ tail_t2 = (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_tmp2[1] = head_t1;
+ tail_tmp2[1] = tail_t1;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_tmp1[0];
+ tail_a = tail_tmp1[0];
+ head_b = head_tmp2[0];
+ tail_b = tail_tmp2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_tmp3[0] = head_t;
+ tail_tmp3[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_tmp1[1];
+ tail_a = tail_tmp1[1];
+ head_b = head_tmp2[1];
+ tail_b = tail_tmp2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_tmp3[1] = head_t;
+ tail_tmp3[1] = tail_t;
+ }
+ y_i[yi] = head_tmp3[0];
+ y_i[yi + 1] = head_tmp3[1];
+ }
+ } else {
+ /* uplo == blas_upper */
+ for (i = 0, yi = yi0, ai = 0; i < n; i++, yi += incy, ai += incai) {
+ head_sum1[0] = head_sum1[1] = tail_sum1[0] = tail_sum1[1] = 0.0;
+ head_sum2[0] = head_sum2[1] = tail_sum2[0] = tail_sum2[1] = 0.0;
+
+ for (j = 0, aij = ai, xi = xi0; j < i;
+ j++, aij += incaij, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ a_elem[1] = -a_elem[1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ /* Compute complex-extra = complex-double * complex-double. */
+ double head_t1, tail_t1;
+ double head_t2, tail_t2;
+ /* Real part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[0] * split;
+ a1 = con - a_elem[0];
+ a1 = con - a1;
+ a2 = a_elem[0] - a1;
+ con = x_elem[0] * split;
+ b1 = con - x_elem[0];
+ b1 = con - b1;
+ b2 = x_elem[0] - b1;
+
+ head_t1 = a_elem[0] * x_elem[0];
+ tail_t1 =
+ (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[1] * split;
+ a1 = con - a_elem[1];
+ a1 = con - a1;
+ a2 = a_elem[1] - a1;
+ con = x_elem[1] * split;
+ b1 = con - x_elem[1];
+ b1 = con - b1;
+ b2 = x_elem[1] - b1;
+
+ head_t2 = a_elem[1] * x_elem[1];
+ tail_t2 =
+ (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_t2 = -head_t2;
+ tail_t2 = -tail_t2;
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_prod1[0] = head_t1;
+ tail_prod1[0] = tail_t1;
+ /* Imaginary part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[1] * split;
+ a1 = con - a_elem[1];
+ a1 = con - a1;
+ a2 = a_elem[1] - a1;
+ con = x_elem[0] * split;
+ b1 = con - x_elem[0];
+ b1 = con - b1;
+ b2 = x_elem[0] - b1;
+
+ head_t1 = a_elem[1] * x_elem[0];
+ tail_t1 =
+ (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[0] * split;
+ a1 = con - a_elem[0];
+ a1 = con - a1;
+ a2 = a_elem[0] - a1;
+ con = x_elem[1] * split;
+ b1 = con - x_elem[1];
+ b1 = con - b1;
+ b2 = x_elem[1] - b1;
+
+ head_t2 = a_elem[0] * x_elem[1];
+ tail_t2 =
+ (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_prod1[1] = head_t1;
+ tail_prod1[1] = tail_t1;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum1[0];
+ tail_a = tail_sum1[0];
+ head_b = head_prod1[0];
+ tail_b = tail_prod1[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[0] = head_t;
+ tail_sum1[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum1[1];
+ tail_a = tail_sum1[1];
+ head_b = head_prod1[1];
+ tail_b = tail_prod1[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[1] = head_t;
+ tail_sum1[1] = tail_t;
+ }
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ /* Compute complex-extra = complex-double * complex-double. */
+ double head_t1, tail_t1;
+ double head_t2, tail_t2;
+ /* Real part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[0] * split;
+ a1 = con - a_elem[0];
+ a1 = con - a1;
+ a2 = a_elem[0] - a1;
+ con = x_elem[0] * split;
+ b1 = con - x_elem[0];
+ b1 = con - b1;
+ b2 = x_elem[0] - b1;
+
+ head_t1 = a_elem[0] * x_elem[0];
+ tail_t1 =
+ (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[1] * split;
+ a1 = con - a_elem[1];
+ a1 = con - a1;
+ a2 = a_elem[1] - a1;
+ con = x_elem[1] * split;
+ b1 = con - x_elem[1];
+ b1 = con - b1;
+ b2 = x_elem[1] - b1;
+
+ head_t2 = a_elem[1] * x_elem[1];
+ tail_t2 =
+ (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_t2 = -head_t2;
+ tail_t2 = -tail_t2;
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_prod2[0] = head_t1;
+ tail_prod2[0] = tail_t1;
+ /* Imaginary part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[1] * split;
+ a1 = con - a_elem[1];
+ a1 = con - a1;
+ a2 = a_elem[1] - a1;
+ con = x_elem[0] * split;
+ b1 = con - x_elem[0];
+ b1 = con - b1;
+ b2 = x_elem[0] - b1;
+
+ head_t1 = a_elem[1] * x_elem[0];
+ tail_t1 =
+ (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[0] * split;
+ a1 = con - a_elem[0];
+ a1 = con - a1;
+ a2 = a_elem[0] - a1;
+ con = x_elem[1] * split;
+ b1 = con - x_elem[1];
+ b1 = con - b1;
+ b2 = x_elem[1] - b1;
+
+ head_t2 = a_elem[0] * x_elem[1];
+ tail_t2 =
+ (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_prod2[1] = head_t1;
+ tail_prod2[1] = tail_t1;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum2[0];
+ tail_a = tail_sum2[0];
+ head_b = head_prod2[0];
+ tail_b = tail_prod2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[0] = head_t;
+ tail_sum2[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum2[1];
+ tail_a = tail_sum2[1];
+ head_b = head_prod2[1];
+ tail_b = tail_prod2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[1] = head_t;
+ tail_sum2[1] = tail_t;
+ }
+ }
+
+ diag_elem = a_i[aij];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ /* Compute complex-extra = complex-double * real. */
+ double head_t, tail_t;
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = diag_elem * split;
+ a1 = con - diag_elem;
+ a1 = con - a1;
+ a2 = diag_elem - a1;
+ con = x_elem[0] * split;
+ b1 = con - x_elem[0];
+ b1 = con - b1;
+ b2 = x_elem[0] - b1;
+
+ head_t = diag_elem * x_elem[0];
+ tail_t = (((a1 * b1 - head_t) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_prod1[0] = head_t;
+ tail_prod1[0] = tail_t;
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = diag_elem * split;
+ a1 = con - diag_elem;
+ a1 = con - a1;
+ a2 = diag_elem - a1;
+ con = x_elem[1] * split;
+ b1 = con - x_elem[1];
+ b1 = con - b1;
+ b2 = x_elem[1] - b1;
+
+ head_t = diag_elem * x_elem[1];
+ tail_t = (((a1 * b1 - head_t) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_prod1[1] = head_t;
+ tail_prod1[1] = tail_t;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum1[0];
+ tail_a = tail_sum1[0];
+ head_b = head_prod1[0];
+ tail_b = tail_prod1[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[0] = head_t;
+ tail_sum1[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum1[1];
+ tail_a = tail_sum1[1];
+ head_b = head_prod1[1];
+ tail_b = tail_prod1[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[1] = head_t;
+ tail_sum1[1] = tail_t;
+ }
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ /* Compute complex-extra = complex-double * real. */
+ double head_t, tail_t;
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = diag_elem * split;
+ a1 = con - diag_elem;
+ a1 = con - a1;
+ a2 = diag_elem - a1;
+ con = x_elem[0] * split;
+ b1 = con - x_elem[0];
+ b1 = con - b1;
+ b2 = x_elem[0] - b1;
+
+ head_t = diag_elem * x_elem[0];
+ tail_t = (((a1 * b1 - head_t) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_prod2[0] = head_t;
+ tail_prod2[0] = tail_t;
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = diag_elem * split;
+ a1 = con - diag_elem;
+ a1 = con - a1;
+ a2 = diag_elem - a1;
+ con = x_elem[1] * split;
+ b1 = con - x_elem[1];
+ b1 = con - b1;
+ b2 = x_elem[1] - b1;
+
+ head_t = diag_elem * x_elem[1];
+ tail_t = (((a1 * b1 - head_t) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_prod2[1] = head_t;
+ tail_prod2[1] = tail_t;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum2[0];
+ tail_a = tail_sum2[0];
+ head_b = head_prod2[0];
+ tail_b = tail_prod2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[0] = head_t;
+ tail_sum2[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum2[1];
+ tail_a = tail_sum2[1];
+ head_b = head_prod2[1];
+ tail_b = tail_prod2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[1] = head_t;
+ tail_sum2[1] = tail_t;
+ }
+ j++;
+ aij += incaij2;
+ xi += incx;
+
+ for (; j < n; j++, aij += incaij2, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ /* Compute complex-extra = complex-double * complex-double. */
+ double head_t1, tail_t1;
+ double head_t2, tail_t2;
+ /* Real part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[0] * split;
+ a1 = con - a_elem[0];
+ a1 = con - a1;
+ a2 = a_elem[0] - a1;
+ con = x_elem[0] * split;
+ b1 = con - x_elem[0];
+ b1 = con - b1;
+ b2 = x_elem[0] - b1;
+
+ head_t1 = a_elem[0] * x_elem[0];
+ tail_t1 =
+ (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[1] * split;
+ a1 = con - a_elem[1];
+ a1 = con - a1;
+ a2 = a_elem[1] - a1;
+ con = x_elem[1] * split;
+ b1 = con - x_elem[1];
+ b1 = con - b1;
+ b2 = x_elem[1] - b1;
+
+ head_t2 = a_elem[1] * x_elem[1];
+ tail_t2 =
+ (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_t2 = -head_t2;
+ tail_t2 = -tail_t2;
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_prod1[0] = head_t1;
+ tail_prod1[0] = tail_t1;
+ /* Imaginary part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[1] * split;
+ a1 = con - a_elem[1];
+ a1 = con - a1;
+ a2 = a_elem[1] - a1;
+ con = x_elem[0] * split;
+ b1 = con - x_elem[0];
+ b1 = con - b1;
+ b2 = x_elem[0] - b1;
+
+ head_t1 = a_elem[1] * x_elem[0];
+ tail_t1 =
+ (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[0] * split;
+ a1 = con - a_elem[0];
+ a1 = con - a1;
+ a2 = a_elem[0] - a1;
+ con = x_elem[1] * split;
+ b1 = con - x_elem[1];
+ b1 = con - b1;
+ b2 = x_elem[1] - b1;
+
+ head_t2 = a_elem[0] * x_elem[1];
+ tail_t2 =
+ (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_prod1[1] = head_t1;
+ tail_prod1[1] = tail_t1;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum1[0];
+ tail_a = tail_sum1[0];
+ head_b = head_prod1[0];
+ tail_b = tail_prod1[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[0] = head_t;
+ tail_sum1[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum1[1];
+ tail_a = tail_sum1[1];
+ head_b = head_prod1[1];
+ tail_b = tail_prod1[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[1] = head_t;
+ tail_sum1[1] = tail_t;
+ }
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ /* Compute complex-extra = complex-double * complex-double. */
+ double head_t1, tail_t1;
+ double head_t2, tail_t2;
+ /* Real part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[0] * split;
+ a1 = con - a_elem[0];
+ a1 = con - a1;
+ a2 = a_elem[0] - a1;
+ con = x_elem[0] * split;
+ b1 = con - x_elem[0];
+ b1 = con - b1;
+ b2 = x_elem[0] - b1;
+
+ head_t1 = a_elem[0] * x_elem[0];
+ tail_t1 =
+ (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[1] * split;
+ a1 = con - a_elem[1];
+ a1 = con - a1;
+ a2 = a_elem[1] - a1;
+ con = x_elem[1] * split;
+ b1 = con - x_elem[1];
+ b1 = con - b1;
+ b2 = x_elem[1] - b1;
+
+ head_t2 = a_elem[1] * x_elem[1];
+ tail_t2 =
+ (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_t2 = -head_t2;
+ tail_t2 = -tail_t2;
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_prod2[0] = head_t1;
+ tail_prod2[0] = tail_t1;
+ /* Imaginary part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[1] * split;
+ a1 = con - a_elem[1];
+ a1 = con - a1;
+ a2 = a_elem[1] - a1;
+ con = x_elem[0] * split;
+ b1 = con - x_elem[0];
+ b1 = con - b1;
+ b2 = x_elem[0] - b1;
+
+ head_t1 = a_elem[1] * x_elem[0];
+ tail_t1 =
+ (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[0] * split;
+ a1 = con - a_elem[0];
+ a1 = con - a1;
+ a2 = a_elem[0] - a1;
+ con = x_elem[1] * split;
+ b1 = con - x_elem[1];
+ b1 = con - b1;
+ b2 = x_elem[1] - b1;
+
+ head_t2 = a_elem[0] * x_elem[1];
+ tail_t2 =
+ (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_prod2[1] = head_t1;
+ tail_prod2[1] = tail_t1;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum2[0];
+ tail_a = tail_sum2[0];
+ head_b = head_prod2[0];
+ tail_b = tail_prod2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[0] = head_t;
+ tail_sum2[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum2[1];
+ tail_a = tail_sum2[1];
+ head_b = head_prod2[1];
+ tail_b = tail_prod2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[1] = head_t;
+ tail_sum2[1] = tail_t;
+ }
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum1[0];
+ tail_a = tail_sum1[0];
+ head_b = head_sum2[0];
+ tail_b = tail_sum2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[0] = head_t;
+ tail_sum1[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum1[1];
+ tail_a = tail_sum1[1];
+ head_b = head_sum2[1];
+ tail_b = tail_sum2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[1] = head_t;
+ tail_sum1[1] = tail_t;
+ }
+ {
+ /* Compute complex-extra = complex-extra * complex-double. */
+ double head_a0, tail_a0;
+ double head_a1, tail_a1;
+ double head_t1, tail_t1;
+ double head_t2, tail_t2;
+ head_a0 = head_sum1[0];
+ tail_a0 = tail_sum1[0];
+ head_a1 = head_sum1[1];
+ tail_a1 = tail_sum1[1];
+ /* real part */
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_a0 * split;
+ a11 = con - head_a0;
+ a11 = con - a11;
+ a21 = head_a0 - a11;
+ con = alpha_i[0] * split;
+ b1 = con - alpha_i[0];
+ b1 = con - b1;
+ b2 = alpha_i[0] - b1;
+
+ c11 = head_a0 * alpha_i[0];
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_a0 * alpha_i[0];
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_a1 * split;
+ a11 = con - head_a1;
+ a11 = con - a11;
+ a21 = head_a1 - a11;
+ con = alpha_i[1] * split;
+ b1 = con - alpha_i[1];
+ b1 = con - b1;
+ b2 = alpha_i[1] - b1;
+
+ c11 = head_a1 * alpha_i[1];
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_a1 * alpha_i[1];
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_t2 = t1 + t2;
+ tail_t2 = t2 - (head_t2 - t1);
+ }
+ head_t2 = -head_t2;
+ tail_t2 = -tail_t2;
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_tmp1[0] = head_t1;
+ tail_tmp1[0] = tail_t1;
+ /* imaginary part */
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_a1 * split;
+ a11 = con - head_a1;
+ a11 = con - a11;
+ a21 = head_a1 - a11;
+ con = alpha_i[0] * split;
+ b1 = con - alpha_i[0];
+ b1 = con - b1;
+ b2 = alpha_i[0] - b1;
+
+ c11 = head_a1 * alpha_i[0];
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_a1 * alpha_i[0];
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_a0 * split;
+ a11 = con - head_a0;
+ a11 = con - a11;
+ a21 = head_a0 - a11;
+ con = alpha_i[1] * split;
+ b1 = con - alpha_i[1];
+ b1 = con - b1;
+ b2 = alpha_i[1] - b1;
+
+ c11 = head_a0 * alpha_i[1];
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_a0 * alpha_i[1];
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_t2 = t1 + t2;
+ tail_t2 = t2 - (head_t2 - t1);
+ }
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_tmp1[1] = head_t1;
+ tail_tmp1[1] = tail_t1;
+ }
+
+ y_elem[0] = y_i[yi];
+ y_elem[1] = y_i[yi + 1];
+ {
+ /* Compute complex-extra = complex-double * complex-double. */
+ double head_t1, tail_t1;
+ double head_t2, tail_t2;
+ /* Real part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = y_elem[0] * split;
+ a1 = con - y_elem[0];
+ a1 = con - a1;
+ a2 = y_elem[0] - a1;
+ con = beta_i[0] * split;
+ b1 = con - beta_i[0];
+ b1 = con - b1;
+ b2 = beta_i[0] - b1;
+
+ head_t1 = y_elem[0] * beta_i[0];
+ tail_t1 = (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = y_elem[1] * split;
+ a1 = con - y_elem[1];
+ a1 = con - a1;
+ a2 = y_elem[1] - a1;
+ con = beta_i[1] * split;
+ b1 = con - beta_i[1];
+ b1 = con - b1;
+ b2 = beta_i[1] - b1;
+
+ head_t2 = y_elem[1] * beta_i[1];
+ tail_t2 = (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_t2 = -head_t2;
+ tail_t2 = -tail_t2;
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_tmp2[0] = head_t1;
+ tail_tmp2[0] = tail_t1;
+ /* Imaginary part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = y_elem[1] * split;
+ a1 = con - y_elem[1];
+ a1 = con - a1;
+ a2 = y_elem[1] - a1;
+ con = beta_i[0] * split;
+ b1 = con - beta_i[0];
+ b1 = con - b1;
+ b2 = beta_i[0] - b1;
+
+ head_t1 = y_elem[1] * beta_i[0];
+ tail_t1 = (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = y_elem[0] * split;
+ a1 = con - y_elem[0];
+ a1 = con - a1;
+ a2 = y_elem[0] - a1;
+ con = beta_i[1] * split;
+ b1 = con - beta_i[1];
+ b1 = con - b1;
+ b2 = beta_i[1] - b1;
+
+ head_t2 = y_elem[0] * beta_i[1];
+ tail_t2 = (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_tmp2[1] = head_t1;
+ tail_tmp2[1] = tail_t1;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_tmp1[0];
+ tail_a = tail_tmp1[0];
+ head_b = head_tmp2[0];
+ tail_b = tail_tmp2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_tmp3[0] = head_t;
+ tail_tmp3[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_tmp1[1];
+ tail_a = tail_tmp1[1];
+ head_b = head_tmp2[1];
+ tail_b = tail_tmp2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_tmp3[1] = head_t;
+ tail_tmp3[1] = tail_t;
+ }
+ y_i[yi] = head_tmp3[0];
+ y_i[yi + 1] = head_tmp3[1];
+ }
+ }
+
+ FPU_FIX_STOP;
+
+ break;
+ }
+ }
+} /* end BLAS_zhemv2_x */
--- /dev/null
+
+#include "f2c-bridge.h"
+#include "blas_enum.h"
+void BLAS_zhemv2_z_c(enum blas_order_type order, enum blas_uplo_type uplo,
+ int n, const void *alpha, const void *a, int lda,
+ const void *x_head, const void *x_tail, int incx,
+ const void *beta, const void *y, int incy);
+
+
+extern void FC_FUNC_(blas_zhemv2_z_c, BLAS_ZHEMV2_Z_C)
+
+ (int *uplo, int *n, const void *alpha, const void *a, int *lda,
+ const void *x_head, const void *x_tail, int *incx, const void *beta,
+ const void *y, int *incy) {
+ BLAS_zhemv2_z_c(blas_colmajor, (enum blas_uplo_type) *uplo, *n, alpha, a,
+ *lda, x_head, x_tail, *incx, beta, y, *incy);
+}
--- /dev/null
+#include <blas_extended.h>
+#include <blas_extended_private.h>
+#include <blas_fpu.h>
+void BLAS_zhemv2_z_c(enum blas_order_type order, enum blas_uplo_type uplo,
+ int n, const void *alpha, const void *a, int lda,
+ const void *x_head, const void *x_tail, int incx,
+ const void *beta, const void *y, int incy)
+
+/*
+ * Purpose
+ * =======
+ *
+ * This routines computes the matrix product:
+ *
+ * y <- alpha * A * (x_head + x_tail) + beta * y
+ *
+ * where A is a complex Hermitian matrix.
+ *
+ * Arguments
+ * =========
+ *
+ * order (input) enum blas_order_type
+ * Storage format of input symmetric matrix A.
+ *
+ * uplo (input) enum blas_uplo_type
+ * Determines which half of matrix A (upper or lower triangle)
+ * is accessed.
+ *
+ * n (input) int
+ * Dimension of A and size of vectors x, y.
+ *
+ * alpha (input) const void*
+ *
+ * a (input) void*
+ * Matrix A.
+ *
+ * lda (input) int
+ * Leading dimension of matrix A.
+ *
+ * x_head (input) void*
+ * Vector x_head
+ *
+ * x_tail (input) void*
+ * Vector x_tail
+ *
+ * incx (input) int
+ * Stride for vector x.
+ *
+ * beta (input) const void*
+ *
+ * y (input) void*
+ * Vector y.
+ *
+ * incy (input) int
+ * Stride for vector y.
+ *
+ */
+{
+ /* Routine name */
+ const char routine_name[] = "BLAS_zhemv2_z_c";
+
+ int i, j;
+ int xi, yi, xi0, yi0;
+ int aij, ai;
+ int incai;
+ int incaij, incaij2;
+
+ const double *a_i = (double *) a;
+ const float *x_head_i = (float *) x_head;
+ const float *x_tail_i = (float *) x_tail;
+ double *y_i = (double *) y;
+ double *alpha_i = (double *) alpha;
+ double *beta_i = (double *) beta;
+ double a_elem[2];
+ float x_elem[2];
+ double y_elem[2];
+ double diag_elem;
+ double prod1[2];
+ double prod2[2];
+ double sum1[2];
+ double sum2[2];
+ double tmp1[2];
+ double tmp2[2];
+ double tmp3[2];
+
+
+
+ /* Test for no-op */
+ if (n <= 0) {
+ return;
+ }
+ if (alpha_i[0] == 0.0 && alpha_i[1] == 0.0
+ && (beta_i[0] == 1.0 && beta_i[1] == 0.0)) {
+ return;
+ }
+
+ /* Check for error conditions. */
+ if (n < 0) {
+ BLAS_error(routine_name, -3, n, NULL);
+ }
+ if (lda < n) {
+ BLAS_error(routine_name, -6, n, NULL);
+ }
+ if (incx == 0) {
+ BLAS_error(routine_name, -9, incx, NULL);
+ }
+ if (incy == 0) {
+ BLAS_error(routine_name, -12, incy, NULL);
+ }
+
+ if ((order == blas_colmajor && uplo == blas_upper) ||
+ (order == blas_rowmajor && uplo == blas_lower)) {
+ incai = lda;
+ incaij = 1;
+ incaij2 = lda;
+ } else {
+ incai = 1;
+ incaij = lda;
+ incaij2 = 1;
+ }
+
+ incx *= 2;
+ incy *= 2;
+ incai *= 2;
+ incaij *= 2;
+ incaij2 *= 2;
+ xi0 = (incx > 0) ? 0 : ((-n + 1) * incx);
+ yi0 = (incy > 0) ? 0 : ((-n + 1) * incy);
+
+
+
+ /* The most general form, y <--- alpha * A * (x_head + x_tail) + beta * y */
+ if (uplo == blas_lower) {
+ for (i = 0, yi = yi0, ai = 0; i < n; i++, yi += incy, ai += incai) {
+ sum1[0] = sum1[1] = 0.0;
+ sum2[0] = sum2[1] = 0.0;
+ for (j = 0, aij = ai, xi = xi0; j < i; j++, aij += incaij, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] =
+ (double) a_elem[0] * x_elem[0] - (double) a_elem[1] * x_elem[1];
+ prod1[1] =
+ (double) a_elem[0] * x_elem[1] + (double) a_elem[1] * x_elem[0];
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] =
+ (double) a_elem[0] * x_elem[0] - (double) a_elem[1] * x_elem[1];
+ prod2[1] =
+ (double) a_elem[0] * x_elem[1] + (double) a_elem[1] * x_elem[0];
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+
+ diag_elem = a_i[aij];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] = x_elem[0] * diag_elem;
+ prod1[1] = x_elem[1] * diag_elem;
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] = x_elem[0] * diag_elem;
+ prod2[1] = x_elem[1] * diag_elem;
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ j++;
+ aij += incaij2;
+ xi += incx;
+
+ for (; j < n; j++, aij += incaij2, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ a_elem[1] = -a_elem[1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] =
+ (double) a_elem[0] * x_elem[0] - (double) a_elem[1] * x_elem[1];
+ prod1[1] =
+ (double) a_elem[0] * x_elem[1] + (double) a_elem[1] * x_elem[0];
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] =
+ (double) a_elem[0] * x_elem[0] - (double) a_elem[1] * x_elem[1];
+ prod2[1] =
+ (double) a_elem[0] * x_elem[1] + (double) a_elem[1] * x_elem[0];
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+ sum1[0] = sum1[0] + sum2[0];
+ sum1[1] = sum1[1] + sum2[1];
+ {
+ tmp1[0] =
+ (double) sum1[0] * alpha_i[0] - (double) sum1[1] * alpha_i[1];
+ tmp1[1] =
+ (double) sum1[0] * alpha_i[1] + (double) sum1[1] * alpha_i[0];
+ }
+ y_elem[0] = y_i[yi];
+ y_elem[1] = y_i[yi + 1];
+ {
+ tmp2[0] =
+ (double) y_elem[0] * beta_i[0] - (double) y_elem[1] * beta_i[1];
+ tmp2[1] =
+ (double) y_elem[0] * beta_i[1] + (double) y_elem[1] * beta_i[0];
+ }
+ tmp3[0] = tmp1[0] + tmp2[0];
+ tmp3[1] = tmp1[1] + tmp2[1];
+ y_i[yi] = tmp3[0];
+ y_i[yi + 1] = tmp3[1];
+ }
+ } else {
+ /* uplo == blas_upper */
+ for (i = 0, yi = yi0, ai = 0; i < n; i++, yi += incy, ai += incai) {
+ sum1[0] = sum1[1] = 0.0;
+ sum2[0] = sum2[1] = 0.0;
+
+ for (j = 0, aij = ai, xi = xi0; j < i; j++, aij += incaij, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ a_elem[1] = -a_elem[1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] =
+ (double) a_elem[0] * x_elem[0] - (double) a_elem[1] * x_elem[1];
+ prod1[1] =
+ (double) a_elem[0] * x_elem[1] + (double) a_elem[1] * x_elem[0];
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] =
+ (double) a_elem[0] * x_elem[0] - (double) a_elem[1] * x_elem[1];
+ prod2[1] =
+ (double) a_elem[0] * x_elem[1] + (double) a_elem[1] * x_elem[0];
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+
+ diag_elem = a_i[aij];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] = x_elem[0] * diag_elem;
+ prod1[1] = x_elem[1] * diag_elem;
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] = x_elem[0] * diag_elem;
+ prod2[1] = x_elem[1] * diag_elem;
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ j++;
+ aij += incaij2;
+ xi += incx;
+
+ for (; j < n; j++, aij += incaij2, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] =
+ (double) a_elem[0] * x_elem[0] - (double) a_elem[1] * x_elem[1];
+ prod1[1] =
+ (double) a_elem[0] * x_elem[1] + (double) a_elem[1] * x_elem[0];
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] =
+ (double) a_elem[0] * x_elem[0] - (double) a_elem[1] * x_elem[1];
+ prod2[1] =
+ (double) a_elem[0] * x_elem[1] + (double) a_elem[1] * x_elem[0];
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+ sum1[0] = sum1[0] + sum2[0];
+ sum1[1] = sum1[1] + sum2[1];
+ {
+ tmp1[0] =
+ (double) sum1[0] * alpha_i[0] - (double) sum1[1] * alpha_i[1];
+ tmp1[1] =
+ (double) sum1[0] * alpha_i[1] + (double) sum1[1] * alpha_i[0];
+ }
+ y_elem[0] = y_i[yi];
+ y_elem[1] = y_i[yi + 1];
+ {
+ tmp2[0] =
+ (double) y_elem[0] * beta_i[0] - (double) y_elem[1] * beta_i[1];
+ tmp2[1] =
+ (double) y_elem[0] * beta_i[1] + (double) y_elem[1] * beta_i[0];
+ }
+ tmp3[0] = tmp1[0] + tmp2[0];
+ tmp3[1] = tmp1[1] + tmp2[1];
+ y_i[yi] = tmp3[0];
+ y_i[yi + 1] = tmp3[1];
+ }
+ }
+
+
+
+} /* end BLAS_zhemv2_z_c */
--- /dev/null
+
+#include "f2c-bridge.h"
+#include "blas_enum.h"
+void BLAS_zhemv2_z_c_x(enum blas_order_type order, enum blas_uplo_type uplo,
+ int n, const void *alpha, const void *a, int lda,
+ const void *x_head, const void *x_tail, int incx,
+ const void *beta, const void *y, int incy,
+ enum blas_prec_type prec);
+
+
+extern void FC_FUNC_(blas_zhemv2_z_c_x, BLAS_ZHEMV2_Z_C_X)
+
+ (int *uplo, int *n, const void *alpha, const void *a, int *lda,
+ const void *x_head, const void *x_tail, int *incx, const void *beta,
+ const void *y, int *incy, int *prec) {
+ BLAS_zhemv2_z_c_x(blas_colmajor, (enum blas_uplo_type) *uplo, *n, alpha, a,
+ *lda, x_head, x_tail, *incx, beta, y, *incy,
+ (enum blas_prec_type) *prec);
+}
--- /dev/null
+#include <blas_extended.h>
+#include <blas_extended_private.h>
+#include <blas_fpu.h>
+void BLAS_zhemv2_z_c_x(enum blas_order_type order, enum blas_uplo_type uplo,
+ int n, const void *alpha, const void *a, int lda,
+ const void *x_head, const void *x_tail, int incx,
+ const void *beta, const void *y, int incy,
+ enum blas_prec_type prec)
+
+/*
+ * Purpose
+ * =======
+ *
+ * This routines computes the matrix product:
+ *
+ * y <- alpha * A * (x_head + x_tail) + beta * y
+ *
+ * where A is a complex Hermitian matrix.
+ *
+ * Arguments
+ * =========
+ *
+ * order (input) enum blas_order_type
+ * Storage format of input symmetric matrix A.
+ *
+ * uplo (input) enum blas_uplo_type
+ * Determines which half of matrix A (upper or lower triangle)
+ * is accessed.
+ *
+ * n (input) int
+ * Dimension of A and size of vectors x, y.
+ *
+ * alpha (input) const void*
+ *
+ * a (input) void*
+ * Matrix A.
+ *
+ * lda (input) int
+ * Leading dimension of matrix A.
+ *
+ * x_head (input) void*
+ * Vector x_head
+ *
+ * x_tail (input) void*
+ * Vector x_tail
+ *
+ * incx (input) int
+ * Stride for vector x.
+ *
+ * beta (input) const void*
+ *
+ * y (input) void*
+ * Vector y.
+ *
+ * incy (input) int
+ * Stride for vector y.
+ *
+ * prec (input) enum blas_prec_type
+ * Specifies the internal precision to be used.
+ * = blas_prec_single: single precision.
+ * = blas_prec_double: double precision.
+ * = blas_prec_extra : anything at least 1.5 times as accurate
+ * than double, and wider than 80-bits.
+ * We use double-double in our implementation.
+ *
+ */
+{
+ /* Routine name */
+ const char routine_name[] = "BLAS_zhemv2_z_c_x";
+ switch (prec) {
+
+ case blas_prec_single:{
+
+ int i, j;
+ int xi, yi, xi0, yi0;
+ int aij, ai;
+ int incai;
+ int incaij, incaij2;
+
+ const double *a_i = (double *) a;
+ const float *x_head_i = (float *) x_head;
+ const float *x_tail_i = (float *) x_tail;
+ double *y_i = (double *) y;
+ double *alpha_i = (double *) alpha;
+ double *beta_i = (double *) beta;
+ double a_elem[2];
+ float x_elem[2];
+ double y_elem[2];
+ double diag_elem;
+ double prod1[2];
+ double prod2[2];
+ double sum1[2];
+ double sum2[2];
+ double tmp1[2];
+ double tmp2[2];
+ double tmp3[2];
+
+
+
+ /* Test for no-op */
+ if (n <= 0) {
+ return;
+ }
+ if (alpha_i[0] == 0.0 && alpha_i[1] == 0.0
+ && (beta_i[0] == 1.0 && beta_i[1] == 0.0)) {
+ return;
+ }
+
+ /* Check for error conditions. */
+ if (n < 0) {
+ BLAS_error(routine_name, -3, n, NULL);
+ }
+ if (lda < n) {
+ BLAS_error(routine_name, -6, n, NULL);
+ }
+ if (incx == 0) {
+ BLAS_error(routine_name, -9, incx, NULL);
+ }
+ if (incy == 0) {
+ BLAS_error(routine_name, -12, incy, NULL);
+ }
+
+ if ((order == blas_colmajor && uplo == blas_upper) ||
+ (order == blas_rowmajor && uplo == blas_lower)) {
+ incai = lda;
+ incaij = 1;
+ incaij2 = lda;
+ } else {
+ incai = 1;
+ incaij = lda;
+ incaij2 = 1;
+ }
+
+ incx *= 2;
+ incy *= 2;
+ incai *= 2;
+ incaij *= 2;
+ incaij2 *= 2;
+ xi0 = (incx > 0) ? 0 : ((-n + 1) * incx);
+ yi0 = (incy > 0) ? 0 : ((-n + 1) * incy);
+
+
+
+ /* The most general form, y <--- alpha * A * (x_head + x_tail) + beta * y */
+ if (uplo == blas_lower) {
+ for (i = 0, yi = yi0, ai = 0; i < n; i++, yi += incy, ai += incai) {
+ sum1[0] = sum1[1] = 0.0;
+ sum2[0] = sum2[1] = 0.0;
+ for (j = 0, aij = ai, xi = xi0; j < i;
+ j++, aij += incaij, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod1[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod2[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+
+ diag_elem = a_i[aij];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] = x_elem[0] * diag_elem;
+ prod1[1] = x_elem[1] * diag_elem;
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] = x_elem[0] * diag_elem;
+ prod2[1] = x_elem[1] * diag_elem;
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ j++;
+ aij += incaij2;
+ xi += incx;
+
+ for (; j < n; j++, aij += incaij2, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ a_elem[1] = -a_elem[1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod1[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod2[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+ sum1[0] = sum1[0] + sum2[0];
+ sum1[1] = sum1[1] + sum2[1];
+ {
+ tmp1[0] =
+ (double) sum1[0] * alpha_i[0] - (double) sum1[1] * alpha_i[1];
+ tmp1[1] =
+ (double) sum1[0] * alpha_i[1] + (double) sum1[1] * alpha_i[0];
+ }
+ y_elem[0] = y_i[yi];
+ y_elem[1] = y_i[yi + 1];
+ {
+ tmp2[0] =
+ (double) y_elem[0] * beta_i[0] - (double) y_elem[1] * beta_i[1];
+ tmp2[1] =
+ (double) y_elem[0] * beta_i[1] + (double) y_elem[1] * beta_i[0];
+ }
+ tmp3[0] = tmp1[0] + tmp2[0];
+ tmp3[1] = tmp1[1] + tmp2[1];
+ y_i[yi] = tmp3[0];
+ y_i[yi + 1] = tmp3[1];
+ }
+ } else {
+ /* uplo == blas_upper */
+ for (i = 0, yi = yi0, ai = 0; i < n; i++, yi += incy, ai += incai) {
+ sum1[0] = sum1[1] = 0.0;
+ sum2[0] = sum2[1] = 0.0;
+
+ for (j = 0, aij = ai, xi = xi0; j < i;
+ j++, aij += incaij, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ a_elem[1] = -a_elem[1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod1[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod2[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+
+ diag_elem = a_i[aij];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] = x_elem[0] * diag_elem;
+ prod1[1] = x_elem[1] * diag_elem;
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] = x_elem[0] * diag_elem;
+ prod2[1] = x_elem[1] * diag_elem;
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ j++;
+ aij += incaij2;
+ xi += incx;
+
+ for (; j < n; j++, aij += incaij2, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod1[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod2[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+ sum1[0] = sum1[0] + sum2[0];
+ sum1[1] = sum1[1] + sum2[1];
+ {
+ tmp1[0] =
+ (double) sum1[0] * alpha_i[0] - (double) sum1[1] * alpha_i[1];
+ tmp1[1] =
+ (double) sum1[0] * alpha_i[1] + (double) sum1[1] * alpha_i[0];
+ }
+ y_elem[0] = y_i[yi];
+ y_elem[1] = y_i[yi + 1];
+ {
+ tmp2[0] =
+ (double) y_elem[0] * beta_i[0] - (double) y_elem[1] * beta_i[1];
+ tmp2[1] =
+ (double) y_elem[0] * beta_i[1] + (double) y_elem[1] * beta_i[0];
+ }
+ tmp3[0] = tmp1[0] + tmp2[0];
+ tmp3[1] = tmp1[1] + tmp2[1];
+ y_i[yi] = tmp3[0];
+ y_i[yi + 1] = tmp3[1];
+ }
+ }
+
+
+
+ break;
+ }
+
+ case blas_prec_double:
+ case blas_prec_indigenous:{
+
+ int i, j;
+ int xi, yi, xi0, yi0;
+ int aij, ai;
+ int incai;
+ int incaij, incaij2;
+
+ const double *a_i = (double *) a;
+ const float *x_head_i = (float *) x_head;
+ const float *x_tail_i = (float *) x_tail;
+ double *y_i = (double *) y;
+ double *alpha_i = (double *) alpha;
+ double *beta_i = (double *) beta;
+ double a_elem[2];
+ float x_elem[2];
+ double y_elem[2];
+ double diag_elem;
+ double prod1[2];
+ double prod2[2];
+ double sum1[2];
+ double sum2[2];
+ double tmp1[2];
+ double tmp2[2];
+ double tmp3[2];
+
+
+
+ /* Test for no-op */
+ if (n <= 0) {
+ return;
+ }
+ if (alpha_i[0] == 0.0 && alpha_i[1] == 0.0
+ && (beta_i[0] == 1.0 && beta_i[1] == 0.0)) {
+ return;
+ }
+
+ /* Check for error conditions. */
+ if (n < 0) {
+ BLAS_error(routine_name, -3, n, NULL);
+ }
+ if (lda < n) {
+ BLAS_error(routine_name, -6, n, NULL);
+ }
+ if (incx == 0) {
+ BLAS_error(routine_name, -9, incx, NULL);
+ }
+ if (incy == 0) {
+ BLAS_error(routine_name, -12, incy, NULL);
+ }
+
+ if ((order == blas_colmajor && uplo == blas_upper) ||
+ (order == blas_rowmajor && uplo == blas_lower)) {
+ incai = lda;
+ incaij = 1;
+ incaij2 = lda;
+ } else {
+ incai = 1;
+ incaij = lda;
+ incaij2 = 1;
+ }
+
+ incx *= 2;
+ incy *= 2;
+ incai *= 2;
+ incaij *= 2;
+ incaij2 *= 2;
+ xi0 = (incx > 0) ? 0 : ((-n + 1) * incx);
+ yi0 = (incy > 0) ? 0 : ((-n + 1) * incy);
+
+
+
+ /* The most general form, y <--- alpha * A * (x_head + x_tail) + beta * y */
+ if (uplo == blas_lower) {
+ for (i = 0, yi = yi0, ai = 0; i < n; i++, yi += incy, ai += incai) {
+ sum1[0] = sum1[1] = 0.0;
+ sum2[0] = sum2[1] = 0.0;
+ for (j = 0, aij = ai, xi = xi0; j < i;
+ j++, aij += incaij, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod1[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod2[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+
+ diag_elem = a_i[aij];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] = x_elem[0] * diag_elem;
+ prod1[1] = x_elem[1] * diag_elem;
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] = x_elem[0] * diag_elem;
+ prod2[1] = x_elem[1] * diag_elem;
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ j++;
+ aij += incaij2;
+ xi += incx;
+
+ for (; j < n; j++, aij += incaij2, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ a_elem[1] = -a_elem[1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod1[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod2[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+ sum1[0] = sum1[0] + sum2[0];
+ sum1[1] = sum1[1] + sum2[1];
+ {
+ tmp1[0] =
+ (double) sum1[0] * alpha_i[0] - (double) sum1[1] * alpha_i[1];
+ tmp1[1] =
+ (double) sum1[0] * alpha_i[1] + (double) sum1[1] * alpha_i[0];
+ }
+ y_elem[0] = y_i[yi];
+ y_elem[1] = y_i[yi + 1];
+ {
+ tmp2[0] =
+ (double) y_elem[0] * beta_i[0] - (double) y_elem[1] * beta_i[1];
+ tmp2[1] =
+ (double) y_elem[0] * beta_i[1] + (double) y_elem[1] * beta_i[0];
+ }
+ tmp3[0] = tmp1[0] + tmp2[0];
+ tmp3[1] = tmp1[1] + tmp2[1];
+ y_i[yi] = tmp3[0];
+ y_i[yi + 1] = tmp3[1];
+ }
+ } else {
+ /* uplo == blas_upper */
+ for (i = 0, yi = yi0, ai = 0; i < n; i++, yi += incy, ai += incai) {
+ sum1[0] = sum1[1] = 0.0;
+ sum2[0] = sum2[1] = 0.0;
+
+ for (j = 0, aij = ai, xi = xi0; j < i;
+ j++, aij += incaij, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ a_elem[1] = -a_elem[1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod1[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod2[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+
+ diag_elem = a_i[aij];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] = x_elem[0] * diag_elem;
+ prod1[1] = x_elem[1] * diag_elem;
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] = x_elem[0] * diag_elem;
+ prod2[1] = x_elem[1] * diag_elem;
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ j++;
+ aij += incaij2;
+ xi += incx;
+
+ for (; j < n; j++, aij += incaij2, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ prod1[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod1[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ prod2[0] =
+ (double) a_elem[0] * x_elem[0] -
+ (double) a_elem[1] * x_elem[1];
+ prod2[1] =
+ (double) a_elem[0] * x_elem[1] +
+ (double) a_elem[1] * x_elem[0];
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+ sum1[0] = sum1[0] + sum2[0];
+ sum1[1] = sum1[1] + sum2[1];
+ {
+ tmp1[0] =
+ (double) sum1[0] * alpha_i[0] - (double) sum1[1] * alpha_i[1];
+ tmp1[1] =
+ (double) sum1[0] * alpha_i[1] + (double) sum1[1] * alpha_i[0];
+ }
+ y_elem[0] = y_i[yi];
+ y_elem[1] = y_i[yi + 1];
+ {
+ tmp2[0] =
+ (double) y_elem[0] * beta_i[0] - (double) y_elem[1] * beta_i[1];
+ tmp2[1] =
+ (double) y_elem[0] * beta_i[1] + (double) y_elem[1] * beta_i[0];
+ }
+ tmp3[0] = tmp1[0] + tmp2[0];
+ tmp3[1] = tmp1[1] + tmp2[1];
+ y_i[yi] = tmp3[0];
+ y_i[yi + 1] = tmp3[1];
+ }
+ }
+
+
+
+ break;
+ }
+
+ case blas_prec_extra:{
+
+ int i, j;
+ int xi, yi, xi0, yi0;
+ int aij, ai;
+ int incai;
+ int incaij, incaij2;
+
+ const double *a_i = (double *) a;
+ const float *x_head_i = (float *) x_head;
+ const float *x_tail_i = (float *) x_tail;
+ double *y_i = (double *) y;
+ double *alpha_i = (double *) alpha;
+ double *beta_i = (double *) beta;
+ double a_elem[2];
+ float x_elem[2];
+ double y_elem[2];
+ double diag_elem;
+ double head_prod1[2], tail_prod1[2];
+ double head_prod2[2], tail_prod2[2];
+ double head_sum1[2], tail_sum1[2];
+ double head_sum2[2], tail_sum2[2];
+ double head_tmp1[2], tail_tmp1[2];
+ double head_tmp2[2], tail_tmp2[2];
+ double head_tmp3[2], tail_tmp3[2];
+
+ FPU_FIX_DECL;
+
+ /* Test for no-op */
+ if (n <= 0) {
+ return;
+ }
+ if (alpha_i[0] == 0.0 && alpha_i[1] == 0.0
+ && (beta_i[0] == 1.0 && beta_i[1] == 0.0)) {
+ return;
+ }
+
+ /* Check for error conditions. */
+ if (n < 0) {
+ BLAS_error(routine_name, -3, n, NULL);
+ }
+ if (lda < n) {
+ BLAS_error(routine_name, -6, n, NULL);
+ }
+ if (incx == 0) {
+ BLAS_error(routine_name, -9, incx, NULL);
+ }
+ if (incy == 0) {
+ BLAS_error(routine_name, -12, incy, NULL);
+ }
+
+ if ((order == blas_colmajor && uplo == blas_upper) ||
+ (order == blas_rowmajor && uplo == blas_lower)) {
+ incai = lda;
+ incaij = 1;
+ incaij2 = lda;
+ } else {
+ incai = 1;
+ incaij = lda;
+ incaij2 = 1;
+ }
+
+ incx *= 2;
+ incy *= 2;
+ incai *= 2;
+ incaij *= 2;
+ incaij2 *= 2;
+ xi0 = (incx > 0) ? 0 : ((-n + 1) * incx);
+ yi0 = (incy > 0) ? 0 : ((-n + 1) * incy);
+
+ FPU_FIX_START;
+
+ /* The most general form, y <--- alpha * A * (x_head + x_tail) + beta * y */
+ if (uplo == blas_lower) {
+ for (i = 0, yi = yi0, ai = 0; i < n; i++, yi += incy, ai += incai) {
+ head_sum1[0] = head_sum1[1] = tail_sum1[0] = tail_sum1[1] = 0.0;
+ head_sum2[0] = head_sum2[1] = tail_sum2[0] = tail_sum2[1] = 0.0;
+ for (j = 0, aij = ai, xi = xi0; j < i;
+ j++, aij += incaij, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ double cd[2];
+ cd[0] = (double) x_elem[0];
+ cd[1] = (double) x_elem[1];
+ {
+ /* Compute complex-extra = complex-double * complex-double. */
+ double head_t1, tail_t1;
+ double head_t2, tail_t2;
+ /* Real part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[0] * split;
+ a1 = con - a_elem[0];
+ a1 = con - a1;
+ a2 = a_elem[0] - a1;
+ con = cd[0] * split;
+ b1 = con - cd[0];
+ b1 = con - b1;
+ b2 = cd[0] - b1;
+
+ head_t1 = a_elem[0] * cd[0];
+ tail_t1 =
+ (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[1] * split;
+ a1 = con - a_elem[1];
+ a1 = con - a1;
+ a2 = a_elem[1] - a1;
+ con = cd[1] * split;
+ b1 = con - cd[1];
+ b1 = con - b1;
+ b2 = cd[1] - b1;
+
+ head_t2 = a_elem[1] * cd[1];
+ tail_t2 =
+ (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_t2 = -head_t2;
+ tail_t2 = -tail_t2;
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_prod1[0] = head_t1;
+ tail_prod1[0] = tail_t1;
+ /* Imaginary part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[1] * split;
+ a1 = con - a_elem[1];
+ a1 = con - a1;
+ a2 = a_elem[1] - a1;
+ con = cd[0] * split;
+ b1 = con - cd[0];
+ b1 = con - b1;
+ b2 = cd[0] - b1;
+
+ head_t1 = a_elem[1] * cd[0];
+ tail_t1 =
+ (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[0] * split;
+ a1 = con - a_elem[0];
+ a1 = con - a1;
+ a2 = a_elem[0] - a1;
+ con = cd[1] * split;
+ b1 = con - cd[1];
+ b1 = con - b1;
+ b2 = cd[1] - b1;
+
+ head_t2 = a_elem[0] * cd[1];
+ tail_t2 =
+ (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_prod1[1] = head_t1;
+ tail_prod1[1] = tail_t1;
+ }
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum1[0];
+ tail_a = tail_sum1[0];
+ head_b = head_prod1[0];
+ tail_b = tail_prod1[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[0] = head_t;
+ tail_sum1[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum1[1];
+ tail_a = tail_sum1[1];
+ head_b = head_prod1[1];
+ tail_b = tail_prod1[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[1] = head_t;
+ tail_sum1[1] = tail_t;
+ }
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ double cd[2];
+ cd[0] = (double) x_elem[0];
+ cd[1] = (double) x_elem[1];
+ {
+ /* Compute complex-extra = complex-double * complex-double. */
+ double head_t1, tail_t1;
+ double head_t2, tail_t2;
+ /* Real part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[0] * split;
+ a1 = con - a_elem[0];
+ a1 = con - a1;
+ a2 = a_elem[0] - a1;
+ con = cd[0] * split;
+ b1 = con - cd[0];
+ b1 = con - b1;
+ b2 = cd[0] - b1;
+
+ head_t1 = a_elem[0] * cd[0];
+ tail_t1 =
+ (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[1] * split;
+ a1 = con - a_elem[1];
+ a1 = con - a1;
+ a2 = a_elem[1] - a1;
+ con = cd[1] * split;
+ b1 = con - cd[1];
+ b1 = con - b1;
+ b2 = cd[1] - b1;
+
+ head_t2 = a_elem[1] * cd[1];
+ tail_t2 =
+ (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_t2 = -head_t2;
+ tail_t2 = -tail_t2;
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_prod2[0] = head_t1;
+ tail_prod2[0] = tail_t1;
+ /* Imaginary part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[1] * split;
+ a1 = con - a_elem[1];
+ a1 = con - a1;
+ a2 = a_elem[1] - a1;
+ con = cd[0] * split;
+ b1 = con - cd[0];
+ b1 = con - b1;
+ b2 = cd[0] - b1;
+
+ head_t1 = a_elem[1] * cd[0];
+ tail_t1 =
+ (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[0] * split;
+ a1 = con - a_elem[0];
+ a1 = con - a1;
+ a2 = a_elem[0] - a1;
+ con = cd[1] * split;
+ b1 = con - cd[1];
+ b1 = con - b1;
+ b2 = cd[1] - b1;
+
+ head_t2 = a_elem[0] * cd[1];
+ tail_t2 =
+ (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_prod2[1] = head_t1;
+ tail_prod2[1] = tail_t1;
+ }
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum2[0];
+ tail_a = tail_sum2[0];
+ head_b = head_prod2[0];
+ tail_b = tail_prod2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[0] = head_t;
+ tail_sum2[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum2[1];
+ tail_a = tail_sum2[1];
+ head_b = head_prod2[1];
+ tail_b = tail_prod2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[1] = head_t;
+ tail_sum2[1] = tail_t;
+ }
+ }
+
+ diag_elem = a_i[aij];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ head_prod1[0] = (double) x_elem[0] * diag_elem;
+ tail_prod1[0] = 0.0;
+ head_prod1[1] = (double) x_elem[1] * diag_elem;
+ tail_prod1[1] = 0.0;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum1[0];
+ tail_a = tail_sum1[0];
+ head_b = head_prod1[0];
+ tail_b = tail_prod1[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[0] = head_t;
+ tail_sum1[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum1[1];
+ tail_a = tail_sum1[1];
+ head_b = head_prod1[1];
+ tail_b = tail_prod1[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[1] = head_t;
+ tail_sum1[1] = tail_t;
+ }
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ head_prod2[0] = (double) x_elem[0] * diag_elem;
+ tail_prod2[0] = 0.0;
+ head_prod2[1] = (double) x_elem[1] * diag_elem;
+ tail_prod2[1] = 0.0;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum2[0];
+ tail_a = tail_sum2[0];
+ head_b = head_prod2[0];
+ tail_b = tail_prod2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[0] = head_t;
+ tail_sum2[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum2[1];
+ tail_a = tail_sum2[1];
+ head_b = head_prod2[1];
+ tail_b = tail_prod2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[1] = head_t;
+ tail_sum2[1] = tail_t;
+ }
+ j++;
+ aij += incaij2;
+ xi += incx;
+
+ for (; j < n; j++, aij += incaij2, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ a_elem[1] = -a_elem[1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ double cd[2];
+ cd[0] = (double) x_elem[0];
+ cd[1] = (double) x_elem[1];
+ {
+ /* Compute complex-extra = complex-double * complex-double. */
+ double head_t1, tail_t1;
+ double head_t2, tail_t2;
+ /* Real part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[0] * split;
+ a1 = con - a_elem[0];
+ a1 = con - a1;
+ a2 = a_elem[0] - a1;
+ con = cd[0] * split;
+ b1 = con - cd[0];
+ b1 = con - b1;
+ b2 = cd[0] - b1;
+
+ head_t1 = a_elem[0] * cd[0];
+ tail_t1 =
+ (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[1] * split;
+ a1 = con - a_elem[1];
+ a1 = con - a1;
+ a2 = a_elem[1] - a1;
+ con = cd[1] * split;
+ b1 = con - cd[1];
+ b1 = con - b1;
+ b2 = cd[1] - b1;
+
+ head_t2 = a_elem[1] * cd[1];
+ tail_t2 =
+ (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_t2 = -head_t2;
+ tail_t2 = -tail_t2;
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_prod1[0] = head_t1;
+ tail_prod1[0] = tail_t1;
+ /* Imaginary part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[1] * split;
+ a1 = con - a_elem[1];
+ a1 = con - a1;
+ a2 = a_elem[1] - a1;
+ con = cd[0] * split;
+ b1 = con - cd[0];
+ b1 = con - b1;
+ b2 = cd[0] - b1;
+
+ head_t1 = a_elem[1] * cd[0];
+ tail_t1 =
+ (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[0] * split;
+ a1 = con - a_elem[0];
+ a1 = con - a1;
+ a2 = a_elem[0] - a1;
+ con = cd[1] * split;
+ b1 = con - cd[1];
+ b1 = con - b1;
+ b2 = cd[1] - b1;
+
+ head_t2 = a_elem[0] * cd[1];
+ tail_t2 =
+ (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_prod1[1] = head_t1;
+ tail_prod1[1] = tail_t1;
+ }
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum1[0];
+ tail_a = tail_sum1[0];
+ head_b = head_prod1[0];
+ tail_b = tail_prod1[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[0] = head_t;
+ tail_sum1[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum1[1];
+ tail_a = tail_sum1[1];
+ head_b = head_prod1[1];
+ tail_b = tail_prod1[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[1] = head_t;
+ tail_sum1[1] = tail_t;
+ }
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ double cd[2];
+ cd[0] = (double) x_elem[0];
+ cd[1] = (double) x_elem[1];
+ {
+ /* Compute complex-extra = complex-double * complex-double. */
+ double head_t1, tail_t1;
+ double head_t2, tail_t2;
+ /* Real part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[0] * split;
+ a1 = con - a_elem[0];
+ a1 = con - a1;
+ a2 = a_elem[0] - a1;
+ con = cd[0] * split;
+ b1 = con - cd[0];
+ b1 = con - b1;
+ b2 = cd[0] - b1;
+
+ head_t1 = a_elem[0] * cd[0];
+ tail_t1 =
+ (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[1] * split;
+ a1 = con - a_elem[1];
+ a1 = con - a1;
+ a2 = a_elem[1] - a1;
+ con = cd[1] * split;
+ b1 = con - cd[1];
+ b1 = con - b1;
+ b2 = cd[1] - b1;
+
+ head_t2 = a_elem[1] * cd[1];
+ tail_t2 =
+ (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_t2 = -head_t2;
+ tail_t2 = -tail_t2;
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_prod2[0] = head_t1;
+ tail_prod2[0] = tail_t1;
+ /* Imaginary part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[1] * split;
+ a1 = con - a_elem[1];
+ a1 = con - a1;
+ a2 = a_elem[1] - a1;
+ con = cd[0] * split;
+ b1 = con - cd[0];
+ b1 = con - b1;
+ b2 = cd[0] - b1;
+
+ head_t1 = a_elem[1] * cd[0];
+ tail_t1 =
+ (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[0] * split;
+ a1 = con - a_elem[0];
+ a1 = con - a1;
+ a2 = a_elem[0] - a1;
+ con = cd[1] * split;
+ b1 = con - cd[1];
+ b1 = con - b1;
+ b2 = cd[1] - b1;
+
+ head_t2 = a_elem[0] * cd[1];
+ tail_t2 =
+ (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_prod2[1] = head_t1;
+ tail_prod2[1] = tail_t1;
+ }
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum2[0];
+ tail_a = tail_sum2[0];
+ head_b = head_prod2[0];
+ tail_b = tail_prod2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[0] = head_t;
+ tail_sum2[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum2[1];
+ tail_a = tail_sum2[1];
+ head_b = head_prod2[1];
+ tail_b = tail_prod2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[1] = head_t;
+ tail_sum2[1] = tail_t;
+ }
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum1[0];
+ tail_a = tail_sum1[0];
+ head_b = head_sum2[0];
+ tail_b = tail_sum2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[0] = head_t;
+ tail_sum1[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum1[1];
+ tail_a = tail_sum1[1];
+ head_b = head_sum2[1];
+ tail_b = tail_sum2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[1] = head_t;
+ tail_sum1[1] = tail_t;
+ }
+ {
+ /* Compute complex-extra = complex-extra * complex-double. */
+ double head_a0, tail_a0;
+ double head_a1, tail_a1;
+ double head_t1, tail_t1;
+ double head_t2, tail_t2;
+ head_a0 = head_sum1[0];
+ tail_a0 = tail_sum1[0];
+ head_a1 = head_sum1[1];
+ tail_a1 = tail_sum1[1];
+ /* real part */
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_a0 * split;
+ a11 = con - head_a0;
+ a11 = con - a11;
+ a21 = head_a0 - a11;
+ con = alpha_i[0] * split;
+ b1 = con - alpha_i[0];
+ b1 = con - b1;
+ b2 = alpha_i[0] - b1;
+
+ c11 = head_a0 * alpha_i[0];
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_a0 * alpha_i[0];
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_a1 * split;
+ a11 = con - head_a1;
+ a11 = con - a11;
+ a21 = head_a1 - a11;
+ con = alpha_i[1] * split;
+ b1 = con - alpha_i[1];
+ b1 = con - b1;
+ b2 = alpha_i[1] - b1;
+
+ c11 = head_a1 * alpha_i[1];
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_a1 * alpha_i[1];
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_t2 = t1 + t2;
+ tail_t2 = t2 - (head_t2 - t1);
+ }
+ head_t2 = -head_t2;
+ tail_t2 = -tail_t2;
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_tmp1[0] = head_t1;
+ tail_tmp1[0] = tail_t1;
+ /* imaginary part */
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_a1 * split;
+ a11 = con - head_a1;
+ a11 = con - a11;
+ a21 = head_a1 - a11;
+ con = alpha_i[0] * split;
+ b1 = con - alpha_i[0];
+ b1 = con - b1;
+ b2 = alpha_i[0] - b1;
+
+ c11 = head_a1 * alpha_i[0];
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_a1 * alpha_i[0];
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_a0 * split;
+ a11 = con - head_a0;
+ a11 = con - a11;
+ a21 = head_a0 - a11;
+ con = alpha_i[1] * split;
+ b1 = con - alpha_i[1];
+ b1 = con - b1;
+ b2 = alpha_i[1] - b1;
+
+ c11 = head_a0 * alpha_i[1];
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_a0 * alpha_i[1];
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_t2 = t1 + t2;
+ tail_t2 = t2 - (head_t2 - t1);
+ }
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_tmp1[1] = head_t1;
+ tail_tmp1[1] = tail_t1;
+ }
+
+ y_elem[0] = y_i[yi];
+ y_elem[1] = y_i[yi + 1];
+ {
+ /* Compute complex-extra = complex-double * complex-double. */
+ double head_t1, tail_t1;
+ double head_t2, tail_t2;
+ /* Real part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = y_elem[0] * split;
+ a1 = con - y_elem[0];
+ a1 = con - a1;
+ a2 = y_elem[0] - a1;
+ con = beta_i[0] * split;
+ b1 = con - beta_i[0];
+ b1 = con - b1;
+ b2 = beta_i[0] - b1;
+
+ head_t1 = y_elem[0] * beta_i[0];
+ tail_t1 = (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = y_elem[1] * split;
+ a1 = con - y_elem[1];
+ a1 = con - a1;
+ a2 = y_elem[1] - a1;
+ con = beta_i[1] * split;
+ b1 = con - beta_i[1];
+ b1 = con - b1;
+ b2 = beta_i[1] - b1;
+
+ head_t2 = y_elem[1] * beta_i[1];
+ tail_t2 = (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_t2 = -head_t2;
+ tail_t2 = -tail_t2;
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_tmp2[0] = head_t1;
+ tail_tmp2[0] = tail_t1;
+ /* Imaginary part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = y_elem[1] * split;
+ a1 = con - y_elem[1];
+ a1 = con - a1;
+ a2 = y_elem[1] - a1;
+ con = beta_i[0] * split;
+ b1 = con - beta_i[0];
+ b1 = con - b1;
+ b2 = beta_i[0] - b1;
+
+ head_t1 = y_elem[1] * beta_i[0];
+ tail_t1 = (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = y_elem[0] * split;
+ a1 = con - y_elem[0];
+ a1 = con - a1;
+ a2 = y_elem[0] - a1;
+ con = beta_i[1] * split;
+ b1 = con - beta_i[1];
+ b1 = con - b1;
+ b2 = beta_i[1] - b1;
+
+ head_t2 = y_elem[0] * beta_i[1];
+ tail_t2 = (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_tmp2[1] = head_t1;
+ tail_tmp2[1] = tail_t1;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_tmp1[0];
+ tail_a = tail_tmp1[0];
+ head_b = head_tmp2[0];
+ tail_b = tail_tmp2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_tmp3[0] = head_t;
+ tail_tmp3[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_tmp1[1];
+ tail_a = tail_tmp1[1];
+ head_b = head_tmp2[1];
+ tail_b = tail_tmp2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_tmp3[1] = head_t;
+ tail_tmp3[1] = tail_t;
+ }
+ y_i[yi] = head_tmp3[0];
+ y_i[yi + 1] = head_tmp3[1];
+ }
+ } else {
+ /* uplo == blas_upper */
+ for (i = 0, yi = yi0, ai = 0; i < n; i++, yi += incy, ai += incai) {
+ head_sum1[0] = head_sum1[1] = tail_sum1[0] = tail_sum1[1] = 0.0;
+ head_sum2[0] = head_sum2[1] = tail_sum2[0] = tail_sum2[1] = 0.0;
+
+ for (j = 0, aij = ai, xi = xi0; j < i;
+ j++, aij += incaij, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ a_elem[1] = -a_elem[1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ double cd[2];
+ cd[0] = (double) x_elem[0];
+ cd[1] = (double) x_elem[1];
+ {
+ /* Compute complex-extra = complex-double * complex-double. */
+ double head_t1, tail_t1;
+ double head_t2, tail_t2;
+ /* Real part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[0] * split;
+ a1 = con - a_elem[0];
+ a1 = con - a1;
+ a2 = a_elem[0] - a1;
+ con = cd[0] * split;
+ b1 = con - cd[0];
+ b1 = con - b1;
+ b2 = cd[0] - b1;
+
+ head_t1 = a_elem[0] * cd[0];
+ tail_t1 =
+ (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[1] * split;
+ a1 = con - a_elem[1];
+ a1 = con - a1;
+ a2 = a_elem[1] - a1;
+ con = cd[1] * split;
+ b1 = con - cd[1];
+ b1 = con - b1;
+ b2 = cd[1] - b1;
+
+ head_t2 = a_elem[1] * cd[1];
+ tail_t2 =
+ (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_t2 = -head_t2;
+ tail_t2 = -tail_t2;
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_prod1[0] = head_t1;
+ tail_prod1[0] = tail_t1;
+ /* Imaginary part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[1] * split;
+ a1 = con - a_elem[1];
+ a1 = con - a1;
+ a2 = a_elem[1] - a1;
+ con = cd[0] * split;
+ b1 = con - cd[0];
+ b1 = con - b1;
+ b2 = cd[0] - b1;
+
+ head_t1 = a_elem[1] * cd[0];
+ tail_t1 =
+ (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[0] * split;
+ a1 = con - a_elem[0];
+ a1 = con - a1;
+ a2 = a_elem[0] - a1;
+ con = cd[1] * split;
+ b1 = con - cd[1];
+ b1 = con - b1;
+ b2 = cd[1] - b1;
+
+ head_t2 = a_elem[0] * cd[1];
+ tail_t2 =
+ (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_prod1[1] = head_t1;
+ tail_prod1[1] = tail_t1;
+ }
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum1[0];
+ tail_a = tail_sum1[0];
+ head_b = head_prod1[0];
+ tail_b = tail_prod1[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[0] = head_t;
+ tail_sum1[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum1[1];
+ tail_a = tail_sum1[1];
+ head_b = head_prod1[1];
+ tail_b = tail_prod1[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[1] = head_t;
+ tail_sum1[1] = tail_t;
+ }
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ double cd[2];
+ cd[0] = (double) x_elem[0];
+ cd[1] = (double) x_elem[1];
+ {
+ /* Compute complex-extra = complex-double * complex-double. */
+ double head_t1, tail_t1;
+ double head_t2, tail_t2;
+ /* Real part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[0] * split;
+ a1 = con - a_elem[0];
+ a1 = con - a1;
+ a2 = a_elem[0] - a1;
+ con = cd[0] * split;
+ b1 = con - cd[0];
+ b1 = con - b1;
+ b2 = cd[0] - b1;
+
+ head_t1 = a_elem[0] * cd[0];
+ tail_t1 =
+ (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[1] * split;
+ a1 = con - a_elem[1];
+ a1 = con - a1;
+ a2 = a_elem[1] - a1;
+ con = cd[1] * split;
+ b1 = con - cd[1];
+ b1 = con - b1;
+ b2 = cd[1] - b1;
+
+ head_t2 = a_elem[1] * cd[1];
+ tail_t2 =
+ (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_t2 = -head_t2;
+ tail_t2 = -tail_t2;
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_prod2[0] = head_t1;
+ tail_prod2[0] = tail_t1;
+ /* Imaginary part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[1] * split;
+ a1 = con - a_elem[1];
+ a1 = con - a1;
+ a2 = a_elem[1] - a1;
+ con = cd[0] * split;
+ b1 = con - cd[0];
+ b1 = con - b1;
+ b2 = cd[0] - b1;
+
+ head_t1 = a_elem[1] * cd[0];
+ tail_t1 =
+ (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[0] * split;
+ a1 = con - a_elem[0];
+ a1 = con - a1;
+ a2 = a_elem[0] - a1;
+ con = cd[1] * split;
+ b1 = con - cd[1];
+ b1 = con - b1;
+ b2 = cd[1] - b1;
+
+ head_t2 = a_elem[0] * cd[1];
+ tail_t2 =
+ (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_prod2[1] = head_t1;
+ tail_prod2[1] = tail_t1;
+ }
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum2[0];
+ tail_a = tail_sum2[0];
+ head_b = head_prod2[0];
+ tail_b = tail_prod2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[0] = head_t;
+ tail_sum2[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum2[1];
+ tail_a = tail_sum2[1];
+ head_b = head_prod2[1];
+ tail_b = tail_prod2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[1] = head_t;
+ tail_sum2[1] = tail_t;
+ }
+ }
+
+ diag_elem = a_i[aij];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ head_prod1[0] = (double) x_elem[0] * diag_elem;
+ tail_prod1[0] = 0.0;
+ head_prod1[1] = (double) x_elem[1] * diag_elem;
+ tail_prod1[1] = 0.0;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum1[0];
+ tail_a = tail_sum1[0];
+ head_b = head_prod1[0];
+ tail_b = tail_prod1[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[0] = head_t;
+ tail_sum1[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum1[1];
+ tail_a = tail_sum1[1];
+ head_b = head_prod1[1];
+ tail_b = tail_prod1[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[1] = head_t;
+ tail_sum1[1] = tail_t;
+ }
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ head_prod2[0] = (double) x_elem[0] * diag_elem;
+ tail_prod2[0] = 0.0;
+ head_prod2[1] = (double) x_elem[1] * diag_elem;
+ tail_prod2[1] = 0.0;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum2[0];
+ tail_a = tail_sum2[0];
+ head_b = head_prod2[0];
+ tail_b = tail_prod2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[0] = head_t;
+ tail_sum2[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum2[1];
+ tail_a = tail_sum2[1];
+ head_b = head_prod2[1];
+ tail_b = tail_prod2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[1] = head_t;
+ tail_sum2[1] = tail_t;
+ }
+ j++;
+ aij += incaij2;
+ xi += incx;
+
+ for (; j < n; j++, aij += incaij2, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ x_elem[0] = x_head_i[xi];
+ x_elem[1] = x_head_i[xi + 1];
+ {
+ double cd[2];
+ cd[0] = (double) x_elem[0];
+ cd[1] = (double) x_elem[1];
+ {
+ /* Compute complex-extra = complex-double * complex-double. */
+ double head_t1, tail_t1;
+ double head_t2, tail_t2;
+ /* Real part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[0] * split;
+ a1 = con - a_elem[0];
+ a1 = con - a1;
+ a2 = a_elem[0] - a1;
+ con = cd[0] * split;
+ b1 = con - cd[0];
+ b1 = con - b1;
+ b2 = cd[0] - b1;
+
+ head_t1 = a_elem[0] * cd[0];
+ tail_t1 =
+ (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[1] * split;
+ a1 = con - a_elem[1];
+ a1 = con - a1;
+ a2 = a_elem[1] - a1;
+ con = cd[1] * split;
+ b1 = con - cd[1];
+ b1 = con - b1;
+ b2 = cd[1] - b1;
+
+ head_t2 = a_elem[1] * cd[1];
+ tail_t2 =
+ (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_t2 = -head_t2;
+ tail_t2 = -tail_t2;
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_prod1[0] = head_t1;
+ tail_prod1[0] = tail_t1;
+ /* Imaginary part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[1] * split;
+ a1 = con - a_elem[1];
+ a1 = con - a1;
+ a2 = a_elem[1] - a1;
+ con = cd[0] * split;
+ b1 = con - cd[0];
+ b1 = con - b1;
+ b2 = cd[0] - b1;
+
+ head_t1 = a_elem[1] * cd[0];
+ tail_t1 =
+ (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[0] * split;
+ a1 = con - a_elem[0];
+ a1 = con - a1;
+ a2 = a_elem[0] - a1;
+ con = cd[1] * split;
+ b1 = con - cd[1];
+ b1 = con - b1;
+ b2 = cd[1] - b1;
+
+ head_t2 = a_elem[0] * cd[1];
+ tail_t2 =
+ (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_prod1[1] = head_t1;
+ tail_prod1[1] = tail_t1;
+ }
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum1[0];
+ tail_a = tail_sum1[0];
+ head_b = head_prod1[0];
+ tail_b = tail_prod1[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[0] = head_t;
+ tail_sum1[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum1[1];
+ tail_a = tail_sum1[1];
+ head_b = head_prod1[1];
+ tail_b = tail_prod1[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[1] = head_t;
+ tail_sum1[1] = tail_t;
+ }
+ x_elem[0] = x_tail_i[xi];
+ x_elem[1] = x_tail_i[xi + 1];
+ {
+ double cd[2];
+ cd[0] = (double) x_elem[0];
+ cd[1] = (double) x_elem[1];
+ {
+ /* Compute complex-extra = complex-double * complex-double. */
+ double head_t1, tail_t1;
+ double head_t2, tail_t2;
+ /* Real part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[0] * split;
+ a1 = con - a_elem[0];
+ a1 = con - a1;
+ a2 = a_elem[0] - a1;
+ con = cd[0] * split;
+ b1 = con - cd[0];
+ b1 = con - b1;
+ b2 = cd[0] - b1;
+
+ head_t1 = a_elem[0] * cd[0];
+ tail_t1 =
+ (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[1] * split;
+ a1 = con - a_elem[1];
+ a1 = con - a1;
+ a2 = a_elem[1] - a1;
+ con = cd[1] * split;
+ b1 = con - cd[1];
+ b1 = con - b1;
+ b2 = cd[1] - b1;
+
+ head_t2 = a_elem[1] * cd[1];
+ tail_t2 =
+ (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_t2 = -head_t2;
+ tail_t2 = -tail_t2;
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_prod2[0] = head_t1;
+ tail_prod2[0] = tail_t1;
+ /* Imaginary part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[1] * split;
+ a1 = con - a_elem[1];
+ a1 = con - a1;
+ a2 = a_elem[1] - a1;
+ con = cd[0] * split;
+ b1 = con - cd[0];
+ b1 = con - b1;
+ b2 = cd[0] - b1;
+
+ head_t1 = a_elem[1] * cd[0];
+ tail_t1 =
+ (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = a_elem[0] * split;
+ a1 = con - a_elem[0];
+ a1 = con - a1;
+ a2 = a_elem[0] - a1;
+ con = cd[1] * split;
+ b1 = con - cd[1];
+ b1 = con - b1;
+ b2 = cd[1] - b1;
+
+ head_t2 = a_elem[0] * cd[1];
+ tail_t2 =
+ (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_prod2[1] = head_t1;
+ tail_prod2[1] = tail_t1;
+ }
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum2[0];
+ tail_a = tail_sum2[0];
+ head_b = head_prod2[0];
+ tail_b = tail_prod2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[0] = head_t;
+ tail_sum2[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum2[1];
+ tail_a = tail_sum2[1];
+ head_b = head_prod2[1];
+ tail_b = tail_prod2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[1] = head_t;
+ tail_sum2[1] = tail_t;
+ }
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum1[0];
+ tail_a = tail_sum1[0];
+ head_b = head_sum2[0];
+ tail_b = tail_sum2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[0] = head_t;
+ tail_sum1[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum1[1];
+ tail_a = tail_sum1[1];
+ head_b = head_sum2[1];
+ tail_b = tail_sum2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[1] = head_t;
+ tail_sum1[1] = tail_t;
+ }
+ {
+ /* Compute complex-extra = complex-extra * complex-double. */
+ double head_a0, tail_a0;
+ double head_a1, tail_a1;
+ double head_t1, tail_t1;
+ double head_t2, tail_t2;
+ head_a0 = head_sum1[0];
+ tail_a0 = tail_sum1[0];
+ head_a1 = head_sum1[1];
+ tail_a1 = tail_sum1[1];
+ /* real part */
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_a0 * split;
+ a11 = con - head_a0;
+ a11 = con - a11;
+ a21 = head_a0 - a11;
+ con = alpha_i[0] * split;
+ b1 = con - alpha_i[0];
+ b1 = con - b1;
+ b2 = alpha_i[0] - b1;
+
+ c11 = head_a0 * alpha_i[0];
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_a0 * alpha_i[0];
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_a1 * split;
+ a11 = con - head_a1;
+ a11 = con - a11;
+ a21 = head_a1 - a11;
+ con = alpha_i[1] * split;
+ b1 = con - alpha_i[1];
+ b1 = con - b1;
+ b2 = alpha_i[1] - b1;
+
+ c11 = head_a1 * alpha_i[1];
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_a1 * alpha_i[1];
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_t2 = t1 + t2;
+ tail_t2 = t2 - (head_t2 - t1);
+ }
+ head_t2 = -head_t2;
+ tail_t2 = -tail_t2;
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_tmp1[0] = head_t1;
+ tail_tmp1[0] = tail_t1;
+ /* imaginary part */
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_a1 * split;
+ a11 = con - head_a1;
+ a11 = con - a11;
+ a21 = head_a1 - a11;
+ con = alpha_i[0] * split;
+ b1 = con - alpha_i[0];
+ b1 = con - b1;
+ b2 = alpha_i[0] - b1;
+
+ c11 = head_a1 * alpha_i[0];
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_a1 * alpha_i[0];
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_a0 * split;
+ a11 = con - head_a0;
+ a11 = con - a11;
+ a21 = head_a0 - a11;
+ con = alpha_i[1] * split;
+ b1 = con - alpha_i[1];
+ b1 = con - b1;
+ b2 = alpha_i[1] - b1;
+
+ c11 = head_a0 * alpha_i[1];
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_a0 * alpha_i[1];
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_t2 = t1 + t2;
+ tail_t2 = t2 - (head_t2 - t1);
+ }
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_tmp1[1] = head_t1;
+ tail_tmp1[1] = tail_t1;
+ }
+
+ y_elem[0] = y_i[yi];
+ y_elem[1] = y_i[yi + 1];
+ {
+ /* Compute complex-extra = complex-double * complex-double. */
+ double head_t1, tail_t1;
+ double head_t2, tail_t2;
+ /* Real part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = y_elem[0] * split;
+ a1 = con - y_elem[0];
+ a1 = con - a1;
+ a2 = y_elem[0] - a1;
+ con = beta_i[0] * split;
+ b1 = con - beta_i[0];
+ b1 = con - b1;
+ b2 = beta_i[0] - b1;
+
+ head_t1 = y_elem[0] * beta_i[0];
+ tail_t1 = (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = y_elem[1] * split;
+ a1 = con - y_elem[1];
+ a1 = con - a1;
+ a2 = y_elem[1] - a1;
+ con = beta_i[1] * split;
+ b1 = con - beta_i[1];
+ b1 = con - b1;
+ b2 = beta_i[1] - b1;
+
+ head_t2 = y_elem[1] * beta_i[1];
+ tail_t2 = (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_t2 = -head_t2;
+ tail_t2 = -tail_t2;
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_tmp2[0] = head_t1;
+ tail_tmp2[0] = tail_t1;
+ /* Imaginary part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = y_elem[1] * split;
+ a1 = con - y_elem[1];
+ a1 = con - a1;
+ a2 = y_elem[1] - a1;
+ con = beta_i[0] * split;
+ b1 = con - beta_i[0];
+ b1 = con - b1;
+ b2 = beta_i[0] - b1;
+
+ head_t1 = y_elem[1] * beta_i[0];
+ tail_t1 = (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = y_elem[0] * split;
+ a1 = con - y_elem[0];
+ a1 = con - a1;
+ a2 = y_elem[0] - a1;
+ con = beta_i[1] * split;
+ b1 = con - beta_i[1];
+ b1 = con - b1;
+ b2 = beta_i[1] - b1;
+
+ head_t2 = y_elem[0] * beta_i[1];
+ tail_t2 = (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_tmp2[1] = head_t1;
+ tail_tmp2[1] = tail_t1;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_tmp1[0];
+ tail_a = tail_tmp1[0];
+ head_b = head_tmp2[0];
+ tail_b = tail_tmp2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_tmp3[0] = head_t;
+ tail_tmp3[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_tmp1[1];
+ tail_a = tail_tmp1[1];
+ head_b = head_tmp2[1];
+ tail_b = tail_tmp2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_tmp3[1] = head_t;
+ tail_tmp3[1] = tail_t;
+ }
+ y_i[yi] = head_tmp3[0];
+ y_i[yi + 1] = head_tmp3[1];
+ }
+ }
+
+ FPU_FIX_STOP;
+
+ break;
+ }
+ }
+} /* end BLAS_zhemv2_z_c_x */
--- /dev/null
+
+#include "f2c-bridge.h"
+#include "blas_enum.h"
+void BLAS_zhemv2_z_d(enum blas_order_type order, enum blas_uplo_type uplo,
+ int n, const void *alpha, const void *a, int lda,
+ const double *x_head, const double *x_tail, int incx,
+ const void *beta, const double *y, int incy);
+
+
+extern void FC_FUNC_(blas_zhemv2_z_d, BLAS_ZHEMV2_Z_D)
+
+ (int *uplo, int *n, const void *alpha, const void *a, int *lda,
+ const double *x_head, const double *x_tail, int *incx, const void *beta,
+ const double *y, int *incy) {
+ BLAS_zhemv2_z_d(blas_colmajor, (enum blas_uplo_type) *uplo, *n, alpha, a,
+ *lda, x_head, x_tail, *incx, beta, y, *incy);
+}
--- /dev/null
+#include <blas_extended.h>
+#include <blas_extended_private.h>
+#include <blas_fpu.h>
+void BLAS_zhemv2_z_d(enum blas_order_type order, enum blas_uplo_type uplo,
+ int n, const void *alpha, const void *a, int lda,
+ const double *x_head, const double *x_tail, int incx,
+ const void *beta, const double *y, int incy)
+
+/*
+ * Purpose
+ * =======
+ *
+ * This routines computes the matrix product:
+ *
+ * y <- alpha * A * (x_head + x_tail) + beta * y
+ *
+ * where A is a complex Hermitian matrix.
+ *
+ * Arguments
+ * =========
+ *
+ * order (input) enum blas_order_type
+ * Storage format of input symmetric matrix A.
+ *
+ * uplo (input) enum blas_uplo_type
+ * Determines which half of matrix A (upper or lower triangle)
+ * is accessed.
+ *
+ * n (input) int
+ * Dimension of A and size of vectors x, y.
+ *
+ * alpha (input) const void*
+ *
+ * a (input) void*
+ * Matrix A.
+ *
+ * lda (input) int
+ * Leading dimension of matrix A.
+ *
+ * x_head (input) double*
+ * Vector x_head
+ *
+ * x_tail (input) double*
+ * Vector x_tail
+ *
+ * incx (input) int
+ * Stride for vector x.
+ *
+ * beta (input) const void*
+ *
+ * y (input) double*
+ * Vector y.
+ *
+ * incy (input) int
+ * Stride for vector y.
+ *
+ */
+{
+ /* Routine name */
+ const char routine_name[] = "BLAS_zhemv2_z_d";
+
+ int i, j;
+ int xi, yi, xi0, yi0;
+ int aij, ai;
+ int incai;
+ int incaij, incaij2;
+
+ const double *a_i = (double *) a;
+ const double *x_head_i = x_head;
+ const double *x_tail_i = x_tail;
+ double *y_i = (double *) y;
+ double *alpha_i = (double *) alpha;
+ double *beta_i = (double *) beta;
+ double a_elem[2];
+ double x_elem;
+ double y_elem[2];
+ double diag_elem;
+ double prod1[2];
+ double prod2[2];
+ double sum1[2];
+ double sum2[2];
+ double tmp1[2];
+ double tmp2[2];
+ double tmp3[2];
+
+
+
+ /* Test for no-op */
+ if (n <= 0) {
+ return;
+ }
+ if (alpha_i[0] == 0.0 && alpha_i[1] == 0.0
+ && (beta_i[0] == 1.0 && beta_i[1] == 0.0)) {
+ return;
+ }
+
+ /* Check for error conditions. */
+ if (n < 0) {
+ BLAS_error(routine_name, -3, n, NULL);
+ }
+ if (lda < n) {
+ BLAS_error(routine_name, -6, n, NULL);
+ }
+ if (incx == 0) {
+ BLAS_error(routine_name, -9, incx, NULL);
+ }
+ if (incy == 0) {
+ BLAS_error(routine_name, -12, incy, NULL);
+ }
+
+ if ((order == blas_colmajor && uplo == blas_upper) ||
+ (order == blas_rowmajor && uplo == blas_lower)) {
+ incai = lda;
+ incaij = 1;
+ incaij2 = lda;
+ } else {
+ incai = 1;
+ incaij = lda;
+ incaij2 = 1;
+ }
+
+
+ incy *= 2;
+ incai *= 2;
+ incaij *= 2;
+ incaij2 *= 2;
+ xi0 = (incx > 0) ? 0 : ((-n + 1) * incx);
+ yi0 = (incy > 0) ? 0 : ((-n + 1) * incy);
+
+
+
+ /* The most general form, y <--- alpha * A * (x_head + x_tail) + beta * y */
+ if (uplo == blas_lower) {
+ for (i = 0, yi = yi0, ai = 0; i < n; i++, yi += incy, ai += incai) {
+ sum1[0] = sum1[1] = 0.0;
+ sum2[0] = sum2[1] = 0.0;
+ for (j = 0, aij = ai, xi = xi0; j < i; j++, aij += incaij, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ x_elem = x_head_i[xi];
+ {
+ prod1[0] = a_elem[0] * x_elem;
+ prod1[1] = a_elem[1] * x_elem;
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem = x_tail_i[xi];
+ {
+ prod2[0] = a_elem[0] * x_elem;
+ prod2[1] = a_elem[1] * x_elem;
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+
+ diag_elem = a_i[aij];
+ x_elem = x_head_i[xi];
+ prod1[0] = x_elem * diag_elem;
+ prod1[1] = 0.0;
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem = x_tail_i[xi];
+ prod2[0] = x_elem * diag_elem;
+ prod2[1] = 0.0;
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ j++;
+ aij += incaij2;
+ xi += incx;
+
+ for (; j < n; j++, aij += incaij2, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ a_elem[1] = -a_elem[1];
+ x_elem = x_head_i[xi];
+ {
+ prod1[0] = a_elem[0] * x_elem;
+ prod1[1] = a_elem[1] * x_elem;
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem = x_tail_i[xi];
+ {
+ prod2[0] = a_elem[0] * x_elem;
+ prod2[1] = a_elem[1] * x_elem;
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+ sum1[0] = sum1[0] + sum2[0];
+ sum1[1] = sum1[1] + sum2[1];
+ {
+ tmp1[0] =
+ (double) sum1[0] * alpha_i[0] - (double) sum1[1] * alpha_i[1];
+ tmp1[1] =
+ (double) sum1[0] * alpha_i[1] + (double) sum1[1] * alpha_i[0];
+ }
+ y_elem[0] = y_i[yi];
+ y_elem[1] = y_i[yi + 1];
+ {
+ tmp2[0] =
+ (double) y_elem[0] * beta_i[0] - (double) y_elem[1] * beta_i[1];
+ tmp2[1] =
+ (double) y_elem[0] * beta_i[1] + (double) y_elem[1] * beta_i[0];
+ }
+ tmp3[0] = tmp1[0] + tmp2[0];
+ tmp3[1] = tmp1[1] + tmp2[1];
+ y_i[yi] = tmp3[0];
+ y_i[yi + 1] = tmp3[1];
+ }
+ } else {
+ /* uplo == blas_upper */
+ for (i = 0, yi = yi0, ai = 0; i < n; i++, yi += incy, ai += incai) {
+ sum1[0] = sum1[1] = 0.0;
+ sum2[0] = sum2[1] = 0.0;
+
+ for (j = 0, aij = ai, xi = xi0; j < i; j++, aij += incaij, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ a_elem[1] = -a_elem[1];
+ x_elem = x_head_i[xi];
+ {
+ prod1[0] = a_elem[0] * x_elem;
+ prod1[1] = a_elem[1] * x_elem;
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem = x_tail_i[xi];
+ {
+ prod2[0] = a_elem[0] * x_elem;
+ prod2[1] = a_elem[1] * x_elem;
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+
+ diag_elem = a_i[aij];
+ x_elem = x_head_i[xi];
+ prod1[0] = x_elem * diag_elem;
+ prod1[1] = 0.0;
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem = x_tail_i[xi];
+ prod2[0] = x_elem * diag_elem;
+ prod2[1] = 0.0;
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ j++;
+ aij += incaij2;
+ xi += incx;
+
+ for (; j < n; j++, aij += incaij2, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ x_elem = x_head_i[xi];
+ {
+ prod1[0] = a_elem[0] * x_elem;
+ prod1[1] = a_elem[1] * x_elem;
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem = x_tail_i[xi];
+ {
+ prod2[0] = a_elem[0] * x_elem;
+ prod2[1] = a_elem[1] * x_elem;
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+ sum1[0] = sum1[0] + sum2[0];
+ sum1[1] = sum1[1] + sum2[1];
+ {
+ tmp1[0] =
+ (double) sum1[0] * alpha_i[0] - (double) sum1[1] * alpha_i[1];
+ tmp1[1] =
+ (double) sum1[0] * alpha_i[1] + (double) sum1[1] * alpha_i[0];
+ }
+ y_elem[0] = y_i[yi];
+ y_elem[1] = y_i[yi + 1];
+ {
+ tmp2[0] =
+ (double) y_elem[0] * beta_i[0] - (double) y_elem[1] * beta_i[1];
+ tmp2[1] =
+ (double) y_elem[0] * beta_i[1] + (double) y_elem[1] * beta_i[0];
+ }
+ tmp3[0] = tmp1[0] + tmp2[0];
+ tmp3[1] = tmp1[1] + tmp2[1];
+ y_i[yi] = tmp3[0];
+ y_i[yi + 1] = tmp3[1];
+ }
+ }
+
+
+
+} /* end BLAS_zhemv2_z_d */
--- /dev/null
+
+#include "f2c-bridge.h"
+#include "blas_enum.h"
+void BLAS_zhemv2_z_d_x(enum blas_order_type order, enum blas_uplo_type uplo,
+ int n, const void *alpha, const void *a, int lda,
+ const double *x_head, const double *x_tail, int incx,
+ const void *beta, const double *y, int incy,
+ enum blas_prec_type prec);
+
+
+extern void FC_FUNC_(blas_zhemv2_z_d_x, BLAS_ZHEMV2_Z_D_X)
+
+ (int *uplo, int *n, const void *alpha, const void *a, int *lda,
+ const double *x_head, const double *x_tail, int *incx, const void *beta,
+ const double *y, int *incy, int *prec) {
+ BLAS_zhemv2_z_d_x(blas_colmajor, (enum blas_uplo_type) *uplo, *n, alpha, a,
+ *lda, x_head, x_tail, *incx, beta, y, *incy,
+ (enum blas_prec_type) *prec);
+}
--- /dev/null
+#include <blas_extended.h>
+#include <blas_extended_private.h>
+#include <blas_fpu.h>
+void BLAS_zhemv2_z_d_x(enum blas_order_type order, enum blas_uplo_type uplo,
+ int n, const void *alpha, const void *a, int lda,
+ const double *x_head, const double *x_tail, int incx,
+ const void *beta, const double *y, int incy,
+ enum blas_prec_type prec)
+
+/*
+ * Purpose
+ * =======
+ *
+ * This routines computes the matrix product:
+ *
+ * y <- alpha * A * (x_head + x_tail) + beta * y
+ *
+ * where A is a complex Hermitian matrix.
+ *
+ * Arguments
+ * =========
+ *
+ * order (input) enum blas_order_type
+ * Storage format of input symmetric matrix A.
+ *
+ * uplo (input) enum blas_uplo_type
+ * Determines which half of matrix A (upper or lower triangle)
+ * is accessed.
+ *
+ * n (input) int
+ * Dimension of A and size of vectors x, y.
+ *
+ * alpha (input) const void*
+ *
+ * a (input) void*
+ * Matrix A.
+ *
+ * lda (input) int
+ * Leading dimension of matrix A.
+ *
+ * x_head (input) double*
+ * Vector x_head
+ *
+ * x_tail (input) double*
+ * Vector x_tail
+ *
+ * incx (input) int
+ * Stride for vector x.
+ *
+ * beta (input) const void*
+ *
+ * y (input) double*
+ * Vector y.
+ *
+ * incy (input) int
+ * Stride for vector y.
+ *
+ * prec (input) enum blas_prec_type
+ * Specifies the internal precision to be used.
+ * = blas_prec_single: single precision.
+ * = blas_prec_double: double precision.
+ * = blas_prec_extra : anything at least 1.5 times as accurate
+ * than double, and wider than 80-bits.
+ * We use double-double in our implementation.
+ *
+ */
+{
+ /* Routine name */
+ const char routine_name[] = "BLAS_zhemv2_z_d_x";
+ switch (prec) {
+
+ case blas_prec_single:{
+
+ int i, j;
+ int xi, yi, xi0, yi0;
+ int aij, ai;
+ int incai;
+ int incaij, incaij2;
+
+ const double *a_i = (double *) a;
+ const double *x_head_i = x_head;
+ const double *x_tail_i = x_tail;
+ double *y_i = (double *) y;
+ double *alpha_i = (double *) alpha;
+ double *beta_i = (double *) beta;
+ double a_elem[2];
+ double x_elem;
+ double y_elem[2];
+ double diag_elem;
+ double prod1[2];
+ double prod2[2];
+ double sum1[2];
+ double sum2[2];
+ double tmp1[2];
+ double tmp2[2];
+ double tmp3[2];
+
+
+
+ /* Test for no-op */
+ if (n <= 0) {
+ return;
+ }
+ if (alpha_i[0] == 0.0 && alpha_i[1] == 0.0
+ && (beta_i[0] == 1.0 && beta_i[1] == 0.0)) {
+ return;
+ }
+
+ /* Check for error conditions. */
+ if (n < 0) {
+ BLAS_error(routine_name, -3, n, NULL);
+ }
+ if (lda < n) {
+ BLAS_error(routine_name, -6, n, NULL);
+ }
+ if (incx == 0) {
+ BLAS_error(routine_name, -9, incx, NULL);
+ }
+ if (incy == 0) {
+ BLAS_error(routine_name, -12, incy, NULL);
+ }
+
+ if ((order == blas_colmajor && uplo == blas_upper) ||
+ (order == blas_rowmajor && uplo == blas_lower)) {
+ incai = lda;
+ incaij = 1;
+ incaij2 = lda;
+ } else {
+ incai = 1;
+ incaij = lda;
+ incaij2 = 1;
+ }
+
+
+ incy *= 2;
+ incai *= 2;
+ incaij *= 2;
+ incaij2 *= 2;
+ xi0 = (incx > 0) ? 0 : ((-n + 1) * incx);
+ yi0 = (incy > 0) ? 0 : ((-n + 1) * incy);
+
+
+
+ /* The most general form, y <--- alpha * A * (x_head + x_tail) + beta * y */
+ if (uplo == blas_lower) {
+ for (i = 0, yi = yi0, ai = 0; i < n; i++, yi += incy, ai += incai) {
+ sum1[0] = sum1[1] = 0.0;
+ sum2[0] = sum2[1] = 0.0;
+ for (j = 0, aij = ai, xi = xi0; j < i;
+ j++, aij += incaij, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ x_elem = x_head_i[xi];
+ {
+ prod1[0] = a_elem[0] * x_elem;
+ prod1[1] = a_elem[1] * x_elem;
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem = x_tail_i[xi];
+ {
+ prod2[0] = a_elem[0] * x_elem;
+ prod2[1] = a_elem[1] * x_elem;
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+
+ diag_elem = a_i[aij];
+ x_elem = x_head_i[xi];
+ prod1[0] = x_elem * diag_elem;
+ prod1[1] = 0.0;
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem = x_tail_i[xi];
+ prod2[0] = x_elem * diag_elem;
+ prod2[1] = 0.0;
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ j++;
+ aij += incaij2;
+ xi += incx;
+
+ for (; j < n; j++, aij += incaij2, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ a_elem[1] = -a_elem[1];
+ x_elem = x_head_i[xi];
+ {
+ prod1[0] = a_elem[0] * x_elem;
+ prod1[1] = a_elem[1] * x_elem;
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem = x_tail_i[xi];
+ {
+ prod2[0] = a_elem[0] * x_elem;
+ prod2[1] = a_elem[1] * x_elem;
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+ sum1[0] = sum1[0] + sum2[0];
+ sum1[1] = sum1[1] + sum2[1];
+ {
+ tmp1[0] =
+ (double) sum1[0] * alpha_i[0] - (double) sum1[1] * alpha_i[1];
+ tmp1[1] =
+ (double) sum1[0] * alpha_i[1] + (double) sum1[1] * alpha_i[0];
+ }
+ y_elem[0] = y_i[yi];
+ y_elem[1] = y_i[yi + 1];
+ {
+ tmp2[0] =
+ (double) y_elem[0] * beta_i[0] - (double) y_elem[1] * beta_i[1];
+ tmp2[1] =
+ (double) y_elem[0] * beta_i[1] + (double) y_elem[1] * beta_i[0];
+ }
+ tmp3[0] = tmp1[0] + tmp2[0];
+ tmp3[1] = tmp1[1] + tmp2[1];
+ y_i[yi] = tmp3[0];
+ y_i[yi + 1] = tmp3[1];
+ }
+ } else {
+ /* uplo == blas_upper */
+ for (i = 0, yi = yi0, ai = 0; i < n; i++, yi += incy, ai += incai) {
+ sum1[0] = sum1[1] = 0.0;
+ sum2[0] = sum2[1] = 0.0;
+
+ for (j = 0, aij = ai, xi = xi0; j < i;
+ j++, aij += incaij, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ a_elem[1] = -a_elem[1];
+ x_elem = x_head_i[xi];
+ {
+ prod1[0] = a_elem[0] * x_elem;
+ prod1[1] = a_elem[1] * x_elem;
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem = x_tail_i[xi];
+ {
+ prod2[0] = a_elem[0] * x_elem;
+ prod2[1] = a_elem[1] * x_elem;
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+
+ diag_elem = a_i[aij];
+ x_elem = x_head_i[xi];
+ prod1[0] = x_elem * diag_elem;
+ prod1[1] = 0.0;
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem = x_tail_i[xi];
+ prod2[0] = x_elem * diag_elem;
+ prod2[1] = 0.0;
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ j++;
+ aij += incaij2;
+ xi += incx;
+
+ for (; j < n; j++, aij += incaij2, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ x_elem = x_head_i[xi];
+ {
+ prod1[0] = a_elem[0] * x_elem;
+ prod1[1] = a_elem[1] * x_elem;
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem = x_tail_i[xi];
+ {
+ prod2[0] = a_elem[0] * x_elem;
+ prod2[1] = a_elem[1] * x_elem;
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+ sum1[0] = sum1[0] + sum2[0];
+ sum1[1] = sum1[1] + sum2[1];
+ {
+ tmp1[0] =
+ (double) sum1[0] * alpha_i[0] - (double) sum1[1] * alpha_i[1];
+ tmp1[1] =
+ (double) sum1[0] * alpha_i[1] + (double) sum1[1] * alpha_i[0];
+ }
+ y_elem[0] = y_i[yi];
+ y_elem[1] = y_i[yi + 1];
+ {
+ tmp2[0] =
+ (double) y_elem[0] * beta_i[0] - (double) y_elem[1] * beta_i[1];
+ tmp2[1] =
+ (double) y_elem[0] * beta_i[1] + (double) y_elem[1] * beta_i[0];
+ }
+ tmp3[0] = tmp1[0] + tmp2[0];
+ tmp3[1] = tmp1[1] + tmp2[1];
+ y_i[yi] = tmp3[0];
+ y_i[yi + 1] = tmp3[1];
+ }
+ }
+
+
+
+ break;
+ }
+
+ case blas_prec_double:
+ case blas_prec_indigenous:{
+
+ int i, j;
+ int xi, yi, xi0, yi0;
+ int aij, ai;
+ int incai;
+ int incaij, incaij2;
+
+ const double *a_i = (double *) a;
+ const double *x_head_i = x_head;
+ const double *x_tail_i = x_tail;
+ double *y_i = (double *) y;
+ double *alpha_i = (double *) alpha;
+ double *beta_i = (double *) beta;
+ double a_elem[2];
+ double x_elem;
+ double y_elem[2];
+ double diag_elem;
+ double prod1[2];
+ double prod2[2];
+ double sum1[2];
+ double sum2[2];
+ double tmp1[2];
+ double tmp2[2];
+ double tmp3[2];
+
+
+
+ /* Test for no-op */
+ if (n <= 0) {
+ return;
+ }
+ if (alpha_i[0] == 0.0 && alpha_i[1] == 0.0
+ && (beta_i[0] == 1.0 && beta_i[1] == 0.0)) {
+ return;
+ }
+
+ /* Check for error conditions. */
+ if (n < 0) {
+ BLAS_error(routine_name, -3, n, NULL);
+ }
+ if (lda < n) {
+ BLAS_error(routine_name, -6, n, NULL);
+ }
+ if (incx == 0) {
+ BLAS_error(routine_name, -9, incx, NULL);
+ }
+ if (incy == 0) {
+ BLAS_error(routine_name, -12, incy, NULL);
+ }
+
+ if ((order == blas_colmajor && uplo == blas_upper) ||
+ (order == blas_rowmajor && uplo == blas_lower)) {
+ incai = lda;
+ incaij = 1;
+ incaij2 = lda;
+ } else {
+ incai = 1;
+ incaij = lda;
+ incaij2 = 1;
+ }
+
+
+ incy *= 2;
+ incai *= 2;
+ incaij *= 2;
+ incaij2 *= 2;
+ xi0 = (incx > 0) ? 0 : ((-n + 1) * incx);
+ yi0 = (incy > 0) ? 0 : ((-n + 1) * incy);
+
+
+
+ /* The most general form, y <--- alpha * A * (x_head + x_tail) + beta * y */
+ if (uplo == blas_lower) {
+ for (i = 0, yi = yi0, ai = 0; i < n; i++, yi += incy, ai += incai) {
+ sum1[0] = sum1[1] = 0.0;
+ sum2[0] = sum2[1] = 0.0;
+ for (j = 0, aij = ai, xi = xi0; j < i;
+ j++, aij += incaij, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ x_elem = x_head_i[xi];
+ {
+ prod1[0] = a_elem[0] * x_elem;
+ prod1[1] = a_elem[1] * x_elem;
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem = x_tail_i[xi];
+ {
+ prod2[0] = a_elem[0] * x_elem;
+ prod2[1] = a_elem[1] * x_elem;
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+
+ diag_elem = a_i[aij];
+ x_elem = x_head_i[xi];
+ prod1[0] = x_elem * diag_elem;
+ prod1[1] = 0.0;
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem = x_tail_i[xi];
+ prod2[0] = x_elem * diag_elem;
+ prod2[1] = 0.0;
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ j++;
+ aij += incaij2;
+ xi += incx;
+
+ for (; j < n; j++, aij += incaij2, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ a_elem[1] = -a_elem[1];
+ x_elem = x_head_i[xi];
+ {
+ prod1[0] = a_elem[0] * x_elem;
+ prod1[1] = a_elem[1] * x_elem;
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem = x_tail_i[xi];
+ {
+ prod2[0] = a_elem[0] * x_elem;
+ prod2[1] = a_elem[1] * x_elem;
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+ sum1[0] = sum1[0] + sum2[0];
+ sum1[1] = sum1[1] + sum2[1];
+ {
+ tmp1[0] =
+ (double) sum1[0] * alpha_i[0] - (double) sum1[1] * alpha_i[1];
+ tmp1[1] =
+ (double) sum1[0] * alpha_i[1] + (double) sum1[1] * alpha_i[0];
+ }
+ y_elem[0] = y_i[yi];
+ y_elem[1] = y_i[yi + 1];
+ {
+ tmp2[0] =
+ (double) y_elem[0] * beta_i[0] - (double) y_elem[1] * beta_i[1];
+ tmp2[1] =
+ (double) y_elem[0] * beta_i[1] + (double) y_elem[1] * beta_i[0];
+ }
+ tmp3[0] = tmp1[0] + tmp2[0];
+ tmp3[1] = tmp1[1] + tmp2[1];
+ y_i[yi] = tmp3[0];
+ y_i[yi + 1] = tmp3[1];
+ }
+ } else {
+ /* uplo == blas_upper */
+ for (i = 0, yi = yi0, ai = 0; i < n; i++, yi += incy, ai += incai) {
+ sum1[0] = sum1[1] = 0.0;
+ sum2[0] = sum2[1] = 0.0;
+
+ for (j = 0, aij = ai, xi = xi0; j < i;
+ j++, aij += incaij, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ a_elem[1] = -a_elem[1];
+ x_elem = x_head_i[xi];
+ {
+ prod1[0] = a_elem[0] * x_elem;
+ prod1[1] = a_elem[1] * x_elem;
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem = x_tail_i[xi];
+ {
+ prod2[0] = a_elem[0] * x_elem;
+ prod2[1] = a_elem[1] * x_elem;
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+
+ diag_elem = a_i[aij];
+ x_elem = x_head_i[xi];
+ prod1[0] = x_elem * diag_elem;
+ prod1[1] = 0.0;
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem = x_tail_i[xi];
+ prod2[0] = x_elem * diag_elem;
+ prod2[1] = 0.0;
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ j++;
+ aij += incaij2;
+ xi += incx;
+
+ for (; j < n; j++, aij += incaij2, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ x_elem = x_head_i[xi];
+ {
+ prod1[0] = a_elem[0] * x_elem;
+ prod1[1] = a_elem[1] * x_elem;
+ }
+ sum1[0] = sum1[0] + prod1[0];
+ sum1[1] = sum1[1] + prod1[1];
+ x_elem = x_tail_i[xi];
+ {
+ prod2[0] = a_elem[0] * x_elem;
+ prod2[1] = a_elem[1] * x_elem;
+ }
+ sum2[0] = sum2[0] + prod2[0];
+ sum2[1] = sum2[1] + prod2[1];
+ }
+ sum1[0] = sum1[0] + sum2[0];
+ sum1[1] = sum1[1] + sum2[1];
+ {
+ tmp1[0] =
+ (double) sum1[0] * alpha_i[0] - (double) sum1[1] * alpha_i[1];
+ tmp1[1] =
+ (double) sum1[0] * alpha_i[1] + (double) sum1[1] * alpha_i[0];
+ }
+ y_elem[0] = y_i[yi];
+ y_elem[1] = y_i[yi + 1];
+ {
+ tmp2[0] =
+ (double) y_elem[0] * beta_i[0] - (double) y_elem[1] * beta_i[1];
+ tmp2[1] =
+ (double) y_elem[0] * beta_i[1] + (double) y_elem[1] * beta_i[0];
+ }
+ tmp3[0] = tmp1[0] + tmp2[0];
+ tmp3[1] = tmp1[1] + tmp2[1];
+ y_i[yi] = tmp3[0];
+ y_i[yi + 1] = tmp3[1];
+ }
+ }
+
+
+
+ break;
+ }
+
+ case blas_prec_extra:{
+
+ int i, j;
+ int xi, yi, xi0, yi0;
+ int aij, ai;
+ int incai;
+ int incaij, incaij2;
+
+ const double *a_i = (double *) a;
+ const double *x_head_i = x_head;
+ const double *x_tail_i = x_tail;
+ double *y_i = (double *) y;
+ double *alpha_i = (double *) alpha;
+ double *beta_i = (double *) beta;
+ double a_elem[2];
+ double x_elem;
+ double y_elem[2];
+ double diag_elem;
+ double head_prod1[2], tail_prod1[2];
+ double head_prod2[2], tail_prod2[2];
+ double head_sum1[2], tail_sum1[2];
+ double head_sum2[2], tail_sum2[2];
+ double head_tmp1[2], tail_tmp1[2];
+ double head_tmp2[2], tail_tmp2[2];
+ double head_tmp3[2], tail_tmp3[2];
+
+ FPU_FIX_DECL;
+
+ /* Test for no-op */
+ if (n <= 0) {
+ return;
+ }
+ if (alpha_i[0] == 0.0 && alpha_i[1] == 0.0
+ && (beta_i[0] == 1.0 && beta_i[1] == 0.0)) {
+ return;
+ }
+
+ /* Check for error conditions. */
+ if (n < 0) {
+ BLAS_error(routine_name, -3, n, NULL);
+ }
+ if (lda < n) {
+ BLAS_error(routine_name, -6, n, NULL);
+ }
+ if (incx == 0) {
+ BLAS_error(routine_name, -9, incx, NULL);
+ }
+ if (incy == 0) {
+ BLAS_error(routine_name, -12, incy, NULL);
+ }
+
+ if ((order == blas_colmajor && uplo == blas_upper) ||
+ (order == blas_rowmajor && uplo == blas_lower)) {
+ incai = lda;
+ incaij = 1;
+ incaij2 = lda;
+ } else {
+ incai = 1;
+ incaij = lda;
+ incaij2 = 1;
+ }
+
+
+ incy *= 2;
+ incai *= 2;
+ incaij *= 2;
+ incaij2 *= 2;
+ xi0 = (incx > 0) ? 0 : ((-n + 1) * incx);
+ yi0 = (incy > 0) ? 0 : ((-n + 1) * incy);
+
+ FPU_FIX_START;
+
+ /* The most general form, y <--- alpha * A * (x_head + x_tail) + beta * y */
+ if (uplo == blas_lower) {
+ for (i = 0, yi = yi0, ai = 0; i < n; i++, yi += incy, ai += incai) {
+ head_sum1[0] = head_sum1[1] = tail_sum1[0] = tail_sum1[1] = 0.0;
+ head_sum2[0] = head_sum2[1] = tail_sum2[0] = tail_sum2[1] = 0.0;
+ for (j = 0, aij = ai, xi = xi0; j < i;
+ j++, aij += incaij, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ x_elem = x_head_i[xi];
+ {
+ /* Compute complex-extra = complex-double * real. */
+ double head_t, tail_t;
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = x_elem * split;
+ a1 = con - x_elem;
+ a1 = con - a1;
+ a2 = x_elem - a1;
+ con = a_elem[0] * split;
+ b1 = con - a_elem[0];
+ b1 = con - b1;
+ b2 = a_elem[0] - b1;
+
+ head_t = x_elem * a_elem[0];
+ tail_t = (((a1 * b1 - head_t) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_prod1[0] = head_t;
+ tail_prod1[0] = tail_t;
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = x_elem * split;
+ a1 = con - x_elem;
+ a1 = con - a1;
+ a2 = x_elem - a1;
+ con = a_elem[1] * split;
+ b1 = con - a_elem[1];
+ b1 = con - b1;
+ b2 = a_elem[1] - b1;
+
+ head_t = x_elem * a_elem[1];
+ tail_t = (((a1 * b1 - head_t) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_prod1[1] = head_t;
+ tail_prod1[1] = tail_t;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum1[0];
+ tail_a = tail_sum1[0];
+ head_b = head_prod1[0];
+ tail_b = tail_prod1[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[0] = head_t;
+ tail_sum1[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum1[1];
+ tail_a = tail_sum1[1];
+ head_b = head_prod1[1];
+ tail_b = tail_prod1[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[1] = head_t;
+ tail_sum1[1] = tail_t;
+ }
+ x_elem = x_tail_i[xi];
+ {
+ /* Compute complex-extra = complex-double * real. */
+ double head_t, tail_t;
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = x_elem * split;
+ a1 = con - x_elem;
+ a1 = con - a1;
+ a2 = x_elem - a1;
+ con = a_elem[0] * split;
+ b1 = con - a_elem[0];
+ b1 = con - b1;
+ b2 = a_elem[0] - b1;
+
+ head_t = x_elem * a_elem[0];
+ tail_t = (((a1 * b1 - head_t) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_prod2[0] = head_t;
+ tail_prod2[0] = tail_t;
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = x_elem * split;
+ a1 = con - x_elem;
+ a1 = con - a1;
+ a2 = x_elem - a1;
+ con = a_elem[1] * split;
+ b1 = con - a_elem[1];
+ b1 = con - b1;
+ b2 = a_elem[1] - b1;
+
+ head_t = x_elem * a_elem[1];
+ tail_t = (((a1 * b1 - head_t) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_prod2[1] = head_t;
+ tail_prod2[1] = tail_t;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum2[0];
+ tail_a = tail_sum2[0];
+ head_b = head_prod2[0];
+ tail_b = tail_prod2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[0] = head_t;
+ tail_sum2[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum2[1];
+ tail_a = tail_sum2[1];
+ head_b = head_prod2[1];
+ tail_b = tail_prod2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[1] = head_t;
+ tail_sum2[1] = tail_t;
+ }
+ }
+
+ diag_elem = a_i[aij];
+ x_elem = x_head_i[xi];
+ {
+ /* Compute complex double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = x_elem * split;
+ a1 = con - x_elem;
+ a1 = con - a1;
+ a2 = x_elem - a1;
+ con = diag_elem * split;
+ b1 = con - diag_elem;
+ b1 = con - b1;
+ b2 = diag_elem - b1;
+
+ head_prod1[0] = x_elem * diag_elem;
+ tail_prod1[0] =
+ (((a1 * b1 - head_prod1[0]) + a1 * b2) + a2 * b1) + a2 * b2;
+ head_prod1[1] = tail_prod1[1] = 0.0;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum1[0];
+ tail_a = tail_sum1[0];
+ head_b = head_prod1[0];
+ tail_b = tail_prod1[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[0] = head_t;
+ tail_sum1[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum1[1];
+ tail_a = tail_sum1[1];
+ head_b = head_prod1[1];
+ tail_b = tail_prod1[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[1] = head_t;
+ tail_sum1[1] = tail_t;
+ }
+ x_elem = x_tail_i[xi];
+ {
+ /* Compute complex double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = x_elem * split;
+ a1 = con - x_elem;
+ a1 = con - a1;
+ a2 = x_elem - a1;
+ con = diag_elem * split;
+ b1 = con - diag_elem;
+ b1 = con - b1;
+ b2 = diag_elem - b1;
+
+ head_prod2[0] = x_elem * diag_elem;
+ tail_prod2[0] =
+ (((a1 * b1 - head_prod2[0]) + a1 * b2) + a2 * b1) + a2 * b2;
+ head_prod2[1] = tail_prod2[1] = 0.0;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum2[0];
+ tail_a = tail_sum2[0];
+ head_b = head_prod2[0];
+ tail_b = tail_prod2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[0] = head_t;
+ tail_sum2[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum2[1];
+ tail_a = tail_sum2[1];
+ head_b = head_prod2[1];
+ tail_b = tail_prod2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[1] = head_t;
+ tail_sum2[1] = tail_t;
+ }
+ j++;
+ aij += incaij2;
+ xi += incx;
+
+ for (; j < n; j++, aij += incaij2, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ a_elem[1] = -a_elem[1];
+ x_elem = x_head_i[xi];
+ {
+ /* Compute complex-extra = complex-double * real. */
+ double head_t, tail_t;
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = x_elem * split;
+ a1 = con - x_elem;
+ a1 = con - a1;
+ a2 = x_elem - a1;
+ con = a_elem[0] * split;
+ b1 = con - a_elem[0];
+ b1 = con - b1;
+ b2 = a_elem[0] - b1;
+
+ head_t = x_elem * a_elem[0];
+ tail_t = (((a1 * b1 - head_t) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_prod1[0] = head_t;
+ tail_prod1[0] = tail_t;
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = x_elem * split;
+ a1 = con - x_elem;
+ a1 = con - a1;
+ a2 = x_elem - a1;
+ con = a_elem[1] * split;
+ b1 = con - a_elem[1];
+ b1 = con - b1;
+ b2 = a_elem[1] - b1;
+
+ head_t = x_elem * a_elem[1];
+ tail_t = (((a1 * b1 - head_t) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_prod1[1] = head_t;
+ tail_prod1[1] = tail_t;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum1[0];
+ tail_a = tail_sum1[0];
+ head_b = head_prod1[0];
+ tail_b = tail_prod1[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[0] = head_t;
+ tail_sum1[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum1[1];
+ tail_a = tail_sum1[1];
+ head_b = head_prod1[1];
+ tail_b = tail_prod1[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[1] = head_t;
+ tail_sum1[1] = tail_t;
+ }
+ x_elem = x_tail_i[xi];
+ {
+ /* Compute complex-extra = complex-double * real. */
+ double head_t, tail_t;
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = x_elem * split;
+ a1 = con - x_elem;
+ a1 = con - a1;
+ a2 = x_elem - a1;
+ con = a_elem[0] * split;
+ b1 = con - a_elem[0];
+ b1 = con - b1;
+ b2 = a_elem[0] - b1;
+
+ head_t = x_elem * a_elem[0];
+ tail_t = (((a1 * b1 - head_t) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_prod2[0] = head_t;
+ tail_prod2[0] = tail_t;
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = x_elem * split;
+ a1 = con - x_elem;
+ a1 = con - a1;
+ a2 = x_elem - a1;
+ con = a_elem[1] * split;
+ b1 = con - a_elem[1];
+ b1 = con - b1;
+ b2 = a_elem[1] - b1;
+
+ head_t = x_elem * a_elem[1];
+ tail_t = (((a1 * b1 - head_t) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_prod2[1] = head_t;
+ tail_prod2[1] = tail_t;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum2[0];
+ tail_a = tail_sum2[0];
+ head_b = head_prod2[0];
+ tail_b = tail_prod2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[0] = head_t;
+ tail_sum2[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum2[1];
+ tail_a = tail_sum2[1];
+ head_b = head_prod2[1];
+ tail_b = tail_prod2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[1] = head_t;
+ tail_sum2[1] = tail_t;
+ }
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum1[0];
+ tail_a = tail_sum1[0];
+ head_b = head_sum2[0];
+ tail_b = tail_sum2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[0] = head_t;
+ tail_sum1[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum1[1];
+ tail_a = tail_sum1[1];
+ head_b = head_sum2[1];
+ tail_b = tail_sum2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[1] = head_t;
+ tail_sum1[1] = tail_t;
+ }
+ {
+ /* Compute complex-extra = complex-extra * complex-double. */
+ double head_a0, tail_a0;
+ double head_a1, tail_a1;
+ double head_t1, tail_t1;
+ double head_t2, tail_t2;
+ head_a0 = head_sum1[0];
+ tail_a0 = tail_sum1[0];
+ head_a1 = head_sum1[1];
+ tail_a1 = tail_sum1[1];
+ /* real part */
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_a0 * split;
+ a11 = con - head_a0;
+ a11 = con - a11;
+ a21 = head_a0 - a11;
+ con = alpha_i[0] * split;
+ b1 = con - alpha_i[0];
+ b1 = con - b1;
+ b2 = alpha_i[0] - b1;
+
+ c11 = head_a0 * alpha_i[0];
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_a0 * alpha_i[0];
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_a1 * split;
+ a11 = con - head_a1;
+ a11 = con - a11;
+ a21 = head_a1 - a11;
+ con = alpha_i[1] * split;
+ b1 = con - alpha_i[1];
+ b1 = con - b1;
+ b2 = alpha_i[1] - b1;
+
+ c11 = head_a1 * alpha_i[1];
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_a1 * alpha_i[1];
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_t2 = t1 + t2;
+ tail_t2 = t2 - (head_t2 - t1);
+ }
+ head_t2 = -head_t2;
+ tail_t2 = -tail_t2;
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_tmp1[0] = head_t1;
+ tail_tmp1[0] = tail_t1;
+ /* imaginary part */
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_a1 * split;
+ a11 = con - head_a1;
+ a11 = con - a11;
+ a21 = head_a1 - a11;
+ con = alpha_i[0] * split;
+ b1 = con - alpha_i[0];
+ b1 = con - b1;
+ b2 = alpha_i[0] - b1;
+
+ c11 = head_a1 * alpha_i[0];
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_a1 * alpha_i[0];
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_a0 * split;
+ a11 = con - head_a0;
+ a11 = con - a11;
+ a21 = head_a0 - a11;
+ con = alpha_i[1] * split;
+ b1 = con - alpha_i[1];
+ b1 = con - b1;
+ b2 = alpha_i[1] - b1;
+
+ c11 = head_a0 * alpha_i[1];
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_a0 * alpha_i[1];
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_t2 = t1 + t2;
+ tail_t2 = t2 - (head_t2 - t1);
+ }
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_tmp1[1] = head_t1;
+ tail_tmp1[1] = tail_t1;
+ }
+
+ y_elem[0] = y_i[yi];
+ y_elem[1] = y_i[yi + 1];
+ {
+ /* Compute complex-extra = complex-double * complex-double. */
+ double head_t1, tail_t1;
+ double head_t2, tail_t2;
+ /* Real part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = y_elem[0] * split;
+ a1 = con - y_elem[0];
+ a1 = con - a1;
+ a2 = y_elem[0] - a1;
+ con = beta_i[0] * split;
+ b1 = con - beta_i[0];
+ b1 = con - b1;
+ b2 = beta_i[0] - b1;
+
+ head_t1 = y_elem[0] * beta_i[0];
+ tail_t1 = (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = y_elem[1] * split;
+ a1 = con - y_elem[1];
+ a1 = con - a1;
+ a2 = y_elem[1] - a1;
+ con = beta_i[1] * split;
+ b1 = con - beta_i[1];
+ b1 = con - b1;
+ b2 = beta_i[1] - b1;
+
+ head_t2 = y_elem[1] * beta_i[1];
+ tail_t2 = (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_t2 = -head_t2;
+ tail_t2 = -tail_t2;
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_tmp2[0] = head_t1;
+ tail_tmp2[0] = tail_t1;
+ /* Imaginary part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = y_elem[1] * split;
+ a1 = con - y_elem[1];
+ a1 = con - a1;
+ a2 = y_elem[1] - a1;
+ con = beta_i[0] * split;
+ b1 = con - beta_i[0];
+ b1 = con - b1;
+ b2 = beta_i[0] - b1;
+
+ head_t1 = y_elem[1] * beta_i[0];
+ tail_t1 = (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = y_elem[0] * split;
+ a1 = con - y_elem[0];
+ a1 = con - a1;
+ a2 = y_elem[0] - a1;
+ con = beta_i[1] * split;
+ b1 = con - beta_i[1];
+ b1 = con - b1;
+ b2 = beta_i[1] - b1;
+
+ head_t2 = y_elem[0] * beta_i[1];
+ tail_t2 = (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_tmp2[1] = head_t1;
+ tail_tmp2[1] = tail_t1;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_tmp1[0];
+ tail_a = tail_tmp1[0];
+ head_b = head_tmp2[0];
+ tail_b = tail_tmp2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_tmp3[0] = head_t;
+ tail_tmp3[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_tmp1[1];
+ tail_a = tail_tmp1[1];
+ head_b = head_tmp2[1];
+ tail_b = tail_tmp2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_tmp3[1] = head_t;
+ tail_tmp3[1] = tail_t;
+ }
+ y_i[yi] = head_tmp3[0];
+ y_i[yi + 1] = head_tmp3[1];
+ }
+ } else {
+ /* uplo == blas_upper */
+ for (i = 0, yi = yi0, ai = 0; i < n; i++, yi += incy, ai += incai) {
+ head_sum1[0] = head_sum1[1] = tail_sum1[0] = tail_sum1[1] = 0.0;
+ head_sum2[0] = head_sum2[1] = tail_sum2[0] = tail_sum2[1] = 0.0;
+
+ for (j = 0, aij = ai, xi = xi0; j < i;
+ j++, aij += incaij, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ a_elem[1] = -a_elem[1];
+ x_elem = x_head_i[xi];
+ {
+ /* Compute complex-extra = complex-double * real. */
+ double head_t, tail_t;
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = x_elem * split;
+ a1 = con - x_elem;
+ a1 = con - a1;
+ a2 = x_elem - a1;
+ con = a_elem[0] * split;
+ b1 = con - a_elem[0];
+ b1 = con - b1;
+ b2 = a_elem[0] - b1;
+
+ head_t = x_elem * a_elem[0];
+ tail_t = (((a1 * b1 - head_t) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_prod1[0] = head_t;
+ tail_prod1[0] = tail_t;
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = x_elem * split;
+ a1 = con - x_elem;
+ a1 = con - a1;
+ a2 = x_elem - a1;
+ con = a_elem[1] * split;
+ b1 = con - a_elem[1];
+ b1 = con - b1;
+ b2 = a_elem[1] - b1;
+
+ head_t = x_elem * a_elem[1];
+ tail_t = (((a1 * b1 - head_t) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_prod1[1] = head_t;
+ tail_prod1[1] = tail_t;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum1[0];
+ tail_a = tail_sum1[0];
+ head_b = head_prod1[0];
+ tail_b = tail_prod1[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[0] = head_t;
+ tail_sum1[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum1[1];
+ tail_a = tail_sum1[1];
+ head_b = head_prod1[1];
+ tail_b = tail_prod1[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[1] = head_t;
+ tail_sum1[1] = tail_t;
+ }
+ x_elem = x_tail_i[xi];
+ {
+ /* Compute complex-extra = complex-double * real. */
+ double head_t, tail_t;
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = x_elem * split;
+ a1 = con - x_elem;
+ a1 = con - a1;
+ a2 = x_elem - a1;
+ con = a_elem[0] * split;
+ b1 = con - a_elem[0];
+ b1 = con - b1;
+ b2 = a_elem[0] - b1;
+
+ head_t = x_elem * a_elem[0];
+ tail_t = (((a1 * b1 - head_t) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_prod2[0] = head_t;
+ tail_prod2[0] = tail_t;
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = x_elem * split;
+ a1 = con - x_elem;
+ a1 = con - a1;
+ a2 = x_elem - a1;
+ con = a_elem[1] * split;
+ b1 = con - a_elem[1];
+ b1 = con - b1;
+ b2 = a_elem[1] - b1;
+
+ head_t = x_elem * a_elem[1];
+ tail_t = (((a1 * b1 - head_t) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_prod2[1] = head_t;
+ tail_prod2[1] = tail_t;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum2[0];
+ tail_a = tail_sum2[0];
+ head_b = head_prod2[0];
+ tail_b = tail_prod2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[0] = head_t;
+ tail_sum2[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum2[1];
+ tail_a = tail_sum2[1];
+ head_b = head_prod2[1];
+ tail_b = tail_prod2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[1] = head_t;
+ tail_sum2[1] = tail_t;
+ }
+ }
+
+ diag_elem = a_i[aij];
+ x_elem = x_head_i[xi];
+ {
+ /* Compute complex double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = x_elem * split;
+ a1 = con - x_elem;
+ a1 = con - a1;
+ a2 = x_elem - a1;
+ con = diag_elem * split;
+ b1 = con - diag_elem;
+ b1 = con - b1;
+ b2 = diag_elem - b1;
+
+ head_prod1[0] = x_elem * diag_elem;
+ tail_prod1[0] =
+ (((a1 * b1 - head_prod1[0]) + a1 * b2) + a2 * b1) + a2 * b2;
+ head_prod1[1] = tail_prod1[1] = 0.0;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum1[0];
+ tail_a = tail_sum1[0];
+ head_b = head_prod1[0];
+ tail_b = tail_prod1[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[0] = head_t;
+ tail_sum1[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum1[1];
+ tail_a = tail_sum1[1];
+ head_b = head_prod1[1];
+ tail_b = tail_prod1[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[1] = head_t;
+ tail_sum1[1] = tail_t;
+ }
+ x_elem = x_tail_i[xi];
+ {
+ /* Compute complex double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = x_elem * split;
+ a1 = con - x_elem;
+ a1 = con - a1;
+ a2 = x_elem - a1;
+ con = diag_elem * split;
+ b1 = con - diag_elem;
+ b1 = con - b1;
+ b2 = diag_elem - b1;
+
+ head_prod2[0] = x_elem * diag_elem;
+ tail_prod2[0] =
+ (((a1 * b1 - head_prod2[0]) + a1 * b2) + a2 * b1) + a2 * b2;
+ head_prod2[1] = tail_prod2[1] = 0.0;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum2[0];
+ tail_a = tail_sum2[0];
+ head_b = head_prod2[0];
+ tail_b = tail_prod2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[0] = head_t;
+ tail_sum2[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum2[1];
+ tail_a = tail_sum2[1];
+ head_b = head_prod2[1];
+ tail_b = tail_prod2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[1] = head_t;
+ tail_sum2[1] = tail_t;
+ }
+ j++;
+ aij += incaij2;
+ xi += incx;
+
+ for (; j < n; j++, aij += incaij2, xi += incx) {
+ a_elem[0] = a_i[aij];
+ a_elem[1] = a_i[aij + 1];
+ x_elem = x_head_i[xi];
+ {
+ /* Compute complex-extra = complex-double * real. */
+ double head_t, tail_t;
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = x_elem * split;
+ a1 = con - x_elem;
+ a1 = con - a1;
+ a2 = x_elem - a1;
+ con = a_elem[0] * split;
+ b1 = con - a_elem[0];
+ b1 = con - b1;
+ b2 = a_elem[0] - b1;
+
+ head_t = x_elem * a_elem[0];
+ tail_t = (((a1 * b1 - head_t) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_prod1[0] = head_t;
+ tail_prod1[0] = tail_t;
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = x_elem * split;
+ a1 = con - x_elem;
+ a1 = con - a1;
+ a2 = x_elem - a1;
+ con = a_elem[1] * split;
+ b1 = con - a_elem[1];
+ b1 = con - b1;
+ b2 = a_elem[1] - b1;
+
+ head_t = x_elem * a_elem[1];
+ tail_t = (((a1 * b1 - head_t) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_prod1[1] = head_t;
+ tail_prod1[1] = tail_t;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum1[0];
+ tail_a = tail_sum1[0];
+ head_b = head_prod1[0];
+ tail_b = tail_prod1[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[0] = head_t;
+ tail_sum1[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum1[1];
+ tail_a = tail_sum1[1];
+ head_b = head_prod1[1];
+ tail_b = tail_prod1[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[1] = head_t;
+ tail_sum1[1] = tail_t;
+ }
+ x_elem = x_tail_i[xi];
+ {
+ /* Compute complex-extra = complex-double * real. */
+ double head_t, tail_t;
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = x_elem * split;
+ a1 = con - x_elem;
+ a1 = con - a1;
+ a2 = x_elem - a1;
+ con = a_elem[0] * split;
+ b1 = con - a_elem[0];
+ b1 = con - b1;
+ b2 = a_elem[0] - b1;
+
+ head_t = x_elem * a_elem[0];
+ tail_t = (((a1 * b1 - head_t) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_prod2[0] = head_t;
+ tail_prod2[0] = tail_t;
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = x_elem * split;
+ a1 = con - x_elem;
+ a1 = con - a1;
+ a2 = x_elem - a1;
+ con = a_elem[1] * split;
+ b1 = con - a_elem[1];
+ b1 = con - b1;
+ b2 = a_elem[1] - b1;
+
+ head_t = x_elem * a_elem[1];
+ tail_t = (((a1 * b1 - head_t) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_prod2[1] = head_t;
+ tail_prod2[1] = tail_t;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum2[0];
+ tail_a = tail_sum2[0];
+ head_b = head_prod2[0];
+ tail_b = tail_prod2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[0] = head_t;
+ tail_sum2[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum2[1];
+ tail_a = tail_sum2[1];
+ head_b = head_prod2[1];
+ tail_b = tail_prod2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum2[1] = head_t;
+ tail_sum2[1] = tail_t;
+ }
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_sum1[0];
+ tail_a = tail_sum1[0];
+ head_b = head_sum2[0];
+ tail_b = tail_sum2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[0] = head_t;
+ tail_sum1[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_sum1[1];
+ tail_a = tail_sum1[1];
+ head_b = head_sum2[1];
+ tail_b = tail_sum2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_sum1[1] = head_t;
+ tail_sum1[1] = tail_t;
+ }
+ {
+ /* Compute complex-extra = complex-extra * complex-double. */
+ double head_a0, tail_a0;
+ double head_a1, tail_a1;
+ double head_t1, tail_t1;
+ double head_t2, tail_t2;
+ head_a0 = head_sum1[0];
+ tail_a0 = tail_sum1[0];
+ head_a1 = head_sum1[1];
+ tail_a1 = tail_sum1[1];
+ /* real part */
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_a0 * split;
+ a11 = con - head_a0;
+ a11 = con - a11;
+ a21 = head_a0 - a11;
+ con = alpha_i[0] * split;
+ b1 = con - alpha_i[0];
+ b1 = con - b1;
+ b2 = alpha_i[0] - b1;
+
+ c11 = head_a0 * alpha_i[0];
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_a0 * alpha_i[0];
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_a1 * split;
+ a11 = con - head_a1;
+ a11 = con - a11;
+ a21 = head_a1 - a11;
+ con = alpha_i[1] * split;
+ b1 = con - alpha_i[1];
+ b1 = con - b1;
+ b2 = alpha_i[1] - b1;
+
+ c11 = head_a1 * alpha_i[1];
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_a1 * alpha_i[1];
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_t2 = t1 + t2;
+ tail_t2 = t2 - (head_t2 - t1);
+ }
+ head_t2 = -head_t2;
+ tail_t2 = -tail_t2;
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_tmp1[0] = head_t1;
+ tail_tmp1[0] = tail_t1;
+ /* imaginary part */
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_a1 * split;
+ a11 = con - head_a1;
+ a11 = con - a11;
+ a21 = head_a1 - a11;
+ con = alpha_i[0] * split;
+ b1 = con - alpha_i[0];
+ b1 = con - b1;
+ b2 = alpha_i[0] - b1;
+
+ c11 = head_a1 * alpha_i[0];
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_a1 * alpha_i[0];
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_a0 * split;
+ a11 = con - head_a0;
+ a11 = con - a11;
+ a21 = head_a0 - a11;
+ con = alpha_i[1] * split;
+ b1 = con - alpha_i[1];
+ b1 = con - b1;
+ b2 = alpha_i[1] - b1;
+
+ c11 = head_a0 * alpha_i[1];
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_a0 * alpha_i[1];
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_t2 = t1 + t2;
+ tail_t2 = t2 - (head_t2 - t1);
+ }
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_tmp1[1] = head_t1;
+ tail_tmp1[1] = tail_t1;
+ }
+
+ y_elem[0] = y_i[yi];
+ y_elem[1] = y_i[yi + 1];
+ {
+ /* Compute complex-extra = complex-double * complex-double. */
+ double head_t1, tail_t1;
+ double head_t2, tail_t2;
+ /* Real part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = y_elem[0] * split;
+ a1 = con - y_elem[0];
+ a1 = con - a1;
+ a2 = y_elem[0] - a1;
+ con = beta_i[0] * split;
+ b1 = con - beta_i[0];
+ b1 = con - b1;
+ b2 = beta_i[0] - b1;
+
+ head_t1 = y_elem[0] * beta_i[0];
+ tail_t1 = (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = y_elem[1] * split;
+ a1 = con - y_elem[1];
+ a1 = con - a1;
+ a2 = y_elem[1] - a1;
+ con = beta_i[1] * split;
+ b1 = con - beta_i[1];
+ b1 = con - b1;
+ b2 = beta_i[1] - b1;
+
+ head_t2 = y_elem[1] * beta_i[1];
+ tail_t2 = (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ head_t2 = -head_t2;
+ tail_t2 = -tail_t2;
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_tmp2[0] = head_t1;
+ tail_tmp2[0] = tail_t1;
+ /* Imaginary part */
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = y_elem[1] * split;
+ a1 = con - y_elem[1];
+ a1 = con - a1;
+ a2 = y_elem[1] - a1;
+ con = beta_i[0] * split;
+ b1 = con - beta_i[0];
+ b1 = con - b1;
+ b2 = beta_i[0] - b1;
+
+ head_t1 = y_elem[1] * beta_i[0];
+ tail_t1 = (((a1 * b1 - head_t1) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double_double = double * double. */
+ double a1, a2, b1, b2, con;
+
+ con = y_elem[0] * split;
+ a1 = con - y_elem[0];
+ a1 = con - a1;
+ a2 = y_elem[0] - a1;
+ con = beta_i[1] * split;
+ b1 = con - beta_i[1];
+ b1 = con - b1;
+ b2 = beta_i[1] - b1;
+
+ head_t2 = y_elem[0] * beta_i[1];
+ tail_t2 = (((a1 * b1 - head_t2) + a1 * b2) + a2 * b1) + a2 * b2;
+ }
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_t1 + head_t2;
+ bv = s1 - head_t1;
+ s2 = ((head_t2 - bv) + (head_t1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_t1 + tail_t2;
+ bv = t1 - tail_t1;
+ t2 = ((tail_t2 - bv) + (tail_t1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t1 = t1 + t2;
+ tail_t1 = t2 - (head_t1 - t1);
+ }
+ head_tmp2[1] = head_t1;
+ tail_tmp2[1] = tail_t1;
+ }
+ {
+ double head_t, tail_t;
+ double head_a, tail_a;
+ double head_b, tail_b;
+ /* Real part */
+ head_a = head_tmp1[0];
+ tail_a = tail_tmp1[0];
+ head_b = head_tmp2[0];
+ tail_b = tail_tmp2[0];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_tmp3[0] = head_t;
+ tail_tmp3[0] = tail_t;
+ /* Imaginary part */
+ head_a = head_tmp1[1];
+ tail_a = tail_tmp1[1];
+ head_b = head_tmp2[1];
+ tail_b = tail_tmp2[1];
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_a + head_b;
+ bv = s1 - head_a;
+ s2 = ((head_b - bv) + (head_a - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_a + tail_b;
+ bv = t1 - tail_a;
+ t2 = ((tail_b - bv) + (tail_a - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_t = t1 + t2;
+ tail_t = t2 - (head_t - t1);
+ }
+ head_tmp3[1] = head_t;
+ tail_tmp3[1] = tail_t;
+ }
+ y_i[yi] = head_tmp3[0];
+ y_i[yi + 1] = head_tmp3[1];
+ }
+ }
+
+ FPU_FIX_STOP;
+
+ break;
+ }
+ }
+} /* end BLAS_zhemv2_z_d_x */
--- /dev/null
+include ../../make.conf
+include ../../$(MAKEINC)
+
+LIB_PATH = ../../$(OUTPUT_DIR)
+SRC_PATH = .
+HEADER_PATH = ..
+
+HEMV2_SRCS =\
+ $(SRC_PATH)/BLAS_zhemv2_z_c.c\
+ $(SRC_PATH)/BLAS_zhemv2_c_z.c\
+ $(SRC_PATH)/BLAS_zhemv2_c_c.c\
+ $(SRC_PATH)/BLAS_chemv2_c_s.c\
+ $(SRC_PATH)/BLAS_zhemv2_z_d.c\
+ $(SRC_PATH)/BLAS_chemv2_x.c\
+ $(SRC_PATH)/BLAS_zhemv2_x.c\
+ $(SRC_PATH)/BLAS_zhemv2_z_c_x.c\
+ $(SRC_PATH)/BLAS_zhemv2_c_z_x.c\
+ $(SRC_PATH)/BLAS_zhemv2_c_c_x.c\
+ $(SRC_PATH)/BLAS_chemv2_c_s_x.c\
+ $(SRC_PATH)/BLAS_zhemv2_z_d_x.c \
+ \
+ $(SRC_PATH)/BLAS_zhemv2_z_c-f2c.c\
+ $(SRC_PATH)/BLAS_zhemv2_c_z-f2c.c\
+ $(SRC_PATH)/BLAS_zhemv2_c_c-f2c.c\
+ $(SRC_PATH)/BLAS_chemv2_c_s-f2c.c\
+ $(SRC_PATH)/BLAS_zhemv2_z_d-f2c.c\
+ $(SRC_PATH)/BLAS_chemv2_x-f2c.c\
+ $(SRC_PATH)/BLAS_zhemv2_x-f2c.c\
+ $(SRC_PATH)/BLAS_zhemv2_z_c_x-f2c.c\
+ $(SRC_PATH)/BLAS_zhemv2_c_z_x-f2c.c\
+ $(SRC_PATH)/BLAS_zhemv2_c_c_x-f2c.c\
+ $(SRC_PATH)/BLAS_chemv2_c_s_x-f2c.c\
+ $(SRC_PATH)/BLAS_zhemv2_z_d_x-f2c.c
+
+HEMV2_OBJS = $(HEMV2_SRCS:.c=.o)
+
+all: $(HEMV2_OBJS)
+
+lib: $(HEMV2_OBJS)
+ $(ARCH) $(ARCHFLAGS) $(LIB_PATH)/$(XBLASLIB) $(HEMV2_OBJS)
+ $(RANLIB) $(LIB_PATH)/$(XBLASLIB)
+
+.c.o:
+ $(CC) $(CFLAGS) -I$(HEADER_PATH) -c -o $@ $<
+
+clean:
+ rm -f *.o *~ *.BAK
+
void *tail_x, void *beta, int beta_flag, void *y,
int *seed, double *r_true_l, double *r_true_t);
+
+void BLAS_sskmv2_testgen(int norm, enum blas_order_type order,
+ enum blas_uplo_type uplo, int n, float *alpha,
+ float *beta, float *a, int lda, float *x_head,
+ float *x_tail, float *y, int *seed,
+ double *head_r_true, double *tail_r_true);
+void BLAS_dskmv2_testgen(int norm, enum blas_order_type order,
+ enum blas_uplo_type uplo, int n, double *alpha,
+ double *beta, double *a, int lda, double *x_head,
+ double *x_tail, double *y, int *seed,
+ double *head_r_true, double *tail_r_true);
+void BLAS_dskmv2_testgen_d_s(int norm, enum blas_order_type order,
+ enum blas_uplo_type uplo, int n, double *alpha,
+ double *beta, double *a, int lda, float *x_head,
+ float *x_tail, double *y, int *seed,
+ double *head_r_true, double *tail_r_true);
+void BLAS_dskmv2_testgen_s_d(int norm, enum blas_order_type order,
+ enum blas_uplo_type uplo, int n, double *alpha,
+ double *beta, float *a, int lda, double *x_head,
+ double *x_tail, double *y, int *seed,
+ double *head_r_true, double *tail_r_true);
+void BLAS_dskmv2_testgen_s_s(int norm, enum blas_order_type order,
+ enum blas_uplo_type uplo, int n, double *alpha,
+ double *beta, float *a, int lda, float *x_head,
+ float *x_tail, double *y, int *seed,
+ double *head_r_true, double *tail_r_true);
+
+void BLAS_chemv2_testgen(int norm, enum blas_order_type order,
+ enum blas_uplo_type uplo, int n, void *alpha,
+ int alpha_flag, void *beta, int beta_flag, void *a,
+ int lda, void *x_head, void *x_tail, void *y,
+ int *seed, double *head_r_true, double *tail_r_true);
+void BLAS_zhemv2_testgen(int norm, enum blas_order_type order,
+ enum blas_uplo_type uplo, int n, void *alpha,
+ int alpha_flag, void *beta, int beta_flag, void *a,
+ int lda, void *x_head, void *x_tail, void *y,
+ int *seed, double *head_r_true, double *tail_r_true);
+void BLAS_zhemv2_c_z_testgen(int norm, enum blas_order_type order,
+ enum blas_uplo_type uplo, int n, void *alpha,
+ int alpha_flag, void *beta, int beta_flag,
+ void *a, int lda, void *x_head, void *x_tail,
+ void *y, int *seed, double *head_r_true,
+ double *tail_r_true);
+void BLAS_zhemv2_z_c_testgen(int norm, enum blas_order_type order,
+ enum blas_uplo_type uplo, int n, void *alpha,
+ int alpha_flag, void *beta, int beta_flag,
+ void *a, int lda, void *x_head, void *x_tail,
+ void *y, int *seed, double *head_r_true,
+ double *tail_r_true);
+void BLAS_zhemv2_c_c_testgen(int norm, enum blas_order_type order,
+ enum blas_uplo_type uplo, int n, void *alpha,
+ int alpha_flag, void *beta, int beta_flag,
+ void *a, int lda, void *x_head, void *x_tail,
+ void *y, int *seed, double *head_r_true,
+ double *tail_r_true);
+void BLAS_zhemv2_z_d_testgen(int norm, enum blas_order_type order,
+ enum blas_uplo_type uplo, int n, void *alpha,
+ int alpha_flag, void *beta, int beta_flag,
+ void *a, int lda, double *x_head, double *x_tail,
+ void *y, int *seed, double *head_r_true,
+ double *tail_r_true);
+void BLAS_chemv2_c_s_testgen(int norm, enum blas_order_type order,
+ enum blas_uplo_type uplo, int n, void *alpha,
+ int alpha_flag, void *beta, int beta_flag,
+ void *a, int lda, float *x_head, float *x_tail,
+ void *y, int *seed, double *head_r_true,
+ double *tail_r_true);
+
void BLAS_sge_sum_mv_testgen(int norm, enum blas_order_type order,
int m, int n, int randomize,
float *alpha, int alpha_flag, float *beta,
--- /dev/null
+
+#include <stdio.h>
+#include <stdlib.h>
+#include "blas_extended.h"
+#include "blas_extended_private.h"
+#include "blas_extended_test.h"
+
+void BLAS_sskmv2_testgen(int norm, enum blas_order_type order,
+ enum blas_uplo_type uplo, int n, float *alpha,
+ float *beta, float *a, int lda, float *x_head,
+ float *x_tail, float *y, int *seed,
+ double *head_r_true, double *tail_r_true)
+
+/*
+ * Purpose
+ * =======
+ *
+ * Generates a skew Matrix for use with hemv2 testing
+ *
+ * Arguments
+ * =========
+ *
+ * norm (input) int
+ * = -1: the vectors are scaled with norms near underflow.
+ * = 0: the vectors have norms of order 1.
+ * = 1: the vectors are scaled with norms near overflow.
+ *
+ * order (input) enum blas_order_type
+ * storage format of the matrices
+ *
+ * uplo (input) enum blas_uplo_type
+ * which half of the skew symmetric matrix a is to be stored.
+ *
+ * n (input) int
+ * sizes of symmetrical matrix a, size of vectors x, y:
+ * matrix a is n-by-n.
+ *
+ * alpha (input/output) float*
+ *
+ * beta (input) float*
+ *
+ * a (input/output) float*
+ *
+ * lda (input) lda
+ * leading dimension of matrix A.
+ *
+ * x_head (input) float*
+ * x_tail (input) float*
+ * note : x is input only. x should be determined before calling
+ * this function.
+ *
+ * y (input/output) float*
+ * generated vector y.
+ *
+ * seed (input/output) int *
+ * seed for the random number generator.
+ *
+ * head_r_true (output) double *
+ * the leading part of the truth in double-double.
+ *
+ * tail_r_true (output) double *
+ * the trailing part of the truth in double-double
+ *
+ */
+{
+
+ int i, yi, ri;
+ int incx = 1, incy = 1;
+ int incyi, incri;
+ int incx_veci, yi0;
+ int inca_vec;
+
+ float y_elem;
+ double head_r_true_elem, tail_r_true_elem;
+
+ float *a_vec;
+ float *x_head_vec;
+ float *x_tail_vec;
+
+ float *y_i = y;
+ float *alpha_i = alpha;
+ float *beta_i = beta;
+ float *x_head_i = x_head;
+ float *x_tail_i = x_tail;
+
+ /*a_vec must have stride of 1 */
+ inca_vec = 1;
+
+
+ a_vec = (float *) blas_malloc(n * sizeof(float));
+ if (n > 0 && a_vec == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ for (i = 0; i < n; i += inca_vec) {
+ a_vec[i] = 0.0;
+ }
+ x_head_vec = (float *) blas_malloc(n * sizeof(float));
+ if (n > 0 && x_head_vec == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ x_tail_vec = (float *) blas_malloc(n * sizeof(float));
+ if (n > 0 && x_tail_vec == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ scopy_vector(x_head_i, n, incx, x_head_vec, 1);
+ scopy_vector(x_tail_i, n, incx, x_tail_vec, 1);
+
+ incyi = incy;
+
+ yi0 = (incy > 0) ? 0 : -(n - 1) * incyi;
+
+ incri = 1;
+
+
+ incx_veci = 1;
+
+
+ /* Fill in skew matrix A */
+ for (i = 0, yi = yi0, ri = 0; i < n; i++, ri += incri, yi += incyi) {
+ /* x_i has already been copied to x_vec */
+ sskew_copy_row(order, uplo, blas_left_side, n, a, lda, a_vec, i);
+
+ /* skew matricies have zeroed diagonals */
+ a_vec[i] = 0.0;
+ BLAS_sdot2_testgen(n, i + 1, n - i - 1, norm, blas_no_conj, alpha_i, 1,
+ beta_i, 1, x_head_vec, x_tail_vec, a_vec, seed,
+ &y_elem, &head_r_true_elem, &tail_r_true_elem);
+
+ sskew_commit_row(order, uplo, blas_left_side, n, a, lda, a_vec, i);
+
+ /*commits an element to the generated y */
+ y_i[yi] = y_elem;
+ head_r_true[ri] = head_r_true_elem;
+ tail_r_true[ri] = tail_r_true_elem;
+ }
+
+ blas_free(a_vec);
+ blas_free(x_head_vec);
+ blas_free(x_tail_vec);
+}
+void BLAS_dskmv2_testgen(int norm, enum blas_order_type order,
+ enum blas_uplo_type uplo, int n, double *alpha,
+ double *beta, double *a, int lda, double *x_head,
+ double *x_tail, double *y, int *seed,
+ double *head_r_true, double *tail_r_true)
+
+/*
+ * Purpose
+ * =======
+ *
+ * Generates a skew Matrix for use with hemv2 testing
+ *
+ * Arguments
+ * =========
+ *
+ * norm (input) int
+ * = -1: the vectors are scaled with norms near underflow.
+ * = 0: the vectors have norms of order 1.
+ * = 1: the vectors are scaled with norms near overflow.
+ *
+ * order (input) enum blas_order_type
+ * storage format of the matrices
+ *
+ * uplo (input) enum blas_uplo_type
+ * which half of the skew symmetric matrix a is to be stored.
+ *
+ * n (input) int
+ * sizes of symmetrical matrix a, size of vectors x, y:
+ * matrix a is n-by-n.
+ *
+ * alpha (input/output) double*
+ *
+ * beta (input) double*
+ *
+ * a (input/output) double*
+ *
+ * lda (input) lda
+ * leading dimension of matrix A.
+ *
+ * x_head (input) double*
+ * x_tail (input) double*
+ * note : x is input only. x should be determined before calling
+ * this function.
+ *
+ * y (input/output) double*
+ * generated vector y.
+ *
+ * seed (input/output) int *
+ * seed for the random number generator.
+ *
+ * head_r_true (output) double *
+ * the leading part of the truth in double-double.
+ *
+ * tail_r_true (output) double *
+ * the trailing part of the truth in double-double
+ *
+ */
+{
+
+ int i, yi, ri;
+ int incx = 1, incy = 1;
+ int incyi, incri;
+ int incx_veci, yi0;
+ int inca_vec;
+
+ double y_elem;
+ double head_r_true_elem, tail_r_true_elem;
+
+ double *a_vec;
+ double *x_head_vec;
+ double *x_tail_vec;
+
+ double *y_i = y;
+ double *alpha_i = alpha;
+ double *beta_i = beta;
+ double *x_head_i = x_head;
+ double *x_tail_i = x_tail;
+
+ /*a_vec must have stride of 1 */
+ inca_vec = 1;
+
+
+ a_vec = (double *) blas_malloc(n * sizeof(double));
+ if (n > 0 && a_vec == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ for (i = 0; i < n; i += inca_vec) {
+ a_vec[i] = 0.0;
+ }
+ x_head_vec = (double *) blas_malloc(n * sizeof(double));
+ if (n > 0 && x_head_vec == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ x_tail_vec = (double *) blas_malloc(n * sizeof(double));
+ if (n > 0 && x_tail_vec == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ dcopy_vector(x_head_i, n, incx, x_head_vec, 1);
+ dcopy_vector(x_tail_i, n, incx, x_tail_vec, 1);
+
+ incyi = incy;
+
+ yi0 = (incy > 0) ? 0 : -(n - 1) * incyi;
+
+ incri = 1;
+
+
+ incx_veci = 1;
+
+
+ /* Fill in skew matrix A */
+ for (i = 0, yi = yi0, ri = 0; i < n; i++, ri += incri, yi += incyi) {
+ /* x_i has already been copied to x_vec */
+ dskew_copy_row(order, uplo, blas_left_side, n, a, lda, a_vec, i);
+
+ /* skew matricies have zeroed diagonals */
+ a_vec[i] = 0.0;
+ BLAS_ddot2_testgen(n, i + 1, n - i - 1, norm, blas_no_conj, alpha_i, 1,
+ beta_i, 1, x_head_vec, x_tail_vec, a_vec, seed,
+ &y_elem, &head_r_true_elem, &tail_r_true_elem);
+
+ dskew_commit_row(order, uplo, blas_left_side, n, a, lda, a_vec, i);
+
+ /*commits an element to the generated y */
+ y_i[yi] = y_elem;
+ head_r_true[ri] = head_r_true_elem;
+ tail_r_true[ri] = tail_r_true_elem;
+ }
+
+ blas_free(a_vec);
+ blas_free(x_head_vec);
+ blas_free(x_tail_vec);
+}
+void BLAS_dskmv2_testgen_d_s(int norm, enum blas_order_type order,
+ enum blas_uplo_type uplo, int n, double *alpha,
+ double *beta, double *a, int lda, float *x_head,
+ float *x_tail, double *y, int *seed,
+ double *head_r_true, double *tail_r_true)
+
+/*
+ * Purpose
+ * =======
+ *
+ * Generates a skew Matrix for use with hemv2 testing
+ *
+ * Arguments
+ * =========
+ *
+ * norm (input) int
+ * = -1: the vectors are scaled with norms near underflow.
+ * = 0: the vectors have norms of order 1.
+ * = 1: the vectors are scaled with norms near overflow.
+ *
+ * order (input) enum blas_order_type
+ * storage format of the matrices
+ *
+ * uplo (input) enum blas_uplo_type
+ * which half of the skew symmetric matrix a is to be stored.
+ *
+ * n (input) int
+ * sizes of symmetrical matrix a, size of vectors x, y:
+ * matrix a is n-by-n.
+ *
+ * alpha (input/output) double*
+ *
+ * beta (input) double*
+ *
+ * a (input/output) double*
+ *
+ * lda (input) lda
+ * leading dimension of matrix A.
+ *
+ * x_head (input) float*
+ * x_tail (input) float*
+ * note : x is input only. x should be determined before calling
+ * this function.
+ *
+ * y (input/output) double*
+ * generated vector y.
+ *
+ * seed (input/output) int *
+ * seed for the random number generator.
+ *
+ * head_r_true (output) double *
+ * the leading part of the truth in double-double.
+ *
+ * tail_r_true (output) double *
+ * the trailing part of the truth in double-double
+ *
+ */
+{
+
+ int i, yi, ri;
+ int incx = 1, incy = 1;
+ int incyi, incri;
+ int incx_veci, yi0;
+ int inca_vec;
+
+ double y_elem;
+ double head_r_true_elem, tail_r_true_elem;
+
+ double *a_vec;
+ float *x_head_vec;
+ float *x_tail_vec;
+
+ double *y_i = y;
+ double *alpha_i = alpha;
+ double *beta_i = beta;
+ float *x_head_i = x_head;
+ float *x_tail_i = x_tail;
+
+ /*a_vec must have stride of 1 */
+ inca_vec = 1;
+
+
+ a_vec = (double *) blas_malloc(n * sizeof(double));
+ if (n > 0 && a_vec == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ for (i = 0; i < n; i += inca_vec) {
+ a_vec[i] = 0.0;
+ }
+ x_head_vec = (float *) blas_malloc(n * sizeof(float));
+ if (n > 0 && x_head_vec == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ x_tail_vec = (float *) blas_malloc(n * sizeof(float));
+ if (n > 0 && x_tail_vec == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ scopy_vector(x_head_i, n, incx, x_head_vec, 1);
+ scopy_vector(x_tail_i, n, incx, x_tail_vec, 1);
+
+ incyi = incy;
+
+ yi0 = (incy > 0) ? 0 : -(n - 1) * incyi;
+
+ incri = 1;
+
+
+ incx_veci = 1;
+
+
+ /* Fill in skew matrix A */
+ for (i = 0, yi = yi0, ri = 0; i < n; i++, ri += incri, yi += incyi) {
+ /* x_i has already been copied to x_vec */
+ dskew_copy_row(order, uplo, blas_left_side, n, a, lda, a_vec, i);
+
+ /* skew matricies have zeroed diagonals */
+ a_vec[i] = 0.0;
+ BLAS_ddot2_s_d_testgen(n, i + 1, n - i - 1, norm, blas_no_conj, alpha_i,
+ 1, beta_i, 1, x_head_vec, x_tail_vec, a_vec, seed,
+ &y_elem, &head_r_true_elem, &tail_r_true_elem);
+
+ dskew_commit_row(order, uplo, blas_left_side, n, a, lda, a_vec, i);
+
+ /*commits an element to the generated y */
+ y_i[yi] = y_elem;
+ head_r_true[ri] = head_r_true_elem;
+ tail_r_true[ri] = tail_r_true_elem;
+ }
+
+ blas_free(a_vec);
+ blas_free(x_head_vec);
+ blas_free(x_tail_vec);
+}
+void BLAS_dskmv2_testgen_s_d(int norm, enum blas_order_type order,
+ enum blas_uplo_type uplo, int n, double *alpha,
+ double *beta, float *a, int lda, double *x_head,
+ double *x_tail, double *y, int *seed,
+ double *head_r_true, double *tail_r_true)
+
+/*
+ * Purpose
+ * =======
+ *
+ * Generates a skew Matrix for use with hemv2 testing
+ *
+ * Arguments
+ * =========
+ *
+ * norm (input) int
+ * = -1: the vectors are scaled with norms near underflow.
+ * = 0: the vectors have norms of order 1.
+ * = 1: the vectors are scaled with norms near overflow.
+ *
+ * order (input) enum blas_order_type
+ * storage format of the matrices
+ *
+ * uplo (input) enum blas_uplo_type
+ * which half of the skew symmetric matrix a is to be stored.
+ *
+ * n (input) int
+ * sizes of symmetrical matrix a, size of vectors x, y:
+ * matrix a is n-by-n.
+ *
+ * alpha (input/output) double*
+ *
+ * beta (input) double*
+ *
+ * a (input/output) float*
+ *
+ * lda (input) lda
+ * leading dimension of matrix A.
+ *
+ * x_head (input) double*
+ * x_tail (input) double*
+ * note : x is input only. x should be determined before calling
+ * this function.
+ *
+ * y (input/output) double*
+ * generated vector y.
+ *
+ * seed (input/output) int *
+ * seed for the random number generator.
+ *
+ * head_r_true (output) double *
+ * the leading part of the truth in double-double.
+ *
+ * tail_r_true (output) double *
+ * the trailing part of the truth in double-double
+ *
+ */
+{
+
+ int i, yi, ri;
+ int incx = 1, incy = 1;
+ int incyi, incri;
+ int incx_veci, yi0;
+ int inca_vec;
+
+ double y_elem;
+ double head_r_true_elem, tail_r_true_elem;
+
+ float *a_vec;
+ double *x_head_vec;
+ double *x_tail_vec;
+
+ double *y_i = y;
+ double *alpha_i = alpha;
+ double *beta_i = beta;
+ double *x_head_i = x_head;
+ double *x_tail_i = x_tail;
+
+ /*a_vec must have stride of 1 */
+ inca_vec = 1;
+
+
+ a_vec = (float *) blas_malloc(n * sizeof(float));
+ if (n > 0 && a_vec == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ for (i = 0; i < n; i += inca_vec) {
+ a_vec[i] = 0.0;
+ }
+ x_head_vec = (double *) blas_malloc(n * sizeof(double));
+ if (n > 0 && x_head_vec == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ x_tail_vec = (double *) blas_malloc(n * sizeof(double));
+ if (n > 0 && x_tail_vec == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ dcopy_vector(x_head_i, n, incx, x_head_vec, 1);
+ dcopy_vector(x_tail_i, n, incx, x_tail_vec, 1);
+
+ incyi = incy;
+
+ yi0 = (incy > 0) ? 0 : -(n - 1) * incyi;
+
+ incri = 1;
+
+
+ incx_veci = 1;
+
+
+ /* Fill in skew matrix A */
+ for (i = 0, yi = yi0, ri = 0; i < n; i++, ri += incri, yi += incyi) {
+ /* x_i has already been copied to x_vec */
+ sskew_copy_row(order, uplo, blas_left_side, n, a, lda, a_vec, i);
+
+ /* skew matricies have zeroed diagonals */
+ a_vec[i] = 0.0;
+ BLAS_ddot2_d_s_testgen(n, i + 1, n - i - 1, norm, blas_no_conj, alpha_i,
+ 1, beta_i, 1, x_head_vec, x_tail_vec, a_vec, seed,
+ &y_elem, &head_r_true_elem, &tail_r_true_elem);
+
+ sskew_commit_row(order, uplo, blas_left_side, n, a, lda, a_vec, i);
+
+ /*commits an element to the generated y */
+ y_i[yi] = y_elem;
+ head_r_true[ri] = head_r_true_elem;
+ tail_r_true[ri] = tail_r_true_elem;
+ }
+
+ blas_free(a_vec);
+ blas_free(x_head_vec);
+ blas_free(x_tail_vec);
+}
+void BLAS_dskmv2_testgen_s_s(int norm, enum blas_order_type order,
+ enum blas_uplo_type uplo, int n, double *alpha,
+ double *beta, float *a, int lda, float *x_head,
+ float *x_tail, double *y, int *seed,
+ double *head_r_true, double *tail_r_true)
+
+/*
+ * Purpose
+ * =======
+ *
+ * Generates a skew Matrix for use with hemv2 testing
+ *
+ * Arguments
+ * =========
+ *
+ * norm (input) int
+ * = -1: the vectors are scaled with norms near underflow.
+ * = 0: the vectors have norms of order 1.
+ * = 1: the vectors are scaled with norms near overflow.
+ *
+ * order (input) enum blas_order_type
+ * storage format of the matrices
+ *
+ * uplo (input) enum blas_uplo_type
+ * which half of the skew symmetric matrix a is to be stored.
+ *
+ * n (input) int
+ * sizes of symmetrical matrix a, size of vectors x, y:
+ * matrix a is n-by-n.
+ *
+ * alpha (input/output) double*
+ *
+ * beta (input) double*
+ *
+ * a (input/output) float*
+ *
+ * lda (input) lda
+ * leading dimension of matrix A.
+ *
+ * x_head (input) float*
+ * x_tail (input) float*
+ * note : x is input only. x should be determined before calling
+ * this function.
+ *
+ * y (input/output) double*
+ * generated vector y.
+ *
+ * seed (input/output) int *
+ * seed for the random number generator.
+ *
+ * head_r_true (output) double *
+ * the leading part of the truth in double-double.
+ *
+ * tail_r_true (output) double *
+ * the trailing part of the truth in double-double
+ *
+ */
+{
+
+ int i, yi, ri;
+ int incx = 1, incy = 1;
+ int incyi, incri;
+ int incx_veci, yi0;
+ int inca_vec;
+
+ double y_elem;
+ double head_r_true_elem, tail_r_true_elem;
+
+ float *a_vec;
+ float *x_head_vec;
+ float *x_tail_vec;
+
+ double *y_i = y;
+ double *alpha_i = alpha;
+ double *beta_i = beta;
+ float *x_head_i = x_head;
+ float *x_tail_i = x_tail;
+
+ /*a_vec must have stride of 1 */
+ inca_vec = 1;
+
+
+ a_vec = (float *) blas_malloc(n * sizeof(float));
+ if (n > 0 && a_vec == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ for (i = 0; i < n; i += inca_vec) {
+ a_vec[i] = 0.0;
+ }
+ x_head_vec = (float *) blas_malloc(n * sizeof(float));
+ if (n > 0 && x_head_vec == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ x_tail_vec = (float *) blas_malloc(n * sizeof(float));
+ if (n > 0 && x_tail_vec == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ scopy_vector(x_head_i, n, incx, x_head_vec, 1);
+ scopy_vector(x_tail_i, n, incx, x_tail_vec, 1);
+
+ incyi = incy;
+
+ yi0 = (incy > 0) ? 0 : -(n - 1) * incyi;
+
+ incri = 1;
+
+
+ incx_veci = 1;
+
+
+ /* Fill in skew matrix A */
+ for (i = 0, yi = yi0, ri = 0; i < n; i++, ri += incri, yi += incyi) {
+ /* x_i has already been copied to x_vec */
+ sskew_copy_row(order, uplo, blas_left_side, n, a, lda, a_vec, i);
+
+ /* skew matricies have zeroed diagonals */
+ a_vec[i] = 0.0;
+ BLAS_ddot2_s_s_testgen(n, i + 1, n - i - 1, norm, blas_no_conj, alpha_i,
+ 1, beta_i, 1, x_head_vec, x_tail_vec, a_vec, seed,
+ &y_elem, &head_r_true_elem, &tail_r_true_elem);
+
+ sskew_commit_row(order, uplo, blas_left_side, n, a, lda, a_vec, i);
+
+ /*commits an element to the generated y */
+ y_i[yi] = y_elem;
+ head_r_true[ri] = head_r_true_elem;
+ tail_r_true[ri] = tail_r_true_elem;
+ }
+
+ blas_free(a_vec);
+ blas_free(x_head_vec);
+ blas_free(x_tail_vec);
+}
+
+
+void BLAS_chemv2_testgen(int norm, enum blas_order_type order,
+ enum blas_uplo_type uplo, int n, void *alpha,
+ int alpha_flag, void *beta, int beta_flag, void *a,
+ int lda, void *x_head, void *x_tail, void *y,
+ int *seed, double *head_r_true, double *tail_r_true)
+
+/*
+ * Purpose
+ * =======
+ *
+ * Generates the test inputs to BLAS_chemv2{_x}
+ *
+ * Arguments
+ * =========
+ *
+ * norm (input) int
+ * = -1: the vectors are scaled with norms near underflow.
+ * = 0: the vectors have norms of order 1.
+ * = 1: the vectors are scaled with norms near overflow.
+ *
+ * order (input) enum blas_order_type
+ * storage format of the matrices
+ *
+ * uplo (input) enum blas_uplo_type
+ * which half of the hemv2etric matrix a is to be stored.
+ *
+ * n (input) int
+ * sizes of symmetrical matrix a, size of vectors x, y:
+ * matrix a is n-by-n.
+ *
+ * alpha (input/output) void*
+ * if alpha_flag = 1, alpha is input.
+ * if alpha_flag = 0, alpha is output.
+ *
+ * alpha_flag (input) int
+ * = 0: alpha is free, and is output.
+ * = 1: alpha is fixed on input.
+ *
+ * beta (input/output) void*
+ * if beta_flag = 1, beta is input.
+ * if beta_flag = 0, beta is output.
+ *
+ * beta_flag (input) int
+ * = 0: beta is free, and is output.
+ * = 1: beta is fixed on input.
+ *
+ * a (input/output) void*
+ *
+ * lda (input) lda
+ * leading dimension of matrix A.
+ *
+ * x_head (input/output) void*
+ * x_tail (input/output) void*
+ * vector x = (x_head + x_tail)
+ *
+ * y (input/output) void*
+ * generated vector y that will be used as an input to HEMV2.
+ *
+ * seed (input/output) int *
+ * seed for the random number generator.
+ *
+ * head_r_true (output) double *
+ * the leading part of the truth in double-double.
+ *
+ * tail_r_true (output) double *
+ * the trailing part of the truth in double-double
+ *
+ */
+{
+ {
+
+ /* Strategy:
+ r1 = alpha * A1 * x + beta * y1
+ r2 = alpha * A2 * x + beta * y2
+ where all the matrices and vectors are real. Then let R = R1 + i R2,
+ A = A1 + i A2, y = y1 + i y2. To make A Hermitian, A1 is symmetric,
+ and A2 is skew-symmetric.
+ */
+
+ int i, j;
+ int yi;
+ int aij, ai;
+ int a1ij, a1i;
+ int xi;
+ int mi;
+ int incx = 1, incy = 1;
+ int incyi, xi0, yi0;
+ int incaij, incai;
+ int inca1ij, inca1i;
+ int incxi;
+ int inca_vec, incx_vec;
+ int ld;
+ int ab;
+ int ri, incri;
+
+ float *a1;
+ float *a2;
+ float *y1;
+ float *y2;
+ float *x_head_0;
+ float *x_tail_0;
+
+ double *head_r1_true, *tail_r1_true;
+ double *head_r2_true, *tail_r2_true;
+
+ double head_r_elem1, tail_r_elem1;
+ double head_r_elem2, tail_r_elem2;
+ double head_r_elem, tail_r_elem;
+
+ float *a_vec;
+ float *x_head_vec;
+ float *x_tail_vec;
+
+ float *y_i = (float *) y;
+ float *alpha_i = (float *) alpha;
+ float *beta_i = (float *) beta;
+
+ float *a_i = (float *) a;
+ float *x_head_i = (float *) x_head;
+ float *x_tail_i = (float *) x_tail;
+
+ ld = n;
+ if (order == blas_colmajor) {
+ inca1i = incai = 1;
+ incyi = incy;
+ incaij = lda;
+ incxi = incx;
+ inca1ij = n;
+ } else {
+ incyi = incy;
+ incai = lda;
+ incxi = incx;
+ inca1i = n;
+ inca1ij = incaij = 1;
+ }
+ xi0 = (incx > 0) ? 0 : -(n - 1) * incx;
+ yi0 = (incy > 0) ? 0 : -(n - 1) * incy;
+ incri = 1;
+ incri *= 2;
+ xi0 *= 2;
+ yi0 *= 2;
+ incyi *= 2;
+ incai *= 2;
+ incaij *= 2;
+ incxi *= 2;
+
+ inca_vec = incx_vec = 1;
+ inca_vec *= 2;
+ incx_vec *= 2;
+ a_vec = (float *) blas_malloc(n * sizeof(float) * 2);
+ if (n > 0 && a_vec == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ x_head_vec = (float *) blas_malloc(n * sizeof(float) * 2);
+ if (n > 0 && x_head_vec == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ x_tail_vec = (float *) blas_malloc(n * sizeof(float) * 2);
+ if (n > 0 && x_tail_vec == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+
+ int incx0, incy1, incy2, incmi = 1;
+ a1 = (float *) blas_malloc(n * n * sizeof(float));
+ if (n * n > 0 && a1 == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ a2 = (float *) blas_malloc(n * n * sizeof(float));
+ if (n * n > 0 && a2 == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ y1 = (float *) blas_malloc(n * sizeof(float));
+ if (n > 0 && y1 == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ incy1 = 1;
+
+ y2 = (float *) blas_malloc(n * sizeof(float));
+ if (n > 0 && y2 == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ incy2 = 1;
+
+ x_head_0 = (float *) blas_malloc(n * sizeof(float));
+ if (n > 0 && x_head_0 == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ x_tail_0 = (float *) blas_malloc(n * sizeof(float));
+ if (n > 0 && x_tail_0 == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ incx0 = 1;
+
+ head_r1_true = (double *) blas_malloc(n * sizeof(double));
+ tail_r1_true = (double *) blas_malloc(n * sizeof(double));
+ if (n > 0 && (head_r1_true == NULL || tail_r1_true == NULL)) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ };
+ head_r2_true = (double *) blas_malloc(n * sizeof(double));
+ tail_r2_true = (double *) blas_malloc(n * sizeof(double));
+ if (n > 0 && (head_r2_true == NULL || tail_r2_true == NULL)) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ };
+
+ /* First generate the real portion of A and x. */
+ BLAS_ssymv2_testgen(norm, order, uplo, n, alpha_i, alpha_flag, a1, n,
+ x_head_0, x_tail_0, beta_i, beta_flag, y1, seed,
+ head_r1_true, tail_r1_true);
+
+ /* x0 is now fixed and is input to this call */
+ BLAS_sskmv2_testgen(norm, order, uplo, n, alpha_i, beta_i, a2, n,
+ x_head_0, x_tail_0, y2, seed, head_r2_true,
+ tail_r2_true);
+
+
+ /* The case where x is a complex vector. Since x is generated
+ as a real vector, we need to perform some scaling.
+
+ There are four cases to consider, depending on the values
+ of alpha and beta.
+
+ values scaling
+ alpha beta alpha A x beta y r (truth)
+ 0 1 1 i i i
+ 1 1 ? 1+i 1+i 1+i
+ 2 ? 1 1+i 1+i 2i 2i
+ 3 ? ? 1+i 1+i 2i 2i
+
+ Note that we can afford to scale r by 1+i, since they are
+ computed in double-double precision.
+ */
+
+ if (alpha_i[0] == 1.0 && beta_i[0] == 1.0) {
+ ab = 0;
+ alpha_i[1] = beta_i[1] = 0.0; /* set alpha, beta to be 1. */
+ } else if (alpha_i[0] == 1.0) {
+ ab = 1;
+ /* set alpha to 1, multiply beta by 1+i. */
+ alpha_i[1] = 0.0;
+ beta_i[1] = beta_i[0];
+ } else if (beta_i[0] == 1.0) {
+ ab = 2;
+ /* set beta to 1, multiply alpha by 1+i. */
+ beta_i[1] = 0.0;
+ alpha_i[1] = alpha_i[0];
+ } else {
+ ab = 3;
+ /* multiply alpha by 1+i, beta by 2i. */
+ alpha_i[1] = alpha_i[0];
+ beta_i[1] = 2.0 * beta_i[0];
+ beta_i[0] = 0.0;
+ }
+
+ /* Now fill in a */
+ for (i = 0, ai = 0, a1i = 0; i < n; i++, ai += incai, a1i += inca1i) {
+ for (j = 0, aij = ai, a1ij = a1i; j < n;
+ j++, aij += incaij, a1ij += inca1ij) {
+ a_i[aij] = a1[a1ij];
+ a_i[aij + 1] = a2[a1ij];
+ }
+ }
+
+ /* Fill in x */
+ for (i = 0, xi = xi0, mi = 0; i < n; i++, xi += incxi, mi += incx0) {
+ if (ab == 0) {
+ x_head_i[xi] = 0.0;
+ x_head_i[xi + 1] = x_head_0[mi];
+ x_tail_i[xi] = 0.0;
+ x_tail_i[xi + 1] = x_tail_0[mi];
+ } else {
+ x_head_i[xi] = x_head_0[mi];
+ x_head_i[xi + 1] = x_head_0[mi];
+ x_tail_i[xi] = x_tail_0[mi];
+ x_tail_i[xi + 1] = x_tail_0[mi];
+ }
+ }
+
+ /* Fill in y */
+ for (i = 0, yi = yi0, mi = 0; i < n; i++, yi += incyi, mi += incy1) {
+ if (ab == 0) {
+ y_i[yi] = -y2[mi];
+ y_i[yi + 1] = y1[mi];
+ } else if (ab == 2) {
+ y_i[yi] = -2.0 * y2[mi];
+ y_i[yi + 1] = 2.0 * y1[mi];
+ } else {
+ y_i[yi] = y1[mi];
+ y_i[yi + 1] = y2[mi];
+ }
+ }
+
+ /* Fill in the truth */
+ for (i = 0, ri = 0, mi = 0; i < n; i++, ri += incri, mi += incmi) {
+
+ head_r_elem1 = head_r1_true[mi];
+ tail_r_elem1 = tail_r1_true[mi];
+ head_r_elem2 = head_r2_true[mi];
+ tail_r_elem2 = tail_r2_true[mi];
+
+ if (ab == 0) {
+ head_r_true[ri] = -head_r_elem2;
+ tail_r_true[ri] = -tail_r_elem2;
+ head_r_true[ri + 1] = head_r_elem1;
+ tail_r_true[ri + 1] = tail_r_elem1;
+ } else if (ab == 1) {
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_r_elem1 + head_r_elem2;
+ bv = s1 - head_r_elem1;
+ s2 = ((head_r_elem2 - bv) + (head_r_elem1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_r_elem1 + tail_r_elem2;
+ bv = t1 - tail_r_elem1;
+ t2 = ((tail_r_elem2 - bv) + (tail_r_elem1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_r_elem = t1 + t2;
+ tail_r_elem = t2 - (head_r_elem - t1);
+ }
+
+ /* Set the imaginary part to R1 + R2 */
+ tail_r_true[ri + 1] = tail_r_elem;
+ head_r_true[ri + 1] = head_r_elem;
+
+ /* Set the real part to R1 - R2. */
+ {
+ double head_bt, tail_bt;
+ head_bt = -head_r_elem2;
+ tail_bt = -tail_r_elem2;
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_r_elem1 + head_bt;
+ bv = s1 - head_r_elem1;
+ s2 = ((head_bt - bv) + (head_r_elem1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_r_elem1 + tail_bt;
+ bv = t1 - tail_r_elem1;
+ t2 = ((tail_bt - bv) + (tail_r_elem1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_r_elem = t1 + t2;
+ tail_r_elem = t2 - (head_r_elem - t1);
+ }
+ }
+ tail_r_true[ri] = tail_r_elem;
+ head_r_true[ri] = head_r_elem;
+ } else {
+ /* Real part */
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_r_elem2 * split;
+ a11 = con - head_r_elem2;
+ a11 = con - a11;
+ a21 = head_r_elem2 - a11;
+ con = -2.0 * split;
+ b1 = con - -2.0;
+ b1 = con - b1;
+ b2 = -2.0 - b1;
+
+ c11 = head_r_elem2 * -2.0;
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_r_elem2 * -2.0;
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_r_elem = t1 + t2;
+ tail_r_elem = t2 - (head_r_elem - t1);
+ }
+ head_r_true[ri] = head_r_elem;
+ tail_r_true[ri] = tail_r_elem;
+
+ /* Imaginary Part */
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_r_elem1 * split;
+ a11 = con - head_r_elem1;
+ a11 = con - a11;
+ a21 = head_r_elem1 - a11;
+ con = 2.0 * split;
+ b1 = con - 2.0;
+ b1 = con - b1;
+ b2 = 2.0 - b1;
+
+ c11 = head_r_elem1 * 2.0;
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_r_elem1 * 2.0;
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_r_elem = t1 + t2;
+ tail_r_elem = t2 - (head_r_elem - t1);
+ }
+ head_r_true[ri + 1] = head_r_elem;
+ tail_r_true[ri + 1] = tail_r_elem;
+ }
+ }
+
+
+ blas_free(a1);
+ blas_free(a2);
+ blas_free(y1);
+ blas_free(y2);
+ blas_free(x_head_0);
+ blas_free(x_tail_0);
+ blas_free(head_r1_true);
+ blas_free(tail_r1_true);
+ blas_free(head_r2_true);
+ blas_free(tail_r2_true);
+ blas_free(a_vec);
+ blas_free(x_head_vec);
+ blas_free(x_tail_vec);
+ }
+}
+
+void BLAS_zhemv2_testgen(int norm, enum blas_order_type order,
+ enum blas_uplo_type uplo, int n, void *alpha,
+ int alpha_flag, void *beta, int beta_flag, void *a,
+ int lda, void *x_head, void *x_tail, void *y,
+ int *seed, double *head_r_true, double *tail_r_true)
+
+/*
+ * Purpose
+ * =======
+ *
+ * Generates the test inputs to BLAS_zhemv2{_x}
+ *
+ * Arguments
+ * =========
+ *
+ * norm (input) int
+ * = -1: the vectors are scaled with norms near underflow.
+ * = 0: the vectors have norms of order 1.
+ * = 1: the vectors are scaled with norms near overflow.
+ *
+ * order (input) enum blas_order_type
+ * storage format of the matrices
+ *
+ * uplo (input) enum blas_uplo_type
+ * which half of the hemv2etric matrix a is to be stored.
+ *
+ * n (input) int
+ * sizes of symmetrical matrix a, size of vectors x, y:
+ * matrix a is n-by-n.
+ *
+ * alpha (input/output) void*
+ * if alpha_flag = 1, alpha is input.
+ * if alpha_flag = 0, alpha is output.
+ *
+ * alpha_flag (input) int
+ * = 0: alpha is free, and is output.
+ * = 1: alpha is fixed on input.
+ *
+ * beta (input/output) void*
+ * if beta_flag = 1, beta is input.
+ * if beta_flag = 0, beta is output.
+ *
+ * beta_flag (input) int
+ * = 0: beta is free, and is output.
+ * = 1: beta is fixed on input.
+ *
+ * a (input/output) void*
+ *
+ * lda (input) lda
+ * leading dimension of matrix A.
+ *
+ * x_head (input/output) void*
+ * x_tail (input/output) void*
+ * vector x = (x_head + x_tail)
+ *
+ * y (input/output) void*
+ * generated vector y that will be used as an input to HEMV2.
+ *
+ * seed (input/output) int *
+ * seed for the random number generator.
+ *
+ * head_r_true (output) double *
+ * the leading part of the truth in double-double.
+ *
+ * tail_r_true (output) double *
+ * the trailing part of the truth in double-double
+ *
+ */
+{
+ {
+
+ /* Strategy:
+ r1 = alpha * A1 * x + beta * y1
+ r2 = alpha * A2 * x + beta * y2
+ where all the matrices and vectors are real. Then let R = R1 + i R2,
+ A = A1 + i A2, y = y1 + i y2. To make A Hermitian, A1 is symmetric,
+ and A2 is skew-symmetric.
+ */
+
+ int i, j;
+ int yi;
+ int aij, ai;
+ int a1ij, a1i;
+ int xi;
+ int mi;
+ int incx = 1, incy = 1;
+ int incyi, xi0, yi0;
+ int incaij, incai;
+ int inca1ij, inca1i;
+ int incxi;
+ int inca_vec, incx_vec;
+ int ld;
+ int ab;
+ int ri, incri;
+
+ double *a1;
+ double *a2;
+ double *y1;
+ double *y2;
+ double *x_head_0;
+ double *x_tail_0;
+
+ double *head_r1_true, *tail_r1_true;
+ double *head_r2_true, *tail_r2_true;
+
+ double head_r_elem1, tail_r_elem1;
+ double head_r_elem2, tail_r_elem2;
+ double head_r_elem, tail_r_elem;
+
+ double *a_vec;
+ double *x_head_vec;
+ double *x_tail_vec;
+
+ double *y_i = (double *) y;
+ double *alpha_i = (double *) alpha;
+ double *beta_i = (double *) beta;
+
+ double *a_i = (double *) a;
+ double *x_head_i = (double *) x_head;
+ double *x_tail_i = (double *) x_tail;
+
+ ld = n;
+ if (order == blas_colmajor) {
+ inca1i = incai = 1;
+ incyi = incy;
+ incaij = lda;
+ incxi = incx;
+ inca1ij = n;
+ } else {
+ incyi = incy;
+ incai = lda;
+ incxi = incx;
+ inca1i = n;
+ inca1ij = incaij = 1;
+ }
+ xi0 = (incx > 0) ? 0 : -(n - 1) * incx;
+ yi0 = (incy > 0) ? 0 : -(n - 1) * incy;
+ incri = 1;
+ incri *= 2;
+ xi0 *= 2;
+ yi0 *= 2;
+ incyi *= 2;
+ incai *= 2;
+ incaij *= 2;
+ incxi *= 2;
+
+ inca_vec = incx_vec = 1;
+ inca_vec *= 2;
+ incx_vec *= 2;
+ a_vec = (double *) blas_malloc(n * sizeof(double) * 2);
+ if (n > 0 && a_vec == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ x_head_vec = (double *) blas_malloc(n * sizeof(double) * 2);
+ if (n > 0 && x_head_vec == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ x_tail_vec = (double *) blas_malloc(n * sizeof(double) * 2);
+ if (n > 0 && x_tail_vec == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+
+ int incx0, incy1, incy2, incmi = 1;
+ a1 = (double *) blas_malloc(n * n * sizeof(double));
+ if (n * n > 0 && a1 == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ a2 = (double *) blas_malloc(n * n * sizeof(double));
+ if (n * n > 0 && a2 == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ y1 = (double *) blas_malloc(n * sizeof(double));
+ if (n > 0 && y1 == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ incy1 = 1;
+
+ y2 = (double *) blas_malloc(n * sizeof(double));
+ if (n > 0 && y2 == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ incy2 = 1;
+
+ x_head_0 = (double *) blas_malloc(n * sizeof(double));
+ if (n > 0 && x_head_0 == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ x_tail_0 = (double *) blas_malloc(n * sizeof(double));
+ if (n > 0 && x_tail_0 == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ incx0 = 1;
+
+ head_r1_true = (double *) blas_malloc(n * sizeof(double));
+ tail_r1_true = (double *) blas_malloc(n * sizeof(double));
+ if (n > 0 && (head_r1_true == NULL || tail_r1_true == NULL)) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ };
+ head_r2_true = (double *) blas_malloc(n * sizeof(double));
+ tail_r2_true = (double *) blas_malloc(n * sizeof(double));
+ if (n > 0 && (head_r2_true == NULL || tail_r2_true == NULL)) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ };
+
+ /* First generate the real portion of A and x. */
+ BLAS_dsymv2_testgen(norm, order, uplo, n, alpha_i, alpha_flag, a1, n,
+ x_head_0, x_tail_0, beta_i, beta_flag, y1, seed,
+ head_r1_true, tail_r1_true);
+
+ /* x0 is now fixed and is input to this call */
+ BLAS_dskmv2_testgen(norm, order, uplo, n, alpha_i, beta_i, a2, n,
+ x_head_0, x_tail_0, y2, seed, head_r2_true,
+ tail_r2_true);
+
+
+ /* The case where x is a complex vector. Since x is generated
+ as a real vector, we need to perform some scaling.
+
+ There are four cases to consider, depending on the values
+ of alpha and beta.
+
+ values scaling
+ alpha beta alpha A x beta y r (truth)
+ 0 1 1 i i i
+ 1 1 ? 1+i 1+i 1+i
+ 2 ? 1 1+i 1+i 2i 2i
+ 3 ? ? 1+i 1+i 2i 2i
+
+ Note that we can afford to scale r by 1+i, since they are
+ computed in double-double precision.
+ */
+
+ if (alpha_i[0] == 1.0 && beta_i[0] == 1.0) {
+ ab = 0;
+ alpha_i[1] = beta_i[1] = 0.0; /* set alpha, beta to be 1. */
+ } else if (alpha_i[0] == 1.0) {
+ ab = 1;
+ /* set alpha to 1, multiply beta by 1+i. */
+ alpha_i[1] = 0.0;
+ beta_i[1] = beta_i[0];
+ } else if (beta_i[0] == 1.0) {
+ ab = 2;
+ /* set beta to 1, multiply alpha by 1+i. */
+ beta_i[1] = 0.0;
+ alpha_i[1] = alpha_i[0];
+ } else {
+ ab = 3;
+ /* multiply alpha by 1+i, beta by 2i. */
+ alpha_i[1] = alpha_i[0];
+ beta_i[1] = 2.0 * beta_i[0];
+ beta_i[0] = 0.0;
+ }
+
+ /* Now fill in a */
+ for (i = 0, ai = 0, a1i = 0; i < n; i++, ai += incai, a1i += inca1i) {
+ for (j = 0, aij = ai, a1ij = a1i; j < n;
+ j++, aij += incaij, a1ij += inca1ij) {
+ a_i[aij] = a1[a1ij];
+ a_i[aij + 1] = a2[a1ij];
+ }
+ }
+
+ /* Fill in x */
+ for (i = 0, xi = xi0, mi = 0; i < n; i++, xi += incxi, mi += incx0) {
+ if (ab == 0) {
+ x_head_i[xi] = 0.0;
+ x_head_i[xi + 1] = x_head_0[mi];
+ x_tail_i[xi] = 0.0;
+ x_tail_i[xi + 1] = x_tail_0[mi];
+ } else {
+ x_head_i[xi] = x_head_0[mi];
+ x_head_i[xi + 1] = x_head_0[mi];
+ x_tail_i[xi] = x_tail_0[mi];
+ x_tail_i[xi + 1] = x_tail_0[mi];
+ }
+ }
+
+ /* Fill in y */
+ for (i = 0, yi = yi0, mi = 0; i < n; i++, yi += incyi, mi += incy1) {
+ if (ab == 0) {
+ y_i[yi] = -y2[mi];
+ y_i[yi + 1] = y1[mi];
+ } else if (ab == 2) {
+ y_i[yi] = -2.0 * y2[mi];
+ y_i[yi + 1] = 2.0 * y1[mi];
+ } else {
+ y_i[yi] = y1[mi];
+ y_i[yi + 1] = y2[mi];
+ }
+ }
+
+ /* Fill in the truth */
+ for (i = 0, ri = 0, mi = 0; i < n; i++, ri += incri, mi += incmi) {
+
+ head_r_elem1 = head_r1_true[mi];
+ tail_r_elem1 = tail_r1_true[mi];
+ head_r_elem2 = head_r2_true[mi];
+ tail_r_elem2 = tail_r2_true[mi];
+
+ if (ab == 0) {
+ head_r_true[ri] = -head_r_elem2;
+ tail_r_true[ri] = -tail_r_elem2;
+ head_r_true[ri + 1] = head_r_elem1;
+ tail_r_true[ri + 1] = tail_r_elem1;
+ } else if (ab == 1) {
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_r_elem1 + head_r_elem2;
+ bv = s1 - head_r_elem1;
+ s2 = ((head_r_elem2 - bv) + (head_r_elem1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_r_elem1 + tail_r_elem2;
+ bv = t1 - tail_r_elem1;
+ t2 = ((tail_r_elem2 - bv) + (tail_r_elem1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_r_elem = t1 + t2;
+ tail_r_elem = t2 - (head_r_elem - t1);
+ }
+
+ /* Set the imaginary part to R1 + R2 */
+ tail_r_true[ri + 1] = tail_r_elem;
+ head_r_true[ri + 1] = head_r_elem;
+
+ /* Set the real part to R1 - R2. */
+ {
+ double head_bt, tail_bt;
+ head_bt = -head_r_elem2;
+ tail_bt = -tail_r_elem2;
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_r_elem1 + head_bt;
+ bv = s1 - head_r_elem1;
+ s2 = ((head_bt - bv) + (head_r_elem1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_r_elem1 + tail_bt;
+ bv = t1 - tail_r_elem1;
+ t2 = ((tail_bt - bv) + (tail_r_elem1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_r_elem = t1 + t2;
+ tail_r_elem = t2 - (head_r_elem - t1);
+ }
+ }
+ tail_r_true[ri] = tail_r_elem;
+ head_r_true[ri] = head_r_elem;
+ } else {
+ /* Real part */
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_r_elem2 * split;
+ a11 = con - head_r_elem2;
+ a11 = con - a11;
+ a21 = head_r_elem2 - a11;
+ con = -2.0 * split;
+ b1 = con - -2.0;
+ b1 = con - b1;
+ b2 = -2.0 - b1;
+
+ c11 = head_r_elem2 * -2.0;
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_r_elem2 * -2.0;
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_r_elem = t1 + t2;
+ tail_r_elem = t2 - (head_r_elem - t1);
+ }
+ head_r_true[ri] = head_r_elem;
+ tail_r_true[ri] = tail_r_elem;
+
+ /* Imaginary Part */
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_r_elem1 * split;
+ a11 = con - head_r_elem1;
+ a11 = con - a11;
+ a21 = head_r_elem1 - a11;
+ con = 2.0 * split;
+ b1 = con - 2.0;
+ b1 = con - b1;
+ b2 = 2.0 - b1;
+
+ c11 = head_r_elem1 * 2.0;
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_r_elem1 * 2.0;
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_r_elem = t1 + t2;
+ tail_r_elem = t2 - (head_r_elem - t1);
+ }
+ head_r_true[ri + 1] = head_r_elem;
+ tail_r_true[ri + 1] = tail_r_elem;
+ }
+ }
+
+
+ blas_free(a1);
+ blas_free(a2);
+ blas_free(y1);
+ blas_free(y2);
+ blas_free(x_head_0);
+ blas_free(x_tail_0);
+ blas_free(head_r1_true);
+ blas_free(tail_r1_true);
+ blas_free(head_r2_true);
+ blas_free(tail_r2_true);
+ blas_free(a_vec);
+ blas_free(x_head_vec);
+ blas_free(x_tail_vec);
+ }
+}
+
+void BLAS_zhemv2_c_z_testgen(int norm, enum blas_order_type order,
+ enum blas_uplo_type uplo, int n, void *alpha,
+ int alpha_flag, void *beta, int beta_flag,
+ void *a, int lda, void *x_head, void *x_tail,
+ void *y, int *seed, double *head_r_true,
+ double *tail_r_true)
+
+/*
+ * Purpose
+ * =======
+ *
+ * Generates the test inputs to BLAS_zhemv_c_z{_x}
+ *
+ * Arguments
+ * =========
+ *
+ * norm (input) int
+ * = -1: the vectors are scaled with norms near underflow.
+ * = 0: the vectors have norms of order 1.
+ * = 1: the vectors are scaled with norms near overflow.
+ *
+ * order (input) enum blas_order_type
+ * storage format of the matrices
+ *
+ * uplo (input) enum blas_uplo_type
+ * which half of the hemv2etric matrix a is to be stored.
+ *
+ * n (input) int
+ * sizes of symmetrical matrix a, size of vectors x, y:
+ * matrix a is n-by-n.
+ *
+ * alpha (input/output) void*
+ * if alpha_flag = 1, alpha is input.
+ * if alpha_flag = 0, alpha is output.
+ *
+ * alpha_flag (input) int
+ * = 0: alpha is free, and is output.
+ * = 1: alpha is fixed on input.
+ *
+ * beta (input/output) void*
+ * if beta_flag = 1, beta is input.
+ * if beta_flag = 0, beta is output.
+ *
+ * beta_flag (input) int
+ * = 0: beta is free, and is output.
+ * = 1: beta is fixed on input.
+ *
+ * a (input/output) void*
+ *
+ * lda (input) lda
+ * leading dimension of matrix A.
+ *
+ * x_head (input/output) void*
+ * x_tail (input/output) void*
+ * vector x = (x_head + x_tail)
+ *
+ * y (input/output) void*
+ * generated vector y that will be used as an input to HEMV2.
+ *
+ * seed (input/output) int *
+ * seed for the random number generator.
+ *
+ * head_r_true (output) double *
+ * the leading part of the truth in double-double.
+ *
+ * tail_r_true (output) double *
+ * the trailing part of the truth in double-double
+ *
+ */
+{
+ {
+
+ /* Strategy:
+ r1 = alpha * A1 * x + beta * y1
+ r2 = alpha * A2 * x + beta * y2
+ where all the matrices and vectors are real. Then let R = R1 + i R2,
+ A = A1 + i A2, y = y1 + i y2. To make A Hermitian, A1 is symmetric,
+ and A2 is skew-symmetric.
+ */
+
+ int i, j;
+ int yi;
+ int aij, ai;
+ int a1ij, a1i;
+ int xi;
+ int mi;
+ int incx = 1, incy = 1;
+ int incyi, xi0, yi0;
+ int incaij, incai;
+ int inca1ij, inca1i;
+ int incxi;
+ int inca_vec, incx_vec;
+ int ld;
+ int ab;
+ int ri, incri;
+
+ float *a1;
+ float *a2;
+ double *y1;
+ double *y2;
+ double *x_head_0;
+ double *x_tail_0;
+
+ double *head_r1_true, *tail_r1_true;
+ double *head_r2_true, *tail_r2_true;
+
+ double head_r_elem1, tail_r_elem1;
+ double head_r_elem2, tail_r_elem2;
+ double head_r_elem, tail_r_elem;
+
+ float *a_vec;
+ double *x_head_vec;
+ double *x_tail_vec;
+
+ double *y_i = (double *) y;
+ double *alpha_i = (double *) alpha;
+ double *beta_i = (double *) beta;
+
+ float *a_i = (float *) a;
+ double *x_head_i = (double *) x_head;
+ double *x_tail_i = (double *) x_tail;
+
+ ld = n;
+ if (order == blas_colmajor) {
+ inca1i = incai = 1;
+ incyi = incy;
+ incaij = lda;
+ incxi = incx;
+ inca1ij = n;
+ } else {
+ incyi = incy;
+ incai = lda;
+ incxi = incx;
+ inca1i = n;
+ inca1ij = incaij = 1;
+ }
+ xi0 = (incx > 0) ? 0 : -(n - 1) * incx;
+ yi0 = (incy > 0) ? 0 : -(n - 1) * incy;
+ incri = 1;
+ incri *= 2;
+ xi0 *= 2;
+ yi0 *= 2;
+ incyi *= 2;
+ incai *= 2;
+ incaij *= 2;
+ incxi *= 2;
+
+ inca_vec = incx_vec = 1;
+ inca_vec *= 2;
+ incx_vec *= 2;
+ a_vec = (float *) blas_malloc(n * sizeof(float) * 2);
+ if (n > 0 && a_vec == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ x_head_vec = (double *) blas_malloc(n * sizeof(double) * 2);
+ if (n > 0 && x_head_vec == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ x_tail_vec = (double *) blas_malloc(n * sizeof(double) * 2);
+ if (n > 0 && x_tail_vec == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+
+ int incx0, incy1, incy2, incmi = 1;
+ a1 = (float *) blas_malloc(n * n * sizeof(float));
+ if (n * n > 0 && a1 == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ a2 = (float *) blas_malloc(n * n * sizeof(float));
+ if (n * n > 0 && a2 == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ y1 = (double *) blas_malloc(n * sizeof(double));
+ if (n > 0 && y1 == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ incy1 = 1;
+
+ y2 = (double *) blas_malloc(n * sizeof(double));
+ if (n > 0 && y2 == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ incy2 = 1;
+
+ x_head_0 = (double *) blas_malloc(n * sizeof(double));
+ if (n > 0 && x_head_0 == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ x_tail_0 = (double *) blas_malloc(n * sizeof(double));
+ if (n > 0 && x_tail_0 == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ incx0 = 1;
+
+ head_r1_true = (double *) blas_malloc(n * sizeof(double));
+ tail_r1_true = (double *) blas_malloc(n * sizeof(double));
+ if (n > 0 && (head_r1_true == NULL || tail_r1_true == NULL)) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ };
+ head_r2_true = (double *) blas_malloc(n * sizeof(double));
+ tail_r2_true = (double *) blas_malloc(n * sizeof(double));
+ if (n > 0 && (head_r2_true == NULL || tail_r2_true == NULL)) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ };
+
+ /* First generate the real portion of A and x. */
+ BLAS_dsymv2_s_d_testgen(norm, order, uplo, n, alpha_i, alpha_flag, a1, n,
+ x_head_0, x_tail_0, beta_i, beta_flag, y1, seed,
+ head_r1_true, tail_r1_true);
+
+ /* x0 is now fixed and is input to this call */
+ BLAS_dskmv2_testgen_s_d(norm, order, uplo, n, alpha_i, beta_i, a2, n,
+ x_head_0, x_tail_0, y2, seed, head_r2_true,
+ tail_r2_true);
+
+
+ /* The case where x is a complex vector. Since x is generated
+ as a real vector, we need to perform some scaling.
+
+ There are four cases to consider, depending on the values
+ of alpha and beta.
+
+ values scaling
+ alpha beta alpha A x beta y r (truth)
+ 0 1 1 i i i
+ 1 1 ? 1+i 1+i 1+i
+ 2 ? 1 1+i 1+i 2i 2i
+ 3 ? ? 1+i 1+i 2i 2i
+
+ Note that we can afford to scale r by 1+i, since they are
+ computed in double-double precision.
+ */
+
+ if (alpha_i[0] == 1.0 && beta_i[0] == 1.0) {
+ ab = 0;
+ alpha_i[1] = beta_i[1] = 0.0; /* set alpha, beta to be 1. */
+ } else if (alpha_i[0] == 1.0) {
+ ab = 1;
+ /* set alpha to 1, multiply beta by 1+i. */
+ alpha_i[1] = 0.0;
+ beta_i[1] = beta_i[0];
+ } else if (beta_i[0] == 1.0) {
+ ab = 2;
+ /* set beta to 1, multiply alpha by 1+i. */
+ beta_i[1] = 0.0;
+ alpha_i[1] = alpha_i[0];
+ } else {
+ ab = 3;
+ /* multiply alpha by 1+i, beta by 2i. */
+ alpha_i[1] = alpha_i[0];
+ beta_i[1] = 2.0 * beta_i[0];
+ beta_i[0] = 0.0;
+ }
+
+ /* Now fill in a */
+ for (i = 0, ai = 0, a1i = 0; i < n; i++, ai += incai, a1i += inca1i) {
+ for (j = 0, aij = ai, a1ij = a1i; j < n;
+ j++, aij += incaij, a1ij += inca1ij) {
+ a_i[aij] = a1[a1ij];
+ a_i[aij + 1] = a2[a1ij];
+ }
+ }
+
+ /* Fill in x */
+ for (i = 0, xi = xi0, mi = 0; i < n; i++, xi += incxi, mi += incx0) {
+ if (ab == 0) {
+ x_head_i[xi] = 0.0;
+ x_head_i[xi + 1] = x_head_0[mi];
+ x_tail_i[xi] = 0.0;
+ x_tail_i[xi + 1] = x_tail_0[mi];
+ } else {
+ x_head_i[xi] = x_head_0[mi];
+ x_head_i[xi + 1] = x_head_0[mi];
+ x_tail_i[xi] = x_tail_0[mi];
+ x_tail_i[xi + 1] = x_tail_0[mi];
+ }
+ }
+
+ /* Fill in y */
+ for (i = 0, yi = yi0, mi = 0; i < n; i++, yi += incyi, mi += incy1) {
+ if (ab == 0) {
+ y_i[yi] = -y2[mi];
+ y_i[yi + 1] = y1[mi];
+ } else if (ab == 2) {
+ y_i[yi] = -2.0 * y2[mi];
+ y_i[yi + 1] = 2.0 * y1[mi];
+ } else {
+ y_i[yi] = y1[mi];
+ y_i[yi + 1] = y2[mi];
+ }
+ }
+
+ /* Fill in the truth */
+ for (i = 0, ri = 0, mi = 0; i < n; i++, ri += incri, mi += incmi) {
+
+ head_r_elem1 = head_r1_true[mi];
+ tail_r_elem1 = tail_r1_true[mi];
+ head_r_elem2 = head_r2_true[mi];
+ tail_r_elem2 = tail_r2_true[mi];
+
+ if (ab == 0) {
+ head_r_true[ri] = -head_r_elem2;
+ tail_r_true[ri] = -tail_r_elem2;
+ head_r_true[ri + 1] = head_r_elem1;
+ tail_r_true[ri + 1] = tail_r_elem1;
+ } else if (ab == 1) {
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_r_elem1 + head_r_elem2;
+ bv = s1 - head_r_elem1;
+ s2 = ((head_r_elem2 - bv) + (head_r_elem1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_r_elem1 + tail_r_elem2;
+ bv = t1 - tail_r_elem1;
+ t2 = ((tail_r_elem2 - bv) + (tail_r_elem1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_r_elem = t1 + t2;
+ tail_r_elem = t2 - (head_r_elem - t1);
+ }
+
+ /* Set the imaginary part to R1 + R2 */
+ tail_r_true[ri + 1] = tail_r_elem;
+ head_r_true[ri + 1] = head_r_elem;
+
+ /* Set the real part to R1 - R2. */
+ {
+ double head_bt, tail_bt;
+ head_bt = -head_r_elem2;
+ tail_bt = -tail_r_elem2;
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_r_elem1 + head_bt;
+ bv = s1 - head_r_elem1;
+ s2 = ((head_bt - bv) + (head_r_elem1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_r_elem1 + tail_bt;
+ bv = t1 - tail_r_elem1;
+ t2 = ((tail_bt - bv) + (tail_r_elem1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_r_elem = t1 + t2;
+ tail_r_elem = t2 - (head_r_elem - t1);
+ }
+ }
+ tail_r_true[ri] = tail_r_elem;
+ head_r_true[ri] = head_r_elem;
+ } else {
+ /* Real part */
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_r_elem2 * split;
+ a11 = con - head_r_elem2;
+ a11 = con - a11;
+ a21 = head_r_elem2 - a11;
+ con = -2.0 * split;
+ b1 = con - -2.0;
+ b1 = con - b1;
+ b2 = -2.0 - b1;
+
+ c11 = head_r_elem2 * -2.0;
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_r_elem2 * -2.0;
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_r_elem = t1 + t2;
+ tail_r_elem = t2 - (head_r_elem - t1);
+ }
+ head_r_true[ri] = head_r_elem;
+ tail_r_true[ri] = tail_r_elem;
+
+ /* Imaginary Part */
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_r_elem1 * split;
+ a11 = con - head_r_elem1;
+ a11 = con - a11;
+ a21 = head_r_elem1 - a11;
+ con = 2.0 * split;
+ b1 = con - 2.0;
+ b1 = con - b1;
+ b2 = 2.0 - b1;
+
+ c11 = head_r_elem1 * 2.0;
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_r_elem1 * 2.0;
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_r_elem = t1 + t2;
+ tail_r_elem = t2 - (head_r_elem - t1);
+ }
+ head_r_true[ri + 1] = head_r_elem;
+ tail_r_true[ri + 1] = tail_r_elem;
+ }
+ }
+
+
+ blas_free(a1);
+ blas_free(a2);
+ blas_free(y1);
+ blas_free(y2);
+ blas_free(x_head_0);
+ blas_free(x_tail_0);
+ blas_free(head_r1_true);
+ blas_free(tail_r1_true);
+ blas_free(head_r2_true);
+ blas_free(tail_r2_true);
+ blas_free(a_vec);
+ blas_free(x_head_vec);
+ blas_free(x_tail_vec);
+ }
+}
+
+void BLAS_zhemv2_z_c_testgen(int norm, enum blas_order_type order,
+ enum blas_uplo_type uplo, int n, void *alpha,
+ int alpha_flag, void *beta, int beta_flag,
+ void *a, int lda, void *x_head, void *x_tail,
+ void *y, int *seed, double *head_r_true,
+ double *tail_r_true)
+
+/*
+ * Purpose
+ * =======
+ *
+ * Generates the test inputs to BLAS_zhemv_z_c{_x}
+ *
+ * Arguments
+ * =========
+ *
+ * norm (input) int
+ * = -1: the vectors are scaled with norms near underflow.
+ * = 0: the vectors have norms of order 1.
+ * = 1: the vectors are scaled with norms near overflow.
+ *
+ * order (input) enum blas_order_type
+ * storage format of the matrices
+ *
+ * uplo (input) enum blas_uplo_type
+ * which half of the hemv2etric matrix a is to be stored.
+ *
+ * n (input) int
+ * sizes of symmetrical matrix a, size of vectors x, y:
+ * matrix a is n-by-n.
+ *
+ * alpha (input/output) void*
+ * if alpha_flag = 1, alpha is input.
+ * if alpha_flag = 0, alpha is output.
+ *
+ * alpha_flag (input) int
+ * = 0: alpha is free, and is output.
+ * = 1: alpha is fixed on input.
+ *
+ * beta (input/output) void*
+ * if beta_flag = 1, beta is input.
+ * if beta_flag = 0, beta is output.
+ *
+ * beta_flag (input) int
+ * = 0: beta is free, and is output.
+ * = 1: beta is fixed on input.
+ *
+ * a (input/output) void*
+ *
+ * lda (input) lda
+ * leading dimension of matrix A.
+ *
+ * x_head (input/output) void*
+ * x_tail (input/output) void*
+ * vector x = (x_head + x_tail)
+ *
+ * y (input/output) void*
+ * generated vector y that will be used as an input to HEMV2.
+ *
+ * seed (input/output) int *
+ * seed for the random number generator.
+ *
+ * head_r_true (output) double *
+ * the leading part of the truth in double-double.
+ *
+ * tail_r_true (output) double *
+ * the trailing part of the truth in double-double
+ *
+ */
+{
+ {
+
+ /* Strategy:
+ r1 = alpha * A1 * x + beta * y1
+ r2 = alpha * A2 * x + beta * y2
+ where all the matrices and vectors are real. Then let R = R1 + i R2,
+ A = A1 + i A2, y = y1 + i y2. To make A Hermitian, A1 is symmetric,
+ and A2 is skew-symmetric.
+ */
+
+ int i, j;
+ int yi;
+ int aij, ai;
+ int a1ij, a1i;
+ int xi;
+ int mi;
+ int incx = 1, incy = 1;
+ int incyi, xi0, yi0;
+ int incaij, incai;
+ int inca1ij, inca1i;
+ int incxi;
+ int inca_vec, incx_vec;
+ int ld;
+ int ab;
+ int ri, incri;
+
+ double *a1;
+ double *a2;
+ double *y1;
+ double *y2;
+ float *x_head_0;
+ float *x_tail_0;
+
+ double *head_r1_true, *tail_r1_true;
+ double *head_r2_true, *tail_r2_true;
+
+ double head_r_elem1, tail_r_elem1;
+ double head_r_elem2, tail_r_elem2;
+ double head_r_elem, tail_r_elem;
+
+ double *a_vec;
+ float *x_head_vec;
+ float *x_tail_vec;
+
+ double *y_i = (double *) y;
+ double *alpha_i = (double *) alpha;
+ double *beta_i = (double *) beta;
+
+ double *a_i = (double *) a;
+ float *x_head_i = (float *) x_head;
+ float *x_tail_i = (float *) x_tail;
+
+ ld = n;
+ if (order == blas_colmajor) {
+ inca1i = incai = 1;
+ incyi = incy;
+ incaij = lda;
+ incxi = incx;
+ inca1ij = n;
+ } else {
+ incyi = incy;
+ incai = lda;
+ incxi = incx;
+ inca1i = n;
+ inca1ij = incaij = 1;
+ }
+ xi0 = (incx > 0) ? 0 : -(n - 1) * incx;
+ yi0 = (incy > 0) ? 0 : -(n - 1) * incy;
+ incri = 1;
+ incri *= 2;
+ xi0 *= 2;
+ yi0 *= 2;
+ incyi *= 2;
+ incai *= 2;
+ incaij *= 2;
+ incxi *= 2;
+
+ inca_vec = incx_vec = 1;
+ inca_vec *= 2;
+ incx_vec *= 2;
+ a_vec = (double *) blas_malloc(n * sizeof(double) * 2);
+ if (n > 0 && a_vec == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ x_head_vec = (float *) blas_malloc(n * sizeof(float) * 2);
+ if (n > 0 && x_head_vec == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ x_tail_vec = (float *) blas_malloc(n * sizeof(float) * 2);
+ if (n > 0 && x_tail_vec == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+
+ int incx0, incy1, incy2, incmi = 1;
+ a1 = (double *) blas_malloc(n * n * sizeof(double));
+ if (n * n > 0 && a1 == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ a2 = (double *) blas_malloc(n * n * sizeof(double));
+ if (n * n > 0 && a2 == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ y1 = (double *) blas_malloc(n * sizeof(double));
+ if (n > 0 && y1 == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ incy1 = 1;
+
+ y2 = (double *) blas_malloc(n * sizeof(double));
+ if (n > 0 && y2 == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ incy2 = 1;
+
+ x_head_0 = (float *) blas_malloc(n * sizeof(float));
+ if (n > 0 && x_head_0 == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ x_tail_0 = (float *) blas_malloc(n * sizeof(float));
+ if (n > 0 && x_tail_0 == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ incx0 = 1;
+
+ head_r1_true = (double *) blas_malloc(n * sizeof(double));
+ tail_r1_true = (double *) blas_malloc(n * sizeof(double));
+ if (n > 0 && (head_r1_true == NULL || tail_r1_true == NULL)) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ };
+ head_r2_true = (double *) blas_malloc(n * sizeof(double));
+ tail_r2_true = (double *) blas_malloc(n * sizeof(double));
+ if (n > 0 && (head_r2_true == NULL || tail_r2_true == NULL)) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ };
+
+ /* First generate the real portion of A and x. */
+ BLAS_dsymv2_d_s_testgen(norm, order, uplo, n, alpha_i, alpha_flag, a1, n,
+ x_head_0, x_tail_0, beta_i, beta_flag, y1, seed,
+ head_r1_true, tail_r1_true);
+
+ /* x0 is now fixed and is input to this call */
+ BLAS_dskmv2_testgen_d_s(norm, order, uplo, n, alpha_i, beta_i, a2, n,
+ x_head_0, x_tail_0, y2, seed, head_r2_true,
+ tail_r2_true);
+
+
+ /* The case where x is a complex vector. Since x is generated
+ as a real vector, we need to perform some scaling.
+
+ There are four cases to consider, depending on the values
+ of alpha and beta.
+
+ values scaling
+ alpha beta alpha A x beta y r (truth)
+ 0 1 1 i i i
+ 1 1 ? 1+i 1+i 1+i
+ 2 ? 1 1+i 1+i 2i 2i
+ 3 ? ? 1+i 1+i 2i 2i
+
+ Note that we can afford to scale r by 1+i, since they are
+ computed in double-double precision.
+ */
+
+ if (alpha_i[0] == 1.0 && beta_i[0] == 1.0) {
+ ab = 0;
+ alpha_i[1] = beta_i[1] = 0.0; /* set alpha, beta to be 1. */
+ } else if (alpha_i[0] == 1.0) {
+ ab = 1;
+ /* set alpha to 1, multiply beta by 1+i. */
+ alpha_i[1] = 0.0;
+ beta_i[1] = beta_i[0];
+ } else if (beta_i[0] == 1.0) {
+ ab = 2;
+ /* set beta to 1, multiply alpha by 1+i. */
+ beta_i[1] = 0.0;
+ alpha_i[1] = alpha_i[0];
+ } else {
+ ab = 3;
+ /* multiply alpha by 1+i, beta by 2i. */
+ alpha_i[1] = alpha_i[0];
+ beta_i[1] = 2.0 * beta_i[0];
+ beta_i[0] = 0.0;
+ }
+
+ /* Now fill in a */
+ for (i = 0, ai = 0, a1i = 0; i < n; i++, ai += incai, a1i += inca1i) {
+ for (j = 0, aij = ai, a1ij = a1i; j < n;
+ j++, aij += incaij, a1ij += inca1ij) {
+ a_i[aij] = a1[a1ij];
+ a_i[aij + 1] = a2[a1ij];
+ }
+ }
+
+ /* Fill in x */
+ for (i = 0, xi = xi0, mi = 0; i < n; i++, xi += incxi, mi += incx0) {
+ if (ab == 0) {
+ x_head_i[xi] = 0.0;
+ x_head_i[xi + 1] = x_head_0[mi];
+ x_tail_i[xi] = 0.0;
+ x_tail_i[xi + 1] = x_tail_0[mi];
+ } else {
+ x_head_i[xi] = x_head_0[mi];
+ x_head_i[xi + 1] = x_head_0[mi];
+ x_tail_i[xi] = x_tail_0[mi];
+ x_tail_i[xi + 1] = x_tail_0[mi];
+ }
+ }
+
+ /* Fill in y */
+ for (i = 0, yi = yi0, mi = 0; i < n; i++, yi += incyi, mi += incy1) {
+ if (ab == 0) {
+ y_i[yi] = -y2[mi];
+ y_i[yi + 1] = y1[mi];
+ } else if (ab == 2) {
+ y_i[yi] = -2.0 * y2[mi];
+ y_i[yi + 1] = 2.0 * y1[mi];
+ } else {
+ y_i[yi] = y1[mi];
+ y_i[yi + 1] = y2[mi];
+ }
+ }
+
+ /* Fill in the truth */
+ for (i = 0, ri = 0, mi = 0; i < n; i++, ri += incri, mi += incmi) {
+
+ head_r_elem1 = head_r1_true[mi];
+ tail_r_elem1 = tail_r1_true[mi];
+ head_r_elem2 = head_r2_true[mi];
+ tail_r_elem2 = tail_r2_true[mi];
+
+ if (ab == 0) {
+ head_r_true[ri] = -head_r_elem2;
+ tail_r_true[ri] = -tail_r_elem2;
+ head_r_true[ri + 1] = head_r_elem1;
+ tail_r_true[ri + 1] = tail_r_elem1;
+ } else if (ab == 1) {
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_r_elem1 + head_r_elem2;
+ bv = s1 - head_r_elem1;
+ s2 = ((head_r_elem2 - bv) + (head_r_elem1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_r_elem1 + tail_r_elem2;
+ bv = t1 - tail_r_elem1;
+ t2 = ((tail_r_elem2 - bv) + (tail_r_elem1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_r_elem = t1 + t2;
+ tail_r_elem = t2 - (head_r_elem - t1);
+ }
+
+ /* Set the imaginary part to R1 + R2 */
+ tail_r_true[ri + 1] = tail_r_elem;
+ head_r_true[ri + 1] = head_r_elem;
+
+ /* Set the real part to R1 - R2. */
+ {
+ double head_bt, tail_bt;
+ head_bt = -head_r_elem2;
+ tail_bt = -tail_r_elem2;
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_r_elem1 + head_bt;
+ bv = s1 - head_r_elem1;
+ s2 = ((head_bt - bv) + (head_r_elem1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_r_elem1 + tail_bt;
+ bv = t1 - tail_r_elem1;
+ t2 = ((tail_bt - bv) + (tail_r_elem1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_r_elem = t1 + t2;
+ tail_r_elem = t2 - (head_r_elem - t1);
+ }
+ }
+ tail_r_true[ri] = tail_r_elem;
+ head_r_true[ri] = head_r_elem;
+ } else {
+ /* Real part */
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_r_elem2 * split;
+ a11 = con - head_r_elem2;
+ a11 = con - a11;
+ a21 = head_r_elem2 - a11;
+ con = -2.0 * split;
+ b1 = con - -2.0;
+ b1 = con - b1;
+ b2 = -2.0 - b1;
+
+ c11 = head_r_elem2 * -2.0;
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_r_elem2 * -2.0;
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_r_elem = t1 + t2;
+ tail_r_elem = t2 - (head_r_elem - t1);
+ }
+ head_r_true[ri] = head_r_elem;
+ tail_r_true[ri] = tail_r_elem;
+
+ /* Imaginary Part */
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_r_elem1 * split;
+ a11 = con - head_r_elem1;
+ a11 = con - a11;
+ a21 = head_r_elem1 - a11;
+ con = 2.0 * split;
+ b1 = con - 2.0;
+ b1 = con - b1;
+ b2 = 2.0 - b1;
+
+ c11 = head_r_elem1 * 2.0;
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_r_elem1 * 2.0;
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_r_elem = t1 + t2;
+ tail_r_elem = t2 - (head_r_elem - t1);
+ }
+ head_r_true[ri + 1] = head_r_elem;
+ tail_r_true[ri + 1] = tail_r_elem;
+ }
+ }
+
+
+ blas_free(a1);
+ blas_free(a2);
+ blas_free(y1);
+ blas_free(y2);
+ blas_free(x_head_0);
+ blas_free(x_tail_0);
+ blas_free(head_r1_true);
+ blas_free(tail_r1_true);
+ blas_free(head_r2_true);
+ blas_free(tail_r2_true);
+ blas_free(a_vec);
+ blas_free(x_head_vec);
+ blas_free(x_tail_vec);
+ }
+}
+
+void BLAS_zhemv2_c_c_testgen(int norm, enum blas_order_type order,
+ enum blas_uplo_type uplo, int n, void *alpha,
+ int alpha_flag, void *beta, int beta_flag,
+ void *a, int lda, void *x_head, void *x_tail,
+ void *y, int *seed, double *head_r_true,
+ double *tail_r_true)
+
+/*
+ * Purpose
+ * =======
+ *
+ * Generates the test inputs to BLAS_zhemv_c_c{_x}
+ *
+ * Arguments
+ * =========
+ *
+ * norm (input) int
+ * = -1: the vectors are scaled with norms near underflow.
+ * = 0: the vectors have norms of order 1.
+ * = 1: the vectors are scaled with norms near overflow.
+ *
+ * order (input) enum blas_order_type
+ * storage format of the matrices
+ *
+ * uplo (input) enum blas_uplo_type
+ * which half of the hemv2etric matrix a is to be stored.
+ *
+ * n (input) int
+ * sizes of symmetrical matrix a, size of vectors x, y:
+ * matrix a is n-by-n.
+ *
+ * alpha (input/output) void*
+ * if alpha_flag = 1, alpha is input.
+ * if alpha_flag = 0, alpha is output.
+ *
+ * alpha_flag (input) int
+ * = 0: alpha is free, and is output.
+ * = 1: alpha is fixed on input.
+ *
+ * beta (input/output) void*
+ * if beta_flag = 1, beta is input.
+ * if beta_flag = 0, beta is output.
+ *
+ * beta_flag (input) int
+ * = 0: beta is free, and is output.
+ * = 1: beta is fixed on input.
+ *
+ * a (input/output) void*
+ *
+ * lda (input) lda
+ * leading dimension of matrix A.
+ *
+ * x_head (input/output) void*
+ * x_tail (input/output) void*
+ * vector x = (x_head + x_tail)
+ *
+ * y (input/output) void*
+ * generated vector y that will be used as an input to HEMV2.
+ *
+ * seed (input/output) int *
+ * seed for the random number generator.
+ *
+ * head_r_true (output) double *
+ * the leading part of the truth in double-double.
+ *
+ * tail_r_true (output) double *
+ * the trailing part of the truth in double-double
+ *
+ */
+{
+ {
+
+ /* Strategy:
+ r1 = alpha * A1 * x + beta * y1
+ r2 = alpha * A2 * x + beta * y2
+ where all the matrices and vectors are real. Then let R = R1 + i R2,
+ A = A1 + i A2, y = y1 + i y2. To make A Hermitian, A1 is symmetric,
+ and A2 is skew-symmetric.
+ */
+
+ int i, j;
+ int yi;
+ int aij, ai;
+ int a1ij, a1i;
+ int xi;
+ int mi;
+ int incx = 1, incy = 1;
+ int incyi, xi0, yi0;
+ int incaij, incai;
+ int inca1ij, inca1i;
+ int incxi;
+ int inca_vec, incx_vec;
+ int ld;
+ int ab;
+ int ri, incri;
+
+ float *a1;
+ float *a2;
+ double *y1;
+ double *y2;
+ float *x_head_0;
+ float *x_tail_0;
+
+ double *head_r1_true, *tail_r1_true;
+ double *head_r2_true, *tail_r2_true;
+
+ double head_r_elem1, tail_r_elem1;
+ double head_r_elem2, tail_r_elem2;
+ double head_r_elem, tail_r_elem;
+
+ float *a_vec;
+ float *x_head_vec;
+ float *x_tail_vec;
+
+ double *y_i = (double *) y;
+ double *alpha_i = (double *) alpha;
+ double *beta_i = (double *) beta;
+
+ float *a_i = (float *) a;
+ float *x_head_i = (float *) x_head;
+ float *x_tail_i = (float *) x_tail;
+
+ ld = n;
+ if (order == blas_colmajor) {
+ inca1i = incai = 1;
+ incyi = incy;
+ incaij = lda;
+ incxi = incx;
+ inca1ij = n;
+ } else {
+ incyi = incy;
+ incai = lda;
+ incxi = incx;
+ inca1i = n;
+ inca1ij = incaij = 1;
+ }
+ xi0 = (incx > 0) ? 0 : -(n - 1) * incx;
+ yi0 = (incy > 0) ? 0 : -(n - 1) * incy;
+ incri = 1;
+ incri *= 2;
+ xi0 *= 2;
+ yi0 *= 2;
+ incyi *= 2;
+ incai *= 2;
+ incaij *= 2;
+ incxi *= 2;
+
+ inca_vec = incx_vec = 1;
+ inca_vec *= 2;
+ incx_vec *= 2;
+ a_vec = (float *) blas_malloc(n * sizeof(float) * 2);
+ if (n > 0 && a_vec == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ x_head_vec = (float *) blas_malloc(n * sizeof(float) * 2);
+ if (n > 0 && x_head_vec == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ x_tail_vec = (float *) blas_malloc(n * sizeof(float) * 2);
+ if (n > 0 && x_tail_vec == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+
+ int incx0, incy1, incy2, incmi = 1;
+ a1 = (float *) blas_malloc(n * n * sizeof(float));
+ if (n * n > 0 && a1 == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ a2 = (float *) blas_malloc(n * n * sizeof(float));
+ if (n * n > 0 && a2 == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ y1 = (double *) blas_malloc(n * sizeof(double));
+ if (n > 0 && y1 == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ incy1 = 1;
+
+ y2 = (double *) blas_malloc(n * sizeof(double));
+ if (n > 0 && y2 == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ incy2 = 1;
+
+ x_head_0 = (float *) blas_malloc(n * sizeof(float));
+ if (n > 0 && x_head_0 == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ x_tail_0 = (float *) blas_malloc(n * sizeof(float));
+ if (n > 0 && x_tail_0 == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ incx0 = 1;
+
+ head_r1_true = (double *) blas_malloc(n * sizeof(double));
+ tail_r1_true = (double *) blas_malloc(n * sizeof(double));
+ if (n > 0 && (head_r1_true == NULL || tail_r1_true == NULL)) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ };
+ head_r2_true = (double *) blas_malloc(n * sizeof(double));
+ tail_r2_true = (double *) blas_malloc(n * sizeof(double));
+ if (n > 0 && (head_r2_true == NULL || tail_r2_true == NULL)) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ };
+
+ /* First generate the real portion of A and x. */
+ BLAS_dsymv2_s_s_testgen(norm, order, uplo, n, alpha_i, alpha_flag, a1, n,
+ x_head_0, x_tail_0, beta_i, beta_flag, y1, seed,
+ head_r1_true, tail_r1_true);
+
+ /* x0 is now fixed and is input to this call */
+ BLAS_dskmv2_testgen_s_s(norm, order, uplo, n, alpha_i, beta_i, a2, n,
+ x_head_0, x_tail_0, y2, seed, head_r2_true,
+ tail_r2_true);
+
+
+ /* The case where x is a complex vector. Since x is generated
+ as a real vector, we need to perform some scaling.
+
+ There are four cases to consider, depending on the values
+ of alpha and beta.
+
+ values scaling
+ alpha beta alpha A x beta y r (truth)
+ 0 1 1 i i i
+ 1 1 ? 1+i 1+i 1+i
+ 2 ? 1 1+i 1+i 2i 2i
+ 3 ? ? 1+i 1+i 2i 2i
+
+ Note that we can afford to scale r by 1+i, since they are
+ computed in double-double precision.
+ */
+
+ if (alpha_i[0] == 1.0 && beta_i[0] == 1.0) {
+ ab = 0;
+ alpha_i[1] = beta_i[1] = 0.0; /* set alpha, beta to be 1. */
+ } else if (alpha_i[0] == 1.0) {
+ ab = 1;
+ /* set alpha to 1, multiply beta by 1+i. */
+ alpha_i[1] = 0.0;
+ beta_i[1] = beta_i[0];
+ } else if (beta_i[0] == 1.0) {
+ ab = 2;
+ /* set beta to 1, multiply alpha by 1+i. */
+ beta_i[1] = 0.0;
+ alpha_i[1] = alpha_i[0];
+ } else {
+ ab = 3;
+ /* multiply alpha by 1+i, beta by 2i. */
+ alpha_i[1] = alpha_i[0];
+ beta_i[1] = 2.0 * beta_i[0];
+ beta_i[0] = 0.0;
+ }
+
+ /* Now fill in a */
+ for (i = 0, ai = 0, a1i = 0; i < n; i++, ai += incai, a1i += inca1i) {
+ for (j = 0, aij = ai, a1ij = a1i; j < n;
+ j++, aij += incaij, a1ij += inca1ij) {
+ a_i[aij] = a1[a1ij];
+ a_i[aij + 1] = a2[a1ij];
+ }
+ }
+
+ /* Fill in x */
+ for (i = 0, xi = xi0, mi = 0; i < n; i++, xi += incxi, mi += incx0) {
+ if (ab == 0) {
+ x_head_i[xi] = 0.0;
+ x_head_i[xi + 1] = x_head_0[mi];
+ x_tail_i[xi] = 0.0;
+ x_tail_i[xi + 1] = x_tail_0[mi];
+ } else {
+ x_head_i[xi] = x_head_0[mi];
+ x_head_i[xi + 1] = x_head_0[mi];
+ x_tail_i[xi] = x_tail_0[mi];
+ x_tail_i[xi + 1] = x_tail_0[mi];
+ }
+ }
+
+ /* Fill in y */
+ for (i = 0, yi = yi0, mi = 0; i < n; i++, yi += incyi, mi += incy1) {
+ if (ab == 0) {
+ y_i[yi] = -y2[mi];
+ y_i[yi + 1] = y1[mi];
+ } else if (ab == 2) {
+ y_i[yi] = -2.0 * y2[mi];
+ y_i[yi + 1] = 2.0 * y1[mi];
+ } else {
+ y_i[yi] = y1[mi];
+ y_i[yi + 1] = y2[mi];
+ }
+ }
+
+ /* Fill in the truth */
+ for (i = 0, ri = 0, mi = 0; i < n; i++, ri += incri, mi += incmi) {
+
+ head_r_elem1 = head_r1_true[mi];
+ tail_r_elem1 = tail_r1_true[mi];
+ head_r_elem2 = head_r2_true[mi];
+ tail_r_elem2 = tail_r2_true[mi];
+
+ if (ab == 0) {
+ head_r_true[ri] = -head_r_elem2;
+ tail_r_true[ri] = -tail_r_elem2;
+ head_r_true[ri + 1] = head_r_elem1;
+ tail_r_true[ri + 1] = tail_r_elem1;
+ } else if (ab == 1) {
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_r_elem1 + head_r_elem2;
+ bv = s1 - head_r_elem1;
+ s2 = ((head_r_elem2 - bv) + (head_r_elem1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_r_elem1 + tail_r_elem2;
+ bv = t1 - tail_r_elem1;
+ t2 = ((tail_r_elem2 - bv) + (tail_r_elem1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_r_elem = t1 + t2;
+ tail_r_elem = t2 - (head_r_elem - t1);
+ }
+
+ /* Set the imaginary part to R1 + R2 */
+ tail_r_true[ri + 1] = tail_r_elem;
+ head_r_true[ri + 1] = head_r_elem;
+
+ /* Set the real part to R1 - R2. */
+ {
+ double head_bt, tail_bt;
+ head_bt = -head_r_elem2;
+ tail_bt = -tail_r_elem2;
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_r_elem1 + head_bt;
+ bv = s1 - head_r_elem1;
+ s2 = ((head_bt - bv) + (head_r_elem1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_r_elem1 + tail_bt;
+ bv = t1 - tail_r_elem1;
+ t2 = ((tail_bt - bv) + (tail_r_elem1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_r_elem = t1 + t2;
+ tail_r_elem = t2 - (head_r_elem - t1);
+ }
+ }
+ tail_r_true[ri] = tail_r_elem;
+ head_r_true[ri] = head_r_elem;
+ } else {
+ /* Real part */
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_r_elem2 * split;
+ a11 = con - head_r_elem2;
+ a11 = con - a11;
+ a21 = head_r_elem2 - a11;
+ con = -2.0 * split;
+ b1 = con - -2.0;
+ b1 = con - b1;
+ b2 = -2.0 - b1;
+
+ c11 = head_r_elem2 * -2.0;
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_r_elem2 * -2.0;
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_r_elem = t1 + t2;
+ tail_r_elem = t2 - (head_r_elem - t1);
+ }
+ head_r_true[ri] = head_r_elem;
+ tail_r_true[ri] = tail_r_elem;
+
+ /* Imaginary Part */
+ {
+ /* Compute double-double = double-double * double. */
+ double a11, a21, b1, b2, c11, c21, c2, con, t1, t2;
+
+ con = head_r_elem1 * split;
+ a11 = con - head_r_elem1;
+ a11 = con - a11;
+ a21 = head_r_elem1 - a11;
+ con = 2.0 * split;
+ b1 = con - 2.0;
+ b1 = con - b1;
+ b2 = 2.0 - b1;
+
+ c11 = head_r_elem1 * 2.0;
+ c21 = (((a11 * b1 - c11) + a11 * b2) + a21 * b1) + a21 * b2;
+
+ c2 = tail_r_elem1 * 2.0;
+ t1 = c11 + c2;
+ t2 = (c2 - (t1 - c11)) + c21;
+
+ head_r_elem = t1 + t2;
+ tail_r_elem = t2 - (head_r_elem - t1);
+ }
+ head_r_true[ri + 1] = head_r_elem;
+ tail_r_true[ri + 1] = tail_r_elem;
+ }
+ }
+
+
+ blas_free(a1);
+ blas_free(a2);
+ blas_free(y1);
+ blas_free(y2);
+ blas_free(x_head_0);
+ blas_free(x_tail_0);
+ blas_free(head_r1_true);
+ blas_free(tail_r1_true);
+ blas_free(head_r2_true);
+ blas_free(tail_r2_true);
+ blas_free(a_vec);
+ blas_free(x_head_vec);
+ blas_free(x_tail_vec);
+ }
+}
+
+void BLAS_zhemv2_z_d_testgen(int norm, enum blas_order_type order,
+ enum blas_uplo_type uplo, int n, void *alpha,
+ int alpha_flag, void *beta, int beta_flag,
+ void *a, int lda, double *x_head, double *x_tail,
+ void *y, int *seed, double *head_r_true,
+ double *tail_r_true)
+
+/*
+ * Purpose
+ * =======
+ *
+ * Generates the test inputs to BLAS_zhemv_z_d{_x}
+ *
+ * Arguments
+ * =========
+ *
+ * norm (input) int
+ * = -1: the vectors are scaled with norms near underflow.
+ * = 0: the vectors have norms of order 1.
+ * = 1: the vectors are scaled with norms near overflow.
+ *
+ * order (input) enum blas_order_type
+ * storage format of the matrices
+ *
+ * uplo (input) enum blas_uplo_type
+ * which half of the hemv2etric matrix a is to be stored.
+ *
+ * n (input) int
+ * sizes of symmetrical matrix a, size of vectors x, y:
+ * matrix a is n-by-n.
+ *
+ * alpha (input/output) void*
+ * if alpha_flag = 1, alpha is input.
+ * if alpha_flag = 0, alpha is output.
+ *
+ * alpha_flag (input) int
+ * = 0: alpha is free, and is output.
+ * = 1: alpha is fixed on input.
+ *
+ * beta (input/output) void*
+ * if beta_flag = 1, beta is input.
+ * if beta_flag = 0, beta is output.
+ *
+ * beta_flag (input) int
+ * = 0: beta is free, and is output.
+ * = 1: beta is fixed on input.
+ *
+ * a (input/output) void*
+ *
+ * lda (input) lda
+ * leading dimension of matrix A.
+ *
+ * x_head (input/output) double*
+ * x_tail (input/output) double*
+ * vector x = (x_head + x_tail)
+ *
+ * y (input/output) void*
+ * generated vector y that will be used as an input to HEMV2.
+ *
+ * seed (input/output) int *
+ * seed for the random number generator.
+ *
+ * head_r_true (output) double *
+ * the leading part of the truth in double-double.
+ *
+ * tail_r_true (output) double *
+ * the trailing part of the truth in double-double
+ *
+ */
+{
+ {
+
+ /* Strategy:
+ r1 = alpha * A1 * x + beta * y1
+ r2 = alpha * A2 * x + beta * y2
+ where all the matrices and vectors are real. Then let R = R1 + i R2,
+ A = A1 + i A2, y = y1 + i y2. To make A Hermitian, A1 is symmetric,
+ and A2 is skew-symmetric.
+ */
+
+ int i, j;
+ int yi;
+ int aij, ai;
+ int a1ij, a1i;
+ int xi;
+ int mi;
+ int incx = 1, incy = 1;
+ int incyi, xi0, yi0;
+ int incaij, incai;
+ int inca1ij, inca1i;
+ int incxi;
+ int inca_vec, incx_vec;
+ int ld;
+ int ab;
+ int ri, incri;
+
+ double *a1;
+ double *a2;
+ double *y1;
+ double *y2;
+ double *x_head_0;
+ double *x_tail_0;
+
+ double *head_r1_true, *tail_r1_true;
+ double *head_r2_true, *tail_r2_true;
+
+ double head_r_elem1, tail_r_elem1;
+ double head_r_elem2, tail_r_elem2;
+ double head_r_elem, tail_r_elem;
+
+ double *a_vec;
+ double *x_head_vec;
+ double *x_tail_vec;
+
+ double *y_i = (double *) y;
+ double *alpha_i = (double *) alpha;
+ double *beta_i = (double *) beta;
+
+ double *a_i = (double *) a;
+ double *x_head_i = x_head;
+ double *x_tail_i = x_tail;
+
+ ld = n;
+ if (order == blas_colmajor) {
+ inca1i = incai = 1;
+ incyi = incy;
+ incaij = lda;
+ incxi = incx;
+ inca1ij = n;
+ } else {
+ incyi = incy;
+ incai = lda;
+ incxi = incx;
+ inca1i = n;
+ inca1ij = incaij = 1;
+ }
+ xi0 = (incx > 0) ? 0 : -(n - 1) * incx;
+ yi0 = (incy > 0) ? 0 : -(n - 1) * incy;
+ incri = 1;
+ incri *= 2;
+
+ yi0 *= 2;
+ incyi *= 2;
+ incai *= 2;
+ incaij *= 2;
+
+
+ inca_vec = incx_vec = 1;
+ inca_vec *= 2;
+
+ a_vec = (double *) blas_malloc(n * sizeof(double) * 2);
+ if (n > 0 && a_vec == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ x_head_vec = (double *) blas_malloc(n * sizeof(double));
+ if (n > 0 && x_head_vec == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ x_tail_vec = (double *) blas_malloc(n * sizeof(double));
+ if (n > 0 && x_tail_vec == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+
+ int incx0, incy1, incy2, incmi = 1;
+ a1 = (double *) blas_malloc(n * n * sizeof(double));
+ if (n * n > 0 && a1 == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ a2 = (double *) blas_malloc(n * n * sizeof(double));
+ if (n * n > 0 && a2 == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ y1 = (double *) blas_malloc(n * sizeof(double));
+ if (n > 0 && y1 == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ incy1 = 1;
+
+ y2 = (double *) blas_malloc(n * sizeof(double));
+ if (n > 0 && y2 == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ incy2 = 1;
+
+ x_head_0 = (double *) blas_malloc(n * sizeof(double));
+ if (n > 0 && x_head_0 == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ x_tail_0 = (double *) blas_malloc(n * sizeof(double));
+ if (n > 0 && x_tail_0 == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ incx0 = 1;
+
+ head_r1_true = (double *) blas_malloc(n * sizeof(double));
+ tail_r1_true = (double *) blas_malloc(n * sizeof(double));
+ if (n > 0 && (head_r1_true == NULL || tail_r1_true == NULL)) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ };
+ head_r2_true = (double *) blas_malloc(n * sizeof(double));
+ tail_r2_true = (double *) blas_malloc(n * sizeof(double));
+ if (n > 0 && (head_r2_true == NULL || tail_r2_true == NULL)) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ };
+
+ /* First generate the real portion of A and x. */
+ BLAS_dsymv2_testgen(norm, order, uplo, n, alpha_i, alpha_flag, a1, n,
+ x_head_0, x_tail_0, beta_i, beta_flag, y1, seed,
+ head_r1_true, tail_r1_true);
+
+ /* x0 is now fixed and is input to this call */
+ BLAS_dskmv2_testgen(norm, order, uplo, n, alpha_i, beta_i, a2, n,
+ x_head_0, x_tail_0, y2, seed, head_r2_true,
+ tail_r2_true);
+
+
+ /* The case where x is a real vector.
+
+ There are four cases to consider, depending on the
+ values of alpha and beta.
+
+ values scaling
+ alpha beta alpha A x beta y r (truth)
+ 0 1 1
+ 1 1 ? -i i
+ 2 ? 1 i i i
+ 3 ? ? 1+i 1+i 1+i
+
+ Note that we can afford to scale truth by (1+i) since they
+ are computed in double-double.
+ */
+
+ if (alpha_i[0] == 1.0 && beta_i[0] == 1.0) {
+ ab = 0;
+ alpha_i[1] = beta_i[1] = 0.0; /* set alpha, beta to be 1. */
+ } else if (alpha_i[0] == 1.0) {
+ ab = 1;
+ /* set alpha to 1, multiply beta by -i. */
+ alpha_i[1] = 0.0;
+ beta_i[1] = -beta_i[0];
+ beta_i[0] = 0.0;
+ } else if (beta_i[0] == 1.0) {
+ ab = 2;
+ /* set beta to 1, multiply alpha by i. */
+ beta_i[1] = 0.0;
+ alpha_i[1] = alpha_i[0];
+ alpha_i[0] = 0.0;
+ } else {
+ ab = 3;
+ /* multiply alpha, beta by (1 + i). */
+ alpha_i[1] = alpha_i[0];
+ beta_i[1] = beta_i[0];
+ }
+
+ /* Now fill in a */
+ for (i = 0, ai = 0, a1i = 0; i < n; i++, ai += incai, a1i += inca1i) {
+ for (j = 0, aij = ai, a1ij = a1i; j < n;
+ j++, aij += incaij, a1ij += inca1ij) {
+ a_i[aij] = a1[a1ij];
+ a_i[aij + 1] = a2[a1ij];
+ }
+ }
+
+ /* Fill in x */
+ for (i = 0, xi = xi0, mi = 0; i < n; i++, xi += incxi, mi += incx0) {
+ x_head_i[xi] = x_head_0[mi];
+ x_tail_i[xi] = x_tail_0[mi];
+ }
+
+ /* Fill in y */
+ for (i = 0, yi = yi0, mi = 0; i < n; i++, yi += incyi, mi += incy1) {
+ if (ab == 1 || ab == 2) {
+ y_i[yi] = -y2[mi];
+ y_i[yi + 1] = y1[mi];
+ } else {
+ y_i[yi] = y1[mi];
+ y_i[yi + 1] = y2[mi];
+ }
+ }
+
+ /* Fill in truth */
+ for (i = 0, ri = 0, mi = 0; i < n; i++, ri += incri, mi += incmi) {
+ if (ab == 0 || ab == 1) {
+ head_r_true[ri] = head_r1_true[mi];
+ tail_r_true[ri] = tail_r1_true[mi];
+ head_r_true[ri + 1] = head_r2_true[mi];
+ tail_r_true[ri + 1] = tail_r2_true[mi];
+ } else if (ab == 2) {
+ head_r_true[ri] = -head_r2_true[mi];
+ tail_r_true[ri] = -tail_r2_true[mi];
+ head_r_true[ri + 1] = head_r1_true[mi];
+ tail_r_true[ri + 1] = tail_r1_true[mi];
+ } else {
+ head_r_elem1 = head_r1_true[mi];
+ tail_r_elem1 = tail_r1_true[mi];
+
+ head_r_elem2 = head_r2_true[mi];
+ tail_r_elem2 = tail_r2_true[mi];
+
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_r_elem1 + head_r_elem2;
+ bv = s1 - head_r_elem1;
+ s2 = ((head_r_elem2 - bv) + (head_r_elem1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_r_elem1 + tail_r_elem2;
+ bv = t1 - tail_r_elem1;
+ t2 = ((tail_r_elem2 - bv) + (tail_r_elem1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_r_elem = t1 + t2;
+ tail_r_elem = t2 - (head_r_elem - t1);
+ }
+
+ /* Set the imaginary part to r1 + r2 */
+ tail_r_true[ri + 1] = tail_r_elem;
+ head_r_true[ri + 1] = head_r_elem;
+
+ /* Set the real part to r1 - r2. */
+ {
+ double head_bt, tail_bt;
+ head_bt = -head_r_elem2;
+ tail_bt = -tail_r_elem2;
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_r_elem1 + head_bt;
+ bv = s1 - head_r_elem1;
+ s2 = ((head_bt - bv) + (head_r_elem1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_r_elem1 + tail_bt;
+ bv = t1 - tail_r_elem1;
+ t2 = ((tail_bt - bv) + (tail_r_elem1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_r_elem = t1 + t2;
+ tail_r_elem = t2 - (head_r_elem - t1);
+ }
+ }
+ tail_r_true[ri] = tail_r_elem;
+ head_r_true[ri] = head_r_elem;
+ }
+ }
+
+
+ blas_free(a1);
+ blas_free(a2);
+ blas_free(y1);
+ blas_free(y2);
+ blas_free(x_head_0);
+ blas_free(x_tail_0);
+ blas_free(head_r1_true);
+ blas_free(tail_r1_true);
+ blas_free(head_r2_true);
+ blas_free(tail_r2_true);
+ blas_free(a_vec);
+ blas_free(x_head_vec);
+ blas_free(x_tail_vec);
+ }
+}
+
+void BLAS_chemv2_c_s_testgen(int norm, enum blas_order_type order,
+ enum blas_uplo_type uplo, int n, void *alpha,
+ int alpha_flag, void *beta, int beta_flag,
+ void *a, int lda, float *x_head, float *x_tail,
+ void *y, int *seed, double *head_r_true,
+ double *tail_r_true)
+
+/*
+ * Purpose
+ * =======
+ *
+ * Generates the test inputs to BLAS_chemv_c_s{_x}
+ *
+ * Arguments
+ * =========
+ *
+ * norm (input) int
+ * = -1: the vectors are scaled with norms near underflow.
+ * = 0: the vectors have norms of order 1.
+ * = 1: the vectors are scaled with norms near overflow.
+ *
+ * order (input) enum blas_order_type
+ * storage format of the matrices
+ *
+ * uplo (input) enum blas_uplo_type
+ * which half of the hemv2etric matrix a is to be stored.
+ *
+ * n (input) int
+ * sizes of symmetrical matrix a, size of vectors x, y:
+ * matrix a is n-by-n.
+ *
+ * alpha (input/output) void*
+ * if alpha_flag = 1, alpha is input.
+ * if alpha_flag = 0, alpha is output.
+ *
+ * alpha_flag (input) int
+ * = 0: alpha is free, and is output.
+ * = 1: alpha is fixed on input.
+ *
+ * beta (input/output) void*
+ * if beta_flag = 1, beta is input.
+ * if beta_flag = 0, beta is output.
+ *
+ * beta_flag (input) int
+ * = 0: beta is free, and is output.
+ * = 1: beta is fixed on input.
+ *
+ * a (input/output) void*
+ *
+ * lda (input) lda
+ * leading dimension of matrix A.
+ *
+ * x_head (input/output) float*
+ * x_tail (input/output) float*
+ * vector x = (x_head + x_tail)
+ *
+ * y (input/output) void*
+ * generated vector y that will be used as an input to HEMV2.
+ *
+ * seed (input/output) int *
+ * seed for the random number generator.
+ *
+ * head_r_true (output) double *
+ * the leading part of the truth in double-double.
+ *
+ * tail_r_true (output) double *
+ * the trailing part of the truth in double-double
+ *
+ */
+{
+ {
+
+ /* Strategy:
+ r1 = alpha * A1 * x + beta * y1
+ r2 = alpha * A2 * x + beta * y2
+ where all the matrices and vectors are real. Then let R = R1 + i R2,
+ A = A1 + i A2, y = y1 + i y2. To make A Hermitian, A1 is symmetric,
+ and A2 is skew-symmetric.
+ */
+
+ int i, j;
+ int yi;
+ int aij, ai;
+ int a1ij, a1i;
+ int xi;
+ int mi;
+ int incx = 1, incy = 1;
+ int incyi, xi0, yi0;
+ int incaij, incai;
+ int inca1ij, inca1i;
+ int incxi;
+ int inca_vec, incx_vec;
+ int ld;
+ int ab;
+ int ri, incri;
+
+ float *a1;
+ float *a2;
+ float *y1;
+ float *y2;
+ float *x_head_0;
+ float *x_tail_0;
+
+ double *head_r1_true, *tail_r1_true;
+ double *head_r2_true, *tail_r2_true;
+
+ double head_r_elem1, tail_r_elem1;
+ double head_r_elem2, tail_r_elem2;
+ double head_r_elem, tail_r_elem;
+
+ float *a_vec;
+ float *x_head_vec;
+ float *x_tail_vec;
+
+ float *y_i = (float *) y;
+ float *alpha_i = (float *) alpha;
+ float *beta_i = (float *) beta;
+
+ float *a_i = (float *) a;
+ float *x_head_i = x_head;
+ float *x_tail_i = x_tail;
+
+ ld = n;
+ if (order == blas_colmajor) {
+ inca1i = incai = 1;
+ incyi = incy;
+ incaij = lda;
+ incxi = incx;
+ inca1ij = n;
+ } else {
+ incyi = incy;
+ incai = lda;
+ incxi = incx;
+ inca1i = n;
+ inca1ij = incaij = 1;
+ }
+ xi0 = (incx > 0) ? 0 : -(n - 1) * incx;
+ yi0 = (incy > 0) ? 0 : -(n - 1) * incy;
+ incri = 1;
+ incri *= 2;
+
+ yi0 *= 2;
+ incyi *= 2;
+ incai *= 2;
+ incaij *= 2;
+
+
+ inca_vec = incx_vec = 1;
+ inca_vec *= 2;
+
+ a_vec = (float *) blas_malloc(n * sizeof(float) * 2);
+ if (n > 0 && a_vec == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ x_head_vec = (float *) blas_malloc(n * sizeof(float));
+ if (n > 0 && x_head_vec == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ x_tail_vec = (float *) blas_malloc(n * sizeof(float));
+ if (n > 0 && x_tail_vec == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+
+ int incx0, incy1, incy2, incmi = 1;
+ a1 = (float *) blas_malloc(n * n * sizeof(float));
+ if (n * n > 0 && a1 == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ a2 = (float *) blas_malloc(n * n * sizeof(float));
+ if (n * n > 0 && a2 == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ y1 = (float *) blas_malloc(n * sizeof(float));
+ if (n > 0 && y1 == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ incy1 = 1;
+
+ y2 = (float *) blas_malloc(n * sizeof(float));
+ if (n > 0 && y2 == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ incy2 = 1;
+
+ x_head_0 = (float *) blas_malloc(n * sizeof(float));
+ if (n > 0 && x_head_0 == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ x_tail_0 = (float *) blas_malloc(n * sizeof(float));
+ if (n > 0 && x_tail_0 == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ incx0 = 1;
+
+ head_r1_true = (double *) blas_malloc(n * sizeof(double));
+ tail_r1_true = (double *) blas_malloc(n * sizeof(double));
+ if (n > 0 && (head_r1_true == NULL || tail_r1_true == NULL)) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ };
+ head_r2_true = (double *) blas_malloc(n * sizeof(double));
+ tail_r2_true = (double *) blas_malloc(n * sizeof(double));
+ if (n > 0 && (head_r2_true == NULL || tail_r2_true == NULL)) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ };
+
+ /* First generate the real portion of A and x. */
+ BLAS_ssymv2_testgen(norm, order, uplo, n, alpha_i, alpha_flag, a1, n,
+ x_head_0, x_tail_0, beta_i, beta_flag, y1, seed,
+ head_r1_true, tail_r1_true);
+
+ /* x0 is now fixed and is input to this call */
+ BLAS_sskmv2_testgen(norm, order, uplo, n, alpha_i, beta_i, a2, n,
+ x_head_0, x_tail_0, y2, seed, head_r2_true,
+ tail_r2_true);
+
+
+ /* The case where x is a real vector.
+
+ There are four cases to consider, depending on the
+ values of alpha and beta.
+
+ values scaling
+ alpha beta alpha A x beta y r (truth)
+ 0 1 1
+ 1 1 ? -i i
+ 2 ? 1 i i i
+ 3 ? ? 1+i 1+i 1+i
+
+ Note that we can afford to scale truth by (1+i) since they
+ are computed in double-double.
+ */
+
+ if (alpha_i[0] == 1.0 && beta_i[0] == 1.0) {
+ ab = 0;
+ alpha_i[1] = beta_i[1] = 0.0; /* set alpha, beta to be 1. */
+ } else if (alpha_i[0] == 1.0) {
+ ab = 1;
+ /* set alpha to 1, multiply beta by -i. */
+ alpha_i[1] = 0.0;
+ beta_i[1] = -beta_i[0];
+ beta_i[0] = 0.0;
+ } else if (beta_i[0] == 1.0) {
+ ab = 2;
+ /* set beta to 1, multiply alpha by i. */
+ beta_i[1] = 0.0;
+ alpha_i[1] = alpha_i[0];
+ alpha_i[0] = 0.0;
+ } else {
+ ab = 3;
+ /* multiply alpha, beta by (1 + i). */
+ alpha_i[1] = alpha_i[0];
+ beta_i[1] = beta_i[0];
+ }
+
+ /* Now fill in a */
+ for (i = 0, ai = 0, a1i = 0; i < n; i++, ai += incai, a1i += inca1i) {
+ for (j = 0, aij = ai, a1ij = a1i; j < n;
+ j++, aij += incaij, a1ij += inca1ij) {
+ a_i[aij] = a1[a1ij];
+ a_i[aij + 1] = a2[a1ij];
+ }
+ }
+
+ /* Fill in x */
+ for (i = 0, xi = xi0, mi = 0; i < n; i++, xi += incxi, mi += incx0) {
+ x_head_i[xi] = x_head_0[mi];
+ x_tail_i[xi] = x_tail_0[mi];
+ }
+
+ /* Fill in y */
+ for (i = 0, yi = yi0, mi = 0; i < n; i++, yi += incyi, mi += incy1) {
+ if (ab == 1 || ab == 2) {
+ y_i[yi] = -y2[mi];
+ y_i[yi + 1] = y1[mi];
+ } else {
+ y_i[yi] = y1[mi];
+ y_i[yi + 1] = y2[mi];
+ }
+ }
+
+ /* Fill in truth */
+ for (i = 0, ri = 0, mi = 0; i < n; i++, ri += incri, mi += incmi) {
+ if (ab == 0 || ab == 1) {
+ head_r_true[ri] = head_r1_true[mi];
+ tail_r_true[ri] = tail_r1_true[mi];
+ head_r_true[ri + 1] = head_r2_true[mi];
+ tail_r_true[ri + 1] = tail_r2_true[mi];
+ } else if (ab == 2) {
+ head_r_true[ri] = -head_r2_true[mi];
+ tail_r_true[ri] = -tail_r2_true[mi];
+ head_r_true[ri + 1] = head_r1_true[mi];
+ tail_r_true[ri + 1] = tail_r1_true[mi];
+ } else {
+ head_r_elem1 = head_r1_true[mi];
+ tail_r_elem1 = tail_r1_true[mi];
+
+ head_r_elem2 = head_r2_true[mi];
+ tail_r_elem2 = tail_r2_true[mi];
+
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_r_elem1 + head_r_elem2;
+ bv = s1 - head_r_elem1;
+ s2 = ((head_r_elem2 - bv) + (head_r_elem1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_r_elem1 + tail_r_elem2;
+ bv = t1 - tail_r_elem1;
+ t2 = ((tail_r_elem2 - bv) + (tail_r_elem1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_r_elem = t1 + t2;
+ tail_r_elem = t2 - (head_r_elem - t1);
+ }
+
+ /* Set the imaginary part to r1 + r2 */
+ tail_r_true[ri + 1] = tail_r_elem;
+ head_r_true[ri + 1] = head_r_elem;
+
+ /* Set the real part to r1 - r2. */
+ {
+ double head_bt, tail_bt;
+ head_bt = -head_r_elem2;
+ tail_bt = -tail_r_elem2;
+ {
+ /* Compute double-double = double-double + double-double. */
+ double bv;
+ double s1, s2, t1, t2;
+
+ /* Add two hi words. */
+ s1 = head_r_elem1 + head_bt;
+ bv = s1 - head_r_elem1;
+ s2 = ((head_bt - bv) + (head_r_elem1 - (s1 - bv)));
+
+ /* Add two lo words. */
+ t1 = tail_r_elem1 + tail_bt;
+ bv = t1 - tail_r_elem1;
+ t2 = ((tail_bt - bv) + (tail_r_elem1 - (t1 - bv)));
+
+ s2 += t1;
+
+ /* Renormalize (s1, s2) to (t1, s2) */
+ t1 = s1 + s2;
+ s2 = s2 - (t1 - s1);
+
+ t2 += s2;
+
+ /* Renormalize (t1, t2) */
+ head_r_elem = t1 + t2;
+ tail_r_elem = t2 - (head_r_elem - t1);
+ }
+ }
+ tail_r_true[ri] = tail_r_elem;
+ head_r_true[ri] = head_r_elem;
+ }
+ }
+
+
+ blas_free(a1);
+ blas_free(a2);
+ blas_free(y1);
+ blas_free(y2);
+ blas_free(x_head_0);
+ blas_free(x_tail_0);
+ blas_free(head_r1_true);
+ blas_free(tail_r1_true);
+ blas_free(head_r2_true);
+ blas_free(tail_r2_true);
+ blas_free(a_vec);
+ blas_free(x_head_vec);
+ blas_free(x_tail_vec);
+ }
+}
--- /dev/null
+include ../../make.conf
+include ../../$(MAKEINC)
+
+TEST_DOT_PATH = ../test-dot
+TEST_DOT2_PATH = ../test-dot2
+TEST_HEMV_PATH = ../test-hemv
+TEST_SYMV_PATH = ../test-symv
+TEST_SYMV2_PATH = ../test-symv2
+LIB_PATH = ../../$(OUTPUT_DIR)
+HEADER_PATH = -I../../src -I..
+
+TEST_DOT_OBJS = $(TEST_DOT_PATH)/testgen_aux.o \
+ $(TEST_DOT_PATH)/print_vector.o \
+ $(TEST_DOT_PATH)/copy_vector.o
+TEST_DOT2_OBJS = $(TEST_DOT2_PATH)/dot2.o \
+ $(TEST_DOT2_PATH)/testgen_BLAS_sdot2.o \
+ $(TEST_DOT2_PATH)/testgen_BLAS_ddot2.o \
+ $(TEST_DOT2_PATH)/testgen_BLAS_cdot2.o \
+ $(TEST_DOT2_PATH)/testgen_BLAS_zdot2.o \
+ $(TEST_DOT2_PATH)/test_dot2.o \
+ $(TEST_DOT2_PATH)/r_truth2.o \
+ $(TEST_DOT2_PATH)/BLAS_dot2_testgen.o
+TEST_HEMV_OBJS = $(TEST_HEMV_PATH)/hemv-support.o
+TEST_SYMV_OBJS = $(TEST_SYMV_PATH)/symv-support.o
+TEST_SYMV2_OBJS = $(TEST_SYMV2_PATH)/BLAS_symv2_testgen.o
+
+TEST_SRCS = do_test_hemv2.c BLAS_hemv2_testgen.c
+TEST_OBJS = $(TEST_SRCS:.c=.o)
+COMMON_OBJS = ../common/dummy_main.o
+
+ALL_OBJS = $(TEST_OBJS) $(TEST_DOT_OBJS) $(TEST_DOT2_OBJS) \
+ $(TEST_HEMV_OBJS) $(TEST_SYMV_OBJS) $(TEST_SYMV2_OBJS) \
+ $(COMMON_OBJS)
+
+test: do_test_hemv2
+ @echo Testing HEMV2 - default test
+ ./do_test_hemv2 7 1 1.0 0 0.1 > hemv2.results
+
+do_test_hemv2: $(LIB_PATH)/$(XBLASLIB) $(ALL_OBJS)
+ $(LINKER) $(LDFLAGS) $(ALL_OBJS) $(LIB_PATH)/$(XBLASLIB) \
+ -o do_test_hemv2 $(EXTRA_LIBS)
+
+.c.o:
+ $(CC) $(CFLAGS) $(HEADER_PATH) -c -o $@ $<
+
+clean:
+ rm -f *.o *~ *.BAK hemv2.results do_test_hemv2 core
+
--- /dev/null
+#include <stdlib.h>
+#include <stdio.h>
+#include <math.h>
+#include "blas_extended.h"
+#include "blas_extended_private.h"
+#include "blas_extended_test.h"
+
+/* 0 -- 1 */
+#define UPLO_START 0
+#define UPLO_END 1
+
+/* 0 -- 1 */
+#define ORDER_START 0
+#define ORDER_END 1
+
+/* 0 -- 2 */
+#define ALPHA_START 0
+#define ALPHA_END 2
+
+/* 0 -- 2 */
+#define BETA_START 0
+#define BETA_END 2
+
+/* -1 -- 1 */
+#define NORM_START -1
+#define NORM_END 1
+
+/* 0 -- 2 */
+#define LDA_START 0
+#define LDA_END 2
+
+/* 0 -- 2 */
+#define PREC_START 0
+#define PREC_END 2
+
+/* 0 -- 1 */
+#define RANDOMIZE_START 0
+#define RANDOMIZE_END 1
+
+/* -2 -- 2 (Stride) */
+#define INCX_START -2
+#define INCX_END 2
+
+/* -2 -- 2 (Stride) */
+#define INCY_START -2
+#define INCY_END 2
+
+#define NUM_DATA 7
+
+
+
+
+
+
+
+
+
+
+void do_test_zhemv2_z_c
+ (int n,
+ int ntests, int *seed, double thresh, int debug, float test_prob,
+ double *min_ratio, double *max_ratio, int *num_bad_ratio, int *num_tests) {
+
+ /* Function name */
+ const char fname[] = "do_test_zhemv2_z_c";
+ int i;
+ int yi;
+ int incyi, yi0;
+ int test_count;
+ int bad_ratio_count;
+ int ri;
+ int incri = 1;
+ int incx, incy;
+ double ratio;
+ double ratio_min, ratio_max;
+ double eps_int; /* internal machine epsilon */
+ double un_int; /* internal underflow threshold */
+
+ double rin[2];
+ double rout[2];
+ double head_r_true_elem[2], tail_r_true_elem[2];
+
+ enum blas_order_type order_type;
+ enum blas_uplo_type uplo_type;
+ enum blas_prec_type prec;
+
+ int order_val, uplo_val;
+ int lda_val, incx_val, incy_val;
+ int alpha_val, beta_val;
+
+
+
+ int lda;
+ int alpha_flag, beta_flag;
+ int saved_seed;
+ int norm;
+ int test_no;
+
+ double alpha[2];
+ double beta[2];
+ double *a;
+ float *head_x;
+ float *tail_x;
+ double *y;
+ double *a_vec;
+ double *y_gen;
+ float *head_x_gen;
+ float *tail_x_gen;
+ double *ratios;
+
+ /* true result calculated by testgen, in double-double */
+ double *head_r_true, *tail_r_true;
+
+
+ FPU_FIX_DECL;
+
+ if (n < 0)
+ BLAS_error(fname, -1, n, NULL);
+ if (ntests < 0)
+ BLAS_error(fname, -2, ntests, NULL);
+
+ /* initialization */
+ saved_seed = *seed;
+ ratio = 0.0;
+ ratio_min = 1e308;
+ ratio_max = 0.0;
+
+ *num_tests = 0;
+ *num_bad_ratio = 0;
+ *min_ratio = 0.0;
+ *max_ratio = 0.0;
+
+ if (n == 0)
+ return;
+ incri *= 2;
+
+ FPU_FIX_START;
+
+ y = (double *) blas_malloc(2 * n * sizeof(double) * 2);
+ if (2 * n > 0 && y == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ y_gen = (double *) blas_malloc(n * sizeof(double) * 2);
+ if (n > 0 && y_gen == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ head_x_gen = (float *) blas_malloc(n * sizeof(float) * 2);
+ if (n > 0 && head_x_gen == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ tail_x_gen = (float *) blas_malloc(n * sizeof(float) * 2);
+ if (n > 0 && tail_x_gen == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ a = (double *) blas_malloc(2 * n * n * sizeof(double) * 2);
+ if (2 * n * n > 0 && a == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ head_x = (float *) blas_malloc(2 * n * sizeof(float) * 2);
+ if (2 * n > 0 && head_x == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ tail_x = (float *) blas_malloc(2 * n * sizeof(float) * 2);
+ if (2 * n > 0 && tail_x == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ a_vec = (double *) blas_malloc(n * sizeof(double) * 2);
+ if (n > 0 && a_vec == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ head_r_true = (double *) blas_malloc(n * sizeof(double) * 2);
+ tail_r_true = (double *) blas_malloc(n * sizeof(double) * 2);
+ if (n > 0 && (head_r_true == NULL || tail_r_true == NULL)) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ ratios = (double *) blas_malloc(n * sizeof(double));
+ if (n > 0 && ratios == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+
+ test_count = 0;
+ bad_ratio_count = 0;
+
+ /* vary alpha */
+ for (alpha_val = ALPHA_START; alpha_val <= ALPHA_END; alpha_val++) {
+
+ alpha_flag = 0;
+ switch (alpha_val) {
+ case 0:
+ alpha[0] = alpha[1] = 0.0;
+ alpha_flag = 1;
+ break;
+ case 1:
+ alpha[0] = 1.0;
+ alpha[1] = 0.0;
+ alpha_flag = 1;
+ break;
+ }
+
+ /* vary beta */
+ for (beta_val = BETA_START; beta_val <= BETA_END; beta_val++) {
+ beta_flag = 0;
+ switch (beta_val) {
+ case 0:
+ beta[0] = beta[1] = 0.0;
+ beta_flag = 1;
+ break;
+ case 1:
+ beta[0] = 1.0;
+ beta[1] = 0.0;
+ beta_flag = 1;
+ break;
+ }
+
+
+ eps_int = power(2, -BITS_D);
+ un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
+ (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
+ prec = blas_prec_double;
+
+ /* vary norm -- underflow, approx 1, overflow */
+ for (norm = NORM_START; norm <= NORM_END; norm++) {
+
+ /* number of tests */
+ for (test_no = 0; test_no < ntests; test_no++) {
+
+ /* vary storage format */
+ for (order_val = ORDER_START; order_val <= ORDER_END; order_val++) {
+
+ order_type = (order_val == 0) ? blas_colmajor : blas_rowmajor;
+
+ /* vary upper / lower variation */
+ for (uplo_val = UPLO_START; uplo_val <= UPLO_END; uplo_val++) {
+
+ uplo_type = (uplo_val == 0) ? blas_upper : blas_lower;
+
+ /* vary lda = n, n+1, 2*n */
+ for (lda_val = LDA_START; lda_val <= LDA_END; lda_val++) {
+
+ lda = (lda_val == 0) ? n : (lda_val == 1) ? n + 1 : 2 * n;
+
+ saved_seed = *seed;
+ /* For the sake of speed, we throw out this case at random */
+ if (xrand(seed) >= test_prob)
+ continue;
+
+ alpha_flag = 0;
+ switch (alpha_val) {
+ case 0:
+ alpha[0] = alpha[1] = 0.0;
+ alpha_flag = 1;
+ break;
+ case 1:
+ alpha[0] = 1.0;
+ alpha[1] = 0.0;
+ alpha_flag = 1;
+ break;
+ }
+ beta_flag = 0;
+ switch (beta_val) {
+ case 0:
+ beta[0] = beta[1] = 0.0;
+ beta_flag = 1;
+ break;
+ case 1:
+ beta[0] = 1.0;
+ beta[1] = 0.0;
+ beta_flag = 1;
+ break;
+ }
+
+ /* finally we are here to generate the test case */
+ BLAS_zhemv2_z_c_testgen(norm, order_type,
+ uplo_type, n, &alpha, alpha_flag,
+ &beta, beta_flag, a, lda, head_x_gen,
+ tail_x_gen, y_gen, seed, head_r_true,
+ tail_r_true);
+ test_count++;
+
+ /* vary incx = -2, -1, 1, 2 */
+ for (incx_val = INCX_START; incx_val <= INCX_END; incx_val++) {
+
+ incx = incx_val;
+ if (0 == incx)
+ continue;
+
+ /* vary incy = -2, -1, 1, 2 */
+ for (incy_val = INCY_START; incy_val <= INCY_END;
+ incy_val++) {
+
+ incy = incy_val;
+ if (0 == incy)
+ continue;
+
+ /* copy generated vector with appropriate incs. */
+ zcopy_vector(y_gen, n, 1, y, incy);
+ ccopy_vector(head_x_gen, n, 1, head_x, incx);
+ ccopy_vector(tail_x_gen, n, 1, tail_x, incx);
+
+ /* call hemv2 routines to be tested */
+ FPU_FIX_STOP;
+ BLAS_zhemv2_z_c(order_type,
+ uplo_type, n, alpha, a, lda, head_x,
+ tail_x, incx, beta, y, incy);
+ FPU_FIX_START;
+
+ /* now compute the ratio using test_BLAS_xdot */
+ /* copy a row from A, use x, run dot test */
+
+ incyi = incy;
+ incyi *= 2;
+ yi0 = (incy > 0) ? 0 : (-n + 1) * incyi;
+
+ for (i = 0, yi = yi0, ri = 0;
+ i < n; i++, yi += incyi, ri += incri) {
+ zhe_copy_row(order_type, uplo_type, blas_left_side,
+ n, a, lda, a_vec, i);
+
+ /* just use the x vector - it was unchanged (in theory) */
+ rin[0] = y_gen[i];
+ rin[1] = y_gen[i + 1];
+ rout[0] = y[yi];
+ rout[1] = y[yi + 1];
+ head_r_true_elem[0] = head_r_true[ri];
+ head_r_true_elem[1] = head_r_true[ri + 1];
+ tail_r_true_elem[0] = tail_r_true[ri];
+ tail_r_true_elem[1] = tail_r_true[ri + 1];
+
+ test_BLAS_zdot2_z_c(n, blas_no_conj, alpha, beta,
+ rin, rout, head_r_true_elem,
+ tail_r_true_elem, a_vec, 1, head_x,
+ tail_x, incx, eps_int, un_int,
+ &ratios[i]);
+
+ /* take the max ratio */
+ if (i == 0) {
+ ratio = ratios[0];
+
+ /* The !<= below causes NaN errors to be included.
+ * Note that (NaN > 0) is false */
+ } else if (!(ratios[i] <= ratio)) {
+ ratio = ratios[i];
+ }
+
+ } /* end of dot-test loop */
+
+
+ /* The !<= below causes NaN errors to be included.
+ * Note that (NaN > 0) is false */
+ if (!(ratio <= thresh)) {
+
+ if (debug == 3) {
+ printf("\n\t\tTest # %d\n", test_count);
+ printf("y type : z, a type : z, x type : c\n");
+ printf("Seed = %d\t", saved_seed);
+ printf("n %d\n", n);
+ printf("LDA %d INCX %d INCY %d\n", lda, incx, incx);
+
+ if (order_type == blas_rowmajor)
+ printf("row ");
+ else
+ printf("col ");
+
+ if (uplo_type == blas_upper)
+ printf("upper ");
+ else
+ printf("lower ");
+
+ printf("NORM %d, ALPHA %d, BETA %d\n",
+ norm, alpha_val, beta_val);
+
+ /* print out info */
+ printf("alpha = ");
+ printf("(%24.16e, %24.16e)", alpha[0], alpha[1]);;
+ printf(" ");
+ printf("beta = ");
+ printf("(%24.16e, %24.16e)", beta[0], beta[1]);;
+ printf("\n");
+
+ printf("a\n");
+ zhe_print_matrix(a, n, lda, order_type, uplo_type);
+ cprint_vector(head_x, n, incx, "head_x");
+ cprint_vector(tail_x, n, incx, "tail_x");
+ zprint_vector(y_gen, n, incy, "y_gen");
+ zprint_vector(y, n, incy, "y");
+ zprint_vector(head_r_true, n, 1, "head_r_true");
+ dprint_vector(ratios, n, 1, "ratios");
+ printf("ratio = %g\n", ratio);
+ }
+ bad_ratio_count++;
+ if (bad_ratio_count >= MAX_BAD_TESTS) {
+ printf("\ntoo many failures, exiting....");
+ printf("\nTesting and compilation");
+ printf(" are incomplete\n\n");
+ goto end;
+ }
+ if (!(ratio <= TOTAL_FAILURE_THRESHOLD)) {
+ printf("\nFlagrant ratio error, exiting...");
+ printf("\nTesting and compilation");
+ printf(" are incomplete\n\n");
+ goto end;
+ }
+ }
+
+ if (!(ratio <= ratio_max))
+ ratio_max = ratio;
+ if (ratio != 0.0 && !(ratio >= ratio_min))
+ ratio_min = ratio;
+
+ } /* end of incy loop */
+
+ } /* end of incx loop */
+
+ } /* end of lda loop */
+
+ } /* end of uplo loop */
+
+ } /* end of order loop */
+
+ } /* end of nr test loop */
+
+ } /* end of norm loop */
+
+
+
+ } /* end of beta loop */
+
+ } /* end of alpha loop */
+
+end:
+ FPU_FIX_STOP;
+
+ blas_free(y);
+ blas_free(a);
+ blas_free(y_gen);
+ blas_free(head_x);
+ blas_free(tail_x);
+ blas_free(head_x_gen);
+ blas_free(tail_x_gen);
+ blas_free(head_r_true);
+ blas_free(tail_r_true);
+ blas_free(ratios);
+ blas_free(a_vec);
+
+ *max_ratio = ratio_max;
+ *min_ratio = ratio_min;
+ *num_tests = test_count;
+ *num_bad_ratio = bad_ratio_count;
+
+}
+void do_test_zhemv2_c_z
+ (int n,
+ int ntests, int *seed, double thresh, int debug, float test_prob,
+ double *min_ratio, double *max_ratio, int *num_bad_ratio, int *num_tests) {
+
+ /* Function name */
+ const char fname[] = "do_test_zhemv2_c_z";
+ int i;
+ int yi;
+ int incyi, yi0;
+ int test_count;
+ int bad_ratio_count;
+ int ri;
+ int incri = 1;
+ int incx, incy;
+ double ratio;
+ double ratio_min, ratio_max;
+ double eps_int; /* internal machine epsilon */
+ double un_int; /* internal underflow threshold */
+
+ double rin[2];
+ double rout[2];
+ double head_r_true_elem[2], tail_r_true_elem[2];
+
+ enum blas_order_type order_type;
+ enum blas_uplo_type uplo_type;
+ enum blas_prec_type prec;
+
+ int order_val, uplo_val;
+ int lda_val, incx_val, incy_val;
+ int alpha_val, beta_val;
+
+
+
+ int lda;
+ int alpha_flag, beta_flag;
+ int saved_seed;
+ int norm;
+ int test_no;
+
+ double alpha[2];
+ double beta[2];
+ float *a;
+ double *head_x;
+ double *tail_x;
+ double *y;
+ float *a_vec;
+ double *y_gen;
+ double *head_x_gen;
+ double *tail_x_gen;
+ double *ratios;
+
+ /* true result calculated by testgen, in double-double */
+ double *head_r_true, *tail_r_true;
+
+
+ FPU_FIX_DECL;
+
+ if (n < 0)
+ BLAS_error(fname, -1, n, NULL);
+ if (ntests < 0)
+ BLAS_error(fname, -2, ntests, NULL);
+
+ /* initialization */
+ saved_seed = *seed;
+ ratio = 0.0;
+ ratio_min = 1e308;
+ ratio_max = 0.0;
+
+ *num_tests = 0;
+ *num_bad_ratio = 0;
+ *min_ratio = 0.0;
+ *max_ratio = 0.0;
+
+ if (n == 0)
+ return;
+ incri *= 2;
+
+ FPU_FIX_START;
+
+ y = (double *) blas_malloc(2 * n * sizeof(double) * 2);
+ if (2 * n > 0 && y == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ y_gen = (double *) blas_malloc(n * sizeof(double) * 2);
+ if (n > 0 && y_gen == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ head_x_gen = (double *) blas_malloc(n * sizeof(double) * 2);
+ if (n > 0 && head_x_gen == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ tail_x_gen = (double *) blas_malloc(n * sizeof(double) * 2);
+ if (n > 0 && tail_x_gen == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ a = (float *) blas_malloc(2 * n * n * sizeof(float) * 2);
+ if (2 * n * n > 0 && a == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ head_x = (double *) blas_malloc(2 * n * sizeof(double) * 2);
+ if (2 * n > 0 && head_x == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ tail_x = (double *) blas_malloc(2 * n * sizeof(double) * 2);
+ if (2 * n > 0 && tail_x == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ a_vec = (float *) blas_malloc(n * sizeof(float) * 2);
+ if (n > 0 && a_vec == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ head_r_true = (double *) blas_malloc(n * sizeof(double) * 2);
+ tail_r_true = (double *) blas_malloc(n * sizeof(double) * 2);
+ if (n > 0 && (head_r_true == NULL || tail_r_true == NULL)) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ ratios = (double *) blas_malloc(n * sizeof(double));
+ if (n > 0 && ratios == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+
+ test_count = 0;
+ bad_ratio_count = 0;
+
+ /* vary alpha */
+ for (alpha_val = ALPHA_START; alpha_val <= ALPHA_END; alpha_val++) {
+
+ alpha_flag = 0;
+ switch (alpha_val) {
+ case 0:
+ alpha[0] = alpha[1] = 0.0;
+ alpha_flag = 1;
+ break;
+ case 1:
+ alpha[0] = 1.0;
+ alpha[1] = 0.0;
+ alpha_flag = 1;
+ break;
+ }
+
+ /* vary beta */
+ for (beta_val = BETA_START; beta_val <= BETA_END; beta_val++) {
+ beta_flag = 0;
+ switch (beta_val) {
+ case 0:
+ beta[0] = beta[1] = 0.0;
+ beta_flag = 1;
+ break;
+ case 1:
+ beta[0] = 1.0;
+ beta[1] = 0.0;
+ beta_flag = 1;
+ break;
+ }
+
+
+ eps_int = power(2, -BITS_D);
+ un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
+ (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
+ prec = blas_prec_double;
+
+ /* vary norm -- underflow, approx 1, overflow */
+ for (norm = NORM_START; norm <= NORM_END; norm++) {
+
+ /* number of tests */
+ for (test_no = 0; test_no < ntests; test_no++) {
+
+ /* vary storage format */
+ for (order_val = ORDER_START; order_val <= ORDER_END; order_val++) {
+
+ order_type = (order_val == 0) ? blas_colmajor : blas_rowmajor;
+
+ /* vary upper / lower variation */
+ for (uplo_val = UPLO_START; uplo_val <= UPLO_END; uplo_val++) {
+
+ uplo_type = (uplo_val == 0) ? blas_upper : blas_lower;
+
+ /* vary lda = n, n+1, 2*n */
+ for (lda_val = LDA_START; lda_val <= LDA_END; lda_val++) {
+
+ lda = (lda_val == 0) ? n : (lda_val == 1) ? n + 1 : 2 * n;
+
+ saved_seed = *seed;
+ /* For the sake of speed, we throw out this case at random */
+ if (xrand(seed) >= test_prob)
+ continue;
+
+ alpha_flag = 0;
+ switch (alpha_val) {
+ case 0:
+ alpha[0] = alpha[1] = 0.0;
+ alpha_flag = 1;
+ break;
+ case 1:
+ alpha[0] = 1.0;
+ alpha[1] = 0.0;
+ alpha_flag = 1;
+ break;
+ }
+ beta_flag = 0;
+ switch (beta_val) {
+ case 0:
+ beta[0] = beta[1] = 0.0;
+ beta_flag = 1;
+ break;
+ case 1:
+ beta[0] = 1.0;
+ beta[1] = 0.0;
+ beta_flag = 1;
+ break;
+ }
+
+ /* finally we are here to generate the test case */
+ BLAS_zhemv2_c_z_testgen(norm, order_type,
+ uplo_type, n, &alpha, alpha_flag,
+ &beta, beta_flag, a, lda, head_x_gen,
+ tail_x_gen, y_gen, seed, head_r_true,
+ tail_r_true);
+ test_count++;
+
+ /* vary incx = -2, -1, 1, 2 */
+ for (incx_val = INCX_START; incx_val <= INCX_END; incx_val++) {
+
+ incx = incx_val;
+ if (0 == incx)
+ continue;
+
+ /* vary incy = -2, -1, 1, 2 */
+ for (incy_val = INCY_START; incy_val <= INCY_END;
+ incy_val++) {
+
+ incy = incy_val;
+ if (0 == incy)
+ continue;
+
+ /* copy generated vector with appropriate incs. */
+ zcopy_vector(y_gen, n, 1, y, incy);
+ zcopy_vector(head_x_gen, n, 1, head_x, incx);
+ zcopy_vector(tail_x_gen, n, 1, tail_x, incx);
+
+ /* call hemv2 routines to be tested */
+ FPU_FIX_STOP;
+ BLAS_zhemv2_c_z(order_type,
+ uplo_type, n, alpha, a, lda, head_x,
+ tail_x, incx, beta, y, incy);
+ FPU_FIX_START;
+
+ /* now compute the ratio using test_BLAS_xdot */
+ /* copy a row from A, use x, run dot test */
+
+ incyi = incy;
+ incyi *= 2;
+ yi0 = (incy > 0) ? 0 : (-n + 1) * incyi;
+
+ for (i = 0, yi = yi0, ri = 0;
+ i < n; i++, yi += incyi, ri += incri) {
+ che_copy_row(order_type, uplo_type, blas_left_side,
+ n, a, lda, a_vec, i);
+
+ /* just use the x vector - it was unchanged (in theory) */
+ rin[0] = y_gen[i];
+ rin[1] = y_gen[i + 1];
+ rout[0] = y[yi];
+ rout[1] = y[yi + 1];
+ head_r_true_elem[0] = head_r_true[ri];
+ head_r_true_elem[1] = head_r_true[ri + 1];
+ tail_r_true_elem[0] = tail_r_true[ri];
+ tail_r_true_elem[1] = tail_r_true[ri + 1];
+
+ test_BLAS_zdot2_c_z(n, blas_no_conj, alpha, beta,
+ rin, rout, head_r_true_elem,
+ tail_r_true_elem, a_vec, 1, head_x,
+ tail_x, incx, eps_int, un_int,
+ &ratios[i]);
+
+ /* take the max ratio */
+ if (i == 0) {
+ ratio = ratios[0];
+
+ /* The !<= below causes NaN errors to be included.
+ * Note that (NaN > 0) is false */
+ } else if (!(ratios[i] <= ratio)) {
+ ratio = ratios[i];
+ }
+
+ } /* end of dot-test loop */
+
+
+ /* The !<= below causes NaN errors to be included.
+ * Note that (NaN > 0) is false */
+ if (!(ratio <= thresh)) {
+
+ if (debug == 3) {
+ printf("\n\t\tTest # %d\n", test_count);
+ printf("y type : z, a type : c, x type : z\n");
+ printf("Seed = %d\t", saved_seed);
+ printf("n %d\n", n);
+ printf("LDA %d INCX %d INCY %d\n", lda, incx, incx);
+
+ if (order_type == blas_rowmajor)
+ printf("row ");
+ else
+ printf("col ");
+
+ if (uplo_type == blas_upper)
+ printf("upper ");
+ else
+ printf("lower ");
+
+ printf("NORM %d, ALPHA %d, BETA %d\n",
+ norm, alpha_val, beta_val);
+
+ /* print out info */
+ printf("alpha = ");
+ printf("(%24.16e, %24.16e)", alpha[0], alpha[1]);;
+ printf(" ");
+ printf("beta = ");
+ printf("(%24.16e, %24.16e)", beta[0], beta[1]);;
+ printf("\n");
+
+ printf("a\n");
+ che_print_matrix(a, n, lda, order_type, uplo_type);
+ zprint_vector(head_x, n, incx, "head_x");
+ zprint_vector(tail_x, n, incx, "tail_x");
+ zprint_vector(y_gen, n, incy, "y_gen");
+ zprint_vector(y, n, incy, "y");
+ zprint_vector(head_r_true, n, 1, "head_r_true");
+ dprint_vector(ratios, n, 1, "ratios");
+ printf("ratio = %g\n", ratio);
+ }
+ bad_ratio_count++;
+ if (bad_ratio_count >= MAX_BAD_TESTS) {
+ printf("\ntoo many failures, exiting....");
+ printf("\nTesting and compilation");
+ printf(" are incomplete\n\n");
+ goto end;
+ }
+ if (!(ratio <= TOTAL_FAILURE_THRESHOLD)) {
+ printf("\nFlagrant ratio error, exiting...");
+ printf("\nTesting and compilation");
+ printf(" are incomplete\n\n");
+ goto end;
+ }
+ }
+
+ if (!(ratio <= ratio_max))
+ ratio_max = ratio;
+ if (ratio != 0.0 && !(ratio >= ratio_min))
+ ratio_min = ratio;
+
+ } /* end of incy loop */
+
+ } /* end of incx loop */
+
+ } /* end of lda loop */
+
+ } /* end of uplo loop */
+
+ } /* end of order loop */
+
+ } /* end of nr test loop */
+
+ } /* end of norm loop */
+
+
+
+ } /* end of beta loop */
+
+ } /* end of alpha loop */
+
+end:
+ FPU_FIX_STOP;
+
+ blas_free(y);
+ blas_free(a);
+ blas_free(y_gen);
+ blas_free(head_x);
+ blas_free(tail_x);
+ blas_free(head_x_gen);
+ blas_free(tail_x_gen);
+ blas_free(head_r_true);
+ blas_free(tail_r_true);
+ blas_free(ratios);
+ blas_free(a_vec);
+
+ *max_ratio = ratio_max;
+ *min_ratio = ratio_min;
+ *num_tests = test_count;
+ *num_bad_ratio = bad_ratio_count;
+
+}
+void do_test_zhemv2_c_c
+ (int n,
+ int ntests, int *seed, double thresh, int debug, float test_prob,
+ double *min_ratio, double *max_ratio, int *num_bad_ratio, int *num_tests) {
+
+ /* Function name */
+ const char fname[] = "do_test_zhemv2_c_c";
+ int i;
+ int yi;
+ int incyi, yi0;
+ int test_count;
+ int bad_ratio_count;
+ int ri;
+ int incri = 1;
+ int incx, incy;
+ double ratio;
+ double ratio_min, ratio_max;
+ double eps_int; /* internal machine epsilon */
+ double un_int; /* internal underflow threshold */
+
+ double rin[2];
+ double rout[2];
+ double head_r_true_elem[2], tail_r_true_elem[2];
+
+ enum blas_order_type order_type;
+ enum blas_uplo_type uplo_type;
+ enum blas_prec_type prec;
+
+ int order_val, uplo_val;
+ int lda_val, incx_val, incy_val;
+ int alpha_val, beta_val;
+
+
+
+ int lda;
+ int alpha_flag, beta_flag;
+ int saved_seed;
+ int norm;
+ int test_no;
+
+ double alpha[2];
+ double beta[2];
+ float *a;
+ float *head_x;
+ float *tail_x;
+ double *y;
+ float *a_vec;
+ double *y_gen;
+ float *head_x_gen;
+ float *tail_x_gen;
+ double *ratios;
+
+ /* true result calculated by testgen, in double-double */
+ double *head_r_true, *tail_r_true;
+
+
+ FPU_FIX_DECL;
+
+ if (n < 0)
+ BLAS_error(fname, -1, n, NULL);
+ if (ntests < 0)
+ BLAS_error(fname, -2, ntests, NULL);
+
+ /* initialization */
+ saved_seed = *seed;
+ ratio = 0.0;
+ ratio_min = 1e308;
+ ratio_max = 0.0;
+
+ *num_tests = 0;
+ *num_bad_ratio = 0;
+ *min_ratio = 0.0;
+ *max_ratio = 0.0;
+
+ if (n == 0)
+ return;
+ incri *= 2;
+
+ FPU_FIX_START;
+
+ y = (double *) blas_malloc(2 * n * sizeof(double) * 2);
+ if (2 * n > 0 && y == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ y_gen = (double *) blas_malloc(n * sizeof(double) * 2);
+ if (n > 0 && y_gen == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ head_x_gen = (float *) blas_malloc(n * sizeof(float) * 2);
+ if (n > 0 && head_x_gen == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ tail_x_gen = (float *) blas_malloc(n * sizeof(float) * 2);
+ if (n > 0 && tail_x_gen == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ a = (float *) blas_malloc(2 * n * n * sizeof(float) * 2);
+ if (2 * n * n > 0 && a == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ head_x = (float *) blas_malloc(2 * n * sizeof(float) * 2);
+ if (2 * n > 0 && head_x == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ tail_x = (float *) blas_malloc(2 * n * sizeof(float) * 2);
+ if (2 * n > 0 && tail_x == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ a_vec = (float *) blas_malloc(n * sizeof(float) * 2);
+ if (n > 0 && a_vec == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ head_r_true = (double *) blas_malloc(n * sizeof(double) * 2);
+ tail_r_true = (double *) blas_malloc(n * sizeof(double) * 2);
+ if (n > 0 && (head_r_true == NULL || tail_r_true == NULL)) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ ratios = (double *) blas_malloc(n * sizeof(double));
+ if (n > 0 && ratios == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+
+ test_count = 0;
+ bad_ratio_count = 0;
+
+ /* vary alpha */
+ for (alpha_val = ALPHA_START; alpha_val <= ALPHA_END; alpha_val++) {
+
+ alpha_flag = 0;
+ switch (alpha_val) {
+ case 0:
+ alpha[0] = alpha[1] = 0.0;
+ alpha_flag = 1;
+ break;
+ case 1:
+ alpha[0] = 1.0;
+ alpha[1] = 0.0;
+ alpha_flag = 1;
+ break;
+ }
+
+ /* vary beta */
+ for (beta_val = BETA_START; beta_val <= BETA_END; beta_val++) {
+ beta_flag = 0;
+ switch (beta_val) {
+ case 0:
+ beta[0] = beta[1] = 0.0;
+ beta_flag = 1;
+ break;
+ case 1:
+ beta[0] = 1.0;
+ beta[1] = 0.0;
+ beta_flag = 1;
+ break;
+ }
+
+
+ eps_int = power(2, -BITS_D);
+ un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
+ (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
+ prec = blas_prec_double;
+
+ /* vary norm -- underflow, approx 1, overflow */
+ for (norm = NORM_START; norm <= NORM_END; norm++) {
+
+ /* number of tests */
+ for (test_no = 0; test_no < ntests; test_no++) {
+
+ /* vary storage format */
+ for (order_val = ORDER_START; order_val <= ORDER_END; order_val++) {
+
+ order_type = (order_val == 0) ? blas_colmajor : blas_rowmajor;
+
+ /* vary upper / lower variation */
+ for (uplo_val = UPLO_START; uplo_val <= UPLO_END; uplo_val++) {
+
+ uplo_type = (uplo_val == 0) ? blas_upper : blas_lower;
+
+ /* vary lda = n, n+1, 2*n */
+ for (lda_val = LDA_START; lda_val <= LDA_END; lda_val++) {
+
+ lda = (lda_val == 0) ? n : (lda_val == 1) ? n + 1 : 2 * n;
+
+ saved_seed = *seed;
+ /* For the sake of speed, we throw out this case at random */
+ if (xrand(seed) >= test_prob)
+ continue;
+
+ alpha_flag = 0;
+ switch (alpha_val) {
+ case 0:
+ alpha[0] = alpha[1] = 0.0;
+ alpha_flag = 1;
+ break;
+ case 1:
+ alpha[0] = 1.0;
+ alpha[1] = 0.0;
+ alpha_flag = 1;
+ break;
+ }
+ beta_flag = 0;
+ switch (beta_val) {
+ case 0:
+ beta[0] = beta[1] = 0.0;
+ beta_flag = 1;
+ break;
+ case 1:
+ beta[0] = 1.0;
+ beta[1] = 0.0;
+ beta_flag = 1;
+ break;
+ }
+
+ /* finally we are here to generate the test case */
+ BLAS_zhemv2_c_c_testgen(norm, order_type,
+ uplo_type, n, &alpha, alpha_flag,
+ &beta, beta_flag, a, lda, head_x_gen,
+ tail_x_gen, y_gen, seed, head_r_true,
+ tail_r_true);
+ test_count++;
+
+ /* vary incx = -2, -1, 1, 2 */
+ for (incx_val = INCX_START; incx_val <= INCX_END; incx_val++) {
+
+ incx = incx_val;
+ if (0 == incx)
+ continue;
+
+ /* vary incy = -2, -1, 1, 2 */
+ for (incy_val = INCY_START; incy_val <= INCY_END;
+ incy_val++) {
+
+ incy = incy_val;
+ if (0 == incy)
+ continue;
+
+ /* copy generated vector with appropriate incs. */
+ zcopy_vector(y_gen, n, 1, y, incy);
+ ccopy_vector(head_x_gen, n, 1, head_x, incx);
+ ccopy_vector(tail_x_gen, n, 1, tail_x, incx);
+
+ /* call hemv2 routines to be tested */
+ FPU_FIX_STOP;
+ BLAS_zhemv2_c_c(order_type,
+ uplo_type, n, alpha, a, lda, head_x,
+ tail_x, incx, beta, y, incy);
+ FPU_FIX_START;
+
+ /* now compute the ratio using test_BLAS_xdot */
+ /* copy a row from A, use x, run dot test */
+
+ incyi = incy;
+ incyi *= 2;
+ yi0 = (incy > 0) ? 0 : (-n + 1) * incyi;
+
+ for (i = 0, yi = yi0, ri = 0;
+ i < n; i++, yi += incyi, ri += incri) {
+ che_copy_row(order_type, uplo_type, blas_left_side,
+ n, a, lda, a_vec, i);
+
+ /* just use the x vector - it was unchanged (in theory) */
+ rin[0] = y_gen[i];
+ rin[1] = y_gen[i + 1];
+ rout[0] = y[yi];
+ rout[1] = y[yi + 1];
+ head_r_true_elem[0] = head_r_true[ri];
+ head_r_true_elem[1] = head_r_true[ri + 1];
+ tail_r_true_elem[0] = tail_r_true[ri];
+ tail_r_true_elem[1] = tail_r_true[ri + 1];
+
+ test_BLAS_zdot2_c_c(n, blas_no_conj, alpha, beta,
+ rin, rout, head_r_true_elem,
+ tail_r_true_elem, a_vec, 1, head_x,
+ tail_x, incx, eps_int, un_int,
+ &ratios[i]);
+
+ /* take the max ratio */
+ if (i == 0) {
+ ratio = ratios[0];
+
+ /* The !<= below causes NaN errors to be included.
+ * Note that (NaN > 0) is false */
+ } else if (!(ratios[i] <= ratio)) {
+ ratio = ratios[i];
+ }
+
+ } /* end of dot-test loop */
+
+
+ /* The !<= below causes NaN errors to be included.
+ * Note that (NaN > 0) is false */
+ if (!(ratio <= thresh)) {
+
+ if (debug == 3) {
+ printf("\n\t\tTest # %d\n", test_count);
+ printf("y type : z, a type : c, x type : c\n");
+ printf("Seed = %d\t", saved_seed);
+ printf("n %d\n", n);
+ printf("LDA %d INCX %d INCY %d\n", lda, incx, incx);
+
+ if (order_type == blas_rowmajor)
+ printf("row ");
+ else
+ printf("col ");
+
+ if (uplo_type == blas_upper)
+ printf("upper ");
+ else
+ printf("lower ");
+
+ printf("NORM %d, ALPHA %d, BETA %d\n",
+ norm, alpha_val, beta_val);
+
+ /* print out info */
+ printf("alpha = ");
+ printf("(%24.16e, %24.16e)", alpha[0], alpha[1]);;
+ printf(" ");
+ printf("beta = ");
+ printf("(%24.16e, %24.16e)", beta[0], beta[1]);;
+ printf("\n");
+
+ printf("a\n");
+ che_print_matrix(a, n, lda, order_type, uplo_type);
+ cprint_vector(head_x, n, incx, "head_x");
+ cprint_vector(tail_x, n, incx, "tail_x");
+ zprint_vector(y_gen, n, incy, "y_gen");
+ zprint_vector(y, n, incy, "y");
+ zprint_vector(head_r_true, n, 1, "head_r_true");
+ dprint_vector(ratios, n, 1, "ratios");
+ printf("ratio = %g\n", ratio);
+ }
+ bad_ratio_count++;
+ if (bad_ratio_count >= MAX_BAD_TESTS) {
+ printf("\ntoo many failures, exiting....");
+ printf("\nTesting and compilation");
+ printf(" are incomplete\n\n");
+ goto end;
+ }
+ if (!(ratio <= TOTAL_FAILURE_THRESHOLD)) {
+ printf("\nFlagrant ratio error, exiting...");
+ printf("\nTesting and compilation");
+ printf(" are incomplete\n\n");
+ goto end;
+ }
+ }
+
+ if (!(ratio <= ratio_max))
+ ratio_max = ratio;
+ if (ratio != 0.0 && !(ratio >= ratio_min))
+ ratio_min = ratio;
+
+ } /* end of incy loop */
+
+ } /* end of incx loop */
+
+ } /* end of lda loop */
+
+ } /* end of uplo loop */
+
+ } /* end of order loop */
+
+ } /* end of nr test loop */
+
+ } /* end of norm loop */
+
+
+
+ } /* end of beta loop */
+
+ } /* end of alpha loop */
+
+end:
+ FPU_FIX_STOP;
+
+ blas_free(y);
+ blas_free(a);
+ blas_free(y_gen);
+ blas_free(head_x);
+ blas_free(tail_x);
+ blas_free(head_x_gen);
+ blas_free(tail_x_gen);
+ blas_free(head_r_true);
+ blas_free(tail_r_true);
+ blas_free(ratios);
+ blas_free(a_vec);
+
+ *max_ratio = ratio_max;
+ *min_ratio = ratio_min;
+ *num_tests = test_count;
+ *num_bad_ratio = bad_ratio_count;
+
+}
+void do_test_chemv2_c_s
+ (int n,
+ int ntests, int *seed, double thresh, int debug, float test_prob,
+ double *min_ratio, double *max_ratio, int *num_bad_ratio, int *num_tests) {
+
+ /* Function name */
+ const char fname[] = "do_test_chemv2_c_s";
+ int i;
+ int yi;
+ int incyi, yi0;
+ int test_count;
+ int bad_ratio_count;
+ int ri;
+ int incri = 1;
+ int incx, incy;
+ double ratio;
+ double ratio_min, ratio_max;
+ double eps_int; /* internal machine epsilon */
+ double un_int; /* internal underflow threshold */
+
+ float rin[2];
+ float rout[2];
+ double head_r_true_elem[2], tail_r_true_elem[2];
+
+ enum blas_order_type order_type;
+ enum blas_uplo_type uplo_type;
+ enum blas_prec_type prec;
+
+ int order_val, uplo_val;
+ int lda_val, incx_val, incy_val;
+ int alpha_val, beta_val;
+
+
+
+ int lda;
+ int alpha_flag, beta_flag;
+ int saved_seed;
+ int norm;
+ int test_no;
+
+ float alpha[2];
+ float beta[2];
+ float *a;
+ float *head_x;
+ float *tail_x;
+ float *y;
+ float *a_vec;
+ float *y_gen;
+ float *head_x_gen;
+ float *tail_x_gen;
+ double *ratios;
+
+ /* true result calculated by testgen, in double-double */
+ double *head_r_true, *tail_r_true;
+
+
+ FPU_FIX_DECL;
+
+ if (n < 0)
+ BLAS_error(fname, -1, n, NULL);
+ if (ntests < 0)
+ BLAS_error(fname, -2, ntests, NULL);
+
+ /* initialization */
+ saved_seed = *seed;
+ ratio = 0.0;
+ ratio_min = 1e308;
+ ratio_max = 0.0;
+
+ *num_tests = 0;
+ *num_bad_ratio = 0;
+ *min_ratio = 0.0;
+ *max_ratio = 0.0;
+
+ if (n == 0)
+ return;
+ incri *= 2;
+
+ FPU_FIX_START;
+
+ y = (float *) blas_malloc(2 * n * sizeof(float) * 2);
+ if (2 * n > 0 && y == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ y_gen = (float *) blas_malloc(n * sizeof(float) * 2);
+ if (n > 0 && y_gen == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ head_x_gen = (float *) blas_malloc(n * sizeof(float));
+ if (n > 0 && head_x_gen == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ tail_x_gen = (float *) blas_malloc(n * sizeof(float));
+ if (n > 0 && tail_x_gen == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ a = (float *) blas_malloc(2 * n * n * sizeof(float) * 2);
+ if (2 * n * n > 0 && a == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ head_x = (float *) blas_malloc(2 * n * sizeof(float));
+ if (2 * n > 0 && head_x == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ tail_x = (float *) blas_malloc(2 * n * sizeof(float));
+ if (2 * n > 0 && tail_x == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ a_vec = (float *) blas_malloc(n * sizeof(float) * 2);
+ if (n > 0 && a_vec == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ head_r_true = (double *) blas_malloc(n * sizeof(double) * 2);
+ tail_r_true = (double *) blas_malloc(n * sizeof(double) * 2);
+ if (n > 0 && (head_r_true == NULL || tail_r_true == NULL)) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ ratios = (double *) blas_malloc(n * sizeof(double));
+ if (n > 0 && ratios == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+
+ test_count = 0;
+ bad_ratio_count = 0;
+
+ /* vary alpha */
+ for (alpha_val = ALPHA_START; alpha_val <= ALPHA_END; alpha_val++) {
+
+ alpha_flag = 0;
+ switch (alpha_val) {
+ case 0:
+ alpha[0] = alpha[1] = 0.0;
+ alpha_flag = 1;
+ break;
+ case 1:
+ alpha[0] = 1.0;
+ alpha[1] = 0.0;
+ alpha_flag = 1;
+ break;
+ }
+
+ /* vary beta */
+ for (beta_val = BETA_START; beta_val <= BETA_END; beta_val++) {
+ beta_flag = 0;
+ switch (beta_val) {
+ case 0:
+ beta[0] = beta[1] = 0.0;
+ beta_flag = 1;
+ break;
+ case 1:
+ beta[0] = 1.0;
+ beta[1] = 0.0;
+ beta_flag = 1;
+ break;
+ }
+
+
+ eps_int = power(2, -BITS_S);
+ un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_single),
+ (double) BLAS_fpinfo_x(blas_emin, blas_prec_single));
+ prec = blas_prec_single;
+
+ /* vary norm -- underflow, approx 1, overflow */
+ for (norm = NORM_START; norm <= NORM_END; norm++) {
+
+ /* number of tests */
+ for (test_no = 0; test_no < ntests; test_no++) {
+
+ /* vary storage format */
+ for (order_val = ORDER_START; order_val <= ORDER_END; order_val++) {
+
+ order_type = (order_val == 0) ? blas_colmajor : blas_rowmajor;
+
+ /* vary upper / lower variation */
+ for (uplo_val = UPLO_START; uplo_val <= UPLO_END; uplo_val++) {
+
+ uplo_type = (uplo_val == 0) ? blas_upper : blas_lower;
+
+ /* vary lda = n, n+1, 2*n */
+ for (lda_val = LDA_START; lda_val <= LDA_END; lda_val++) {
+
+ lda = (lda_val == 0) ? n : (lda_val == 1) ? n + 1 : 2 * n;
+
+ saved_seed = *seed;
+ /* For the sake of speed, we throw out this case at random */
+ if (xrand(seed) >= test_prob)
+ continue;
+
+ alpha_flag = 0;
+ switch (alpha_val) {
+ case 0:
+ alpha[0] = alpha[1] = 0.0;
+ alpha_flag = 1;
+ break;
+ case 1:
+ alpha[0] = 1.0;
+ alpha[1] = 0.0;
+ alpha_flag = 1;
+ break;
+ }
+ beta_flag = 0;
+ switch (beta_val) {
+ case 0:
+ beta[0] = beta[1] = 0.0;
+ beta_flag = 1;
+ break;
+ case 1:
+ beta[0] = 1.0;
+ beta[1] = 0.0;
+ beta_flag = 1;
+ break;
+ }
+
+ /* finally we are here to generate the test case */
+ BLAS_chemv2_c_s_testgen(norm, order_type,
+ uplo_type, n, &alpha, alpha_flag,
+ &beta, beta_flag, a, lda, head_x_gen,
+ tail_x_gen, y_gen, seed, head_r_true,
+ tail_r_true);
+ test_count++;
+
+ /* vary incx = -2, -1, 1, 2 */
+ for (incx_val = INCX_START; incx_val <= INCX_END; incx_val++) {
+
+ incx = incx_val;
+ if (0 == incx)
+ continue;
+
+ /* vary incy = -2, -1, 1, 2 */
+ for (incy_val = INCY_START; incy_val <= INCY_END;
+ incy_val++) {
+
+ incy = incy_val;
+ if (0 == incy)
+ continue;
+
+ /* copy generated vector with appropriate incs. */
+ ccopy_vector(y_gen, n, 1, y, incy);
+ scopy_vector(head_x_gen, n, 1, head_x, incx);
+ scopy_vector(tail_x_gen, n, 1, tail_x, incx);
+
+ /* call hemv2 routines to be tested */
+ FPU_FIX_STOP;
+ BLAS_chemv2_c_s(order_type,
+ uplo_type, n, alpha, a, lda, head_x,
+ tail_x, incx, beta, y, incy);
+ FPU_FIX_START;
+
+ /* now compute the ratio using test_BLAS_xdot */
+ /* copy a row from A, use x, run dot test */
+
+ incyi = incy;
+ incyi *= 2;
+ yi0 = (incy > 0) ? 0 : (-n + 1) * incyi;
+
+ for (i = 0, yi = yi0, ri = 0;
+ i < n; i++, yi += incyi, ri += incri) {
+ che_copy_row(order_type, uplo_type, blas_left_side,
+ n, a, lda, a_vec, i);
+
+ /* just use the x vector - it was unchanged (in theory) */
+ rin[0] = y_gen[i];
+ rin[1] = y_gen[i + 1];
+ rout[0] = y[yi];
+ rout[1] = y[yi + 1];
+ head_r_true_elem[0] = head_r_true[ri];
+ head_r_true_elem[1] = head_r_true[ri + 1];
+ tail_r_true_elem[0] = tail_r_true[ri];
+ tail_r_true_elem[1] = tail_r_true[ri + 1];
+
+ test_BLAS_cdot2_c_s(n, blas_no_conj, alpha, beta,
+ rin, rout, head_r_true_elem,
+ tail_r_true_elem, a_vec, 1, head_x,
+ tail_x, incx, eps_int, un_int,
+ &ratios[i]);
+
+ /* take the max ratio */
+ if (i == 0) {
+ ratio = ratios[0];
+
+ /* The !<= below causes NaN errors to be included.
+ * Note that (NaN > 0) is false */
+ } else if (!(ratios[i] <= ratio)) {
+ ratio = ratios[i];
+ }
+
+ } /* end of dot-test loop */
+
+
+ /* The !<= below causes NaN errors to be included.
+ * Note that (NaN > 0) is false */
+ if (!(ratio <= thresh)) {
+
+ if (debug == 3) {
+ printf("\n\t\tTest # %d\n", test_count);
+ printf("y type : c, a type : c, x type : s\n");
+ printf("Seed = %d\t", saved_seed);
+ printf("n %d\n", n);
+ printf("LDA %d INCX %d INCY %d\n", lda, incx, incx);
+
+ if (order_type == blas_rowmajor)
+ printf("row ");
+ else
+ printf("col ");
+
+ if (uplo_type == blas_upper)
+ printf("upper ");
+ else
+ printf("lower ");
+
+ printf("NORM %d, ALPHA %d, BETA %d\n",
+ norm, alpha_val, beta_val);
+
+ /* print out info */
+ printf("alpha = ");
+ printf("(%16.8e, %16.8e)", alpha[0], alpha[1]);;
+ printf(" ");
+ printf("beta = ");
+ printf("(%16.8e, %16.8e)", beta[0], beta[1]);;
+ printf("\n");
+
+ printf("a\n");
+ che_print_matrix(a, n, lda, order_type, uplo_type);
+ sprint_vector(head_x, n, incx, "head_x");
+ sprint_vector(tail_x, n, incx, "tail_x");
+ cprint_vector(y_gen, n, incy, "y_gen");
+ cprint_vector(y, n, incy, "y");
+ zprint_vector(head_r_true, n, 1, "head_r_true");
+ dprint_vector(ratios, n, 1, "ratios");
+ printf("ratio = %g\n", ratio);
+ }
+ bad_ratio_count++;
+ if (bad_ratio_count >= MAX_BAD_TESTS) {
+ printf("\ntoo many failures, exiting....");
+ printf("\nTesting and compilation");
+ printf(" are incomplete\n\n");
+ goto end;
+ }
+ if (!(ratio <= TOTAL_FAILURE_THRESHOLD)) {
+ printf("\nFlagrant ratio error, exiting...");
+ printf("\nTesting and compilation");
+ printf(" are incomplete\n\n");
+ goto end;
+ }
+ }
+
+ if (!(ratio <= ratio_max))
+ ratio_max = ratio;
+ if (ratio != 0.0 && !(ratio >= ratio_min))
+ ratio_min = ratio;
+
+ } /* end of incy loop */
+
+ } /* end of incx loop */
+
+ } /* end of lda loop */
+
+ } /* end of uplo loop */
+
+ } /* end of order loop */
+
+ } /* end of nr test loop */
+
+ } /* end of norm loop */
+
+
+
+ } /* end of beta loop */
+
+ } /* end of alpha loop */
+
+end:
+ FPU_FIX_STOP;
+
+ blas_free(y);
+ blas_free(a);
+ blas_free(y_gen);
+ blas_free(head_x);
+ blas_free(tail_x);
+ blas_free(head_x_gen);
+ blas_free(tail_x_gen);
+ blas_free(head_r_true);
+ blas_free(tail_r_true);
+ blas_free(ratios);
+ blas_free(a_vec);
+
+ *max_ratio = ratio_max;
+ *min_ratio = ratio_min;
+ *num_tests = test_count;
+ *num_bad_ratio = bad_ratio_count;
+
+}
+void do_test_zhemv2_z_d
+ (int n,
+ int ntests, int *seed, double thresh, int debug, float test_prob,
+ double *min_ratio, double *max_ratio, int *num_bad_ratio, int *num_tests) {
+
+ /* Function name */
+ const char fname[] = "do_test_zhemv2_z_d";
+ int i;
+ int yi;
+ int incyi, yi0;
+ int test_count;
+ int bad_ratio_count;
+ int ri;
+ int incri = 1;
+ int incx, incy;
+ double ratio;
+ double ratio_min, ratio_max;
+ double eps_int; /* internal machine epsilon */
+ double un_int; /* internal underflow threshold */
+
+ double rin[2];
+ double rout[2];
+ double head_r_true_elem[2], tail_r_true_elem[2];
+
+ enum blas_order_type order_type;
+ enum blas_uplo_type uplo_type;
+ enum blas_prec_type prec;
+
+ int order_val, uplo_val;
+ int lda_val, incx_val, incy_val;
+ int alpha_val, beta_val;
+
+
+
+ int lda;
+ int alpha_flag, beta_flag;
+ int saved_seed;
+ int norm;
+ int test_no;
+
+ double alpha[2];
+ double beta[2];
+ double *a;
+ double *head_x;
+ double *tail_x;
+ double *y;
+ double *a_vec;
+ double *y_gen;
+ double *head_x_gen;
+ double *tail_x_gen;
+ double *ratios;
+
+ /* true result calculated by testgen, in double-double */
+ double *head_r_true, *tail_r_true;
+
+
+ FPU_FIX_DECL;
+
+ if (n < 0)
+ BLAS_error(fname, -1, n, NULL);
+ if (ntests < 0)
+ BLAS_error(fname, -2, ntests, NULL);
+
+ /* initialization */
+ saved_seed = *seed;
+ ratio = 0.0;
+ ratio_min = 1e308;
+ ratio_max = 0.0;
+
+ *num_tests = 0;
+ *num_bad_ratio = 0;
+ *min_ratio = 0.0;
+ *max_ratio = 0.0;
+
+ if (n == 0)
+ return;
+ incri *= 2;
+
+ FPU_FIX_START;
+
+ y = (double *) blas_malloc(2 * n * sizeof(double) * 2);
+ if (2 * n > 0 && y == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ y_gen = (double *) blas_malloc(n * sizeof(double) * 2);
+ if (n > 0 && y_gen == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ head_x_gen = (double *) blas_malloc(n * sizeof(double));
+ if (n > 0 && head_x_gen == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ tail_x_gen = (double *) blas_malloc(n * sizeof(double));
+ if (n > 0 && tail_x_gen == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ a = (double *) blas_malloc(2 * n * n * sizeof(double) * 2);
+ if (2 * n * n > 0 && a == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ head_x = (double *) blas_malloc(2 * n * sizeof(double));
+ if (2 * n > 0 && head_x == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ tail_x = (double *) blas_malloc(2 * n * sizeof(double));
+ if (2 * n > 0 && tail_x == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ a_vec = (double *) blas_malloc(n * sizeof(double) * 2);
+ if (n > 0 && a_vec == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ head_r_true = (double *) blas_malloc(n * sizeof(double) * 2);
+ tail_r_true = (double *) blas_malloc(n * sizeof(double) * 2);
+ if (n > 0 && (head_r_true == NULL || tail_r_true == NULL)) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ ratios = (double *) blas_malloc(n * sizeof(double));
+ if (n > 0 && ratios == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+
+ test_count = 0;
+ bad_ratio_count = 0;
+
+ /* vary alpha */
+ for (alpha_val = ALPHA_START; alpha_val <= ALPHA_END; alpha_val++) {
+
+ alpha_flag = 0;
+ switch (alpha_val) {
+ case 0:
+ alpha[0] = alpha[1] = 0.0;
+ alpha_flag = 1;
+ break;
+ case 1:
+ alpha[0] = 1.0;
+ alpha[1] = 0.0;
+ alpha_flag = 1;
+ break;
+ }
+
+ /* vary beta */
+ for (beta_val = BETA_START; beta_val <= BETA_END; beta_val++) {
+ beta_flag = 0;
+ switch (beta_val) {
+ case 0:
+ beta[0] = beta[1] = 0.0;
+ beta_flag = 1;
+ break;
+ case 1:
+ beta[0] = 1.0;
+ beta[1] = 0.0;
+ beta_flag = 1;
+ break;
+ }
+
+
+ eps_int = power(2, -BITS_D);
+ un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
+ (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
+ prec = blas_prec_double;
+
+ /* vary norm -- underflow, approx 1, overflow */
+ for (norm = NORM_START; norm <= NORM_END; norm++) {
+
+ /* number of tests */
+ for (test_no = 0; test_no < ntests; test_no++) {
+
+ /* vary storage format */
+ for (order_val = ORDER_START; order_val <= ORDER_END; order_val++) {
+
+ order_type = (order_val == 0) ? blas_colmajor : blas_rowmajor;
+
+ /* vary upper / lower variation */
+ for (uplo_val = UPLO_START; uplo_val <= UPLO_END; uplo_val++) {
+
+ uplo_type = (uplo_val == 0) ? blas_upper : blas_lower;
+
+ /* vary lda = n, n+1, 2*n */
+ for (lda_val = LDA_START; lda_val <= LDA_END; lda_val++) {
+
+ lda = (lda_val == 0) ? n : (lda_val == 1) ? n + 1 : 2 * n;
+
+ saved_seed = *seed;
+ /* For the sake of speed, we throw out this case at random */
+ if (xrand(seed) >= test_prob)
+ continue;
+
+ alpha_flag = 0;
+ switch (alpha_val) {
+ case 0:
+ alpha[0] = alpha[1] = 0.0;
+ alpha_flag = 1;
+ break;
+ case 1:
+ alpha[0] = 1.0;
+ alpha[1] = 0.0;
+ alpha_flag = 1;
+ break;
+ }
+ beta_flag = 0;
+ switch (beta_val) {
+ case 0:
+ beta[0] = beta[1] = 0.0;
+ beta_flag = 1;
+ break;
+ case 1:
+ beta[0] = 1.0;
+ beta[1] = 0.0;
+ beta_flag = 1;
+ break;
+ }
+
+ /* finally we are here to generate the test case */
+ BLAS_zhemv2_z_d_testgen(norm, order_type,
+ uplo_type, n, &alpha, alpha_flag,
+ &beta, beta_flag, a, lda, head_x_gen,
+ tail_x_gen, y_gen, seed, head_r_true,
+ tail_r_true);
+ test_count++;
+
+ /* vary incx = -2, -1, 1, 2 */
+ for (incx_val = INCX_START; incx_val <= INCX_END; incx_val++) {
+
+ incx = incx_val;
+ if (0 == incx)
+ continue;
+
+ /* vary incy = -2, -1, 1, 2 */
+ for (incy_val = INCY_START; incy_val <= INCY_END;
+ incy_val++) {
+
+ incy = incy_val;
+ if (0 == incy)
+ continue;
+
+ /* copy generated vector with appropriate incs. */
+ zcopy_vector(y_gen, n, 1, y, incy);
+ dcopy_vector(head_x_gen, n, 1, head_x, incx);
+ dcopy_vector(tail_x_gen, n, 1, tail_x, incx);
+
+ /* call hemv2 routines to be tested */
+ FPU_FIX_STOP;
+ BLAS_zhemv2_z_d(order_type,
+ uplo_type, n, alpha, a, lda, head_x,
+ tail_x, incx, beta, y, incy);
+ FPU_FIX_START;
+
+ /* now compute the ratio using test_BLAS_xdot */
+ /* copy a row from A, use x, run dot test */
+
+ incyi = incy;
+ incyi *= 2;
+ yi0 = (incy > 0) ? 0 : (-n + 1) * incyi;
+
+ for (i = 0, yi = yi0, ri = 0;
+ i < n; i++, yi += incyi, ri += incri) {
+ zhe_copy_row(order_type, uplo_type, blas_left_side,
+ n, a, lda, a_vec, i);
+
+ /* just use the x vector - it was unchanged (in theory) */
+ rin[0] = y_gen[i];
+ rin[1] = y_gen[i + 1];
+ rout[0] = y[yi];
+ rout[1] = y[yi + 1];
+ head_r_true_elem[0] = head_r_true[ri];
+ head_r_true_elem[1] = head_r_true[ri + 1];
+ tail_r_true_elem[0] = tail_r_true[ri];
+ tail_r_true_elem[1] = tail_r_true[ri + 1];
+
+ test_BLAS_zdot2_z_d(n, blas_no_conj, alpha, beta,
+ rin, rout, head_r_true_elem,
+ tail_r_true_elem, a_vec, 1, head_x,
+ tail_x, incx, eps_int, un_int,
+ &ratios[i]);
+
+ /* take the max ratio */
+ if (i == 0) {
+ ratio = ratios[0];
+
+ /* The !<= below causes NaN errors to be included.
+ * Note that (NaN > 0) is false */
+ } else if (!(ratios[i] <= ratio)) {
+ ratio = ratios[i];
+ }
+
+ } /* end of dot-test loop */
+
+
+ /* The !<= below causes NaN errors to be included.
+ * Note that (NaN > 0) is false */
+ if (!(ratio <= thresh)) {
+
+ if (debug == 3) {
+ printf("\n\t\tTest # %d\n", test_count);
+ printf("y type : z, a type : z, x type : d\n");
+ printf("Seed = %d\t", saved_seed);
+ printf("n %d\n", n);
+ printf("LDA %d INCX %d INCY %d\n", lda, incx, incx);
+
+ if (order_type == blas_rowmajor)
+ printf("row ");
+ else
+ printf("col ");
+
+ if (uplo_type == blas_upper)
+ printf("upper ");
+ else
+ printf("lower ");
+
+ printf("NORM %d, ALPHA %d, BETA %d\n",
+ norm, alpha_val, beta_val);
+
+ /* print out info */
+ printf("alpha = ");
+ printf("(%24.16e, %24.16e)", alpha[0], alpha[1]);;
+ printf(" ");
+ printf("beta = ");
+ printf("(%24.16e, %24.16e)", beta[0], beta[1]);;
+ printf("\n");
+
+ printf("a\n");
+ zhe_print_matrix(a, n, lda, order_type, uplo_type);
+ dprint_vector(head_x, n, incx, "head_x");
+ dprint_vector(tail_x, n, incx, "tail_x");
+ zprint_vector(y_gen, n, incy, "y_gen");
+ zprint_vector(y, n, incy, "y");
+ zprint_vector(head_r_true, n, 1, "head_r_true");
+ dprint_vector(ratios, n, 1, "ratios");
+ printf("ratio = %g\n", ratio);
+ }
+ bad_ratio_count++;
+ if (bad_ratio_count >= MAX_BAD_TESTS) {
+ printf("\ntoo many failures, exiting....");
+ printf("\nTesting and compilation");
+ printf(" are incomplete\n\n");
+ goto end;
+ }
+ if (!(ratio <= TOTAL_FAILURE_THRESHOLD)) {
+ printf("\nFlagrant ratio error, exiting...");
+ printf("\nTesting and compilation");
+ printf(" are incomplete\n\n");
+ goto end;
+ }
+ }
+
+ if (!(ratio <= ratio_max))
+ ratio_max = ratio;
+ if (ratio != 0.0 && !(ratio >= ratio_min))
+ ratio_min = ratio;
+
+ } /* end of incy loop */
+
+ } /* end of incx loop */
+
+ } /* end of lda loop */
+
+ } /* end of uplo loop */
+
+ } /* end of order loop */
+
+ } /* end of nr test loop */
+
+ } /* end of norm loop */
+
+
+
+ } /* end of beta loop */
+
+ } /* end of alpha loop */
+
+end:
+ FPU_FIX_STOP;
+
+ blas_free(y);
+ blas_free(a);
+ blas_free(y_gen);
+ blas_free(head_x);
+ blas_free(tail_x);
+ blas_free(head_x_gen);
+ blas_free(tail_x_gen);
+ blas_free(head_r_true);
+ blas_free(tail_r_true);
+ blas_free(ratios);
+ blas_free(a_vec);
+
+ *max_ratio = ratio_max;
+ *min_ratio = ratio_min;
+ *num_tests = test_count;
+ *num_bad_ratio = bad_ratio_count;
+
+}
+void do_test_chemv2_x
+ (int n,
+ int ntests, int *seed, double thresh, int debug, float test_prob,
+ double *min_ratio, double *max_ratio, int *num_bad_ratio, int *num_tests) {
+
+ /* Function name */
+ const char fname[] = "do_test_chemv2_x";
+ int i;
+ int yi;
+ int incyi, yi0;
+ int test_count;
+ int bad_ratio_count;
+ int ri;
+ int incri = 1;
+ int incx, incy;
+ double ratio;
+ double ratio_min, ratio_max;
+ double eps_int; /* internal machine epsilon */
+ double un_int; /* internal underflow threshold */
+
+ float rin[2];
+ float rout[2];
+ double head_r_true_elem[2], tail_r_true_elem[2];
+
+ enum blas_order_type order_type;
+ enum blas_uplo_type uplo_type;
+ enum blas_prec_type prec;
+
+ int order_val, uplo_val;
+ int lda_val, incx_val, incy_val;
+ int alpha_val, beta_val;
+
+ int prec_val;
+
+ int lda;
+ int alpha_flag, beta_flag;
+ int saved_seed;
+ int norm;
+ int test_no;
+
+ float alpha[2];
+ float beta[2];
+ float *a;
+ float *head_x;
+ float *tail_x;
+ float *y;
+ float *a_vec;
+ float *y_gen;
+ float *head_x_gen;
+ float *tail_x_gen;
+ double *ratios;
+
+ /* true result calculated by testgen, in double-double */
+ double *head_r_true, *tail_r_true;
+
+
+ FPU_FIX_DECL;
+
+ if (n < 0)
+ BLAS_error(fname, -1, n, NULL);
+ if (ntests < 0)
+ BLAS_error(fname, -2, ntests, NULL);
+
+ /* initialization */
+ saved_seed = *seed;
+ ratio = 0.0;
+ ratio_min = 1e308;
+ ratio_max = 0.0;
+
+ *num_tests = 0;
+ *num_bad_ratio = 0;
+ *min_ratio = 0.0;
+ *max_ratio = 0.0;
+
+ if (n == 0)
+ return;
+ incri *= 2;
+
+ FPU_FIX_START;
+
+ y = (float *) blas_malloc(2 * n * sizeof(float) * 2);
+ if (2 * n > 0 && y == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ y_gen = (float *) blas_malloc(n * sizeof(float) * 2);
+ if (n > 0 && y_gen == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ head_x_gen = (float *) blas_malloc(n * sizeof(float) * 2);
+ if (n > 0 && head_x_gen == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ tail_x_gen = (float *) blas_malloc(n * sizeof(float) * 2);
+ if (n > 0 && tail_x_gen == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ a = (float *) blas_malloc(2 * n * n * sizeof(float) * 2);
+ if (2 * n * n > 0 && a == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ head_x = (float *) blas_malloc(2 * n * sizeof(float) * 2);
+ if (2 * n > 0 && head_x == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ tail_x = (float *) blas_malloc(2 * n * sizeof(float) * 2);
+ if (2 * n > 0 && tail_x == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ a_vec = (float *) blas_malloc(n * sizeof(float) * 2);
+ if (n > 0 && a_vec == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ head_r_true = (double *) blas_malloc(n * sizeof(double) * 2);
+ tail_r_true = (double *) blas_malloc(n * sizeof(double) * 2);
+ if (n > 0 && (head_r_true == NULL || tail_r_true == NULL)) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ ratios = (double *) blas_malloc(n * sizeof(double));
+ if (n > 0 && ratios == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+
+ test_count = 0;
+ bad_ratio_count = 0;
+
+ /* vary alpha */
+ for (alpha_val = ALPHA_START; alpha_val <= ALPHA_END; alpha_val++) {
+
+ alpha_flag = 0;
+ switch (alpha_val) {
+ case 0:
+ alpha[0] = alpha[1] = 0.0;
+ alpha_flag = 1;
+ break;
+ case 1:
+ alpha[0] = 1.0;
+ alpha[1] = 0.0;
+ alpha_flag = 1;
+ break;
+ }
+
+ /* vary beta */
+ for (beta_val = BETA_START; beta_val <= BETA_END; beta_val++) {
+ beta_flag = 0;
+ switch (beta_val) {
+ case 0:
+ beta[0] = beta[1] = 0.0;
+ beta_flag = 1;
+ break;
+ case 1:
+ beta[0] = 1.0;
+ beta[1] = 0.0;
+ beta_flag = 1;
+ break;
+ }
+
+
+ /* varying extra precs */
+ for (prec_val = PREC_START; prec_val <= PREC_END; prec_val++) {
+ switch (prec_val) {
+ case 0:
+ eps_int = power(2, -BITS_S);
+ un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_single),
+ (double) BLAS_fpinfo_x(blas_emin, blas_prec_single));
+ prec = blas_prec_single;
+ break;
+ case 1:
+ eps_int = power(2, -BITS_D);
+ un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
+ (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
+ prec = blas_prec_double;
+ break;
+ case 2:
+ default:
+ eps_int = power(2, -BITS_E);
+ un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_extra),
+ (double) BLAS_fpinfo_x(blas_emin, blas_prec_extra));
+ prec = blas_prec_extra;
+ break;
+ }
+
+ /* vary norm -- underflow, approx 1, overflow */
+ for (norm = NORM_START; norm <= NORM_END; norm++) {
+
+ /* number of tests */
+ for (test_no = 0; test_no < ntests; test_no++) {
+
+ /* vary storage format */
+ for (order_val = ORDER_START; order_val <= ORDER_END; order_val++) {
+
+ order_type = (order_val == 0) ? blas_colmajor : blas_rowmajor;
+
+ /* vary upper / lower variation */
+ for (uplo_val = UPLO_START; uplo_val <= UPLO_END; uplo_val++) {
+
+ uplo_type = (uplo_val == 0) ? blas_upper : blas_lower;
+
+ /* vary lda = n, n+1, 2*n */
+ for (lda_val = LDA_START; lda_val <= LDA_END; lda_val++) {
+
+ lda = (lda_val == 0) ? n : (lda_val == 1) ? n + 1 : 2 * n;
+
+ saved_seed = *seed;
+ /* For the sake of speed, we throw out this case at random */
+ if (xrand(seed) >= test_prob)
+ continue;
+
+ alpha_flag = 0;
+ switch (alpha_val) {
+ case 0:
+ alpha[0] = alpha[1] = 0.0;
+ alpha_flag = 1;
+ break;
+ case 1:
+ alpha[0] = 1.0;
+ alpha[1] = 0.0;
+ alpha_flag = 1;
+ break;
+ }
+ beta_flag = 0;
+ switch (beta_val) {
+ case 0:
+ beta[0] = beta[1] = 0.0;
+ beta_flag = 1;
+ break;
+ case 1:
+ beta[0] = 1.0;
+ beta[1] = 0.0;
+ beta_flag = 1;
+ break;
+ }
+
+ /* finally we are here to generate the test case */
+ BLAS_chemv2_testgen(norm, order_type,
+ uplo_type, n, &alpha, alpha_flag, &beta,
+ beta_flag, a, lda, head_x_gen,
+ tail_x_gen, y_gen, seed, head_r_true,
+ tail_r_true);
+ test_count++;
+
+ /* vary incx = -2, -1, 1, 2 */
+ for (incx_val = INCX_START; incx_val <= INCX_END;
+ incx_val++) {
+
+ incx = incx_val;
+ if (0 == incx)
+ continue;
+
+ /* vary incy = -2, -1, 1, 2 */
+ for (incy_val = INCY_START; incy_val <= INCY_END;
+ incy_val++) {
+
+ incy = incy_val;
+ if (0 == incy)
+ continue;
+
+ /* copy generated vector with appropriate incs. */
+ ccopy_vector(y_gen, n, 1, y, incy);
+ ccopy_vector(head_x_gen, n, 1, head_x, incx);
+ ccopy_vector(tail_x_gen, n, 1, tail_x, incx);
+
+ /* call hemv2 routines to be tested */
+ FPU_FIX_STOP;
+ BLAS_chemv2_x(order_type,
+ uplo_type, n, alpha, a, lda, head_x,
+ tail_x, incx, beta, y, incy, prec);
+ FPU_FIX_START;
+
+ /* now compute the ratio using test_BLAS_xdot */
+ /* copy a row from A, use x, run dot test */
+
+ incyi = incy;
+ incyi *= 2;
+ yi0 = (incy > 0) ? 0 : (-n + 1) * incyi;
+
+ for (i = 0, yi = yi0, ri = 0;
+ i < n; i++, yi += incyi, ri += incri) {
+ che_copy_row(order_type, uplo_type, blas_left_side,
+ n, a, lda, a_vec, i);
+
+ /* just use the x vector - it was unchanged (in theory) */
+ rin[0] = y_gen[i];
+ rin[1] = y_gen[i + 1];
+ rout[0] = y[yi];
+ rout[1] = y[yi + 1];
+ head_r_true_elem[0] = head_r_true[ri];
+ head_r_true_elem[1] = head_r_true[ri + 1];
+ tail_r_true_elem[0] = tail_r_true[ri];
+ tail_r_true_elem[1] = tail_r_true[ri + 1];
+
+ test_BLAS_cdot2(n, blas_no_conj, alpha, beta,
+ rin, rout, head_r_true_elem,
+ tail_r_true_elem, a_vec, 1, head_x,
+ tail_x, incx, eps_int, un_int,
+ &ratios[i]);
+
+ /* take the max ratio */
+ if (i == 0) {
+ ratio = ratios[0];
+
+ /* The !<= below causes NaN errors to be included.
+ * Note that (NaN > 0) is false */
+ } else if (!(ratios[i] <= ratio)) {
+ ratio = ratios[i];
+ }
+
+ } /* end of dot-test loop */
+
+
+ /* The !<= below causes NaN errors to be included.
+ * Note that (NaN > 0) is false */
+ if (!(ratio <= thresh)) {
+
+ if (debug == 3) {
+ printf("\n\t\tTest # %d\n", test_count);
+ printf("y type : c, a type : c, x type : c\n");
+ printf("Seed = %d\t", saved_seed);
+ printf("n %d\n", n);
+ printf("LDA %d INCX %d INCY %d\n", lda, incx,
+ incx);
+
+ if (order_type == blas_rowmajor)
+ printf("row ");
+ else
+ printf("col ");
+
+ if (uplo_type == blas_upper)
+ printf("upper ");
+ else
+ printf("lower ");
+
+ printf("NORM %d, ALPHA %d, BETA %d\n",
+ norm, alpha_val, beta_val);
+
+ /* print out info */
+ printf("alpha = ");
+ printf("(%16.8e, %16.8e)", alpha[0], alpha[1]);;
+ printf(" ");
+ printf("beta = ");
+ printf("(%16.8e, %16.8e)", beta[0], beta[1]);;
+ printf("\n");
+
+ printf("a\n");
+ che_print_matrix(a, n, lda, order_type, uplo_type);
+ cprint_vector(head_x, n, incx, "head_x");
+ cprint_vector(tail_x, n, incx, "tail_x");
+ cprint_vector(y_gen, n, incy, "y_gen");
+ cprint_vector(y, n, incy, "y");
+ zprint_vector(head_r_true, n, 1, "head_r_true");
+ dprint_vector(ratios, n, 1, "ratios");
+ printf("ratio = %g\n", ratio);
+ }
+ bad_ratio_count++;
+ if (bad_ratio_count >= MAX_BAD_TESTS) {
+ printf("\ntoo many failures, exiting....");
+ printf("\nTesting and compilation");
+ printf(" are incomplete\n\n");
+ goto end;
+ }
+ if (!(ratio <= TOTAL_FAILURE_THRESHOLD)) {
+ printf("\nFlagrant ratio error, exiting...");
+ printf("\nTesting and compilation");
+ printf(" are incomplete\n\n");
+ goto end;
+ }
+ }
+
+ if (!(ratio <= ratio_max))
+ ratio_max = ratio;
+ if (ratio != 0.0 && !(ratio >= ratio_min))
+ ratio_min = ratio;
+
+ } /* end of incy loop */
+
+ } /* end of incx loop */
+
+ } /* end of lda loop */
+
+ } /* end of uplo loop */
+
+ } /* end of order loop */
+
+ } /* end of nr test loop */
+
+ } /* end of norm loop */
+
+
+ } /* end of prec loop */
+
+ } /* end of beta loop */
+
+ } /* end of alpha loop */
+
+end:
+ FPU_FIX_STOP;
+
+ blas_free(y);
+ blas_free(a);
+ blas_free(y_gen);
+ blas_free(head_x);
+ blas_free(tail_x);
+ blas_free(head_x_gen);
+ blas_free(tail_x_gen);
+ blas_free(head_r_true);
+ blas_free(tail_r_true);
+ blas_free(ratios);
+ blas_free(a_vec);
+
+ *max_ratio = ratio_max;
+ *min_ratio = ratio_min;
+ *num_tests = test_count;
+ *num_bad_ratio = bad_ratio_count;
+
+}
+void do_test_zhemv2_x
+ (int n,
+ int ntests, int *seed, double thresh, int debug, float test_prob,
+ double *min_ratio, double *max_ratio, int *num_bad_ratio, int *num_tests) {
+
+ /* Function name */
+ const char fname[] = "do_test_zhemv2_x";
+ int i;
+ int yi;
+ int incyi, yi0;
+ int test_count;
+ int bad_ratio_count;
+ int ri;
+ int incri = 1;
+ int incx, incy;
+ double ratio;
+ double ratio_min, ratio_max;
+ double eps_int; /* internal machine epsilon */
+ double un_int; /* internal underflow threshold */
+
+ double rin[2];
+ double rout[2];
+ double head_r_true_elem[2], tail_r_true_elem[2];
+
+ enum blas_order_type order_type;
+ enum blas_uplo_type uplo_type;
+ enum blas_prec_type prec;
+
+ int order_val, uplo_val;
+ int lda_val, incx_val, incy_val;
+ int alpha_val, beta_val;
+
+ int prec_val;
+
+ int lda;
+ int alpha_flag, beta_flag;
+ int saved_seed;
+ int norm;
+ int test_no;
+
+ double alpha[2];
+ double beta[2];
+ double *a;
+ double *head_x;
+ double *tail_x;
+ double *y;
+ double *a_vec;
+ double *y_gen;
+ double *head_x_gen;
+ double *tail_x_gen;
+ double *ratios;
+
+ /* true result calculated by testgen, in double-double */
+ double *head_r_true, *tail_r_true;
+
+
+ FPU_FIX_DECL;
+
+ if (n < 0)
+ BLAS_error(fname, -1, n, NULL);
+ if (ntests < 0)
+ BLAS_error(fname, -2, ntests, NULL);
+
+ /* initialization */
+ saved_seed = *seed;
+ ratio = 0.0;
+ ratio_min = 1e308;
+ ratio_max = 0.0;
+
+ *num_tests = 0;
+ *num_bad_ratio = 0;
+ *min_ratio = 0.0;
+ *max_ratio = 0.0;
+
+ if (n == 0)
+ return;
+ incri *= 2;
+
+ FPU_FIX_START;
+
+ y = (double *) blas_malloc(2 * n * sizeof(double) * 2);
+ if (2 * n > 0 && y == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ y_gen = (double *) blas_malloc(n * sizeof(double) * 2);
+ if (n > 0 && y_gen == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ head_x_gen = (double *) blas_malloc(n * sizeof(double) * 2);
+ if (n > 0 && head_x_gen == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ tail_x_gen = (double *) blas_malloc(n * sizeof(double) * 2);
+ if (n > 0 && tail_x_gen == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ a = (double *) blas_malloc(2 * n * n * sizeof(double) * 2);
+ if (2 * n * n > 0 && a == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ head_x = (double *) blas_malloc(2 * n * sizeof(double) * 2);
+ if (2 * n > 0 && head_x == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ tail_x = (double *) blas_malloc(2 * n * sizeof(double) * 2);
+ if (2 * n > 0 && tail_x == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ a_vec = (double *) blas_malloc(n * sizeof(double) * 2);
+ if (n > 0 && a_vec == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ head_r_true = (double *) blas_malloc(n * sizeof(double) * 2);
+ tail_r_true = (double *) blas_malloc(n * sizeof(double) * 2);
+ if (n > 0 && (head_r_true == NULL || tail_r_true == NULL)) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ ratios = (double *) blas_malloc(n * sizeof(double));
+ if (n > 0 && ratios == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+
+ test_count = 0;
+ bad_ratio_count = 0;
+
+ /* vary alpha */
+ for (alpha_val = ALPHA_START; alpha_val <= ALPHA_END; alpha_val++) {
+
+ alpha_flag = 0;
+ switch (alpha_val) {
+ case 0:
+ alpha[0] = alpha[1] = 0.0;
+ alpha_flag = 1;
+ break;
+ case 1:
+ alpha[0] = 1.0;
+ alpha[1] = 0.0;
+ alpha_flag = 1;
+ break;
+ }
+
+ /* vary beta */
+ for (beta_val = BETA_START; beta_val <= BETA_END; beta_val++) {
+ beta_flag = 0;
+ switch (beta_val) {
+ case 0:
+ beta[0] = beta[1] = 0.0;
+ beta_flag = 1;
+ break;
+ case 1:
+ beta[0] = 1.0;
+ beta[1] = 0.0;
+ beta_flag = 1;
+ break;
+ }
+
+
+ /* varying extra precs */
+ for (prec_val = PREC_START; prec_val <= PREC_END; prec_val++) {
+ switch (prec_val) {
+ case 0:
+ eps_int = power(2, -BITS_D);
+ un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
+ (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
+ prec = blas_prec_double;
+ break;
+ case 1:
+ eps_int = power(2, -BITS_D);
+ un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
+ (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
+ prec = blas_prec_double;
+ break;
+ case 2:
+ default:
+ eps_int = power(2, -BITS_E);
+ un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_extra),
+ (double) BLAS_fpinfo_x(blas_emin, blas_prec_extra));
+ prec = blas_prec_extra;
+ break;
+ }
+
+ /* vary norm -- underflow, approx 1, overflow */
+ for (norm = NORM_START; norm <= NORM_END; norm++) {
+
+ /* number of tests */
+ for (test_no = 0; test_no < ntests; test_no++) {
+
+ /* vary storage format */
+ for (order_val = ORDER_START; order_val <= ORDER_END; order_val++) {
+
+ order_type = (order_val == 0) ? blas_colmajor : blas_rowmajor;
+
+ /* vary upper / lower variation */
+ for (uplo_val = UPLO_START; uplo_val <= UPLO_END; uplo_val++) {
+
+ uplo_type = (uplo_val == 0) ? blas_upper : blas_lower;
+
+ /* vary lda = n, n+1, 2*n */
+ for (lda_val = LDA_START; lda_val <= LDA_END; lda_val++) {
+
+ lda = (lda_val == 0) ? n : (lda_val == 1) ? n + 1 : 2 * n;
+
+ saved_seed = *seed;
+ /* For the sake of speed, we throw out this case at random */
+ if (xrand(seed) >= test_prob)
+ continue;
+
+ alpha_flag = 0;
+ switch (alpha_val) {
+ case 0:
+ alpha[0] = alpha[1] = 0.0;
+ alpha_flag = 1;
+ break;
+ case 1:
+ alpha[0] = 1.0;
+ alpha[1] = 0.0;
+ alpha_flag = 1;
+ break;
+ }
+ beta_flag = 0;
+ switch (beta_val) {
+ case 0:
+ beta[0] = beta[1] = 0.0;
+ beta_flag = 1;
+ break;
+ case 1:
+ beta[0] = 1.0;
+ beta[1] = 0.0;
+ beta_flag = 1;
+ break;
+ }
+
+ /* finally we are here to generate the test case */
+ BLAS_zhemv2_testgen(norm, order_type,
+ uplo_type, n, &alpha, alpha_flag, &beta,
+ beta_flag, a, lda, head_x_gen,
+ tail_x_gen, y_gen, seed, head_r_true,
+ tail_r_true);
+ test_count++;
+
+ /* vary incx = -2, -1, 1, 2 */
+ for (incx_val = INCX_START; incx_val <= INCX_END;
+ incx_val++) {
+
+ incx = incx_val;
+ if (0 == incx)
+ continue;
+
+ /* vary incy = -2, -1, 1, 2 */
+ for (incy_val = INCY_START; incy_val <= INCY_END;
+ incy_val++) {
+
+ incy = incy_val;
+ if (0 == incy)
+ continue;
+
+ /* copy generated vector with appropriate incs. */
+ zcopy_vector(y_gen, n, 1, y, incy);
+ zcopy_vector(head_x_gen, n, 1, head_x, incx);
+ zcopy_vector(tail_x_gen, n, 1, tail_x, incx);
+
+ /* call hemv2 routines to be tested */
+ FPU_FIX_STOP;
+ BLAS_zhemv2_x(order_type,
+ uplo_type, n, alpha, a, lda, head_x,
+ tail_x, incx, beta, y, incy, prec);
+ FPU_FIX_START;
+
+ /* now compute the ratio using test_BLAS_xdot */
+ /* copy a row from A, use x, run dot test */
+
+ incyi = incy;
+ incyi *= 2;
+ yi0 = (incy > 0) ? 0 : (-n + 1) * incyi;
+
+ for (i = 0, yi = yi0, ri = 0;
+ i < n; i++, yi += incyi, ri += incri) {
+ zhe_copy_row(order_type, uplo_type, blas_left_side,
+ n, a, lda, a_vec, i);
+
+ /* just use the x vector - it was unchanged (in theory) */
+ rin[0] = y_gen[i];
+ rin[1] = y_gen[i + 1];
+ rout[0] = y[yi];
+ rout[1] = y[yi + 1];
+ head_r_true_elem[0] = head_r_true[ri];
+ head_r_true_elem[1] = head_r_true[ri + 1];
+ tail_r_true_elem[0] = tail_r_true[ri];
+ tail_r_true_elem[1] = tail_r_true[ri + 1];
+
+ test_BLAS_zdot2(n, blas_no_conj, alpha, beta,
+ rin, rout, head_r_true_elem,
+ tail_r_true_elem, a_vec, 1, head_x,
+ tail_x, incx, eps_int, un_int,
+ &ratios[i]);
+
+ /* take the max ratio */
+ if (i == 0) {
+ ratio = ratios[0];
+
+ /* The !<= below causes NaN errors to be included.
+ * Note that (NaN > 0) is false */
+ } else if (!(ratios[i] <= ratio)) {
+ ratio = ratios[i];
+ }
+
+ } /* end of dot-test loop */
+
+
+ /* The !<= below causes NaN errors to be included.
+ * Note that (NaN > 0) is false */
+ if (!(ratio <= thresh)) {
+
+ if (debug == 3) {
+ printf("\n\t\tTest # %d\n", test_count);
+ printf("y type : z, a type : z, x type : z\n");
+ printf("Seed = %d\t", saved_seed);
+ printf("n %d\n", n);
+ printf("LDA %d INCX %d INCY %d\n", lda, incx,
+ incx);
+
+ if (order_type == blas_rowmajor)
+ printf("row ");
+ else
+ printf("col ");
+
+ if (uplo_type == blas_upper)
+ printf("upper ");
+ else
+ printf("lower ");
+
+ printf("NORM %d, ALPHA %d, BETA %d\n",
+ norm, alpha_val, beta_val);
+
+ /* print out info */
+ printf("alpha = ");
+ printf("(%24.16e, %24.16e)", alpha[0], alpha[1]);;
+ printf(" ");
+ printf("beta = ");
+ printf("(%24.16e, %24.16e)", beta[0], beta[1]);;
+ printf("\n");
+
+ printf("a\n");
+ zhe_print_matrix(a, n, lda, order_type, uplo_type);
+ zprint_vector(head_x, n, incx, "head_x");
+ zprint_vector(tail_x, n, incx, "tail_x");
+ zprint_vector(y_gen, n, incy, "y_gen");
+ zprint_vector(y, n, incy, "y");
+ zprint_vector(head_r_true, n, 1, "head_r_true");
+ dprint_vector(ratios, n, 1, "ratios");
+ printf("ratio = %g\n", ratio);
+ }
+ bad_ratio_count++;
+ if (bad_ratio_count >= MAX_BAD_TESTS) {
+ printf("\ntoo many failures, exiting....");
+ printf("\nTesting and compilation");
+ printf(" are incomplete\n\n");
+ goto end;
+ }
+ if (!(ratio <= TOTAL_FAILURE_THRESHOLD)) {
+ printf("\nFlagrant ratio error, exiting...");
+ printf("\nTesting and compilation");
+ printf(" are incomplete\n\n");
+ goto end;
+ }
+ }
+
+ if (!(ratio <= ratio_max))
+ ratio_max = ratio;
+ if (ratio != 0.0 && !(ratio >= ratio_min))
+ ratio_min = ratio;
+
+ } /* end of incy loop */
+
+ } /* end of incx loop */
+
+ } /* end of lda loop */
+
+ } /* end of uplo loop */
+
+ } /* end of order loop */
+
+ } /* end of nr test loop */
+
+ } /* end of norm loop */
+
+
+ } /* end of prec loop */
+
+ } /* end of beta loop */
+
+ } /* end of alpha loop */
+
+end:
+ FPU_FIX_STOP;
+
+ blas_free(y);
+ blas_free(a);
+ blas_free(y_gen);
+ blas_free(head_x);
+ blas_free(tail_x);
+ blas_free(head_x_gen);
+ blas_free(tail_x_gen);
+ blas_free(head_r_true);
+ blas_free(tail_r_true);
+ blas_free(ratios);
+ blas_free(a_vec);
+
+ *max_ratio = ratio_max;
+ *min_ratio = ratio_min;
+ *num_tests = test_count;
+ *num_bad_ratio = bad_ratio_count;
+
+}
+void do_test_zhemv2_z_c_x
+ (int n,
+ int ntests, int *seed, double thresh, int debug, float test_prob,
+ double *min_ratio, double *max_ratio, int *num_bad_ratio, int *num_tests) {
+
+ /* Function name */
+ const char fname[] = "do_test_zhemv2_z_c_x";
+ int i;
+ int yi;
+ int incyi, yi0;
+ int test_count;
+ int bad_ratio_count;
+ int ri;
+ int incri = 1;
+ int incx, incy;
+ double ratio;
+ double ratio_min, ratio_max;
+ double eps_int; /* internal machine epsilon */
+ double un_int; /* internal underflow threshold */
+
+ double rin[2];
+ double rout[2];
+ double head_r_true_elem[2], tail_r_true_elem[2];
+
+ enum blas_order_type order_type;
+ enum blas_uplo_type uplo_type;
+ enum blas_prec_type prec;
+
+ int order_val, uplo_val;
+ int lda_val, incx_val, incy_val;
+ int alpha_val, beta_val;
+
+ int prec_val;
+
+ int lda;
+ int alpha_flag, beta_flag;
+ int saved_seed;
+ int norm;
+ int test_no;
+
+ double alpha[2];
+ double beta[2];
+ double *a;
+ float *head_x;
+ float *tail_x;
+ double *y;
+ double *a_vec;
+ double *y_gen;
+ float *head_x_gen;
+ float *tail_x_gen;
+ double *ratios;
+
+ /* true result calculated by testgen, in double-double */
+ double *head_r_true, *tail_r_true;
+
+
+ FPU_FIX_DECL;
+
+ if (n < 0)
+ BLAS_error(fname, -1, n, NULL);
+ if (ntests < 0)
+ BLAS_error(fname, -2, ntests, NULL);
+
+ /* initialization */
+ saved_seed = *seed;
+ ratio = 0.0;
+ ratio_min = 1e308;
+ ratio_max = 0.0;
+
+ *num_tests = 0;
+ *num_bad_ratio = 0;
+ *min_ratio = 0.0;
+ *max_ratio = 0.0;
+
+ if (n == 0)
+ return;
+ incri *= 2;
+
+ FPU_FIX_START;
+
+ y = (double *) blas_malloc(2 * n * sizeof(double) * 2);
+ if (2 * n > 0 && y == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ y_gen = (double *) blas_malloc(n * sizeof(double) * 2);
+ if (n > 0 && y_gen == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ head_x_gen = (float *) blas_malloc(n * sizeof(float) * 2);
+ if (n > 0 && head_x_gen == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ tail_x_gen = (float *) blas_malloc(n * sizeof(float) * 2);
+ if (n > 0 && tail_x_gen == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ a = (double *) blas_malloc(2 * n * n * sizeof(double) * 2);
+ if (2 * n * n > 0 && a == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ head_x = (float *) blas_malloc(2 * n * sizeof(float) * 2);
+ if (2 * n > 0 && head_x == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ tail_x = (float *) blas_malloc(2 * n * sizeof(float) * 2);
+ if (2 * n > 0 && tail_x == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ a_vec = (double *) blas_malloc(n * sizeof(double) * 2);
+ if (n > 0 && a_vec == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ head_r_true = (double *) blas_malloc(n * sizeof(double) * 2);
+ tail_r_true = (double *) blas_malloc(n * sizeof(double) * 2);
+ if (n > 0 && (head_r_true == NULL || tail_r_true == NULL)) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ ratios = (double *) blas_malloc(n * sizeof(double));
+ if (n > 0 && ratios == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+
+ test_count = 0;
+ bad_ratio_count = 0;
+
+ /* vary alpha */
+ for (alpha_val = ALPHA_START; alpha_val <= ALPHA_END; alpha_val++) {
+
+ alpha_flag = 0;
+ switch (alpha_val) {
+ case 0:
+ alpha[0] = alpha[1] = 0.0;
+ alpha_flag = 1;
+ break;
+ case 1:
+ alpha[0] = 1.0;
+ alpha[1] = 0.0;
+ alpha_flag = 1;
+ break;
+ }
+
+ /* vary beta */
+ for (beta_val = BETA_START; beta_val <= BETA_END; beta_val++) {
+ beta_flag = 0;
+ switch (beta_val) {
+ case 0:
+ beta[0] = beta[1] = 0.0;
+ beta_flag = 1;
+ break;
+ case 1:
+ beta[0] = 1.0;
+ beta[1] = 0.0;
+ beta_flag = 1;
+ break;
+ }
+
+
+ /* varying extra precs */
+ for (prec_val = PREC_START; prec_val <= PREC_END; prec_val++) {
+ switch (prec_val) {
+ case 0:
+ eps_int = power(2, -BITS_D);
+ un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
+ (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
+ prec = blas_prec_double;
+ break;
+ case 1:
+ eps_int = power(2, -BITS_D);
+ un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
+ (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
+ prec = blas_prec_double;
+ break;
+ case 2:
+ default:
+ eps_int = power(2, -BITS_E);
+ un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_extra),
+ (double) BLAS_fpinfo_x(blas_emin, blas_prec_extra));
+ prec = blas_prec_extra;
+ break;
+ }
+
+ /* vary norm -- underflow, approx 1, overflow */
+ for (norm = NORM_START; norm <= NORM_END; norm++) {
+
+ /* number of tests */
+ for (test_no = 0; test_no < ntests; test_no++) {
+
+ /* vary storage format */
+ for (order_val = ORDER_START; order_val <= ORDER_END; order_val++) {
+
+ order_type = (order_val == 0) ? blas_colmajor : blas_rowmajor;
+
+ /* vary upper / lower variation */
+ for (uplo_val = UPLO_START; uplo_val <= UPLO_END; uplo_val++) {
+
+ uplo_type = (uplo_val == 0) ? blas_upper : blas_lower;
+
+ /* vary lda = n, n+1, 2*n */
+ for (lda_val = LDA_START; lda_val <= LDA_END; lda_val++) {
+
+ lda = (lda_val == 0) ? n : (lda_val == 1) ? n + 1 : 2 * n;
+
+ saved_seed = *seed;
+ /* For the sake of speed, we throw out this case at random */
+ if (xrand(seed) >= test_prob)
+ continue;
+
+ alpha_flag = 0;
+ switch (alpha_val) {
+ case 0:
+ alpha[0] = alpha[1] = 0.0;
+ alpha_flag = 1;
+ break;
+ case 1:
+ alpha[0] = 1.0;
+ alpha[1] = 0.0;
+ alpha_flag = 1;
+ break;
+ }
+ beta_flag = 0;
+ switch (beta_val) {
+ case 0:
+ beta[0] = beta[1] = 0.0;
+ beta_flag = 1;
+ break;
+ case 1:
+ beta[0] = 1.0;
+ beta[1] = 0.0;
+ beta_flag = 1;
+ break;
+ }
+
+ /* finally we are here to generate the test case */
+ BLAS_zhemv2_z_c_testgen(norm, order_type,
+ uplo_type, n, &alpha, alpha_flag,
+ &beta, beta_flag, a, lda,
+ head_x_gen, tail_x_gen, y_gen, seed,
+ head_r_true, tail_r_true);
+ test_count++;
+
+ /* vary incx = -2, -1, 1, 2 */
+ for (incx_val = INCX_START; incx_val <= INCX_END;
+ incx_val++) {
+
+ incx = incx_val;
+ if (0 == incx)
+ continue;
+
+ /* vary incy = -2, -1, 1, 2 */
+ for (incy_val = INCY_START; incy_val <= INCY_END;
+ incy_val++) {
+
+ incy = incy_val;
+ if (0 == incy)
+ continue;
+
+ /* copy generated vector with appropriate incs. */
+ zcopy_vector(y_gen, n, 1, y, incy);
+ ccopy_vector(head_x_gen, n, 1, head_x, incx);
+ ccopy_vector(tail_x_gen, n, 1, tail_x, incx);
+
+ /* call hemv2 routines to be tested */
+ FPU_FIX_STOP;
+ BLAS_zhemv2_z_c_x(order_type,
+ uplo_type, n, alpha, a, lda, head_x,
+ tail_x, incx, beta, y, incy, prec);
+ FPU_FIX_START;
+
+ /* now compute the ratio using test_BLAS_xdot */
+ /* copy a row from A, use x, run dot test */
+
+ incyi = incy;
+ incyi *= 2;
+ yi0 = (incy > 0) ? 0 : (-n + 1) * incyi;
+
+ for (i = 0, yi = yi0, ri = 0;
+ i < n; i++, yi += incyi, ri += incri) {
+ zhe_copy_row(order_type, uplo_type, blas_left_side,
+ n, a, lda, a_vec, i);
+
+ /* just use the x vector - it was unchanged (in theory) */
+ rin[0] = y_gen[i];
+ rin[1] = y_gen[i + 1];
+ rout[0] = y[yi];
+ rout[1] = y[yi + 1];
+ head_r_true_elem[0] = head_r_true[ri];
+ head_r_true_elem[1] = head_r_true[ri + 1];
+ tail_r_true_elem[0] = tail_r_true[ri];
+ tail_r_true_elem[1] = tail_r_true[ri + 1];
+
+ test_BLAS_zdot2_z_c(n, blas_no_conj, alpha, beta,
+ rin, rout, head_r_true_elem,
+ tail_r_true_elem, a_vec, 1,
+ head_x, tail_x, incx, eps_int,
+ un_int, &ratios[i]);
+
+ /* take the max ratio */
+ if (i == 0) {
+ ratio = ratios[0];
+
+ /* The !<= below causes NaN errors to be included.
+ * Note that (NaN > 0) is false */
+ } else if (!(ratios[i] <= ratio)) {
+ ratio = ratios[i];
+ }
+
+ } /* end of dot-test loop */
+
+
+ /* The !<= below causes NaN errors to be included.
+ * Note that (NaN > 0) is false */
+ if (!(ratio <= thresh)) {
+
+ if (debug == 3) {
+ printf("\n\t\tTest # %d\n", test_count);
+ printf("y type : z, a type : z, x type : c\n");
+ printf("Seed = %d\t", saved_seed);
+ printf("n %d\n", n);
+ printf("LDA %d INCX %d INCY %d\n", lda, incx,
+ incx);
+
+ if (order_type == blas_rowmajor)
+ printf("row ");
+ else
+ printf("col ");
+
+ if (uplo_type == blas_upper)
+ printf("upper ");
+ else
+ printf("lower ");
+
+ printf("NORM %d, ALPHA %d, BETA %d\n",
+ norm, alpha_val, beta_val);
+
+ /* print out info */
+ printf("alpha = ");
+ printf("(%24.16e, %24.16e)", alpha[0], alpha[1]);;
+ printf(" ");
+ printf("beta = ");
+ printf("(%24.16e, %24.16e)", beta[0], beta[1]);;
+ printf("\n");
+
+ printf("a\n");
+ zhe_print_matrix(a, n, lda, order_type, uplo_type);
+ cprint_vector(head_x, n, incx, "head_x");
+ cprint_vector(tail_x, n, incx, "tail_x");
+ zprint_vector(y_gen, n, incy, "y_gen");
+ zprint_vector(y, n, incy, "y");
+ zprint_vector(head_r_true, n, 1, "head_r_true");
+ dprint_vector(ratios, n, 1, "ratios");
+ printf("ratio = %g\n", ratio);
+ }
+ bad_ratio_count++;
+ if (bad_ratio_count >= MAX_BAD_TESTS) {
+ printf("\ntoo many failures, exiting....");
+ printf("\nTesting and compilation");
+ printf(" are incomplete\n\n");
+ goto end;
+ }
+ if (!(ratio <= TOTAL_FAILURE_THRESHOLD)) {
+ printf("\nFlagrant ratio error, exiting...");
+ printf("\nTesting and compilation");
+ printf(" are incomplete\n\n");
+ goto end;
+ }
+ }
+
+ if (!(ratio <= ratio_max))
+ ratio_max = ratio;
+ if (ratio != 0.0 && !(ratio >= ratio_min))
+ ratio_min = ratio;
+
+ } /* end of incy loop */
+
+ } /* end of incx loop */
+
+ } /* end of lda loop */
+
+ } /* end of uplo loop */
+
+ } /* end of order loop */
+
+ } /* end of nr test loop */
+
+ } /* end of norm loop */
+
+
+ } /* end of prec loop */
+
+ } /* end of beta loop */
+
+ } /* end of alpha loop */
+
+end:
+ FPU_FIX_STOP;
+
+ blas_free(y);
+ blas_free(a);
+ blas_free(y_gen);
+ blas_free(head_x);
+ blas_free(tail_x);
+ blas_free(head_x_gen);
+ blas_free(tail_x_gen);
+ blas_free(head_r_true);
+ blas_free(tail_r_true);
+ blas_free(ratios);
+ blas_free(a_vec);
+
+ *max_ratio = ratio_max;
+ *min_ratio = ratio_min;
+ *num_tests = test_count;
+ *num_bad_ratio = bad_ratio_count;
+
+}
+void do_test_zhemv2_c_z_x
+ (int n,
+ int ntests, int *seed, double thresh, int debug, float test_prob,
+ double *min_ratio, double *max_ratio, int *num_bad_ratio, int *num_tests) {
+
+ /* Function name */
+ const char fname[] = "do_test_zhemv2_c_z_x";
+ int i;
+ int yi;
+ int incyi, yi0;
+ int test_count;
+ int bad_ratio_count;
+ int ri;
+ int incri = 1;
+ int incx, incy;
+ double ratio;
+ double ratio_min, ratio_max;
+ double eps_int; /* internal machine epsilon */
+ double un_int; /* internal underflow threshold */
+
+ double rin[2];
+ double rout[2];
+ double head_r_true_elem[2], tail_r_true_elem[2];
+
+ enum blas_order_type order_type;
+ enum blas_uplo_type uplo_type;
+ enum blas_prec_type prec;
+
+ int order_val, uplo_val;
+ int lda_val, incx_val, incy_val;
+ int alpha_val, beta_val;
+
+ int prec_val;
+
+ int lda;
+ int alpha_flag, beta_flag;
+ int saved_seed;
+ int norm;
+ int test_no;
+
+ double alpha[2];
+ double beta[2];
+ float *a;
+ double *head_x;
+ double *tail_x;
+ double *y;
+ float *a_vec;
+ double *y_gen;
+ double *head_x_gen;
+ double *tail_x_gen;
+ double *ratios;
+
+ /* true result calculated by testgen, in double-double */
+ double *head_r_true, *tail_r_true;
+
+
+ FPU_FIX_DECL;
+
+ if (n < 0)
+ BLAS_error(fname, -1, n, NULL);
+ if (ntests < 0)
+ BLAS_error(fname, -2, ntests, NULL);
+
+ /* initialization */
+ saved_seed = *seed;
+ ratio = 0.0;
+ ratio_min = 1e308;
+ ratio_max = 0.0;
+
+ *num_tests = 0;
+ *num_bad_ratio = 0;
+ *min_ratio = 0.0;
+ *max_ratio = 0.0;
+
+ if (n == 0)
+ return;
+ incri *= 2;
+
+ FPU_FIX_START;
+
+ y = (double *) blas_malloc(2 * n * sizeof(double) * 2);
+ if (2 * n > 0 && y == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ y_gen = (double *) blas_malloc(n * sizeof(double) * 2);
+ if (n > 0 && y_gen == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ head_x_gen = (double *) blas_malloc(n * sizeof(double) * 2);
+ if (n > 0 && head_x_gen == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ tail_x_gen = (double *) blas_malloc(n * sizeof(double) * 2);
+ if (n > 0 && tail_x_gen == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ a = (float *) blas_malloc(2 * n * n * sizeof(float) * 2);
+ if (2 * n * n > 0 && a == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ head_x = (double *) blas_malloc(2 * n * sizeof(double) * 2);
+ if (2 * n > 0 && head_x == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ tail_x = (double *) blas_malloc(2 * n * sizeof(double) * 2);
+ if (2 * n > 0 && tail_x == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ a_vec = (float *) blas_malloc(n * sizeof(float) * 2);
+ if (n > 0 && a_vec == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ head_r_true = (double *) blas_malloc(n * sizeof(double) * 2);
+ tail_r_true = (double *) blas_malloc(n * sizeof(double) * 2);
+ if (n > 0 && (head_r_true == NULL || tail_r_true == NULL)) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ ratios = (double *) blas_malloc(n * sizeof(double));
+ if (n > 0 && ratios == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+
+ test_count = 0;
+ bad_ratio_count = 0;
+
+ /* vary alpha */
+ for (alpha_val = ALPHA_START; alpha_val <= ALPHA_END; alpha_val++) {
+
+ alpha_flag = 0;
+ switch (alpha_val) {
+ case 0:
+ alpha[0] = alpha[1] = 0.0;
+ alpha_flag = 1;
+ break;
+ case 1:
+ alpha[0] = 1.0;
+ alpha[1] = 0.0;
+ alpha_flag = 1;
+ break;
+ }
+
+ /* vary beta */
+ for (beta_val = BETA_START; beta_val <= BETA_END; beta_val++) {
+ beta_flag = 0;
+ switch (beta_val) {
+ case 0:
+ beta[0] = beta[1] = 0.0;
+ beta_flag = 1;
+ break;
+ case 1:
+ beta[0] = 1.0;
+ beta[1] = 0.0;
+ beta_flag = 1;
+ break;
+ }
+
+
+ /* varying extra precs */
+ for (prec_val = PREC_START; prec_val <= PREC_END; prec_val++) {
+ switch (prec_val) {
+ case 0:
+ eps_int = power(2, -BITS_D);
+ un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
+ (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
+ prec = blas_prec_double;
+ break;
+ case 1:
+ eps_int = power(2, -BITS_D);
+ un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
+ (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
+ prec = blas_prec_double;
+ break;
+ case 2:
+ default:
+ eps_int = power(2, -BITS_E);
+ un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_extra),
+ (double) BLAS_fpinfo_x(blas_emin, blas_prec_extra));
+ prec = blas_prec_extra;
+ break;
+ }
+
+ /* vary norm -- underflow, approx 1, overflow */
+ for (norm = NORM_START; norm <= NORM_END; norm++) {
+
+ /* number of tests */
+ for (test_no = 0; test_no < ntests; test_no++) {
+
+ /* vary storage format */
+ for (order_val = ORDER_START; order_val <= ORDER_END; order_val++) {
+
+ order_type = (order_val == 0) ? blas_colmajor : blas_rowmajor;
+
+ /* vary upper / lower variation */
+ for (uplo_val = UPLO_START; uplo_val <= UPLO_END; uplo_val++) {
+
+ uplo_type = (uplo_val == 0) ? blas_upper : blas_lower;
+
+ /* vary lda = n, n+1, 2*n */
+ for (lda_val = LDA_START; lda_val <= LDA_END; lda_val++) {
+
+ lda = (lda_val == 0) ? n : (lda_val == 1) ? n + 1 : 2 * n;
+
+ saved_seed = *seed;
+ /* For the sake of speed, we throw out this case at random */
+ if (xrand(seed) >= test_prob)
+ continue;
+
+ alpha_flag = 0;
+ switch (alpha_val) {
+ case 0:
+ alpha[0] = alpha[1] = 0.0;
+ alpha_flag = 1;
+ break;
+ case 1:
+ alpha[0] = 1.0;
+ alpha[1] = 0.0;
+ alpha_flag = 1;
+ break;
+ }
+ beta_flag = 0;
+ switch (beta_val) {
+ case 0:
+ beta[0] = beta[1] = 0.0;
+ beta_flag = 1;
+ break;
+ case 1:
+ beta[0] = 1.0;
+ beta[1] = 0.0;
+ beta_flag = 1;
+ break;
+ }
+
+ /* finally we are here to generate the test case */
+ BLAS_zhemv2_c_z_testgen(norm, order_type,
+ uplo_type, n, &alpha, alpha_flag,
+ &beta, beta_flag, a, lda,
+ head_x_gen, tail_x_gen, y_gen, seed,
+ head_r_true, tail_r_true);
+ test_count++;
+
+ /* vary incx = -2, -1, 1, 2 */
+ for (incx_val = INCX_START; incx_val <= INCX_END;
+ incx_val++) {
+
+ incx = incx_val;
+ if (0 == incx)
+ continue;
+
+ /* vary incy = -2, -1, 1, 2 */
+ for (incy_val = INCY_START; incy_val <= INCY_END;
+ incy_val++) {
+
+ incy = incy_val;
+ if (0 == incy)
+ continue;
+
+ /* copy generated vector with appropriate incs. */
+ zcopy_vector(y_gen, n, 1, y, incy);
+ zcopy_vector(head_x_gen, n, 1, head_x, incx);
+ zcopy_vector(tail_x_gen, n, 1, tail_x, incx);
+
+ /* call hemv2 routines to be tested */
+ FPU_FIX_STOP;
+ BLAS_zhemv2_c_z_x(order_type,
+ uplo_type, n, alpha, a, lda, head_x,
+ tail_x, incx, beta, y, incy, prec);
+ FPU_FIX_START;
+
+ /* now compute the ratio using test_BLAS_xdot */
+ /* copy a row from A, use x, run dot test */
+
+ incyi = incy;
+ incyi *= 2;
+ yi0 = (incy > 0) ? 0 : (-n + 1) * incyi;
+
+ for (i = 0, yi = yi0, ri = 0;
+ i < n; i++, yi += incyi, ri += incri) {
+ che_copy_row(order_type, uplo_type, blas_left_side,
+ n, a, lda, a_vec, i);
+
+ /* just use the x vector - it was unchanged (in theory) */
+ rin[0] = y_gen[i];
+ rin[1] = y_gen[i + 1];
+ rout[0] = y[yi];
+ rout[1] = y[yi + 1];
+ head_r_true_elem[0] = head_r_true[ri];
+ head_r_true_elem[1] = head_r_true[ri + 1];
+ tail_r_true_elem[0] = tail_r_true[ri];
+ tail_r_true_elem[1] = tail_r_true[ri + 1];
+
+ test_BLAS_zdot2_c_z(n, blas_no_conj, alpha, beta,
+ rin, rout, head_r_true_elem,
+ tail_r_true_elem, a_vec, 1,
+ head_x, tail_x, incx, eps_int,
+ un_int, &ratios[i]);
+
+ /* take the max ratio */
+ if (i == 0) {
+ ratio = ratios[0];
+
+ /* The !<= below causes NaN errors to be included.
+ * Note that (NaN > 0) is false */
+ } else if (!(ratios[i] <= ratio)) {
+ ratio = ratios[i];
+ }
+
+ } /* end of dot-test loop */
+
+
+ /* The !<= below causes NaN errors to be included.
+ * Note that (NaN > 0) is false */
+ if (!(ratio <= thresh)) {
+
+ if (debug == 3) {
+ printf("\n\t\tTest # %d\n", test_count);
+ printf("y type : z, a type : c, x type : z\n");
+ printf("Seed = %d\t", saved_seed);
+ printf("n %d\n", n);
+ printf("LDA %d INCX %d INCY %d\n", lda, incx,
+ incx);
+
+ if (order_type == blas_rowmajor)
+ printf("row ");
+ else
+ printf("col ");
+
+ if (uplo_type == blas_upper)
+ printf("upper ");
+ else
+ printf("lower ");
+
+ printf("NORM %d, ALPHA %d, BETA %d\n",
+ norm, alpha_val, beta_val);
+
+ /* print out info */
+ printf("alpha = ");
+ printf("(%24.16e, %24.16e)", alpha[0], alpha[1]);;
+ printf(" ");
+ printf("beta = ");
+ printf("(%24.16e, %24.16e)", beta[0], beta[1]);;
+ printf("\n");
+
+ printf("a\n");
+ che_print_matrix(a, n, lda, order_type, uplo_type);
+ zprint_vector(head_x, n, incx, "head_x");
+ zprint_vector(tail_x, n, incx, "tail_x");
+ zprint_vector(y_gen, n, incy, "y_gen");
+ zprint_vector(y, n, incy, "y");
+ zprint_vector(head_r_true, n, 1, "head_r_true");
+ dprint_vector(ratios, n, 1, "ratios");
+ printf("ratio = %g\n", ratio);
+ }
+ bad_ratio_count++;
+ if (bad_ratio_count >= MAX_BAD_TESTS) {
+ printf("\ntoo many failures, exiting....");
+ printf("\nTesting and compilation");
+ printf(" are incomplete\n\n");
+ goto end;
+ }
+ if (!(ratio <= TOTAL_FAILURE_THRESHOLD)) {
+ printf("\nFlagrant ratio error, exiting...");
+ printf("\nTesting and compilation");
+ printf(" are incomplete\n\n");
+ goto end;
+ }
+ }
+
+ if (!(ratio <= ratio_max))
+ ratio_max = ratio;
+ if (ratio != 0.0 && !(ratio >= ratio_min))
+ ratio_min = ratio;
+
+ } /* end of incy loop */
+
+ } /* end of incx loop */
+
+ } /* end of lda loop */
+
+ } /* end of uplo loop */
+
+ } /* end of order loop */
+
+ } /* end of nr test loop */
+
+ } /* end of norm loop */
+
+
+ } /* end of prec loop */
+
+ } /* end of beta loop */
+
+ } /* end of alpha loop */
+
+end:
+ FPU_FIX_STOP;
+
+ blas_free(y);
+ blas_free(a);
+ blas_free(y_gen);
+ blas_free(head_x);
+ blas_free(tail_x);
+ blas_free(head_x_gen);
+ blas_free(tail_x_gen);
+ blas_free(head_r_true);
+ blas_free(tail_r_true);
+ blas_free(ratios);
+ blas_free(a_vec);
+
+ *max_ratio = ratio_max;
+ *min_ratio = ratio_min;
+ *num_tests = test_count;
+ *num_bad_ratio = bad_ratio_count;
+
+}
+void do_test_zhemv2_c_c_x
+ (int n,
+ int ntests, int *seed, double thresh, int debug, float test_prob,
+ double *min_ratio, double *max_ratio, int *num_bad_ratio, int *num_tests) {
+
+ /* Function name */
+ const char fname[] = "do_test_zhemv2_c_c_x";
+ int i;
+ int yi;
+ int incyi, yi0;
+ int test_count;
+ int bad_ratio_count;
+ int ri;
+ int incri = 1;
+ int incx, incy;
+ double ratio;
+ double ratio_min, ratio_max;
+ double eps_int; /* internal machine epsilon */
+ double un_int; /* internal underflow threshold */
+
+ double rin[2];
+ double rout[2];
+ double head_r_true_elem[2], tail_r_true_elem[2];
+
+ enum blas_order_type order_type;
+ enum blas_uplo_type uplo_type;
+ enum blas_prec_type prec;
+
+ int order_val, uplo_val;
+ int lda_val, incx_val, incy_val;
+ int alpha_val, beta_val;
+
+ int prec_val;
+
+ int lda;
+ int alpha_flag, beta_flag;
+ int saved_seed;
+ int norm;
+ int test_no;
+
+ double alpha[2];
+ double beta[2];
+ float *a;
+ float *head_x;
+ float *tail_x;
+ double *y;
+ float *a_vec;
+ double *y_gen;
+ float *head_x_gen;
+ float *tail_x_gen;
+ double *ratios;
+
+ /* true result calculated by testgen, in double-double */
+ double *head_r_true, *tail_r_true;
+
+
+ FPU_FIX_DECL;
+
+ if (n < 0)
+ BLAS_error(fname, -1, n, NULL);
+ if (ntests < 0)
+ BLAS_error(fname, -2, ntests, NULL);
+
+ /* initialization */
+ saved_seed = *seed;
+ ratio = 0.0;
+ ratio_min = 1e308;
+ ratio_max = 0.0;
+
+ *num_tests = 0;
+ *num_bad_ratio = 0;
+ *min_ratio = 0.0;
+ *max_ratio = 0.0;
+
+ if (n == 0)
+ return;
+ incri *= 2;
+
+ FPU_FIX_START;
+
+ y = (double *) blas_malloc(2 * n * sizeof(double) * 2);
+ if (2 * n > 0 && y == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ y_gen = (double *) blas_malloc(n * sizeof(double) * 2);
+ if (n > 0 && y_gen == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ head_x_gen = (float *) blas_malloc(n * sizeof(float) * 2);
+ if (n > 0 && head_x_gen == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ tail_x_gen = (float *) blas_malloc(n * sizeof(float) * 2);
+ if (n > 0 && tail_x_gen == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ a = (float *) blas_malloc(2 * n * n * sizeof(float) * 2);
+ if (2 * n * n > 0 && a == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ head_x = (float *) blas_malloc(2 * n * sizeof(float) * 2);
+ if (2 * n > 0 && head_x == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ tail_x = (float *) blas_malloc(2 * n * sizeof(float) * 2);
+ if (2 * n > 0 && tail_x == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ a_vec = (float *) blas_malloc(n * sizeof(float) * 2);
+ if (n > 0 && a_vec == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ head_r_true = (double *) blas_malloc(n * sizeof(double) * 2);
+ tail_r_true = (double *) blas_malloc(n * sizeof(double) * 2);
+ if (n > 0 && (head_r_true == NULL || tail_r_true == NULL)) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ ratios = (double *) blas_malloc(n * sizeof(double));
+ if (n > 0 && ratios == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+
+ test_count = 0;
+ bad_ratio_count = 0;
+
+ /* vary alpha */
+ for (alpha_val = ALPHA_START; alpha_val <= ALPHA_END; alpha_val++) {
+
+ alpha_flag = 0;
+ switch (alpha_val) {
+ case 0:
+ alpha[0] = alpha[1] = 0.0;
+ alpha_flag = 1;
+ break;
+ case 1:
+ alpha[0] = 1.0;
+ alpha[1] = 0.0;
+ alpha_flag = 1;
+ break;
+ }
+
+ /* vary beta */
+ for (beta_val = BETA_START; beta_val <= BETA_END; beta_val++) {
+ beta_flag = 0;
+ switch (beta_val) {
+ case 0:
+ beta[0] = beta[1] = 0.0;
+ beta_flag = 1;
+ break;
+ case 1:
+ beta[0] = 1.0;
+ beta[1] = 0.0;
+ beta_flag = 1;
+ break;
+ }
+
+
+ /* varying extra precs */
+ for (prec_val = PREC_START; prec_val <= PREC_END; prec_val++) {
+ switch (prec_val) {
+ case 0:
+ eps_int = power(2, -BITS_D);
+ un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
+ (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
+ prec = blas_prec_double;
+ break;
+ case 1:
+ eps_int = power(2, -BITS_D);
+ un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
+ (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
+ prec = blas_prec_double;
+ break;
+ case 2:
+ default:
+ eps_int = power(2, -BITS_E);
+ un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_extra),
+ (double) BLAS_fpinfo_x(blas_emin, blas_prec_extra));
+ prec = blas_prec_extra;
+ break;
+ }
+
+ /* vary norm -- underflow, approx 1, overflow */
+ for (norm = NORM_START; norm <= NORM_END; norm++) {
+
+ /* number of tests */
+ for (test_no = 0; test_no < ntests; test_no++) {
+
+ /* vary storage format */
+ for (order_val = ORDER_START; order_val <= ORDER_END; order_val++) {
+
+ order_type = (order_val == 0) ? blas_colmajor : blas_rowmajor;
+
+ /* vary upper / lower variation */
+ for (uplo_val = UPLO_START; uplo_val <= UPLO_END; uplo_val++) {
+
+ uplo_type = (uplo_val == 0) ? blas_upper : blas_lower;
+
+ /* vary lda = n, n+1, 2*n */
+ for (lda_val = LDA_START; lda_val <= LDA_END; lda_val++) {
+
+ lda = (lda_val == 0) ? n : (lda_val == 1) ? n + 1 : 2 * n;
+
+ saved_seed = *seed;
+ /* For the sake of speed, we throw out this case at random */
+ if (xrand(seed) >= test_prob)
+ continue;
+
+ alpha_flag = 0;
+ switch (alpha_val) {
+ case 0:
+ alpha[0] = alpha[1] = 0.0;
+ alpha_flag = 1;
+ break;
+ case 1:
+ alpha[0] = 1.0;
+ alpha[1] = 0.0;
+ alpha_flag = 1;
+ break;
+ }
+ beta_flag = 0;
+ switch (beta_val) {
+ case 0:
+ beta[0] = beta[1] = 0.0;
+ beta_flag = 1;
+ break;
+ case 1:
+ beta[0] = 1.0;
+ beta[1] = 0.0;
+ beta_flag = 1;
+ break;
+ }
+
+ /* finally we are here to generate the test case */
+ BLAS_zhemv2_c_c_testgen(norm, order_type,
+ uplo_type, n, &alpha, alpha_flag,
+ &beta, beta_flag, a, lda,
+ head_x_gen, tail_x_gen, y_gen, seed,
+ head_r_true, tail_r_true);
+ test_count++;
+
+ /* vary incx = -2, -1, 1, 2 */
+ for (incx_val = INCX_START; incx_val <= INCX_END;
+ incx_val++) {
+
+ incx = incx_val;
+ if (0 == incx)
+ continue;
+
+ /* vary incy = -2, -1, 1, 2 */
+ for (incy_val = INCY_START; incy_val <= INCY_END;
+ incy_val++) {
+
+ incy = incy_val;
+ if (0 == incy)
+ continue;
+
+ /* copy generated vector with appropriate incs. */
+ zcopy_vector(y_gen, n, 1, y, incy);
+ ccopy_vector(head_x_gen, n, 1, head_x, incx);
+ ccopy_vector(tail_x_gen, n, 1, tail_x, incx);
+
+ /* call hemv2 routines to be tested */
+ FPU_FIX_STOP;
+ BLAS_zhemv2_c_c_x(order_type,
+ uplo_type, n, alpha, a, lda, head_x,
+ tail_x, incx, beta, y, incy, prec);
+ FPU_FIX_START;
+
+ /* now compute the ratio using test_BLAS_xdot */
+ /* copy a row from A, use x, run dot test */
+
+ incyi = incy;
+ incyi *= 2;
+ yi0 = (incy > 0) ? 0 : (-n + 1) * incyi;
+
+ for (i = 0, yi = yi0, ri = 0;
+ i < n; i++, yi += incyi, ri += incri) {
+ che_copy_row(order_type, uplo_type, blas_left_side,
+ n, a, lda, a_vec, i);
+
+ /* just use the x vector - it was unchanged (in theory) */
+ rin[0] = y_gen[i];
+ rin[1] = y_gen[i + 1];
+ rout[0] = y[yi];
+ rout[1] = y[yi + 1];
+ head_r_true_elem[0] = head_r_true[ri];
+ head_r_true_elem[1] = head_r_true[ri + 1];
+ tail_r_true_elem[0] = tail_r_true[ri];
+ tail_r_true_elem[1] = tail_r_true[ri + 1];
+
+ test_BLAS_zdot2_c_c(n, blas_no_conj, alpha, beta,
+ rin, rout, head_r_true_elem,
+ tail_r_true_elem, a_vec, 1,
+ head_x, tail_x, incx, eps_int,
+ un_int, &ratios[i]);
+
+ /* take the max ratio */
+ if (i == 0) {
+ ratio = ratios[0];
+
+ /* The !<= below causes NaN errors to be included.
+ * Note that (NaN > 0) is false */
+ } else if (!(ratios[i] <= ratio)) {
+ ratio = ratios[i];
+ }
+
+ } /* end of dot-test loop */
+
+
+ /* The !<= below causes NaN errors to be included.
+ * Note that (NaN > 0) is false */
+ if (!(ratio <= thresh)) {
+
+ if (debug == 3) {
+ printf("\n\t\tTest # %d\n", test_count);
+ printf("y type : z, a type : c, x type : c\n");
+ printf("Seed = %d\t", saved_seed);
+ printf("n %d\n", n);
+ printf("LDA %d INCX %d INCY %d\n", lda, incx,
+ incx);
+
+ if (order_type == blas_rowmajor)
+ printf("row ");
+ else
+ printf("col ");
+
+ if (uplo_type == blas_upper)
+ printf("upper ");
+ else
+ printf("lower ");
+
+ printf("NORM %d, ALPHA %d, BETA %d\n",
+ norm, alpha_val, beta_val);
+
+ /* print out info */
+ printf("alpha = ");
+ printf("(%24.16e, %24.16e)", alpha[0], alpha[1]);;
+ printf(" ");
+ printf("beta = ");
+ printf("(%24.16e, %24.16e)", beta[0], beta[1]);;
+ printf("\n");
+
+ printf("a\n");
+ che_print_matrix(a, n, lda, order_type, uplo_type);
+ cprint_vector(head_x, n, incx, "head_x");
+ cprint_vector(tail_x, n, incx, "tail_x");
+ zprint_vector(y_gen, n, incy, "y_gen");
+ zprint_vector(y, n, incy, "y");
+ zprint_vector(head_r_true, n, 1, "head_r_true");
+ dprint_vector(ratios, n, 1, "ratios");
+ printf("ratio = %g\n", ratio);
+ }
+ bad_ratio_count++;
+ if (bad_ratio_count >= MAX_BAD_TESTS) {
+ printf("\ntoo many failures, exiting....");
+ printf("\nTesting and compilation");
+ printf(" are incomplete\n\n");
+ goto end;
+ }
+ if (!(ratio <= TOTAL_FAILURE_THRESHOLD)) {
+ printf("\nFlagrant ratio error, exiting...");
+ printf("\nTesting and compilation");
+ printf(" are incomplete\n\n");
+ goto end;
+ }
+ }
+
+ if (!(ratio <= ratio_max))
+ ratio_max = ratio;
+ if (ratio != 0.0 && !(ratio >= ratio_min))
+ ratio_min = ratio;
+
+ } /* end of incy loop */
+
+ } /* end of incx loop */
+
+ } /* end of lda loop */
+
+ } /* end of uplo loop */
+
+ } /* end of order loop */
+
+ } /* end of nr test loop */
+
+ } /* end of norm loop */
+
+
+ } /* end of prec loop */
+
+ } /* end of beta loop */
+
+ } /* end of alpha loop */
+
+end:
+ FPU_FIX_STOP;
+
+ blas_free(y);
+ blas_free(a);
+ blas_free(y_gen);
+ blas_free(head_x);
+ blas_free(tail_x);
+ blas_free(head_x_gen);
+ blas_free(tail_x_gen);
+ blas_free(head_r_true);
+ blas_free(tail_r_true);
+ blas_free(ratios);
+ blas_free(a_vec);
+
+ *max_ratio = ratio_max;
+ *min_ratio = ratio_min;
+ *num_tests = test_count;
+ *num_bad_ratio = bad_ratio_count;
+
+}
+void do_test_chemv2_c_s_x
+ (int n,
+ int ntests, int *seed, double thresh, int debug, float test_prob,
+ double *min_ratio, double *max_ratio, int *num_bad_ratio, int *num_tests) {
+
+ /* Function name */
+ const char fname[] = "do_test_chemv2_c_s_x";
+ int i;
+ int yi;
+ int incyi, yi0;
+ int test_count;
+ int bad_ratio_count;
+ int ri;
+ int incri = 1;
+ int incx, incy;
+ double ratio;
+ double ratio_min, ratio_max;
+ double eps_int; /* internal machine epsilon */
+ double un_int; /* internal underflow threshold */
+
+ float rin[2];
+ float rout[2];
+ double head_r_true_elem[2], tail_r_true_elem[2];
+
+ enum blas_order_type order_type;
+ enum blas_uplo_type uplo_type;
+ enum blas_prec_type prec;
+
+ int order_val, uplo_val;
+ int lda_val, incx_val, incy_val;
+ int alpha_val, beta_val;
+
+ int prec_val;
+
+ int lda;
+ int alpha_flag, beta_flag;
+ int saved_seed;
+ int norm;
+ int test_no;
+
+ float alpha[2];
+ float beta[2];
+ float *a;
+ float *head_x;
+ float *tail_x;
+ float *y;
+ float *a_vec;
+ float *y_gen;
+ float *head_x_gen;
+ float *tail_x_gen;
+ double *ratios;
+
+ /* true result calculated by testgen, in double-double */
+ double *head_r_true, *tail_r_true;
+
+
+ FPU_FIX_DECL;
+
+ if (n < 0)
+ BLAS_error(fname, -1, n, NULL);
+ if (ntests < 0)
+ BLAS_error(fname, -2, ntests, NULL);
+
+ /* initialization */
+ saved_seed = *seed;
+ ratio = 0.0;
+ ratio_min = 1e308;
+ ratio_max = 0.0;
+
+ *num_tests = 0;
+ *num_bad_ratio = 0;
+ *min_ratio = 0.0;
+ *max_ratio = 0.0;
+
+ if (n == 0)
+ return;
+ incri *= 2;
+
+ FPU_FIX_START;
+
+ y = (float *) blas_malloc(2 * n * sizeof(float) * 2);
+ if (2 * n > 0 && y == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ y_gen = (float *) blas_malloc(n * sizeof(float) * 2);
+ if (n > 0 && y_gen == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ head_x_gen = (float *) blas_malloc(n * sizeof(float));
+ if (n > 0 && head_x_gen == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ tail_x_gen = (float *) blas_malloc(n * sizeof(float));
+ if (n > 0 && tail_x_gen == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ a = (float *) blas_malloc(2 * n * n * sizeof(float) * 2);
+ if (2 * n * n > 0 && a == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ head_x = (float *) blas_malloc(2 * n * sizeof(float));
+ if (2 * n > 0 && head_x == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ tail_x = (float *) blas_malloc(2 * n * sizeof(float));
+ if (2 * n > 0 && tail_x == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ a_vec = (float *) blas_malloc(n * sizeof(float) * 2);
+ if (n > 0 && a_vec == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ head_r_true = (double *) blas_malloc(n * sizeof(double) * 2);
+ tail_r_true = (double *) blas_malloc(n * sizeof(double) * 2);
+ if (n > 0 && (head_r_true == NULL || tail_r_true == NULL)) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ ratios = (double *) blas_malloc(n * sizeof(double));
+ if (n > 0 && ratios == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+
+ test_count = 0;
+ bad_ratio_count = 0;
+
+ /* vary alpha */
+ for (alpha_val = ALPHA_START; alpha_val <= ALPHA_END; alpha_val++) {
+
+ alpha_flag = 0;
+ switch (alpha_val) {
+ case 0:
+ alpha[0] = alpha[1] = 0.0;
+ alpha_flag = 1;
+ break;
+ case 1:
+ alpha[0] = 1.0;
+ alpha[1] = 0.0;
+ alpha_flag = 1;
+ break;
+ }
+
+ /* vary beta */
+ for (beta_val = BETA_START; beta_val <= BETA_END; beta_val++) {
+ beta_flag = 0;
+ switch (beta_val) {
+ case 0:
+ beta[0] = beta[1] = 0.0;
+ beta_flag = 1;
+ break;
+ case 1:
+ beta[0] = 1.0;
+ beta[1] = 0.0;
+ beta_flag = 1;
+ break;
+ }
+
+
+ /* varying extra precs */
+ for (prec_val = PREC_START; prec_val <= PREC_END; prec_val++) {
+ switch (prec_val) {
+ case 0:
+ eps_int = power(2, -BITS_S);
+ un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_single),
+ (double) BLAS_fpinfo_x(blas_emin, blas_prec_single));
+ prec = blas_prec_single;
+ break;
+ case 1:
+ eps_int = power(2, -BITS_D);
+ un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
+ (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
+ prec = blas_prec_double;
+ break;
+ case 2:
+ default:
+ eps_int = power(2, -BITS_E);
+ un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_extra),
+ (double) BLAS_fpinfo_x(blas_emin, blas_prec_extra));
+ prec = blas_prec_extra;
+ break;
+ }
+
+ /* vary norm -- underflow, approx 1, overflow */
+ for (norm = NORM_START; norm <= NORM_END; norm++) {
+
+ /* number of tests */
+ for (test_no = 0; test_no < ntests; test_no++) {
+
+ /* vary storage format */
+ for (order_val = ORDER_START; order_val <= ORDER_END; order_val++) {
+
+ order_type = (order_val == 0) ? blas_colmajor : blas_rowmajor;
+
+ /* vary upper / lower variation */
+ for (uplo_val = UPLO_START; uplo_val <= UPLO_END; uplo_val++) {
+
+ uplo_type = (uplo_val == 0) ? blas_upper : blas_lower;
+
+ /* vary lda = n, n+1, 2*n */
+ for (lda_val = LDA_START; lda_val <= LDA_END; lda_val++) {
+
+ lda = (lda_val == 0) ? n : (lda_val == 1) ? n + 1 : 2 * n;
+
+ saved_seed = *seed;
+ /* For the sake of speed, we throw out this case at random */
+ if (xrand(seed) >= test_prob)
+ continue;
+
+ alpha_flag = 0;
+ switch (alpha_val) {
+ case 0:
+ alpha[0] = alpha[1] = 0.0;
+ alpha_flag = 1;
+ break;
+ case 1:
+ alpha[0] = 1.0;
+ alpha[1] = 0.0;
+ alpha_flag = 1;
+ break;
+ }
+ beta_flag = 0;
+ switch (beta_val) {
+ case 0:
+ beta[0] = beta[1] = 0.0;
+ beta_flag = 1;
+ break;
+ case 1:
+ beta[0] = 1.0;
+ beta[1] = 0.0;
+ beta_flag = 1;
+ break;
+ }
+
+ /* finally we are here to generate the test case */
+ BLAS_chemv2_c_s_testgen(norm, order_type,
+ uplo_type, n, &alpha, alpha_flag,
+ &beta, beta_flag, a, lda,
+ head_x_gen, tail_x_gen, y_gen, seed,
+ head_r_true, tail_r_true);
+ test_count++;
+
+ /* vary incx = -2, -1, 1, 2 */
+ for (incx_val = INCX_START; incx_val <= INCX_END;
+ incx_val++) {
+
+ incx = incx_val;
+ if (0 == incx)
+ continue;
+
+ /* vary incy = -2, -1, 1, 2 */
+ for (incy_val = INCY_START; incy_val <= INCY_END;
+ incy_val++) {
+
+ incy = incy_val;
+ if (0 == incy)
+ continue;
+
+ /* copy generated vector with appropriate incs. */
+ ccopy_vector(y_gen, n, 1, y, incy);
+ scopy_vector(head_x_gen, n, 1, head_x, incx);
+ scopy_vector(tail_x_gen, n, 1, tail_x, incx);
+
+ /* call hemv2 routines to be tested */
+ FPU_FIX_STOP;
+ BLAS_chemv2_c_s_x(order_type,
+ uplo_type, n, alpha, a, lda, head_x,
+ tail_x, incx, beta, y, incy, prec);
+ FPU_FIX_START;
+
+ /* now compute the ratio using test_BLAS_xdot */
+ /* copy a row from A, use x, run dot test */
+
+ incyi = incy;
+ incyi *= 2;
+ yi0 = (incy > 0) ? 0 : (-n + 1) * incyi;
+
+ for (i = 0, yi = yi0, ri = 0;
+ i < n; i++, yi += incyi, ri += incri) {
+ che_copy_row(order_type, uplo_type, blas_left_side,
+ n, a, lda, a_vec, i);
+
+ /* just use the x vector - it was unchanged (in theory) */
+ rin[0] = y_gen[i];
+ rin[1] = y_gen[i + 1];
+ rout[0] = y[yi];
+ rout[1] = y[yi + 1];
+ head_r_true_elem[0] = head_r_true[ri];
+ head_r_true_elem[1] = head_r_true[ri + 1];
+ tail_r_true_elem[0] = tail_r_true[ri];
+ tail_r_true_elem[1] = tail_r_true[ri + 1];
+
+ test_BLAS_cdot2_c_s(n, blas_no_conj, alpha, beta,
+ rin, rout, head_r_true_elem,
+ tail_r_true_elem, a_vec, 1,
+ head_x, tail_x, incx, eps_int,
+ un_int, &ratios[i]);
+
+ /* take the max ratio */
+ if (i == 0) {
+ ratio = ratios[0];
+
+ /* The !<= below causes NaN errors to be included.
+ * Note that (NaN > 0) is false */
+ } else if (!(ratios[i] <= ratio)) {
+ ratio = ratios[i];
+ }
+
+ } /* end of dot-test loop */
+
+
+ /* The !<= below causes NaN errors to be included.
+ * Note that (NaN > 0) is false */
+ if (!(ratio <= thresh)) {
+
+ if (debug == 3) {
+ printf("\n\t\tTest # %d\n", test_count);
+ printf("y type : c, a type : c, x type : s\n");
+ printf("Seed = %d\t", saved_seed);
+ printf("n %d\n", n);
+ printf("LDA %d INCX %d INCY %d\n", lda, incx,
+ incx);
+
+ if (order_type == blas_rowmajor)
+ printf("row ");
+ else
+ printf("col ");
+
+ if (uplo_type == blas_upper)
+ printf("upper ");
+ else
+ printf("lower ");
+
+ printf("NORM %d, ALPHA %d, BETA %d\n",
+ norm, alpha_val, beta_val);
+
+ /* print out info */
+ printf("alpha = ");
+ printf("(%16.8e, %16.8e)", alpha[0], alpha[1]);;
+ printf(" ");
+ printf("beta = ");
+ printf("(%16.8e, %16.8e)", beta[0], beta[1]);;
+ printf("\n");
+
+ printf("a\n");
+ che_print_matrix(a, n, lda, order_type, uplo_type);
+ sprint_vector(head_x, n, incx, "head_x");
+ sprint_vector(tail_x, n, incx, "tail_x");
+ cprint_vector(y_gen, n, incy, "y_gen");
+ cprint_vector(y, n, incy, "y");
+ zprint_vector(head_r_true, n, 1, "head_r_true");
+ dprint_vector(ratios, n, 1, "ratios");
+ printf("ratio = %g\n", ratio);
+ }
+ bad_ratio_count++;
+ if (bad_ratio_count >= MAX_BAD_TESTS) {
+ printf("\ntoo many failures, exiting....");
+ printf("\nTesting and compilation");
+ printf(" are incomplete\n\n");
+ goto end;
+ }
+ if (!(ratio <= TOTAL_FAILURE_THRESHOLD)) {
+ printf("\nFlagrant ratio error, exiting...");
+ printf("\nTesting and compilation");
+ printf(" are incomplete\n\n");
+ goto end;
+ }
+ }
+
+ if (!(ratio <= ratio_max))
+ ratio_max = ratio;
+ if (ratio != 0.0 && !(ratio >= ratio_min))
+ ratio_min = ratio;
+
+ } /* end of incy loop */
+
+ } /* end of incx loop */
+
+ } /* end of lda loop */
+
+ } /* end of uplo loop */
+
+ } /* end of order loop */
+
+ } /* end of nr test loop */
+
+ } /* end of norm loop */
+
+
+ } /* end of prec loop */
+
+ } /* end of beta loop */
+
+ } /* end of alpha loop */
+
+end:
+ FPU_FIX_STOP;
+
+ blas_free(y);
+ blas_free(a);
+ blas_free(y_gen);
+ blas_free(head_x);
+ blas_free(tail_x);
+ blas_free(head_x_gen);
+ blas_free(tail_x_gen);
+ blas_free(head_r_true);
+ blas_free(tail_r_true);
+ blas_free(ratios);
+ blas_free(a_vec);
+
+ *max_ratio = ratio_max;
+ *min_ratio = ratio_min;
+ *num_tests = test_count;
+ *num_bad_ratio = bad_ratio_count;
+
+}
+void do_test_zhemv2_z_d_x
+ (int n,
+ int ntests, int *seed, double thresh, int debug, float test_prob,
+ double *min_ratio, double *max_ratio, int *num_bad_ratio, int *num_tests) {
+
+ /* Function name */
+ const char fname[] = "do_test_zhemv2_z_d_x";
+ int i;
+ int yi;
+ int incyi, yi0;
+ int test_count;
+ int bad_ratio_count;
+ int ri;
+ int incri = 1;
+ int incx, incy;
+ double ratio;
+ double ratio_min, ratio_max;
+ double eps_int; /* internal machine epsilon */
+ double un_int; /* internal underflow threshold */
+
+ double rin[2];
+ double rout[2];
+ double head_r_true_elem[2], tail_r_true_elem[2];
+
+ enum blas_order_type order_type;
+ enum blas_uplo_type uplo_type;
+ enum blas_prec_type prec;
+
+ int order_val, uplo_val;
+ int lda_val, incx_val, incy_val;
+ int alpha_val, beta_val;
+
+ int prec_val;
+
+ int lda;
+ int alpha_flag, beta_flag;
+ int saved_seed;
+ int norm;
+ int test_no;
+
+ double alpha[2];
+ double beta[2];
+ double *a;
+ double *head_x;
+ double *tail_x;
+ double *y;
+ double *a_vec;
+ double *y_gen;
+ double *head_x_gen;
+ double *tail_x_gen;
+ double *ratios;
+
+ /* true result calculated by testgen, in double-double */
+ double *head_r_true, *tail_r_true;
+
+
+ FPU_FIX_DECL;
+
+ if (n < 0)
+ BLAS_error(fname, -1, n, NULL);
+ if (ntests < 0)
+ BLAS_error(fname, -2, ntests, NULL);
+
+ /* initialization */
+ saved_seed = *seed;
+ ratio = 0.0;
+ ratio_min = 1e308;
+ ratio_max = 0.0;
+
+ *num_tests = 0;
+ *num_bad_ratio = 0;
+ *min_ratio = 0.0;
+ *max_ratio = 0.0;
+
+ if (n == 0)
+ return;
+ incri *= 2;
+
+ FPU_FIX_START;
+
+ y = (double *) blas_malloc(2 * n * sizeof(double) * 2);
+ if (2 * n > 0 && y == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ y_gen = (double *) blas_malloc(n * sizeof(double) * 2);
+ if (n > 0 && y_gen == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ head_x_gen = (double *) blas_malloc(n * sizeof(double));
+ if (n > 0 && head_x_gen == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ tail_x_gen = (double *) blas_malloc(n * sizeof(double));
+ if (n > 0 && tail_x_gen == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ a = (double *) blas_malloc(2 * n * n * sizeof(double) * 2);
+ if (2 * n * n > 0 && a == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ head_x = (double *) blas_malloc(2 * n * sizeof(double));
+ if (2 * n > 0 && head_x == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ tail_x = (double *) blas_malloc(2 * n * sizeof(double));
+ if (2 * n > 0 && tail_x == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ a_vec = (double *) blas_malloc(n * sizeof(double) * 2);
+ if (n > 0 && a_vec == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ head_r_true = (double *) blas_malloc(n * sizeof(double) * 2);
+ tail_r_true = (double *) blas_malloc(n * sizeof(double) * 2);
+ if (n > 0 && (head_r_true == NULL || tail_r_true == NULL)) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+ ratios = (double *) blas_malloc(n * sizeof(double));
+ if (n > 0 && ratios == NULL) {
+ BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
+ }
+
+ test_count = 0;
+ bad_ratio_count = 0;
+
+ /* vary alpha */
+ for (alpha_val = ALPHA_START; alpha_val <= ALPHA_END; alpha_val++) {
+
+ alpha_flag = 0;
+ switch (alpha_val) {
+ case 0:
+ alpha[0] = alpha[1] = 0.0;
+ alpha_flag = 1;
+ break;
+ case 1:
+ alpha[0] = 1.0;
+ alpha[1] = 0.0;
+ alpha_flag = 1;
+ break;
+ }
+
+ /* vary beta */
+ for (beta_val = BETA_START; beta_val <= BETA_END; beta_val++) {
+ beta_flag = 0;
+ switch (beta_val) {
+ case 0:
+ beta[0] = beta[1] = 0.0;
+ beta_flag = 1;
+ break;
+ case 1:
+ beta[0] = 1.0;
+ beta[1] = 0.0;
+ beta_flag = 1;
+ break;
+ }
+
+
+ /* varying extra precs */
+ for (prec_val = PREC_START; prec_val <= PREC_END; prec_val++) {
+ switch (prec_val) {
+ case 0:
+ eps_int = power(2, -BITS_D);
+ un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
+ (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
+ prec = blas_prec_double;
+ break;
+ case 1:
+ eps_int = power(2, -BITS_D);
+ un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_double),
+ (double) BLAS_fpinfo_x(blas_emin, blas_prec_double));
+ prec = blas_prec_double;
+ break;
+ case 2:
+ default:
+ eps_int = power(2, -BITS_E);
+ un_int = pow((double) BLAS_fpinfo_x(blas_base, blas_prec_extra),
+ (double) BLAS_fpinfo_x(blas_emin, blas_prec_extra));
+ prec = blas_prec_extra;
+ break;
+ }
+
+ /* vary norm -- underflow, approx 1, overflow */
+ for (norm = NORM_START; norm <= NORM_END; norm++) {
+
+ /* number of tests */
+ for (test_no = 0; test_no < ntests; test_no++) {
+
+ /* vary storage format */
+ for (order_val = ORDER_START; order_val <= ORDER_END; order_val++) {
+
+ order_type = (order_val == 0) ? blas_colmajor : blas_rowmajor;
+
+ /* vary upper / lower variation */
+ for (uplo_val = UPLO_START; uplo_val <= UPLO_END; uplo_val++) {
+
+ uplo_type = (uplo_val == 0) ? blas_upper : blas_lower;
+
+ /* vary lda = n, n+1, 2*n */
+ for (lda_val = LDA_START; lda_val <= LDA_END; lda_val++) {
+
+ lda = (lda_val == 0) ? n : (lda_val == 1) ? n + 1 : 2 * n;
+
+ saved_seed = *seed;
+ /* For the sake of speed, we throw out this case at random */
+ if (xrand(seed) >= test_prob)
+ continue;
+
+ alpha_flag = 0;
+ switch (alpha_val) {
+ case 0:
+ alpha[0] = alpha[1] = 0.0;
+ alpha_flag = 1;
+ break;
+ case 1:
+ alpha[0] = 1.0;
+ alpha[1] = 0.0;
+ alpha_flag = 1;
+ break;
+ }
+ beta_flag = 0;
+ switch (beta_val) {
+ case 0:
+ beta[0] = beta[1] = 0.0;
+ beta_flag = 1;
+ break;
+ case 1:
+ beta[0] = 1.0;
+ beta[1] = 0.0;
+ beta_flag = 1;
+ break;
+ }
+
+ /* finally we are here to generate the test case */
+ BLAS_zhemv2_z_d_testgen(norm, order_type,
+ uplo_type, n, &alpha, alpha_flag,
+ &beta, beta_flag, a, lda,
+ head_x_gen, tail_x_gen, y_gen, seed,
+ head_r_true, tail_r_true);
+ test_count++;
+
+ /* vary incx = -2, -1, 1, 2 */
+ for (incx_val = INCX_START; incx_val <= INCX_END;
+ incx_val++) {
+
+ incx = incx_val;
+ if (0 == incx)
+ continue;
+
+ /* vary incy = -2, -1, 1, 2 */
+ for (incy_val = INCY_START; incy_val <= INCY_END;
+ incy_val++) {
+
+ incy = incy_val;
+ if (0 == incy)
+ continue;
+
+ /* copy generated vector with appropriate incs. */
+ zcopy_vector(y_gen, n, 1, y, incy);
+ dcopy_vector(head_x_gen, n, 1, head_x, incx);
+ dcopy_vector(tail_x_gen, n, 1, tail_x, incx);
+
+ /* call hemv2 routines to be tested */
+ FPU_FIX_STOP;
+ BLAS_zhemv2_z_d_x(order_type,
+ uplo_type, n, alpha, a, lda, head_x,
+ tail_x, incx, beta, y, incy, prec);
+ FPU_FIX_START;
+
+ /* now compute the ratio using test_BLAS_xdot */
+ /* copy a row from A, use x, run dot test */
+
+ incyi = incy;
+ incyi *= 2;
+ yi0 = (incy > 0) ? 0 : (-n + 1) * incyi;
+
+ for (i = 0, yi = yi0, ri = 0;
+ i < n; i++, yi += incyi, ri += incri) {
+ zhe_copy_row(order_type, uplo_type, blas_left_side,
+ n, a, lda, a_vec, i);
+
+ /* just use the x vector - it was unchanged (in theory) */
+ rin[0] = y_gen[i];
+ rin[1] = y_gen[i + 1];
+ rout[0] = y[yi];
+ rout[1] = y[yi + 1];
+ head_r_true_elem[0] = head_r_true[ri];
+ head_r_true_elem[1] = head_r_true[ri + 1];
+ tail_r_true_elem[0] = tail_r_true[ri];
+ tail_r_true_elem[1] = tail_r_true[ri + 1];
+
+ test_BLAS_zdot2_z_d(n, blas_no_conj, alpha, beta,
+ rin, rout, head_r_true_elem,
+ tail_r_true_elem, a_vec, 1,
+ head_x, tail_x, incx, eps_int,
+ un_int, &ratios[i]);
+
+ /* take the max ratio */
+ if (i == 0) {
+ ratio = ratios[0];
+
+ /* The !<= below causes NaN errors to be included.
+ * Note that (NaN > 0) is false */
+ } else if (!(ratios[i] <= ratio)) {
+ ratio = ratios[i];
+ }
+
+ } /* end of dot-test loop */
+
+
+ /* The !<= below causes NaN errors to be included.
+ * Note that (NaN > 0) is false */
+ if (!(ratio <= thresh)) {
+
+ if (debug == 3) {
+ printf("\n\t\tTest # %d\n", test_count);
+ printf("y type : z, a type : z, x type : d\n");
+ printf("Seed = %d\t", saved_seed);
+ printf("n %d\n", n);
+ printf("LDA %d INCX %d INCY %d\n", lda, incx,
+ incx);
+
+ if (order_type == blas_rowmajor)
+ printf("row ");
+ else
+ printf("col ");
+
+ if (uplo_type == blas_upper)
+ printf("upper ");
+ else
+ printf("lower ");
+
+ printf("NORM %d, ALPHA %d, BETA %d\n",
+ norm, alpha_val, beta_val);
+
+ /* print out info */
+ printf("alpha = ");
+ printf("(%24.16e, %24.16e)", alpha[0], alpha[1]);;
+ printf(" ");
+ printf("beta = ");
+ printf("(%24.16e, %24.16e)", beta[0], beta[1]);;
+ printf("\n");
+
+ printf("a\n");
+ zhe_print_matrix(a, n, lda, order_type, uplo_type);
+ dprint_vector(head_x, n, incx, "head_x");
+ dprint_vector(tail_x, n, incx, "tail_x");
+ zprint_vector(y_gen, n, incy, "y_gen");
+ zprint_vector(y, n, incy, "y");
+ zprint_vector(head_r_true, n, 1, "head_r_true");
+ dprint_vector(ratios, n, 1, "ratios");
+ printf("ratio = %g\n", ratio);
+ }
+ bad_ratio_count++;
+ if (bad_ratio_count >= MAX_BAD_TESTS) {
+ printf("\ntoo many failures, exiting....");
+ printf("\nTesting and compilation");
+ printf(" are incomplete\n\n");
+ goto end;
+ }
+ if (!(ratio <= TOTAL_FAILURE_THRESHOLD)) {
+ printf("\nFlagrant ratio error, exiting...");
+ printf("\nTesting and compilation");
+ printf(" are incomplete\n\n");
+ goto end;
+ }
+ }
+
+ if (!(ratio <= ratio_max))
+ ratio_max = ratio;
+ if (ratio != 0.0 && !(ratio >= ratio_min))
+ ratio_min = ratio;
+
+ } /* end of incy loop */
+
+ } /* end of incx loop */
+
+ } /* end of lda loop */
+
+ } /* end of uplo loop */
+
+ } /* end of order loop */
+
+ } /* end of nr test loop */
+
+ } /* end of norm loop */
+
+
+ } /* end of prec loop */
+
+ } /* end of beta loop */
+
+ } /* end of alpha loop */
+
+end:
+ FPU_FIX_STOP;
+
+ blas_free(y);
+ blas_free(a);
+ blas_free(y_gen);
+ blas_free(head_x);
+ blas_free(tail_x);
+ blas_free(head_x_gen);
+ blas_free(tail_x_gen);
+ blas_free(head_r_true);
+ blas_free(tail_r_true);
+ blas_free(ratios);
+ blas_free(a_vec);
+
+ *max_ratio = ratio_max;
+ *min_ratio = ratio_min;
+ *num_tests = test_count;
+ *num_bad_ratio = bad_ratio_count;
+
+}
+
+int main(int argc, char **argv)
+{
+ int nsizes, ntests, debug;
+ double thresh, test_prob;
+ double total_min_ratio, total_max_ratio;
+ int total_bad_ratios;
+ int seed, num_bad_ratio, num_tests;
+ int total_tests, nr_failed_routines = 0, nr_routines = 0;
+ double min_ratio, max_ratio;
+ const char *base_routine = "hemv2";
+ char *fname;
+ int n;
+
+ int i;
+ int n_data[NUM_DATA][1] = { {4}, {2}, {3}, {8}, {10}, {1}, {7} };
+
+ if (argc != 6) {
+ printf("Usage:\n");
+ printf("do_test_hemv2 <nsizes> <ntests> <thresh> <debug> <test_prob>\n");
+ printf(" <nsizes>: number of sizes to be run.\n");
+ printf
+ (" <ntests>: the number of tests performed for each set of attributes\n");
+ printf
+ (" <thresh>: to catch bad ratios if it is greater than <thresh>\n");
+ printf(" <debug>: 0, 1, 2, or 3; \n");
+ printf(" if 0, no printing \n");
+ printf(" if 1, print error summary only if tests fail\n");
+ printf(" if 2, print error summary for each n\n");
+ printf(" if 3, print complete info each test fails \n");
+ printf("<test_prob>: probability of preforming a given \n");
+ printf(" test case: 0.0 does no tests, 1.0 does all tests\n");
+ return -1;
+ } else {
+ nsizes = atoi(argv[1]);
+ ntests = atoi(argv[2]);
+ thresh = atof(argv[3]);
+ debug = atoi(argv[4]);
+ test_prob = atof(argv[5]);
+ }
+
+ seed = 1999;
+
+ if (nsizes < 0 || ntests < 0 || debug < 0 || debug > 3)
+ BLAS_error("Testing hemv2", 0, 0, NULL);
+
+ printf("Testing %s...\n", base_routine);
+ printf("INPUT: nsizes = %d, ntests = %d, thresh = %4.2f, debug = %d\n\n",
+ nsizes, ntests, thresh, debug);
+
+
+
+ if (nsizes < 0 || nsizes > NUM_DATA)
+ BLAS_error("do_test_hemv2", -1, nsizes, NULL);
+
+ fname = "BLAS_zhemv2_z_c";
+ printf("Testing %s...\n", fname);
+ total_tests = 0;
+ total_bad_ratios = 0;
+ total_min_ratio = 1e308;
+ total_max_ratio = 0.0;
+ for (i = 0; i < nsizes; i++) {
+ n = n_data[i][0];
+
+ do_test_zhemv2_z_c(n, ntests, &seed, thresh, debug,
+ test_prob,
+ &min_ratio, &max_ratio, &num_bad_ratio, &num_tests);
+
+ if (debug == 2 || (debug == 1 && num_bad_ratio > 0)) {
+ printf(" [%d %d]: ", n, n);
+ printf("bad/total = %d/%d, min_ratio = %g, max_ratio = %g\n",
+ num_bad_ratio, num_tests, min_ratio, max_ratio);
+ }
+
+ total_tests += num_tests;
+ total_bad_ratios += num_bad_ratio;
+ if (total_min_ratio > min_ratio)
+ total_min_ratio = min_ratio;
+ if (total_max_ratio < max_ratio)
+ total_max_ratio = max_ratio;
+ }
+
+ nr_routines++;
+ if (total_bad_ratios == 0)
+ printf("PASS> ");
+ else {
+ printf("FAIL> ");
+ nr_failed_routines++;
+ }
+ printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n",
+ fname, total_bad_ratios, total_tests, max_ratio);
+
+ fname = "BLAS_zhemv2_c_z";
+ printf("Testing %s...\n", fname);
+ total_tests = 0;
+ total_bad_ratios = 0;
+ total_min_ratio = 1e308;
+ total_max_ratio = 0.0;
+ for (i = 0; i < nsizes; i++) {
+ n = n_data[i][0];
+
+ do_test_zhemv2_c_z(n, ntests, &seed, thresh, debug,
+ test_prob,
+ &min_ratio, &max_ratio, &num_bad_ratio, &num_tests);
+
+ if (debug == 2 || (debug == 1 && num_bad_ratio > 0)) {
+ printf(" [%d %d]: ", n, n);
+ printf("bad/total = %d/%d, min_ratio = %g, max_ratio = %g\n",
+ num_bad_ratio, num_tests, min_ratio, max_ratio);
+ }
+
+ total_tests += num_tests;
+ total_bad_ratios += num_bad_ratio;
+ if (total_min_ratio > min_ratio)
+ total_min_ratio = min_ratio;
+ if (total_max_ratio < max_ratio)
+ total_max_ratio = max_ratio;
+ }
+
+ nr_routines++;
+ if (total_bad_ratios == 0)
+ printf("PASS> ");
+ else {
+ printf("FAIL> ");
+ nr_failed_routines++;
+ }
+ printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n",
+ fname, total_bad_ratios, total_tests, max_ratio);
+
+ fname = "BLAS_zhemv2_c_c";
+ printf("Testing %s...\n", fname);
+ total_tests = 0;
+ total_bad_ratios = 0;
+ total_min_ratio = 1e308;
+ total_max_ratio = 0.0;
+ for (i = 0; i < nsizes; i++) {
+ n = n_data[i][0];
+
+ do_test_zhemv2_c_c(n, ntests, &seed, thresh, debug,
+ test_prob,
+ &min_ratio, &max_ratio, &num_bad_ratio, &num_tests);
+
+ if (debug == 2 || (debug == 1 && num_bad_ratio > 0)) {
+ printf(" [%d %d]: ", n, n);
+ printf("bad/total = %d/%d, min_ratio = %g, max_ratio = %g\n",
+ num_bad_ratio, num_tests, min_ratio, max_ratio);
+ }
+
+ total_tests += num_tests;
+ total_bad_ratios += num_bad_ratio;
+ if (total_min_ratio > min_ratio)
+ total_min_ratio = min_ratio;
+ if (total_max_ratio < max_ratio)
+ total_max_ratio = max_ratio;
+ }
+
+ nr_routines++;
+ if (total_bad_ratios == 0)
+ printf("PASS> ");
+ else {
+ printf("FAIL> ");
+ nr_failed_routines++;
+ }
+ printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n",
+ fname, total_bad_ratios, total_tests, max_ratio);
+
+ fname = "BLAS_chemv2_c_s";
+ printf("Testing %s...\n", fname);
+ total_tests = 0;
+ total_bad_ratios = 0;
+ total_min_ratio = 1e308;
+ total_max_ratio = 0.0;
+ for (i = 0; i < nsizes; i++) {
+ n = n_data[i][0];
+
+ do_test_chemv2_c_s(n, ntests, &seed, thresh, debug,
+ test_prob,
+ &min_ratio, &max_ratio, &num_bad_ratio, &num_tests);
+
+ if (debug == 2 || (debug == 1 && num_bad_ratio > 0)) {
+ printf(" [%d %d]: ", n, n);
+ printf("bad/total = %d/%d, min_ratio = %g, max_ratio = %g\n",
+ num_bad_ratio, num_tests, min_ratio, max_ratio);
+ }
+
+ total_tests += num_tests;
+ total_bad_ratios += num_bad_ratio;
+ if (total_min_ratio > min_ratio)
+ total_min_ratio = min_ratio;
+ if (total_max_ratio < max_ratio)
+ total_max_ratio = max_ratio;
+ }
+
+ nr_routines++;
+ if (total_bad_ratios == 0)
+ printf("PASS> ");
+ else {
+ printf("FAIL> ");
+ nr_failed_routines++;
+ }
+ printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n",
+ fname, total_bad_ratios, total_tests, max_ratio);
+
+ fname = "BLAS_zhemv2_z_d";
+ printf("Testing %s...\n", fname);
+ total_tests = 0;
+ total_bad_ratios = 0;
+ total_min_ratio = 1e308;
+ total_max_ratio = 0.0;
+ for (i = 0; i < nsizes; i++) {
+ n = n_data[i][0];
+
+ do_test_zhemv2_z_d(n, ntests, &seed, thresh, debug,
+ test_prob,
+ &min_ratio, &max_ratio, &num_bad_ratio, &num_tests);
+
+ if (debug == 2 || (debug == 1 && num_bad_ratio > 0)) {
+ printf(" [%d %d]: ", n, n);
+ printf("bad/total = %d/%d, min_ratio = %g, max_ratio = %g\n",
+ num_bad_ratio, num_tests, min_ratio, max_ratio);
+ }
+
+ total_tests += num_tests;
+ total_bad_ratios += num_bad_ratio;
+ if (total_min_ratio > min_ratio)
+ total_min_ratio = min_ratio;
+ if (total_max_ratio < max_ratio)
+ total_max_ratio = max_ratio;
+ }
+
+ nr_routines++;
+ if (total_bad_ratios == 0)
+ printf("PASS> ");
+ else {
+ printf("FAIL> ");
+ nr_failed_routines++;
+ }
+ printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n",
+ fname, total_bad_ratios, total_tests, max_ratio);
+
+ fname = "BLAS_chemv2_x";
+ printf("Testing %s...\n", fname);
+ total_tests = 0;
+ total_bad_ratios = 0;
+ total_min_ratio = 1e308;
+ total_max_ratio = 0.0;
+ for (i = 0; i < nsizes; i++) {
+ n = n_data[i][0];
+
+ do_test_chemv2_x(n, ntests, &seed, thresh, debug,
+ test_prob,
+ &min_ratio, &max_ratio, &num_bad_ratio, &num_tests);
+
+ if (debug == 2 || (debug == 1 && num_bad_ratio > 0)) {
+ printf(" [%d %d]: ", n, n);
+ printf("bad/total = %d/%d, min_ratio = %g, max_ratio = %g\n",
+ num_bad_ratio, num_tests, min_ratio, max_ratio);
+ }
+
+ total_tests += num_tests;
+ total_bad_ratios += num_bad_ratio;
+ if (total_min_ratio > min_ratio)
+ total_min_ratio = min_ratio;
+ if (total_max_ratio < max_ratio)
+ total_max_ratio = max_ratio;
+ }
+
+ nr_routines++;
+ if (total_bad_ratios == 0)
+ printf("PASS> ");
+ else {
+ printf("FAIL> ");
+ nr_failed_routines++;
+ }
+ printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n",
+ fname, total_bad_ratios, total_tests, max_ratio);
+
+ fname = "BLAS_zhemv2_x";
+ printf("Testing %s...\n", fname);
+ total_tests = 0;
+ total_bad_ratios = 0;
+ total_min_ratio = 1e308;
+ total_max_ratio = 0.0;
+ for (i = 0; i < nsizes; i++) {
+ n = n_data[i][0];
+
+ do_test_zhemv2_x(n, ntests, &seed, thresh, debug,
+ test_prob,
+ &min_ratio, &max_ratio, &num_bad_ratio, &num_tests);
+
+ if (debug == 2 || (debug == 1 && num_bad_ratio > 0)) {
+ printf(" [%d %d]: ", n, n);
+ printf("bad/total = %d/%d, min_ratio = %g, max_ratio = %g\n",
+ num_bad_ratio, num_tests, min_ratio, max_ratio);
+ }
+
+ total_tests += num_tests;
+ total_bad_ratios += num_bad_ratio;
+ if (total_min_ratio > min_ratio)
+ total_min_ratio = min_ratio;
+ if (total_max_ratio < max_ratio)
+ total_max_ratio = max_ratio;
+ }
+
+ nr_routines++;
+ if (total_bad_ratios == 0)
+ printf("PASS> ");
+ else {
+ printf("FAIL> ");
+ nr_failed_routines++;
+ }
+ printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n",
+ fname, total_bad_ratios, total_tests, max_ratio);
+
+ fname = "BLAS_zhemv2_z_c_x";
+ printf("Testing %s...\n", fname);
+ total_tests = 0;
+ total_bad_ratios = 0;
+ total_min_ratio = 1e308;
+ total_max_ratio = 0.0;
+ for (i = 0; i < nsizes; i++) {
+ n = n_data[i][0];
+
+ do_test_zhemv2_z_c_x(n, ntests, &seed, thresh, debug,
+ test_prob,
+ &min_ratio, &max_ratio, &num_bad_ratio, &num_tests);
+
+ if (debug == 2 || (debug == 1 && num_bad_ratio > 0)) {
+ printf(" [%d %d]: ", n, n);
+ printf("bad/total = %d/%d, min_ratio = %g, max_ratio = %g\n",
+ num_bad_ratio, num_tests, min_ratio, max_ratio);
+ }
+
+ total_tests += num_tests;
+ total_bad_ratios += num_bad_ratio;
+ if (total_min_ratio > min_ratio)
+ total_min_ratio = min_ratio;
+ if (total_max_ratio < max_ratio)
+ total_max_ratio = max_ratio;
+ }
+
+ nr_routines++;
+ if (total_bad_ratios == 0)
+ printf("PASS> ");
+ else {
+ printf("FAIL> ");
+ nr_failed_routines++;
+ }
+ printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n",
+ fname, total_bad_ratios, total_tests, max_ratio);
+
+ fname = "BLAS_zhemv2_c_z_x";
+ printf("Testing %s...\n", fname);
+ total_tests = 0;
+ total_bad_ratios = 0;
+ total_min_ratio = 1e308;
+ total_max_ratio = 0.0;
+ for (i = 0; i < nsizes; i++) {
+ n = n_data[i][0];
+
+ do_test_zhemv2_c_z_x(n, ntests, &seed, thresh, debug,
+ test_prob,
+ &min_ratio, &max_ratio, &num_bad_ratio, &num_tests);
+
+ if (debug == 2 || (debug == 1 && num_bad_ratio > 0)) {
+ printf(" [%d %d]: ", n, n);
+ printf("bad/total = %d/%d, min_ratio = %g, max_ratio = %g\n",
+ num_bad_ratio, num_tests, min_ratio, max_ratio);
+ }
+
+ total_tests += num_tests;
+ total_bad_ratios += num_bad_ratio;
+ if (total_min_ratio > min_ratio)
+ total_min_ratio = min_ratio;
+ if (total_max_ratio < max_ratio)
+ total_max_ratio = max_ratio;
+ }
+
+ nr_routines++;
+ if (total_bad_ratios == 0)
+ printf("PASS> ");
+ else {
+ printf("FAIL> ");
+ nr_failed_routines++;
+ }
+ printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n",
+ fname, total_bad_ratios, total_tests, max_ratio);
+
+ fname = "BLAS_zhemv2_c_c_x";
+ printf("Testing %s...\n", fname);
+ total_tests = 0;
+ total_bad_ratios = 0;
+ total_min_ratio = 1e308;
+ total_max_ratio = 0.0;
+ for (i = 0; i < nsizes; i++) {
+ n = n_data[i][0];
+
+ do_test_zhemv2_c_c_x(n, ntests, &seed, thresh, debug,
+ test_prob,
+ &min_ratio, &max_ratio, &num_bad_ratio, &num_tests);
+
+ if (debug == 2 || (debug == 1 && num_bad_ratio > 0)) {
+ printf(" [%d %d]: ", n, n);
+ printf("bad/total = %d/%d, min_ratio = %g, max_ratio = %g\n",
+ num_bad_ratio, num_tests, min_ratio, max_ratio);
+ }
+
+ total_tests += num_tests;
+ total_bad_ratios += num_bad_ratio;
+ if (total_min_ratio > min_ratio)
+ total_min_ratio = min_ratio;
+ if (total_max_ratio < max_ratio)
+ total_max_ratio = max_ratio;
+ }
+
+ nr_routines++;
+ if (total_bad_ratios == 0)
+ printf("PASS> ");
+ else {
+ printf("FAIL> ");
+ nr_failed_routines++;
+ }
+ printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n",
+ fname, total_bad_ratios, total_tests, max_ratio);
+
+ fname = "BLAS_chemv2_c_s_x";
+ printf("Testing %s...\n", fname);
+ total_tests = 0;
+ total_bad_ratios = 0;
+ total_min_ratio = 1e308;
+ total_max_ratio = 0.0;
+ for (i = 0; i < nsizes; i++) {
+ n = n_data[i][0];
+
+ do_test_chemv2_c_s_x(n, ntests, &seed, thresh, debug,
+ test_prob,
+ &min_ratio, &max_ratio, &num_bad_ratio, &num_tests);
+
+ if (debug == 2 || (debug == 1 && num_bad_ratio > 0)) {
+ printf(" [%d %d]: ", n, n);
+ printf("bad/total = %d/%d, min_ratio = %g, max_ratio = %g\n",
+ num_bad_ratio, num_tests, min_ratio, max_ratio);
+ }
+
+ total_tests += num_tests;
+ total_bad_ratios += num_bad_ratio;
+ if (total_min_ratio > min_ratio)
+ total_min_ratio = min_ratio;
+ if (total_max_ratio < max_ratio)
+ total_max_ratio = max_ratio;
+ }
+
+ nr_routines++;
+ if (total_bad_ratios == 0)
+ printf("PASS> ");
+ else {
+ printf("FAIL> ");
+ nr_failed_routines++;
+ }
+ printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n",
+ fname, total_bad_ratios, total_tests, max_ratio);
+
+ fname = "BLAS_zhemv2_z_d_x";
+ printf("Testing %s...\n", fname);
+ total_tests = 0;
+ total_bad_ratios = 0;
+ total_min_ratio = 1e308;
+ total_max_ratio = 0.0;
+ for (i = 0; i < nsizes; i++) {
+ n = n_data[i][0];
+
+ do_test_zhemv2_z_d_x(n, ntests, &seed, thresh, debug,
+ test_prob,
+ &min_ratio, &max_ratio, &num_bad_ratio, &num_tests);
+
+ if (debug == 2 || (debug == 1 && num_bad_ratio > 0)) {
+ printf(" [%d %d]: ", n, n);
+ printf("bad/total = %d/%d, min_ratio = %g, max_ratio = %g\n",
+ num_bad_ratio, num_tests, min_ratio, max_ratio);
+ }
+
+ total_tests += num_tests;
+ total_bad_ratios += num_bad_ratio;
+ if (total_min_ratio > min_ratio)
+ total_min_ratio = min_ratio;
+ if (total_max_ratio < max_ratio)
+ total_max_ratio = max_ratio;
+ }
+
+ nr_routines++;
+ if (total_bad_ratios == 0)
+ printf("PASS> ");
+ else {
+ printf("FAIL> ");
+ nr_failed_routines++;
+ }
+ printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n",
+ fname, total_bad_ratios, total_tests, max_ratio);
+
+
+
+ printf("\n");
+ if (nr_failed_routines)
+ printf("FAILED ");
+ else
+ printf("PASSED ");
+ printf("%-10s: FAIL/TOTAL = %d/%d\n",
+ base_routine, nr_failed_routines, nr_routines);
+
+ return 0;
+}