/* $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_ */