本文整理汇总了C++中slascl_函数的典型用法代码示例。如果您正苦于以下问题：C++ slascl_函数的具体用法？C++ slascl_怎么用？C++ slascl_使用的例子？那么恭喜您, 这里精选的函数代码示例或许可以为您提供帮助。
在下文中一共展示了slascl_函数的20个代码示例，这些例子默认根据受欢迎程度排序。您可以为喜欢或者感觉有用的代码点赞，您的评价将有助于我们的系统推荐出更棒的C++代码示例。
示例1: sgegv_
/* Subroutine */
int sgegv_(char *jobvl, char *jobvr, integer *n, real *a, integer *lda, real *b, integer *ldb, real *alphar, real *alphai, real *beta, real *vl, integer *ldvl, real *vr, integer *ldvr, real *work, integer *lwork, integer *info)
{
/* System generated locals */
integer a_dim1, a_offset, b_dim1, b_offset, vl_dim1, vl_offset, vr_dim1, vr_offset, i__1, i__2;
real r__1, r__2, r__3, r__4;
/* Local variables */
integer jc, nb, in, jr, nb1, nb2, nb3, ihi, ilo;
real eps;
logical ilv;
real absb, anrm, bnrm;
integer itau;
real temp;
logical ilvl, ilvr;
integer lopt;
real anrm1, anrm2, bnrm1, bnrm2, absai, scale, absar, sbeta;
extern logical lsame_(char *, char *);
integer ileft, iinfo, icols, iwork, irows;
real salfai;
extern /* Subroutine */
int sggbak_(char *, char *, integer *, integer *, integer *, real *, real *, integer *, real *, integer *, integer * ), sggbal_(char *, integer *, real *, integer *, real *, integer *, integer *, integer *, real *, real *, real *, integer *);
real salfar;
extern real slamch_(char *), slange_(char *, integer *, integer *, real *, integer *, real *);
real safmin;
extern /* Subroutine */
int sgghrd_(char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real *, integer * , real *, integer *, integer *);
real safmax;
char chtemp[1];
logical ldumma[1];
extern /* Subroutine */
int slascl_(char *, integer *, integer *, real *, real *, integer *, integer *, real *, integer *, integer *), xerbla_(char *, integer *);
extern integer ilaenv_(integer *, char *, char *, integer *, integer *, integer *, integer *);
integer ijobvl, iright;
logical ilimit;
extern /* Subroutine */
int sgeqrf_(integer *, integer *, real *, integer *, real *, real *, integer *, integer *);
integer ijobvr;
extern /* Subroutine */
int slacpy_(char *, integer *, integer *, real *, integer *, real *, integer *), slaset_(char *, integer *, integer *, real *, real *, real *, integer *), stgevc_( char *, char *, logical *, integer *, real *, integer *, real *, integer *, real *, integer *, real *, integer *, integer *, integer *, real *, integer *);
real onepls;
integer lwkmin;
extern /* Subroutine */
int shgeqz_(char *, char *, char *, integer *, integer *, integer *, real *, integer *, real *, integer *, real * , real *, real *, real *, integer *, real *, integer *, real *, integer *, integer *), sorgqr_(integer *, integer *, integer *, real *, integer *, real *, real *, integer * , integer *);
integer lwkopt;
logical lquery;
extern /* Subroutine */
int sormqr_(char *, char *, integer *, integer *, integer *, real *, integer *, real *, real *, integer *, real *, integer *, integer *);
/* -- LAPACK driver routine (version 3.4.0) -- */
/* -- LAPACK is a software package provided by Univ. of Tennessee, -- */
/* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */
/* November 2011 */
/* .. Scalar Arguments .. */
/* .. */
/* .. Array Arguments .. */
/* .. */
/* ===================================================================== */
/* .. Parameters .. */
/* .. */
/* .. Local Scalars .. */
/* .. */
/* .. Local Arrays .. */
/* .. */
/* .. External Subroutines .. */
/* .. */
/* .. External Functions .. */
/* .. */
/* .. Intrinsic Functions .. */
/* .. */
/* .. Executable Statements .. */
/* Decode the input arguments */
/* Parameter adjustments */
a_dim1 = *lda;
a_offset = 1 + a_dim1;
a -= a_offset;
b_dim1 = *ldb;
b_offset = 1 + b_dim1;
b -= b_offset;
--alphar;
--alphai;
--beta;
vl_dim1 = *ldvl;
vl_offset = 1 + vl_dim1;
vl -= vl_offset;
vr_dim1 = *ldvr;
vr_offset = 1 + vr_dim1;
vr -= vr_offset;
--work;
/* Function Body */
if (lsame_(jobvl, "N"))
{
ijobvl = 1;
ilvl = FALSE_;
}
else if (lsame_(jobvl, "V"))
{
ijobvl = 2;
ilvl = TRUE_;
}
else
{
//.........这里部分代码省略.........
开发者ID:flame，项目名称:libflame，代码行数:101，代码来源:sgegv.c
示例2: if
//.........这里部分代码省略.........
work[j] = 0.f;
} else {
work[j] = -poles[j + (poles_dim1 << 1)] * z__[j] / diflj /
(poles[j + (poles_dim1 << 1)] + dj);
}
i__2 = j - 1;
for (i__ = 1; i__ <= i__2; ++i__) {
if (z__[i__] == 0.f || poles[i__ + (poles_dim1 << 1)] ==
0.f) {
work[i__] = 0.f;
} else {
work[i__] = poles[i__ + (poles_dim1 << 1)] * z__[i__]
/ (slamc3_(&poles[i__ + (poles_dim1 << 1)], &
dsigj) - diflj) / (poles[i__ + (poles_dim1 <<
1)] + dj);
}
}
i__2 = *k;
for (i__ = j + 1; i__ <= i__2; ++i__) {
if (z__[i__] == 0.f || poles[i__ + (poles_dim1 << 1)] ==
0.f) {
work[i__] = 0.f;
} else {
work[i__] = poles[i__ + (poles_dim1 << 1)] * z__[i__]
/ (slamc3_(&poles[i__ + (poles_dim1 << 1)], &
dsigjp) + difrj) / (poles[i__ + (poles_dim1 <<
1)] + dj);
}
}
work[1] = -1.f;
temp = snrm2_(k, &work[1], &c__1);
sgemv_("T", k, nrhs, &c_b11, &bx[bx_offset], ldbx, &work[1], &
c__1, &c_b13, &b[j + b_dim1], ldb);
slascl_("G", &c__0, &c__0, &temp, &c_b11, &c__1, nrhs, &b[j +
b_dim1], ldb, info);
}
}
/* Move the deflated rows of BX to B also. */
if (*k < max(m,n)) {
i__1 = n - *k;
slacpy_("A", &i__1, nrhs, &bx[*k + 1 + bx_dim1], ldbx, &b[*k + 1
+ b_dim1], ldb);
}
} else {
/* Apply back the right orthogonal transformations. */
/* Step (1R): apply back the new right singular vector matrix */
/* to B. */
if (*k == 1) {
scopy_(nrhs, &b[b_offset], ldb, &bx[bx_offset], ldbx);
} else {
i__1 = *k;
for (j = 1; j <= i__1; ++j) {
dsigj = poles[j + (poles_dim1 << 1)];
if (z__[j] == 0.f) {
work[j] = 0.f;
} else {
work[j] = -z__[j] / difl[j] / (dsigj + poles[j +
poles_dim1]) / difr[j + (difr_dim1 << 1)];
}
i__2 = j - 1;
for (i__ = 1; i__ <= i__2; ++i__) {
开发者ID:juanjosegarciaripoll，项目名称:cblapack，代码行数:67，代码来源:slals0.c
示例3: lsame_
//.........这里部分代码省略.........
/* Get machine constants */
eps = slamch_("P");
smlnum = slamch_("S");
bignum = 1.f / smlnum;
slabad_(&smlnum, &bignum);
smlnum = sqrt(smlnum) / eps;
bignum = 1.f / smlnum;
/* Scale A if max element outside range [SMLNUM,BIGNUM] */
icond = 0;
anrm = clange_("M", n, n, &a[a_offset], lda, dum);
scalea = FALSE_;
if (anrm > 0.f && anrm < smlnum) {
scalea = TRUE_;
cscale = smlnum;
} else if (anrm > bignum) {
scalea = TRUE_;
cscale = bignum;
}
if (scalea) {
clascl_("G", &c__0, &c__0, &anrm, &cscale, n, n, &a[a_offset], lda, &
ierr);
}
/* Balance the matrix and compute ABNRM */
cgebal_(balanc, n, &a[a_offset], lda, ilo, ihi, &scale[1], &ierr);
*abnrm = clange_("1", n, n, &a[a_offset], lda, dum);
if (scalea) {
dum[0] = *abnrm;
slascl_("G", &c__0, &c__0, &cscale, &anrm, &c__1, &c__1, dum, &c__1, &
ierr);
*abnrm = dum[0];
}
/* Reduce to upper Hessenberg form */
/* (CWorkspace: need 2*N, prefer N+N*NB) */
/* (RWorkspace: none) */
itau = 1;
iwrk = itau + *n;
i__1 = *lwork - iwrk + 1;
cgehrd_(n, ilo, ihi, &a[a_offset], lda, &work[itau], &work[iwrk], &i__1, &
ierr);
if (wantvl) {
/* Want left eigenvectors */
/* Copy Householder vectors to VL */
*(unsigned char *)side = 'L';
clacpy_("L", n, n, &a[a_offset], lda, &vl[vl_offset], ldvl)
;
/* Generate unitary matrix in VL */
/* (CWorkspace: need 2*N-1, prefer N+(N-1)*NB) */
/* (RWorkspace: none) */
i__1 = *lwork - iwrk + 1;
cunghr_(n, ilo, ihi, &vl[vl_offset], ldvl, &work[itau], &work[iwrk], &
i__1, &ierr);
/* Perform QR iteration, accumulating Schur vectors in VL */
开发者ID:juanjosegarciaripoll，项目名称:cblapack，代码行数:67，代码来源:cgeevx.c
示例4: matrices
//.........这里部分代码省略.........
/* System generated locals */
integer a_dim1, a_offset, b_dim1, b_offset, vsl_dim1, vsl_offset,
vsr_dim1, vsr_offset, i__1, i__2;
real r__1;
/* Builtin functions */
double sqrt(doublereal);
/* Local variables */
static real anrm, bnrm;
static integer idum[1], ierr, itau, iwrk;
static real pvsl, pvsr;
static integer i__;
extern logical lsame_(char *, char *);
static integer ileft, icols;
static logical cursl, ilvsl, ilvsr;
static integer irows;
static logical lst2sl;
extern /* Subroutine */ int slabad_(real *, real *);
static integer ip;
extern /* Subroutine */ int sggbak_(char *, char *, integer *, integer *,
integer *, real *, real *, integer *, real *, integer *, integer *
), sggbal_(char *, integer *, real *, integer *,
real *, integer *, integer *, integer *, real *, real *, real *,
integer *);
static logical ilascl, ilbscl;
extern doublereal slamch_(char *), slange_(char *, integer *,
integer *, real *, integer *, real *);
static real safmin;
extern /* Subroutine */ int sgghrd_(char *, char *, integer *, integer *,
integer *, real *, integer *, real *, integer *, real *, integer *
, real *, integer *, integer *);
static real safmax;
extern /* Subroutine */ int xerbla_(char *, integer *);
static real bignum;
extern /* Subroutine */ int slascl_(char *, integer *, integer *, real *,
real *, integer *, integer *, real *, integer *, integer *);
extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
integer *, integer *, ftnlen, ftnlen);
static integer ijobvl, iright;
extern /* Subroutine */ int sgeqrf_(integer *, integer *, real *, integer
*, real *, real *, integer *, integer *);
static integer ijobvr;
extern /* Subroutine */ int slacpy_(char *, integer *, integer *, real *,
integer *, real *, integer *), slaset_(char *, integer *,
integer *, real *, real *, real *, integer *);
static real anrmto, bnrmto;
static logical lastsl;
extern /* Subroutine */ int shgeqz_(char *, char *, char *, integer *,
integer *, integer *, real *, integer *, real *, integer *, real *
, real *, real *, real *, integer *, real *, integer *, real *,
integer *, integer *), stgsen_(integer *,
logical *, logical *, logical *, integer *, real *, integer *,
real *, integer *, real *, real *, real *, real *, integer *,
real *, integer *, integer *, real *, real *, real *, real *,
integer *, integer *, integer *, integer *);
static integer minwrk, maxwrk;
static real smlnum;
extern /* Subroutine */ int sorgqr_(integer *, integer *, integer *, real
*, integer *, real *, real *, integer *, integer *);
static logical wantst, lquery;
extern /* Subroutine */ int sormqr_(char *, char *, integer *, integer *,
integer *, real *, integer *, real *, real *, integer *, real *,
integer *, integer *);
static real dif[2];
static integer ihi, ilo;
static real eps;
#define a_ref(a_1,a_2) a[(a_2)*a_dim1 + a_1]
开发者ID:MichaelH13，项目名称:sdkpub，代码行数:67，代码来源:sgges.c
示例5: if
//.........这里部分代码省略.........
xerbla_("SGEGV ", &i__1);
return 0;
} else if (lquery) {
return 0;
}
/* Quick return if possible */
if (*n == 0) {
return 0;
}
/* Get machine constants */
eps = slamch_("E") * slamch_("B");
safmin = slamch_("S");
safmin += safmin;
safmax = 1.f / safmin;
onepls = eps * 4 + 1.f;
/* Scale A */
anrm = slange_("M", n, n, &a[a_offset], lda, &work[1]);
anrm1 = anrm;
anrm2 = 1.f;
if (anrm < 1.f) {
if (safmax * anrm < 1.f) {
anrm1 = safmin;
anrm2 = safmax * anrm;
}
}
if (anrm > 0.f) {
slascl_("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 = slange_("M", n, n, &b[b_offset], ldb, &work[1]);
bnrm1 = bnrm;
bnrm2 = 1.f;
if (bnrm < 1.f) {
if (safmax * bnrm < 1.f) {
bnrm1 = safmin;
bnrm2 = safmax * bnrm;
}
}
if (bnrm > 0.f) {
slascl_("G", &c_n1, &c_n1, &bnrm, &c_b27, n, n, &b[b_offset], ldb, &
iinfo);
if (iinfo != 0) {
*info = *n + 10;
return 0;
}
}
/* Permute the matrix to make it more nearly triangular */
/* Workspace layout: (8*N words -- "work" requires 6*N words) */
ileft = 1;
开发者ID:juanjosegarciaripoll，项目名称:cblapack，代码行数:67，代码来源:sgegv.c
示例6: sqrt
/* Subroutine */ int ssterf_(integer *n, real *d__, real *e, integer *info)
{
/* System generated locals */
integer i__1;
real r__1, r__2, r__3;
/* Builtin functions */
double sqrt(doublereal), r_sign(real *, real *);
/* Local variables */
real c__;
integer i__, l, m;
real p, r__, s;
integer l1;
real bb, rt1, rt2, eps, rte;
integer lsv;
real eps2, oldc;
integer lend, jtot;
extern /* Subroutine */ int slae2_(real *, real *, real *, real *, real *)
;
real gamma, alpha, sigma, anorm;
extern doublereal slapy2_(real *, real *);
integer iscale;
real oldgam;
extern doublereal slamch_(char *);
real safmin;
extern /* Subroutine */ int xerbla_(char *, integer *);
real safmax;
extern /* Subroutine */ int slascl_(char *, integer *, integer *, real *,
real *, integer *, integer *, real *, integer *, integer *);
integer lendsv;
real ssfmin;
integer nmaxit;
real ssfmax;
extern doublereal slanst_(char *, integer *, real *, real *);
extern /* Subroutine */ int slasrt_(char *, integer *, real *, integer *);
/* -- LAPACK routine (version 3.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* .. Array Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* SSTERF computes all eigenvalues of a symmetric tridiagonal matrix */
/* using the Pal-Walker-Kahan variant of the QL or QR algorithm. */
/* Arguments */
/* ========= */
/* N (input) INTEGER */
/* The order of the matrix. N >= 0. */
/* D (input/output) REAL array, dimension (N) */
/* On entry, the n diagonal elements of the tridiagonal matrix. */
/* On exit, if INFO = 0, the eigenvalues in ascending order. */
/* E (input/output) REAL array, dimension (N-1) */
/* On entry, the (n-1) subdiagonal elements of the tridiagonal */
/* matrix. */
/* On exit, E has been destroyed. */
/* INFO (output) INTEGER */
/* = 0: successful exit */
/* < 0: if INFO = -i, the i-th argument had an illegal value */
/* > 0: the algorithm failed to find all of the eigenvalues in */
/* a total of 30*N iterations; if INFO = i, then i */
/* elements of E have not converged to zero. */
/* ===================================================================== */
/* .. Parameters .. */
/* .. */
/* .. Local Scalars .. */
/* .. */
/* .. External Functions .. */
/* .. */
/* .. External Subroutines .. */
/* .. */
/* .. Intrinsic Functions .. */
/* .. */
/* .. Executable Statements .. */
/* Test the input parameters. */
/* Parameter adjustments */
--e;
--d__;
/* Function Body */
*info = 0;
/* Quick return if possible */
//.........这里部分代码省略.........
开发者ID:Avatarchik，项目名称:EmguCV-Unity，代码行数:101，代码来源:ssterf.c
示例7: ssbev_
int ssbev_(char *jobz, char *uplo, int *n, int *kd,
float *ab, int *ldab, float *w, float *z__, int *ldz, float *work,
int *info)
{
/* System generated locals */
int ab_dim1, ab_offset, z_dim1, z_offset, i__1;
float r__1;
/* Builtin functions */
double sqrt(double);
/* Local variables */
float eps;
int inde;
float anrm;
int imax;
float rmin, rmax, sigma;
extern int lsame_(char *, char *);
int iinfo;
extern int sscal_(int *, float *, float *, int *);
int lower, wantz;
int iscale;
extern double slamch_(char *);
float safmin;
extern int xerbla_(char *, int *);
float bignum;
extern double slansb_(char *, char *, int *, int *, float *,
int *, float *);
extern int slascl_(char *, int *, int *, float *,
float *, int *, int *, float *, int *, int *);
int indwrk;
extern int ssbtrd_(char *, char *, int *, int *,
float *, int *, float *, float *, float *, int *, float *,
int *), ssterf_(int *, float *, float *,
int *);
float smlnum;
extern int ssteqr_(char *, int *, float *, float *,
float *, int *, float *, int *);
/* -- LAPACK driver routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* .. Array Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* SSBEV computes all the eigenvalues and, optionally, eigenvectors of */
/* a float symmetric band matrix A. */
/* Arguments */
/* ========= */
/* JOBZ (input) CHARACTER*1 */
/* = 'N': Compute eigenvalues only; */
/* = 'V': Compute eigenvalues and eigenvectors. */
/* UPLO (input) CHARACTER*1 */
/* = 'U': Upper triangle of A is stored; */
/* = 'L': Lower triangle of A is stored. */
/* N (input) INTEGER */
/* The order of the matrix A. N >= 0. */
/* KD (input) INTEGER */
/* The number of superdiagonals of the matrix A if UPLO = 'U', */
/* or the number of subdiagonals if UPLO = 'L'. KD >= 0. */
/* AB (input/output) REAL array, dimension (LDAB, N) */
/* On entry, the upper or lower triangle of the symmetric band */
/* matrix A, stored in the first KD+1 rows of the array. The */
/* j-th column of A is stored in the j-th column of the array AB */
/* as follows: */
/* if UPLO = 'U', AB(kd+1+i-j,j) = A(i,j) for MAX(1,j-kd)<=i<=j; */
/* if UPLO = 'L', AB(1+i-j,j) = A(i,j) for j<=i<=MIN(n,j+kd). */
/* On exit, AB is overwritten by values generated during the */
/* reduction to tridiagonal form. If UPLO = 'U', the first */
/* superdiagonal and the diagonal of the tridiagonal matrix T */
/* are returned in rows KD and KD+1 of AB, and if UPLO = 'L', */
/* the diagonal and first subdiagonal of T are returned in the */
/* first two rows of AB. */
/* LDAB (input) INTEGER */
/* The leading dimension of the array AB. LDAB >= KD + 1. */
/* W (output) REAL array, dimension (N) */
/* If INFO = 0, the eigenvalues in ascending order. */
/* Z (output) REAL array, dimension (LDZ, N) */
/* If JOBZ = 'V', then if INFO = 0, Z contains the orthonormal */
/* eigenvectors of the matrix A, with the i-th column of Z */
/* holding the eigenvector associated with W(i). */
/* If JOBZ = 'N', then Z is not referenced. */
//.........这里部分代码省略.........
开发者ID:GuillaumeFuchs，项目名称:Ensimag，代码行数:101，代码来源:ssbev.c
示例8: cgemm_
/* Subroutine */ int cqrt15_(integer *scale, integer *rksel, integer *m,
integer *n, integer *nrhs, complex *a, integer *lda, complex *b,
integer *ldb, real *s, integer *rank, real *norma, real *normb,
integer *iseed, complex *work, integer *lwork)
{
/* System generated locals */
integer a_dim1, a_offset, b_dim1, b_offset, i__1, i__2;
real r__1;
/* Local variables */
integer j, mn;
real eps;
integer info;
real temp;
extern /* Subroutine */ int cgemm_(char *, char *, integer *, integer *,
integer *, complex *, complex *, integer *, complex *, integer *,
complex *, complex *, integer *), clarf_(char *,
integer *, integer *, complex *, integer *, complex *, complex *,
integer *, complex *);
extern doublereal sasum_(integer *, real *, integer *);
real dummy[1];
extern doublereal scnrm2_(integer *, complex *, integer *);
extern /* Subroutine */ int slabad_(real *, real *);
extern doublereal clange_(char *, integer *, integer *, complex *,
integer *, real *);
extern /* Subroutine */ int clascl_(char *, integer *, integer *, real *,
real *, integer *, integer *, complex *, integer *, integer *);
extern doublereal slamch_(char *);
extern /* Subroutine */ int csscal_(integer *, real *, complex *, integer
*), claset_(char *, integer *, integer *, complex *, complex *,
complex *, integer *), xerbla_(char *, integer *);
real bignum;
extern /* Subroutine */ int claror_(char *, char *, integer *, integer *,
complex *, integer *, integer *, complex *, integer *);
extern doublereal slarnd_(integer *, integer *);
extern /* Subroutine */ int slaord_(char *, integer *, real *, integer *), clarnv_(integer *, integer *, integer *, complex *),
slascl_(char *, integer *, integer *, real *, real *, integer *,
integer *, real *, integer *, integer *);
real smlnum;
/* -- LAPACK test routine (version 3.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* .. Array Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* CQRT15 generates a matrix with full or deficient rank and of various */
/* norms. */
/* Arguments */
/* ========= */
/* SCALE (input) INTEGER */
/* SCALE = 1: normally scaled matrix */
/* SCALE = 2: matrix scaled up */
/* SCALE = 3: matrix scaled down */
/* RKSEL (input) INTEGER */
/* RKSEL = 1: full rank matrix */
/* RKSEL = 2: rank-deficient matrix */
/* M (input) INTEGER */
/* The number of rows of the matrix A. */
/* N (input) INTEGER */
/* The number of columns of A. */
/* NRHS (input) INTEGER */
/* The number of columns of B. */
/* A (output) COMPLEX array, dimension (LDA,N) */
/* The M-by-N matrix A. */
/* LDA (input) INTEGER */
/* The leading dimension of the array A. */
/* B (output) COMPLEX array, dimension (LDB, NRHS) */
/* A matrix that is in the range space of matrix A. */
/* LDB (input) INTEGER */
/* The leading dimension of the array B. */
/* S (output) REAL array, dimension MIN(M,N) */
/* Singular values of A. */
/* RANK (output) INTEGER */
/* number of nonzero singular values of A. */
/* NORMA (output) REAL */
/* one-norm norm of A. */
/* NORMB (output) REAL */
/* one-norm norm of B. */
//.........这里部分代码省略.........
开发者ID:nya3jp，项目名称:python-animeface，代码行数:101，代码来源:cqrt15.c
示例9: eigenvalues
//.........这里部分代码省略.........
static integer c__8 = 8;
static integer c_n1 = -1;
static integer c__4 = 4;
/* System generated locals */
integer a_dim1, a_offset, vs_dim1, vs_offset, i__1, i__2, i__3, i__4;
/* Builtin functions */
double sqrt(doublereal);
/* Local variables */
static integer ibal, maxb;
static real anrm;
static integer ierr, itau, iwrk, i, k, icond, ieval;
extern logical lsame_(char *, char *);
extern /* Subroutine */ int ccopy_(integer *, complex *, integer *,
complex *, integer *), cgebak_(char *, char *, integer *, integer
*, integer *, real *, integer *, complex *, integer *, integer *), cgebal_(char *, integer *, complex *, integer *,
integer *, integer *, real *, integer *), slabad_(real *,
real *);
static logical scalea;
extern doublereal clange_(char *, integer *, integer *, complex *,
integer *, real *);
static real cscale;
extern /* Subroutine */ int cgehrd_(integer *, integer *, integer *,
complex *, integer *, complex *, complex *, integer *, integer *),
clascl_(char *, integer *, integer *, real *, real *, integer *,
integer *, complex *, integer *, integer *);
extern doublereal slamch_(char *);
extern /* Subroutine */ int clacpy_(char *, integer *, integer *, complex
*, integer *, complex *, integer *), xerbla_(char *,
integer *);
extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
integer *, integer *, ftnlen, ftnlen);
static real bignum;
extern /* Subroutine */ int slascl_(char *, integer *, integer *, real *,
real *, integer *, integer *, real *, integer *, integer *), chseqr_(char *, char *, integer *, integer *, integer *,
complex *, integer *, complex *, complex *, integer *, complex *,
integer *, integer *), cunghr_(integer *, integer
*, integer *, complex *, integer *, complex *, complex *, integer
*, integer *);
static logical wantsb;
extern /* Subroutine */ int ctrsen_(char *, char *, logical *, integer *,
complex *, integer *, complex *, integer *, complex *, integer *,
real *, real *, complex *, integer *, integer *);
static logical wantse;
static integer minwrk, maxwrk;
static logical wantsn;
static real smlnum;
static integer hswork;
static logical wantst, wantsv, wantvs;
static integer ihi, ilo;
static real dum[1], eps;
#define W(I) w[(I)-1]
#define WORK(I) work[(I)-1]
#define RWORK(I) rwork[(I)-1]
#define BWORK(I) bwork[(I)-1]
#define A(I,J) a[(I)-1 + ((J)-1)* ( *lda)]
#define VS(I,J) vs[(I)-1 + ((J)-1)* ( *ldvs)]
*info = 0;
wantvs = lsame_(jobvs, "V");
wantst = lsame_(sort, "S");
wantsn = lsame_(sense, "N");
开发者ID:deepakantony，项目名称:vispack，代码行数:67，代码来源:cgeesx.c
示例10: sqrt12_
doublereal sqrt12_(integer *m, integer *n, real *a, integer *lda, real *s,
real *work, integer *lwork)
{
/* System generated locals */
integer a_dim1, a_offset, i__1, i__2;
real ret_val;
/* Local variables */
static integer iscl, info;
static real anrm;
extern doublereal snrm2_(integer *, real *, integer *);
static integer i__, j;
extern doublereal sasum_(integer *, real *, integer *);
static real dummy[1];
extern /* Subroutine */ int saxpy_(integer *, real *, real *, integer *,
real *, integer *), sgebd2_(integer *, integer *, real *, integer
*, real *, real *, real *, real *, real *, integer *), slabad_(
real *, real *);
static integer mn;
extern doublereal slamch_(char *), slange_(char *, integer *,
integer *, real *, integer *, real *);
extern /* Subroutine */ int xerbla_(char *, integer *);
static real bignum;
extern /* Subroutine */ int slascl_(char *, integer *, integer *, real *,
real *, integer *, integer *, real *, integer *, integer *), slaset_(char *, integer *, integer *, real *, real *,
real *, integer *), sbdsqr_(char *, integer *, integer *,
integer *, integer *, real *, real *, real *, integer *, real *,
integer *, real *, integer *, real *, integer *);
static real smlnum, nrmsvl;
#define a_ref(a_1,a_2) a[(a_2)*a_dim1 + a_1]
/* -- LAPACK test routine (version 3.0) --
Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
Courant Institute, Argonne National Lab, and Rice University
September 30, 1994
Purpose
=======
SQRT12 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) REAL 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) REAL array, dimension (min(M,N))
The singular values of the matrix A.
WORK (workspace) REAL array, dimension (LWORK)
LWORK (input) INTEGER
The length of the array WORK. LWORK >= M*N + 4*min(M,N) +
max(M,N).
=====================================================================
Parameter adjustments */
a_dim1 = *lda;
a_offset = 1 + a_dim1 * 1;
a -= a_offset;
--s;
--work;
/* Function Body */
ret_val = 0.f;
/* Test that enough workspace is supplied */
if (*lwork < *m * *n + (min(*m,*n) << 2) + max(*m,*n)) {
xerbla_("SQRT12", &c__7);
return ret_val;
}
/* Quick return if possible */
mn = min(*m,*n);
if ((real) mn <= 0.f) {
return ret_val;
}
nrmsvl = snrm2_(&mn, &s[1], &c__1);
//.........这里部分代码省略.........
开发者ID:zangel，项目名称:uquad，代码行数:101，代码来源:sqrt12.c
示例11: dimension
/* Subroutine */ int ssterf_(integer *n, real *d, real *e, integer *info)
{
/* -- LAPACK routine (version 2.0) --
Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
Courant Institute, Argonne National Lab, and Rice University
September 30, 1994
Purpose
=======
SSTERF computes all eigenvalues of a symmetric tridiagonal matrix
using the Pal-Walker-Kahan variant of the QL or QR algorithm.
Arguments
=========
N (input) INTEGER
The order of the matrix. N >= 0.
D (input/output) REAL array, dimension (N)
On entry, the n diagonal elements of the tridiagonal matrix.
On exit, if INFO = 0, the eigenvalues in ascending order.
E (input/output) REAL array, dimension (N-1)
On entry, the (n-1) subdiagonal elements of the tridiagonal
matrix.
On exit, E has been destroyed.
INFO (output) INTEGER
= 0: successful exit
< 0: if INFO = -i, the i-th argument had an illegal value
> 0: the algorithm failed to find all of the eigenvalues in
a total of 30*N iterations; if INFO = i, then i
elements of E have not converged to zero.
=====================================================================
Test the input parameters.
Parameter adjustments
Function Body */
/* Table of constant values */
static integer c__0 = 0;
static integer c__1 = 1;
static real c_b32 = 1.f;
/* System generated locals */
integer i__1;
real r__1, r__2;
/* Builtin functions */
double sqrt(doublereal), r_sign(real *, real *);
/* Local variables */
static real oldc;
static integer lend, jtot;
extern /* Subroutine */ int slae2_(real *, real *, real *, real *, real *)
;
static real c;
static integer i, l, m;
static real p, gamma, r, s, alpha, sigma, anorm;
static integer l1, lendm1, lendp1;
static real bb;
extern doublereal slapy2_(real *, real *);
static integer iscale;
static real oldgam;
extern doublereal slamch_(char *);
static real safmin;
extern /* Subroutine */ int xerbla_(char *, integer *);
static real safmax;
extern /* Subroutine */ int slascl_(char *, integer *, integer *, real *,
real *, integer *, integer *, real *, integer *, integer *);
static integer lendsv;
static real ssfmin;
static integer nmaxit;
static real ssfmax;
extern doublereal slanst_(char *, integer *, real *, real *);
extern /* Subroutine */ int slasrt_(char *, integer *, real *, integer *);
static integer lm1, mm1, nm1;
static real rt1, rt2, eps, rte;
static integer lsv;
static real tst, eps2;
#define E(I) e[(I)-1]
#define D(I) d[(I)-1]
*info = 0;
/* Quick return if possible */
if (*n < 0) {
*info = -1;
i__1 = -(*info);
//.........这里部分代码省略.........
开发者ID:bliss-sid，项目名称:OCR，代码行数:101，代码来源:SSTERF.C
示例12: sqrt
/* Subroutine */ int sggesx_(char *jobvsl, char *jobvsr, char *sort, L_fp
selctg, char *sense, integer *n, real *a, integer *lda, real *b,
integer *ldb, integer *sdim, real *alphar, real *alphai, real *beta,
real *vsl, integer *ldvsl, real *vsr, integer *ldvsr, real *rconde,
real *rcondv, real *work, integer *lwork, integer *iwork, integer *
liwork, logical *bwork, integer *info)
{
/* System generated locals */
integer a_dim1, a_offset, b_dim1, b_offset, vsl_dim1, vsl_offset,
vsr_dim1, vsr_offset, i__1, i__2;
real r__1;
/* Builtin functions */
double sqrt(doublereal);
/* Local variables */
integer i__, ip;
real pl, pr, dif[2];
integer ihi, ilo;
real eps;
integer ijob;
real anrm, bnrm;
integer ierr, itau, iwrk, lwrk;
extern logical lsame_(char *, char *);
integer ileft, icols;
logical cursl, ilvsl, ilvsr;
integer irows;
logical lst2sl;
extern /* Subroutine */ int slabad_(real *, real *), sggbak_(char *, char
*, integer *, integer *, integer *, real *, real *, integer *,
real *, integer *, integer *), sggbal_(char *,
integer *, real *, integer *, real *, integer *, integer *,
integer *, real *, real *, real *, integer *);
logical ilascl, ilbscl;
extern doublereal slamch_(char *), slange_(char *, integer *,
integer *, real *, integer *, real *);
real safmin;
extern /* Subroutine */ int sgghrd_(char *, char *, integer *, integer *,
integer *, real *, integer *, real *, integer *, real *, integer *
, real *, integer *, integer *);
real safmax;
extern /* Subroutine */ int xerbla_(char *, integer *);
real bignum;
extern /* Subroutine */ int slascl_(char *, integer *, integer *, real *,
real *, integer *, integer *, real *, integer *, integer *);
extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
integer *, integer *);
integer ijobvl, iright;
extern /* Subroutine */ int sgeqrf_(integer *, integer *, real *, integer
*, real *, real *, integer *, integer *);
integer ijobvr;
extern /* Subroutine */ int slacpy_(char *, integer *, integer *, real *,
integer *, real *, integer *);
logical wantsb, wantse, lastsl;
integer liwmin;
real anrmto, bnrmto;
integer minwrk, maxwrk;
logical wantsn;
real smlnum;
extern /* Subroutine */ int shgeqz_(char *, char *, char *, integer *,
integer *, integer *, real *, integer *, real *, integer *, real *
, real *, real *, real *, integer *, real *, integer *, real *,
integer *, integer *), slaset_(char *,
integer *, integer *, real *, real *, real *, integer *),
sorgqr_(integer *, integer *, integer *, real *, integer *, real *
, real *, integer *, integer *), stgsen_(integer *, logical *,
logical *, logical *, integer *, real *, integer *, real *,
integer *, real *, real *, real *, real *, integer *, real *,
integer *, integer *, real *, real *, real *, real *, integer *,
integer *, integer *, integer *);
logical wantst, lquery, wantsv;
extern /* Subroutine */ int sormqr_(char *, char *, integer *, integer *,
integer *, real *, integer *, real *, real *, integer *, real *,
integer *, integer *);
/* -- LAPACK driver routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* .. Array Arguments .. */
/* .. */
/* .. Function Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* SGGESX computes for a pair of N-by-N real nonsymmetric matrices */
/* (A,B), the generalized eigenvalues, the real Schur form (S,T), and, */
/* optionally, the left and/or right matrices of Schur vectors (VSL and */
/* VSR). This gives the generalized Schur factorization */
/* (A,B) = ( (VSL) S (VSR)**T, (VSL) T (VSR)**T ) */
/* Optionally, it also orders the eigenvalues so that a selected cluster */
/* of eigenvalues appears in the leading diagonal blocks of the upper */
/* quasi-triangular matrix S and the upper triangular matrix T; computes */
//.........这里部分代码省略.........
开发者ID:0u812，项目名称:roadrunner-backup，代码行数:101，代码来源:sggesx.c
示例13: scopy_
/* Subroutine */ int slasd6_(integer *icompq, integer *nl, integer *nr,
integer *sqre, real *d__, real *vf, real *vl, real *alpha, real *beta,
integer *idxq, integer *perm, integer *givptr, integer *givcol,
integer *ldgcol, real *givnum, integer *ldgnum, real *poles, real *
difl, real *difr, real *z__, integer *k, real *c__, real *s, real *
work, integer *iwork, integer *info)
{
/* System generated locals */
integer givcol_dim1, givcol_offset, givnum_dim1, givnum_offset,
poles_dim1, poles_offset, i__1;
real r__1, r__2;
/* Local variables */
integer i__, m, n, n1, n2, iw, idx, idxc, idxp, ivfw, ivlw;
extern /* Subroutine */ int scopy_(integer *, real *, integer *, real *,
integer *), slasd7_(integer *, integer *, integer *, integer *,
integer *, real *, real *, real *, real *, real *, real *, real *,
real *, real *, real *, integer *, integer *, integer *, integer
*, integer *, integer *, integer *, real *, integer *, real *,
real *, integer *), slasd8_(integer *, integer *, real *, real *,
real *, real *, real *, real *, integer *, real *, real *,
integer *);
integer isigma;
extern /* Subroutine */ int xerbla_(char *, integer *), slascl_(
char *, integer *, integer *, real *, real *, integer *, integer *
, real *, integer *, integer *), slamrg_(integer *,
integer *, real *, integer *, integer *, integer *);
real orgnrm;
/* -- LAPACK auxiliary routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* .. Array Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* SLASD6 computes the SVD of an updated upper bidiagonal matrix B */
/* obtained by merging two smaller ones by appending a row. This */
/* routine is used only for the problem which requires all singular */
/* values and optionally singular vector matrices in factored form. */
/* B is an N-by-M matrix with N = NL + NR + 1 and M = N + SQRE. */
/* A related subroutine, SLASD1, handles the case in which all singular */
/* values and singular vectors of the bidiagonal matrix are desired. */
/* SLASD6 computes the SVD as follows: */
/* ( D1(in) 0 0 0 ) */
/* B = U(in) * ( Z1' a Z2' b ) * VT(in) */
/* ( 0 0 D2(in) 0 ) */
/* = U(out) * ( D(out) 0) * VT(out) */
/* where Z' = (Z1' a Z2' b) = u' VT', and u is a vector of dimension M */
/* with ALPHA and BETA in the NL+1 and NL+2 th entries and zeros */
/* elsewhere; and the entry b is empty if SQRE = 0. */
/* The singular values of B can be computed using D1, D2, the first */
/* components of all the right singular vectors of the lower block, and */
/* the last components of all the right singular vectors of the upper */
/* block. These components are stored and updated in VF and VL, */
/* respectively, in SLASD6. Hence U and VT are not explicitly */
/* referenced. */
/* The singular values are stored in D. The algorithm consists of two */
/* stages: */
/* The first stage consists of deflating the size of the problem */
/* when there are multiple singular values or if there is a zero */
/* in the Z vector. For each such occurence the dimension of the */
/* secular equation problem is reduced by one. This stage is */
/* performed by the routine SLASD7. */
/* The second stage consists of calculating the updated */
/* singular values. This is done by finding the roots of the */
/* secular equation via the routine SLASD4 (as called by SLASD8). */
/* This routine also updates VF and VL and computes the distances */
/* between the updated singular values and the old singular */
/* values. */
/* SLASD6 is called from SLASDA. */
/* Arguments */
/* ========= */
/* ICOMPQ (input) INTEGER */
/* Specifies whether singular vectors are to be computed in */
/* factored form: */
/* = 0: Compute singular values only. */
/* = 1: Compute singular vectors in factored form as well. */
/* NL (input) INTEGER */
/* The row dimension of the upper block. NL >= 1. */
/* NR (input) INTEGER */
//.........这里部分代码省略.........
开发者ID:3deggi，项目名称:levmar-ndk，代码行数:101，代码来源:slasd6.c
示例14: sqrt17_
doublereal sqrt17_(char *trans, integer *iresid, integer *m, integer *n,
integer *nrhs, real *a, integer *lda, real *x, integer *ldx, real *b,
integer *ldb, real *c__, real *work, integer *lwork)
{
/* System generated locals */
integer a_dim1, a_offset, b_dim1, b_offset, c_dim1, c_offset, x_dim1,
x_offset, i__1;
real ret_val;
/* Local variables */
static integer iscl, info;
extern logical lsame_(char *, char *);
extern /* Subroutine */ int sgemm_(char *, char *, integer *, integer *,
integer *, real *, real *, integer *, real *, integer *, real *,
real *, integer *);
static real norma, normb;
static integer ncols;
static real normx, rwork[1];
static integer nrows;
extern doublereal slamch_(char *), slange_(char *, integer *,
integer *, real *, integer *, real *);
extern /* Subroutine */ int xerbla_(char *, integer *);
static real bignum;
extern /* Subroutine */ int slascl_(char *, integer *, integer *, real *,
real *, integer *, integer *, real *, integer *, integer *), slacpy_(char *, integer *, integer *, real *, integer *,
real *, integer *);
static real smlnum, normrs, err;
/* -- LAPACK test routine (version 3.0) --
Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
Courant Institute, Argonne National Lab, and Rice University
June 30, 1999
Purpose
=======
SQRT17 computes the ratio
|| R'*op(A) ||/(||A||*alpha*max(M,N,NRHS)*eps)
where R = op(A)*X - B, op(A) is A or A', and
alpha = ||B|| if IRESID = 1 (zero-residual problem)
alpha = ||R|| if IRESID = 2 (otherwise).
Arguments
=========
TRANS (input) CHARACTER*1
Specifies whether or not the transpose of A is used.
= 'N': No transpose, op(A) = A.
= 'T': Transpose, op(A) = A'.
IRESID (input) INTEGER
IRESID = 1 indicates zero-residual problem.
IRESID = 2 indicates non-zero residual.
M (input) INTEGER
The number of rows of the matrix A.
If TRANS = 'N', the number of rows of the matrix B.
If TRANS = 'T', the number of rows of the matrix X.
N (input) INTEGER
The number of columns of the matrix A.
If TRANS = 'N', the number of rows of the matrix X.
If TRANS = 'T', the number of rows of the matrix B.
NRHS (input) INTEGER
The number of columns of the matrices X and B.
A (input) REAL array, dimension (LDA,N)
The m-by-n matrix A.
LDA (input) INTEGER
The leading dimension of the array A. LDA >= M.
X (input) REAL array, dimension (LDX,NRHS)
If TRANS = 'N', the n-by-nrhs matrix X.
If TRANS = 'T', the m-by-nrhs matrix X.
LDX (input) INTEGER
The le
|
客服电话
APP下载
官方微信
请发表评论