testing/test-tpmv/do_test_tpmv.c

#include <stdlib.h>
#include <stdio.h>
#include <math.h>
#include "blas_extended.h"
#include "blas_extended_private.h"
#include "blas_extended_test.h"


double do_test_dtpmv_s(int n,
		       int ntests,
		       int *seed,
		       double thresh,
		       int debug,
		       float test_prob,
		       double *min_ratio, int *num_bad_ratio, int *num_tests)

/*
 * Purpose
 * =======
 *
 * Runs a series of tests on TPMV.
 *
 * Arguments
 * =========
 *
 * n         (input) int
 *           The size of vector being tested
 *
 * ntests    (input) int
 *           The number of tests to run for each set of attributes.
 *
 * seed      (input/output) int
 *           The seed for the random number generator used in testgen().
 *
 * thresh    (input) double
 *           When the ratio returned from test() exceeds the specified
 *           threshold, the current size, r_true, r_comp, and ratio will be
 *           printed.  (Since ratio is supposed to be O(1), we can set thresh
 *           to ~10.)
 *
 * debug     (input) int
 *           If debug=3, print summary
 *           If debug=2, print summary only if the number of bad ratios > 0
 *           If debug=1, print complete info if tests fail
 *           If debug=0, return max ratio
 *
 * min_ratio (output) double
 *           The minimum ratio
 *
 * num_bad_ratio (output) int
 *               The number of tests fail; they are above the threshold.
 *
 * num_tests (output) int
 *           The number of tests is being performed.
 *
 * Return value
 * ============
 *
 * The maximum ratio if run successfully, otherwise return -1
 *
 * Code structure
 * ==============
 *
 *  debug loop  -- if debug is one, the first loop computes the max ratio
 *              -- and the last(second) loop outputs debugging information,
 *              -- if the test fail and its ratio > 0.5 * max ratio.
 *              -- if debug is zero, the loop is executed once
 *    alpha loop  -- varying alpha: 0, 1, or random
 *
 *        norm loop   -- varying norm: near undeflow, near one, or
 *                    -- near overflow
 *          order loop  -- varying order type: rowmajor or colmajor
 *            uplo loop   -- varying uplo type: upper or lower
 *              trans loop  -- varying trans type: no trans, trans, and conj trans
 *                diag loop   -- varying diag type: non unit, and unit
 *                  numtest loop  -- how many times the test is perform with
 *                                -- above set of attributes
 *                        incx loop     -- varying incx: -2, -1, 1, 2
 */
{
  /* function name */
  const char fname[] = "BLAS_dtpmv_s";

  /* max number of debug lines to print */
  const int max_print = 3;

  /* Variables in the "x_val" form are loop vars for corresponding
     variables */
  int i;			/* iterate through the repeating tests */
  int j;			/* multipurpose counters */
  int ix;			/* use to index x  */
  int incx_val, incx;		/* for testing different inc values */
  int inctp, inc_index;		/* 1 if real, 2 if complex */
  int d_count;			/* counter for debug */
  int find_max_ratio;		/* find_max_ratio = 1 only if debug = 3 */
  int p_count;			/* counter for the number of debug lines printed */
  int tot_tests;		/* total number of tests to be done */
  int norm;			/* input values of near underflow/one/overflow */
  double ratio_max;		/* the current maximum ratio */
  double ratio_min;		/* the current minimum ratio */
  double *ratios;		/* a temporary variable for calculating ratio */
  double ratio = 0.0;		/* the per-use test ratio from test() */
  int bad_ratios = 0;		/* the number of ratios over the threshold */
  double eps_int;		/* the internal epsilon expected--2^(-24) for float */
  double un_int;		/* the internal underflow threshold */
  double alpha;
  double beta;
  float *tp;
  double *x;
  double *x_gen;		/* used to store vectors generated by testgen; eventually copied to x */
  float *temp;			/* use for calculating ratio */

  /* the true r calculated by testgen(), in double-double */
  double *head_r_true, *tail_r_true;

  int alpha_val;
  int alpha_flag = 0, beta_flag = 0;
  int order_val;
  enum blas_order_type order_type = 0;

  enum blas_prec_type prec = 0;
  int uplo_val;
  enum blas_uplo_type uplo_type = 0;
  int trans_val;
  enum blas_trans_type trans_type = 0;
  int diag_val;
  enum blas_diag_type diag_type = 0;

  double beta_zero_fake;
  double rin_zero_fake;

  int saved_seed;		/* for saving the original seed */
  int count, old_count = -1;
  FPU_FIX_DECL;

  /* test for bad arguments */
  if (n < 0 || ntests < 0)
    BLAS_error(fname, 0, 0, NULL);

  /* if there is nothing to test, return all zero */
  if (n == 0 || ntests == 0) {
    *min_ratio = 0.0;
    *num_bad_ratio = 0;
    *num_tests = 0;
    return 0.0;
  }

  FPU_FIX_START;


  incx = inctp = inc_index = 1;


  /* get space for calculation */
  x = (double *) blas_malloc(3 * n * 2 * sizeof(double));
  if (3 * n * 2 > 0 && x == NULL) {
    BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
  }
  x_gen = (double *) blas_malloc(3 * n * 2 * sizeof(double));
  if (3 * n * 2 > 0 && x_gen == NULL) {
    BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
  }
  tp = (float *) blas_malloc(2 * n * n * n * inctp * sizeof(float));
  if (2 * n * n * n * inctp > 0 && tp == NULL) {
    BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
  }
  temp = (float *) blas_malloc(3 * n * 2 * sizeof(float));
  if (3 * n * 2 > 0 && temp == NULL) {
    BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
  }
  head_r_true = (double *) blas_malloc(n * sizeof(double));
  tail_r_true = (double *) blas_malloc(n * sizeof(double));
  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");
  }


  /* initialization */
  saved_seed = *seed;
  ratio_min = 1e308;
  ratio_max = 0.0;
  tot_tests = 0;
  p_count = 0;
  count = 0;
  find_max_ratio = 0;
  beta = 0.0;
  beta_flag = 1;

  beta_zero_fake = 0.0;
  rin_zero_fake = 0.0;

  if (debug == 3)
    find_max_ratio = 1;

  /* The debug iteration:
     If debug=1, then will execute the iteration twice. First, compute the
     max ratio. Second, print info if ratio > (50% * ratio_max). */
  for (d_count = 0; d_count <= find_max_ratio; d_count++) {
    bad_ratios = 0;		/* set to zero */

    if ((debug == 3) && (d_count == find_max_ratio))
      *seed = saved_seed;	/* restore the original seed */

    /* varying alpha */
    for (alpha_val = 0; alpha_val < 3; alpha_val++) {
      alpha_flag = 0;
      switch (alpha_val) {
      case 0:
	alpha = 0.0;
	alpha_flag = 1;
	break;
      case 1:
	alpha = 1.0;
	alpha_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;

      /* values near underflow, 1, or overflow */
      for (norm = -1; norm <= 1; norm++) {

	/* row or col major */
	for (order_val = 0; order_val < 2; order_val++) {
	  switch (order_val) {
	  case 0:
	    order_type = blas_rowmajor;
	    break;
	  case 1:
	    order_type = blas_colmajor;
	    break;
	  }

	  /* upper or lower */
	  for (uplo_val = 0; uplo_val < 2; uplo_val++) {
	    switch (uplo_val) {
	    case 0:
	      uplo_type = blas_upper;
	      break;
	    case 1:
	      uplo_type = blas_lower;
	      break;
	    }

	    /* no trans, trans, or conj trans */
	    for (trans_val = 0; trans_val < 3; trans_val++) {
	      switch (trans_val) {
	      case 0:
		trans_type = blas_no_trans;
		break;
	      case 1:
		trans_type = blas_trans;
		break;
	      case 2:
		trans_type = blas_conj_trans;
		break;
	      }

	      /* non_unit_diag, unit_diag */
	      for (diag_val = 0; diag_val < 2; diag_val++) {
		switch (diag_val) {
		case 0:
		  diag_type = blas_non_unit_diag;
		  break;
		case 1:
		  diag_type = blas_unit_diag;
		  break;
		}

		/* number of tests */
		for (i = 0; i < ntests; i++) {
		  /* For the sake of speed, we throw out this case at random */
		  if (xrand(seed) >= test_prob)
		    continue;

		  BLAS_dtpmv_s_testgen(norm, order_type, uplo_type,
				       trans_type, diag_type, n,
				       &alpha, alpha_flag, tp, x_gen,
				       seed, head_r_true, tail_r_true);

		  count++;

		  /* varying incx */
		  for (incx_val = -2; incx_val <= 2; incx_val++) {
		    if (incx_val == 0)
		      continue;

		    /* setting incx */
		    incx = incx_val;


		    /* set x starting index */
		    ix = 0;
		    if (incx < 0)
		      ix = -(n - 1) * incx;

		    /* copy x_gen to x */
		    for (j = 0; j < n; j++) {
		      x[ix] = x_gen[j * inc_index];
		      ix += incx;
		    }

		    /* call BLAS_dtpmv_s */
		    FPU_FIX_STOP;
		    BLAS_dtpmv_s(order_type, uplo_type, trans_type, diag_type,
				 n, alpha, tp, x, incx_val);
		    FPU_FIX_START;

		    /* set x starting index */
		    ix = 0;
		    if (incx < 0)
		      ix = -(n - 1) * incx;

		    /* computing the ratio */
		    for (j = 0; j < n; j++) {
		      /* copy row j of tp to temp */
		      stpmv_copy_row(order_type, uplo_type, trans_type, n, tp,
				     temp, j);

		      test_BLAS_ddot_s_d(n, blas_no_conj,
					 alpha, beta_zero_fake, rin_zero_fake,
					 x[ix],
					 head_r_true[j * inc_index],
					 tail_r_true[j * inc_index], temp, 1,
					 x_gen, 1, eps_int, un_int,
					 &ratios[j]);

		      /* take the max ratio */
		      if (j == 0)
			ratio = ratios[0];
		      else if (ratios[j] > ratio)
			ratio = ratios[j];

		      ix += incx;
		    }

		    /* increase the number of bad ratio, if the ratio is
		       bigger than the threshold */
		    if (ratio > thresh) {
		      bad_ratios++;

		      if ((debug == 3) &&	/* print only when debug is on */
			  (count != old_count) &&	/* print if old vector is different
							   from the current one */
			  (d_count == find_max_ratio) &&
			  (p_count <= max_print) &&
			  (ratio > 0.5 * ratio_max)) {
			p_count++;
			old_count = count;

			printf
			  ("FAIL> %s: n = %d, ntests = %d, threshold = %4.2f,\n",
			   fname, n, ntests, thresh);

			/* Print test info */
			switch (prec) {
			case blas_prec_single:
			  printf("single ");
			  break;
			case blas_prec_double:
			  printf("double ");
			  break;
			case blas_prec_indigenous:
			  printf("indigenous ");
			  break;
			case blas_prec_extra:
			  printf("extra ");
			  break;
			}
			switch (norm) {
			case -1:
			  printf("near_underflow ");
			  break;
			case 0:
			  printf("near_one ");
			  break;
			case 1:
			  printf("near_overflow ");
			  break;
			}
			switch (order_type) {
			case blas_rowmajor:
			  printf("row_major ");
			  break;
			case blas_colmajor:
			  printf("col_major ");
			  break;
			}
			switch (uplo_type) {
			case blas_upper:
			  printf("upper ");
			  break;
			case blas_lower:
			  printf("lower ");
			  break;
			}
			switch (trans_type) {
			case blas_no_trans:
			  printf("no_trans ");
			  break;
			case blas_trans:
			  printf("trans ");
			  break;
			case blas_conj_trans:
			  printf("conj_trans ");
			  break;
			}
			switch (diag_type) {
			case blas_non_unit_diag:
			  printf("non_unit_diag ");
			  break;
			case blas_unit_diag:
			  printf("unit_diag ");
			  break;
			}

			printf(" incx=%d:\n", incx);
			ix = 0;
			if (incx < 0)
			  ix = -(n - 1) * incx;

			printf("      TP=");
			for (j = 0; j < n; j++) {
			  /* copy row j of tp to temp */
			  stpmv_copy_row(order_type, uplo_type, trans_type, n,
					 tp, temp, j);

			  if (j > 0)
			    printf("        ");
			  sprint_vector(temp, n, 1, NULL);
			}

			ix = 0;
			if (incx < 0)
			  ix = -(n - 1) * incx;

			for (j = 0; j < n; j++) {
			  printf("      ");
			  printf("x[%d] = ", j * inc_index);
			  printf("%24.16e", x_gen[j * inc_index]);
			  printf("; ");
			  printf("x_final[%d] = ", ix);
			  printf("%24.16e", x[ix]);
			  printf("\n");
			  ix += incx;
			}

			printf("      ");
			printf("alpha = ");
			printf("%24.16e", alpha);
			printf("; ");
			printf("\n");
			for (j = 0; j < n; j++) {
			  printf("      ");

			  printf("[%24.16e, %24.16e]",
				 head_r_true[j * inc_index],
				 tail_r_true[j * inc_index]);
			  printf(", ratio[%d]=%.4e\n", j, ratios[j]);
			}
			printf("      ratio=%.4e\n", ratio);
		      }
		    }
		    if (d_count == 0) {
		      if (ratio > ratio_max)
			ratio_max = ratio;
		      if (ratio != 0.0 && ratio < ratio_min)
			ratio_min = ratio;
		      tot_tests++;
		    }
		  }		/* incx */

		}		/* numtests */
	      }			/* diag */
	    }			/* trans */
	  }			/* uplo */
	}			/* order */
      }				/* norm */

    }				/* alpha */
  }				/* debug */

  if ((debug == 2) || ((debug == 1) && bad_ratios > 0)) {
    printf("      %s:  n = %d, ntests = %d, thresh = %4.2f\n",
	   fname, n, ntests, thresh);
    printf
      ("      bad/total = %d/%d=%3.2f, min_ratio = %.4e, max_ratio = %.4e\n\n",
       bad_ratios, tot_tests, ((double) bad_ratios) / ((double) tot_tests),
       ratio_min, ratio_max);
  }

  FPU_FIX_STOP;

  blas_free(x);
  blas_free(x_gen);
  blas_free(temp);
  blas_free(tp);
  blas_free(head_r_true);
  blas_free(tail_r_true);
  blas_free(ratios);

  *min_ratio = ratio_min;
  *num_bad_ratio = bad_ratios;
  *num_tests = tot_tests;
  return ratio_max;
}				/* end of do_test_dtpmv_s */

double do_test_ztpmv_c(int n,
		       int ntests,
		       int *seed,
		       double thresh,
		       int debug,
		       float test_prob,
		       double *min_ratio, int *num_bad_ratio, int *num_tests)

/*
 * Purpose
 * =======
 *
 * Runs a series of tests on TPMV.
 *
 * Arguments
 * =========
 *
 * n         (input) int
 *           The size of vector being tested
 *
 * ntests    (input) int
 *           The number of tests to run for each set of attributes.
 *
 * seed      (input/output) int
 *           The seed for the random number generator used in testgen().
 *
 * thresh    (input) double
 *           When the ratio returned from test() exceeds the specified
 *           threshold, the current size, r_true, r_comp, and ratio will be
 *           printed.  (Since ratio is supposed to be O(1), we can set thresh
 *           to ~10.)
 *
 * debug     (input) int
 *           If debug=3, print summary
 *           If debug=2, print summary only if the number of bad ratios > 0
 *           If debug=1, print complete info if tests fail
 *           If debug=0, return max ratio
 *
 * min_ratio (output) double
 *           The minimum ratio
 *
 * num_bad_ratio (output) int
 *               The number of tests fail; they are above the threshold.
 *
 * num_tests (output) int
 *           The number of tests is being performed.
 *
 * Return value
 * ============
 *
 * The maximum ratio if run successfully, otherwise return -1
 *
 * Code structure
 * ==============
 *
 *  debug loop  -- if debug is one, the first loop computes the max ratio
 *              -- and the last(second) loop outputs debugging information,
 *              -- if the test fail and its ratio > 0.5 * max ratio.
 *              -- if debug is zero, the loop is executed once
 *    alpha loop  -- varying alpha: 0, 1, or random
 *
 *        norm loop   -- varying norm: near undeflow, near one, or
 *                    -- near overflow
 *          order loop  -- varying order type: rowmajor or colmajor
 *            uplo loop   -- varying uplo type: upper or lower
 *              trans loop  -- varying trans type: no trans, trans, and conj trans
 *                diag loop   -- varying diag type: non unit, and unit
 *                  numtest loop  -- how many times the test is perform with
 *                                -- above set of attributes
 *                        incx loop     -- varying incx: -2, -1, 1, 2
 */
{
  /* function name */
  const char fname[] = "BLAS_ztpmv_c";

  /* max number of debug lines to print */
  const int max_print = 3;

  /* Variables in the "x_val" form are loop vars for corresponding
     variables */
  int i;			/* iterate through the repeating tests */
  int j;			/* multipurpose counters */
  int ix;			/* use to index x  */
  int incx_val, incx;		/* for testing different inc values */
  int inctp, inc_index;		/* 1 if real, 2 if complex */
  int d_count;			/* counter for debug */
  int find_max_ratio;		/* find_max_ratio = 1 only if debug = 3 */
  int p_count;			/* counter for the number of debug lines printed */
  int tot_tests;		/* total number of tests to be done */
  int norm;			/* input values of near underflow/one/overflow */
  double ratio_max;		/* the current maximum ratio */
  double ratio_min;		/* the current minimum ratio */
  double *ratios;		/* a temporary variable for calculating ratio */
  double ratio = 0.0;		/* the per-use test ratio from test() */
  int bad_ratios = 0;		/* the number of ratios over the threshold */
  double eps_int;		/* the internal epsilon expected--2^(-24) for float */
  double un_int;		/* the internal underflow threshold */
  double alpha[2];
  double beta[2];
  float *tp;
  double *x;
  double *x_gen;		/* used to store vectors generated by testgen; eventually copied to x */
  float *temp;			/* use for calculating ratio */

  /* the true r calculated by testgen(), in double-double */
  double *head_r_true, *tail_r_true;


  int alpha_val;
  int alpha_flag = 0, beta_flag = 0;
  int order_val;
  enum blas_order_type order_type = 0;

  enum blas_prec_type prec = 0;
  int uplo_val;
  enum blas_uplo_type uplo_type = 0;
  int trans_val;
  enum blas_trans_type trans_type = 0;
  int diag_val;
  enum blas_diag_type diag_type = 0;

  double beta_zero_fake[2];
  double rin_zero_fake[2];

  int saved_seed;		/* for saving the original seed */
  int count, old_count = -1;
  FPU_FIX_DECL;

  /* test for bad arguments */
  if (n < 0 || ntests < 0)
    BLAS_error(fname, 0, 0, NULL);

  /* if there is nothing to test, return all zero */
  if (n == 0 || ntests == 0) {
    *min_ratio = 0.0;
    *num_bad_ratio = 0;
    *num_tests = 0;
    return 0.0;
  }

  FPU_FIX_START;


  incx = inctp = inc_index = 1;
  incx *= 2;
  inctp *= 2;
  inc_index *= 2;

  /* get space for calculation */
  x = (double *) blas_malloc(3 * n * 2 * sizeof(double) * 2);
  if (3 * n * 2 > 0 && x == NULL) {
    BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
  }
  x_gen = (double *) blas_malloc(3 * n * 2 * sizeof(double) * 2);
  if (3 * n * 2 > 0 && x_gen == NULL) {
    BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
  }
  tp = (float *) blas_malloc(2 * n * n * n * inctp * sizeof(float) * 2);
  if (2 * n * n * n * inctp > 0 && tp == NULL) {
    BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
  }
  temp = (float *) blas_malloc(3 * n * 2 * sizeof(float) * 2);
  if (3 * n * 2 > 0 && temp == 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");
  }


  /* initialization */
  saved_seed = *seed;
  ratio_min = 1e308;
  ratio_max = 0.0;
  tot_tests = 0;
  p_count = 0;
  count = 0;
  find_max_ratio = 0;
  beta[0] = beta[1] = 0.0;
  beta_flag = 1;

  beta_zero_fake[0] = beta_zero_fake[1] = 0.0;
  rin_zero_fake[0] = rin_zero_fake[1] = 0.0;

  if (debug == 3)
    find_max_ratio = 1;

  /* The debug iteration:
     If debug=1, then will execute the iteration twice. First, compute the
     max ratio. Second, print info if ratio > (50% * ratio_max). */
  for (d_count = 0; d_count <= find_max_ratio; d_count++) {
    bad_ratios = 0;		/* set to zero */

    if ((debug == 3) && (d_count == find_max_ratio))
      *seed = saved_seed;	/* restore the original seed */

    /* varying alpha */
    for (alpha_val = 0; alpha_val < 3; 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;
      }


      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;

      /* values near underflow, 1, or overflow */
      for (norm = -1; norm <= 1; norm++) {

	/* row or col major */
	for (order_val = 0; order_val < 2; order_val++) {
	  switch (order_val) {
	  case 0:
	    order_type = blas_rowmajor;
	    break;
	  case 1:
	    order_type = blas_colmajor;
	    break;
	  }

	  /* upper or lower */
	  for (uplo_val = 0; uplo_val < 2; uplo_val++) {
	    switch (uplo_val) {
	    case 0:
	      uplo_type = blas_upper;
	      break;
	    case 1:
	      uplo_type = blas_lower;
	      break;
	    }

	    /* no trans, trans, or conj trans */
	    for (trans_val = 0; trans_val < 3; trans_val++) {
	      switch (trans_val) {
	      case 0:
		trans_type = blas_no_trans;
		break;
	      case 1:
		trans_type = blas_trans;
		break;
	      case 2:
		trans_type = blas_conj_trans;
		break;
	      }

	      /* non_unit_diag, unit_diag */
	      for (diag_val = 0; diag_val < 2; diag_val++) {
		switch (diag_val) {
		case 0:
		  diag_type = blas_non_unit_diag;
		  break;
		case 1:
		  diag_type = blas_unit_diag;
		  break;
		}

		/* number of tests */
		for (i = 0; i < ntests; i++) {
		  /* For the sake of speed, we throw out this case at random */
		  if (xrand(seed) >= test_prob)
		    continue;

		  BLAS_ztpmv_c_testgen(norm, order_type, uplo_type,
				       trans_type, diag_type, n,
				       &alpha, alpha_flag, tp, x_gen,
				       seed, head_r_true, tail_r_true);

		  count++;

		  /* varying incx */
		  for (incx_val = -2; incx_val <= 2; incx_val++) {
		    if (incx_val == 0)
		      continue;

		    /* setting incx */
		    incx = incx_val;
		    incx *= 2;

		    /* set x starting index */
		    ix = 0;
		    if (incx < 0)
		      ix = -(n - 1) * incx;

		    /* copy x_gen to x */
		    for (j = 0; j < n; j++) {
		      x[ix] = x_gen[j * inc_index];
		      x[ix + 1] = x_gen[j * inc_index + 1];
		      ix += incx;
		    }

		    /* call BLAS_ztpmv_c */
		    FPU_FIX_STOP;
		    BLAS_ztpmv_c(order_type, uplo_type, trans_type, diag_type,
				 n, alpha, tp, x, incx_val);
		    FPU_FIX_START;

		    /* set x starting index */
		    ix = 0;
		    if (incx < 0)
		      ix = -(n - 1) * incx;

		    /* computing the ratio */
		    for (j = 0; j < n; j++) {
		      /* copy row j of tp to temp */
		      ctpmv_copy_row(order_type, uplo_type, trans_type, n, tp,
				     temp, j);

		      test_BLAS_zdot_c_z(n, blas_no_conj,
					 alpha, beta_zero_fake, rin_zero_fake,
					 &x[ix],
					 &head_r_true[j * inc_index],
					 &tail_r_true[j * inc_index], temp, 1,
					 x_gen, 1, eps_int, un_int,
					 &ratios[j]);

		      /* take the max ratio */
		      if (j == 0)
			ratio = ratios[0];
		      else if (ratios[j] > ratio)
			ratio = ratios[j];

		      ix += incx;
		    }

		    /* increase the number of bad ratio, if the ratio is
		       bigger than the threshold */
		    if (ratio > thresh) {
		      bad_ratios++;

		      if ((debug == 3) &&	/* print only when debug is on */
			  (count != old_count) &&	/* print if old vector is different
							   from the current one */
			  (d_count == find_max_ratio) &&
			  (p_count <= max_print) &&
			  (ratio > 0.5 * ratio_max)) {
			p_count++;
			old_count = count;

			printf
			  ("FAIL> %s: n = %d, ntests = %d, threshold = %4.2f,\n",
			   fname, n, ntests, thresh);

			/* Print test info */
			switch (prec) {
			case blas_prec_single:
			  printf("single ");
			  break;
			case blas_prec_double:
			  printf("double ");
			  break;
			case blas_prec_indigenous:
			  printf("indigenous ");
			  break;
			case blas_prec_extra:
			  printf("extra ");
			  break;
			}
			switch (norm) {
			case -1:
			  printf("near_underflow ");
			  break;
			case 0:
			  printf("near_one ");
			  break;
			case 1:
			  printf("near_overflow ");
			  break;
			}
			switch (order_type) {
			case blas_rowmajor:
			  printf("row_major ");
			  break;
			case blas_colmajor:
			  printf("col_major ");
			  break;
			}
			switch (uplo_type) {
			case blas_upper:
			  printf("upper ");
			  break;
			case blas_lower:
			  printf("lower ");
			  break;
			}
			switch (trans_type) {
			case blas_no_trans:
			  printf("no_trans ");
			  break;
			case blas_trans:
			  printf("trans ");
			  break;
			case blas_conj_trans:
			  printf("conj_trans ");
			  break;
			}
			switch (diag_type) {
			case blas_non_unit_diag:
			  printf("non_unit_diag ");
			  break;
			case blas_unit_diag:
			  printf("unit_diag ");
			  break;
			}

			printf(" incx=%d:\n", incx);
			ix = 0;
			if (incx < 0)
			  ix = -(n - 1) * incx;

			printf("      TP=");
			for (j = 0; j < n; j++) {
			  /* copy row j of tp to temp */
			  ctpmv_copy_row(order_type, uplo_type, trans_type, n,
					 tp, temp, j);

			  if (j > 0)
			    printf("        ");
			  cprint_vector(temp, n, 1, NULL);
			}

			ix = 0;
			if (incx < 0)
			  ix = -(n - 1) * incx;

			for (j = 0; j < n; j++) {
			  printf("      ");
			  printf("x[%d] = ", j * inc_index);
			  printf("(%24.16e, %24.16e)", x_gen[j * inc_index],
				 x_gen[j * inc_index + 1]);
			  printf("; ");
			  printf("x_final[%d] = ", ix);
			  printf("(%24.16e, %24.16e)", x[ix], x[ix + 1]);
			  printf("\n");
			  ix += incx;
			}

			printf("      ");
			printf("alpha = ");
			printf("(%24.16e, %24.16e)", alpha[0], alpha[1]);
			printf("; ");
			printf("\n");
			for (j = 0; j < n; j++) {
			  printf("      ");

			  printf("([%24.16e  %24.16e], [%24.16e %24.16e])",
				 head_r_true[j * inc_index],
				 tail_r_true[j * inc_index],
				 head_r_true[j * inc_index + 1],
				 tail_r_true[j * inc_index + 1]);
			  printf(", ratio[%d]=%.4e\n", j, ratios[j]);
			}
			printf("      ratio=%.4e\n", ratio);
		      }
		    }
		    if (d_count == 0) {
		      if (ratio > ratio_max)
			ratio_max = ratio;
		      if (ratio != 0.0 && ratio < ratio_min)
			ratio_min = ratio;
		      tot_tests++;
		    }
		  }		/* incx */

		}		/* numtests */
	      }			/* diag */
	    }			/* trans */
	  }			/* uplo */
	}			/* order */
      }				/* norm */

    }				/* alpha */
  }				/* debug */

  if ((debug == 2) || ((debug == 1) && bad_ratios > 0)) {
    printf("      %s:  n = %d, ntests = %d, thresh = %4.2f\n",
	   fname, n, ntests, thresh);
    printf
      ("      bad/total = %d/%d=%3.2f, min_ratio = %.4e, max_ratio = %.4e\n\n",
       bad_ratios, tot_tests, ((double) bad_ratios) / ((double) tot_tests),
       ratio_min, ratio_max);
  }

  FPU_FIX_STOP;

  blas_free(x);
  blas_free(x_gen);
  blas_free(temp);
  blas_free(tp);
  blas_free(head_r_true);
  blas_free(tail_r_true);
  blas_free(ratios);

  *min_ratio = ratio_min;
  *num_bad_ratio = bad_ratios;
  *num_tests = tot_tests;
  return ratio_max;
}				/* end of do_test_ztpmv_c */

double do_test_ctpmv_s(int n,
		       int ntests,
		       int *seed,
		       double thresh,
		       int debug,
		       float test_prob,
		       double *min_ratio, int *num_bad_ratio, int *num_tests)

/*
 * Purpose
 * =======
 *
 * Runs a series of tests on TPMV.
 *
 * Arguments
 * =========
 *
 * n         (input) int
 *           The size of vector being tested
 *
 * ntests    (input) int
 *           The number of tests to run for each set of attributes.
 *
 * seed      (input/output) int
 *           The seed for the random number generator used in testgen().
 *
 * thresh    (input) double
 *           When the ratio returned from test() exceeds the specified
 *           threshold, the current size, r_true, r_comp, and ratio will be
 *           printed.  (Since ratio is supposed to be O(1), we can set thresh
 *           to ~10.)
 *
 * debug     (input) int
 *           If debug=3, print summary
 *           If debug=2, print summary only if the number of bad ratios > 0
 *           If debug=1, print complete info if tests fail
 *           If debug=0, return max ratio
 *
 * min_ratio (output) double
 *           The minimum ratio
 *
 * num_bad_ratio (output) int
 *               The number of tests fail; they are above the threshold.
 *
 * num_tests (output) int
 *           The number of tests is being performed.
 *
 * Return value
 * ============
 *
 * The maximum ratio if run successfully, otherwise return -1
 *
 * Code structure
 * ==============
 *
 *  debug loop  -- if debug is one, the first loop computes the max ratio
 *              -- and the last(second) loop outputs debugging information,
 *              -- if the test fail and its ratio > 0.5 * max ratio.
 *              -- if debug is zero, the loop is executed once
 *    alpha loop  -- varying alpha: 0, 1, or random
 *
 *        norm loop   -- varying norm: near undeflow, near one, or
 *                    -- near overflow
 *          order loop  -- varying order type: rowmajor or colmajor
 *            uplo loop   -- varying uplo type: upper or lower
 *              trans loop  -- varying trans type: no trans, trans, and conj trans
 *                diag loop   -- varying diag type: non unit, and unit
 *                  numtest loop  -- how many times the test is perform with
 *                                -- above set of attributes
 *                        incx loop     -- varying incx: -2, -1, 1, 2
 */
{
  /* function name */
  const char fname[] = "BLAS_ctpmv_s";

  /* max number of debug lines to print */
  const int max_print = 3;

  /* Variables in the "x_val" form are loop vars for corresponding
     variables */
  int i;			/* iterate through the repeating tests */
  int j;			/* multipurpose counters */
  int ix;			/* use to index x  */
  int incx_val, incx;		/* for testing different inc values */
  int inctp, inc_index;		/* 1 if real, 2 if complex */
  int d_count;			/* counter for debug */
  int find_max_ratio;		/* find_max_ratio = 1 only if debug = 3 */
  int p_count;			/* counter for the number of debug lines printed */
  int tot_tests;		/* total number of tests to be done */
  int norm;			/* input values of near underflow/one/overflow */
  double ratio_max;		/* the current maximum ratio */
  double ratio_min;		/* the current minimum ratio */
  double *ratios;		/* a temporary variable for calculating ratio */
  double ratio = 0.0;		/* the per-use test ratio from test() */
  int bad_ratios = 0;		/* the number of ratios over the threshold */
  double eps_int;		/* the internal epsilon expected--2^(-24) for float */
  double un_int;		/* the internal underflow threshold */
  float alpha[2];
  float beta[2];
  float *tp;
  float *x;
  float *x_gen;			/* used to store vectors generated by testgen; eventually copied to x */
  float *temp;			/* use for calculating ratio */

  /* the true r calculated by testgen(), in double-double */
  double *head_r_true, *tail_r_true;


  int alpha_val;
  int alpha_flag = 0, beta_flag = 0;
  int order_val;
  enum blas_order_type order_type = 0;

  enum blas_prec_type prec = 0;
  int uplo_val;
  enum blas_uplo_type uplo_type = 0;
  int trans_val;
  enum blas_trans_type trans_type = 0;
  int diag_val;
  enum blas_diag_type diag_type = 0;

  float beta_zero_fake[2];
  float rin_zero_fake[2];

  int saved_seed;		/* for saving the original seed */
  int count, old_count = -1;
  FPU_FIX_DECL;

  /* test for bad arguments */
  if (n < 0 || ntests < 0)
    BLAS_error(fname, 0, 0, NULL);

  /* if there is nothing to test, return all zero */
  if (n == 0 || ntests == 0) {
    *min_ratio = 0.0;
    *num_bad_ratio = 0;
    *num_tests = 0;
    return 0.0;
  }

  FPU_FIX_START;


  incx = inctp = inc_index = 1;
  incx *= 2;

  inc_index *= 2;

  /* get space for calculation */
  x = (float *) blas_malloc(3 * n * 2 * sizeof(float) * 2);
  if (3 * n * 2 > 0 && x == NULL) {
    BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
  }
  x_gen = (float *) blas_malloc(3 * n * 2 * sizeof(float) * 2);
  if (3 * n * 2 > 0 && x_gen == NULL) {
    BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
  }
  tp = (float *) blas_malloc(2 * n * n * n * inctp * sizeof(float));
  if (2 * n * n * n * inctp > 0 && tp == NULL) {
    BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
  }
  temp = (float *) blas_malloc(3 * n * 2 * sizeof(float));
  if (3 * n * 2 > 0 && temp == 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");
  }


  /* initialization */
  saved_seed = *seed;
  ratio_min = 1e308;
  ratio_max = 0.0;
  tot_tests = 0;
  p_count = 0;
  count = 0;
  find_max_ratio = 0;
  beta[0] = beta[1] = 0.0;
  beta_flag = 1;

  beta_zero_fake[0] = beta_zero_fake[1] = 0.0;
  rin_zero_fake[0] = rin_zero_fake[1] = 0.0;

  if (debug == 3)
    find_max_ratio = 1;

  /* The debug iteration:
     If debug=1, then will execute the iteration twice. First, compute the
     max ratio. Second, print info if ratio > (50% * ratio_max). */
  for (d_count = 0; d_count <= find_max_ratio; d_count++) {
    bad_ratios = 0;		/* set to zero */

    if ((debug == 3) && (d_count == find_max_ratio))
      *seed = saved_seed;	/* restore the original seed */

    /* varying alpha */
    for (alpha_val = 0; alpha_val < 3; 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;
      }


      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;

      /* values near underflow, 1, or overflow */
      for (norm = -1; norm <= 1; norm++) {

	/* row or col major */
	for (order_val = 0; order_val < 2; order_val++) {
	  switch (order_val) {
	  case 0:
	    order_type = blas_rowmajor;
	    break;
	  case 1:
	    order_type = blas_colmajor;
	    break;
	  }

	  /* upper or lower */
	  for (uplo_val = 0; uplo_val < 2; uplo_val++) {
	    switch (uplo_val) {
	    case 0:
	      uplo_type = blas_upper;
	      break;
	    case 1:
	      uplo_type = blas_lower;
	      break;
	    }

	    /* no trans, trans, or conj trans */
	    for (trans_val = 0; trans_val < 3; trans_val++) {
	      switch (trans_val) {
	      case 0:
		trans_type = blas_no_trans;
		break;
	      case 1:
		trans_type = blas_trans;
		break;
	      case 2:
		trans_type = blas_conj_trans;
		break;
	      }

	      /* non_unit_diag, unit_diag */
	      for (diag_val = 0; diag_val < 2; diag_val++) {
		switch (diag_val) {
		case 0:
		  diag_type = blas_non_unit_diag;
		  break;
		case 1:
		  diag_type = blas_unit_diag;
		  break;
		}

		/* number of tests */
		for (i = 0; i < ntests; i++) {
		  /* For the sake of speed, we throw out this case at random */
		  if (xrand(seed) >= test_prob)
		    continue;

		  BLAS_ctpmv_s_testgen(norm, order_type, uplo_type,
				       trans_type, diag_type, n,
				       &alpha, alpha_flag, tp, x_gen,
				       seed, head_r_true, tail_r_true);

		  count++;

		  /* varying incx */
		  for (incx_val = -2; incx_val <= 2; incx_val++) {
		    if (incx_val == 0)
		      continue;

		    /* setting incx */
		    incx = incx_val;
		    incx *= 2;

		    /* set x starting index */
		    ix = 0;
		    if (incx < 0)
		      ix = -(n - 1) * incx;

		    /* copy x_gen to x */
		    for (j = 0; j < n; j++) {
		      x[ix] = x_gen[j * inc_index];
		      x[ix + 1] = x_gen[j * inc_index + 1];
		      ix += incx;
		    }

		    /* call BLAS_ctpmv_s */
		    FPU_FIX_STOP;
		    BLAS_ctpmv_s(order_type, uplo_type, trans_type, diag_type,
				 n, alpha, tp, x, incx_val);
		    FPU_FIX_START;

		    /* set x starting index */
		    ix = 0;
		    if (incx < 0)
		      ix = -(n - 1) * incx;

		    /* computing the ratio */
		    for (j = 0; j < n; j++) {
		      /* copy row j of tp to temp */
		      stpmv_copy_row(order_type, uplo_type, trans_type, n, tp,
				     temp, j);

		      test_BLAS_cdot_s_c(n, blas_no_conj,
					 alpha, beta_zero_fake, rin_zero_fake,
					 &x[ix],
					 &head_r_true[j * inc_index],
					 &tail_r_true[j * inc_index], temp, 1,
					 x_gen, 1, eps_int, un_int,
					 &ratios[j]);

		      /* take the max ratio */
		      if (j == 0)
			ratio = ratios[0];
		      else if (ratios[j] > ratio)
			ratio = ratios[j];

		      ix += incx;
		    }

		    /* increase the number of bad ratio, if the ratio is
		       bigger than the threshold */
		    if (ratio > thresh) {
		      bad_ratios++;

		      if ((debug == 3) &&	/* print only when debug is on */
			  (count != old_count) &&	/* print if old vector is different
							   from the current one */
			  (d_count == find_max_ratio) &&
			  (p_count <= max_print) &&
			  (ratio > 0.5 * ratio_max)) {
			p_count++;
			old_count = count;

			printf
			  ("FAIL> %s: n = %d, ntests = %d, threshold = %4.2f,\n",
			   fname, n, ntests, thresh);

			/* Print test info */
			switch (prec) {
			case blas_prec_single:
			  printf("single ");
			  break;
			case blas_prec_double:
			  printf("double ");
			  break;
			case blas_prec_indigenous:
			  printf("indigenous ");
			  break;
			case blas_prec_extra:
			  printf("extra ");
			  break;
			}
			switch (norm) {
			case -1:
			  printf("near_underflow ");
			  break;
			case 0:
			  printf("near_one ");
			  break;
			case 1:
			  printf("near_overflow ");
			  break;
			}
			switch (order_type) {
			case blas_rowmajor:
			  printf("row_major ");
			  break;
			case blas_colmajor:
			  printf("col_major ");
			  break;
			}
			switch (uplo_type) {
			case blas_upper:
			  printf("upper ");
			  break;
			case blas_lower:
			  printf("lower ");
			  break;
			}
			switch (trans_type) {
			case blas_no_trans:
			  printf("no_trans ");
			  break;
			case blas_trans:
			  printf("trans ");
			  break;
			case blas_conj_trans:
			  printf("conj_trans ");
			  break;
			}
			switch (diag_type) {
			case blas_non_unit_diag:
			  printf("non_unit_diag ");
			  break;
			case blas_unit_diag:
			  printf("unit_diag ");
			  break;
			}

			printf(" incx=%d:\n", incx);
			ix = 0;
			if (incx < 0)
			  ix = -(n - 1) * incx;

			printf("      TP=");
			for (j = 0; j < n; j++) {
			  /* copy row j of tp to temp */
			  stpmv_copy_row(order_type, uplo_type, trans_type, n,
					 tp, temp, j);

			  if (j > 0)
			    printf("        ");
			  sprint_vector(temp, n, 1, NULL);
			}

			ix = 0;
			if (incx < 0)
			  ix = -(n - 1) * incx;

			for (j = 0; j < n; j++) {
			  printf("      ");
			  printf("x[%d] = ", j * inc_index);
			  printf("(%16.8e, %16.8e)", x_gen[j * inc_index],
				 x_gen[j * inc_index + 1]);
			  printf("; ");
			  printf("x_final[%d] = ", ix);
			  printf("(%16.8e, %16.8e)", x[ix], x[ix + 1]);
			  printf("\n");
			  ix += incx;
			}

			printf("      ");
			printf("alpha = ");
			printf("(%16.8e, %16.8e)", alpha[0], alpha[1]);
			printf("; ");
			printf("\n");
			for (j = 0; j < n; j++) {
			  printf("      ");

			  printf("([%24.16e  %24.16e], [%24.16e %24.16e])",
				 head_r_true[j * inc_index],
				 tail_r_true[j * inc_index],
				 head_r_true[j * inc_index + 1],
				 tail_r_true[j * inc_index + 1]);
			  printf(", ratio[%d]=%.4e\n", j, ratios[j]);
			}
			printf("      ratio=%.4e\n", ratio);
		      }
		    }
		    if (d_count == 0) {
		      if (ratio > ratio_max)
			ratio_max = ratio;
		      if (ratio != 0.0 && ratio < ratio_min)
			ratio_min = ratio;
		      tot_tests++;
		    }
		  }		/* incx */

		}		/* numtests */
	      }			/* diag */
	    }			/* trans */
	  }			/* uplo */
	}			/* order */
      }				/* norm */

    }				/* alpha */
  }				/* debug */

  if ((debug == 2) || ((debug == 1) && bad_ratios > 0)) {
    printf("      %s:  n = %d, ntests = %d, thresh = %4.2f\n",
	   fname, n, ntests, thresh);
    printf
      ("      bad/total = %d/%d=%3.2f, min_ratio = %.4e, max_ratio = %.4e\n\n",
       bad_ratios, tot_tests, ((double) bad_ratios) / ((double) tot_tests),
       ratio_min, ratio_max);
  }

  FPU_FIX_STOP;

  blas_free(x);
  blas_free(x_gen);
  blas_free(temp);
  blas_free(tp);
  blas_free(head_r_true);
  blas_free(tail_r_true);
  blas_free(ratios);

  *min_ratio = ratio_min;
  *num_bad_ratio = bad_ratios;
  *num_tests = tot_tests;
  return ratio_max;
}				/* end of do_test_ctpmv_s */

double do_test_ztpmv_d(int n,
		       int ntests,
		       int *seed,
		       double thresh,
		       int debug,
		       float test_prob,
		       double *min_ratio, int *num_bad_ratio, int *num_tests)

/*
 * Purpose
 * =======
 *
 * Runs a series of tests on TPMV.
 *
 * Arguments
 * =========
 *
 * n         (input) int
 *           The size of vector being tested
 *
 * ntests    (input) int
 *           The number of tests to run for each set of attributes.
 *
 * seed      (input/output) int
 *           The seed for the random number generator used in testgen().
 *
 * thresh    (input) double
 *           When the ratio returned from test() exceeds the specified
 *           threshold, the current size, r_true, r_comp, and ratio will be
 *           printed.  (Since ratio is supposed to be O(1), we can set thresh
 *           to ~10.)
 *
 * debug     (input) int
 *           If debug=3, print summary
 *           If debug=2, print summary only if the number of bad ratios > 0
 *           If debug=1, print complete info if tests fail
 *           If debug=0, return max ratio
 *
 * min_ratio (output) double
 *           The minimum ratio
 *
 * num_bad_ratio (output) int
 *               The number of tests fail; they are above the threshold.
 *
 * num_tests (output) int
 *           The number of tests is being performed.
 *
 * Return value
 * ============
 *
 * The maximum ratio if run successfully, otherwise return -1
 *
 * Code structure
 * ==============
 *
 *  debug loop  -- if debug is one, the first loop computes the max ratio
 *              -- and the last(second) loop outputs debugging information,
 *              -- if the test fail and its ratio > 0.5 * max ratio.
 *              -- if debug is zero, the loop is executed once
 *    alpha loop  -- varying alpha: 0, 1, or random
 *
 *        norm loop   -- varying norm: near undeflow, near one, or
 *                    -- near overflow
 *          order loop  -- varying order type: rowmajor or colmajor
 *            uplo loop   -- varying uplo type: upper or lower
 *              trans loop  -- varying trans type: no trans, trans, and conj trans
 *                diag loop   -- varying diag type: non unit, and unit
 *                  numtest loop  -- how many times the test is perform with
 *                                -- above set of attributes
 *                        incx loop     -- varying incx: -2, -1, 1, 2
 */
{
  /* function name */
  const char fname[] = "BLAS_ztpmv_d";

  /* max number of debug lines to print */
  const int max_print = 3;

  /* Variables in the "x_val" form are loop vars for corresponding
     variables */
  int i;			/* iterate through the repeating tests */
  int j;			/* multipurpose counters */
  int ix;			/* use to index x  */
  int incx_val, incx;		/* for testing different inc values */
  int inctp, inc_index;		/* 1 if real, 2 if complex */
  int d_count;			/* counter for debug */
  int find_max_ratio;		/* find_max_ratio = 1 only if debug = 3 */
  int p_count;			/* counter for the number of debug lines printed */
  int tot_tests;		/* total number of tests to be done */
  int norm;			/* input values of near underflow/one/overflow */
  double ratio_max;		/* the current maximum ratio */
  double ratio_min;		/* the current minimum ratio */
  double *ratios;		/* a temporary variable for calculating ratio */
  double ratio = 0.0;		/* the per-use test ratio from test() */
  int bad_ratios = 0;		/* the number of ratios over the threshold */
  double eps_int;		/* the internal epsilon expected--2^(-24) for float */
  double un_int;		/* the internal underflow threshold */
  double alpha[2];
  double beta[2];
  double *tp;
  double *x;
  double *x_gen;		/* used to store vectors generated by testgen; eventually copied to x */
  double *temp;			/* use for calculating ratio */

  /* the true r calculated by testgen(), in double-double */
  double *head_r_true, *tail_r_true;


  int alpha_val;
  int alpha_flag = 0, beta_flag = 0;
  int order_val;
  enum blas_order_type order_type = 0;

  enum blas_prec_type prec = 0;
  int uplo_val;
  enum blas_uplo_type uplo_type = 0;
  int trans_val;
  enum blas_trans_type trans_type = 0;
  int diag_val;
  enum blas_diag_type diag_type = 0;

  double beta_zero_fake[2];
  double rin_zero_fake[2];

  int saved_seed;		/* for saving the original seed */
  int count, old_count = -1;
  FPU_FIX_DECL;

  /* test for bad arguments */
  if (n < 0 || ntests < 0)
    BLAS_error(fname, 0, 0, NULL);

  /* if there is nothing to test, return all zero */
  if (n == 0 || ntests == 0) {
    *min_ratio = 0.0;
    *num_bad_ratio = 0;
    *num_tests = 0;
    return 0.0;
  }

  FPU_FIX_START;


  incx = inctp = inc_index = 1;
  incx *= 2;

  inc_index *= 2;

  /* get space for calculation */
  x = (double *) blas_malloc(3 * n * 2 * sizeof(double) * 2);
  if (3 * n * 2 > 0 && x == NULL) {
    BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
  }
  x_gen = (double *) blas_malloc(3 * n * 2 * sizeof(double) * 2);
  if (3 * n * 2 > 0 && x_gen == NULL) {
    BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
  }
  tp = (double *) blas_malloc(2 * n * n * n * inctp * sizeof(double));
  if (2 * n * n * n * inctp > 0 && tp == NULL) {
    BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
  }
  temp = (double *) blas_malloc(3 * n * 2 * sizeof(double));
  if (3 * n * 2 > 0 && temp == 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");
  }


  /* initialization */
  saved_seed = *seed;
  ratio_min = 1e308;
  ratio_max = 0.0;
  tot_tests = 0;
  p_count = 0;
  count = 0;
  find_max_ratio = 0;
  beta[0] = beta[1] = 0.0;
  beta_flag = 1;

  beta_zero_fake[0] = beta_zero_fake[1] = 0.0;
  rin_zero_fake[0] = rin_zero_fake[1] = 0.0;

  if (debug == 3)
    find_max_ratio = 1;

  /* The debug iteration:
     If debug=1, then will execute the iteration twice. First, compute the
     max ratio. Second, print info if ratio > (50% * ratio_max). */
  for (d_count = 0; d_count <= find_max_ratio; d_count++) {
    bad_ratios = 0;		/* set to zero */

    if ((debug == 3) && (d_count == find_max_ratio))
      *seed = saved_seed;	/* restore the original seed */

    /* varying alpha */
    for (alpha_val = 0; alpha_val < 3; 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;
      }


      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;

      /* values near underflow, 1, or overflow */
      for (norm = -1; norm <= 1; norm++) {

	/* row or col major */
	for (order_val = 0; order_val < 2; order_val++) {
	  switch (order_val) {
	  case 0:
	    order_type = blas_rowmajor;
	    break;
	  case 1:
	    order_type = blas_colmajor;
	    break;
	  }

	  /* upper or lower */
	  for (uplo_val = 0; uplo_val < 2; uplo_val++) {
	    switch (uplo_val) {
	    case 0:
	      uplo_type = blas_upper;
	      break;
	    case 1:
	      uplo_type = blas_lower;
	      break;
	    }

	    /* no trans, trans, or conj trans */
	    for (trans_val = 0; trans_val < 3; trans_val++) {
	      switch (trans_val) {
	      case 0:
		trans_type = blas_no_trans;
		break;
	      case 1:
		trans_type = blas_trans;
		break;
	      case 2:
		trans_type = blas_conj_trans;
		break;
	      }

	      /* non_unit_diag, unit_diag */
	      for (diag_val = 0; diag_val < 2; diag_val++) {
		switch (diag_val) {
		case 0:
		  diag_type = blas_non_unit_diag;
		  break;
		case 1:
		  diag_type = blas_unit_diag;
		  break;
		}

		/* number of tests */
		for (i = 0; i < ntests; i++) {
		  /* For the sake of speed, we throw out this case at random */
		  if (xrand(seed) >= test_prob)
		    continue;

		  BLAS_ztpmv_d_testgen(norm, order_type, uplo_type,
				       trans_type, diag_type, n,
				       &alpha, alpha_flag, tp, x_gen,
				       seed, head_r_true, tail_r_true);

		  count++;

		  /* varying incx */
		  for (incx_val = -2; incx_val <= 2; incx_val++) {
		    if (incx_val == 0)
		      continue;

		    /* setting incx */
		    incx = incx_val;
		    incx *= 2;

		    /* set x starting index */
		    ix = 0;
		    if (incx < 0)
		      ix = -(n - 1) * incx;

		    /* copy x_gen to x */
		    for (j = 0; j < n; j++) {
		      x[ix] = x_gen[j * inc_index];
		      x[ix + 1] = x_gen[j * inc_index + 1];
		      ix += incx;
		    }

		    /* call BLAS_ztpmv_d */
		    FPU_FIX_STOP;
		    BLAS_ztpmv_d(order_type, uplo_type, trans_type, diag_type,
				 n, alpha, tp, x, incx_val);
		    FPU_FIX_START;

		    /* set x starting index */
		    ix = 0;
		    if (incx < 0)
		      ix = -(n - 1) * incx;

		    /* computing the ratio */
		    for (j = 0; j < n; j++) {
		      /* copy row j of tp to temp */
		      dtpmv_copy_row(order_type, uplo_type, trans_type, n, tp,
				     temp, j);

		      test_BLAS_zdot_d_z(n, blas_no_conj,
					 alpha, beta_zero_fake, rin_zero_fake,
					 &x[ix],
					 &head_r_true[j * inc_index],
					 &tail_r_true[j * inc_index], temp, 1,
					 x_gen, 1, eps_int, un_int,
					 &ratios[j]);

		      /* take the max ratio */
		      if (j == 0)
			ratio = ratios[0];
		      else if (ratios[j] > ratio)
			ratio = ratios[j];

		      ix += incx;
		    }

		    /* increase the number of bad ratio, if the ratio is
		       bigger than the threshold */
		    if (ratio > thresh) {
		      bad_ratios++;

		      if ((debug == 3) &&	/* print only when debug is on */
			  (count != old_count) &&	/* print if old vector is different
							   from the current one */
			  (d_count == find_max_ratio) &&
			  (p_count <= max_print) &&
			  (ratio > 0.5 * ratio_max)) {
			p_count++;
			old_count = count;

			printf
			  ("FAIL> %s: n = %d, ntests = %d, threshold = %4.2f,\n",
			   fname, n, ntests, thresh);

			/* Print test info */
			switch (prec) {
			case blas_prec_single:
			  printf("single ");
			  break;
			case blas_prec_double:
			  printf("double ");
			  break;
			case blas_prec_indigenous:
			  printf("indigenous ");
			  break;
			case blas_prec_extra:
			  printf("extra ");
			  break;
			}
			switch (norm) {
			case -1:
			  printf("near_underflow ");
			  break;
			case 0:
			  printf("near_one ");
			  break;
			case 1:
			  printf("near_overflow ");
			  break;
			}
			switch (order_type) {
			case blas_rowmajor:
			  printf("row_major ");
			  break;
			case blas_colmajor:
			  printf("col_major ");
			  break;
			}
			switch (uplo_type) {
			case blas_upper:
			  printf("upper ");
			  break;
			case blas_lower:
			  printf("lower ");
			  break;
			}
			switch (trans_type) {
			case blas_no_trans:
			  printf("no_trans ");
			  break;
			case blas_trans:
			  printf("trans ");
			  break;
			case blas_conj_trans:
			  printf("conj_trans ");
			  break;
			}
			switch (diag_type) {
			case blas_non_unit_diag:
			  printf("non_unit_diag ");
			  break;
			case blas_unit_diag:
			  printf("unit_diag ");
			  break;
			}

			printf(" incx=%d:\n", incx);
			ix = 0;
			if (incx < 0)
			  ix = -(n - 1) * incx;

			printf("      TP=");
			for (j = 0; j < n; j++) {
			  /* copy row j of tp to temp */
			  dtpmv_copy_row(order_type, uplo_type, trans_type, n,
					 tp, temp, j);

			  if (j > 0)
			    printf("        ");
			  dprint_vector(temp, n, 1, NULL);
			}

			ix = 0;
			if (incx < 0)
			  ix = -(n - 1) * incx;

			for (j = 0; j < n; j++) {
			  printf("      ");
			  printf("x[%d] = ", j * inc_index);
			  printf("(%24.16e, %24.16e)", x_gen[j * inc_index],
				 x_gen[j * inc_index + 1]);
			  printf("; ");
			  printf("x_final[%d] = ", ix);
			  printf("(%24.16e, %24.16e)", x[ix], x[ix + 1]);
			  printf("\n");
			  ix += incx;
			}

			printf("      ");
			printf("alpha = ");
			printf("(%24.16e, %24.16e)", alpha[0], alpha[1]);
			printf("; ");
			printf("\n");
			for (j = 0; j < n; j++) {
			  printf("      ");

			  printf("([%24.16e  %24.16e], [%24.16e %24.16e])",
				 head_r_true[j * inc_index],
				 tail_r_true[j * inc_index],
				 head_r_true[j * inc_index + 1],
				 tail_r_true[j * inc_index + 1]);
			  printf(", ratio[%d]=%.4e\n", j, ratios[j]);
			}
			printf("      ratio=%.4e\n", ratio);
		      }
		    }
		    if (d_count == 0) {
		      if (ratio > ratio_max)
			ratio_max = ratio;
		      if (ratio != 0.0 && ratio < ratio_min)
			ratio_min = ratio;
		      tot_tests++;
		    }
		  }		/* incx */

		}		/* numtests */
	      }			/* diag */
	    }			/* trans */
	  }			/* uplo */
	}			/* order */
      }				/* norm */

    }				/* alpha */
  }				/* debug */

  if ((debug == 2) || ((debug == 1) && bad_ratios > 0)) {
    printf("      %s:  n = %d, ntests = %d, thresh = %4.2f\n",
	   fname, n, ntests, thresh);
    printf
      ("      bad/total = %d/%d=%3.2f, min_ratio = %.4e, max_ratio = %.4e\n\n",
       bad_ratios, tot_tests, ((double) bad_ratios) / ((double) tot_tests),
       ratio_min, ratio_max);
  }

  FPU_FIX_STOP;

  blas_free(x);
  blas_free(x_gen);
  blas_free(temp);
  blas_free(tp);
  blas_free(head_r_true);
  blas_free(tail_r_true);
  blas_free(ratios);

  *min_ratio = ratio_min;
  *num_bad_ratio = bad_ratios;
  *num_tests = tot_tests;
  return ratio_max;
}				/* end of do_test_ztpmv_d */

double do_test_stpmv_x(int n,
		       int ntests,
		       int *seed,
		       double thresh,
		       int debug,
		       float test_prob,
		       double *min_ratio, int *num_bad_ratio, int *num_tests)

/*
 * Purpose
 * =======
 *
 * Runs a series of tests on TPMV.
 *
 * Arguments
 * =========
 *
 * n         (input) int
 *           The size of vector being tested
 *
 * ntests    (input) int
 *           The number of tests to run for each set of attributes.
 *
 * seed      (input/output) int
 *           The seed for the random number generator used in testgen().
 *
 * thresh    (input) double
 *           When the ratio returned from test() exceeds the specified
 *           threshold, the current size, r_true, r_comp, and ratio will be
 *           printed.  (Since ratio is supposed to be O(1), we can set thresh
 *           to ~10.)
 *
 * debug     (input) int
 *           If debug=3, print summary
 *           If debug=2, print summary only if the number of bad ratios > 0
 *           If debug=1, print complete info if tests fail
 *           If debug=0, return max ratio
 *
 * min_ratio (output) double
 *           The minimum ratio
 *
 * num_bad_ratio (output) int
 *               The number of tests fail; they are above the threshold.
 *
 * num_tests (output) int
 *           The number of tests is being performed.
 *
 * Return value
 * ============
 *
 * The maximum ratio if run successfully, otherwise return -1
 *
 * Code structure
 * ==============
 *
 *  debug loop  -- if debug is one, the first loop computes the max ratio
 *              -- and the last(second) loop outputs debugging information,
 *              -- if the test fail and its ratio > 0.5 * max ratio.
 *              -- if debug is zero, the loop is executed once
 *    alpha loop  -- varying alpha: 0, 1, or random
 *        prec loop   -- varying internal prec: single, double, or extra
 *        norm loop   -- varying norm: near undeflow, near one, or
 *                    -- near overflow
 *          order loop  -- varying order type: rowmajor or colmajor
 *            uplo loop   -- varying uplo type: upper or lower
 *              trans loop  -- varying trans type: no trans, trans, and conj trans
 *                diag loop   -- varying diag type: non unit, and unit
 *                  numtest loop  -- how many times the test is perform with
 *                                -- above set of attributes
 *                        incx loop     -- varying incx: -2, -1, 1, 2
 */
{
  /* function name */
  const char fname[] = "BLAS_stpmv_x";

  /* max number of debug lines to print */
  const int max_print = 3;

  /* Variables in the "x_val" form are loop vars for corresponding
     variables */
  int i;			/* iterate through the repeating tests */
  int j;			/* multipurpose counters */
  int ix;			/* use to index x  */
  int incx_val, incx;		/* for testing different inc values */
  int inctp, inc_index;		/* 1 if real, 2 if complex */
  int d_count;			/* counter for debug */
  int find_max_ratio;		/* find_max_ratio = 1 only if debug = 3 */
  int p_count;			/* counter for the number of debug lines printed */
  int tot_tests;		/* total number of tests to be done */
  int norm;			/* input values of near underflow/one/overflow */
  double ratio_max;		/* the current maximum ratio */
  double ratio_min;		/* the current minimum ratio */
  double *ratios;		/* a temporary variable for calculating ratio */
  double ratio = 0.0;		/* the per-use test ratio from test() */
  int bad_ratios = 0;		/* the number of ratios over the threshold */
  double eps_int;		/* the internal epsilon expected--2^(-24) for float */
  double un_int;		/* the internal underflow threshold */
  float alpha;
  float beta;
  float *tp;
  float *x;
  float *x_gen;			/* used to store vectors generated by testgen; eventually copied to x */
  float *temp;			/* use for calculating ratio */

  /* the true r calculated by testgen(), in double-double */
  double *head_r_true, *tail_r_true;

  int alpha_val;
  int alpha_flag = 0, beta_flag = 0;
  int order_val;
  enum blas_order_type order_type = 0;
  int prec_val;
  enum blas_prec_type prec = 0;
  int uplo_val;
  enum blas_uplo_type uplo_type = 0;
  int trans_val;
  enum blas_trans_type trans_type = 0;
  int diag_val;
  enum blas_diag_type diag_type = 0;

  float beta_zero_fake;
  float rin_zero_fake;

  int saved_seed;		/* for saving the original seed */
  int count, old_count = -1;
  FPU_FIX_DECL;

  /* test for bad arguments */
  if (n < 0 || ntests < 0)
    BLAS_error(fname, 0, 0, NULL);

  /* if there is nothing to test, return all zero */
  if (n == 0 || ntests == 0) {
    *min_ratio = 0.0;
    *num_bad_ratio = 0;
    *num_tests = 0;
    return 0.0;
  }

  FPU_FIX_START;


  incx = inctp = inc_index = 1;


  /* get space for calculation */
  x = (float *) blas_malloc(3 * n * 2 * sizeof(float));
  if (3 * n * 2 > 0 && x == NULL) {
    BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
  }
  x_gen = (float *) blas_malloc(3 * n * 2 * sizeof(float));
  if (3 * n * 2 > 0 && x_gen == NULL) {
    BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
  }
  tp = (float *) blas_malloc(2 * n * n * n * inctp * sizeof(float));
  if (2 * n * n * n * inctp > 0 && tp == NULL) {
    BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
  }
  temp = (float *) blas_malloc(3 * n * 2 * sizeof(float));
  if (3 * n * 2 > 0 && temp == NULL) {
    BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
  }
  head_r_true = (double *) blas_malloc(n * sizeof(double));
  tail_r_true = (double *) blas_malloc(n * sizeof(double));
  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");
  }


  /* initialization */
  saved_seed = *seed;
  ratio_min = 1e308;
  ratio_max = 0.0;
  tot_tests = 0;
  p_count = 0;
  count = 0;
  find_max_ratio = 0;
  beta = 0.0;
  beta_flag = 1;

  beta_zero_fake = 0.0;
  rin_zero_fake = 0.0;

  if (debug == 3)
    find_max_ratio = 1;

  /* The debug iteration:
     If debug=1, then will execute the iteration twice. First, compute the
     max ratio. Second, print info if ratio > (50% * ratio_max). */
  for (d_count = 0; d_count <= find_max_ratio; d_count++) {
    bad_ratios = 0;		/* set to zero */

    if ((debug == 3) && (d_count == find_max_ratio))
      *seed = saved_seed;	/* restore the original seed */

    /* varying alpha */
    for (alpha_val = 0; alpha_val < 3; alpha_val++) {
      alpha_flag = 0;
      switch (alpha_val) {
      case 0:
	alpha = 0.0;
	alpha_flag = 1;
	break;
      case 1:
	alpha = 1.0;
	alpha_flag = 1;
	break;
      }


      /* varying extra precs */
      for (prec_val = 0; prec_val <= 2; 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;
	}

	/* values near underflow, 1, or overflow */
	for (norm = -1; norm <= 1; norm++) {

	  /* row or col major */
	  for (order_val = 0; order_val < 2; order_val++) {
	    switch (order_val) {
	    case 0:
	      order_type = blas_rowmajor;
	      break;
	    case 1:
	      order_type = blas_colmajor;
	      break;
	    }

	    /* upper or lower */
	    for (uplo_val = 0; uplo_val < 2; uplo_val++) {
	      switch (uplo_val) {
	      case 0:
		uplo_type = blas_upper;
		break;
	      case 1:
		uplo_type = blas_lower;
		break;
	      }

	      /* no trans, trans, or conj trans */
	      for (trans_val = 0; trans_val < 3; trans_val++) {
		switch (trans_val) {
		case 0:
		  trans_type = blas_no_trans;
		  break;
		case 1:
		  trans_type = blas_trans;
		  break;
		case 2:
		  trans_type = blas_conj_trans;
		  break;
		}

		/* non_unit_diag, unit_diag */
		for (diag_val = 0; diag_val < 2; diag_val++) {
		  switch (diag_val) {
		  case 0:
		    diag_type = blas_non_unit_diag;
		    break;
		  case 1:
		    diag_type = blas_unit_diag;
		    break;
		  }

		  /* number of tests */
		  for (i = 0; i < ntests; i++) {
		    /* For the sake of speed, we throw out this case at random */
		    if (xrand(seed) >= test_prob)
		      continue;

		    BLAS_stpmv_testgen(norm, order_type, uplo_type,
				       trans_type, diag_type, n,
				       &alpha, alpha_flag, tp, x_gen,
				       seed, head_r_true, tail_r_true);

		    count++;

		    /* varying incx */
		    for (incx_val = -2; incx_val <= 2; incx_val++) {
		      if (incx_val == 0)
			continue;

		      /* setting incx */
		      incx = incx_val;


		      /* set x starting index */
		      ix = 0;
		      if (incx < 0)
			ix = -(n - 1) * incx;

		      /* copy x_gen to x */
		      for (j = 0; j < n; j++) {
			x[ix] = x_gen[j * inc_index];
			ix += incx;
		      }

		      /* call BLAS_stpmv_x */
		      FPU_FIX_STOP;
		      BLAS_stpmv_x(order_type, uplo_type, trans_type,
				   diag_type, n, alpha, tp, x, incx_val,
				   prec);
		      FPU_FIX_START;

		      /* set x starting index */
		      ix = 0;
		      if (incx < 0)
			ix = -(n - 1) * incx;

		      /* computing the ratio */
		      for (j = 0; j < n; j++) {
			/* copy row j of tp to temp */
			stpmv_copy_row(order_type, uplo_type, trans_type, n,
				       tp, temp, j);

			test_BLAS_sdot(n, blas_no_conj,
				       alpha, beta_zero_fake, rin_zero_fake,
				       x[ix],
				       head_r_true[j * inc_index],
				       tail_r_true[j * inc_index], temp, 1,
				       x_gen, 1, eps_int, un_int, &ratios[j]);

			/* take the max ratio */
			if (j == 0)
			  ratio = ratios[0];
			else if (ratios[j] > ratio)
			  ratio = ratios[j];

			ix += incx;
		      }

		      /* increase the number of bad ratio, if the ratio is
		         bigger than the threshold */
		      if (ratio > thresh) {
			bad_ratios++;

			if ((debug == 3) &&	/* print only when debug is on */
			    (count != old_count) &&	/* print if old vector is different
							   from the current one */
			    (d_count == find_max_ratio) &&
			    (p_count <= max_print) &&
			    (ratio > 0.5 * ratio_max)) {
			  p_count++;
			  old_count = count;

			  printf
			    ("FAIL> %s: n = %d, ntests = %d, threshold = %4.2f,\n",
			     fname, n, ntests, thresh);

			  /* Print test info */
			  switch (prec) {
			  case blas_prec_single:
			    printf("single ");
			    break;
			  case blas_prec_double:
			    printf("double ");
			    break;
			  case blas_prec_indigenous:
			    printf("indigenous ");
			    break;
			  case blas_prec_extra:
			    printf("extra ");
			    break;
			  }
			  switch (norm) {
			  case -1:
			    printf("near_underflow ");
			    break;
			  case 0:
			    printf("near_one ");
			    break;
			  case 1:
			    printf("near_overflow ");
			    break;
			  }
			  switch (order_type) {
			  case blas_rowmajor:
			    printf("row_major ");
			    break;
			  case blas_colmajor:
			    printf("col_major ");
			    break;
			  }
			  switch (uplo_type) {
			  case blas_upper:
			    printf("upper ");
			    break;
			  case blas_lower:
			    printf("lower ");
			    break;
			  }
			  switch (trans_type) {
			  case blas_no_trans:
			    printf("no_trans ");
			    break;
			  case blas_trans:
			    printf("trans ");
			    break;
			  case blas_conj_trans:
			    printf("conj_trans ");
			    break;
			  }
			  switch (diag_type) {
			  case blas_non_unit_diag:
			    printf("non_unit_diag ");
			    break;
			  case blas_unit_diag:
			    printf("unit_diag ");
			    break;
			  }

			  printf(" incx=%d:\n", incx);
			  ix = 0;
			  if (incx < 0)
			    ix = -(n - 1) * incx;

			  printf("      TP=");
			  for (j = 0; j < n; j++) {
			    /* copy row j of tp to temp */
			    stpmv_copy_row(order_type, uplo_type, trans_type,
					   n, tp, temp, j);

			    if (j > 0)
			      printf("        ");
			    sprint_vector(temp, n, 1, NULL);
			  }

			  ix = 0;
			  if (incx < 0)
			    ix = -(n - 1) * incx;

			  for (j = 0; j < n; j++) {
			    printf("      ");
			    printf("x[%d] = ", j * inc_index);
			    printf("%16.8e", x_gen[j * inc_index]);
			    printf("; ");
			    printf("x_final[%d] = ", ix);
			    printf("%16.8e", x[ix]);
			    printf("\n");
			    ix += incx;
			  }

			  printf("      ");
			  printf("alpha = ");
			  printf("%16.8e", alpha);
			  printf("; ");
			  printf("\n");
			  for (j = 0; j < n; j++) {
			    printf("      ");

			    printf("[%24.16e, %24.16e]",
				   head_r_true[j * inc_index],
				   tail_r_true[j * inc_index]);
			    printf(", ratio[%d]=%.4e\n", j, ratios[j]);
			  }
			  printf("      ratio=%.4e\n", ratio);
			}
		      }
		      if (d_count == 0) {
			if (ratio > ratio_max)
			  ratio_max = ratio;
			if (ratio != 0.0 && ratio < ratio_min)
			  ratio_min = ratio;
			tot_tests++;
		      }
		    }		/* incx */

		  }		/* numtests */
		}		/* diag */
	      }			/* trans */
	    }			/* uplo */
	  }			/* order */
	}			/* norm */
      }				/* prec */
    }				/* alpha */
  }				/* debug */

  if ((debug == 2) || ((debug == 1) && bad_ratios > 0)) {
    printf("      %s:  n = %d, ntests = %d, thresh = %4.2f\n",
	   fname, n, ntests, thresh);
    printf
      ("      bad/total = %d/%d=%3.2f, min_ratio = %.4e, max_ratio = %.4e\n\n",
       bad_ratios, tot_tests, ((double) bad_ratios) / ((double) tot_tests),
       ratio_min, ratio_max);
  }

  FPU_FIX_STOP;

  blas_free(x);
  blas_free(x_gen);
  blas_free(temp);
  blas_free(tp);
  blas_free(head_r_true);
  blas_free(tail_r_true);
  blas_free(ratios);

  *min_ratio = ratio_min;
  *num_bad_ratio = bad_ratios;
  *num_tests = tot_tests;
  return ratio_max;
}				/* end of do_test_stpmv_x */

double do_test_dtpmv_x(int n,
		       int ntests,
		       int *seed,
		       double thresh,
		       int debug,
		       float test_prob,
		       double *min_ratio, int *num_bad_ratio, int *num_tests)

/*
 * Purpose
 * =======
 *
 * Runs a series of tests on TPMV.
 *
 * Arguments
 * =========
 *
 * n         (input) int
 *           The size of vector being tested
 *
 * ntests    (input) int
 *           The number of tests to run for each set of attributes.
 *
 * seed      (input/output) int
 *           The seed for the random number generator used in testgen().
 *
 * thresh    (input) double
 *           When the ratio returned from test() exceeds the specified
 *           threshold, the current size, r_true, r_comp, and ratio will be
 *           printed.  (Since ratio is supposed to be O(1), we can set thresh
 *           to ~10.)
 *
 * debug     (input) int
 *           If debug=3, print summary
 *           If debug=2, print summary only if the number of bad ratios > 0
 *           If debug=1, print complete info if tests fail
 *           If debug=0, return max ratio
 *
 * min_ratio (output) double
 *           The minimum ratio
 *
 * num_bad_ratio (output) int
 *               The number of tests fail; they are above the threshold.
 *
 * num_tests (output) int
 *           The number of tests is being performed.
 *
 * Return value
 * ============
 *
 * The maximum ratio if run successfully, otherwise return -1
 *
 * Code structure
 * ==============
 *
 *  debug loop  -- if debug is one, the first loop computes the max ratio
 *              -- and the last(second) loop outputs debugging information,
 *              -- if the test fail and its ratio > 0.5 * max ratio.
 *              -- if debug is zero, the loop is executed once
 *    alpha loop  -- varying alpha: 0, 1, or random
 *        prec loop   -- varying internal prec: single, double, or extra
 *        norm loop   -- varying norm: near undeflow, near one, or
 *                    -- near overflow
 *          order loop  -- varying order type: rowmajor or colmajor
 *            uplo loop   -- varying uplo type: upper or lower
 *              trans loop  -- varying trans type: no trans, trans, and conj trans
 *                diag loop   -- varying diag type: non unit, and unit
 *                  numtest loop  -- how many times the test is perform with
 *                                -- above set of attributes
 *                        incx loop     -- varying incx: -2, -1, 1, 2
 */
{
  /* function name */
  const char fname[] = "BLAS_dtpmv_x";

  /* max number of debug lines to print */
  const int max_print = 3;

  /* Variables in the "x_val" form are loop vars for corresponding
     variables */
  int i;			/* iterate through the repeating tests */
  int j;			/* multipurpose counters */
  int ix;			/* use to index x  */
  int incx_val, incx;		/* for testing different inc values */
  int inctp, inc_index;		/* 1 if real, 2 if complex */
  int d_count;			/* counter for debug */
  int find_max_ratio;		/* find_max_ratio = 1 only if debug = 3 */
  int p_count;			/* counter for the number of debug lines printed */
  int tot_tests;		/* total number of tests to be done */
  int norm;			/* input values of near underflow/one/overflow */
  double ratio_max;		/* the current maximum ratio */
  double ratio_min;		/* the current minimum ratio */
  double *ratios;		/* a temporary variable for calculating ratio */
  double ratio = 0.0;		/* the per-use test ratio from test() */
  int bad_ratios = 0;		/* the number of ratios over the threshold */
  double eps_int;		/* the internal epsilon expected--2^(-24) for float */
  double un_int;		/* the internal underflow threshold */
  double alpha;
  double beta;
  double *tp;
  double *x;
  double *x_gen;		/* used to store vectors generated by testgen; eventually copied to x */
  double *temp;			/* use for calculating ratio */

  /* the true r calculated by testgen(), in double-double */
  double *head_r_true, *tail_r_true;

  int alpha_val;
  int alpha_flag = 0, beta_flag = 0;
  int order_val;
  enum blas_order_type order_type = 0;
  int prec_val;
  enum blas_prec_type prec = 0;
  int uplo_val;
  enum blas_uplo_type uplo_type = 0;
  int trans_val;
  enum blas_trans_type trans_type = 0;
  int diag_val;
  enum blas_diag_type diag_type = 0;

  double beta_zero_fake;
  double rin_zero_fake;

  int saved_seed;		/* for saving the original seed */
  int count, old_count = -1;
  FPU_FIX_DECL;

  /* test for bad arguments */
  if (n < 0 || ntests < 0)
    BLAS_error(fname, 0, 0, NULL);

  /* if there is nothing to test, return all zero */
  if (n == 0 || ntests == 0) {
    *min_ratio = 0.0;
    *num_bad_ratio = 0;
    *num_tests = 0;
    return 0.0;
  }

  FPU_FIX_START;


  incx = inctp = inc_index = 1;


  /* get space for calculation */
  x = (double *) blas_malloc(3 * n * 2 * sizeof(double));
  if (3 * n * 2 > 0 && x == NULL) {
    BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
  }
  x_gen = (double *) blas_malloc(3 * n * 2 * sizeof(double));
  if (3 * n * 2 > 0 && x_gen == NULL) {
    BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
  }
  tp = (double *) blas_malloc(2 * n * n * n * inctp * sizeof(double));
  if (2 * n * n * n * inctp > 0 && tp == NULL) {
    BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
  }
  temp = (double *) blas_malloc(3 * n * 2 * sizeof(double));
  if (3 * n * 2 > 0 && temp == NULL) {
    BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
  }
  head_r_true = (double *) blas_malloc(n * sizeof(double));
  tail_r_true = (double *) blas_malloc(n * sizeof(double));
  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");
  }


  /* initialization */
  saved_seed = *seed;
  ratio_min = 1e308;
  ratio_max = 0.0;
  tot_tests = 0;
  p_count = 0;
  count = 0;
  find_max_ratio = 0;
  beta = 0.0;
  beta_flag = 1;

  beta_zero_fake = 0.0;
  rin_zero_fake = 0.0;

  if (debug == 3)
    find_max_ratio = 1;

  /* The debug iteration:
     If debug=1, then will execute the iteration twice. First, compute the
     max ratio. Second, print info if ratio > (50% * ratio_max). */
  for (d_count = 0; d_count <= find_max_ratio; d_count++) {
    bad_ratios = 0;		/* set to zero */

    if ((debug == 3) && (d_count == find_max_ratio))
      *seed = saved_seed;	/* restore the original seed */

    /* varying alpha */
    for (alpha_val = 0; alpha_val < 3; alpha_val++) {
      alpha_flag = 0;
      switch (alpha_val) {
      case 0:
	alpha = 0.0;
	alpha_flag = 1;
	break;
      case 1:
	alpha = 1.0;
	alpha_flag = 1;
	break;
      }


      /* varying extra precs */
      for (prec_val = 0; prec_val <= 2; 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;
	}

	/* values near underflow, 1, or overflow */
	for (norm = -1; norm <= 1; norm++) {

	  /* row or col major */
	  for (order_val = 0; order_val < 2; order_val++) {
	    switch (order_val) {
	    case 0:
	      order_type = blas_rowmajor;
	      break;
	    case 1:
	      order_type = blas_colmajor;
	      break;
	    }

	    /* upper or lower */
	    for (uplo_val = 0; uplo_val < 2; uplo_val++) {
	      switch (uplo_val) {
	      case 0:
		uplo_type = blas_upper;
		break;
	      case 1:
		uplo_type = blas_lower;
		break;
	      }

	      /* no trans, trans, or conj trans */
	      for (trans_val = 0; trans_val < 3; trans_val++) {
		switch (trans_val) {
		case 0:
		  trans_type = blas_no_trans;
		  break;
		case 1:
		  trans_type = blas_trans;
		  break;
		case 2:
		  trans_type = blas_conj_trans;
		  break;
		}

		/* non_unit_diag, unit_diag */
		for (diag_val = 0; diag_val < 2; diag_val++) {
		  switch (diag_val) {
		  case 0:
		    diag_type = blas_non_unit_diag;
		    break;
		  case 1:
		    diag_type = blas_unit_diag;
		    break;
		  }

		  /* number of tests */
		  for (i = 0; i < ntests; i++) {
		    /* For the sake of speed, we throw out this case at random */
		    if (xrand(seed) >= test_prob)
		      continue;

		    BLAS_dtpmv_testgen(norm, order_type, uplo_type,
				       trans_type, diag_type, n,
				       &alpha, alpha_flag, tp, x_gen,
				       seed, head_r_true, tail_r_true);

		    count++;

		    /* varying incx */
		    for (incx_val = -2; incx_val <= 2; incx_val++) {
		      if (incx_val == 0)
			continue;

		      /* setting incx */
		      incx = incx_val;


		      /* set x starting index */
		      ix = 0;
		      if (incx < 0)
			ix = -(n - 1) * incx;

		      /* copy x_gen to x */
		      for (j = 0; j < n; j++) {
			x[ix] = x_gen[j * inc_index];
			ix += incx;
		      }

		      /* call BLAS_dtpmv_x */
		      FPU_FIX_STOP;
		      BLAS_dtpmv_x(order_type, uplo_type, trans_type,
				   diag_type, n, alpha, tp, x, incx_val,
				   prec);
		      FPU_FIX_START;

		      /* set x starting index */
		      ix = 0;
		      if (incx < 0)
			ix = -(n - 1) * incx;

		      /* computing the ratio */
		      for (j = 0; j < n; j++) {
			/* copy row j of tp to temp */
			dtpmv_copy_row(order_type, uplo_type, trans_type, n,
				       tp, temp, j);

			test_BLAS_ddot(n, blas_no_conj,
				       alpha, beta_zero_fake, rin_zero_fake,
				       x[ix],
				       head_r_true[j * inc_index],
				       tail_r_true[j * inc_index], temp, 1,
				       x_gen, 1, eps_int, un_int, &ratios[j]);

			/* take the max ratio */
			if (j == 0)
			  ratio = ratios[0];
			else if (ratios[j] > ratio)
			  ratio = ratios[j];

			ix += incx;
		      }

		      /* increase the number of bad ratio, if the ratio is
		         bigger than the threshold */
		      if (ratio > thresh) {
			bad_ratios++;

			if ((debug == 3) &&	/* print only when debug is on */
			    (count != old_count) &&	/* print if old vector is different
							   from the current one */
			    (d_count == find_max_ratio) &&
			    (p_count <= max_print) &&
			    (ratio > 0.5 * ratio_max)) {
			  p_count++;
			  old_count = count;

			  printf
			    ("FAIL> %s: n = %d, ntests = %d, threshold = %4.2f,\n",
			     fname, n, ntests, thresh);

			  /* Print test info */
			  switch (prec) {
			  case blas_prec_single:
			    printf("single ");
			    break;
			  case blas_prec_double:
			    printf("double ");
			    break;
			  case blas_prec_indigenous:
			    printf("indigenous ");
			    break;
			  case blas_prec_extra:
			    printf("extra ");
			    break;
			  }
			  switch (norm) {
			  case -1:
			    printf("near_underflow ");
			    break;
			  case 0:
			    printf("near_one ");
			    break;
			  case 1:
			    printf("near_overflow ");
			    break;
			  }
			  switch (order_type) {
			  case blas_rowmajor:
			    printf("row_major ");
			    break;
			  case blas_colmajor:
			    printf("col_major ");
			    break;
			  }
			  switch (uplo_type) {
			  case blas_upper:
			    printf("upper ");
			    break;
			  case blas_lower:
			    printf("lower ");
			    break;
			  }
			  switch (trans_type) {
			  case blas_no_trans:
			    printf("no_trans ");
			    break;
			  case blas_trans:
			    printf("trans ");
			    break;
			  case blas_conj_trans:
			    printf("conj_trans ");
			    break;
			  }
			  switch (diag_type) {
			  case blas_non_unit_diag:
			    printf("non_unit_diag ");
			    break;
			  case blas_unit_diag:
			    printf("unit_diag ");
			    break;
			  }

			  printf(" incx=%d:\n", incx);
			  ix = 0;
			  if (incx < 0)
			    ix = -(n - 1) * incx;

			  printf("      TP=");
			  for (j = 0; j < n; j++) {
			    /* copy row j of tp to temp */
			    dtpmv_copy_row(order_type, uplo_type, trans_type,
					   n, tp, temp, j);

			    if (j > 0)
			      printf("        ");
			    dprint_vector(temp, n, 1, NULL);
			  }

			  ix = 0;
			  if (incx < 0)
			    ix = -(n - 1) * incx;

			  for (j = 0; j < n; j++) {
			    printf("      ");
			    printf("x[%d] = ", j * inc_index);
			    printf("%24.16e", x_gen[j * inc_index]);
			    printf("; ");
			    printf("x_final[%d] = ", ix);
			    printf("%24.16e", x[ix]);
			    printf("\n");
			    ix += incx;
			  }

			  printf("      ");
			  printf("alpha = ");
			  printf("%24.16e", alpha);
			  printf("; ");
			  printf("\n");
			  for (j = 0; j < n; j++) {
			    printf("      ");

			    printf("[%24.16e, %24.16e]",
				   head_r_true[j * inc_index],
				   tail_r_true[j * inc_index]);
			    printf(", ratio[%d]=%.4e\n", j, ratios[j]);
			  }
			  printf("      ratio=%.4e\n", ratio);
			}
		      }
		      if (d_count == 0) {
			if (ratio > ratio_max)
			  ratio_max = ratio;
			if (ratio != 0.0 && ratio < ratio_min)
			  ratio_min = ratio;
			tot_tests++;
		      }
		    }		/* incx */

		  }		/* numtests */
		}		/* diag */
	      }			/* trans */
	    }			/* uplo */
	  }			/* order */
	}			/* norm */
      }				/* prec */
    }				/* alpha */
  }				/* debug */

  if ((debug == 2) || ((debug == 1) && bad_ratios > 0)) {
    printf("      %s:  n = %d, ntests = %d, thresh = %4.2f\n",
	   fname, n, ntests, thresh);
    printf
      ("      bad/total = %d/%d=%3.2f, min_ratio = %.4e, max_ratio = %.4e\n\n",
       bad_ratios, tot_tests, ((double) bad_ratios) / ((double) tot_tests),
       ratio_min, ratio_max);
  }

  FPU_FIX_STOP;

  blas_free(x);
  blas_free(x_gen);
  blas_free(temp);
  blas_free(tp);
  blas_free(head_r_true);
  blas_free(tail_r_true);
  blas_free(ratios);

  *min_ratio = ratio_min;
  *num_bad_ratio = bad_ratios;
  *num_tests = tot_tests;
  return ratio_max;
}				/* end of do_test_dtpmv_x */

double do_test_ctpmv_x(int n,
		       int ntests,
		       int *seed,
		       double thresh,
		       int debug,
		       float test_prob,
		       double *min_ratio, int *num_bad_ratio, int *num_tests)

/*
 * Purpose
 * =======
 *
 * Runs a series of tests on TPMV.
 *
 * Arguments
 * =========
 *
 * n         (input) int
 *           The size of vector being tested
 *
 * ntests    (input) int
 *           The number of tests to run for each set of attributes.
 *
 * seed      (input/output) int
 *           The seed for the random number generator used in testgen().
 *
 * thresh    (input) double
 *           When the ratio returned from test() exceeds the specified
 *           threshold, the current size, r_true, r_comp, and ratio will be
 *           printed.  (Since ratio is supposed to be O(1), we can set thresh
 *           to ~10.)
 *
 * debug     (input) int
 *           If debug=3, print summary
 *           If debug=2, print summary only if the number of bad ratios > 0
 *           If debug=1, print complete info if tests fail
 *           If debug=0, return max ratio
 *
 * min_ratio (output) double
 *           The minimum ratio
 *
 * num_bad_ratio (output) int
 *               The number of tests fail; they are above the threshold.
 *
 * num_tests (output) int
 *           The number of tests is being performed.
 *
 * Return value
 * ============
 *
 * The maximum ratio if run successfully, otherwise return -1
 *
 * Code structure
 * ==============
 *
 *  debug loop  -- if debug is one, the first loop computes the max ratio
 *              -- and the last(second) loop outputs debugging information,
 *              -- if the test fail and its ratio > 0.5 * max ratio.
 *              -- if debug is zero, the loop is executed once
 *    alpha loop  -- varying alpha: 0, 1, or random
 *        prec loop   -- varying internal prec: single, double, or extra
 *        norm loop   -- varying norm: near undeflow, near one, or
 *                    -- near overflow
 *          order loop  -- varying order type: rowmajor or colmajor
 *            uplo loop   -- varying uplo type: upper or lower
 *              trans loop  -- varying trans type: no trans, trans, and conj trans
 *                diag loop   -- varying diag type: non unit, and unit
 *                  numtest loop  -- how many times the test is perform with
 *                                -- above set of attributes
 *                        incx loop     -- varying incx: -2, -1, 1, 2
 */
{
  /* function name */
  const char fname[] = "BLAS_ctpmv_x";

  /* max number of debug lines to print */
  const int max_print = 3;

  /* Variables in the "x_val" form are loop vars for corresponding
     variables */
  int i;			/* iterate through the repeating tests */
  int j;			/* multipurpose counters */
  int ix;			/* use to index x  */
  int incx_val, incx;		/* for testing different inc values */
  int inctp, inc_index;		/* 1 if real, 2 if complex */
  int d_count;			/* counter for debug */
  int find_max_ratio;		/* find_max_ratio = 1 only if debug = 3 */
  int p_count;			/* counter for the number of debug lines printed */
  int tot_tests;		/* total number of tests to be done */
  int norm;			/* input values of near underflow/one/overflow */
  double ratio_max;		/* the current maximum ratio */
  double ratio_min;		/* the current minimum ratio */
  double *ratios;		/* a temporary variable for calculating ratio */
  double ratio = 0.0;		/* the per-use test ratio from test() */
  int bad_ratios = 0;		/* the number of ratios over the threshold */
  double eps_int;		/* the internal epsilon expected--2^(-24) for float */
  double un_int;		/* the internal underflow threshold */
  float alpha[2];
  float beta[2];
  float *tp;
  float *x;
  float *x_gen;			/* used to store vectors generated by testgen; eventually copied to x */
  float *temp;			/* use for calculating ratio */

  /* the true r calculated by testgen(), in double-double */
  double *head_r_true, *tail_r_true;


  int alpha_val;
  int alpha_flag = 0, beta_flag = 0;
  int order_val;
  enum blas_order_type order_type = 0;
  int prec_val;
  enum blas_prec_type prec = 0;
  int uplo_val;
  enum blas_uplo_type uplo_type = 0;
  int trans_val;
  enum blas_trans_type trans_type = 0;
  int diag_val;
  enum blas_diag_type diag_type = 0;

  float beta_zero_fake[2];
  float rin_zero_fake[2];

  int saved_seed;		/* for saving the original seed */
  int count, old_count = -1;
  FPU_FIX_DECL;

  /* test for bad arguments */
  if (n < 0 || ntests < 0)
    BLAS_error(fname, 0, 0, NULL);

  /* if there is nothing to test, return all zero */
  if (n == 0 || ntests == 0) {
    *min_ratio = 0.0;
    *num_bad_ratio = 0;
    *num_tests = 0;
    return 0.0;
  }

  FPU_FIX_START;


  incx = inctp = inc_index = 1;
  incx *= 2;
  inctp *= 2;
  inc_index *= 2;

  /* get space for calculation */
  x = (float *) blas_malloc(3 * n * 2 * sizeof(float) * 2);
  if (3 * n * 2 > 0 && x == NULL) {
    BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
  }
  x_gen = (float *) blas_malloc(3 * n * 2 * sizeof(float) * 2);
  if (3 * n * 2 > 0 && x_gen == NULL) {
    BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
  }
  tp = (float *) blas_malloc(2 * n * n * n * inctp * sizeof(float) * 2);
  if (2 * n * n * n * inctp > 0 && tp == NULL) {
    BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
  }
  temp = (float *) blas_malloc(3 * n * 2 * sizeof(float) * 2);
  if (3 * n * 2 > 0 && temp == 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");
  }


  /* initialization */
  saved_seed = *seed;
  ratio_min = 1e308;
  ratio_max = 0.0;
  tot_tests = 0;
  p_count = 0;
  count = 0;
  find_max_ratio = 0;
  beta[0] = beta[1] = 0.0;
  beta_flag = 1;

  beta_zero_fake[0] = beta_zero_fake[1] = 0.0;
  rin_zero_fake[0] = rin_zero_fake[1] = 0.0;

  if (debug == 3)
    find_max_ratio = 1;

  /* The debug iteration:
     If debug=1, then will execute the iteration twice. First, compute the
     max ratio. Second, print info if ratio > (50% * ratio_max). */
  for (d_count = 0; d_count <= find_max_ratio; d_count++) {
    bad_ratios = 0;		/* set to zero */

    if ((debug == 3) && (d_count == find_max_ratio))
      *seed = saved_seed;	/* restore the original seed */

    /* varying alpha */
    for (alpha_val = 0; alpha_val < 3; 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;
      }


      /* varying extra precs */
      for (prec_val = 0; prec_val <= 2; 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;
	}

	/* values near underflow, 1, or overflow */
	for (norm = -1; norm <= 1; norm++) {

	  /* row or col major */
	  for (order_val = 0; order_val < 2; order_val++) {
	    switch (order_val) {
	    case 0:
	      order_type = blas_rowmajor;
	      break;
	    case 1:
	      order_type = blas_colmajor;
	      break;
	    }

	    /* upper or lower */
	    for (uplo_val = 0; uplo_val < 2; uplo_val++) {
	      switch (uplo_val) {
	      case 0:
		uplo_type = blas_upper;
		break;
	      case 1:
		uplo_type = blas_lower;
		break;
	      }

	      /* no trans, trans, or conj trans */
	      for (trans_val = 0; trans_val < 3; trans_val++) {
		switch (trans_val) {
		case 0:
		  trans_type = blas_no_trans;
		  break;
		case 1:
		  trans_type = blas_trans;
		  break;
		case 2:
		  trans_type = blas_conj_trans;
		  break;
		}

		/* non_unit_diag, unit_diag */
		for (diag_val = 0; diag_val < 2; diag_val++) {
		  switch (diag_val) {
		  case 0:
		    diag_type = blas_non_unit_diag;
		    break;
		  case 1:
		    diag_type = blas_unit_diag;
		    break;
		  }

		  /* number of tests */
		  for (i = 0; i < ntests; i++) {
		    /* For the sake of speed, we throw out this case at random */
		    if (xrand(seed) >= test_prob)
		      continue;

		    BLAS_ctpmv_testgen(norm, order_type, uplo_type,
				       trans_type, diag_type, n,
				       &alpha, alpha_flag, tp, x_gen,
				       seed, head_r_true, tail_r_true);

		    count++;

		    /* varying incx */
		    for (incx_val = -2; incx_val <= 2; incx_val++) {
		      if (incx_val == 0)
			continue;

		      /* setting incx */
		      incx = incx_val;
		      incx *= 2;

		      /* set x starting index */
		      ix = 0;
		      if (incx < 0)
			ix = -(n - 1) * incx;

		      /* copy x_gen to x */
		      for (j = 0; j < n; j++) {
			x[ix] = x_gen[j * inc_index];
			x[ix + 1] = x_gen[j * inc_index + 1];
			ix += incx;
		      }

		      /* call BLAS_ctpmv_x */
		      FPU_FIX_STOP;
		      BLAS_ctpmv_x(order_type, uplo_type, trans_type,
				   diag_type, n, alpha, tp, x, incx_val,
				   prec);
		      FPU_FIX_START;

		      /* set x starting index */
		      ix = 0;
		      if (incx < 0)
			ix = -(n - 1) * incx;

		      /* computing the ratio */
		      for (j = 0; j < n; j++) {
			/* copy row j of tp to temp */
			ctpmv_copy_row(order_type, uplo_type, trans_type, n,
				       tp, temp, j);

			test_BLAS_cdot(n, blas_no_conj,
				       alpha, beta_zero_fake, rin_zero_fake,
				       &x[ix],
				       &head_r_true[j * inc_index],
				       &tail_r_true[j * inc_index], temp, 1,
				       x_gen, 1, eps_int, un_int, &ratios[j]);

			/* take the max ratio */
			if (j == 0)
			  ratio = ratios[0];
			else if (ratios[j] > ratio)
			  ratio = ratios[j];

			ix += incx;
		      }

		      /* increase the number of bad ratio, if the ratio is
		         bigger than the threshold */
		      if (ratio > thresh) {
			bad_ratios++;

			if ((debug == 3) &&	/* print only when debug is on */
			    (count != old_count) &&	/* print if old vector is different
							   from the current one */
			    (d_count == find_max_ratio) &&
			    (p_count <= max_print) &&
			    (ratio > 0.5 * ratio_max)) {
			  p_count++;
			  old_count = count;

			  printf
			    ("FAIL> %s: n = %d, ntests = %d, threshold = %4.2f,\n",
			     fname, n, ntests, thresh);

			  /* Print test info */
			  switch (prec) {
			  case blas_prec_single:
			    printf("single ");
			    break;
			  case blas_prec_double:
			    printf("double ");
			    break;
			  case blas_prec_indigenous:
			    printf("indigenous ");
			    break;
			  case blas_prec_extra:
			    printf("extra ");
			    break;
			  }
			  switch (norm) {
			  case -1:
			    printf("near_underflow ");
			    break;
			  case 0:
			    printf("near_one ");
			    break;
			  case 1:
			    printf("near_overflow ");
			    break;
			  }
			  switch (order_type) {
			  case blas_rowmajor:
			    printf("row_major ");
			    break;
			  case blas_colmajor:
			    printf("col_major ");
			    break;
			  }
			  switch (uplo_type) {
			  case blas_upper:
			    printf("upper ");
			    break;
			  case blas_lower:
			    printf("lower ");
			    break;
			  }
			  switch (trans_type) {
			  case blas_no_trans:
			    printf("no_trans ");
			    break;
			  case blas_trans:
			    printf("trans ");
			    break;
			  case blas_conj_trans:
			    printf("conj_trans ");
			    break;
			  }
			  switch (diag_type) {
			  case blas_non_unit_diag:
			    printf("non_unit_diag ");
			    break;
			  case blas_unit_diag:
			    printf("unit_diag ");
			    break;
			  }

			  printf(" incx=%d:\n", incx);
			  ix = 0;
			  if (incx < 0)
			    ix = -(n - 1) * incx;

			  printf("      TP=");
			  for (j = 0; j < n; j++) {
			    /* copy row j of tp to temp */
			    ctpmv_copy_row(order_type, uplo_type, trans_type,
					   n, tp, temp, j);

			    if (j > 0)
			      printf("        ");
			    cprint_vector(temp, n, 1, NULL);
			  }

			  ix = 0;
			  if (incx < 0)
			    ix = -(n - 1) * incx;

			  for (j = 0; j < n; j++) {
			    printf("      ");
			    printf("x[%d] = ", j * inc_index);
			    printf("(%16.8e, %16.8e)", x_gen[j * inc_index],
				   x_gen[j * inc_index + 1]);
			    printf("; ");
			    printf("x_final[%d] = ", ix);
			    printf("(%16.8e, %16.8e)", x[ix], x[ix + 1]);
			    printf("\n");
			    ix += incx;
			  }

			  printf("      ");
			  printf("alpha = ");
			  printf("(%16.8e, %16.8e)", alpha[0], alpha[1]);
			  printf("; ");
			  printf("\n");
			  for (j = 0; j < n; j++) {
			    printf("      ");

			    printf("([%24.16e  %24.16e], [%24.16e %24.16e])",
				   head_r_true[j * inc_index],
				   tail_r_true[j * inc_index],
				   head_r_true[j * inc_index + 1],
				   tail_r_true[j * inc_index + 1]);
			    printf(", ratio[%d]=%.4e\n", j, ratios[j]);
			  }
			  printf("      ratio=%.4e\n", ratio);
			}
		      }
		      if (d_count == 0) {
			if (ratio > ratio_max)
			  ratio_max = ratio;
			if (ratio != 0.0 && ratio < ratio_min)
			  ratio_min = ratio;
			tot_tests++;
		      }
		    }		/* incx */

		  }		/* numtests */
		}		/* diag */
	      }			/* trans */
	    }			/* uplo */
	  }			/* order */
	}			/* norm */
      }				/* prec */
    }				/* alpha */
  }				/* debug */

  if ((debug == 2) || ((debug == 1) && bad_ratios > 0)) {
    printf("      %s:  n = %d, ntests = %d, thresh = %4.2f\n",
	   fname, n, ntests, thresh);
    printf
      ("      bad/total = %d/%d=%3.2f, min_ratio = %.4e, max_ratio = %.4e\n\n",
       bad_ratios, tot_tests, ((double) bad_ratios) / ((double) tot_tests),
       ratio_min, ratio_max);
  }

  FPU_FIX_STOP;

  blas_free(x);
  blas_free(x_gen);
  blas_free(temp);
  blas_free(tp);
  blas_free(head_r_true);
  blas_free(tail_r_true);
  blas_free(ratios);

  *min_ratio = ratio_min;
  *num_bad_ratio = bad_ratios;
  *num_tests = tot_tests;
  return ratio_max;
}				/* end of do_test_ctpmv_x */

double do_test_ztpmv_x(int n,
		       int ntests,
		       int *seed,
		       double thresh,
		       int debug,
		       float test_prob,
		       double *min_ratio, int *num_bad_ratio, int *num_tests)

/*
 * Purpose
 * =======
 *
 * Runs a series of tests on TPMV.
 *
 * Arguments
 * =========
 *
 * n         (input) int
 *           The size of vector being tested
 *
 * ntests    (input) int
 *           The number of tests to run for each set of attributes.
 *
 * seed      (input/output) int
 *           The seed for the random number generator used in testgen().
 *
 * thresh    (input) double
 *           When the ratio returned from test() exceeds the specified
 *           threshold, the current size, r_true, r_comp, and ratio will be
 *           printed.  (Since ratio is supposed to be O(1), we can set thresh
 *           to ~10.)
 *
 * debug     (input) int
 *           If debug=3, print summary
 *           If debug=2, print summary only if the number of bad ratios > 0
 *           If debug=1, print complete info if tests fail
 *           If debug=0, return max ratio
 *
 * min_ratio (output) double
 *           The minimum ratio
 *
 * num_bad_ratio (output) int
 *               The number of tests fail; they are above the threshold.
 *
 * num_tests (output) int
 *           The number of tests is being performed.
 *
 * Return value
 * ============
 *
 * The maximum ratio if run successfully, otherwise return -1
 *
 * Code structure
 * ==============
 *
 *  debug loop  -- if debug is one, the first loop computes the max ratio
 *              -- and the last(second) loop outputs debugging information,
 *              -- if the test fail and its ratio > 0.5 * max ratio.
 *              -- if debug is zero, the loop is executed once
 *    alpha loop  -- varying alpha: 0, 1, or random
 *        prec loop   -- varying internal prec: single, double, or extra
 *        norm loop   -- varying norm: near undeflow, near one, or
 *                    -- near overflow
 *          order loop  -- varying order type: rowmajor or colmajor
 *            uplo loop   -- varying uplo type: upper or lower
 *              trans loop  -- varying trans type: no trans, trans, and conj trans
 *                diag loop   -- varying diag type: non unit, and unit
 *                  numtest loop  -- how many times the test is perform with
 *                                -- above set of attributes
 *                        incx loop     -- varying incx: -2, -1, 1, 2
 */
{
  /* function name */
  const char fname[] = "BLAS_ztpmv_x";

  /* max number of debug lines to print */
  const int max_print = 3;

  /* Variables in the "x_val" form are loop vars for corresponding
     variables */
  int i;			/* iterate through the repeating tests */
  int j;			/* multipurpose counters */
  int ix;			/* use to index x  */
  int incx_val, incx;		/* for testing different inc values */
  int inctp, inc_index;		/* 1 if real, 2 if complex */
  int d_count;			/* counter for debug */
  int find_max_ratio;		/* find_max_ratio = 1 only if debug = 3 */
  int p_count;			/* counter for the number of debug lines printed */
  int tot_tests;		/* total number of tests to be done */
  int norm;			/* input values of near underflow/one/overflow */
  double ratio_max;		/* the current maximum ratio */
  double ratio_min;		/* the current minimum ratio */
  double *ratios;		/* a temporary variable for calculating ratio */
  double ratio = 0.0;		/* the per-use test ratio from test() */
  int bad_ratios = 0;		/* the number of ratios over the threshold */
  double eps_int;		/* the internal epsilon expected--2^(-24) for float */
  double un_int;		/* the internal underflow threshold */
  double alpha[2];
  double beta[2];
  double *tp;
  double *x;
  double *x_gen;		/* used to store vectors generated by testgen; eventually copied to x */
  double *temp;			/* use for calculating ratio */

  /* the true r calculated by testgen(), in double-double */
  double *head_r_true, *tail_r_true;


  int alpha_val;
  int alpha_flag = 0, beta_flag = 0;
  int order_val;
  enum blas_order_type order_type = 0;
  int prec_val;
  enum blas_prec_type prec = 0;
  int uplo_val;
  enum blas_uplo_type uplo_type = 0;
  int trans_val;
  enum blas_trans_type trans_type = 0;
  int diag_val;
  enum blas_diag_type diag_type = 0;

  double beta_zero_fake[2];
  double rin_zero_fake[2];

  int saved_seed;		/* for saving the original seed */
  int count, old_count = -1;
  FPU_FIX_DECL;

  /* test for bad arguments */
  if (n < 0 || ntests < 0)
    BLAS_error(fname, 0, 0, NULL);

  /* if there is nothing to test, return all zero */
  if (n == 0 || ntests == 0) {
    *min_ratio = 0.0;
    *num_bad_ratio = 0;
    *num_tests = 0;
    return 0.0;
  }

  FPU_FIX_START;


  incx = inctp = inc_index = 1;
  incx *= 2;
  inctp *= 2;
  inc_index *= 2;

  /* get space for calculation */
  x = (double *) blas_malloc(3 * n * 2 * sizeof(double) * 2);
  if (3 * n * 2 > 0 && x == NULL) {
    BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
  }
  x_gen = (double *) blas_malloc(3 * n * 2 * sizeof(double) * 2);
  if (3 * n * 2 > 0 && x_gen == NULL) {
    BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
  }
  tp = (double *) blas_malloc(2 * n * n * n * inctp * sizeof(double) * 2);
  if (2 * n * n * n * inctp > 0 && tp == NULL) {
    BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
  }
  temp = (double *) blas_malloc(3 * n * 2 * sizeof(double) * 2);
  if (3 * n * 2 > 0 && temp == 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");
  }


  /* initialization */
  saved_seed = *seed;
  ratio_min = 1e308;
  ratio_max = 0.0;
  tot_tests = 0;
  p_count = 0;
  count = 0;
  find_max_ratio = 0;
  beta[0] = beta[1] = 0.0;
  beta_flag = 1;

  beta_zero_fake[0] = beta_zero_fake[1] = 0.0;
  rin_zero_fake[0] = rin_zero_fake[1] = 0.0;

  if (debug == 3)
    find_max_ratio = 1;

  /* The debug iteration:
     If debug=1, then will execute the iteration twice. First, compute the
     max ratio. Second, print info if ratio > (50% * ratio_max). */
  for (d_count = 0; d_count <= find_max_ratio; d_count++) {
    bad_ratios = 0;		/* set to zero */

    if ((debug == 3) && (d_count == find_max_ratio))
      *seed = saved_seed;	/* restore the original seed */

    /* varying alpha */
    for (alpha_val = 0; alpha_val < 3; 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;
      }


      /* varying extra precs */
      for (prec_val = 0; prec_val <= 2; 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;
	}

	/* values near underflow, 1, or overflow */
	for (norm = -1; norm <= 1; norm++) {

	  /* row or col major */
	  for (order_val = 0; order_val < 2; order_val++) {
	    switch (order_val) {
	    case 0:
	      order_type = blas_rowmajor;
	      break;
	    case 1:
	      order_type = blas_colmajor;
	      break;
	    }

	    /* upper or lower */
	    for (uplo_val = 0; uplo_val < 2; uplo_val++) {
	      switch (uplo_val) {
	      case 0:
		uplo_type = blas_upper;
		break;
	      case 1:
		uplo_type = blas_lower;
		break;
	      }

	      /* no trans, trans, or conj trans */
	      for (trans_val = 0; trans_val < 3; trans_val++) {
		switch (trans_val) {
		case 0:
		  trans_type = blas_no_trans;
		  break;
		case 1:
		  trans_type = blas_trans;
		  break;
		case 2:
		  trans_type = blas_conj_trans;
		  break;
		}

		/* non_unit_diag, unit_diag */
		for (diag_val = 0; diag_val < 2; diag_val++) {
		  switch (diag_val) {
		  case 0:
		    diag_type = blas_non_unit_diag;
		    break;
		  case 1:
		    diag_type = blas_unit_diag;
		    break;
		  }

		  /* number of tests */
		  for (i = 0; i < ntests; i++) {
		    /* For the sake of speed, we throw out this case at random */
		    if (xrand(seed) >= test_prob)
		      continue;

		    BLAS_ztpmv_testgen(norm, order_type, uplo_type,
				       trans_type, diag_type, n,
				       &alpha, alpha_flag, tp, x_gen,
				       seed, head_r_true, tail_r_true);

		    count++;

		    /* varying incx */
		    for (incx_val = -2; incx_val <= 2; incx_val++) {
		      if (incx_val == 0)
			continue;

		      /* setting incx */
		      incx = incx_val;
		      incx *= 2;

		      /* set x starting index */
		      ix = 0;
		      if (incx < 0)
			ix = -(n - 1) * incx;

		      /* copy x_gen to x */
		      for (j = 0; j < n; j++) {
			x[ix] = x_gen[j * inc_index];
			x[ix + 1] = x_gen[j * inc_index + 1];
			ix += incx;
		      }

		      /* call BLAS_ztpmv_x */
		      FPU_FIX_STOP;
		      BLAS_ztpmv_x(order_type, uplo_type, trans_type,
				   diag_type, n, alpha, tp, x, incx_val,
				   prec);
		      FPU_FIX_START;

		      /* set x starting index */
		      ix = 0;
		      if (incx < 0)
			ix = -(n - 1) * incx;

		      /* computing the ratio */
		      for (j = 0; j < n; j++) {
			/* copy row j of tp to temp */
			ztpmv_copy_row(order_type, uplo_type, trans_type, n,
				       tp, temp, j);

			test_BLAS_zdot(n, blas_no_conj,
				       alpha, beta_zero_fake, rin_zero_fake,
				       &x[ix],
				       &head_r_true[j * inc_index],
				       &tail_r_true[j * inc_index], temp, 1,
				       x_gen, 1, eps_int, un_int, &ratios[j]);

			/* take the max ratio */
			if (j == 0)
			  ratio = ratios[0];
			else if (ratios[j] > ratio)
			  ratio = ratios[j];

			ix += incx;
		      }

		      /* increase the number of bad ratio, if the ratio is
		         bigger than the threshold */
		      if (ratio > thresh) {
			bad_ratios++;

			if ((debug == 3) &&	/* print only when debug is on */
			    (count != old_count) &&	/* print if old vector is different
							   from the current one */
			    (d_count == find_max_ratio) &&
			    (p_count <= max_print) &&
			    (ratio > 0.5 * ratio_max)) {
			  p_count++;
			  old_count = count;

			  printf
			    ("FAIL> %s: n = %d, ntests = %d, threshold = %4.2f,\n",
			     fname, n, ntests, thresh);

			  /* Print test info */
			  switch (prec) {
			  case blas_prec_single:
			    printf("single ");
			    break;
			  case blas_prec_double:
			    printf("double ");
			    break;
			  case blas_prec_indigenous:
			    printf("indigenous ");
			    break;
			  case blas_prec_extra:
			    printf("extra ");
			    break;
			  }
			  switch (norm) {
			  case -1:
			    printf("near_underflow ");
			    break;
			  case 0:
			    printf("near_one ");
			    break;
			  case 1:
			    printf("near_overflow ");
			    break;
			  }
			  switch (order_type) {
			  case blas_rowmajor:
			    printf("row_major ");
			    break;
			  case blas_colmajor:
			    printf("col_major ");
			    break;
			  }
			  switch (uplo_type) {
			  case blas_upper:
			    printf("upper ");
			    break;
			  case blas_lower:
			    printf("lower ");
			    break;
			  }
			  switch (trans_type) {
			  case blas_no_trans:
			    printf("no_trans ");
			    break;
			  case blas_trans:
			    printf("trans ");
			    break;
			  case blas_conj_trans:
			    printf("conj_trans ");
			    break;
			  }
			  switch (diag_type) {
			  case blas_non_unit_diag:
			    printf("non_unit_diag ");
			    break;
			  case blas_unit_diag:
			    printf("unit_diag ");
			    break;
			  }

			  printf(" incx=%d:\n", incx);
			  ix = 0;
			  if (incx < 0)
			    ix = -(n - 1) * incx;

			  printf("      TP=");
			  for (j = 0; j < n; j++) {
			    /* copy row j of tp to temp */
			    ztpmv_copy_row(order_type, uplo_type, trans_type,
					   n, tp, temp, j);

			    if (j > 0)
			      printf("        ");
			    zprint_vector(temp, n, 1, NULL);
			  }

			  ix = 0;
			  if (incx < 0)
			    ix = -(n - 1) * incx;

			  for (j = 0; j < n; j++) {
			    printf("      ");
			    printf("x[%d] = ", j * inc_index);
			    printf("(%24.16e, %24.16e)", x_gen[j * inc_index],
				   x_gen[j * inc_index + 1]);
			    printf("; ");
			    printf("x_final[%d] = ", ix);
			    printf("(%24.16e, %24.16e)", x[ix], x[ix + 1]);
			    printf("\n");
			    ix += incx;
			  }

			  printf("      ");
			  printf("alpha = ");
			  printf("(%24.16e, %24.16e)", alpha[0], alpha[1]);
			  printf("; ");
			  printf("\n");
			  for (j = 0; j < n; j++) {
			    printf("      ");

			    printf("([%24.16e  %24.16e], [%24.16e %24.16e])",
				   head_r_true[j * inc_index],
				   tail_r_true[j * inc_index],
				   head_r_true[j * inc_index + 1],
				   tail_r_true[j * inc_index + 1]);
			    printf(", ratio[%d]=%.4e\n", j, ratios[j]);
			  }
			  printf("      ratio=%.4e\n", ratio);
			}
		      }
		      if (d_count == 0) {
			if (ratio > ratio_max)
			  ratio_max = ratio;
			if (ratio != 0.0 && ratio < ratio_min)
			  ratio_min = ratio;
			tot_tests++;
		      }
		    }		/* incx */

		  }		/* numtests */
		}		/* diag */
	      }			/* trans */
	    }			/* uplo */
	  }			/* order */
	}			/* norm */
      }				/* prec */
    }				/* alpha */
  }				/* debug */

  if ((debug == 2) || ((debug == 1) && bad_ratios > 0)) {
    printf("      %s:  n = %d, ntests = %d, thresh = %4.2f\n",
	   fname, n, ntests, thresh);
    printf
      ("      bad/total = %d/%d=%3.2f, min_ratio = %.4e, max_ratio = %.4e\n\n",
       bad_ratios, tot_tests, ((double) bad_ratios) / ((double) tot_tests),
       ratio_min, ratio_max);
  }

  FPU_FIX_STOP;

  blas_free(x);
  blas_free(x_gen);
  blas_free(temp);
  blas_free(tp);
  blas_free(head_r_true);
  blas_free(tail_r_true);
  blas_free(ratios);

  *min_ratio = ratio_min;
  *num_bad_ratio = bad_ratios;
  *num_tests = tot_tests;
  return ratio_max;
}				/* end of do_test_ztpmv_x */

double do_test_dtpmv_s_x(int n,
			 int ntests,
			 int *seed,
			 double thresh,
			 int debug,
			 float test_prob,
			 double *min_ratio,
			 int *num_bad_ratio, int *num_tests)

/*
 * Purpose
 * =======
 *
 * Runs a series of tests on TPMV.
 *
 * Arguments
 * =========
 *
 * n         (input) int
 *           The size of vector being tested
 *
 * ntests    (input) int
 *           The number of tests to run for each set of attributes.
 *
 * seed      (input/output) int
 *           The seed for the random number generator used in testgen().
 *
 * thresh    (input) double
 *           When the ratio returned from test() exceeds the specified
 *           threshold, the current size, r_true, r_comp, and ratio will be
 *           printed.  (Since ratio is supposed to be O(1), we can set thresh
 *           to ~10.)
 *
 * debug     (input) int
 *           If debug=3, print summary
 *           If debug=2, print summary only if the number of bad ratios > 0
 *           If debug=1, print complete info if tests fail
 *           If debug=0, return max ratio
 *
 * min_ratio (output) double
 *           The minimum ratio
 *
 * num_bad_ratio (output) int
 *               The number of tests fail; they are above the threshold.
 *
 * num_tests (output) int
 *           The number of tests is being performed.
 *
 * Return value
 * ============
 *
 * The maximum ratio if run successfully, otherwise return -1
 *
 * Code structure
 * ==============
 *
 *  debug loop  -- if debug is one, the first loop computes the max ratio
 *              -- and the last(second) loop outputs debugging information,
 *              -- if the test fail and its ratio > 0.5 * max ratio.
 *              -- if debug is zero, the loop is executed once
 *    alpha loop  -- varying alpha: 0, 1, or random
 *        prec loop   -- varying internal prec: single, double, or extra
 *        norm loop   -- varying norm: near undeflow, near one, or
 *                    -- near overflow
 *          order loop  -- varying order type: rowmajor or colmajor
 *            uplo loop   -- varying uplo type: upper or lower
 *              trans loop  -- varying trans type: no trans, trans, and conj trans
 *                diag loop   -- varying diag type: non unit, and unit
 *                  numtest loop  -- how many times the test is perform with
 *                                -- above set of attributes
 *                        incx loop     -- varying incx: -2, -1, 1, 2
 */
{
  /* function name */
  const char fname[] = "BLAS_dtpmv_s_x";

  /* max number of debug lines to print */
  const int max_print = 3;

  /* Variables in the "x_val" form are loop vars for corresponding
     variables */
  int i;			/* iterate through the repeating tests */
  int j;			/* multipurpose counters */
  int ix;			/* use to index x  */
  int incx_val, incx;		/* for testing different inc values */
  int inctp, inc_index;		/* 1 if real, 2 if complex */
  int d_count;			/* counter for debug */
  int find_max_ratio;		/* find_max_ratio = 1 only if debug = 3 */
  int p_count;			/* counter for the number of debug lines printed */
  int tot_tests;		/* total number of tests to be done */
  int norm;			/* input values of near underflow/one/overflow */
  double ratio_max;		/* the current maximum ratio */
  double ratio_min;		/* the current minimum ratio */
  double *ratios;		/* a temporary variable for calculating ratio */
  double ratio = 0.0;		/* the per-use test ratio from test() */
  int bad_ratios = 0;		/* the number of ratios over the threshold */
  double eps_int;		/* the internal epsilon expected--2^(-24) for float */
  double un_int;		/* the internal underflow threshold */
  double alpha;
  double beta;
  float *tp;
  double *x;
  double *x_gen;		/* used to store vectors generated by testgen; eventually copied to x */
  float *temp;			/* use for calculating ratio */

  /* the true r calculated by testgen(), in double-double */
  double *head_r_true, *tail_r_true;

  int alpha_val;
  int alpha_flag = 0, beta_flag = 0;
  int order_val;
  enum blas_order_type order_type = 0;
  int prec_val;
  enum blas_prec_type prec = 0;
  int uplo_val;
  enum blas_uplo_type uplo_type = 0;
  int trans_val;
  enum blas_trans_type trans_type = 0;
  int diag_val;
  enum blas_diag_type diag_type = 0;

  double beta_zero_fake;
  double rin_zero_fake;

  int saved_seed;		/* for saving the original seed */
  int count, old_count = -1;
  FPU_FIX_DECL;

  /* test for bad arguments */
  if (n < 0 || ntests < 0)
    BLAS_error(fname, 0, 0, NULL);

  /* if there is nothing to test, return all zero */
  if (n == 0 || ntests == 0) {
    *min_ratio = 0.0;
    *num_bad_ratio = 0;
    *num_tests = 0;
    return 0.0;
  }

  FPU_FIX_START;


  incx = inctp = inc_index = 1;


  /* get space for calculation */
  x = (double *) blas_malloc(3 * n * 2 * sizeof(double));
  if (3 * n * 2 > 0 && x == NULL) {
    BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
  }
  x_gen = (double *) blas_malloc(3 * n * 2 * sizeof(double));
  if (3 * n * 2 > 0 && x_gen == NULL) {
    BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
  }
  tp = (float *) blas_malloc(2 * n * n * n * inctp * sizeof(float));
  if (2 * n * n * n * inctp > 0 && tp == NULL) {
    BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
  }
  temp = (float *) blas_malloc(3 * n * 2 * sizeof(float));
  if (3 * n * 2 > 0 && temp == NULL) {
    BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
  }
  head_r_true = (double *) blas_malloc(n * sizeof(double));
  tail_r_true = (double *) blas_malloc(n * sizeof(double));
  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");
  }


  /* initialization */
  saved_seed = *seed;
  ratio_min = 1e308;
  ratio_max = 0.0;
  tot_tests = 0;
  p_count = 0;
  count = 0;
  find_max_ratio = 0;
  beta = 0.0;
  beta_flag = 1;

  beta_zero_fake = 0.0;
  rin_zero_fake = 0.0;

  if (debug == 3)
    find_max_ratio = 1;

  /* The debug iteration:
     If debug=1, then will execute the iteration twice. First, compute the
     max ratio. Second, print info if ratio > (50% * ratio_max). */
  for (d_count = 0; d_count <= find_max_ratio; d_count++) {
    bad_ratios = 0;		/* set to zero */

    if ((debug == 3) && (d_count == find_max_ratio))
      *seed = saved_seed;	/* restore the original seed */

    /* varying alpha */
    for (alpha_val = 0; alpha_val < 3; alpha_val++) {
      alpha_flag = 0;
      switch (alpha_val) {
      case 0:
	alpha = 0.0;
	alpha_flag = 1;
	break;
      case 1:
	alpha = 1.0;
	alpha_flag = 1;
	break;
      }


      /* varying extra precs */
      for (prec_val = 0; prec_val <= 2; 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;
	}

	/* values near underflow, 1, or overflow */
	for (norm = -1; norm <= 1; norm++) {

	  /* row or col major */
	  for (order_val = 0; order_val < 2; order_val++) {
	    switch (order_val) {
	    case 0:
	      order_type = blas_rowmajor;
	      break;
	    case 1:
	      order_type = blas_colmajor;
	      break;
	    }

	    /* upper or lower */
	    for (uplo_val = 0; uplo_val < 2; uplo_val++) {
	      switch (uplo_val) {
	      case 0:
		uplo_type = blas_upper;
		break;
	      case 1:
		uplo_type = blas_lower;
		break;
	      }

	      /* no trans, trans, or conj trans */
	      for (trans_val = 0; trans_val < 3; trans_val++) {
		switch (trans_val) {
		case 0:
		  trans_type = blas_no_trans;
		  break;
		case 1:
		  trans_type = blas_trans;
		  break;
		case 2:
		  trans_type = blas_conj_trans;
		  break;
		}

		/* non_unit_diag, unit_diag */
		for (diag_val = 0; diag_val < 2; diag_val++) {
		  switch (diag_val) {
		  case 0:
		    diag_type = blas_non_unit_diag;
		    break;
		  case 1:
		    diag_type = blas_unit_diag;
		    break;
		  }

		  /* number of tests */
		  for (i = 0; i < ntests; i++) {
		    /* For the sake of speed, we throw out this case at random */
		    if (xrand(seed) >= test_prob)
		      continue;

		    BLAS_dtpmv_s_testgen(norm, order_type, uplo_type,
					 trans_type, diag_type, n,
					 &alpha, alpha_flag, tp, x_gen,
					 seed, head_r_true, tail_r_true);

		    count++;

		    /* varying incx */
		    for (incx_val = -2; incx_val <= 2; incx_val++) {
		      if (incx_val == 0)
			continue;

		      /* setting incx */
		      incx = incx_val;


		      /* set x starting index */
		      ix = 0;
		      if (incx < 0)
			ix = -(n - 1) * incx;

		      /* copy x_gen to x */
		      for (j = 0; j < n; j++) {
			x[ix] = x_gen[j * inc_index];
			ix += incx;
		      }

		      /* call BLAS_dtpmv_s_x */
		      FPU_FIX_STOP;
		      BLAS_dtpmv_s_x(order_type, uplo_type, trans_type,
				     diag_type, n, alpha, tp, x, incx_val,
				     prec);
		      FPU_FIX_START;

		      /* set x starting index */
		      ix = 0;
		      if (incx < 0)
			ix = -(n - 1) * incx;

		      /* computing the ratio */
		      for (j = 0; j < n; j++) {
			/* copy row j of tp to temp */
			stpmv_copy_row(order_type, uplo_type, trans_type, n,
				       tp, temp, j);

			test_BLAS_ddot_s_d(n, blas_no_conj,
					   alpha, beta_zero_fake,
					   rin_zero_fake, x[ix],
					   head_r_true[j * inc_index],
					   tail_r_true[j * inc_index], temp,
					   1, x_gen, 1, eps_int, un_int,
					   &ratios[j]);

			/* take the max ratio */
			if (j == 0)
			  ratio = ratios[0];
			else if (ratios[j] > ratio)
			  ratio = ratios[j];

			ix += incx;
		      }

		      /* increase the number of bad ratio, if the ratio is
		         bigger than the threshold */
		      if (ratio > thresh) {
			bad_ratios++;

			if ((debug == 3) &&	/* print only when debug is on */
			    (count != old_count) &&	/* print if old vector is different
							   from the current one */
			    (d_count == find_max_ratio) &&
			    (p_count <= max_print) &&
			    (ratio > 0.5 * ratio_max)) {
			  p_count++;
			  old_count = count;

			  printf
			    ("FAIL> %s: n = %d, ntests = %d, threshold = %4.2f,\n",
			     fname, n, ntests, thresh);

			  /* Print test info */
			  switch (prec) {
			  case blas_prec_single:
			    printf("single ");
			    break;
			  case blas_prec_double:
			    printf("double ");
			    break;
			  case blas_prec_indigenous:
			    printf("indigenous ");
			    break;
			  case blas_prec_extra:
			    printf("extra ");
			    break;
			  }
			  switch (norm) {
			  case -1:
			    printf("near_underflow ");
			    break;
			  case 0:
			    printf("near_one ");
			    break;
			  case 1:
			    printf("near_overflow ");
			    break;
			  }
			  switch (order_type) {
			  case blas_rowmajor:
			    printf("row_major ");
			    break;
			  case blas_colmajor:
			    printf("col_major ");
			    break;
			  }
			  switch (uplo_type) {
			  case blas_upper:
			    printf("upper ");
			    break;
			  case blas_lower:
			    printf("lower ");
			    break;
			  }
			  switch (trans_type) {
			  case blas_no_trans:
			    printf("no_trans ");
			    break;
			  case blas_trans:
			    printf("trans ");
			    break;
			  case blas_conj_trans:
			    printf("conj_trans ");
			    break;
			  }
			  switch (diag_type) {
			  case blas_non_unit_diag:
			    printf("non_unit_diag ");
			    break;
			  case blas_unit_diag:
			    printf("unit_diag ");
			    break;
			  }

			  printf(" incx=%d:\n", incx);
			  ix = 0;
			  if (incx < 0)
			    ix = -(n - 1) * incx;

			  printf("      TP=");
			  for (j = 0; j < n; j++) {
			    /* copy row j of tp to temp */
			    stpmv_copy_row(order_type, uplo_type, trans_type,
					   n, tp, temp, j);

			    if (j > 0)
			      printf("        ");
			    sprint_vector(temp, n, 1, NULL);
			  }

			  ix = 0;
			  if (incx < 0)
			    ix = -(n - 1) * incx;

			  for (j = 0; j < n; j++) {
			    printf("      ");
			    printf("x[%d] = ", j * inc_index);
			    printf("%24.16e", x_gen[j * inc_index]);
			    printf("; ");
			    printf("x_final[%d] = ", ix);
			    printf("%24.16e", x[ix]);
			    printf("\n");
			    ix += incx;
			  }

			  printf("      ");
			  printf("alpha = ");
			  printf("%24.16e", alpha);
			  printf("; ");
			  printf("\n");
			  for (j = 0; j < n; j++) {
			    printf("      ");

			    printf("[%24.16e, %24.16e]",
				   head_r_true[j * inc_index],
				   tail_r_true[j * inc_index]);
			    printf(", ratio[%d]=%.4e\n", j, ratios[j]);
			  }
			  printf("      ratio=%.4e\n", ratio);
			}
		      }
		      if (d_count == 0) {
			if (ratio > ratio_max)
			  ratio_max = ratio;
			if (ratio != 0.0 && ratio < ratio_min)
			  ratio_min = ratio;
			tot_tests++;
		      }
		    }		/* incx */

		  }		/* numtests */
		}		/* diag */
	      }			/* trans */
	    }			/* uplo */
	  }			/* order */
	}			/* norm */
      }				/* prec */
    }				/* alpha */
  }				/* debug */

  if ((debug == 2) || ((debug == 1) && bad_ratios > 0)) {
    printf("      %s:  n = %d, ntests = %d, thresh = %4.2f\n",
	   fname, n, ntests, thresh);
    printf
      ("      bad/total = %d/%d=%3.2f, min_ratio = %.4e, max_ratio = %.4e\n\n",
       bad_ratios, tot_tests, ((double) bad_ratios) / ((double) tot_tests),
       ratio_min, ratio_max);
  }

  FPU_FIX_STOP;

  blas_free(x);
  blas_free(x_gen);
  blas_free(temp);
  blas_free(tp);
  blas_free(head_r_true);
  blas_free(tail_r_true);
  blas_free(ratios);

  *min_ratio = ratio_min;
  *num_bad_ratio = bad_ratios;
  *num_tests = tot_tests;
  return ratio_max;
}				/* end of do_test_dtpmv_s_x */

double do_test_ztpmv_c_x(int n,
			 int ntests,
			 int *seed,
			 double thresh,
			 int debug,
			 float test_prob,
			 double *min_ratio,
			 int *num_bad_ratio, int *num_tests)

/*
 * Purpose
 * =======
 *
 * Runs a series of tests on TPMV.
 *
 * Arguments
 * =========
 *
 * n         (input) int
 *           The size of vector being tested
 *
 * ntests    (input) int
 *           The number of tests to run for each set of attributes.
 *
 * seed      (input/output) int
 *           The seed for the random number generator used in testgen().
 *
 * thresh    (input) double
 *           When the ratio returned from test() exceeds the specified
 *           threshold, the current size, r_true, r_comp, and ratio will be
 *           printed.  (Since ratio is supposed to be O(1), we can set thresh
 *           to ~10.)
 *
 * debug     (input) int
 *           If debug=3, print summary
 *           If debug=2, print summary only if the number of bad ratios > 0
 *           If debug=1, print complete info if tests fail
 *           If debug=0, return max ratio
 *
 * min_ratio (output) double
 *           The minimum ratio
 *
 * num_bad_ratio (output) int
 *               The number of tests fail; they are above the threshold.
 *
 * num_tests (output) int
 *           The number of tests is being performed.
 *
 * Return value
 * ============
 *
 * The maximum ratio if run successfully, otherwise return -1
 *
 * Code structure
 * ==============
 *
 *  debug loop  -- if debug is one, the first loop computes the max ratio
 *              -- and the last(second) loop outputs debugging information,
 *              -- if the test fail and its ratio > 0.5 * max ratio.
 *              -- if debug is zero, the loop is executed once
 *    alpha loop  -- varying alpha: 0, 1, or random
 *        prec loop   -- varying internal prec: single, double, or extra
 *        norm loop   -- varying norm: near undeflow, near one, or
 *                    -- near overflow
 *          order loop  -- varying order type: rowmajor or colmajor
 *            uplo loop   -- varying uplo type: upper or lower
 *              trans loop  -- varying trans type: no trans, trans, and conj trans
 *                diag loop   -- varying diag type: non unit, and unit
 *                  numtest loop  -- how many times the test is perform with
 *                                -- above set of attributes
 *                        incx loop     -- varying incx: -2, -1, 1, 2
 */
{
  /* function name */
  const char fname[] = "BLAS_ztpmv_c_x";

  /* max number of debug lines to print */
  const int max_print = 3;

  /* Variables in the "x_val" form are loop vars for corresponding
     variables */
  int i;			/* iterate through the repeating tests */
  int j;			/* multipurpose counters */
  int ix;			/* use to index x  */
  int incx_val, incx;		/* for testing different inc values */
  int inctp, inc_index;		/* 1 if real, 2 if complex */
  int d_count;			/* counter for debug */
  int find_max_ratio;		/* find_max_ratio = 1 only if debug = 3 */
  int p_count;			/* counter for the number of debug lines printed */
  int tot_tests;		/* total number of tests to be done */
  int norm;			/* input values of near underflow/one/overflow */
  double ratio_max;		/* the current maximum ratio */
  double ratio_min;		/* the current minimum ratio */
  double *ratios;		/* a temporary variable for calculating ratio */
  double ratio = 0.0;		/* the per-use test ratio from test() */
  int bad_ratios = 0;		/* the number of ratios over the threshold */
  double eps_int;		/* the internal epsilon expected--2^(-24) for float */
  double un_int;		/* the internal underflow threshold */
  double alpha[2];
  double beta[2];
  float *tp;
  double *x;
  double *x_gen;		/* used to store vectors generated by testgen; eventually copied to x */
  float *temp;			/* use for calculating ratio */

  /* the true r calculated by testgen(), in double-double */
  double *head_r_true, *tail_r_true;


  int alpha_val;
  int alpha_flag = 0, beta_flag = 0;
  int order_val;
  enum blas_order_type order_type = 0;
  int prec_val;
  enum blas_prec_type prec = 0;
  int uplo_val;
  enum blas_uplo_type uplo_type = 0;
  int trans_val;
  enum blas_trans_type trans_type = 0;
  int diag_val;
  enum blas_diag_type diag_type = 0;

  double beta_zero_fake[2];
  double rin_zero_fake[2];

  int saved_seed;		/* for saving the original seed */
  int count, old_count = -1;
  FPU_FIX_DECL;

  /* test for bad arguments */
  if (n < 0 || ntests < 0)
    BLAS_error(fname, 0, 0, NULL);

  /* if there is nothing to test, return all zero */
  if (n == 0 || ntests == 0) {
    *min_ratio = 0.0;
    *num_bad_ratio = 0;
    *num_tests = 0;
    return 0.0;
  }

  FPU_FIX_START;


  incx = inctp = inc_index = 1;
  incx *= 2;
  inctp *= 2;
  inc_index *= 2;

  /* get space for calculation */
  x = (double *) blas_malloc(3 * n * 2 * sizeof(double) * 2);
  if (3 * n * 2 > 0 && x == NULL) {
    BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
  }
  x_gen = (double *) blas_malloc(3 * n * 2 * sizeof(double) * 2);
  if (3 * n * 2 > 0 && x_gen == NULL) {
    BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
  }
  tp = (float *) blas_malloc(2 * n * n * n * inctp * sizeof(float) * 2);
  if (2 * n * n * n * inctp > 0 && tp == NULL) {
    BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
  }
  temp = (float *) blas_malloc(3 * n * 2 * sizeof(float) * 2);
  if (3 * n * 2 > 0 && temp == 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");
  }


  /* initialization */
  saved_seed = *seed;
  ratio_min = 1e308;
  ratio_max = 0.0;
  tot_tests = 0;
  p_count = 0;
  count = 0;
  find_max_ratio = 0;
  beta[0] = beta[1] = 0.0;
  beta_flag = 1;

  beta_zero_fake[0] = beta_zero_fake[1] = 0.0;
  rin_zero_fake[0] = rin_zero_fake[1] = 0.0;

  if (debug == 3)
    find_max_ratio = 1;

  /* The debug iteration:
     If debug=1, then will execute the iteration twice. First, compute the
     max ratio. Second, print info if ratio > (50% * ratio_max). */
  for (d_count = 0; d_count <= find_max_ratio; d_count++) {
    bad_ratios = 0;		/* set to zero */

    if ((debug == 3) && (d_count == find_max_ratio))
      *seed = saved_seed;	/* restore the original seed */

    /* varying alpha */
    for (alpha_val = 0; alpha_val < 3; 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;
      }


      /* varying extra precs */
      for (prec_val = 0; prec_val <= 2; 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;
	}

	/* values near underflow, 1, or overflow */
	for (norm = -1; norm <= 1; norm++) {

	  /* row or col major */
	  for (order_val = 0; order_val < 2; order_val++) {
	    switch (order_val) {
	    case 0:
	      order_type = blas_rowmajor;
	      break;
	    case 1:
	      order_type = blas_colmajor;
	      break;
	    }

	    /* upper or lower */
	    for (uplo_val = 0; uplo_val < 2; uplo_val++) {
	      switch (uplo_val) {
	      case 0:
		uplo_type = blas_upper;
		break;
	      case 1:
		uplo_type = blas_lower;
		break;
	      }

	      /* no trans, trans, or conj trans */
	      for (trans_val = 0; trans_val < 3; trans_val++) {
		switch (trans_val) {
		case 0:
		  trans_type = blas_no_trans;
		  break;
		case 1:
		  trans_type = blas_trans;
		  break;
		case 2:
		  trans_type = blas_conj_trans;
		  break;
		}

		/* non_unit_diag, unit_diag */
		for (diag_val = 0; diag_val < 2; diag_val++) {
		  switch (diag_val) {
		  case 0:
		    diag_type = blas_non_unit_diag;
		    break;
		  case 1:
		    diag_type = blas_unit_diag;
		    break;
		  }

		  /* number of tests */
		  for (i = 0; i < ntests; i++) {
		    /* For the sake of speed, we throw out this case at random */
		    if (xrand(seed) >= test_prob)
		      continue;

		    BLAS_ztpmv_c_testgen(norm, order_type, uplo_type,
					 trans_type, diag_type, n,
					 &alpha, alpha_flag, tp, x_gen,
					 seed, head_r_true, tail_r_true);

		    count++;

		    /* varying incx */
		    for (incx_val = -2; incx_val <= 2; incx_val++) {
		      if (incx_val == 0)
			continue;

		      /* setting incx */
		      incx = incx_val;
		      incx *= 2;

		      /* set x starting index */
		      ix = 0;
		      if (incx < 0)
			ix = -(n - 1) * incx;

		      /* copy x_gen to x */
		      for (j = 0; j < n; j++) {
			x[ix] = x_gen[j * inc_index];
			x[ix + 1] = x_gen[j * inc_index + 1];
			ix += incx;
		      }

		      /* call BLAS_ztpmv_c_x */
		      FPU_FIX_STOP;
		      BLAS_ztpmv_c_x(order_type, uplo_type, trans_type,
				     diag_type, n, alpha, tp, x, incx_val,
				     prec);
		      FPU_FIX_START;

		      /* set x starting index */
		      ix = 0;
		      if (incx < 0)
			ix = -(n - 1) * incx;

		      /* computing the ratio */
		      for (j = 0; j < n; j++) {
			/* copy row j of tp to temp */
			ctpmv_copy_row(order_type, uplo_type, trans_type, n,
				       tp, temp, j);

			test_BLAS_zdot_c_z(n, blas_no_conj,
					   alpha, beta_zero_fake,
					   rin_zero_fake, &x[ix],
					   &head_r_true[j * inc_index],
					   &tail_r_true[j * inc_index], temp,
					   1, x_gen, 1, eps_int, un_int,
					   &ratios[j]);

			/* take the max ratio */
			if (j == 0)
			  ratio = ratios[0];
			else if (ratios[j] > ratio)
			  ratio = ratios[j];

			ix += incx;
		      }

		      /* increase the number of bad ratio, if the ratio is
		         bigger than the threshold */
		      if (ratio > thresh) {
			bad_ratios++;

			if ((debug == 3) &&	/* print only when debug is on */
			    (count != old_count) &&	/* print if old vector is different
							   from the current one */
			    (d_count == find_max_ratio) &&
			    (p_count <= max_print) &&
			    (ratio > 0.5 * ratio_max)) {
			  p_count++;
			  old_count = count;

			  printf
			    ("FAIL> %s: n = %d, ntests = %d, threshold = %4.2f,\n",
			     fname, n, ntests, thresh);

			  /* Print test info */
			  switch (prec) {
			  case blas_prec_single:
			    printf("single ");
			    break;
			  case blas_prec_double:
			    printf("double ");
			    break;
			  case blas_prec_indigenous:
			    printf("indigenous ");
			    break;
			  case blas_prec_extra:
			    printf("extra ");
			    break;
			  }
			  switch (norm) {
			  case -1:
			    printf("near_underflow ");
			    break;
			  case 0:
			    printf("near_one ");
			    break;
			  case 1:
			    printf("near_overflow ");
			    break;
			  }
			  switch (order_type) {
			  case blas_rowmajor:
			    printf("row_major ");
			    break;
			  case blas_colmajor:
			    printf("col_major ");
			    break;
			  }
			  switch (uplo_type) {
			  case blas_upper:
			    printf("upper ");
			    break;
			  case blas_lower:
			    printf("lower ");
			    break;
			  }
			  switch (trans_type) {
			  case blas_no_trans:
			    printf("no_trans ");
			    break;
			  case blas_trans:
			    printf("trans ");
			    break;
			  case blas_conj_trans:
			    printf("conj_trans ");
			    break;
			  }
			  switch (diag_type) {
			  case blas_non_unit_diag:
			    printf("non_unit_diag ");
			    break;
			  case blas_unit_diag:
			    printf("unit_diag ");
			    break;
			  }

			  printf(" incx=%d:\n", incx);
			  ix = 0;
			  if (incx < 0)
			    ix = -(n - 1) * incx;

			  printf("      TP=");
			  for (j = 0; j < n; j++) {
			    /* copy row j of tp to temp */
			    ctpmv_copy_row(order_type, uplo_type, trans_type,
					   n, tp, temp, j);

			    if (j > 0)
			      printf("        ");
			    cprint_vector(temp, n, 1, NULL);
			  }

			  ix = 0;
			  if (incx < 0)
			    ix = -(n - 1) * incx;

			  for (j = 0; j < n; j++) {
			    printf("      ");
			    printf("x[%d] = ", j * inc_index);
			    printf("(%24.16e, %24.16e)", x_gen[j * inc_index],
				   x_gen[j * inc_index + 1]);
			    printf("; ");
			    printf("x_final[%d] = ", ix);
			    printf("(%24.16e, %24.16e)", x[ix], x[ix + 1]);
			    printf("\n");
			    ix += incx;
			  }

			  printf("      ");
			  printf("alpha = ");
			  printf("(%24.16e, %24.16e)", alpha[0], alpha[1]);
			  printf("; ");
			  printf("\n");
			  for (j = 0; j < n; j++) {
			    printf("      ");

			    printf("([%24.16e  %24.16e], [%24.16e %24.16e])",
				   head_r_true[j * inc_index],
				   tail_r_true[j * inc_index],
				   head_r_true[j * inc_index + 1],
				   tail_r_true[j * inc_index + 1]);
			    printf(", ratio[%d]=%.4e\n", j, ratios[j]);
			  }
			  printf("      ratio=%.4e\n", ratio);
			}
		      }
		      if (d_count == 0) {
			if (ratio > ratio_max)
			  ratio_max = ratio;
			if (ratio != 0.0 && ratio < ratio_min)
			  ratio_min = ratio;
			tot_tests++;
		      }
		    }		/* incx */

		  }		/* numtests */
		}		/* diag */
	      }			/* trans */
	    }			/* uplo */
	  }			/* order */
	}			/* norm */
      }				/* prec */
    }				/* alpha */
  }				/* debug */

  if ((debug == 2) || ((debug == 1) && bad_ratios > 0)) {
    printf("      %s:  n = %d, ntests = %d, thresh = %4.2f\n",
	   fname, n, ntests, thresh);
    printf
      ("      bad/total = %d/%d=%3.2f, min_ratio = %.4e, max_ratio = %.4e\n\n",
       bad_ratios, tot_tests, ((double) bad_ratios) / ((double) tot_tests),
       ratio_min, ratio_max);
  }

  FPU_FIX_STOP;

  blas_free(x);
  blas_free(x_gen);
  blas_free(temp);
  blas_free(tp);
  blas_free(head_r_true);
  blas_free(tail_r_true);
  blas_free(ratios);

  *min_ratio = ratio_min;
  *num_bad_ratio = bad_ratios;
  *num_tests = tot_tests;
  return ratio_max;
}				/* end of do_test_ztpmv_c_x */

double do_test_ctpmv_s_x(int n,
			 int ntests,
			 int *seed,
			 double thresh,
			 int debug,
			 float test_prob,
			 double *min_ratio,
			 int *num_bad_ratio, int *num_tests)

/*
 * Purpose
 * =======
 *
 * Runs a series of tests on TPMV.
 *
 * Arguments
 * =========
 *
 * n         (input) int
 *           The size of vector being tested
 *
 * ntests    (input) int
 *           The number of tests to run for each set of attributes.
 *
 * seed      (input/output) int
 *           The seed for the random number generator used in testgen().
 *
 * thresh    (input) double
 *           When the ratio returned from test() exceeds the specified
 *           threshold, the current size, r_true, r_comp, and ratio will be
 *           printed.  (Since ratio is supposed to be O(1), we can set thresh
 *           to ~10.)
 *
 * debug     (input) int
 *           If debug=3, print summary
 *           If debug=2, print summary only if the number of bad ratios > 0
 *           If debug=1, print complete info if tests fail
 *           If debug=0, return max ratio
 *
 * min_ratio (output) double
 *           The minimum ratio
 *
 * num_bad_ratio (output) int
 *               The number of tests fail; they are above the threshold.
 *
 * num_tests (output) int
 *           The number of tests is being performed.
 *
 * Return value
 * ============
 *
 * The maximum ratio if run successfully, otherwise return -1
 *
 * Code structure
 * ==============
 *
 *  debug loop  -- if debug is one, the first loop computes the max ratio
 *              -- and the last(second) loop outputs debugging information,
 *              -- if the test fail and its ratio > 0.5 * max ratio.
 *              -- if debug is zero, the loop is executed once
 *    alpha loop  -- varying alpha: 0, 1, or random
 *        prec loop   -- varying internal prec: single, double, or extra
 *        norm loop   -- varying norm: near undeflow, near one, or
 *                    -- near overflow
 *          order loop  -- varying order type: rowmajor or colmajor
 *            uplo loop   -- varying uplo type: upper or lower
 *              trans loop  -- varying trans type: no trans, trans, and conj trans
 *                diag loop   -- varying diag type: non unit, and unit
 *                  numtest loop  -- how many times the test is perform with
 *                                -- above set of attributes
 *                        incx loop     -- varying incx: -2, -1, 1, 2
 */
{
  /* function name */
  const char fname[] = "BLAS_ctpmv_s_x";

  /* max number of debug lines to print */
  const int max_print = 3;

  /* Variables in the "x_val" form are loop vars for corresponding
     variables */
  int i;			/* iterate through the repeating tests */
  int j;			/* multipurpose counters */
  int ix;			/* use to index x  */
  int incx_val, incx;		/* for testing different inc values */
  int inctp, inc_index;		/* 1 if real, 2 if complex */
  int d_count;			/* counter for debug */
  int find_max_ratio;		/* find_max_ratio = 1 only if debug = 3 */
  int p_count;			/* counter for the number of debug lines printed */
  int tot_tests;		/* total number of tests to be done */
  int norm;			/* input values of near underflow/one/overflow */
  double ratio_max;		/* the current maximum ratio */
  double ratio_min;		/* the current minimum ratio */
  double *ratios;		/* a temporary variable for calculating ratio */
  double ratio = 0.0;		/* the per-use test ratio from test() */
  int bad_ratios = 0;		/* the number of ratios over the threshold */
  double eps_int;		/* the internal epsilon expected--2^(-24) for float */
  double un_int;		/* the internal underflow threshold */
  float alpha[2];
  float beta[2];
  float *tp;
  float *x;
  float *x_gen;			/* used to store vectors generated by testgen; eventually copied to x */
  float *temp;			/* use for calculating ratio */

  /* the true r calculated by testgen(), in double-double */
  double *head_r_true, *tail_r_true;


  int alpha_val;
  int alpha_flag = 0, beta_flag = 0;
  int order_val;
  enum blas_order_type order_type = 0;
  int prec_val;
  enum blas_prec_type prec = 0;
  int uplo_val;
  enum blas_uplo_type uplo_type = 0;
  int trans_val;
  enum blas_trans_type trans_type = 0;
  int diag_val;
  enum blas_diag_type diag_type = 0;

  float beta_zero_fake[2];
  float rin_zero_fake[2];

  int saved_seed;		/* for saving the original seed */
  int count, old_count = -1;
  FPU_FIX_DECL;

  /* test for bad arguments */
  if (n < 0 || ntests < 0)
    BLAS_error(fname, 0, 0, NULL);

  /* if there is nothing to test, return all zero */
  if (n == 0 || ntests == 0) {
    *min_ratio = 0.0;
    *num_bad_ratio = 0;
    *num_tests = 0;
    return 0.0;
  }

  FPU_FIX_START;


  incx = inctp = inc_index = 1;
  incx *= 2;

  inc_index *= 2;

  /* get space for calculation */
  x = (float *) blas_malloc(3 * n * 2 * sizeof(float) * 2);
  if (3 * n * 2 > 0 && x == NULL) {
    BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
  }
  x_gen = (float *) blas_malloc(3 * n * 2 * sizeof(float) * 2);
  if (3 * n * 2 > 0 && x_gen == NULL) {
    BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
  }
  tp = (float *) blas_malloc(2 * n * n * n * inctp * sizeof(float));
  if (2 * n * n * n * inctp > 0 && tp == NULL) {
    BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
  }
  temp = (float *) blas_malloc(3 * n * 2 * sizeof(float));
  if (3 * n * 2 > 0 && temp == 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");
  }


  /* initialization */
  saved_seed = *seed;
  ratio_min = 1e308;
  ratio_max = 0.0;
  tot_tests = 0;
  p_count = 0;
  count = 0;
  find_max_ratio = 0;
  beta[0] = beta[1] = 0.0;
  beta_flag = 1;

  beta_zero_fake[0] = beta_zero_fake[1] = 0.0;
  rin_zero_fake[0] = rin_zero_fake[1] = 0.0;

  if (debug == 3)
    find_max_ratio = 1;

  /* The debug iteration:
     If debug=1, then will execute the iteration twice. First, compute the
     max ratio. Second, print info if ratio > (50% * ratio_max). */
  for (d_count = 0; d_count <= find_max_ratio; d_count++) {
    bad_ratios = 0;		/* set to zero */

    if ((debug == 3) && (d_count == find_max_ratio))
      *seed = saved_seed;	/* restore the original seed */

    /* varying alpha */
    for (alpha_val = 0; alpha_val < 3; 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;
      }


      /* varying extra precs */
      for (prec_val = 0; prec_val <= 2; 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;
	}

	/* values near underflow, 1, or overflow */
	for (norm = -1; norm <= 1; norm++) {

	  /* row or col major */
	  for (order_val = 0; order_val < 2; order_val++) {
	    switch (order_val) {
	    case 0:
	      order_type = blas_rowmajor;
	      break;
	    case 1:
	      order_type = blas_colmajor;
	      break;
	    }

	    /* upper or lower */
	    for (uplo_val = 0; uplo_val < 2; uplo_val++) {
	      switch (uplo_val) {
	      case 0:
		uplo_type = blas_upper;
		break;
	      case 1:
		uplo_type = blas_lower;
		break;
	      }

	      /* no trans, trans, or conj trans */
	      for (trans_val = 0; trans_val < 3; trans_val++) {
		switch (trans_val) {
		case 0:
		  trans_type = blas_no_trans;
		  break;
		case 1:
		  trans_type = blas_trans;
		  break;
		case 2:
		  trans_type = blas_conj_trans;
		  break;
		}

		/* non_unit_diag, unit_diag */
		for (diag_val = 0; diag_val < 2; diag_val++) {
		  switch (diag_val) {
		  case 0:
		    diag_type = blas_non_unit_diag;
		    break;
		  case 1:
		    diag_type = blas_unit_diag;
		    break;
		  }

		  /* number of tests */
		  for (i = 0; i < ntests; i++) {
		    /* For the sake of speed, we throw out this case at random */
		    if (xrand(seed) >= test_prob)
		      continue;

		    BLAS_ctpmv_s_testgen(norm, order_type, uplo_type,
					 trans_type, diag_type, n,
					 &alpha, alpha_flag, tp, x_gen,
					 seed, head_r_true, tail_r_true);

		    count++;

		    /* varying incx */
		    for (incx_val = -2; incx_val <= 2; incx_val++) {
		      if (incx_val == 0)
			continue;

		      /* setting incx */
		      incx = incx_val;
		      incx *= 2;

		      /* set x starting index */
		      ix = 0;
		      if (incx < 0)
			ix = -(n - 1) * incx;

		      /* copy x_gen to x */
		      for (j = 0; j < n; j++) {
			x[ix] = x_gen[j * inc_index];
			x[ix + 1] = x_gen[j * inc_index + 1];
			ix += incx;
		      }

		      /* call BLAS_ctpmv_s_x */
		      FPU_FIX_STOP;
		      BLAS_ctpmv_s_x(order_type, uplo_type, trans_type,
				     diag_type, n, alpha, tp, x, incx_val,
				     prec);
		      FPU_FIX_START;

		      /* set x starting index */
		      ix = 0;
		      if (incx < 0)
			ix = -(n - 1) * incx;

		      /* computing the ratio */
		      for (j = 0; j < n; j++) {
			/* copy row j of tp to temp */
			stpmv_copy_row(order_type, uplo_type, trans_type, n,
				       tp, temp, j);

			test_BLAS_cdot_s_c(n, blas_no_conj,
					   alpha, beta_zero_fake,
					   rin_zero_fake, &x[ix],
					   &head_r_true[j * inc_index],
					   &tail_r_true[j * inc_index], temp,
					   1, x_gen, 1, eps_int, un_int,
					   &ratios[j]);

			/* take the max ratio */
			if (j == 0)
			  ratio = ratios[0];
			else if (ratios[j] > ratio)
			  ratio = ratios[j];

			ix += incx;
		      }

		      /* increase the number of bad ratio, if the ratio is
		         bigger than the threshold */
		      if (ratio > thresh) {
			bad_ratios++;

			if ((debug == 3) &&	/* print only when debug is on */
			    (count != old_count) &&	/* print if old vector is different
							   from the current one */
			    (d_count == find_max_ratio) &&
			    (p_count <= max_print) &&
			    (ratio > 0.5 * ratio_max)) {
			  p_count++;
			  old_count = count;

			  printf
			    ("FAIL> %s: n = %d, ntests = %d, threshold = %4.2f,\n",
			     fname, n, ntests, thresh);

			  /* Print test info */
			  switch (prec) {
			  case blas_prec_single:
			    printf("single ");
			    break;
			  case blas_prec_double:
			    printf("double ");
			    break;
			  case blas_prec_indigenous:
			    printf("indigenous ");
			    break;
			  case blas_prec_extra:
			    printf("extra ");
			    break;
			  }
			  switch (norm) {
			  case -1:
			    printf("near_underflow ");
			    break;
			  case 0:
			    printf("near_one ");
			    break;
			  case 1:
			    printf("near_overflow ");
			    break;
			  }
			  switch (order_type) {
			  case blas_rowmajor:
			    printf("row_major ");
			    break;
			  case blas_colmajor:
			    printf("col_major ");
			    break;
			  }
			  switch (uplo_type) {
			  case blas_upper:
			    printf("upper ");
			    break;
			  case blas_lower:
			    printf("lower ");
			    break;
			  }
			  switch (trans_type) {
			  case blas_no_trans:
			    printf("no_trans ");
			    break;
			  case blas_trans:
			    printf("trans ");
			    break;
			  case blas_conj_trans:
			    printf("conj_trans ");
			    break;
			  }
			  switch (diag_type) {
			  case blas_non_unit_diag:
			    printf("non_unit_diag ");
			    break;
			  case blas_unit_diag:
			    printf("unit_diag ");
			    break;
			  }

			  printf(" incx=%d:\n", incx);
			  ix = 0;
			  if (incx < 0)
			    ix = -(n - 1) * incx;

			  printf("      TP=");
			  for (j = 0; j < n; j++) {
			    /* copy row j of tp to temp */
			    stpmv_copy_row(order_type, uplo_type, trans_type,
					   n, tp, temp, j);

			    if (j > 0)
			      printf("        ");
			    sprint_vector(temp, n, 1, NULL);
			  }

			  ix = 0;
			  if (incx < 0)
			    ix = -(n - 1) * incx;

			  for (j = 0; j < n; j++) {
			    printf("      ");
			    printf("x[%d] = ", j * inc_index);
			    printf("(%16.8e, %16.8e)", x_gen[j * inc_index],
				   x_gen[j * inc_index + 1]);
			    printf("; ");
			    printf("x_final[%d] = ", ix);
			    printf("(%16.8e, %16.8e)", x[ix], x[ix + 1]);
			    printf("\n");
			    ix += incx;
			  }

			  printf("      ");
			  printf("alpha = ");
			  printf("(%16.8e, %16.8e)", alpha[0], alpha[1]);
			  printf("; ");
			  printf("\n");
			  for (j = 0; j < n; j++) {
			    printf("      ");

			    printf("([%24.16e  %24.16e], [%24.16e %24.16e])",
				   head_r_true[j * inc_index],
				   tail_r_true[j * inc_index],
				   head_r_true[j * inc_index + 1],
				   tail_r_true[j * inc_index + 1]);
			    printf(", ratio[%d]=%.4e\n", j, ratios[j]);
			  }
			  printf("      ratio=%.4e\n", ratio);
			}
		      }
		      if (d_count == 0) {
			if (ratio > ratio_max)
			  ratio_max = ratio;
			if (ratio != 0.0 && ratio < ratio_min)
			  ratio_min = ratio;
			tot_tests++;
		      }
		    }		/* incx */

		  }		/* numtests */
		}		/* diag */
	      }			/* trans */
	    }			/* uplo */
	  }			/* order */
	}			/* norm */
      }				/* prec */
    }				/* alpha */
  }				/* debug */

  if ((debug == 2) || ((debug == 1) && bad_ratios > 0)) {
    printf("      %s:  n = %d, ntests = %d, thresh = %4.2f\n",
	   fname, n, ntests, thresh);
    printf
      ("      bad/total = %d/%d=%3.2f, min_ratio = %.4e, max_ratio = %.4e\n\n",
       bad_ratios, tot_tests, ((double) bad_ratios) / ((double) tot_tests),
       ratio_min, ratio_max);
  }

  FPU_FIX_STOP;

  blas_free(x);
  blas_free(x_gen);
  blas_free(temp);
  blas_free(tp);
  blas_free(head_r_true);
  blas_free(tail_r_true);
  blas_free(ratios);

  *min_ratio = ratio_min;
  *num_bad_ratio = bad_ratios;
  *num_tests = tot_tests;
  return ratio_max;
}				/* end of do_test_ctpmv_s_x */

double do_test_ztpmv_d_x(int n,
			 int ntests,
			 int *seed,
			 double thresh,
			 int debug,
			 float test_prob,
			 double *min_ratio,
			 int *num_bad_ratio, int *num_tests)

/*
 * Purpose
 * =======
 *
 * Runs a series of tests on TPMV.
 *
 * Arguments
 * =========
 *
 * n         (input) int
 *           The size of vector being tested
 *
 * ntests    (input) int
 *           The number of tests to run for each set of attributes.
 *
 * seed      (input/output) int
 *           The seed for the random number generator used in testgen().
 *
 * thresh    (input) double
 *           When the ratio returned from test() exceeds the specified
 *           threshold, the current size, r_true, r_comp, and ratio will be
 *           printed.  (Since ratio is supposed to be O(1), we can set thresh
 *           to ~10.)
 *
 * debug     (input) int
 *           If debug=3, print summary
 *           If debug=2, print summary only if the number of bad ratios > 0
 *           If debug=1, print complete info if tests fail
 *           If debug=0, return max ratio
 *
 * min_ratio (output) double
 *           The minimum ratio
 *
 * num_bad_ratio (output) int
 *               The number of tests fail; they are above the threshold.
 *
 * num_tests (output) int
 *           The number of tests is being performed.
 *
 * Return value
 * ============
 *
 * The maximum ratio if run successfully, otherwise return -1
 *
 * Code structure
 * ==============
 *
 *  debug loop  -- if debug is one, the first loop computes the max ratio
 *              -- and the last(second) loop outputs debugging information,
 *              -- if the test fail and its ratio > 0.5 * max ratio.
 *              -- if debug is zero, the loop is executed once
 *    alpha loop  -- varying alpha: 0, 1, or random
 *        prec loop   -- varying internal prec: single, double, or extra
 *        norm loop   -- varying norm: near undeflow, near one, or
 *                    -- near overflow
 *          order loop  -- varying order type: rowmajor or colmajor
 *            uplo loop   -- varying uplo type: upper or lower
 *              trans loop  -- varying trans type: no trans, trans, and conj trans
 *                diag loop   -- varying diag type: non unit, and unit
 *                  numtest loop  -- how many times the test is perform with
 *                                -- above set of attributes
 *                        incx loop     -- varying incx: -2, -1, 1, 2
 */
{
  /* function name */
  const char fname[] = "BLAS_ztpmv_d_x";

  /* max number of debug lines to print */
  const int max_print = 3;

  /* Variables in the "x_val" form are loop vars for corresponding
     variables */
  int i;			/* iterate through the repeating tests */
  int j;			/* multipurpose counters */
  int ix;			/* use to index x  */
  int incx_val, incx;		/* for testing different inc values */
  int inctp, inc_index;		/* 1 if real, 2 if complex */
  int d_count;			/* counter for debug */
  int find_max_ratio;		/* find_max_ratio = 1 only if debug = 3 */
  int p_count;			/* counter for the number of debug lines printed */
  int tot_tests;		/* total number of tests to be done */
  int norm;			/* input values of near underflow/one/overflow */
  double ratio_max;		/* the current maximum ratio */
  double ratio_min;		/* the current minimum ratio */
  double *ratios;		/* a temporary variable for calculating ratio */
  double ratio = 0.0;		/* the per-use test ratio from test() */
  int bad_ratios = 0;		/* the number of ratios over the threshold */
  double eps_int;		/* the internal epsilon expected--2^(-24) for float */
  double un_int;		/* the internal underflow threshold */
  double alpha[2];
  double beta[2];
  double *tp;
  double *x;
  double *x_gen;		/* used to store vectors generated by testgen; eventually copied to x */
  double *temp;			/* use for calculating ratio */

  /* the true r calculated by testgen(), in double-double */
  double *head_r_true, *tail_r_true;


  int alpha_val;
  int alpha_flag = 0, beta_flag = 0;
  int order_val;
  enum blas_order_type order_type = 0;
  int prec_val;
  enum blas_prec_type prec = 0;
  int uplo_val;
  enum blas_uplo_type uplo_type = 0;
  int trans_val;
  enum blas_trans_type trans_type = 0;
  int diag_val;
  enum blas_diag_type diag_type = 0;

  double beta_zero_fake[2];
  double rin_zero_fake[2];

  int saved_seed;		/* for saving the original seed */
  int count, old_count = -1;
  FPU_FIX_DECL;

  /* test for bad arguments */
  if (n < 0 || ntests < 0)
    BLAS_error(fname, 0, 0, NULL);

  /* if there is nothing to test, return all zero */
  if (n == 0 || ntests == 0) {
    *min_ratio = 0.0;
    *num_bad_ratio = 0;
    *num_tests = 0;
    return 0.0;
  }

  FPU_FIX_START;


  incx = inctp = inc_index = 1;
  incx *= 2;

  inc_index *= 2;

  /* get space for calculation */
  x = (double *) blas_malloc(3 * n * 2 * sizeof(double) * 2);
  if (3 * n * 2 > 0 && x == NULL) {
    BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
  }
  x_gen = (double *) blas_malloc(3 * n * 2 * sizeof(double) * 2);
  if (3 * n * 2 > 0 && x_gen == NULL) {
    BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
  }
  tp = (double *) blas_malloc(2 * n * n * n * inctp * sizeof(double));
  if (2 * n * n * n * inctp > 0 && tp == NULL) {
    BLAS_error("blas_malloc", 0, 0, "malloc failed.\n");
  }
  temp = (double *) blas_malloc(3 * n * 2 * sizeof(double));
  if (3 * n * 2 > 0 && temp == 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");
  }


  /* initialization */
  saved_seed = *seed;
  ratio_min = 1e308;
  ratio_max = 0.0;
  tot_tests = 0;
  p_count = 0;
  count = 0;
  find_max_ratio = 0;
  beta[0] = beta[1] = 0.0;
  beta_flag = 1;

  beta_zero_fake[0] = beta_zero_fake[1] = 0.0;
  rin_zero_fake[0] = rin_zero_fake[1] = 0.0;

  if (debug == 3)
    find_max_ratio = 1;

  /* The debug iteration:
     If debug=1, then will execute the iteration twice. First, compute the
     max ratio. Second, print info if ratio > (50% * ratio_max). */
  for (d_count = 0; d_count <= find_max_ratio; d_count++) {
    bad_ratios = 0;		/* set to zero */

    if ((debug == 3) && (d_count == find_max_ratio))
      *seed = saved_seed;	/* restore the original seed */

    /* varying alpha */
    for (alpha_val = 0; alpha_val < 3; 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;
      }


      /* varying extra precs */
      for (prec_val = 0; prec_val <= 2; 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;
	}

	/* values near underflow, 1, or overflow */
	for (norm = -1; norm <= 1; norm++) {

	  /* row or col major */
	  for (order_val = 0; order_val < 2; order_val++) {
	    switch (order_val) {
	    case 0:
	      order_type = blas_rowmajor;
	      break;
	    case 1:
	      order_type = blas_colmajor;
	      break;
	    }

	    /* upper or lower */
	    for (uplo_val = 0; uplo_val < 2; uplo_val++) {
	      switch (uplo_val) {
	      case 0:
		uplo_type = blas_upper;
		break;
	      case 1:
		uplo_type = blas_lower;
		break;
	      }

	      /* no trans, trans, or conj trans */
	      for (trans_val = 0; trans_val < 3; trans_val++) {
		switch (trans_val) {
		case 0:
		  trans_type = blas_no_trans;
		  break;
		case 1:
		  trans_type = blas_trans;
		  break;
		case 2:
		  trans_type = blas_conj_trans;
		  break;
		}

		/* non_unit_diag, unit_diag */
		for (diag_val = 0; diag_val < 2; diag_val++) {
		  switch (diag_val) {
		  case 0:
		    diag_type = blas_non_unit_diag;
		    break;
		  case 1:
		    diag_type = blas_unit_diag;
		    break;
		  }

		  /* number of tests */
		  for (i = 0; i < ntests; i++) {
		    /* For the sake of speed, we throw out this case at random */
		    if (xrand(seed) >= test_prob)
		      continue;

		    BLAS_ztpmv_d_testgen(norm, order_type, uplo_type,
					 trans_type, diag_type, n,
					 &alpha, alpha_flag, tp, x_gen,
					 seed, head_r_true, tail_r_true);

		    count++;

		    /* varying incx */
		    for (incx_val = -2; incx_val <= 2; incx_val++) {
		      if (incx_val == 0)
			continue;

		      /* setting incx */
		      incx = incx_val;
		      incx *= 2;

		      /* set x starting index */
		      ix = 0;
		      if (incx < 0)
			ix = -(n - 1) * incx;

		      /* copy x_gen to x */
		      for (j = 0; j < n; j++) {
			x[ix] = x_gen[j * inc_index];
			x[ix + 1] = x_gen[j * inc_index + 1];
			ix += incx;
		      }

		      /* call BLAS_ztpmv_d_x */
		      FPU_FIX_STOP;
		      BLAS_ztpmv_d_x(order_type, uplo_type, trans_type,
				     diag_type, n, alpha, tp, x, incx_val,
				     prec);
		      FPU_FIX_START;

		      /* set x starting index */
		      ix = 0;
		      if (incx < 0)
			ix = -(n - 1) * incx;

		      /* computing the ratio */
		      for (j = 0; j < n; j++) {
			/* copy row j of tp to temp */
			dtpmv_copy_row(order_type, uplo_type, trans_type, n,
				       tp, temp, j);

			test_BLAS_zdot_d_z(n, blas_no_conj,
					   alpha, beta_zero_fake,
					   rin_zero_fake, &x[ix],
					   &head_r_true[j * inc_index],
					   &tail_r_true[j * inc_index], temp,
					   1, x_gen, 1, eps_int, un_int,
					   &ratios[j]);

			/* take the max ratio */
			if (j == 0)
			  ratio = ratios[0];
			else if (ratios[j] > ratio)
			  ratio = ratios[j];

			ix += incx;
		      }

		      /* increase the number of bad ratio, if the ratio is
		         bigger than the threshold */
		      if (ratio > thresh) {
			bad_ratios++;

			if ((debug == 3) &&	/* print only when debug is on */
			    (count != old_count) &&	/* print if old vector is different
							   from the current one */
			    (d_count == find_max_ratio) &&
			    (p_count <= max_print) &&
			    (ratio > 0.5 * ratio_max)) {
			  p_count++;
			  old_count = count;

			  printf
			    ("FAIL> %s: n = %d, ntests = %d, threshold = %4.2f,\n",
			     fname, n, ntests, thresh);

			  /* Print test info */
			  switch (prec) {
			  case blas_prec_single:
			    printf("single ");
			    break;
			  case blas_prec_double:
			    printf("double ");
			    break;
			  case blas_prec_indigenous:
			    printf("indigenous ");
			    break;
			  case blas_prec_extra:
			    printf("extra ");
			    break;
			  }
			  switch (norm) {
			  case -1:
			    printf("near_underflow ");
			    break;
			  case 0:
			    printf("near_one ");
			    break;
			  case 1:
			    printf("near_overflow ");
			    break;
			  }
			  switch (order_type) {
			  case blas_rowmajor:
			    printf("row_major ");
			    break;
			  case blas_colmajor:
			    printf("col_major ");
			    break;
			  }
			  switch (uplo_type) {
			  case blas_upper:
			    printf("upper ");
			    break;
			  case blas_lower:
			    printf("lower ");
			    break;
			  }
			  switch (trans_type) {
			  case blas_no_trans:
			    printf("no_trans ");
			    break;
			  case blas_trans:
			    printf("trans ");
			    break;
			  case blas_conj_trans:
			    printf("conj_trans ");
			    break;
			  }
			  switch (diag_type) {
			  case blas_non_unit_diag:
			    printf("non_unit_diag ");
			    break;
			  case blas_unit_diag:
			    printf("unit_diag ");
			    break;
			  }

			  printf(" incx=%d:\n", incx);
			  ix = 0;
			  if (incx < 0)
			    ix = -(n - 1) * incx;

			  printf("      TP=");
			  for (j = 0; j < n; j++) {
			    /* copy row j of tp to temp */
			    dtpmv_copy_row(order_type, uplo_type, trans_type,
					   n, tp, temp, j);

			    if (j > 0)
			      printf("        ");
			    dprint_vector(temp, n, 1, NULL);
			  }

			  ix = 0;
			  if (incx < 0)
			    ix = -(n - 1) * incx;

			  for (j = 0; j < n; j++) {
			    printf("      ");
			    printf("x[%d] = ", j * inc_index);
			    printf("(%24.16e, %24.16e)", x_gen[j * inc_index],
				   x_gen[j * inc_index + 1]);
			    printf("; ");
			    printf("x_final[%d] = ", ix);
			    printf("(%24.16e, %24.16e)", x[ix], x[ix + 1]);
			    printf("\n");
			    ix += incx;
			  }

			  printf("      ");
			  printf("alpha = ");
			  printf("(%24.16e, %24.16e)", alpha[0], alpha[1]);
			  printf("; ");
			  printf("\n");
			  for (j = 0; j < n; j++) {
			    printf("      ");

			    printf("([%24.16e  %24.16e], [%24.16e %24.16e])",
				   head_r_true[j * inc_index],
				   tail_r_true[j * inc_index],
				   head_r_true[j * inc_index + 1],
				   tail_r_true[j * inc_index + 1]);
			    printf(", ratio[%d]=%.4e\n", j, ratios[j]);
			  }
			  printf("      ratio=%.4e\n", ratio);
			}
		      }
		      if (d_count == 0) {
			if (ratio > ratio_max)
			  ratio_max = ratio;
			if (ratio != 0.0 && ratio < ratio_min)
			  ratio_min = ratio;
			tot_tests++;
		      }
		    }		/* incx */

		  }		/* numtests */
		}		/* diag */
	      }			/* trans */
	    }			/* uplo */
	  }			/* order */
	}			/* norm */
      }				/* prec */
    }				/* alpha */
  }				/* debug */

  if ((debug == 2) || ((debug == 1) && bad_ratios > 0)) {
    printf("      %s:  n = %d, ntests = %d, thresh = %4.2f\n",
	   fname, n, ntests, thresh);
    printf
      ("      bad/total = %d/%d=%3.2f, min_ratio = %.4e, max_ratio = %.4e\n\n",
       bad_ratios, tot_tests, ((double) bad_ratios) / ((double) tot_tests),
       ratio_min, ratio_max);
  }

  FPU_FIX_STOP;

  blas_free(x);
  blas_free(x_gen);
  blas_free(temp);
  blas_free(tp);
  blas_free(head_r_true);
  blas_free(tail_r_true);
  blas_free(ratios);

  *min_ratio = ratio_min;
  *num_bad_ratio = bad_ratios;
  *num_tests = tot_tests;
  return ratio_max;
}				/* end of do_test_ztpmv_d_x */

#define NSIZES 12

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 = "tpmv";
  char *fname;
  int n;

  int i;
  int sizes[NSIZES] = { 0, 1, 2, 3, 4, 5, 6, 10, 17, 28, 37, 58 };

  if (argc != 6) {
    printf("Usage:\n");
    printf("do_test_tpmv <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 tpmv", 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);


  fname = "BLAS_dtpmv_s";
  printf("Testing %s...\n", fname);
  min_ratio = 1e308;
  max_ratio = 0.0;
  total_bad_ratios = 0;
  total_tests = 0;
  for (i = 0; i < nsizes; i++) {

    n = sizes[i];
    total_max_ratio = do_test_dtpmv_s(n, ntests, &seed, thresh, debug,
				      test_prob,
				      &total_min_ratio, &num_bad_ratio,
				      &num_tests);
    if (total_max_ratio > max_ratio)
      max_ratio = total_max_ratio;

    if (total_min_ratio != 0.0 && total_min_ratio < min_ratio)
      min_ratio = total_min_ratio;

    total_bad_ratios += num_bad_ratio;
    total_tests += num_tests;
  }

  nr_routines++;
  if (total_bad_ratios == 0)
    printf("PASS> ");
  else {
    nr_failed_routines++;
    printf("FAIL> ");
  }

  if (min_ratio == 1e308)
    min_ratio = 0.0;
  printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n",
	 fname, total_bad_ratios, total_tests, max_ratio);

  fname = "BLAS_ztpmv_c";
  printf("Testing %s...\n", fname);
  min_ratio = 1e308;
  max_ratio = 0.0;
  total_bad_ratios = 0;
  total_tests = 0;
  for (i = 0; i < nsizes; i++) {

    n = sizes[i];
    total_max_ratio = do_test_ztpmv_c(n, ntests, &seed, thresh, debug,
				      test_prob,
				      &total_min_ratio, &num_bad_ratio,
				      &num_tests);
    if (total_max_ratio > max_ratio)
      max_ratio = total_max_ratio;

    if (total_min_ratio != 0.0 && total_min_ratio < min_ratio)
      min_ratio = total_min_ratio;

    total_bad_ratios += num_bad_ratio;
    total_tests += num_tests;
  }

  nr_routines++;
  if (total_bad_ratios == 0)
    printf("PASS> ");
  else {
    nr_failed_routines++;
    printf("FAIL> ");
  }

  if (min_ratio == 1e308)
    min_ratio = 0.0;
  printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n",
	 fname, total_bad_ratios, total_tests, max_ratio);

  fname = "BLAS_ctpmv_s";
  printf("Testing %s...\n", fname);
  min_ratio = 1e308;
  max_ratio = 0.0;
  total_bad_ratios = 0;
  total_tests = 0;
  for (i = 0; i < nsizes; i++) {

    n = sizes[i];
    total_max_ratio = do_test_ctpmv_s(n, ntests, &seed, thresh, debug,
				      test_prob,
				      &total_min_ratio, &num_bad_ratio,
				      &num_tests);
    if (total_max_ratio > max_ratio)
      max_ratio = total_max_ratio;

    if (total_min_ratio != 0.0 && total_min_ratio < min_ratio)
      min_ratio = total_min_ratio;

    total_bad_ratios += num_bad_ratio;
    total_tests += num_tests;
  }

  nr_routines++;
  if (total_bad_ratios == 0)
    printf("PASS> ");
  else {
    nr_failed_routines++;
    printf("FAIL> ");
  }

  if (min_ratio == 1e308)
    min_ratio = 0.0;
  printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n",
	 fname, total_bad_ratios, total_tests, max_ratio);

  fname = "BLAS_ztpmv_d";
  printf("Testing %s...\n", fname);
  min_ratio = 1e308;
  max_ratio = 0.0;
  total_bad_ratios = 0;
  total_tests = 0;
  for (i = 0; i < nsizes; i++) {

    n = sizes[i];
    total_max_ratio = do_test_ztpmv_d(n, ntests, &seed, thresh, debug,
				      test_prob,
				      &total_min_ratio, &num_bad_ratio,
				      &num_tests);
    if (total_max_ratio > max_ratio)
      max_ratio = total_max_ratio;

    if (total_min_ratio != 0.0 && total_min_ratio < min_ratio)
      min_ratio = total_min_ratio;

    total_bad_ratios += num_bad_ratio;
    total_tests += num_tests;
  }

  nr_routines++;
  if (total_bad_ratios == 0)
    printf("PASS> ");
  else {
    nr_failed_routines++;
    printf("FAIL> ");
  }

  if (min_ratio == 1e308)
    min_ratio = 0.0;
  printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n",
	 fname, total_bad_ratios, total_tests, max_ratio);

  fname = "BLAS_stpmv_x";
  printf("Testing %s...\n", fname);
  min_ratio = 1e308;
  max_ratio = 0.0;
  total_bad_ratios = 0;
  total_tests = 0;
  for (i = 0; i < nsizes; i++) {

    n = sizes[i];
    total_max_ratio = do_test_stpmv_x(n, ntests, &seed, thresh, debug,
				      test_prob,
				      &total_min_ratio, &num_bad_ratio,
				      &num_tests);
    if (total_max_ratio > max_ratio)
      max_ratio = total_max_ratio;

    if (total_min_ratio != 0.0 && total_min_ratio < min_ratio)
      min_ratio = total_min_ratio;

    total_bad_ratios += num_bad_ratio;
    total_tests += num_tests;
  }

  nr_routines++;
  if (total_bad_ratios == 0)
    printf("PASS> ");
  else {
    nr_failed_routines++;
    printf("FAIL> ");
  }

  if (min_ratio == 1e308)
    min_ratio = 0.0;
  printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n",
	 fname, total_bad_ratios, total_tests, max_ratio);

  fname = "BLAS_dtpmv_x";
  printf("Testing %s...\n", fname);
  min_ratio = 1e308;
  max_ratio = 0.0;
  total_bad_ratios = 0;
  total_tests = 0;
  for (i = 0; i < nsizes; i++) {

    n = sizes[i];
    total_max_ratio = do_test_dtpmv_x(n, ntests, &seed, thresh, debug,
				      test_prob,
				      &total_min_ratio, &num_bad_ratio,
				      &num_tests);
    if (total_max_ratio > max_ratio)
      max_ratio = total_max_ratio;

    if (total_min_ratio != 0.0 && total_min_ratio < min_ratio)
      min_ratio = total_min_ratio;

    total_bad_ratios += num_bad_ratio;
    total_tests += num_tests;
  }

  nr_routines++;
  if (total_bad_ratios == 0)
    printf("PASS> ");
  else {
    nr_failed_routines++;
    printf("FAIL> ");
  }

  if (min_ratio == 1e308)
    min_ratio = 0.0;
  printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n",
	 fname, total_bad_ratios, total_tests, max_ratio);

  fname = "BLAS_ctpmv_x";
  printf("Testing %s...\n", fname);
  min_ratio = 1e308;
  max_ratio = 0.0;
  total_bad_ratios = 0;
  total_tests = 0;
  for (i = 0; i < nsizes; i++) {

    n = sizes[i];
    total_max_ratio = do_test_ctpmv_x(n, ntests, &seed, thresh, debug,
				      test_prob,
				      &total_min_ratio, &num_bad_ratio,
				      &num_tests);
    if (total_max_ratio > max_ratio)
      max_ratio = total_max_ratio;

    if (total_min_ratio != 0.0 && total_min_ratio < min_ratio)
      min_ratio = total_min_ratio;

    total_bad_ratios += num_bad_ratio;
    total_tests += num_tests;
  }

  nr_routines++;
  if (total_bad_ratios == 0)
    printf("PASS> ");
  else {
    nr_failed_routines++;
    printf("FAIL> ");
  }

  if (min_ratio == 1e308)
    min_ratio = 0.0;
  printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n",
	 fname, total_bad_ratios, total_tests, max_ratio);

  fname = "BLAS_ztpmv_x";
  printf("Testing %s...\n", fname);
  min_ratio = 1e308;
  max_ratio = 0.0;
  total_bad_ratios = 0;
  total_tests = 0;
  for (i = 0; i < nsizes; i++) {

    n = sizes[i];
    total_max_ratio = do_test_ztpmv_x(n, ntests, &seed, thresh, debug,
				      test_prob,
				      &total_min_ratio, &num_bad_ratio,
				      &num_tests);
    if (total_max_ratio > max_ratio)
      max_ratio = total_max_ratio;

    if (total_min_ratio != 0.0 && total_min_ratio < min_ratio)
      min_ratio = total_min_ratio;

    total_bad_ratios += num_bad_ratio;
    total_tests += num_tests;
  }

  nr_routines++;
  if (total_bad_ratios == 0)
    printf("PASS> ");
  else {
    nr_failed_routines++;
    printf("FAIL> ");
  }

  if (min_ratio == 1e308)
    min_ratio = 0.0;
  printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n",
	 fname, total_bad_ratios, total_tests, max_ratio);

  fname = "BLAS_dtpmv_s_x";
  printf("Testing %s...\n", fname);
  min_ratio = 1e308;
  max_ratio = 0.0;
  total_bad_ratios = 0;
  total_tests = 0;
  for (i = 0; i < nsizes; i++) {

    n = sizes[i];
    total_max_ratio = do_test_dtpmv_s_x(n, ntests, &seed, thresh, debug,
					test_prob,
					&total_min_ratio, &num_bad_ratio,
					&num_tests);
    if (total_max_ratio > max_ratio)
      max_ratio = total_max_ratio;

    if (total_min_ratio != 0.0 && total_min_ratio < min_ratio)
      min_ratio = total_min_ratio;

    total_bad_ratios += num_bad_ratio;
    total_tests += num_tests;
  }

  nr_routines++;
  if (total_bad_ratios == 0)
    printf("PASS> ");
  else {
    nr_failed_routines++;
    printf("FAIL> ");
  }

  if (min_ratio == 1e308)
    min_ratio = 0.0;
  printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n",
	 fname, total_bad_ratios, total_tests, max_ratio);

  fname = "BLAS_ztpmv_c_x";
  printf("Testing %s...\n", fname);
  min_ratio = 1e308;
  max_ratio = 0.0;
  total_bad_ratios = 0;
  total_tests = 0;
  for (i = 0; i < nsizes; i++) {

    n = sizes[i];
    total_max_ratio = do_test_ztpmv_c_x(n, ntests, &seed, thresh, debug,
					test_prob,
					&total_min_ratio, &num_bad_ratio,
					&num_tests);
    if (total_max_ratio > max_ratio)
      max_ratio = total_max_ratio;

    if (total_min_ratio != 0.0 && total_min_ratio < min_ratio)
      min_ratio = total_min_ratio;

    total_bad_ratios += num_bad_ratio;
    total_tests += num_tests;
  }

  nr_routines++;
  if (total_bad_ratios == 0)
    printf("PASS> ");
  else {
    nr_failed_routines++;
    printf("FAIL> ");
  }

  if (min_ratio == 1e308)
    min_ratio = 0.0;
  printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n",
	 fname, total_bad_ratios, total_tests, max_ratio);

  fname = "BLAS_ctpmv_s_x";
  printf("Testing %s...\n", fname);
  min_ratio = 1e308;
  max_ratio = 0.0;
  total_bad_ratios = 0;
  total_tests = 0;
  for (i = 0; i < nsizes; i++) {

    n = sizes[i];
    total_max_ratio = do_test_ctpmv_s_x(n, ntests, &seed, thresh, debug,
					test_prob,
					&total_min_ratio, &num_bad_ratio,
					&num_tests);
    if (total_max_ratio > max_ratio)
      max_ratio = total_max_ratio;

    if (total_min_ratio != 0.0 && total_min_ratio < min_ratio)
      min_ratio = total_min_ratio;

    total_bad_ratios += num_bad_ratio;
    total_tests += num_tests;
  }

  nr_routines++;
  if (total_bad_ratios == 0)
    printf("PASS> ");
  else {
    nr_failed_routines++;
    printf("FAIL> ");
  }

  if (min_ratio == 1e308)
    min_ratio = 0.0;
  printf("%-24s: bad/total = %d/%d, max_ratio = %.2e\n\n",
	 fname, total_bad_ratios, total_tests, max_ratio);

  fname = "BLAS_ztpmv_d_x";
  printf("Testing %s...\n", fname);
  min_ratio = 1e308;
  max_ratio = 0.0;
  total_bad_ratios = 0;
  total_tests = 0;
  for (i = 0; i < nsizes; i++) {

    n = sizes[i];
    total_max_ratio = do_test_ztpmv_d_x(n, ntests, &seed, thresh, debug,
					test_prob,
					&total_min_ratio, &num_bad_ratio,
					&num_tests);
    if (total_max_ratio > max_ratio)
      max_ratio = total_max_ratio;

    if (total_min_ratio != 0.0 && total_min_ratio < min_ratio)
      min_ratio = total_min_ratio;

    total_bad_ratios += num_bad_ratio;
    total_tests += num_tests;
  }

  nr_routines++;
  if (total_bad_ratios == 0)
    printf("PASS> ");
  else {
    nr_failed_routines++;
    printf("FAIL> ");
  }

  if (min_ratio == 1e308)
    min_ratio = 0.0;
  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;
}