本文整理汇总了C++中scopy_函数的典型用法代码示例。如果您正苦于以下问题：C++ scopy_函数的具体用法？C++ scopy_怎么用？C++ scopy_使用的例子？那么恭喜您, 这里精选的函数代码示例或许可以为您提供帮助。
在下文中一共展示了scopy_函数的20个代码示例，这些例子默认根据受欢迎程度排序。您可以为喜欢或者感觉有用的代码点赞，您的评价将有助于我们的系统推荐出更棒的C++代码示例。
示例1: chla_transtype__
//.........这里部分代码省略.........
/* Force HUGEVAL to Inf */
hugeval *= hugeval;
/* Using HUGEVAL may lead to spurious underflows. */
incr_thresh__ = (real) (*n) * eps;
i__1 = *nrhs;
for (j = 1; j <= i__1; ++j) {
y_prec_state__ = 1;
if (y_prec_state__ == 2) {
i__2 = *n;
for (i__ = 1; i__ <= i__2; ++i__) {
y_tail__[i__] = 0.f;
}
}
dxrat = 0.f;
dxratmax = 0.f;
dzrat = 0.f;
dzratmax = 0.f;
final_dx_x__ = hugeval;
final_dz_z__ = hugeval;
prevnormdx = hugeval;
prev_dz_z__ = hugeval;
dz_z__ = hugeval;
dx_x__ = hugeval;
x_state__ = 1;
z_state__ = 0;
incr_prec__ = FALSE_;
i__2 = *ithresh;
for (cnt = 1; cnt <= i__2; ++cnt) {
/* Compute residual RES = B_s - op(A_s) * Y, */
/* op(A) = A, A**T, or A**H depending on TRANS (and type). */
scopy_(n, &b[j * b_dim1 + 1], &c__1, &res[1], &c__1);
if (y_prec_state__ == 0) {
sgemv_(trans, n, n, &c_b6, &a[a_offset], lda, &y[j * y_dim1 +
1], &c__1, &c_b8, &res[1], &c__1);
} else if (y_prec_state__ == 1) {
blas_sgemv_x__(trans_type__, n, n, &c_b6, &a[a_offset], lda, &
y[j * y_dim1 + 1], &c__1, &c_b8, &res[1], &c__1,
prec_type__);
} else {
blas_sgemv2_x__(trans_type__, n, n, &c_b6, &a[a_offset], lda,
&y[j * y_dim1 + 1], &y_tail__[1], &c__1, &c_b8, &res[
1], &c__1, prec_type__);
}
/* XXX: RES is no longer needed. */
scopy_(n, &res[1], &c__1, &dy[1], &c__1);
sgetrs_(trans, n, &c__1, &af[af_offset], ldaf, &ipiv[1], &dy[1],
n, info);
/* Calculate relative changes DX_X, DZ_Z and ratios DXRAT, DZRAT. */
normx = 0.f;
normy = 0.f;
normdx = 0.f;
dz_z__ = 0.f;
ymin = hugeval;
i__3 = *n;
for (i__ = 1; i__ <= i__3; ++i__) {
yk = (r__1 = y[i__ + j * y_dim1], dabs(r__1));
dyk = (r__1 = dy[i__], dabs(r__1));
if (yk != 0.f) {
/* Computing MAX */
r__1 = dz_z__, r__2 = dyk / yk;
开发者ID:juanjosegarciaripoll，项目名称:cblapack，代码行数:67，代码来源:sla_gerfsx_extended.c
示例2: sger_
/* ----------------------------------------------------------------------- */
/* Subroutine */ int sneupd_(logical *rvec, char *howmny, logical *select,
real *dr, real *di, real *z__, integer *ldz, real *sigmar, real *
sigmai, real *workev, char *bmat, integer *n, char *which, integer *
nev, real *tol, real *resid, integer *ncv, real *v, integer *ldv,
integer *iparam, integer *ipntr, real *workd, real *workl, integer *
lworkl, integer *info, ftnlen howmny_len, ftnlen bmat_len, ftnlen
which_len)
{
/* System generated locals */
integer v_dim1, v_offset, z_dim1, z_offset, i__1;
real r__1, r__2;
doublereal d__1;
/* Local variables */
static integer j, k, ih, jj, np;
static real vl[1] /* was [1][1] */;
static integer ibd, ldh, ldq, iri;
static real sep;
static integer irr, wri, wrr, mode;
static real eps23;
extern /* Subroutine */ int sger_(integer *, integer *, real *, real *,
integer *, real *, integer *, real *, integer *);
static integer ierr;
static real temp;
static integer iwev;
static char type__[6];
static real temp1;
extern doublereal snrm2_(integer *, real *, integer *);
static integer ihbds, iconj;
extern /* Subroutine */ int sscal_(integer *, real *, real *, integer *);
static real conds;
static logical reord;
extern /* Subroutine */ int sgemv_(char *, integer *, integer *, real *,
real *, integer *, real *, integer *, real *, real *, integer *,
ftnlen);
static integer nconv, iwork[1];
static real rnorm;
extern /* Subroutine */ int scopy_(integer *, real *, integer *, real *,
integer *);
static integer ritzi;
extern /* Subroutine */ int strmm_(char *, char *, char *, char *,
integer *, integer *, real *, real *, integer *, real *, integer *
, ftnlen, ftnlen, ftnlen, ftnlen), ivout_(integer *, integer *,
integer *, integer *, char *, ftnlen), smout_(integer *, integer *
, integer *, real *, integer *, integer *, char *, ftnlen);
static integer ritzr;
extern /* Subroutine */ int svout_(integer *, integer *, real *, integer *
, char *, ftnlen), sgeqr2_(integer *, integer *, real *, integer *
, real *, real *, integer *);
static integer nconv2;
extern doublereal slapy2_(real *, real *);
extern /* Subroutine */ int sorm2r_(char *, char *, integer *, integer *,
integer *, real *, integer *, real *, real *, integer *, real *,
integer *, ftnlen, ftnlen);
static integer iheigi, iheigr, bounds, invsub, iuptri, msglvl, outncv,
ishift, numcnv;
extern /* Subroutine */ int slacpy_(char *, integer *, integer *, real *,
integer *, real *, integer *, ftnlen), slahqr_(logical *, logical
*, integer *, integer *, integer *, real *, integer *, real *,
real *, integer *, integer *, real *, integer *, integer *),
slaset_(char *, integer *, integer *, real *, real *, real *,
integer *, ftnlen), strevc_(char *, char *, logical *, integer *,
real *, integer *, real *, integer *, real *, integer *, integer *
, integer *, real *, integer *, ftnlen, ftnlen), strsen_(char *,
char *, logical *, integer *, real *, integer *, real *, integer *
, real *, real *, integer *, real *, real *, real *, integer *,
integer *, integer *, integer *, ftnlen, ftnlen);
extern doublereal slamch_(char *, ftnlen);
extern /* Subroutine */ int sngets_(integer *, char *, integer *, integer
*, real *, real *, real *, real *, real *, 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 | */
//.........这里部分代码省略.........
开发者ID:cadarso，项目名称:tensor，代码行数:101，代码来源:sneupd.f.c
示例3: scopy_
/* Subroutine */ int sseigt_(real *rnorm, integer *n, real *h__, integer *ldh,
real *eig, real *bounds, real *workl, integer *ierr)
{
/* System generated locals */
integer h_dim1, h_offset, i__1;
real r__1;
/* Local variables */
static integer k;
static real t0, t1;
extern /* Subroutine */ int scopy_(integer *, real *, integer *, real *,
integer *), svout_(integer *, integer *, real *, integer *, char *
, ftnlen), second_(real *);
static integer msglvl;
extern /* Subroutine */ int sstqrb_(integer *, real *, real *, real *,
real *, integer *);
/* %----------------------------------------------------% */
/* | 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 | */
/* %---------------% */
/* %----------------------% */
/* | External Subroutines | */
/* %----------------------% */
/* %-----------------------% */
/* | Executable Statements | */
/* %-----------------------% */
/* %-------------------------------% */
/* | Initialize timing statistics | */
/* | & message level for debugging | */
/* %-------------------------------% */
/* Parameter adjustments */
--workl;
--bounds;
--eig;
h_dim1 = *ldh;
h_offset = 1 + h_dim1;
h__ -= h_offset;
/* Function Body */
second_(&t0);
msglvl = debug_1.mseigt;
if (msglvl > 0) {
svout_(&debug_1.logfil, n, &h__[(h_dim1 << 1) + 1], &debug_1.ndigit,
"_seigt: main diagonal of matrix H", (ftnlen)33);
if (*n > 1) {
i__1 = *n - 1;
svout_(&debug_1.logfil, &i__1, &h__[h_dim1 + 2], &debug_1.ndigit,
"_seigt: sub diagonal of matrix H", (ftnlen)32);
}
}
scopy_(n, &h__[(h_dim1 << 1) + 1], &c__1, &eig[1], &c__1);
i__1 = *n - 1;
scopy_(&i__1, &h__[h_dim1 + 2], &c__1, &workl[1], &c__1);
sstqrb_(n, &eig[1], &workl[1], &bounds[1], &workl[*n + 1], ierr);
if (*ierr != 0) {
goto L9000;
//.........这里部分代码省略.........
开发者ID:LinkChain，项目名称:pspectralclustering，代码行数:101，代码来源:sseigt.c
示例4: test05
void test05 ( void )
/******************************************************************************/
/*
Purpose:
TEST05 demonstrates SCOPY.
Modified:
29 March 2007
Author:
John Burkardt
*/
{
float a[5*5];
int i;
int inc1;
int inc2;
int j;
int ncopy;
float x[10];
float y[10];
printf ( "\n" );
printf ( "TEST05\n" );
printf ( " SCOPY copies one vector into another.\n" );
printf ( "\n" );
for ( i = 0; i < 10; i++ )
{
x[i] = ( float ) ( i + 1 );
}
for ( i = 0; i < 10; i++ )
{
y[i] = ( float ) ( 10 * ( i + 1 ) );
}
for ( i = 0; i < 5; i++ )
{
for ( j = 0; j < 5; j++ )
{
a[i+j*5] = ( float ) ( 10 * ( i + 1 ) + j + 1 );
}
}
printf ( "\n" );
printf ( " X =\n" );
printf ( "\n" );
for ( i = 0; i < 10; i++ )
{
printf ( " %6d %14f\n", i + 1, x[i] );
}
printf ( "\n" );
printf ( " Y =\n" );
printf ( "\n" );
for ( i = 0; i < 10; i++ )
{
printf ( " %6d %14f\n", i + 1, y[i] );
}
printf ( "\n" );
printf ( " A =\n" );
printf ( "\n" );
for ( i = 0; i < 5; i++ )
{
for ( j = 0; j < 5; j++ )
{
printf ( " %14f", a[i+j*5] );
}
printf ( "\n" );
}
ncopy = 5;
inc1 = 1;
inc2 = 1;
scopy_ ( &ncopy, x, &inc1, y, &inc2 );
printf ( "\n" );
printf ( " SCOPY ( 5, X, 1, Y, 1 )\n" );
printf ( "\n" );
for ( i = 0; i < 10; i++ )
{
printf ( " %6d %14f\n", i + 1, y[i] );
}
for ( i = 0; i < 10; i++ )
{
y[i] = ( float ) ( 10 * ( i + 1 ) );
}
ncopy = 3;
inc1 = 2;
inc2 = 3;
scopy_ ( &ncopy, x, &inc1, y, &inc2 );
//.........这里部分代码省略.........
开发者ID:spino327，项目名称:jburkardt-c，代码行数:101，代码来源:super_blas1_s_prb.c
示例5: sdot_
/*< subroutine sqrsl(x,ldx,n,k,qraux,y,qy,qty,b,rsd,xb,job,info) >*/
/* Subroutine */ int sqrsl_(real *x, integer *ldx, integer *n, integer *k,
real *qraux, real *y, real *qy, real *qty, real *b, real *rsd, real *
xb, integer *job, integer *info)
{
/* System generated locals */
integer x_dim1, x_offset, i__1, i__2;
/* Local variables */
integer i__, j;
real t;
logical cb;
integer jj;
logical cr;
integer ju, kp1;
logical cxb, cqy;
real temp;
extern doublereal sdot_(integer *, real *, integer *, real *, integer *);
logical cqty;
extern /* Subroutine */ int scopy_(integer *, real *, integer *, real *,
integer *), saxpy_(integer *, real *, real *, integer *, real *,
integer *);
/*< integer ldx,n,k,job,info >*/
/*< real x(ldx,1),qraux(1),y(1),qy(1),qty(1),b(1),rsd(1),xb(1) >*/
/* sqrsl applies the output of sqrdc to compute coordinate */
/* transformations, projections, and least squares solutions. */
/* for k .le. min(n,p), let xk be the matrix */
/* xk = (x(jpvt(1)),x(jpvt(2)), ... ,x(jpvt(k))) */
/* formed from columns jpvt(1), ... ,jpvt(k) of the original */
/* n x p matrix x that was input to sqrdc (if no pivoting was */
/* done, xk consists of the first k columns of x in their */
/* original order). sqrdc produces a factored orthogonal matrix q */
/* and an upper triangular matrix r such that */
/* xk = q * (r) */
/* (0) */
/* this information is contained in coded form in the arrays */
/* x and qraux. */
/* on entry */
/* x real(ldx,p). */
/* x contains the output of sqrdc. */
/* ldx integer. */
/* ldx is the leading dimension of the array x. */
/* n integer. */
/* n is the number of rows of the matrix xk. it must */
/* have the same value as n in sqrdc. */
/* k integer. */
/* k is the number of columns of the matrix xk. k */
/* must nnot be greater than min(n,p), where p is the */
/* same as in the calling sequence to sqrdc. */
/* qraux real(p). */
/* qraux contains the auxiliary output from sqrdc. */
/* y real(n) */
/* y contains an n-vector that is to be manipulated */
/* by sqrsl. */
/* job integer. */
/* job specifies what is to be computed. job has */
/* the decimal expansion abcde, with the following */
/* meaning. */
/* if a.ne.0, compute qy. */
/* if b,c,d, or e .ne. 0, compute qty. */
/* if c.ne.0, compute b. */
/* if d.ne.0, compute rsd. */
/* if e.ne.0, compute xb. */
/* note that a request to compute b, rsd, or xb */
/* automatically triggers the computation of qty, for */
/* which an array must be provided in the calling */
/* sequence. */
/* on return */
/* qy real(n). */
/* qy conntains q*y, if its computation has been */
/* requested. */
/* qty real(n). */
/* qty contains trans(q)*y, if its computation has */
/* been requested. here trans(q) is the */
/* transpose of the matrix q. */
/* b real(k) */
/* b contains the solution of the least squares problem */
/* minimize norm2(y - xk*b), */
//.........这里部分代码省略.........
开发者ID:Niner10，项目名称:ITK-1，代码行数:101，代码来源:sqrsl.c
示例6: ICOMPQ
//.........这里部分代码省略.........
order.
INFO (output) INTEGER
= 0: successful exit.
< 0: if INFO = -i, the i-th argument had an illegal value.
=====================================================================
Test the input parameters.
Parameter adjustments */
/* Table of constant values */
static real c_b3 = -1.f;
static integer c__1 = 1;
/* System generated locals */
integer q_dim1, q_offset, q2_dim1, q2_offset, i__1;
real r__1;
/* Builtin functions */
double sqrt(doublereal);
/* Local variables */
static integer jlam, imax, jmax;
extern /* Subroutine */ int srot_(integer *, real *, integer *, real *,
integer *, real *, real *);
static real c;
static integer i, j;
static real s, t;
extern /* Subroutine */ int sscal_(integer *, real *, real *, integer *);
static integer k2;
extern /* Subroutine */ int scopy_(integer *, real *, integer *, real *,
integer *);
static integer n1, n2;
extern doublereal slapy2_(real *, real *);
static integer jp;
extern doublereal slamch_(char *);
extern /* Subroutine */ int xerbla_(char *, integer *);
extern integer isamax_(integer *, real *, integer *);
extern /* Subroutine */ int slamrg_(integer *, integer *, real *, integer
*, integer *, integer *), slacpy_(char *, integer *, integer *,
real *, integer *, real *, integer *);
static integer n1p1;
static real eps, tau, tol;
--d;
q_dim1 = *ldq;
q_offset = q_dim1 + 1;
q -= q_offset;
--indxq;
--z;
--dlamda;
q2_dim1 = *ldq2;
q2_offset = q2_dim1 + 1;
q2 -= q2_offset;
--w;
--perm;
givcol -= 3;
givnum -= 3;
--indxp;
--indx;
/* Function Body */
开发者ID:deepakantony，项目名称:vispack，代码行数:67，代码来源:slaed8.c
示例7: s_wsle
/* Subroutine */ int check2_(real *sfac)
{
/* Initialized data */
static real sa = .3f;
static integer incxs[4] = { 1,2,-2,-1 };
static integer incys[4] = { 1,-2,1,-2 };
static integer lens[8] /* was [4][2] */ = { 1,1,2,4,1,1,3,7 };
static integer ns[4] = { 0,1,2,4 };
static real dx1[7] = { .6f,.1f,-.5f,.8f,.9f,-.3f,-.4f };
static real dy1[7] = { .5f,-.9f,.3f,.7f,-.6f,.2f,.8f };
static real dt7[16] /* was [4][4] */ = { 0.f,.3f,.21f,.62f,0.f,.3f,-.07f,
.85f,0.f,.3f,-.79f,-.74f,0.f,.3f,.33f,1.27f };
static real dt8[112] /* was [7][4][4] */ = { .5f,0.f,0.f,0.f,0.f,
0.f,0.f,.68f,0.f,0.f,0.f,0.f,0.f,0.f,.68f,-.87f,0.f,0.f,0.f,0.f,
0.f,.68f,-.87f,.15f,.94f,0.f,0.f,0.f,.5f,0.f,0.f,0.f,0.f,0.f,0.f,
.68f,0.f,0.f,0.f,0.f,0.f,0.f,.35f,-.9f,.48f,0.f,0.f,0.f,0.f,.38f,
-.9f,.57f,.7f,-.75f,.2f,.98f,.5f,0.f,0.f,0.f,0.f,0.f,0.f,.68f,0.f,
0.f,0.f,0.f,0.f,0.f,.35f,-.72f,0.f,0.f,0.f,0.f,0.f,.38f,-.63f,
.15f,.88f,0.f,0.f,0.f,.5f,0.f,0.f,0.f,0.f,0.f,0.f,.68f,0.f,0.f,
0.f,0.f,0.f,0.f,.68f,-.9f,.33f,0.f,0.f,0.f,0.f,.68f,-.9f,.33f,.7f,
-.75f,.2f,1.04f };
static real dt10x[112] /* was [7][4][4] */ = { .6f,0.f,0.f,0.f,0.f,
0.f,0.f,.5f,0.f,0.f,0.f,0.f,0.f,0.f,.5f,-.9f,0.f,0.f,0.f,0.f,0.f,
.5f,-.9f,.3f,.7f,0.f,0.f,0.f,.6f,0.f,0.f,0.f,0.f,0.f,0.f,.5f,0.f,
0.f,0.f,0.f,0.f,0.f,.3f,.1f,.5f,0.f,0.f,0.f,0.f,.8f,.1f,-.6f,.8f,
.3f,-.3f,.5f,.6f,0.f,0.f,0.f,0.f,0.f,0.f,.5f,0.f,0.f,0.f,0.f,0.f,
0.f,-.9f,.1f,.5f,0.f,0.f,0.f,0.f,.7f,.1f,.3f,.8f,-.9f,-.3f,.5f,
.6f,0.f,0.f,0.f,0.f,0.f,0.f,.5f,0.f,0.f,0.f,0.f,0.f,0.f,.5f,.3f,
0.f,0.f,0.f,0.f,0.f,.5f,.3f,-.6f,.8f,0.f,0.f,0.f };
static real dt10y[112] /* was [7][4][4] */ = { .5f,0.f,0.f,0.f,0.f,
0.f,0.f,.6f,0.f,0.f,0.f,0.f,0.f,0.f,.6f,.1f,0.f,0.f,0.f,0.f,0.f,
.6f,.1f,-.5f,.8f,0.f,0.f,0.f,.5f,0.f,0.f,0.f,0.f,0.f,0.f,.6f,0.f,
0.f,0.f,0.f,0.f,0.f,-.5f,-.9f,.6f,0.f,0.f,0.f,0.f,-.4f,-.9f,.9f,
.7f,-.5f,.2f,.6f,.5f,0.f,0.f,0.f,0.f,0.f,0.f,.6f,0.f,0.f,0.f,0.f,
0.f,0.f,-.5f,.6f,0.f,0.f,0.f,0.f,0.f,-.4f,.9f,-.5f,.6f,0.f,0.f,
0.f,.5f,0.f,0.f,0.f,0.f,0.f,0.f,.6f,0.f,0.f,0.f,0.f,0.f,0.f,.6f,
-.9f,.1f,0.f,0.f,0.f,0.f,.6f,-.9f,.1f,.7f,-.5f,.2f,.8f };
static real ssize1[4] = { 0.f,.3f,1.6f,3.2f };
static real ssize2[28] /* was [14][2] */ = { 0.f,0.f,0.f,0.f,0.f,0.f,
0.f,0.f,0.f,0.f,0.f,0.f,0.f,0.f,1.17f,1.17f,1.17f,1.17f,1.17f,
1.17f,1.17f,1.17f,1.17f,1.17f,1.17f,1.17f,1.17f,1.17f };
/* System generated locals */
integer i__1;
real r__1;
/* Builtin functions */
integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen),
e_wsle(void);
/* Subroutine */ int s_stop(char *, ftnlen);
/* Local variables */
integer i__, j, ki, kn, mx, my;
real sx[7], sy[7], stx[7], sty[7];
integer lenx, leny;
extern doublereal sdot_(integer *, real *, integer *, real *, integer *);
integer ksize;
extern /* Subroutine */ int scopy_(integer *, real *, integer *, real *,
integer *), sswap_(integer *, real *, integer *, real *, integer *
), stest_(integer *, real *, real *, real *, real *), saxpy_(
integer *, real *, real *, integer *, real *, integer *), stest1_(
real *, real *, real *, real *);
/* Fortran I/O blocks */
static cilist io___63 = { 0, 6, 0, 0, 0 };
/* .. Parameters .. */
/* .. Scalar Arguments .. */
/* .. Scalars in Common .. */
/* .. Local Scalars .. */
/* .. Local Arrays .. */
/* .. External Functions .. */
/* .. External Subroutines .. */
/* .. Intrinsic Functions .. */
/* .. Common blocks .. */
/* .. Data statements .. */
/* .. Executable Statements .. */
for (ki = 1; ki <= 4; ++ki) {
combla_1.incx = incxs[ki - 1];
combla_1.incy = incys[ki - 1];
mx = abs(combla_1.incx);
my = abs(combla_1.incy);
for (kn = 1; kn <= 4; ++kn) {
combla_1.n = ns[kn - 1];
ksize = min(2,kn);
lenx = lens[kn + (mx << 2) - 5];
leny = lens[kn + (my << 2) - 5];
/* .. Initialize all argument arrays .. */
for (i__ = 1; i__ <= 7; ++i__) {
sx[i__ - 1] = dx1[i__ - 1];
sy[i__ - 1] = dy1[i__ - 1];
/* L20: */
}
if (combla_1.icase == 1) {
/* .. SDOT .. */
//.........这里部分代码省略.........
开发者ID:kstraube，项目名称:hysim，代码行数:101，代码来源:sblat1.c
示例8: lsame_
//.........这里部分代码省略.........
} else {
clascl_("Q", kd, kd, &c_b16, &sigma, n, n, &ab[ab_offset], ldab,
info);
}
if (*abstol > 0.f) {
abstll = *abstol * sigma;
}
if (valeig) {
vll = *vl * sigma;
vuu = *vu * sigma;
}
}
/* Call CHBTRD to reduce Hermitian band matrix to tridiagonal form. */
indd = 1;
inde = indd + *n;
indrwk = inde + *n;
indwrk = 1;
chbtrd_(jobz, uplo, n, kd, &ab[ab_offset], ldab, &rwork[indd], &rwork[
inde], &q[q_offset], ldq, &work[indwrk], &iinfo);
/* If all eigenvalues are desired and ABSTOL is less than or equal */
/* to zero, then call SSTERF or CSTEQR. If this fails for some */
/* eigenvalue, then try SSTEBZ. */
test = FALSE_;
if (indeig) {
if (*il == 1 && *iu == *n) {
test = TRUE_;
}
}
if ((alleig || test) && *abstol <= 0.f) {
scopy_(n, &rwork[indd], &c__1, &w[1], &c__1);
indee = indrwk + (*n << 1);
if (! wantz) {
i__1 = *n - 1;
scopy_(&i__1, &rwork[inde], &c__1, &rwork[indee], &c__1);
ssterf_(n, &w[1], &rwork[indee], info);
} else {
clacpy_("A", n, n, &q[q_offset], ldq, &z__[z_offset], ldz);
i__1 = *n - 1;
scopy_(&i__1, &rwork[inde], &c__1, &rwork[indee], &c__1);
csteqr_(jobz, n, &w[1], &rwork[indee], &z__[z_offset], ldz, &
rwork[indrwk], info);
if (*info == 0) {
i__1 = *n;
for (i__ = 1; i__ <= i__1; ++i__) {
ifail[i__] = 0;
}
}
}
if (*info == 0) {
*m = *n;
goto L30;
}
*info = 0;
}
/* Otherwise, call SSTEBZ and, if eigenvectors are desired, CSTEIN. */
if (wantz) {
*(unsigned char *)order = 'B';
} else {
*(unsigned char *)order = 'E';
}
开发者ID:juanjosegarciaripoll，项目名称:cblapack，代码行数:67，代码来源:chbevx.c
示例9: sasum_
/* DECK SPINIT */
/* Subroutine */ int spinit_(integer *mrelas, integer *nvars__, real *costs,
real *bl, real *bu, integer *ind, real *primal, integer *info, real *
amat, real *csc, real *costsc, real *colnrm, real *xlamda, real *
anorm, real *rhs, real *rhsnrm, integer *ibasis, integer *ibb,
integer *imat, logical *lopt)
{
/* System generated locals */
real r__1, r__2, r__3;
/* Local variables */
static integer i__, j, ip;
static real aij, one;
static integer n20041, n20007, n20070, n20019, n20028, n20056, n20066,
n20074, n20078;
static real cmax, csum, zero, scalr;
extern doublereal sasum_(integer *, real *, integer *);
extern /* Subroutine */ int scopy_(integer *, real *, integer *, real *,
integer *);
static integer iplace;
static logical colscp, minprb, contin, usrbas, cstscp;
static real testsc;
extern /* Subroutine */ int pnnzrs_(integer *, real *, integer *, real *,
integer *, integer *);
/* ***BEGIN PROLOGUE SPINIT */
/* ***SUBSIDIARY */
/* ***PURPOSE Subsidiary to SPLP */
/* ***LIBRARY SLATEC */
/* ***TYPE SINGLE PRECISION (SPINIT-S, DPINIT-D) */
/* ***AUTHOR (UNKNOWN) */
/* ***DESCRIPTION */
/* THE EDITING REQUIRED TO CONVERT THIS SUBROUTINE FROM SINGLE TO */
/* DOUBLE PRECISION INVOLVES THE FOLLOWING CHARACTER STRING CHANGES. */
/* USE AN EDITING COMMAND (CHANGE) /STRING-1/(TO)STRING-2/. */
/* /REAL (12 BLANKS)/DOUBLE PRECISION/,/SCOPY/DCOPY/ */
/* REVISED 810519-0900 */
/* REVISED YYMMDD-HHMM */
/* INITIALIZATION SUBROUTINE FOR SPLP(*) PACKAGE. */
/* ***SEE ALSO SPLP */
/* ***ROUTINES CALLED PNNZRS, SASUM, SCOPY */
/* ***REVISION HISTORY (YYMMDD) */
/* 811215 DATE WRITTEN */
/* 890531 Changed all specific intrinsics to generic. (WRB) */
/* 890605 Removed unreferenced labels. (WRB) */
/* 891214 Prologue converted to Version 4.0 format. (BAB) */
/* 900328 Added TYPE section. (WRB) */
/* ***END PROLOGUE SPINIT */
/* ***FIRST EXECUTABLE STATEMENT SPINIT */
/* Parameter adjustments */
--lopt;
--imat;
--ibb;
--ibasis;
--rhs;
--colnrm;
--csc;
--amat;
--primal;
--ind;
--bu;
--bl;
--costs;
/* Function Body */
zero = 0.f;
one = 1.f;
contin = lopt[1];
usrbas = lopt[2];
colscp = lopt[5];
cstscp = lopt[6];
minprb = lopt[7];
/* SCALE DATA. NORMALIZE BOUNDS. FORM COLUMN CHECK SUMS. */
goto L30001;
/* INITIALIZE ACTIVE BASIS MATRIX. */
L20002:
goto L30002;
L20003:
return 0;
/* PROCEDURE (SCALE DATA. NORMALIZE BOUNDS. FORM COLUMN CHECK SUMS) */
/* DO COLUMN SCALING IF NOT PROVIDED BY THE USER. */
L30001:
if (colscp) {
goto L20004;
}
j = 1;
n20007 = *nvars__;
goto L20008;
L20007:
++j;
L20008:
//.........这里部分代码省略.........
开发者ID:Rufflewind，项目名称:cslatec，代码行数:101，代码来源:spinit.c
示例10: sqrt
/* Subroutine */ int sstemr_(char *jobz, char *range, integer *n, real *d__,
real *e, real *vl, real *vu, integer *il, integer *iu, integer *m,
real *w, real *z__, integer *ldz, integer *nzc, integer *isuppz,
logical *tryrac, real *work, integer *lwork, integer *iwork, integer *
liwork, integer *info)
{
/* System generated locals */
integer z_dim1, z_offset, i__1, i__2;
real r__1, r__2;
/* Builtin functions */
double sqrt(doublereal);
/* Local variables */
integer i__, j;
real r1, r2;
integer jj;
real cs;
integer in;
real sn, wl, wu;
integer iil, iiu;
real eps, tmp;
integer indd, iend, jblk, wend;
real rmin, rmax;
integer itmp;
real tnrm;
integer inde2;
extern /* Subroutine */ int slae2_(real *, real *, real *, real *, real *)
;
integer itmp2;
real rtol1, rtol2, scale;
integer indgp;
extern logical lsame_(char *, char *);
integer iinfo;
extern /* Subroutine */ int sscal_(integer *, real *, real *, integer *);
integer iindw, ilast, lwmin;
extern /* Subroutine */ int scopy_(integer *, real *, integer *, real *,
integer *), sswap_(integer *, real *, integer *, real *, integer *
);
logical wantz;
extern /* Subroutine */ int slaev2_(real *, real *, real *, real *, real *
, real *, real *);
logical alleig;
integer ibegin;
logical indeig;
integer iindbl;
logical valeig;
extern doublereal slamch_(char *);
integer wbegin;
real safmin;
extern /* Subroutine */ int xerbla_(char *, integer *);
real bignum;
integer inderr, iindwk, indgrs, offset;
extern /* Subroutine */ int slarrc_(char *, integer *, real *, real *,
real *, real *, real *, integer *, integer *, integer *, integer *
), slarre_(char *, integer *, real *, real *, integer *,
integer *, real *, real *, real *, real *, real *, real *,
integer *, integer *, integer *, real *, real *, real *, integer *
, integer *, real *, real *, real *, integer *, integer *)
;
real thresh;
integer iinspl, indwrk, ifirst, liwmin, nzcmin;
real pivmin;
extern doublereal slanst_(char *, integer *, real *, real *);
extern /* Subroutine */ int slarrj_(integer *, real *, real *, integer *,
integer *, real *, integer *, real *, real *, real *, integer *,
real *, real *, integer *), slarrr_(integer *, real *, real *,
integer *);
integer nsplit;
extern /* Subroutine */ int slarrv_(integer *, real *, real *, real *,
real *, real *, integer *, integer *, integer *, integer *, real *
, real *, real *, real *, real *, real *, integer *, integer *,
real *, real *, integer *, integer *, real *, integer *, integer *
);
real smlnum;
extern /* Subroutine */ int slasrt_(char *, integer *, real *, integer *);
logical lquery, zquery;
/* -- LAPACK computational routine (version 3.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* .. Array Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* SSTEMR computes selected eigenvalues and, optionally, eigenvectors */
/* of a real symmetric tridiagonal matrix T. Any such unreduced matrix has */
/* a well defined set of pairwise different real eigenvalues, the corresponding */
/* real eigenvectors are pairwise orthogonal. */
/* The spectrum may be computed either completely or partially by specifying */
/* either an interval (VL,VU] or a range of indices IL:IU for the desired */
/* eigenvalues. */
//.........这里部分代码省略.........
开发者ID:dacap，项目名称:loseface，代码行数:101，代码来源:sstemr.c
示例11: lsame_
/* Subroutine */ int sporfs_(char *uplo, integer *n, integer *nrhs, real *a,
integer *lda, real *af, integer *ldaf, real *b, integer *ldb, real *x,
integer *ldx, real *ferr, real *berr, real *work, integer *iwork,
integer *info)
{
/* System generated locals */
integer a_dim1, a_offset, af_dim1, af_offset, b_dim1, b_offset, x_dim1,
x_offset, i__1, i__2, i__3;
real r__1, r__2, r__3;
/* Local variables */
integer i__, j, k;
real s, xk;
integer nz;
real eps;
integer kase;
real safe1, safe2;
extern logical lsame_(char *, char *);
integer isave[3], count;
logical upper;
extern /* Subroutine */ int scopy_(integer *, real *, integer *, real *,
integer *), saxpy_(integer *, real *, real *, integer *, real *,
integer *), ssymv_(char *, integer *, real *, real *, integer *,
real *, integer *, real *, real *, integer *), slacn2_(
integer *, real *, real *, integer *, real *, integer *, integer *
);
extern doublereal slamch_(char *);
real safmin;
extern /* Subroutine */ int xerbla_(char *, integer *);
real lstres;
extern /* Subroutine */ int spotrs_(char *, integer *, integer *, real *,
integer *, real *, integer *, integer *);
/* -- LAPACK routine (version 3.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* Modified to call SLACN2 in place of SLACON, 7 Feb 03, SJH. */
/* .. Scalar Arguments .. */
/* .. */
/* .. Array Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* SPORFS improves the computed solution to a system of linear */
/* equations when the coefficient matrix is symmetric positive definite, */
/* and provides error bounds and backward error estimates for the */
/* solution. */
/* Arguments */
/* ========= */
/* 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. */
/* NRHS (input) INTEGER */
/* The number of right hand sides, i.e., the number of columns */
/* of the matrices B and X. NRHS >= 0. */
/* A (input) REAL array, dimension (LDA,N) */
/* The symmetric matrix A. If UPLO = 'U', the leading N-by-N */
/* upper triangular part of A contains the upper triangular part */
/* of the matrix A, and the strictly lower triangular part of A */
/* is not referenced. If UPLO = 'L', the leading N-by-N lower */
/* triangular part of A contains the lower triangular part of */
/* the matrix A, and the strictly upper triangular part of A is */
/* not referenced. */
/* LDA (input) INTEGER */
/* The leading dimension of the array A. LDA >= max(1,N). */
/* AF (input) REAL array, dimension (LDAF,N) */
/* The triangular factor U or L from the Cholesky factorization */
/* A = U**T*U or A = L*L**T, as computed by SPOTRF. */
/* LDAF (input) INTEGER */
/* The leading dimension of the array AF. LDAF >= max(1,N). */
/* B (input) REAL array, dimension (LDB,NRHS) */
/* The right hand side matrix B. */
/* LDB (input) INTEGER */
/* The leading dimension of the array B. LDB >= max(1,N). */
/* X (input/output) REAL array, dimension (LDX,NRHS) */
/* On entry, the solution matrix X, as computed by SPOTRS. */
/* On exit, the improved solution matrix X. */
/* LDX (input) INTEGER */
/* The leading dimension of the array X. LDX >= max(1,N). */
/* FERR (output) REAL array, dimension (NRHS) */
//.........这里部分代码省略.........
开发者ID:dacap，项目名称:loseface，代码行数:101，代码来源:sporfs.c
示例12: The
//.........这里部分代码省略.........
Based on contributions by
Ming Gu and Ren-Cang Li, Computer Science Division, University of
California at Berkeley, USA
Osni Marques, LBNL/NERSC, USA
=====================================================================
Test the input parameters.
Parameter adjustments */
/* Table of constant values */
static real c_b5 = -1.f;
static integer c__1 = 1;
static real c_b11 = 1.f;
static real c_b13 = 0.f;
static integer c__0 = 0;
/* System generated locals */
integer givcol_dim1, givcol_offset, b_dim1, b_offset, bx_dim1, bx_offset,
difr_dim1, difr_offset, givnum_dim1, givnum_offset, poles_dim1,
poles_offset, i__1, i__2;
real r__1;
/* Local variables */
static real temp;
extern /* Subroutine */ int srot_(integer *, real *, integer *, real *,
integer *, real *, real *);
extern doublereal snrm2_(integer *, real *, integer *);
static integer i__, j, m, n;
static real diflj, difrj, dsigj;
extern /* Subroutine */ int sscal_(integer *, real *, real *, integer *),
sgemv_(char *, integer *, integer *, real *, real *, integer *,
real *, integer *, real *, real *, integer *), scopy_(
integer *, real *, integer *, real *, integer *);
extern doublereal slamc3_(real *, real *);
static real dj;
extern /* Subroutine */ int xerbla_(char *, integer *);
static real dsigjp;
extern /* Subroutine */ int slascl_(char *, integer *, integer *, real *,
real *, integer *, integer *, real *, integer *, integer *), slacpy_(char *, integer *, integer *, real *, integer *,
real *, integer *);
static integer nlp1;
#define difr_ref(a_1,a_2) difr[(a_2)*difr_dim1 + a_1]
#define b_ref(a_1,a_2) b[(a_2)*b_dim1 + a_1]
#define poles_ref(a_1,a_2) poles[(a_2)*poles_dim1 + a_1]
#define bx_ref(a_1,a_2) bx[(a_2)*bx_dim1 + a_1]
#define givcol_ref(a_1,a_2) givcol[(a_2)*givcol_dim1 + a_1]
#define givnum_ref(a_1,a_2) givnum[(a_2)*givnum_dim1 + a_1]
b_dim1 = *ldb;
b_offset = 1 + b_dim1 * 1;
b -= b_offset;
bx_dim1 = *ldbx;
bx_offset = 1 + bx_dim1 * 1;
bx -= bx_offset;
--perm;
givcol_dim1 = *ldgcol;
givcol_offset = 1 + givcol_dim1 * 1;
givcol -= givcol_offset;
difr_dim1 = *ldgnum;
difr_offset = 1 + difr_dim1 * 1;
difr -= difr_offset;
poles_dim1 = *ldgnum;
poles_offset = 1 + poles_dim1 * 1;
开发者ID:MichaelH13，项目名称:sdkpub，代码行数:67，代码来源:slals0.c
示例13: ilu_sdrop_row
//.........这里部分代码省略.........
/ sqrt((double)n);
break;
case INF_NORM:
default:
k = isamax_(&n, &lusup[xlusup_first + i], &m) - 1;
temp[i] = fabs(lusup[xlusup_first + i + m * k]);
break;
}
/* drop small entries due to drop_tol */
if (drop_rule & DROP_BASIC && temp[i] < drop_tol)
{
r++;
/* drop the current row and move the last undropped row here */
if (r > 1) /* add to last row */
{
/* accumulate the sum (for MILU) */
switch (milu)
{
case SMILU_1:
case SMILU_2:
saxpy_(&n, &one, &lusup[xlusup_first + i], &m,
&lusup[xlusup_first + m - 1], &m);
break;
case SMILU_3:
for (j = 0; j < n; j++)
lusup[xlusup_first + (m - 1) + j * m] +=
fabs(lusup[xlusup_first + i + j * m]);
break;
case SILU:
default:
break;
}
scopy_(&n, &lusup[xlusup_first + m1], &m,
&lusup[xlusup_first + i], &m);
} /* if (r > 1) */
else /* move to last row */
{
sswap_(&n, &lusup[xlusup_first + m1], &m,
&lusup[xlusup_first + i], &m);
if (milu == SMILU_3)
for (j = 0; j < n; j++) {
lusup[xlusup_first + m1 + j * m] =
fabs(lusup[xlusup_first + m1 + j * m]);
}
}
lsub[xlsub_first + i] = lsub[xlsub_first + m1];
m1--;
continue;
} /* if dropping */
else
{
if (temp[i] > d_max) d_max = temp[i];
if (temp[i] < d_min) d_min = temp[i];
}
i++;
} /* for */
/* Secondary dropping: drop more rows according to the quota. */
quota = ceil((double)quota / (double)n);
if (drop_rule & DROP_SECONDARY && m - r > quota)
{
register double tol = d_max;
/* Calculate the second dropping tolerance */
if (quota > n)
开发者ID:DarkOfTheMoon，项目名称:HONEI，代码行数:67，代码来源:ilu_sdrop_row.c
示例14: QSIZ
/* Subroutine */ int claed0_(integer *qsiz, integer *n, real *d__, real *e,
complex *q, integer *ldq, complex *qstore, integer *ldqs, real *rwork,
integer *iwork, integer *info)
{
/* -- LAPACK 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
=======
Using the divide and conquer method, CLAED0 computes all eigenvalues
of a symmetric tridiagonal matrix which is one diagonal block of
those from reducing a dense or band Hermitian matrix and
corresponding eigenvectors of the dense or band matrix.
Arguments
=========
QSIZ (input) INTEGER
The dimension of the unitary matrix used to reduce
the full matrix to tridiagonal form. QSIZ >= N if ICOMPQ = 1.
N (input) INTEGER
The dimension of the symmetric tridiagonal matrix. N >= 0.
D (input/output) REAL array, dimension (N)
On entry, the diagonal elements of the tridiagonal matrix.
On exit, the eigenvalues in ascending order.
E (input/output) REAL array, dimension (N-1)
On entry, the off-diagonal elements of the tridiagonal matrix.
On exit, E has been destroyed.
Q (input/output) COMPLEX array, dimension (LDQ,N)
On entry, Q must contain an QSIZ x N matrix whose columns
unitarily orthonormal. It is a part of the unitary matrix
that reduces the full dense Hermitian matrix to a
(reducible) symmetric tridiagonal matrix.
LDQ (input) INTEGER
The leading dimension of the array Q. LDQ >= max(1,N).
IWORK (workspace) INTEGER array,
the dimension of IWORK must be at least
6 + 6*N + 5*N*lg N
( lg( N ) = smallest integer k
such that 2^k >= N )
RWORK (workspace) REAL array,
dimension (1 + 3*N + 2*N*lg N + 3*N**2)
( lg( N ) = smallest integer k
such that 2^k >= N )
QSTORE (workspace) COMPLEX array, dimension (LDQS, N)
Used to store parts of
the eigenvector matrix when the updating matrix multiplies
take place.
LDQS (input) INTEGER
The leading dimension of the array QSTORE.
LDQS >= max(1,N).
INFO (output) INTEGER
= 0: successful exit.
< 0: if INFO = -i, the i-th argument had an illegal value.
> 0: The algorithm failed to compute an eigenvalue while
working on the submatrix lying in rows and columns
INFO/(N+1) through mod(INFO,N+1).
=====================================================================
Warning: N could be as big as QSIZ!
Test the input parameters.
Parameter adjustments */
/* Table of constant values */
static integer c__9 = 9;
static integer c__0 = 0;
static integer c__2 = 2;
static integer c__1 = 1;
/* System generated locals */
integer q_dim1, q_offset, qstore_dim1, qstore_offset, i__1, i__2;
real r__1;
/* Builtin functions */
double log(doublereal);
integer pow_ii(integer *, integer *);
/* Local variables */
static real temp;
static integer curr, i__, j, k, iperm;
extern /* Subroutine */ int ccopy_(integer *, complex *, integer *,
complex *, integer *);
static integer indxq, iwrem;
extern /* Subroutine */ int scopy_(integer *, real *, integer *, real *,
integer *);
//.........这里部分代码省略.........
开发者ID:MichaelH13，项目名称:sdkpub，代码行数:101，代码来源:claed0.c
示例15: UPLO
//.........这里部分代码省略.........
The componentwise relative backward error of each solution
vector X(j) (i.e., the smallest relative change in
any element of A or B that makes X(j) an exact solution).
WORK (workspace) REAL array, dimension (3*N)
IWORK (workspace) INTEGER array, dimension (N)
INFO (output) INTEGER
= 0: successful exit
< 0: if INFO = -i, the i-th argument had an illegal value
=====================================================================
Test the input parameters.
Parameter adjustments */
/* Table of constant values */
static integer c__1 = 1;
static real c_b19 = -1.f;
/* System generated locals */
integer a_
|
客服电话
APP下载
官方微信
请发表评论