本文整理汇总了C++中dlange_函数的典型用法代码示例。如果您正苦于以下问题：C++ dlange_函数的具体用法？C++ dlange_怎么用？C++ dlange_使用的例子？那么恭喜您, 这里精选的函数代码示例或许可以为您提供帮助。
在下文中一共展示了dlange_函数的20个代码示例，这些例子默认根据受欢迎程度排序。您可以为喜欢或者感觉有用的代码点赞，您的评价将有助于我们的系统推荐出更棒的C++代码示例。
示例1: invert_matrix_checked
int32_t invert_matrix_checked(__CLPK_integer dim, double* matrix, MATRIX_INVERT_BUF1_TYPE* int_1d_buf, double* dbl_2d_buf) {
// This used to fall back on PLINK 1.07's SVD-based implementation when the
// rcond estimate was too small, but in practice that just slowed things down
// without meaningfully improving inversion of nonsingular matrices. So now
// this just exits a bit earlier, while leaving the old "binary search for
// the first row/column causing multicollinearity" logic to the caller.
__CLPK_integer lwork = dim * dim;
char cc = '1';
double norm = dlange_(&cc, &dim, &dim, matrix, &dim, dbl_2d_buf);
__CLPK_integer info;
double rcond;
dgetrf_(&dim, &dim, matrix, &dim, int_1d_buf, &info);
if (info > 0) {
return 1;
}
dgecon_(&cc, &dim, matrix, &dim, &norm, &rcond, dbl_2d_buf, &(int_1d_buf[dim]), &info);
if (rcond < MATRIX_SINGULAR_RCOND) {
return 1;
}
dgetri_(&dim, matrix, &dim, int_1d_buf, dbl_2d_buf, &lwork, &info);
return 0;
}
开发者ID:chrchang，项目名称:plink-ng，代码行数:22，代码来源:plink_matrix.c
示例2: dtzt01_
doublereal dtzt01_(integer *m, integer *n, doublereal *a, doublereal *af,
integer *lda, doublereal *tau, doublereal *work, integer *lwork)
{
/* System generated locals */
integer a_dim1, a_offset, af_dim1, af_offset, i__1, i__2;
doublereal ret_val;
/* Local variables */
integer i__, j;
doublereal norma;
extern /* Subroutine */ int daxpy_(integer *, doublereal *, doublereal *,
integer *, doublereal *, integer *);
doublereal rwork[1];
extern doublereal dlamch_(char *), dlange_(char *, integer *,
integer *, doublereal *, integer *, doublereal *);
extern /* Subroutine */ int dlaset_(char *, integer *, integer *,
doublereal *, doublereal *, doublereal *, integer *),
xerbla_(char *, integer *), dlatzm_(char *, integer *,
integer *, doublereal *, integer *, doublereal *, doublereal *,
doublereal *, integer *, doublereal *);
/* -- LAPACK test routine (version 3.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* .. Array Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* DTZT01 returns */
/* || A - R*Q || / ( M * eps * ||A|| ) */
/* for an upper trapezoidal A that was factored with DTZRQF. */
/* Arguments */
/* ========= */
/* M (input) INTEGER */
/* The number of rows of the matrices A and AF. */
/* N (input) INTEGER */
/* The number of columns of the matrices A and AF. */
/* A (input) DOUBLE PRECISION array, dimension (LDA,N) */
/* The original upper trapezoidal M by N matrix A. */
/* AF (input) DOUBLE PRECISION array, dimension (LDA,N) */
/* The output of DTZRQF for input matrix A. */
/* The lower triangle is not referenced. */
/* LDA (input) INTEGER */
/* The leading dimension of the arrays A and AF. */
/* TAU (input) DOUBLE PRECISION array, dimension (M) */
/* Details of the Householder transformations as returned by */
/* DTZRQF. */
/* WORK (workspace) DOUBLE PRECISION array, dimension (LWORK) */
/* LWORK (input) INTEGER */
/* The length of the array WORK. LWORK >= m*n + m. */
/* ===================================================================== */
/* .. Parameters .. */
/* .. */
/* .. Local Scalars .. */
/* .. */
/* .. Local Arrays .. */
/* .. */
/* .. External Functions .. */
/* .. */
/* .. External Subroutines .. */
/* .. */
/* .. Intrinsic Functions .. */
/* .. */
/* .. Executable Statements .. */
/* Parameter adjustments */
af_dim1 = *lda;
af_offset = 1 + af_dim1;
af -= af_offset;
a_dim1 = *lda;
a_offset = 1 + a_dim1;
a -= a_offset;
--tau;
--work;
/* Function Body */
ret_val = 0.;
if (*lwork < *m * *n + *m) {
xerbla_("DTZT01", &c__8);
return ret_val;
}
//.........这里部分代码省略.........
开发者ID:kstraube，项目名称:hysim，代码行数:101，代码来源:dtzt01.c
示例3: ddot_
/* Subroutine */ int dlaqtr_(logical *ltran, logical *lreal, integer *n,
doublereal *t, integer *ldt, doublereal *b, doublereal *w, doublereal
*scale, doublereal *x, doublereal *work, integer *info)
{
/* System generated locals */
integer t_dim1, t_offset, i__1, i__2;
doublereal d__1, d__2, d__3, d__4, d__5, d__6;
/* Local variables */
doublereal d__[4] /* was [2][2] */;
integer i__, j, k;
doublereal v[4] /* was [2][2] */, z__;
integer j1, j2, n1, n2;
doublereal si, xj, sr, rec, eps, tjj, tmp;
extern doublereal ddot_(integer *, doublereal *, integer *, doublereal *,
integer *);
integer ierr;
doublereal smin, xmax;
extern /* Subroutine */ int dscal_(integer *, doublereal *, doublereal *,
integer *);
extern doublereal dasum_(integer *, doublereal *, integer *);
extern /* Subroutine */ int daxpy_(integer *, doublereal *, doublereal *,
integer *, doublereal *, integer *);
integer jnext;
doublereal sminw, xnorm;
extern /* Subroutine */ int dlaln2_(logical *, integer *, integer *,
doublereal *, doublereal *, doublereal *, integer *, doublereal *,
doublereal *, doublereal *, integer *, doublereal *, doublereal *
, doublereal *, integer *, doublereal *, doublereal *, integer *);
extern doublereal dlamch_(char *), dlange_(char *, integer *,
integer *, doublereal *, integer *, doublereal *);
extern integer idamax_(integer *, doublereal *, integer *);
doublereal scaloc;
extern /* Subroutine */ int dladiv_(doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *);
doublereal bignum;
logical notran;
doublereal smlnum;
/* -- LAPACK auxiliary routine (version 3.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* .. Array Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* DLAQTR solves the real quasi-triangular system */
/* op(T)*p = scale*c, if LREAL = .TRUE. */
/* or the complex quasi-triangular systems */
/* op(T + iB)*(p+iq) = scale*(c+id), if LREAL = .FALSE. */
/* in real arithmetic, where T is upper quasi-triangular. */
/* If LREAL = .FALSE., then the first diagonal block of T must be */
/* 1 by 1, B is the specially structured matrix */
/* B = [ b(1) b(2) ... b(n) ] */
/* [ w ] */
/* [ w ] */
/* [ . ] */
/* [ w ] */
/* op(A) = A or A', A' denotes the conjugate transpose of */
/* matrix A. */
/* On input, X = [ c ]. On output, X = [ p ]. */
/* [ d ] [ q ] */
/* This subroutine is designed for the condition number estimation */
/* in routine DTRSNA. */
/* Arguments */
/* ========= */
/* LTRAN (input) LOGICAL */
/* On entry, LTRAN specifies the option of conjugate transpose: */
/* = .FALSE., op(T+i*B) = T+i*B, */
/* = .TRUE., op(T+i*B) = (T+i*B)'. */
/* LREAL (input) LOGICAL */
/* On entry, LREAL specifies the input matrix structure: */
/* = .FALSE., the input is complex */
/* = .TRUE., the input is real */
/* N (input) INTEGER */
/* On entry, N specifies the order of T+i*B. N >= 0. */
/* T (input) DOUBLE PRECISION array, dimension (LDT,N) */
/* On entry, T contains a matrix in Schur canonical form. */
/* If LREAL = .FALSE., then the first diagonal block of T mu */
/* be 1 by 1. */
//.........这里部分代码省略.........
开发者ID:Ayato-Harashima，项目名称:Bundler，代码行数:101，代码来源:dlaqtr.c
示例4: if
//.........这里部分代码省略.........
/* Computing MAX */
i__1 = max(nb1,nb2);
nb = max(i__1,nb3);
/* Computing MAX */
i__1 = *n * 6, i__2 = *n * (nb + 1);
lopt = (*n << 1) + max(i__1,i__2);
work[1] = (doublereal) lopt;
}
if (*info != 0) {
i__1 = -(*info);
xerbla_("DGEGV ", &i__1);
return 0;
} else if (lquery) {
return 0;
}
/* Quick return if possible */
if (*n == 0) {
return 0;
}
/* Get machine constants */
eps = dlamch_("E") * dlamch_("B");
safmin = dlamch_("S");
safmin += safmin;
safmax = 1. / safmin;
onepls = eps * 4 + 1.;
/* Scale A */
anrm = dlange_("M", n, n, &a[a_offset], lda, &work[1]);
anrm1 = anrm;
anrm2 = 1.;
if (anrm < 1.) {
if (safmax * anrm < 1.) {
anrm1 = safmin;
anrm2 = safmax * anrm;
}
}
if (anrm > 0.) {
dlascl_("G", &c_n1, &c_n1, &anrm, &c_b27, n, n, &a[a_offset], lda, &
iinfo);
if (iinfo != 0) {
*info = *n + 10;
return 0;
}
}
/* Scale B */
bnrm = dlange_("M", n, n, &b[b_offset], ldb, &work[1]);
bnrm1 = bnrm;
bnrm2 = 1.;
if (bnrm < 1.) {
if (safmax * bnrm < 1.) {
bnrm1 = safmin;
bnrm2 = safmax * bnrm;
}
}
if (bnrm > 0.) {
dlascl_("G", &c_n1, &c_n1, &bnrm, &c_b27, n, n, &b[b_offset], ldb, &
开发者ID:juanjosegarciaripoll，项目名称:cblapack，代码行数:67，代码来源:dgegv.c
示例5: d_matrix_norm
DLLEXPORT double d_matrix_norm(char norm, MKL_INT m, MKL_INT n, double a[], double work[])
{
return dlange_(&norm, &m, &n, a, &m, work);
}
开发者ID:the-vk，项目名称:mathnet-numerics，代码行数:4，代码来源:lapack.cpp
示例6: dqrt12_
doublereal dqrt12_(integer *m, integer *n, doublereal *a, integer *lda,
doublereal *s, doublereal *work, integer *lwork)
{
/* System generated locals */
integer a_dim1, a_offset, i__1, i__2;
doublereal ret_val;
/* Local variables */
integer i__, j, mn, iscl, info;
doublereal anrm;
extern doublereal dnrm2_(integer *, doublereal *, integer *), dasum_(
integer *, doublereal *, integer *);
extern /* Subroutine */ int daxpy_(integer *, doublereal *, doublereal *,
integer *, doublereal *, integer *), dgebd2_(integer *, integer *,
doublereal *, integer *, doublereal *, doublereal *, doublereal *
, doublereal *, doublereal *, integer *);
doublereal dummy[1];
extern /* Subroutine */ int dlabad_(doublereal *, doublereal *);
extern doublereal dlamch_(char *), dlange_(char *, integer *,
integer *, doublereal *, integer *, doublereal *);
extern /* Subroutine */ int dlascl_(char *, integer *, integer *,
doublereal *, doublereal *, integer *, integer *, doublereal *,
integer *, integer *), dlaset_(char *, integer *, integer
*, doublereal *, doublereal *, doublereal *, integer *),
xerbla_(char *, integer *), dbdsqr_(char *, integer *,
integer *, integer *, integer *, doublereal *, doublereal *,
doublereal *, integer *, doublereal *, integer *, doublereal *,
integer *, doublereal *, integer *);
doublereal bignum, smlnum, nrmsvl;
/* -- LAPACK test routine (version 3.1.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* January 2007 */
/* .. Scalar Arguments .. */
/* .. */
/* .. Array Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* DQRT12 computes the singular values `svlues' of the upper trapezoid */
/* of A(1:M,1:N) and returns the ratio */
/* || s - svlues||/(||svlues||*eps*max(M,N)) */
/* Arguments */
/* ========= */
/* M (input) INTEGER */
/* The number of rows of the matrix A. */
/* N (input) INTEGER */
/* The number of columns of the matrix A. */
/* A (input) DOUBLE PRECISION array, dimension (LDA,N) */
/* The M-by-N matrix A. Only the upper trapezoid is referenced. */
/* LDA (input) INTEGER */
/* The leading dimension of the array A. */
/* S (input) DOUBLE PRECISION array, dimension (min(M,N)) */
/* The singular values of the matrix A. */
/* WORK (workspace) DOUBLE PRECISION array, dimension (LWORK) */
/* LWORK (input) INTEGER */
/* The length of the array WORK. LWORK >= max(M*N + 4*min(M,N) + */
/* max(M,N), M*N+2*MIN( M, N )+4*N). */
/* ===================================================================== */
/* .. Parameters .. */
/* .. */
/* .. Local Scalars .. */
/* .. */
/* .. External Functions .. */
/* .. */
/* .. External Subroutines .. */
/* .. */
/* .. Intrinsic Functions .. */
/* .. */
/* .. Local Arrays .. */
/* .. */
/* .. Executable Statements .. */
/* Parameter adjustments */
a_dim1 = *lda;
a_offset = 1 + a_dim1;
a -= a_offset;
--s;
--work;
/* Function Body */
ret_val = 0.;
/* Test that enough workspace is supplied */
//.........这里部分代码省略.........
开发者ID:3deggi，项目名称:levmar-ndk，代码行数:101，代码来源:dqrt12.c
示例7: WANTQ
//.........这里部分代码省略.........
Parameter adjustments */
/* Table of constant values */
static integer c__1 = 1;
static integer c__4 = 4;
static logical c_false = FALSE_;
static integer c_n1 = -1;
static integer c__2 = 2;
static integer c__3 = 3;
/* System generated locals */
integer q_dim1, q_offset, t_dim1, t_offset, i__1;
doublereal d__1, d__2, d__3, d__4, d__5, d__6;
/* Local variables */
static integer ierr;
static doublereal temp;
extern /* Subroutine */ int drot_(integer *, doublereal *, integer *,
doublereal *, integer *, doublereal *, doublereal *);
static doublereal d__[16] /* was [4][4] */;
static integer k;
static doublereal u[3], scale, x[4] /* was [2][2] */, dnorm;
static integer j2, j3, j4;
static doublereal xnorm, u1[3], u2[3];
extern /* Subroutine */ int dlanv2_(doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *), dlasy2_(
logical *, logical *, integer *, integer *, integer *, doublereal
*, integer *, doublereal *, integer *, doublereal *, integer *,
doublereal *, doublereal *, integer *, doublereal *, integer *);
static integer nd;
static doublereal cs, t11, t22;
extern doublereal dlamch_(char *);
static doublereal t33;
extern doublereal dlange_(char *, integer *, integer *, doublereal *,
integer *, doublereal *);
extern /* Subroutine */ int dlarfg_(integer *, doublereal *, doublereal *,
integer *, doublereal *);
static doublereal sn;
extern /* Subroutine */ int dlacpy_(char *, integer *, integer *,
doublereal *, integer *, doublereal *, integer *),
dlartg_(doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *), dlarfx_(char *, integer *, integer *, doublereal *,
doublereal *, doublereal *, integer *, doublereal *);
static doublereal thresh, smlnum, wi1, wi2, wr1, wr2, eps, tau, tau1,
tau2;
#define d___ref(a_1,a_2) d__[(a_2)*4 + a_1 - 5]
#define q_ref(a_1,a_2) q[(a_2)*q_dim1 + a_1]
#define t_ref(a_1,a_2) t[(a_2)*t_dim1 + a_1]
#define x_ref(a_1,a_2) x[(a_2)*2 + a_1 - 3]
t_dim1 = *ldt;
t_offset = 1 + t_dim1 * 1;
t -= t_offset;
q_dim1 = *ldq;
q_offset = 1 + q_dim1 * 1;
q -= q_offset;
--work;
/* Function Body */
*info = 0;
/* Quick return if possible */
if (*n == 0 || *n1 == 0 || *n2 == 0) {
return 0;
开发者ID:EugeneGalipchak，项目名称:antelope_contrib，代码行数:67，代码来源:dlaexc.c
示例8: if
//.........这里部分代码省略.........
if (*n < 0) {
*info = -1;
} else if (*nrhs < 0) {
*info = -2;
} else if (*lda < max(1,*n)) {
*info = -4;
} else if (*ldb < max(1,*n)) {
*info = -7;
} else if (*ldx < max(1,*n)) {
*info = -9;
}
if (*info != 0) {
i__1 = -(*info);
xerbla_("DSGESV", &i__1);
return 0;
}
/* Quick return if (N.EQ.0). */
if (*n == 0) {
return 0;
}
/* Skip single precision iterative refinement if a priori slower */
/* than double precision factorization. */
if (FALSE_) {
*iter = -1;
goto L40;
}
/* Compute some constants. */
anrm = dlange_("I", n, n, &a[a_offset], lda, &work[work_offset]);
eps = dlamch_("Epsilon");
cte = anrm * eps * sqrt((doublereal) (*n)) * 1.;
/* Set the indices PTSA, PTSX for referencing SA and SX in SWORK. */
ptsa = 1;
ptsx = ptsa + *n * *n;
/* Convert B from double precision to single precision and store the */
/* result in SX. */
dlag2s_(n, nrhs, &b[b_offset], ldb, &swork[ptsx], n, info);
if (*info != 0) {
*iter = -2;
goto L40;
}
/* Convert A from double precision to single precision and store the */
/* result in SA. */
dlag2s_(n, n, &a[a_offset], lda, &swork[ptsa], n, info);
if (*info != 0) {
*iter = -2;
goto L40;
}
/* Compute the LU factorization of SA. */
sgetrf_(n, n, &swork[ptsa], n, &ipiv[1], info);
开发者ID:juanjosegarciaripoll，项目名称:cblapack，代码行数:66，代码来源:dsgesv.c
示例9: if
//.........这里部分代码省略.........
}
work[1] = (doublereal) maxwrk;
if (*lwork < minwrk && ! lquery) {
*info = -26;
}
}
if (*info != 0) {
i__1 = -(*info);
xerbla_("DGGEVX", &i__1);
return 0;
} else if (lquery) {
return 0;
}
/* Quick return if possible */
if (*n == 0) {
return 0;
}
/* Get machine constants */
eps = dlamch_("P");
smlnum = dlamch_("S");
bignum = 1. / smlnum;
dlabad_(&smlnum, &bignum);
smlnum = sqrt(smlnum) / eps;
bignum = 1. / smlnum;
/* Scale A if max element outside range [SMLNUM,BIGNUM] */
anrm = dlange_("M", n, n, &a[a_offset], lda, &work[1]);
ilascl = FALSE_;
if (anrm > 0. && anrm < smlnum) {
anrmto = smlnum;
ilascl = TRUE_;
} else if (anrm > bignum) {
anrmto = bignum;
ilascl = TRUE_;
}
if (ilascl) {
dlascl_("G", &c__0, &c__0, &anrm, &anrmto, n, n, &a[a_offset], lda, &
ierr);
}
/* Scale B if max element outside range [SMLNUM,BIGNUM] */
bnrm = dlange_("M", n, n, &b[b_offset], ldb, &work[1]);
ilbscl = FALSE_;
if (bnrm > 0. && bnrm < smlnum) {
bnrmto = smlnum;
ilbscl = TRUE_;
} else if (bnrm > bignum) {
bnrmto = bignum;
ilbscl = TRUE_;
}
if (ilbscl) {
dlascl_("G", &c__0, &c__0, &bnrm, &bnrmto, n, n, &b[b_offset], ldb, &
ierr);
}
/* Permute and/or balance the matrix pair (A,B) */
/* (Workspace: need 6*N if BALANC = 'S' or 'B', 1 otherwise) */
开发者ID:juanjosegarciaripoll，项目名称:cblapack，代码行数:66，代码来源:dggevx.c
示例10: dqrt11_
//.........这里部分代码省略.........
/* where the orthogonal matrix Q is represented as a product of */
/* elementary transformations. Each transformation has the form */
/* H(k) = I - tau(k) v(k) v(k)' */
/* where tau(k) is stored in TAU(k) and v(k) is an m-vector of the form */
/* [ 0 ... 0 1 x(k) ]', where x(k) is a vector of length m-k stored */
/* in A(k+1:m,k). */
/* Arguments */
/* ========= */
/* M (input) INTEGER */
/* The number of rows of the matrix A. */
/* K (input) INTEGER */
/* The number of columns of A whose subdiagonal entries */
/* contain information about orthogonal transformations. */
/* A (input) DOUBLE PRECISION array, dimension (LDA,K) */
/* The (possibly partial) output of a QR reduction routine. */
/* LDA (input) INTEGER */
/* The leading dimension of the array A. */
/* TAU (input) DOUBLE PRECISION array, dimension (K) */
/* The scaling factors tau for the elementary transformations as */
/* computed by the QR factorization routine. */
/* WORK (workspace) DOUBLE PRECISION array, dimension (LWORK) */
/* LWORK (input) INTEGER */
/* The length of the array WORK. LWORK >= M*M + M. */
/* ===================================================================== */
/* .. Parameters .. */
/* .. */
/* .. Local Scalars .. */
/* .. */
/* .. External Functions .. */
/* .. */
/* .. External Subroutines .. */
/* .. */
/* .. Intrinsic Functions .. */
/* .. */
/* .. Local Arrays .. */
/* .. */
/* .. Executable Statements .. */
/* Parameter adjustments */
a_dim1 = *lda;
a_offset = 1 + a_dim1;
a -= a_offset;
--tau;
--work;
/* Function Body */
ret_val = 0.;
/* Test for sufficient workspace */
if (*lwork < *m * *m + *m) {
this_xerbla_("DQRT11", &c__7);
return ret_val;
}
/* Quick return if possible */
if (*m <= 0) {
return ret_val;
}
dlaset_("Full", m, m, &c_b5, &c_b6, &work[1], m);
/* Form Q */
dorm2r_("Left", "No transpose", m, m, k, &a[a_offset], lda, &tau[1], &
work[1], m, &work[*m * *m + 1], &info);
/* Form Q'*Q */
dorm2r_("Left", "Transpose", m, m, k, &a[a_offset], lda, &tau[1], &work[1]
, m, &work[*m * *m + 1], &info);
i__1 = *m;
for (j = 1; j <= i__1; ++j) {
work[(j - 1) * *m + j] += -1.;
/* L10: */
}
ret_val = dlange_("One-norm", m, m, &work[1], m, rdummy) / ((
doublereal) (*m) * dlamch_("Epsilon"));
return ret_val;
/* End of DQRT11 */
} /* dqrt11_ */
开发者ID:juanjosegarciaripoll，项目名称:cblapack，代码行数:101，代码来源:dqrt11.c
示例11: Error
/* Subroutine */ int ddrvrf3_(integer *nout, integer *nn, integer *nval,
doublereal *thresh, doublereal *a, integer *lda, doublereal *arf,
doublereal *b1, doublereal *b2, doublereal *d_work_dlange__,
doublereal *d_work_dgeqrf__, doublereal *tau)
{
/* Initialized data */
static integer iseedy[4] = { 1988,1989,1990,1991 };
static char uplos[1*2] = "U" "L";
static char forms[1*2] = "N" "T";
static char sides[1*2] = "L" "R";
static char transs[1*2] = "N" "T";
static char diags[1*2] = "N" "U";
/* Format strings */
static char fmt_9999[] = "(1x,\002 *** Error(s) or Failure(s) while test"
"ing DTFSM ***\002)";
static char fmt_9997[] = "(1x,\002 Failure in \002,a5,\002, CFORM="
"'\002,a1,\002',\002,\002 SIDE='\002,a1,\002',\002,\002 UPLO='"
"\002,a1,\002',\002,\002 TRANS='\002,a1,\002',\002,\002 DIAG='"
"\002,a1,\002',\002,\002 M=\002,i3,\002, N =\002,i3,\002, test"
"=\002,g12.5)";
static char fmt_9996[] = "(1x,\002All tests for \002,a5,\002 auxiliary r"
"outine passed the \002,\002threshold (\002,i5,\002 tests run)"
"\002)";
static char fmt_9995[] = "(1x,a6,\002 auxiliary routine:\002,i5,\002 out"
" of \002,i5,\002 tests failed to pass the threshold\002)";
/* System generated locals */
integer a_dim1, a_offset, b1_dim1, b1_offset, b2_dim1, b2_offset, i__1,
i__2, i__3, i__4;
/* Local variables */
integer i__, j, m, n, na, iim, iin;
doublereal eps;
char diag[1], side[1];
integer info;
char uplo[1];
integer nrun, idiag;
doublereal alpha;
integer nfail, iseed[4], iside;
char cform[1];
integer iform;
char trans[1];
integer iuplo;
integer ialpha;
integer itrans;
doublereal result[1];
/* Fortran I/O blocks */
static cilist io___32 = { 0, 0, 0, 0, 0 };
static cilist io___33 = { 0, 0, 0, fmt_9999, 0 };
static cilist io___34 = { 0, 0, 0, fmt_9997, 0 };
static cilist io___35 = { 0, 0, 0, fmt_9996, 0 };
static cilist io___36 = { 0, 0, 0, fmt_9995, 0 };
/* -- LAPACK test routine (version 3.2.0) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2008 */
/* .. Scalar Arguments .. */
/* .. */
/* .. Array Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* DDRVRF3 tests the LAPACK RFP routines: */
/* DTFSM */
/* Arguments */
/* ========= */
/* NOUT (input) INTEGER */
/* The unit number for output. */
/* NN (input) INTEGER */
/* The number of values of N contained in the vector NVAL. */
/* NVAL (input) INTEGER array, dimension (NN) */
/* The values of the matrix dimension N. */
/* THRESH (input) DOUBLE PRECISION */
/* The threshold value for the test ratios. A result is */
/* included in the output file if RESULT >= THRESH. To have */
/* every test ratio printed, use THRESH = 0. */
/* A (workspace) DOUBLE PRECISION array, dimension (LDA,NMAX) */
/* LDA (input) INTEGER */
/* The leading dimension of the array A. LDA >= max(1,NMAX). */
/* ARF (workspace) DOUBLE PRECISION array, dimension ((NMAX*(NMAX+1))/2). */
/* B1 (workspace) DOUBLE PRECISION array, dimension (LDA,NMAX) */
/* B2 (workspace) DOUBLE PRECISION array, dimension (LDA,NMAX) */
//.........这里部分代码省略.........
开发者ID:juanjosegarciaripoll，项目名称:cblapack，代码行数:101，代码来源:ddrvrf3.c
示例12: lsame_
/* Subroutine */ int dpot03_(char *uplo, integer *n, doublereal *a, integer *
lda, doublereal *ainv, integer *ldainv, doublereal *work, integer *
ldwork, doublereal *rwork, doublereal *rcond, doublereal *resid)
{
/* System generated locals */
integer a_dim1, a_offset, ainv_dim1, ainv_offset, work_dim1, work_offset,
i__1, i__2;
/* Local variables */
integer i__, j;
doublereal eps;
extern logical lsame_(char *, char *);
doublereal anorm;
extern /* Subroutine */ int dsymm_(char *, char *, integer *, integer *,
doublereal *, doublereal *, integer *, doublereal *, integer *,
doublereal *, doublereal *, integer *);
extern doublereal dlamch_(char *), dlange_(char *, integer *,
integer *, doublereal *, integer *, doublereal *);
doublereal ainvnm;
extern doublereal dlansy_(char *, char *, integer *, doublereal *,
integer *, doublereal *);
/* -- LAPACK test routine (version 3.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* .. Array Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* DPOT03 computes the residual for a symmetric matrix times its */
/* inverse: */
/* norm( I - A*AINV ) / ( N * norm(A) * norm(AINV) * EPS ), */
/* where EPS is the machine epsilon. */
/* Arguments */
/* ========== */
/* UPLO (input) CHARACTER*1 */
/* Specifies whether the upper or lower triangular part of the */
/* symmetric matrix A is stored: */
/* = 'U': Upper triangular */
/* = 'L': Lower triangular */
/* N (input) INTEGER */
/* The number of rows and columns of the matrix A. N >= 0. */
/* A (input) DOUBLE PRECISION array, dimension (LDA,N) */
/* The original symmetric matrix A. */
/* LDA (input) INTEGER */
/* The leading dimension of the array A. LDA >= max(1,N) */
/* AINV (input/output) DOUBLE PRECISION array, dimension (LDAINV,N) */
/* On entry, the inverse of the matrix A, stored as a symmetric */
/* matrix in the same format as A. */
/* In this version, AINV is expanded into a full matrix and */
/* multiplied by A, so the opposing triangle of AINV will be */
/* changed; i.e., if the upper triangular part of AINV is */
/* stored, the lower triangular part will be used as work space. */
/* LDAINV (input) INTEGER */
/* The leading dimension of the array AINV. LDAINV >= max(1,N). */
/* WORK (workspace) DOUBLE PRECISION array, dimension (LDWORK,N) */
/* LDWORK (input) INTEGER */
/* The leading dimension of the array WORK. LDWORK >= max(1,N). */
/* RWORK (workspace) DOUBLE PRECISION array, dimension (N) */
/* RCOND (output) DOUBLE PRECISION */
/* The reciprocal of the condition number of A, computed as */
/* ( 1/norm(A) ) / norm(AINV). */
/* RESID (output) DOUBLE PRECISION */
/* norm(I - A*AINV) / ( N * norm(A) * norm(AINV) * EPS ) */
/* ===================================================================== */
/* .. Parameters .. */
/* .. */
/* .. Local Scalars .. */
/* .. */
/* .. External Functions .. */
/* .. */
/* .. External Subroutines .. */
/* .. */
/* .. Intrinsic Functions .. */
/* .. */
/* .. Executable Statements .. */
/* Quick exit if N = 0. */
/* Parameter adjustments */
//.........这里部分代码省略.........
开发者ID:3deggi，项目名称:levmar-ndk，代码行数:101，代码来源:dpot03.c
示例13: if
//.........这里部分代码省略.........
work[1] = (doublereal) maxwrk;
if (*lwork < minwrk && ! lquery) {
*info = -19;
}
}
if (*info != 0) {
i__1 = -(*info);
xerbla_("DGGES ", &i__1);
return 0;
} else if (lquery) {
return 0;
}
/* Quick return if possible */
if (*n == 0) {
*sdim = 0;
return 0;
}
/* Get machine constants */
eps = dlamch_("P");
safmin = dlamch_("S");
safmax = 1. / safmin;
dlabad_(&safmin, &safmax);
smlnum = sqrt(safmin) / eps;
bignum = 1. / smlnum;
/* Scale A if max element outside range [SMLNUM,BIGNUM] */
anrm = dlange_("M", n, n, &a[a_offset], lda, &work[1]);
ilascl = FALSE_;
if (anrm > 0. && anrm < smlnum) {
anrmto = smlnum;
ilascl = TRUE_;
} else if (anrm > bignum) {
anrmto = bignum;
ilascl = TRUE_;
}
if (ilascl) {
dlascl_("G", &c__0, &c__0, &anrm, &anrmto, n, n, &a[a_offset], lda, &
ierr);
}
/* Scale B if max element outside range [SMLNUM,BIGNUM] */
bnrm = dlange_("M", n, n, &b[b_offset], ldb, &work[1]);
ilbscl = FALSE_;
if (bnrm > 0. && bnrm < smlnum) {
bnrmto = smlnum;
ilbscl = TRUE_;
} else if (bnrm > bignum) {
bnrmto = bignum;
ilbscl = TRUE_;
}
if (ilbscl) {
dlascl_("G", &c__0, &c__0, &bnrm, &bnrmto, n, n, &b[b_offset], ldb, &
ierr);
}
/* Permute the matrix to make it more nearly triangular */
/* (Workspace: need 6*N + 2*N space for storing balancing factors) */
开发者ID:juanjosegarciaripoll，项目名称:cblapack，代码行数:66，代码来源:dgges.c
示例14: dgemv_
/* Subroutine */ int dget52_(logical *left, integer *n, doublereal *a,
integer *lda, doublereal *b, integer *ldb, doublereal *e, integer *
lde, doublereal *alphar, doublereal *alphai, doublereal *beta,
doublereal *work, doublereal *result)
{
/* System generated locals */
integer a_dim1, a_offset, b_dim1, b_offset, e_dim1, e_offset, i__1, i__2;
doublereal d__1, d__2, d__3, d__4;
/* Local variables */
integer j;
doublereal ulp;
integer jvec;
doublereal temp1, acoef, scale, abmax, salfi, sbeta;
extern /* Subroutine */ int dgemv_(char *, integer *, integer *,
doublereal *, doublereal *, integer *, doublereal *, integer *,
doublereal *, doublereal *, integer *);
doublereal salfr, anorm, bnorm, enorm;
char trans[1];
doublereal bcoefi;
extern doublereal dlamch_(char *), dlange_(char *, integer *,
integer *, doublereal *, integer *, doublereal *);
doublereal bcoefr, alfmax, safmin;
char normab[1];
doublereal safmax, betmax, enrmer;
logical ilcplx;
doublereal errnrm;
/* -- LAPACK test routine (version 3.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* .. Array Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* DGET52 does an eigenvector check for the generalized eigenvalue */
/* problem. */
/* The basic test for right eigenvectors is: */
/* | b(j) A E(j) - a(j) B E(j) | */
/* RESULT(1) = max ------------------------------- */
/* j n ulp max( |b(j) A|, |a(j) B| ) */
/* using the 1-norm. Here, a(j)/b(j) = w is the j-th generalized */
/* eigenvalue of A - w B, or, equivalently, b(j)/a(j) = m is the j-th */
/* generalized eigenvalue of m A - B. */
/* For real eigenvalues, the test is straightforward. For complex */
/* eigenvalues, E(j) and a(j) are complex, represented by */
/* Er(j) + i*Ei(j) and ar(j) + i*ai(j), resp., so the test for that */
/* eigenvector becomes */
/* max( |Wr|, |Wi| ) */
/* -------------------------------------------- */
/* n ulp max( |b(j) A|, (|ar(j)|+|ai(j)|) |B| ) */
/* where */
/* Wr = b(j) A Er(j) - ar(j) B Er(j) + ai(j) B Ei(j) */
/* Wi = b(j) A Ei(j) - ai(j) B Er(j) - ar(j) B Ei(j) */
/* T T _ */
/* For left eigenvectors, A , B , a, and b are used. */
/* DGET52 also tests the normalization of E. Each eigenvector is */
/* supposed to be normalized so that the maximum "absolute value" */
/* of its elements is 1, where in this case, "absolute value" */
/* of a complex value x is |Re(x)| + |Im(x)| ; let us call this */
/* maximum "absolute value" norm of a vector v M(v). */
/* if a(j)=b(j)=0, then the eigenvector is set to be the jth coordinate */
/* vector. The normalization test is: */
/* RESULT(2) = max | M(v(j)) - 1 | / ( n ulp ) */
/* eigenvectors v(j) */
/* Arguments */
/* ========= */
/* LEFT (input) LOGICAL */
/* =.TRUE.: The eigenvectors in the columns of E are assumed */
/* to be *left* eigenvectors. */
/* =.FALSE.: The eigenvectors in the columns of E are assumed */
/* to be *right* eigenvectors. */
/* N (input) INTEGER */
/* The size of the matrices. If it is zero, DGET52 does */
/* nothing. It must be at least zero. */
/* A (input) DOUBLE PRECISION array, dimension (LDA, N) */
/* The matrix A. */
/* LDA (input) INTEGER */
//.........这里部分代码省略.........
开发者ID:3deggi，项目名称:levmar-ndk，代码行数:101，代码来源:dget52.c
示例15: test
/* Subroutine */ int ddrvge_(logical *dotype, integer *nn, integer *nval,
integer *nrhs, doublereal *thresh, logical *tsterr, integer *nmax,
doublereal *a, doublereal *afac, doublereal *asav, doublereal *b,
doublereal *bsav, doublereal *x, doublereal *xact, doublereal *s,
doublereal *work, doublereal *rwork, integer *iwork, integer *nout)
{
/* Initialized data */
static integer iseedy[4] = { 1988,1989,1990,1991 };
static char transs[1*3] = "N" "T" "C";
static char facts[1*3] = "F" "N" "E";
static char equeds[1*4] = "N" "R" "C" "B";
/* Format strings */
static char fmt_9999[] = "(1x,a,\002, N =\002,i5,\002, type \002,i2,\002"
", test(\002,i2,\002) =\002,g12.5)";
static char fmt_9997[] = "(1x,a,\002, FACT='\002,a1,\002', TRANS='\002,a"
"1,\002', N=\002,i5,\002, EQUED='\002,a1,\002', type \002,i2,\002"
", test(\002,i1,\002)=\002,g12.5)";
static char fmt_9998[] = "(1x,a,\002, FACT='\002,a1,\002', TRANS='\002,a"
"1,\002', N=\002,i5,\002, type \002,i2,\002, test(\002,i1,\002)"
"=\002,g12.5)";
/* System generated locals */
address a__1[2];
integer i__1, i__2, i__3, i__4, i__5[2];
doublereal d__1;
char ch__1[2];
/* Builtin functions */
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
/* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
/* Local variables */
extern /* Subroutine */ int debchvxx_(doublereal *, char *);
integer i__, k, n;
doublereal *errbnds_c__, *errbnds_n__;
integer k1, nb, in, kl, ku, nt, n_err_bnds__;
extern doublereal dla_rpvgrw__(integer *, integer *, doublereal *,
integer *, doublereal *, integer *);
integer lda;
char fact[1];
integer ioff, mode;
doublereal amax;
char path[3];
integer imat, info;
doublereal *berr;
char dist[1];
doublereal rpvgrw_svxx__;
char type__[1];
integer nrun;
extern /* Subroutine */ int dget01_(integer *, integer *, doublereal *,
integer *, doublereal *, integer *, integer *, doublereal *,
doublereal *), dget02_(char *, integer *, integer *, integer *,
doublereal *, integer *, doublereal *, integer *, doublereal *,
integer *, doublereal *, doublereal *);
integer ifact;
extern /* Subroutine */ int dget04_(integer *, integer *, doublereal *,
integer *, doublereal *, integer *, doublereal *, doublereal *);
integer nfail, iseed[4], nfact;
extern doublereal dget06_(doublereal *, doublereal *);
extern /* Subroutine */ int dget07_(char *, integer *, integer *,
doublereal *, integer *, doublereal *, integer *, doublereal *,
integer *, doublereal *, integer *, doublereal *, logical *,
doublereal *, doublereal *);
extern logical lsame_(char *, char *);
char equed[1];
integer nbmin;
doublereal rcond, roldc;
integer nimat;
doublereal roldi;
extern /* Subroutine */ int dgesv_(integer *, integer *, doublereal *,
integer *, integer *, doublereal *, integer *, integer *);
doublereal anorm;
integer itran;
logical equil;
doublereal roldo;
char trans[1];
integer izero, nerrs, lwork;
logical zerot;
char xtype[1];
extern /* Subroutine */ int dlatb4_(char *, integer *, integer *, integer
*, char *, integer *, integer *, doublereal *, integer *,
doublereal *, char *), aladhd_(integer *,
char *);
extern doublereal dlamch_(char *), dlange_(char *, integer *,
integer *, doublereal *, integer *, doublereal *);
extern /* Subroutine */ int alaerh_(char *, char *, integer *, integer *,
char *, integer *, integer *, integer *, integer *, integer *,
integer *, integer *, integer *, integer *), dlaqge_(integer *, integer *, doublereal *, integer *,
doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *, char *);
logical prefac;
doublereal colcnd, rcondc;
logical nofact;
integer iequed;
extern /* Subroutine */ int dgeequ_(integer *, integer *, doublereal *,
integer *, doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *, integer *);
//.........这里部分代码省略.........
开发者ID:3deggi，项目名称:levmar-ndk，代码行数:101，代码来源:ddrvgex.c
示例16: matrices
//.........这里部分代码省略.........
Parameter adjustments */
/* Table of constant values */
static integer c__1 = 1;
static integer c__0 = 0;
static doublereal c_b47 = 0.;
static doublereal c_b48 = 1.;
/* System generated locals */
integer a_dim1, a_offset, b_dim1, b_offset, vl_dim1, vl_offset, vr_dim1,
vr_offset, i__1, i__2;
doublereal d__1, d__2, d__3, d__4;
/* Builtin functions */
double sqrt(doublereal);
/* Local variables */
static logical pair;
static doublereal anrm, bnrm;
static integer ierr, itau;
static doublereal temp;
static logical ilvl, ilvr;
static integer iwrk, iwrk1, i__, j, m;
extern logical lsame_(char *, char *);
static integer icols, irows;
extern /* Subroutine */ int dlabad_(doublereal *, doublereal *);
static integer jc;
extern /* Subroutine */ int dggbak_(char *, char *, integer *, integer *,
integer *, doublereal *, doublereal *, integer *, doublereal *,
integer *, integer *), dggbal_(char *, integer *,
doublereal *, integer *, doublereal *, integer *, integer *,
integer *, doublereal *, doublereal *, doublereal *, integer *);
static integer in;
extern doublereal dlamch_(char *);
static integer mm;
extern doublereal dlange_(char *, integer *, integer *, doublereal *,
integer *, doublereal *);
static integer jr;
extern /* Subroutine */ int dgghrd_(char *, char *, integer *, integer *,
integer *, doublereal *, integer *, doublereal *, integer *,
doublereal *, integer *, doublereal *, integer *, integer *), dlascl_(char *, integer *, integer *, doublereal
*, doublereal *, integer *, integer *, doublereal *, integer *,
integer *);
static logical ilascl, ilbscl;
extern /* Subroutine */ int dgeqrf_(integer *, integer *, doublereal *,
integer *, doublereal *, doublereal *, integer *, integer *),
dlacpy_(char *, integer *, integer *, doublereal *, integer *,
doublereal *, integer *);
static logical ldumma[1];
static char chtemp[1];
static doublereal bignum;
extern /* Subroutine */ int dhgeqz_(char *, char *, char *, integer *,
integer *, integer *, doublereal *, integer *, doublereal *,
integer *, doublereal *, doublereal *, doublereal *, doublereal *,
integer *, doublereal *, integer *, doublereal *, integer *,
integer *), dlaset_(char *, integer *,
integer *, doublereal *, doublereal *, doublereal *, integer *);
static integer ijobvl;
extern /* Subroutine */ int dtgevc_(char *, char *, logical *, integer *,
doublereal *, integer *, doublereal *, integer *, doublereal *,
integer *, doublereal *, integer *, integer *, integer *,
doublereal *, integer *), dtgsna_(char *, char *,
logical *, integer *, doublereal *, integer *, doublereal *,
integer *, doublereal *, integer *, doublereal *, integer *,
doublereal *, doublereal *, integer *, integer *, doublereal *,
integer *, integer *, integer *), xerbla_(char *,
integer *);
extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
开发者ID:EugeneGalipchak，项目名称:antelope_contrib，代码行数:67，代码来源:dggevx.c
|
客服电话
APP下载
官方微信
请发表评论