本文整理汇总了C++中e_wsle函数的典型用法代码示例。如果您正苦于以下问题：C++ e_wsle函数的具体用法？C++ e_wsle怎么用？C++ e_wsle使用的例子？那么恭喜您, 这里精选的函数代码示例或许可以为您提供帮助。
在下文中一共展示了e_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: 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;
}示例5: 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__ */示例6: s_wsne
s_wsne(cilist *a)
#endif
{
int n;
if((n=c_le(a)))
return(n);
f__reading=0;
f__external=1;
f__formatted=1;
f__putn = x_putc;
L_len = LINE;
f__donewrec = x_wSL;
if(f__curunit->uwrt != 1 && f__nowwriting(f__curunit))
err(a->cierr, errno, "namelist output start");
x_wsne(a);
return e_wsle();
}示例7: s_wsle
/* Subroutine */ int cerrqr_(char *path, integer *nunit)
{
/* System generated locals */
integer i__1;
real r__1, r__2;
complex q__1;
/* Builtin functions */
integer s_wsle(cilist *), e_wsle(void);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
/* Local variables */
complex a[4] /* was [2][2] */, b[2];
integer i__, j;
complex w[2], x[2], af[4] /* was [2][2] */;
integer info;
extern /* Subroutine */ int cgeqr2_(integer *, integer *, complex *,
integer *, complex *, complex *, integer *), cung2r_(integer *,
integer *, integer *, complex *, integer *, complex *, complex *,
integer *), cunm2r_(char *, char *, integer *, integer *, integer
*, complex *, integer *, complex *, complex *, integer *, complex
*, integer *), alaesm_(char *, logical *, integer
*), cgeqrf_(integer *, integer *, complex *, integer *,
complex *, complex *, integer *, integer *), cgeqrs_(integer *,
integer *, integer *, complex *, integer *, complex *, complex *,
integer *, complex *, integer *, integer *), chkxer_(char *,
integer *, integer *, logical *, logical *), cungqr_(
integer *, integer *, integer *, complex *, integer *, complex *,
complex *, integer *, integer *), cunmqr_(char *, char *, integer
*, integer *, integer *, complex *, integer *, complex *, complex
*, integer *, complex *, 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 */
/* ======= */
/* CERRQR tests the error exits for the COMPLEX routines */
/* that use the QR 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__) {
i__1 = i__ + (j << 1) - 3;
r__1 = 1.f / (real) (i__ + j);
r__2 = -1.f / (real) (i__ + j);
q__1.r = r__1, q__1.i = r__2;
a[i__1].r = q__1.r, a[i__1].i = q__1.i;
i__1 = i__ + (j << 1) - 3;
r__1 = 1.f / (real) (i__ + j);
r__2 = -1.f / (real) (i__ + j);
q__1.r = r__1, q__1.i = r__2;
af[i__1].r = q__1.r, af[i__1].i = q__1.i;
/* L10: */
}
i__1 = j - 1;
b[i__1].r = 0.f, b[i__1].i = 0.f;
//.........这里部分代码省略.........
示例8: s_cmp
/* $Procedure META_2 ( Percy's interface to META_0 ) */
/* Subroutine */ int meta_2__0_(int n__, char *command, char *temps, integer *
ntemps, char *temp, integer *btemp, char *error, ftnlen command_len,
ftnlen temps_len, ftnlen temp_len, ftnlen error_len)
{
/* Initialized data */
static logical pass1 = TRUE_;
static char margns[128] = "LEFT 1 RIGHT 75 "
" "
" ";
static char keynam[6*10] = "1 " "2 " "3 " "4 " "5 "
"6 " "7 " "8 " "9 " "10 ";
/* System generated locals */
address a__1[5];
integer i__1, i__2[5];
/* Builtin functions */
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer s_cmp(char *, char *, ftnlen, ftnlen), s_wsle(cilist *), e_wsle(
void);
/* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
integer do_lio(integer *, integer *, char *, ftnlen);
/* Local variables */
extern /* Subroutine */ int getopt_1__(char *, integer *, char *, integer
*, char *, integer *, char *, char *, ftnlen, ftnlen, ftnlen,
ftnlen, ftnlen);
static integer sbeg;
static char mode[16], pick[32];
static integer b, e, i__, j;
extern integer cardc_(char *, ftnlen);
extern logical batch_(void);
static integer score;
static logical fixit;
extern integer rtrim_(char *, ftnlen);
static char style[128];
static integer m2code;
static char tryit[600];
extern /* Subroutine */ int m2gmch_(char *, char *, char *, integer *,
logical *, integer *, logical *, integer *, integer *, char *,
ftnlen, ftnlen, ftnlen, ftnlen), m2rcvr_(integer *, integer *,
char *, ftnlen), scardc_(integer *, char *, ftnlen);
static integer bscore, cutoff;
static logical reason;
extern /* Subroutine */ int prefix_(char *, integer *, char *, ftnlen,
ftnlen), ssizec_(integer *, char *, ftnlen), repsub_(char *,
integer *, integer *, char *, char *, ftnlen, ftnlen, ftnlen);
static logical intrct;
extern /* Subroutine */ int suffix_(char *, integer *, char *, ftnlen,
ftnlen);
static char thnwds[32*7], kwords[32*16];
extern /* Subroutine */ int cmprss_(char *, integer *, char *, char *,
ftnlen, ftnlen, ftnlen), prepsn_(char *, ftnlen);
static logical pssthn;
static char questn[80];
extern /* Subroutine */ int niceio_3__(char *, integer *, char *, ftnlen,
ftnlen), cnfirm_1__(char *, logical *, ftnlen);
/* Fortran I/O blocks */
static cilist io___19 = { 0, 6, 0, 0, 0 };
static cilist io___20 = { 0, 6, 0, 0, 0 };
static cilist io___21 = { 0, 6, 0, 0, 0 };
static cilist io___22 = { 0, 6, 0, 0, 0 };
static cilist io___23 = { 0, 6, 0, 0, 0 };
static cilist io___27 = { 0, 6, 0, 0, 0 };
static cilist io___29 = { 0, 6, 0, 0, 0 };
static cilist io___30 = { 0, 6, 0, 0, 0 };
static cilist io___31 = { 0, 6, 0, 0, 0 };
/* $ Abstract */
/* Given a collection of acceptable syntax's and a statement */
/* (COMMAND) this routine determines if the statement is */
/* syntactically correct. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
//.........这里部分代码省略.........
示例9: s_copy
/* Subroutine */ int dtimqp_(char *line, integer *nm, integer *mval, integer *
nval, integer *nlda, integer *ldaval, doublereal *timmin, doublereal *
a, doublereal *copya, doublereal *tau, doublereal *work, integer *
iwork, doublereal *reslts, integer *ldr1, integer *ldr2, integer *
nout, ftnlen line_len)
{
/* Initialized data */
static char subnam[6*1] = "DGEQPF";
static integer modes[2] = { 2,3 };
static integer iseed[4] = { 0,0,0,1 };
/* Format strings */
static char fmt_9999[] = "(1x,a6,\002 timing run not attempted\002,/)";
static char fmt_9998[] = "(/\002 *** Speed of \002,a6,\002 in megaflops "
"***\002)";
static char fmt_9997[] = "(5x,\002line \002,i2,\002 with LDA = \002,i5)";
/* System generated locals */
integer reslts_dim1, reslts_dim2, reslts_offset, i__1, i__2, i__3;
/* Builtin functions
Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void),
s_wsle(cilist *), e_wsle(void);
/* Local variables */
static integer ilda;
static doublereal cond;
static integer mode;
static doublereal dmax__;
static integer info;
static char path[3];
static doublereal time;
static integer i__, m, n;
static char cname[6];
static integer imode;
extern doublereal dopla_(char *, integer *, integer *, integer *, integer
*, integer *);
static integer minmn;
extern /* Subroutine */ int icopy_(integer *, integer *, integer *,
integer *, integer *);
static doublereal s1, s2;
extern /* Subroutine */ int dprtb5_(char *, char *, char *, integer *,
integer *, integer *, integer *, integer *, integer *, doublereal
*, integer *, integer *, integer *, ftnlen, ftnlen, ftnlen);
static integer ic, im;
extern doublereal dlamch_(char *), dsecnd_(void);
extern /* Subroutine */ int dgeqpf_(integer *, integer *, doublereal *,
integer *, integer *, doublereal *, doublereal *, integer *),
atimck_(integer *, char *, integer *, integer *, integer *,
integer *, integer *, integer *, ftnlen), dlacpy_(char *, integer
*, integer *, doublereal *, integer *, doublereal *, integer *);
extern doublereal dmflop_(doublereal *, doublereal *, integer *);
extern /* Subroutine */ int atimin_(char *, char *, integer *, char *,
logical *, integer *, integer *, ftnlen, ftnlen, ftnlen), dlatms_(
integer *, integer *, char *, integer *, char *, doublereal *,
integer *, doublereal *, doublereal *, integer *, integer *, char
*, doublereal *, integer *, doublereal *, integer *);
static doublereal untime;
static logical timsub[1];
static integer lda, icl;
static doublereal ops;
/* Fortran I/O blocks */
static cilist io___8 = { 0, 0, 0, fmt_9999, 0 };
static cilist io___27 = { 0, 0, 0, fmt_9998, 0 };
static cilist io___28 = { 0, 0, 0, fmt_9997, 0 };
static cilist io___29 = { 0, 0, 0, 0, 0 };
#define subnam_ref(a_0,a_1) &subnam[(a_1)*6 + a_0 - 6]
#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
June 30, 1999
Purpose
=======
DTIMQP times the LAPACK routines to perform the QR factorization with
column pivoting of a DOUBLE PRECISION general matrix.
Two matrix types may be used for timing. The number of types is
set in the parameter NMODE and the matrix types are set in the vector
MODES, using the following key:
2. BREAK1 D(1:N-1)=1 and D(N)=1.0/COND in DLATMS
3. GEOM D(I)=COND**(-(I-1)/(N-1)) in DLATMS
These numbers are chosen to correspond with the matrix types in the
test code.
Arguments
=========
//.........这里部分代码省略.........
示例10: 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 */
//.........这里部分代码省略.........
示例11: 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);
//.........这里部分代码省略.........
示例12: Error
//.........这里部分代码省略.........
s_copy(srnamc_1.srnamt, "ZTFSM", (ftnlen)
32, (ftnlen)5);
ztfsm_(cform, side, uplo, trans, diag, &m,
&n, &alpha, &arf[1], &b2[
b2_offset], lda);
/* Check that the result agrees. */
i__3 = n;
for (j = 1; j <= i__3; ++j) {
i__4 = m;
for (i__ = 1; i__ <= i__4; ++i__) {
i__5 = i__ + j * b1_dim1;
i__6 = i__ + j * b2_dim1;
i__7 = i__ + j * b1_dim1;
z__1.r = b2[i__6].r - b1[i__7].r,
z__1.i = b2[i__6].i - b1[
i__7].i;
b1[i__5].r = z__1.r, b1[i__5].i =
z__1.i;
}
}
result[0] = zlange_("I", &m, &n, &b1[
b1_offset], lda, &d_work_zlange__[
1]);
/* Computing MAX */
i__3 = max(m,n);
result[0] = result[0] / sqrt(eps) / max(
i__3,1);
if (result[0] >= *thresh) {
if (nfail == 0) {
io___32.ciunit = *nout;
s_wsle(&io___32);
e_wsle();
io___33.ciunit = *nout;
s_wsfe(&io___33);
e_wsfe();
}
io___34.ciunit = *nout;
s_wsfe(&io___34);
do_fio(&c__1, "ZTFSM", (ftnlen)5);
do_fio(&c__1, cform, (ftnlen)1);
do_fio(&c__1, side, (ftnlen)1);
do_fio(&c__1, uplo, (ftnlen)1);
do_fio(&c__1, trans, (ftnlen)1);
do_fio(&c__1, diag, (ftnlen)1);
do_fio(&c__1, (char *)&m, (ftnlen)
sizeof(integer));
do_fio(&c__1, (char *)&n, (ftnlen)
sizeof(integer));
do_fio(&c__1, (char *)&result[0], (
ftnlen)sizeof(doublereal));
e_wsfe();
++nfail;
}
/* L100: */
}
/* L110: */
}
/* L120: */
}
/* L130: */
}
/* L140: */
}
/* L150: */
}
/* L160: */
}
/* L170: */
}
/* Print a summary of the results. */
if (nfail == 0) {
io___35.ciunit = *nout;
s_wsfe(&io___35);
do_fio(&c__1, "ZTFSM", (ftnlen)5);
do_fio(&c__1, (char *)&nrun, (ftnlen)sizeof(integer));
e_wsfe();
} else {
io___36.ciunit = *nout;
s_wsfe(&io___36);
do_fio(&c__1, "ZTFSM", (ftnlen)5);
do_fio(&c__1, (char *)&nfail, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&nrun, (ftnlen)sizeof(integer));
e_wsfe();
}
return 0;
/* End of ZDRVRF3 */
} /* zdrvrf3_ */示例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: norm
//.........这里部分代码省略.........
tstrat[1] = 0.f;
}
if (tstrat[1] > 1.f) {
tstrat[1] = 1 / (eps * 4.f);
}
}
} else {
s_copy(cguar, "NO", (ftnlen)3, (ftnlen)2);
if (cwise_bnd__ < 1.f) {
tstrat[1] = 1 / (eps * 8.f);
} else {
tstrat[1] = 1.f;
}
}
/* Backwards error test */
tstrat[2] = berr[k - 1] / eps;
/* Condition number tests */
tstrat[3] = rcond / orcond;
if (rcond >= condthresh && tstrat[3] < 1.f) {
tstrat[3] = 1.f / tstrat[3];
}
tstrat[4] = ncond / nwise_rcond__;
if (ncond >= condthresh && tstrat[4] < 1.f) {
tstrat[4] = 1.f / tstrat[4];
}
tstrat[5] = ccond / nwise_rcond__;
if (ccond >= condthresh && tstrat[5] < 1.f) {
tstrat[5] = 1.f / tstrat[5];
}
for (i__ = 1; i__ <= 6; ++i__) {
if (tstrat[i__ - 1] > *thresh) {
if (! printed_guide__) {
s_wsle(&io___66);
e_wsle();
s_wsfe(&io___67);
do_fio(&c__1, (char *)&c__1, (ftnlen)sizeof(integer));
e_wsfe();
s_wsfe(&io___68);
do_fio(&c__1, (char *)&c__2, (ftnlen)sizeof(integer));
e_wsfe();
s_wsfe(&io___69);
do_fio(&c__1, (char *)&c__3, (ftnlen)sizeof(integer));
e_wsfe();
s_wsfe(&io___70);
do_fio(&c__1, (char *)&c__4, (ftnlen)sizeof(integer));
e_wsfe();
s_wsfe(&io___71);
do_fio(&c__1, (char *)&c__5, (ftnlen)sizeof(integer));
e_wsfe();
s_wsfe(&io___72);
do_fio(&c__1, (char *)&c__6, (ftnlen)sizeof(integer));
e_wsfe();
s_wsfe(&io___73);
do_fio(&c__1, (char *)&c__7, (ftnlen)sizeof(integer));
e_wsfe();
s_wsfe(&io___74);
do_fio(&c__1, (char *)&c__8, (ftnlen)sizeof(integer));
e_wsfe();
s_wsle(&io___75);
e_wsle();
printed_guide__ = TRUE_;
}
s_wsfe(&io___76);
do_fio(&c__1, c2, (ftnlen)2);
do_fio(&c__1, (char *)&n, (ftnlen)sizeof(integer));
do_fio(&c__1, (char *)&k, (ftnlen)sizeof(integer));示例15: 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);
//.........这里部分代码省略.........