Esempio n. 1
0
 inline 
 void ger (CBLAS_ORDER const Order, int const M, int const N,
           double const alpha, double const* X, int const incX,
           double const* Y, int const incY, double* A, int const lda)
 {
   cblas_dger (Order, M, N, alpha, X, incX, Y, incY, A, lda); 
 }
Esempio n. 2
0
void get_class(crbm *m, double *h, double *py, int batch_size){
    int i;
    double sum;

    cblas_dgemm(CblasRowMajor, CblasNoTrans, CblasNoTrans,
                batch_size, m->ncat, m->nhidden,
                1.0, h, m->nhidden, m->u, m->ncat,
                0, py, m->ncat);

    cblas_dger(CblasRowMajor, batch_size, m->ncat, 1,
               I, 1, m->by, 1, py, m->ncat);

    for(i = 0; i < batch_size * m->ncat; i++){
        py[i] = exp(py[i]);
    }

    //sum
    cblas_dgemm(CblasRowMajor, CblasNoTrans, CblasNoTrans,
                batch_size, 1, m->ncat,
                1, py, m->ncat, I, 1,
                0, a, 1);

    for(i = 0; i < batch_size; i++){
        cblas_dscal(m->ncat, 1.0 / a[i], py + i * m->ncat, 1);
        //printf("sum:%.2lf\n", cblas_dasum(m->ncat, py + i * m->ncat, 1));
    }
}
Esempio n. 3
0
/// Deadzone Damped Pseudoinverse
void aa_la_dzdpinv( size_t m, size_t n, double s2_min, const double *A, double *A_star ) {
    // A^T (AA^T + kI)^{-1}
    // A is m*n
    // x = Aq, x is m, q is n

    const int mi = (int)m;
    const int ni = (int)n;

    // This method uses the SVD
    double *W = (double*)aa_mem_region_local_alloc( sizeof(double) *
                                                (m*m + n*n + AA_MIN(m,n)) );
    double *U = W;        // size m*m
    double *Vt = U + m*m; // size n*n
    double *S = Vt + n*n; // size min(m,n)

    // A = U S V^T
    aa_la_svd(m,n,A,U,S,Vt);

    memset( A_star, 0, sizeof(double)*m*n );
    // \sum s_i/(s_i**2+k) * v_i * u_i^T
    for( size_t i = 0; i < AA_MIN(m,n); i ++ ) {
        double s2 = AA_MAX( (S[i]*S[i]), s2_min );
        cblas_dger( CblasColMajor, ni, mi, S[i] / s2,
                Vt + i, ni,
                U + m*i, 1,
                A_star, ni
                );
    }
    aa_mem_region_local_pop( W );
}
Esempio n. 4
0
void THBlas_(ger)(long m, long n, real alpha, real *x, long incx, real *y, long incy, real *a, long lda)
{
  if(n == 1)
    lda = m;

#if defined(USE_BLAS) && (defined(TH_REAL_IS_DOUBLE) || defined(TH_REAL_IS_FLOAT))
  if( (m <= INT_MAX) && (n <= INT_MAX) && (lda <= INT_MAX)  && (incx <= INT_MAX) && (incy <= INT_MAX) )
  {
    int i_m = (int)m;
    int i_n = (int)n;
    int i_lda = (int)lda;
    int i_incx = (int)incx;
    int i_incy = (int)incy;

#if defined(TH_REAL_IS_DOUBLE)
    cblas_dger(CblasColMajor, i_m, i_n, alpha, x, i_incx, y, i_incy, a, i_lda);
#else
    cblas_sger(CblasColMajor, i_m, i_n, alpha, x, i_incx, y, i_incy, a, i_lda);
#endif
    return;
  }
#endif
  {
    long i, j;
    for(j = 0; j < n; j++)
    {
      real *column_ = a+j*lda;
      real z = alpha*y[j*incy];
      for(i = 0; i < m; i++)
        column_[i] += z*x[i*incx] ;
    }
  }
}
Esempio n. 5
0
static inline void compute_gemm_blas2(CMDOptions * options,  double * C, double * A, double * B)
{
	for(int i = 0;i < options->k; ++i) {
		cblas_dger(CblasRowMajor, options->m, options->n, 1.0, &A[i], options->k, &B[i*options->n],
					1, C, options->n);
	}
}
Esempio n. 6
0
void THBlas_outerProduct(long nRow, long nColumn, real alpha, real *x, long xStride, real *y, long yStride, real *m, long mStride)
{
  if(nColumn == 1)
    mStride = nRow;

#if USE_CBLAS
  if( (nRow < INT_MAX) && (nColumn < INT_MAX) && (mStride < INT_MAX)  && (xStride < INT_MAX) && (yStride < INT_MAX) )
  {
#ifdef USE_DOUBLE
    cblas_dger(CblasColMajor, nRow, nColumn, alpha, x, xStride, y, yStride, m, mStride);
#else
    cblas_sger(CblasColMajor, nRow, nColumn, alpha, x, xStride, y, yStride, m, mStride);
#endif
    return;
  }
#endif
  {
    long r, c;
    for(c = 0; c < nColumn; c++)
    {
      real *column_ = m+c*mStride;
      real z = alpha*y[c*yStride];
      for(r = 0; r < nRow; r++)
        column_[r] += z*x[r*xStride] ;
    }
  }
}
Esempio n. 7
0
void blas2_inner_product(double *A, double *B, double *C, int m, int k, int n) {
    //http://www.cs.utexas.edu/users/flame/pubs/SUMMA2d3dTOMS.pdf
    //https://software.intel.com/en-us/node/520751#94156EDE-4ADD-4830-940E-1CA5688ABE88

	for (int row = 0; row < k; ++row) {
		cblas_dger(CblasColMajor, m, n, 1, &(A[row*m]), 1, &(B[row]), k, C, m);
	}

}
Esempio n. 8
0
 /*
  * Class:     com_intel_analytics_bigdl_mkl_MKL
  * Method:    vdger
  * Signature: (I[DII[DII)V
  */
JNIEXPORT void JNICALL Java_com_intel_analytics_bigdl_mkl_MKL_vdger
   (JNIEnv * env, jclass cls, jint m, jint n, jdouble alpha, jdoubleArray x, jint xOffset,
   jint incx, jdoubleArray y, jint yOffset, jint incy, jdoubleArray a, jint aOffset, jint lda) {

   jdouble * jni_x = (*env)->GetPrimitiveArrayCritical(env, x, JNI_FALSE);
   jdouble * jni_y = (*env)->GetPrimitiveArrayCritical(env, y, JNI_FALSE);
   jdouble * jni_a = (*env)->GetPrimitiveArrayCritical(env, a, JNI_FALSE);

   cblas_dger(CblasColMajor, m, n, alpha, jni_x + xOffset, incx, jni_y + yOffset, incy, jni_a + aOffset, lda);

   (*env)->ReleasePrimitiveArrayCritical(env, a, jni_a, 0);
   (*env)->ReleasePrimitiveArrayCritical(env, y, jni_y, 0);
   (*env)->ReleasePrimitiveArrayCritical(env, x, jni_x, 0);
}
JNIEXPORT void JNICALL Java_uncomplicate_neanderthal_CBLAS_dger
(JNIEnv *env, jclass clazz,
 jint Order,
 jint M, jint N,
 jdouble alpha,
 jobject X, jint offsetX, jint incX,
 jobject Y, jint offsetY, jint incY,
 jobject A, jint offsetA, jint lda) {

    double *cX = (double *) (*env)->GetDirectBufferAddress(env, X);
    double *cY = (double *) (*env)->GetDirectBufferAddress(env, Y);
    double *cA = (double *) (*env)->GetDirectBufferAddress(env, A);
    cblas_dger(Order, M, N, alpha, cX + offsetX, incX, cY + offsetY, incY, cA + offsetA, lda);
};
Esempio n. 10
0
void get_visible(crbm *m, double *h, double *pv, int batch_size){
    int i;

    cblas_dgemm(CblasRowMajor, CblasNoTrans, CblasNoTrans,
                batch_size, m->nvisible, m->nhidden,
                1.0, h, m->nhidden, m->w, m->nvisible,
                0, pv, m->nvisible);

    cblas_dger(CblasRowMajor, batch_size, m->nvisible, 1,
               I, 1, m->bv, 1, pv, m->nvisible);

    for(i = 0; i < batch_size * m->nvisible; i++){
        pv[i] = sigmoid(pv[i]); 
    }
}
Esempio n. 11
0
void F77_dger(int *order, int *m, int *n, double *alpha, double *x, int *incx,
	     double *y, int *incy, double *a, int *lda ) {

  double *A;
  int i,j,LDA;

  if (*order == TEST_ROW_MJR) {
     LDA = *n+1;
     A   = ( double* )malloc( (*m)*LDA*sizeof( double ) );

     for( i=0; i<*m; i++ ) {
       for( j=0; j<*n; j++ )
         A[ LDA*i+j ]=a[ (*lda)*j+i ];
     }

     cblas_dger(CblasRowMajor, *m, *n, *alpha, x, *incx, y, *incy, A, LDA );
     for( i=0; i<*m; i++ )
       for( j=0; j<*n; j++ )
         a[ (*lda)*j+i ]=A[ LDA*i+j ];
     free(A);
  }
  else
     cblas_dger( CblasColMajor, *m, *n, *alpha, x, *incx, y, *incy, a, *lda );
}
Esempio n. 12
0
void EncoderLayer::getHFromX(double *x, double *h, int size){
    cblas_dgemm(CblasRowMajor, CblasNoTrans, CblasNoTrans,
                size, numOut, numIn,
                1, x, numIn, w, numOut,
                0, h, numOut);

    cblas_dger(CblasRowMajor, size, numOut,
               1.0, I(), 1, b, 1, h, numOut);

    if(binOut){
        for(int i = 0; i < size * numOut; i++){
            h[i] = sigmoid(h[i]);
        }
    }
}
Esempio n. 13
0
void EncoderLayer::getYFromH(double *h, double *y, int size){
    cblas_dgemm(CblasRowMajor, CblasNoTrans, CblasTrans,
                size, numIn, numOut,
                1, h, numOut, w, numOut,
                0, y, numIn);

    cblas_dger(CblasRowMajor, size, numIn,
               1.0, I(), 1, c, 1, y, numIn);

    if(binIn){
        for(int i = 0; i < size * numIn; i++){
            y[i] = sigmoid(y[i]);
        }
    }
}
Esempio n. 14
0
void get_reconstruct_input(const da *m, const double *x,
                           double *y, const int batch_size){
    int i;

    cblas_dgemm(CblasRowMajor, CblasNoTrans, CblasNoTrans,
                batch_size, m->n_in, m->n_out,
                1, x, m->n_out, m->W, m->n_in,
                0, y, m->n_in);

    cblas_dger(CblasColMajor, batch_size, m->n_in,
               1.0, m->c, 1, Ivec, 1, y, m->n_in);

    /* TODO */
    for(i = 0; i < batch_size*m->n_in; i++){
        y[i] = sigmoid(y[i]);
    }
}
Esempio n. 15
0
void test_dger2()
{
    const size_t m=35, n=45;
    double a[m*n];
    double b[m*n];
    double x[m];
    double y[n];
    size_t i;
    for(i=0; i<m*n; i++) b[i]=a[i]=i;
    for(i=0; i<m; i++) x[i]=i+m*n;
    for(i=0; i<n; i++) y[i]=i*i;
    my_dger(CblasRowMajor,m,n,2.0,x,1,y,1,a,n);
    cblas_dger(CblasRowMajor,m,n,2.0,x,1,y,1,b,n);
    for(i=0; i<m*n; i++){
	assert(a[i]==b[i]);
    }
}
Esempio n. 16
0
void test_dger()
{
    const size_t m=3, n=4;
    double a[3*4]={
	1,2,3,4,
	5,6,7,8,
	9,10,11,12
    };
    double b[3*4];
    double x[3]={2,3,4};
    double y[4]={7,6,4,5};
    size_t i;
    for(i=0; i<m*n; i++) b[i]=a[i];
    my_dger(CblasRowMajor,m,n,2.0,x,1,y,1,a,n);
    cblas_dger(CblasRowMajor,m,n,2.0,x,1,y,1,b,n);
    for(i=0; i<m*n; i++){
	assert(a[i]==b[i]);
    }
}
Esempio n. 17
0
void get_hidden(crbm *m, double *v, double *y, double *ph, int batch_size){
    int i;

    cblas_dgemm(CblasRowMajor, CblasNoTrans, CblasTrans,
                batch_size, m->nhidden, m->nvisible,
                1, v, m->nvisible, m->w, m->nvisible,
                0, ph, m->nhidden);

    cblas_dgemm(CblasRowMajor, CblasNoTrans, CblasTrans,
                batch_size, m->nhidden, m->ncat,
                1, y, m->ncat, m->u, m->ncat,
                1, ph, m->nhidden);

    cblas_dger(CblasRowMajor, batch_size, m->nhidden, 1,
               I, 1, m->bh, 1, ph, m->nhidden);

    for(i = 0; i < batch_size * m->nhidden; i++){
        ph[i] = sigmoid(ph[i]); 
    }
}
Esempio n. 18
0
// computes means of the rows of A, subtracts them from A, and returns them in meanVec on the root process
// assumes memory has already been allocated for meanVec
void computeAndSubtractRowMeans(double *localRowChunk, double *meanVec, distMatrixInfo *matInfo) {
    int mpi_rank = matInfo->mpi_rank;
    int numcols = matInfo->numcols;
    int localrows = matInfo->localrows;
    int * rowcounts = matInfo->rowcounts;
    int * rowoffsets = matInfo->rowoffsets;
    MPI_Comm *comm = matInfo->comm;

    double *onesVec = (double *) malloc( numcols * sizeof(double));
    double *localMeanVec = (double *) malloc( localrows * sizeof(double));

    for(int idx = 0; idx < numcols; idx = idx + 1) {
        onesVec[idx]=1;
    }
    cblas_dgemv(CblasRowMajor, CblasNoTrans, localrows, numcols, 1.0/((double)numcols), localRowChunk, numcols, onesVec, 1, 0, localMeanVec, 1);
    cblas_dger(CblasRowMajor, localrows, numcols, -1.0, localMeanVec, 1, onesVec, 1, localRowChunk, numcols);
    if (mpi_rank != 0) {
        MPI_Gatherv(localMeanVec, localrows, MPI_DOUBLE, NULL, NULL, NULL, MPI_DOUBLE, 0, *comm);
    } else {
        MPI_Gatherv(localMeanVec, localrows, MPI_DOUBLE, meanVec, rowcounts, rowoffsets, MPI_DOUBLE, 0, *comm);
    }
    free(onesVec);
    free(localMeanVec);
}
Esempio n. 19
0
void
test_ger (void) {
const double flteps = 1e-4, dbleps = 1e-6;
  {
   int order = 101;
   int M = 1;
   int N = 1;
   int lda = 1;
   float alpha = 1.0f;
   float A[] = { -0.515f };
   float X[] = { 0.611f };
   int incX = -1;
   float Y[] = { -0.082f };
   int incY = -1;
   float A_expected[] = { -0.565102f };
   cblas_sger(order, M, N, alpha, X, incX, Y, incY, A, lda);
   {
     int i;
     for (i = 0; i < 1; i++) {
       gsl_test_rel(A[i], A_expected[i], flteps, "sger(case 1390)");
     }
   };
  };


  {
   int order = 102;
   int M = 1;
   int N = 1;
   int lda = 1;
   float alpha = 1.0f;
   float A[] = { -0.515f };
   float X[] = { 0.611f };
   int incX = -1;
   float Y[] = { -0.082f };
   int incY = -1;
   float A_expected[] = { -0.565102f };
   cblas_sger(order, M, N, alpha, X, incX, Y, incY, A, lda);
   {
     int i;
     for (i = 0; i < 1; i++) {
       gsl_test_rel(A[i], A_expected[i], flteps, "sger(case 1391)");
     }
   };
  };


  {
   int order = 101;
   int M = 1;
   int N = 1;
   int lda = 1;
   double alpha = 1;
   double A[] = { -0.809 };
   double X[] = { -0.652 };
   int incX = -1;
   double Y[] = { 0.712 };
   int incY = -1;
   double A_expected[] = { -1.273224 };
   cblas_dger(order, M, N, alpha, X, incX, Y, incY, A, lda);
   {
     int i;
     for (i = 0; i < 1; i++) {
       gsl_test_rel(A[i], A_expected[i], dbleps, "dger(case 1392)");
     }
   };
  };


  {
   int order = 102;
   int M = 1;
   int N = 1;
   int lda = 1;
   double alpha = 1;
   double A[] = { -0.809 };
   double X[] = { -0.652 };
   int incX = -1;
   double Y[] = { 0.712 };
   int incY = -1;
   double A_expected[] = { -1.273224 };
   cblas_dger(order, M, N, alpha, X, incX, Y, incY, A, lda);
   {
     int i;
     for (i = 0; i < 1; i++) {
       gsl_test_rel(A[i], A_expected[i], dbleps, "dger(case 1393)");
     }
   };
  };


  {
   int order = 101;
   int M = 1;
   int N = 1;
   int lda = 1;
   float alpha[2] = {0.0f, 0.0f};
   float A[] = { -0.651f, 0.856f };
   float X[] = { -0.38f, -0.235f };
   int incX = -1;
   float Y[] = { -0.627f, 0.757f };
   int incY = -1;
   float A_expected[] = { -0.651f, 0.856f };
   cblas_cgeru(order, M, N, alpha, X, incX, Y, incY, A, lda);
   {
     int i;
     for (i = 0; i < 1; i++) {
       gsl_test_rel(A[2*i], A_expected[2*i], flteps, "cgeru(case 1394) real");
       gsl_test_rel(A[2*i+1], A_expected[2*i+1], flteps, "cgeru(case 1394) imag");
     };
   };
  };


  {
   int order = 101;
   int M = 1;
   int N = 1;
   int lda = 1;
   float alpha[2] = {0.0f, 0.0f};
   float A[] = { -0.651f, 0.856f };
   float X[] = { -0.38f, -0.235f };
   int incX = -1;
   float Y[] = { -0.627f, 0.757f };
   int incY = -1;
   float A_expected[] = { -0.651f, 0.856f };
   cblas_cgerc(order, M, N, alpha, X, incX, Y, incY, A, lda);
   {
     int i;
     for (i = 0; i < 1; i++) {
       gsl_test_rel(A[2*i], A_expected[2*i], flteps, "cgerc(case 1395) real");
       gsl_test_rel(A[2*i+1], A_expected[2*i+1], flteps, "cgerc(case 1395) imag");
     };
   };
  };


  {
   int order = 102;
   int M = 1;
   int N = 1;
   int lda = 1;
   float alpha[2] = {0.0f, 0.0f};
   float A[] = { -0.651f, 0.856f };
   float X[] = { -0.38f, -0.235f };
   int incX = -1;
   float Y[] = { -0.627f, 0.757f };
   int incY = -1;
   float A_expected[] = { -0.651f, 0.856f };
   cblas_cgeru(order, M, N, alpha, X, incX, Y, incY, A, lda);
   {
     int i;
     for (i = 0; i < 1; i++) {
       gsl_test_rel(A[2*i], A_expected[2*i], flteps, "cgeru(case 1396) real");
       gsl_test_rel(A[2*i+1], A_expected[2*i+1], flteps, "cgeru(case 1396) imag");
     };
   };
  };


  {
   int order = 102;
   int M = 1;
   int N = 1;
   int lda = 1;
   float alpha[2] = {0.0f, 0.0f};
   float A[] = { -0.651f, 0.856f };
   float X[] = { -0.38f, -0.235f };
   int incX = -1;
   float Y[] = { -0.627f, 0.757f };
   int incY = -1;
   float A_expected[] = { -0.651f, 0.856f };
   cblas_cgerc(order, M, N, alpha, X, incX, Y, incY, A, lda);
   {
     int i;
     for (i = 0; i < 1; i++) {
       gsl_test_rel(A[2*i], A_expected[2*i], flteps, "cgerc(case 1397) real");
       gsl_test_rel(A[2*i+1], A_expected[2*i+1], flteps, "cgerc(case 1397) imag");
     };
   };
  };


  {
   int order = 101;
   int M = 1;
   int N = 1;
   int lda = 1;
   double alpha[2] = {-1, 0};
   double A[] = { -0.426, 0.757 };
   double X[] = { -0.579, -0.155 };
   int incX = -1;
   double Y[] = { 0.831, 0.035 };
   int incY = -1;
   double A_expected[] = { 0.049724, 0.90607 };
   cblas_zgeru(order, M, N, alpha, X, incX, Y, incY, A, lda);
   {
     int i;
     for (i = 0; i < 1; i++) {
       gsl_test_rel(A[2*i], A_expected[2*i], dbleps, "zgeru(case 1398) real");
       gsl_test_rel(A[2*i+1], A_expected[2*i+1], dbleps, "zgeru(case 1398) imag");
     };
   };
  };


  {
   int order = 101;
   int M = 1;
   int N = 1;
   int lda = 1;
   double alpha[2] = {-1, 0};
   double A[] = { -0.426, 0.757 };
   double X[] = { -0.579, -0.155 };
   int incX = -1;
   double Y[] = { 0.831, 0.035 };
   int incY = -1;
   double A_expected[] = { 0.060574, 0.86554 };
   cblas_zgerc(order, M, N, alpha, X, incX, Y, incY, A, lda);
   {
     int i;
     for (i = 0; i < 1; i++) {
       gsl_test_rel(A[2*i], A_expected[2*i], dbleps, "zgerc(case 1399) real");
       gsl_test_rel(A[2*i+1], A_expected[2*i+1], dbleps, "zgerc(case 1399) imag");
     };
   };
  };


  {
   int order = 102;
   int M = 1;
   int N = 1;
   int lda = 1;
   double alpha[2] = {-1, 0};
   double A[] = { -0.426, 0.757 };
   double X[] = { -0.579, -0.155 };
   int incX = -1;
   double Y[] = { 0.831, 0.035 };
   int incY = -1;
   double A_expected[] = { 0.049724, 0.90607 };
   cblas_zgeru(order, M, N, alpha, X, incX, Y, incY, A, lda);
   {
     int i;
     for (i = 0; i < 1; i++) {
       gsl_test_rel(A[2*i], A_expected[2*i], dbleps, "zgeru(case 1400) real");
       gsl_test_rel(A[2*i+1], A_expected[2*i+1], dbleps, "zgeru(case 1400) imag");
     };
   };
  };


  {
   int order = 102;
   int M = 1;
   int N = 1;
   int lda = 1;
   double alpha[2] = {-1, 0};
   double A[] = { -0.426, 0.757 };
   double X[] = { -0.579, -0.155 };
   int incX = -1;
   double Y[] = { 0.831, 0.035 };
   int incY = -1;
   double A_expected[] = { 0.060574, 0.86554 };
   cblas_zgerc(order, M, N, alpha, X, incX, Y, incY, A, lda);
   {
     int i;
     for (i = 0; i < 1; i++) {
       gsl_test_rel(A[2*i], A_expected[2*i], dbleps, "zgerc(case 1401) real");
       gsl_test_rel(A[2*i+1], A_expected[2*i+1], dbleps, "zgerc(case 1401) imag");
     };
   };
  };


}
Esempio n. 20
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);
}
void My_dger(double alpha, const gsl_vector * x, const gsl_vector * y, gsl_matrix * A)
{
	cblas_dger(CblasRowMajor, A->size1, A->size2, alpha, x->data, x->stride, y->data, y->stride, A->data, A->tda);
}
Esempio n. 22
0
inline void blas_ger(size_t n1, size_t n2, double alpha, double* a, double* b, double* c) {
    cblas_dger(CblasRowMajor, n1, n2, alpha, a, 1, b, 1, c, n2);
}
// Update inverse a1 after column in matrix a has changed
// get new column out of array1 newCol
//
// a1= old inverse
// newCol = new column lCol in the new matrix a_new
// returns Det(a_old)/Det(a_new)
doublevar InverseUpdateColumn(Array2 <doublevar> & a1, const Array1 <doublevar> & newCol,
                              const int lCol, const int n)
{
  Array1 <doublevar> & tmpColL(tmp11);
  tmpColL.Resize(n);
  Array1 <doublevar> & prod(tmp12);
  prod.Resize(n);

  doublevar f=0.0;

#ifdef USE_BLAS
  int a1size=a1.GetDim(1);

  doublevar * a1col=a1.v+lCol*a1size;

  f=cblas_ddot(n,a1col, 1, newCol.v, 1);
  f=-1.0/f;

  cblas_dcopy(n,a1col,1,tmpColL.v,1);
  
  cblas_dgemv(CblasRowMajor,CblasNoTrans,n,n,
              1.0,a1.v,a1size,
              newCol.v,1,
              0.0,prod.v,1);

  cblas_dscal(n,f,prod.v,1);

  cblas_dger(CblasRowMajor, n,n,1.0,
             prod.v,1,
             tmpColL.v,1,
             a1.v,a1size);
  f=-f;
  cblas_dcopy(n,tmpColL.v,1,a1col,1);
  cblas_dscal(n,f,a1col,1);

#else 

  for(int i=0;i<n;++i)
  {
    f += a1(lCol,i)*newCol[i];
  }
  f =-1.0/f;

  for(int j=0;j<n;++j)
  {
    tmpColL[j]=a1(lCol,j);
    prod[j]   =0.0;
    for(int i=0;i<n;++i)
    {
      prod[j] += a1(j,i)*newCol[i];
    }
    prod[j] *= f;
  }

  for(int i=0;i<n;++i)
  {
    doublevar & p(prod[i]);
    for(int j=0;j<n;++j)
    {
      a1(i,j) += tmpColL[j]*p;
    }
  }

  f = -f;
  for(int j=0;j<n;++j)
  {
    a1(lCol,j) = f*tmpColL[j];
  }

#endif

  return f;
}
Esempio n. 24
0
void dgetf2( long m, long n, double a[], long lda, long ipiv[], long *info )
{
  /**
   *  -- LAPACK routine (version 1.1) --
   *     Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
   *     Courant Institute, Argonne National Lab, and Rice University
   *     June 30, 1992
   *
   *     .. Scalar Arguments ..*/
  /**     ..
   *     .. Array Arguments ..*/
#undef ipiv_1
#define ipiv_1(a1) ipiv[a1-1]
#undef a_2
#define a_2(a1,a2) a[a1-1+lda*(a2-1)]
  /**     ..
   *
   *  Purpose
   *  =======
   *
   *  DGETF2 computes an LU factorization of a general m-by-n matrix A
   *  using partial pivoting with row interchanges.
   *
   *  The factorization has the form
   *     A = P * L * U
   *  where P is a permutation matrix, L is lower triangular with unit
   *  diagonal elements (lower trapezoidal if m > n), and U is upper
   *  triangular (upper trapezoidal if m < n).
   *
   *  This is the right-looking Level 2 BLAS version of the algorithm.
   *
   *  Arguments
   *  =========
   *
   *  M       (input) INTEGER
   *          The number of rows of the matrix A.  M >= 0.
   *
   *  N       (input) INTEGER
   *          The number of columns of the matrix A.  N >= 0.
   *
   *  A       (input/output) DOUBLE PRECISION array, dimension (LDA,N)
   *          On entry, the m by n matrix to be factored.
   *          On exit, the factors L and U from the factorization
   *          A = P*L*U; the unit diagonal elements of L are not stored.
   *
   *  LDA     (input) INTEGER
   *          The leading dimension of the array A.  LDA >= max(1,M).
   *
   *  IPIV    (output) INTEGER array, dimension (min(M,N))
   *          The pivot indices; for 1 <= i <= min(M,N), row i of the
   *          matrix was interchanged with row IPIV(i).
   *
   *  INFO    (output) INTEGER
   *          = 0: successful exit
   *          < 0: if INFO = -k, the k-th argument had an illegal value
   *          > 0: if INFO = k, U(k,k) is exactly zero. The factorization
   *               has been completed, but the factor U is exactly
   *               singular, and division by zero will occur if it is used
   *               to solve a system of equations.
   *
   *  =====================================================================
   *
   *     .. Parameters ..*/
#undef one
#define one 1.0e+0
#undef zero
#define zero 0.0e+0
  /**     ..
   *     .. Local Scalars ..*/
  long            j, jp;
  /**     ..
   *     .. Intrinsic Functions ..*/
  /*      intrinsic          max, min;*/
  /**     ..
   *     .. Executable Statements ..
   *
   *     Test the input parameters.
   **/
  /*-----implicit-declarations-----*/
  /*-----end-of-declarations-----*/
  *info = 0;
  if( m<0 ) {
    *info = -1;
  } else if( n<0 ) {
    *info = -2;
  } else if( lda<max( 1, m ) ) {
    *info = -4;
  }
  if( *info!=0 ) {
    xerbla( "dgetf2", -*info );
    return;
  }
  /**
   *     Quick return if possible
   **/
  if( m==0 || n==0 )
    return;

  for (j=1 ; j<=min( m, n ) ; j+=1) {
    /**
     *        Find pivot and test for singularity.
     **/
    jp = j + cblas_idamax( m-j+1, &a_2( j, j ), 1 );
    ipiv_1( j ) = jp;
    if( a_2( jp, j )!=zero ) {
      /**
       *           Apply the interchange to columns 1:N.
       **/
      if( jp!=j )
        cblas_dswap( n, &a_2( j, 1 ), lda, &a_2( jp, 1 ), lda );
      /**
       *           Compute elements J+1:M of J-th column.
       **/
      if( j<m )
        cblas_dscal( m-j, one / a_2( j, j ), &a_2( j+1, j ), 1 );

    } else if( *info==0 ) {

      *info = j;
    }

    if( j<min( m, n ) ) {
      /**
       *           Update trailing submatrix.
       **/
      cblas_dger(CblasColMajor, m-j, n-j, -one, &a_2( j+1, j ), 1,
                 &a_2( j, j+1 ), lda, &a_2( j+1, j+1 ), lda );
    }
  }
  return;
  /**
   *     End of DGETF2
   **/
}
void STARPU_DGER(const int m, const int n, const double alpha,
                  const double *x, const int incx, const double *y,
                  const int incy, double *A, const int lda)
{
	cblas_dger(CblasColMajor, m, n, alpha, x, incx, y, incy, A, lda);
}
Esempio n. 26
0
int CORE_dtstrf(int M, int N, int IB, int NB,
                double *U, int LDU,
                double *A, int LDA,
                double *L, int LDL,
                int *IPIV,
                double *WORK, int LDWORK,
                int *INFO)
{
    static double zzero = 0.0;
    static double mzone =-1.0;

    double alpha;
    int i, j, ii, sb;
    int im, ip;

    /* Check input arguments */
    *INFO = 0;
    if (M < 0) {
        coreblas_error(1, "Illegal value of M");
        return -1;
    }
    if (N < 0) {
        coreblas_error(2, "Illegal value of N");
        return -2;
    }
    if (IB < 0) {
        coreblas_error(3, "Illegal value of IB");
        return -3;
    }
    if ((LDU < max(1,NB)) && (NB > 0)) {
        coreblas_error(6, "Illegal value of LDU");
        return -6;
    }
    if ((LDA < max(1,M)) && (M > 0)) {
        coreblas_error(8, "Illegal value of LDA");
        return -8;
    }
    if ((LDL < max(1,IB)) && (IB > 0)) {
        coreblas_error(10, "Illegal value of LDL");
        return -10;
    }

    /* Quick return */
    if ((M == 0) || (N == 0) || (IB == 0))
        return PLASMA_SUCCESS;

    /* Set L to 0 */
    memset(L, 0, LDL*N*sizeof(double));

    ip = 0;
    for (ii = 0; ii < N; ii += IB) {
        sb = min(N-ii, IB);

        for (i = 0; i < sb; i++) {
            im = cblas_idamax(M, &A[LDA*(ii+i)], 1);
            IPIV[ip] = ii+i+1;

            if (fabs(A[LDA*(ii+i)+im]) > fabs(U[LDU*(ii+i)+ii+i])) {
                /*
                 * Swap behind.
                 */
                cblas_dswap(i, &L[LDL*ii+i], LDL, &WORK[im], LDWORK );
                /*
                 * Swap ahead.
                 */
                cblas_dswap(sb-i, &U[LDU*(ii+i)+ii+i], LDU, &A[LDA*(ii+i)+im], LDA );
                /*
                 * Set IPIV.
                 */
                IPIV[ip] = NB + im + 1;

                for (j = 0; j < i; j++) {
                    A[LDA*(ii+j)+im] = zzero;
                }
            }

            if ((*INFO == 0) && (fabs(A[LDA*(ii+i)+im]) == zzero)
                && (fabs(U[LDU*(ii+i)+ii+i]) == zzero)) {
                *INFO = ii+i+1;
            }

            alpha = ((double)1. / U[LDU*(ii+i)+ii+i]);
            cblas_dscal(M, (alpha), &A[LDA*(ii+i)], 1);
            cblas_dcopy(M, &A[LDA*(ii+i)], 1, &WORK[LDWORK*i], 1);
            cblas_dger(
                CblasColMajor, M, sb-i-1,
                (mzone), &A[LDA*(ii+i)], 1,
                &U[LDU*(ii+i+1)+ii+i], LDU,
                &A[LDA*(ii+i+1)], LDA );
            ip = ip+1;
        }
        /*
         * Apply the subpanel to the rest of the panel.
         */
        if(ii+i < N) {
            for(j = ii; j < ii+sb; j++) {
                if (IPIV[j] <= NB) {
                    IPIV[j] = IPIV[j] - ii;
                }
            }

            CORE_dssssm(
                NB, N-(ii+sb), M, N-(ii+sb), sb, sb,
                &U[LDU*(ii+sb)+ii], LDU,
                &A[LDA*(ii+sb)], LDA,
                &L[LDL*ii], LDL,
                WORK, LDWORK, &IPIV[ii]);

            for(j = ii; j < ii+sb; j++) {
                if (IPIV[j] <= NB) {
                    IPIV[j] = IPIV[j] + ii;
                }
            }
        }
    }
    return PLASMA_SUCCESS;
}
Esempio n. 27
0
void HPL_dger
(
   const enum HPL_ORDER             ORDER,
   const int                        M,
   const int                        N,
   const double                     ALPHA,
   const double *                   X,
   const int                        INCX,
   double *                         Y,
   const int                        INCY,
   double *                         A,
   const int                        LDA
)
{
/* 
 * Purpose
 * =======
 *
 * HPL_dger performs the rank 1 operation
 *  
 *     A := alpha * x * y^T + A,
 *  
 * where alpha is a scalar,  x is an m-element vector, y is an n-element
 * vector and A is an m by n matrix.
 *
 * Arguments
 * =========
 *
 * ORDER   (local input)                 const enum HPL_ORDER
 *         On entry, ORDER  specifies the storage format of the operands
 *         as follows:                                                  
 *            ORDER = HplRowMajor,                                      
 *            ORDER = HplColumnMajor.                                   
 *
 * M       (local input)                 const int
 *         On entry,  M  specifies  the number of rows of  the matrix A.
 *         M must be at least zero.
 *
 * N       (local input)                 const int
 *         On entry, N  specifies the number of columns of the matrix A.
 *         N must be at least zero.
 *
 * ALPHA   (local input)                 const double
 *         On entry, ALPHA specifies the scalar alpha.   When  ALPHA  is
 *         supplied as zero then  X and Y  need not be set on input.
 *
 * X       (local input)                 const double *
 *         On entry,  X  is an incremented array of dimension  at  least
 *         ( 1 + ( m - 1 ) * abs( INCX ) )  that  contains the vector x.
 *
 * INCX    (local input)                 const int
 *         On entry, INCX specifies the increment for the elements of X.
 *         INCX must not be zero.
 *
 * Y       (local input)                 double *
 *         On entry,  Y  is an incremented array of dimension  at  least
 *         ( 1 + ( n - 1 ) * abs( INCY ) )  that  contains the vector y.
 *
 * INCY    (local input)                 const int
 *         On entry, INCY specifies the increment for the elements of Y.
 *         INCY must not be zero.
 *
 * A       (local input/output)          double *
 *         On entry,  A  points  to an array of size equal to or greater
 *         than LDA * n.  Before  entry, the leading m by n part  of the
 *         array  A  must contain the matrix coefficients. On exit, A is
 *         overwritten by the updated matrix.
 *
 * LDA     (local input)                 const int
 *         On entry,  LDA  specifies  the  leading  dimension  of  A  as
 *         declared  in  the  calling  (sub) program.  LDA  must  be  at
 *         least MAX(1,m).
 *
 * ---------------------------------------------------------------------
 */ 
START_TRACE( DGER )

   cblas_dger( ORDER, M, N, ALPHA, X, INCX, Y, INCY, A, LDA );

END_TRACE
/*
 * End of HPL_dger
 */
}