本文整理汇总了C++中s_copy函数的典型用法代码示例。如果您正苦于以下问题：C++ s_copy函数的具体用法？C++ s_copy怎么用？C++ s_copy使用的例子？那么恭喜您, 这里精选的函数代码示例或许可以为您提供帮助。
在下文中一共展示了s_copy函数的20个代码示例，这些例子默认根据受欢迎程度排序。您可以为喜欢或者感觉有用的代码点赞，您的评价将有助于我们的系统推荐出更棒的C++代码示例。
示例1: lsame_
//.........这里部分代码省略.........
/* .. */
/* .. Executable Statements .. */
eps = dlamch_("Epsilon");
minmn = min(*m,*n);
/* Quick return if possible */
if (minmn == 0) {
result[1] = 0.;
result[2] = 0.;
result[3] = 0.;
result[4] = 0.;
return 0;
}
/* Copy the last k rows of the factorization to the array Q */
zlaset_("Full", n, n, &c_b1, &c_b1, &q[q_offset], lda);
if (*k > 0 && *n > *k) {
i__1 = *n - *k;
zlacpy_("Full", k, &i__1, &af[*m - *k + 1 + af_dim1], lda, &q[*n - *k
+ 1 + q_dim1], lda);
}
if (*k > 1) {
i__1 = *k - 1;
i__2 = *k - 1;
zlacpy_("Lower", &i__1, &i__2, &af[*m - *k + 2 + (*n - *k + 1) *
af_dim1], lda, &q[*n - *k + 2 + (*n - *k + 1) * q_dim1], lda);
}
/* Generate the n-by-n matrix Q */
s_copy(srnamc_1.srnamt, "ZUNGRQ", (ftnlen)6, (ftnlen)6);
zungrq_(n, n, k, &q[q_offset], lda, &tau[minmn - *k + 1], &work[1], lwork,
&info);
for (iside = 1; iside <= 2; ++iside) {
if (iside == 1) {
*(unsigned char *)side = 'L';
mc = *n;
nc = *m;
} else {
*(unsigned char *)side = 'R';
mc = *m;
nc = *n;
}
/* Generate MC by NC matrix C */
i__1 = nc;
for (j = 1; j <= i__1; ++j) {
zlarnv_(&c__2, iseed, &mc, &c__[j * c_dim1 + 1]);
/* L10: */
}
cnorm = zlange_("1", &mc, &nc, &c__[c_offset], lda, &rwork[1]);
if (cnorm == 0.) {
cnorm = 1.;
}
for (itrans = 1; itrans <= 2; ++itrans) {
if (itrans == 1) {
*(unsigned char *)trans = 'N';
} else {
*(unsigned char *)trans = 'C';
}
开发者ID:kstraube，项目名称:hysim，代码行数:67，代码来源:zrqt03.c
示例2: s_copy
/* Subroutine */ int ddrvsp_(logical *dotype, integer *nn, integer *nval,
integer *nrhs, doublereal *thresh, logical *tsterr, integer *nmax,
doublereal *a, doublereal *afac, doublereal *ainv, doublereal *b,
doublereal *x, doublereal *xact, doublereal *work, doublereal *rwork,
integer *iwork, integer *nout)
{
/* Initialized data */
static integer iseedy[4] = { 1988,1989,1990,1991 };
static char facts[1*2] = "F" "N";
/* Format strings */
static char fmt_9999[] = "(1x,a6,\002, UPLO='\002,a1,\002', N =\002,i5"
",\002, type \002,i2,\002, test \002,i2,\002, ratio =\002,g12.5)";
static char fmt_9998[] = "(1x,a6,\002, FACT='\002,a1,\002', UPLO='\002,a"
"1,\002', N =\002,i5,\002, type \002,i2,\002, test \002,i2,\002, "
"ratio =\002,g12.5)";
/* System generated locals */
address a__1[2];
integer i__1, i__2, i__3, i__4, i__5[2];
char ch__1[2];
/* Builtin functions
Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
/* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
/* Local variables */
static char fact[1];
static integer ioff, mode, imat, info;
static char path[3], dist[1], uplo[1], type__[1];
static integer nrun, i__, j, k, n, ifact;
extern /* Subroutine */ int dget04_(integer *, integer *, doublereal *,
integer *, doublereal *, integer *, doublereal *, doublereal *);
static integer nfail, iseed[4];
extern doublereal dget06_(doublereal *, doublereal *);
static doublereal rcond;
static integer nimat;
extern /* Subroutine */ int dppt02_(char *, integer *, integer *,
doublereal *, doublereal *, integer *, doublereal *, integer *,
doublereal *, doublereal *), dspt01_(char *, integer *,
doublereal *, doublereal *, integer *, doublereal *, integer *,
doublereal *, doublereal *);
static doublereal anorm;
extern /* Subroutine */ int dppt05_(char *, integer *, integer *,
doublereal *, doublereal *, integer *, doublereal *, integer *,
doublereal *, integer *, doublereal *, doublereal *, doublereal *), dcopy_(integer *, doublereal *, integer *, doublereal *,
integer *);
static integer iuplo, izero, i1, i2, k1, lwork, nerrs;
extern /* Subroutine */ int dspsv_(char *, integer *, integer *,
doublereal *, integer *, doublereal *, integer *, integer *);
static logical zerot;
static char xtype[1];
extern /* Subroutine */ int dlatb4_(char *, integer *, integer *, integer
*, char *, integer *, integer *, doublereal *, integer *,
doublereal *, char *), aladhd_(integer *,
char *);
static integer in, kl;
extern /* Subroutine */ int alaerh_(char *, char *, integer *, integer *,
char *, integer *, integer *, integer *, integer *, integer *,
integer *, integer *, integer *, integer *);
static integer ku, nt;
static doublereal rcondc;
static char packit[1];
extern /* Subroutine */ int dlacpy_(char *, integer *, integer *,
doublereal *, integer *, doublereal *, integer *),
dlarhs_(char *, char *, char *, char *, integer *, integer *,
integer *, integer *, integer *, doublereal *, integer *,
doublereal *, integer *, doublereal *, integer *, integer *,
integer *), dlaset_(char *,
integer *, integer *, doublereal *, doublereal *, doublereal *,
integer *);
extern doublereal dlansp_(char *, char *, integer *, doublereal *,
doublereal *);
extern /* Subroutine */ int alasvm_(char *, integer *, integer *, integer
*, integer *);
static doublereal cndnum;
extern /* Subroutine */ int dlatms_(integer *, integer *, char *, integer
*, char *, doublereal *, integer *, doublereal *, doublereal *,
integer *, integer *, char *, doublereal *, integer *, doublereal
*, integer *);
static doublereal ainvnm;
extern /* Subroutine */ int dsptrf_(char *, integer *, doublereal *,
integer *, integer *), dsptri_(char *, integer *,
doublereal *, integer *, doublereal *, integer *),
derrvx_(char *, integer *);
static doublereal result[6];
extern /* Subroutine */ int dspsvx_(char *, char *, integer *, integer *,
doublereal *, doublereal *, integer *, doublereal *, integer *,
doublereal *, integer *, doublereal *, doublereal *, doublereal *,
doublereal *, integer *, integer *);
static integer lda, npp;
/* Fortran I/O blocks */
static cilist io___41 = { 0, 0, 0, fmt_9999, 0 };
static cilist io___44 = { 0, 0, 0, fmt_9998, 0 };
//.........这里部分代码省略.........
开发者ID:zangel，项目名称:uquad，代码行数:101，代码来源:ddrvsp.c
示例3: s_wsfe
//.........这里部分代码省略.........
i__1 = nunit;
for (kunit = 1; kunit <= i__1; ++kunit) {
iunit = lun[kunit - 1];
if (iunit == 0) {
iunit = i1mach_(&c__4);
}
/* Print the table header. */
io___7.ciunit = iunit;
s_wsfe(&io___7);
e_wsfe();
/* Print body of table. */
i__2 = nmsg;
for (i__ = 1; i__ <= i__2; ++i__) {
io___9.ciunit = iunit;
s_wsfe(&io___9);
do_fio(&c__1, libtab + ((i__ - 1) << 3), (ftnlen)8);
do_fio(&c__1, subtab + ((i__ - 1) << 3), (ftnlen)8);
do_fio(&c__1, mestab + (i__ - 1) * 20, (ftnlen)20);
do_fio(&c__1, (char *)&nertab[i__ - 1], (ftnlen)sizeof(
integer));
do_fio(&c__1, (char *)&levtab[i__ - 1], (ftnlen)sizeof(
integer));
do_fio(&c__1, (char *)&kount[i__ - 1], (ftnlen)sizeof(integer)
);
e_wsfe();
/* L10: */
}
/* Print number of other errors. */
if (kountx != 0) {
io___16.ciunit = iunit;
s_wsfe(&io___16);
do_fio(&c__1, (char *)&kountx, (ftnlen)sizeof(integer));
e_wsfe();
}
io___17.ciunit = iunit;
s_wsfe(&io___17);
e_wsfe();
/* L20: */
}
/* Clear the error tables. */
if (*kflag == 0) {
nmsg = 0;
kountx = 0;
}
} else {
/* PROCESS A MESSAGE... */
/* SEARCH FOR THIS MESSG, OR ELSE AN EMPTY SLOT FOR THIS MESSG, */
/* OR ELSE DETERMINE THAT THE ERROR TABLE IS FULL. */
s_copy(lib, librar, (ftnlen)8, librar_len);
s_copy(sub, subrou, (ftnlen)8, subrou_len);
s_copy(mes, messg, (ftnlen)20, messg_len);
i__1 = nmsg;
for (i__ = 1; i__ <= i__1; ++i__) {
if (s_cmp(lib, libtab + ((i__ - 1) << 3), (ftnlen)8, (ftnlen)8) ==
0 && s_cmp(sub, subtab + ((i__ - 1) << 3), (ftnlen)8, (
ftnlen)8) == 0 && s_cmp(mes, mestab + (i__ - 1) * 20, (
ftnlen)20, (ftnlen)20) == 0 && *nerr == nertab[i__ - 1] &&
*level == levtab[i__ - 1]) {
++kount[i__ - 1];
*icount = kount[i__ - 1];
return 0;
}
/* L30: */
}
if (nmsg < 10) {
/* Empty slot found for new message. */
++nmsg;
s_copy(libtab + ((i__ - 1) << 3), lib, (ftnlen)8, (ftnlen)8);
s_copy(subtab + ((i__ - 1) << 3), sub, (ftnlen)8, (ftnlen)8);
s_copy(mestab + (i__ - 1) * 20, mes, (ftnlen)20, (ftnlen)20);
nertab[i__ - 1] = *nerr;
levtab[i__ - 1] = *level;
kount[i__ - 1] = 1;
*icount = 1;
} else {
/* Table is full. */
++kountx;
*icount = 0;
}
}
return 0;
/* Formats. */
} /* xersve_ */
开发者ID:Cantera，项目名称:cantera-svn，代码行数:101，代码来源:xersve.c
示例4: Error
//.........这里部分代码省略.........
}
i__1 = *nn;
for (iin = 1; iin <= i__1; ++iin) {
n = nval[iin];
/* Do first for UPLO = 'U', then for UPLO = 'L' */
for (iuplo = 1; iuplo <= 2; ++iuplo) {
*(unsigned char *)uplo = *(unsigned char *)&uplos[iuplo - 1];
lower = TRUE_;
if (iuplo == 1) {
lower = FALSE_;
}
/* Do first for CFORM = 'N', then for CFORM = 'T' */
for (iform = 1; iform <= 2; ++iform) {
*(unsigned char *)cform = *(unsigned char *)&forms[iform - 1];
++nrun;
i__2 = n;
for (j = 1; j <= i__2; ++j) {
i__3 = n;
for (i__ = 1; i__ <= i__3; ++i__) {
a[i__ + j * a_dim1] = slarnd_(&c__2, iseed);
}
}
s_copy(srnamc_1.srnamt, "DTRTTF", (ftnlen)32, (ftnlen)6);
strttf_(cform, uplo, &n, &a[a_offset], lda, &arf[1], &info);
s_copy(srnamc_1.srnamt, "DTFTTP", (ftnlen)32, (ftnlen)6);
stfttp_(cform, uplo, &n, &arf[1], &ap[1], &info);
s_copy(srnamc_1.srnamt, "DTPTTR", (ftnlen)32, (ftnlen)6);
stpttr_(uplo, &n, &ap[1], &asav[asav_offset], lda, &info);
ok1 = TRUE_;
if (lower) {
i__2 = n;
for (j = 1; j <= i__2; ++j) {
i__3 = n;
for (i__ = j; i__ <= i__3; ++i__) {
if (a[i__ + j * a_dim1] != asav[i__ + j *
asav_dim1]) {
ok1 = FALSE_;
}
}
}
} else {
i__2 = n;
for (j = 1; j <= i__2; ++j) {
i__3 = j;
for (i__ = 1; i__ <= i__3; ++i__) {
if (a[i__ + j * a_dim1] != asav[i__ + j *
asav_dim1]) {
ok1 = FALSE_;
}
}
}
}
开发者ID:juanjosegarciaripoll，项目名称:cblapack，代码行数:67，代码来源:sdrvrf2.c
示例5: test
//.........这里部分代码省略.........
/* .. */
/* .. External Functions .. */
/* .. */
/* .. External Subroutines .. */
/* .. */
/* .. Intrinsic Functions .. */
/* .. */
/* .. Scalars in Common .. */
/* .. */
/* .. Common blocks .. */
/* .. */
/* .. Data statements .. */
/* Parameter adjustments */
--iwork;
--rwork;
--work;
--s;
--xact;
--x;
--bsav;
--b;
--asav;
--afac;
--a;
--nval;
--dotype;
/* Function Body */
/* .. */
/* .. Executable Statements .. */
/* Initialize constants and the random number seed. */
s_copy(path, "Single precision", (ftnlen)1, (ftnlen)16);
s_copy(path + 1, "PB", (ftnlen)2, (ftnlen)2);
nrun = 0;
nfail = 0;
nerrs = 0;
for (i__ = 1; i__ <= 4; ++i__) {
iseed[i__ - 1] = iseedy[i__ - 1];
/* L10: */
}
/* Test the error exits */
if (*tsterr) {
serrvx_(path, nout);
}
infoc_1.infot = 0;
kdval[0] = 0;
/* Set the block size and minimum block size for testing. */
nb = 1;
nbmin = 2;
xlaenv_(&c__1, &nb);
xlaenv_(&c__2, &nbmin);
/* Do for each value of N in NVAL */
i__1 = *nn;
for (in = 1; in <= i__1; ++in) {
n = nval[in];
lda = max(n,1);
*(unsigned char *)xtype = 'N';
开发者ID:3deggi，项目名称:levmar-ndk，代码行数:66，代码来源:sdrvpb.c
示例6: zgemm_
//.........这里部分代码省略.........
/* ===================================================================== */
/* .. Parameters .. */
/* .. */
/* .. Local Scalars .. */
/* .. */
/* .. External Functions .. */
/* .. */
/* .. External Subroutines .. */
/* .. */
/* .. Intrinsic Functions .. */
/* .. */
/* .. Scalars in Common .. */
/* .. */
/* .. Common blocks .. */
/* .. */
/* .. Executable Statements .. */
/* Parameter adjustments */
l_dim1 = *lda;
l_offset = 1 + l_dim1;
l -= l_offset;
q_dim1 = *lda;
q_offset = 1 + q_dim1;
q -= q_offset;
af_dim1 = *lda;
af_offset = 1 + af_dim1;
af -= af_offset;
a_dim1 = *lda;
a_offset = 1 + a_dim1;
a -= a_offset;
--tau;
--work;
--rwork;
--result;
/* Function Body */
minmn = min(*m,*n);
eps = dlamch_("Epsilon");
/* Copy the matrix A to the array AF. */
zlacpy_("Full", m, n, &a[a_offset], lda, &af[af_offset], lda);
/* Factorize the matrix A in the array AF. */
s_copy(srnamc_1.srnamt, "ZGELQF", (ftnlen)32, (ftnlen)6);
zgelqf_(m, n, &af[af_offset], lda, &tau[1], &work[1], lwork, &info);
/* Copy details of Q */
zlaset_("Full", n, n, &c_b1, &c_b1, &q[q_offset], lda);
if (*n > 1) {
i__1 = *n - 1;
zlacpy_("Upper", m, &i__1, &af[(af_dim1 << 1) + 1], lda, &q[(q_dim1 <<
1) + 1], lda);
}
/* Generate the n-by-n matrix Q */
s_copy(srnamc_1.srnamt, "ZUNGLQ", (ftnlen)32, (ftnlen)6);
zunglq_(n, n, &minmn, &q[q_offset], lda, &tau[1], &work[1], lwork, &info);
/* Copy L */
zlaset_("Full", m, n, &c_b10, &c_b10, &l[l_offset], lda);
zlacpy_("Lower", m, n, &af[af_offset], lda, &l[l_offset], lda);
/* Compute L - A*Q' */
zgemm_("No transpose", "Conjugate transpose", m, n, n, &c_b15, &a[
a_offset], lda, &q[q_offset], lda, &c_b16, &l[l_offset], lda);
/* Compute norm( L - Q'*A ) / ( N * norm(A) * EPS ) . */
anorm = zlange_("1", m, n, &a[a_offset], lda, &rwork[1]);
resid = zlange_("1", m, n, &l[l_offset], lda, &rwork[1]);
if (anorm > 0.) {
result[1] = resid / (doublereal) max(1,*n) / anorm / eps;
} else {
result[1] = 0.;
}
/* Compute I - Q*Q' */
zlaset_("Full", n, n, &c_b10, &c_b16, &l[l_offset], lda);
zherk_("Upper", "No transpose", n, n, &c_b24, &q[q_offset], lda, &c_b25, &
l[l_offset], lda);
/* Compute norm( I - Q*Q' ) / ( N * EPS ) . */
resid = zlansy_("1", "Upper", n, &l[l_offset], lda, &rwork[1]);
result[2] = resid / (doublereal) max(1,*n) / eps;
return 0;
/* End of ZLQT01 */
} /* zlqt01_ */
开发者ID:3deggi，项目名称:levmar-ndk，代码行数:101，代码来源:zlqt01.c
示例7: s_wsle
/* Subroutine */ int cerrps_(char *path, integer *nunit)
{
/* System generated locals */
integer i__1;
real r__1;
/* Builtin functions */
integer s_wsle(cilist *), e_wsle(void);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
/* Local variables */
complex a[16] /* was [4][4] */;
integer i__, j, piv[4], info;
real rwork[8];
extern /* Subroutine */ int cpstf2_(char *, integer *, complex *, integer
*, integer *, integer *, real *, real *, integer *),
alaesm_(char *, logical *, integer *), chkxer_(char *,
integer *, integer *, logical *, logical *), cpstrf_(char
*, integer *, complex *, integer *, integer *, integer *, real *,
real *, integer *);
/* Fortran I/O blocks */
static cilist io___1 = { 0, 0, 0, 0, 0 };
/* -- LAPACK test routine (version 3.1) -- */
/* Craig Lucas, University of Manchester / NAG Ltd. */
/* October, 2008 */
/* .. Scalar Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* CERRPS tests the error exits for the COMPLEX routines */
/* for CPSTRF.. */
/* Arguments */
/* ========= */
/* PATH (input) CHARACTER*3 */
/* The LAPACK path name for the routines to be tested. */
/* NUNIT (input) INTEGER */
/* The unit number for output. */
/* ===================================================================== */
/* .. Parameters .. */
/* .. */
/* .. Local Scalars .. */
/* .. */
/* .. Local Arrays .. */
/* .. */
/* .. External Subroutines .. */
/* .. */
/* .. Scalars in Common .. */
/* .. */
/* .. Common blocks .. */
/* .. */
/* .. Intrinsic Functions .. */
/* .. */
/* .. Executable Statements .. */
infoc_1.nout = *nunit;
io___1.ciunit = infoc_1.nout;
s_wsle(&io___1);
e_wsle();
/* Set the variables to innocuous values. */
for (j = 1; j <= 4; ++j) {
for (i__ = 1; i__ <= 4; ++i__) {
i__1 = i__ + (j << 2) - 5;
r__1 = 1.f / (real) (i__ + j);
a[i__1].r = r__1, a[i__1].i = 0.f;
/* L100: */
}
piv[j - 1] = j;
rwork[j - 1] = 0.f;
rwork[j + 3] = 0.f;
/* L110: */
}
infoc_1.ok = TRUE_;
/* Test error exits of the routines that use the Cholesky */
/* decomposition of an Hermitian positive semidefinite matrix. */
/* CPSTRF */
s_copy(srnamc_1.srnamt, "CPSTRF", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
cpstrf_("/", &c__0, a, &c__1, piv, &c__1, &c_b9, rwork, &info);
chkxer_("CPSTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
//.........这里部分代码省略.........
开发者ID:3deggi，项目名称:levmar-ndk，代码行数:101，代码来源:cerrps.c
示例8: test
//.........这里部分代码省略.........
/* Check for errors */
if (*nsizes < 0) {
*info = -1;
} else if (badmm) {
*info = -2;
} else if (badnn) {
*info = -3;
} else if (*ntypes < 0) {
*info = -4;
} else if (*nrhs < 0) {
*info = -6;
} else if (*lda < mmax) {
*info = -11;
} else if (*ldx < mmax) {
*info = -17;
} else if (*ldq < mmax) {
*info = -21;
} else if (*ldpt < mnmax) {
*info = -23;
} else if (minwrk > *lwork) {
*info = -27;
}
if (*info != 0) {
i__1 = -(*info);
xerbla_("CCHKBD", &i__1);
return 0;
}
/* Initialize constants */
s_copy(path, "Complex precision", (ftnlen)1, (ftnlen)17);
s_copy(path + 1, "BD", (ftnlen)2, (ftnlen)2);
nfail = 0;
ntest = 0;
unfl = slamch_("Safe minimum");
ovfl = slamch_("Overflow");
slabad_(&unfl, &ovfl);
ulp = slamch_("Precision");
ulpinv = 1.f / ulp;
log2ui = (integer) (log(ulpinv) / log(2.f));
rtunfl = sqrt(unfl);
rtovfl = sqrt(ovfl);
infoc_1.infot = 0;
/* Loop over sizes, types */
i__1 = *nsizes;
for (jsize = 1; jsize <= i__1; ++jsize) {
m = mval[jsize];
n = nval[jsize];
mnmin = min(m,n);
/* Computing MAX */
i__2 = max(m,n);
amninv = 1.f / max(i__2,1);
if (*nsizes != 1) {
mtypes = min(16,*ntypes);
} else {
mtypes = min(17,*ntypes);
}
i__2 = mtypes;
for (jtype = 1; jtype <= i__2; ++jtype) {
开发者ID:3deggi，项目名称:levmar-ndk，代码行数:67，代码来源:cchkbd.c
示例9: s_copy
//.........这里部分代码省略.........
/* .. */
/* .. Intrinsic Functions .. */
/* .. */
/* .. Scalars in Common .. */
/* .. */
/* .. Common blocks .. */
/* .. */
/* .. Data statements .. */
/* Parameter adjustments */
--iwork;
--rwork;
--work;
--tau;
--xact;
--x;
--b;
--ac;
--ar;
--aq;
--af;
--a;
--nxval;
--nbval;
--nval;
--mval;
--dotype;
/* Function Body */
/* .. */
/* .. Executable Statements .. */
/* Initialize constants and the random number seed. */
s_copy(path, "Complex precision", (ftnlen)1, (ftnlen)17);
s_copy(path + 1, "QR", (ftnlen)2, (ftnlen)2);
nrun = 0;
nfail = 0;
nerrs = 0;
for (i__ = 1; i__ <= 4; ++i__) {
iseed[i__ - 1] = iseedy[i__ - 1];
/* L10: */
}
/* Test the error exits */
if (*tsterr) {
cerrqr_(path, nout);
}
infoc_1.infot = 0;
xlaenv_(&c__2, &c__2);
lda = *nmax;
lwork = *nmax * max(*nmax,*nrhs);
/* Do for each value of M in MVAL. */
i__1 = *nm;
for (im = 1; im <= i__1; ++im) {
m = mval[im];
/* Do for each value of N in NVAL. */
i__2 = *nn;
for (in = 1; in <= i__2; ++in) {
n = nval[in];
minmn = min(m,n);
开发者ID:juanjosegarciaripoll，项目名称:cblapack，代码行数:67，代码来源:cchkqr.c
示例10: i_len
//.........这里部分代码省略.........
/* H.A. Neilan (JPL) */
/* W.L. Taber (JPL) */
/* I.M. Underwood (JPL) */
/* $ Literature_References */
/* None. */
/* $ Version */
/* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (WLT) (IMU) */
/* -& */
/* $ Index_Entries */
/* remove a substring */
/* -& */
/* $ Revisions */
/* - Beta Version 2.0.0, 5-JAN-1989 (HAN) */
/* Error handling was added to detect invalid character */
/* positions. If LEFT > RIGHT, RIGHT < 1, LEFT < 1, */
/* RIGHT > LEN(IN), or LEFT > LEN(IN), an error is signalled. */
/* -& */
/* SPICELIB functions */
/* Other functions */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("REMSUB", (ftnlen)6);
}
/* If a character position is out of range, signal an error. */
if (*left > *right || *right < 1 || *left < 1 || *right > i_len(in,
in_len) || *left > i_len(in, in_len)) {
setmsg_("Left location was *. Right location was *.", (ftnlen)42);
errint_("*", left, (ftnlen)1);
errint_("*", right, (ftnlen)1);
sigerr_("SPICE(INVALIDINDEX)", (ftnlen)19);
chkout_("REMSUB", (ftnlen)6);
return 0;
} else {
l = *left;
r__ = *right;
}
/* How much of the input string will we use? And how big is the */
/* output string? */
inlen = lastnb_(in, in_len);
outlen = i_len(out, out_len);
/* Copy the first part of the input string. (One character at a */
/* time, in case this is being done in place.) */
/* Computing MIN */
i__2 = l - 1;
i__1 = min(i__2,outlen);
for (i__ = 1; i__ <= i__1; ++i__) {
*(unsigned char *)&out[i__ - 1] = *(unsigned char *)&in[i__ - 1];
}
/* Now move the rest of the string over. */
i__ = l;
j = r__ + 1;
while(i__ <= outlen && j <= inlen) {
*(unsigned char *)&out[i__ - 1] = *(unsigned char *)&in[j - 1];
++i__;
++j;
}
/* Pad with blanks, if necessary. */
if (i__ <= outlen) {
s_copy(out + (i__ - 1), " ", out_len - (i__ - 1), (ftnlen)1);
}
chkout_("REMSUB", (ftnlen)6);
return 0;
} /* remsub_ */
开发者ID:Dbelsa，项目名称:coft，代码行数:101，代码来源:remsub.c
示例11: s_copy
/* Subroutine */ int clqt01_(integer *m, integer *n, complex *a, complex *af,
complex *q, complex *l, integer *lda, complex *tau, complex *work,
integer *lwork, real *rwork, real *result)
{
/* System generated locals */
integer a_dim1, a_offset, af_dim1, af_offset, l_dim1, l_offset, q_dim1,
q_offset, i__1;
/* Builtin functions
Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
/* Local variables */
static integer info;
extern /* Subroutine */ int cgemm_(char *, char *, integer *, integer *,
integer *, complex *, complex *, integer *, complex *, integer *,
complex *, complex *, integer *), cherk_(char *,
char *, integer *, integer *, real *, complex *, integer *, real *
, complex *, integer *);
static real resid, anorm;
static integer minmn;
extern doublereal clange_(char *, integer *, integer *, complex *,
integer *, real *);
extern /* Subroutine */ int cgelqf_(integer *, integer *, complex *,
integer *, complex *, complex *, integer *, integer *);
extern doublereal slamch_(char *);
extern /* Subroutine */ int clacpy_(char *, integer *, integer *, complex
*, integer *, complex *, integer *), claset_(char *,
integer *, integer *, complex *, complex *, complex *, integer *);
extern doublereal clansy_(char *, char *, integer *, complex *, integer *,
real *);
extern /* Subroutine */ int cunglq_(integer *, integer *, integer *,
complex *, integer *, complex *, complex *, integer *, integer *);
static real eps;
#define q_subscr(a_1,a_2) (a_2)*q_dim1 + a_1
#define q_ref(a_1,a_2) q[q_subscr(a_1,a_2)]
#define af_subscr(a_1,a_2) (a_2)*af_dim1 + a_1
#define af_ref(a_1,a_2) af[af_subscr(a_1,a_2)]
/* -- 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
=======
CLQT01 tests CGELQF, which computes the LQ factorization of an m-by-n
matrix A, and partially tests CUNGLQ which forms the n-by-n
orthogonal matrix Q.
CLQT01 compares L with A*Q', and checks that Q is orthogonal.
Arguments
=========
M (input) INTEGER
The number of rows of the matrix A. M >= 0.
N (input) INTEGER
The number of columns of the matrix A. N >= 0.
A (input) COMPLEX array, dimension (LDA,N)
The m-by-n matrix A.
AF (output) COMPLEX array, dimension (LDA,N)
Details of the LQ factorization of A, as returned by CGELQF.
See CGELQF for further details.
Q (output) COMPLEX array, dimension (LDA,N)
The n-by-n orthogonal matrix Q.
L (workspace) COMPLEX array, dimension (LDA,max(M,N))
LDA (input) INTEGER
The leading dimension of the arrays A, AF, Q and L.
LDA >= max(M,N).
TAU (output) COMPLEX array, dimension (min(M,N))
The scalar factors of the elementary reflectors, as returned
by CGELQF.
WORK (workspace) COMPLEX array, dimension (LWORK)
LWORK (input) INTEGER
The dimension of the array WORK.
RWORK (workspace) REAL array, dimension (max(M,N))
RESULT (output) REAL array, dimension (2)
The test ratios:
RESULT(1) = norm( L - A*Q' ) / ( N * norm(A) * EPS )
RESULT(2) = norm( I - Q*Q' ) / ( N * EPS )
=====================================================================
//.........这里部分代码省略.........
开发者ID:zangel，项目名称:uquad，代码行数:101，代码来源:clqt01.c
示例12: ilaenv_
//.........这里部分代码省略.........
/* .. External Functions .. */
/* .. */
/* .. Executable Statements .. */
switch (*ispec) {
case 1: goto L10;
case 2: goto L10;
case 3: goto L10;
case 4: goto L80;
case 5: goto L90;
case 6: goto L100;
case 7: goto L110;
case 8: goto L120;
case 9: goto L130;
case 10: goto L140;
case 11: goto L150;
case 12: goto L160;
case 13: goto L160;
case 14: goto L160;
case 15: goto L160;
case 16: goto L160;
}
/* Invalid value for ISPEC */
ret_val = -1;
return ret_val;
L10:
/* Convert NAME to upper case if the first character is lower case. */
ret_val = 1;
s_copy(subnam, name__, (ftnlen)6, name_len);
ic = *(unsigned char*)subnam;
iz = 'Z';
if (iz == 90 || iz == 122) {
/* ASCII character set */
if (ic >= 97 && ic <= 122) {
*(unsigned char*)subnam = (char)(ic - 32);
for (i__ = 2; i__ <= 6; ++i__) {
ic = *(unsigned char*)&subnam[i__ - 1];
if (ic >= 97 && ic <= 122) {
*(unsigned char*)&subnam[i__ - 1] = (char)(ic - 32);
}
/* L20: */
}
}
} else if (iz == 233 || iz == 169) {
/* EBCDIC character set */
if (ic >= 129 && ic <= 137 || ic >= 145 && ic <= 153 || ic >= 162 &&
ic <= 169) {
*(unsigned char*)subnam = (char)(ic + 64);
for (i__ = 2; i__ <= 6; ++i__) {
ic = *(unsigned char*)&subnam[i__ - 1];
if (ic >= 129 && ic <= 137 || ic >= 145 && ic <= 153 || ic >=
162 && ic <= 169) {
*(unsigned char*)&subnam[i__ - 1] = (char)(ic + 64);
}
/* L30: */
}
开发者ID:353，项目名称:viewercv，代码行数:67，代码来源:ilaenv.c
示例13: test
/* Subroutine */ int cchkgt_(logical *dotype, integer *nn, integer *nval,
integer *nns, integer *nsval, real *thresh, logical *tsterr, complex *
a, complex *af, complex *b, complex *x, complex *xact, complex *work,
real *rwork, integer *iwork, integer *nout)
{
/* Initialized data */
static integer iseedy[4] = { 0,0,0,1 };
static char transs[1*3] = "N" "T" "C";
/* Format strings */
static char fmt_9999[] = "(12x,\002N =\002,i5,\002,\002,10x,\002 type"
" \002,i2,\002, test(\002,i2,\002) = \002,g12.5)";
static char fmt_9997[] = "(\002 NORM ='\002,a1,\002', N =\002,i5,\002"
",\002,10x,\002 type \002,i2,\002, test(\002,i2,\002) = \002,g12."
"5)";
static char fmt_9998[] = "(\002 TRANS='\002,a1,\002', N =\002,i5,\002, N"
"RHS=\002,i3,\002, type \002,i2,\002, test(\002,i2,\002) = \002,g"
"12.5)";
/* System generated locals */
integer i__1, i__2, i__3, i__4, i__5;
real r__1, r__2;
/* Builtin functions
Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void);
/* Local variables */
static real cond;
static integer mode, koff, imat, info;
static char path[3], dist[1];
static integer irhs, nrhs;
static char norm[1], type__[1];
static integer nrun, i__, j, k;
extern /* Subroutine */ int alahd_(integer *, char *);
static integer m, n;
extern /* Subroutine */ int cget04_(integer *, integer *, complex *,
integer *, complex *, integer *, real *, real *);
static integer nfail, iseed[4];
static complex z__[3];
extern /* Subroutine */ int cgtt01_(integer *, complex *, complex *,
complex *, complex *, complex *, complex *, complex *, integer *,
complex *, integer *, real *, real *), cgtt02_(char *, integer *,
integer *, complex *, complex *, complex *, complex *, integer *,
complex *, integer *, real *, real *);
static real rcond;
extern /* Subroutine */ int cgtt05_(char *, integer *, integer *, complex
*, complex *, complex *, complex *, integer *, complex *, integer
*, complex *, integer *, real *, real *, real *);
static integer nimat;
extern doublereal sget06_(real *, real *);
static real anorm;
static integer itran;
extern /* Subroutine */ int ccopy_(integer *, complex *, integer *,
complex *, integer *);
static char trans[1];
static integer izero, nerrs;
static logical zerot;
extern /* Subroutine */ int clatb4_(char *, integer *, integer *, integer
*, char *, integer *, integer *, real *, integer *, real *, char *
);
static integer in, kl;
extern /* Subroutine */ int alaerh_(char *, char *, integer *, integer *,
char *, integer *, integer *, integer *, integer *, integer *,
integer *, integer *, integer *, integer *);
static integer ku, ix;
extern /* Subroutine */ int cerrge_(char *, integer *);
static real rcondc;
extern doublereal clangt_(char *, integer *, complex *, complex *,
complex *);
extern /* Subroutine */ int clagtm_(char *, integer *, integer *, real *,
complex *, complex *, complex *, complex *, integer *, real *,
complex *, integer *), clacpy_(char *, integer *, integer
*, complex *, integer *, complex *, integer *), csscal_(
integer *, real *, complex *, integer *), cgtcon_(char *, integer
*, complex *, complex *, complex *, complex *, integer *, real *,
real *, complex *, integer *);
static real rcondi;
extern /* Subroutine */ int alasum_(char *, integer *, integer *, integer
*, integer *);
static real rcondo;
extern /* Subroutine */ int clarnv_(integer *, integer *, integer *,
complex *), clatms_(integer *, integer *, char *, integer *, char
*, real *, integer *, real *, real *, integer *, integer *, char *
, complex *, integer *, complex *, integer *);
static real ainvnm;
extern /* Subroutine */ int cgtrfs_(char *, integer *, integer *, complex
*, complex *, complex *, complex *, complex *, complex *, complex
*, integer *, complex *, integer *, complex *, integer *, real *,
real *, complex *, real *, integer *), cgttrf_(integer *,
complex *, complex *, complex *, complex *, integer *, integer *);
static logical trfcon;
extern doublereal scasum_(integer *, complex *, integer *);
extern /* Subroutine */ int cgttrs_(char *, integer *, integer *, complex
*, complex *, complex *, complex *, integer *, complex *, integer
*, integer *);
static real result[7];
static integer lda;
//.........这里部分代码省略.........
开发者ID:zangel，项目名称:uquad，代码行数:101，代码来源:cchkgt.c
示例14: cardc_
//.........这里部分代码省略.........
/* None. */
/* $ Examples */
/* The contents of the symbol table are: */
/* BOHR --> HYDROGEN ATOM */
/* EINSTEIN --> SPECIAL RELATIVITY */
/* PHOTOELECTRIC EFFECT */
/* BROWNIAN MOTION */
/* FERMI --> NUCLEAR FISSION */
/* The calls, */
/* CALL SYFETC ( 2, TABSYM, TABPTR, TABVAL, NAME, FOUND ) */
/* CALL SYFETC ( 3, TABSYM, TABPTR, TABVAL, NAME, FOUND ) */
/* CALL SYFETC ( -1, TABSYM, TABPTR, TABVAL, NAME, FOUND ) */
/* CALL SYFETC ( 4, TABSYM, TABPTR, TABVAL, NAME, FOUND ) */
/* result in the values for NAME and FOUND: */
/* NAME FOUND */
/* ---------- ----- */
/* EINSTEIN TRUE */
/* FERMI TRUE */
/* FALSE */
/* FALSE */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* N.J. Bachman (JPL) */
/* H.A. Neilan (JPL) */
/* I.M. Underwood (JPL) */
/* $ Version */
/* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) (HAN) */
/* -& */
/* $ Index_Entries */
/* fetch the nth symbol in the table */
/* -& */
/* $ Revisions */
/* - Beta Version 1.1.0, 17-FEB-1989 (NJB) */
/* Declaration of the unused variable SUMAI removed. */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("SYFETC", (ftnlen)6);
}
/* How many symbols to start with? */
nsym = cardc_(tabsym, tabsym_len);
/* If the value of NTH is out of range, that's a problem. */
if (*nth < 1 || *nth > nsym) {
*found = FALSE_;
/* Otherwise, we can proceed without fear of error. Merely locate */
/* and return the appropriate component from the values table. */
} else {
*found = TRUE_;
s_copy(name__, tabsym + (*nth + 5) * tabsym_len, name_len, tabsym_len)
;
}
chkout_("SYFETC", (ftnlen)6);
return 0;
} /* syfetc_ */
开发者ID:Dbelsa，项目名称:coft，代码行数:101，代码来源:syfetc.c
示例15: test
//.........这里部分代码省略.........
/* .. */
/* .. External Functions .. */
/* .. */
/* .. External Subroutines .. */
/* .. */
/* .. Scalars in Common .. */
/* .. */
/* .. Common blocks .. */
/* .. */
/* .. Intrinsic Functions .. */
/* .. */
/* .. Data statements .. */
/* Parameter adjustments */
--iwork;
--rwork;
--work;
--xact;
--x;
--b;
--ainv;
--afac;
--a;
--nsval;
--nbval;
--nval;
--dotype;
/* Function Body */
/* .. */
/* .. Executable Statements .. */
/* Initialize constants and the random number seed. */
s_copy(path, "Double precision", (ftnlen)1, (ftnlen)16);
s_copy(path + 1, "PO", (ftnlen)2, (ftnlen)2);
nrun = 0;
nfail = 0;
nerrs = 0;
for (i__ = 1; i__ <= 4; ++i__) {
iseed[i__ - 1] = iseedy[i__ - 1];
/* L10: */
}
/* Test the error exits */
if (*tsterr) {
derrpo_(path, nout);
}
infoc_1.infot = 0;
xlaenv_(&c__2, &c__2);
/* Do for each value of N in NVAL */
i__1 = *nn;
for (in = 1; in <= i__1; ++in) {
n = nval[in];
lda = max(n,1);
*(unsigned char *)xtype = 'N';
nimat = 9;
if (n <= 0) {
nimat = 1;
}
izero = 0;
i__2 = nimat;
for (imat = 1; imat <= i__2; ++imat) {
开发者ID:3deggi，项目名称:levmar-ndk，代码行数:67，代码来源:dchkpo.c
示例16: types
//.........这里部分代码省略.........
--nn;
--dotype;
--iseed;
ht_dim1 = *lda;
ht_offset = 1 + ht_dim1;
ht -= ht_offset;
h_dim1 = *lda;
h_offset = 1 + h_dim1;
h__ -= h_offset;
a_dim1 = *lda;
a_offset = 1 + a_dim1;
a -= a_offset;
--wr;
--wi;
--wrt;
--wit;
--wrtmp;
--witmp;
vs1_dim1 = *ldvs;
vs1_offset = 1 + vs1_dim1;
vs1 -= vs1_offset;
vs_dim1 = *ldvs;
vs_offset = 1 + vs_dim1;
vs -= vs_offset;
--result;
--work;
--iwork;
--bwork;
/* Function Body */
/* .. */
/* .. Executable Statements .. */
s_copy(path, "Single precision", (ftnlen)1, (ftnlen)16);
s_copy(path + 1, "SX", (ftnlen)2, (ftnlen)2);
/* Check for errors */
ntestt = 0;
ntestf = 0;
*info = 0;
/* Important constants */
badnn = FALSE_;
/* 12 is the largest dimension in the input file of precomputed */
/* problems */
nmax = 12;
i__1 = *nsizes;
for (j = 1; j <= i__1; ++j) {
/* Computing MAX */
i__2 = nmax, i__3 = nn[j];
nmax = max(i__2,i__3);
if (nn[j] < 0) {
badnn = TRUE_;
}
/* L10: */
}
/* Check for errors */
if (*nsizes < 0) {
*info = -1;
} else if (badnn) {
开发者ID:juanjosegarciaripoll，项目名称:cblapack，代码行数:67，代码来源:sdrvsx.c
示例17: i_len
//.........这里部分代码省略.........
/* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (CAC) (WLT) (IMU) */
/* -& */
/* $ Index_Entries */
/* insert an item into a character set */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 2.0.0, 01-NOV-2005 (NJB) */
/* Bug fix: when the item to be inserted would, after */
/* truncation to the set's string length, match an item */
/* already in the set, no insertion is performed. Previously */
/* the truncated string was inserted, corrupting the set. */
/* Long error message was updated to include size of */
/* set into which insertion was attempted. */
/* - Beta Version 1.1.0, 06-JAN-1989 (NJB) */
/* Calling protocol of EXCESS changed. Call to SETMSG removed. */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Set up the error processing. */
if (return_()) {
return 0;
}
chkin_("INSRTC", (ftnlen)6);
/* What are the size and cardinality of the set? */
size = sizec_(a, a_len);
card = cardc_(a, a_len);
/* When we insert an item into the set, any trailing characters */
/* that don't fit are truncated. So in deciding where to insert */
/* the item, we ignore any characters that won't remain after */
/* insertion. */
/* We're going to consider only the initial substring of ITEM */
/* whose length doesn't exceed the string length of the set's */
/* members. */
/* Computing MIN */
i__1 = i_len(item, item_len), i__2 = i_len(a + a_len * 6, a_len);
slen = min(i__1,i__2);
/* Find the last element of the set which would come before the */
/* input item. This will be the item itself, if it is already an */
/* element of the set. */
last = lstlec_(item, &card, a + a_len * 6, slen, a_len);
/* Is the item already in the set? If not, it needs to be inserted. */
if (last > 0) {
in = s_cmp(a + (last + 5) * a_len, item, a_len, slen) == 0;
} else {
in = FALSE_;
}
if (! in) {
/* If there is room in the set for the new element, then move */
/* the succeeding elements
|
客服电话
APP下载
官方微信
请发表评论