1 /* spcec.f -- translated by f2c (version 19980913).
2 You must link the resulting object file with the libraries:
3 -lf2c -lm (in that order)
4 */
5
6 #include "f2c.h"
7
8 /* Table of constant values */
9
10 static logical c_false = FALSE_;
11 static integer c__1 = 1;
12
13 /* $Procedure SPCEC ( SPK and CK, extract comments ) */
spcec_(integer * handle,integer * unit)14 /* Subroutine */ int spcec_(integer *handle, integer *unit)
15 {
16 /* System generated locals */
17 integer i__1;
18 cilist ci__1;
19
20 /* Builtin functions */
21 /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
22 integer s_rdue(cilist *), do_uio(integer *, char *, ftnlen), e_rdue(void),
23 s_wsle(cilist *), e_wsle(void), s_wsfe(cilist *), do_fio(integer
24 *, char *, ftnlen), e_wsfe(void);
25
26 /* Local variables */
27 integer dafu, free;
28 char line[1000], null[1];
29 extern /* Subroutine */ int zzddhhlu_(integer *, char *, logical *,
30 integer *, ftnlen);
31 integer c__;
32 extern /* Subroutine */ int chkin_(char *, ftnlen);
33 integer bward, fward, nd;
34 extern logical failed_(void);
35 integer ni;
36 extern /* Subroutine */ int dafsih_(integer *, char *, ftnlen);
37 char ifname[60];
38 extern /* Subroutine */ int dafrfr_(integer *, integer *, integer *, char
39 *, integer *, integer *, integer *, ftnlen);
40 char record[1000];
41 extern /* Subroutine */ int errfnm_(char *, integer *, ftnlen), sigerr_(
42 char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen);
43 integer iostat;
44 extern /* Subroutine */ int errint_(char *, integer *, ftnlen);
45 extern logical return_(void);
46 integer rec;
47 char eot[1];
48 integer nrr, pos;
49
50 /* Fortran I/O blocks */
51 static cilist io___16 = { 1, 0, 1, 0, 0 };
52 static cilist io___18 = { 1, 0, 0, 0, 0 };
53
54
55 /* $ Abstract */
56
57 /* Extract the text from the comment area of a binary SPK or CK file */
58 /* and write it to a text file. */
59
60 /* $ Disclaimer */
61
62 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
63 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
64 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
65 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
66 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
67 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
68 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
69 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
70 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
71 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
72
73 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
74 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
75 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
76 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
77 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
78 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
79
80 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
81 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
82 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
83 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
84
85 /* $ Required_Reading */
86
87 /* SPC */
88
89 /* $ Keywords */
90
91 /* FILES */
92
93 /* $ Declarations */
94 /* $ Brief_I/O */
95
96 /* Variable I/O Description */
97 /* -------- --- -------------------------------------------------- */
98 /* HANDLE I Handle assigned to binary SPK or CK file. */
99 /* UNIT I Logical unit connected to text file. */
100
101 /* $ Detailed_Input */
102
103 /* HANDLE is the handle assigned to the binary SPK or CK file */
104 /* which has been opened for read access. */
105
106 /* UNIT is the logical unit connected to the text file to */
107 /* which the contents of the comment area of the SPK */
108 /* or CK file will be written, beginning at the current */
109 /* position of the file pointer. */
110
111 /* $ Detailed_Output */
112
113 /* None. */
114
115 /* $ Parameters */
116
117 /* None. */
118
119 /* $ Exceptions */
120
121 /* 1) If the comment area of the SPK or CK file is empty, nothing */
122 /* will be written to the text file. */
123
124 /* 2) If there is a problem reading from the comment area, the error */
125 /* SPICE(FILEREADFAILED) is signalled. */
126
127 /* 3) If there is a problem writing to the text file, the error */
128 /* SPICE(FILEWRITEFAILED) is signalled. */
129
130 /* $ Files */
131
132 /* HANDLE is the handle assigned to the binary SPK or CK file. */
133 /* Use DAFOPR to open it for read access and get its */
134 /* handle unless SPKLEF or CKLPF has already been called */
135 /* and returned the handle. This file is unchanged by */
136 /* calling SPCEC. */
137
138 /* UNIT is the logical unit connected to the text file which */
139 /* has been opened for write access. Use TXTOPN to */
140 /* open the file and get its logical unit. Upon exit, */
141 /* this file will contain the text from the comment */
142 /* area of the binary SPK or CK file, beginning at */
143 /* the line that was the position of the file pointer */
144 /* when SPCEC was called. In other words, SPCEC does */
145 /* not rewind or backspace this file before writing */
146 /* the text to it. */
147
148 /* $ Particulars */
149
150 /* The structure of SPK and CK files accommodates comments in */
151 /* addition to data. The following three routines are available */
152 /* for accessing the comment area of a binary SPK or CK file: */
153
154 /* SPCAC add comments */
155
156 /* SPCEC extract comments */
157
158 /* SPCDC delete comments */
159
160 /* Note that comments must consist of only text, that is, printable */
161 /* ASCII characters, specifically ASCII 32-126. This excludes */
162 /* tabs (ASCII 9) and control characters. */
163
164 /* The SPC conversion routines---SPCB2A, SPCA2B, SPCB2T, and */
165 /* SPCT2B---include these comments when converting SPK and CK */
166 /* files between binary and text formats. */
167
168 /* $ Examples */
169
170 /* Suppose we have a binary SPK file called A.BSP. The following */
171 /* code fragment stores the contents of the comment area of A.BSP */
172 /* in a text file called COMMENTS.TXT and surrounds the comments */
173 /* with markers. */
174
175 /* CALL DAFOPR ( 'A.BSP', HANDLE ) */
176
177 /* CALL TXTOPN ( 'COMMENTS.TXT', UNIT ) */
178
179 /* WRITE (UNIT,*) '\begincomments' */
180
181 /* CALL SPCEC ( HANDLE, UNIT ) */
182
183 /* WRITE (UNIT,*) '\endcomments' */
184
185 /* $ Restrictions */
186
187 /* 1) Use TXTOPN to open new text files and get their logical unit. */
188 /* There are system dependencies regarding opening text files, */
189 /* and these have been isolated in the routines TXTOPN and */
190 /* TXTOPR. */
191
192 /* 2) This routine assumes that the comment area of the binary SPK */
193 /* or CK file contains only text stored by SPCAC. Comments */
194 /* written any other way may not be handled properly. */
195
196 /* 3) This routine is only used to read records on environments */
197 /* whose characters are a single byte in size. Updates */
198 /* to this routine and routines in its call tree may be */
199 /* required to properly handle other cases. */
200
201 /* $ Literature_References */
202
203 /* None. */
204
205 /* $ Author_and_Institution */
206
207 /* J.E. McLean (JPL) */
208
209 /* $ Version */
210
211 /* - SPICELIB Version 2.0.0, 16-NOV-2001 (FST) */
212
213 /* Updated this routine to utilize new handle manager */
214 /* interfaces. */
215
216 /* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
217
218 /* Comment section for permuted index source lines was added */
219 /* following the header. */
220
221 /* - SPICELIB Version 1.0.0, 05-APR-1991 (JEM) */
222
223 /* -& */
224 /* $ Index_Entries */
225
226 /* extract comments from spk or ck file */
227
228 /* -& */
229 /* $ Revisions */
230
231 /* - SPICELIB Version 2.0.0, 16-NOV-2001 (FST) */
232
233 /* The call to DAFHLU has been replaced with a call to */
234 /* ZZDDHHLU, the handle manager interface for retrieving */
235 /* a logical unit. DAFHLU is no longer used, since it */
236 /* locks the unit returned to its HANDLE, tying up resources */
237 /* in the handle manager. A call to DAFSIH was inserted to */
238 /* make certain that HANDLE is present in DAFAH's file table. */
239
240 /* -& */
241
242 /* SPICELIB functions */
243
244
245 /* Local parameters */
246
247 /* IFNLEN is the length of a DAF internal file name. */
248
249 /* MAXCPR is the maximum number of characters per DAF record and */
250 /* hence the maximum comment line length. */
251
252
253 /* Local variables */
254
255
256 /* Standard SPICE error handling. */
257
258 if (return_()) {
259 return 0;
260 } else {
261 chkin_("SPCEC", (ftnlen)5);
262 }
263
264 /* First, check to see if HANDLE is a legitimate DAF handle. */
265
266 dafsih_(handle, "READ", (ftnlen)4);
267 if (failed_()) {
268 chkout_("SPCEC", (ftnlen)5);
269 return 0;
270 }
271
272 /* Read the file record to find out if the DAF contains any */
273 /* reserved records. The reserved records in an array file */
274 /* are stored between the first record and the first summary */
275 /* record. FWARD is the record number of that first summary */
276 /* record, and NRR is the number of reserved records in the file. */
277 /* If there are no reserved records, there's nothing to be done. */
278
279 dafrfr_(handle, &nd, &ni, ifname, &fward, &bward, &free, (ftnlen)60);
280 nrr = fward - 2;
281 if (nrr == 0) {
282 chkout_("SPCEC", (ftnlen)5);
283 return 0;
284 }
285
286 /* We need to read directly from the SPK or CK file, using a logical */
287 /* unit instead of a handle. */
288
289 zzddhhlu_(handle, "DAF", &c_false, &dafu, (ftnlen)3);
290 if (failed_()) {
291 chkout_("SPCEC", (ftnlen)5);
292 return 0;
293 }
294
295 /* Load the contents of the reserved records into individual lines, */
296 /* for printing. Keep adding characters to the current line until */
297 /* it has been filled, then write it to the text file, and */
298 /* begin a new line. */
299
300 /* In the comment area, NULL means end-of-line, and EOT means */
301 /* end-of-transmission, or in other words, end-of-comments. */
302
303 *(unsigned char *)null = '\0';
304 *(unsigned char *)eot = '\4';
305 s_copy(line, " ", (ftnlen)1000, (ftnlen)1);
306 s_copy(record, " ", (ftnlen)1000, (ftnlen)1);
307 pos = 0;
308 i__1 = nrr;
309 for (rec = 1; rec <= i__1; ++rec) {
310 io___16.ciunit = dafu;
311 io___16.cirec = rec + 1;
312 iostat = s_rdue(&io___16);
313 if (iostat != 0) {
314 goto L100001;
315 }
316 iostat = do_uio(&c__1, record, (ftnlen)1000);
317 if (iostat != 0) {
318 goto L100001;
319 }
320 iostat = e_rdue();
321 L100001:
322 if (iostat != 0) {
323 setmsg_("Error reading comment area of the binary file named FNM"
324 ". Value of IOSTAT is #.", (ftnlen)79);
325 errint_("#", &iostat, (ftnlen)1);
326 errfnm_("FNM", &dafu, (ftnlen)3);
327 sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21);
328 chkout_("SPCEC", (ftnlen)5);
329 return 0;
330 }
331 for (c__ = 1; c__ <= 1000; ++c__) {
332
333 /* End-of-transmission means we're done. */
334
335 if (*(unsigned char *)&record[c__ - 1] == *(unsigned char *)eot) {
336 chkout_("SPCEC", (ftnlen)5);
337 return 0;
338
339 /* NULL means that the current line is ready to be written to */
340 /* the text file. The end-of-line character itself does not */
341 /* get written. After this, the current line should be empty */
342 /* again. */
343
344 } else if (*(unsigned char *)&record[c__ - 1] == *(unsigned char *
345 )null) {
346 if (pos == 0) {
347 io___18.ciunit = *unit;
348 iostat = s_wsle(&io___18);
349 if (iostat != 0) {
350 goto L100002;
351 }
352 iostat = e_wsle();
353 L100002:
354 ;
355 } else {
356 ci__1.cierr = 1;
357 ci__1.ciunit = *unit;
358 ci__1.cifmt = "(A)";
359 iostat = s_wsfe(&ci__1);
360 if (iostat != 0) {
361 goto L100003;
362 }
363 iostat = do_fio(&c__1, line, pos);
364 if (iostat != 0) {
365 goto L100003;
366 }
367 iostat = e_wsfe();
368 L100003:
369 ;
370 }
371 if (iostat != 0) {
372 setmsg_("Error writing to the text file named FNM. Valu"
373 "e of IOSTAT is #.", (ftnlen)64);
374 errint_("#", &iostat, (ftnlen)1);
375 sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22);
376 chkout_("SPCEC", (ftnlen)5);
377 return 0;
378 }
379 s_copy(line, " ", (ftnlen)1000, (ftnlen)1);
380 pos = 0;
381
382 /* If this a normal character, add it to the current line. */
383
384 } else {
385 ++pos;
386 *(unsigned char *)&line[pos - 1] = *(unsigned char *)&record[
387 c__ - 1];
388 }
389 }
390 }
391 chkout_("SPCEC", (ftnlen)5);
392 return 0;
393 } /* spcec_ */
394
395