1 /* dafbt.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 static integer c__3 = 3;
13 static integer c__2 = 2;
14
15 /* $Procedure DAFBT ( DAF, convert binary file to transfer file ) */
dafbt_(char * binfil,integer * xfrlun,ftnlen binfil_len)16 /* Subroutine */ int dafbt_(char *binfil, integer *xfrlun, ftnlen binfil_len)
17 {
18 /* System generated locals */
19 address a__1[3];
20 integer i__1[3], i__2, i__3;
21 char ch__1[10], ch__2[62], ch__3[1002];
22 cilist ci__1;
23
24 /* Builtin functions */
25 integer s_rdue(cilist *), do_uio(integer *, char *, ftnlen), e_rdue(void),
26 s_wsfe(cilist *), do_fio(integer *, char *, ftnlen), e_wsfe(void)
27 ;
28 /* Subroutine */ int s_cat(char *, char **, integer *, integer *, ftnlen);
29 integer s_rnge(char *, integer, char *, integer);
30 /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
31
32 /* Local variables */
33 char name__[1000];
34 integer free;
35 char line[80];
36 extern /* Subroutine */ int zzddhhlu_(integer *, char *, logical *,
37 integer *, ftnlen), dafgn_(char *, ftnlen), dafgs_(doublereal *),
38 chkin_(char *, ftnlen);
39 integer bward;
40 extern /* Subroutine */ int dafus_(doublereal *, integer *, integer *,
41 doublereal *, integer *);
42 integer fward;
43 logical found;
44 extern /* Subroutine */ int repmi_(char *, char *, integer *, char *,
45 ftnlen, ftnlen, ftnlen);
46 extern integer rtrim_(char *, ftnlen);
47 extern /* Subroutine */ int dafgda_(integer *, integer *, integer *,
48 doublereal *), daffna_(logical *);
49 integer nd;
50 extern logical failed_(void);
51 extern /* Subroutine */ int dafbfs_(integer *);
52 integer dtabeg, ni;
53 extern /* Subroutine */ int dafcls_(integer *);
54 char ifname[60];
55 integer binhdl;
56 extern /* Subroutine */ int dafrfr_(integer *, integer *, integer *, char
57 *, integer *, integer *, integer *, ftnlen);
58 doublereal buffer[1024];
59 integer dtacnt;
60 extern /* Subroutine */ int dafopr_(char *, integer *, ftnlen), wrencd_(
61 integer *, integer *, doublereal *);
62 integer binlun;
63 char idword[8];
64 integer numdta;
65 extern /* Subroutine */ int errfnm_(char *, integer *, ftnlen), sigerr_(
66 char *, ftnlen);
67 integer snmlen;
68 extern /* Subroutine */ int chkout_(char *, ftnlen), wrenci_(integer *,
69 integer *, integer *);
70 integer iostat, numarr, numlft;
71 extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *,
72 integer *, ftnlen);
73 extern logical return_(void);
74 doublereal dsumry[125];
75 integer isumry[250];
76 doublereal summry[125];
77
78 /* Fortran I/O blocks */
79 static cilist io___4 = { 1, 0, 1, 0, 1 };
80
81
82 /* $ Abstract */
83
84 /* Convert the contents of a binary DAF file to an equivalent DAF */
85 /* transfer file. */
86
87 /* $ Disclaimer */
88
89 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
90 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
91 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
92 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
93 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
94 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
95 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
96 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
97 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
98 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
99
100 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
101 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
102 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
103 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
104 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
105 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
106
107 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
108 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
109 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
110 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
111
112 /* $ Required_Reading */
113
114 /* DAF */
115
116 /* $ Keywords */
117
118 /* CONVERSION */
119 /* FILES */
120
121 /* $ Declarations */
122 /* $ Brief_I/O */
123
124 /* Variable I/O Description */
125 /* -------- --- -------------------------------------------------- */
126 /* BINFIL I The name of a binary DAF file to be converted. */
127 /* XFRLUN I Logical unit of a previously opened file. */
128
129 /* $ Detailed_Input */
130
131 /* BINFIL The name of a binary DAF file which is to be converted */
132 /* to an equivalent DAF transfer file. */
133
134 /* XFRLUN The Fortran logical unit number of a previously opened */
135 /* file. The DAF transfer file will be written to the */
136 /* file attached to this logical unit beginning at the */
137 /* current position in the file. */
138
139 /* $ Detailed_Output */
140
141 /* None. */
142
143 /* $ Parameters */
144
145 /* None. */
146
147 /* $ Files */
148
149 /* See arguments BINFIL, XFRLUN. */
150
151 /* $ Exceptions */
152
153
154 /* 1) If the binary DAF file specified by the filename BINFIL */
155 /* cannot be opened for read access, an appropriate error */
156 /* message will be signalled by a DAF file access routine that */
157 /* is called. */
158
159 /* 2) If for some reason the DAF transfer file cannot be written */
160 /* to, the error SPICE(FILEWRITEFAILED) is signalled. */
161
162 /* 3) If, for any reason, the DAF file cannot be read, a DAF file */
163 /* access routine will signal an error with appropriate error */
164 /* message. */
165
166 /* 4) If the ID word cannot be read from the binary file, the error */
167 /* SPICE(FILEREADFAILED) will be signalled. */
168
169 /* 5) The binary DAF file opened by this routine, BINFIL, is only */
170 /* GUARANTEED to be closed upon successful completion of the */
171 /* conversion process. In the event of an error, the caller of */
172 /* this routine is required to close the binary DAF file BINFIL. */
173
174 /* $ Particulars */
175
176 /* Any binary DAF file may be transferred between heterogeneous */
177 /* Fortran environments by converting it to an equivalent file */
178 /* containing only ASCII characters. Such a file can be transferred */
179 /* almost universally, using any number of established protocols. */
180 /* Once transferred, the ASCII file can be converted to a binary */
181 /* file, using the representations native to the new host */
182 /* environment. */
183
184 /* This routine provides a mechanism for converting a binary DAF */
185 /* file into an equivalent encoded ASCII file called a DAF transfer */
186 /* file. It is one of a pair of routines for performing conversions */
187 /* between the binary format of a DAF file and the DAF transfer file. */
188 /* The inverse of this routine is the routine DAFTB. */
189
190 /* The contents of the reserved records in a binary DAF file are */
191 /* ignored by this routine. They are not written to the DAF transfer */
192 /* file. The reserved records must be dealt with separately from the */
193 /* data in a DAF file. */
194
195 /* Upon successful completion, the DAF transfer file attached to */
196 /* Fortran logical unit XFRLUN will contain the same data as the */
197 /* binary DAF file BINFIL. The binary DAF file BINFIL will be closed */
198 /* when this routine exits. The DAF transfer file will remain open, */
199 /* as it was on entry, and it will be positioned to write on the */
200 /* first line following the encoded DAF data. */
201
202 /* $ Examples */
203
204 /* Let */
205
206 /* BINFIL be the name of a binary DAF file which is to be */
207 /* converted to an equivalent DAF transfer file. */
208
209 /* XFRLUN be the Fortran logical unit to which the DAF transfer */
210 /* file is to be written. */
211
212 /* The following subroutine call would read the binary DAF */
213 /* file with the name BINFIL, convert its data into an encoded */
214 /* format, and write that data to the DAF transfer file attached */
215 /* to the Fortran logical unit XFRLUN, beginning at the current */
216 /* position in the file. */
217
218 /* CALL DAFBT( BINFIL, XFRLUN ) */
219
220 /* $ Restrictions */
221
222 /* None. */
223
224 /* $ Literature_References */
225
226 /* None. */
227
228 /* $ Author_and_Institution */
229
230 /* K.R. Gehringer (JPL) */
231
232 /* $ Version */
233
234 /* - SPICELIB Version 4.0.0, 16-NOV-2001 (FST) */
235
236 /* Updated the routine to utilize the new handle manager */
237 /* interfaces. */
238
239 /* - SPICELIB Version 3.0.0, 25-JAN-1995 (KRG) */
240
241 /* Updated the header and in line comments to reflect the change */
242 /* from calling files text files to calling them transfer files. */
243
244 /* Changed the variable name TXTLUN to XFRLUN to make it */
245 /* compatible with the change in terminology. */
246
247 /* - SPICELIB Version 2.0.0, 04-OCT-1993 (KRG) */
248
249 /* No changes to this routine were necessary to incorporate the */
250 /* new file ID word format. This routine already read and copied */
251 /* the ID word to the text file being created. */
252
253 /* Also, all list directed writes in this routine were replaced by */
254 /* formatted writes with FMT = '(A)'. This routine only writes */
255 /* character data. */
256
257 /* Added a test of FAILED() after the call to DAFHLU for */
258 /* completeness. */
259
260 /* - SPICELIB Version 1.0.1, 24-JUN-1993 (KRG) */
261
262 /* Modified the description of the DAF encoded text file format */
263 /* appearing before the program code. */
264
265 /* - SPICELIB Version 1.0.0, 29-OCT-1992 (KRG) */
266
267 /* -& */
268 /* $ Index_Entries */
269
270 /* convert binary daf into a daf transfer file */
271
272 /* -& */
273 /* $ Revisions */
274
275 /* - SPICELIB Version 4.0.0, 16-NOV-2001 (FST) */
276
277 /* This routine still uses a naked READ to retrieve the */
278 /* file IDWORD from the first 8 characters stored in the */
279 /* file record. It may be that future environments */
280 /* will have characters whose storage exceeds 1 byte, */
281 /* in which case this routine will require modification. */
282 /* One possibility is to call the private file record */
283 /* reader ZZDAFGFR, which must address the translation */
284 /* for all supported non-native binary file formats on this */
285 /* platform. */
286
287 /* The existing call to DAFHLU was replaced with ZZDDHHLU. */
288 /* The call to DAFRDA was replaced with a call to the new, */
289 /* translation-aware routine DAFGDA. */
290
291 /* - SPICELIB Version 2.0.0, 04-OCT-1993 (KRG) */
292
293 /* No changes to this routine were necessary to incorporate the */
294 /* new file ID word format. This routine already read and copied */
295 /* the ID word to the text file being created. */
296
297 /* Also, all list directed writes in this routine were replaced by */
298 /* formatted writes with FMT = '(A)'. This routine only writes */
299 /* character data. */
300
301 /* Added a test of FAILED() after the call to DAFHLU for */
302 /* completeness. */
303
304 /* - SPICELIB Version 1.0.1, 24-JUN-1993 (KRG) */
305
306 /* Modified the description of the DAF encoded text file format */
307 /* appearing before the program code. Changed the line: */
308
309 /* C < DAF ND value > < DAF NI value > */
310
311 /* to the lines: */
312
313 /* C < DAF ND value > */
314 /* C < DAF NI value > */
315
316 /* This change was necessary because the output format for the */
317 /* low level routines which encode and write the data were */
318 /* modified to fix a problem. See the routines WRENCD and WRENCI */
319 /* for details of the modification. */
320
321 /* - SPICELIB Version 1.0.0, 29-OCT-1992 (KRG) */
322
323 /* -& */
324
325 /* SPICELIB functions */
326
327
328 /* Local parameters */
329
330
331 /* Local variables */
332
333
334 /* Standard SPICE error handling. */
335
336 if (return_()) {
337 return 0;
338 } else {
339 chkin_("DAFBT", (ftnlen)5);
340 }
341
342 /* A brief description of the DAF transfer file format and its */
343 /* intended use follows. This description is intended to provide a */
344 /* simple ``picture'' of the DAF transfer file format to aid in the */
345 /* understanding of this routine. This description is NOT intended to */
346 /* be a detailed specification of the file format. */
347
348 /* A DAF transfer file contains all of the data from a binary */
349 /* DAF file, except for the reserved record area, in an encoded */
350 /* ASCII format. The file also contains some bookkeeping information */
351 /* for maintaining the integrity of the data. The DAF transfer file */
352 /* format allows the full precision of both integer and floating */
353 /* point numeric data to be maintained in a portable fashion. The DAF */
354 /* transfer file format is intended to provide a reliable and */
355 /* accurate means for porting data among multiple computer systems */
356 /* and for the archival storage of data. */
357
358 /* A DAF transfer file is not intended to be used directly to */
359 /* provide data to a program, the equivalent binary DAF file is */
360 /* to be used for this purpose. In no way should any program, other */
361 /* than a DAF binary <-> transfer conversion program, rely on the DAF */
362 /* encoded transfer file format. */
363
364 /* To correctly understand the DAF transfer file description */
365 /* the reader should be familiar with the DAF file architecture. */
366 /* Items enclosed in angle brackets, '<' and '>', are used to */
367 /* represent the data which is to be placed at that position in */
368 /* the file. The bookkeeping information is represented exactly */
369 /* as it would appear in a DAF transfer file. */
370
371 /* Let */
372
373 /* BOF denote the beginning of the file */
374 /* EOF denote the end of the file */
375
376 /* and */
377
378 /* n denote the total number of arrays in a DAF file */
379 /* NA(i) denote the number of double precision numbers in array i */
380 /* m(i) denote the number of blocks of encoded data for array i */
381 /* N(i,j) denote the number of encoded double precision numbers */
382 /* in block j of array i */
383
384 /* and */
385
386 /* m(i) */
387 /* ----- */
388 /* \ */
389 /* > N(i,k) = NA(i), i = 1, ..., n. */
390 /* / */
391 /* ----- */
392 /* k=1 */
393
394 /* A DAF encoded transfer file has the following format: */
395
396 /* <BOF> */
397 /* < Information line > */
398 /* < DAF file ID word > */
399 /* < DAF ND value > */
400 /* < DAF NI value > */
401 /* < DAF internal file name > */
402 /* BEGIN_ARRAY 1 NA(1) */
403 /* < Name for array 1 > */
404 /* < ND double precision summary values > */
405 /* < NI-2 integer summary values > */
406 /* N(1,1) */
407 /* < N(1,1) Encoded double precision numbers > */
408 /* N(1,2) */
409 /* < N(1,2) Encoded double precision numbers > */
410 /* . */
411 /* . */
412 /* . */
413 /* N(1,m(1)) */
414 /* < N(1,m(1)) Encoded double precision numbers > */
415 /* END_ARRAY 1 NA(1) */
416 /* BEGIN_ARRAY 2 NA(2) */
417 /* < Name for array 2 > */
418 /* < ND double precision summary values > */
419 /* < NI-2 integer summary values > */
420 /* N(2,1) */
421 /* < N(2,1) Encoded double precision numbers > */
422 /* N(2,2) */
423 /* < N(2,2) Encoded double precision numbers > */
424 /* . */
425 /* . */
426 /* . */
427 /* N(2,m(2)) */
428 /* < N(2,m(2)) Encoded double precision numbers > */
429 /* END_ARRAY 2 NA(2) */
430 /* . */
431 /* . */
432 /* . */
433 /* BEGIN_ARRAY n NA(n) */
434 /* < Name for array n > */
435 /* < ND double precision summary values > */
436 /* < NI-2 integer summary values > */
437 /* N(n,1) */
438 /* < N(n,1) Encoded double precision numbers > */
439 /* N(n,2) */
440 /* < N(n,2) Encoded double precision numbers > */
441 /* . */
442 /* . */
443 /* . */
444 /* N(n,m(n)) */
445 /* < N(n,m(n)) Encoded double precision numbers > */
446 /* END_ARRAY n NA(n) */
447 /* TOTAL_ARRAYS n */
448 /* <EOF> */
449
450 /* This routine will check the SPICELIB function FAILED() after */
451 /* each call, or consecutive sequence of calls, to data encoding */
452 /* routines, and if an error was signalled it will simply check out */
453 /* and return to the caller. */
454
455 /* This routine will check the SPICELIB function FAILED() after */
456 /* each DAF file access call, and if an error was signalled it will */
457 /* simply check out and return to the caller. */
458
459 /* We begin by opening the binary DAF file specified by BINFIL for */
460 /* read access, obtaining a DAF file handle. */
461
462 dafopr_(binfil, &binhdl, binfil_len);
463
464 /* If the open failed, check out and return, as an appropriate error */
465 /* message should have already been set. */
466
467 if (failed_()) {
468 chkout_("DAFBT", (ftnlen)5);
469 return 0;
470 }
471
472 /* At this point, we know that we have a DAF file, because we were */
473 /* able to successfully open it, so we will attempt to proceed with */
474 /* the file conversion process. */
475
476 /* Convert the DAF file handle to its equivalent Fortran logical */
477 /* unit. We need to do this in order to accurately move the file */
478 /* ID word to the DAF transfer file. */
479
480 zzddhhlu_(&binhdl, "DAF", &c_false, &binlun, (ftnlen)3);
481
482 /* If the translation failed, checkout and return, as an appropriate */
483 /* error message should have already been set. */
484
485 if (failed_()) {
486 chkout_("DAFBT", (ftnlen)5);
487 return 0;
488 }
489
490 /* Read the ID word from the binary file. It should be the first 8 */
491 /* characters on the first record in the file. */
492
493 io___4.ciunit = binlun;
494 iostat = s_rdue(&io___4);
495 if (iostat != 0) {
496 goto L100001;
497 }
498 iostat = do_uio(&c__1, idword, (ftnlen)8);
499 if (iostat != 0) {
500 goto L100001;
501 }
502 iostat = e_rdue();
503 L100001:
504 if (iostat != 0) {
505 setmsg_("Error reading the file ID word from the binary DAF file '#'"
506 ". IOSTAT = #.", (ftnlen)72);
507 errfnm_("#", &binlun, (ftnlen)1);
508 errint_("#", &iostat, (ftnlen)1);
509 sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21);
510 chkout_("DAFBT", (ftnlen)5);
511 return 0;
512 }
513
514 /* Get the contents of the file record: the number of double */
515 /* precision numbers in the summary (ND), the number of integers */
516 /* in the summary (NI), the internal filename (IFNAME), and some */
517 /* data pointer information (FWARD, BWARD, FREE). */
518
519 dafrfr_(&binhdl, &nd, &ni, ifname, &fward, &bward, &free, (ftnlen)60);
520 if (failed_()) {
521 chkout_("DAFBT", (ftnlen)5);
522 return 0;
523 }
524
525 /* Write the information line containing the file type information */
526 /* for the DAF transfer file format to the current position in the */
527 /* DAF transfer file. The file type information must be the first */
528 /* ``word'' on the information line. The rest of the line may be used */
529 /* for other purposes. Right now, it simply contains an expanded */
530 /* description of the file type information ``word.'' */
531
532 ci__1.cierr = 1;
533 ci__1.ciunit = *xfrlun;
534 ci__1.cifmt = "(A)";
535 iostat = s_wsfe(&ci__1);
536 if (iostat != 0) {
537 goto L100002;
538 }
539 iostat = do_fio(&c__1, "DAFETF NAIF DAF ENCODED TRANSFER FILE", (ftnlen)
540 37);
541 if (iostat != 0) {
542 goto L100002;
543 }
544 iostat = e_wsfe();
545 L100002:
546 if (iostat != 0) {
547 setmsg_("Error writing to the DAF transfer file '#'.IOSTAT = #.", (
548 ftnlen)54);
549 errfnm_("#", xfrlun, (ftnlen)1);
550 errint_("#", &iostat, (ftnlen)1);
551 sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22);
552 chkout_("DAFBT", (ftnlen)5);
553 return 0;
554 }
555
556 /* Write the ID word to the DAF transfer file. */
557
558 ci__1.cierr = 1;
559 ci__1.ciunit = *xfrlun;
560 ci__1.cifmt = "(A)";
561 iostat = s_wsfe(&ci__1);
562 if (iostat != 0) {
563 goto L100003;
564 }
565 /* Writing concatenation */
566 i__1[0] = 1, a__1[0] = "'";
567 i__1[1] = 8, a__1[1] = idword;
568 i__1[2] = 1, a__1[2] = "'";
569 s_cat(ch__1, a__1, i__1, &c__3, (ftnlen)10);
570 iostat = do_fio(&c__1, ch__1, (ftnlen)10);
571 if (iostat != 0) {
572 goto L100003;
573 }
574 iostat = e_wsfe();
575 L100003:
576 if (iostat != 0) {
577 setmsg_("Error writing to the DAF transfer file '#'. IOSTAT = #.", (
578 ftnlen)55);
579 errfnm_("#", xfrlun, (ftnlen)1);
580 errint_("#", &iostat, (ftnlen)1);
581 sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22);
582 chkout_("DAFBT", (ftnlen)5);
583 return 0;
584 }
585
586 /* Write out the ND and NI values for the DAF file architecture. */
587
588 isumry[0] = nd;
589 isumry[1] = ni;
590 wrenci_(xfrlun, &c__2, isumry);
591 if (failed_()) {
592 chkout_("DAFBT", (ftnlen)5);
593 return 0;
594 }
595
596 /* Write out the internal file name. */
597
598 ci__1.cierr = 1;
599 ci__1.ciunit = *xfrlun;
600 ci__1.cifmt = "(A)";
601 iostat = s_wsfe(&ci__1);
602 if (iostat != 0) {
603 goto L100004;
604 }
605 /* Writing concatenation */
606 i__1[0] = 1, a__1[0] = "'";
607 i__1[1] = 60, a__1[1] = ifname;
608 i__1[2] = 1, a__1[2] = "'";
609 s_cat(ch__2, a__1, i__1, &c__3, (ftnlen)62);
610 iostat = do_fio(&c__1, ch__2, (ftnlen)62);
611 if (iostat != 0) {
612 goto L100004;
613 }
614 iostat = e_wsfe();
615 L100004:
616 if (iostat != 0) {
617 setmsg_("Error writing to the DAF transfer file '#'. IOSTAT = #.", (
618 ftnlen)55);
619 errfnm_("#", xfrlun, (ftnlen)1);
620 errint_("#", &iostat, (ftnlen)1);
621 sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22);
622 chkout_("DAFBT", (ftnlen)5);
623 return 0;
624 }
625
626 /* Calculate the length of the segment names. */
627
628 snmlen = nd + (ni + 1) / 2 << 3;
629
630 /* Get ready to begin a forward search through the DAF file for the */
631 /* data. */
632
633 dafbfs_(&binhdl);
634 if (failed_()) {
635 chkout_("DAFBT", (ftnlen)5);
636 return 0;
637 }
638
639 /* Initialize the number of arrays processed to zero. */
640
641 numarr = 0;
642
643 /* We'll assume that we will find some data, until proven otherwise. */
644
645 found = TRUE_;
646
647 /* Begin looking for and processing the arrays in the binary DAF */
648 /* file. */
649
650 while(found) {
651
652 /* Look for a DAF array. */
653
654 daffna_(&found);
655 if (failed_()) {
656 chkout_("DAFBT", (ftnlen)5);
657 return 0;
658 }
659
660 /* If we found an array, then we need to process it. Start */
661 /* by incrementing the number of arrays processed. If not, */
662 /* we just skip to the bottom of the loop. */
663
664 if (found) {
665 ++numarr;
666
667 /* Get and unpack the summary information for the current */
668 /* array. */
669
670 dafgs_(summry);
671 dafus_(summry, &nd, &ni, dsumry, isumry);
672
673 /* Get the name of the current array. */
674
675 dafgn_(name__, (ftnlen)1000);
676 if (failed_()) {
677
678 /* If an error occurred on any of the DAF system calls */
679 /* above, return to the caller. An appropriate error */
680 /* message will have already been set by the routine which */
681 /* signalled the error. */
682
683 chkout_("DAFBT", (ftnlen)5);
684 return 0;
685 }
686
687 /* Get the beginning address for the data in the current array. */
688
689 dtabeg = isumry[(i__2 = ni - 2) < 250 && 0 <= i__2 ? i__2 :
690 s_rnge("isumry", i__2, "dafbt_", (ftnlen)657)];
691
692 /* Set the number of double precision numbers in the current */
693 /* array. */
694
695 dtacnt = isumry[(i__2 = ni - 1) < 250 && 0 <= i__2 ? i__2 :
696 s_rnge("isumry", i__2, "dafbt_", (ftnlen)662)] - isumry[(
697 i__3 = ni - 2) < 250 && 0 <= i__3 ? i__3 : s_rnge("isumry"
698 , i__3, "dafbt_", (ftnlen)662)] + 1;
699 s_copy(line, "BEGIN_ARRAY # #", (ftnlen)80, (ftnlen)15);
700 repmi_(line, "#", &numarr, line, (ftnlen)80, (ftnlen)1, (ftnlen)
701 80);
702 repmi_(line, "#", &dtacnt, line, (ftnlen)80, (ftnlen)1, (ftnlen)
703 80);
704 ci__1.cierr = 1;
705 ci__1.ciunit = *xfrlun;
706 ci__1.cifmt = "(A)";
707 iostat = s_wsfe(&ci__1);
708 if (iostat != 0) {
709 goto L100005;
710 }
711 iostat = do_fio(&c__1, line, rtrim_(line, (ftnlen)80));
712 if (iostat != 0) {
713 goto L100005;
714 }
715 iostat = e_wsfe();
716 L100005:
717 if (iostat != 0) {
718 setmsg_("Error writing to the DAF transfer file '#'. IOSTAT "
719 "= #.", (ftnlen)55);
720 errfnm_("#", xfrlun, (ftnlen)1);
721 errint_("#", &iostat, (ftnlen)1);
722 sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22);
723 chkout_("DAFBT", (ftnlen)5);
724 return 0;
725 }
726
727 /* Write the name of the current array. */
728
729 ci__1.cierr = 1;
730 ci__1.ciunit = *xfrlun;
731 ci__1.cifmt = "(A)";
732 iostat = s_wsfe(&ci__1);
733 if (iostat != 0) {
734 goto L100006;
735 }
736 /* Writing concatenation */
737 i__1[0] = 1, a__1[0] = "'";
738 i__1[1] = snmlen, a__1[1] = name__;
739 i__1[2] = 1, a__1[2] = "'";
740 s_cat(ch__3, a__1, i__1, &c__3, (ftnlen)1002);
741 iostat = do_fio(&c__1, ch__3, snmlen + 2);
742 if (iostat != 0) {
743 goto L100006;
744 }
745 iostat = e_wsfe();
746 L100006:
747 if (iostat != 0) {
748 setmsg_("Error writing to the DAF transfer file '#'. IOSTAT "
749 "= #.", (ftnlen)55);
750 errfnm_("#", xfrlun, (ftnlen)1);
751 errint_("#", &iostat, (ftnlen)1);
752 sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22);
753 chkout_("DAFBT", (ftnlen)5);
754 return 0;
755 }
756
757 /* Write out the double precision part of the summary. */
758
759 wrencd_(xfrlun, &nd, dsumry);
760
761 /* Write out the integer part of the summary, excluding the */
762 /* beginning and ending addresses of the data in the array, */
763 /* ISUMRY(NI-1) and ISUMRY(NI), since these values vary with */
764 /* the number of reserved records allocated. */
765
766 i__2 = ni - 2;
767 wrenci_(xfrlun, &i__2, isumry);
768 if (failed_()) {
769
770 /* If an error occurred on any of the data encoding calls */
771 /* above, return to the caller. An appropriate error message */
772 /* will have already been set by the routine which signalled */
773 /* the error. */
774
775 chkout_("DAFBT", (ftnlen)5);
776 return 0;
777 }
778 numlft = dtacnt;
779 while(numlft > 0) {
780 if (numlft >= 1024) {
781 numdta = 1024;
782 } else {
783 numdta = numlft;
784 }
785
786 /* Read in NUMDTA numbers from the current array. The */
787 /* desired data are specified by beginning and ending */
788 /* indices into the array, inclusive: thus the subtraction */
789 /* of 1 in the call. */
790
791 i__2 = dtabeg + numdta - 1;
792 dafgda_(&binhdl, &dtabeg, &i__2, buffer);
793 if (failed_()) {
794
795 /* We want to check failed here because were in a loop. */
796 /* We should exit the loop, and the routine, as soon as */
797 /* an error is detected, so we don't continue doing */
798 /* things for a long time. */
799
800 chkout_("DAFBT", (ftnlen)5);
801 return 0;
802 }
803
804 /* Write out the count of double precision numbers which are */
805 /* in the buffer. */
806
807 s_copy(line, "#", (ftnlen)80, (ftnlen)1);
808 repmi_(line, "#", &numdta, line, (ftnlen)80, (ftnlen)1, (
809 ftnlen)80);
810 ci__1.cierr = 1;
811 ci__1.ciunit = *xfrlun;
812 ci__1.cifmt = "(A)";
813 iostat = s_wsfe(&ci__1);
814 if (iostat != 0) {
815 goto L100007;
816 }
817 iostat = do_fio(&c__1, line, rtrim_(line, (ftnlen)80));
818 if (iostat != 0) {
819 goto L100007;
820 }
821 iostat = e_wsfe();
822 L100007:
823 if (iostat != 0) {
824 setmsg_("Error writing to the DAF transfer file '#'. IOS"
825 "TAT = #.", (ftnlen)55);
826 errfnm_("#", xfrlun, (ftnlen)1);
827 errint_("#", &iostat, (ftnlen)1);
828 sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22);
829 chkout_("DAFBT", (ftnlen)5);
830 return 0;
831 }
832
833 /* Encode and write out a buffer of double precision */
834 /* numbers. */
835
836 wrencd_(xfrlun, &numdta, buffer);
837 if (failed_()) {
838
839 /* We want to check failed here because were in a loop. */
840 /* We should exit the loop, and the routine, as soon as */
841 /* an error is detected, so we don't continue doing */
842 /* things for a long time. */
843
844 chkout_("DAFBT", (ftnlen)5);
845 return 0;
846 }
847 numlft -= numdta;
848 dtabeg += numdta;
849 }
850 s_copy(line, "END_ARRAY # #", (ftnlen)80, (ftnlen)13);
851 repmi_(line, "#", &numarr, line, (ftnlen)80, (ftnlen)1, (ftnlen)
852 80);
853 repmi_(line, "#", &dtacnt, line, (ftnlen)80, (ftnlen)1, (ftnlen)
854 80);
855 ci__1.cierr = 1;
856 ci__1.ciunit = *xfrlun;
857 ci__1.cifmt = "(A)";
858 iostat = s_wsfe(&ci__1);
859 if (iostat != 0) {
860 goto L100008;
861 }
862 iostat = do_fio(&c__1, line, rtrim_(line, (ftnlen)80));
863 if (iostat != 0) {
864 goto L100008;
865 }
866 iostat = e_wsfe();
867 L100008:
868 if (iostat != 0) {
869 setmsg_("Error writing to the DAF transfer file '#'. IOSTAT "
870 "= #.", (ftnlen)55);
871 errfnm_("#", xfrlun, (ftnlen)1);
872 errint_("#", &iostat, (ftnlen)1);
873 sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22);
874 chkout_("DAFBT", (ftnlen)5);
875 return 0;
876 }
877 }
878
879 /* At this point, one complete DAF array has been written to the */
880 /* DAF transfer file. */
881
882 }
883
884 /* Write out the number of arrays processed. */
885
886 s_copy(line, "TOTAL_ARRAYS #", (ftnlen)80, (ftnlen)14);
887 repmi_(line, "#", &numarr, line, (ftnlen)80, (ftnlen)1, (ftnlen)80);
888 ci__1.cierr = 1;
889 ci__1.ciunit = *xfrlun;
890 ci__1.cifmt = "(A)";
891 iostat = s_wsfe(&ci__1);
892 if (iostat != 0) {
893 goto L100009;
894 }
895 iostat = do_fio(&c__1, line, rtrim_(line, (ftnlen)80));
896 if (iostat != 0) {
897 goto L100009;
898 }
899 iostat = e_wsfe();
900 L100009:
901 if (iostat != 0) {
902 setmsg_("Error writing to the DAF transfer file '#'. IOSTAT = #.", (
903 ftnlen)55);
904 errfnm_("#", xfrlun, (ftnlen)1);
905 errint_("#", &iostat, (ftnlen)1);
906 sigerr_("SPICE(FILEWRITEFAILED)", (ftnlen)22);
907 chkout_("DAFBT", (ftnlen)5);
908 return 0;
909 }
910
911 /* Close only the binary file. */
912
913 dafcls_(&binhdl);
914 chkout_("DAFBT", (ftnlen)5);
915 return 0;
916 } /* dafbt_ */
917
918