本文整理汇总了C++中s_wsle函数的典型用法代码示例。如果您正苦于以下问题：C++ s_wsle函数的具体用法？C++ s_wsle怎么用？C++ s_wsle使用的例子？那么恭喜您, 这里精选的函数代码示例或许可以为您提供帮助。
在下文中一共展示了s_wsle函数的15个代码示例，这些例子默认根据受欢迎程度排序。您可以为喜欢或者感觉有用的代码点赞，您的评价将有助于系统推荐出更棒的C++代码示例。
示例1: s_wsle
/* Main program */ int MAIN__(void)
{
/* Builtin functions */
integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen),
e_wsle(void);
/* Local variables */
integer patch, major, minor;
extern /* Subroutine */ int ilaver_(integer *, integer *, integer *);
/* Fortran I/O blocks */
static cilist io___4 = { 0, 6, 0, 0, 0 };
ilaver_(&major, &minor, &patch);
s_wsle(&io___4);
do_lio(&c__9, &c__1, "LAPACK ", (ftnlen)7);
do_lio(&c__3, &c__1, (char *)&major, (ftnlen)sizeof(integer));
do_lio(&c__9, &c__1, ".", (ftnlen)1);
do_lio(&c__3, &c__1, (char *)&minor, (ftnlen)sizeof(integer));
do_lio(&c__9, &c__1, ".", (ftnlen)1);
do_lio(&c__3, &c__1, (char *)&patch, (ftnlen)sizeof(integer));
e_wsle();
return 0;
} /* MAIN__ */示例2: s_wsle
/* Subroutine */ int check0_(doublereal *sfac)
{
/* Initialized data */
static doublereal ds1[8] = { .8,.6,.8,-.6,.8,0.,1.,0. };
static doublereal datrue[8] = { .5,.5,.5,-.5,-.5,0.,1.,1. };
static doublereal dbtrue[8] = { 0.,.6,0.,-.6,0.,0.,1.,0. };
static doublereal da1[8] = { .3,.4,-.3,-.4,-.3,0.,0.,1. };
static doublereal db1[8] = { .4,.3,.4,.3,-.4,0.,1.,0. };
static doublereal dc1[8] = { .6,.8,-.6,.8,.6,1.,0.,1. };
/* Builtin functions */
integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen),
e_wsle(void);
/* Subroutine */ int s_stop(char *, ftnlen);
/* Local variables */
static integer k;
extern /* Subroutine */ int drotg_(doublereal *, doublereal *, doublereal
*, doublereal *), stest1_(doublereal *, doublereal *, doublereal *
, doublereal *);
static doublereal sa, sb, sc, ss;
/* Fortran I/O blocks */
static cilist io___19 = { 0, 6, 0, 0, 0 };
/* Compute true values which cannot be prestored
in decimal notation */
dbtrue[0] = 1.6666666666666667;
dbtrue[2] = -1.6666666666666667;
dbtrue[4] = 1.6666666666666667;
for (k = 1; k <= 8; ++k) {
combla_1.n = k;
if (combla_1.icase == 3) {
if (k > 8) {
goto L40;
}
sa = da1[k - 1];
sb = db1[k - 1];
drotg_(&sa, &sb, &sc, &ss);
stest1_(&sa, &datrue[k - 1], &datrue[k - 1], sfac);
stest1_(&sb, &dbtrue[k - 1], &dbtrue[k - 1], sfac);
stest1_(&sc, &dc1[k - 1], &dc1[k - 1], sfac);
stest1_(&ss, &ds1[k - 1], &ds1[k - 1], sfac);
} else {
s_wsle(&io___19);
do_lio(&c__9, &c__1, " Shouldn't be here in CHECK0", (ftnlen)28);
e_wsle();
s_stop("", (ftnlen)0);
}
/* L20: */
}
L40:
return 0;
} /* check0_ 示例3: atan
/* whatsoever. */
/* Subroutine */ int wavelet_(integer *n, doublereal *y, doublereal *dt,
integer *mother, doublereal *param, doublereal *s0, doublereal *dj,
integer *jtot, integer *npad, doublecomplex *wave, doublereal *scale,
doublereal *period, doublereal *coi)
{
/* System generated locals */
integer wave_dim1, wave_offset, i__1, i__2, i__3, i__4, i__5;
doublereal d__1;
doublecomplex z__1;
/* Builtin functions */
double atan(doublereal);
integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen),
e_wsle();
double pow_dd(doublereal *, doublereal *);
/* Local variables */
doublecomplex daughter[65535];
integer i__, j, k;
doublereal pi, coi1;
doublecomplex yfft[65535];
doublereal freq1;
extern /* Subroutine */ int cfftb_(integer *, doublecomplex *, doublereal
*), cfftf_(integer *, doublecomplex *, doublereal *), cffti_(
integer *, doublereal *);
doublereal ymean, kwave[65535], wsave[262155];
extern /* Subroutine */ int wave_function__(integer *, doublereal *,
integer *, doublereal *, doublereal *, doublereal *, doublereal *,
doublereal *, doublecomplex *);
doublereal period1;
/* Fortran I/O blocks */
static cilist io___2 = { 0, 6, 0, 0, 0 };
/* ** initialize work arrays */
/* Parameter adjustments */
--coi;
--y;
--period;
--scale;
wave_dim1 = *n;
wave_offset = 1 + wave_dim1;
wave -= wave_offset;
/* Function Body */
pi = atan(1.) * 4.;
if (*npad < *n) {
s_wsle(&io___2);
do_lio(&c__9, &c__1, "**WAVELET: \"npad\" must be greater than or eq\
ual to \"n\"", (ftnlen)54);
e_wsle();
return 0;
}示例4: fio_swsle
/* PURE fio_swsle PUREGVA */
int fio_swsle( int cierr, int ciunit, int ciend, const char* cifmt, int cirec )
{
cilist params;
params.cierr = cierr;
params.ciunit = ciunit;
params.ciend = ciend;
params.cifmt = cifmt;
params.cirec = cirec;
return s_wsle( ¶ms );
}示例5: MAIN__
// address: 80486cc
void MAIN__(__size32 param1) {
int local0; // m[esp - 16]
s_wsle();
do_lio();
e_wsle();
s_rsle();
do_lio();
e_rsle();
if (param1 == 2) {
}
if (param1 == 3) {
}
if (param1 == 4) {
}
switch(local0) {
case 0x8048760:
s_wsle();
do_lio();
e_wsle();
break;
case 0x8048793:
s_wsle();
do_lio();
e_wsle();
break;
case 0x80487c3:
s_wsle();
do_lio();
e_wsle();
break;
case 0x80487f3:
s_wsle();
do_lio();
e_wsle();
break;
}
return;
}示例6: s_wsle
/* * *************************************************************************** */
/* Main program */ int MAIN__(void)
{
/* Builtin functions */
integer s_wsle(cilist *), do_lio(integer *, integer *, char *, ftnlen),
e_wsle(void);
/* Subroutine */ int s_stop(char *, ftnlen);
/* Fortran I/O blocks */
static cilist io___1 = { 0, 6, 0, 0, 0 };
s_wsle(&io___1);
do_lio(&c__9, &c__1, "Hello, Word!", (ftnlen)12);
e_wsle();
s_stop("", (ftnlen)0);
return 0;
} /* MAIN__ */示例7: s_wsle
/* Subroutine */ int serrgt_(char *path, integer *nunit)
{
/* System generated locals */
real r__1;
/* Builtin functions */
integer s_wsle(cilist *), e_wsle(void);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
/* Local variables */
real b[2], c__[2], d__[2], e[2], f[2], w[2], x[2];
char c2[2];
real r1[2], r2[2], cf[2], df[2], ef[2];
integer ip[2], iw[2], info;
real rcond, anorm;
extern /* Subroutine */ int alaesm_(char *, logical *, integer *);
extern logical lsamen_(integer *, char *, char *);
extern /* Subroutine */ int chkxer_(char *, integer *, integer *, logical
*, logical *), sgtcon_(char *, integer *, real *, real *,
real *, real *, integer *, real *, real *, real *, integer *,
integer *), sptcon_(integer *, real *, real *, real *,
real *, real *, integer *), sgtrfs_(char *, integer *, integer *,
real *, real *, real *, real *, real *, real *, real *, integer *,
real *, integer *, real *, integer *, real *, real *, real *,
integer *, integer *), sgttrf_(integer *, real *, real *,
real *, real *, integer *, integer *), sptrfs_(integer *, integer
*, real *, real *, real *, real *, real *, integer *, real *,
integer *, real *, real *, real *, integer *), spttrf_(integer *,
real *, real *, integer *), sgttrs_(char *, integer *, integer *,
real *, real *, real *, real *, integer *, real *, integer *,
integer *), spttrs_(integer *, integer *, real *, real *,
real *, integer *, integer *);
/* Fortran I/O blocks */
static cilist io___1 = { 0, 0, 0, 0, 0 };
/* -- LAPACK test routine (version 3.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* SERRGT tests the error exits for the REAL tridiagonal */
/* routines. */
/* 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 Functions .. */
/* .. */
/* .. External Subroutines .. */
/* .. */
/* .. Scalars in Common .. */
/* .. */
/* .. Common blocks .. */
/* .. */
/* .. Executable Statements .. */
infoc_1.nout = *nunit;
io___1.ciunit = infoc_1.nout;
s_wsle(&io___1);
e_wsle();
s_copy(c2, path + 1, (ftnlen)2, (ftnlen)2);
d__[0] = 1.f;
d__[1] = 2.f;
df[0] = 1.f;
df[1] = 2.f;
e[0] = 3.f;
e[1] = 4.f;
ef[0] = 3.f;
ef[1] = 4.f;
anorm = 1.f;
infoc_1.ok = TRUE_;
if (lsamen_(&c__2, c2, "GT")) {
/* Test error exits for the general tridiagonal routines. */
/* SGTTRF */
//.........这里部分代码省略.........
示例8: s_wsle
/* Subroutine */ int serrlq_(char *path, integer *nunit)
{
/* Local variables */
real a[4] /* was [2][2] */, b[2];
integer i__, j;
real w[2], x[2], af[4] /* was [2][2] */;
integer info;
/* Fortran I/O blocks */
static cilist io___1 = { 0, 0, 0, 0, 0 };
/* -- LAPACK test routine (version 3.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* SERRLQ tests the error exits for the REAL routines */
/* that use the LQ decomposition of a general matrix. */
/* 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 <= 2; ++j) {
for (i__ = 1; i__ <= 2; ++i__) {
a[i__ + (j << 1) - 3] = 1.f / (real) (i__ + j);
af[i__ + (j << 1) - 3] = 1.f / (real) (i__ + j);
/* L10: */
}
b[j - 1] = 0.f;
w[j - 1] = 0.f;
x[j - 1] = 0.f;
/* L20: */
}
infoc_1.ok = TRUE_;
/* Error exits for LQ factorization */
/* SGELQF */
s_copy(srnamc_1.srnamt, "SGELQF", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
sgelqf_(&c_n1, &c__0, a, &c__1, b, w, &c__1, &info);
chkxer_("SGELQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
sgelqf_(&c__0, &c_n1, a, &c__1, b, w, &c__1, &info);
chkxer_("SGELQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
sgelqf_(&c__2, &c__1, a, &c__1, b, w, &c__2, &info);
chkxer_("SGELQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 7;
sgelqf_(&c__2, &c__1, a, &c__2, b, w, &c__1, &info);
chkxer_("SGELQF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* SGELQ2 */
s_copy(srnamc_1.srnamt, "SGELQ2", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
sgelq2_(&c_n1, &c__0, a, &c__1, b, w, &info);
//.........这里部分代码省略.........
示例9: s_wsle
/* Subroutine */ int serrps_(char *path, integer *nunit)
{
/* Builtin functions */
integer s_wsle(cilist *), e_wsle(void);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
/* Local variables */
real a[16] /* was [4][4] */;
integer i__, j, piv[4], info;
real work[8];
extern /* Subroutine */ int spstf2_(char *, integer *, real *, integer *,
integer *, integer *, real *, real *, integer *), alaesm_(
char *, logical *, integer *), chkxer_(char *, integer *,
integer *, logical *, logical *), spstrf_(char *, integer
*, real *, 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 */
/* ======= */
/* SERRPS tests the error exits for the REAL routines */
/* for SPSTRF.. */
/* 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__) {
a[i__ + (j << 2) - 5] = 1.f / (real) (i__ + j);
/* L100: */
}
piv[j - 1] = j;
work[j - 1] = 0.f;
work[j + 3] = 0.f;
/* L110: */
}
infoc_1.ok = TRUE_;
/* Test error exits of the routines that use the Cholesky */
/* decomposition of a symmetric positive semidefinite matrix. */
/* SPSTRF */
s_copy(srnamc_1.srnamt, "SPSTRF", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
spstrf_("/", &c__0, a, &c__1, piv, &c__1, &c_b9, work, &info);
chkxer_("SPSTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
spstrf_("U", &c_n1, a, &c__1, piv, &c__1, &c_b9, work, &info);
chkxer_("SPSTRF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
spstrf_("U", &c__2, a, &c__1, piv, &c__1, &c_b9, work, &info);
//.........这里部分代码省略.........
示例10: s_copy
/* Subroutine */ int cerrqp_(char *path, integer *nunit)
{
/* System generated locals */
integer i__1;
/* Local variables */
complex a[9] /* was [3][3] */, w[15];
char c2[2];
integer ip[3], lw;
real rw[6];
complex tau[3];
integer info;
/* Fortran I/O blocks */
static cilist io___4 = { 0, 0, 0, 0, 0 };
/* -- LAPACK test routine (version 3.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* CERRQP tests the error exits for CGEQPF and CGEQP3. */
/* 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 Functions .. */
/* .. */
/* .. External Subroutines .. */
/* .. */
/* .. Scalars in Common .. */
/* .. */
/* .. Common blocks .. */
/* .. */
/* .. Intrinsic Functions .. */
/* .. */
/* .. Executable Statements .. */
infoc_1.nout = *nunit;
s_copy(c2, path + 1, (ftnlen)2, (ftnlen)2);
lw = 4;
a[0].r = 1.f, a[0].i = -1.f;
a[3].r = 2.f, a[3].i = -2.f;
a[4].r = 3.f, a[4].i = -3.f;
a[1].r = 4.f, a[1].i = -4.f;
infoc_1.ok = TRUE_;
io___4.ciunit = infoc_1.nout;
s_wsle(&io___4);
e_wsle();
/* Test error exits for QR factorization with pivoting */
if (lsamen_(&c__2, c2, "QP")) {
/* CGEQPF */
s_copy(srnamc_1.srnamt, "CGEQPF", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
cgeqpf_(&c_n1, &c__0, a, &c__1, ip, tau, w, rw, &info);
chkxer_("CGEQPF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
cgeqpf_(&c__0, &c_n1, a, &c__1, ip, tau, w, rw, &info);
chkxer_("CGEQPF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 4;
cgeqpf_(&c__2, &c__0, a, &c__1, ip, tau, w, rw, &info);
chkxer_("CGEQPF", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
/* CGEQP3 */
s_copy(srnamc_1.srnamt, "CGEQP3", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
cgeqp3_(&c_n1, &c__0, a, &c__1, ip, tau, w, &lw, rw, &info);
chkxer_("CGEQP3", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
cgeqp3_(&c__1, &c_n1, a, &c__1, ip, tau, w, &lw, rw, &info);
//.........这里部分代码省略.........
示例11: Error
//.........这里部分代码省略.........
i__3 = n;
for (i__ = 1; i__ <= i__3; ++i__) {
i__4 = i__ + j * a_dim1;
i__5 = i__ + j * a_dim1;
q__1.r = small * a[i__5].r, q__1.i = small * a[i__5]
.i;
a[i__4].r = q__1.r, a[i__4].i = q__1.i;
}
}
}
/* Do first for UPLO = 'U', then for UPLO = 'L' */
for (iuplo = 1; iuplo <= 2; ++iuplo) {
*(unsigned char *)uplo = *(unsigned char *)&uplos[iuplo - 1];
/* Do first for CFORM = 'N', then for CFORM = 'C' */
for (iform = 1; iform <= 2; ++iform) {
*(unsigned char *)cform = *(unsigned char *)&forms[iform
- 1];
s_copy(srnamc_1.srnamt, "CTRTTF", (ftnlen)32, (ftnlen)6);
ctrttf_(cform, uplo, &n, &a[a_offset], lda, &arf[1], &
info);
/* Check error code from CTRTTF */
if (info != 0) {
if (nfail == 0 && nerrs == 0) {
io___22.ciunit = *nout;
s_wsle(&io___22);
e_wsle();
io___23.ciunit = *nout;
s_wsfe(&io___23);
e_wsfe();
}
io___24.ciunit = *nout;
s_wsfe(&io___24);
do_fio(&c__1, srnamc_1.srnamt, (ftnlen)32);
do_fio(&c__1, uplo, (ftnlen)1);
do_fio(&c__1, cform, (ftnlen)1);
do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
e_wsfe();
++nerrs;
goto L100;
}
for (inorm = 1; inorm <= 4; ++inorm) {
/* Check all four norms: 'M', '1', 'I', 'F' */
*(unsigned char *)norm = *(unsigned char *)&norms[
inorm - 1];
normarf = clanhf_(norm, cform, uplo, &n, &arf[1], &
work[1]);
norma = clanhe_(norm, uplo, &n, &a[a_offset], lda, &
work[1]);
result[0] = (norma - normarf) / norma / eps;
++nrun;
if (result[0] >= *thresh) {
if (nfail == 0 && nerrs == 0) {示例12: zgebak_
//.........这里部分代码省略.........
/* ZUNMHR, ZHSEQR, CHSEIN, and ZTREVC. */
/* 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 Functions .. */
/* .. */
/* .. External Subroutines .. */
/* .. */
/* .. Intrinsic Functions .. */
/* .. */
/* .. Scalars in Common .. */
/* .. */
/* .. Common blocks .. */
/* .. */
/* .. Executable Statements .. */
infoc_1.nout = *nunit;
io___1.ciunit = infoc_1.nout;
s_wsle(&io___1);
e_wsle();
s_copy(c2, path + 1, (ftnlen)2, (ftnlen)2);
/* Set the variables to innocuous values. */
for (j = 1; j <= 3; ++j) {
for (i__ = 1; i__ <= 3; ++i__) {
i__1 = i__ + j * 3 - 4;
d__1 = 1. / (doublereal) (i__ + j);
a[i__1].r = d__1, a[i__1].i = 0.;
/* L10: */
}
sel[j - 1] = TRUE_;
/* L20: */
}
infoc_1.ok = TRUE_;
nt = 0;
/* Test error exits of the nonsymmetric eigenvalue routines. */
if (lsamen_(&c__2, c2, "HS")) {
/* ZGEBAL */
s_copy(srnamc_1.srnamt, "ZGEBAL", (ftnlen)32, (ftnlen)6);
infoc_1.infot = 1;
zgebal_("/", &c__0, a, &c__1, &ilo, &ihi, s, &info);
chkxer_("ZGEBAL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &
infoc_1.ok);
infoc_1.infot = 2;
zgebal_("N", &c_n1, a, &c__1, &ilo, &ihi, s, &info);
chkxer_("ZGEBAL", &infoc_1.infot, &infoc_1.nout, &infoc_1.lerr, &示例13: f_open
/* Subroutine */ int geoutg_(integer *iprt)
{
/* Initialized data */
static char elemnt[2*107] = " H" "He" "Li" "Be" " B" " C" " N" " O" " F"
"Ne" "Na" "Mg" "Al" "Si" " P" " S" "Cl" "Ar" " K" "Ca" "Sc" "Ti"
" V" "Cr" "Mn" "Fe" "Co" "Ni" "Cu" "Zn" "Ga" "Ge" "As" "Se" "Br"
"Kr" "Rb" "Sr" " Y" "Zr" "Nb" "Mo" "Tc" "Ru" "Rh" "Pd" "Ag" "Cd"
"In" "Sn" "Sb" "Te" " I" "Xe" "Cs" "Ba" "La" "Ce" "Pr" "Nd" "Pm"
"Sm" "Eu" "Gd" "Tb" "Dy" "Ho" "Er" "Tm" "Yb" "Lu" "Hf" "Ta" " W"
"Re" "Os" "Ir" "Pt" "Au" "Hg" "Tl" "Pb" "Bi" "Po" "At" "Rn" "Fr"
"Ra" "Ac" "Th" "Pa" " U" "Np" "Pu" "Am" "Cm" "Bk" "Cf" "XX" "Fm"
"Md" "Cb" "++" " +" "--" " -" "Tv";
static char type__[1*3] = "r" "a" "d";
/* System generated locals */
address a__1[3];
integer i__1, i__2[3], i__3, i__4;
doublereal d__1;
olist o__1;
alist al__1;
/* Builtin functions */
integer f_open(olist *);
double asin(doublereal);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer f_rew(alist *), s_wsfe(cilist *), do_fio(integer *, char *,
ftnlen), e_wsfe(void), s_rsfe(cilist *), e_rsfe(void), s_cmp(char
*, char *, ftnlen, ftnlen);
/* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
integer s_wsle(cilist *), e_wsle(void);
/* Local variables */
static integer i__, j, l, nbi, nci;
extern /* Subroutine */ int xxx_(char *, integer *, integer *, integer *,
integer *, char *, ftnlen, ftnlen);
static integer igeo[360] /* was [3][120] */;
static char line[15*3*120];
static integer nopt;
static char blank[80];
static doublereal degree;
static char optdat[14*360];
static integer maxtxt;
/* Fortran I/O blocks */
static cilist io___10 = { 0, 21, 0, "(F12.6)", 0 };
static cilist io___11 = { 0, 21, 0, "(F12.6)", 0 };
static cilist io___12 = { 0, 21, 0, "(A)", 0 };
static cilist io___17 = { 0, 0, 0, "(1X,A,I4,A,I4,A,I4,A,I4)", 0 };
static cilist io___18 = { 0, 0, 0, "(1X,A,I4,A,I4,A,I4,A,I4)", 0 };
static cilist io___19 = { 0, 0, 0, "(1X,A,I4,A,I4,A,I4,A,I4)", 0 };
static cilist io___21 = { 0, 0, 0, "(1X,A,I4,A,I4,A,I4,A,I4)", 0 };
static cilist io___22 = { 0, 0, 0, 0, 0 };
static cilist io___23 = { 0, 0, 0, "(A,F12.6)", 0 };
static cilist io___24 = { 0, 0, 0, "(A,F12.6)", 0 };
/* COMDECK SIZES */
/* *********************************************************************** */
/* THIS FILE CONTAINS ALL THE ARRAY SIZES FOR USE IN MOPAC. */
/* THERE ARE ONLY 5 PARAMETERS THAT THE PROGRAMMER NEED SET: */
/* MAXHEV = MAXIMUM NUMBER OF HEAVY ATOMS (HEAVY: NON-HYDROGEN ATOMS) */
/* MAXLIT = MAXIMUM NUMBER OF HYDROGEN ATOMS. */
/* MAXTIM = DEFAULT TIME FOR A JOB. (SECONDS) */
/* MAXDMP = DEFAULT TIME FOR AUTOMATIC RESTART FILE GENERATION (SECS) */
/* ISYBYL = 1 IF MOPAC IS TO BE USED IN THE SYBYL PACKAGE, =0 OTHERWISE */
/* SEE ALSO NMECI, NPULAY AND MESP AT THE END OF THIS FILE */
/* *********************************************************************** */
/* THE FOLLOWING CODE DOES NOT NEED TO BE ALTERED BY THE PROGRAMMER */
/* *********************************************************************** */
/* ALL OTHER PARAMETERS ARE DERIVED FUNCTIONS OF THESE TWO PARAMETERS */
/* NAME DEFINITION */
/* NUMATM MAXIMUM NUMBER OF ATOMS ALLOWED. */
/* MAXORB MAXIMUM NUMBER OF ORBITALS ALLOWED. */
/* MAXPAR MAXIMUM NUMBER OF PARAMETERS FOR OPTIMISATION. */
/* N2ELEC MAXIMUM NUMBER OF TWO ELECTRON INTEGRALS ALLOWED. */
/* MPACK AREA OF LOWER HALF TRIANGLE OF DENSITY MATRIX. */
/* MORB2 SQUARE OF THE MAXIMUM NUMBER OF ORBITALS ALLOWED. */
/* MAXHES AREA OF HESSIAN MATRIX */
/* MAXALL LARGER THAN MAXORB OR MAXPAR. */
/* *********************************************************************** */
/* *********************************************************************** */
/* DECK MOPAC */
/* *********************************************************************** */
/* GEOUTG WRITES OUT THE GEOMETRY IN GAUSSIAN-8X STYLE */
/* *********************************************************************** */
i__1 = geokst_1.natoms;
for (i__ = 1; i__ <= i__1; ++i__) {
for (j = 1; j <= 3; ++j) {
/* L10: */
//.........这里部分代码省略.........
示例14: s_wsle
/* Subroutine */ int zcklse_(integer *nn, integer *mval, integer *pval,
integer *nval, integer *nmats, integer *iseed, doublereal *thresh,
integer *nmax, doublecomplex *a, doublecomplex *af, doublecomplex *b,
doublecomplex *bf, doublecomplex *x, doublecomplex *work, doublereal *
rwork, integer *nin, integer *nout, integer *info)
{
/* Format strings */
static char fmt_9997[] = "(\002 *** Invalid input for LSE: M = \002,"
"i6,\002, P = \002,i6,\002, N = \002,i6,\002;\002,/\002 must "
"satisfy P <= N <= P+M \002,\002(this set of values will be skip"
"ped)\002)";
static char fmt_9999[] = "(\002 ZLATMS in ZCKLSE INFO = \002,i5)";
static char fmt_9998[] = "(\002 M=\002,i4,\002 P=\002,i4,\002, N=\002,"
"i4,\002, type \002,i2,\002, test \002,i2,\002, ratio=\002,g13.6)";
/* System generated locals */
integer i__1, i__2, i__3, i__4, i__5, i__6, i__7;
/* Builtin functions */
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer s_wsle(cilist *), e_wsle(void), s_wsfe(cilist *), do_fio(integer *
, char *, ftnlen), e_wsfe(void);
/* Local variables */
integer i__, m, n, p, ik, nt, lda, ldb, kla, klb, kua, kub, imat;
char path[3], type__[1];
integer nrun, modea, modeb, nfail;
char dista[1], distb[1];
integer iinfo;
doublereal anorm, bnorm;
integer lwork;
extern /* Subroutine */ int dlatb9_(char *, integer *, integer *, integer
*, integer *, char *, integer *, integer *, integer *, integer *,
doublereal *, doublereal *, integer *, integer *, doublereal *,
doublereal *, char *, char *),
alahdg_(integer *, char *);
doublereal cndnma, cndnmb;
extern /* Subroutine */ int alareq_(char *, integer *, logical *, integer
*, integer *, integer *), alasum_(char *, integer *,
integer *, integer *, integer *), zlarhs_(char *, char *,
char *, char *, integer *, integer *, integer *, integer *,
integer *, doublecomplex *, integer *, doublecomplex *, integer *,
doublecomplex *, integer *, integer *, integer *);
logical dotype[8];
extern /* Subroutine */ int zlatms_(integer *, integer *, char *, integer
*, char *, doublereal *, integer *, doublereal *, doublereal *,
integer *, integer *, char *, doublecomplex *, integer *,
doublecomplex *, integer *);
logical firstt;
doublereal result[7];
extern /* Subroutine */ int zlsets_(integer *, integer *, integer *,
doublecomplex *, doublecomplex *, integer *, doublecomplex *,
doublecomplex *, integer *, doublecomplex *, doublecomplex *,
doublecomplex *, doublecomplex *, doublecomplex *, doublecomplex *
, integer *, doublereal *, doublereal *);
/* Fortran I/O blocks */
static cilist io___13 = { 0, 0, 0, 0, 0 };
static cilist io___14 = { 0, 0, 0, fmt_9997, 0 };
static cilist io___30 = { 0, 0, 0, fmt_9999, 0 };
static cilist io___31 = { 0, 0, 0, fmt_9999, 0 };
static cilist io___35 = { 0, 0, 0, fmt_9998, 0 };
/* -- LAPACK test routine (version 3.1) -- */
/* Univ. of Tennessee, Univ. of California Berkeley and NAG Ltd.. */
/* November 2006 */
/* .. Scalar Arguments .. */
/* .. */
/* .. Array Arguments .. */
/* .. */
/* Purpose */
/* ======= */
/* ZCKLSE tests ZGGLSE - a subroutine for solving linear equality */
/* constrained least square problem (LSE). */
/* Arguments */
/* ========= */
/* NN (input) INTEGER */
/* The number of values of (M,P,N) contained in the vectors */
/* (MVAL, PVAL, NVAL). */
/* MVAL (input) INTEGER array, dimension (NN) */
/* The values of the matrix row(column) dimension M. */
/* PVAL (input) INTEGER array, dimension (NN) */
/* The values of the matrix row(column) dimension P. */
/* NVAL (input) INTEGER array, dimension (NN) */
/* The values of the matrix column(row) dimension N. */
/* NMATS (input) INTEGER */
/* The number of matrix types to be tested for each combination */
/* of matrix dimensions. If NMATS >= NTYPES (the maximum */
/* number of matrix types), then all the different types are */
//.........这里部分代码省略.........
示例15: s_wsfe
/* Subroutine */ int sprtbr_(char *lab1, char *lab2, integer *ntypes, logical
*dotype, integer *nsizes, integer *mm, integer *nn, integer *nparms,
logical *doline, real *reslts, integer *ldr1, integer *ldr2, integer *
nout, ftnlen lab1_len, ftnlen lab2_len)
{
/* Format strings */
static char fmt_9999[] = "(7x,a4,(12(\002(\002,i4,\002,\002,i4,\002)\002"
",:)))";
static char fmt_9998[] = "(3x,a4)";
static char fmt_9997[] = "(3x,i4,4x,1p,(12(3x,g8.2)))";
static char fmt_9996[] = "(11x,1p,(12(3x,g8.2)))";
/* System generated locals */
integer reslts_dim1, reslts_dim2, reslts_offset, i__1, i__2, i__3;
/* Builtin functions */
integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void),
s_wsle(cilist *), e_wsle(void);
/* Local variables */
static integer i__, j, k, iline;
/* Fortran I/O blocks */
static cilist io___1 = { 0, 0, 0, fmt_9999, 0 };
static cilist io___3 = { 0, 0, 0, fmt_9998, 0 };
static cilist io___6 = { 0, 0, 0, fmt_9997, 0 };
static cilist io___8 = { 0, 0, 0, fmt_9996, 0 };
static cilist io___9 = { 0, 0, 0, 0, 0 };
#define reslts_ref(a_1,a_2,a_3) reslts[((a_3)*reslts_dim2 + (a_2))*\
reslts_dim1 + a_1]
/* -- LAPACK timing routine (version 3.0) --
Univ. of Tennessee, Univ. of California Berkeley, NAG Ltd.,
Courant Institute, Argonne National Lab, and Rice University
February 29, 1992
Purpose
=======
SPRTBR prints a table of timing data for the timing programs.
The table has NTYPES block rows and NSIZES columns, with NPARMS
individual rows in each block row.
Arguments (none are modified)
=========
LAB1 - CHARACTER*(*)
The label for the rows.
LAB2 - CHARACTER*(*)
The label for the columns.
NTYPES - INTEGER
The number of values of DOTYPE, and also the
number of sets of rows of the table.
DOTYPE - LOGICAL array of dimension( NTYPES )
If DOTYPE(j) is .TRUE., then block row j (which includes
data from RESLTS( i, j, k ), for all i and k) will be
printed. If DOTYPE(j) is .FALSE., then block row j will
not be printed.
NSIZES - INTEGER
The number of values of NN, and also the
number of columns of the table.
MM - INTEGER array of dimension( NSIZES )
The values of M used to label each column.
NN - INTEGER array of dimension( NSIZES )
The values of N used to label each column.
NPARMS - INTEGER
The number of values of LDA, hence the
number of rows for each value of DOTYPE.
DOLINE - LOGICAL array of dimension( NPARMS )
If DOLINE(i) is .TRUE., then row i (which includes data
from RESLTS( i, j, k ) for all j and k) will be printed.
If DOLINE(i) is .FALSE., then row i will not be printed.
RESLTS - REAL array of dimension( LDR1, LDR2, NSIZES )
The timing results. The first index indicates the row,
the second index indicates the block row, and the last
indicates the column.
LDR1 - INTEGER
The first dimension of RESLTS. It must be at least
min( 1, NPARMS ).
LDR2 - INTEGER
The second dimension of RESLTS. It must be at least
min( 1, NTYPES ).
NOUT - INTEGER
//.........这里部分代码省略.........