inline
 void spmv (CBLAS_ORDER const Order, CBLAS_UPLO const Uplo,
            int const N, double const alpha, double const* Ap,
            double const* X, int const incX,
            double const beta, double* Y, int const incY) 
 {
   cblas_dspmv (Order, Uplo, N, alpha, Ap, X, incX, beta, Y, incY);
 }
Exemple #2
0
void F77_dspmv(int *order, char *uplow, int *n, double *alpha, double *ap,
	      double *x, int *incx, double *beta, double *y, int *incy) {
  double *A,*AP;
  int i,j,k,LDA;
  enum CBLAS_UPLO uplo;

  get_uplo_type(uplow,&uplo);

  if (*order == TEST_ROW_MJR) {
     LDA = *n;
     A   = ( double* )malloc( LDA*LDA*sizeof( double ) );
     AP  = ( double* )malloc( (((LDA+1)*LDA)/2)*sizeof( double ) );
     if (uplo == CblasUpper) {
        for( j=0, k=0; j<*n; j++ )
           for( i=0; i<j+1; i++, k++ )
              A[ LDA*i+j ]=ap[ k ];
        for( i=0, k=0; i<*n; i++ )
           for( j=i; j<*n; j++, k++ )
              AP[ k ]=A[ LDA*i+j ];
     }
     else {
        for( j=0, k=0; j<*n; j++ )
           for( i=j; i<*n; i++, k++ )
              A[ LDA*i+j ]=ap[ k ];
        for( i=0, k=0; i<*n; i++ )
           for( j=0; j<i+1; j++, k++ )
              AP[ k ]=A[ LDA*i+j ];
     }
     cblas_dspmv( CblasRowMajor, uplo, *n, *alpha, AP, x, *incx, *beta, y, 
		  *incy );
     free(A);
     free(AP);
  }
  else
     cblas_dspmv( CblasColMajor, uplo, *n, *alpha, ap, x, *incx, *beta, y, 
		  *incy );
}
JNIEXPORT void JNICALL Java_uncomplicate_neanderthal_CBLAS_dspmv
(JNIEnv *env, jclass clazz,
 jint Order, jint Uplo,
 jint N,
 jdouble alpha,
 jobject Ap,
 jobject X, jint incX,
 jdouble beta,
 jobject Y, jint incY) {

  double *cAp = (double *) (*env)->GetDirectBufferAddress(env, Ap);
  double *cX = (double *) (*env)->GetDirectBufferAddress(env, X);
  double *cY = (double *) (*env)->GetDirectBufferAddress(env, Y);
  cblas_dspmv(Order, Uplo, N, alpha, cAp, cX, incX, beta, cY, incY);
};
Exemple #4
0
/* f77 interface */
void dspmv_(char *uplo, int *n, double *alpha, double *Ap,
            double *X, int *incx, double *beta, double *Y, int *incy)
{
    enum CBLAS_UPLO Uplo;
    int info = 0;
    if (F77UploToCBlasUplo(uplo,&Uplo) < 0)                     info =  1;
    if (info != 0) {
        xerbla_(ERROR_NAME, &info);
        return;
    }
    Blasx_Debug_Output("Calling dspmv_ interface\n");
    cblas_dspmv(CblasColMajor, Uplo,
                *n, *alpha, Ap,
                X, *incx,
                *beta, Y, *incy);
}
Exemple #5
0
void F77_d2chke(char *rout) {
   char *sf = ( rout ) ;
   double A[2] = {0.0,0.0},
          X[2] = {0.0,0.0},
          Y[2] = {0.0,0.0},
          ALPHA=0.0, BETA=0.0;
   extern int cblas_info, cblas_lerr, cblas_ok;
   extern int RowMajorStrg;
   extern char *cblas_rout;

   if (link_xerbla) /* call these first to link */
   {
      cblas_xerbla(cblas_info,cblas_rout,"");
      F77_xerbla(cblas_rout,&cblas_info);
   }

   cblas_ok = TRUE ;
   cblas_lerr = PASSED ;

   if (strncmp( sf,"cblas_dgemv",11)==0) {
      cblas_rout = "cblas_dgemv";
      cblas_info = 1;
      cblas_dgemv(INVALID, CblasNoTrans, 0, 0,
                  ALPHA, A, 1, X, 1, BETA, Y, 1 );
      chkxer();
      cblas_info = 2; RowMajorStrg = FALSE;
      cblas_dgemv(CblasColMajor, INVALID, 0, 0,
                  ALPHA, A, 1, X, 1, BETA, Y, 1 );
      chkxer();
      cblas_info = 3; RowMajorStrg = FALSE;
      cblas_dgemv(CblasColMajor, CblasNoTrans, INVALID, 0,
                  ALPHA, A, 1, X, 1, BETA, Y, 1 );
      chkxer();
      cblas_info = 4; RowMajorStrg = FALSE;
      cblas_dgemv(CblasColMajor, CblasNoTrans, 0, INVALID,
                  ALPHA, A, 1, X, 1, BETA, Y, 1 );
      chkxer();
      cblas_info = 7; RowMajorStrg = FALSE;
      cblas_dgemv(CblasColMajor, CblasNoTrans, 2, 0,
                  ALPHA, A, 1, X, 1, BETA, Y, 1 );
      chkxer();
      cblas_info = 9; RowMajorStrg = FALSE;
      cblas_dgemv(CblasColMajor, CblasNoTrans, 0, 0,
                  ALPHA, A, 1, X, 0, BETA, Y, 1 );
      chkxer();
      cblas_info = 12; RowMajorStrg = FALSE;
      cblas_dgemv(CblasColMajor, CblasNoTrans, 0, 0,
                  ALPHA, A, 1, X, 1, BETA, Y, 0 );
      chkxer();

      cblas_info = 2; RowMajorStrg = TRUE; RowMajorStrg = TRUE;
      cblas_dgemv(CblasRowMajor, INVALID, 0, 0,
                  ALPHA, A, 1, X, 1, BETA, Y, 1 );
      chkxer();
      cblas_info = 3; RowMajorStrg = TRUE;
      cblas_dgemv(CblasRowMajor, CblasNoTrans, INVALID, 0,
                  ALPHA, A, 1, X, 1, BETA, Y, 1 );
      chkxer();
      cblas_info = 4; RowMajorStrg = TRUE;
      cblas_dgemv(CblasRowMajor, CblasNoTrans, 0, INVALID,
                  ALPHA, A, 1, X, 1, BETA, Y, 1 );
      chkxer();
      cblas_info = 7; RowMajorStrg = TRUE;
      cblas_dgemv(CblasRowMajor, CblasNoTrans, 0, 2,
                  ALPHA, A, 1, X, 1, BETA, Y, 1 );
      chkxer();
      cblas_info = 9; RowMajorStrg = TRUE;
      cblas_dgemv(CblasRowMajor, CblasNoTrans, 0, 0,
                  ALPHA, A, 1, X, 0, BETA, Y, 1 );
      chkxer();
      cblas_info = 12; RowMajorStrg = TRUE;
      cblas_dgemv(CblasRowMajor, CblasNoTrans, 0, 0,
                  ALPHA, A, 1, X, 1, BETA, Y, 0 );
      chkxer();
   } else if (strncmp( sf,"cblas_dgbmv",11)==0) {
      cblas_rout = "cblas_dgbmv";
      cblas_info = 1; RowMajorStrg = FALSE;
      cblas_dgbmv(INVALID, CblasNoTrans, 0, 0, 0, 0,
                  ALPHA, A, 1, X, 1, BETA, Y, 1 );
      chkxer();
      cblas_info = 2; RowMajorStrg = FALSE;
      cblas_dgbmv(CblasColMajor, INVALID, 0, 0, 0, 0,
                  ALPHA, A, 1, X, 1, BETA, Y, 1 );
      chkxer();
      cblas_info = 3; RowMajorStrg = FALSE;
      cblas_dgbmv(CblasColMajor, CblasNoTrans, INVALID, 0, 0, 0,
                  ALPHA, A, 1, X, 1, BETA, Y, 1 );
      chkxer();
      cblas_info = 4; RowMajorStrg = FALSE;
      cblas_dgbmv(CblasColMajor, CblasNoTrans, 0, INVALID, 0, 0,
                  ALPHA, A, 1, X, 1, BETA, Y, 1 );
      chkxer();
      cblas_info = 5; RowMajorStrg = FALSE;
      cblas_dgbmv(CblasColMajor, CblasNoTrans, 0, 0, INVALID, 0,
                  ALPHA, A, 1, X, 1, BETA, Y, 1 );
      chkxer();
      cblas_info = 6; RowMajorStrg = FALSE;
      cblas_dgbmv(CblasColMajor, CblasNoTrans, 2, 0, 0, INVALID,
                  ALPHA, A, 1, X, 1, BETA, Y, 1 );
      chkxer();
      cblas_info = 9; RowMajorStrg = FALSE;
      cblas_dgbmv(CblasColMajor, CblasNoTrans, 0, 0, 1, 0,
                  ALPHA, A, 1, X, 1, BETA, Y, 1 );
      chkxer();
      cblas_info = 11; RowMajorStrg = FALSE;
      cblas_dgbmv(CblasColMajor, CblasNoTrans, 0, 0, 0, 0,
                  ALPHA, A, 1, X, 0, BETA, Y, 1 );
      chkxer();
      cblas_info = 14; RowMajorStrg = FALSE;
      cblas_dgbmv(CblasColMajor, CblasNoTrans, 0, 0, 0, 0,
                  ALPHA, A, 1, X, 1, BETA, Y, 0 );
      chkxer();
      cblas_info = 2; RowMajorStrg = TRUE;
      cblas_dgbmv(CblasRowMajor, INVALID, 0, 0, 0, 0,
                  ALPHA, A, 1, X, 1, BETA, Y, 1 );
      chkxer();
      cblas_info = 3; RowMajorStrg = TRUE;
      cblas_dgbmv(CblasRowMajor, CblasNoTrans, INVALID, 0, 0, 0,
                  ALPHA, A, 1, X, 1, BETA, Y, 1 );
      chkxer();
      cblas_info = 4; RowMajorStrg = TRUE;
      cblas_dgbmv(CblasRowMajor, CblasNoTrans, 0, INVALID, 0, 0,
                  ALPHA, A, 1, X, 1, BETA, Y, 1 );
      chkxer();
      cblas_info = 5; RowMajorStrg = TRUE;
      cblas_dgbmv(CblasRowMajor, CblasNoTrans, 0, 0, INVALID, 0,
                  ALPHA, A, 1, X, 1, BETA, Y, 1 );
      chkxer();
      cblas_info = 6; RowMajorStrg = TRUE;
      cblas_dgbmv(CblasRowMajor, CblasNoTrans, 2, 0, 0, INVALID,
                  ALPHA, A, 1, X, 1, BETA, Y, 1 );
      chkxer();
      cblas_info = 9; RowMajorStrg = TRUE;
      cblas_dgbmv(CblasRowMajor, CblasNoTrans, 0, 0, 1, 0,
                  ALPHA, A, 1, X, 1, BETA, Y, 1 );
      chkxer();
      cblas_info = 11; RowMajorStrg = TRUE;
      cblas_dgbmv(CblasRowMajor, CblasNoTrans, 0, 0, 0, 0,
                  ALPHA, A, 1, X, 0, BETA, Y, 1 );
      chkxer();
      cblas_info = 14; RowMajorStrg = TRUE;
      cblas_dgbmv(CblasRowMajor, CblasNoTrans, 0, 0, 0, 0,
                  ALPHA, A, 1, X, 1, BETA, Y, 0 );
      chkxer();
   } else if (strncmp( sf,"cblas_dsymv",11)==0) {
      cblas_rout = "cblas_dsymv";
      cblas_info = 1; RowMajorStrg = FALSE;
      cblas_dsymv(INVALID, CblasUpper, 0,
                  ALPHA, A, 1, X, 1, BETA, Y, 1 );
      chkxer();
      cblas_info = 2; RowMajorStrg = FALSE;
      cblas_dsymv(CblasColMajor, INVALID, 0,
                  ALPHA, A, 1, X, 1, BETA, Y, 1 );
      chkxer();
      cblas_info = 3; RowMajorStrg = FALSE;
      cblas_dsymv(CblasColMajor, CblasUpper, INVALID,
                  ALPHA, A, 1, X, 1, BETA, Y, 1 );
      chkxer();
      cblas_info = 6; RowMajorStrg = FALSE;
      cblas_dsymv(CblasColMajor, CblasUpper, 2,
                  ALPHA, A, 1, X, 1, BETA, Y, 1 );
      chkxer();
      cblas_info = 8; RowMajorStrg = FALSE;
      cblas_dsymv(CblasColMajor, CblasUpper, 0,
                  ALPHA, A, 1, X, 0, BETA, Y, 1 );
      chkxer();
      cblas_info = 11; RowMajorStrg = FALSE;
      cblas_dsymv(CblasColMajor, CblasUpper, 0,
                  ALPHA, A, 1, X, 1, BETA, Y, 0 );
      chkxer();
      cblas_info = 2; RowMajorStrg = TRUE;
      cblas_dsymv(CblasRowMajor, INVALID, 0,
                  ALPHA, A, 1, X, 1, BETA, Y, 1 );
      chkxer();
      cblas_info = 3; RowMajorStrg = TRUE;
      cblas_dsymv(CblasRowMajor, CblasUpper, INVALID,
                  ALPHA, A, 1, X, 1, BETA, Y, 1 );
      chkxer();
      cblas_info = 6; RowMajorStrg = TRUE;
      cblas_dsymv(CblasRowMajor, CblasUpper, 2,
                  ALPHA, A, 1, X, 1, BETA, Y, 1 );
      chkxer();
      cblas_info = 8; RowMajorStrg = TRUE;
      cblas_dsymv(CblasRowMajor, CblasUpper, 0,
                  ALPHA, A, 1, X, 0, BETA, Y, 1 );
      chkxer();
      cblas_info = 11; RowMajorStrg = TRUE;
      cblas_dsymv(CblasRowMajor, CblasUpper, 0,
                  ALPHA, A, 1, X, 1, BETA, Y, 0 );
      chkxer();
   } else if (strncmp( sf,"cblas_dsbmv",11)==0) {
      cblas_rout = "cblas_dsbmv";
      cblas_info = 1; RowMajorStrg = FALSE;
      cblas_dsbmv(INVALID, CblasUpper, 0, 0,
                  ALPHA, A, 1, X, 1, BETA, Y, 1 );
      chkxer();
      cblas_info = 2; RowMajorStrg = FALSE;
      cblas_dsbmv(CblasColMajor, INVALID, 0, 0,
                  ALPHA, A, 1, X, 1, BETA, Y, 1 );
      chkxer();
      cblas_info = 3; RowMajorStrg = FALSE;
      cblas_dsbmv(CblasColMajor, CblasUpper, INVALID, 0,
                  ALPHA, A, 1, X, 1, BETA, Y, 1 );
      chkxer();
      cblas_info = 4; RowMajorStrg = FALSE;
      cblas_dsbmv(CblasColMajor, CblasUpper, 0, INVALID,
                  ALPHA, A, 1, X, 1, BETA, Y, 1 );
      chkxer();
      cblas_info = 7; RowMajorStrg = FALSE;
      cblas_dsbmv(CblasColMajor, CblasUpper, 0, 1,
                  ALPHA, A, 1, X, 1, BETA, Y, 1 );
      chkxer();
      cblas_info = 9; RowMajorStrg = FALSE;
      cblas_dsbmv(CblasColMajor, CblasUpper, 0, 0,
                  ALPHA, A, 1, X, 0, BETA, Y, 1 );
      chkxer();
      cblas_info = 12; RowMajorStrg = FALSE;
      cblas_dsbmv(CblasColMajor, CblasUpper, 0, 0,
                  ALPHA, A, 1, X, 1, BETA, Y, 0 );
      chkxer();
      cblas_info = 2; RowMajorStrg = TRUE;
      cblas_dsbmv(CblasRowMajor, INVALID, 0, 0,
                  ALPHA, A, 1, X, 1, BETA, Y, 1 );
      chkxer();
      cblas_info = 3; RowMajorStrg = TRUE;
      cblas_dsbmv(CblasRowMajor, CblasUpper, INVALID, 0,
                  ALPHA, A, 1, X, 1, BETA, Y, 1 );
      chkxer();
      cblas_info = 4; RowMajorStrg = TRUE;
      cblas_dsbmv(CblasRowMajor, CblasUpper, 0, INVALID,
                  ALPHA, A, 1, X, 1, BETA, Y, 1 );
      chkxer();
      cblas_info = 7; RowMajorStrg = TRUE;
      cblas_dsbmv(CblasRowMajor, CblasUpper, 0, 1,
                  ALPHA, A, 1, X, 1, BETA, Y, 1 );
      chkxer();
      cblas_info = 9; RowMajorStrg = TRUE;
      cblas_dsbmv(CblasRowMajor, CblasUpper, 0, 0,
                  ALPHA, A, 1, X, 0, BETA, Y, 1 );
      chkxer();
      cblas_info = 12; RowMajorStrg = TRUE;
      cblas_dsbmv(CblasRowMajor, CblasUpper, 0, 0,
                  ALPHA, A, 1, X, 1, BETA, Y, 0 );
      chkxer();
   } else if (strncmp( sf,"cblas_dspmv",11)==0) {
      cblas_rout = "cblas_dspmv";
      cblas_info = 1; RowMajorStrg = FALSE;
      cblas_dspmv(INVALID, CblasUpper, 0,
                  ALPHA, A, X, 1, BETA, Y, 1 );
      chkxer();
      cblas_info = 2; RowMajorStrg = FALSE;
      cblas_dspmv(CblasColMajor, INVALID, 0,
                  ALPHA, A, X, 1, BETA, Y, 1 );
      chkxer();
      cblas_info = 3; RowMajorStrg = FALSE;
      cblas_dspmv(CblasColMajor, CblasUpper, INVALID,
                  ALPHA, A, X, 1, BETA, Y, 1 );
      chkxer();
      cblas_info = 7; RowMajorStrg = FALSE;
      cblas_dspmv(CblasColMajor, CblasUpper, 0,
                  ALPHA, A, X, 0, BETA, Y, 1 );
      chkxer();
      cblas_info = 10; RowMajorStrg = FALSE;
      cblas_dspmv(CblasColMajor, CblasUpper, 0,
                  ALPHA, A, X, 1, BETA, Y, 0 );
      chkxer();
      cblas_info = 2; RowMajorStrg = TRUE;
      cblas_dspmv(CblasRowMajor, INVALID, 0,
                  ALPHA, A, X, 1, BETA, Y, 1 );
      chkxer();
      cblas_info = 3; RowMajorStrg = TRUE;
      cblas_dspmv(CblasRowMajor, CblasUpper, INVALID,
                  ALPHA, A, X, 1, BETA, Y, 1 );
      chkxer();
      cblas_info = 7; RowMajorStrg = TRUE;
      cblas_dspmv(CblasRowMajor, CblasUpper, 0,
                  ALPHA, A, X, 0, BETA, Y, 1 );
      chkxer();
      cblas_info = 10; RowMajorStrg = TRUE;
      cblas_dspmv(CblasRowMajor, CblasUpper, 0,
                  ALPHA, A, X, 1, BETA, Y, 0 );
      chkxer();
   } else if (strncmp( sf,"cblas_dtrmv",11)==0) {
      cblas_rout = "cblas_dtrmv";
      cblas_info = 1; RowMajorStrg = FALSE;
      cblas_dtrmv(INVALID, CblasUpper, CblasNoTrans,
                  CblasNonUnit, 0, A, 1, X, 1 );
      chkxer();
      cblas_info = 2; RowMajorStrg = FALSE;
      cblas_dtrmv(CblasColMajor, INVALID, CblasNoTrans,
                  CblasNonUnit, 0, A, 1, X, 1 );
      chkxer();
      cblas_info = 3; RowMajorStrg = FALSE;
      cblas_dtrmv(CblasColMajor, CblasUpper, INVALID,
                  CblasNonUnit, 0, A, 1, X, 1 );
      chkxer();
      cblas_info = 4; RowMajorStrg = FALSE;
      cblas_dtrmv(CblasColMajor, CblasUpper, CblasNoTrans,
                  INVALID, 0, A, 1, X, 1 );
      chkxer();
      cblas_info = 5; RowMajorStrg = FALSE;
      cblas_dtrmv(CblasColMajor, CblasUpper, CblasNoTrans,
                  CblasNonUnit, INVALID, A, 1, X, 1 );
      chkxer();
      cblas_info = 7; RowMajorStrg = FALSE;
      cblas_dtrmv(CblasColMajor, CblasUpper, CblasNoTrans,
                  CblasNonUnit, 2, A, 1, X, 1 );
      chkxer();
      cblas_info = 9; RowMajorStrg = FALSE;
      cblas_dtrmv(CblasColMajor, CblasUpper, CblasNoTrans,
                  CblasNonUnit, 0, A, 1, X, 0 );
      chkxer();
      cblas_info = 2; RowMajorStrg = TRUE;
      cblas_dtrmv(CblasRowMajor, INVALID, CblasNoTrans,
                  CblasNonUnit, 0, A, 1, X, 1 );
      chkxer();
      cblas_info = 3; RowMajorStrg = TRUE;
      cblas_dtrmv(CblasRowMajor, CblasUpper, INVALID,
                  CblasNonUnit, 0, A, 1, X, 1 );
      chkxer();
      cblas_info = 4; RowMajorStrg = TRUE;
      cblas_dtrmv(CblasRowMajor, CblasUpper, CblasNoTrans,
                  INVALID, 0, A, 1, X, 1 );
      chkxer();
      cblas_info = 5; RowMajorStrg = TRUE;
      cblas_dtrmv(CblasRowMajor, CblasUpper, CblasNoTrans,
                  CblasNonUnit, INVALID, A, 1, X, 1 );
      chkxer();
      cblas_info = 7; RowMajorStrg = TRUE;
      cblas_dtrmv(CblasRowMajor, CblasUpper, CblasNoTrans,
                  CblasNonUnit, 2, A, 1, X, 1 );
      chkxer();
      cblas_info = 9; RowMajorStrg = TRUE;
      cblas_dtrmv(CblasRowMajor, CblasUpper, CblasNoTrans,
                  CblasNonUnit, 0, A, 1, X, 0 );
      chkxer();
   } else if (strncmp( sf,"cblas_dtbmv",11)==0) {
      cblas_rout = "cblas_dtbmv";
      cblas_info = 1; RowMajorStrg = FALSE;
      cblas_dtbmv(INVALID, CblasUpper, CblasNoTrans,
                  CblasNonUnit, 0, 0, A, 1, X, 1 );
      chkxer();
      cblas_info = 2; RowMajorStrg = FALSE;
      cblas_dtbmv(CblasColMajor, INVALID, CblasNoTrans,
                  CblasNonUnit, 0, 0, A, 1, X, 1 );
      chkxer();
      cblas_info = 3; RowMajorStrg = FALSE;
      cblas_dtbmv(CblasColMajor, CblasUpper, INVALID,
                  CblasNonUnit, 0, 0, A, 1, X, 1 );
      chkxer();
      cblas_info = 4; RowMajorStrg = FALSE;
      cblas_dtbmv(CblasColMajor, CblasUpper, CblasNoTrans,
                  INVALID, 0, 0, A, 1, X, 1 );
      chkxer();
      cblas_info = 5; RowMajorStrg = FALSE;
      cblas_dtbmv(CblasColMajor, CblasUpper, CblasNoTrans,
                  CblasNonUnit, INVALID, 0, A, 1, X, 1 );
      chkxer();
      cblas_info = 6; RowMajorStrg = FALSE;
      cblas_dtbmv(CblasColMajor, CblasUpper, CblasNoTrans,
                  CblasNonUnit, 0, INVALID, A, 1, X, 1 );
      chkxer();
      cblas_info = 8; RowMajorStrg = FALSE;
      cblas_dtbmv(CblasColMajor, CblasUpper, CblasNoTrans,
                  CblasNonUnit, 0, 1, A, 1, X, 1 );
      chkxer();
      cblas_info = 10; RowMajorStrg = FALSE;
      cblas_dtbmv(CblasColMajor, CblasUpper, CblasNoTrans,
                  CblasNonUnit, 0, 0, A, 1, X, 0 );
      chkxer();
      cblas_info = 2; RowMajorStrg = TRUE;
      cblas_dtbmv(CblasRowMajor, INVALID, CblasNoTrans,
                  CblasNonUnit, 0, 0, A, 1, X, 1 );
      chkxer();
      cblas_info = 3; RowMajorStrg = TRUE;
      cblas_dtbmv(CblasRowMajor, CblasUpper, INVALID,
                  CblasNonUnit, 0, 0, A, 1, X, 1 );
      chkxer();
      cblas_info = 4; RowMajorStrg = TRUE;
      cblas_dtbmv(CblasRowMajor, CblasUpper, CblasNoTrans,
                  INVALID, 0, 0, A, 1, X, 1 );
      chkxer();
      cblas_info = 5; RowMajorStrg = TRUE;
      cblas_dtbmv(CblasRowMajor, CblasUpper, CblasNoTrans,
                  CblasNonUnit, INVALID, 0, A, 1, X, 1 );
      chkxer();
      cblas_info = 6; RowMajorStrg = TRUE;
      cblas_dtbmv(CblasRowMajor, CblasUpper, CblasNoTrans,
                  CblasNonUnit, 0, INVALID, A, 1, X, 1 );
      chkxer();
      cblas_info = 8; RowMajorStrg = TRUE;
      cblas_dtbmv(CblasRowMajor, CblasUpper, CblasNoTrans,
                  CblasNonUnit, 0, 1, A, 1, X, 1 );
      chkxer();
      cblas_info = 10; RowMajorStrg = TRUE;
      cblas_dtbmv(CblasRowMajor, CblasUpper, CblasNoTrans,
                  CblasNonUnit, 0, 0, A, 1, X, 0 );
      chkxer();
   } else if (strncmp( sf,"cblas_dtpmv",11)==0) {
      cblas_rout = "cblas_dtpmv";
      cblas_info = 1; RowMajorStrg = FALSE;
      cblas_dtpmv(INVALID, CblasUpper, CblasNoTrans,
                  CblasNonUnit, 0, A, X, 1 );
      chkxer();
      cblas_info = 2; RowMajorStrg = FALSE;
      cblas_dtpmv(CblasColMajor, INVALID, CblasNoTrans,
                  CblasNonUnit, 0, A, X, 1 );
      chkxer();
      cblas_info = 3; RowMajorStrg = FALSE;
      cblas_dtpmv(CblasColMajor, CblasUpper, INVALID,
                  CblasNonUnit, 0, A, X, 1 );
      chkxer();
      cblas_info = 4; RowMajorStrg = FALSE;
      cblas_dtpmv(CblasColMajor, CblasUpper, CblasNoTrans,
                  INVALID, 0, A, X, 1 );
      chkxer();
      cblas_info = 5; RowMajorStrg = FALSE;
      cblas_dtpmv(CblasColMajor, CblasUpper, CblasNoTrans,
                  CblasNonUnit, INVALID, A, X, 1 );
      chkxer();
      cblas_info = 8; RowMajorStrg = FALSE;
      cblas_dtpmv(CblasColMajor, CblasUpper, CblasNoTrans,
                  CblasNonUnit, 0, A, X, 0 );
      chkxer();
      cblas_info = 2; RowMajorStrg = TRUE;
      cblas_dtpmv(CblasRowMajor, INVALID, CblasNoTrans,
                  CblasNonUnit, 0, A, X, 1 );
      chkxer();
      cblas_info = 3; RowMajorStrg = TRUE;
      cblas_dtpmv(CblasRowMajor, CblasUpper, INVALID,
                  CblasNonUnit, 0, A, X, 1 );
      chkxer();
      cblas_info = 4; RowMajorStrg = TRUE;
      cblas_dtpmv(CblasRowMajor, CblasUpper, CblasNoTrans,
                  INVALID, 0, A, X, 1 );
      chkxer();
      cblas_info = 5; RowMajorStrg = TRUE;
      cblas_dtpmv(CblasRowMajor, CblasUpper, CblasNoTrans,
                  CblasNonUnit, INVALID, A, X, 1 );
      chkxer();
      cblas_info = 8; RowMajorStrg = TRUE;
      cblas_dtpmv(CblasRowMajor, CblasUpper, CblasNoTrans,
                  CblasNonUnit, 0, A, X, 0 );
      chkxer();
   } else if (strncmp( sf,"cblas_dtrsv",11)==0) {
      cblas_rout = "cblas_dtrsv";
      cblas_info = 1; RowMajorStrg = FALSE;
      cblas_dtrsv(INVALID, CblasUpper, CblasNoTrans,
                  CblasNonUnit, 0, A, 1, X, 1 );
      chkxer();
      cblas_info = 2; RowMajorStrg = FALSE;
      cblas_dtrsv(CblasColMajor, INVALID, CblasNoTrans,
                  CblasNonUnit, 0, A, 1, X, 1 );
      chkxer();
      cblas_info = 3; RowMajorStrg = FALSE;
      cblas_dtrsv(CblasColMajor, CblasUpper, INVALID,
                  CblasNonUnit, 0, A, 1, X, 1 );
      chkxer();
      cblas_info = 4; RowMajorStrg = FALSE;
      cblas_dtrsv(CblasColMajor, CblasUpper, CblasNoTrans,
                  INVALID, 0, A, 1, X, 1 );
      chkxer();
      cblas_info = 5; RowMajorStrg = FALSE;
      cblas_dtrsv(CblasColMajor, CblasUpper, CblasNoTrans,
                  CblasNonUnit, INVALID, A, 1, X, 1 );
      chkxer();
      cblas_info = 7; RowMajorStrg = FALSE;
      cblas_dtrsv(CblasColMajor, CblasUpper, CblasNoTrans,
                  CblasNonUnit, 2, A, 1, X, 1 );
      chkxer();
      cblas_info = 9; RowMajorStrg = FALSE;
      cblas_dtrsv(CblasColMajor, CblasUpper, CblasNoTrans,
                  CblasNonUnit, 0, A, 1, X, 0 );
      chkxer();
      cblas_info = 2; RowMajorStrg = TRUE;
      cblas_dtrsv(CblasRowMajor, INVALID, CblasNoTrans,
                  CblasNonUnit, 0, A, 1, X, 1 );
      chkxer();
      cblas_info = 3; RowMajorStrg = TRUE;
      cblas_dtrsv(CblasRowMajor, CblasUpper, INVALID,
                  CblasNonUnit, 0, A, 1, X, 1 );
      chkxer();
      cblas_info = 4; RowMajorStrg = TRUE;
      cblas_dtrsv(CblasRowMajor, CblasUpper, CblasNoTrans,
                  INVALID, 0, A, 1, X, 1 );
      chkxer();
      cblas_info = 5; RowMajorStrg = TRUE;
      cblas_dtrsv(CblasRowMajor, CblasUpper, CblasNoTrans,
                  CblasNonUnit, INVALID, A, 1, X, 1 );
      chkxer();
      cblas_info = 7; RowMajorStrg = TRUE;
      cblas_dtrsv(CblasRowMajor, CblasUpper, CblasNoTrans,
                  CblasNonUnit, 2, A, 1, X, 1 );
      chkxer();
      cblas_info = 9; RowMajorStrg = TRUE;
      cblas_dtrsv(CblasRowMajor, CblasUpper, CblasNoTrans,
                  CblasNonUnit, 0, A, 1, X, 0 );
      chkxer();
   } else if (strncmp( sf,"cblas_dtbsv",11)==0) {
      cblas_rout = "cblas_dtbsv";
      cblas_info = 1; RowMajorStrg = FALSE;
      cblas_dtbsv(INVALID, CblasUpper, CblasNoTrans,
                  CblasNonUnit, 0, 0, A, 1, X, 1 );
      chkxer();
      cblas_info = 2; RowMajorStrg = FALSE;
      cblas_dtbsv(CblasColMajor, INVALID, CblasNoTrans,
                  CblasNonUnit, 0, 0, A, 1, X, 1 );
      chkxer();
      cblas_info = 3; RowMajorStrg = FALSE;
      cblas_dtbsv(CblasColMajor, CblasUpper, INVALID,
                  CblasNonUnit, 0, 0, A, 1, X, 1 );
      chkxer();
      cblas_info = 4; RowMajorStrg = FALSE;
      cblas_dtbsv(CblasColMajor, CblasUpper, CblasNoTrans,
                  INVALID, 0, 0, A, 1, X, 1 );
      chkxer();
      cblas_info = 5; RowMajorStrg = FALSE;
      cblas_dtbsv(CblasColMajor, CblasUpper, CblasNoTrans,
                  CblasNonUnit, INVALID, 0, A, 1, X, 1 );
      chkxer();
      cblas_info = 6; RowMajorStrg = FALSE;
      cblas_dtbsv(CblasColMajor, CblasUpper, CblasNoTrans,
                  CblasNonUnit, 0, INVALID, A, 1, X, 1 );
      chkxer();
      cblas_info = 8; RowMajorStrg = FALSE;
      cblas_dtbsv(CblasColMajor, CblasUpper, CblasNoTrans,
                  CblasNonUnit, 0, 1, A, 1, X, 1 );
      chkxer();
      cblas_info = 10; RowMajorStrg = FALSE;
      cblas_dtbsv(CblasColMajor, CblasUpper, CblasNoTrans,
                  CblasNonUnit, 0, 0, A, 1, X, 0 );
      chkxer();
      cblas_info = 2; RowMajorStrg = TRUE;
      cblas_dtbsv(CblasRowMajor, INVALID, CblasNoTrans,
                  CblasNonUnit, 0, 0, A, 1, X, 1 );
      chkxer();
      cblas_info = 3; RowMajorStrg = TRUE;
      cblas_dtbsv(CblasRowMajor, CblasUpper, INVALID,
                  CblasNonUnit, 0, 0, A, 1, X, 1 );
      chkxer();
      cblas_info = 4; RowMajorStrg = TRUE;
      cblas_dtbsv(CblasRowMajor, CblasUpper, CblasNoTrans,
                  INVALID, 0, 0, A, 1, X, 1 );
      chkxer();
      cblas_info = 5; RowMajorStrg = TRUE;
      cblas_dtbsv(CblasRowMajor, CblasUpper, CblasNoTrans,
                  CblasNonUnit, INVALID, 0, A, 1, X, 1 );
      chkxer();
      cblas_info = 6; RowMajorStrg = TRUE;
      cblas_dtbsv(CblasRowMajor, CblasUpper, CblasNoTrans,
                  CblasNonUnit, 0, INVALID, A, 1, X, 1 );
      chkxer();
      cblas_info = 8; RowMajorStrg = TRUE;
      cblas_dtbsv(CblasRowMajor, CblasUpper, CblasNoTrans,
                  CblasNonUnit, 0, 1, A, 1, X, 1 );
      chkxer();
      cblas_info = 10; RowMajorStrg = TRUE;
      cblas_dtbsv(CblasRowMajor, CblasUpper, CblasNoTrans,
                  CblasNonUnit, 0, 0, A, 1, X, 0 );
      chkxer();
   } else if (strncmp( sf,"cblas_dtpsv",11)==0) {
      cblas_rout = "cblas_dtpsv";
      cblas_info = 1; RowMajorStrg = FALSE;
      cblas_dtpsv(INVALID, CblasUpper, CblasNoTrans,
                  CblasNonUnit, 0, A, X, 1 );
      chkxer();
      cblas_info = 2; RowMajorStrg = FALSE;
      cblas_dtpsv(CblasColMajor, INVALID, CblasNoTrans,
                  CblasNonUnit, 0, A, X, 1 );
      chkxer();
      cblas_info = 3; RowMajorStrg = FALSE;
      cblas_dtpsv(CblasColMajor, CblasUpper, INVALID,
                  CblasNonUnit, 0, A, X, 1 );
      chkxer();
      cblas_info = 4; RowMajorStrg = FALSE;
      cblas_dtpsv(CblasColMajor, CblasUpper, CblasNoTrans,
                  INVALID, 0, A, X, 1 );
      chkxer();
      cblas_info = 5; RowMajorStrg = FALSE;
      cblas_dtpsv(CblasColMajor, CblasUpper, CblasNoTrans,
                  CblasNonUnit, INVALID, A, X, 1 );
      chkxer();
      cblas_info = 8; RowMajorStrg = FALSE;
      cblas_dtpsv(CblasColMajor, CblasUpper, CblasNoTrans,
                  CblasNonUnit, 0, A, X, 0 );
      chkxer();
      cblas_info = 2; RowMajorStrg = TRUE;
      cblas_dtpsv(CblasRowMajor, INVALID, CblasNoTrans,
                  CblasNonUnit, 0, A, X, 1 );
      chkxer();
      cblas_info = 3; RowMajorStrg = TRUE;
      cblas_dtpsv(CblasRowMajor, CblasUpper, INVALID,
                  CblasNonUnit, 0, A, X, 1 );
      chkxer();
      cblas_info = 4; RowMajorStrg = TRUE;
      cblas_dtpsv(CblasRowMajor, CblasUpper, CblasNoTrans,
                  INVALID, 0, A, X, 1 );
      chkxer();
      cblas_info = 5; RowMajorStrg = TRUE;
      cblas_dtpsv(CblasRowMajor, CblasUpper, CblasNoTrans,
                  CblasNonUnit, INVALID, A, X, 1 );
      chkxer();
      cblas_info = 8; RowMajorStrg = TRUE;
      cblas_dtpsv(CblasRowMajor, CblasUpper, CblasNoTrans,
                  CblasNonUnit, 0, A, X, 0 );
      chkxer();
   } else if (strncmp( sf,"cblas_dger",10)==0) {
      cblas_rout = "cblas_dger";
      cblas_info = 1; RowMajorStrg = FALSE;
      cblas_dger(INVALID, 0, 0, ALPHA, X, 1, Y, 1, A, 1 );
      chkxer();
      cblas_info = 2; RowMajorStrg = FALSE;
      cblas_dger(CblasColMajor, INVALID, 0, ALPHA, X, 1, Y, 1, A, 1 );
      chkxer();
      cblas_info = 3; RowMajorStrg = FALSE;
      cblas_dger(CblasColMajor, 0, INVALID, ALPHA, X, 1, Y, 1, A, 1 );
      chkxer();
      cblas_info = 6; RowMajorStrg = FALSE;
      cblas_dger(CblasColMajor, 0, 0, ALPHA, X, 0, Y, 1, A, 1 );
      chkxer();
      cblas_info = 8; RowMajorStrg = FALSE;
      cblas_dger(CblasColMajor, 0, 0, ALPHA, X, 1, Y, 0, A, 1 );
      chkxer();
      cblas_info = 10; RowMajorStrg = FALSE;
      cblas_dger(CblasColMajor, 2, 0, ALPHA, X, 1, Y, 1, A, 1 );
      chkxer();
      cblas_info = 2; RowMajorStrg = TRUE;
      cblas_dger(CblasRowMajor, INVALID, 0, ALPHA, X, 1, Y, 1, A, 1 );
      chkxer();
      cblas_info = 3; RowMajorStrg = TRUE;
      cblas_dger(CblasRowMajor, 0, INVALID, ALPHA, X, 1, Y, 1, A, 1 );
      chkxer();
      cblas_info = 6; RowMajorStrg = TRUE;
      cblas_dger(CblasRowMajor, 0, 0, ALPHA, X, 0, Y, 1, A, 1 );
      chkxer();
      cblas_info = 8; RowMajorStrg = TRUE;
      cblas_dger(CblasRowMajor, 0, 0, ALPHA, X, 1, Y, 0, A, 1 );
      chkxer();
      cblas_info = 10; RowMajorStrg = TRUE;
      cblas_dger(CblasRowMajor, 0, 2, ALPHA, X, 1, Y, 1, A, 1 );
      chkxer();
   } else if (strncmp( sf,"cblas_dsyr2",11)==0) {
      cblas_rout = "cblas_dsyr2";
      cblas_info = 1; RowMajorStrg = FALSE;
      cblas_dsyr2(INVALID, CblasUpper, 0, ALPHA, X, 1, Y, 1, A, 1 );
      chkxer();
      cblas_info = 2; RowMajorStrg = FALSE;
      cblas_dsyr2(CblasColMajor, INVALID, 0, ALPHA, X, 1, Y, 1, A, 1 );
      chkxer();
      cblas_info = 3; RowMajorStrg = FALSE;
      cblas_dsyr2(CblasColMajor, CblasUpper, INVALID, ALPHA, X, 1, Y, 1, A, 1 );
      chkxer();
      cblas_info = 6; RowMajorStrg = FALSE;
      cblas_dsyr2(CblasColMajor, CblasUpper, 0, ALPHA, X, 0, Y, 1, A, 1 );
      chkxer();
      cblas_info = 8; RowMajorStrg = FALSE;
      cblas_dsyr2(CblasColMajor, CblasUpper, 0, ALPHA, X, 1, Y, 0, A, 1 );
      chkxer();
      cblas_info = 10; RowMajorStrg = FALSE;
      cblas_dsyr2(CblasColMajor, CblasUpper, 2, ALPHA, X, 1, Y, 1, A, 1 );
      chkxer();
      cblas_info = 2; RowMajorStrg = TRUE;
      cblas_dsyr2(CblasRowMajor, INVALID, 0, ALPHA, X, 1, Y, 1, A, 1 );
      chkxer();
      cblas_info = 3; RowMajorStrg = TRUE;
      cblas_dsyr2(CblasRowMajor, CblasUpper, INVALID, ALPHA, X, 1, Y, 1, A, 1 );
      chkxer();
      cblas_info = 6; RowMajorStrg = TRUE;
      cblas_dsyr2(CblasRowMajor, CblasUpper, 0, ALPHA, X, 0, Y, 1, A, 1 );
      chkxer();
      cblas_info = 8; RowMajorStrg = TRUE;
      cblas_dsyr2(CblasRowMajor, CblasUpper, 0, ALPHA, X, 1, Y, 0, A, 1 );
      chkxer();
      cblas_info = 10; RowMajorStrg = TRUE;
      cblas_dsyr2(CblasRowMajor, CblasUpper, 2, ALPHA, X, 1, Y, 1, A, 1 );
      chkxer();
   } else if (strncmp( sf,"cblas_dspr2",11)==0) {
      cblas_rout = "cblas_dspr2";
      cblas_info = 1; RowMajorStrg = FALSE;
      cblas_dspr2(INVALID, CblasUpper, 0, ALPHA, X, 1, Y, 1, A );
      chkxer();
      cblas_info = 2; RowMajorStrg = FALSE;
      cblas_dspr2(CblasColMajor, INVALID, 0, ALPHA, X, 1, Y, 1, A );
      chkxer();
      cblas_info = 3; RowMajorStrg = FALSE;
      cblas_dspr2(CblasColMajor, CblasUpper, INVALID, ALPHA, X, 1, Y, 1, A );
      chkxer();
      cblas_info = 6; RowMajorStrg = FALSE;
      cblas_dspr2(CblasColMajor, CblasUpper, 0, ALPHA, X, 0, Y, 1, A );
      chkxer();
      cblas_info = 8; RowMajorStrg = FALSE;
      cblas_dspr2(CblasColMajor, CblasUpper, 0, ALPHA, X, 1, Y, 0, A );
      chkxer();
      cblas_info = 2; RowMajorStrg = TRUE;
      cblas_dspr2(CblasRowMajor, INVALID, 0, ALPHA, X, 1, Y, 1, A );
      chkxer();
      cblas_info = 3; RowMajorStrg = TRUE;
      cblas_dspr2(CblasRowMajor, CblasUpper, INVALID, ALPHA, X, 1, Y, 1, A );
      chkxer();
      cblas_info = 6; RowMajorStrg = TRUE;
      cblas_dspr2(CblasRowMajor, CblasUpper, 0, ALPHA, X, 0, Y, 1, A );
      chkxer();
      cblas_info = 8; RowMajorStrg = TRUE;
      cblas_dspr2(CblasRowMajor, CblasUpper, 0, ALPHA, X, 1, Y, 0, A );
      chkxer();
   } else if (strncmp( sf,"cblas_dsyr",10)==0) {
      cblas_rout = "cblas_dsyr";
      cblas_info = 1; RowMajorStrg = FALSE;
      cblas_dsyr(INVALID, CblasUpper, 0, ALPHA, X, 1, A, 1 );
      chkxer();
      cblas_info = 2; RowMajorStrg = FALSE;
      cblas_dsyr(CblasColMajor, INVALID, 0, ALPHA, X, 1, A, 1 );
      chkxer();
      cblas_info = 3; RowMajorStrg = FALSE;
      cblas_dsyr(CblasColMajor, CblasUpper, INVALID, ALPHA, X, 1, A, 1 );
      chkxer();
      cblas_info = 6; RowMajorStrg = FALSE;
      cblas_dsyr(CblasColMajor, CblasUpper, 0, ALPHA, X, 0, A, 1 );
      chkxer();
      cblas_info = 8; RowMajorStrg = FALSE;
      cblas_dsyr(CblasColMajor, CblasUpper, 2, ALPHA, X, 1, A, 1 );
      chkxer();
      cblas_info = 2; RowMajorStrg = TRUE;
      cblas_dsyr(CblasRowMajor, INVALID, 0, ALPHA, X, 1, A, 1 );
      chkxer();
      cblas_info = 3; RowMajorStrg = TRUE;
      cblas_dsyr(CblasRowMajor, CblasUpper, INVALID, ALPHA, X, 1, A, 1 );
      chkxer();
      cblas_info = 6; RowMajorStrg = TRUE;
      cblas_dsyr(CblasRowMajor, CblasUpper, 0, ALPHA, X, 0, A, 1 );
      chkxer();
      cblas_info = 8; RowMajorStrg = TRUE;
      cblas_dsyr(CblasRowMajor, CblasUpper, 2, ALPHA, X, 1, A, 1 );
      chkxer();
   } else if (strncmp( sf,"cblas_dspr",10)==0) {
      cblas_rout = "cblas_dspr";
      cblas_info = 1; RowMajorStrg = FALSE;
      cblas_dspr(INVALID, CblasUpper, 0, ALPHA, X, 1, A );
      chkxer();
      cblas_info = 2; RowMajorStrg = FALSE;
      cblas_dspr(CblasColMajor, INVALID, 0, ALPHA, X, 1, A );
      chkxer();
      cblas_info = 3; RowMajorStrg = FALSE;
      cblas_dspr(CblasColMajor, CblasUpper, INVALID, ALPHA, X, 1, A );
      chkxer();
      cblas_info = 6; RowMajorStrg = FALSE;
      cblas_dspr(CblasColMajor, CblasUpper, 0, ALPHA, X, 0, A );
      chkxer();
      cblas_info = 2; RowMajorStrg = FALSE;
      cblas_dspr(CblasColMajor, INVALID, 0, ALPHA, X, 1, A );
      chkxer();
      cblas_info = 3; RowMajorStrg = FALSE;
      cblas_dspr(CblasColMajor, CblasUpper, INVALID, ALPHA, X, 1, A );
      chkxer();
      cblas_info = 6; RowMajorStrg = FALSE;
      cblas_dspr(CblasColMajor, CblasUpper, 0, ALPHA, X, 0, A );
      chkxer();
   }
   if (cblas_ok == TRUE)
       printf(" %-12s PASSED THE TESTS OF ERROR-EXITS\n", cblas_rout);
   else
       printf("******* %s FAILED THE TESTS OF ERROR-EXITS *******\n",cblas_rout);
}
Exemple #6
0
/** Create bulge
 *
 * Creates the bulge structure for matrix M. Create the bulge with as many shifts as
 * possible.
 *
 * Returns the number of chasing steps needed to chase the bulge or -1 on error.
 */
int form_bulge(struct bulge_info *bi, const size_t order, double *M, const size_t nshifts,
               double *shifts, const enum chase_direction direction) {
	size_t bulge_size, bulge_position, householder_stride, shiftidx, r, c;
	double house[(nshifts + 2) * (nshifts + 2 + 1)/2];
	short M_data_stride_sign;

	/* populate bulge_info structure now so it can serve as a useful "return
	 * value" */
	bi->order = order;
	bi->M = M;
	bi->nshifts = nshifts;
	bi->shifts = shifts;
	bi->nshifts_applied = 0;
	bi->steps_chased = 0;
	bi->direction = direction;

	/* apply as many shifts as we can to "build the bulge" */
	for (shiftidx = 0; (shiftidx < nshifts) && (shiftidx <= order - 1); shiftidx++) {
		bulge_size = shiftidx + 2;

		switch (direction) {
		case CHASE_FORWARD:

			/* build up house by pulling out v from top to bottom */
			bulge_position = 0;
			householder_stride = order;
			M_data_stride_sign = 1;

			/* indicate location of vector to build Householder matrix from */
			r = 0;
			c = 0;
			break;

		case CHASE_BACKWARD:

			/* build up house by pulling out v from right to left (the vector gets
			 * read backwards--i.e. ending at M[r,c] but starting further along
			 * in the matrix--when the stride is negative) */
			bulge_position = order - bulge_size;
			householder_stride = -1;
			M_data_stride_sign = -1;

			/* indicate location of vector to build Householder matrix from */
			r = order - 1;
			c = order - 2 - shiftidx;
			break;

		default:
			return FORM_BULGE_ERROR;
		}

		create_house_matrix_packed(bulge_size, shifts[shiftidx],
			&M[c + r*order], householder_stride, house);

		/* use house to process each small col and row which intersects with the bulge zone */
		r = bulge_position;
		for (c = 0; c < order; c++) { /* small cols */
			cblas_dspmv(CblasRowMajor, CblasUpper, bulge_size, -2.0, house,
				&M[c + r*order], M_data_stride_sign*order,
				1.0,
				&M[c + r*order], M_data_stride_sign*order);
		}

		c = bulge_position;
		for (r = 0; r < order; r++) { /* small rows */
			cblas_dspmv(CblasRowMajor, CblasUpper, bulge_size, -2.0, house,
				&M[c + r*order], M_data_stride_sign*1,
				1.0,
				&M[c + r*order], M_data_stride_sign*1);
		}

		/* OPTIMIZATION: we can unroll the first few hits to the above loops
		 * into a level 3 BLAS operation */

		/* in case we don't complete all shifts for some reason... */
		bi->nshifts_applied = shiftidx + 1;
	}

	return (order - 2); /* number of shifts needed to eradicate the bulge */
}
Exemple #7
0
/** Incrementally chase bulge
 *
 * returns number of steps left to do
 */
int chase_bulge_step(struct bulge_info *bi) {
	size_t bulge_size, bulge_position, householder_stride;
	short M_data_stride_sign;
	size_t r, c;
	
	/* stop now if we've already chased the bulge off the matrix */
	int steps_remaining = bi->order - 2 - bi->steps_chased;
	if (steps_remaining <= 0) {
		return 0;
	}

	/* calculate bulge_size at this step (shrinks near end of chase) */
	bulge_size = bi->nshifts_applied + 2;
	if (bulge_size + bi->steps_chased > bi->order) {
		bulge_size = bi->order - bi->steps_chased;
	}

	/* build Householder matrix house */
	double house[bulge_size * (bulge_size + 1)/2];

	switch (bi->direction) {
	case CHASE_FORWARD:
		bulge_position = bi->steps_chased;
		householder_stride = bi->order;
		M_data_stride_sign = 1;

		/* indicate location of vector to build Householder matrix from */
		r = bulge_position + 1;
		c = bulge_position;
		break;
	case CHASE_BACKWARD:
		bulge_position = bi->order - bulge_size - bi->steps_chased;
		householder_stride = -1;
		M_data_stride_sign = -1;

		/* indicate location of vector to build Householder matrix from */
		r = bulge_position + bulge_size - 1;
		c = bulge_position + bulge_size - 1 - bulge_size + 1;
		break;
	}

	create_house_matrix_packed(bulge_size - 1, 0.0, &bi->M[c + r*bi->order], householder_stride, house);

	/* use house to process each small col and row which intersects with the bulge zone */
	switch (bi->direction) {
	case CHASE_FORWARD:  r = bulge_position + 1; break;
	case CHASE_BACKWARD: r = bulge_position; break;
	}
	for (c = 0; c < bi->order; c++) { /* small cols */
		cblas_dspmv(CblasRowMajor, CblasUpper, bulge_size - 1, -2.0, house,
			&bi->M[c + r*bi->order], M_data_stride_sign*bi->order,
			1.0,
			&bi->M[c + r*bi->order], M_data_stride_sign*bi->order);
	}

	switch (bi->direction) {
	case CHASE_FORWARD:  c = bulge_position + 1; break;
	case CHASE_BACKWARD: c = bulge_position; break;
	}
	for (r = 0; r < bi->order; r++) { /* small rows */
		cblas_dspmv(CblasRowMajor, CblasUpper, bulge_size - 1, -2.0, house,
			&bi->M[c + r*bi->order], M_data_stride_sign*1,
			1.0,
			&bi->M[c + r*bi->order], M_data_stride_sign*1);
	}

	/* keep an accurate count */
	bi->steps_chased++;
	steps_remaining--;

	return steps_remaining;
}
Exemple #8
0
void
test_spmv (void) {
const double flteps = 1e-4, dbleps = 1e-6;
  {
   int order = 101;
   int uplo = 121;
   float alpha = 0.1f;
   float beta = -0.3f;
   int N = 2;
   float A[] = { -0.174f, 0.878f, 0.478f };
   float X[] = { 0.503f, 0.313f };
   int incX = -1;
   float Y[] = { -0.565f, -0.109f };
   int incY = -1;
   float y_expected[] = { 0.221025f, 0.0714172f };
   cblas_sspmv(order, uplo, N, alpha, A, X, incX, beta, Y, incY);
   {
     int i;
     for (i = 0; i < 2; i++) {
       gsl_test_rel(Y[i], y_expected[i], flteps, "sspmv(case 1134)");
     }
   };
  };


  {
   int order = 101;
   int uplo = 121;
   float alpha = 0.1f;
   float beta = -0.3f;
   int N = 2;
   float A[] = { -0.174f, 0.878f, 0.478f };
   float X[] = { 0.503f, 0.313f };
   int incX = -1;
   float Y[] = { -0.565f, -0.109f };
   int incY = -1;
   float y_expected[] = { 0.221025f, 0.0714172f };
   cblas_sspmv(order, uplo, N, alpha, A, X, incX, beta, Y, incY);
   {
     int i;
     for (i = 0; i < 2; i++) {
       gsl_test_rel(Y[i], y_expected[i], flteps, "sspmv(case 1135)");
     }
   };
  };


  {
   int order = 101;
   int uplo = 122;
   float alpha = 0.1f;
   float beta = -0.3f;
   int N = 2;
   float A[] = { -0.174f, 0.878f, 0.478f };
   float X[] = { 0.503f, 0.313f };
   int incX = -1;
   float Y[] = { -0.565f, -0.109f };
   int incY = -1;
   float y_expected[] = { 0.221025f, 0.0714172f };
   cblas_sspmv(order, uplo, N, alpha, A, X, incX, beta, Y, incY);
   {
     int i;
     for (i = 0; i < 2; i++) {
       gsl_test_rel(Y[i], y_expected[i], flteps, "sspmv(case 1136)");
     }
   };
  };


  {
   int order = 101;
   int uplo = 122;
   float alpha = 0.1f;
   float beta = -0.3f;
   int N = 2;
   float A[] = { -0.174f, 0.878f, 0.478f };
   float X[] = { 0.503f, 0.313f };
   int incX = -1;
   float Y[] = { -0.565f, -0.109f };
   int incY = -1;
   float y_expected[] = { 0.221025f, 0.0714172f };
   cblas_sspmv(order, uplo, N, alpha, A, X, incX, beta, Y, incY);
   {
     int i;
     for (i = 0; i < 2; i++) {
       gsl_test_rel(Y[i], y_expected[i], flteps, "sspmv(case 1137)");
     }
   };
  };


  {
   int order = 102;
   int uplo = 121;
   float alpha = 0.1f;
   float beta = -0.3f;
   int N = 2;
   float A[] = { -0.174f, 0.878f, 0.478f };
   float X[] = { 0.503f, 0.313f };
   int incX = -1;
   float Y[] = { -0.565f, -0.109f };
   int incY = -1;
   float y_expected[] = { 0.221025f, 0.0714172f };
   cblas_sspmv(order, uplo, N, alpha, A, X, incX, beta, Y, incY);
   {
     int i;
     for (i = 0; i < 2; i++) {
       gsl_test_rel(Y[i], y_expected[i], flteps, "sspmv(case 1138)");
     }
   };
  };


  {
   int order = 102;
   int uplo = 121;
   float alpha = 0.1f;
   float beta = -0.3f;
   int N = 2;
   float A[] = { -0.174f, 0.878f, 0.478f };
   float X[] = { 0.503f, 0.313f };
   int incX = -1;
   float Y[] = { -0.565f, -0.109f };
   int incY = -1;
   float y_expected[] = { 0.221025f, 0.0714172f };
   cblas_sspmv(order, uplo, N, alpha, A, X, incX, beta, Y, incY);
   {
     int i;
     for (i = 0; i < 2; i++) {
       gsl_test_rel(Y[i], y_expected[i], flteps, "sspmv(case 1139)");
     }
   };
  };


  {
   int order = 102;
   int uplo = 122;
   float alpha = 0.1f;
   float beta = -0.3f;
   int N = 2;
   float A[] = { -0.174f, 0.878f, 0.478f };
   float X[] = { 0.503f, 0.313f };
   int incX = -1;
   float Y[] = { -0.565f, -0.109f };
   int incY = -1;
   float y_expected[] = { 0.221025f, 0.0714172f };
   cblas_sspmv(order, uplo, N, alpha, A, X, incX, beta, Y, incY);
   {
     int i;
     for (i = 0; i < 2; i++) {
       gsl_test_rel(Y[i], y_expected[i], flteps, "sspmv(case 1140)");
     }
   };
  };


  {
   int order = 102;
   int uplo = 122;
   float alpha = 0.1f;
   float beta = -0.3f;
   int N = 2;
   float A[] = { -0.174f, 0.878f, 0.478f };
   float X[] = { 0.503f, 0.313f };
   int incX = -1;
   float Y[] = { -0.565f, -0.109f };
   int incY = -1;
   float y_expected[] = { 0.221025f, 0.0714172f };
   cblas_sspmv(order, uplo, N, alpha, A, X, incX, beta, Y, incY);
   {
     int i;
     for (i = 0; i < 2; i++) {
       gsl_test_rel(Y[i], y_expected[i], flteps, "sspmv(case 1141)");
     }
   };
  };


  {
   int order = 101;
   int uplo = 121;
   double alpha = -1;
   double beta = 0.1;
   int N = 2;
   double A[] = { -0.181, -0.071, -0.038 };
   double X[] = { -0.015, 0.132 };
   int incX = -1;
   double Y[] = { -0.449, -0.219 };
   int incY = -1;
   double y_expected[] = { -0.036098, 9.27e-04 };
   cblas_dspmv(order, uplo, N, alpha, A, X, incX, beta, Y, incY);
   {
     int i;
     for (i = 0; i < 2; i++) {
       gsl_test_rel(Y[i], y_expected[i], dbleps, "dspmv(case 1142)");
     }
   };
  };


  {
   int order = 101;
   int uplo = 121;
   double alpha = -1;
   double beta = 0.1;
   int N = 2;
   double A[] = { -0.181, -0.071, -0.038 };
   double X[] = { -0.015, 0.132 };
   int incX = -1;
   double Y[] = { -0.449, -0.219 };
   int incY = -1;
   double y_expected[] = { -0.036098, 9.27e-04 };
   cblas_dspmv(order, uplo, N, alpha, A, X, incX, beta, Y, incY);
   {
     int i;
     for (i = 0; i < 2; i++) {
       gsl_test_rel(Y[i], y_expected[i], dbleps, "dspmv(case 1143)");
     }
   };
  };


  {
   int order = 101;
   int uplo = 122;
   double alpha = -1;
   double beta = 0.1;
   int N = 2;
   double A[] = { -0.181, -0.071, -0.038 };
   double X[] = { -0.015, 0.132 };
   int incX = -1;
   double Y[] = { -0.449, -0.219 };
   int incY = -1;
   double y_expected[] = { -0.036098, 9.27e-04 };
   cblas_dspmv(order, uplo, N, alpha, A, X, incX, beta, Y, incY);
   {
     int i;
     for (i = 0; i < 2; i++) {
       gsl_test_rel(Y[i], y_expected[i], dbleps, "dspmv(case 1144)");
     }
   };
  };


  {
   int order = 101;
   int uplo = 122;
   double alpha = -1;
   double beta = 0.1;
   int N = 2;
   double A[] = { -0.181, -0.071, -0.038 };
   double X[] = { -0.015, 0.132 };
   int incX = -1;
   double Y[] = { -0.449, -0.219 };
   int incY = -1;
   double y_expected[] = { -0.036098, 9.27e-04 };
   cblas_dspmv(order, uplo, N, alpha, A, X, incX, beta, Y, incY);
   {
     int i;
     for (i = 0; i < 2; i++) {
       gsl_test_rel(Y[i], y_expected[i], dbleps, "dspmv(case 1145)");
     }
   };
  };


  {
   int order = 102;
   int uplo = 121;
   double alpha = -1;
   double beta = 0.1;
   int N = 2;
   double A[] = { -0.181, -0.071, -0.038 };
   double X[] = { -0.015, 0.132 };
   int incX = -1;
   double Y[] = { -0.449, -0.219 };
   int incY = -1;
   double y_expected[] = { -0.036098, 9.27e-04 };
   cblas_dspmv(order, uplo, N, alpha, A, X, incX, beta, Y, incY);
   {
     int i;
     for (i = 0; i < 2; i++) {
       gsl_test_rel(Y[i], y_expected[i], dbleps, "dspmv(case 1146)");
     }
   };
  };


  {
   int order = 102;
   int uplo = 121;
   double alpha = -1;
   double beta = 0.1;
   int N = 2;
   double A[] = { -0.181, -0.071, -0.038 };
   double X[] = { -0.015, 0.132 };
   int incX = -1;
   double Y[] = { -0.449, -0.219 };
   int incY = -1;
   double y_expected[] = { -0.036098, 9.27e-04 };
   cblas_dspmv(order, uplo, N, alpha, A, X, incX, beta, Y, incY);
   {
     int i;
     for (i = 0; i < 2; i++) {
       gsl_test_rel(Y[i], y_expected[i], dbleps, "dspmv(case 1147)");
     }
   };
  };


  {
   int order = 102;
   int uplo = 122;
   double alpha = -1;
   double beta = 0.1;
   int N = 2;
   double A[] = { -0.181, -0.071, -0.038 };
   double X[] = { -0.015, 0.132 };
   int incX = -1;
   double Y[] = { -0.449, -0.219 };
   int incY = -1;
   double y_expected[] = { -0.036098, 9.27e-04 };
   cblas_dspmv(order, uplo, N, alpha, A, X, incX, beta, Y, incY);
   {
     int i;
     for (i = 0; i < 2; i++) {
       gsl_test_rel(Y[i], y_expected[i], dbleps, "dspmv(case 1148)");
     }
   };
  };


  {
   int order = 102;
   int uplo = 122;
   double alpha = -1;
   double beta = 0.1;
   int N = 2;
   double A[] = { -0.181, -0.071, -0.038 };
   double X[] = { -0.015, 0.132 };
   int incX = -1;
   double Y[] = { -0.449, -0.219 };
   int incY = -1;
   double y_expected[] = { -0.036098, 9.27e-04 };
   cblas_dspmv(order, uplo, N, alpha, A, X, incX, beta, Y, incY);
   {
     int i;
     for (i = 0; i < 2; i++) {
       gsl_test_rel(Y[i], y_expected[i], dbleps, "dspmv(case 1149)");
     }
   };
  };


}