1 /* zzddhgtu.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 /* $Procedure ZZDDHGTU ( Private --- DDH Get Unit ) */
zzddhgtu_(integer * utcst,integer * uthan,logical * utlck,integer * utlun,integer * nut,integer * uindex)9 /* Subroutine */ int zzddhgtu_(integer *utcst, integer *uthan, logical *utlck,
10 integer *utlun, integer *nut, integer *uindex)
11 {
12 /* System generated locals */
13 integer i__1;
14 cllist cl__1;
15
16 /* Builtin functions */
17 integer s_rnge(char *, integer, char *, integer), f_clos(cllist *);
18
19 /* Local variables */
20 logical done;
21 integer i__;
22 extern /* Subroutine */ int chkin_(char *, ftnlen);
23 extern logical failed_(void);
24 extern /* Subroutine */ int orderi_(integer *, integer *, integer *),
25 frelun_(integer *), sigerr_(char *, ftnlen), getlun_(integer *),
26 chkout_(char *, ftnlen);
27 integer orderv[23];
28 extern /* Subroutine */ int setmsg_(char *, ftnlen);
29 extern logical return_(void);
30
31 /* $ Abstract */
32
33 /* SPICE Private routine intended solely for the support of SPICE */
34 /* routines. Users should not call this routine directly due */
35 /* to the volatile nature of this routine. */
36
37 /* Get or prepare an entry in the unit table to receive a new */
38 /* file. */
39
40 /* $ Disclaimer */
41
42 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
43 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
44 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
45 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
46 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
47 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
48 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
49 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
50 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
51 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
52
53 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
54 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
55 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
56 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
57 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
58 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
59
60 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
61 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
62 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
63 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
64
65 /* $ Required_Reading */
66
67 /* None. */
68
69 /* $ Keywords */
70
71 /* PRIVATE */
72
73 /* $ Declarations */
74
75 /* $ Abstract */
76
77 /* Parameter declarations for the DAF/DAS handle manager. */
78
79 /* $ Disclaimer */
80
81 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
82 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
83 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
84 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
85 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
86 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
87 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
88 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
89 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
90 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
91
92 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
93 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
94 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
95 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
96 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
97 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
98
99 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
100 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
101 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
102 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
103
104 /* $ Required_Reading */
105
106 /* DAF, DAS */
107
108 /* $ Keywords */
109
110 /* PRIVATE */
111
112 /* $ Particulars */
113
114 /* This include file contains parameters defining limits and */
115 /* integer codes that are utilized in the DAF/DAS handle manager */
116 /* routines. */
117
118 /* $ Restrictions */
119
120 /* None. */
121
122 /* $ Author_and_Institution */
123
124 /* F.S. Turner (JPL) */
125
126 /* $ Literature_References */
127
128 /* None. */
129
130 /* $ Version */
131
132 /* - SPICELIB Version 2.5.0, 10-MAR-2014 (BVS) */
133
134 /* Updated for SUN-SOLARIS-64BIT-INTEL. */
135
136 /* - SPICELIB Version 2.4.0, 10-MAR-2014 (BVS) */
137
138 /* Updated for PC-LINUX-64BIT-IFORT. */
139
140 /* - SPICELIB Version 2.3.0, 10-MAR-2014 (BVS) */
141
142 /* Updated for PC-CYGWIN-GFORTRAN. */
143
144 /* - SPICELIB Version 2.2.0, 10-MAR-2014 (BVS) */
145
146 /* Updated for PC-CYGWIN-64BIT-GFORTRAN. */
147
148 /* - SPICELIB Version 2.1.0, 10-MAR-2014 (BVS) */
149
150 /* Updated for PC-CYGWIN-64BIT-GCC_C. */
151
152 /* - SPICELIB Version 2.0.0, 12-APR-2012 (BVS) */
153
154 /* Increased FTSIZE (from 1000 to 5000). */
155
156 /* - SPICELIB Version 1.20.0, 13-MAY-2010 (BVS) */
157
158 /* Updated for SUN-SOLARIS-INTEL. */
159
160 /* - SPICELIB Version 1.19.0, 13-MAY-2010 (BVS) */
161
162 /* Updated for SUN-SOLARIS-INTEL-CC_C. */
163
164 /* - SPICELIB Version 1.18.0, 13-MAY-2010 (BVS) */
165
166 /* Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */
167
168 /* - SPICELIB Version 1.17.0, 13-MAY-2010 (BVS) */
169
170 /* Updated for SUN-SOLARIS-64BIT-NATIVE_C. */
171
172 /* - SPICELIB Version 1.16.0, 13-MAY-2010 (BVS) */
173
174 /* Updated for PC-WINDOWS-64BIT-IFORT. */
175
176 /* - SPICELIB Version 1.15.0, 13-MAY-2010 (BVS) */
177
178 /* Updated for PC-LINUX-64BIT-GFORTRAN. */
179
180 /* - SPICELIB Version 1.14.0, 13-MAY-2010 (BVS) */
181
182 /* Updated for PC-64BIT-MS_C. */
183
184 /* - SPICELIB Version 1.13.0, 13-MAY-2010 (BVS) */
185
186 /* Updated for MAC-OSX-64BIT-INTEL_C. */
187
188 /* - SPICELIB Version 1.12.0, 13-MAY-2010 (BVS) */
189
190 /* Updated for MAC-OSX-64BIT-IFORT. */
191
192 /* - SPICELIB Version 1.11.0, 13-MAY-2010 (BVS) */
193
194 /* Updated for MAC-OSX-64BIT-GFORTRAN. */
195
196 /* - SPICELIB Version 1.10.0, 18-MAR-2009 (BVS) */
197
198 /* Updated for PC-LINUX-GFORTRAN. */
199
200 /* - SPICELIB Version 1.9.0, 18-MAR-2009 (BVS) */
201
202 /* Updated for MAC-OSX-GFORTRAN. */
203
204 /* - SPICELIB Version 1.8.0, 19-FEB-2008 (BVS) */
205
206 /* Updated for PC-LINUX-IFORT. */
207
208 /* - SPICELIB Version 1.7.0, 14-NOV-2006 (BVS) */
209
210 /* Updated for PC-LINUX-64BIT-GCC_C. */
211
212 /* - SPICELIB Version 1.6.0, 14-NOV-2006 (BVS) */
213
214 /* Updated for MAC-OSX-INTEL_C. */
215
216 /* - SPICELIB Version 1.5.0, 14-NOV-2006 (BVS) */
217
218 /* Updated for MAC-OSX-IFORT. */
219
220 /* - SPICELIB Version 1.4.0, 14-NOV-2006 (BVS) */
221
222 /* Updated for PC-WINDOWS-IFORT. */
223
224 /* - SPICELIB Version 1.3.0, 26-OCT-2005 (BVS) */
225
226 /* Updated for SUN-SOLARIS-64BIT-GCC_C. */
227
228 /* - SPICELIB Version 1.2.0, 03-JAN-2005 (BVS) */
229
230 /* Updated for PC-CYGWIN_C. */
231
232 /* - SPICELIB Version 1.1.0, 03-JAN-2005 (BVS) */
233
234 /* Updated for PC-CYGWIN. */
235
236 /* - SPICELIB Version 1.0.1, 17-JUL-2002 */
237
238 /* Added MAC-OSX environments. */
239
240 /* - SPICELIB Version 1.0.0, 07-NOV-2001 */
241
242 /* -& */
243
244 /* Unit and file table size parameters. */
245
246 /* FTSIZE is the maximum number of files (DAS and DAF) that a */
247 /* user may have open simultaneously. */
248
249
250 /* RSVUNT is the number of units protected from being locked */
251 /* to a particular handle by ZZDDHHLU. */
252
253
254 /* SCRUNT is the number of units protected for use by scratch */
255 /* files. */
256
257
258 /* UTSIZE is the maximum number of logical units this manager */
259 /* will utilize at one time. */
260
261
262 /* Access method enumeration. These parameters are used to */
263 /* identify which access method is associated with a particular */
264 /* handle. They need to be synchronized with the STRAMH array */
265 /* defined in ZZDDHGSD in the following fashion: */
266
267 /* STRAMH ( READ ) = 'READ' */
268 /* STRAMH ( WRITE ) = 'WRITE' */
269 /* STRAMH ( SCRTCH ) = 'SCRATCH' */
270 /* STRAMH ( NEW ) = 'NEW' */
271
272 /* These values are used in the file table variable FTAMH. */
273
274
275 /* Binary file format enumeration. These parameters are used to */
276 /* identify which binary file format is associated with a */
277 /* particular handle. They need to be synchronized with the STRBFF */
278 /* array defined in ZZDDHGSD in the following fashion: */
279
280 /* STRBFF ( BIGI3E ) = 'BIG-IEEE' */
281 /* STRBFF ( LTLI3E ) = 'LTL-IEEE' */
282 /* STRBFF ( VAXGFL ) = 'VAX-GFLT' */
283 /* STRBFF ( VAXDFL ) = 'VAX-DFLT' */
284
285 /* These values are used in the file table variable FTBFF. */
286
287
288 /* Some random string lengths... more documentation required. */
289 /* For now this will have to suffice. */
290
291
292 /* Architecture enumeration. These parameters are used to identify */
293 /* which file architecture is associated with a particular handle. */
294 /* They need to be synchronized with the STRARC array defined in */
295 /* ZZDDHGSD in the following fashion: */
296
297 /* STRARC ( DAF ) = 'DAF' */
298 /* STRARC ( DAS ) = 'DAS' */
299
300 /* These values will be used in the file table variable FTARC. */
301
302
303 /* For the following environments, record length is measured in */
304 /* characters (bytes) with eight characters per double precision */
305 /* number. */
306
307 /* Environment: Sun, Sun FORTRAN */
308 /* Source: Sun Fortran Programmer's Guide */
309
310 /* Environment: PC, MS FORTRAN */
311 /* Source: Microsoft Fortran Optimizing Compiler User's Guide */
312
313 /* Environment: Macintosh, Language Systems FORTRAN */
314 /* Source: Language Systems FORTRAN Reference Manual, */
315 /* Version 1.2, page 12-7 */
316
317 /* Environment: PC/Linux, g77 */
318 /* Source: Determined by experiment. */
319
320 /* Environment: PC, Lahey F77 EM/32 Version 4.0 */
321 /* Source: Lahey F77 EM/32 Language Reference Manual, */
322 /* page 144 */
323
324 /* Environment: HP-UX 9000/750, FORTRAN/9000 Series 700 computers */
325 /* Source: FORTRAN/9000 Reference-Series 700 Computers, */
326 /* page 5-110 */
327
328 /* Environment: NeXT Mach OS (Black Hardware), */
329 /* Absoft Fortran Version 3.2 */
330 /* Source: NAIF Program */
331
332
333 /* The following parameter defines the size of a string used */
334 /* to store a filenames on this target platform. */
335
336
337 /* The following parameter controls the size of the character record */
338 /* buffer used to read data from non-native files. */
339
340 /* $ Brief_I/O */
341
342 /* VARIABLE I/O DESCRIPTION */
343 /* -------- --- -------------------------------------------------- */
344 /* UTCST, */
345 /* UTHAN, */
346 /* UTLCK, */
347 /* UTLUN, I/O Unit table. */
348 /* NUT I/O Number of entries in the unit table. */
349 /* UINDEX O Row in the unit table that can be replaced. */
350
351 /* $ Detailed_Input */
352
353 /* UTCST, */
354 /* UTHAN, */
355 /* UTLCK, */
356 /* UTLUN, are the arrays respectively containing the cost, */
357 /* handle, locked, and logical unit columns of the */
358 /* unit table. */
359
360 /* NUT is the number of entries in the unit table. */
361
362 /* $ Detailed_Output */
363
364 /* UTCST, */
365 /* UTHAN, */
366 /* UTLCK, */
367 /* UTLUN, are the arrays respectively containing the cost, */
368 /* handle, locked, and logical unit columns of the */
369 /* unit table. This may change as a new unit is */
370 /* added or old ones are removed. */
371
372 /* NUT is the number of entries in the unit table. This may */
373 /* change as new entries are added. */
374
375 /* UINDEX is the index of the row where the new unit should */
376 /* be attached. */
377
378 /* $ Parameters */
379
380 /* None. */
381
382 /* $ Files */
383
384 /* This routine may disconnect a file from its logical unit, to */
385 /* successfully process the caller's request for a unit. */
386
387 /* $ Exceptions */
388
389 /* 1) If GETLUN fails to assign a logical unit for any reason to */
390 /* the row of interest, this routine sets the logical unit to -1, */
391 /* since negative logical units in Fortran are not permitted. */
392
393 /* $ Particulars */
394
395 /* This routine only manipulates the contents of the unit table. */
396 /* Any "zero" cost rows in the table indicate rows where the */
397 /* listed logical unit has been reserved, but no file is currently */
398 /* attached. */
399
400 /* Callers of this routine should check FAILED since this */
401 /* routine may invoke GETLUN. */
402
403 /* $ Examples */
404
405 /* See ZZDDHHLU for sample usage. */
406
407 /* $ Restrictions */
408
409 /* 1) This routine must not be used to retrieve a unit for a */
410 /* file that is already connected to a unit listed in the */
411 /* unit table. */
412
413 /* $ Author_and_Institution */
414
415 /* F.S. Turner (JPL) */
416
417 /* $ Literature_References */
418
419 /* None. */
420
421 /* $ Version */
422
423 /* - SPICELIB Version 1.0.0, 29-MAY-2001 (FST) */
424
425
426 /* -& */
427
428 /* SPICELIB Functions */
429
430
431 /* Local Variables */
432
433
434 /* Standard SPICE discovery error handling. */
435
436 if (return_()) {
437 return 0;
438 }
439
440 /* First check the case when the unit table is completely empty. */
441
442 if (*nut == 0) {
443 *nut = 1;
444 *uindex = 1;
445 utcst[*uindex - 1] = 0;
446 uthan[*uindex - 1] = 0;
447 utlck[*uindex - 1] = FALSE_;
448 getlun_(&utlun[*uindex - 1]);
449
450 /* Check FAILED to see if GETLUN signaled an error. If so, then */
451 /* return an invalid unit to the caller. */
452
453 if (failed_()) {
454 utlun[*uindex - 1] = -1;
455 return 0;
456 }
457
458 /* If we end up here, then GETLUN succeeded and we have the new */
459 /* unit. Now return. */
460
461 return 0;
462 }
463
464 /* If we reach here, then the table contains at least one entry. */
465 /* Order the table rows by cost. */
466
467 orderi_(utcst, nut, orderv);
468
469 /* Now check to for '0' cost rows as this indicates rows whose */
470 /* logical units are reserved for this suite of routines usage, */
471 /* but are not currently assigned a file. */
472
473 if (utcst[orderv[0] - 1] <= 0) {
474 *uindex = orderv[0];
475
476 /* '0' cost rows end up in the unit table as the result of a */
477 /* row deletion, occurring when excess files are present. */
478 /* When this process occurs, the logical unit listed in this */
479 /* row is reserved for this module's usage only with RESLUN. */
480 /* Free it, since we're about to reassign it. */
481
482 frelun_(&utlun[*uindex - 1]);
483 return 0;
484 }
485
486 /* Now if no '0' cost rows exist, check to see if we can */
487 /* expand the table. */
488
489 if (*nut < 23) {
490
491 /* Now increment NUT and set UINDEX. */
492
493 ++(*nut);
494 *uindex = *nut;
495
496 /* Prepare the default values for the new row. */
497
498 utcst[*uindex - 1] = 0;
499 uthan[*uindex - 1] = 0;
500 utlck[*uindex - 1] = FALSE_;
501 getlun_(&utlun[*uindex - 1]);
502
503 /* Check FAILED to see if GETLUN signaled an error. If so, then */
504 /* return an invalid unit to the caller. */
505
506 if (failed_()) {
507 utlun[*uindex - 1] = -1;
508 return 0;
509 }
510
511 /* If we end up here, then GETLUN worked properly. Now return. */
512
513 return 0;
514 }
515
516 /* If we reach here, then we have no zero-cost rows and a full unit */
517 /* table. Now it's time to determine which entry in the table to */
518 /* bump. We do this by stepping through the order vector until */
519 /* we find the first 'non-locked' row. */
520
521 i__ = 0;
522 done = FALSE_;
523 while(! done && i__ != *nut) {
524 ++i__;
525 done = ! utlck[orderv[(i__1 = i__ - 1) < 23 && 0 <= i__1 ? i__1 :
526 s_rnge("orderv", i__1, "zzddhgtu_", (ftnlen)279)] - 1];
527 }
528
529 /* Before going any further, signal an error if we discover */
530 /* we have not found a row. */
531
532 if (! done) {
533 *uindex = 0;
534 chkin_("ZZDDHGTU", (ftnlen)8);
535 setmsg_("The unit table is full and all entries are locked. This sh"
536 "ould never happen. Contact NAIF.", (ftnlen)91);
537 sigerr_("SPICE(BUG)", (ftnlen)10);
538 chkout_("ZZDDHGTU", (ftnlen)8);
539 return 0;
540 }
541
542 /* Clear UTCST and UTHAN since we intend to disconnect */
543 /* the unit upon return. */
544
545 utcst[orderv[(i__1 = i__ - 1) < 23 && 0 <= i__1 ? i__1 : s_rnge("orderv",
546 i__1, "zzddhgtu_", (ftnlen)304)] - 1] = 0;
547 uthan[orderv[(i__1 = i__ - 1) < 23 && 0 <= i__1 ? i__1 : s_rnge("orderv",
548 i__1, "zzddhgtu_", (ftnlen)305)] - 1] = 0;
549
550 /* Set UINDEX and CLSLUN, then return. */
551
552 *uindex = orderv[(i__1 = i__ - 1) < 23 && 0 <= i__1 ? i__1 : s_rnge("ord"
553 "erv", i__1, "zzddhgtu_", (ftnlen)310)];
554
555 /* At this point we need to close the unit from the row of interest. */
556
557 cl__1.cerr = 0;
558 cl__1.cunit = utlun[*uindex - 1];
559 cl__1.csta = 0;
560 f_clos(&cl__1);
561 return 0;
562 } /* zzddhgtu_ */
563
564