C++ s_rnge函数代码示例

/* $Procedure   MTXMG ( Matrix transpose times matrix, general dimension ) */
/* Subroutine */ int mtxmg_(doublereal *m1, doublereal *m2, integer *nc1, 
	integer *nr1r2, integer *nc2, doublereal *mout)
{
    /* System generated locals */
    integer m1_dim1, m1_dim2, m1_offset, m2_dim1, m2_dim2, m2_offset, 
	    mout_dim1, mout_dim2, mout_offset, i__1, i__2, i__3, i__4, i__5, 
	    i__6, i__7;

    /* Builtin functions */
    integer s_rnge(char *, integer, char *, integer);

    /* Local variables */
    integer i__, j, k;

/* $ Abstract */

/*      Multiply the transpose of a matrix with another matrix, */
/*      both of arbitrary size. (The dimensions of the matrices must be */
/*      compatible with this multiplication.) */

/* $ 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 */

/*      MATRIX */

/* $ Declarations */
/* $ Brief_I/O */

/*      VARIABLE  I/O  DESCRIPTION */
/*      --------  ---  -------------------------------------------------- */
/*       M1        I     Left-hand matrix whose transpose is to be */
/*                       multiplied. */
/*       M2        I     Right-hand matrix to be multiplied. */
/*       NC1       I     Column dimension of M1 and row dimension of */
/*                       MOUT. */
/*       NR1R2     I     Row dimension of M1 and row dimension of M2. */
/*       NC2       I     Column dimension of M2 and column dimension of */
/*                       MOUT. */
/*       MOUT      O     Product matrix M1**T * M2. */
/*                       MOUT must NOT overwrite either M1 or M2. */

/* $ Detailed_Input */

/*      M1      This is an double precision matrix of arbitrary dimension */
/*              whose transpose is the left hand multiplier of a matrix */
/*              multiplication. */
/*      M2      This is an double precision matrix of arbitrary dimension */
/*              whose transpose is the left hand multiplier of a matrix */
/*              multiplication. */
/*      NC1     This is the column dimension of M1 and row dimension of */
/*              MOUT. */
/*      NR1R2   This is the row dimension of both M1 and M2. */
/*      NC2     This is the column dimension of both M2 and MOUT. */

/* $ Detailed_Output */

/*      MOUT is a double precision matrix containing the product */

/*                        T */
/*             MOUT = (M1)   x (M2) */

/*      where the superscript T denotes the transpose of M1. */

/* $ Parameters */

/*     None. */

/* $ Particulars */

/*      The code reflects precisely the following mathematical expression */

//.........这里部分代码省略.........

/* $Procedure      M2YEAR ( Determine whether or not a word is a year ) */
logical m2year_(char *word, ftnlen word_len)
{
    /* Initialized data */

    static logical first = TRUE_;

    /* System generated locals */
    integer i__1, i__2, i__3, i__4;
    logical ret_val;

    /* Builtin functions */
    integer s_rnge(char *, integer, char *, integer);

    /* Local variables */
    static integer i__, value;
    extern integer ltrim_(char *, ftnlen);
    static integer i1, i2, i3, i4, length, values[256];
    extern integer qrtrim_(char *, ftnlen);

    /* $ Abstract */

    /*     This function is true if the input string is a year in the */
    /*     sense of META/2. */

    /* $ 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 */

    /*     META/2 a language specification language. */

    /* $ Keywords */

    /*     ALPHANUMERIC */
    /*     ASCII */
    /*     PARSING */
    /*     UTILITY */
    /*     WORD */

    /* $ Declarations */
    /* $ Brief_I/O */

    /*     VARIABLE  I/O  DESCRIPTION */
    /*     --------  ---  -------------------------------------------------- */
    /*     WORD       I   A character string word */

    /*     The function is returned as .TRUE. if word is a META/2 year. */

    /* $ Detailed_Input */

    /*     WORD      is a character string that is assumed to have no */
    /*               spaces between the first and last non-blank characters. */

    /* $ Detailed_Output */

    /*     M2YEAR     returns as .TRUE. if WORD is a META/2 year. */
    /*               Otherwise it is returned .FALSE. */

    /* $ Error_Handling */

    /*     None. */
    /* C */
    /* $ Input_Files */

    /*     None. */

    /* $ Output_Files */

    /*     None. */

    /* $ Particulars */

    /*     This is a utility routine for the subroutine META2.  It */
    /*     determines whether or not a word is a year in the sense */
    /*     of the language META/2. */

    /* $ Examples */
//.........这里部分代码省略.........

/* $Procedure KPLFRM ( Kernel pool frame IDs ) */
/* Subroutine */ int kplfrm_(integer *frmcls, integer *idset)
{
    /* System generated locals */
    integer i__1, i__2;

    /* Builtin functions */
    /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
    integer s_rnge(char *, integer, char *, integer);

    /* Local variables */
    integer i__, l, m, n, w;
    extern /* Subroutine */ int chkin_(char *, ftnlen), repmc_(char *, char *,
	     char *, char *, ftnlen, ftnlen, ftnlen, ftnlen);
    logical found;
    extern /* Subroutine */ int repmi_(char *, char *, integer *, char *, 
	    ftnlen, ftnlen, ftnlen);
    extern integer sizei_(integer *);
    integer idcode, to;
    extern /* Subroutine */ int scardi_(integer *, integer *);
    char frname[32];
    extern /* Subroutine */ int validi_(integer *, integer *, integer *);
    char kvcode[32];
    integer fclass;
    char kvname[32], kvbuff[32*100], kvclas[32];
    extern /* Subroutine */ int gcpool_(char *, integer *, integer *, integer 
	    *, char *, logical *, ftnlen, ftnlen), gipool_(char *, integer *, 
	    integer *, integer *, integer *, logical *, ftnlen);
    char tmpnam[32];
    extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, 
	    ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, 
	    ftnlen);
    char kvtemp[32];
    extern /* Subroutine */ int gnpool_(char *, integer *, integer *, integer 
	    *, char *, logical *, ftnlen, ftnlen);
    extern logical return_(void);

/* $ Abstract */

/*     Return a SPICE set containing the frame IDs of all reference */
/*     frames of a given class having specifications in the kernel pool. */

/* $ 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 */

/*     CELLS */
/*     FRAMES */
/*     KERNEL */
/*     NAIF_IDS */
/*     SETS */

/* $ Keywords */

/*     FRAME */
/*     SET */
/*     UTILITY */

/* $ Declarations */
/* $ Abstract */

/*     The parameters below form an enumerated list of the recognized */
/*     frame types.  They are: INERTL, PCK, CK, TK, DYN.  The meanings */
/*     are outlined below. */

/* $ 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. */
//.........这里部分代码省略.........

/* $Procedure  VTMVG  ( Vector transpose times matrix times vector ) */
doublereal vtmvg_(doublereal *v1, doublereal *matrix, doublereal *v2, integer 
	*nrow, integer *ncol)
{
    /* System generated locals */
    integer v1_dim1, matrix_dim1, matrix_dim2, matrix_offset, v2_dim1, i__1, 
	    i__2, i__3, i__4, i__5;
    doublereal ret_val;

    /* Builtin functions */
    integer s_rnge(char *, integer, char *, integer);

    /* Local variables */
    integer k, l;

/* $ Abstract */

/*      Multiply the transpose of a n-dimensional column vector, */
/*      a nxm matrix, and a m-dimensional column vector. */

/* $ 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 */

/*      MATRIX,  VECTOR */

/* $ Declarations */
/* $ Brief_I/O */

/*      VARIABLE  I/O  DESCRIPTION */
/*      --------  ---  -------------------------------------------------- */
/*       V1        I   N-dimensional double precision column vector. */
/*       MATRIX    I   NxM double precision matrix. */
/*       V2        I   M-dimensional double porecision column vector. */
/*       NROW      I   Number of rows in MATRIX (number of rows in V1.) */
/*       NCOL      I   Number of columns in MATRIX (number of rows in */
/*                     V2.) */

/*       The function returns the result of (V1**T * MATRIX * V2 ). */

/* $ Detailed_Input */

/*      V1         is an n-dimensional double precision vector. */

/*      MATRIX     is an n x m double precision matrix. */

/*      V2         is an m-dimensional double precision vector. */

/*      NROW       is the number of rows in MATRIX.  This is also */
/*                 equivalent to the number of rows in the vector V1. */

/*      NCOL       is the number of columns in MATRIX. This is also */
/*                 equivalent to the number of rows in the vector V2. */

/* $ Detailed_Output */

/*      The function returns the double precision value of the equation */
/*      (V1**T * MATRIX * V2 ). */

/*      Notice that VTMVG is actually the dot product of the vector */
/*      resulting from multiplying the transpose of V1 and MATRIX and the */
/*      vector V2. */

/* $ Parameters */

/*      None. */

/* $ Particulars */

/*      This routine implements the following vector/matrix/vector */
/*      multiplication: */

/*                       T */
//.........这里部分代码省略.........

/* $Procedure LGRIND (Lagrange polynomial interpolation with derivative) */
/* Subroutine */ int lgrind_(integer *n, doublereal *xvals, doublereal *yvals,
	 doublereal *work, doublereal *x, doublereal *p, doublereal *dp)
{
    /* System generated locals */
    integer xvals_dim1, yvals_dim1, work_dim1, work_offset, i__1, i__2, i__3, 
	    i__4, i__5, i__6, i__7;

    /* Builtin functions */
    integer s_rnge(char *, integer, char *, integer);

    /* Local variables */
    integer i__, j;
    extern /* Subroutine */ int chkin_(char *, ftnlen);
    doublereal denom;
    extern /* Subroutine */ int errdp_(char *, doublereal *, ftnlen);
    doublereal c1, c2;
    extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, 
	    ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, 
	    ftnlen);
    extern logical return_(void);

/* $ Abstract */

/*     Evaluate a Lagrange interpolating polynomial for a specified */
/*     set of coordinate pairs, at a specified abcissisa value. */
/*     Return the value of both polynomial and derivative. */

/* $ 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 */

/*     INTERPOLATION */
/*     POLYNOMIAL */

/* $ Declarations */
/* $ Brief_I/O */

/*     Variable  I/O  Description */
/*     --------  ---  -------------------------------------------------- */
/*     N          I   Number of points defining the polynomial. */
/*     XVALS      I   Abscissa values. */
/*     YVALS      I   Ordinate values. */
/*     WORK      I-O  Work space array. */
/*     X          I   Point at which to interpolate the polynomial. */
/*     P          O   Polynomial value at X. */
/*     DP         O   Polynomial derivative at X. */

/* $ Detailed_Input */

/*     N              is the number of points defining the polynomial. */
/*                    The arrays XVALS and YVALS contain N elements. */


/*     XVALS, */
/*     YVALS          are arrays of abscissa and ordinate values that */
/*                    together define N ordered pairs.  The set of points */

/*                       ( XVALS(I), YVALS(I) ) */

/*                    define the Lagrange polynomial used for */
/*                    interpolation.  The elements of XVALS must be */
/*                    distinct and in increasing order. */


/*     WORK           is an N x 2 work space array, where N is the same */
/*                    dimension as that of XVALS and YVALS.  It is used */
/*                    by this routine as a scratch area to hold */
/*                    intermediate results.  WORK is permitted to */
/*                    coincide with YVALS. */


/*     X              is the abscissa value at which the interpolating */
//.........这里部分代码省略.........

/* $Procedure    LS  ( Return L_s, planetocentric longitude of the sun ) */
doublereal ls_(integer *body, doublereal *et, char *corr, ftnlen corr_len)
{
    /* System generated locals */
    integer i__1, i__2;
    doublereal ret_val;

    /* Builtin functions */
    integer s_rnge(char *, integer, char *, integer);

    /* Local variables */
    doublereal tipm[9]	/* was [3][3] */;
    extern /* Subroutine */ int vequ_(doublereal *, doublereal *);
    integer i__;
    doublereal x[3], y[3], z__[3];
    extern /* Subroutine */ int chkin_(char *, ftnlen);
    doublereal uavel[3], npole[3], state[6], trans[9]	/* was [3][3] */;
    extern /* Subroutine */ int spkez_(integer *, doublereal *, char *, char *
	    , integer *, doublereal *, doublereal *, ftnlen, ftnlen), ucrss_(
	    doublereal *, doublereal *, doublereal *);
    doublereal lt;
    extern /* Subroutine */ int reclat_(doublereal *, doublereal *, 
	    doublereal *, doublereal *), tipbod_(char *, integer *, 
	    doublereal *, doublereal *, ftnlen);
    doublereal radius;
    extern /* Subroutine */ int chkout_(char *, ftnlen);
    extern logical return_(void);
    doublereal lat, pos[3];
    extern /* Subroutine */ int mxv_(doublereal *, doublereal *, doublereal *)
	    ;

/* $ Abstract */

/*     Compute L_s, the planetocentric longitude of the sun, as seen */
/*     from a specified body. */

/* $ 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 */

/*     GEOMETRY */

/* $ Declarations */
/* $ Brief_I/O */

/*     Variable  I/O  Description */
/*     --------  ---  -------------------------------------------------- */
/*     BODY       I   NAIF integer code of central body. */
/*     ET         I   Epoch in ephemeris seconds past J2000. */
/*     CORR       I   Aberration correction. */

/*     The function returns the value of L_s for the specified body */
/*     at the specified time. */

/* $ Detailed_Input */

/*     BODY        is the NAIF integer code of the central body, */
/*                 typically a planet. */

/*     ET          is the epoch in ephemeris seconds past J2000 at which */
/*                 the longitude of the sun (L_s) is to be computed. */

/*     CORR        indicates the aberration corrections to be applied */
/*                 when computing the longitude of the sun.  CORR */
/*                 may be any of the following. */

/*                    'NONE'     Apply no correction. */

/*                    'LT'       Correct the position of the sun, */
/*                               relative to the central body, for */
/*                               planetary (light time) aberration. */

/*                    'LT+S'     Correct the position of the sun, */
//.........这里部分代码省略.........

/* $Procedure            ETCAL ( Convert ET to Calendar format ) */
/* Subroutine */ int etcal_(doublereal *et, char *string, ftnlen string_len)
{
    /* Initialized data */

    static logical first = TRUE_;
    static integer extra[12] = { 0,0,1,1,1,1,1,1,1,1,1,1 };
    static integer dpjan0[12] = { 0,31,59,90,120,151,181,212,243,273,304,334 }
	    ;
    static integer dpbegl[12] = { 0,31,60,91,121,152,182,213,244,274,305,335 }
	    ;
    static char months[3*12] = "JAN" "FEB" "MAR" "APR" "MAY" "JUN" "JUL" 
	    "AUG" "SEP" "OCT" "NOV" "DEC";

    /* System generated locals */
    address a__1[12];
    integer i__1, i__2, i__3[12];
    doublereal d__1;

    /* Builtin functions */
    integer s_rnge(char *, integer, char *, integer);
    double d_int(doublereal *);
    /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *,
	     char **, integer *, integer *, ftnlen);

    /* Local variables */
    static integer dn2000;
    static doublereal dp2000, frac;
    static char date[180];
    static doublereal remd, secs;
    static integer year, mins;
    static char dstr[16], hstr[16], mstr[16], sstr[16], ystr[16];
    static doublereal halfd, q;
    static integer tsecs, dofyr, month, hours;
    extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen);
    static doublereal mynum;
    static integer bh, bm, iq;
    static doublereal secspd;
    static char messge[16];
    static integer offset;
    static doublereal dmnint;
    static logical adjust;
    static integer daynum;
    extern integer intmin_(void), intmax_(void);
    extern /* Subroutine */ int dpstrf_(doublereal *, integer *, char *, char 
	    *, ftnlen, ftnlen);
    static doublereal dmxint, mydnom;
    extern /* Subroutine */ int cmprss_(char *, integer *, char *, char *, 
	    ftnlen, ftnlen, ftnlen);
    extern integer lstlti_(integer *, integer *, integer *);
    extern /* Subroutine */ int intstr_(integer *, char *, ftnlen);
    static integer yr1, yr4;
    static char era[16];
    static integer day, rem;
    extern doublereal spd_(void);
    static integer yr100, yr400;

/* $ Abstract */


/*     Convert from an ephemeris epoch measured in seconds past */
/*     the epoch of J2000 to a calendar string format using a */
/*     formal calendar free of leapseconds. */

/* $ 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 */

/*     TIME */

/* $ Declarations */
/* $ Brief_I/O */

//.........这里部分代码省略.........

/* $Procedure      DELTET ( Delta ET, ET - UTC ) */
/* Subroutine */ int deltet_(doublereal *epoch, char *eptype, doublereal *
	delta, ftnlen eptype_len)
{
    /* Initialized data */

    static char missed[20*5] = "DELTET/DELTA_T_A, # " "DELTET/K, #         " 
	    "DELTET/EB, #        " "DELTET/M, #         " "DELTET/DELTA_AT, "
	    "#  ";

    /* System generated locals */
    integer i__1, i__2, i__3;
    doublereal d__1;

    /* Builtin functions */
    integer s_rnge(char *, integer, char *, integer), s_cmp(char *, char *, 
	    ftnlen, ftnlen);
    double d_nint(doublereal *), sin(doublereal);

    /* Local variables */
    char type__[4];
    integer i__;
    doublereal k, m[2];
    integer n;
    doublereal dleap[400]	/* was [2][200] */;
    extern /* Subroutine */ int chkin_(char *, ftnlen);
    integer nleap;
    extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen), 
	    errch_(char *, char *, ftnlen, ftnlen);
    doublereal leaps, ettai;
    logical found[5];
    char dtype[1];
    doublereal ea, eb, ma, et;
    extern /* Subroutine */ int gdpool_(char *, integer *, integer *, integer 
	    *, doublereal *, logical *, ftnlen), sigerr_(char *, ftnlen), 
	    chkout_(char *, ftnlen), dtpool_(char *, logical *, integer *, 
	    char *, ftnlen, ftnlen), setmsg_(char *, ftnlen), errint_(char *, 
	    integer *, ftnlen);
    extern logical return_(void);
    doublereal dta, aet;

/* $ Abstract */

/*     Return the value of Delta ET (ET-UTC) for an input epoch. */

/* $ 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 */

/*     TIME */
/*     KERNEL */

/* $ Keywords */

/*     TIME */

/* $ Declarations */
/* $ Brief_I/O */

/*      VARIABLE  I/O  DESCRIPTION */
/*      --------  ---  -------------------------------------------------- */
/*      EPOCH      I   Input epoch (seconds past J2000). */
/*      EPTYPE     I   Type of input epoch ('UTC' or 'ET'). */
/*      DELTA      O   Delta ET (ET-UTC) at input epoch. */

/* $ Detailed_Input */

/*      EPOCH       is the epoch at which Delta ET is to be computed. */
/*                  This may be either UTC or ephemeris seconds past */
/*                  J2000, as specified by EPTYPE. */

/*      EPTYPE      indicates the type of input epoch. It may be either */
/*                  of the following: */

/*                     'UTC'    input is UTC seconds past J2000. */
/*                     'ET'     input is ephemeris seconds past J2000. */

//.........这里部分代码省略.........

/* $Procedure  ZZEKNRES ( Private: EK, resolve names in encoded query ) */
/* Subroutine */ int zzeknres_(char *query, integer *eqryi, char *eqryc, 
	logical *error, char *errmsg, integer *errptr, ftnlen query_len, 
	ftnlen eqryc_len, ftnlen errmsg_len)
{
    /* System generated locals */
    integer i__1, i__2, i__3, i__4, i__5;

    /* Builtin functions */
    /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
    integer s_rnge(char *, integer, char *, integer), s_cmp(char *, char *, 
	    ftnlen, ftnlen);

    /* Local variables */
    integer base, ntab, ncnj, ncns, nord, nsel;
    extern /* Subroutine */ int zzekcchk_(char *, integer *, char *, integer *
	    , char *, char *, integer *, logical *, char *, integer *, ftnlen,
	     ftnlen, ftnlen, ftnlen, ftnlen), zzekqtab_(integer *, char *, 
	    integer *, char *, char *, ftnlen, ftnlen, ftnlen), zzekreqi_(
	    integer *, char *, integer *, ftnlen), zzekweqi_(char *, integer *
	    , integer *, ftnlen);
    integer i__, j;
    char table[64*10], alias[64*10];
    extern /* Subroutine */ int chkin_(char *, ftnlen);
    integer nload;
    extern /* Subroutine */ int repmc_(char *, char *, char *, char *, ftnlen,
	     ftnlen, ftnlen, ftnlen);
    integer cc[10];
    extern logical failed_(void);
    char ltable[64];
    extern /* Subroutine */ int ekntab_(integer *);
    extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen);
    integer cnstyp, iparse;
    extern /* Subroutine */ int setmsg_(char *, ftnlen), sigerr_(char *, 
	    ftnlen), chkout_(char *, ftnlen), ektnam_(integer *, char *, 
	    ftnlen), ekccnt_(char *, integer *, ftnlen);
    logical fnd;
    integer lxb, lxe;

/* $ 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. */

/*     Resolve and semantically check table names, aliases, and column */
/*     names in an encoded EK query. */

/* $ 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 */

/*     EK */

/* $ Keywords */

/*     EK */
/*     PRIVATE */

/* $ 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, */
//.........这里部分代码省略.........

/* $Procedure VERSION ( Print library version information ) */
/* Main program */ MAIN__(void)
{
    /* System generated locals */
    address a__1[2], a__2[4];
    integer i__1[2], i__2, i__3[4], i__4;
    doublereal d__1;
    char ch__1[25], ch__2[99];

    /* Builtin functions */
    /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen),
	     s_copy(char *, char *, ftnlen, ftnlen);
    integer s_rnge(char *, integer, char *, integer);
    /* Subroutine */ int s_stop(char *, ftnlen);

    /* Local variables */
    char line[80], vrsn[6];
    extern /* Subroutine */ int zzplatfm_(char *, char *, ftnlen, ftnlen);
    integer i__;
    extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen);
    extern doublereal dpmin_(void);
    extern /* Subroutine */ int repmd_(char *, char *, doublereal *, integer *
	    , char *, ftnlen, ftnlen, ftnlen);
    extern doublereal dpmax_(void);
    char fform[80];
    extern /* Subroutine */ int repmi_(char *, char *, integer *, char *, 
	    ftnlen, ftnlen, ftnlen);
    char cmplr[80];
    extern integer wdcnt_(char *, ftnlen);
    char tform[80];
    extern integer rtrim_(char *, ftnlen);
    char os[80];
    extern /* Subroutine */ int getcml_(char *, ftnlen), byebye_(char *, 
	    ftnlen);
    extern integer intmin_(void), intmax_(void);
    char linout[80*6];
    extern /* Subroutine */ int tostdo_(char *, ftnlen), tkvrsn_(char *, char 
	    *, ftnlen, ftnlen);
    extern integer pos_(char *, char *, integer *, ftnlen, ftnlen);
    char sys[80];

/* $ Abstract */

/*     This program prints to standard output the current SPICE */
/*     distribution version number, hardware system ID, operating */
/*     system ID, compiler name, the format of double precision */
/*     numbers for the hardware architecture, and the max and min */
/*     values for double precision and integer numbers. */

/* $ 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. */

/* $ Keyword */

/*     VERSION */
/*     UTILITY */

/* $ Parameters */

/*     LINELN            length of line output string, set to 80. */

/*     DATEID            update version time string, set to 20. */

/* $ Exceptions */

/*     None. */

/* $ Files */

/*     None. */

/* $ Particulars */

/*     The version utility may use 3 different command line arguments. */
//.........这里部分代码省略.........

/* $Procedure ANA ( AN or A ? ) */
/* Character */ VOID ana_(char *ret_val, ftnlen ret_val_len, char *word, char 
	*case__, ftnlen word_len, ftnlen case_len)
{
    /* Initialized data */

    static char a[2*3] = "A " "A " "a ";
    static char an[2*3] = "AN" "An" "an";
    static char anword[8*22] = "HEIR    " "HONEST  " "HONOR   " "H       " 
	    "HOUR    " "HORS    " "HOMBRE  " "F       " "L       " "M       " 
	    "N       " "R       " "S       " "X       " "UNIN    " "UNIM    " 
	    "ONEI    " "ONER    " "SPK     " "EK      " "IK      " "SCLK    ";
    static char aword[8*33] = "HORSE   " "ONE     " "ONE-    " "ONCE    " 
	    "ONENESS " "UIG     " "UIN     " "UKA     " "UKE     " "UKO     " 
	    "UKI     " "UKU     " "ULOT    " "UNANI   " "UNI     " "UNINU   " 
	    "UPA     " "URA     " "URE     " "URO     " "USA     " "USE     " 
	    "USU     " "UTE     " "UTI     " "UTO     " "UVA     " "UVE     " 
	    "UVU     " "EU      " "EWE     " "UTRI    " "U       ";

    /* System generated locals */
    integer i__1;

    /* Builtin functions */
    /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
    integer i_indx(char *, char *, ftnlen, ftnlen), s_rnge(char *, integer, 
	    char *, integer);

    /* Local variables */
    static integer caps, i__;
    static char begin[1];
    extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen);
    static char start[32*7];
    extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen);
    extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen);
    extern /* Subroutine */ int replch_(char *, char *, char *, char *, 
	    ftnlen, ftnlen, ftnlen, ftnlen);
    static char mycase[1], myword[32];

/* $ Abstract */

/*     Return the correct article "a" or "an" used to modify a word */
/*     and return it capitalized, lower case, or upper case. */

/* $ 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 */

/*     WORD */

/* $ Keywords */

/*     UTILITY */
/*     WORD */

/* $ Declarations */
/* $ Brief_I/O */

/*     Variable  I/O  Description */
/*     --------  ---  -------------------------------------------------- */
/*     WORD       I   is a word that should be modified by "a" or "an" */
/*     CASE       I   'U', 'L', or 'C' to specify capitalization of ANA. */
/*     ANA        O   'A' or 'AN' appropriately capitalized. */

/* $ Detailed_Input */

/*     WORD       is any english word for which you want to write the */
/*                correct phrase "a(an) response(answer)".  The case */
/*                of the letters of word do not matter. */

/*                Leading white space in word is ignored.  The characters */
/*                " and ' are ignored.  Thus ''' apple '' ' and */
/*                '"apple"' and ' apple' and 'apple' are all treated as */
/*                the same word. */

/*     CASE       is a character that describes how the value returned */
/*                in ANA should be capitalized.  The rules are: */

//.........这里部分代码省略.........

/* $Procedure     STRAN */
/* Subroutine */ int stran_0_(int n__, char *input, char *output, logical *
	tran, ftnlen input_len, ftnlen output_len)
{
    /* Initialized data */

    static logical first = TRUE_;

    /* System generated locals */
    integer i__1, i__2, i__3;

    /* Builtin functions */
    /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
    integer s_cmp(char *, char *, ftnlen, ftnlen), i_indx(char *, char *, 
	    ftnlen, ftnlen), s_rnge(char *, integer, char *, integer), i_len(
	    char *, ftnlen);

    /* Local variables */
    static integer ldef, leno, vdim, slot, lout, lsym, ptrs[810], i__, j;
    extern integer cardc_(char *, ftnlen);
    static integer l, n;
    static logical check[200];
    extern logical batch_(void);
    static integer place;
    extern /* Subroutine */ int lcase_(char *, char *, ftnlen, ftnlen);
    static char delim[1];
    extern /* Subroutine */ int chkin_(char *, ftnlen);
    static integer nname;
    extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen);
    static char names[32*206];
    extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen), 
	    geteq_(char *, ftnlen);
    extern integer ncpos_(char *, char *, integer *, ftnlen, ftnlen);
    extern /* Subroutine */ int nthwd_(char *, integer *, char *, integer *, 
	    ftnlen, ftnlen);
    static char symbl[33];
    static integer psize;
    extern integer rtrim_(char *, ftnlen);
    static logical checkd[200];
    extern logical failed_(void);
    static char alphab[32];
    extern /* Subroutine */ int getdel_(char *, ftnlen);
    extern logical matchm_(char *, char *, char *, char *, char *, char *, 
	    ftnlen, ftnlen, ftnlen, ftnlen, ftnlen, ftnlen);
    static char buffer[256*52];
    extern integer isrchc_(char *, integer *, char *, ftnlen, ftnlen), 
	    lastnb_(char *, ftnlen);
    static logical gotone;
    extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, 
	    ftnlen), repsub_(char *, integer *, integer *, char *, char *, 
	    ftnlen, ftnlen, ftnlen);
    static char equote[1];
    extern /* Subroutine */ int setmsg_(char *, ftnlen);
    static char resvrd[32*12], symbol[33], pattrn[80];
    static integer nxtchr;
    extern /* Subroutine */ int suffix_(char *, integer *, char *, ftnlen, 
	    ftnlen), rdstmn_(char *, char *, char *, ftnlen, ftnlen, ftnlen);
    extern logical return_(void);
    extern /* Subroutine */ int sbget_1__(char *, char *, integer *, char *, 
	    char *, integer *, ftnlen, ftnlen, ftnlen, ftnlen), nthuqw_(char *
	    , integer *, char *, char *, integer *, ftnlen, ftnlen, ftnlen);
    static char myprmt[80];
    extern /* Subroutine */ int sbrem_1__(char *, char *, integer *, char *, 
	    ftnlen, ftnlen, ftnlen);
    static integer lsttry;
    extern /* Subroutine */ int sbset_1__(char *, char *, char *, integer *, 
	    char *, ftnlen, ftnlen, ftnlen, ftnlen);
    static char def[1024];
    static integer loc;
    static char key[32];
    static logical new__;
    extern /* Subroutine */ int sbinit_1__(integer *, integer *, integer *, 
	    char *, integer *, char *, ftnlen, ftnlen);

/* $ Abstract */

/*     Translate the symbols in an input string. */

/* $ 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 */
//.........这里部分代码省略.........

/* $Procedure ZZFTPSTR ( Private --- Fetch FTP Validation String ) */
/* Subroutine */ int zzftpstr_(char *tstcom, char *lend, char *rend, char *
	delim, ftnlen tstcom_len, ftnlen lend_len, ftnlen rend_len, ftnlen 
	delim_len)
{
    /* Initialized data */

    static logical first = TRUE_;
    static char locdlm[1] = ":";
    static char loclnd[6] = "FTPSTR";
    static char locrnd[6] = "ENDFTP";

    /* System generated locals */
    address a__1[3], a__2[2];
    integer i__1[3], i__2[2], i__3;

    /* Builtin functions */
    /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen),
	     s_copy(char *, char *, ftnlen, ftnlen);
    integer s_rnge(char *, integer, char *, integer);

    /* Local variables */
    char asc000[1], asc010[1], asc013[1], asc016[1], asc206[1], asc129[1];
    integer i__;
    extern /* Subroutine */ int suffix_(char *, integer *, char *, ftnlen, 
	    ftnlen);
    static char locstr[16];
    char testsq[5*6];

/* $ Abstract */

/*    Retrieve the components of the FTP validation string. */

/* $ 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 */

/*     UTILITY */

/* $ 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. */

/*     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. */


/*     Include Section:  Private FTP Validation String Parameters */

/*        zzftprms.inc Version 1    01-MAR-1999 (FST) */

/*     This include file centralizes the definition of string sizes */
/*     and other parameters that are necessary to properly implement */
/*     the FTP error detection scheme for binary kernels. */
//.........这里部分代码省略.........

/* $Procedure      SAELGV ( Semi-axes of ellipse from generating vectors ) */
/* Subroutine */ int saelgv_(doublereal *vec1, doublereal *vec2, doublereal *
	smajor, doublereal *sminor)
{
    /* System generated locals */
    integer i__1, i__2;
    doublereal d__1, d__2;

    /* Builtin functions */
    integer s_rnge(char *, integer, char *, integer);

    /* Local variables */
    extern doublereal vdot_(doublereal *, doublereal *);
    doublereal c__[4]	/* was [2][2] */;
    integer i__;
    doublereal s[4]	/* was [2][2] */, scale;
    extern /* Subroutine */ int chkin_(char *, ftnlen);
    integer major;
    extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *),
	     vlcom_(doublereal *, doublereal *, doublereal *, doublereal *, 
	    doublereal *);
    integer minor;
    extern doublereal vnorm_(doublereal *);
    extern /* Subroutine */ int diags2_(doublereal *, doublereal *, 
	    doublereal *);
    doublereal tmpvc1[3], tmpvc2[3];
    extern /* Subroutine */ int cleard_(integer *, doublereal *);
    doublereal eigval[4]	/* was [2][2] */;
    extern /* Subroutine */ int chkout_(char *, ftnlen), vsclip_(doublereal *,
	     doublereal *);
    extern logical return_(void);

/* $ Abstract */

/*     Find semi-axis vectors of an ellipse generated by two arbitrary */
/*     three-dimensional vectors. */

/* $ 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 */

/*     ELLIPSES */

/* $ Keywords */

/*     ELLIPSE */
/*     GEOMETRY */
/*     MATH */

/* $ Declarations */
/* $ Brief_I/O */

/*     Variable  I/O  Description */
/*     --------  ---  -------------------------------------------------- */
/*     VEC1, */
/*     VEC2       I   Two vectors used to generate an ellipse. */
/*     SMAJOR     O   Semi-major axis of ellipse. */
/*     SMINOR     O   Semi-minor axis of ellipse. */

/* $ Detailed_Input */

/*     VEC1, */
/*     VEC2           are two vectors that define an ellipse. */
/*                    The ellipse is the set of points in 3-space */

/*                       CENTER  +  cos(theta) VEC1  +  sin(theta) VEC2 */

/*                    where theta is in the interval ( -pi, pi ] and */
/*                    CENTER is an arbitrary point at which the ellipse */
/*                    is centered.  An ellipse's semi-axes are */
/*                    independent of its center, so the vector CENTER */
/*                    shown above is not an input to this routine. */

/*                    VEC2 and VEC1 need not be linearly independent; */
/*                    degenerate input ellipses are allowed. */

/* $ Detailed_Output */
//.........这里部分代码省略.........

/* $Procedure      BODMAT ( Return transformation matrix for a body ) */
/* Subroutine */ int bodmat_(integer *body, doublereal *et, doublereal *tipm)
{
    /* Initialized data */

    static logical first = TRUE_;
    static logical found = FALSE_;

    /* System generated locals */
    integer i__1, i__2, i__3;
    doublereal d__1;

    /* Builtin functions */
    integer s_rnge(char *, integer, char *, integer);
    /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
    integer i_dnnt(doublereal *);
    double sin(doublereal), cos(doublereal), d_mod(doublereal *, doublereal *)
	    ;

    /* Local variables */
    integer cent;
    char item[32];
    doublereal j2ref[9]	/* was [3][3] */;
    extern integer zzbodbry_(integer *);
    extern /* Subroutine */ int eul2m_(doublereal *, doublereal *, doublereal 
	    *, integer *, integer *, integer *, doublereal *);
    doublereal d__;
    integer i__, j;
    doublereal dcoef[3], t, w;
    extern /* Subroutine */ int etcal_(doublereal *, char *, ftnlen);
    integer refid;
    doublereal delta;
    extern /* Subroutine */ int chkin_(char *, ftnlen);
    doublereal epoch, rcoef[3], tcoef[200]	/* was [2][100] */, wcoef[3];
    extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen);
    doublereal theta;
    extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *),
	     repmi_(char *, char *, integer *, char *, ftnlen, ftnlen, ftnlen)
	    , errdp_(char *, doublereal *, ftnlen);
    doublereal costh[100];
    extern doublereal vdotg_(doublereal *, doublereal *, integer *);
    char dtype[1];
    doublereal sinth[100], tsipm[36]	/* was [6][6] */;
    extern doublereal twopi_(void);
    static integer j2code;
    doublereal ac[100], dc[100];
    integer na, nd;
    doublereal ra, wc[100];
    extern /* Subroutine */ int cleard_(integer *, doublereal *);
    extern logical bodfnd_(integer *, char *, ftnlen);
    extern /* Subroutine */ int bodvcd_(integer *, char *, integer *, integer 
	    *, doublereal *, ftnlen);
    integer frcode;
    extern doublereal halfpi_(void);
    extern /* Subroutine */ int ccifrm_(integer *, integer *, integer *, char 
	    *, integer *, logical *, ftnlen);
    integer nw;
    doublereal conepc, conref;
    extern /* Subroutine */ int pckmat_(integer *, doublereal *, integer *, 
	    doublereal *, logical *);
    integer ntheta;
    extern /* Subroutine */ int gdpool_(char *, integer *, integer *, integer 
	    *, doublereal *, logical *, ftnlen);
    char fixfrm[32], errmsg[1840];
    extern /* Subroutine */ int irfnum_(char *, integer *, ftnlen), dtpool_(
	    char *, logical *, integer *, char *, ftnlen, ftnlen);
    doublereal tmpmat[9]	/* was [3][3] */;
    extern /* Subroutine */ int setmsg_(char *, ftnlen), suffix_(char *, 
	    integer *, char *, ftnlen, ftnlen), errint_(char *, integer *, 
	    ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen), 
	    irfrot_(integer *, integer *, doublereal *);
    extern logical return_(void);
    char timstr[35];
    extern doublereal j2000_(void);
    doublereal dec;
    integer dim, ref;
    doublereal phi;
    extern doublereal rpd_(void), spd_(void);
    extern /* Subroutine */ int mxm_(doublereal *, doublereal *, doublereal *)
	    ;

/* $ Abstract */

/*     Return the J2000 to body Equator and Prime Meridian coordinate */
/*     transformation matrix for a specified body. */

/* $ 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 */
//.........这里部分代码省略.........