Пример #1
0
inline std::ptrdiff_t getrs( Order, const Trans, const int n, const int nrhs,
        const double* a, const int lda, const int* ipiv, double* b,
        const int ldb ) {
    return clapack_dgetrs
   ( clapack_option< Order >::value, clapack_option< Trans >::value, n, nrhs,
           a, lda, ipiv, b, ldb );
}
Пример #2
0
int test_lapack(int n)
{
  int* ipiv;
  int info;
  int i, j;
  double * m, *x, *y;
  
  int LDB,LDA, N, NRHS;
  char transp = 'N';
 
  
  m=(double*)malloc(sizeof(double)*n*n);
  x=(double*)malloc(sizeof(double)*n);
  y=(double*)malloc(sizeof(double)*n);
  ipiv=(int*)malloc(sizeof(int)*n);
 
  for (i=0; i<n; ++i) {
    x[i]=1.0;
    for (j=0; j<n; ++j) {
      m[i*n+j]=(rand()%100+1)/10.0;
      //      printf("m[%d,%d]=%lf\n",i,j, m[i*n+j]); 
    }
  }
 
  /* test cblas.h */
  //cblas_dgemv(CblasColMajor, CblasNoTrans, n, n, 1.0, m, n,
  //	      x, 1, 0.0, y, 1);
 
  //  for (i=0; i<n; ++i)  printf("x[%d]=%lf\n",i, x[i]); 
  //for (i=0; i<n; ++i)  printf("y[%d]=%lf\n",i, y[i]); 
 
	LDB=n;
	LDA=n;
	N=n;
	NRHS=1;
	info=clapack_dgetrf ( CblasColMajor,n,n,m,n,ipiv );
	
if (info != 0) fprintf(stderr, "dgetrf failure with error %d\n", info);
 
  clapack_dgetrs ( CblasColMajor,CblasNoTrans,n,1,m,n,ipiv,y,n);
  
  if (info != 0) fprintf(stderr, "failure with error %d\n", info);
  //  for (i=0; i<n; ++i) printf("%lf\n", y[i]);

  free(m);
  free(x);
  free(y);
  free(ipiv);
  return 0;
}
Пример #3
0
int utpm_solve(int P, int D, int N, int NRHS, int *ipiv, double *A, int *Astrides,
                  double *B, int *Bstrides){
    /*
    Solves the linear system op(A) X = B in Taylor arithmetic,
    
    where op(A) = A or op(A) = A**T
    
    A (N,N) matrix.
    B (N,NRHS) matrix
    
    This is a modification of the API of dgesv.f: added possiblity enum CBLAS_TRANSPOSE TransA
    to the function argument list.Compare to http://www.netlib.org/lapack/double/dgesv.f.
    
    The solution is computed by:
    1) clapack_dgetrf (see http://www.netlib.org/lapack/double/dgetrf.f)
    2) clapack_dgetrs (see http://www.netlib.org/lapack/double/dgetrs.f)

    */
    
    int d,p,k;
    int dstrideA, dstrideB, pstrideA, pstrideB;
    double *Ad, *Bd;
    double *Ap, *Bp;
    
    int lda, ldb, TransA, TransB;
    int Order;
    
    /* prepare stuff for the lapack call */
    Order = CblasColMajor;
    get_leadim_and_cblas_transpose(N, N, Astrides, &lda, &TransA);
    get_leadim_and_cblas_transpose(N, NRHS, Bstrides, &ldb, &TransB);
    
    /* compute d = 0 */
    /* first A = P L U, i.e. LU with partial pivoting */
    
    clapack_dgetrf(Order, N, N, A, lda, ipiv);
    clapack_dgetrs(Order, TransA, N, NRHS, A, lda, ipiv, B, ldb);
    /* clapack_dgesv(Order, N, NRHS, A, lda, ipiv, B, ldb); */
    
    /* compute higher order coefficients d > 0 */
    dstrideA = lda*N; dstrideB = ldb*NRHS;
    pstrideA = dstrideA*(D-1); pstrideB = dstrideB*(D-1);
    
    for( p = 0; p < P; ++p){
        Ap = A + p*pstrideA;
        Bp = B + p*pstrideB;
        for( d = 1; d < D; ++d){
            /* compute B_d - \sum_{k=1}^d A_k B_{d-k} */
            for(k=1; k < d; ++k){
                Ad = Ap + k * dstrideA;
                Bd = Bp + (d-k) * dstrideB;
                /* FIXME: why the hell is now ldb = NRHS??? */
                cblas_dgemm(Order, TransA, CblasNoTrans, N, NRHS,
                     N, -1., Ad, lda, Bd, ldb, 1., Bp + d*dstrideB, ldb);
            }
            
            /* compute the last loop element, i.e. k = d */
            Ad = Ap + d*dstrideA;   Bd = Bp + d*dstrideB;
            
            cblas_dgemm(Order, TransA, CblasNoTrans, N, NRHS,
                 N, -1., Ad, lda, B, ldb, 1., Bd, ldb);
            
            /* compute solve(A_0,  B_d - \sum_{k=1}^d A_k B_{d-k}
               where A_0 is LU factorized already            */
            clapack_dgetrs(Order, TransA, N, NRHS, A, lda, ipiv, Bd, ldb);
        }
    }
    return 0;
}