1 /* zzddhrmu.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 ZZDDHRMU ( Private --- DDH Remove Unit ) */
zzddhrmu_(integer * uindex,integer * nft,integer * utcst,integer * uthan,logical * utlck,integer * utlun,integer * nut)9 /* Subroutine */ int zzddhrmu_(integer *uindex, integer *nft, integer *utcst,
10 	integer *uthan, logical *utlck, integer *utlun, integer *nut)
11 {
12     /* System generated locals */
13     integer i__1;
14 
15     /* Local variables */
16     integer i__;
17     extern /* Subroutine */ int chkin_(char *, ftnlen), sigerr_(char *,
18 	    ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen),
19 	    errint_(char *, integer *, ftnlen), reslun_(integer *);
20 
21 /* $ Abstract */
22 
23 /*     SPICE Private routine intended solely for the support of SPICE */
24 /*     routines.  Users should not call this routine directly due */
25 /*     to the volatile nature of this routine. */
26 
27 /*     Remove an entry from the unit table. */
28 
29 /* $ Disclaimer */
30 
31 /*     THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
32 /*     CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
33 /*     GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
34 /*     ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
35 /*     PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
36 /*     TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
37 /*     WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
38 /*     PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
39 /*     SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
40 /*     SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
41 
42 /*     IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
43 /*     BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
44 /*     LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
45 /*     INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
46 /*     REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
47 /*     REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
48 
49 /*     RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
50 /*     THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
51 /*     CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
52 /*     ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
53 
54 /* $ Required_Reading */
55 
56 /*     None. */
57 
58 /* $ Keywords */
59 
60 /*     PRIVATE */
61 
62 /* $ Declarations */
63 
64 /* $ Abstract */
65 
66 /*     Parameter declarations for the DAF/DAS handle manager. */
67 
68 /* $ Disclaimer */
69 
70 /*     THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
71 /*     CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
72 /*     GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
73 /*     ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
74 /*     PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
75 /*     TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
76 /*     WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
77 /*     PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
78 /*     SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
79 /*     SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
80 
81 /*     IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
82 /*     BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
83 /*     LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
84 /*     INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
85 /*     REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
86 /*     REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
87 
88 /*     RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
89 /*     THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
90 /*     CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
91 /*     ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
92 
93 /* $ Required_Reading */
94 
95 /*     DAF, DAS */
96 
97 /* $ Keywords */
98 
99 /*     PRIVATE */
100 
101 /* $ Particulars */
102 
103 /*     This include file contains parameters defining limits and */
104 /*     integer codes that are utilized in the DAF/DAS handle manager */
105 /*     routines. */
106 
107 /* $ Restrictions */
108 
109 /*     None. */
110 
111 /* $ Author_and_Institution */
112 
113 /*     F.S. Turner       (JPL) */
114 
115 /* $ Literature_References */
116 
117 /*     None. */
118 
119 /* $ Version */
120 
121 /* -    SPICELIB Version 2.5.0, 10-MAR-2014 (BVS) */
122 
123 /*        Updated for SUN-SOLARIS-64BIT-INTEL. */
124 
125 /* -    SPICELIB Version 2.4.0, 10-MAR-2014 (BVS) */
126 
127 /*        Updated for PC-LINUX-64BIT-IFORT. */
128 
129 /* -    SPICELIB Version 2.3.0, 10-MAR-2014 (BVS) */
130 
131 /*        Updated for PC-CYGWIN-GFORTRAN. */
132 
133 /* -    SPICELIB Version 2.2.0, 10-MAR-2014 (BVS) */
134 
135 /*        Updated for PC-CYGWIN-64BIT-GFORTRAN. */
136 
137 /* -    SPICELIB Version 2.1.0, 10-MAR-2014 (BVS) */
138 
139 /*        Updated for PC-CYGWIN-64BIT-GCC_C. */
140 
141 /* -    SPICELIB Version 2.0.0, 12-APR-2012 (BVS) */
142 
143 /*        Increased FTSIZE (from 1000 to 5000). */
144 
145 /* -    SPICELIB Version 1.20.0, 13-MAY-2010 (BVS) */
146 
147 /*        Updated for SUN-SOLARIS-INTEL. */
148 
149 /* -    SPICELIB Version 1.19.0, 13-MAY-2010 (BVS) */
150 
151 /*        Updated for SUN-SOLARIS-INTEL-CC_C. */
152 
153 /* -    SPICELIB Version 1.18.0, 13-MAY-2010 (BVS) */
154 
155 /*        Updated for SUN-SOLARIS-INTEL-64BIT-CC_C. */
156 
157 /* -    SPICELIB Version 1.17.0, 13-MAY-2010 (BVS) */
158 
159 /*        Updated for SUN-SOLARIS-64BIT-NATIVE_C. */
160 
161 /* -    SPICELIB Version 1.16.0, 13-MAY-2010 (BVS) */
162 
163 /*        Updated for PC-WINDOWS-64BIT-IFORT. */
164 
165 /* -    SPICELIB Version 1.15.0, 13-MAY-2010 (BVS) */
166 
167 /*        Updated for PC-LINUX-64BIT-GFORTRAN. */
168 
169 /* -    SPICELIB Version 1.14.0, 13-MAY-2010 (BVS) */
170 
171 /*        Updated for PC-64BIT-MS_C. */
172 
173 /* -    SPICELIB Version 1.13.0, 13-MAY-2010 (BVS) */
174 
175 /*        Updated for MAC-OSX-64BIT-INTEL_C. */
176 
177 /* -    SPICELIB Version 1.12.0, 13-MAY-2010 (BVS) */
178 
179 /*        Updated for MAC-OSX-64BIT-IFORT. */
180 
181 /* -    SPICELIB Version 1.11.0, 13-MAY-2010 (BVS) */
182 
183 /*        Updated for MAC-OSX-64BIT-GFORTRAN. */
184 
185 /* -    SPICELIB Version 1.10.0, 18-MAR-2009 (BVS) */
186 
187 /*        Updated for PC-LINUX-GFORTRAN. */
188 
189 /* -    SPICELIB Version 1.9.0, 18-MAR-2009 (BVS) */
190 
191 /*        Updated for MAC-OSX-GFORTRAN. */
192 
193 /* -    SPICELIB Version 1.8.0, 19-FEB-2008 (BVS) */
194 
195 /*        Updated for PC-LINUX-IFORT. */
196 
197 /* -    SPICELIB Version 1.7.0, 14-NOV-2006 (BVS) */
198 
199 /*        Updated for PC-LINUX-64BIT-GCC_C. */
200 
201 /* -    SPICELIB Version 1.6.0, 14-NOV-2006 (BVS) */
202 
203 /*        Updated for MAC-OSX-INTEL_C. */
204 
205 /* -    SPICELIB Version 1.5.0, 14-NOV-2006 (BVS) */
206 
207 /*        Updated for MAC-OSX-IFORT. */
208 
209 /* -    SPICELIB Version 1.4.0, 14-NOV-2006 (BVS) */
210 
211 /*        Updated for PC-WINDOWS-IFORT. */
212 
213 /* -    SPICELIB Version 1.3.0, 26-OCT-2005 (BVS) */
214 
215 /*        Updated for SUN-SOLARIS-64BIT-GCC_C. */
216 
217 /* -    SPICELIB Version 1.2.0, 03-JAN-2005 (BVS) */
218 
219 /*        Updated for PC-CYGWIN_C. */
220 
221 /* -    SPICELIB Version 1.1.0, 03-JAN-2005 (BVS) */
222 
223 /*        Updated for PC-CYGWIN. */
224 
225 /* -    SPICELIB Version 1.0.1, 17-JUL-2002 */
226 
227 /*        Added MAC-OSX environments. */
228 
229 /* -    SPICELIB Version 1.0.0, 07-NOV-2001 */
230 
231 /* -& */
232 
233 /*     Unit and file table size parameters. */
234 
235 /*     FTSIZE     is the maximum number of files (DAS and DAF) that a */
236 /*                user may have open simultaneously. */
237 
238 
239 /*     RSVUNT     is the number of units protected from being locked */
240 /*                to a particular handle by ZZDDHHLU. */
241 
242 
243 /*     SCRUNT     is the number of units protected for use by scratch */
244 /*                files. */
245 
246 
247 /*     UTSIZE     is the maximum number of logical units this manager */
248 /*                will utilize at one time. */
249 
250 
251 /*     Access method enumeration.  These parameters are used to */
252 /*     identify which access method is associated with a particular */
253 /*     handle.  They need to be synchronized with the STRAMH array */
254 /*     defined in ZZDDHGSD in the following fashion: */
255 
256 /*        STRAMH ( READ   ) = 'READ' */
257 /*        STRAMH ( WRITE  ) = 'WRITE' */
258 /*        STRAMH ( SCRTCH ) = 'SCRATCH' */
259 /*        STRAMH ( NEW    ) = 'NEW' */
260 
261 /*     These values are used in the file table variable FTAMH. */
262 
263 
264 /*     Binary file format enumeration.  These parameters are used to */
265 /*     identify which binary file format is associated with a */
266 /*     particular handle.  They need to be synchronized with the STRBFF */
267 /*     array defined in ZZDDHGSD in the following fashion: */
268 
269 /*        STRBFF ( BIGI3E ) = 'BIG-IEEE' */
270 /*        STRBFF ( LTLI3E ) = 'LTL-IEEE' */
271 /*        STRBFF ( VAXGFL ) = 'VAX-GFLT' */
272 /*        STRBFF ( VAXDFL ) = 'VAX-DFLT' */
273 
274 /*     These values are used in the file table variable FTBFF. */
275 
276 
277 /*     Some random string lengths... more documentation required. */
278 /*     For now this will have to suffice. */
279 
280 
281 /*     Architecture enumeration.  These parameters are used to identify */
282 /*     which file architecture is associated with a particular handle. */
283 /*     They need to be synchronized with the STRARC array defined in */
284 /*     ZZDDHGSD in the following fashion: */
285 
286 /*        STRARC ( DAF ) = 'DAF' */
287 /*        STRARC ( DAS ) = 'DAS' */
288 
289 /*     These values will be used in the file table variable FTARC. */
290 
291 
292 /*     For the following environments, record length is measured in */
293 /*     characters (bytes) with eight characters per double precision */
294 /*     number. */
295 
296 /*     Environment: Sun, Sun FORTRAN */
297 /*     Source:      Sun Fortran Programmer's Guide */
298 
299 /*     Environment: PC, MS FORTRAN */
300 /*     Source:      Microsoft Fortran Optimizing Compiler User's Guide */
301 
302 /*     Environment: Macintosh, Language Systems FORTRAN */
303 /*     Source:      Language Systems FORTRAN Reference Manual, */
304 /*                  Version 1.2, page 12-7 */
305 
306 /*     Environment: PC/Linux, g77 */
307 /*     Source:      Determined by experiment. */
308 
309 /*     Environment: PC, Lahey F77 EM/32 Version 4.0 */
310 /*     Source:      Lahey F77 EM/32 Language Reference Manual, */
311 /*                  page 144 */
312 
313 /*     Environment: HP-UX 9000/750, FORTRAN/9000 Series 700 computers */
314 /*     Source:      FORTRAN/9000 Reference-Series 700 Computers, */
315 /*                  page 5-110 */
316 
317 /*     Environment: NeXT Mach OS (Black Hardware), */
318 /*                  Absoft Fortran Version 3.2 */
319 /*     Source:      NAIF Program */
320 
321 
322 /*     The following parameter defines the size of a string used */
323 /*     to store a filenames on this target platform. */
324 
325 
326 /*     The following parameter controls the size of the character record */
327 /*     buffer used to read data from non-native files. */
328 
329 /* $ Brief_I/O */
330 
331 /*     VARIABLE  I/O  DESCRIPTION */
332 /*     --------  ---  -------------------------------------------------- */
333 /*     UINDEX     I   Row index to remove from the unit table. */
334 /*     NFT        I   Number of entries in the file table. */
335 /*     UTCST, */
336 /*     UTHAN, */
337 /*     UTLCK, */
338 /*     UTLUN     I/O  Unit table. */
339 /*     NUT       I/O  Number of entries in the unit table. */
340 
341 /* $ Detailed_Input */
342 
343 /*     HANDLE     is the index of the row in the unit table for the */
344 /*                unit to remove. */
345 
346 /*     NFT        is the number of entries in the file table after */
347 /*                the file whose unit is about to be disconnected */
348 /*                has been removed. */
349 
350 /*     UTCST, */
351 /*     UTHAN, */
352 /*     UTLCK, */
353 /*     UTLUN,     are the cost, handle, locked, and logical unit columns */
354 /*                of the unit table respectively. */
355 
356 /*     NUT        is the number of entries in the unit table. */
357 
358 /* $ Detailed_Output */
359 
360 /*     UTCST, */
361 /*     UTHAN, */
362 /*     UTLCK, */
363 /*     UTLUN,     are the cost, handle, locked, and logical unit columns */
364 /*                of the unit table respectively.  The contents will */
365 /*                change, for specifics see the Particulars section */
366 /*                below. */
367 
368 /*     NUT        is the number of entries in the unit table.  Depending */
369 /*                on the state of the file table, this may or may not */
370 /*                change.  See the $Particulars section below for */
371 /*                details. */
372 
373 /* $ Parameters */
374 
375 /*     None. */
376 
377 /* $ Files */
378 
379 /*     None. */
380 
381 /* $ Exceptions */
382 
383 /*     1) SPICE(INDEXOUTOFRANGE) is signaled when the input UINDEX is */
384 /*        either greater than NUT or less than 1. */
385 
386 /*     2) If NUT is 0 on input, then this module simply returns. */
387 
388 /* $ Particulars */
389 
390 /*     This routine only manipulates the contents of the unit table. */
391 /*     It is utilized to delete an entry in the unit table that is */
392 /*     the result of a file 'unload' or close operation. */
393 
394 /*     If the number of files listed in the file table exceeds the */
395 /*     number of entries in the unit table, then this module will */
396 /*     reserve the logical unit listed in the row to remove, zero */
397 /*     out the cost and return.  In this event, NUT will remain */
398 /*     unchanged. */
399 
400 /*     However, if there are less files in the file table than the */
401 /*     number of entries in the unit table, then this routine removes */
402 /*     the row and compresses the unit table, as one would expect. */
403 
404 /*     The file attached to UNIT is not closed by this routine, the */
405 /*     closure should occur before invoking this module. */
406 
407 /* $ Examples */
408 
409 /*     See ZZDDHHLU for sample usage. */
410 
411 /* $ Restrictions */
412 
413 /*     1) This routine operates when an error condition introduced */
414 /*        by a prior call to SIGERR exists.  It calls no routines */
415 /*        that return on entry when proper inputs are provided. */
416 /*        Any updates to this routine must preserve this behavior. */
417 
418 /*     2) The file attached to the unit that is to be removed should */
419 /*        already have been removed from the file table.  This is */
420 /*        necessary so the value of NFT reflects the number of files */
421 /*        available after the removal. */
422 
423 /*     3) The logical unit in UTLUN(UINDEX) must be closed or buffered */
424 /*        externally prior to calling this routine.  Knowledge of its */
425 /*        value could be lost otherwise. */
426 
427 /* $ Author_and_Institution */
428 
429 /*     F.S. Turner     (JPL) */
430 
431 /* $ Literature_References */
432 
433 /*     None. */
434 
435 /* $ Version */
436 
437 /* -    SPICELIB Version 1.0.0, 05-NOV-2001 (FST) */
438 
439 
440 /* -& */
441 
442 /*     Local Variables */
443 
444 
445 /*     First check to see if NUT is 0.  If so, just return, as there */
446 /*     are no rows to remove. */
447 
448     if (*nut == 0) {
449 	return 0;
450     }
451 
452 /*     Check to see if we found the UINDEX in the unit table. */
453 /*     If not, use discovery check-in, signal an error and return. */
454 
455     if (*uindex > *nut || *uindex < 1) {
456 	chkin_("ZZDDHRMU", (ftnlen)8);
457 	setmsg_("Attempt to remove row # from the unit table failed because "
458 		"valid row indices range from 1 to NUT.", (ftnlen)97);
459 	errint_("#", uindex, (ftnlen)1);
460 	errint_("#", nut, (ftnlen)1);
461 	sigerr_("SPICE(INDEXOUTOFRANGE)", (ftnlen)22);
462 	chkout_("ZZDDHRMU", (ftnlen)8);
463 	return 0;
464     }
465 
466 /*     We have found the row we need to remove from the table. */
467 /*     Check to see whether we are to remove this row or simply */
468 /*     mark it as zero cost and reserve the unit.  We know this */
469 /*     is the case when NFT is greater than or equal to NUT. */
470 
471     if (*nft >= *nut) {
472 
473 /*        Zero the cost, clear the handle, and unlock the unit. */
474 
475 	utcst[*uindex - 1] = 0;
476 	uthan[*uindex - 1] = 0;
477 	utlck[*uindex - 1] = FALSE_;
478 
479 /*        Reserve the unit for the handle manager's usage and */
480 /*        return. */
481 
482 	reslun_(&utlun[*uindex - 1]);
483 	return 0;
484     }
485 
486 /*     If we reach here, then we have to remove the row from the */
487 /*     unit table and compress. */
488 
489     i__1 = *nut;
490     for (i__ = *uindex + 1; i__ <= i__1; ++i__) {
491 	utcst[i__ - 2] = utcst[i__ - 1];
492 	uthan[i__ - 2] = uthan[i__ - 1];
493 	utlck[i__ - 2] = utlck[i__ - 1];
494 	utlun[i__ - 2] = utlun[i__ - 1];
495     }
496 
497 /*     Decrement NUT. */
498 
499     --(*nut);
500     return 0;
501 } /* zzddhrmu_ */
502 
503