/* $Procedure DAFB2A ( DAF, binary to ASCII ) */ /* Subroutine */ int dafb2a_(char *binary, char *ascii, ftnlen binary_len, ftnlen ascii_len) { /* System generated locals */ cllist cl__1; /* Builtin functions */ integer f_clos(cllist *); /* Local variables */ integer unit; extern /* Subroutine */ int chkin_(char *, ftnlen), dafb2t_(char *, integer *, ftnlen); extern logical failed_(void); extern /* Subroutine */ int chkout_(char *, ftnlen); extern logical return_(void); extern /* Subroutine */ int txtopn_(char *, integer *, ftnlen); /* $ Abstract */ /* Convert a binary DAF to an equivalent ASCII (text) 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 */ /* -------- --- -------------------------------------------------- */ /* BINARY I Name of an existing binary DAF. */ /* ASCII I Name of an ASCII (text) DAF to be created. */ /* $ Detailed_Input */ /* BINARY is the name of an existing binary DAF. */ /* ASCII is the name of an ASCII (text) DAF to be created. */ /* The ASCII file contains the same data as the binary */ /* file, but in a form more suitable for transfer */ /* between heterogeneous computing environments. */ /* $ Detailed_Output */ /* None. */ /* $ Parameters */ /* None. */ /* $ Files */ /* See arguments BINARY, ASCII. */ /* $ Exceptions */ /* None. */ /* Errors are detected and signalled by routines called by this */ /* routine. */ /* $ Particulars */ /* This routine has been made obsolete by the new DAF binary to text */ /* conversion routine DAFBT. This routine remains available for */ /* reasons of backward compatibility. We strongly recommend that the */ /* conversion routine DAFBT be used for any new software development. */ /* Please see the header of the routine DAFBT for details. */ /* Note that the contents of reserved records in the binary file */ /* are not stored in the ASCII file. */ /* $ 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 */ /* None. */ /* $ 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.1.0, 18-JUN-1999 (WLT) */ /* Fixed call to CHKOUT with wrong name. */ /* - SPICELIB Version 2.0.0, 04-OCT-1993 (KRG) */ /* This routine was completely rewritten to make use of the */ /* routines DAFB2T and TXTOPN, for converting a text file to */ /* binary and opening a text file. It now simply calls the */ /* routine DAFT2B after opening the text file with TXTOPN. */ /* Added a statement to the $ Particulars section to the effect */ /* that this routine has been made obsolete by the introduction of */ /* the routine DAFBT, and that we strongly recommend the use of */ /* the new routine. */ /* 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 */ /* binary daf to ascii */ /* -& */ /* $ Revisions */ /* - SPICELIB Version 2.0.0, 04-OCT-1993 (KRG) */ /* This routine was completely rewritten to make use of the */ /* routines DAFB2T and TXTOPN, for converting a text file to */ /* binary and opening a text file. It now simply calls the */ /* routine DAFT2B after opening the text file with TXTOPN. */ /* Added a statement to the $ Particulars section to the effect */ /* that this routine has been made obsolete by the introduction of */ /* the routine DAFBT, and that we strongly recommend the use of */ /* the new routine. */ /* 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_("DAFB2A", (ftnlen)6); } /* Open the ASCII file for writing. If an error occurs, then check */ /* out and return. An appropriate error message will have already */ /* been set. */ txtopn_(ascii, &unit, ascii_len); if (failed_()) { chkout_("DAFB2A", (ftnlen)6); return 0; } /* Attempt to perform the file conversion. If it fails, close the */ /* text file with STATUS = 'DELETE', check out and return, as an */ /* appropriate error message should have already been set. */ dafb2t_(binary, &unit, binary_len); if (failed_()) { cl__1.cerr = 0; cl__1.cunit = unit; cl__1.csta = "DELETE"; f_clos(&cl__1); chkout_("DAFB2A", (ftnlen)6); return 0; } /* Close the text file. */ cl__1.cerr = 0; cl__1.cunit = unit; cl__1.csta = 0; f_clos(&cl__1); chkout_("DAFB2A", (ftnlen)6); return 0; } /* dafb2a_ */
/* $Procedure SPCB2A ( SPK and CK, binary to ASCII ) */ /* Subroutine */ int spcb2a_(char *binary, char *text, ftnlen binary_len, ftnlen text_len) { /* System generated locals */ cllist cl__1; /* Builtin functions */ integer f_clos(cllist *); /* Local variables */ integer unit; extern /* Subroutine */ int chkin_(char *, ftnlen), spcb2t_(char *, integer *, ftnlen), chkout_(char *, ftnlen); extern logical return_(void); extern /* Subroutine */ int txtopn_(char *, integer *, ftnlen); /* $ Abstract */ /* Convert a binary SPK or CK file to an equivalent text (ASCII) */ /* file, including the comment area. */ /* $ 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 */ /* -------- --- -------------------------------------------------- */ /* BINARY I Name of an existing binary SPK or CK file. */ /* TEXT I Name of a text file to be created. */ /* $ Detailed_Input */ /* BINARY is the name of an existing binary SPK or CK file */ /* that may contain comments in its comment area as */ /* written by the routine SPCAC. */ /* TEXT is the name of a text SPK or CK file to be created. */ /* The text file will contain the same data and comments */ /* as the binary file, but in a form more suitable for */ /* transfer between heterogeneous computing environments. */ /* $ Detailed_Output */ /* None. */ /* $ Parameters */ /* None. */ /* $ Files */ /* See arguments BINARY and TEXT. */ /* $ Exceptions */ /* 1) If there is an IOSTAT error while opening, reading, */ /* or writing a file, a routine that SPCB2A 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) */ /* $ Version */ /* - 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, 05-APR-1991 (JEM) */ /* -& */ /* $ Index_Entries */ /* binary spk or ck to ascii */ /* -& */ /* SPICELIB functions */ /* Local parameters */ /* Local variables */ /* Standard SPICE error handling. */ if (return_()) { return 0; } else { chkin_("SPCB2A", (ftnlen)6); } /* Open the new text file. Call SPCB2T to write the data */ /* and comments. Then close the text file and we're done. */ txtopn_(text, &unit, text_len); spcb2t_(binary, &unit, binary_len); cl__1.cerr = 0; cl__1.cunit = unit; cl__1.csta = 0; f_clos(&cl__1); chkout_("SPCB2A", (ftnlen)6); return 0; } /* spcb2a_ */
/* $ Procedure CONVBT ( Convert Kernel file from binary to text ) */ /* Subroutine */ int convbt_(char *binfil, char *txtfil, ftnlen binfil_len, ftnlen txtfil_len) { /* System generated locals */ cllist cl__1; /* Builtin functions */ /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen); integer s_cmp(char *, char *, ftnlen, ftnlen), f_clos(cllist *), s_wsle( cilist *), do_lio(integer *, integer *, char *, ftnlen), e_wsle( void); /* Local variables */ extern /* Subroutine */ int dafbt_(char *, integer *, ftnlen); char farch[3]; extern /* Subroutine */ int chkin_(char *, ftnlen), spcec_(integer *, integer *), dasbt_(char *, integer *, ftnlen), errch_(char *, char *, ftnlen, ftnlen); char ftype[4]; extern logical failed_(void); integer handle; extern /* Subroutine */ int dafcls_(integer *), getfat_(char *, char *, char *, ftnlen, ftnlen, ftnlen), dafopr_(char *, integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen); integer iostat; logical comnts; extern /* Subroutine */ int errint_(char *, integer *, ftnlen); extern logical return_(void); extern /* Subroutine */ int txtopn_(char *, integer *, ftnlen); integer txtlun; /* Fortran I/O blocks */ static cilist io___7 = { 1, 0, 0, 0, 0 }; static cilist io___8 = { 1, 0, 0, 0, 0 }; /* $ Abstract */ /* Convert a SPICE binary file to an equivalent text file format. */ /* NOTE: This routine is currently for use ONLY with the SPACIT */ /* utility program. Use it at your own risk. */ /* $ 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 */ /* CONVERSION */ /* FILES */ /* UTILITY */ /* $ Declarations */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* BINFIL I Name of an existing SPICE binary file. */ /* TXTFIL I Name of the text file to be created. */ /* $ Detailed_Input */ /* None. */ /* $ Detailed_Output */ /* None. */ /* $ Parameters */ /* None. */ /* $ Files */ /* None. */ /* $ Exceptions */ /* 1) */ /* $ Particulars */ /* This routine accepts as inputs the name of a binary file to be */ /* converted to text and the name of the text file to be created. */ /* The binary file must already exist and the text file must not */ /* exist for this routine to work correctly. The architecture and the */ /* file type are determined and then an appropriate file conversion */ /* is performed. */ /* $ Examples */ /* None. */ /* $ Restrictions */ /* 1) */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* K.R. Gehringer (JPL) */ /* $ Version */ /* - Beta Version 3.2.0, 30-AUG-1994 (KRG) */ /* Improved the error diagnostics when incorrect inputs are */ /* provided, e.g., a transfer filename instead of a binary kernel */ /* filename. */ /* - Beta Version 3.1.0, 12-AUG-1994 (KRG) */ /* Fixed a minor bug that would occur when formatting a long error */ /* message. ERRFNM was called with a logical unit that had already */ /* been closed. */ /* - Beta Version 3.0.0, 22-APR-1994 (KRG) */ /* Made updates to the routine to make use of the new SPICE */ /* capability of determining binary kernel file types at run time. */ /* Removed the arguments for the file architecture and file type */ /* from the calling list. This information was no longer */ /* necessary. */ /* Rearranged some of the code to make it easier to understand. */ /* Added a new error: if the architecture or type are not */ /* recognized, we can't process the file. */ /* - Beta Version 2.0.0, 28-JAN-1994 (KRG) */ /* -& */ /* $ Index_Entries */ /* convert binary SPICE files to text */ /* -& */ /* SPICELIB functions */ /* Local parameters */ /* Begin and end markers in the file for the comment area. */ /* File types that are recognized. */ /* Length of a file architecture. */ /* Maximum length for a file type. */ /* Local variables */ /* Standard SPICE error handling. */ if (return_()) { return 0; } else { chkin_("CONVBT", (ftnlen)6); } /* Initialize the file architecture and the file type. */ s_copy(farch, " ", (ftnlen)3, (ftnlen)1); s_copy(ftype, " ", (ftnlen)4, (ftnlen)1); /* Get the architecture and type of the binary file. */ getfat_(binfil, farch, ftype, binfil_len, (ftnlen)3, (ftnlen)4); if (failed_()) { /* If there was an error getting the file architecture, just */ /* return. An appropriate error message should have been set. */ /* So, all we need to do here is return to the caller. */ chkout_("CONVBT", (ftnlen)6); return 0; } /* Check to see that we got back a valid architecture and type. */ /* Open the text file for output, obtaining a Fortran logical */ /* unit. */ txtopn_(txtfil, &txtlun, txtfil_len); if (failed_()) { /* If there was an error opening the text file, just return. */ /* An appropriate error message should have been set by TXTOPN. */ /* So, all we need to do here is return to the caller. */ chkout_("CONVBT", (ftnlen)6); return 0; } /* Process the files based on their binary architectures */ if (s_cmp(farch, "DAF", (ftnlen)3, (ftnlen)3) == 0) { /* If the file is a NAIF SPK, CK, or PCK binary file, it may have */ /* a comment area. So set the COMNTS flag appropriately. */ comnts = s_cmp(ftype, "SPK", (ftnlen)4, (ftnlen)3) == 0; comnts = comnts || s_cmp(ftype, "CK", (ftnlen)4, (ftnlen)2) == 0; comnts = comnts || s_cmp(ftype, "PCK", (ftnlen)4, (ftnlen)3) == 0; /* First, convert the data portion of the binary file to text. */ /* We only support the latest and greatest text file format for */ /* conversion of the binary files to text. */ dafbt_(binfil, &txtlun, binfil_len); if (failed_()) { /* If an error occurred while attempting to convert the */ /* data portion of the DAF file to text, we need to close */ /* the text file and return to the caller. We will delete */ /* the text file when we close it. */ cl__1.cerr = 0; cl__1.cunit = txtlun; cl__1.csta = "DELETE"; f_clos(&cl__1); chkout_("CONVBT", (ftnlen)6); return 0; } /* The DAF file may or may not have a comment area. If it is a */ /* NAIF SPICE kernel file, then it does and we need to deal with */ /* it. Otherwise we do nothing. */ if (comnts) { /* We need to open the binary DAF file so that we can extract */ /* the comments from its comment area and place them in the */ /* text file. */ dafopr_(binfil, &handle, binfil_len); if (failed_()) { /* If an error occurred, we need to close the text file and */ /* return to the caller. We will delete the text file when */ /* we close it. */ cl__1.cerr = 0; cl__1.cunit = txtlun; cl__1.csta = "DELETE"; f_clos(&cl__1); chkout_("CONVBT", (ftnlen)6); return 0; } /* Write the begin comments marker to the text file. */ io___7.ciunit = txtlun; iostat = s_wsle(&io___7); if (iostat != 0) { goto L100001; } iostat = do_lio(&c__9, &c__1, "~NAIF/SPC BEGIN COMMENTS~", ( ftnlen)25); if (iostat != 0) { goto L100001; } iostat = e_wsle(); L100001: if (iostat != 0) { /* An error occurred, so close both the text and binary */ /* files, set an appropriate error message, and return to */ /* the caller. The text file is deleted when it is closed. */ cl__1.cerr = 0; cl__1.cunit = txtlun; cl__1.csta = "DELETE"; f_clos(&cl__1); dafcls_(&handle); setmsg_("Error writing the begin comments marker to the text" " file: #. IOSTAT = #.", (ftnlen)72); errch_("#", txtfil, (ftnlen)1, txtfil_len); errint_("#", &iostat, (ftnlen)1); sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22); chkout_("CONVBT", (ftnlen)6); return 0; } /* Extract the comment area of the binary file to the text */ /* file. */ spcec_(&handle, &txtlun); if (failed_()) { /* If the comment extraction failed, then an appropriate */ /* error message should have already been set, so close */ /* the text and binary files and return to the caller. The */ /* text file is deleted when it is closed. */ cl__1.cerr = 0; cl__1.cunit = txtlun; cl__1.csta = "DELETE"; f_clos(&cl__1); chkout_("CONVBT", (ftnlen)6); return 0; } /* Write the end comments marker. */ io___8.ciunit = txtlun; iostat = s_wsle(&io___8); if (iostat != 0) { goto L100002; } iostat = do_lio(&c__9, &c__1, "~NAIF/SPC END COMMENTS~", (ftnlen) 23); if (iostat != 0) { goto L100002; } iostat = e_wsle(); L100002: if (iostat != 0) { /* An error occurred, so close both the text and binary */ /* files, set an appropriate error message, and return to */ /* the caller. The text file is deleted when it is closed. */ cl__1.cerr = 0; cl__1.cunit = txtlun; cl__1.csta = "DELETE"; f_clos(&cl__1); dafcls_(&handle); setmsg_("Error writing the end comments marker to the text f" "ile: #. IOSTAT = #.", (ftnlen)70); errch_("#", txtfil, (ftnlen)1, txtfil_len); errint_("#", &iostat, (ftnlen)1); sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22); chkout_("CONVBT", (ftnlen)6); return 0; } /* Close the binary DAF file that we opened to extract the */ /* comments. */ dafcls_(&handle); } } else if (s_cmp(farch, "DAS", (ftnlen)3, (ftnlen)3) == 0) { /* DAS files are easy. Everything is integrated into the files */ /* so we do not need to worry about comments or reserved records */ /* or anything. We just convert it. */ /* Convert the data portion of the binary file to text. We */ /* only support the latest and greatest text file format for */ /* conversion of the binary files to text. */ dasbt_(binfil, &txtlun, binfil_len); if (failed_()) { /* If an error occurred while attempting to convert the */ /* DAS file to text, we need to close the text file and */ /* return to the caller. We will delete the text file */ /* when we close it. */ cl__1.cerr = 0; cl__1.cunit = txtlun; cl__1.csta = "DELETE"; f_clos(&cl__1); chkout_("CONVBT", (ftnlen)6); return 0; } } else if (s_cmp(farch, "XFR", (ftnlen)3, (ftnlen)3) == 0) { /* This is an error case, most likely caused by reading a transfer */ /* file by accident. So signal an appropriate error. */ cl__1.cerr = 0; cl__1.cunit = txtlun; cl__1.csta = "DELETE"; f_clos(&cl__1); setmsg_("The file '#' appears to be a transfer file and not a binary" " kernel file.", (ftnlen)72); errch_("#", binfil, (ftnlen)1, binfil_len); sigerr_("SPICE(NOTABINARYKERNEL)", (ftnlen)23); chkout_("CONVBT", (ftnlen)6); return 0; } else if (s_cmp(farch, "DEC", (ftnlen)3, (ftnlen)3) == 0) { /* This is an error case, most likely caused by reading a transfer */ /* file by accident. So signal an appropriate error. */ cl__1.cerr = 0; cl__1.cunit = txtlun; cl__1.csta = "DELETE"; f_clos(&cl__1); setmsg_("The file '#' appears to be a decimal transfer file and not " "a binary kernel file.", (ftnlen)80); errch_("#", binfil, (ftnlen)1, binfil_len); sigerr_("SPICE(NOTABINARYKERNEL)", (ftnlen)23); chkout_("CONVBT", (ftnlen)6); return 0; } else { /* This is the catch all error case. At this point, we didn't */ /* match any of the files whose architecture and types are */ /* recognized. So, we toss our hands in the air and signal an */ /* error. */ cl__1.cerr = 0; cl__1.cunit = txtlun; cl__1.csta = "DELETE"; f_clos(&cl__1); setmsg_("The architecture and type of the file '#' were not recogniz" "ed.", (ftnlen)62); errch_("#", binfil, (ftnlen)1, binfil_len); sigerr_("SPICE(BADFILEFORMAT)", (ftnlen)20); chkout_("CONVBT", (ftnlen)6); return 0; } /* Close the text file that was created. */ cl__1.cerr = 0; cl__1.cunit = txtlun; cl__1.csta = 0; f_clos(&cl__1); chkout_("CONVBT", (ftnlen)6); return 0; } /* convbt_ */
/* $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__ */