/* $Procedure DASADC ( DAS, add data, character ) */
/* Subroutine */ int dasadc_(integer *handle, integer *n, integer *bpos,
integer *epos, char *data, ftnlen data_len)
{
/* System generated locals */
integer i__1, i__2, i__3;
/* Builtin functions */
integer i_len(char *, ftnlen);
/* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
/* Local variables */
integer free;
extern /* Subroutine */ int chkin_(char *, ftnlen);
integer ncomc, lastc, recno, ncomr, nmove, rcpos;
extern /* Subroutine */ int dasa2l_(integer *, integer *, integer *,
integer *, integer *, integer *, integer *);
extern logical failed_(void);
integer clbase;
extern /* Subroutine */ int dascud_(integer *, integer *, integer *),
dashfs_(integer *, integer *, integer *, integer *, integer *,
integer *, integer *, integer *, integer *);
char record[1024];
integer lastla[3];
extern /* Subroutine */ int dasurc_(integer *, integer *, integer *,
integer *, char *, ftnlen), daswrc_(integer *, integer *, char *,
ftnlen);
integer lastrc[3], clsize, nmoved;
extern /* Subroutine */ int sigerr_(char *, ftnlen);
integer numchr;
extern /* Subroutine */ int chkout_(char *, ftnlen);
integer lastwd[3], nresvc;
extern /* Subroutine */ int setmsg_(char *, ftnlen), errint_(char *,
integer *, ftnlen);
integer wordno;
extern logical return_(void);
integer nresvr, nwritn, chr, elt;
/* $ Abstract */
/* Add character data to a DAS file. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* DAS */
/* $ Keywords */
/* ARRAY */
/* ASSIGNMENT */
/* DAS */
/* FILES */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I DAS file handle. */
/* N I Number of characters to add to file. */
/* BPOS, */
/* EPOS I Begin and end positions of substrings. */
/* DATA I Array of character strings. */
/* $ Detailed_Input */
/* HANDLE is a file handle of a DAS file opened for writing. */
/* N is the number of characters, in the specified set */
/* of substrings, to add to the specified DAS file. */
/* BPOS, */
/* EPOS are begin and end character positions that define */
/* a set of substrings in the input array. This */
/* routine writes characters from the specified set */
/* of substrings to the specified DAS file. */
/* DATA is an array of character strings, some portion of */
/* whose contents are to be added to the specified */
/* DAS file. Specifically, the first N characters of */
/* the substrings */
/* DATA(I) (BPOS:EPOS), I = 1, ... */
/* are appended to the character data in the file. */
/* The order of characters in the input substrings */
/* is considered to increase from left to right */
/* within each element of DATA, and to increase */
/* with the indices of the elements of DATA. */
/* $ Detailed_Output */
/* None. See $Particulars for a description of the effect of this */
/* routine. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the input file handle is invalid, the error will be */
/* diagnosed by routines called by this routine. */
/* 2) If EPOS or BPOS are outside of the range */
/* [ 1, LEN( DATA(1) ) ] */
/* or if EPOS < BPOS, the error SPICE(BADSUBSTRINGBOUNDS) will */
/* be signalled. */
/* 3) If the input count N is less than 1, no data will be */
/* added to the specified DAS file. */
/* 4) If an I/O error occurs during the data addition attempted */
/* by this routine, the error will be diagnosed by routines */
/* called by this routine. */
/* 5) If N is greater than the number of characters in the */
/* specified set of input substrings, the results of calling */
/* this routine are unpredictable. This routine cannot */
/* detect this error. */
/* $ Files */
/* See the description of the argument HANDLE in $Detailed_Input. */
/* $ Particulars */
/* This routine adds character data to a DAS file by `appending' it */
/* after any character data already in the file. The sense in which */
/* the data is `appended' is that the data will occupy a range of */
/* logical addresses for character data that immediately follow the */
/* last logical address of a character that is occupied at the time */
/* this routine is called. The diagram below illustrates this */
/* addition: */
/* +-------------------------+ */
/* | (already in use) | Character logical address 1 */
/* +-------------------------+ */
/* . */
/* . */
/* . */
/* +-------------------------+ Last character logical address */
/* | (already in use) | in use before call to DASADC */
/* +-------------------------+ */
/* | DATA(1) (BPOS:BPOS) | First added character */
/* +-------------------------+ */
/* | DATA(1) (BPOS+1:BPOS+1) | */
/* +-------------------------+ */
/* . */
/* . */
/* . */
/* +-------------------------+ */
/* | DATA(1) (EPOS:EPOS) | */
/* +-------------------------+ */
/* | DATA(2) (BPOS:BPOS) | */
/* +-------------------------+ */
/* . */
/* . */
/* . */
/* +-------------------------+ */
/* | DATA(R) (C:C) | Nth added character---here R is */
/* +-------------------------+ */
/* INT ( (N+L-1)/L ) */
/* where L = EPOS - BPOS + 1, and */
/* C is */
/* N - (R-1)*L */
/* The logical organization of the characters in the DAS file is */
/* independent of the order of addition to the file or physical */
/* location of any data of integer or double precision type. */
/* The actual physical write operations that add the input array */
/* DATA to the indicated DAS file may not take place before this */
/* routine returns, since the DAS system buffers data that is */
/* written as well as data that is read. In any case, the data */
/* will be flushed to the file at the time the file is closed, if */
/* not earlier. A physical write of all buffered records can be */
/* forced by calling the SPICELIB routine DASWUR ( DAS, write */
/* updated records ). */
/* In order to update character logical addresses that already */
/* contain data, the SPICELIB routine DASUDC (DAS, update data, */
/* character) should be used. */
/* $ Examples */
/* 1) Create the new DAS file TEST.DAS and add 120 characters to it. */
/* Close the file, then re-open it and read the data back out. */
/* PROGRAM TEST_ADD */
/* CHARACTER*(80) LINES ( 3 ) */
/* CHARACTER*(4) TYPE */
/* INTEGER HANDLE */
/* INTEGER I */
/* DATA LINES / 'Here is the first line.', */
/* . 'Here is the second line.', */
/* . 'Here is the third line.' / */
/* C */
/* C Open a new DAS file. Use the file name as */
/* C the internal file name. */
/* C */
/* TYPE = 'TEST' */
/* CALL DASONW ( 'TEST.DAS', TYPE, 'TEST.DAS', HANDLE ) */
/* C */
/* C Add the contents of the array LINES to the file. */
/* C Since the lines are short, just use the first 40 */
/* C characters of each one. */
/* C */
/* CALL DASADC ( HANDLE, 120, 1, 40, LINES ) */
/* C */
/* C Close the file. */
/* C */
/* CALL DASCLS ( HANDLE ) */
/* C */
/* C Now verify the addition of data by opening the */
/* C file for read access and retrieving the data. */
/* C */
/* CALL DASOPR ( 'TEST.DAS', HANDLE ) */
/* DO I = 1, 3 */
/* LINES(I) = ' ' */
/* END DO */
/* CALL DASRDC ( HANDLE, 1, 120, 1, 40, LINES ) */
/* C */
/* C Dump the data to the screen. We should see the */
/* C sequence */
/* C */
/* C Here is the first line. */
/* C Here is the second line. */
/* C Here is the third line. */
/* C */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) 'Data from TEST.DAS: ' */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) LINES */
/* END */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* K.R. Gehringer (JPL) */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 1.1.1 19-DEC-1995 (NJB) */
/* Corrected title of permuted index entry section. */
/* - SPICELIB Version 1.1.0 12-MAY-1994 (KRG) (NJB) */
/* Test of FAILED() added to loop termination condition. */
/* Removed references to specific DAS file open routines in the */
/* $ Detailed_Input section of the header. This was done in order */
/* to minimize documentation changes if the DAS open routines ever */
/* change. */
/* Modified the $ Examples section to demonstrate the new ID word */
/* format which includes a file type and to include a call to the */
/* new routine DASONW, open new, which makes use of the file */
/* type. Also, a variable for the type of the file to be created */
/* was added. */
/* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) */
/* -& */
/* $ Index_Entries */
/* add character data to a DAS file */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 1.1.0, 12-MAY-1994 (KRG) (NJB) */
/* Test of FAILED() added to loop termination condition. Without */
/* this test, an infinite loop could result if DASA2L, DASURC or */
/* DASWRC signaled an error inside the loop. */
/* Removed references to specific DAS file open routines in the */
/* $ Detailed_Input section of the header. This was done in order */
/* to minimize documentation changes if the DAS open routines ever */
/* change. */
/* Modified the $ Examples section to demonstrate the new ID word */
/* format which includes a file type and to include a call to the */
/* new routine DASONW, open new, which makes use of the file */
/* type. Also, a variable for the type of the file to be created */
/* was added. */
/* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("DASADC", (ftnlen)6);
}
/* Make sure BPOS and EPOS are OK; stop here if not. */
if (*bpos < 1 || *epos < 1 || *bpos > i_len(data, data_len) || *epos >
i_len(data, data_len)) {
setmsg_("Substring bounds must be in range [1,#]. Actual range [BPOS"
",EPOS] was [#,#].", (ftnlen)76);
i__1 = i_len(data, data_len);
errint_("#", &i__1, (ftnlen)1);
errint_("#", bpos, (ftnlen)1);
errint_("#", epos, (ftnlen)1);
sigerr_("SPICE(BADSUBSTRINGBOUNDS)", (ftnlen)25);
chkout_("DASADC", (ftnlen)6);
return 0;
} else if (*epos < *bpos) {
setmsg_("Substring upper bound must not be less than lower bound. A"
"ctual range [BPOS,EPOS] was [#,#].", (ftnlen)93);
errint_("#", bpos, (ftnlen)1);
errint_("#", epos, (ftnlen)1);
sigerr_("SPICE(BADSUBSTRINGBOUNDS)", (ftnlen)25);
chkout_("DASADC", (ftnlen)6);
return 0;
}
/* Get the file summary for this DAS. */
dashfs_(handle, &nresvr, &nresvc, &ncomr, &ncomc, &free, lastla, lastrc,
lastwd);
lastc = lastla[0];
/* We will keep track of the location that we wish to write to */
/* with the variables RECNO and WORDNO. RECNO will be the record */
/* number of the record we'll write to; WORDNO will be the number */
/* preceding the word index, within record number RECNO, that we'll */
/* write to. For example, if we're about to write to the first */
/* character in record 10, RECNO will be 10 and WORDNO will be 0. Of */
/* course, when WORDNO reaches NWC, we'll have to find a free record */
/* before writing anything. */
/* Prepare the variables RECNO and WORDNO: use the physical location */
/* of the last character address, if there are any character data in */
/* the file. Otherwise, RECNO becomes the first record available for */
/* character data. */
if (lastc >= 1) {
dasa2l_(handle, &c__1, &lastc, &clbase, &clsize, &recno, &wordno);
} else {
recno = free;
wordno = 0;
}
/* Set the number of character words already written. Keep */
/* writing to the file until this number equals the number of */
/* elements in DATA. */
/* Note that if N is non-positive, the loop doesn't get */
/* exercised. */
/* Also initialize the array element index and position of the */
/* character to be moved next. */
nwritn = 0;
elt = 1;
chr = *bpos;
while(nwritn < *n && ! failed_()) {
/* Write as much data as we can (or need to) into the current */
/* record. We assume that RECNO, WORDNO, and NWRITN have */
/* been set correctly at this point. */
/* Find out how many words to write into the current record. */
/* There may be no space left in the current record. */
/* Computing MIN */
i__1 = *n - nwritn, i__2 = 1024 - wordno;
numchr = min(i__1,i__2);
if (numchr > 0) {
/* Write NUMCHR words into the current record. If the record */
/* is new, write the entire record. Otherwise, just update */
/* the part we're interested in. */
/* In either case, we'll first fill in characters WORDNO+1 */
/* through WORDNO + NUMCHR of the string RECORD. */
/* So far, we haven't moved any characters. */
nmoved = 0;
rcpos = wordno;
while(nmoved < numchr) {
/* Find out how many characters in the current array */
/* element we should move. */
if (chr > *epos) {
++elt;
chr = *bpos;
}
/* Computing MIN */
i__1 = numchr - nmoved, i__2 = *epos - chr + 1;
nmove = min(i__1,i__2);
i__1 = rcpos;
s_copy(record + i__1, data + ((elt - 1) * data_len + (chr - 1)
), rcpos + nmove - i__1, data_len - (chr - 1));
nmoved += nmove;
rcpos += nmove;
chr += nmove;
}
/* Now we can write or update the file with RECORD. */
if (wordno == 0) {
/* The record has not yet been written, so write out the */
/* entire record. */
daswrc_(handle, &recno, record, (ftnlen)1024);
} else {
/* Update elements WORDNO+1 through WORDNO+NUMCHR. */
i__1 = wordno;
i__2 = wordno + 1;
i__3 = wordno + numchr;
dasurc_(handle, &recno, &i__2, &i__3, record + i__1, wordno +
numchr - i__1);
}
nwritn += numchr;
wordno += numchr;
} else {
/* It's time to start on a new record. If the record we */
/* just finished writing to (or just attempted writing to, */
/* if it was full) was FREE or a higher-numbered record, */
/* then we are writing to a contiguous set of data records: */
/* the next record to write to is the immediate successor */
/* of the last one. Otherwise, FREE is the next record */
/* to write to. */
/* We intentionally leave FREE at the value it had before */
/* we starting adding data to the file. */
if (recno >= free) {
++recno;
} else {
recno = free;
}
wordno = 0;
}
}
/* Update the DAS file directories to reflect the addition of N */
/* character words. DASCUD will also update the file summary */
/* accordingly. */
dascud_(handle, &c__1, n);
chkout_("DASADC", (ftnlen)6);
return 0;
} /* dasadc_ */
/* $Procedure DASUDC ( DAS, update data, character ) */
/* Subroutine */ int dasudc_(integer *handle, integer *first, integer *last,
integer *bpos, integer *epos, char *data, ftnlen data_len)
{
/* System generated locals */
integer i__1, i__2;
/* Local variables */
integer l, n;
extern /* Subroutine */ int chkin_(char *, ftnlen);
integer lastc, lastd, recno, lasti, nmove, rcpos;
extern /* Subroutine */ int dasa2l_(integer *, integer *, integer *,
integer *, integer *, integer *, integer *);
extern logical failed_(void);
integer clbase;
extern /* Subroutine */ int daslla_(integer *, integer *, integer *,
integer *), dasurc_(integer *, integer *, integer *, integer *,
char *, ftnlen);
integer nmoved, clsize;
extern /* Subroutine */ int sigerr_(char *, ftnlen);
integer numchr;
extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *,
ftnlen), errint_(char *, integer *, ftnlen);
integer wordno;
extern logical return_(void);
integer nwritn, chr, elt;
/* $ Abstract */
/* Update character data in a specified range of DAS logical */
/* addresses with substrings of a character array. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* DAS */
/* $ Keywords */
/* ASSIGNMENT */
/* DAS */
/* FILES */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I DAS file handle. */
/* FIRST, */
/* LAST I Range of DAS character logical addresses. */
/* BPOS, */
/* EPOS I Begin and end positions of substrings. */
/* DATA I Data having addresses FIRST through LAST. */
/* $ Detailed_Input */
/* HANDLE is a file handle of a DAS file opened for writing. */
/* FIRST, */
/* LAST are the first and last of a range of DAS logical */
/* addresses of characters. These addresses satisfy */
/* the inequality */
/* 1 < FIRST < LAST < LASTC */
/* _ - - */
/* where LASTC is the last character logical address */
/* in use in the DAS file designated by HANDLE. */
/* BPOS, */
/* EPOS are begin and end character positions that define */
/* the substrings of the input array that are to be */
/* added to the DAS file. */
/* DATA is an array of character strings. The contents of */
/* the specified substrings of the elements of the */
/* array DATA will be written to the indicated DAS */
/* file in order: DATA(1)(BPOS:BPOS) will be written */
/* to character logical address FIRST; */
/* DATA(1)(BPOS+1:BPOS+1) will be written to */
/* the character logical address FIRST+1, and so on; */
/* in this ordering scheme, character (BPOS:BPOS) of */
/* DATA(I+1) is the successor of character (EPOS:EPOS) */
/* of DATA(I). */
/* $ Detailed_Output */
/* None. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the input file handle is invalid, the error will be */
/* diagnosed by routines called by this routine. */
/* 2) Only logical addresses that already contain data may be */
/* updated: if either FIRST or LAST are outside the range */
/* [ 1, LASTC ] */
/* where LASTC is the last character logical address that */
/* currently contains data in the indicated DAS file, the error */
/* SPICE(INVALIDADDRESS) is signalled. The DAS file will not be */
/* modified. */
/* 3) If FIRST > LAST but both addresses are valid, this routine */
/* will not modify the indicated DAS file. No error will be */
/* signalled. */
/* 4) If an I/O error occurs during the data update attempted */
/* by this routine, the error will be diagnosed by routines */
/* called by this routine. FIRST and LAST will not be modified. */
/* $ Files */
/* See the description of the argument HANDLE in $Detailed_Input. */
/* $ Particulars */
/* This routine replaces the character data in the specified range */
/* of logical addresses within a DAS file with the contents of the */
/* specified substrings of the input array DATA. */
/* The actual physical write operations that update the indicated */
/* DAS file with the contents of the input array DATA may not take */
/* place before this routine returns, since the DAS system buffers */
/* data that is written as well as data that is read. In any case, */
/* the data will be flushed to the file at the time the file is */
/* closed, if not earlier. A physical write of all buffered */
/* records can be forced by calling the SPICELIB routine DASWUR */
/* ( DAS, write updated records ). */
/* In order to append character data to a DAS file, filling in a */
/* range of character logical addresses that starts immediately */
/* after the last character logical address currently in use, the */
/* SPICELIB routines DASADS ( DAS add data, substring ) or DASADC */
/* ( DAS add data, character ) should be used. */
/* $ Examples */
/* 1) Write to addresses 1 through 320 in a DAS file in */
/* random-access fashion by updating the file. Recall */
/* that data must be present in the file before it can */
/* be updated. */
/* PROGRAM UP */
/* CHARACTER*(80) BUFFER ( 10 ) */
/* CHARACTER*(80) LINE */
/* CHARACTER*(4) TYPE */
/* INTEGER FIRST */
/* INTEGER HANDLE */
/* INTEGER I */
/* INTEGER LAST */
/* C */
/* C Open the new DAS file RAND.DAS. Use the file name */
/* C as the internal file name. */
/* C */
/* TYPE = 'TEST' */
/* CALL DASONW ( 'TEST.DAS', TYPE, 'TEST.DAS', HANDLE ) */
/* C */
/* C Append 320 characters to the file, thereby reserving */
/* C enough room for 10 strings of 32 characters. After */
/* C the data is present, we're free to update it in any */
/* C order we please. */
/* C */
/* LINE = ' ' */
/* DO I = 1, 10 */
/* CALL DASADC ( HANDLE, 32, 1, 32, LINE ) */
/* END DO */
/* C */
/* C Now the character logical addresses 1:320 can be */
/* C written to in random-access fashion. We'll fill */
/* C them in by writing 32 characters at a time, starting */
/* C with addresses 289:320 and working backwards. */
/* C */
/* FIRST = 321 */
/* DO I = 10, 1, -1 */
/* LAST = FIRST - 1 */
/* FIRST = LAST - 32 */
/* LINE = 'This is the # line.' */
/* CALL REPMOT ( LINE, '#', I, 'L', LINE ) */
/* CALL DASUDC ( HANDLE, FIRST, LAST, 1, 32, LINE ) */
/* END DO */
/* C */
/* C Close the file. */
/* C */
/* CALL DASCLS ( HANDLE ) */
/* C */
/* C Now make sure that we updated the file properly. */
/* C Open the file for reading and dump the contents */
/* C of the character logical addresses 1:320. */
/* C */
/* CALL DASOPR ( 'RAND.DAS', HANDLE ) */
/* CALL DASRDC ( HANDLE, 1, 320, 1, 32, BUFFER ) */
/* WRITE (*,*) 'Contents of RAND.DAS:' */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) BUFFER(1:32) */
/* END */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* K.R. Gehringer (JPL) */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 1.2.1 19-DEC-1995 (NJB) */
/* Corrected title of permuted index entry section. */
/* - SPICELIB Version 1.2.0, 12-MAY-1995 (NJB) */
/* Bug fix: routine handled values of BPOS incorrectly when */
/* BPOS > 1. */
/* - SPICELIB Version 1.1.0, 12-MAY-1994 (KRG) (NJB) */
/* Test of FAILED() added to loop termination conditions. */
/* Removed references to specific DAS file open routines in the */
/* $ Detailed_Input section of the header. This was done in order */
/* to minimize documentation changes if the DAS open routines ever */
/* change. */
/* Modified the $ Examples section to demonstrate the new ID word */
/* format which includes a file type and to include a call to the */
/* new routine DASONW, open new for write, which makes use of the */
/* file type. Also, a variable for the type of the file to be */
/* created was added. */
/* - SPICELIB Version 1.0.0, 12-NOV-1992 (NJB) (WLT) */
/* -& */
/* $ Index_Entries */
/* update a range of DAS logical addresses using substrings */
/* write substrings to a range of DAS logical addresses */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 1.2.0, 12-MAY-1995 (NJB) */
/* Bug fix: routine handled values of BPOS incorrectly when */
/* BPOS > 1. This was due to the incorrect initialization */
/* of the internal variables CHR and ELT. The initialization */
/* was corrected. */
/* - SPICELIB Version 1.1.0, 12-MAY-1994 (KRG) (NJB) */
/* Tests of FAILED() added to loop termination conditions. */
/* Without these tests, infinite loops could result if DASA2L or */
/* DASURC signaled an error inside the loops. */
/* Removed references to specific DAS file open routines in the */
/* $ Detailed_Input section of the header. This was done in order */
/* to minimize documentation changes if the DAS open routines ever */
/* change. */
/* Modified the $ Examples section to demonstrate the new ID word */
/* format which includes a file type and to include a call to the */
/* new routine DASONW, open new for write, which makes use of the */
/* file type. Also, a variable for the type of the file to be */
/* created was added. */
/* - SPICELIB Version 1.0.0, 12-NOV-1992 (NJB) (WLT) */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("DASUDC", (ftnlen)6);
}
/* Get the last logical addresses in use in this DAS file. */
daslla_(handle, &lastc, &lastd, &lasti);
/* Validate the input addresses. */
if (*first < 1 || *first > lastc || *last < 1 || *last > lastc) {
setmsg_("FIRST was #. LAST was #. Valid range is [1,#].", (ftnlen)46);
errint_("#", first, (ftnlen)1);
errint_("#", last, (ftnlen)1);
errint_("#", &lastc, (ftnlen)1);
sigerr_("SPICE(INVALIDADDRESS)", (ftnlen)21);
chkout_("DASUDC", (ftnlen)6);
return 0;
}
/* Get the length of the substrings of DATA. Count the total number */
/* of characters to write. */
l = *epos - *bpos + 1;
n = *last - *first + 1;
nwritn = 0;
/* Find out the physical location of the first character to update. */
dasa2l_(handle, &c__1, first, &clbase, &clsize, &recno, &wordno);
/* Write as much data into record RECNO as is necessary and possible. */
/* NUMCHR is the number of characters to write to the current record. */
/* ELT is the index of the element of the input array that we're */
/* taking data from. CHR is the position in that array element of */
/* the next character to move to the file. */
/* NMOVED is the number of characters we've moved into the current */
/* record so far. */
/* RCPOS is the character position we'll write to next in the current */
/* record. */
/* Computing MIN */
i__1 = n, i__2 = 1024 - wordno + 1;
numchr = min(i__1,i__2);
elt = 1;
chr = *bpos;
nmoved = 0;
rcpos = wordno;
while(nmoved < numchr && ! failed_()) {
if (chr > *epos) {
++elt;
chr = *bpos;
}
/* Find out how many characters to move from the current array */
/* element to the current record. */
/* Computing MIN */
i__1 = numchr - nmoved, i__2 = *epos - chr + 1;
nmove = min(i__1,i__2);
/* Update the current record. */
i__1 = rcpos + nmove - 1;
dasurc_(handle, &recno, &rcpos, &i__1, data + ((elt - 1) * data_len +
(chr - 1)), chr + nmove - 1 - (chr - 1));
nmoved += nmove;
rcpos += nmove;
chr += nmove;
}
nwritn = numchr;
++recno;
/* Update as many additional records as necessary. */
while(nwritn < n && ! failed_()) {
/* At this point, RECNO is the correct number of the record to */
/* write to next. CLBASE is the number of the first record of */
/* the cluster we're about to write to. */
if (recno < clbase + clsize) {
/* We can continue writing the current cluster. Find */
/* out how many elements to write to the current record, */
/* and write them. */
/* Computing MIN */
i__1 = n - nwritn;
numchr = min(i__1,1024);
nmoved = 0;
rcpos = 1;
while(nmoved < numchr && ! failed_()) {
if (chr > l) {
++elt;
chr = *bpos;
}
/* Find out how many characters to move from the array */
/* element to the current record. */
/* Computing MIN */
i__1 = numchr - nmoved, i__2 = *epos - chr + 1;
nmove = min(i__1,i__2);
i__1 = rcpos + nmove - 1;
dasurc_(handle, &recno, &rcpos, &i__1, data + ((elt - 1) *
data_len + (chr - 1)), chr + nmove - 1 - (chr - 1));
nmoved += nmove;
rcpos += nmove;
chr += nmove;
}
nwritn += numchr;
++recno;
} else {
/* We must find the next character cluster to write to. */
/* The first character in this cluster has address FIRST + */
/* NWRITN. */
i__1 = *first + nwritn;
dasa2l_(handle, &c__1, &i__1, &clbase, &clsize, &recno, &wordno);
}
}
chkout_("DASUDC", (ftnlen)6);
return 0;
} /* dasudc_ */
/* $Procedure DASRDD ( DAS, read data, double precision ) */
/* Subroutine */ int dasrdd_(integer *handle, integer *first, integer *last,
doublereal *data)
{
/* System generated locals */
integer i__1, i__2;
/* Local variables */
integer n, nread, recno, numdp;
extern /* Subroutine */ int dasa2l_(integer *, integer *, integer *,
integer *, integer *, integer *, integer *);
extern logical failed_(void);
integer clbase;
extern /* Subroutine */ int dasrrd_(integer *, integer *, integer *,
integer *, doublereal *);
integer clsize, wordno;
/* $ Abstract */
/* Read double precision data from a range of DAS logical addresses. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* DAS */
/* $ Keywords */
/* ARRAY */
/* ASSIGNMENT */
/* DAS */
/* FILES */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I DAS file handle. */
/* FIRST, */
/* LAST I Range of DAS double precision logical addresses. */
/* DATA O Data having addresses FIRST through LAST. */
/* $ Detailed_Input */
/* HANDLE is a file handle for an open DAS file. */
/* FIRST, */
/* LAST are a range of DAS double precision logical */
/* addresses. FIRST and LAST must be greater than or */
/* equal to 1 and less than or equal to the highest */
/* double precision logical address in the DAS file */
/* designated by HANDLE. */
/* $ Detailed_Output */
/* DATA is an array of double precision numbers. DATA */
/* should have length at least LAST - FIRST + 1. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the input file handle is invalid, the error will be */
/* diagnosed by routines called by this routine. DATA will */
/* not be modified. */
/* 2) If FIRST or LAST are out of range, the error will be diagnosed */
/* by routines called by this routine. */
/* 3) If FIRST is greater than LAST, DATA is left unchanged. */
/* 4) If DATA is declared with length less than FIRST - LAST + 1, */
/* the error cannot be diagnosed by this routine. */
/* $ Files */
/* See the description of the argument HANDLE in $Detailed_Input. */
/* $ Particulars */
/* This routine provides random read access to the double precision */
/* data in a DAS file. This data is logically structured as a */
/* one-dimensional array of double precision numbers. */
/* $ Examples */
/* 1) Create the new DAS file TEST.DAS and add 200 double */
/* precision numbers to it. Close the file, then re-open */
/* it and read the data back out. */
/* PROGRAM TEST_READ */
/* CHARACTER*(4) TYPE */
/* DOUBLE PRECISION DATA ( 200 ) */
/* INTEGER FIRST */
/* INTEGER HANDLE */
/* INTEGER I */
/* INTEGER LAST */
/* C */
/* C Open a new DAS file. Use the file name as */
/* C the internal file name. */
/* C */
/* TYPE = 'TEST' */
/* CALL DASONW ( 'TEST.DAS', TYPE, 'TEST.DAS', HANDLE ) */
/* C */
/* C Fill the array DATA with the double precision */
/* C numbers 1.D0 through 100.D0, and add this array */
/* C to the file. */
/* C */
/* DO I = 1, 100 */
/* DATA(I) = DBLE(I) */
/* END DO */
/* CALL DASADD ( HANDLE, 100, DATA, FIRST, LAST ) */
/* C */
/* C Now append the array DATA to the file again. */
/* C */
/* CALL DASADD ( HANDLE, 100, DATA, FIRST, LAST ) */
/* C */
/* C Close the file. */
/* C */
/* CALL DASCLS ( HANDLE ) */
/* C */
/* C Now verify the addition of data by opening the */
/* C file for read access and retrieving the data. */
/* C */
/* CALL DASRDD ( HANDLE, 1, 200, DATA ) */
/* C */
/* C Dump the data to the screen. We should see the */
/* C sequence 1, 2, ..., 100, 1, 2, ... , 100. The */
/* C numbers will be represented as double precision */
/* C numbers in the output. */
/* C */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) 'Data from TEST.DAS: ' */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) DATA */
/* END */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* K.R. Gehringer (JPL) */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 1.1.1 19-DEC-1995 (NJB) */
/* Corrected title of permuted index entry section. */
/* - SPICELIB Version 1.2.0, 01-NOV-1995 (NJB) */
/* Routine now uses discovery check-in. FAILED test moved inside */
/* loop. */
/* - SPICELIB Version 1.1.0, 12-MAY-1994 (KRG) (NJB) */
/* Test of FAILED() added to loop termination condition. */
/* Removed references to specific DAS file open routines in the */
/* $ Detailed_Input section of the header. This was done in order */
/* to minimize documentation changes if the DAS open routines ever */
/* change. */
/* Modified the $ Examples section to demonstrate the new ID word */
/* format which includes a file type and to include a call to the */
/* new routine DASONW, open new for write, which makes use of the */
/* file type. Also, a variable for the type of the file to be */
/* created was added. */
/* - SPICELIB Version 1.0.0, 13-JUN-1992 (NJB) (WLT) */
/* -& */
/* $ Index_Entries */
/* read double precision data from a DAS file */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 1.2.0, 30-OCT-1995 (NJB) */
/* Routine now uses discovery check-in. FAILED test moved inside */
/* loop. */
/* - SPICELIB Version 1.1.0, 12-MAY-1994 (KRG) (NJB) */
/* Test of FAILED() added to loop termination condition. Without */
/* this test, an infinite loop could result if DASA2L or DASRRD */
/* signaled an error inside the loop. */
/* Removed references to specific DAS file open routines in the */
/* $ Detailed_Input section of the header. This was done in order */
/* to minimize documentation changes if the DAS open routines ever */
/* change. */
/* Modified the $ Examples section to demonstrate the new ID word */
/* format which includes a file type and to include a call to the */
/* new routine DASONW, open new for write, which makes use of the */
/* file type. Also, a variable for the type of the file to be */
/* created was added. */
/* - SPICELIB Version 1.0.0, 13-JUN-1992 (NJB) (WLT) */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Find out the physical location of the first double precision */
/* number. If FIRST is invalid, DASA2L will take care of the */
/* problem. */
dasa2l_(handle, &c__2, first, &clbase, &clsize, &recno, &wordno);
/* Decide how many double precision numbers to read. */
numdp = *last - *first + 1;
nread = 0;
/* Read as much data from record RECNO as necessary. */
/* Computing MIN */
i__1 = numdp, i__2 = 128 - wordno + 1;
n = min(i__1,i__2);
i__1 = wordno + n - 1;
dasrrd_(handle, &recno, &wordno, &i__1, data);
nread = n;
++recno;
/* Read from as many additional records as necessary. */
while(nread < numdp) {
if (failed_()) {
return 0;
}
/* At this point, RECNO is the correct number of the */
/* record to read from next. CLBASE is the number */
/* of the first record of the cluster we're about */
/* to read from. */
if (recno < clbase + clsize) {
/* We can continue reading from the current */
/* cluster. */
/* Computing MIN */
i__1 = numdp - nread;
n = min(i__1,128);
dasrrd_(handle, &recno, &c__1, &n, &data[nread]);
nread += n;
++recno;
} else {
/* We must find the next double precision cluster to */
/* read from. The first double precision number in this */
/* cluster has address FIRST + NREAD. */
i__1 = *first + nread;
dasa2l_(handle, &c__2, &i__1, &clbase, &clsize, &recno, &wordno);
}
}
return 0;
} /* dasrdd_ */
/* $Procedure DASUDD ( DAS, update data, double precision ) */
/* Subroutine */ int dasudd_(integer *handle, integer *first, integer *last,
doublereal *data)
{
/* System generated locals */
integer i__1, i__2;
/* Local variables */
integer n;
extern /* Subroutine */ int chkin_(char *, ftnlen);
integer lastc, lastd, recno, lasti, numdp;
extern /* Subroutine */ int dasa2l_(integer *, integer *, integer *,
integer *, integer *, integer *, integer *);
extern logical failed_(void);
integer clbase;
extern /* Subroutine */ int daslla_(integer *, integer *, integer *,
integer *), dasurd_(integer *, integer *, integer *, integer *,
doublereal *);
integer clsize;
extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *,
ftnlen);
integer wordno;
extern logical return_(void);
integer nwritn;
/* $ Abstract */
/* Update data in a specified range of double precision addresses */
/* in a DAS file. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* DAS */
/* $ Keywords */
/* ARRAY */
/* ASSIGNMENT */
/* DAS */
/* FILES */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I DAS file handle. */
/* FIRST, */
/* LAST I Range of d.p. addresses to write to. */
/* DATA I An array of d.p. numbers. */
/* $ Detailed_Input */
/* HANDLE is a file handle of a DAS file opened for writing. */
/* FIRST, */
/* LAST are the first and last of a range of DAS logical */
/* addresses of double precision numbers. These */
/* addresses satisfy the inequality */
/* 1 < FIRST < LAST < LASTD */
/* _ - - */
/* where LASTD is the last double precision logical */
/* address in use in the DAS file designated by */
/* HANDLE. */
/* DATA is an array of double precision numbers. The */
/* array elements DATA(1) through DATA(N) will be */
/* written to the indicated DAS file, where N is */
/* LAST - FIRST + 1. */
/* $ Detailed_Output */
/* See $Particulars for a description of the effect of this routine. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the input file handle is invalid, the error will be */
/* diagnosed by routines called by this routine. */
/* 2) Only logical addresses that already contain data may be */
/* updated: if either FIRST or LAST are outside the range */
/* [ 1, LASTD ] */
/* where LASTD is the last double precision logical address */
/* that currently contains data in the indicated DAS file, the */
/* error SPICE(INVALIDADDRESS) is signalled. */
/* The DAS file will not be modified. */
/* 3) If FIRST > LAST but both addresses are valid, this routine */
/* will not modify the indicated DAS file. No error will be */
/* signalled. */
/* 4) If an I/O error occurs during the data update attempted */
/* by this routine, the error will be diagnosed by routines */
/* called by this routine. FIRST and LAST will not be modified. */
/* $ Files */
/* See the description of the argument HANDLE in $Detailed_Input. */
/* $ Particulars */
/* This routine replaces the double precision data in the specified */
/* range of logical addresses within a DAS file with the contents of */
/* the input array DATA. */
/* The actual physical write operations that update the indicated */
/* DAS file with the contents of the input array DATA may not take */
/* place before this routine returns, since the DAS system buffers */
/* data that is written as well as data that is read. In any case, */
/* the data will be flushed to the file at the time the file is */
/* closed, if not earlier. A physical write of all buffered */
/* records can be forced by calling the SPICELIB routine DASWUR */
/* ( DAS, write updated records ). */
/* In order to append double precision data to a DAS file, filling */
/* in a range of double precision logical addresses that starts */
/* immediately after the last double precision logical address */
/* currently in use, the SPICELIB routine DASADD ( DAS add data, */
/* double precision ) should be used. */
/* $ Examples */
/* 1) Write to addresses 1 through 500 in a DAS file in */
/* random-access fashion by updating the file. Recall */
/* that data must be present in the file before it can */
/* be updated. */
/* PROGRAM UP */
/* CHARACTER*(4) TYPE */
/* DOUBLE PRECISION DATA ( 500 ) */
/* INTEGER HANDLE */
/* INTEGER I */
/* C */
/* C Open the new DAS file RAND.DAS. Use the file name */
/* C as the internal file name. */
/* C */
/* TYPE = 'TEST' */
/* CALL DASONW ( 'TEST.DAS', TYPE, 'TEST.DAS', HANDLE ) */
/* C */
/* C Append 500 double precision numbers to the file; */
/* C after the data is present, we're free to update it */
/* C in any order we please. (CLEARD zeros out a double */
/* C precision array.) */
/* C */
/* CALL CLEARD ( 500, DATA ) */
/* CALL DASADD ( HANDLE, 500, DATA ) */
/* C */
/* C Now the double precision logical addresses 1:500 */
/* C can be written to in random-access fashion. We'll */
/* C fill them in in reverse order. */
/* C */
/* DO I = 500, 1, -1 */
/* CALL DASUDD ( HANDLE, I, I, DBLE(I) ) */
/* END DO */
/* C */
/* C Close the file. */
/* C */
/* CALL DASCLS ( HANDLE ) */
/* C */
/* C Now make sure that we updated the file properly. */
/* C Open the file for reading and dump the contents */
/* C of the double precision logical addresses 1:500. */
/* C */
/* CALL DASOPR ( 'RAND.DAS', HANDLE ) */
/* CALL CLEARD ( 500, DATA ) */
/* CALL DASRDD ( HANDLE, 1, 500, DATA ) */
/* WRITE (*,*) 'Contents of RAND.DAS:' */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) DATA */
/* END */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* K.R. Gehringer (JPL) */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 1.1.1 19-DEC-1995 (NJB) */
/* Corrected title of permuted index entry section. */
/* - SPICELIB Version 1.1.0, 12-MAY-1994 (KRG) (NJB) */
/* Test of FAILED() added to loop termination conditions. */
/* Removed references to specific DAS file open routines in the */
/* $ Detailed_Input section of the header. This was done in order */
/* to minimize documentation changes if the DAS open routines ever */
/* change. */
/* Modified the $ Examples section to demonstrate the new ID word */
/* format which includes a file type and to include a call to the */
/* new routine DASONW, open new for write, which makes use of the */
/* file type. Also, a variable for the type of the file to be */
/* created was added. */
/* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) */
/* -& */
/* $ Index_Entries */
/* update double precision data in a DAS file */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 1.1.0, 12-MAY-1994 (KRG) (NJB) */
/* Test of FAILED() added to loop termination condition. Without */
/* this test, an infinite loop could result if DASA2L or DASURD */
/* signaled an error inside the loop. */
/* Removed references to specific DAS file open routines in the */
/* $ Detailed_Input section of the header. This was done in order */
/* to minimize documentation changes if the DAS open routines ever */
/* change. */
/* Modified the $ Examples section to demonstrate the new ID word */
/* format which includes a file type and to include a call to the */
/* new routine DASONW, open new for write, which makes use of the */
/* file type. Also, a variable for the type of the file to be */
/* created was added. */
/* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("DASUDD", (ftnlen)6);
}
/* Get the last logical addresses in use in this DAS file. */
daslla_(handle, &lastc, &lastd, &lasti);
/* Validate the input addresses. */
if (*first < 1 || *first > lastd || *last < 1 || *last > lastd) {
setmsg_("FIRST was #. LAST was #. Valid range is [1,#].", (ftnlen)46);
errint_("#", first, (ftnlen)1);
errint_("#", last, (ftnlen)1);
errint_("#", &lastd, (ftnlen)1);
sigerr_("SPICE(INVALIDADDRESS)", (ftnlen)21);
chkout_("DASUDD", (ftnlen)6);
return 0;
}
/* Let N be the number of addresses to update. */
n = *last - *first + 1;
/* We will use the variables RECNO and OFFSET to determine where to */
/* write data in the DAS file. RECNO will be the record containing */
/* the physical location to write to; WORDNO will be the word */
/* location that we will write to next. */
/* Find the first location to write to. CLBASE and CLSIZE are the */
/* base record number and size of the cluster of d.p. records that */
/* the address FIRST lies within. */
dasa2l_(handle, &c__2, first, &clbase, &clsize, &recno, &wordno);
/* Set the number of double precision words already written. Keep */
/* writing to the file until this number equals the number of */
/* elements in DATA. */
/* Note that if N is non-positive, the loop doesn't get exercised. */
nwritn = 0;
while(nwritn < n && ! failed_()) {
/* Write as much data as we can (or need to) into the current */
/* record. We assume that CLBASE, RECNO, WORDNO, and NWRITN have */
/* been set correctly at this point. */
/* Find out how many words to write into the current record. */
/* There may be no space left in the current record. */
/* Computing MIN */
i__1 = n - nwritn, i__2 = 128 - wordno + 1;
numdp = min(i__1,i__2);
if (numdp > 0) {
/* Write NUMDP words into the current record. */
i__1 = wordno + numdp - 1;
dasurd_(handle, &recno, &wordno, &i__1, &data[nwritn]);
nwritn += numdp;
wordno += numdp;
} else {
/* It's time to start on a new record. If the record we */
/* just finished writing to (or just attempted writing to, */
/* if it was full) was not the last of the cluster, the next */
/* record to write to is the immediate successor of the last */
/* one. Otherwise, we'll have to look up the location of the */
/* next d.p. logical address. */
if (recno < clbase + clsize - 1) {
++recno;
wordno = 1;
} else {
i__1 = *first + nwritn;
dasa2l_(handle, &c__2, &i__1, &clbase, &clsize, &recno, &
wordno);
}
}
}
chkout_("DASUDD", (ftnlen)6);
return 0;
} /* dasudd_ */
/* $Procedure DASADD ( DAS, add data, double precision ) */
/* Subroutine */ int dasadd_(integer *handle, integer *n, doublereal *data)
{
/* System generated locals */
integer i__1, i__2;
/* Local variables */
integer free;
extern /* Subroutine */ int chkin_(char *, ftnlen);
integer ncomc, recno, lastd;
extern /* Subroutine */ int moved_(doublereal *, integer *, doublereal *);
integer ncomr, numdp;
extern /* Subroutine */ int dasa2l_(integer *, integer *, integer *,
integer *, integer *, integer *, integer *);
extern logical failed_(void);
integer clbase;
extern /* Subroutine */ int dascud_(integer *, integer *, integer *),
dashfs_(integer *, integer *, integer *, integer *, integer *,
integer *, integer *, integer *, integer *);
doublereal record[128];
integer lastla[3];
extern /* Subroutine */ int dasurd_(integer *, integer *, integer *,
integer *, doublereal *), daswrd_(integer *, integer *,
doublereal *);
integer lastrc[3], clsize;
extern /* Subroutine */ int chkout_(char *, ftnlen);
integer lastwd[3], nresvc, wordno;
extern logical return_(void);
integer nresvr, nwritn;
/* $ Abstract */
/* Add an array of double precision numbers to a DAS file. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* DAS */
/* $ Keywords */
/* ARRAY */
/* ASSIGNMENT */
/* DAS */
/* FILES */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I DAS file handle. */
/* N I Number of d.p. numbers to add to DAS file. */
/* DATA I Array of d.p. numbers to add. */
/* $ Detailed_Input */
/* HANDLE is a file handle of a DAS file opened for writing. */
/* N is a the number of double precision `words' to */
/* add to the DAS file specified by HANDLE. */
/* DATA is an array of double precision numbers to be */
/* added to the specified DAS file. Elements */
/* 1 through N are appended to the double precision */
/* data in the file. */
/* $ Detailed_Output */
/* None. See $Particulars for a description of the effect of this */
/* routine. */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the input file handle is invalid, the error will be */
/* diagnosed by routines called by this routine. */
/* 2) If an I/O error occurs during the data addition attempted */
/* by this routine, the error will be diagnosed by routines */
/* called by this routine. */
/* 3) If the input count N is less than 1, no data will be */
/* added to the specified DAS file. */
/* $ Files */
/* See the description of the argument HANDLE in $Detailed_Input. */
/* $ Particulars */
/* This routine adds double precision data to a DAS file by */
/* `appending' it after any double precision data already in the */
/* file. The sense in which the data is `appended' is that the */
/* data will occupy a range of logical addresses for double precision */
/* data that immediately follow the last logical address of a double */
/* precision number that is occupied at the time this routine is */
/* called. The diagram below illustrates this addition: */
/* +-------------------------+ */
/* | (already in use) | D.p. logical address 1 */
/* +-------------------------+ */
/* . */
/* . */
/* . */
/* +-------------------------+ */
/* | (already in use) | Last d.p. logical address */
/* +-------------------------+ in use before call to DASADD */
/* | DATA(1) | */
/* +-------------------------+ */
/* . */
/* . */
/* . */
/* +-------------------------+ */
/* | DATA(N) | */
/* +-------------------------+ */
/* The logical organization of the double precision numbers in the */
/* DAS file is independent of the order of addition to the file or */
/* physical location of any data of integer or character type. */
/* The actual physical write operations that add the input array */
/* DATA to the indicated DAS file may not take place before this */
/* routine returns, since the DAS system buffers data that is */
/* written as well as data that is read. In any case, the data */
/* will be flushed to the file at the time the file is closed, if */
/* not earlier. A physical write of all buffered records can be */
/* forced by calling the SPICELIB routine DASWBR ( DAS, write */
/* buffered records ). */
/* In order to update double precision logical addresses that */
/* already contain data, the SPICELIB routine DASUDD */
/* ( DAS update data, double precision ) should be used. */
/* $ Examples */
/* 1) Create the new DAS file TEST.DAS and add 200 double */
/* precision numbers to it. Close the file, then re-open */
/* it and read the data back out. */
/* PROGRAM TEST_ADD */
/* CHARACTER*(4) TYPE */
/* DOUBLE PRECISION DATA ( 200 ) */
/* INTEGER HANDLE */
/* INTEGER I */
/* C */
/* C Open a new DAS file. Use the file name as */
/* C the internal file name. */
/* C */
/* TYPE = 'TEST' */
/* CALL DASONW ( 'TEST.DAS', TYPE, 'TEST.DAS', HANDLE ) */
/* C */
/* C Fill the array DATA with the double precision */
/* C numbers 1.D0 through 100.D0, and add this array */
/* C to the file. */
/* C */
/* DO I = 1, 100 */
/* DATA(I) = DBLE(I) */
/* END DO */
/* CALL DASADD ( HANDLE, 100, DATA ) */
/* C */
/* C Now append the array DATA to the file again. */
/* C */
/* CALL DASADD ( HANDLE, 100, DATA ) */
/* C */
/* C Close the file. */
/* C */
/* CALL DASCLS ( HANDLE ) */
/* C */
/* C Now verify the addition of data by opening the */
/* C file for read access and retrieving the data. */
/* C */
/* CALL DASRDD ( HANDLE, 1, 200, DATA ) */
/* C */
/* C Dump the data to the screen. We should see the */
/* C sequence 1, 2, ..., 100, 1, 2, ... , 100. The */
/* C numbers will be represented as double precision */
/* C numbers in the output. */
/* C */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) 'Data from TEST.DAS: ' */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) DATA */
/* END */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* K.R. Gehringer (JPL) */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 1.2.0 10-APR-2014 (NJB) */
/* Deleted declarations of unused parameters. */
/* Corrected header comments: routine that flushes */
/* written, buffered records is DASWBR, not DASWUR. */
/* - SPICELIB Version 1.1.1 19-DEC-1995 (NJB) */
/* Corrected title of permuted index entry section. */
/* - SPICELIB Version 1.1.0, 12-MAY-1994 (KRG) (NJB) */
/* Test of FAILED() added to loop termination condition. */
/* Removed references to specific DAS file open routines in the */
/* $ Detailed_Input section of the header. This was done in order */
/* to minimize documentation changes if the DAS open routines ever */
/* change. */
/* Modified the $ Examples section to demonstrate the new ID word */
/* format which includes a file type and to include a call to the */
/* new routine DASONW, open new, which makes use of the file */
/* type. Also, a variable for the type of the file to be created */
/* was added. */
/* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) */
/* -& */
/* $ Index_Entries */
/* add double precision data to a DAS file */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 1.1.0, 12-MAY-1994 (KRG) (NJB) */
/* Test of FAILED() added to loop termination condition. Without */
/* this test, an infinite loop could result if DASA2L, DASURD or */
/* DASWRD signaled an error inside the loop. */
/* Removed references to specific DAS file open routines in the */
/* $ Detailed_Input section of the header. This was done in order */
/* to minimize documentation changes if the DAS open routines ever */
/* change. */
/* Modified the $ Examples section to demonstrate the new ID word */
/* format which includes a file type and to include a call to the */
/* new routine DASONW, open new, which makes use of the file */
/* type. Also, a variable for the type of the file to be created */
/* was added. */
/* - SPICELIB Version 1.0.0, 11-NOV-1992 (NJB) (WLT) */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Standard SPICE error handling. */
if (return_()) {
return 0;
} else {
chkin_("DASADD", (ftnlen)6);
}
/* Get the file summary for this DAS. */
dashfs_(handle, &nresvr, &nresvc, &ncomr, &ncomc, &free, lastla, lastrc,
lastwd);
lastd = lastla[1];
/* We will keep track of the location that we wish to write to */
/* with the variables RECNO and WORDNO. RECNO will be the record */
/* number of the record we'll write to; WORDNO will be the number */
/* preceding the word index, within record number RECNO, that we'll */
/* write to. For example, if we're about to write to the first */
/* double precision number in record 10, RECNO will be 10 and */
/* WORDNO will be 0. Of course, when WORDNO reaches NWD, we'll */
/* have to find a free record before writing anything. */
/* Prepare the variables RECNO and WORDNO: use the physical */
/* location of the last double precision address, if there are any */
/* double precision data in the file. Otherwise, RECNO becomes the */
/* first record available for double precision data. */
if (lastd >= 1) {
dasa2l_(handle, &c__2, &lastd, &clbase, &clsize, &recno, &wordno);
} else {
recno = free;
wordno = 0;
}
/* Set the number of double precision words already written. Keep */
/* writing to the file until this number equals the number of */
/* elements in DATA. */
/* Note that if N is non-positive, the loop doesn't get exercised. */
nwritn = 0;
while(nwritn < *n && ! failed_()) {
/* Write as much data as we can (or need to) into the current */
/* record. We assume that RECNO, WORDNO, and NWRITN have been */
/* set correctly at this point. */
/* Find out how many words to write into the current record. */
/* There may be no space left in the current record. */
/* Computing MIN */
i__1 = *n - nwritn, i__2 = 128 - wordno;
numdp = min(i__1,i__2);
if (numdp > 0) {
/* Write NUMDP words into the current record. If the record */
/* is new, write the entire record. Otherwise, just update */
/* the part we're interested in. */
if (wordno == 0) {
moved_(&data[nwritn], &numdp, record);
daswrd_(handle, &recno, record);
} else {
i__1 = wordno + 1;
i__2 = wordno + numdp;
dasurd_(handle, &recno, &i__1, &i__2, &data[nwritn]);
}
nwritn += numdp;
wordno += numdp;
} else {
/* It's time to start on a new record. If the record we */
/* just finished writing to (or just attempted writing to, */
/* if it was full) was FREE or a higher-numbered record, */
/* then we are writing to a contiguous set of data records: */
/* the next record to write to is the immediate successor */
/* of the last one. Otherwise, FREE is the next record */
/* to write to. */
/* We intentionally leave FREE at the value it had before */
/* we starting adding data to the file. */
if (recno >= free) {
++recno;
} else {
recno = free;
}
wordno = 0;
}
}
/* Update the DAS file directories to reflect the addition of N */
/* double precision words. DASCUD will also update the file summary */
/* accordingly. */
dascud_(handle, &c__2, n);
chkout_("DASADD", (ftnlen)6);
return 0;
} /* dasadd_ */
/* $Procedure DASRDC ( DAS, read data, character ) */
/* Subroutine */ int dasrdc_(integer *handle, integer *first, integer *last,
integer *bpos, integer *epos, char *data, ftnlen data_len)
{
/* System generated locals */
integer i__1, i__2;
/* Builtin functions */
integer i_len(char *, ftnlen);
/* Local variables */
integer l, n, nread;
extern /* Subroutine */ int chkin_(char *, ftnlen);
integer recno, nmove, rcpos;
extern /* Subroutine */ int dasa2l_(integer *, integer *, integer *,
integer *, integer *, integer *, integer *);
extern logical failed_(void);
integer clbase;
extern /* Subroutine */ int dasrrc_(integer *, integer *, integer *,
integer *, char *, ftnlen);
integer nmoved, clsize;
extern /* Subroutine */ int sigerr_(char *, ftnlen);
integer numchr;
extern /* Subroutine */ int chkout_(char *, ftnlen), setmsg_(char *,
ftnlen), errint_(char *, integer *, ftnlen);
integer wordno, chr, elt;
/* $ Abstract */
/* Read character data from a range of DAS logical addresses. */
/* $ Disclaimer */
/* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
/* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
/* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
/* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
/* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
/* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
/* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
/* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
/* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
/* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
/* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
/* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
/* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
/* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
/* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
/* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
/* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
/* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
/* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
/* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
/* $ Required_Reading */
/* DAS */
/* $ Keywords */
/* ARRAY */
/* ASSIGNMENT */
/* DAS */
/* FILES */
/* $ Declarations */
/* $ Brief_I/O */
/* Variable I/O Description */
/* -------- --- -------------------------------------------------- */
/* HANDLE I DAS file handle. */
/* FIRST, */
/* LAST I Range of DAS character logical addresses. */
/* BPOS, */
/* EPOS I Begin and end positions of substrings. */
/* DATA O Data having addresses FIRST through LAST. */
/* $ Detailed_Input */
/* HANDLE is a file handle for an open DAS file. */
/* FIRST, */
/* LAST are a range of DAS character logical addresses. */
/* FIRST and LAST must be greater than or equal to */
/* 1 and less than or equal to the highest character */
/* logical address in the DAS file designated by */
/* HANDLE. */
/* BPOS, */
/* EPOS are begin and end character positions that define */
/* the substrings of the elements of the output array */
/* DATA into which character data is to be read. */
/* $ Detailed_Output */
/* DATA is an array of character strings. On output, the */
/* character words in the logical address range */
/* FIRST through LAST are copied into the characters */
/* DATA(1)(BPOS:BPOS), */
/* DATA(1)(BPOS+1:BPOS+1), */
/* . */
/* . */
/* . */
/* DATA(1)(EPOS:EPOS), */
/* DATA(2)(BPOS:BPOS), */
/* DATA(2)(BPOS+1:BPOS+1), */
/* . */
/* . */
/* . */
/* in that order. */
/* DATA must have dimension at least */
/* ( LAST - FIRST + L ) / L */
/* where */
/* L = EPOS - BPOS + 1 */
/* $ Parameters */
/* None. */
/* $ Exceptions */
/* 1) If the input file handle is invalid, the error will be */
/* diagnosed by routines called by this routine. DATA will */
/* not be modified. */
/* 2) If EPOS or BPOS are outside of the range */
/* [ 1, LEN( DATA(1) ) ], or if EPOS < BPOS, the error */
/* SPICE(BADSUBSTRINGBOUNDS) will be signalled. */
/* 3) If FIRST or LAST are out of range, the error will be diagnosed */
/* by routines called by this routine. DATA will not be */
/* modified. */
/* 4) If FIRST is greater than LAST, DATA is left unchanged. */
/* 5) If DATA is declared with length less than */
/* ( LAST - FIRST + ( EPOS-BPOS+1 ) ) / ( EPOS-BPOS+1 ) */
/* the error cannot be diagnosed by this routine. */
/* $ Files */
/* See the description of the argument HANDLE in $Detailed_Input. */
/* $ Particulars */
/* This routine provides random read access to the character data in */
/* a DAS file. This data is logically structured as a */
/* one-dimensional array of characters. */
/* However, since Fortran programs usually use strings rather */
/* than arrays of individual characters, the interface of this */
/* routine provides for extraction of data from a DAS file into */
/* an array of strings. */
/* DASRDC allows the caller to control the amount of character data */
/* read into each array element. This feature allows a program to */
/* read character data into an array that has a different string */
/* length from the one used to write the character data, without */
/* losing the correspondence between input and output array elements. */
/* For example, an array of strings of 32 characters can be written */
/* to a DAS file and read back by DASRDC into a buffer of strings */
/* having length 80 characters, mapping each 32-character string to */
/* characters 1--32 of the output buffer. */
/* $ Examples */
/* 1) Create the new DAS file TEST.DAS and add 240 characters to it. */
/* Close the file, then re-open it and read the data back out. */
/* PROGRAM TEST_ADD */
/* CHARACTER*(40) LINES ( 3 ) */
/* CHARACTER*(80) BUFFER ( 3 ) */
/* CHARACTER*(4) TYPE */
/* INTEGER FIRST */
/* INTEGER HANDLE */
/* INTEGER I */
/* INTEGER LAST */
/* DATA LINES / 'Here is the first line.', */
/* . 'Here is the second line.', */
/* . 'Here is the third line.' / */
/* C */
/* C Open a new DAS file. Use the file name as */
/* C the internal file name. */
/* C */
/* TYPE = 'TEST' */
/* CALL DASONW ( 'TEST.DAS', TYPE, 'TEST.DAS', HANDLE ) */
/* C */
/* C Add the contents of the array LINES to the file. */
/* C */
/* CALL DASADC ( HANDLE, 120, 1, 40, LINES ) */
/* C */
/* C Close the file. */
/* C */
/* CALL DASCLS ( HANDLE ) */
/* C */
/* C Now verify the addition of data by opening the */
/* C file for read access and retrieving the data. This */
/* C time, use a buffer of 80-character strings to read */
/* C the data. Use only the first 40 characters of each */
/* C buffer element. */
/* C */
/* DO I = 1, 3 */
/* BUFFER(I) = ' ' */
/* END DO */
/* CALL DASRDC ( HANDLE, 1, 120, 1, 40, BUFFER ) */
/* C */
/* C Dump the data to the screen. We should see the */
/* C sequence */
/* C */
/* C Here is the first line. */
/* C Here is the second line. */
/* C Here is the third line. */
/* C */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) 'Data from TEST.DAS: ' */
/* WRITE (*,*) ' ' */
/* WRITE (*,*) BUFFER */
/* END */
/* $ Restrictions */
/* None. */
/* $ Literature_References */
/* None. */
/* $ Author_and_Institution */
/* K.R. Gehringer (JPL) */
/* N.J. Bachman (JPL) */
/* W.L. Taber (JPL) */
/* $ Version */
/* - SPICELIB Version 1.2.2 03-JUL-1996 (NJB) */
/* Various errors in the header comments were fixed. */
/* - SPICELIB Version 1.2.1 19-DEC-1995 (NJB) */
/* Corrected title of permuted index entry section. */
/* - SPICELIB Version 1.2.0, 03-NOV-1995 (NJB) */
/* Routine now uses discovery check-in. FAILED test moved inside */
/* loops. */
/* - SPICELIB Version 1.2.0, 14-SEP-1995 (NJB) */
/* Bug fix: reference to DASADS in CHKOUT calls corrected. */
/* - SPICELIB Version 1.1.0, 12-MAY-1994 (KRG) (NJB) */
/* Test of FAILED() added to loop termination conditions. */
/* Removed references to specific DAS file open routines in the */
/* $ Detailed_Input section of the header. This was done in order */
/* to minimize documentation changes if the DAS open routines ever */
/* change. */
/* Modified the $ Examples section to demonstrate the new ID word */
/* format which includes a file type and to include a call to the */
/* new routine DASONW, open new for write, which makes use of the */
/* file type. Also, a variable for the type of the file to be */
/* created was added. */
/* - SPICELIB Version 1.0.0, 12-NOV-1992 (NJB) (WLT) */
/* -& */
/* $ Index_Entries */
/* read character data from a DAS file */
/* -& */
/* $ Revisions */
/* - SPICELIB Version 1.2.0, 03-NOV-1995 (NJB) */
/* Routine now uses discovery check-in. FAILED test moved inside */
/* loops. */
/* - SPICELIB Version 1.2.0, 14-SEP-1995 (NJB) */
/* Bug fix: reference to DASADS in CHKOUT calls corrected. */
/* These references have been changed to 'DASRDC'. */
/* - SPICELIB Version 1.1.0, 12-MAY-1994 (KRG) (NJB) */
/* Test of FAILED() added to loop termination conditions. Without */
/* this test, an infinite loop could result if DASA2L or DASRRC */
/* signaled an error inside the loops. */
/* Removed references to specific DAS file open routines in the */
/* $ Detailed_Input section of the header. This was done in order */
/* to minimize documentation changes if the DAS open routines ever */
/* change. */
/* Modified the $ Examples section to demonstrate the new ID word */
/* format which includes a file type and to include a call to the */
/* new routine DASONW, open new for write, which makes use of the */
/* file type. Also, a variable for the type of the file to be */
/* created was added. */
/* - SPICELIB Version 1.0.0, 12-NOV-1992 (NJB) (WLT) */
/* -& */
/* SPICELIB functions */
/* Local parameters */
/* Local variables */
/* Make sure BPOS and EPOS are ok; stop here if not. */
if (*bpos < 1 || *epos < 1 || *bpos > i_len(data, data_len) || *epos >
i_len(data, data_len)) {
chkin_("DASRDC", (ftnlen)6);
setmsg_("Substring bounds must be in range [1,#]. Actual range [BPOS"
",EPOS] was [#,#].", (ftnlen)76);
i__1 = i_len(data, data_len);
errint_("#", &i__1, (ftnlen)1);
errint_("#", bpos, (ftnlen)1);
errint_("#", epos, (ftnlen)1);
sigerr_("SPICE(BADSUBSTRINGBOUNDS)", (ftnlen)25);
chkout_("DASRDC", (ftnlen)6);
return 0;
} else if (*epos < *bpos) {
chkin_("DASRDC", (ftnlen)6);
setmsg_("Substring upper bound must not be less than lower bound. A"
"ctual range [BPOS,EPOS] was [#,#].", (ftnlen)93);
errint_("#", bpos, (ftnlen)1);
errint_("#", epos, (ftnlen)1);
sigerr_("SPICE(BADSUBSTRINGBOUNDS)", (ftnlen)25);
chkout_("DASRDC", (ftnlen)6);
return 0;
}
/* Find out the physical location of the first character to read. If */
/* FIRST is out of range, DASA2L will cause an error to be signalled. */
dasa2l_(handle, &c__1, first, &clbase, &clsize, &recno, &wordno);
/* Get the length of the elements of DATA. Count the total number */
/* of characters to read. */
l = *epos - *bpos + 1;
n = *last - *first + 1;
nread = 0;
/* Read as much data from record RECNO as is necessary and possible. */
/* Computing MIN */
i__1 = n, i__2 = 1024 - wordno + 1;
numchr = min(i__1,i__2);
elt = 1;
chr = *bpos;
nmoved = 0;
rcpos = wordno;
while(nmoved < numchr) {
if (failed_()) {
return 0;
}
if (chr > *epos) {
++elt;
chr = *bpos;
}
/* Find out how many characters to move from the current record */
/* to the current array element. */
/* Computing MIN */
i__1 = numchr - nmoved, i__2 = *epos - chr + 1;
nmove = min(i__1,i__2);
i__1 = rcpos + nmove - 1;
dasrrc_(handle, &recno, &rcpos, &i__1, data + ((elt - 1) * data_len +
(chr - 1)), chr + nmove - 1 - (chr - 1));
nmoved += nmove;
rcpos += nmove;
chr += nmove;
}
nread = numchr;
++recno;
/* Read from as many additional records as necessary. */
while(nread < n) {
if (failed_()) {
return 0;
}
/* At this point, RECNO is the correct number of the */
/* record to read from next. CLBASE is the number */
/* of the first record of the cluster we're about */
/* to read from. */
if (recno < clbase + clsize) {
/* We can continue reading from the current cluster. Find */
/* out how many elements to read from the current record, */
/* and read them. */
/* Computing MIN */
i__1 = n - nread;
numchr = min(i__1,1024);
nmoved = 0;
rcpos = 1;
while(nmoved < numchr && ! failed_()) {
if (chr > *epos) {
++elt;
chr = *bpos;
}
/* Find out how many characters to move from the current */
/* record to the current array element. */
/* Computing MIN */
i__1 = numchr - nmoved, i__2 = *epos - chr + 1;
nmove = min(i__1,i__2);
i__1 = rcpos + nmove - 1;
dasrrc_(handle, &recno, &rcpos, &i__1, data + ((elt - 1) *
data_len + (chr - 1)), chr + nmove - 1 - (chr - 1));
nmoved += nmove;
rcpos += nmove;
chr += nmove;
}
nread += numchr;
++recno;
} else {
/* We must find the next character cluster to */
/* read from. The first character in this */
/* cluster has address FIRST + NREAD. */
i__1 = *first + nread;
dasa2l_(handle, &c__1, &i__1, &clbase, &clsize, &recno, &wordno);
}
}
return 0;
} /* dasrdc_ */
