1 /* dasadc.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 integer c__1 = 1;
11
12 /* $Procedure DASADC ( DAS, add data, character ) */
dasadc_(integer * handle,integer * n,integer * bpos,integer * epos,char * data,ftnlen data_len)13 /* Subroutine */ int dasadc_(integer *handle, integer *n, integer *bpos,
14 integer *epos, char *data, ftnlen data_len)
15 {
16 /* System generated locals */
17 integer i__1, i__2, i__3;
18
19 /* Builtin functions */
20 integer i_len(char *, ftnlen);
21 /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
22
23 /* Local variables */
24 integer free;
25 extern /* Subroutine */ int chkin_(char *, ftnlen);
26 integer ncomc, lastc, recno, ncomr, nmove, rcpos;
27 extern /* Subroutine */ int dasa2l_(integer *, integer *, integer *,
28 integer *, integer *, integer *, integer *);
29 extern logical failed_(void);
30 integer clbase;
31 extern /* Subroutine */ int dascud_(integer *, integer *, integer *),
32 dashfs_(integer *, integer *, integer *, integer *, integer *,
33 integer *, integer *, integer *, integer *);
34 char record[1024];
35 integer lastla[3];
36 extern /* Subroutine */ int dasurc_(integer *, integer *, integer *,
37 integer *, char *, ftnlen), daswrc_(integer *, integer *, char *,
38 ftnlen);
39 integer lastrc[3], clsize, nmoved;
40 extern /* Subroutine */ int sigerr_(char *, ftnlen);
41 integer numchr;
42 extern /* Subroutine */ int chkout_(char *, ftnlen);
43 integer lastwd[3], nresvc;
44 extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *,
45 integer *, ftnlen);
46 integer wordno;
47 extern logical return_(void);
48 integer nresvr, nwritn, chr, elt;
49
50 /* $ Abstract */
51
52 /* Add character data to a DAS file. */
53
54 /* $ Disclaimer */
55
56 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
57 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
58 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
59 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
60 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
61 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
62 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
63 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
64 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
65 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
66
67 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
68 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
69 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
70 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
71 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
72 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
73
74 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
75 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
76 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
77 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
78
79 /* $ Required_Reading */
80
81 /* DAS */
82
83 /* $ Keywords */
84
85 /* ARRAY */
86 /* ASSIGNMENT */
87 /* DAS */
88 /* FILES */
89
90 /* $ Declarations */
91 /* $ Brief_I/O */
92
93 /* Variable I/O Description */
94 /* -------- --- -------------------------------------------------- */
95 /* HANDLE I DAS file handle. */
96 /* N I Number of characters to add to file. */
97 /* BPOS, */
98 /* EPOS I Begin and end positions of substrings. */
99 /* DATA I Array of character strings. */
100
101 /* $ Detailed_Input */
102
103 /* HANDLE is a file handle of a DAS file opened for writing. */
104
105 /* N is the number of characters, in the specified set */
106 /* of substrings, to add to the specified DAS file. */
107
108 /* BPOS, */
109 /* EPOS are begin and end character positions that define */
110 /* a set of substrings in the input array. This */
111 /* routine writes characters from the specified set */
112 /* of substrings to the specified DAS file. */
113
114 /* DATA is an array of character strings, some portion of */
115 /* whose contents are to be added to the specified */
116 /* DAS file. Specifically, the first N characters of */
117 /* the substrings */
118
119 /* DATA(I) (BPOS:EPOS), I = 1, ... */
120
121 /* are appended to the character data in the file. */
122 /* The order of characters in the input substrings */
123 /* is considered to increase from left to right */
124 /* within each element of DATA, and to increase */
125 /* with the indices of the elements of DATA. */
126
127 /* $ Detailed_Output */
128
129 /* None. See $Particulars for a description of the effect of this */
130 /* routine. */
131
132 /* $ Parameters */
133
134 /* None. */
135
136 /* $ Exceptions */
137
138 /* 1) If the input file handle is invalid, the error will be */
139 /* diagnosed by routines called by this routine. */
140
141 /* 2) If EPOS or BPOS are outside of the range */
142
143 /* [ 1, LEN( DATA(1) ) ] */
144
145 /* or if EPOS < BPOS, the error SPICE(BADSUBSTRINGBOUNDS) will */
146 /* be signalled. */
147
148 /* 3) If the input count N is less than 1, no data will be */
149 /* added to the specified DAS file. */
150
151 /* 4) If an I/O error occurs during the data addition attempted */
152 /* by this routine, the error will be diagnosed by routines */
153 /* called by this routine. */
154
155 /* 5) If N is greater than the number of characters in the */
156 /* specified set of input substrings, the results of calling */
157 /* this routine are unpredictable. This routine cannot */
158 /* detect this error. */
159
160 /* $ Files */
161
162 /* See the description of the argument HANDLE in $Detailed_Input. */
163
164 /* $ Particulars */
165
166 /* This routine adds character data to a DAS file by `appending' it */
167 /* after any character data already in the file. The sense in which */
168 /* the data is `appended' is that the data will occupy a range of */
169 /* logical addresses for character data that immediately follow the */
170 /* last logical address of a character that is occupied at the time */
171 /* this routine is called. The diagram below illustrates this */
172 /* addition: */
173
174 /* +-------------------------+ */
175 /* | (already in use) | Character logical address 1 */
176 /* +-------------------------+ */
177 /* . */
178 /* . */
179 /* . */
180 /* +-------------------------+ Last character logical address */
181 /* | (already in use) | in use before call to DASADC */
182 /* +-------------------------+ */
183 /* | DATA(1) (BPOS:BPOS) | First added character */
184 /* +-------------------------+ */
185 /* | DATA(1) (BPOS+1:BPOS+1) | */
186 /* +-------------------------+ */
187 /* . */
188 /* . */
189 /* . */
190 /* +-------------------------+ */
191 /* | DATA(1) (EPOS:EPOS) | */
192 /* +-------------------------+ */
193 /* | DATA(2) (BPOS:BPOS) | */
194 /* +-------------------------+ */
195 /* . */
196 /* . */
197 /* . */
198 /* +-------------------------+ */
199 /* | DATA(R) (C:C) | Nth added character---here R is */
200 /* +-------------------------+ */
201 /* INT ( (N+L-1)/L ) */
202
203 /* where L = EPOS - BPOS + 1, and */
204 /* C is */
205
206 /* N - (R-1)*L */
207
208
209 /* The logical organization of the characters in the DAS file is */
210 /* independent of the order of addition to the file or physical */
211 /* location of any data of integer or double precision type. */
212
213 /* The actual physical write operations that add the input array */
214 /* DATA to the indicated DAS file may not take place before this */
215 /* routine returns, since the DAS system buffers data that is */
216 /* written as well as data that is read. In any case, the data */
217 /* will be flushed to the file at the time the file is closed, if */
218 /* not earlier. A physical write of all buffered records can be */
219 /* forced by calling the SPICELIB routine DASWBR (DAS, write */
220 /* buffered records). */
221
222 /* In order to update character logical addresses that already */
223 /* contain data, the SPICELIB routine DASUDC (DAS, update data, */
224 /* character) should be used. */
225
226 /* $ Examples */
227
228 /* 1) Create the new DAS file TEST.DAS and add 120 characters to it. */
229 /* Close the file, then re-open it and read the data back out. */
230
231
232 /* PROGRAM TEST_ADD */
233
234 /* CHARACTER*(80) LINES ( 3 ) */
235 /* CHARACTER*(4) TYPE */
236
237 /* INTEGER HANDLE */
238 /* INTEGER I */
239
240 /* DATA LINES / 'Here is the first line.', */
241 /* . 'Here is the second line.', */
242 /* . 'Here is the third line.' / */
243
244 /* C */
245 /* C Open a new DAS file. Use the file name as */
246 /* C the internal file name. */
247 /* C */
248 /* TYPE = 'TEST' */
249 /* CALL DASONW ( 'TEST.DAS', TYPE, 'TEST.DAS', HANDLE ) */
250
251 /* C */
252 /* C Add the contents of the array LINES to the file. */
253 /* C Since the lines are short, just use the first 40 */
254 /* C characters of each one. */
255 /* C */
256 /* CALL DASADC ( HANDLE, 120, 1, 40, LINES ) */
257
258 /* C */
259 /* C Close the file. */
260 /* C */
261 /* CALL DASCLS ( HANDLE ) */
262
263 /* C */
264 /* C Now verify the addition of data by opening the */
265 /* C file for read access and retrieving the data. */
266 /* C */
267 /* CALL DASOPR ( 'TEST.DAS', HANDLE ) */
268
269 /* DO I = 1, 3 */
270 /* LINES(I) = ' ' */
271 /* END DO */
272
273 /* CALL DASRDC ( HANDLE, 1, 120, 1, 40, LINES ) */
274
275 /* C */
276 /* C Dump the data to the screen. We should see the */
277 /* C sequence */
278 /* C */
279 /* C Here is the first line. */
280 /* C Here is the second line. */
281 /* C Here is the third line. */
282 /* C */
283 /* WRITE (*,*) ' ' */
284 /* WRITE (*,*) 'Data from TEST.DAS: ' */
285 /* WRITE (*,*) ' ' */
286 /* WRITE (*,*) LINES */
287
288 /* END */
289
290 /* $ Restrictions */
291
292 /* None. */
293
294 /* $ Literature_References */
295
296 /* None. */
297
298 /* $ Author_and_Institution */
299
300 /* K.R. Gehringer (JPL) */
301 /* N.J. Bachman (JPL) */
302 /* W.L. Taber (JPL) */
303
304 /* $ Version */
305
306 /* - SPICELIB Version 1.2.0 10-APR-2014 (NJB) */
307
308 /* Deleted declarations of unused parameters. */
309
310 /* Corrected header comments: routine that flushes */
311 /* written, buffered records is DASWBR, not DASWUR. */
312
313 /* - SPICELIB Version 1.1.1 19-DEC-1995 (NJB) */
314
315 /* Corrected title of permuted index entry section. */
316
317 /* - SPICELIB Version 1.1.0 12-MAY-1994 (KRG) (NJB) */
318
319 /* Test of FAILED() added to loop termination condition. */
320
321 /* Removed references to specific DAS file open routines in the */
322 /* $ Detailed_Input section of the header. This was done in order */
323 /* to minimize documentation changes if the DAS open routines ever */
324 /* change. */
325
326 /* Modified the $ Examples section to demonstrate the new ID word */
327 /* format which includes a file type and to include a call to the */
328 /* new routine DASONW, open new, which makes use of the file */
329 /* type. Also, a variable for the type of the file to be created */
330 /* was added. */
331
332 /* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) */
333
334 /* -& */
335 /* $ Index_Entries */
336
337 /* add character data to a DAS file */
338
339 /* -& */
340 /* $ Revisions */
341
342 /* - SPICELIB Version 1.1.0, 12-MAY-1994 (KRG) (NJB) */
343
344 /* Test of FAILED() added to loop termination condition. Without */
345 /* this test, an infinite loop could result if DASA2L, DASURC or */
346 /* DASWRC signaled an error inside the loop. */
347
348 /* Removed references to specific DAS file open routines in the */
349 /* $ Detailed_Input section of the header. This was done in order */
350 /* to minimize documentation changes if the DAS open routines ever */
351 /* change. */
352
353 /* Modified the $ Examples section to demonstrate the new ID word */
354 /* format which includes a file type and to include a call to the */
355 /* new routine DASONW, open new, which makes use of the file */
356 /* type. Also, a variable for the type of the file to be created */
357 /* was added. */
358
359 /* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) */
360
361 /* -& */
362
363 /* SPICELIB functions */
364
365
366 /* Local parameters */
367
368
369 /* Local variables */
370
371
372 /* Standard SPICE error handling. */
373
374 if (return_()) {
375 return 0;
376 } else {
377 chkin_("DASADC", (ftnlen)6);
378 }
379
380 /* Make sure BPOS and EPOS are OK; stop here if not. */
381
382 if (*bpos < 1 || *epos < 1 || *bpos > i_len(data, data_len) || *epos >
383 i_len(data, data_len)) {
384 setmsg_("Substring bounds must be in range [1,#]. Actual range [BPOS"
385 ",EPOS] was [#,#].", (ftnlen)76);
386 i__1 = i_len(data, data_len);
387 errint_("#", &i__1, (ftnlen)1);
388 errint_("#", bpos, (ftnlen)1);
389 errint_("#", epos, (ftnlen)1);
390 sigerr_("SPICE(BADSUBSTRINGBOUNDS)", (ftnlen)25);
391 chkout_("DASADC", (ftnlen)6);
392 return 0;
393 } else if (*epos < *bpos) {
394 setmsg_("Substring upper bound must not be less than lower bound. A"
395 "ctual range [BPOS,EPOS] was [#,#].", (ftnlen)93);
396 errint_("#", bpos, (ftnlen)1);
397 errint_("#", epos, (ftnlen)1);
398 sigerr_("SPICE(BADSUBSTRINGBOUNDS)", (ftnlen)25);
399 chkout_("DASADC", (ftnlen)6);
400 return 0;
401 }
402
403 /* Get the file summary for this DAS. */
404
405 dashfs_(handle, &nresvr, &nresvc, &ncomr, &ncomc, &free, lastla, lastrc,
406 lastwd);
407 lastc = lastla[0];
408
409 /* We will keep track of the location that we wish to write to */
410 /* with the variables RECNO and WORDNO. RECNO will be the record */
411 /* number of the record we'll write to; WORDNO will be the number */
412 /* preceding the word index, within record number RECNO, that we'll */
413 /* write to. For example, if we're about to write to the first */
414 /* character in record 10, RECNO will be 10 and WORDNO will be 0. Of */
415 /* course, when WORDNO reaches NWC, we'll have to find a free record */
416 /* before writing anything. */
417
418 /* Prepare the variables RECNO and WORDNO: use the physical location */
419 /* of the last character address, if there are any character data in */
420 /* the file. Otherwise, RECNO becomes the first record available for */
421 /* character data. */
422
423 if (lastc >= 1) {
424 dasa2l_(handle, &c__1, &lastc, &clbase, &clsize, &recno, &wordno);
425 } else {
426 recno = free;
427 wordno = 0;
428 }
429
430 /* Set the number of character words already written. Keep */
431 /* writing to the file until this number equals the number of */
432 /* elements in DATA. */
433
434 /* Note that if N is non-positive, the loop doesn't get */
435 /* exercised. */
436
437 /* Also initialize the array element index and position of the */
438 /* character to be moved next. */
439
440 nwritn = 0;
441 elt = 1;
442 chr = *bpos;
443 while(nwritn < *n && ! failed_()) {
444
445 /* Write as much data as we can (or need to) into the current */
446 /* record. We assume that RECNO, WORDNO, and NWRITN have */
447 /* been set correctly at this point. */
448
449 /* Find out how many words to write into the current record. */
450 /* There may be no space left in the current record. */
451
452 /* Computing MIN */
453 i__1 = *n - nwritn, i__2 = 1024 - wordno;
454 numchr = min(i__1,i__2);
455 if (numchr > 0) {
456
457 /* Write NUMCHR words into the current record. If the record */
458 /* is new, write the entire record. Otherwise, just update */
459 /* the part we're interested in. */
460
461 /* In either case, we'll first fill in characters WORDNO+1 */
462 /* through WORDNO + NUMCHR of the string RECORD. */
463
464
465 /* So far, we haven't moved any characters. */
466
467 nmoved = 0;
468 rcpos = wordno;
469 while(nmoved < numchr) {
470
471 /* Find out how many characters in the current array */
472 /* element we should move. */
473
474 if (chr > *epos) {
475 ++elt;
476 chr = *bpos;
477 }
478 /* Computing MIN */
479 i__1 = numchr - nmoved, i__2 = *epos - chr + 1;
480 nmove = min(i__1,i__2);
481 i__1 = rcpos;
482 s_copy(record + i__1, data + ((elt - 1) * data_len + (chr - 1)
483 ), rcpos + nmove - i__1, data_len - (chr - 1));
484 nmoved += nmove;
485 rcpos += nmove;
486 chr += nmove;
487 }
488
489 /* Now we can write or update the file with RECORD. */
490
491 if (wordno == 0) {
492
493 /* The record has not yet been written, so write out the */
494 /* entire record. */
495
496 daswrc_(handle, &recno, record, (ftnlen)1024);
497 } else {
498
499 /* Update elements WORDNO+1 through WORDNO+NUMCHR. */
500
501 i__1 = wordno;
502 i__2 = wordno + 1;
503 i__3 = wordno + numchr;
504 dasurc_(handle, &recno, &i__2, &i__3, record + i__1, wordno +
505 numchr - i__1);
506 }
507 nwritn += numchr;
508 wordno += numchr;
509 } else {
510
511 /* It's time to start on a new record. If the record we */
512 /* just finished writing to (or just attempted writing to, */
513 /* if it was full) was FREE or a higher-numbered record, */
514 /* then we are writing to a contiguous set of data records: */
515 /* the next record to write to is the immediate successor */
516 /* of the last one. Otherwise, FREE is the next record */
517 /* to write to. */
518
519 /* We intentionally leave FREE at the value it had before */
520 /* we starting adding data to the file. */
521
522 if (recno >= free) {
523 ++recno;
524 } else {
525 recno = free;
526 }
527 wordno = 0;
528 }
529 }
530
531 /* Update the DAS file directories to reflect the addition of N */
532 /* character words. DASCUD will also update the file summary */
533 /* accordingly. */
534
535 dascud_(handle, &c__1, n);
536 chkout_("DASADC", (ftnlen)6);
537 return 0;
538 } /* dasadc_ */
539
540