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 ); }
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; }
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; }