1 /* dasacr.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__3 = 3;
12 static integer c__256 = 256;
13
14 /* $Procedure DASACR ( DAS, add comment records ) */
dasacr_(integer * handle,integer * n)15 /* Subroutine */ int dasacr_(integer *handle, integer *n)
16 {
17 /* Initialized data */
18
19 static integer next[3] = { 2,3,1 };
20 static integer prev[3] = { 3,1,2 };
21
22 /* System generated locals */
23 integer i__1, i__2, i__3;
24
25 /* Builtin functions */
26 integer s_rnge(char *, integer, char *, integer);
27
28 /* Local variables */
29 integer base;
30 char recc[1024];
31 doublereal recd[128];
32 integer free, reci[256], lrec, nrec, prec, unit, type__;
33 extern /* Subroutine */ int zzddhhlu_(integer *, char *, logical *,
34 integer *, ftnlen);
35 integer i__;
36 extern /* Subroutine */ int chkin_(char *, ftnlen);
37 integer ncomc;
38 extern /* Subroutine */ int maxai_(integer *, integer *, integer *,
39 integer *);
40 integer ncomr, lword;
41 extern logical failed_(void);
42 extern /* Subroutine */ int cleari_(integer *, integer *), dasioc_(char *,
43 integer *, integer *, char *, ftnlen, ftnlen), dasiod_(char *,
44 integer *, integer *, doublereal *, ftnlen);
45 integer dirrec[256];
46 extern /* Subroutine */ int dashfs_(integer *, integer *, integer *,
47 integer *, integer *, integer *, integer *, integer *, integer *),
48 dassih_(integer *, char *, ftnlen), dasioi_(char *, integer *,
49 integer *, integer *, ftnlen);
50 integer lastla[3];
51 extern /* Subroutine */ int daswbr_(integer *);
52 integer lindex;
53 extern /* Subroutine */ int dasufs_(integer *, integer *, integer *,
54 integer *, integer *, integer *, integer *, integer *, integer *);
55 integer lastrc[3];
56 extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
57 ftnlen);
58 integer lastwd[3], nresvc;
59 extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *,
60 integer *, ftnlen);
61 extern logical return_(void);
62 integer nresvr, nxttyp, loc, pos;
63
64 /* $ Abstract */
65
66 /* Increase the size of the comment area in a DAS file to accommodate */
67 /* a specified number of additional comment records. */
68
69 /* $ Disclaimer */
70
71 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
72 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
73 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
74 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
75 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
76 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
77 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
78 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
79 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
80 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
81
82 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
83 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
84 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
85 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
86 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
87 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
88
89 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
90 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
91 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
92 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
93
94 /* $ Required_Reading */
95
96 /* DAS */
97
98 /* $ Keywords */
99
100 /* DAS */
101 /* FILES */
102 /* UTILITY */
103
104 /* $ Declarations */
105 /* $ Brief_I/O */
106
107 /* Variable I/O Description */
108 /* -------- --- -------------------------------------------------- */
109 /* HANDLE I A DAS file handle. */
110 /* N I Number of comment records to append to the comment */
111 /* area of the specified file. */
112
113 /* $ Detailed_Input */
114
115 /* HANDLE is the handle of an existing DAS file opened for */
116 /* comment area modification by DASOPC. */
117
118 /* N is the number of records to append to the comment */
119 /* area. If NCOMR is the number of comment records */
120 /* present in the file on input, then on output the */
121 /* number of comment records will be NCOMR + N. */
122
123 /* $ Detailed_Output */
124
125 /* None. See $Particulars for a description of the effect of this */
126 /* routine. */
127
128 /* $ Parameters */
129
130 /* None. */
131
132 /* $ Exceptions */
133
134 /* 1) If the input handle is invalid, the error will be diagnosed by */
135 /* routines called by this routine. */
136
137 /* 2) If an I/O error occurs during the addition process, the error */
138 /* will be diagnosed by routines called by this routine. The */
139 /* DAS file will probably be corrupted in this case. */
140
141 /* $ Files */
142
143 /* See the description of the argument HANDLE in $Detailed_Input. */
144
145 /* $ Particulars */
146
147 /* This routine is used to create space in the comment area of a DAS */
148 /* file to allow addition of comments to the file. If there are */
149 /* comment records present in the file at the time this routine is */
150 /* called, the number of comment records specified by the input */
151 /* argument N will be appended to the existing comment records. */
152 /* In any case, any existing directory records and data records will */
153 /* be shifted down by N records. */
154
155 /* This routine updates the file record of the specified DAS file */
156 /* to reflect the addition of records to the file's comment area. */
157 /* Also, the file summary obtainable from DASHFS will be updated to */
158 /* reflect the addition of comment records. */
159
160 /* This routine may be used only on existing DAS files opened by */
161 /* DASOPW. */
162
163 /* The association of DAS logical addresses and data within the */
164 /* specified file will remain unaffected by use of this routine. */
165
166 /* Normally, SPICELIB applications will not call this routine */
167 /* directly, but will add comments by calling DASAC. */
168
169 /* This routine has an inverse DASRCR, which removes a specified */
170 /* number of records from the end of the comment area. */
171
172 /* $ Examples */
173
174 /* 1) Make room for 10 comment records in the comment area of a */
175 /* new DAS file. */
176
177 /* C */
178 /* C Create a new DAS file. */
179 /* C */
180 /* CALL DASOPW ( DAS, HANDLE ) */
181
182 /* C */
183 /* C Now add 10 comment records to the comment area. */
184 /* C */
185 /* CALL DASACR ( HANDLE, 10 ) */
186
187 /* $ Restrictions */
188
189 /* 1) The DAS file must have a binary file format native to the host */
190 /* system. */
191
192 /* $ Literature_References */
193
194 /* None. */
195
196 /* $ Author_and_Institution */
197
198 /* N.J. Bachman (JPL) */
199 /* W.L. Taber (JPL) */
200
201 /* $ Version */
202
203 /* - SPICELIB Version 1.2.0, 05-FEB-2015 (NJB) */
204
205 /* Updated to support integration with the handle */
206 /* manager subsystem. */
207
208 /* Cleaned up use of unnecessary variables and unneeded */
209 /* declarations. */
210
211 /* - SPICELIB Version 1.1.0, 11-OCT-1996 (NJB) */
212
213 /* Bug fix: backward and forward directory record pointers */
214 /* are now updated when directory records are moved. */
215
216 /* - SPICELIB Version 1.0.0, 01-FEB-1993 (NJB) (WLT) */
217
218 /* -& */
219 /* $ Index_Entries */
220
221 /* add comment records to a DAS file */
222
223 /* -& */
224 /* $ Revisions */
225
226 /* - SPICELIB Version 1.1.0, 11-OCT-1996 (NJB) */
227
228 /* Bug fix: backward and forward directory record pointers */
229 /* are now updated when directory records are moved. */
230
231 /* Because these pointers are not used by the DAS sofware */
232 /* once a DAS file is segregated, this bug had no effect on */
233 /* DAS files that were created and closed via DASCLS, then */
234 /* commented via the commnt utility. */
235
236 /* -& */
237
238 /* SPICELIB functions */
239
240
241 /* Local parameters */
242
243
244 /* Words per data record, for each data type: */
245
246
247 /* Data type parameters */
248
249
250 /* Directory pointer locations (backward and forward): */
251
252
253 /* Location of first type descriptor */
254
255
256 /* Local variables */
257
258
259 /* Saved variables */
260
261
262 /* NEXT and PREV map the DAS data type codes to their */
263 /* successors and predecessors, respectively. */
264
265
266 /* Initial values */
267
268
269 /* Standard SPICE error handling. */
270
271 if (return_()) {
272 return 0;
273 }
274 chkin_("DASACR", (ftnlen)6);
275
276 /* Programmer's note: the calls to */
277
278 /* DASIOC */
279 /* DASIOD */
280 /* DASIOI */
281
282 /* for read access are valid only for native format DAS files. */
283 /* If this routine is updated to support writing to non-native */
284 /* DAS files, at least the calls to the numeric I/O routines */
285 /* will need to be replaced. (Consider using ZZDASGRD, ZZDASGRI.) */
286
287 /* Make sure this DAS file is open for writing. Signal an error if */
288 /* not. */
289
290 dassih_(handle, "WRITE", (ftnlen)5);
291
292 /* Get the logical unit for this DAS file. */
293
294 zzddhhlu_(handle, "DAS", &c_false, &unit, (ftnlen)3);
295 if (failed_()) {
296 chkout_("DASACR", (ftnlen)6);
297 return 0;
298 }
299
300 /* It's a mistake to use a negative value of N. */
301
302 if (*n < 0) {
303 setmsg_("Number of comment records to add must be non-negative. Act"
304 "ual number requested was #.", (ftnlen)86);
305 errint_("#", n, (ftnlen)1);
306 sigerr_("SPICE(DASINVALIDCOUNT)", (ftnlen)22);
307 chkout_("DASACR", (ftnlen)6);
308 return 0;
309 }
310
311 /* Before doing anything to the file, make sure that the DASRWR */
312 /* data buffers do not contain any updated records for this file. */
313 /* All of the record numbers that pertain to this file and remain */
314 /* in the DASRWR buffers will be invalidated after this routine */
315 /* returns. */
316
317 /* DASWBR flushes buffered records to the file. */
318
319 daswbr_(handle);
320
321 /* Grab the file summary for this DAS file. Find the number of */
322 /* comment records and the number of the first free record. */
323
324 dashfs_(handle, &nresvr, &nresvc, &ncomr, &ncomc, &free, lastla, lastrc,
325 lastwd);
326
327 /* Find the record and word positions LREC and LWORD of the last */
328 /* descriptor in the file. */
329
330 maxai_(lastrc, &c__3, &lrec, &loc);
331 lword = 0;
332 for (i__ = 1; i__ <= 3; ++i__) {
333 if (lastrc[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge("lastrc",
334 i__1, "dasacr_", (ftnlen)373)] == lrec && lastwd[(i__2 = i__
335 - 1) < 3 && 0 <= i__2 ? i__2 : s_rnge("lastwd", i__2, "dasac"
336 "r_", (ftnlen)373)] > lword) {
337 lword = lastwd[(i__1 = i__ - 1) < 3 && 0 <= i__1 ? i__1 : s_rnge(
338 "lastwd", i__1, "dasacr_", (ftnlen)376)];
339 }
340 }
341
342 /* LREC and LWORD are now the record and word index of the last word */
343 /* of the last descriptor in the file. If LREC is zero, there are no */
344 /* directories in the file yet. However, even DAS files that don't */
345 /* contain any data have their first directory records zeroed out, */
346 /* and this should remain true after the addition of the comment */
347 /* records. */
348
349 if (lrec == 0) {
350
351 /* Just write the zero-filled record to record number */
352
353 /* NRESVR + NCOMR + N + 2 */
354
355 cleari_(&c__256, dirrec);
356 i__1 = nresvr + ncomr + *n + 2;
357 dasioi_("WRITE", &unit, &i__1, dirrec, (ftnlen)5);
358 } else {
359
360 /* There really is stuff to move. For each directory record, */
361 /* move all of the records described by that directory. We start */
362 /* with the last directory and work our way toward the beginning */
363 /* of the file. */
364
365 nrec = lrec;
366 while(nrec > 0) {
367
368 /* For each descriptor in the current directory, move the */
369 /* cluster of data records it refers to. */
370
371 /* Read the current directory record. */
372
373 dasioi_("READ", &unit, &nrec, dirrec, (ftnlen)4);
374
375 /* Find the data type, size, and base record number of the */
376 /* last cluster in the current directory. To do this, */
377 /* traverse the directory record, keeping track of the record */
378 /* count and data types of descriptors as we go. */
379
380 type__ = dirrec[8];
381 base = nrec + 1;
382 if (nrec == lrec) {
383 lindex = lword;
384 } else {
385 lindex = 256;
386 }
387 i__1 = lindex;
388 for (i__ = 11; i__ <= i__1; ++i__) {
389 if (dirrec[(i__2 = i__ - 1) < 256 && 0 <= i__2 ? i__2 :
390 s_rnge("dirrec", i__2, "dasacr_", (ftnlen)435)] < 0) {
391 type__ = prev[(i__2 = type__ - 1) < 3 && 0 <= i__2 ? i__2
392 : s_rnge("prev", i__2, "dasacr_", (ftnlen)436)];
393 } else {
394 type__ = next[(i__2 = type__ - 1) < 3 && 0 <= i__2 ? i__2
395 : s_rnge("next", i__2, "dasacr_", (ftnlen)438)];
396 }
397 base += (i__3 = dirrec[(i__2 = i__ - 2) < 256 && 0 <= i__2 ?
398 i__2 : s_rnge("dirrec", i__2, "dasacr_", (ftnlen)441)]
399 , abs(i__3));
400 }
401
402 /* TYPE and BASE are now the data type and base record number */
403 /* of the last cluster described by the current directory. */
404
405 /* We'll now traverse the directory in reverse order, keeping */
406 /* track of cluster sizes and types as we go. */
407
408 /* POS will be the index of the descriptor of the current */
409 /* cluster. */
410
411 pos = lindex;
412 while(pos > 9) {
413 if (pos < lindex) {
414
415 /* We'll need to determine the type of the current */
416 /* cluster. If the next descriptor contains a positive */
417 /* value, the data type of the cluster it refers to is */
418 /* the successor of the current type, according to our */
419 /* ordering of types. */
420
421 if (dirrec[(i__1 = pos) < 256 && 0 <= i__1 ? i__1 :
422 s_rnge("dirrec", i__1, "dasacr_", (ftnlen)467)] >
423 0) {
424
425 /* This assignment and the one below in the ELSE */
426 /* block are performed from the second loop iteration */
427 /* onward. NXTTYP is initialized on the first loop */
428 /* iteration. */
429
430 type__ = prev[(i__1 = nxttyp - 1) < 3 && 0 <= i__1 ?
431 i__1 : s_rnge("prev", i__1, "dasacr_", (
432 ftnlen)474)];
433 } else {
434 type__ = next[(i__1 = nxttyp - 1) < 3 && 0 <= i__1 ?
435 i__1 : s_rnge("next", i__1, "dasacr_", (
436 ftnlen)476)];
437 }
438
439 /* Update the cluster base record number. */
440
441 base -= (i__2 = dirrec[(i__1 = pos - 1) < 256 && 0 <=
442 i__1 ? i__1 : s_rnge("dirrec", i__1, "dasacr_", (
443 ftnlen)482)], abs(i__2));
444 }
445
446 /* Move the current cluster. */
447
448 i__3 = base;
449 for (i__ = base + (i__2 = dirrec[(i__1 = pos - 1) < 256 && 0
450 <= i__1 ? i__1 : s_rnge("dirrec", i__1, "dasacr_", (
451 ftnlen)489)], abs(i__2)) - 1; i__ >= i__3; --i__) {
452 if (type__ == 1) {
453 dasioc_("READ", &unit, &i__, recc, (ftnlen)4, (ftnlen)
454 1024);
455 i__1 = i__ + *n;
456 dasioc_("WRITE", &unit, &i__1, recc, (ftnlen)5, (
457 ftnlen)1024);
458 } else if (type__ == 2) {
459 dasiod_("READ", &unit, &i__, recd, (ftnlen)4);
460 i__1 = i__ + *n;
461 dasiod_("WRITE", &unit, &i__1, recd, (ftnlen)5);
462 } else {
463 dasioi_("READ", &unit, &i__, reci, (ftnlen)4);
464 i__1 = i__ + *n;
465 dasioi_("WRITE", &unit, &i__1, reci, (ftnlen)5);
466 }
467 }
468
469 /* The next descriptor to look at is the preceding one in */
470 /* the directory. */
471
472 --pos;
473 nxttyp = type__;
474 }
475
476 /* Find the preceding directory record. */
477
478 prec = dirrec[0];
479
480 /* Update the backward and forward pointers in the current */
481 /* directory record. However, don't modify null pointers. */
482
483 if (dirrec[1] > 0) {
484 dirrec[1] += *n;
485 }
486 if (dirrec[0] > 0) {
487 dirrec[0] += *n;
488 }
489
490 /* Move the current directory record. */
491
492 i__3 = nrec + *n;
493 dasioi_("WRITE", &unit, &i__3, dirrec, (ftnlen)5);
494
495 /* Consider the previous directory. */
496
497 nrec = prec;
498 }
499 }
500
501 /* Update the file summary. The number of comment records and the */
502 /* number of the first free record have been incremented by N. */
503 /* The numbers of the records containing the last descriptor of each */
504 /* type have been incremented by N only if they were non-zero. */
505
506 /* The call to DASUFS will update the file record as well as the */
507 /* file summary. */
508
509 ncomr += *n;
510 free += *n;
511 for (i__ = 1; i__ <= 3; ++i__) {
512 if (lastrc[(i__3 = i__ - 1) < 3 && 0 <= i__3 ? i__3 : s_rnge("lastrc",
513 i__3, "dasacr_", (ftnlen)564)] != 0) {
514 lastrc[(i__3 = i__ - 1) < 3 && 0 <= i__3 ? i__3 : s_rnge("lastrc",
515 i__3, "dasacr_", (ftnlen)565)] = lastrc[(i__1 = i__ - 1)
516 < 3 && 0 <= i__1 ? i__1 : s_rnge("lastrc", i__1, "dasacr_"
517 , (ftnlen)565)] + *n;
518 }
519 }
520 dasufs_(handle, &nresvr, &nresvc, &ncomr, &ncomc, &free, lastla, lastrc,
521 lastwd);
522 chkout_("DASACR", (ftnlen)6);
523 return 0;
524 } /* dasacr_ */
525
526