本文整理汇总了C++中s_cmp函数的典型用法代码示例。如果您正苦于以下问题:C++ s_cmp函数的具体用法?C++ s_cmp怎么用?C++ s_cmp使用的例子?那么恭喜您, 这里精选的函数代码示例或许可以为您提供帮助。
在下文中一共展示了s_cmp函数的15个代码示例,这些例子默认根据受欢迎程度排序。您可以为喜欢或者感觉有用的代码点赞,您的评价将有助于系统推荐出更棒的C++代码示例。
示例1: nv3optmsat_
integer nv3optmsat_(integer *ifunc, real *xin, real *xout)
{
/* System generated locals */
integer ret_val;
char ch__1[4];
/* Builtin functions */
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer s_cmp(char *, char *, ftnlen, ftnlen);
/* Local variables */
extern /* Character */ VOID clit_(char *, ftnlen, integer *);
static char cfunc[4];
/* Parameter adjustments */
--xout;
--xin;
/* Function Body */
clit_(ch__1, (ftnlen)4, ifunc);
s_copy(cfunc, ch__1, (ftnlen)4, (ftnlen)4);
ret_val = 0;
if (s_cmp(cfunc, "SPOS", (ftnlen)4, (ftnlen)4) == 0) {
xout[1] = 0.f;
xout[2] = polyxxmsatnv3_1.sublon;
} else if (s_cmp(cfunc, "HGT ", (ftnlen)4, (ftnlen)4) == 0) {
metxxxmsatnv3_1.re = xin[1] + 6378.155f;
metxxxmsatnv3_1.a = .0033670033670033669f;
metxxxmsatnv3_1.rp = metxxxmsatnv3_1.re / (metxxxmsatnv3_1.a + 1.f);
} else {
ret_val = 1;
}
return ret_val;
} /* nv3optmsat_ */
示例2: nv2optrect_
integer nv2optrect_(integer *ifunc, real *xin, real *xout)
{
/* System generated locals */
integer ret_val;
char ch__1[4];
/* Builtin functions */
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer s_cmp(char *, char *, ftnlen, ftnlen);
/* Local variables */
extern /* Character */ VOID clit_(char *, ftnlen, integer *);
static char cfunc[4];
extern /* Subroutine */ int llobl_(real *, real *);
/* Parameter adjustments */
--xout;
--xin;
/* Function Body */
clit_(ch__1, (ftnlen)4, ifunc);
s_copy(cfunc, ch__1, (ftnlen)4, (ftnlen)4);
ret_val = 0;
if (s_cmp(cfunc, "SPOS", (ftnlen)4, (ftnlen)4) == 0) {
xout[1] = rctcomrectnv2_1.zslat;
xout[2] = rctcomrectnv2_1.zslon;
} else if (s_cmp(cfunc, "ORAD", (ftnlen)4, (ftnlen)4) == 0) {
llobl_(&xin[1], &xout[1]);
} else {
ret_val = 1;
}
return ret_val;
} /* nv2optrect_ */
示例3: nv2optmsgt_
integer nv2optmsgt_(integer *ifunc, real *xin, real *xout)
{
/* System generated locals */
integer ret_val;
char ch__1[4];
/* Builtin functions */
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer s_cmp(char *, char *, ftnlen, ftnlen);
/* Local variables */
extern /* Character */ VOID clit_(char *, ftnlen, integer *);
static char cfunc[4];
/* Parameter adjustments */
--xout;
--xin;
/* Function Body */
ret_val = 0;
clit_(ch__1, (ftnlen)4, ifunc);
s_copy(cfunc, ch__1, (ftnlen)4, (ftnlen)4);
if (s_cmp(cfunc, "SPOS", (ftnlen)4, (ftnlen)4) == 0) {
xout[1] = 0.f;
xout[2] = 0.f;
} else {
ret_val = -1;
}
return ret_val;
} /* nv2optmsgt_ */
示例4: i_indx
/* Subroutine */ int timer_(char *a, ftnlen a_len)
{
/* Initialized data */
static logical first = TRUE_;
/* System generated locals */
doublereal d__1, d__2;
/* Builtin functions */
integer i_indx(char *, char *, ftnlen, ftnlen), s_cmp(char *, char *,
ftnlen, ftnlen), s_wsfe(cilist *), do_fio(integer *, char *,
ftnlen), e_wsfe(void);
/* Local variables */
static doublereal t0, t1, t2;
extern doublereal second_(void);
/* Fortran I/O blocks */
static cilist io___5 = { 0, 6, 0, "(2X,A,A,F7.2,A,F8.2)", 0 };
static cilist io___6 = { 0, 6, 0, "(40X,'TIME LOST:',F7.2)", 0 };
if (first) {
/* DEFINE THE ZERO OF TIME */
t0 = second_();
t1 = t0;
first = FALSE_;
}
/* THE ACT OF CALLING THIS ROUTINE COSTS 0.026 SECONDS */
t0 += .026;
t2 = second_();
if (i_indx(a, "BEF", a_len, (ftnlen)3) == 0 && s_cmp(a, " ", a_len, (
ftnlen)1) != 0) {
s_wsfe(&io___5);
do_fio(&c__1, a, a_len);
do_fio(&c__1, " INTERVAL:", (ftnlen)10);
d__1 = t2 - t1;
do_fio(&c__1, (char *)&d__1, (ftnlen)sizeof(doublereal));
do_fio(&c__1, " INTEGRAL:", (ftnlen)10);
d__2 = t2 - t0;
do_fio(&c__1, (char *)&d__2, (ftnlen)sizeof(doublereal));
e_wsfe();
} else {
s_wsfe(&io___6);
d__1 = t2 - t1;
do_fio(&c__1, (char *)&d__1, (ftnlen)sizeof(doublereal));
e_wsfe();
}
t1 = t2 + .026;
return 0;
} /* timer_ */
示例5: nv2optps_
integer nv2optps_(integer *ifunc, real *xin, real *xout)
{
/* Initialized data */
static real rad = .01745329f;
/* System generated locals */
integer ret_val;
char ch__1[4];
/* Builtin functions */
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer s_cmp(char *, char *, ftnlen, ftnlen);
/* Local variables */
extern /* Character */ VOID clit_(char *, ftnlen, integer *);
static char cfunc[4];
extern /* Subroutine */ int llobl_(real *, real *);
/* Parameter adjustments */
--xout;
--xin;
/* Function Body */
clit_(ch__1, (ftnlen)4, ifunc);
s_copy(cfunc, ch__1, (ftnlen)4, (ftnlen)4);
ret_val = 0;
if (s_cmp(cfunc, "SPOS", (ftnlen)4, (ftnlen)4) == 0) {
xout[1] = pscompsnv2_1.xpole - pscompsnv2_1.xlat1 / rad;
xout[2] = pscompsnv2_1.xqlon;
} else if (s_cmp(cfunc, "ORAD", (ftnlen)4, (ftnlen)4) == 0) {
llobl_(&xin[1], &xout[1]);
} else {
ret_val = 1;
}
return ret_val;
} /* nv2optps_ */
示例6: nv2optgmsx_
integer nv2optgmsx_(integer *ifunc, real *xin, real *xout)
{
/* System generated locals */
integer ret_val;
char ch__1[4];
/* Builtin functions */
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer s_cmp(char *, char *, ftnlen, ftnlen);
/* Local variables */
extern /* Subroutine */ int sublatlon_(real *);
extern /* Character */ VOID clit_(char *, ftnlen, integer *);
static char cfunc[4];
extern /* Subroutine */ int sdest_(char *, integer *, ftnlen);
/* Parameter adjustments */
--xout;
--xin;
/* Function Body */
clit_(ch__1, (ftnlen)4, ifunc);
s_copy(cfunc, ch__1, (ftnlen)4, (ftnlen)4);
ret_val = 0;
if (s_cmp(cfunc, "SPOS", (ftnlen)4, (ftnlen)4) == 0) {
sublatlon_(&xout[1]);
sdest_("IN NVX OPT USING --- SPOS", &c__0, (ftnlen)25);
} else if (s_cmp(cfunc, "ANG ", (ftnlen)4, (ftnlen)4) == 0) {
sdest_("IN NVX OPT USING --- ANG ", &c__0, (ftnlen)25);
} else if (s_cmp(cfunc, "HGT ", (ftnlen)4, (ftnlen)4) == 0) {
sdest_("IN NVX OPT USING --- HGT ", &c__0, (ftnlen)25);
} else {
ret_val = 1;
}
return ret_val;
} /* nv2optgmsx_ */
示例7: beuns_
/* $Procedure BEUNS ( Be an unsigned integer? ) */
logical beuns_(char *string, ftnlen string_len)
{
/* System generated locals */
logical ret_val;
/* Builtin functions */
integer i_len(char *, ftnlen), i_indx(char *, char *, ftnlen, ftnlen),
s_cmp(char *, char *, ftnlen, ftnlen);
/* Local variables */
integer i__, l;
logical ok;
extern integer frstnb_(char *, ftnlen);
/* $ Abstract */
/* Determine whether a string represents an unsigned integer. */
/* $ 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 */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* WORDS */
/* $ Keywords */
/* ALPHANUMERIC */
/* NUMBERS */
/* SCANNING */
/* UTILITY */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* STRING I Character string. */
/* The function returns TRUE if the string represents an unsigned */
/* integer. Otherwise, it returns FALSE. */
/* $ Detailed_Input */
/* STRING is any string. */
/* $ Detailed_Output */
/* If STRING contains a single word made entirely from the */
/* characters '0' through '9', then the function returns TRUE. */
/* Otherwise, it returns FALSE. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* Error free. */
/* $ Files */
/* None. */
/* $ Particulars */
/* By definition an unsigned integer is a word made exclusively */
/* from the characters '0', '1', '2', '3', '4', '5', '6', '7', '8', */
/* and '9'. */
/* $ Examples */
/* Four classes of numbers recognized by the various BE functions. */
/* UNS unsigned integer */
/* INT integer (includes INT) */
//.........这里部分代码省略.........
示例8: s_cmp
/* $Procedure PRINST (Display string of CK-file summary) */
/* Subroutine */ int prinst_0_(int n__, integer *id, doublereal *tbegin,
doublereal *tend, integer *avflag, integer *frame, char *tout,
logical *fdsp, logical *tdsp, logical *gdsp, logical *ndsp, ftnlen
tout_len)
{
/* Initialized data */
static doublereal tbprev = 0.;
static doublereal teprev = 0.;
static integer idprev = 0;
/* System generated locals */
integer i__1;
/* Builtin functions */
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer s_cmp(char *, char *, ftnlen, ftnlen);
/* Local variables */
integer hint;
extern /* Subroutine */ int repmc_(char *, char *, char *, char *, ftnlen,
ftnlen, ftnlen, ftnlen);
integer scidw;
logical found;
extern /* Subroutine */ int repmi_(char *, char *, integer *, char *,
ftnlen, ftnlen, ftnlen);
extern integer rtrim_(char *, ftnlen);
integer frcode;
extern /* Subroutine */ int ccifrm_(integer *, integer *, integer *, char
*, integer *, logical *, ftnlen);
char idline[256], fnline[256], tbline[256], avline[256], teline[256];
extern /* Subroutine */ int timecn_(doublereal *, integer *, char *, char
*, ftnlen, ftnlen), frmnam_(integer *, char *, ftnlen), repmcw_(
char *, char *, char *, integer *, char *, ftnlen, ftnlen, ftnlen,
ftnlen);
char outlin[256];
extern /* Subroutine */ int tostdo_(char *, ftnlen), intstr_(integer *,
char *, ftnlen);
/* $ Abstract */
/* Write a single CK-file summary record string to standard */
/* output in requested format. */
/* $ 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 */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* CKBRIEF.UG */
/* $ Keywords */
/* SUMMARY */
/* CK */
/* $ Declarations */
/* $ 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. */
//.........这里部分代码省略.........
示例9: i_len
/* $Procedure SEPOOL ( String from pool ) */
/* Subroutine */ int sepool_(char *item, integer *fidx, char *contin, char *
string, integer *size, integer *lidx, logical *found, ftnlen item_len,
ftnlen contin_len, ftnlen string_len)
{
/* Builtin functions */
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer i_len(char *, ftnlen), s_cmp(char *, char *, ftnlen, ftnlen);
/* Local variables */
integer comp;
logical more;
char part[80];
integer room, n;
extern /* Subroutine */ int chkin_(char *, ftnlen);
integer clast, csize;
logical gotit;
extern integer rtrim_(char *, ftnlen);
integer putat;
extern /* Subroutine */ int gcpool_(char *, integer *, integer *, integer
*, char *, logical *, ftnlen, ftnlen);
integer cfirst;
extern /* Subroutine */ int chkout_(char *, ftnlen);
extern logical return_(void);
/* $ Abstract */
/* Retrieve the string starting at the FIDX element of the kernel */
/* pool variable, where the string may be continued across several */
/* components of the kernel pool variable. */
/* $ 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 */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* None. */
/* $ Keywords */
/* POOL */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- -------------------------------------------------- */
/* ITEM I name of the kernel pool variable */
/* FIDX I index of the first component of the string */
/* CONTIN I character sequence used to indicate continuation */
/* STRING O a full string concatenated across continuations */
/* SIZE O the number of character in the full string value */
/* LIDX O index of the last component of the string */
/* FOUND O flag indicating success or failure of request */
/* $ Detailed_Input */
/* ITEM is the name of a kernel pool variable for which */
/* the caller wants to retrieve a full (potentially */
/* continued) string. */
/* FIDX is the index of the first component (the start) of */
/* the string in ITEM. */
/* CONTIN is a sequence of characters which (if they appear as */
/* the last non-blank sequence of characters in a */
/* component of a value of a kernel pool variable) */
/* indicate that the string associated with the */
/* component is continued into the next literal */
/* component of the kernel pool variable. */
/* If CONTIN is blank, all of the components of ITEM */
/* will be retrieved as a single string. */
/* $ Detailed_Output */
/* STRING is the full string starting at the FIDX element of the */
/* kernel pool variable specified by ITEM. */
//.........这里部分代码省略.........
示例10: s_rsfe
/* $Procedure SPCT2B ( SPK and CK, text to binary ) */
/* Subroutine */ int spct2b_(integer *unit, char *binary, ftnlen binary_len)
{
/* System generated locals */
integer i__1;
cilist ci__1;
olist o__1;
cllist cl__1;
/* Builtin functions */
integer s_rsfe(cilist *), do_fio(integer *, char *, ftnlen), e_rsfe(void),
s_cmp(char *, char *, ftnlen, ftnlen), f_open(olist *), s_wsfe(
cilist *), e_wsfe(void), f_clos(cllist *);
/* Local variables */
char line[1000];
extern /* Subroutine */ int spcac_(integer *, integer *, char *, char *,
ftnlen, ftnlen), chkin_(char *, ftnlen);
extern integer ltrim_(char *, ftnlen), rtrim_(char *, ftnlen);
extern /* Subroutine */ int daft2b_(integer *, char *, integer *, ftnlen);
integer handle;
extern /* Subroutine */ int dafcls_(integer *), dafopw_(char *, integer *,
ftnlen);
integer scrtch;
extern /* Subroutine */ int errfnm_(char *, integer *, ftnlen), sigerr_(
char *, ftnlen), chkout_(char *, ftnlen), getlun_(integer *),
setmsg_(char *, ftnlen);
integer iostat;
extern /* Subroutine */ int errint_(char *, integer *, ftnlen);
extern logical return_(void);
/* $ Abstract */
/* Reconstruct a binary SPK or CK file including comments */
/* from a text file opened by the calling program. */
/* $ 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 */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* SPC */
/* $ Keywords */
/* FILES */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* UNIT I Logical unit connected to the text format file. */
/* BINARY I Name of a binary SPK or CK file to be created. */
/* $ Detailed_Input */
/* UNIT is the logical unit connected to an existing text */
/* format SPK or CK file that may contain comments in */
/* the appropriate SPC format, as written by SPCB2A or */
/* SPCB2T. This file must be opened for read access */
/* using the routine TXTOPR. */
/* This file may contain text that precedes and */
/* follows the SPK or CK data and comments, however, */
/* when calling this routine, the file pointer must be */
/* in a position in the file such that the next line */
/* returned by a READ statement is */
/* ''NAIF/DAF'' */
/* which marks the beginning of the data. */
/* BINARY is the name of a binary SPK or CK file to be created. */
/* The binary file contains the same data and comments */
/* as the text file, but in the binary format required */
/* for use with the SPICELIB reader subroutines. */
//.........这里部分代码省略.........
示例11: 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 */
//.........这里部分代码省略.........
示例12: s_rnge
/* $Procedure ZZBODKER ( Private --- Process Body-Name Kernel Pool Maps ) */
/* Subroutine */ int zzbodker_(char *names, char *nornam, integer *codes,
integer *nvals, integer *ordnom, integer *ordcod, integer *nocds,
logical *extker, ftnlen names_len, ftnlen nornam_len)
{
/* Initialized data */
static char nbc[32] = "NAIF_BODY_CODE ";
static char nbn[32] = "NAIF_BODY_NAME ";
/* System generated locals */
integer i__1, i__2, i__3, i__4, i__5;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer), s_cmp(char *, char *,
ftnlen, ftnlen);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
/* Local variables */
logical drop[2000];
char type__[1*2];
integer nsiz[2];
extern /* Subroutine */ int zzbodini_(char *, char *, integer *, integer *
, integer *, integer *, integer *, ftnlen, ftnlen);
integer i__, j;
extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *,
ftnlen, ftnlen), errch_(char *, char *, ftnlen, ftnlen);
logical found;
extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen);
logical plfind[2];
extern /* Subroutine */ int orderc_(char *, integer *, integer *, ftnlen),
gcpool_(char *, integer *, integer *, integer *, char *, logical
*, ftnlen, ftnlen), gipool_(char *, integer *, integer *, integer
*, integer *, logical *, ftnlen), sigerr_(char *, ftnlen);
logical remdup;
extern /* Subroutine */ int chkout_(char *, ftnlen), dtpool_(char *,
logical *, integer *, char *, ftnlen, ftnlen), setmsg_(char *,
ftnlen), errint_(char *, integer *, ftnlen), cmprss_(char *,
integer *, char *, char *, ftnlen, ftnlen, ftnlen);
extern logical return_(void);
integer num[2];
/* $ Abstract */
/* SPICE Private routine intended solely for the support of SPICE */
/* routines. Users should not call this routine directly due */
/* to the volatile nature of this routine. */
/* This routine processes the kernel pool vectors NAIF_BODY_NAME */
/* and NAIF_BODY_CODE into the formatted lists required by ZZBODTRN */
/* to successfully compute code-name mappings. */
/* $ 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 */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* NAIF_IDS */
/* $ Keywords */
/* BODY */
/* $ Declarations */
/* $ Abstract */
/* This include file lists the parameter collection */
/* defining the number of SPICE ID -> NAME mappings. */
/* $ 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 */
//.........这里部分代码省略.........
示例13: kb1inimsg_
integer kb1inimsg_(char *cin, char *cout, integer *iopt, ftnlen cin_len,
ftnlen cout_len)
{
/* System generated locals */
integer ret_val;
/* Builtin functions */
integer s_cmp(char *, char *, ftnlen, ftnlen);
/* Local variables */
extern /* Subroutine */ int movw_(integer *, integer *, integer *);
/* symbolic constants & shared data */
/* Copyright(c) 1997, Space Science and Engineering Center, UW-Madison */
/* Refer to "McIDAS Software Acquisition and Distribution Policies" */
/* in the file mcidas/data/license.txt */
/* *** $Id: areaparm.inc,v 1.1 2000/07/12 13:12:23 gad Exp $ *** */
/* area subsystem parameters */
/* XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX */
/* NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE */
/* XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX */
/* IF YOU CHANGE THESE VALUES, YOU MUST ALSO CHANGE THEM IN */
/* MCIDAS.H !! */
/* XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX */
/* MAXGRIDPT maximum number of grid points */
/* MAX_BANDS maximum number of bands within an area */
/* MAXDFELEMENTS maximum number of elements that DF can handle */
/* in an area line */
/* MAXOPENAREAS maximum number of areas that the library can */
/* have open (formerly called `NA') */
/* NUMAREAOPTIONS number of options settable through ARAOPT() */
/* It is presently 5 because there are five options */
/* that ARAOPT() knows about: */
/* 'PREC','SPAC','UNIT','SCAL','CALB' */
/* (formerly called `NB') */
/* --- Size (number of words) in an area directory */
/* MAX_AUXBLOCK_SIZE size (in bytes) of the internal buffers */
/* used to recieve AUX blocks during an */
/* ADDE transaction */
/* ----- MAX_AREA_NUMBER Maximum area number allowed on system */
/* ----- MAXAREARQSTLEN - max length of area request string */
/* external functions */
/* local variables */
/* Parameter adjustments */
--iopt;
/* Function Body */
movw_(&c__5, &iopt[1], msgcommsgkb1_1.jopt);
msgcommsgkb1_1.itype = 0;
msgcommsgkb1_1.calflg = 0;
if (s_cmp(cin, "RAW", (ftnlen)4, (ftnlen)3) == 0 && s_cmp(cout, "BRIT", (
ftnlen)4, (ftnlen)4) == 0) {
msgcommsgkb1_1.itype = 1;
}
if (s_cmp(cin, "RAW", (ftnlen)4, (ftnlen)3) == 0 && s_cmp(cout, "RAD ", (
ftnlen)4, (ftnlen)4) == 0) {
msgcommsgkb1_1.itype = 2;
}
if (s_cmp(cin, "RAW", (ftnlen)4, (ftnlen)3) == 0 && s_cmp(cout, "REFL", (
ftnlen)4, (ftnlen)4) == 0) {
msgcommsgkb1_1.itype = 3;
}
if (s_cmp(cin, "RAW", (ftnlen)4, (ftnlen)3) == 0 && s_cmp(cout, "TEMP", (
ftnlen)4, (ftnlen)4) == 0) {
msgcommsgkb1_1.itype = 4;
}
if (msgcommsgkb1_1.itype == 0) {
goto L900;
}
ret_val = 0;
return ret_val;
L900:
ret_val = -1;
return ret_val;
} /* kb1inimsg_ */
示例14: kb1calmsg_
integer kb1calmsg_(integer *pfx, integer *idir, integer *nval, integer *band,
shortint *ibuf)
{
/* Initialized data */
static real factor[12] = { 21.21f,23.24f,19.77f,0.f,0.f,0.f,0.f,0.f,0.f,
0.f,0.f,22.39f };
static integer this__ = -9999;
static doublereal c1w3 = 0.;
static doublereal c2w = 0.;
static doublereal alpha = 0.;
static doublereal beta = 0.;
static doublereal gain = 0.;
static doublereal offset = 0.;
/* Format strings */
static char fmt_1[] = "(6e17.10)";
/* System generated locals */
address a__1[2];
integer ret_val, i__1[2], i__2;
real r__1;
char ch__1[116], ch__2[25], ch__3[12], ch__4[27];
static integer equiv_0[313];
/* Builtin functions */
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer s_cmp(char *, char *, ftnlen, ftnlen);
/* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
integer s_rsfi(icilist *), do_fio(integer *, char *, ftnlen), e_rsfi(void)
, i_nint(real *);
double sqrt(doublereal), log(doublereal);
/* Local variables */
extern /* Subroutine */ int m0sxtrce_(char *, ftnlen);
static integer i__, bandoffset;
extern /* Character */ VOID cff_(char *, ftnlen, doublereal *, integer *);
#define buf (equiv_0)
#define cbuf ((char *)equiv_0)
static integer ides;
static real refl;
static char cout[104];
static integer isou;
extern /* Subroutine */ int movw_(integer *, integer *, integer *);
static integer ibrit, itemp;
static real xtemp;
extern /* Subroutine */ int araget_(integer *, integer *, integer *,
integer *), mpixel_(integer *, integer *, integer *, shortint *),
gryscl_(real *, integer *);
/* Fortran I/O blocks */
static icilist io___13 = { 1, cout, 0, fmt_1, 104, 1 };
/* symbolic constants & shared data */
/* Copyright(c) 1997, Space Science and Engineering Center, UW-Madison */
/* Refer to "McIDAS Software Acquisition and Distribution Policies" */
/* in the file mcidas/data/license.txt */
/* *** $Id: areaparm.inc,v 1.1 2000/07/12 13:12:23 gad Exp $ *** */
/* area subsystem parameters */
/* XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX */
/* NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE NOTE */
/* XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX */
/* IF YOU CHANGE THESE VALUES, YOU MUST ALSO CHANGE THEM IN */
/* MCIDAS.H !! */
/* XXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXXX */
/* MAXGRIDPT maximum number of grid points */
/* MAX_BANDS maximum number of bands within an area */
/* MAXDFELEMENTS maximum number of elements that DF can handle */
/* in an area line */
/* MAXOPENAREAS maximum number of areas that the library can */
/* have open (formerly called `NA') */
/* NUMAREAOPTIONS number of options settable through ARAOPT() */
/* It is presently 5 because there are five options */
/* that ARAOPT() knows about: */
/* 'PREC','SPAC','UNIT','SCAL','CALB' */
/* (formerly called `NB') */
/* --- Size (number of words) in an area directory */
/* MAX_AUXBLOCK_SIZE size (in bytes) of the internal buffers */
/* used to recieve AUX blocks during an */
/* ADDE transaction */
/* ----- MAX_AREA_NUMBER Maximum area number allowed on system */
/* ----- MAXAREARQSTLEN - max length of area request string */
/* external functions */
/* local variables */
/* Parameter adjustments */
--ibuf;
--idir;
--pfx;
/* Function Body */
if (this__ != idir[33]) {
this__ = idir[33];
s_copy(cout, " ", (ftnlen)104, (ftnlen)1);
if (msgcommsgkb1_1.calflg != 0) {
//.........这里部分代码省略.........
示例15: in
/* Subroutine */ int cnaupd_(integer *ido, char *bmat, integer *n, char *
which, integer *nev, real *tol, complex *resid, integer *ncv, complex
*v, integer *ldv, integer *iparam, integer *ipntr, complex *workd,
complex *workl, integer *lworkl, real *rwork, integer *info, ftnlen
bmat_len, ftnlen which_len)
{
/* Format strings */
static char fmt_1000[] = "(//,5x,\002==================================="
"==========\002,/5x,\002= Complex implicit Arnoldi update code "
" =\002,/5x,\002= Version Number: \002,\002 2.3\002,21x,\002 "
"=\002,/5x,\002= Version Date: \002,\002 07/31/96\002,16x,\002 ="
"\002,/5x,\002=============================================\002,/"
"5x,\002= Summary of timing statistics =\002,/5x,"
"\002=============================================\002,//)";
static char fmt_1100[] = "(5x,\002Total number update iterations "
" = \002,i5,/5x,\002Total number of OP*x operations "
" = \002,i5,/5x,\002Total number of B*x operations = "
"\002,i5,/5x,\002Total number of reorthogonalization steps = "
"\002,i5,/5x,\002Total number of iterative refinement steps = "
"\002,i5,/5x,\002Total number of restart steps = "
"\002,i5,/5x,\002Total time in user OP*x operation = "
"\002,f12.6,/5x,\002Total time in user B*x operation ="
" \002,f12.6,/5x,\002Total time in Arnoldi update routine = "
"\002,f12.6,/5x,\002Total time in naup2 routine ="
" \002,f12.6,/5x,\002Total time in basic Arnoldi iteration loop = "
"\002,f12.6,/5x,\002Total time in reorthogonalization phase ="
" \002,f12.6,/5x,\002Total time in (re)start vector generation = "
"\002,f12.6,/5x,\002Total time in Hessenberg eig. subproblem ="
" \002,f12.6,/5x,\002Total time in getting the shifts = "
"\002,f12.6,/5x,\002Total time in applying the shifts ="
" \002,f12.6,/5x,\002Total time in convergence testing = "
"\002,f12.6,/5x,\002Total time in computing final Ritz vectors ="
" \002,f12.6/)";
/* System generated locals */
integer v_dim1, v_offset, i__1, i__2;
/* Builtin functions */
integer s_cmp(char *, char *, ftnlen, ftnlen), s_wsfe(cilist *), e_wsfe(
void), do_fio(integer *, char *, ftnlen);
/* Local variables */
static integer j;
static real t0, t1;
static integer nb, ih, iq, np, iw, ldh, ldq, nev0, mode, ierr, iupd, next,
ritz;
extern /* Subroutine */ int cvout_(integer *, integer *, complex *,
integer *, char *, ftnlen), ivout_(integer *, integer *, integer *
, integer *, char *, ftnlen), cnaup2_(integer *, char *, integer *
, char *, integer *, integer *, real *, complex *, integer *,
integer *, integer *, integer *, complex *, integer *, complex *,
integer *, complex *, complex *, complex *, integer *, complex *,
integer *, complex *, real *, integer *, ftnlen, ftnlen);
extern doublereal slamch_(char *, ftnlen);
extern /* Subroutine */ int second_(real *);
static integer bounds, ishift, msglvl, mxiter;
extern /* Subroutine */ int cstatn_(void);
/* Fortran I/O blocks */
static cilist io___21 = { 0, 6, 0, fmt_1000, 0 };
static cilist io___22 = { 0, 6, 0, fmt_1100, 0 };
/* %----------------------------------------------------% */
/* | Include files for debugging and timing information | */
/* %----------------------------------------------------% */
/* \SCCS Information: @(#) */
/* FILE: debug.h SID: 2.3 DATE OF SID: 11/16/95 RELEASE: 2 */
/* %---------------------------------% */
/* | See debug.doc for documentation | */
/* %---------------------------------% */
/* %------------------% */
/* | Scalar Arguments | */
/* %------------------% */
/* %--------------------------------% */
/* | See stat.doc for documentation | */
/* %--------------------------------% */
/* \SCCS Information: @(#) */
/* FILE: stat.h SID: 2.2 DATE OF SID: 11/16/95 RELEASE: 2 */
/* %-----------------% */
/* | Array Arguments | */
/* %-----------------% */
/* %------------% */
/* | Parameters | */
/* %------------% */
/* %---------------% */
//.........这里部分代码省略.........