Exemple #1
0
SPVEC_double *SPVEC_double_new(int N, int nz)
{
    SPVEC_double *A = NULL;
    double *new_val = NULL;
    int *new_index =  NULL;

    A = (SPVEC_double*) blas_malloc(sizeof(SPVEC_double));
    BLAS_ASSERT_RETURN( A!=0, NULL);


    if (nz > 0)
    {
        new_val = (double*) blas_malloc(sizeof(double)*nz);
        BLAS_ASSERT_RETURN( new_val !=0, NULL);

        new_index = (int*) blas_malloc(sizeof(int)*nz);
        BLAS_ASSERT_RETURN( new_index !=0, NULL);

    }

    A->val_ = new_val;
    A->index_ = new_index;
    A->N_ = N;
    A->allocated_nz_ = nz;
    A->nz_ = 0;

    return A;
}
void BLAS_ztrmv_c_testgen(int norm, enum blas_order_type order,
			  enum blas_uplo_type uplo,
			  enum blas_trans_type trans,
			  enum blas_diag_type diag, int n, void *alpha,
			  int alpha_flag, void *T, int ldt, void *x,
			  int *seed, double *head_r_true, double *tail_r_true)

/*
 * Purpose
 * =======
 *
 * Generates alpha, T and x, where T is a triangular matrix; and 
 * computes r_true.
 *
 * Arguments
 * =========
 *
 * norm         (input) blas_norm_type 
 *
 * order        (input) blas_order_type
 *              Order of T; row or column major
 *
 * uplo         (input) blas_uplo_type
 *              Whether T is upper or lower
 *
 * trans        (input) blas_trans_type
 *              No trans, trans, conj trans
 *
 * diag         (input) blas_diag_type
 *              non unit, unit
 *
 * n            (input) int
 *              Dimension of AP and the length of vector x
 *
 * 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.
 *              
 * T            (output) void*
 *
 * x            (input/output) void*
 *
 * seed         (input/output) int
 *
 * 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.
 *
 */
{
  double *x_i = (double *) x;
  float *T_i = (float *) T;
  double *alpha_i = (double *) alpha;
  double *x_vec;
  float *t_vec;
  double beta[2];
  double r[2];
  double head_r_true_elem[2], tail_r_true_elem[2];
  double x_elem[2];
  float t_elem[2];

  int inc_tvec = 1, inc_xvec = 1;
  int xvec_i, tvec_j;
  int xi;
  int ti, tij;
  int inc_ti, inc_tij;
  int inc_xi;
  int i, j;

  r[0] = r[1] = 0.0;
  beta[0] = beta[1] = 0.0;

  inc_tvec *= 2;
  inc_xvec *= 2;

  t_vec = (float *) blas_malloc(n * sizeof(float) * 2);
  if (n > 0 && t_vec == NULL) {
    BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
  };
  x_vec = (double *) blas_malloc(n * sizeof(double) * 2);
  if (n > 0 && x_vec == NULL) {
    BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
  };

  if (trans == blas_no_trans) {
    if (uplo == blas_upper) {
      inc_xi = -1;
      if (order == blas_rowmajor) {
	inc_ti = -ldt;
	inc_tij = -1;
      } else {
	inc_ti = -1;
	inc_tij = -ldt;
      }
    } else {
      inc_xi = 1;
      if (order == blas_rowmajor) {
	inc_ti = ldt;
	inc_tij = 1;
      } else {
	inc_ti = 1;
	inc_tij = ldt;
      }
    }
  } else {
    if (uplo == blas_upper) {
      inc_xi = 1;
      if (order == blas_rowmajor) {
	inc_ti = 1;
	inc_tij = ldt;
      } else {
	inc_ti = ldt;
	inc_tij = 1;
      }
    } else {
      inc_xi = -1;
      if (order == blas_rowmajor) {
	inc_ti = -1;
	inc_tij = -ldt;
      } else {
	inc_ti = -ldt;
	inc_tij = -1;
      }
    }
  }

  inc_xi *= 2;

  inc_ti *= 2;
  inc_tij *= 2;

  /* Call dot_testgen n times.  Each call will generate
   * one row of T and one element of x.                   */
  ti = (inc_ti > 0 ? 0 : -(n - 1) * inc_ti);
  xi = (inc_xi > 0 ? 0 : -(n - 1) * inc_xi);
  xvec_i = 0;
  for (i = 0; i < n; i++) {

    /* Generate the i-th element of x_vec and all of t_vec. */
    if (diag == blas_unit_diag) {
      /* Since we need alpha = beta, we fix alpha if alpha_flag = 0. */
      if (i == 0 && alpha_flag == 0) {
	alpha_i[0] = xrand(seed);
	alpha_i[1] = xrand(seed);
      }
      BLAS_zdot_z_c_testgen(i, 0, i, norm, blas_no_conj, alpha_i,
			    1, alpha_i, 1, x_vec, t_vec,
			    seed, r, head_r_true_elem, tail_r_true_elem);

      /* Copy generated t_vec to T. */
      tvec_j = 0;
      tij = (inc_tij > 0 ? ti : ti - (n - 1) * inc_tij);
      for (j = 0; j < i; j++) {
	t_elem[0] = t_vec[tvec_j];
	t_elem[1] = t_vec[tvec_j + 1];

	if (trans == blas_conj_trans) {
	  t_elem[1] = -t_elem[1];
	}
	T_i[tij] = t_elem[0];
	T_i[tij + 1] = t_elem[1];
	tvec_j += inc_tvec;
	tij += inc_tij;
      }

      /* Set the diagonal element to 1. */
      t_elem[0] = 1.0;
      t_elem[1] = 0.0;
      T_i[tij] = t_elem[0];
      T_i[tij + 1] = t_elem[1];

      /* Set x[i] to be r. */
      x_i[xi] = r[0];
      x_i[xi + 1] = r[1];
      x_vec[xvec_i] = r[0];
      x_vec[xvec_i + 1] = r[1];

    } else {
      BLAS_zdot_z_c_testgen(i + 1, 0, i, norm, blas_no_conj, alpha,
			    (i == 0 ? alpha_flag : 1), beta, 1, x_vec, t_vec,
			    seed, r, head_r_true_elem, tail_r_true_elem);

      /* Copy generated t_vec to T. */
      tvec_j = 0;
      tij = (inc_tij > 0 ? ti : ti - (n - 1) * inc_tij);
      for (j = 0; j <= i; j++) {
	t_elem[0] = t_vec[tvec_j];
	t_elem[1] = t_vec[tvec_j + 1];

	if (trans == blas_conj_trans) {
	  t_elem[1] = -t_elem[1];
	}
	T_i[tij] = t_elem[0];
	T_i[tij + 1] = t_elem[1];
	tvec_j += inc_tvec;
	tij += inc_tij;
      }

      /* Copy generated x_vec[i] to appropriate position in x. */
      x_elem[0] = x_vec[xvec_i];
      x_elem[1] = x_vec[xvec_i + 1];
      x_i[xi] = x_elem[0];
      x_i[xi + 1] = x_elem[1];
    }

    /* Copy r_true */
    head_r_true[xi] = head_r_true_elem[0];
    head_r_true[xi + 1] = head_r_true_elem[1];
    tail_r_true[xi] = tail_r_true_elem[0];
    tail_r_true[xi + 1] = tail_r_true_elem[1];

    xvec_i += inc_xvec;
    xi += inc_xi;

    ti += inc_ti;
  }

  blas_free(x_vec);
  blas_free(t_vec);
}