1 /* dasudc.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 DASUDC ( DAS, update data, character ) */
dasudc_(integer * handle,integer * first,integer * last,integer * bpos,integer * epos,char * data,ftnlen data_len)13 /* Subroutine */ int dasudc_(integer *handle, integer *first, integer *last,
14 integer *bpos, integer *epos, char *data, ftnlen data_len)
15 {
16 /* System generated locals */
17 integer i__1, i__2;
18
19 /* Local variables */
20 integer l, n;
21 extern /* Subroutine */ int chkin_(char *, ftnlen);
22 integer lastc, lastd, recno, lasti, nmove, rcpos;
23 extern /* Subroutine */ int dasa2l_(integer *, integer *, integer *,
24 integer *, integer *, integer *, integer *);
25 extern logical failed_(void);
26 integer clbase;
27 extern /* Subroutine */ int daslla_(integer *, integer *, integer *,
28 integer *), dasurc_(integer *, integer *, integer *, integer *,
29 char *, ftnlen);
30 integer nmoved, clsize;
31 extern /* Subroutine */ int sigerr_(char *, ftnlen);
32 integer numchr;
33 extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *,
34 ftnlen), errint_(char *, integer *, ftnlen);
35 integer wordno;
36 extern logical return_(void);
37 integer nwritn, chr, elt;
38
39 /* $ Abstract */
40
41 /* Update character data in a specified range of DAS logical */
42 /* addresses with substrings of a character array. */
43
44 /* $ Disclaimer */
45
46 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
47 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
48 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
49 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
50 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
51 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
52 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
53 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
54 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
55 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
56
57 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
58 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
59 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
60 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
61 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
62 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
63
64 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
65 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
66 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
67 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
68
69 /* $ Required_Reading */
70
71 /* DAS */
72
73 /* $ Keywords */
74
75 /* ASSIGNMENT */
76 /* DAS */
77 /* FILES */
78
79 /* $ Declarations */
80 /* $ Brief_I/O */
81
82 /* Variable I/O Description */
83 /* -------- --- -------------------------------------------------- */
84 /* HANDLE I DAS file handle. */
85 /* FIRST, */
86 /* LAST I Range of DAS character logical addresses. */
87 /* BPOS, */
88 /* EPOS I Begin and end positions of substrings. */
89 /* DATA I Data having addresses FIRST through LAST. */
90
91 /* $ Detailed_Input */
92
93 /* HANDLE is a file handle of a DAS file opened for writing. */
94
95 /* FIRST, */
96 /* LAST are the first and last of a range of DAS logical */
97 /* addresses of characters. These addresses satisfy */
98 /* the inequality */
99
100 /* 1 < FIRST < LAST < LASTC */
101 /* _ - - */
102
103 /* where LASTC is the last character logical address */
104 /* in use in the DAS file designated by HANDLE. */
105
106 /* BPOS, */
107 /* EPOS are begin and end character positions that define */
108 /* the substrings of the input array that are to be */
109 /* added to the DAS file. */
110
111 /* DATA is an array of character strings. The contents of */
112 /* the specified substrings of the elements of the */
113 /* array DATA will be written to the indicated DAS */
114 /* file in order: DATA(1)(BPOS:BPOS) will be written */
115 /* to character logical address FIRST; */
116 /* DATA(1)(BPOS+1:BPOS+1) will be written to */
117 /* the character logical address FIRST+1, and so on; */
118 /* in this ordering scheme, character (BPOS:BPOS) of */
119 /* DATA(I+1) is the successor of character (EPOS:EPOS) */
120 /* of DATA(I). */
121
122 /* $ Detailed_Output */
123
124 /* None. */
125
126 /* $ Parameters */
127
128 /* None. */
129
130 /* $ Exceptions */
131
132 /* 1) If the input file handle is invalid, the error will be */
133 /* diagnosed by routines called by this routine. */
134
135 /* 2) Only logical addresses that already contain data may be */
136 /* updated: if either FIRST or LAST are outside the range */
137
138 /* [ 1, LASTC ] */
139
140 /* where LASTC is the last character logical address that */
141 /* currently contains data in the indicated DAS file, the error */
142 /* SPICE(INVALIDADDRESS) is signalled. The DAS file will not be */
143 /* modified. */
144
145 /* 3) If FIRST > LAST but both addresses are valid, this routine */
146 /* will not modify the indicated DAS file. No error will be */
147 /* signalled. */
148
149 /* 4) If an I/O error occurs during the data update attempted */
150 /* by this routine, the error will be diagnosed by routines */
151 /* called by this routine. FIRST and LAST will not be modified. */
152
153 /* $ Files */
154
155 /* See the description of the argument HANDLE in $Detailed_Input. */
156
157 /* $ Particulars */
158
159 /* This routine replaces the character data in the specified range */
160 /* of logical addresses within a DAS file with the contents of the */
161 /* specified substrings of the input array DATA. */
162
163 /* The actual physical write operations that update the indicated */
164 /* DAS file with the contents of the input array DATA may not take */
165 /* place before this routine returns, since the DAS system buffers */
166 /* data that is written as well as data that is read. In any case, */
167 /* the data will be flushed to the file at the time the file is */
168 /* closed, if not earlier. A physical write of all buffered */
169 /* records can be forced by calling the SPICELIB routine DASWBR */
170 /* (DAS, write buffered records). */
171
172 /* In order to append character data to a DAS file, filling in a */
173 /* range of character logical addresses that starts immediately */
174 /* after the last character logical address currently in use, the */
175 /* SPICELIB routines DASADS ( DAS add data, substring ) or DASADC */
176 /* ( DAS add data, character ) should be used. */
177
178 /* $ Examples */
179
180 /* 1) Write to addresses 1 through 320 in a DAS file in */
181 /* random-access fashion by updating the file. Recall */
182 /* that data must be present in the file before it can */
183 /* be updated. */
184
185
186 /* PROGRAM UP */
187
188 /* CHARACTER*(80) BUFFER ( 10 ) */
189 /* CHARACTER*(80) LINE */
190 /* CHARACTER*(4) TYPE */
191
192 /* INTEGER FIRST */
193 /* INTEGER HANDLE */
194 /* INTEGER I */
195 /* INTEGER LAST */
196
197 /* C */
198 /* C Open the new DAS file RAND.DAS. Use the file name */
199 /* C as the internal file name. */
200 /* C */
201 /* TYPE = 'TEST' */
202 /* CALL DASONW ( 'TEST.DAS', TYPE, 'TEST.DAS', HANDLE ) */
203
204 /* C */
205 /* C Append 320 characters to the file, thereby reserving */
206 /* C enough room for 10 strings of 32 characters. After */
207 /* C the data is present, we're free to update it in any */
208 /* C order we please. */
209 /* C */
210 /* LINE = ' ' */
211
212 /* DO I = 1, 10 */
213 /* CALL DASADC ( HANDLE, 32, 1, 32, LINE ) */
214 /* END DO */
215
216 /* C */
217 /* C Now the character logical addresses 1:320 can be */
218 /* C written to in random-access fashion. We'll fill */
219 /* C them in by writing 32 characters at a time, starting */
220 /* C with addresses 289:320 and working backwards. */
221 /* C */
222 /* FIRST = 321 */
223
224 /* DO I = 10, 1, -1 */
225
226 /* LAST = FIRST - 1 */
227 /* FIRST = LAST - 32 */
228
229 /* LINE = 'This is the # line.' */
230 /* CALL REPMOT ( LINE, '#', I, 'L', LINE ) */
231 /* CALL DASUDC ( HANDLE, FIRST, LAST, 1, 32, LINE ) */
232
233 /* END DO */
234
235 /* C */
236 /* C Close the file. */
237 /* C */
238 /* CALL DASCLS ( HANDLE ) */
239
240 /* C */
241 /* C Now make sure that we updated the file properly. */
242 /* C Open the file for reading and dump the contents */
243 /* C of the character logical addresses 1:320. */
244 /* C */
245 /* CALL DASOPR ( 'RAND.DAS', HANDLE ) */
246
247 /* CALL DASRDC ( HANDLE, 1, 320, 1, 32, BUFFER ) */
248
249 /* WRITE (*,*) 'Contents of RAND.DAS:' */
250 /* WRITE (*,*) ' ' */
251 /* WRITE (*,*) BUFFER(1:32) */
252
253 /* END */
254
255 /* $ Restrictions */
256
257 /* None. */
258
259 /* $ Literature_References */
260
261 /* None. */
262
263 /* $ Author_and_Institution */
264
265 /* K.R. Gehringer (JPL) */
266 /* N.J. Bachman (JPL) */
267 /* W.L. Taber (JPL) */
268
269 /* $ Version */
270
271 /* - SPICELIB Version 1.3.0 10-APR-2014 (NJB) */
272
273 /* Deleted declarations of unused parameters. */
274
275 /* Corrected header comments: routine that flushes */
276 /* written, buffered records is DASWBR, not DASWUR. */
277
278 /* - SPICELIB Version 1.2.1 19-DEC-1995 (NJB) */
279
280 /* Corrected title of permuted index entry section. */
281
282 /* - SPICELIB Version 1.2.0, 12-MAY-1995 (NJB) */
283
284 /* Bug fix: routine handled values of BPOS incorrectly when */
285 /* BPOS > 1. */
286
287 /* - SPICELIB Version 1.1.0, 12-MAY-1994 (KRG) (NJB) */
288
289 /* Test of FAILED() added to loop termination conditions. */
290
291 /* Removed references to specific DAS file open routines in the */
292 /* $ Detailed_Input section of the header. This was done in order */
293 /* to minimize documentation changes if the DAS open routines ever */
294 /* change. */
295
296 /* Modified the $ Examples section to demonstrate the new ID word */
297 /* format which includes a file type and to include a call to the */
298 /* new routine DASONW, open new for write, which makes use of the */
299 /* file type. Also, a variable for the type of the file to be */
300 /* created was added. */
301
302 /* - SPICELIB Version 1.0.0, 12-NOV-1992 (NJB) (WLT) */
303
304 /* -& */
305 /* $ Index_Entries */
306
307 /* update a range of DAS logical addresses using substrings */
308 /* write substrings to a range of DAS logical addresses */
309
310 /* -& */
311 /* $ Revisions */
312
313 /* - SPICELIB Version 1.2.0, 12-MAY-1995 (NJB) */
314
315 /* Bug fix: routine handled values of BPOS incorrectly when */
316 /* BPOS > 1. This was due to the incorrect initialization */
317 /* of the internal variables CHR and ELT. The initialization */
318 /* was corrected. */
319
320 /* - SPICELIB Version 1.1.0, 12-MAY-1994 (KRG) (NJB) */
321
322 /* Tests of FAILED() added to loop termination conditions. */
323 /* Without these tests, infinite loops could result if DASA2L or */
324 /* DASURC signaled an error inside the loops. */
325
326 /* Removed references to specific DAS file open routines in the */
327 /* $ Detailed_Input section of the header. This was done in order */
328 /* to minimize documentation changes if the DAS open routines ever */
329 /* change. */
330
331 /* Modified the $ Examples section to demonstrate the new ID word */
332 /* format which includes a file type and to include a call to the */
333 /* new routine DASONW, open new for write, which makes use of the */
334 /* file type. Also, a variable for the type of the file to be */
335 /* created was added. */
336
337 /* - SPICELIB Version 1.0.0, 12-NOV-1992 (NJB) (WLT) */
338
339 /* -& */
340
341 /* SPICELIB functions */
342
343
344 /* Local parameters */
345
346
347 /* Local variables */
348
349
350 /* Standard SPICE error handling. */
351
352 if (return_()) {
353 return 0;
354 } else {
355 chkin_("DASUDC", (ftnlen)6);
356 }
357
358 /* Get the last logical addresses in use in this DAS file. */
359
360 daslla_(handle, &lastc, &lastd, &lasti);
361
362 /* Validate the input addresses. */
363
364 if (*first < 1 || *first > lastc || *last < 1 || *last > lastc) {
365 setmsg_("FIRST was #. LAST was #. Valid range is [1,#].", (ftnlen)46);
366 errint_("#", first, (ftnlen)1);
367 errint_("#", last, (ftnlen)1);
368 errint_("#", &lastc, (ftnlen)1);
369 sigerr_("SPICE(INVALIDADDRESS)", (ftnlen)21);
370 chkout_("DASUDC", (ftnlen)6);
371 return 0;
372 }
373
374 /* Get the length of the substrings of DATA. Count the total number */
375 /* of characters to write. */
376
377 l = *epos - *bpos + 1;
378 n = *last - *first + 1;
379 nwritn = 0;
380
381 /* Find out the physical location of the first character to update. */
382
383 dasa2l_(handle, &c__1, first, &clbase, &clsize, &recno, &wordno);
384
385 /* Write as much data into record RECNO as is necessary and possible. */
386
387 /* NUMCHR is the number of characters to write to the current record. */
388
389 /* ELT is the index of the element of the input array that we're */
390 /* taking data from. CHR is the position in that array element of */
391 /* the next character to move to the file. */
392
393 /* NMOVED is the number of characters we've moved into the current */
394 /* record so far. */
395
396 /* RCPOS is the character position we'll write to next in the current */
397 /* record. */
398
399 /* Computing MIN */
400 i__1 = n, i__2 = 1024 - wordno + 1;
401 numchr = min(i__1,i__2);
402 elt = 1;
403 chr = *bpos;
404 nmoved = 0;
405 rcpos = wordno;
406 while(nmoved < numchr && ! failed_()) {
407 if (chr > *epos) {
408 ++elt;
409 chr = *bpos;
410 }
411
412 /* Find out how many characters to move from the current array */
413 /* element to the current record. */
414
415 /* Computing MIN */
416 i__1 = numchr - nmoved, i__2 = *epos - chr + 1;
417 nmove = min(i__1,i__2);
418
419 /* Update the current record. */
420
421 i__1 = rcpos + nmove - 1;
422 dasurc_(handle, &recno, &rcpos, &i__1, data + ((elt - 1) * data_len +
423 (chr - 1)), chr + nmove - 1 - (chr - 1));
424 nmoved += nmove;
425 rcpos += nmove;
426 chr += nmove;
427 }
428 nwritn = numchr;
429 ++recno;
430
431 /* Update as many additional records as necessary. */
432
433 while(nwritn < n && ! failed_()) {
434
435 /* At this point, RECNO is the correct number of the record to */
436 /* write to next. CLBASE is the number of the first record of */
437 /* the cluster we're about to write to. */
438
439 if (recno < clbase + clsize) {
440
441 /* We can continue writing the current cluster. Find */
442 /* out how many elements to write to the current record, */
443 /* and write them. */
444
445 /* Computing MIN */
446 i__1 = n - nwritn;
447 numchr = min(i__1,1024);
448 nmoved = 0;
449 rcpos = 1;
450 while(nmoved < numchr && ! failed_()) {
451 if (chr > l) {
452 ++elt;
453 chr = *bpos;
454 }
455
456 /* Find out how many characters to move from the array */
457 /* element to the current record. */
458
459 /* Computing MIN */
460 i__1 = numchr - nmoved, i__2 = *epos - chr + 1;
461 nmove = min(i__1,i__2);
462 i__1 = rcpos + nmove - 1;
463 dasurc_(handle, &recno, &rcpos, &i__1, data + ((elt - 1) *
464 data_len + (chr - 1)), chr + nmove - 1 - (chr - 1));
465 nmoved += nmove;
466 rcpos += nmove;
467 chr += nmove;
468 }
469 nwritn += numchr;
470 ++recno;
471 } else {
472
473 /* We must find the next character cluster to write to. */
474 /* The first character in this cluster has address FIRST + */
475 /* NWRITN. */
476
477 i__1 = *first + nwritn;
478 dasa2l_(handle, &c__1, &i__1, &clbase, &clsize, &recno, &wordno);
479 }
480 }
481 chkout_("DASUDC", (ftnlen)6);
482 return 0;
483 } /* dasudc_ */
484
485