/* $Procedure OUTMSG ( Output Error Messages ) */ /* Subroutine */ int outmsg_(char *list, ftnlen list_len) { /* Initialized data */ static char defmsg[80*4] = "Oh, by the way: The SPICELIB error handling" " actions are USER-TAILORABLE. You " "can choose whether the To" "olkit aborts or continues when errors occur, which " "error " "messages to output, and where to send the output. Please read t" "he ERROR " "\"Required Reading\" file, or see the routines ERRA" "CT, ERRDEV, and ERRPRT. "; static logical first = TRUE_; /* System generated locals */ address a__1[2], a__2[3]; integer i__1, i__2, i__3[2], i__4[3]; char ch__1[38]; /* Builtin functions */ integer s_rnge(char *, integer, char *, integer), s_cmp(char *, char *, ftnlen, ftnlen); /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen), s_copy(char *, char *, ftnlen, ftnlen); /* Local variables */ char name__[32], line[80]; logical long__; char lmsg[1840]; logical expl; char smsg[25], xmsg[80]; integer i__; logical trace; extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen); integer depth, index; extern integer wdcnt_(char *, ftnlen); extern /* Subroutine */ int expln_(char *, char *, ftnlen, ftnlen); extern integer rtrim_(char *, ftnlen); char versn[80], words[9*5]; integer start; logical short__; extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen); char device[255]; integer remain; static char border[80]; extern /* Subroutine */ int getdev_(char *, ftnlen); logical dfault; integer length; extern /* Subroutine */ int trcdep_(integer *); extern integer lastnb_(char *, ftnlen); extern /* Subroutine */ int trcnam_(integer *, char *, ftnlen), lparse_( char *, char *, integer *, integer *, char *, ftnlen, ftnlen, ftnlen); extern logical msgsel_(char *, ftnlen); integer wrdlen; extern /* Subroutine */ int getlms_(char *, ftnlen), wrline_(char *, char *, ftnlen, ftnlen), getsms_(char *, ftnlen), suffix_(char *, integer *, char *, ftnlen, ftnlen); char tmpmsg[105]; extern /* Subroutine */ int nextwd_(char *, char *, char *, ftnlen, ftnlen, ftnlen); integer numwrd; char upword[9], outwrd[1840]; extern /* Subroutine */ int tkvrsn_(char *, char *, ftnlen, ftnlen); logical output; /* $ Abstract */ /* Output error messages. */ /* $ 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 */ /* ERROR */ /* $ Keywords */ /* ERROR */ /* $ 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 File: SPICELIB Error Handling Parameters */ /* errhnd.inc Version 2 18-JUN-1997 (WLT) */ /* The size of the long error message was */ /* reduced from 25*80 to 23*80 so that it */ /* will be accepted by the Microsoft Power Station */ /* FORTRAN compiler which has an upper bound */ /* of 1900 for the length of a character string. */ /* errhnd.inc Version 1 29-JUL-1997 (NJB) */ /* Maximum length of the long error message: */ /* Maximum length of the short error message: */ /* End Include File: SPICELIB Error Handling Parameters */ /* $ Brief_I/O */ /* VARIABLE I/O DESCRIPTION */ /* -------- --- -------------------------------------------------- */ /* LIST I A list of error message types. */ /* FILEN P Maximum length of file name. */ /* NAMLEN P Maximum length of module name. See TRCPKG. */ /* LL P Output line length. */ /* $ Detailed_Input */ /* LIST is a list of error message types. A list is a */ /* character string containing one or more words */ /* from the following list, separated by commas. */ /* SHORT */ /* EXPLAIN */ /* LONG */ /* TRACEBACK */ /* DEFAULT */ /* Each type of error message specified in LIST will */ /* be output when an error is detected, if it is */ /* enabled for output. Note that DEFAULT does */ /* NOT refer to the "default message selection," */ /* but rather to a special message that is output */ /* when the error action is 'DEFAULT'. This message */ /* is a statement referring the user to the error */ /* handling documentation. */ /* Messages are never duplicated in the output; for */ /* instance, supplying a value of LIST such as */ /* 'SHORT, SHORT' */ /* does NOT result in the output of two short */ /* messages. */ /* The words in LIST may appear in mixed case; */ /* for example, the call */ /* CALL OUTMSG ( 'ShOrT' ) */ /* will work. */ /* $ Detailed_Output */ /* None. */ /* $ Parameters */ /* FILEN is the maximum device name length that can be */ /* accommodated by this routine. */ /* NAMELN is the maximum length of an individual module name. */ /* LL is the maximum line length for the output message. */ /* If the output message string is very long, it is */ /* displayed over several lines, each of which has a */ /* maximum length of LL characters. */ /* $ Exceptions */ /* 1) This routine detects invalid message types in the argument, */ /* LIST. The short error message in this case is */ /* 'SPICE(INVALIDLISTITEM)' */ /* $ Files */ /* None. */ /* $ Particulars */ /* This routine is part of the SPICELIB error handling */ /* mechanism. */ /* This routine outputs the error messages specified in LIST that */ /* have been enabled for output (use the SPICELIB routine ERRPRT */ /* to enable or disable output of specified types of error */ /* messages). A border is written out preceding and following the */ /* messages. Output is directed to the current error output device. */ /* $ Examples */ /* 1) Output the short and long error messages: */ /* C */ /* C Output short and long messages: */ /* C */ /* CALL OUTMSG ( 'SHORT, LONG' ) */ /* $ Restrictions */ /* 1) This routine is intended for use by the SPICELIB error */ /* handling mechanism. SPICELIB users are not expected to */ /* need to call this routine. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* K.R. Gehringer (JPL) */ /* H.A. Neilan (JPL) */ /* M.J. Spencer (JPL) */ /* $ Version */ /* - SPICELIB Version 5.27.0, 10-MAR-2014 (BVS) */ /* Updated for SUN-SOLARIS-64BIT-INTEL. */ /* - SPICELIB Version 5.26.0, 10-MAR-2014 (BVS) */ /* Updated for PC-LINUX-64BIT-IFORT. */ /* - SPICELIB Version 5.25.0, 10-MAR-2014 (BVS) */ /* Updated for PC-CYGWIN-GFORTRAN. */ /* - SPICELIB Version 5.24.0, 10-MAR-2014 (BVS) */ /* Updated for PC-CYGWIN-64BIT-GFORTRAN. */ /* - SPICELIB Version 5.23.0, 10-MAR-2014 (BVS) */ /* Updated for PC-CYGWIN-64BIT-GCC_C. */ /* - SPICELIB Version 5.22.0, 13-MAY-2010 (BVS) */ /* Updated for SUN-SOLARIS-INTEL. */ /* - SPICELIB Version 5.21.0, 13-MAY-2010 (BVS) */ /* Updated for SUN-SOLARIS-INTEL-CC_C. */ /* - SPICELIB Version 5.20.0, 13-MAY-2010 (BVS) */ /* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */ /* - SPICELIB Version 5.19.0, 13-MAY-2010 (BVS) */ /* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */ /* - SPICELIB Version 5.18.0, 13-MAY-2010 (BVS) */ /* Updated for PC-WINDOWS-64BIT-IFORT. */ /* - SPICELIB Version 5.17.0, 13-MAY-2010 (BVS) */ /* Updated for PC-LINUX-64BIT-GFORTRAN. */ /* - SPICELIB Version 5.16.0, 13-MAY-2010 (BVS) */ /* Updated for PC-64BIT-MS_C. */ /* - SPICELIB Version 5.15.0, 13-MAY-2010 (BVS) */ /* Updated for MAC-OSX-64BIT-INTEL_C. */ /* - SPICELIB Version 5.14.0, 13-MAY-2010 (BVS) */ /* Updated for MAC-OSX-64BIT-IFORT. */ /* - SPICELIB Version 5.13.0, 13-MAY-2010 (BVS) */ /* Updated for MAC-OSX-64BIT-GFORTRAN. */ /* - SPICELIB Version 5.12.0, 18-MAR-2009 (BVS) */ /* Updated for PC-LINUX-GFORTRAN. */ /* - SPICELIB Version 5.11.0, 18-MAR-2009 (BVS) */ /* Updated for MAC-OSX-GFORTRAN. */ /* - SPICELIB Version 5.10.0, 01-MAR-2009 (NJB) */ /* Bug fix: truncation of long words in */ /* output has been corrected. Local parameter */ /* TMPLEN was added and is used in declaration */ /* of TMPMSG. */ /* - SPICELIB Version 5.9.0, 19-FEB-2008 (BVS) */ /* Updated for PC-LINUX-IFORT. */ /* - SPICELIB Version 5.8.0, 14-NOV-2006 (BVS) */ /* Updated for PC-LINUX-64BIT-GCC_C. */ /* - SPICELIB Version 5.7.0, 14-NOV-2006 (BVS) */ /* Updated for MAC-OSX-INTEL_C. */ /* - SPICELIB Version 5.6.0, 14-NOV-2006 (BVS) */ /* Updated for MAC-OSX-IFORT. */ /* - SPICELIB Version 5.5.0, 14-NOV-2006 (BVS) */ /* Updated for PC-WINDOWS-IFORT. */ /* - SPICELIB Version 5.4.0, 26-OCT-2005 (BVS) */ /* Updated for SUN-SOLARIS-64BIT-GCC_C. */ /* - SPICELIB Version 5.3.0, 03-JAN-2005 (BVS) */ /* Updated for PC-CYGWIN_C. */ /* - SPICELIB Version 5.2.0, 03-JAN-2005 (BVS) */ /* Updated for PC-CYGWIN. */ /* - SPICELIB Version 5.1.5, 17-JUL-2002 (BVS) */ /* Added MAC-OSX environments. */ /* - SPICELIB Version 5.1.4, 08-OCT-1999 (WLT) */ /* The environment lines were expanded so that the supported */ /* environments are now explicitely given. New */ /* environments are WIN-NT */ /* - SPICELIB Version 5.1.3, 24-SEP-1999 (NJB) */ /* CSPICE environments were added. Some typos were corrected. */ /* - SPICELIB Version 5.1.2, 28-JUL-1999 (WLT) */ /* The environment lines were expanded so that the supported */ /* environments are now explicitly given. New */ /* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ /* - SPICELIB Version 5.1.1, 18-MAR-1999 (WLT) */ /* The environment lines were expanded so that the supported */ /* environments are now explicitly given. Previously, */ /* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ /* by the environment label SUN. */ /* - SPICELIB Version 5.1.0, 13-JAN-1999 (BVS) */ /* ``errhnd.inc'' file was included. Long and short error */ /* message lengths parameter declarations were deleted. Long */ /* and short error message string sizes were changed to those */ /* declared in ``errhnd.inc''. */ /* - SPICELIB Version 5.0.0, 08-APR-1998 (NJB) */ /* Module was updated for the PC-LINUX platform. */ /* - SPICELIB Version 4.0.0, 09-MAY-1996 (KRG) */ /* Added the toolkit version to the output error message. */ /* Updated this routine to be consistent with the trace package */ /* revisions. This primarily affects the creation of the */ /* traceback string. */ /* Long error messages are now wrapped on word boundaries when */ /* they are longer than the output line length. Note that this */ /* only happens for long error messages obtained from GETLMS, */ /* and not for the error messages displayed by this subroutine */ /* and other error handling subroutines that write their own */ /* error messages. */ /* - SPICELIB Version 3.0.0, 09-NOV-1993 (HAN) */ /* Module was updated to include the value for FILEN */ /* for the Silicon Graphics, DEC Alpha-OSF/1, and */ /* NeXT platforms. Also, the previous value of 256 for */ /* Unix platforms was changed to 255. */ /* - SPICELIB Version 2.2.0, 12-OCT-1992 (HAN) */ /* Updated module for multiple environments. Moved the parameter */ /* LL to the Declarations section of the header since it's */ /* environment dependent. */ /* The code was also reformatted so that a utility program can */ /* create the source file for a specific environment given a */ /* master source file. */ /* - SPICELIB Version 2.1.1, 10-MAR-1992 (WLT) */ /* Comment section for permuted index source lines was added */ /* following the header. */ /* - SPICELIB Version 2.1.0, 15-MAY-1991 (MJS) */ /* Module was updated to include the value of LL for the */ /* Macintosh. */ /* - SPICELIB Version 2.0.0, 28-MAR-1991 (NJB) */ /* Work-around for MS Fortran compiler error under DOS 3.10 */ /* was made. Some substring bounds were simplified using RTRIM. */ /* Updates were made to the header to clarify the text and */ /* improve the header's appearance. The default error message */ /* was slightly de-uglified. */ /* The IBM PC version of this routine now uses an output line */ /* length of 78 characters rather than 80. This prevents */ /* wrapping of the message borders and default error message. */ /* - SPICELIB Version 1.0.0, 31-JAN-1990 (NJB) */ /* -& */ /* $ Index_Entries */ /* None. */ /* -& */ /* $ Revisions */ /* - SPICELIB Version 5.1.0, 13-JAN-1999 (BVS) */ /* ``errhnd.inc'' file was included. Long and short error */ /* message lengths parameter declarations were deleted. Long */ /* and short error message string size were changed to those */ /* declared in ``errhnd.inc''. */ /* - SPICELIB Version 5.0.0, 08-APR-1998 (NJB) */ /* Module was updated for the PC-LINUX platform. */ /* - SPICELIB Version 4.0.0, 09-MAY-1996 (KRG) */ /* Added the toolkit version to the output error message. */ /* Updated this routine to be consistent with the trace package */ /* revisions. This primarily affects the creation of the */ /* traceback string. */ /* Long error messages are now wrapped on word boundaries when */ /* they are longer than the output line length. Note that this */ /* only happens for long error messages obtained from GETLMS, */ /* and not for the error messages displayed by this subroutine */ /* and other error handling subroutines that write their own */ /* error messages. */ /* - SPICELIB Version 3.0.0, 9-NOV-1993 (HAN) */ /* Module was updated to include the value for FILEN */ /* for the Silicon Graphics, DEC Alpha-OSF/1, and */ /* NeXT platforms. Also, the previous value of 256 for */ /* Unix platforms was changed to 255. */ /* - SPICELIB Version 2.2.0, 12-OCT-1992 (HAN) */ /* Updated module for multiple environments. Moved the */ /* parameter LL to the Declarations section of the header since */ /* it's environment dependent. */ /* The code was also reformatted so that a utility program can */ /* create the source file for a specific environment given a */ /* master source file. */ /* - SPICELIB Version 2.1.0, 15-MAY-1991 (MJS) */ /* Module was updated to include the value of LL for the */ /* Macintosh. */ /* - SPICELIB Version 2.0.0, 28-MAR-1991 (NJB) */ /* 1) Work-around for MS Fortran compiler error under DOS 3.10 */ /* was made. The compiler did not correctly handle code that */ /* concatenated strings whose bounds involved the intrinsic */ /* MAX function. */ /* 2) Some substring bounds were simplified using RTRIM. */ /* 3) Updates were made to the header to clarify the text and */ /* improve the header's appearance. */ /* 4) Declarations were re-organized. */ /* 5) The default error message was slightly de-uglified. */ /* 6) The IBM PC version of this routine now uses an output line */ /* length of 78 characters rather than 80. This prevents */ /* wrapping of the message borders and default error message. */ /* - Beta Version 1.3.0, 19-JUL-1989 (NJB) */ /* Calls to REMSUB removed; blanking and left-justifying used */ /* instead. This was done because REMSUB handles substring */ /* bounds differently than in previous versions, and no longer */ /* handles all possible inputs as required by this routine. */ /* LJUST, which is used now, is error free. */ /* Also, an instance of .LT. was changed to .LE. The old code */ /* caused a line break one character too soon. A minor bug, but */ /* a bug nonetheless. */ /* Also, two substring bounds were changed to ensure that they */ /* remain greater than zero. */ /* - Beta Version 1.2.0, 16-FEB-1989 (NJB) */ /* Warnings added to discourage use of this routine in */ /* non-error-handling code. Parameters section updated to */ /* describe FILEN and NAMLEN. */ /* Declaration of unused function FAILED removed. */ /* - Beta Version 1.1.0, 06-OCT-1988 (NJB) */ /* Test added to ensure substring upper bound is greater than 0. */ /* REMAIN must be greater than 0 when used as the upper bound */ /* for a substring of NAME. Also, substring upper bound in */ /* WRLINE call is now forced to be greater than 0. */ /* -& */ /* SPICELIB functions */ /* Local parameters */ /* These parameters are system-independent. */ /* Local variables */ /* Saved variables */ /* Initial Values: */ /* Executable Code: */ /* The first time through, set up the output borders. */ if (first) { first = FALSE_; for (i__ = 1; i__ <= 80; ++i__) { *(unsigned char *)&border[i__ - 1] = '='; } } /* No messages are to be output which are not specified */ /* in LIST: */ short__ = FALSE_; expl = FALSE_; long__ = FALSE_; trace = FALSE_; dfault = FALSE_; /* We parse the list of message types, and set local flags */ /* indicating which ones are to be output. If we find */ /* a word we don't recognize in the list, we signal an error */ /* and continue parsing the list. */ lparse_(list, ",", &c__5, &numwrd, words, list_len, (ftnlen)1, (ftnlen)9); i__1 = numwrd; for (i__ = 1; i__ <= i__1; ++i__) { ucase_(words + ((i__2 = i__ - 1) < 5 && 0 <= i__2 ? i__2 : s_rnge( "words", i__2, "outmsg_", (ftnlen)613)) * 9, upword, (ftnlen) 9, (ftnlen)9); if (s_cmp(upword, "SHORT", (ftnlen)9, (ftnlen)5) == 0) { short__ = TRUE_; } else if (s_cmp(upword, "EXPLAIN", (ftnlen)9, (ftnlen)7) == 0) { expl = TRUE_; } else if (s_cmp(upword, "LONG", (ftnlen)9, (ftnlen)4) == 0) { long__ = TRUE_; } else if (s_cmp(upword, "TRACEBACK", (ftnlen)9, (ftnlen)9) == 0) { trace = TRUE_; } else if (s_cmp(upword, "DEFAULT", (ftnlen)9, (ftnlen)7) == 0) { dfault = TRUE_; } else { /* Unrecognized word! This is an error... */ /* We have a special case on our hands; this routine */ /* is itself called by SIGERR, so a recursion error will */ /* result if this routine calls SIGERR. So we output */ /* the error message directly: */ getdev_(device, (ftnlen)255); wrline_(device, "SPICE(INVALIDLISTITEM)", (ftnlen)255, (ftnlen)22) ; wrline_(device, " ", (ftnlen)255, (ftnlen)1); wrline_(device, "OUTMSG: An invalid message type was specified " "in the type list. ", (ftnlen)255, (ftnlen)65); /* Writing concatenation */ i__3[0] = 29, a__1[0] = "The invalid message type was "; i__3[1] = 9, a__1[1] = words + ((i__2 = i__ - 1) < 5 && 0 <= i__2 ? i__2 : s_rnge("words", i__2, "outmsg_", (ftnlen)650)) * 9; s_cat(ch__1, a__1, i__3, &c__2, (ftnlen)38); wrline_(device, ch__1, (ftnlen)255, (ftnlen)38); } } /* LIST has been parsed. */ /* Now, we output those error messages that were specified by LIST */ /* and which belong to the set of messages selected for output. */ /* We get the default error output device: */ getdev_(device, (ftnlen)255); output = short__ && msgsel_("SHORT", (ftnlen)5) || expl && msgsel_("EXPL" "AIN", (ftnlen)7) || long__ && msgsel_("LONG", (ftnlen)4) || trace && msgsel_("TRACEBACK", (ftnlen)9) || dfault && msgsel_("DEFAULT", (ftnlen)7) && s_cmp(device, "NULL", (ftnlen)255, (ftnlen)4) != 0; /* We go ahead and output those messages that have been specified */ /* in the list and also are enabled for output. The order of the */ /* cases below IS significant; the order in which the messages */ /* appear in the output depends on it. */ /* If there's nothing to output, we can leave now. */ if (! output) { return 0; } /* Write the starting border: skip a line, write the border, */ /* skip a line. */ wrline_(device, " ", (ftnlen)255, (ftnlen)1); wrline_(device, border, (ftnlen)255, (ftnlen)80); wrline_(device, " ", (ftnlen)255, (ftnlen)1); /* Output the toolkit version and skip a line. */ tkvrsn_("TOOLKIT", versn, (ftnlen)7, (ftnlen)80); /* Writing concatenation */ i__3[0] = 17, a__1[0] = "Toolkit version: "; i__3[1] = 80, a__1[1] = versn; s_cat(line, a__1, i__3, &c__2, (ftnlen)80); wrline_(device, line, (ftnlen)255, (ftnlen)80); wrline_(device, " ", (ftnlen)255, (ftnlen)1); /* Next, we output the messages specified in the list */ /* that have been enabled. */ /* We start with the short message and its accompanying */ /* explanation. If both are to be output, they are */ /* concatenated into a single message. */ if (short__ && msgsel_("SHORT", (ftnlen)5) && (expl && msgsel_("EXPLAIN", (ftnlen)7))) { /* Extract the short message from global storage; then get */ /* the corresponding explanation. */ getsms_(smsg, (ftnlen)25); expln_(smsg, xmsg, (ftnlen)25, (ftnlen)80); /* Writing concatenation */ i__4[0] = rtrim_(smsg, (ftnlen)25), a__2[0] = smsg; i__4[1] = 4, a__2[1] = " -- "; i__4[2] = 80, a__2[2] = xmsg; s_cat(tmpmsg, a__2, i__4, &c__3, (ftnlen)105); wrline_(device, tmpmsg, (ftnlen)255, (ftnlen)105); wrline_(device, " ", (ftnlen)255, (ftnlen)1); } else if (short__ && msgsel_("SHORT", (ftnlen)5)) { /* Output the short error message without the explanation. */ getsms_(smsg, (ftnlen)25); wrline_(device, smsg, (ftnlen)255, (ftnlen)25); wrline_(device, " ", (ftnlen)255, (ftnlen)1); } else if (expl && msgsel_("EXPLAIN", (ftnlen)7)) { /* Obtain the explanatory text for the short error */ /* message and output it: */ getsms_(smsg, (ftnlen)25); expln_(smsg, xmsg, (ftnlen)25, (ftnlen)80); wrline_(device, xmsg, (ftnlen)255, (ftnlen)80); wrline_(device, " ", (ftnlen)255, (ftnlen)1); } if (long__ && msgsel_("LONG", (ftnlen)4)) { /* Extract the long message from global storage and */ /* output it: */ getlms_(lmsg, (ftnlen)1840); /* Get the number of words in the error message. */ numwrd = wdcnt_(lmsg, (ftnlen)1840); s_copy(line, " ", (ftnlen)80, (ftnlen)1); start = 1; /* Format the words into output lines and display them as */ /* needed. */ i__1 = numwrd; for (i__ = 1; i__ <= i__1; ++i__) { nextwd_(lmsg, outwrd, lmsg, (ftnlen)1840, (ftnlen)1840, (ftnlen) 1840); wrdlen = rtrim_(outwrd, (ftnlen)1840); if (start + wrdlen <= 80) { s_copy(line + (start - 1), outwrd, 80 - (start - 1), (ftnlen) 1840); start = start + wrdlen + 1; } else { if (wrdlen <= 80) { /* We had a short word, so just write the line and */ /* continue. */ wrline_(device, line, (ftnlen)255, (ftnlen)80); start = wrdlen + 2; s_copy(line, outwrd, (ftnlen)80, (ftnlen)1840); } else { /* We got a very long word here, so we break it up and */ /* write it out. We fit as much of it as we an into line */ /* as possible before writing it. */ /* Get the remaining space. If START is > 1 we have at */ /* least one word already in the line, including it's */ /* trailing space, otherwise the line is blank. If line */ /* is empty, we have all of the space available. */ if (start > 1) { remain = 80 - start; } else { remain = 80; } /* Now we stuff bits of the word into the output line */ /* until we're done, i.e., until we have a word part */ /* that is less than the output length. First, we */ /* check to see if there is a "significant" amount of */ /* room left in the current output line. If not, we */ /* write it and then begin stuffing the long word into */ /* output lines. */ if (remain < 10) { wrline_(device, line, (ftnlen)255, (ftnlen)80); s_copy(line, " ", (ftnlen)80, (ftnlen)1); remain = 80; start = 1; } /* Stuff the word a chunk at a time into output lines */ /* and write them. After writing a line, we clear the */ /* part of the long word that we just wrote, left */ /* justifying the remaining part before proceeding. */ while(wrdlen > 80) { s_copy(line + (start - 1), outwrd, 80 - (start - 1), remain); wrline_(device, line, (ftnlen)255, (ftnlen)80); s_copy(outwrd, " ", remain, (ftnlen)1); ljust_(outwrd, outwrd, (ftnlen)1840, (ftnlen)1840); s_copy(line, " ", (ftnlen)80, (ftnlen)1); wrdlen -= remain; remain = 80; start = 1; } /* If we had a part of the long word left, get set up to */ /* append more words from the error message to the output */ /* line. If we finished the word, WRDLEN .EQ. 0, then */ /* START and LINE have already been initialized. */ if (wrdlen > 0) { start = wrdlen + 2; s_copy(line, outwrd, (ftnlen)80, (ftnlen)1840); } } } } /* We may need to write the remaining part of a line. */ if (s_cmp(line, " ", (ftnlen)80, (ftnlen)1) != 0) { wrline_(device, line, (ftnlen)255, (ftnlen)80); } wrline_(device, " ", (ftnlen)255, (ftnlen)1); } if (trace && msgsel_("TRACEBACK", (ftnlen)9)) { /* Extract the traceback from global storage and */ /* output it: */ trcdep_(&depth); if (depth > 0) { /* We know we'll be outputting some trace information. */ /* So, write a line telling the reader what's coming. */ wrline_(device, "A traceback follows. The name of the highest l" "evel module is first.", (ftnlen)255, (ftnlen)68); /* While there are more names in the traceback */ /* representation, we stuff them into output lines and */ /* write the lines out when they are full. */ s_copy(line, " ", (ftnlen)80, (ftnlen)1); remain = 80; i__1 = depth; for (index = 1; index <= i__1; ++index) { /* For each module name in the traceback representation, */ /* retrieve module name and stuff it into one or more */ /* lines for output. */ /* Get a name and add the call order sign. We */ /* indicate calling order by a ' --> ' delimiter; e.g. */ /* "A calls B" is indicated by 'A --> B'. */ trcnam_(&index, name__, (ftnlen)32); length = lastnb_(name__, (ftnlen)32); /* If it's the first name, just put it into the output */ /* line, otherwise, add the call order sign and put the */ /* name into the output line. */ if (index == 1) { suffix_(name__, &c__0, line, (ftnlen)32, (ftnlen)80); remain -= length; } else { /* Add the calling order indicator, if it will fit. */ /* If not, write the line and put the indicator as */ /* the first thing on the next line. */ if (remain >= 4) { suffix_("-->", &c__1, line, (ftnlen)3, (ftnlen)80); remain += -4; } else { wrline_(device, line, (ftnlen)255, (ftnlen)80); s_copy(line, "-->", (ftnlen)80, (ftnlen)3); remain = 77; } /* The name fits or it doesn't. If it does, just add */ /* it, if it doesn't, write it, then make the name */ /* the first thing on the next line. */ if (remain >= length) { suffix_(name__, &c__1, line, (ftnlen)32, (ftnlen)80); remain = remain - length - 1; } else { wrline_(device, line, (ftnlen)255, (ftnlen)80); s_copy(line, name__, (ftnlen)80, (ftnlen)32); remain = 80 - length; } } } /* At this point, no more names are left in the */ /* trace representation. LINE may still contain */ /* names, or part of a long name. If it does, */ /* we now write it out. */ if (s_cmp(line, " ", (ftnlen)80, (ftnlen)1) != 0) { wrline_(device, line, (ftnlen)255, (ftnlen)80); } wrline_(device, " ", (ftnlen)255, (ftnlen)1); } /* At this point, either we have output the trace */ /* representation, or the trace representation was */ /* empty. */ } if (dfault && msgsel_("DEFAULT", (ftnlen)7)) { /* Output the default message: */ for (i__ = 1; i__ <= 4; ++i__) { wrline_(device, defmsg + ((i__1 = i__ - 1) < 4 && 0 <= i__1 ? i__1 : s_rnge("defmsg", i__1, "outmsg_", (ftnlen)971)) * 80, (ftnlen)255, (ftnlen)80); } wrline_(device, " ", (ftnlen)255, (ftnlen)1); } /* At this point, we've output all of the enabled messages */ /* that were specified in LIST. At least one message that */ /* was specified was enabled. */ /* Write the ending border out: */ wrline_(device, border, (ftnlen)255, (ftnlen)80); return 0; } /* outmsg_ */
/* $Procedure PRTPKG ( Declare Arguments for Error Message Routines ) */ logical prtpkg_0_(int n__, logical *short__, logical *long__, logical *expl, logical *trace, logical *dfault, char *type__, ftnlen type_len) { /* Initialized data */ static logical svshrt = TRUE_; static logical svexpl = TRUE_; static logical svlong = TRUE_; static logical svtrac = TRUE_; static logical svdflt = TRUE_; /* System generated locals */ address a__1[2]; integer i__1[2]; logical ret_val; char ch__1[96]; /* Builtin functions */ integer s_cmp(char *, char *, ftnlen, ftnlen); /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *, char **, integer *, integer *, ftnlen); /* Local variables */ extern /* Subroutine */ int ucase_(char *, char *, ftnlen, ftnlen); char ltype[10]; extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen); char device[128]; extern /* Subroutine */ int getdev_(char *, ftnlen), wrline_(char *, char *, ftnlen, ftnlen); char loctyp[10]; /* $ Abstract */ /* Declare the arguments for the error message selection entry */ /* points. DO NOT CALL THIS ROUTINE. */ /* $ 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 */ /* ERROR */ /* $ Keywords */ /* ERROR */ /* $ Declarations */ /* $ Brief_I/O */ /* VARIABLE I/O ENTRY */ /* -------- --- -------------------------------------------------- */ /* SHORT I SETPRT */ /* EXPL I SETPRT */ /* LONG I SETPRT */ /* TRACE I SETPRT */ /* DFAULT I SETPRT */ /* TYPE I MSGSEL */ /* FILEN P MSGSEL */ /* $ Detailed_Input */ /* See the ENTRY points for discussions of their arguments. */ /* $ Detailed_Output */ /* See the ENTRY points for discussions of their arguments. */ /* $ Parameters */ /* See the ENTRY points for discussions of their parameters. */ /* $ Exceptions */ /* This routine signals an error IF IT IS CALLED. */ /* $ Files */ /* None. */ /* $ Particulars */ /* DO NOT CALL THIS ROUTINE. */ /* The entry points declared in this routine are: */ /* SETPRT */ /* MSGSEL */ /* There is no reason to call this subroutine. */ /* The purpose of this subroutine is to make the */ /* declarations required by the various entry points. */ /* This routine has no run-time function. */ /* $ Examples */ /* None. DO NOT CALL THIS ROUTINE. */ /* $ Restrictions */ /* DO NOT CALL THIS ROUTINE. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* H.A. Neilan (JPL) */ /* $ Version */ /* - SPICELIB Version 3.25.0, 10-MAR-2014 (BVS) */ /* Updated for SUN-SOLARIS-64BIT-INTEL. */ /* - SPICELIB Version 3.24.0, 10-MAR-2014 (BVS) */ /* Updated for PC-LINUX-64BIT-IFORT. */ /* - SPICELIB Version 3.23.0, 10-MAR-2014 (BVS) */ /* Updated for PC-CYGWIN-GFORTRAN. */ /* - SPICELIB Version 3.22.0, 10-MAR-2014 (BVS) */ /* Updated for PC-CYGWIN-64BIT-GFORTRAN. */ /* - SPICELIB Version 3.21.0, 10-MAR-2014 (BVS) */ /* Updated for PC-CYGWIN-64BIT-GCC_C. */ /* - SPICELIB Version 3.20.0, 13-MAY-2010 (BVS) */ /* Updated for SUN-SOLARIS-INTEL. */ /* - SPICELIB Version 3.19.0, 13-MAY-2010 (BVS) */ /* Updated for SUN-SOLARIS-INTEL-CC_C. */ /* - SPICELIB Version 3.18.0, 13-MAY-2010 (BVS) */ /* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */ /* - SPICELIB Version 3.17.0, 13-MAY-2010 (BVS) */ /* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */ /* - SPICELIB Version 3.16.0, 13-MAY-2010 (BVS) */ /* Updated for PC-WINDOWS-64BIT-IFORT. */ /* - SPICELIB Version 3.15.0, 13-MAY-2010 (BVS) */ /* Updated for PC-LINUX-64BIT-GFORTRAN. */ /* - SPICELIB Version 3.14.0, 13-MAY-2010 (BVS) */ /* Updated for PC-64BIT-MS_C. */ /* - SPICELIB Version 3.13.0, 13-MAY-2010 (BVS) */ /* Updated for MAC-OSX-64BIT-INTEL_C. */ /* - SPICELIB Version 3.12.0, 13-MAY-2010 (BVS) */ /* Updated for MAC-OSX-64BIT-IFORT. */ /* - SPICELIB Version 3.11.0, 13-MAY-2010 (BVS) */ /* Updated for MAC-OSX-64BIT-GFORTRAN. */ /* - SPICELIB Version 3.10.0, 18-MAR-2009 (BVS) */ /* Updated for PC-LINUX-GFORTRAN. */ /* - SPICELIB Version 3.9.0, 18-MAR-2009 (BVS) */ /* Updated for MAC-OSX-GFORTRAN. */ /* - SPICELIB Version 3.8.0, 19-FEB-2008 (BVS) */ /* Updated for PC-LINUX-IFORT. */ /* - SPICELIB Version 3.7.0, 14-NOV-2006 (BVS) */ /* Updated for PC-LINUX-64BIT-GCC_C. */ /* - SPICELIB Version 3.6.0, 14-NOV-2006 (BVS) */ /* Updated for MAC-OSX-INTEL_C. */ /* - SPICELIB Version 3.5.0, 14-NOV-2006 (BVS) */ /* Updated for MAC-OSX-IFORT. */ /* - SPICELIB Version 3.4.0, 14-NOV-2006 (BVS) */ /* Updated for PC-WINDOWS-IFORT. */ /* - SPICELIB Version 3.3.0, 26-OCT-2005 (BVS) */ /* Updated for SUN-SOLARIS-64BIT-GCC_C. */ /* - SPICELIB Version 3.2.0, 03-JAN-2005 (BVS) */ /* Updated for PC-CYGWIN_C. */ /* - SPICELIB Version 3.1.0, 03-JAN-2005 (BVS) */ /* Updated for PC-CYGWIN. */ /* - SPICELIB Version 3.0.5, 17-JUL-2002 (BVS) */ /* Added MAC-OSX environments. */ /* - SPICELIB Version 3.0.4, 08-OCT-1999 (WLT) */ /* The environment lines were expanded so that the supported */ /* environments are now explicitely given. New */ /* environments are WIN-NT */ /* - SPICELIB Version 3.0.3, 24-SEP-1999 (NJB) */ /* CSPICE environments were added. Some typos were corrected. */ /* - SPICELIB Version 3.0.2, 28-JUL-1999 (WLT) */ /* The environment lines were expanded so that the supported */ /* environments are now explicitly given. New */ /* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ /* - SPICELIB Version 3.0.1, 18-MAR-1999 (WLT) */ /* The environment lines were expanded so that the supported */ /* environments are now explicitly given. Previously, */ /* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ /* by the environment label SUN. */ /* - SPICELIB Version 3.0.0, 07-APR-1998 (NJB) */ /* Module was updated for the PC-LINUX platform. */ /* - SPICELIB Version 2.0.0, 9-NOV-1993 (HAN) */ /* Module was updated to include the value for FILEN */ /* for the Silicon Graphics, DEC Alpha-OSF/1, and */ /* NeXT platforms. Also, the previous value of 256 for */ /* Unix platforms was changed to 255. */ /* - SPICELIB Version 1.1.0, 12-OCT-1992 (HAN) */ /* Updated module for multiple environments. */ /* The code was also reformatted so that a utility program can */ /* create the source file for a specific environment given a */ /* master source file. */ /* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */ /* Comment section for permuted index source lines was added */ /* following the header. */ /* - SPICELIB Version 1.0.0, 31-JAN-1990 (NJB) */ /* -& */ /* $ Index_Entries */ /* None. */ /* -& */ /* $ Revisions */ /* - SPICELIB Version 3.0.0, 07-APR-1998 (NJB) */ /* Module was updated for the PC-LINUX platform. */ /* - SPICELIB Version 2.0.0, 9-NOV-1993 (HAN) */ /* Module was updated to include the value for FILEN */ /* for the Silicon Graphics, DEC Alpha-OSF/1, and */ /* NeXT platforms. Also, the previous value of 256 for */ /* Unix platforms was changed to 255. */ /* - SPICELIB Version 1.1.0, 12-OCT-1992 (HAN) */ /* Updated module for multiple environments. */ /* The code was also reformatted so that a utility program can */ /* create the source file for a specific environment given a */ /* master source file. */ /* - Beta Version 1.1.0, 13-DEC-1989 (NJB) */ /* PRTPKG, though it performs no run-time function, must */ /* still return a value, in order to comply with the Fortran */ /* standard. So, now it does. */ /* - Beta Version 1.0.1, 08-FEB-1989 (NJB) */ /* Warnings added to discourage use of this routine. */ /* Parameter declarations moved to "Declarations" section. */ /* Two local declarations moved to the correct location. */ /* -& */ /* SPICELIB functions */ /* Local variables: */ /* Saved variables: */ /* Initial values: */ switch(n__) { case 1: goto L_setprt; case 2: goto L_msgsel; } /* Executable Code: */ getdev_(device, (ftnlen)128); wrline_(device, "PRTPKG: You have called an entry point which has no ru" "n-time function; this may indicate a program bug. Please check " "the PRTPKG documentation. ", (ftnlen)128, (ftnlen)146); wrline_(device, "SPICE(BOGUSENTRY)", (ftnlen)128, (ftnlen)17); ret_val = FALSE_; return ret_val; /* $Procedure SETPRT ( Store Error Message Types to be Output ) */ L_setprt: /* $ Abstract */ /* Store (a representation of) the selection of types of error */ /* messages to be output. DO NOT CALL THIS ROUTINE. */ /* $ 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 */ /* ERROR */ /* $ Keywords */ /* ERROR */ /* $ Declarations */ /* LOGICAL SHORT */ /* LOGICAL EXPL */ /* LOGICAL LONG */ /* LOGICAL TRACE */ /* LOGICAL DFAULT */ /* $ Brief_I/O */ /* VARIABLE I/O DESCRIPTION */ /* -------- --- -------------------------------------------------- */ /* SHORT I Select output of short error message? */ /* EXPL I Select output of explanation of short message? */ /* LONG I Select output of long error message? */ /* TRACE I Select output of traceback? */ /* DFAULT I Select output of default message? */ /* $ Detailed_Input */ /* SHORT indicates whether the short error message is selected */ /* as one of the error messages to be output when an error */ /* is detected. A value of .TRUE. indicates that the */ /* short error message IS selected. */ /* EXPL indicates whether the explanatory text for the short */ /* error message is selected as one of the error messages */ /* to be output when an error is detected. A value of */ /* .TRUE. indicates that the explanatory text for the */ /* short error message IS selected. */ /* LONG indicates whether the long error message is selected */ /* as one of the error messages to be output when an error */ /* is detected. A value of .TRUE. indicates that the */ /* long error message IS selected. */ /* TRACE indicates whether the traceback is selected */ /* as one of the error messages to be output when an error */ /* is detected. A value of .TRUE. indicates that the */ /* traceback IS selected. */ /* DFAULT indicates whether the default message is selected */ /* as one of the error messages to be output when an error */ /* is detected. A value of .TRUE. indicates that the */ /* default message IS selected. */ /* $ Detailed_Output */ /* None. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* None. */ /* $ Files */ /* None. */ /* $ Particulars */ /* DO NOT CALL THIS ROUTINE. */ /* The effect of this routine is an ENVIRONMENTAL one. This */ /* routine performs no output; it stores the error message */ /* selection provided as input. */ /* Note that the actual output of error messages depends not */ /* only on the selection made using this routine, but also */ /* on the selection of the error output device (see ERRDEV) */ /* and the choice of error response action (see ERRACT). If */ /* the action is not 'IGNORE' (possible choices are */ /* 'IGNORE', 'ABORT', 'DEFAULT', 'REPORT', and 'RETURN'), */ /* the selected error messages will be written to the chosen */ /* output device when an error is detected. */ /* $ Examples */ /* 1. In this example, the short and long messages are selected. */ /* C */ /* C Select short and long error messages for output */ /* C (We don't examine the status returned because no */ /* C errors are detected by SETPRT): */ /* C */ /* STATUS = SETPRT ( .TRUE., .FALSE., .TRUE., .FALSE., */ /* . .FALSE. ) */ /* $ Restrictions */ /* DO NOT CALL THIS ROUTINE. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* $ Version */ /* - SPICELIB Version 3.0.5, 17-JUL-2002 (BVS) */ /* Added MAC-OSX environments. */ /* - SPICELIB Version 3.0.4, 08-OCT-1999 (WLT) */ /* The environment lines were expanded so that the supported */ /* environments are now explicitely given. New */ /* environments are WIN-NT */ /* - SPICELIB Version 3.0.2, 28-JUL-1999 (WLT) */ /* The environment lines were expanded so that the supported */ /* environments are now explicitly given. New */ /* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ /* - SPICELIB Version 3.0.1, 18-MAR-1999 (WLT) */ /* The environment lines were expanded so that the supported */ /* environments are now explicitly given. Previously, */ /* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ /* by the environment label SUN. */ /* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */ /* Comment section for permuted index source lines was added */ /* following the header. */ /* - SPICELIB Version 1.0.0, 31-JAN-1990 (NJB) */ /* -& */ /* $ Index_Entries */ /* None. */ /* -& */ /* $ Revisions */ /* - Beta Version 1.0.1, 08-FEB-1989 (NJB) */ /* Warnings added to discourage use of this routine in */ /* non-error-handling code. Parameters section added. */ /* -& */ /* Executable Code: */ if (*short__) { svshrt = TRUE_; } else { svshrt = FALSE_; } if (*expl) { svexpl = TRUE_; } else { svexpl = FALSE_; } if (*long__) { svlong = TRUE_; } else { svlong = FALSE_; } if (*trace) { svtrac = TRUE_; } else { svtrac = FALSE_; } if (*dfault) { svdflt = TRUE_; } else { svdflt = FALSE_; } /* We assign a value to SETPRT, but this value is */ /* not meaningful... */ ret_val = TRUE_; return ret_val; /* $Procedure MSGSEL ( Is This Message Type Selected for Output? ) */ L_msgsel: /* $ Abstract */ /* Indicate whether the specified message type has been selected */ /* for output. */ /* $ 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 */ /* ERROR */ /* $ Keywords */ /* ERROR */ /* $ Declarations */ /* TYPE */ /* $ Brief_I/O */ /* VARIABLE I/O DESCRIPTION */ /* -------- --- -------------------------------------------------- */ /* TYPE I Type of message whose selection status is queried. */ /* FILEN P Maximum length of a file name. */ /* The function takes the value .TRUE. if the message type indicated */ /* by TYPE has been selected for output to the error output device. */ /* $ Detailed_Input */ /* TYPE Refers to a type of error message. Possible values */ /* are 'SHORT', 'EXPLAIN', 'LONG', 'DEFAULT', */ /* and 'TRACEBACK'. */ /* $ Detailed_Output */ /* The function takes the value .TRUE. if the message type indicated */ /* by TYPE has been selected for output to the error output device. */ /* $ Parameters */ /* FILEN is the maximum length of a file name. */ /* $ Exceptions */ /* Additionally, invalid values of TYPE are detected. */ /* The short error message set in this case is: */ /* 'SPICE(INVALIDMSGTYPE)' */ /* The handling of this error is a special case; to avoid recursion */ /* problems, SIGERR is not called when the error is detected. */ /* Instead, the short and long error messages are output directly. */ /* $ Files */ /* None. */ /* $ Particulars */ /* This routine is part of the SPICELIB error handling mechanism. */ /* Note that even though a given type of message may have been */ /* selected for output, the output device and error response */ /* action must also have been selected appropriately. */ /* Use ERRDEV to choose the output device for error messages. */ /* Use ERRACT to choose the error response action. Any action */ /* other than 'IGNORE' will result in error messages being */ /* written to the error output device when errors are detected. */ /* See ERRACT for details. */ /* $ Examples */ /* 1. We want to know if the short message has been selected */ /* for output: */ /* C */ /* C Test whether the short message has been selected: */ /* C */ /* SELECT = MSGSEL ( 'SHORT' ) */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* $ Version */ /* - SPICELIB Version 3.0.5, 17-JUL-2002 (BVS) */ /* Added MAC-OSX environments. */ /* - SPICELIB Version 3.0.4, 08-OCT-1999 (WLT) */ /* The environment lines were expanded so that the supported */ /* environments are now explicitely given. New */ /* environments are WIN-NT */ /* - SPICELIB Version 3.0.2, 28-JUL-1999 (WLT) */ /* The environment lines were expanded so that the supported */ /* environments are now explicitly given. New */ /* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */ /* - SPICELIB Version 3.0.1, 18-MAR-1999 (WLT) */ /* The environment lines were expanded so that the supported */ /* environments are now explicitly given. Previously, */ /* environments such as SUN-SUNOS and SUN-SOLARIS were implied */ /* by the environment label SUN. */ /* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */ /* Comment section for permuted index source lines was added */ /* following the header. */ /* - SPICELIB Version 1.0.0, 31-JAN-1990 (NJB) */ /* -& */ /* $ Index_Entries */ /* None. */ /* -& */ /* $ Revisions */ /* - Beta Version 1.0.1, 08-FEB-1989 (NJB) */ /* Parameters section added; parameter declaration added */ /* to brief I/O section as well. */ /* -& */ /* Executable Code: */ ljust_(type__, ltype, type_len, (ftnlen)10); ucase_(ltype, ltype, (ftnlen)10, (ftnlen)10); if (s_cmp(ltype, "SHORT", (ftnlen)10, (ftnlen)5) == 0) { ret_val = svshrt; } else if (s_cmp(ltype, "EXPLAIN", (ftnlen)10, (ftnlen)7) == 0) { ret_val = svexpl; } else if (s_cmp(ltype, "LONG", (ftnlen)10, (ftnlen)4) == 0) { ret_val = svlong; } else if (s_cmp(ltype, "TRACEBACK", (ftnlen)10, (ftnlen)9) == 0) { ret_val = svtrac; } else if (s_cmp(ltype, "DEFAULT", (ftnlen)10, (ftnlen)7) == 0) { ret_val = svdflt; } else { /* Bad value of type! We have a special case here; to */ /* avoid recursion, we output the messages directly, */ /* rather than call SIGERR. */ getdev_(device, (ftnlen)128); wrline_(device, "SPICE(INVALIDMSGTYPE)", (ftnlen)128, (ftnlen)21); wrline_(device, " ", (ftnlen)128, (ftnlen)1); s_copy(loctyp, type__, (ftnlen)10, type_len); /* Note: What looks like a typo below isn't; there's */ /* a line break after the substring 'specified' of */ /* the "word" 'specifiedwas'. */ /* Writing concatenation */ i__1[0] = 86, a__1[0] = "MSGSEL: An invalid error message type was " "supplied as input; the type specifiedwas: "; i__1[1] = 10, a__1[1] = loctyp; s_cat(ch__1, a__1, i__1, &c__2, (ftnlen)96); wrline_(device, ch__1, (ftnlen)128, (ftnlen)96); } return ret_val; } /* prtpkg_ */
/* $Procedure ZZBODBLT ( Private --- Retrieve Built-In Body-Code Maps ) */ /* Subroutine */ int zzbodblt_0_(int n__, integer *room, char *names, char * nornam, integer *codes, integer *nvals, char *device, char *reqst, ftnlen names_len, ftnlen nornam_len, ftnlen device_len, ftnlen reqst_len) { /* Initialized data */ static logical first = TRUE_; /* System generated locals */ address a__1[2], a__2[3]; integer i__1, i__2, i__3[2], i__4[3]; /* Builtin functions */ integer s_rnge(char *, integer, char *, integer); /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen); /* Local variables */ integer i__; extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *, ftnlen, ftnlen), movec_(char *, integer *, char *, ftnlen, ftnlen), movei_(integer *, integer *, integer *); extern logical eqstr_(char *, char *, ftnlen, ftnlen); extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen); char zzint[36]; static integer bltcod[563]; static char bltnam[36*563]; extern /* Subroutine */ int orderc_(char *, integer *, integer *, ftnlen); extern integer lastnb_(char *, ftnlen); extern /* Subroutine */ int orderi_(integer *, integer *, integer *), sigerr_(char *, ftnlen), chkout_(char *, ftnlen); static char bltnor[36*563]; extern /* Subroutine */ int wrline_(char *, char *, ftnlen, ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, ftnlen), cmprss_(char *, integer *, char *, char *, ftnlen, ftnlen, ftnlen) ; integer zzocod[563]; char zzline[75]; integer zzonam[563]; extern logical return_(void); extern /* Subroutine */ int intstr_(integer *, char *, ftnlen); char zzrqst[4]; extern /* Subroutine */ int zzidmap_(integer *, char *, ftnlen); /* $ 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 is the umbrella routine that contains entry points to */ /* access the built-in body name-code 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 */ /* None. */ /* $ 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 */ /* 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.req */ /* $ Keywords */ /* Body mappings. */ /* $ Author_and_Institution */ /* E.D. Wright (JPL) */ /* $ Version */ /* SPICELIB 1.0.0 Thu May 20 07:57:58 2010 (EDW) */ /* A script generates this file. Do not edit by hand. */ /* Edit the creation script to modify the contents of */ /* ZZBODTRN.INC. */ /* Maximum size of a NAME string */ /* Count of default SPICE mapping assignments. */ /* $ Brief_I/O */ /* VARIABLE I/O DESCRIPTION */ /* -------- --- -------------------------------------------------- */ /* ROOM I ZZBODGET */ /* NAMES O ZZBODGET */ /* NORNAM O ZZBODGET */ /* CODES O ZZBODGET */ /* NVALS O ZZBODGET */ /* DEVICE I ZZBODLST */ /* REQST I ZZBODLST */ /* $ Detailed_Input */ /* See the entry points for a discussion of their arguments. */ /* $ Detailed_Output */ /* See the entry points for a discussion of their arguments. */ /* $ Parameters */ /* See the include file 'zzbodtrn.inc' for the list of parameters */ /* this routine utilizes. */ /* $ Exceptions */ /* 1) The error SPICE(BOGUSENTRY) is signaled if ZZBODBLT is */ /* called directly. */ /* $ Files */ /* None. */ /* $ Particulars */ /* ZZBODBLT should never be called directly, instead access */ /* the entry points: */ /* ZZBODGET Fetch the built-in body name/code list. */ /* ZZBODLST Output the name-ID mapping list. */ /* $ Examples */ /* See ZZBODTRN and its entry points for details. */ /* $ Restrictions */ /* 1) No duplicate entries should appear in the built-in */ /* BLTNAM list. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* F.S. Turner (JPL) */ /* B.V. Semenov (JPL) */ /* $ Version */ /* - SPICELIB Version 2.3.1, 27-FEB-2007 (EDW) */ /* Completed the ZZBODLST decalrations section. */ /* - SPICELIB Version 2.3.0, 17-MAR-2003 (EDW) */ /* Added a call to ZZIDMAP to retrieve the default */ /* mapping list. "zzbodtrn.inc" no longer */ /* contains the default mapping list. */ /* - SPICELIB Version 2.2.0 21-FEB-2003 (BVS) */ /* Changed MER-A and MER-B to MER-1 and MER-2. */ /* - SPICELIB Version 2.1.0 04-DEC-2002 (EDW) */ /* Added new assignments to the default collection: */ /* -226 ROSETTA */ /* 517 CALLIRRHOE */ /* 518 THEMISTO */ /* 519 MAGACLITE */ /* 520 TAYGETE */ /* 521 CHALDENE */ /* 522 HARPALYKE */ /* 523 KALYKE */ /* 524 IOCASTE */ /* 525 ERINOME */ /* 526 ISONOE */ /* 527 PRAXIDIKE */ /* - SPICELIB Version 2.0.0, 23-AUG-2002 (FST) */ /* Initial release. This begins at Version 2.0.0 because */ /* the entry point ZZBODLST was cut out of ZZBODTRN and */ /* placed here at Version 1.0.0. */ /* -& */ /* $ Revisions */ /* - SPICELIB Version 2.0.0, 23-AUG-2002 (FST) */ /* The entries following this one were copied from */ /* the version section of ZZBODTRN. SPICELIB has */ /* been changed to ZZBODTRN for convenience in noting */ /* version information relevant for that module. */ /* This was done to carry the history of body name-code */ /* additions with this new umbrella. */ /* Added to the collection: */ /* -236 MESSENGER */ /* - ZZBODTRN Version 3.2.0, 14-AUG-2002 (EDW) */ /* Added the ZZBODKIK entry point. */ /* Moved the NAIF_BODY_NAME/CODE to subroutine */ /* ZZBODKER. No change in logic. */ /* Added logic to enforce the precedence masking; */ /* logic removes duplicate assignments of ZZBODDEF. */ /* Removed the NAMENOTUNIQUE error block. */ /* - ZZBODTRN Version 3.1.5, 27-NOV-2001 (EDW) */ /* Added to the collection: */ /* -200 CONTOUR */ /* -146 LUNAR-A */ /* -135 DRTS-W */ /* Added the subroutine ZZBODLST as an entry point. */ /* The routine outputs the current name-ID mapping */ /* list to some output device. */ /* - ZZBODTRN Version 3.1.0, 17-OCT-2001 (EDW) */ /* To improve clarity, the BEGXX block initialization now */ /* exists in the include file zzbodtrn.inc. */ /* Removed the comments concerning the 851, 852, ... temporary */ /* codes. */ /* Set the WNAMES assignment to NAIF_BODY_CODE, NAIF_BODY_NAME */ /* as a DATA statement. */ /* Edited headers to match information in naif_ids required */ /* reading. */ /* Edited headers, removed typos and bad grammar, clarified */ /* descriptions. */ /* Added to the collection */ /* -41 MARS EXPRESS, MEX */ /* -44 BEAGLE 2, BEAGLE2 */ /* -70 DEEP IMPACT IMPACTOR SPACECRAFT */ /* -94 MO, MARS OBSERVER */ /* -140 DEEP IMPACT FLYBY SPACECRAFT */ /* -172 SLCOMB, STARLIGHT COMBINER */ /* -205 SLCOLL, STARLIGHT COLLECTOR */ /* -253 MER-A */ /* -254 MER-B */ /* Corrected typo, vehicle -188 should properly be MUSES-C, */ /* previous versions listed the name as MUSES-B. */ /* Removed from collection */ /* -84 MARS SURVEYOR 01 LANDER */ /* -154 EOS-PM1 */ /* -200 PLUTO EXPRESS 1, PEX1 */ /* -202 PLUTO EXPRESS 2, PEX2 */ /* - ZZBODTRN Version 3.0.0, 29-MAR-2000 (WLT) */ /* The ID codes for Cluster 1, 2, 3 and 4 were added. The */ /* ID coded for Pluto Express were removed. The ID codes */ /* for Pluto-Kuiper Express, Pluto-Kuiper Express Simulation */ /* and Contour were added. */ /* - ZZBODTRN Version 2.0.0, 26-JAN-1998 (EDW) */ /* The Galileo probe ID -228 replaces the incorrect ID -344. */ /* DSS stations 5 through 65 added to the collection. */ /* Added to the collection */ /* -107 TROPICAL RAINFALL MEASURING MISSION, TRMM */ /* -154, EOS-PM1 */ /* -142 EOS-AM1 */ /* -151 AXAF */ /* -1 GEOTAIL */ /* -13 POLAR */ /* -21 SOHO */ /* -8 WIND */ /* -25 LUNAR PROSPECTOR, LPM */ /* -116 MARS POLAR LANDER, MPL */ /* -127 MARS CLIMATE ORBITER, MCO */ /* -188 MUSES-C */ /* -97 TOPEX/POSEIDON */ /* -6 PIONEER-6, P6 */ /* -7 PIONEER-7, P7 */ /* -20 PIONEER-8, P8 */ /* -23 PIONEER-10, P10 */ /* -24 PIONEER-11, P11 */ /* -178 NOZOMI, PLANET-B */ /* -79 SPACE INFRARED TELESCOPE FACILITY, SIRTF */ /* -29 STARDUST, SDU */ /* -47 GENESIS */ /* -48 HUBBLE SPACE TELESCOPE, HST */ /* -200 PLUTO EXPRESS 1, PEX1 */ /* -202 PLUTO EXPRESS 2, PEX2 */ /* -164 YOHKOH, SOLAR-A */ /* -165 MAP */ /* -166 IMAGE */ /* -53 MARS SURVEYOR 01 ORBITER */ /* 618 PAN */ /* 716 CALIBAN */ /* 717 SYCORAX */ /* -30 DS-1 (low priority) */ /* -58 HALCA */ /* -150 HUYGEN PROBE, CASP */ /* -55 ULS */ /* Modified ZZBODC2N and ZZBODN2C so the user may load an */ /* external IDs kernel to override or supplement the standard */ /* collection. The kernel must be loaded prior a call to */ /* ZZBODC2N or ZZBODN2C. */ /* - ZZBODTRN Version 1.1.0, 22-MAY-1996 (WLT) */ /* Added the id-code for Comet Hyakutake, Comet Hale-Bopp, */ /* Mars 96, Cassini Simulation, MGS Simulation. */ /* - ZZBODTRN Version 1.0.0, 25-SEP-1995 (BVS) */ /* Renamed umbrella subroutine and entry points to */ /* correspond private routine convention (ZZ...). Added IDs for */ /* tracking stations Goldstone (399001), Canberra (399002), */ /* Madrid (399003), Usuda (399004). */ /* - ZZBODTRN Version 2.2.0, 01-AUG-1995 (HAN) */ /* Added the IDs for Near Earth Asteroid Rendezvous (-93), */ /* Mars Pathfinder (-53), Ulysses (-55), VSOP (-58), */ /* Radioastron (-59), Cassini spacecraft (-82), and Cassini */ /* Huygens probe (-150). */ /* Mars Observer (-94) was replaced with Mars Global */ /* Surveyor (-94). */ /* - ZZBODTRN Version 2.1.0, 15-MAR-1995 (KSZ) (HAN) */ /* Two Shoemaker Levy 9 fragments were added, Q1 and P2 */ /* (IDs 50000022 and 50000023). Two asteroids were added, */ /* Eros and Mathilde (IDs 2000433 and 2000253). The */ /* Saturnian satellite Pan (ID 618) was added. */ /* - ZZBODTRN Version 2.0.0, 03-FEB-1995 (NJB) */ /* The Galileo probe (ID -344) has been added to the permanent */ /* collection. */ /* - ZZBODTRN Version 1.0.0, 29-APR-1994 (MJS) */ /* SPICELIB symbol tables are no longer used. Instead, two order */ /* vectors are used to index the NAMES and CODES arrays. Also, */ /* this version does not support reading body name ID pairs from a */ /* file. */ /* - ZZBODTRN Version 2.0.1, 10-MAR-1992 (WLT) */ /* Comment section for permuted index source lines was added */ /* following the header. */ /* - ZZBODTRN Version 2.0.0, 15-JUL-1991 (WLT) */ /* The body id's for the Uranian satellites discovered by Voyager */ /* were modified to conform to those established by the IAU */ /* nomenclature committee. In addition the id's for Gaspra and */ /* Ida were added. */ /* - ZZBODTRN Version 1.0.0, 7-MAR-1991 (WLT) */ /* Some items previously considered errors were removed */ /* and some minor modifications were made to improve the */ /* robustness of the routines. */ /* - ZZBODTRN Version 1.0.0, 28-JUN-1990 (JEM) */ /* -& */ /* SPICELIB Functions */ /* Local Parameters */ /* Local Variables */ /* Saved Variables */ /* Data Statements */ /* Parameter adjustments */ if (names) { } if (nornam) { } if (codes) { } /* Function Body */ switch(n__) { case 1: goto L_zzbodget; case 2: goto L_zzbodlst; } /* Standard SPICE error handling. */ if (return_()) { return 0; } else { chkin_("ZZBODBLT", (ftnlen)8); sigerr_("SPICE(BOGUSENTRY)", (ftnlen)17); chkout_("ZZBODBLT", (ftnlen)8); } return 0; /* $Procedure ZZBODGET ( Private --- Body-Code Get Built-In List ) */ L_zzbodget: /* $ 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. */ /* Retrieve a copy of the built-in body name-code mapping lists. */ /* $ 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 */ /* PRIVATE */ /* BODY */ /* $ Declarations */ /* INTEGER ROOM */ /* CHARACTER*(*) NAMES ( * ) */ /* CHARACTER*(*) NORNAM ( * ) */ /* INTEGER CODES ( * ) */ /* INTEGER NVALS */ /* $ Brief_I/O */ /* VARIABLE I/O DESCRIPTION */ /* -------- --- -------------------------------------------------- */ /* ROOM I Space available in NAMES, NORNAM, and CODES. */ /* NAMES O Array of built-in body names. */ /* NORNAM O Array of normalized built-in body names. */ /* CODES O Array of built-in ID codes for NAMES/NORNAM. */ /* NVALS O Length of NAMES, NORNAM, CODES, and ORDNOM arrays. */ /* $ Detailed_Input */ /* ROOM is the maximum number of entries that NAMES, NORNAM, */ /* and CODES may receive. */ /* $ Detailed_Output */ /* NAMES the array of built-in names. This array is parallel */ /* to NORNAM and CODES. */ /* NORNAM the array of normalized built-in body names. This */ /* array is computed from the NAMES array by compressing */ /* groups of spaces into a single space, left-justifying */ /* the name, and uppercasing the letters. */ /* CODES the array of built-in codes associated with NAMES */ /* and NORNAM entries. */ /* NVALS the number of items returned in NAMES, NORNAM, */ /* and CODES. */ /* $ Parameters */ /* NPERM the number of permanent, or built-in, body name-code */ /* mappings. */ /* $ Exceptions */ /* 1) SPICE(BUG) is signaled if ROOM is less than NPERM, the */ /* amount of space required to store the entire list of */ /* body names and codes. */ /* $ Files */ /* None. */ /* $ Particulars */ /* This routine simply copies it's local buffered version of the */ /* built-in name-code mappings to the output arguments. */ /* $ Examples */ /* See ZZBODTRN for sample usage. */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* F.S. Turner (JPL) */ /* $ Version */ /* - SPICELIB Version 2.1.0, 17-MAR-2003 (EDW) */ /* Added a call to ZZIDMAP to retrieve the default */ /* mapping list. "zzbodtrn.inc" no longer */ /* contains the default mapping list. */ /* - SPICELIB Version 2.0.0, 23-AUG-2002 (FST) */ /* -& */ /* Standard SPICE error handling. */ if (return_()) { return 0; } else { chkin_("ZZBODGET", (ftnlen)8); } /* On the first invocation compute the normalized forms of BLTNAM */ /* and store them in BLTNOR. */ if (first) { /* Retrieve the default mapping list. */ zzidmap_(bltcod, bltnam, (ftnlen)36); for (i__ = 1; i__ <= 563; ++i__) { ljust_(bltnam + ((i__1 = i__ - 1) < 563 && 0 <= i__1 ? i__1 : s_rnge("bltnam", i__1, "zzbodblt_", (ftnlen)565)) * 36, bltnor + ((i__2 = i__ - 1) < 563 && 0 <= i__2 ? i__2 : s_rnge("bltnor", i__2, "zzbodblt_", (ftnlen)565)) * 36, ( ftnlen)36, (ftnlen)36); ucase_(bltnor + ((i__1 = i__ - 1) < 563 && 0 <= i__1 ? i__1 : s_rnge("bltnor", i__1, "zzbodblt_", (ftnlen)566)) * 36, bltnor + ((i__2 = i__ - 1) < 563 && 0 <= i__2 ? i__2 : s_rnge("bltnor", i__2, "zzbodblt_", (ftnlen)566)) * 36, ( ftnlen)36, (ftnlen)36); cmprss_(" ", &c__1, bltnor + ((i__1 = i__ - 1) < 563 && 0 <= i__1 ? i__1 : s_rnge("bltnor", i__1, "zzbodblt_", (ftnlen)567)) * 36, bltnor + ((i__2 = i__ - 1) < 563 && 0 <= i__2 ? i__2 : s_rnge("bltnor", i__2, "zzbodblt_", (ftnlen)567)) * 36, (ftnlen)1, (ftnlen)36, (ftnlen)36); } /* Do not do this again. */ first = FALSE_; } /* Copy the contents of BLTNAM, BLTNOR, and BLTCOD to the output */ /* arguments, but only if there is sufficient room. */ if (*room < 563) { setmsg_("Insufficient room to copy the stored body name-code mapping" "s to the output arguments. Space required is #, but the cal" "ler supplied #.", (ftnlen)134); errint_("#", &c__563, (ftnlen)1); errint_("#", room, (ftnlen)1); sigerr_("SPICE(BUG)", (ftnlen)10); chkout_("ZZBODGET", (ftnlen)8); return 0; } movec_(bltnam, &c__563, names, (ftnlen)36, names_len); movec_(bltnor, &c__563, nornam, (ftnlen)36, nornam_len); movei_(bltcod, &c__563, codes); *nvals = 563; chkout_("ZZBODGET", (ftnlen)8); return 0; /* $Procedure ZZBODLST ( Output permanent collection to some device. ) */ L_zzbodlst: /* $ Abstract */ /* Output the complete list of built-in body/ID mappings to */ /* some output devide. Thw routine generates 2 lists: one */ /* sorted by ID number, one sorted by name. */ /* $ 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 */ /* BODY */ /* $ Declarations */ /* CHARACTER*(*) DEVICE */ /* CHARACTER*(*) REQST */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* DEVICE I Device name to receive the output. */ /* REQST I Data list name to output. */ /* $ Detailed_Input */ /* DEVICE identifies the device to receive the */ /* body/ID mapping list. WRLINE performs the */ /* output function and so DEVICE may have */ /* the values 'SCREEN' (to generate a screen dump), */ /* 'NULL' (do nothing), or a device name (a */ /* file, or any other name valid in a FORTRAN OPEN */ /* statement). */ /* REQST A case insensitive string indicating the data */ /* set to output. REQST may have the value 'ID', */ /* 'NAME', or 'BOTH'. 'ID' outputs the name/ID mapping */ /* ordered by ID number from least to highest value. */ /* 'NAME' outputs the name/ID mapping ordered by ASCII */ /* sort on the name string. 'BOTH' outputs both */ /* ordered lists. */ /* $ Detailed_Output */ /* None. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* None. */ /* $ Files */ /* None. */ /* $ Particulars */ /* The entry point outputs ordered lists of the name/ID mappings */ /* defined in ZZBODTRN. */ /* $ Examples */ /* 1. Write both sorted lists to screen. */ /* PROGRAM X */ /* CALL ZZBODLST( 'SCREEN', 'BOTH' ) */ /* END */ /* 2. Write an ID number sorted list to a file, "body.txt". */ /* PROGRAM X */ /* CALL ZZBODLST( 'body.txt', 'ID' ) */ /* END */ /* With SCREEN output of the form: */ /* Total number of name/ID mappings: 414 */ /* ID to name mappings. */ /* -550 | M96 */ /* -550 | MARS 96 */ /* -550 | MARS-96 */ /* -550 | MARS96 */ /* -254 | MER-2 */ /* -253 | MER-1 */ /* .. .. */ /* 50000020 | SHOEMAKER-LEVY 9-B */ /* 50000021 | SHOEMAKER-LEVY 9-A */ /* 50000022 | SHOEMAKER-LEVY 9-Q1 */ /* 50000023 | SHOEMAKER-LEVY 9-P2 */ /* Name to ID mappings. */ /* 1978P1 | 901 */ /* 1979J1 | 515 */ /* .. .. */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* F.S. Turner (JPL) */ /* E.D. Wright (JPL) */ /* $ Version */ /* - SPICELIB Version 2.1.1, 27-FEB-2007 (EDW) */ /* Completed the ZZBODLST declarations section. */ /* - SPICELIB Version 2.1.0, 17-MAR-2003 (EDW) */ /* Added a call to ZZIDMAP to retrieve the default */ /* mapping list. "zzbodtrn.inc" no longer */ /* contains the default mapping list. */ /* - SPICELIB Version 2.0.0, 23-AUG-2002 (FST) */ /* This entry point was moved into ZZBODBLT and some */ /* variable names were changed to refer to variables */ /* in the umbrella. */ /* - SPICELIB Version 1.0.0, 26-NOV-2001 (EDW) */ /* -& */ if (return_()) { return 0; } else { chkin_("ZZBODLST", (ftnlen)8); } /* Upper case the ZZRQST value. */ ucase_(reqst, zzrqst, reqst_len, (ftnlen)4); intstr_(&c__563, zzint, (ftnlen)36); /* Writing concatenation */ i__3[0] = 34, a__1[0] = "Total number of name/ID mappings: "; i__3[1] = 36, a__1[1] = zzint; s_cat(zzline, a__1, i__3, &c__2, (ftnlen)75); wrline_(device, zzline, device_len, lastnb_(zzline, (ftnlen)75)); /* Retrieve the current set of name/ID mappings */ zzidmap_(bltcod, bltnam, (ftnlen)36); /* Branch as defined by the value of ZZRQST. 'ID' or 'BOTH'. */ if (eqstr_(zzrqst, "ID", (ftnlen)4, (ftnlen)2) || eqstr_(zzrqst, "BOTH", ( ftnlen)4, (ftnlen)4)) { orderi_(bltcod, &c__563, zzocod); wrline_(device, " ", device_len, (ftnlen)1); wrline_(device, "ID to name mappings.", device_len, (ftnlen)20); for (i__ = 1; i__ <= 563; ++i__) { intstr_(&bltcod[(i__2 = zzocod[(i__1 = i__ - 1) < 563 && 0 <= i__1 ? i__1 : s_rnge("zzocod", i__1, "zzbodblt_", (ftnlen) 812)] - 1) < 563 && 0 <= i__2 ? i__2 : s_rnge("bltcod", i__2, "zzbodblt_", (ftnlen)812)], zzint, (ftnlen)36); /* Writing concatenation */ i__4[0] = 36, a__2[0] = zzint; i__4[1] = 3, a__2[1] = " | "; i__4[2] = 36, a__2[2] = bltnam + ((i__2 = zzocod[(i__1 = i__ - 1) < 563 && 0 <= i__1 ? i__1 : s_rnge("zzocod", i__1, "zzbo" "dblt_", (ftnlen)814)] - 1) < 563 && 0 <= i__2 ? i__2 : s_rnge("bltnam", i__2, "zzbodblt_", (ftnlen)814)) * 36; s_cat(zzline, a__2, i__4, &c__3, (ftnlen)75); wrline_(device, zzline, device_len, lastnb_(zzline, (ftnlen)75)); } } /* ... 'NAME' or 'BOTH'. */ if (eqstr_(zzrqst, "NAME", (ftnlen)4, (ftnlen)4) || eqstr_(zzrqst, "BOTH", (ftnlen)4, (ftnlen)4)) { orderc_(bltnam, &c__563, zzonam, (ftnlen)36); wrline_(device, " ", device_len, (ftnlen)1); wrline_(device, "Name to ID mappings.", device_len, (ftnlen)20); for (i__ = 1; i__ <= 563; ++i__) { intstr_(&bltcod[(i__2 = zzonam[(i__1 = i__ - 1) < 563 && 0 <= i__1 ? i__1 : s_rnge("zzonam", i__1, "zzbodblt_", (ftnlen) 834)] - 1) < 563 && 0 <= i__2 ? i__2 : s_rnge("bltcod", i__2, "zzbodblt_", (ftnlen)834)], zzint, (ftnlen)36); /* Writing concatenation */ i__4[0] = 36, a__2[0] = bltnam + ((i__2 = zzonam[(i__1 = i__ - 1) < 563 && 0 <= i__1 ? i__1 : s_rnge("zzonam", i__1, "zzbo" "dblt_", (ftnlen)836)] - 1) < 563 && 0 <= i__2 ? i__2 : s_rnge("bltnam", i__2, "zzbodblt_", (ftnlen)836)) * 36; i__4[1] = 3, a__2[1] = " | "; i__4[2] = 36, a__2[2] = zzint; s_cat(zzline, a__2, i__4, &c__3, (ftnlen)75); wrline_(device, zzline, device_len, lastnb_(zzline, (ftnlen)75)); } } chkout_("ZZBODLST", (ftnlen)8); return 0; } /* zzbodblt_ */