/* $Procedure SPCA2B ( SPK and CK, ASCII to binary ) */
/* Subroutine */ int spca2b_(char *text, char *binary, ftnlen text_len,
ftnlen binary_len)
{
/* System generated locals */
cllist cl__1;
/* Builtin functions */
integer f_clos(cllist *);
/* Local variables */
integer unit;
extern /* Subroutine */ int chkin_(char *, ftnlen), spct2b_(integer *,
char *, ftnlen), chkout_(char *, ftnlen);
extern logical return_(void);
extern /* Subroutine */ int txtopr_(char *, integer *, ftnlen);
/* $ Abstract */
/* Convert a text (ASCII) format SPK or CK file to an equivalent */
/* binary file, including comments. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* SPC */
/* $ Keywords */
/* FILES */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* TEXT I Name of an existing text format SPK or CK file. */
/* BINARY I Name of a binary SPK or CK file to be created. */
/* $ Detailed_Input */
/* TEXT is the name of an existing text format SPK or CK */
/* file that may contain comments in the appropriate */
/* SPC format, as written by SPCB2A or SPCB2T. This */
/* file is unchanged by calling SPCA2B. */
/* BINARY is the name of a binary SPK or CK file to be created. */
/* The binary file contains the same data and comments */
/* as the text file, but in the binary format required */
/* for use with the SPICELIB reader subroutines. */
/* $ Detailed_Output */
/* None. */
/* $ Parameters */
/* None. */
/* $ Files */
/* See arguments TEXT and BINARY above. */
/* $ Exceptions */
/* 1) If there is an IOSTAT error while opening, reading, */
/* or writing a file, a routine that SPCA2B calls will */
/* diagnose and signal an error. */
/* 2) If the text file is not in the correct format, a */
/* routine that SPCA2B calls will diagnose and signal */
/* an error. */
/* $ Particulars */
/* The SPICELIB SPK and CK reader subroutines read binary files. */
/* However, because different computing environments have different */
/* binary representations of numbers, you must convert SPK and CK */
/* files to text format when porting from one system to another. */
/* After converting the file to text, you can transfer it using */
/* a transfer protocol program like Kermit or FTP. Then, convert */
/* the text file back to binary format. */
/* The following is a list of the SPICELIB routines that convert */
/* SPK and CK files between binary and text format: */
/* SPCA2B converts text to binary. It opens the text file, */
/* creates a new binary file, and closes both files. */
/* SPCB2A converts binary to text. It opens the binary file, */
/* creates a new text file, and closes both files. */
/* SPCT2B converts text to binary. It creates a new binary */
/* file and closes it. The text file is open on */
/* entrance and exit. */
/* SPCB2T converts binary to text. It opens the binary */
/* file and closes it. The text file is open on */
/* entrance and exit */
/* See the SPC required reading for more information */
/* about SPC routines and the SPK and CK file formats. */
/* $ Examples */
/* This is an example of how to use SPCB2A and SPCA2B for */
/* transferring files. Suppose A.BSP is a binary SPK file in */
/* environment 1; to transfer it to environment 2, follow */
/* these three steps: */
/* 1) Call SPCB2A within a program in environment 1 to convert */
/* the file to text: */
/* CALL SPCB2A ( 'A.BSP', 'A.TSP' ) */
/* 2) Transfer the text file from environment 1 to environment 2 */
/* using FTP, Kermit, or some other file transfer utility, */
/* for example, */
/* ftp> put A.TSP */
/* 3) Call SPCA2B within a program in environment 2 to convert */
/* the file to binary on the new machine, */
/* CALL SPCA2B ( 'A.TSP', 'A.BSP' ) */
/* $ Restrictions */
/* 1) This routine assumes that the data and comments in the */
/* text format SPK or CK file come from a binary file */
/* and were written by one of the routines SPCB2A or SPCB2T. */
/* Data and/or comments written any other way may not be */
/* in the correct format and, therefore, may not be handled */
/* properly. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* J.E. McLean (JPL) */
/* H.A. Neilan (JPL) */
/* $ Version */
/* - SPICELIB Version 1.1.1, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.1.0, 05-SEP-1991 (HAN) */
/* Removed declarations of unused variables. */
/* - SPICELIB Version 1.0.0, 05-APR-1991 (JEM) */
/* -& */
/* $ Index_Entries */
/* ascii spk or ck to binary */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("SPCA2B", (ftnlen)6);
}
/* Open the text file with read access. SPCT2B will */
/* create the binary file and write the data and comments */
/* to it. Then we close the text file, and we're done. */
txtopr_(text, &unit, text_len);
spct2b_(&unit, binary, binary_len);
cl__1.cerr = 0;
cl__1.cunit = unit;
cl__1.csta = 0;
f_clos(&cl__1);
chkout_("SPCA2B", (ftnlen)6);
return 0;
} /* spca2b_ */
/* Subroutine */ int prcomf_0_(int n__, char *file, char *delim, char *
command, char *error, char *level, ftnlen file_len, ftnlen delim_len,
ftnlen command_len, ftnlen error_len, ftnlen level_len)
{
/* Initialized data */
static integer nest = 0;
/* System generated locals */
integer i__1;
cilist ci__1;
cllist cl__1;
/* Builtin functions */
integer s_rnge(char *, integer, char *, integer), f_clos(cllist *);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
integer s_rsfe(cilist *), do_fio(integer *, char *, ftnlen), e_rsfe(void),
i_indx(char *, char *, ftnlen, ftnlen);
/* Local variables */
extern logical have_(char *, ftnlen);
static integer i__, j;
static char files[80*8];
static integer units[8];
extern /* Subroutine */ int lbuild_(char *, integer *, char *, char *,
ftnlen, ftnlen, ftnlen);
extern integer lastnb_(char *, ftnlen);
static integer iostat;
extern /* Subroutine */ int rstbuf_(void), putbuf_(char *, ftnlen),
txtopr_(char *, integer *, ftnlen);
/* $ Abstract */
/* Keep track of nested command files. */
/* $ 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. */
/* $ Keywords */
/* PARSE */
/* $ Declarations */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- --------------------------------------------------- */
/* FILE I Command file. */
/* DELIM I Symbol delimiting the end of a command. */
/* COMMAND O Command read from FILE. */
/* ERROR O Error flag. */
/* LEVEL O A list of all files currently open. */
/* $ Detailed_Input */
/* FILE is the name of a file from which a sequence of commands */
/* is to be read. These commands may include commands to */
/* read from other files. */
/* DELIM is the character which delimits the end of each */
/* instruction in FILE. */
/* $ Detailed_Output */
/* COMMAND is a command read from the current file. */
/* If no files are currently open, COMMAND = DELIM. */
/* ERROR is a descriptive error message, which is blank when */
/* no error occurs. */
/* LEVEL is a list of the files currently open, in the order */
/* in which they were opened. It is provided for trace- */
/* back purposes. */
/* $ Detailed_Description */
/* PRCOMF opens, reads, and closes sets of (possibly nested) */
/* command files. For example, consider the following command */
/* files. */
/* FILE_A : A1 FILE_B : B1 FILE_C : C1 */
/* A2 START FILE_C C2 */
/* A3 B2 C3 */
/* START FILE_B B3 */
/* A4 B4 */
/* A5 */
/* If the command 'START FILE_A' were issued, we would expect the */
/* following sequence of commands to ensue: */
/* A1, A2, A3, B1, C1, C2, C3, B2, B3, B4, A4, A5. */
/* The first file immediately becomes, ipso facto, the current file. */
/* Subsequently, instructions are read from the current file until */
/* either a START or the end of the file is encountered. Each time */
/* a new START is encountered, the current file (that is, the */
/* location of the next command in the file) is placed on a stack, */
/* and the first command is read from the new file (which then */
/* becomes the current file). Each time the end of the current file */
/* is encountered, the previous file is popped off the top of the */
/* stack to become the current file. This continues until there are */
/* no files remaining on the stack. */
/* On occasion, the user may wish to exit from a file without */
/* reading the rest of the file. In this case, the previous file */
/* is popped off the stack without further ado. */
/* Also, the user may wish to abruptly stop an entire nested */
/* set of files. In this case, all of the files are popped off */
/* the stack, and no further commands are returned. */
/* PRCOMF and its entry points may be used to process any such */
/* set of files. These entry points are: */
/* - PRCLR ( ERROR ) */
/* This clears the stack. It may thus be used to implement */
/* a STOP command. In any case, it must be called before */
/* any of the other entry points are called. */
/* - PRSTRT ( FILE, ERROR ) */
/* This introduces a new file, causing the current file (if */
/* any) to be placed on the stack, and replacing it with FILE. */
/* It may thus be used to implement a START command. */
/* If the file cannot be opened, or the stack is already */
/* full (it can hold up to seven files), ERROR will contain */
/* a descriptive error message upon return. Otherwise, it */
/* will be blank. */
/* - PRREAD ( COMMAND ) */
/* This causes the next command to be read from the current */
/* file. If the end of the current file is reached, the */
/* previous file is popped off the stack, and the next command */
/* from this file is read instead. (If no files remain to be */
/* read, DELIM is returned.) */
/* - PREXIT */
/* This causes the previous file to be popped off the top of */
/* the stack to replace the current file. It may thus be used */
/* to implement an EXIT command. */
/* - PRTRCE ( LEVEL ) */
/* Should an error occur during the execution of a nested */
/* file, it may be helpful to know the sequence in which */
/* the nested files were invoked. PRTRCE returns a list of */
/* the files currently open, in the order in which they were */
/* invoked. */
/* $ Input_Files */
/* All files read by PRCOMF are opened with logical units */
/* determined at run time. */
/* $ Output_Files */
/* None. */
/* $ Input_Common */
/* None. */
/* $ Output_Common */
/* None. */
/* $ Examples */
/* See Detailed_Description. */
/* $ Restrictions */
/* The declared length of ERROR should be at least 80, to avoid */
/* truncationof error messages. */
/* $ Author_and_Institution */
/* W. L. Taber (JPL) */
/* I. M. Underwood (JPL) */
/* $ Version */
/* - Command Loop Configured Version 1.0.0, 3-MAY-1994 (WLT) */
/* This is the configured version of the Command Loop */
/* software as of May 4, 1994 */
/* Version 1, 6-SEP-1986 */
/* -& */
/* OPTLIB functions */
/* Local variables */
/* NFILES is the maximum number of files that may be open at */
/* any given time. THus, nesting of procedures is limited to */
/* a depth of NFILES. */
/* NEST is the number of files currently open. */
/* FILES are the names of the files on the stack. UNITS are */
/* the logical units to which they are connected. */
switch(n__) {
case 1: goto L_prclr;
case 2: goto L_prstrt;
case 3: goto L_prread;
case 4: goto L_prexit;
case 5: goto L_prtrce;
}
return 0;
/* $ Procedure PRCLR */
L_prclr:
/* $ Abstract */
/* Clear the file stack. */
/* $ 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. */
/* $ Brief_I/O */
/* None. */
/* $ Detailed_Input */
/* None. */
/* $ Detailed_Output */
/* None. */
/* $ Input_Files */
/* None. */
/* $ Output_Files */
/* None. */
/* $ Input_Output_Common */
/* None. */
/* $ Detailed_Description */
/* Pop all the files off the stack. */
/* $ Examples */
/* None. */
/* $ Restrictions */
/* None. */
/* $ Version */
/* - Command Loop Configured Version 1.0.0, 3-MAY-1994 (WLT) */
/* This is the configured version of the Command Loop */
/* software as of May 4, 1994 */
/* - */
while(nest > 0) {
cl__1.cerr = 0;
cl__1.cunit = units[(i__1 = nest - 1) < 8 && 0 <= i__1 ? i__1 :
s_rnge("units", i__1, "prcomf_", (ftnlen)326)];
cl__1.csta = 0;
f_clos(&cl__1);
--nest;
}
return 0;
/* $ Procedure PRSTRT */
L_prstrt:
/* $ Abstract */
/* Put the current file on the stack, and replace it with FILE. */
/* $ 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. */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- --------------------------------------------------- */
/* FILE I New command file. */
/* ERROR O Error flag. */
/* $ Detailed_Input */
/* FILE is the new current file from which commands are */
/* to be read. */
/* $ Detailed_Output */
/* ERROR is blank when no error occurs, and otherwise contains */
/* a descriptive message. Possible errors are: */
/* - The stack is full. */
/* - FILE could not be opened. */
/* $ Input_Files */
/* FILE is opened with a logical unit determined at run time. */
/* $ Output_Files */
/* None. */
/* $ Input_Output_Common */
/* None. */
/* $ Detailed_Description */
/* If the stack is full, return an error. Otherwise, try to open */
/* FILE. If an error occurs, return immediately. Otherwise, put */
/* the current file on the stack, and increase the nesting level. */
/* $ Examples */
/* None. */
/* $ Restrictions */
/* None. */
/* $ Version */
/* - Command Loop Configured Version 1.0.0, 3-MAY-1994 (WLT) */
/* This is the configured version of the Command Loop */
/* software as of May 4, 1994 */
/* - */
/* No error yet. */
s_copy(error, " ", error_len, (ftnlen)1);
/* Proceed only if the stack is not full. */
if (nest == 8) {
s_copy(error, "PRSTRT: Command files are nested too deeply.",
error_len, (ftnlen)44);
return 0;
} else {
++nest;
}
/* Get a new logical unit. If none are available, abort. */
txtopr_(file, &units[(i__1 = nest - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge(
"units", i__1, "prcomf_", (ftnlen)445)], file_len);
if (have_(error, error_len)) {
--nest;
} else {
s_copy(files + ((i__1 = nest - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge(
"files", i__1, "prcomf_", (ftnlen)450)) * 80, file, (ftnlen)
80, file_len);
}
return 0;
/* $ Procedure PRREAD */
L_prread:
/* $ Abstract */
/* Read the next command from the current file. */
/* $ 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. */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- --------------------------------------------------- */
/* DELIM I Character delimiting the end of a command. */
/* COMMAND O Next command from the current file. */
/* $ Detailed_Input */
/* DELIM is the character used to delimit the end of a */
/* command within a command file. */
/* $ Detailed_Output */
/* COMMAND is the next command read from the current file. */
/* If there is no current file, COMMND = DELIM. */
/* $ Input_Files */
/* All files read by PRCOMF are opened with logical units */
/* determined at run time. */
/* $ Output_Files */
/* None. */
/* $ Input_Output_Common */
/* None. */
/* $ Detailed_Description */
/* Attempt to read the next statement from the current file. */
/* If the end of the file is encountered, pop the previous file */
/* off the top of the stack, and try to read from it. Keep this */
/* up until a command is read, or until no files remain open. */
/* $ Examples */
/* None. */
/* $ Restrictions */
/* None. */
/* $ Version */
/* - Command Loop Configured Version 1.0.0, 3-MAY-1994 (WLT) */
/* This is the configured version of the Command Loop */
/* software as of May 4, 1994 */
/* - */
/* Don't even bother unless at least one file is open. */
if (nest == 0) {
s_copy(command, delim, command_len, (ftnlen)1);
return 0;
}
/* Keep trying to read until we run out of files. */
ci__1.cierr = 1;
ci__1.ciend = 1;
ci__1.ciunit = units[(i__1 = nest - 1) < 8 && 0 <= i__1 ? i__1 : s_rnge(
"units", i__1, "prcomf_", (ftnlen)558)];
ci__1.cifmt = "(A)";
iostat = s_rsfe(&ci__1);
if (iostat != 0) {
goto L100001;
}
iostat = do_fio(&c__1, command, command_len);
if (iostat != 0) {
goto L100001;
}
iostat = e_rsfe();
L100001:
while(iostat != 0 && nest > 0) {
cl__1.cerr = 0;
cl__1.cunit = units[(i__1 = nest - 1) < 8 && 0 <= i__1 ? i__1 :
s_rnge("units", i__1, "prcomf_", (ftnlen)562)];
cl__1.csta = 0;
f_clos(&cl__1);
--nest;
if (nest >= 1) {
ci__1.cierr = 1;
ci__1.ciend = 1;
ci__1.ciunit = units[(i__1 = nest - 1) < 8 && 0 <= i__1 ? i__1 :
s_rnge("units", i__1, "prcomf_", (ftnlen)566)];
ci__1.cifmt = "(A)";
iostat = s_rsfe(&ci__1);
if (iostat != 0) {
goto L100002;
}
iostat = do_fio(&c__1, command, command_len);
if (iostat != 0) {
goto L100002;
}
iostat = e_rsfe();
L100002:
;
}
}
rstbuf_();
if (nest == 0) {
s_copy(command, delim, command_len, (ftnlen)1);
putbuf_(command, command_len);
return 0;
}
putbuf_(command, command_len);
/* Okay, we have something. Keep reading until DELIM is found. */
/* (Or until the file ends.) Add each successive line read to */
/* the end of COMMAND. Do not return the delimiter itself. */
j = 1;
i__ = i_indx(command, delim, command_len, (ftnlen)1);
while(i__ == 0 && iostat == 0) {
j = lastnb_(command, command_len) + 1;
*(unsigned char *)&command[j - 1] = ' ';
++j;
ci__1.cierr = 1;
ci__1.ciend = 1;
ci__1.ciunit = units[(i__1 = nest - 1) < 8 && 0 <= i__1 ? i__1 :
s_rnge("units", i__1, "prcomf_", (ftnlen)597)];
ci__1.cifmt = "(A)";
iostat = s_rsfe(&ci__1);
if (iostat != 0) {
goto L100003;
}
iostat = do_fio(&c__1, command + (j - 1), command_len - (j - 1));
if (iostat != 0) {
goto L100003;
}
iostat = e_rsfe();
L100003:
putbuf_(command + (j - 1), command_len - (j - 1));
i__ = i_indx(command, delim, command_len, (ftnlen)1);
}
if (i__ > 0) {
s_copy(command + (i__ - 1), " ", command_len - (i__ - 1), (ftnlen)1);
}
return 0;
/* $ Procedure PREXIT */
L_prexit:
/* $ Abstract */
/* Replace the current file with the one at the top of the stack. */
/* $ 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. */
/* $ Brief_I/O */
/* None. */
/* $ Detailed_Input */
/* None. */
/* $ Detailed_Output */
/* None. */
/* $ Input_Files */
/* None. */
/* $ Output_Files */
/* None. */
/* $ Input_Output_Common */
/* None. */
/* $ Detailed_Description */
/* Close the current file. Pop the previous file off the top of */
/* the stack. If there is no current file, of if there are no */
/* files on the stack, that's cool too. */
/* $ Examples */
/* None. */
/* $ Restrictions */
/* None. */
/* $ Version */
/* - Command Loop Configured Version 1.0.0, 3-MAY-1994 (WLT) */
/* This is the configured version of the Command Loop */
/* software as of May 4, 1994 */
/* - */
if (nest > 0) {
cl__1.cerr = 0;
cl__1.cunit = units[(i__1 = nest - 1) < 8 && 0 <= i__1 ? i__1 :
s_rnge("units", i__1, "prcomf_", (ftnlen)695)];
cl__1.csta = 0;
f_clos(&cl__1);
--nest;
}
return 0;
/* $ Procedure PRTRCE */
L_prtrce:
/* $ Abstract */
/* Provide a list of the files currently open, in the order in */
/* which they were opened. */
/* $ 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. */
/* $ Brief_I/O */
/* VARIABLE I/O DESCRIPTION */
/* -------- --- --------------------------------------------------- */
/* LEVEL O List of all files currently open. */
/* $ Detailed_Input */
/* None. */
/* $ Detailed_Output */
/* LEVEL A list of all files that are currently open, in */
/* the order in which they were opened. For example, */
/* if FILE_A starts FILE_B, and FILE_B starts FILE_C, */
/* LEVEL would be 'FILE_A:FILE_B:_FILE_C'. */
/* $ Input_Files */
/* None. */
/* $ Output_Files */
/* None. */
/* $ Input_Output_Common */
/* None. */
/* $ Detailed_Description */
/* Just step through the stack, Jack. */
/* $ Examples */
/* See Detailed_Description. */
/* $ Restrictions */
/* LEVEL should be declared to be at least CHARACTER*640 by the */
/* calling program to ensure that enough space is available to */
/* list all open files. */
/* $ Version */
/* - Command Loop Configured Version 1.0.0, 3-MAY-1994 (WLT) */
/* This is the configured version of the Command Loop */
/* software as of May 4, 1994 */
/* - */
/* Not much to explain. Use LBUILD to build a list, delimited */
/* by colons. */
s_copy(level, " ", level_len, (ftnlen)1);
if (nest > 0) {
lbuild_(files, &nest, ":", level, (ftnlen)80, (ftnlen)1, level_len);
}
return 0;
} /* prcomf_ */
/* $Procedure DAFA2B ( DAF, ASCII to binary ) */
/* Subroutine */ int dafa2b_(char *ascii, char *binary, integer *resv, ftnlen
ascii_len, ftnlen binary_len)
{
/* System generated locals */
cllist cl__1;
/* Builtin functions */
integer f_clos(cllist *);
/* Local variables */
integer unit;
extern /* Subroutine */ int chkin_(char *, ftnlen), daft2b_(integer *,
char *, integer *, ftnlen);
extern logical failed_(void);
extern /* Subroutine */ int chkout_(char *, ftnlen);
extern logical return_(void);
extern /* Subroutine */ int txtopr_(char *, integer *, ftnlen);
/* $ Abstract */
/* Convert an ASCII (text) DAF to an equivalent binary DAF. */
/* (Obsolete, maintained for backward compatibility only.) */
/* $ 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 */
/* DAF */
/* $ Keywords */
/* FILES */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* ASCII I Name of an existing ASCII (text) DAF. */
/* BINARY I Name of a binary DAF to be created. */
/* RESV I Number of records to reserve. */
/* $ Detailed_Input */
/* ASCII is the name of an existing ASCII (text) DAF. */
/* BINARY is the name of the binary DAF to be created. */
/* The binary DAF contains the same data as the */
/* ASCII DAF, but in a form more suitable for use */
/* by application programs. */
/* RESV is the number of records to be reserved in the */
/* binary DAF. */
/* $ Detailed_Output */
/* None. */
/* $ Parameters */
/* None. */
/* $ Files */
/* See arguments ASCII, BINARY. */
/* $ Exceptions */
/* None. */
/* Errors are detected and signalled by routines called by this */
/* routine. */
/* $ Particulars */
/* This routine has been made obsolete by the new DAF text to binary */
/* conversion routine DAFTB. This routine remains available for */
/* reasons of backward compatibility. We strongly recommend that the */
/* conversion routine DAFTB be used for any new software development. */
/* Please see the header of the routine DAFTB for details. */
/* This routine is used for converting older DAF text files, which */
/* use a decimal format for numbers, into their equivalent binary */
/* formats. Note that the routine DAFTB makes use of a text file */
/* format that is incompatible with the text file format expected by */
/* the routines called by this routine. */
/* Note that you must select the number of records to be reserved */
/* in the binary DAF. The contents of reserved records are ignored */
/* by the normal transfer process. */
/* $ Examples */
/* DAFB2A and DAFA2B are typically used to transfer files. */
/* If file A.DAF is a binary DAF in environment 1, it */
/* can be transferred to environment 2 in three steps. */
/* 1) Convert it to ASCII, */
/* CALL DAFB2A ( 'A.DAF', 'A.ASCII' ) */
/* 2) Transfer the ASCII file, using FTP, Kermit, or some other */
/* file transfer utility, */
/* ftp> put a.ascii */
/* 3) Convert it to binary on the new machine, */
/* CALL DAFA2B ( 'A.ASCII', 'A.DAF', RESV ) */
/* Note that DAFB2A and DAFA2B work in any standard Fortran-77 */
/* environment. */
/* $ Restrictions */
/* DAFA2B cannot be executed while any other DAF is open */
/* for writing. */
/* $ Literature_References */
/* NAIF Document 167.0, "Double Precision Array Files (DAF) */
/* Specification and User's Guide" */
/* $ Author_and_Institution */
/* K.R. Gehringer (JPL) */
/* I.M. Underwood (JPL) */
/* $ Version */
/* - SPICELIB Version 2.0.0, 30-SEP-1993 (KRG) */
/* This routine was completely rewritten to make use of the */
/* routines DAFT2B and TXTOPR, for converting a text file to */
/* binary and opening a text file. It now simply calls the */
/* routine DAFT2B after opening the text file. */
/* Added a statement to the $ Particulars section to the effect */
/* that this routine has been made obsolete by the introduction of */
/* the routine DAFTB, and that the use of the new routine is */
/* strongly recommended for new software development. */
/* Modified the $ Abstract section to reflect the fact that this */
/* routine is obsolete. */
/* - SPICELIB Version 1.0.2, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */
/* Literature references added to the header. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */
/* -& */
/* $ Index_Entries */
/* ascii daf to binary */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 2.0.0, 30-SEP-1993 (KRG) */
/* This routine was completely rewritten to make use of the */
/* routines DAFT2B and TXTOPR, for converting a text file to */
/* binary and opening a text file. It now simply calls the */
/* routine DAFT2B after opening the text file. */
/* Added a statement to the $ Particulars section to the effect */
/* that this routine has been made obsolete by the introduction of */
/* the routine DAFTB, and that the use of the new routine is */
/* strongly recommended for new software development. */
/* Modified the $ Abstract section to reflect the fact that this */
/* routine is obsolete. */
/* - SPICELIB Version 1.0.2, 10-MAR-1992 (WLT) */
/* Comment section for permuted index source lines was added */
/* following the header. */
/* - SPICELIB Version 1.0.1, 22-MAR-1990 (HAN) */
/* Literature references added to the header. */
/* - SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) */
/* -& */
/* SPICELIB functions */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("DAFA2B", (ftnlen)6);
}
/* Open the ASCII file for reading. If an error occurs, then check */
/* out and return. An appropriate error message will have already */
/* been set. */
txtopr_(ascii, &unit, ascii_len);
if (failed_()) {
chkout_("DAFA2B", (ftnlen)6);
return 0;
}
/* Call DAFT2B to perform the conversion. If it fails, then just */
/* check out and return, as an appropriate error message should have */
/* already been set. Also close the text file that we opened. */
daft2b_(&unit, binary, resv, binary_len);
if (failed_()) {
cl__1.cerr = 0;
cl__1.cunit = unit;
cl__1.csta = 0;
f_clos(&cl__1);
chkout_("DAFA2B", (ftnlen)6);
return 0;
}
/* Close the file. */
cl__1.cerr = 0;
cl__1.cunit = unit;
cl__1.csta = 0;
f_clos(&cl__1);
chkout_("DAFA2B", (ftnlen)6);
return 0;
} /* dafa2b_ */
/* $Procedure RDCMD (Read command file) */
/* Subroutine */ int rdcmd_(char *cmdfil, char *cmdsym, integer *cmdptr, char
*cmdval, ftnlen cmdfil_len, ftnlen cmdsym_len, ftnlen cmdval_len)
{
/* Initialized data */
static char kwds1[32*2] = "LEAPSECONDS_KERNEL 1 1 " "SPK_KERNEL"
" 1 1000 ";
static char kwds2[32*5] = "SOURCE_SPK_KERNEL 1 1000 " "LOG_FILE "
" 0 1 " "BODIES 0 1 " "BEGI"
"N_TIME 0 1000 " "INCLUDE_TEXT_FILE 0 1000 ";
static char kwds3[32*3] = "BODIES 0 1 " "BEGIN_TIME"
" 0 1000 " "INCLUDE_COMMENTS 0 1 ";
static char kwds4[32*1] = "END_TIME 1 1 ";
/* System generated locals */
cilist ci__1;
/* Builtin functions */
integer s_rsfe(cilist *), do_fio(integer *, char *, ftnlen), e_rsfe(void);
/* Local variables */
static char line[350];
static integer unit;
extern /* Subroutine */ int chkin_(char *, ftnlen), cperr_(char *,
integer *, ftnlen), repmi_(char *, char *, integer *, char *,
ftnlen, ftnlen, ftnlen);
static char tabval[32*26];
extern /* Subroutine */ int evalcp_(char *, logical *, char *, integer *,
char *, logical *, ftnlen, ftnlen, ftnlen), initcp_(char *,
integer *, char *, char *, ftnlen, ftnlen, ftnlen);
static char reason[160];
extern /* Subroutine */ int sigerr_(char *, ftnlen);
static integer tabptr[26];
extern /* Subroutine */ int prefix_(char *, integer *, char *, ftnlen,
ftnlen);
static char tabsym[32*26];
extern /* Subroutine */ int ssizec_(integer *, char *, ftnlen), chkout_(
char *, ftnlen);
static integer linnum, iostat;
extern /* Subroutine */ int setmsg_(char *, ftnlen), ssizei_(integer *,
integer *);
extern logical return_(void);
extern /* Subroutine */ int syputc_(char *, char *, integer *, char *,
integer *, char *, ftnlen, ftnlen, ftnlen, ftnlen), txtopr_(char *
, integer *, ftnlen);
static logical eof, err;
/* $ Abstract */
/* Parse the command file. */
/* $ 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 */
/* None. */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* CMDFIL I Name of command file. */
/* CMDSYM, */
/* CMDPTR, */
/* CMDVAL O Command symbol table. */
/* $ Detailed_Input */
/* CMDFIL is the name of the command file. */
/* $ Detailed_Output */
/* CMDSYM, */
/* CMDPTR, */
/* CMDVAL is the command symbol table. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) An error is signaled if the file cannot be parsed */
/* successfully. */
/* $ Files */
/* None. */
/* $ Particulars */
/* None. */
/* $ Examples */
/* None. */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* M.J. Spencer (JPL) */
/* $ Version */
/* - Beta Version 1.1.0, 17-JAN-2014 (BVS) */
/* Increased LINLEN from 120 to 350 (350 = 300 characters for */
/* value consistent with VALLEN in CPARSE_2 and the main program */
/* + 50 more characters for the keyword name, =, and blanks.) */
/* Increased maximum counts of child values in KWDS* from 300 to */
/* 1000 for all values. */
/* Saved all variables. */
/* - Beta Version 1.0.0, 26-JAN-1994 (MJS) */
/* -& */
/* SPICELIB functions */
/* Other functions */
/* Local parameters */
/* Local variables */
/* Save all. */
/* Initial values */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("RDCMD", (ftnlen)5);
}
/* Initialize the parser. */
ssizec_(&c__20, tabsym, (ftnlen)32);
ssizei_(&c__20, tabptr);
ssizec_(&c__20, tabval, (ftnlen)32);
syputc_("HEAD", kwds1, &c__2, tabsym, tabptr, tabval, (ftnlen)4, (ftnlen)
32, (ftnlen)32, (ftnlen)32);
syputc_("SPK_KERNEL", kwds2, &c__5, tabsym, tabptr, tabval, (ftnlen)10, (
ftnlen)32, (ftnlen)32, (ftnlen)32);
syputc_("SOURCE_SPK_KERNEL", kwds3, &c__3, tabsym, tabptr, tabval, (
ftnlen)17, (ftnlen)32, (ftnlen)32, (ftnlen)32);
syputc_("BEGIN_TIME", kwds4, &c__1, tabsym, tabptr, tabval, (ftnlen)10, (
ftnlen)32, (ftnlen)32, (ftnlen)32);
initcp_(tabsym, tabptr, tabval, "HEAD", (ftnlen)32, (ftnlen)32, (ftnlen)4)
;
/* Open the command file, and parse its contents */
txtopr_(cmdfil, &unit, cmdfil_len);
eof = FALSE_;
err = FALSE_;
while(! eof && ! err) {
ci__1.cierr = 1;
ci__1.ciend = 1;
ci__1.ciunit = unit;
ci__1.cifmt = "(A)";
iostat = s_rsfe(&ci__1);
if (iostat != 0) {
goto L100001;
}
iostat = do_fio(&c__1, line, (ftnlen)350);
if (iostat != 0) {
goto L100001;
}
iostat = e_rsfe();
L100001:
eof = iostat != 0;
evalcp_(line, &eof, cmdsym, cmdptr, cmdval, &err, (ftnlen)350,
cmdsym_len, cmdval_len);
}
if (err) {
cperr_(reason, &linnum, (ftnlen)160);
repmi_(reason, "#", &linnum, reason, (ftnlen)160, (ftnlen)1, (ftnlen)
160);
prefix_(":", &c__1, reason, (ftnlen)1, (ftnlen)160);
prefix_(cmdfil, &c__0, reason, cmdfil_len, (ftnlen)160);
setmsg_(reason, (ftnlen)160);
sigerr_("SPICE(CMDPARSEERROR)", (ftnlen)20);
chkout_("RDCMD", (ftnlen)5);
return 0;
}
chkout_("RDCMD", (ftnlen)5);
return 0;
} /* rdcmd_ */
/* $Procedure COMMNT ( Comment utility program ) */
/* Main program */ MAIN__(void)
{
/* Initialized data */
static logical insbln = TRUE_;
static char maintl[20] = "COMMNT Options ";
static char mainvl[20*5] = "QUIT " "ADD_COMMENTS "
"READ_COMMENTS " "EXTRACT_COMMENTS " "DELETE_COMMENTS "
" ";
static char maintx[40*5] = "Quit. "
"Add comments to a binary file. " "Read the comments in"
" a binary file. " "Extract comments from a binary file. "
"Delete the comments in a binary file. ";
static char mainnm[1*5] = "Q" "A" "R" "E" "D";
/* System generated locals */
address a__1[3];
integer i__1[3], i__2, i__3, i__4, i__5;
cllist cl__1;
/* Builtin functions */
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *,
char **, integer *, integer *, ftnlen);
integer s_rnge(char *, integer, char *, integer), s_cmp(char *, char *,
ftnlen, ftnlen), f_clos(cllist *);
/* Local variables */
static char arch[3];
static logical done;
static char line[1000];
static logical more;
static integer iopt;
static char type__[4];
static integer i__;
extern /* Subroutine */ int dasdc_(integer *);
extern integer cardi_(integer *);
static integer r__;
extern /* Subroutine */ int spcac_(integer *, integer *, char *, char *,
ftnlen, ftnlen), chkin_(char *, ftnlen), spcec_(integer *,
integer *), spcdc_(integer *), errch_(char *, char *, ftnlen,
ftnlen), repmc_(char *, char *, char *, char *, ftnlen, ftnlen,
ftnlen, ftnlen), reset_(void);
extern integer rtrim_(char *, ftnlen);
extern logical failed_(void);
extern /* Subroutine */ int dafhof_(integer *);
static integer handle;
extern /* Subroutine */ int dafcls_(integer *), dasacu_(integer *, char *,
char *, logical *, integer *, ftnlen, ftnlen), cleari_(integer *,
integer *), delfil_(char *, ftnlen), dasecu_(integer *, integer *
, logical *), scardi_(integer *, integer *), dashof_(integer *);
static logical fileok;
extern /* Subroutine */ int clcomm_(void), getfat_(char *, char *, char *,
ftnlen, ftnlen, ftnlen), cnfirm_(char *, logical *, ftnlen);
static char fnmtbl[128*2], messag[1000], errmsg[320], messgs[1000*7],
option[20], prmtbl[80*2], statbl[3*2];
extern logical exists_(char *, ftnlen);
static integer comlun;
static char status[1000*2];
static integer numfnm;
static char prmpts[80*2];
static integer numopn, opnset[7], tblidx[2];
static logical comnts, contnu, ndfnms, tryagn;
extern /* Subroutine */ int tkvrsn_(char *, char *, ftnlen, ftnlen),
erract_(char *, char *, ftnlen, ftnlen), errprt_(char *, char *,
ftnlen, ftnlen), tostdo_(char *, ftnlen), ssizei_(integer *,
integer *), getopt_(char *, integer *, char *, char *, integer *,
ftnlen, ftnlen, ftnlen), getfnm_(char *, char *, char *, logical *
, char *, ftnlen, ftnlen, ftnlen, ftnlen), setmsg_(char *, ftnlen)
, sigerr_(char *, ftnlen), txtopr_(char *, integer *, ftnlen),
dafopw_(char *, integer *, ftnlen), dasopw_(char *, integer *,
ftnlen), dascls_(integer *), dafopr_(char *, integer *, ftnlen),
spcrfl_(integer *, char *, logical *, ftnlen), spcrnl_(char *,
logical *, ftnlen), dasopr_(char *, integer *, ftnlen), txtopn_(
char *, integer *, ftnlen), chkout_(char *, ftnlen);
static logical eoc;
static char tkv[12];
/* $ Abstract */
/* NAIF Toolkit utility program for adding, reading, extracting, */
/* and deleting comments from a binary file. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* SPC */
/* DAS */
/* $ Author_and_Institution */
/* W.L. Taber (JPL) */
/* K.R. Gehringer (JPL) */
/* J.E. McLean (JPL) */
/* M.J. Spencer (JPL) */
/* $ Version */
/* - Version 6.0.1, 08-MAY-2001 (BVS) */
/* Increased LINLEN from 255 to 1000 to make it consistent */
/* with SPICELIB's SPC* and SUPPORT's DAF* internal line sizes. */
/* - Version 5.0.1, 21-JUL-1997 (WLT) */
/* Modified the banner at start up so that the version of the */
/* toolkit used to link COMMNT will be displayed. */
/* In addition all WRITE statements were replaced by calls to */
/* TOSTDO. */
/* - Version 5.0.0, 05-MAY-1994 (KRG) */
/* Modified the program to use the new file type identification */
/* capability that was added to spicelib. No file type menu is */
/* necessary now, as the file type is determined during the */
/* execution of the program. */
/* The prompts for the begin and end markers used to extract a */
/* subset of text lines from an input comment file which were then */
/* placed into the comment area of a SPICE binary kernel file have */
/* been removed. The entire input comment file is now placed into */
/* the comment area of the binary kernel file. This change */
/* simplifies the user interaction with the program. */
/* Added support for the new PCK binary kernel files. */
/* If an error occurs during the extraction of comments to a file, */
/* the file that was being created is deleted. We cannot know */
/* whether the file had been successfully created before the error */
/* occurred. */
/* - Version 4.0.0, 11-DEC-1992 (KRG) */
/* Added code to support the E-Kernel, and redesigned the */
/* user interface. */
/* - Version 3.1.0, 19-NOV-1991 (MJS) */
/* Variable QUIT initialized to FALSE. */
/* - Version 3.0.1, 10-AUG-1991 (CHA) (NJB) */
/* Updated comments to reflect status as a Toolkit */
/* utility program. Message indicating that no comments */
/* were found in the specified file was changed to include */
/* the file name. */
/* - Version 2.0.0, 28-JUN-1991 (JEM) */
/* The option to read the comments from the comment */
/* area of a binary SPK or CK was added to the menu. */
/* - Version 1.0.0, 05-APR-1991 (JEM) */
/* -& */
/* SPICELIB functions */
/* Parameters */
/* Set the version of the comment program. This should be updated */
/* every time a change is made, and it should agree with the */
/* version number in the header. */
/* Set a value for the logical unit which represents the standard */
/* output device, commonly a terminal. A value of 6 is widely used, */
/* but the Fortran standard does not specify a value, so it may be */
/* different for different Fortran implementations. */
/* Lower bound for a SPICELIB CELL data structure. */
/* Maximum number of open binary files allowed. */
/* Set a value for a replacement marker. */
/* Set a value for a filename prompt. */
/* File types */
/* Set a value for the length of a text line. */
/* Set a value for the length of an error message. */
/* Set a value for the length of a filename. */
/* Set a length for the prompts in the prompt table. */
/* Set a length for the status of a file: 'OLD' or 'NEW'. */
/* Set the length for the architecture of a file. */
/* Set the length for the type of a file. */
/* Set a length for the option values. */
/* Set a length for the title of a menu. */
/* Set a length for an option name (what is typed to select it) */
/* for a menu. */
/* Set the length of the text description of an option on a menu. */
/* The number of options available on the main menu. */
/* Set up some mnemonics for indexing the prompts in the prompt */
/* table. */
/* Set the maximum size of the filename table: this must be the */
/* number of distinct ``types'' of files that the program may */
/* require. */
/* Set up some mnemonics for indexing the messages in the message */
/* table. */
/* Set the maximum size of the message table: There should be a */
/* message for each ``type'' of action that the program can take. */
/* Set up some mnemonics for the OK and not OK status messages. */
/* Set the maximum number of status messages that are available. */
/* We need to have TKVLEN characters to hold the current version */
/* of the toolkit. */
/* Variables */
/* We want to insert a blank line between additions if there are */
/* already comments in the binary file. We indicate this by giving */
/* the variable INSBLN the value .TRUE.. */
/* Define the main menu title ... */
/* Define the main menu option values ... */
/* Define the main menu descriptive text for each option ... */
/* Define the main menu option names ... */
/* Register the COMMNT main program with the SPICELIB error handler. */
chkin_("COMMNT", (ftnlen)6);
clcomm_();
tkvrsn_("TOOLKIT", tkv, (ftnlen)7, (ftnlen)12);
r__ = rtrim_(tkv, (ftnlen)12);
/* Set the error action to 'RETURN'. We don't want the program */
/* to abort if an error is signalled. We check FAILED where */
/* necessary. If an error is signalled, we'll just handle the */
/* error, display an appropriate message, then call RESET at the */
/* end of the loop to continue. */
erract_("SET", "RETURN", (ftnlen)3, (ftnlen)6);
/* Set the error messages that we want to have displayed. We will */
/* diaplay the SPICELIB short and long error messages. This is done */
/* to ensure that some sort of an error message is displayed if an */
/* error occurs. In several places, long error messages are not set, */
/* so if only the long error messages were displayed, it would be */
/* possible to have an error signalled and not see any error */
/* information. This is not a very useful thing. */
errprt_("SET", "NONE, SHORT, LONG, TRACEBACK", (ftnlen)3, (ftnlen)28);
/* Set up the prompt table for the different types of files. */
s_copy(prmtbl + 80, "Enter the name of the comment file to be #.", (
ftnlen)80, (ftnlen)43);
s_copy(prmtbl, "Enter the name of the binary file.", (ftnlen)80, (ftnlen)
34);
/* Set up the message table for the different ``types'' of */
/* operations. The message table contains generic messages which will */
/* have their missing parts filled in after the option and file type */
/* havve been selected. */
s_copy(messgs, "Reading the comment area of the # file.", (ftnlen)1000, (
ftnlen)39);
s_copy(messgs + 1000, "Adding comments to the # file.", (ftnlen)1000, (
ftnlen)30);
s_copy(messgs + 2000, "Extracting comments from the # file.", (ftnlen)
1000, (ftnlen)36);
s_copy(messgs + 3000, "Deleting the comment area of # file.", (ftnlen)
1000, (ftnlen)36);
s_copy(messgs + 4000, "Quitting the program.", (ftnlen)1000, (ftnlen)21);
s_copy(messgs + 5000, "The comments were successfully #.", (ftnlen)1000, (
ftnlen)33);
s_copy(messgs + 6000, "The comments were NOT successfully #.", (ftnlen)
1000, (ftnlen)37);
/* Display a brief commercial with the name of the program and the */
/* version. */
s_copy(line, " Welcome to COMMNT Version: #", (ftnlen)1000, (ftnlen)31);
repmc_(line, "#", "6.0.1", line, (ftnlen)1000, (ftnlen)1, (ftnlen)5, (
ftnlen)1000);
tostdo_(" ", (ftnlen)1);
tostdo_(line, (ftnlen)1000);
/* Writing concatenation */
i__1[0] = 23, a__1[0] = " (Spice Toolkit ";
i__1[1] = r__, a__1[1] = tkv;
i__1[2] = 1, a__1[2] = ")";
s_cat(line, a__1, i__1, &c__3, (ftnlen)1000);
tostdo_(line, (ftnlen)1000);
tostdo_(" ", (ftnlen)1);
/* Initialize the CELL oriented set for collecting open DAF or DAS */
/* files in the event of an error. */
ssizei_(&c__1, opnset);
/* While there is still more to do ... */
done = FALSE_;
while(! done) {
/* We initialize a few things here, so that they get reset for */
/* every trip through the loop. */
/* Initialize the logical flags that we use. */
comnts = FALSE_;
contnu = TRUE_;
eoc = FALSE_;
ndfnms = FALSE_;
/* Initialize the filename table, ... */
s_copy(fnmtbl, " ", (ftnlen)128, (ftnlen)1);
s_copy(fnmtbl + 128, " ", (ftnlen)128, (ftnlen)1);
/* the file status table, ... */
s_copy(statbl, " ", (ftnlen)3, (ftnlen)1);
s_copy(statbl + 3, " ", (ftnlen)3, (ftnlen)1);
/* the table indices, ... */
tblidx[0] = 0;
tblidx[1] = 0;
/* set the number of file names to zero, ... */
numfnm = 0;
/* the prompts in the prompt table, ... */
s_copy(prmpts, " ", (ftnlen)80, (ftnlen)1);
s_copy(prmpts + 80, " ", (ftnlen)80, (ftnlen)1);
/* the message, and the option. */
s_copy(messag, " ", (ftnlen)1000, (ftnlen)1);
s_copy(option, " ", (ftnlen)20, (ftnlen)1);
/* Set the status messages. */
s_copy(status, messgs + 5000, (ftnlen)1000, (ftnlen)1000);
s_copy(status + 1000, messgs + 6000, (ftnlen)1000, (ftnlen)1000);
/* Get the option to be performed from the main menu. */
getopt_(maintl, &c__5, mainnm, maintx, &iopt, (ftnlen)20, (ftnlen)1, (
ftnlen)40);
s_copy(option, mainvl + ((i__2 = iopt - 1) < 5 && 0 <= i__2 ? i__2 :
s_rnge("mainvl", i__2, "commnt_", (ftnlen)502)) * 20, (ftnlen)
20, (ftnlen)20);
/* Set up the messages and other information for the option */
/* selected. */
if (contnu) {
if (s_cmp(option, "ADD_COMMENTS", (ftnlen)20, (ftnlen)12) == 0) {
ndfnms = TRUE_;
numfnm = 2;
s_copy(messag, messgs + 1000, (ftnlen)1000, (ftnlen)1000);
tblidx[0] = 2;
s_copy(prmpts, prmtbl + 80, (ftnlen)80, (ftnlen)80);
repmc_(prmpts, "#", "added", prmpts, (ftnlen)80, (ftnlen)1, (
ftnlen)5, (ftnlen)80);
s_copy(statbl + 3, "OLD", (ftnlen)3, (ftnlen)3);
tblidx[1] = 1;
s_copy(prmpts + 80, prmtbl, (ftnlen)80, (ftnlen)80);
s_copy(statbl, "OLD", (ftnlen)3, (ftnlen)3);
/* Set the operation status messages. */
s_copy(status, messgs + 5000, (ftnlen)1000, (ftnlen)1000);
repmc_(status, "#", "added", status, (ftnlen)1000, (ftnlen)1,
(ftnlen)5, (ftnlen)1000);
s_copy(status + 1000, messgs + 6000, (ftnlen)1000, (ftnlen)
1000);
repmc_(status + 1000, "#", "added", status + 1000, (ftnlen)
1000, (ftnlen)1, (ftnlen)5, (ftnlen)1000);
} else if (s_cmp(option, "READ_COMMENTS", (ftnlen)20, (ftnlen)13)
== 0) {
ndfnms = TRUE_;
numfnm = 1;
s_copy(messag, messgs, (ftnlen)1000, (ftnlen)1000);
tblidx[0] = 1;
s_copy(prmpts, prmtbl, (ftnlen)80, (ftnlen)80);
s_copy(statbl, "OLD", (ftnlen)3, (ftnlen)3);
/* Set the operation status messages. */
s_copy(status, messgs + 5000, (ftnlen)1000, (ftnlen)1000);
repmc_(status, "#", "read", status, (ftnlen)1000, (ftnlen)1, (
ftnlen)4, (ftnlen)1000);
s_copy(status + 1000, messgs + 6000, (ftnlen)1000, (ftnlen)
1000);
repmc_(status + 1000, "#", "read", status + 1000, (ftnlen)
1000, (ftnlen)1, (ftnlen)4, (ftnlen)1000);
} else if (s_cmp(option, "EXTRACT_COMMENTS", (ftnlen)20, (ftnlen)
16) == 0) {
ndfnms = TRUE_;
numfnm = 2;
s_copy(messag, messgs + 2000, (ftnlen)1000, (ftnlen)1000);
tblidx[0] = 1;
s_copy(prmpts, prmtbl, (ftnlen)80, (ftnlen)80);
s_copy(statbl, "OLD", (ftnlen)3, (ftnlen)3);
tblidx[1] = 2;
s_copy(prmpts + 80, prmtbl + 80, (ftnlen)80, (ftnlen)80);
repmc_(prmpts + 80, "#", "created", prmpts + 80, (ftnlen)80, (
ftnlen)1, (ftnlen)7, (ftnlen)80);
s_copy(statbl + 3, "NEW", (ftnlen)3, (ftnlen)3);
/* Set the operation status messages. */
s_copy(status, messgs + 5000, (ftnlen)1000, (ftnlen)1000);
repmc_(status, "#", "extracted", status, (ftnlen)1000, (
ftnlen)1, (ftnlen)9, (ftnlen)1000);
s_copy(status + 1000, messgs + 6000, (ftnlen)1000, (ftnlen)
1000);
repmc_(status + 1000, "#", "extracted", status + 1000, (
ftnlen)1000, (ftnlen)1, (ftnlen)9, (ftnlen)1000);
} else if (s_cmp(option, "DELETE_COMMENTS", (ftnlen)20, (ftnlen)
15) == 0) {
ndfnms = TRUE_;
numfnm = 1;
s_copy(messag, messgs + 3000, (ftnlen)1000, (ftnlen)1000);
tblidx[0] = 1;
s_copy(prmpts, prmtbl, (ftnlen)80, (ftnlen)80);
s_copy(statbl, "OLD", (ftnlen)3, (ftnlen)3);
/* Set the operation status messages. */
s_copy(status, messgs + 5000, (ftnlen)1000, (ftnlen)1000);
repmc_(status, "#", "deleted", status, (ftnlen)1000, (ftnlen)
1, (ftnlen)7, (ftnlen)1000);
s_copy(status + 1000, messgs + 6000, (ftnlen)1000, (ftnlen)
1000);
repmc_(status + 1000, "#", "deleted", status + 1000, (ftnlen)
1000, (ftnlen)1, (ftnlen)7, (ftnlen)1000);
} else if (s_cmp(option, "QUIT", (ftnlen)20, (ftnlen)4) == 0) {
s_copy(messag, messgs + 4000, (ftnlen)1000, (ftnlen)1000);
}
}
/* Collect any filenames that we may need. */
if (contnu && ndfnms) {
/* we always need at least one filename if we get to here. */
i__ = 1;
more = TRUE_;
while(more) {
fileok = FALSE_;
tryagn = TRUE_;
while(tryagn) {
tostdo_(" ", (ftnlen)1);
tostdo_(prmpts + ((i__2 = i__ - 1) < 2 && 0 <= i__2 ?
i__2 : s_rnge("prmpts", i__2, "commnt_", (ftnlen)
614)) * 80, (ftnlen)80);
tostdo_(" ", (ftnlen)1);
getfnm_("Filename? ", statbl + ((i__3 = tblidx[(i__2 =
i__ - 1) < 2 && 0 <= i__2 ? i__2 : s_rnge("tblidx"
, i__2, "commnt_", (ftnlen)617)] - 1) < 2 && 0 <=
i__3 ? i__3 : s_rnge("statbl", i__3, "commnt_", (
ftnlen)617)) * 3, fnmtbl + (((i__5 = tblidx[(i__4
= i__ - 1) < 2 && 0 <= i__4 ? i__4 : s_rnge("tbl"
"idx", i__4, "commnt_", (ftnlen)617)] - 1) < 2 &&
0 <= i__5 ? i__5 : s_rnge("fnmtbl", i__5, "commn"
"t_", (ftnlen)617)) << 7), &fileok, errmsg, (
ftnlen)10, (ftnlen)3, (ftnlen)128, (ftnlen)320);
/* If the filename is OK, increment the filename index */
/* and leave the try again loop. Otherwise, write out the */
/* error message, and give the opportunity to go around */
/* again. */
if (fileok) {
++i__;
tryagn = FALSE_;
} else {
tostdo_(" ", (ftnlen)1);
tostdo_(errmsg, (ftnlen)320);
tostdo_(" ", (ftnlen)1);
cnfirm_("Try again? (Yes/No) ", &tryagn, (ftnlen)20);
if (! tryagn) {
contnu = FALSE_;
more = FALSE_;
}
}
}
if (i__ > numfnm) {
more = FALSE_;
}
}
}
/* Get the file architecture and type. */
if (contnu && ndfnms) {
getfat_(fnmtbl, arch, type__, (ftnlen)128, (ftnlen)3, (ftnlen)4);
if (failed_()) {
contnu = FALSE_;
}
}
/* Check to see that we got back a valid architecture and type. */
if (contnu && ndfnms) {
if (s_cmp(arch, "?", (ftnlen)3, (ftnlen)1) == 0 || s_cmp(type__,
"?", (ftnlen)4, (ftnlen)1) == 0) {
contnu = FALSE_;
setmsg_("The architecture and type of the binary file '#' co"
"uld not be determined. A common error is to give the"
" name of a text file instead of the name of a binary"
" file.", (ftnlen)161);
errch_("#", fnmtbl, (ftnlen)1, (ftnlen)128);
sigerr_("SPICE(BADFILEFORMAT)", (ftnlen)20);
}
}
/* Customize the message. We know we can do this, because we */
/* need files, and so we don't have the QUIT message. */
if (contnu && ndfnms) {
repmc_(messag, "#", type__, messag, (ftnlen)1000, (ftnlen)1, (
ftnlen)4, (ftnlen)1000);
}
/* Process the option that was selected so long ago. */
if (contnu) {
if (s_cmp(option, "QUIT", (ftnlen)20, (ftnlen)4) == 0) {
tostdo_(" ", (ftnlen)1);
tostdo_(messag, (ftnlen)1000);
tostdo_(" ", (ftnlen)1);
done = TRUE_;
} else if (s_cmp(option, "ADD_COMMENTS", (ftnlen)20, (ftnlen)12)
== 0) {
tostdo_(" ", (ftnlen)1);
tostdo_(messag, (ftnlen)1000);
s_copy(line, "From File: #", (ftnlen)1000, (ftnlen)12);
repmc_(line, "#", fnmtbl + 128, line, (ftnlen)1000, (ftnlen)1,
(ftnlen)128, (ftnlen)1000);
tostdo_(" ", (ftnlen)1);
tostdo_(line, (ftnlen)1000);
s_copy(line, "To File : #", (ftnlen)1000, (ftnlen)12);
repmc_(line, "#", fnmtbl, line, (ftnlen)1000, (ftnlen)1, (
ftnlen)128, (ftnlen)1000);
tostdo_(line, (ftnlen)1000);
/* Open the text file which contains the comments to be */
/* added to the binary file. */
txtopr_(fnmtbl + 128, &comlun, (ftnlen)128);
if (! failed_()) {
if (s_cmp(type__, "CK", (ftnlen)4, (ftnlen)2) == 0) {
/* Open the binary file, add the comments, and close */
/* the binary file. */
dafopw_(fnmtbl, &handle, (ftnlen)128);
spcac_(&handle, &comlun, " ", " ", (ftnlen)1, (ftnlen)
1);
dafcls_(&handle);
} else if (s_cmp(type__, "PCK", (ftnlen)4, (ftnlen)3) ==
0) {
/* Open the binary file, add the comments, and close */
/* the binary file. */
dafopw_(fnmtbl, &handle, (ftnlen)128);
spcac_(&handle, &comlun, " ", " ", (ftnlen)1, (ftnlen)
1);
dafcls_(&handle);
} else if (s_cmp(type__, "SPK", (ftnlen)4, (ftnlen)3) ==
0) {
/* Open the binary file, add the comments, and close */
/* the binary file. */
dafopw_(fnmtbl, &handle, (ftnlen)128);
spcac_(&handle, &comlun, " ", " ", (ftnlen)1, (ftnlen)
1);
dafcls_(&handle);
} else if (s_cmp(type__, "EK", (ftnlen)4, (ftnlen)2) == 0)
{
/* Open the binary file, add the comments, and close */
/* the binary file. */
dasopw_(fnmtbl, &handle, (ftnlen)128);
dasacu_(&comlun, " ", " ", &insbln, &handle, (ftnlen)
1, (ftnlen)1);
dascls_(&handle);
}
/* Close the comment file. */
cl__1.cerr = 0;
cl__1.cunit = comlun;
cl__1.csta = 0;
f_clos(&cl__1);
}
/* Display the status of the operation that was selected. */
tostdo_(" ", (ftnlen)1);
if (failed_()) {
tostdo_(status + 1000, (ftnlen)1000);
} else {
tostdo_(status, (ftnlen)1000);
}
} else if (s_cmp(option, "READ_COMMENTS", (ftnlen)20, (ftnlen)13)
== 0) {
tostdo_(" ", (ftnlen)1);
tostdo_(messag, (ftnlen)1000);
s_copy(line, "File: #", (ftnlen)1000, (ftnlen)7);
repmc_(line, "#", fnmtbl, line, (ftnlen)1000, (ftnlen)1, (
ftnlen)128, (ftnlen)1000);
tostdo_(" ", (ftnlen)1);
tostdo_(line, (ftnlen)1000);
tostdo_(" ", (ftnlen)1);
if (s_cmp(type__, "CK", (ftnlen)4, (ftnlen)2) == 0) {
/* Open the binary file, read the comments, and close */
/* the binary file. */
dafopr_(fnmtbl, &handle, (ftnlen)128);
/* The comments are read a line at a time and displayed */
/* on the screen. */
spcrfl_(&handle, line, &eoc, (ftnlen)1000);
if (! failed_()) {
if (eoc) {
tostdo_("There were no comments found in the fil"
"e.", (ftnlen)41);
}
while(! eoc && ! failed_()) {
tostdo_(line, (ftnlen)1000);
spcrnl_(line, &eoc, (ftnlen)1000);
}
}
dafcls_(&handle);
} else if (s_cmp(type__, "PCK", (ftnlen)4, (ftnlen)3) == 0) {
/* Open the binary file, read the comments, and close */
/* the binary file. */
dafopr_(fnmtbl, &handle, (ftnlen)128);
/* The comments are read a line at a time and displayed */
/* on the screen. */
spcrfl_(&handle, line, &eoc, (ftnlen)1000);
if (! failed_()) {
if (eoc) {
tostdo_("There were no commentfound in the file.",
(ftnlen)39);
}
while(! eoc && ! failed_()) {
tostdo_(line, (ftnlen)1000);
spcrnl_(line, &eoc, (ftnlen)1000);
}
}
dafcls_(&handle);
} else if (s_cmp(type__, "SPK", (ftnlen)4, (ftnlen)3) == 0) {
/* Open the binary file, read the comments, and close */
/* the binary file. */
dafopr_(fnmtbl, &handle, (ftnlen)128);
/* The comments are read a line at a time and displayed */
/* on the screen. */
spcrfl_(&handle, line, &eoc, (ftnlen)1000);
if (! failed_()) {
if (eoc) {
tostdo_("There were no comments found in the fil"
"e.", (ftnlen)41);
}
while(! eoc && ! failed_()) {
tostdo_(line, (ftnlen)1000);
spcrnl_(line, &eoc, (ftnlen)1000);
}
}
dafcls_(&handle);
} else if (s_cmp(type__, "EK", (ftnlen)4, (ftnlen)2) == 0) {
/* Open the binary file, read the comments, and close */
/* the binary file. */
dasopr_(fnmtbl, &handle, (ftnlen)128);
dasecu_(&handle, &c__6, &comnts);
dascls_(&handle);
if (! comnts) {
s_copy(line, "There were no comments found in the fi"
"le.", (ftnlen)1000, (ftnlen)41);
tostdo_(line, (ftnlen)1000);
}
}
/* Display the status of the operation that was selected. */
tostdo_(" ", (ftnlen)1);
if (failed_()) {
tostdo_(status + 1000, (ftnlen)1000);
} else {
tostdo_(status, (ftnlen)1000);
}
} else if (s_cmp(option, "EXTRACT_COMMENTS", (ftnlen)20, (ftnlen)
16) == 0) {
tostdo_(" ", (ftnlen)1);
tostdo_(messag, (ftnlen)1000);
s_copy(line, "From File: #", (ftnlen)1000, (ftnlen)12);
repmc_(line, "#", fnmtbl, line, (ftnlen)1000, (ftnlen)1, (
ftnlen)128, (ftnlen)1000);
tostdo_(" ", (ftnlen)1);
tostdo_(line, (ftnlen)1000);
s_copy(line, "To File : #", (ftnlen)1000, (ftnlen)12);
repmc_(line, "#", fnmtbl + 128, line, (ftnlen)1000, (ftnlen)1,
(ftnlen)128, (ftnlen)1000);
tostdo_(line, (ftnlen)1000);
/* Open the text file. */
txtopn_(fnmtbl + 128, &comlun, (ftnlen)128);
if (! failed_()) {
if (s_cmp(type__, "CK", (ftnlen)4, (ftnlen)2) == 0) {
/* Open the binary file, extract the comments, and */
/* close the binary file. */
dafopr_(fnmtbl, &handle, (ftnlen)128);
spcec_(&handle, &comlun);
dafcls_(&handle);
} else if (s_cmp(type__, "PCK", (ftnlen)4, (ftnlen)3) ==
0) {
/* Open the binary file, extract the comments, and */
/* close the binary file. */
dafopr_(fnmtbl, &handle, (ftnlen)128);
spcec_(&handle, &comlun);
dafcls_(&handle);
} else if (s_cmp(type__, "SPK", (ftnlen)4, (ftnlen)3) ==
0) {
/* Open the binary file, extract the comments, and */
/* close the binary file. */
dafopr_(fnmtbl, &handle, (ftnlen)128);
spcec_(&handle, &comlun);
dafcls_(&handle);
} else if (s_cmp(type__, "EK", (ftnlen)4, (ftnlen)2) == 0)
{
/* Open the binary file, extract the comments, and */
/* close the binary file. */
dasopr_(fnmtbl, &handle, (ftnlen)128);
dasecu_(&handle, &comlun, &comnts);
dascls_(&handle);
if (! comnts) {
s_copy(line, "There were no comments found in th"
"e file.", (ftnlen)1000, (ftnlen)41);
tostdo_(line, (ftnlen)1000);
}
}
/* Close the text file that we opened. */
cl__1.cerr = 0;
cl__1.cunit = comlun;
cl__1.csta = 0;
f_clos(&cl__1);
}
/* Display the status of the operation that was selected. */
tostdo_(" ", (ftnlen)1);
if (failed_()) {
tostdo_(status + 1000, (ftnlen)1000);
} else {
tostdo_(status, (ftnlen)1000);
}
} else if (s_cmp(option, "DELETE_COMMENTS", (ftnlen)20, (ftnlen)
15) == 0) {
tostdo_(" ", (ftnlen)1);
tostdo_(messag, (ftnlen)1000);
s_copy(line, "File: #", (ftnlen)1000, (ftnlen)7);
repmc_(line, "#", fnmtbl, line, (ftnlen)1000, (ftnlen)1, (
ftnlen)128, (ftnlen)1000);
tostdo_(" ", (ftnlen)1);
tostdo_(line, (ftnlen)1000);
if (s_cmp(type__, "CK", (ftnlen)4, (ftnlen)2) == 0) {
/* Open the binary file, delete the comments, and close */
/* the binary file. */
dafopw_(fnmtbl, &handle, (ftnlen)128);
spcdc_(&handle);
dafcls_(&handle);
} else if (s_cmp(type__, "PCK", (ftnlen)4, (ftnlen)3) == 0) {
/* Open the binary file, delete the comments, and close */
/* the binary file. */
dafopw_(fnmtbl, &handle, (ftnlen)128);
spcdc_(&handle);
dafcls_(&handle);
} else if (s_cmp(type__, "SPK", (ftnlen)4, (ftnlen)3) == 0) {
/* Open the binary file, delete the comments, and close */
/* the binary file. */
dafopw_(fnmtbl, &handle, (ftnlen)128);
spcdc_(&handle);
dafcls_(&handle);
} else if (s_cmp(type__, "EK", (ftnlen)4, (ftnlen)2) == 0) {
/* Open the binary file, delete the comments, and close */
/* the binary file. */
dasopw_(fnmtbl, &handle, (ftnlen)128);
dasdc_(&handle);
dascls_(&handle);
}
/* Display the status of the operation that was selected. */
tostdo_(" ", (ftnlen)1);
if (failed_()) {
tostdo_(status + 1000, (ftnlen)1000);
} else {
tostdo_(status, (ftnlen)1000);
}
}
}
/* If anything failed, close any binary files that might still be */
/* open and reset the error handling before getting the next */
/* option. */
if (failed_()) {
/* Before we can attempt to perform any clean up actions if an */
/* error occurred, we need to reset the SPICELIB error handling */
/* mechanism so that we can call the SPICELIB routines that we */
/* need to. */
reset_();
/* Clear out any binary file handles in the open set, OPNSET. */
scardi_(&c__0, opnset);
cleari_(&c__1, &opnset[6]);
/* Get the handles for any DAF files which may still be open. */
dafhof_(opnset);
numopn = cardi_(opnset);
if (numopn > 0) {
i__2 = numopn;
for (i__ = 1; i__ <= i__2; ++i__) {
dafcls_(&opnset[(i__3 = i__ + 5) < 7 && 0 <= i__3 ? i__3 :
s_rnge("opnset", i__3, "commnt_", (ftnlen)1100)])
;
}
}
/* Clear out any binary file handles in the open set, OPNSET. */
scardi_(&c__0, opnset);
cleari_(&c__1, &opnset[6]);
/* Get the handles for any DAS files which may still be open. */
dashof_(opnset);
numopn = cardi_(opnset);
if (numopn > 0) {
i__2 = numopn;
for (i__ = 1; i__ <= i__2; ++i__) {
dascls_(&opnset[(i__3 = i__ + 5) < 7 && 0 <= i__3 ? i__3 :
s_rnge("opnset", i__3, "commnt_", (ftnlen)1121)])
;
}
}
/* If there was an error and we were extracting comments to a */
/* file, then we should delete the file that was created, */
/* because we do not know whether the extraction was completed */
/* successfully. */
if (s_cmp(option, "EXTRACT_COMMENTS", (ftnlen)20, (ftnlen)16) ==
0) {
if (exists_(fnmtbl + 128, (ftnlen)128)) {
delfil_(fnmtbl + 128, (ftnlen)128);
}
}
/* Finally, reset the error handling, and go get the next */
/* option. This is just to be sure. */
reset_();
}
}
chkout_("COMMNT", (ftnlen)6);
return 0;
} /* MAIN__ */