1 /* getfat.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 GETFAT ( Get file architecture and type ) */
getfat_(char * file,char * arch,char * kertyp,ftnlen file_len,ftnlen arch_len,ftnlen kertyp_len)14 /* Subroutine */ int getfat_(char *file, char *arch, char *kertyp, ftnlen
15 file_len, ftnlen arch_len, ftnlen kertyp_len)
16 {
17 /* System generated locals */
18 cilist ci__1;
19 olist o__1;
20 cllist cl__1;
21 inlist ioin__1;
22
23 /* Builtin functions */
24 /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
25 integer s_cmp(char *, char *, ftnlen, ftnlen), f_inqu(inlist *), f_open(
26 olist *), s_rdue(cilist *), do_uio(integer *, char *, ftnlen),
27 e_rdue(void), f_clos(cllist *), s_rsfe(cilist *), do_fio(integer *
28 , char *, ftnlen), e_rsfe(void);
29
30 /* Local variables */
31 extern /* Subroutine */ int zzddhfnh_(char *, integer *, logical *,
32 ftnlen), zzddhgsd_(char *, integer *, char *, ftnlen, ftnlen),
33 zzddhnfo_(integer *, char *, integer *, integer *, integer *,
34 logical *, ftnlen), zzddhhlu_(integer *, char *, logical *,
35 integer *, ftnlen);
36 integer i__;
37 char fname[255];
38 extern /* Subroutine */ int chkin_(char *, ftnlen), ucase_(char *, char *,
39 ftnlen, ftnlen), errch_(char *, char *, ftnlen, ftnlen);
40 logical found, exist;
41 extern /* Subroutine */ int ljust_(char *, char *, ftnlen, ftnlen),
42 idw2at_(char *, char *, char *, ftnlen, ftnlen, ftnlen);
43 integer handle;
44 extern /* Subroutine */ int dafcls_(integer *);
45 char filarc[32];
46 integer intbff;
47 logical opened;
48 extern /* Subroutine */ int dafopr_(char *, integer *, ftnlen);
49 integer intarc;
50 char idword[12];
51 integer intamn, number;
52 logical diropn;
53 extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
54 ftnlen), getlun_(integer *), setmsg_(char *, ftnlen);
55 integer iostat;
56 extern /* Subroutine */ int errint_(char *, integer *, ftnlen), nextwd_(
57 char *, char *, char *, ftnlen, ftnlen, ftnlen);
58 char tmpwrd[12];
59 extern logical return_(void);
60 extern /* Subroutine */ int zzckspk_(integer *, char *, ftnlen);
61
62 /* Fortran I/O blocks */
63 static cilist io___14 = { 1, 0, 1, 0, 1 };
64
65
66 /* $ Abstract */
67
68 /* Determine the architecture and type of SPICE kernels. */
69
70 /* $ Disclaimer */
71
72 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
73 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
74 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
75 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
76 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
77 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
78 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
79 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
80 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
81 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
82
83 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
84 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
85 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
86 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
87 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
88 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
89
90 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
91 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
92 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
93 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
94
95 /* $ Required_Reading */
96
97 /* None. */
98
99 /* $ Keywords */
100
101 /* KERNEL */
102 /* UTILITY */
103
104 /* $ Declarations */
105
106 /* $ Abstract */
107
108 /* Parameter declarations for the DAF/DAS handle manager. */
109
110 /* $ Disclaimer */
111
112 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
113 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
114 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
115 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
116 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
117 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
118 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
119 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
120 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
121 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
122
123 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
124 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
125 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
126 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
127 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
128 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
129
130 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
131 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
132 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
133 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
134
135 /* $ Required_Reading */
136
137 /* DAF, DAS */
138
139 /* $ Keywords */
140
141 /* PRIVATE */
142
143 /* $ Particulars */
144
145 /* This include file contains parameters defining limits and */
146 /* integer codes that are utilized in the DAF/DAS handle manager */
147 /* routines. */
148
149 /* $ Restrictions */
150
151 /* None. */
152
153 /* $ Author_and_Institution */
154
155 /* F.S. Turner (JPL) */
156
157 /* $ Literature_References */
158
159 /* None. */
160
161 /* $ Version */
162
163 /* - SPICELIB Version 2.5.0, 10-MAR-2014 (BVS) */
164
165 /* Updated for SUN-SOLARIS-64BIT-INTEL. */
166
167 /* - SPICELIB Version 2.4.0, 10-MAR-2014 (BVS) */
168
169 /* Updated for PC-LINUX-64BIT-IFORT. */
170
171 /* - SPICELIB Version 2.3.0, 10-MAR-2014 (BVS) */
172
173 /* Updated for PC-CYGWIN-GFORTRAN. */
174
175 /* - SPICELIB Version 2.2.0, 10-MAR-2014 (BVS) */
176
177 /* Updated for PC-CYGWIN-64BIT-GFORTRAN. */
178
179 /* - SPICELIB Version 2.1.0, 10-MAR-2014 (BVS) */
180
181 /* Updated for PC-CYGWIN-64BIT-GCC_C. */
182
183 /* - SPICELIB Version 2.0.0, 12-APR-2012 (BVS) */
184
185 /* Increased FTSIZE (from 1000 to 5000). */
186
187 /* - SPICELIB Version 1.20.0, 13-MAY-2010 (BVS) */
188
189 /* Updated for SUN-SOLARIS-INTEL. */
190
191 /* - SPICELIB Version 1.19.0, 13-MAY-2010 (BVS) */
192
193 /* Updated for SUN-SOLARIS-INTEL-CC_C. */
194
195 /* - SPICELIB Version 1.18.0, 13-MAY-2010 (BVS) */
196
197 /* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */
198
199 /* - SPICELIB Version 1.17.0, 13-MAY-2010 (BVS) */
200
201 /* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */
202
203 /* - SPICELIB Version 1.16.0, 13-MAY-2010 (BVS) */
204
205 /* Updated for PC-WINDOWS-64BIT-IFORT. */
206
207 /* - SPICELIB Version 1.15.0, 13-MAY-2010 (BVS) */
208
209 /* Updated for PC-LINUX-64BIT-GFORTRAN. */
210
211 /* - SPICELIB Version 1.14.0, 13-MAY-2010 (BVS) */
212
213 /* Updated for PC-64BIT-MS_C. */
214
215 /* - SPICELIB Version 1.13.0, 13-MAY-2010 (BVS) */
216
217 /* Updated for MAC-OSX-64BIT-INTEL_C. */
218
219 /* - SPICELIB Version 1.12.0, 13-MAY-2010 (BVS) */
220
221 /* Updated for MAC-OSX-64BIT-IFORT. */
222
223 /* - SPICELIB Version 1.11.0, 13-MAY-2010 (BVS) */
224
225 /* Updated for MAC-OSX-64BIT-GFORTRAN. */
226
227 /* - SPICELIB Version 1.10.0, 18-MAR-2009 (BVS) */
228
229 /* Updated for PC-LINUX-GFORTRAN. */
230
231 /* - SPICELIB Version 1.9.0, 18-MAR-2009 (BVS) */
232
233 /* Updated for MAC-OSX-GFORTRAN. */
234
235 /* - SPICELIB Version 1.8.0, 19-FEB-2008 (BVS) */
236
237 /* Updated for PC-LINUX-IFORT. */
238
239 /* - SPICELIB Version 1.7.0, 14-NOV-2006 (BVS) */
240
241 /* Updated for PC-LINUX-64BIT-GCC_C. */
242
243 /* - SPICELIB Version 1.6.0, 14-NOV-2006 (BVS) */
244
245 /* Updated for MAC-OSX-INTEL_C. */
246
247 /* - SPICELIB Version 1.5.0, 14-NOV-2006 (BVS) */
248
249 /* Updated for MAC-OSX-IFORT. */
250
251 /* - SPICELIB Version 1.4.0, 14-NOV-2006 (BVS) */
252
253 /* Updated for PC-WINDOWS-IFORT. */
254
255 /* - SPICELIB Version 1.3.0, 26-OCT-2005 (BVS) */
256
257 /* Updated for SUN-SOLARIS-64BIT-GCC_C. */
258
259 /* - SPICELIB Version 1.2.0, 03-JAN-2005 (BVS) */
260
261 /* Updated for PC-CYGWIN_C. */
262
263 /* - SPICELIB Version 1.1.0, 03-JAN-2005 (BVS) */
264
265 /* Updated for PC-CYGWIN. */
266
267 /* - SPICELIB Version 1.0.1, 17-JUL-2002 */
268
269 /* Added MAC-OSX environments. */
270
271 /* - SPICELIB Version 1.0.0, 07-NOV-2001 */
272
273 /* -& */
274
275 /* Unit and file table size parameters. */
276
277 /* FTSIZE is the maximum number of files (DAS and DAF) that a */
278 /* user may have open simultaneously. */
279
280
281 /* RSVUNT is the number of units protected from being locked */
282 /* to a particular handle by ZZDDHHLU. */
283
284
285 /* SCRUNT is the number of units protected for use by scratch */
286 /* files. */
287
288
289 /* UTSIZE is the maximum number of logical units this manager */
290 /* will utilize at one time. */
291
292
293 /* Access method enumeration. These parameters are used to */
294 /* identify which access method is associated with a particular */
295 /* handle. They need to be synchronized with the STRAMH array */
296 /* defined in ZZDDHGSD in the following fashion: */
297
298 /* STRAMH ( READ ) = 'READ' */
299 /* STRAMH ( WRITE ) = 'WRITE' */
300 /* STRAMH ( SCRTCH ) = 'SCRATCH' */
301 /* STRAMH ( NEW ) = 'NEW' */
302
303 /* These values are used in the file table variable FTAMH. */
304
305
306 /* Binary file format enumeration. These parameters are used to */
307 /* identify which binary file format is associated with a */
308 /* particular handle. They need to be synchronized with the STRBFF */
309 /* array defined in ZZDDHGSD in the following fashion: */
310
311 /* STRBFF ( BIGI3E ) = 'BIG-IEEE' */
312 /* STRBFF ( LTLI3E ) = 'LTL-IEEE' */
313 /* STRBFF ( VAXGFL ) = 'VAX-GFLT' */
314 /* STRBFF ( VAXDFL ) = 'VAX-DFLT' */
315
316 /* These values are used in the file table variable FTBFF. */
317
318
319 /* Some random string lengths... more documentation required. */
320 /* For now this will have to suffice. */
321
322
323 /* Architecture enumeration. These parameters are used to identify */
324 /* which file architecture is associated with a particular handle. */
325 /* They need to be synchronized with the STRARC array defined in */
326 /* ZZDDHGSD in the following fashion: */
327
328 /* STRARC ( DAF ) = 'DAF' */
329 /* STRARC ( DAS ) = 'DAS' */
330
331 /* These values will be used in the file table variable FTARC. */
332
333
334 /* For the following environments, record length is measured in */
335 /* characters (bytes) with eight characters per double precision */
336 /* number. */
337
338 /* Environment: Sun, Sun FORTRAN */
339 /* Source: Sun Fortran Programmer's Guide */
340
341 /* Environment: PC, MS FORTRAN */
342 /* Source: Microsoft Fortran Optimizing Compiler User's Guide */
343
344 /* Environment: Macintosh, Language Systems FORTRAN */
345 /* Source: Language Systems FORTRAN Reference Manual, */
346 /* Version 1.2, page 12-7 */
347
348 /* Environment: PC/Linux, g77 */
349 /* Source: Determined by experiment. */
350
351 /* Environment: PC, Lahey F77 EM/32 Version 4.0 */
352 /* Source: Lahey F77 EM/32 Language Reference Manual, */
353 /* page 144 */
354
355 /* Environment: HP-UX 9000/750, FORTRAN/9000 Series 700 computers */
356 /* Source: FORTRAN/9000 Reference-Series 700 Computers, */
357 /* page 5-110 */
358
359 /* Environment: NeXT Mach OS (Black Hardware), */
360 /* Absoft Fortran Version 3.2 */
361 /* Source: NAIF Program */
362
363
364 /* The following parameter defines the size of a string used */
365 /* to store a filenames on this target platform. */
366
367
368 /* The following parameter controls the size of the character record */
369 /* buffer used to read data from non-native files. */
370
371 /* $ Brief_I/O */
372
373 /* VARIABLE I/O DESCRIPTION */
374 /* -------- --- -------------------------------------------------- */
375 /* FILE I The name of a file to be examined. */
376 /* ARCH O The architecture of the kernel file. */
377 /* KERTYP O The type of the kernel file. */
378
379 /* $ Detailed_Input */
380
381 /* FILE is the name of a SPICE kernel file whose architecture */
382 /* and type are desired. */
383
384 /* $ Detailed_Output */
385
386 /* ARCH is the file architecture of the SPICE kernel file */
387 /* specified be FILE. If the architecture cannot be */
388 /* determined or is not recognized the value '?' is */
389 /* returned. */
390
391 /* Architectures currently recognized are: */
392
393 /* DAF - The file is based on the DAF architecture. */
394 /* DAS - The file is based on the DAS architecture. */
395 /* XFR - The file is in a SPICE transfer file format. */
396 /* DEC - The file is an old SPICE decimal text file. */
397 /* ASC -- An ASCII text file. */
398 /* KPL -- Kernel Pool File (i.e., a text kernel) */
399 /* TXT -- An ASCII text file. */
400 /* TE1 -- Text E-Kernel type 1. */
401 /* ? - The architecture could not be determined. */
402
403 /* This variable must be at least 3 characters long. */
404
405 /* KERTYP is the type of the SPICE kernel file. If the type */
406 /* can not be determined the value '?' is returned. */
407
408 /* Kernel file types may be any sequence of at most four */
409 /* printing characters. NAIF has reserved for its use */
410 /* types which contain all upper case letters. */
411
412 /* A file type of 'PRE' means that the file is a */
413 /* pre-release file. */
414
415 /* This variable may be at most 4 characters long. */
416
417 /* $ Parameters */
418
419 /* RECL is the record length of a binary kernel file. Each */
420 /* record must be large enough to hold 128 double */
421 /* precision numbers. The units in which the record */
422 /* length must be specified vary from environment to */
423 /* environment. For example, VAX Fortran requires */
424 /* record lengths to be specified in longwords, */
425 /* where two longwords equal one double precision */
426 /* number. */
427
428 /* $ Exceptions */
429
430 /* 1) If the filename specified is blank, then the error */
431 /* SPICE(BLANKFILENAME) is signaled. */
432
433 /* 2) If any inquire on the filename specified by FILE fails for */
434 /* some reason, the error SPICE(INQUIREERROR) is signaled. */
435
436 /* 3) If the file specified by FILE does not exist, the error */
437 /* SPICE(FILENOTFOUND) is signaled. */
438
439 /* 4) If the file specified by FILE is already open but not through */
440 /* SPICE interfaces, the error SPICE(EXTERNALOPEN) is signaled. */
441
442 /* 5) If an attempt to open the file specified by FILE fails when */
443 /* this routine requires that it succeed, the error */
444 /* SPICE(FILEOPENFAILED) is signaled. */
445
446 /* 6) If an attempt to read the file specified by FILE fails when */
447 /* this routine requires that it succeed, the error */
448 /* SPICE(FILEREADFAILED) is signaled. */
449
450 /* 7) Routines in the call tree of this routine may trap and */
451 /* signal errors. */
452
453 /* 8) If the ID word in a DAF based kernel is NAIF/DAF, then the */
454 /* algorithm GETFAT uses to distinguish between CK and SPK */
455 /* kernels may result in an indeterminate KERTYP if the SPK or */
456 /* CK files have invalid first segments. */
457
458 /* $ Files */
459
460 /* The SPICE kernel file specified by FILE is examined by this */
461 /* routine to determine its architecture and type. If the file */
462 /* named by FILE is not connected to a logical unit or loaded */
463 /* in the handle manager, this routine will OPEN and CLOSE it. */
464
465 /* $ Particulars */
466
467 /* This subroutine is a support utility routine that determines the */
468 /* architecture and type of a SPICE kernel file. */
469
470 /* $ Examples */
471
472 /* Suppose you wish to write a single routine for loading binary */
473 /* kernels. You can use this routine to determine the type of the */
474 /* file and then pass the file to the appropriate low level file */
475 /* loader to handle the actual loading of the file. */
476
477 /* CALL GETFAT ( FILE, ARCH, KERTYP ) */
478
479 /* IF ( KERTYP .EQ. 'SPK' ) THEN */
480
481 /* CALL SPKLEF ( FILE, HANDLE ) */
482
483 /* ELSE IF ( KERTYP .EQ. 'CK' ) THEN */
484
485 /* CALL CKLPF ( FILE, HANDLE ) */
486
487 /* ELSE IF ( KERTYP .EQ. 'EK' ) THEN */
488
489 /* CALL EKLEF ( FILE, HANDLE ) */
490
491 /* ELSE */
492
493 /* WRITE (*,*) 'The file could not be identified as a known' */
494 /* WRITE (*,*) 'kernel type. Did you load the wrong file' */
495 /* WRITE (*,*) 'by mistake?' */
496
497 /* END IF */
498
499
500 /* $ Restrictions */
501
502 /* 1) In order to properly determine the type of DAF based binary */
503 /* kernels, the routine requires that their first segments and */
504 /* the meta data necessary to address them are valid. */
505
506 /* $ Literature_References */
507
508 /* None. */
509
510 /* $ Author_and_Institution */
511
512 /* K.R. Gehringer (JPL) */
513 /* H.A. Neilan (JPL) */
514 /* W.L. Taber (JPL) */
515 /* F.S. Turner (JPL) */
516 /* E.D. Wright (JPL) */
517
518 /* $ Version */
519
520 /* - SPICELIB Version 5.0.0, 05-FEB-2015 (NJB) */
521
522 /* Updated to support integration of DAS into the */
523 /* handle manager subsystem. Now opened DAS files */
524 /* must be known to that subsystem; if this routine */
525 /* encounters an open, unrecognized DAS file, an */
526 /* error is signaled. */
527
528 /* Corrected various typos in comments. */
529
530 /* - SPICELIB Version 4.25.0, 10-MAR-2014 (BVS) */
531
532 /* Updated for SUN-SOLARIS-64BIT-INTEL. */
533
534 /* - SPICELIB Version 4.24.0, 10-MAR-2014 (BVS) */
535
536 /* Updated for PC-LINUX-64BIT-IFORT. */
537
538 /* - SPICELIB Version 4.23.0, 10-MAR-2014 (BVS) */
539
540 /* Updated for PC-CYGWIN-GFORTRAN. */
541
542 /* - SPICELIB Version 4.22.0, 10-MAR-2014 (BVS) */
543
544 /* Updated for PC-CYGWIN-64BIT-GFORTRAN. */
545
546 /* - SPICELIB Version 4.21.0, 10-MAR-2014 (BVS) */
547
548 /* Updated for PC-CYGWIN-64BIT-GCC_C. */
549
550 /* - SPICELIB Version 4.20.0, 13-MAY-2010 (BVS) */
551
552 /* Updated for SUN-SOLARIS-INTEL. */
553
554 /* - SPICELIB Version 4.19.0, 13-MAY-2010 (BVS) */
555
556 /* Updated for SUN-SOLARIS-INTEL-CC_C. */
557
558 /* - SPICELIB Version 4.18.0, 13-MAY-2010 (BVS) */
559
560 /* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */
561
562 /* - SPICELIB Version 4.17.0, 13-MAY-2010 (BVS) */
563
564 /* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */
565
566 /* - SPICELIB Version 4.16.0, 13-MAY-2010 (BVS) */
567
568 /* Updated for PC-WINDOWS-64BIT-IFORT. */
569
570 /* - SPICELIB Version 4.15.0, 13-MAY-2010 (BVS) */
571
572 /* Updated for PC-LINUX-64BIT-GFORTRAN. */
573
574 /* - SPICELIB Version 4.14.0, 13-MAY-2010 (BVS) */
575
576 /* Updated for PC-64BIT-MS_C. */
577
578 /* - SPICELIB Version 4.13.0, 13-MAY-2010 (BVS) */
579
580 /* Updated for MAC-OSX-64BIT-INTEL_C. */
581
582 /* - SPICELIB Version 4.12.0, 13-MAY-2010 (BVS) */
583
584 /* Updated for MAC-OSX-64BIT-IFORT. */
585
586 /* - SPICELIB Version 4.11.0, 13-MAY-2010 (BVS) */
587
588 /* Updated for MAC-OSX-64BIT-GFORTRAN. */
589
590 /* - SPICELIB Version 4.10.0, 18-MAR-2009 (BVS) */
591
592 /* Updated for PC-LINUX-GFORTRAN. */
593
594 /* - SPICELIB Version 4.9.0, 18-MAR-2009 (BVS) */
595
596 /* Updated for MAC-OSX-GFORTRAN. */
597
598 /* - SPICELIB Version 4.8.0, 19-FEB-2008 (BVS) */
599
600 /* Updated for PC-LINUX-IFORT. */
601
602 /* - SPICELIB Version 4.7.0, 14-NOV-2006 (BVS) */
603
604 /* Updated for PC-LINUX-64BIT-GCC_C. */
605
606 /* - SPICELIB Version 4.6.0, 14-NOV-2006 (BVS) */
607
608 /* Updated for MAC-OSX-INTEL_C. */
609
610 /* - SPICELIB Version 4.5.0, 14-NOV-2006 (BVS) */
611
612 /* Updated for MAC-OSX-IFORT. */
613
614 /* - SPICELIB Version 4.4.0, 14-NOV-2006 (BVS) */
615
616 /* Updated for PC-WINDOWS-IFORT. */
617
618 /* - SPICELIB Version 4.3.0, 26-OCT-2005 (BVS) */
619
620 /* Updated for SUN-SOLARIS-64BIT-GCC_C. */
621
622 /* - SPICELIB Version 4.2.0, 03-JAN-2005 (BVS) */
623
624 /* Updated for PC-CYGWIN_C. */
625
626 /* - SPICELIB Version 4.1.0, 03-JAN-2005 (BVS) */
627
628 /* Updated for PC-CYGWIN. */
629
630 /* - SPICELIB Version 4.0.2, 24-APR-2003 (EDW) */
631
632 /* Added MAC-OSX-F77 to the list of platforms */
633 /* that require READONLY to read write protected */
634 /* kernels. */
635
636 /* - SPICELIB Version 4.0.1, 17-JUL-2002 (BVS) */
637
638 /* Added MAC-OSX environments. */
639
640 /* - SPICELIB Version 4.0.0, 22-AUG-2001 (WLT) (FST) (EDW) */
641
642 /* Added code so that the architecture and type of open binary */
643 /* SPICE kernels can be determined. */
644
645 /* Added exception for MACPPC_C (CodeWarrior Mac classic). */
646 /* Reduced RECL value to 12 to prevent expression of */
647 /* the fseek bug. */
648
649 /* - SPICELIB Version 3.2.0, 06-DEC-1999 (WLT) */
650
651 /* The heuristics for distinguishing between CK and SPK have */
652 /* been enhanced so that the routine is no longer requires */
653 /* that TICKS in C-kernels be positive or integral. */
654
655 /* - SPICELIB Version 3.1.4, 08-OCT-1999 (WLT) */
656
657 /* The environment lines were expanded so that the supported */
658 /* environments are now explicitly given. New */
659 /* environments are WIN-NT */
660
661 /* - SPICELIB Version 3.1.3, 22-SEP-1999 (NJB) */
662
663 /* CSPICE environments were added. Some typos were corrected. */
664
665 /* - SPICELIB Version 3.1.2, 28-JUL-1999 (WLT) */
666
667 /* The environment lines were expanded so that the supported */
668 /* environments are now explicitly given. New */
669 /* environments are PC-DIGITAL, SGI-O32 and SGI-N32. */
670
671 /* - SPICELIB Version 3.1.1, 18-MAR-1999 (WLT) */
672
673 /* The environment lines were expanded so that the supported */
674 /* environments are now explicitly given. Previously, */
675 /* environments such as SUN-SUNOS and SUN-SOLARIS were implied */
676 /* by the environment label SUN. */
677
678 /* - SPICELIB Version 3.1.0, 11-FEB-1999 (FST) */
679
680 /* Added an integrality check to Test 3. If LASTDP is not */
681 /* an integral value, then GETFAT simply returns KERTYP = '?', */
682 /* since it is of an indeterminate type. */
683
684 /* - SPICELIB Version 3.0.0, 07-APR-1998 (NJB) */
685
686 /* Module was updated for the PC-LINUX platform. */
687
688 /* - SPICELIB Version 2.0.0, 19-DEC-1995 (KRG) */
689
690 /* Added several new features to the subroutine: */
691
692 /* - Error handling has been enhanced. */
693 /* - Several new file architectures have been added. */
694
695 /* Removed the mention of 1000 characters as a candidate for the */
696 /* record length of a file. */
697
698 /* Added the exception for a blank filename to the header. The */
699 /* error is signaled, but it was not listed in the header. */
700
701 /* Added IOSTAT values to the appropriate error messages. */
702
703 /* Non-printing characters are replaced with blanks in the ID */
704 /* word when it is read. This deals with the case where a */
705 /* platform allows a text file to be opened as an unformatted */
706 /* file and the ID word does not completely fill 8 characters. */
707
708 /* - SPICELIB Version 1.4.0, 5-JAN-1995 (HAN) */
709
710 /* Removed ENV11 since it is now the same as ENV2. */
711 /* Removed ENV10 since it is the same as the VAX environment. */
712
713 /* - SPICELIB Version 1.3.0, 30-AUG-1994 (HAN) */
714
715 /* Added two new environments, DEC Alpha/OpenVMS and */
716 /* Sun/Solaris, to the source master file. */
717
718 /* - SPICELIB Version 1.2.0, 25-MAR-1994 (HAN) */
719
720 /* Added two new environments, DEC Alpha/OpenVMS and */
721 /* Sun/Solaris, to the source master file. */
722
723 /* - SPICELIB Version 1.1.0, 25-MAR-1994 (HAN) */
724
725 /* Modified master source code file to use READONLY on platforms */
726 /* that support it. Also, changed some local declaration comment */
727 /* lines to match the standard NAIF template. */
728
729 /* - SPICELIB Version 1.0.0, 24-JUL-1993 (WLT) (HAN) (KRG) */
730
731 /* -& */
732 /* $ Index_Entries */
733
734 /* determine the architecture and type of a kernel file */
735
736 /* -& */
737 /* $ Revisions */
738
739 /* - SPICELIB Version 4.0.0, 22-AUG-2001 (WLT) (FST) */
740
741 /* Added code so that the architecture and type of open binary */
742 /* SPICE kernels can be determined. This uses the new DAF/DAS */
743 /* handle manager as well as examination of handles of open DAS */
744 /* files. Currently the handle manager deals only with DAF */
745 /* files. This routine should be updated again when the DAS */
746 /* system is integrated with the handle manager. */
747
748 /* Some slight changes were required to support ZZDDHFNH on */
749 /* the VAX environment. This resulted in the addition of */
750 /* the logical USEFNH that is set to true in most */
751 /* environments, and never used again other than to allow */
752 /* the invocation of the ZZDDHFNH module. */
753
754 /* - SPICELIB Version 2.0.0, 19-DEC-1995 (KRG) */
755
756 /* Added several new features to the subroutine: */
757
758 /* - Error handling has been enhanced. */
759 /* - Several new file architectures have been added. */
760
761 /* Removed the mention of 1000 characters as a candidate for the */
762 /* record length of a file. It seems unlikely that we will */
763 /* encounter an environment where 1000 characters of storage is */
764 /* larger than the storage necessary for 128 double precision */
765 /* numbers; typically there are 8 characters per double precision */
766 /* number, yielding 1024 characters. */
767
768 /* Added the exception for a blank filename to the header. The */
769 /* error is signaled, but it was not listed in the header. */
770
771 /* Added IOSTAT values to the appropriate error messages. */
772
773 /* Non-printing characters are replaced with blanks in the ID */
774 /* word when it is read. This deals with the case where a */
775 /* platform allows a text file to be opened as an unformatted */
776 /* file and the ID word does not completely fill 8 characters. */
777
778 /* -& */
779
780 /* SPICELIB functions */
781
782
783 /* Local parameters */
784
785
786 /* Set the length of a SPICE kernel file ID word. */
787
788
789 /* Set minimum and maximum values for the range of ASCII printing */
790 /* characters. */
791
792
793 /* Local Variables */
794
795
796 /* Standard SPICE error handling. */
797
798 if (return_()) {
799 return 0;
800 } else {
801 chkin_("GETFAT", (ftnlen)6);
802 }
803
804 /* Initialize the temporary storage variables that we use. */
805
806 s_copy(idword, " ", (ftnlen)12, (ftnlen)1);
807
808 /* If the filename we have is blank, signal an error and return. */
809
810 if (s_cmp(file, " ", file_len, (ftnlen)1) == 0) {
811 setmsg_("The file name is blank.", (ftnlen)23);
812 sigerr_("SPICE(BLANKFILENAME)", (ftnlen)20);
813 chkout_("GETFAT", (ftnlen)6);
814 return 0;
815 }
816
817 /* See if this is a binary file that is currently open */
818 /* within the SPICE binary file management subsystem. At */
819 /* the moment, as far as we know, the file is not opened. */
820
821 opened = FALSE_;
822 zzddhfnh_(file, &handle, &found, file_len);
823 if (found) {
824
825 /* If the file was recognized, we need to get the unit number */
826 /* associated with it. */
827
828 zzddhnfo_(&handle, fname, &intarc, &intbff, &intamn, &found, (ftnlen)
829 255);
830
831 /* Translate the architecture ID to a string and retrieve the */
832 /* logical unit to use with this file. */
833
834 zzddhgsd_("ARCH", &intarc, filarc, (ftnlen)4, (ftnlen)32);
835 zzddhhlu_(&handle, filarc, &c_false, &number, (ftnlen)32);
836 opened = TRUE_;
837 } else {
838
839 /* We'll do a bit of inquiring before we try opening anything. */
840
841 ioin__1.inerr = 1;
842 ioin__1.infilen = file_len;
843 ioin__1.infile = file;
844 ioin__1.inex = ∃
845 ioin__1.inopen = &opened;
846 ioin__1.innum = 0;
847 ioin__1.innamed = 0;
848 ioin__1.inname = 0;
849 ioin__1.inacc = 0;
850 ioin__1.inseq = 0;
851 ioin__1.indir = 0;
852 ioin__1.infmt = 0;
853 ioin__1.inform = 0;
854 ioin__1.inunf = 0;
855 ioin__1.inrecl = 0;
856 ioin__1.innrec = 0;
857 ioin__1.inblank = 0;
858 iostat = f_inqu(&ioin__1);
859
860 /* Not too likely, but if the INQUIRE statement fails... */
861
862 if (iostat != 0) {
863 setmsg_("IOSTAT error in INQUIRE statement. IOSTAT = #.", (ftnlen)
864 46);
865 errint_("#", &iostat, (ftnlen)1);
866 sigerr_("SPICE(INQUIREERROR)", (ftnlen)19);
867 chkout_("GETFAT", (ftnlen)6);
868 return 0;
869 }
870
871 /* Note: the following two tests MUST be performed in the order */
872 /* in which they appear, since in some environments files that do */
873 /* not exist are considered to be open. */
874
875 if (! exist) {
876 setmsg_("The kernel file '#' does not exist.", (ftnlen)35);
877 errch_("#", file, (ftnlen)1, file_len);
878 sigerr_("SPICE(FILENOTFOUND)", (ftnlen)19);
879 chkout_("GETFAT", (ftnlen)6);
880 return 0;
881 }
882
883 /* Reject open files not known to the handle manager subsystem. */
884
885 if (opened) {
886
887 /* Open files that are not opened within the SPICE */
888 /* binary file management subsystem are forbidden fruit. */
889 /* All we can do is signal an error letting the caller */
890 /* know that we are helpless in this case. */
891
892 setmsg_("The file '#' is already open.", (ftnlen)29);
893 errch_("#", file, (ftnlen)1, file_len);
894 sigerr_("SPICE(EXTERNALOPEN)", (ftnlen)19);
895 chkout_("GETFAT", (ftnlen)6);
896 return 0;
897 }
898 }
899
900 /* Open the file with a record length of RECL (the length of the */
901 /* DAF and DAS records). We assume, for now, that opening the file as */
902 /* a direct access file will work. */
903
904 diropn = TRUE_;
905
906 /* If the file is not already open (probably the case that */
907 /* happens most frequently) we try opening it for direct access */
908 /* and see if we can locate the idword. */
909
910 if (! opened) {
911 getlun_(&number);
912 o__1.oerr = 1;
913 o__1.ounit = number;
914 o__1.ofnmlen = file_len;
915 o__1.ofnm = file;
916 o__1.orl = 1024;
917 o__1.osta = "OLD";
918 o__1.oacc = "DIRECT";
919 o__1.ofm = 0;
920 o__1.oblnk = 0;
921 iostat = f_open(&o__1);
922
923 /* If we had trouble opening the file, try opening it as a */
924 /* sequential file. */
925
926 if (iostat != 0) {
927 diropn = FALSE_;
928 o__1.oerr = 1;
929 o__1.ounit = number;
930 o__1.ofnmlen = file_len;
931 o__1.ofnm = file;
932 o__1.orl = 0;
933 o__1.osta = "OLD";
934 o__1.oacc = "SEQUENTIAL";
935 o__1.ofm = 0;
936 o__1.oblnk = 0;
937 iostat = f_open(&o__1);
938
939 /* If we still have problems opening the file, we don't have a */
940 /* clue about the file architecture and type. */
941
942 if (iostat != 0) {
943 s_copy(arch, "?", arch_len, (ftnlen)1);
944 s_copy(kertyp, "?", kertyp_len, (ftnlen)1);
945 setmsg_("Attempt to open the file '#' failed. IOSTAT = #.", (
946 ftnlen)48);
947 errch_("#", file, (ftnlen)1, file_len);
948 errint_("#", &iostat, (ftnlen)1);
949 sigerr_("SPICE(FILEOPENFAILED)", (ftnlen)21);
950 chkout_("GETFAT", (ftnlen)6);
951 return 0;
952 }
953 }
954 }
955
956 /* We opened the file successfully, so let's try to read from the */
957 /* file. We need to be sure to use the correct form of the read */
958 /* statement, depending on whether the file was opened with direct */
959 /* access or sequential access. */
960
961 if (diropn) {
962 io___14.ciunit = number;
963 iostat = s_rdue(&io___14);
964 if (iostat != 0) {
965 goto L100001;
966 }
967 iostat = do_uio(&c__1, tmpwrd, (ftnlen)12);
968 if (iostat != 0) {
969 goto L100001;
970 }
971 iostat = e_rdue();
972 L100001:
973
974 /* If we couldn't read from the file as a direct access file with */
975 /* a fixed record length, then try to open the file as a */
976 /* sequential file and read from it. */
977
978 if (iostat != 0) {
979 if (opened) {
980
981 /* Something has gone wrong here. The file was opened */
982 /* as either a DAF or DAS prior to the call to GETFAT. */
983 /* We retrieved the unit number maintained by the */
984 /* underlying binary file management system, but we */
985 /* were unable to read the file as direct access. */
986 /* There's nothing we can do but abandon our quest to */
987 /* determine the type of the file. */
988
989 setmsg_("The file '#' is opened as a binary SPICE kernel. B"
990 "ut it cannot be read using a direct access read. The"
991 " value of IOSTAT returned by the attempted READ is #"
992 ". ", (ftnlen)157);
993 errch_("#", file, (ftnlen)1, file_len);
994 errint_("#", &iostat, (ftnlen)1);
995 sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21);
996 chkout_("GETFAT", (ftnlen)6);
997 return 0;
998 }
999
1000 /* If we reach this point, the file was opened locally */
1001 /* as a direct access file. We could not read it that */
1002 /* way, so we'll try using a sequential read. However, */
1003 /* we first need to close the file and then reopen it */
1004 /* for sequential reading. */
1005
1006 cl__1.cerr = 0;
1007 cl__1.cunit = number;
1008 cl__1.csta = 0;
1009 f_clos(&cl__1);
1010 o__1.oerr = 1;
1011 o__1.ounit = number;
1012 o__1.ofnmlen = file_len;
1013 o__1.ofnm = file;
1014 o__1.orl = 0;
1015 o__1.osta = "OLD";
1016 o__1.oacc = "SEQUENTIAL";
1017 o__1.ofm = 0;
1018 o__1.oblnk = 0;
1019 iostat = f_open(&o__1);
1020
1021 /* If we could not open the file, we don't have a clue about */
1022 /* the file architecture and type. */
1023
1024 if (iostat != 0) {
1025 s_copy(arch, "?", arch_len, (ftnlen)1);
1026 s_copy(kertyp, "?", kertyp_len, (ftnlen)1);
1027 setmsg_("Attempt to open the file '#' failed. IOSTAT = #.", (
1028 ftnlen)48);
1029 errch_("#", file, (ftnlen)1, file_len);
1030 errint_("#", &iostat, (ftnlen)1);
1031 sigerr_("SPICE(FILEOPENFAILED)", (ftnlen)21);
1032 chkout_("GETFAT", (ftnlen)6);
1033 return 0;
1034 }
1035
1036 /* Try to read from the file. */
1037
1038 ci__1.cierr = 1;
1039 ci__1.ciend = 1;
1040 ci__1.ciunit = number;
1041 ci__1.cifmt = "(A)";
1042 iostat = s_rsfe(&ci__1);
1043 if (iostat != 0) {
1044 goto L100002;
1045 }
1046 iostat = do_fio(&c__1, tmpwrd, (ftnlen)12);
1047 if (iostat != 0) {
1048 goto L100002;
1049 }
1050 iostat = e_rsfe();
1051 L100002:
1052 ;
1053 }
1054 } else {
1055 ci__1.cierr = 1;
1056 ci__1.ciend = 1;
1057 ci__1.ciunit = number;
1058 ci__1.cifmt = "(A)";
1059 iostat = s_rsfe(&ci__1);
1060 if (iostat != 0) {
1061 goto L100003;
1062 }
1063 iostat = do_fio(&c__1, tmpwrd, (ftnlen)12);
1064 if (iostat != 0) {
1065 goto L100003;
1066 }
1067 iostat = e_rsfe();
1068 L100003:
1069 ;
1070 }
1071
1072 /* If we had an error while reading, we don't recognize this file. */
1073
1074 if (iostat != 0) {
1075 s_copy(arch, "?", arch_len, (ftnlen)1);
1076 s_copy(kertyp, "?", kertyp_len, (ftnlen)1);
1077 cl__1.cerr = 0;
1078 cl__1.cunit = number;
1079 cl__1.csta = 0;
1080 f_clos(&cl__1);
1081 setmsg_("Attempt to read from file '#' failed. IOSTAT = #.", (ftnlen)
1082 49);
1083 errch_("#", file, (ftnlen)1, file_len);
1084 errint_("#", &iostat, (ftnlen)1);
1085 sigerr_("SPICE(FILEREADFAILED)", (ftnlen)21);
1086 chkout_("GETFAT", (ftnlen)6);
1087 return 0;
1088 }
1089
1090 /* Close the file (if we opened it here), as we do not need it */
1091 /* to be open any more. */
1092
1093 if (! opened) {
1094 cl__1.cerr = 0;
1095 cl__1.cunit = number;
1096 cl__1.csta = 0;
1097 f_clos(&cl__1);
1098 }
1099
1100 /* At this point, we have a candidate for an ID word. To avoid */
1101 /* difficulties with Fortran I/O and other things, we will now */
1102 /* replace any non printing ASCII characters with blanks. */
1103
1104 for (i__ = 1; i__ <= 12; ++i__) {
1105 if (*(unsigned char *)&tmpwrd[i__ - 1] < 32 || *(unsigned char *)&
1106 tmpwrd[i__ - 1] > 126) {
1107 *(unsigned char *)&tmpwrd[i__ - 1] = ' ';
1108 }
1109 }
1110
1111 /* Identify the architecture and type, if we can. */
1112
1113 ljust_(tmpwrd, tmpwrd, (ftnlen)12, (ftnlen)12);
1114 ucase_(tmpwrd, tmpwrd, (ftnlen)12, (ftnlen)12);
1115 nextwd_(tmpwrd, idword, tmpwrd, (ftnlen)12, (ftnlen)12, (ftnlen)12);
1116 if (s_cmp(idword, "DAFETF", (ftnlen)12, (ftnlen)6) == 0) {
1117
1118 /* We have a DAF encoded transfer file. */
1119
1120 s_copy(arch, "XFR", arch_len, (ftnlen)3);
1121 s_copy(kertyp, "DAF", kertyp_len, (ftnlen)3);
1122 } else if (s_cmp(idword, "DASETF", (ftnlen)12, (ftnlen)6) == 0) {
1123
1124 /* We have a DAS encoded transfer file. */
1125
1126 s_copy(arch, "XFR", arch_len, (ftnlen)3);
1127 s_copy(kertyp, "DAS", kertyp_len, (ftnlen)3);
1128 } else if (s_cmp(idword, "'NAIF/DAF'", (ftnlen)10, (ftnlen)10) == 0) {
1129
1130 /* We have an old DAF decimal text file. */
1131
1132 s_copy(arch, "DEC", arch_len, (ftnlen)3);
1133 s_copy(kertyp, "DAF", kertyp_len, (ftnlen)3);
1134 } else if (s_cmp(idword, "NAIF/DAS", (ftnlen)8, (ftnlen)8) == 0) {
1135
1136 /* We have a pre release DAS binary file. */
1137
1138 s_copy(arch, "DAS", arch_len, (ftnlen)3);
1139 s_copy(kertyp, "PRE", kertyp_len, (ftnlen)3);
1140 } else {
1141
1142 /* Get the architecture and type from the ID word, if we can. */
1143
1144 idw2at_(idword, arch, kertyp, (ftnlen)8, arch_len, kertyp_len);
1145 }
1146
1147 /* If the architecture is DAF and the type is unknown, '?', then we */
1148 /* have either an SPK file, a CK file, or something we don't */
1149 /* understand. Let's check it out. */
1150
1151 if (s_cmp(arch, "DAF", arch_len, (ftnlen)3) == 0 && s_cmp(kertyp, "?",
1152 kertyp_len, (ftnlen)1) == 0) {
1153
1154 /* We have a DAF file and we do not know what the type is. This */
1155 /* situation can occur for older SPK and CK files, before the ID */
1156 /* word was used to store type information. */
1157
1158 /* We use Bill's (WLT'S) magic heuristics to determine the type */
1159 /* of the file. */
1160
1161 /* Open the file and pass the handle to the private routine */
1162 /* that deals with the dirty work. */
1163
1164 dafopr_(file, &handle, file_len);
1165 zzckspk_(&handle, kertyp, kertyp_len);
1166 dafcls_(&handle);
1167 }
1168 chkout_("GETFAT", (ftnlen)6);
1169 return 0;
1170 } /* getfat_ */
1171
1172