本文整理汇总了C++中dlapy2_函数 的典型用法代码示例。如果您正苦于以下问题：C++ dlapy2_函数的具体用法？C++ dlapy2_怎么用？C++ dlapy2_使用的例子？那么恭喜您, 这里精选的函数代码示例或许可以为您提供帮助。
在下文中一共展示了dlapy2_函数 的20个代码示例，这些例子默认根据受欢迎程度排序。您可以为喜欢或者感觉有用的代码点赞，您的评价将有助于我们的系统推荐出更棒的C++代码示例。
示例1: dngeres
void dngeres(int *n, int *nev, int *aptr, int *aind,
double *avals, int *bptr, int *bind, double *bvals,
double *dr, double *di, double *z, int *ldz,
double *res)
{
int i, first=1, ione=1, j;
double md, rnrm, *ax, *bx;
ax = (double*)malloc((*n)*sizeof(double));
bx = (double*)malloc((*n)*sizeof(double));
for (i = 0; i<(*nev); i++) {
if (di[i] == 0.0) {
dmvm_(n, avals, aind, aptr, &z(1,i+1), ax, &ione);
dmvm_(n, bvals, bind, bptr, &z(1,i+1), bx, &ione);
md = -dr[i];
daxpy_(n, &md, bx, &ione, ax, &ione);
res[i] = dnrm2_(n, ax, &ione);
res[i] = res[i]/abs(dr[i]);
}
else if (first) {
dmvm_(n, avals, aind, aptr, &z(1,i+1), ax, &ione);
dmvm_(n, bvals, bind, bptr, &z(1,i+1), bx, &ione);
md = -dr[i];
daxpy_(n, &md, bx, &ione, ax, &ione);
dmvm_(n, bvals, bind, bptr, &z(1,i+2), bx, &ione);
daxpy_(n, &di[i], bx, &ione, ax, &ione);
rnrm = dnrm2_(n, ax, &ione);
res[i] = rnrm*rnrm;
dmvm_(n, avals, aind, aptr, &z(1,i+2), ax, &ione);
dmvm_(n, bvals, bind, bptr, &z(1,i+2), bx, &ione);
md = -dr[i];
daxpy_(n, &md, bx, &ione, ax, &ione);
dmvm_(n, bvals, bind, bptr, &z(1,i+1), bx, &ione);
md = -di[i];
daxpy_(n, &md, bx, &ione, ax, &ione);
rnrm = dnrm2_(n, ax, &ione);
res[i] = dlapy2_(&res[i], &rnrm);
res[i] = res[i]/dlapy2_(&dr[i],&di[i]);
res[i+1] = res[i];
first = 0;
}
else {
first = 1;
}
}
free(ax);
free(bx);
}开发者ID:tpatki， 项目名称:rapl-old-data， 代码行数:50， 代码来源:dngeres.c
示例2: matrix
//.........这里部分代码省略.........
static integer c_n1 = -1;
static integer c__2 = 2;
static integer c__8 = 8;
static integer c__15 = 15;
static logical c_false = FALSE_;
static integer c__1 = 1;
/* System generated locals */
address a__1[2];
integer h_dim1, h_offset, z_dim1, z_offset, i__1, i__2, i__3[2], i__4,
i__5;
doublereal d__1, d__2;
char ch__1[2];
/* Builtin functions
Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
/* Local variables */
static integer maxb;
static doublereal absw;
static integer ierr;
static doublereal unfl, temp, ovfl;
static integer i, j, k, l;
static doublereal s[225] /* was [15][15] */, v[16];
extern /* Subroutine */ int dscal_(integer *, doublereal *, doublereal *,
integer *);
extern logical lsame_(char *, char *);
extern /* Subroutine */ int dgemv_(char *, integer *, integer *,
doublereal *, doublereal *, integer *, doublereal *, integer *,
doublereal *, doublereal *, integer *);
static integer itemp;
extern /* Subroutine */ int dcopy_(integer *, doublereal *, integer *,
doublereal *, integer *);
static integer i1, i2;
static logical initz, wantt, wantz;
extern doublereal dlapy2_(doublereal *, doublereal *);
extern /* Subroutine */ int dlabad_(doublereal *, doublereal *);
static integer ii, nh;
extern doublereal dlamch_(char *);
extern /* Subroutine */ int dlarfg_(integer *, doublereal *, doublereal *,
integer *, doublereal *);
static integer nr, ns;
extern integer idamax_(integer *, doublereal *, integer *);
static integer nv;
extern doublereal dlanhs_(char *, integer *, doublereal *, integer *,
doublereal *);
extern /* Subroutine */ int dlahqr_(logical *, logical *, integer *,
integer *, integer *, doublereal *, integer *, doublereal *,
doublereal *, integer *, integer *, doublereal *, integer *,
integer *);
static doublereal vv[16];
extern /* Subroutine */ int dlacpy_(char *, integer *, integer *,
doublereal *, integer *, doublereal *, integer *);
extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
integer *, integer *, ftnlen, ftnlen);
extern /* Subroutine */ int dlaset_(char *, integer *, integer *,
doublereal *, doublereal *, doublereal *, integer *),
dlarfx_(char *, integer *, integer *, doublereal *, doublereal *,
doublereal *, integer *, doublereal *), xerbla_(char *,
integer *);
static doublereal smlnum;
static integer itn;
static doublereal tau;
static integer its;
static doublereal ulp, tst1;
开发者ID:deepakantony， 项目名称:vispack， 代码行数:64， 代码来源:dhseqr.c
示例3: zlarfgp_
/* Subroutine */
int zlarfgp_(integer *n, doublecomplex *alpha, doublecomplex *x, integer *incx, doublecomplex *tau)
{
/* System generated locals */
integer i__1, i__2;
doublereal d__1, d__2;
doublecomplex z__1, z__2;
/* Builtin functions */
double d_imag(doublecomplex *), d_sign(doublereal *, doublereal *), z_abs( doublecomplex *);
/* Local variables */
integer j;
doublecomplex savealpha;
integer knt;
doublereal beta, alphi, alphr;
extern /* Subroutine */
int zscal_(integer *, doublecomplex *, doublecomplex *, integer *);
doublereal xnorm;
extern doublereal dlapy2_(doublereal *, doublereal *), dlapy3_(doublereal *, doublereal *, doublereal *), dznrm2_(integer *, doublecomplex * , integer *), dlamch_(char *);
extern /* Subroutine */
int zdscal_(integer *, doublereal *, doublecomplex *, integer *);
doublereal bignum;
extern /* Double Complex */
VOID zladiv_(doublecomplex *, doublecomplex *, doublecomplex *);
doublereal smlnum;
/* -- LAPACK auxiliary routine (version 3.4.2) -- */
/* -- LAPACK is a software package provided by Univ. of Tennessee, -- */
/* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */
/* September 2012 */
/* .. Scalar Arguments .. */
/* .. */
/* .. Array Arguments .. */
/* .. */
/* ===================================================================== */
/* .. Parameters .. */
/* .. */
/* .. Local Scalars .. */
/* .. */
/* .. External Functions .. */
/* .. */
/* .. Intrinsic Functions .. */
/* .. */
/* .. External Subroutines .. */
/* .. */
/* .. Executable Statements .. */
/* Parameter adjustments */
--x;
/* Function Body */
if (*n <= 0)
{
tau->r = 0., tau->i = 0.;
return 0;
}
i__1 = *n - 1;
xnorm = dznrm2_(&i__1, &x[1], incx);
alphr = alpha->r;
alphi = d_imag(alpha);
if (xnorm == 0.)
{
/* H = [1-alpha/abs(alpha) 0;
0 I], sign chosen so ALPHA >= 0. */
if (alphi == 0.)
{
if (alphr >= 0.)
{
/* When TAU.eq.ZERO, the vector is special-cased to be */
/* all zeros in the application routines. We do not need */
/* to clear it. */
tau->r = 0., tau->i = 0.;
}
else
{
/* However, the application routines rely on explicit */
/* zero checks when TAU.ne.ZERO, and we must clear X. */
tau->r = 2., tau->i = 0.;
i__1 = *n - 1;
for (j = 1;
j <= i__1;
++j)
{
i__2 = (j - 1) * *incx + 1;
x[i__2].r = 0.;
x[i__2].i = 0.; // , expr subst
}
z__1.r = -alpha->r;
z__1.i = -alpha->i; // , expr subst
alpha->r = z__1.r, alpha->i = z__1.i;
}
}
else
{
/* Only "reflecting" the diagonal entry to be real and non-negative. */
xnorm = dlapy2_(&alphr, &alphi);
d__1 = 1. - alphr / xnorm;
d__2 = -alphi / xnorm;
z__1.r = d__1;
z__1.i = d__2; // , expr subst
tau->r = z__1.r, tau->i = z__1.i;
i__1 = *n - 1;
for (j = 1;
j <= i__1;
//.........这里部分代码省略.........
开发者ID:fmarrabal， 项目名称:libflame， 代码行数:101， 代码来源:zlarfgp.c
示例4: dlaein_
/* Subroutine */
int dlaein_(logical *rightv, logical *noinit, integer *n, doublereal *h__, integer *ldh, doublereal *wr, doublereal *wi, doublereal *vr, doublereal *vi, doublereal *b, integer *ldb, doublereal *work, doublereal *eps3, doublereal *smlnum, doublereal * bignum, integer *info)
{
/* System generated locals */
integer b_dim1, b_offset, h_dim1, h_offset, i__1, i__2, i__3, i__4;
doublereal d__1, d__2, d__3, d__4;
/* Builtin functions */
double sqrt(doublereal);
/* Local variables */
integer i__, j;
doublereal w, x, y;
integer i1, i2, i3;
doublereal w1, ei, ej, xi, xr, rec;
integer its, ierr;
doublereal temp, norm, vmax;
extern doublereal dnrm2_(integer *, doublereal *, integer *);
extern /* Subroutine */
int dscal_(integer *, doublereal *, doublereal *, integer *);
doublereal scale;
extern doublereal dasum_(integer *, doublereal *, integer *);
char trans[1];
doublereal vcrit, rootn, vnorm;
extern doublereal dlapy2_(doublereal *, doublereal *);
doublereal absbii, absbjj;
extern integer idamax_(integer *, doublereal *, integer *);
extern /* Subroutine */
int dladiv_(doublereal *, doublereal *, doublereal *, doublereal *, doublereal *, doublereal *), dlatrs_( char *, char *, char *, char *, integer *, doublereal *, integer * , doublereal *, doublereal *, doublereal *, integer *);
char normin[1];
doublereal nrmsml, growto;
/* -- LAPACK auxiliary routine (version 3.4.2) -- */
/* -- LAPACK is a software package provided by Univ. of Tennessee, -- */
/* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */
/* September 2012 */
/* .. Scalar Arguments .. */
/* .. */
/* .. Array Arguments .. */
/* .. */
/* ===================================================================== */
/* .. Parameters .. */
/* .. */
/* .. Local Scalars .. */
/* .. */
/* .. External Functions .. */
/* .. */
/* .. External Subroutines .. */
/* .. */
/* .. Intrinsic Functions .. */
/* .. */
/* .. Executable Statements .. */
/* Parameter adjustments */
h_dim1 = *ldh;
h_offset = 1 + h_dim1;
h__ -= h_offset;
--vr;
--vi;
b_dim1 = *ldb;
b_offset = 1 + b_dim1;
b -= b_offset;
--work;
/* Function Body */
*info = 0;
/* GROWTO is the threshold used in the acceptance test for an */
/* eigenvector. */
rootn = sqrt((doublereal) (*n));
growto = .1 / rootn;
/* Computing MAX */
d__1 = 1.;
d__2 = *eps3 * rootn; // , expr subst
nrmsml = max(d__1,d__2) * *smlnum;
/* Form B = H - (WR,WI)*I (except that the subdiagonal elements and */
/* the imaginary parts of the diagonal elements are not stored). */
i__1 = *n;
for (j = 1;
j <= i__1;
++j)
{
i__2 = j - 1;
for (i__ = 1;
i__ <= i__2;
++i__)
{
b[i__ + j * b_dim1] = h__[i__ + j * h_dim1];
/* L10: */
}
b[j + j * b_dim1] = h__[j + j * h_dim1] - *wr;
/* L20: */
}
if (*wi == 0.)
{
/* Real eigenvalue. */
if (*noinit)
{
/* Set initial vector. */
i__1 = *n;
for (i__ = 1;
i__ <= i__1;
++i__)
{
vr[i__] = *eps3;
/* L30: */
//.........这里部分代码省略.........
开发者ID:csapng， 项目名称:libflame， 代码行数:101， 代码来源:dlaein.c
示例5: zdotc_
/* Subroutine */ int zgetv0_(integer *ido, char *bmat, integer *itry, logical
*initv, integer *n, integer *j, doublecomplex *v, integer *ldv,
doublecomplex *resid, doublereal *rnorm, integer *ipntr,
doublecomplex *workd, integer *ierr, ftnlen bmat_len)
{
/* Initialized data */
static logical inits = TRUE_;
/* System generated locals */
integer v_dim1, v_offset, i__1, i__2;
doublereal d__1, d__2;
doublecomplex z__1;
/* Local variables */
static real t0, t1, t2, t3;
static integer jj, iter;
static logical orth;
static integer iseed[4], idist;
static doublecomplex cnorm;
extern /* Double Complex */ void zdotc_(doublecomplex *, integer *,
doublecomplex *, integer *, doublecomplex *, integer *);
static logical first;
extern /* Subroutine */ int zgemv_(char *, integer *, integer *,
doublecomplex *, doublecomplex *, integer *, doublecomplex *,
integer *, doublecomplex *, doublecomplex *, integer *, ftnlen),
dvout_(integer *, integer *, doublereal *, integer *, char *,
ftnlen), zcopy_(integer *, doublecomplex *, integer *,
doublecomplex *, integer *), zvout_(integer *, integer *,
doublecomplex *, integer *, char *, ftnlen);
extern doublereal dlapy2_(doublereal *, doublereal *), dznrm2_(integer *,
doublecomplex *, integer *);
static doublereal rnorm0;
extern /* Subroutine */ int arscnd_(real *);
static integer msglvl;
extern /* Subroutine */ int zlarnv_(integer *, integer *, integer *,
doublecomplex *);
/* %----------------------------------------------------% */
/* | Include files for debugging and timing information | */
/* %----------------------------------------------------% */
/* \SCCS Information: @(#) */
/* FILE: debug.h SID: 2.3 DATE OF SID: 11/16/95 RELEASE: 2 */
/* %---------------------------------% */
/* | See debug.doc for documentation | */
/* %---------------------------------% */
/* %------------------% */
/* | Scalar Arguments | */
/* %------------------% */
/* %--------------------------------% */
/* | See stat.doc for documentation | */
/* %--------------------------------% */
/* \SCCS Information: @(#) */
/* FILE: stat.h SID: 2.2 DATE OF SID: 11/16/95 RELEASE: 2 */
/* %-----------------% */
/* | Array Arguments | */
/* %-----------------% */
/* %------------% */
/* | Parameters | */
/* %------------% */
/* %------------------------% */
/* | Local Scalars & Arrays | */
/* %------------------------% */
/* %----------------------% */
/* | External Subroutines | */
/* %----------------------% */
/* %--------------------% */
/* | External Functions | */
/* %--------------------% */
/* %-----------------% */
/* | Data Statements | */
/* %-----------------% */
/* Parameter adjustments */
--workd;
--resid;
v_dim1 = *ldv;
v_offset = 1 + v_dim1;
v -= v_offset;
--ipntr;
//.........这里部分代码省略.........
开发者ID:cadarso， 项目名称:tensor， 代码行数:101， 代码来源:zgetv0.f.c
示例6: drot_
/* Subroutine */ int dlasd2_(integer *nl, integer *nr, integer *sqre, integer
*k, doublereal *d__, doublereal *z__, doublereal *alpha, doublereal *
beta, doublereal *u, integer *ldu, doublereal *vt, integer *ldvt,
doublereal *dsigma, doublereal *u2, integer *ldu2, doublereal *vt2,
integer *ldvt2, integer *idxp, integer *idx, integer *idxc, integer *
idxq, integer *coltyp, integer *info)
{
/* System generated locals */
integer u_dim1, u_offset, u2_dim1, u2_offset, vt_dim1, vt_offset,
vt2_dim1, vt2_offset, i__1;
doublereal d__1, d__2;
/* Local variables */
doublereal c__;
integer i__, j, m, n;
doublereal s;
integer k2;
doublereal z1;
integer ct, jp;
doublereal eps, tau, tol;
integer psm[4], nlp1, nlp2, idxi, idxj;
extern /* Subroutine */ int drot_(integer *, doublereal *, integer *,
doublereal *, integer *, doublereal *, doublereal *);
integer ctot[4], idxjp;
extern /* Subroutine */ int dcopy_(integer *, doublereal *, integer *,
doublereal *, integer *);
integer jprev;
extern doublereal dlapy2_(doublereal *, doublereal *), dlamch_(char *);
extern /* Subroutine */ int dlamrg_(integer *, integer *, doublereal *,
integer *, integer *, integer *), dlacpy_(char *, integer *,
integer *, doublereal *, integer *, doublereal *, integer *), dlaset_(char *, integer *, integer *, doublereal *,
doublereal *, doublereal *, integer *), xerbla_(char *,
integer *);
doublereal hlftol;
/* -- LAPACK auxiliary routine (version 3.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* .. Array Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* DLASD2 merges the two sets of singular values together into a single */
/* sorted set. Then it tries to deflate the size of the problem. */
/* There are two ways in which deflation can occur: when two or more */
/* singular values are close together or if there is a tiny entry in the */
/* Z vector. For each such occurrence the order of the related secular */
/* equation problem is reduced by one. */
/* DLASD2 is called from DLASD1. */
/* Arguments */
/* ========= */
/* NL (input) INTEGER */
/* The row dimension of the upper block. NL >= 1. */
/* NR (input) INTEGER */
/* The row dimension of the lower block. NR >= 1. */
/* SQRE (input) INTEGER */
/* = 0: the lower block is an NR-by-NR square matrix. */
/* = 1: the lower block is an NR-by-(NR+1) rectangular matrix. */
/* The bidiagonal matrix has N = NL + NR + 1 rows and */
/* M = N + SQRE >= N columns. */
/* K (output) INTEGER */
/* Contains the dimension of the non-deflated matrix, */
/* This is the order of the related secular equation. 1 <= K <=N. */
/* D (input/output) DOUBLE PRECISION array, dimension(N) */
/* On entry D contains the singular values of the two submatrices */
/* to be combined. On exit D contains the trailing (N-K) updated */
/* singular values (those which were deflated) sorted into */
/* increasing order. */
/* Z (output) DOUBLE PRECISION array, dimension(N) */
/* On exit Z contains the updating row vector in the secular */
/* equation. */
/* ALPHA (input) DOUBLE PRECISION */
/* Contains the diagonal element associated with the added row. */
/* BETA (input) DOUBLE PRECISION */
/* Contains the off-diagonal element associated with the added */
/* row. */
/* U (input/output) DOUBLE PRECISION array, dimension(LDU,N) */
/* On entry U contains the left singular vectors of two */
/* submatrices in the two square blocks with corners at (1,1), */
/* (NL, NL), and (NL+2, NL+2), (N,N). */
/* On exit U contains the trailing (N-K) updated left singular */
/* vectors (those which were deflated) in its last N-K columns. */
//.........这里部分代码省略.........
开发者ID:Ayato-Harashima， 项目名称:Bundler， 代码行数:101， 代码来源:dlasd2.c
示例7: sqrt
/* Subroutine */ int zsteqr_(char *compz, integer *n, doublereal *d__,
doublereal *e, doublecomplex *z__, integer *ldz, doublereal *work,
integer *info)
{
/* System generated locals */
integer z_dim1, z_offset, i__1, i__2;
doublereal d__1, d__2;
/* Builtin functions */
double sqrt(doublereal), d_sign(doublereal *, doublereal *);
/* Local variables */
doublereal b, c__, f, g;
integer i__, j, k, l, m;
doublereal p, r__, s;
integer l1, ii, mm, lm1, mm1, nm1;
doublereal rt1, rt2, eps;
integer lsv;
doublereal tst, eps2;
integer lend, jtot;
extern /* Subroutine */ int dlae2_(doublereal *, doublereal *, doublereal
*, doublereal *, doublereal *);
extern logical lsame_(char *, char *);
doublereal anorm;
extern /* Subroutine */ int zlasr_(char *, char *, char *, integer *,
integer *, doublereal *, doublereal *, doublecomplex *, integer *), zswap_(integer *, doublecomplex *,
integer *, doublecomplex *, integer *), dlaev2_(doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *, doublereal *);
integer lendm1, lendp1;
extern doublereal dlapy2_(doublereal *, doublereal *), dlamch_(char *);
integer iscale;
extern /* Subroutine */ int dlascl_(char *, integer *, integer *,
doublereal *, doublereal *, integer *, integer *, doublereal *,
integer *, integer *);
doublereal safmin;
extern /* Subroutine */ int dlartg_(doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *);
doublereal safmax;
extern /* Subroutine */ int xerbla_(char *, integer *);
extern doublereal dlanst_(char *, integer *, doublereal *, doublereal *);
extern /* Subroutine */ int dlasrt_(char *, integer *, doublereal *,
integer *);
integer lendsv;
doublereal ssfmin;
integer nmaxit, icompz;
doublereal ssfmax;
extern /* Subroutine */ int zlaset_(char *, integer *, integer *,
doublecomplex *, doublecomplex *, doublecomplex *, integer *);
/* -- LAPACK routine (version 3.2) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* .. Array Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* ZSTEQR computes all eigenvalues and, optionally, eigenvectors of a */
/* symmetric tridiagonal matrix using the implicit QL or QR method. */
/* The eigenvectors of a full or band complex Hermitian matrix can also */
/* be found if ZHETRD or ZHPTRD or ZHBTRD has been used to reduce this */
/* matrix to tridiagonal form. */
/* Arguments */
/* ========= */
/* COMPZ (input) CHARACTER*1 */
/* = 'N': Compute eigenvalues only. */
/* = 'V': Compute eigenvalues and eigenvectors of the original */
/* Hermitian matrix. On entry, Z must contain the */
/* unitary matrix used to reduce the original matrix */
/* to tridiagonal form. */
/* = 'I': Compute eigenvalues and eigenvectors of the */
/* tridiagonal matrix. Z is initialized to the identity */
/* matrix. */
/* N (input) INTEGER */
/* The order of the matrix. N >= 0. */
/* D (input/output) DOUBLE PRECISION array, dimension (N) */
/* On entry, the diagonal elements of the tridiagonal matrix. */
/* On exit, if INFO = 0, the eigenvalues in ascending order. */
/* E (input/output) DOUBLE PRECISION array, dimension (N-1) */
/* On entry, the (n-1) subdiagonal elements of the tridiagonal */
/* matrix. */
/* On exit, E has been destroyed. */
/* Z (input/output) COMPLEX*16 array, dimension (LDZ, N) */
/* On entry, if COMPZ = 'V', then Z contains the unitary */
/* matrix used in the reduction to tridiagonal form. */
/* On exit, if INFO = 0, then if COMPZ = 'V', Z contains the */
/* orthonormal eigenvectors of the original Hermitian matrix, */
/* and if COMPZ = 'I', Z contains the orthonormal eigenvectors */
//.........这里部分代码省略.........
开发者ID:0u812， 项目名称:roadrunner-backup， 代码行数:101， 代码来源:zsteqr.c
示例8: s_cmp
/* Subroutine */ int dsortc_(char *which, logical *apply, integer *n,
doublereal *xreal, doublereal *ximag, doublereal *y, ftnlen which_len)
{
/* System generated locals */
integer i__1;
doublereal d__1, d__2;
/* Builtin functions */
integer s_cmp(char *, char *, ftnlen, ftnlen);
/* Local variables */
static integer i__, j, igap;
static doublereal temp, temp1, temp2;
extern doublereal dlapy2_(doublereal *, doublereal *);
/* %------------------% */
/* | Scalar Arguments | */
/* %------------------% */
/* %-----------------% */
/* | Array Arguments | */
/* %-----------------% */
/* %---------------% */
/* | Local Scalars | */
/* %---------------% */
/* %--------------------% */
/* | External Functions | */
/* %--------------------% */
/* %-----------------------% */
/* | Executable Statements | */
/* %-----------------------% */
igap = *n / 2;
if (s_cmp(which, "LM", (ftnlen)2, (ftnlen)2) == 0) {
/* %------------------------------------------------------% */
/* | Sort XREAL,XIMAG into increasing order of magnitude. | */
/* %------------------------------------------------------% */
L10:
if (igap == 0) {
goto L9000;
}
i__1 = *n - 1;
for (i__ = igap; i__ <= i__1; ++i__) {
j = i__ - igap;
L20:
if (j < 0) {
goto L30;
}
temp1 = dlapy2_(&xreal[j], &ximag[j]);
temp2 = dlapy2_(&xreal[j + igap], &ximag[j + igap]);
if (temp1 > temp2) {
temp = xreal[j];
xreal[j] = xreal[j + igap];
xreal[j + igap] = temp;
temp = ximag[j];
ximag[j] = ximag[j + igap];
ximag[j + igap] = temp;
if (*apply) {
temp = y[j];
y[j] = y[j + igap];
y[j + igap] = temp;
}
} else {
goto L30;
}
j -= igap;
goto L20;
L30:
;
}
igap /= 2;
goto L10;
} else if (s_cmp(which, "SM", (ftnlen)2, (ftnlen)2) == 0) {
/* %------------------------------------------------------% */
/* | Sort XREAL,XIMAG into decreasing order of magnitude. | */
/* %------------------------------------------------------% */
L40:
if (igap == 0) {
goto L9000;
}
//.........这里部分代码省略.........
开发者ID:Electrostatics， 项目名称:FETK， 代码行数:101， 代码来源:dsortc.c
示例9: lsame_
//.........这里部分代码省略.........
/* If INFO > 0 from DHSEQR, then quit */
if (*info > 0) {
goto L50;
}
if (wantvl || wantvr) {
/* Compute left and/or right eigenvectors */
/* (Workspace: need 4*N) */
dtrevc_(side, "B", select, n, &a[a_offset], lda, &vl[vl_offset], ldvl,
&vr[vr_offset], ldvr, n, &nout, &work[iwrk], &ierr);
}
if (wantvl) {
/* Undo balancing of left eigenvectors */
/* (Workspace: need N) */
dgebak_("B", "L", n, &ilo, &ihi, &work[ibal], n, &vl[vl_offset], ldvl,
&ierr);
/* Normalize left eigenvectors and make largest component real */
i__1 = *n;
for (i__ = 1; i__ <= i__1; ++i__) {
if (wi[i__] == 0.) {
scl = 1. / dnrm2_(n, &vl[i__ * vl_dim1 + 1], &c__1);
dscal_(n, &scl, &vl[i__ * vl_dim1 + 1], &c__1);
} else if (wi[i__] > 0.) {
d__1 = dnrm2_(n, &vl[i__ * vl_dim1 + 1], &c__1);
d__2 = dnrm2_(n, &vl[(i__ + 1) * vl_dim1 + 1], &c__1);
scl = 1. / dlapy2_(&d__1, &d__2);
dscal_(n, &scl, &vl[i__ * vl_dim1 + 1], &c__1);
dscal_(n, &scl, &vl[(i__ + 1) * vl_dim1 + 1], &c__1);
i__2 = *n;
for (k = 1; k <= i__2; ++k) {
/* Computing 2nd power */
d__1 = vl[k + i__ * vl_dim1];
/* Computing 2nd power */
d__2 = vl[k + (i__ + 1) * vl_dim1];
work[iwrk + k - 1] = d__1 * d__1 + d__2 * d__2;
}
k = idamax_(n, &work[iwrk], &c__1);
dlartg_(&vl[k + i__ * vl_dim1], &vl[k + (i__ + 1) * vl_dim1],
&cs, &sn, &r__);
drot_(n, &vl[i__ * vl_dim1 + 1], &c__1, &vl[(i__ + 1) *
vl_dim1 + 1], &c__1, &cs, &sn);
vl[k + (i__ + 1) * vl_dim1] = 0.;
}
}
}
if (wantvr) {
/* Undo balancing of right eigenvectors */
/* (Workspace: need N) */
dgebak_("B", "R", n, &ilo, &ihi, &work[ibal], n, &vr[vr_offset], ldvr,
&ierr);
/* Normalize right eigenvectors and make largest component real */
i__1 = *n;
for (i__ = 1; i__ <= i__1; ++i__) {开发者ID:juanjosegarciaripoll， 项目名称:cblapack， 代码行数:67， 代码来源:dgeev.c
示例10: sqrt
/* Subroutine */ int dsterf_(integer *n, doublereal *d__, doublereal *e,
integer *info)
{
/* System generated locals */
integer i__1;
doublereal d__1, d__2, d__3;
/* Builtin functions */
double sqrt(doublereal), d_sign(doublereal *, doublereal *);
/* Local variables */
static doublereal oldc;
static integer lend, jtot;
extern /* Subroutine */ int dlae2_(doublereal *, doublereal *, doublereal
*, doublereal *, doublereal *);
static doublereal c__;
static integer i__, l, m;
static doublereal p, gamma, r__, s, alpha, sigma, anorm;
static integer l1;
extern doublereal dlapy2_(doublereal *, doublereal *);
static doublereal bb;
extern doublereal dlamch_(char *);
static integer iscale;
extern /* Subroutine */ int dlascl_(char *, integer *, integer *,
doublereal *, doublereal *, integer *, integer *, doublereal *,
integer *, integer *);
static doublereal oldgam, safmin;
extern /* Subroutine */ int xerbla_(char *, integer *);
static doublereal safmax;
extern doublereal dlanst_(char *, integer *, doublereal *, doublereal *);
extern /* Subroutine */ int dlasrt_(char *, integer *, doublereal *,
integer *);
static integer lendsv;
static doublereal ssfmin;
static integer nmaxit;
static doublereal ssfmax, rt1, rt2, eps, rte;
static integer lsv;
static doublereal eps2;
/* -- LAPACK routine (instrumented to count operations, version 3.0) --
Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
Courant Institute, Argonne National Lab, and Rice University
June 30, 1999
Common block to return operation count and iteration count
ITCNT is initialized to 0, OPS is only incremented
Purpose
=======
DSTERF 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) DOUBLE PRECISION 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) DOUBLE PRECISION 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 */
--e;
--d__;
/* Function Body */
*info = 0;
/* Quick return if possible */
latime_1.itcnt = 0.;
if (*n < 0) {
*info = -1;
i__1 = -(*info);
xerbla_("DSTERF", &i__1);
return 0;
}
if (*n <= 1) {
return 0;
}
//.........这里部分代码省略.........
开发者ID:zangel， 项目名称:uquad， 代码行数:101， 代码来源:dsterf.c
示例11: dnrm2_
/* Subroutine */ int dneigh_(doublereal *rnorm, integer *n, doublereal *h__,
integer *ldh, doublereal *ritzr, doublereal *ritzi, doublereal *
bounds, doublereal *q, integer *ldq, doublereal *workl, integer *ierr)
{
/* System generated locals */
integer h_dim1, h_offset, q_dim1, q_offset, i__1;
doublereal d__1, d__2;
/* Local variables */
static integer i__;
static real t0, t1;
static doublereal vl[1], temp;
extern doublereal dnrm2_(integer *, doublereal *, integer *);
extern /* Subroutine */ int dscal_(integer *, doublereal *, doublereal *,
integer *);
static integer iconj;
extern /* Subroutine */ int dgemv_(char *, integer *, integer *,
doublereal *, doublereal *, integer *, doublereal *, integer *,
doublereal *, doublereal *, integer *, ftnlen), dmout_(integer *,
integer *, integer *, doublereal *, integer *, integer *, char *,
ftnlen), dvout_(integer *, integer *, doublereal *, integer *,
char *, ftnlen);
extern doublereal dlapy2_(doublereal *, doublereal *);
extern /* Subroutine */ int dlaqrb_(logical *, integer *, integer *,
integer *, doublereal *, integer *, doublereal *, doublereal *,
doublereal *, integer *), second_(real *);
static logical select[1];
static integer msglvl;
extern /* Subroutine */ int dlacpy_(char *, integer *, integer *,
doublereal *, integer *, doublereal *, integer *, ftnlen),
dtrevc_(char *, char *, logical *, integer *, doublereal *,
integer *, doublereal *, integer *, doublereal *, integer *,
integer *, integer *, doublereal *, integer *, ftnlen, ftnlen);
/* %----------------------------------------------------% */
/* | Include files for debugging and timing information | */
/* %----------------------------------------------------% */
/* \SCCS Information: @(#) */
/* FILE: debug.h SID: 2.3 DATE OF SID: 11/16/95 RELEASE: 2 */
/* %---------------------------------% */
/* | See debug.doc for documentation | */
/* %---------------------------------% */
/* %------------------% */
/* | Scalar Arguments | */
/* %------------------% */
/* %--------------------------------% */
/* | See stat.doc for documentation | */
/* %--------------------------------% */
/* \SCCS Information: @(#) */
/* FILE: stat.h SID: 2.2 DATE OF SID: 11/16/95 RELEASE: 2 */
/* %-----------------% */
/* | Array Arguments | */
/* %-----------------% */
/* %------------% */
/* | Parameters | */
/* %------------% */
/* %------------------------% */
/* | Local Scalars & Arrays | */
/* %------------------------% */
/* %----------------------% */
/* | External Subroutines | */
/* %----------------------% */
/* %--------------------% */
/* | External Functions | */
/* %--------------------% */
/* %---------------------% */
/* | Intrinsic Functions | */
/* %---------------------% */
/* %-----------------------% */
/* | Executable Statements | */
/* %-----------------------% */
/* %-------------------------------% */
/* | Initialize timing statistics | */
/* | & message level for debugging | */
/* %-------------------------------% */
//.........这里部分代码省略.........
开发者ID:Electrostatics， 项目名称:FETK， 代码行数:101， 代码来源:dneigh.c
示例12: sqrt
/*< SUBROUTINE DSTEQR( COMPZ, N, D, E, Z, LDZ, WORK, INFO ) >*/
/* Subroutine */ int dsteqr_(char *compz, integer *n, doublereal *d__,
doublereal *e, doublereal *z__, integer *ldz, doublereal *work,
integer *info, ftnlen compz_len)
{
/* System generated locals */
integer z_dim1, z_offset, i__1, i__2;
doublereal d__1, d__2;
/* Builtin functions */
double sqrt(doublereal), d_sign(doublereal *, doublereal *);
/* Local variables */
doublereal b, c__, f, g;
integer i__, j, k, l, m;
doublereal p, r__, s;
integer l1, ii, mm, lm1, mm1, nm1;
doublereal rt1, rt2, eps;
integer lsv;
doublereal tst, eps2;
integer lend, jtot;
extern /* Subroutine */ int dlae2_(doublereal *, doublereal *, doublereal
*, doublereal *, doublereal *);
extern logical lsame_(const char *, const char *, ftnlen, ftnlen);
extern /* Subroutine */ int dlasr_(char *, char *, char *, integer *,
integer *, doublereal *, doublereal *, doublereal *, integer *,
ftnlen, ftnlen, ftnlen);
doublereal anorm;
extern /* Subroutine */ int dswap_(integer *, doublereal *, integer *,
doublereal *, integer *), dlaev2_(doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *);
integer lendm1, lendp1;
extern doublereal dlapy2_(doublereal *, doublereal *), dlamch_(char *,
ftnlen);
integer iscale;
extern /* Subroutine */ int dlascl_(char *, integer *, integer *,
doublereal *, doublereal *, integer *, integer *, doublereal *,
integer *, integer *, ftnlen), dlaset_(char *, integer *, integer
*, doublereal *, doublereal *, doublereal *, integer *, ftnlen);
doublereal safmin;
extern /* Subroutine */ int dlartg_(doublereal *, doublereal *,
doublereal *, doublereal *, doublereal *);
doublereal safmax;
extern /* Subroutine */ int xerbla_(char *, integer *, ftnlen);
extern doublereal dlanst_(char *, integer *, doublereal *, doublereal *,
ftnlen);
extern /* Subroutine */ int dlasrt_(char *, integer *, doublereal *,
integer *, ftnlen);
integer lendsv;
doublereal ssfmin;
integer nmaxit, icompz;
doublereal ssfmax;
/* -- LAPACK routine (version 3.2) -- */
/* -- LAPACK is a software package provided by Univ. of Tennessee, -- */
/* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */
/* November 2006 */
/* .. Scalar Arguments .. */
/*< CHARACTER COMPZ >*/
/*< INTEGER INFO, LDZ, N >*/
/* .. */
/* .. Array Arguments .. */
/*< DOUBLE PRECISION D( * ), E( * ), WORK( * ), Z( LDZ, * ) >*/
/* .. */
/* Purpose */
/* ======= */
/* DSTEQR computes all eigenvalues and, optionally, eigenvectors of a */
/* symmetric tridiagonal matrix using the implicit QL or QR method. */
/* The eigenvectors of a full or band symmetric matrix can also be found */
/* if DSYTRD or DSPTRD or DSBTRD has been used to reduce this matrix to */
/* tridiagonal form. */
/* Arguments */
/* ========= */
/* COMPZ (input) CHARACTER*1 */
/* = 'N': Compute eigenvalues only. */
/* = 'V': Compute eigenvalues and eigenvectors of the original */
/* symmetric matrix. On entry, Z must contain the */
/* orthogonal matrix used to reduce the original matrix */
/* to tridiagonal form. */
/* = 'I': Compute eigenvalues and eigenvectors of the */
/* tridiagonal matrix. Z is initialized to the identity */
/* matrix. */
/* N (input) INTEGER */
/* The order of the matrix. N >= 0. */
/* D (input/output) DOUBLE PRECISION array, dimension (N) */
/* On entry, the diagonal elements of the tridiagonal matrix. */
/* On exit, if INFO = 0, the eigenvalues in ascending order. */
/* E (input/output) DOUBLE PRECISION array, dimension (N-1) */
/* On entry, the (n-1) subdiagonal elements of the tridiagonal */
/* matrix. */
//.........这里部分代码省略.........
开发者ID:151706061， 项目名称:ITK， 代码行数:101， 代码来源:dsteqr.c
示例13: COMPZ
//.........这里部分代码省略.........
static logical c_false = FALSE_;
/* System generated locals */
address a__1[2];
integer h_dim1, h_offset, z_dim1, z_offset, i__1, i__2, i__3, i__4[2],
i__5, i__6;
doublereal d__1, d__2, d__3, d__4;
doublecomplex z__1;
char ch__1[2];
/* Builtin functions */
double d_imag(doublecomplex *);
void d_cnjg(doublecomplex *, doublecomplex *);
/* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
/* Local variables */
static integer maxb, ierr;
static doublereal unfl;
static doublecomplex temp;
static doublereal ovfl;
static integer i__, j, k, l;
static doublecomplex s[225] /* was [15][15] */, v[16];
extern logical lsame_(char *, char *);
extern /* Subroutine */ int zscal_(integer *, doublecomplex *,
doublecomplex *, integer *);
static integer itemp;
static doublereal rtemp;
static integer i1, i2;
extern /* Subroutine */ int zgemv_(char *, integer *, integer *,
doublecomplex *, doublecomplex *, integer *, doublecomplex *,
integer *, doublecomplex *, doublecomplex *, integer *);
static logical initz, wantt, wantz;
static doublereal rwork[1];
extern /* Subroutine */ int zcopy_(integer *, doublecomplex *, integer *,
doublecomplex *, integer *);
extern doublereal dlapy2_(doublereal *, doublereal *);
extern /* Subroutine */ int dlabad_(doublereal *, doublereal *);
static integer ii, nh;
extern doublereal dlamch_(char *);
static integer nr, ns, nv;
static doublecomplex vv[16];
extern /* Subroutine */ int xerbla_(char *, integer *);
extern integer ilaenv_(integer *, char *, char *, integer *, integer *,
integer *, integer *, ftnlen, ftnlen);
extern /* Subroutine */ int zdscal_(integer *, doublereal *,
doublecomplex *, integer *), zlarfg_(integer *, doublecomplex *,
doublecomplex *, integer *, doublecomplex *);
extern integer izamax_(integer *, doublecomplex *, integer *);
extern doublereal zlanhs_(char *, integer *, doublecomplex *, integer *,
doublereal *);
extern /* Subroutine */ int zlahqr_(logical *, logical *, integer *,
integer *, integer *, doublecomplex *, integer *, doublecomplex *,
integer *, integer *, doublecomplex *, integer *, integer *),
zlacpy_(char *, integer *, integer *, doublecomplex *, integer *,
doublecomplex *, integer *), zlaset_(char *, integer *,
integer *, doublecomplex *, doublecomplex *, doublecomplex *,
integer *), zlarfx_(char *, integer *, integer *,
doublecomplex *, doublecomplex *, doublecomplex *, integer *,
doublecomplex *);
static doublereal smlnum;
static logical lquery;
static integer itn;
static doublecomplex tau;
static integer its;
static doublereal ulp, tst1;
#define h___subscr(a_1,a_2) (a_2)*h_dim1 + a_1
#define h___ref(a_1,a_2) h__[h___subscr(a_1,a_2)]
#define s_subscr(a_1,a_2) (a_2)*15 + a_1 - 16开发者ID:MichaelH13， 项目名称:sdkpub， 代码行数:67， 代码来源:zhseqr.c
示例14: dlasd2_
/* Subroutine */
int dlasd2_(integer *nl, integer *nr, integer *sqre, integer *k, doublereal *d__, doublereal *z__, doublereal *alpha, doublereal * beta, doublereal *u, integer *ldu, doublereal *vt, integer *ldvt, doublereal *dsigma, doublereal *u2, integer *ldu2, doublereal *vt2, integer *ldvt2, integer *idxp, integer *idx, integer *idxc, integer * idxq, integer *coltyp, integer *info)
{
/* System generated locals */
integer u_dim1, u_offset, u2_dim1, u2_offset, vt_dim1, vt_offset, vt2_dim1, vt2_offset, i__1;
doublereal d__1, d__2;
/* Local variables */
doublereal c__;
integer i__, j, m, n;
doublereal s;
integer k2;
doublereal z1;
integer ct, jp;
doublereal eps, tau, tol;
integer psm[4], nlp1, nlp2, idxi, idxj;
extern /* Subroutine */
int drot_(integer *, doublereal *, integer *, doublereal *, integer *, doublereal *, doublereal *);
integer ctot[4], idxjp;
extern /* Subroutine */
int dcopy_(integer *, doublereal *, integer *, doublereal *, integer *);
integer jprev;
extern doublereal dlapy2_(doublereal *, doublereal *), dlamch_(char *);
extern /* Subroutine */
int dlamrg_(integer *, integer *, doublereal *, integer *, integer *, integer *), dlacpy_(char *, integer *, integer *, doublereal *, integer *, doublereal *, integer *), dlaset_(char *, integer *, integer *, doublereal *, doublereal *, doublereal *, integer *), xerbla_(char *, integer *);
doublereal hlftol;
/* -- LAPACK auxiliary routine (version 3.4.2) -- */
/* -- LAPACK is a software package provided by Univ. of Tennessee, -- */
/* -- Univ. of California Berkeley, Univ. of Colorado Denver and NAG Ltd..-- */
/* September 2012 */
/* .. Scalar Arguments .. */
/* .. */
/* .. Array Arguments .. */
/* .. */
/* ===================================================================== */
/* .. Parameters .. */
/* .. */
/* .. Local Arrays .. */
/* .. */
/* .. Local Scalars .. */
/* .. */
/* .. External Functions .. */
/* .. */
/* .. External Subroutines .. */
/* .. */
/* .. Intrinsic Functions .. */
/* .. */
/* .. Executable Statements .. */
/* Test the input parameters. */
/* Parameter adjustments */
--d__;
--z__;
u_dim1 = *ldu;
u_offset = 1 + u_dim1;
u -= u_offset;
vt_dim1 = *ldvt;
vt_offset = 1 + vt_dim1;
vt -= vt_offset;
--dsigma;
u2_dim1 = *ldu2;
u2_offset = 1 + u2_dim1;
u2 -= u2_offset;
vt2_dim1 = *ldvt2;
vt2_offset = 1 + vt2_dim1;
vt2 -= vt2_offset;
--idxp;
--idx;
--idxc;
--idxq;
--coltyp;
/* Function Body */
*info = 0;
if (*nl < 1)
{
*info = -1;
}
else if (*nr < 1)
{
*info = -2;
}
else if (*sqre != 1 && *sqre != 0)
{
*info = -3;
}
n = *nl + *nr + 1;
m = n + *sqre;
if (*ldu < n)
{
*info = -10;
}
else if (*ldvt < m)
{
*info = -12;
}
else if (*ldu2 < n)
{
*info = -15;
}
else if (*ldvt2 < m)
{
*info = -17;
//.........这里部分代码省略.........
开发者ID:flame， 项目名称:libflame， 代码行数:101， 代码来源:dlasd2.c
六六分期app的软件客服如何联系？不知道吗？加qq群【895510560】即可！标题：六六分期
阅读：18059| 2023-10-27
今天小编告诉大家如何处理win10系统火狐flash插件总是崩溃的问题，可能很多用户都不知
阅读：9605| 2022-11-06
今天小编告诉大家如何对win10系统删除桌面回收站图标进行设置，可能很多用户都不知道
阅读：8146| 2022-11-06
今天小编告诉大家如何对win10系统电脑设置节能降温的设置方法，想必大家都遇到过需要
阅读：8530| 2022-11-06
我们在使用xp系统的过程中,经常需要对xp系统无线网络安装向导设置进行设置，可能很多
阅读：8430| 2022-11-06
今天小编告诉大家如何处理win7系统玩cf老是与主机连接不稳定的问题，可能很多用户都不
阅读：9339| 2022-11-06
电脑对日常生活的重要性小编就不多说了，可是一旦碰到win7系统设置cf烟雾头的问题，很
阅读：8394| 2022-11-06
我们在日常使用电脑的时候，有的小伙伴们可能在打开应用的时候会遇见提示应用程序无法
阅读：7831| 2022-11-06
今天小编告诉大家如何对win7系统打开vcf文件进行设置，可能很多用户都不知道怎么对win
阅读：8382| 2022-11-06
今天小编告诉大家如何对win10系统s4开启USB调试模式进行设置，可能很多用户都不知道怎
阅读：7379| 2022-11-06
客服电话
APP下载
官方微信
请发表评论