/* $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 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 ZZEKPGCH ( EK, paging system access check ) */ /* Subroutine */ int zzekpgch_(integer *handle, char *access, ftnlen access_len) { integer topc, topd, topi, unit; extern /* Subroutine */ int chkin_(char *, ftnlen); integer lastc, lastd, lasti, id; extern logical failed_(void); extern /* Subroutine */ int daslla_(integer *, integer *, integer *, integer *), dasrdi_(integer *, integer *, integer *, integer *), dassih_(integer *, char *, ftnlen), dashlu_(integer *, integer *), errfnm_(char *, integer *, ftnlen), sigerr_(char *, ftnlen), chkout_(char *, ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *, ftnlen); integer npc, npd, npi; /* $ Abstract */ /* Check that an EK is valid for a specified type of access by the */ /* paging system. */ /* $ 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 */ /* EK */ /* $ Keywords */ /* EK */ /* PRIVATE */ /* $ Declarations */ /* $ 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. */ /* Include Section: EK Das Paging Parameters */ /* ekpage.inc Version 4 25-AUG-1995 (NJB) */ /* The EK DAS paging system makes use of the integer portion */ /* of an EK file's DAS address space to store the few numbers */ /* required to describe the system's state. The allocation */ /* of DAS integer addresses is shown below. */ /* DAS integer array */ /* +--------------------------------------------+ */ /* | EK architecture code | Address = 1 */ /* +--------------------------------------------+ */ /* | Character page size (in DAS words) | */ /* +--------------------------------------------+ */ /* | Character page base address | */ /* +--------------------------------------------+ */ /* | Number of character pages in file | */ /* +--------------------------------------------+ */ /* | Number of character pages on free list | */ /* +--------------------------------------------+ */ /* | Character free list head pointer | Address = 6 */ /* +--------------------------------------------+ */ /* | | Addresses = */ /* | Metadata for d.p. pages | 7--11 */ /* | | */ /* +--------------------------------------------+ */ /* | | Addresses = */ /* | Metadata for integer pages | 12--16 */ /* | | */ /* +--------------------------------------------+ */ /* . */ /* . */ /* . */ /* +--------------------------------------------+ */ /* | | End Address = */ /* | Unused space | integer page */ /* | | end */ /* +--------------------------------------------+ */ /* | | Start Address = */ /* | First integer page | integer page */ /* | | base */ /* +--------------------------------------------+ */ /* . */ /* . */ /* . */ /* +--------------------------------------------+ */ /* | | */ /* | Last integer page | */ /* | | */ /* +--------------------------------------------+ */ /* The following parameters indicate positions of elements in the */ /* paging system metadata array: */ /* Number of metadata items per data type: */ /* Character metadata indices: */ /* Double precision metadata indices: */ /* Integer metadata indices: */ /* Size of metadata area: */ /* Page sizes, in units of DAS words of the appropriate type: */ /* Default page base addresses: */ /* End Include Section: EK Das Paging Parameters */ /* $ 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. */ /* Include Section: EK Architecture Version Parameters */ /* ekarch.inc Version 1 01-NOV-1995 (NJB) */ /* The following parameter indicates the EK file architecture */ /* version. EK files read by the EK system must have the */ /* architecture expected by the reader software; the architecture ID */ /* below is used to test for compatibility. */ /* Architecture code: */ /* End Include Section: EK Architecture Version Parameters */ /* $ 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. */ /* Include Section: EK Data Types */ /* ektype.inc Version 1 27-DEC-1994 (NJB) */ /* Within the EK system, data types of EK column contents are */ /* represented by integer codes. The codes and their meanings */ /* are listed below. */ /* Integer codes are also used within the DAS system to indicate */ /* data types; the EK system makes no assumptions about compatibility */ /* between the codes used here and those used in the DAS system. */ /* Character type: */ /* Double precision type: */ /* Integer type: */ /* `Time' type: */ /* Within the EK system, time values are represented as ephemeris */ /* seconds past J2000 (TDB), and double precision numbers are used */ /* to store these values. However, since time values require special */ /* treatment both on input and output, and since the `TIME' column */ /* has a special role in the EK specification and code, time values */ /* are identified as a type distinct from double precision numbers. */ /* End Include Section: EK Data Types */ /* $ Brief_I/O */ /* Variable I/O Description */ /* -------- --- -------------------------------------------------- */ /* HANDLE I Handle attached to EK file. */ /* ACCESS I Access type. */ /* $ Detailed_Input */ /* HANDLE is an EK file handle. The specified file is to be */ /* checked to see whether it is a valid paged EK and */ /* whether it is open for the specified type of */ /* access. */ /* ACCESS is a short string indicating the type of access */ /* desired. Possible values are 'READ' and 'WRITE'. */ /* Leading and trailing blanks in ACCESS are ignored, */ /* and case is not significant. */ /* $ Detailed_Output */ /* None. See $Particulars for a description of the effect of this */ /* routine. */ /* $ Parameters */ /* None. */ /* $ Exceptions */ /* 1) If HANDLE is invalid, the error will be diagnosed by routines */ /* called by this routine. */ /* 2) If the EK architecture version is not current, the error */ /* SPICE(WRONGARCHITECTURE) is signalled. */ /* 3) If the DAS logical address ranges occupied by the EK are */ /* not consistent with those recorded by the paging system, */ /* the error SPICE(INVALIDFORMAT) is signalled. */ /* 4) If the EK is not open for the specified type of access, the */ /* error will be diagnosed by routines called by this routine. */ /* $ Files */ /* See the EK Required Reading for a discussion of the EK file */ /* format. */ /* $ Particulars */ /* This routine centralizes a validation check performed by many */ /* EK routines. The EK designated by HANDLE is tested to see */ /* whether some aspects of its structure are valid, and whether */ /* the specified type of access (read or write) is allowed. */ /* The tests performed are: */ /* - Is the file a DAS file open for the specified type of access? */ /* - Is the file's EK architecture version correct? */ /* - Are the DAS address ranges in use consistent with those */ /* recorded in the file by the paging system? */ /* If the file fails any test, an error is signalled. */ /* $ Examples */ /* See EKINSR. */ /* $ Restrictions */ /* None. */ /* $ Literature_References */ /* None. */ /* $ Author_and_Institution */ /* N.J. Bachman (JPL) */ /* $ Version */ /* - Beta Version 1.0.0, 19-OCT-1995 (NJB) */ /* -& */ /* SPICELIB functions */ /* Local variables */ chkin_("ZZEKPGCH", (ftnlen)8); /* Check whether the DAS is opened for the specified access method. */ dassih_(handle, access, access_len); if (failed_()) { chkout_("ZZEKPGCH", (ftnlen)8); return 0; } /* Make sure the DAS file is of the right type. */ dasrdi_(handle, &c__1, &c__1, &id); if (id != 8) { dashlu_(handle, &unit); setmsg_("File # has architecture #, which is invalid for paged acces" "s. You are using EK software version #.", (ftnlen)99); errfnm_("#", &unit, (ftnlen)1); errint_("#", &id, (ftnlen)1); errint_("#", &c__8, (ftnlen)1); sigerr_("SPICE(WRONGARCHITECTURE)", (ftnlen)24); chkout_("ZZEKPGCH", (ftnlen)8); return 0; } /* Obtain the page counts. Set the `top' addresses. */ dasrdi_(handle, &c__4, &c__4, &npc); dasrdi_(handle, &c__9, &c__9, &npd); dasrdi_(handle, &c__14, &c__14, &npi); topc = npc << 10; topd = npd << 7; topi = (npi << 8) + 256; /* Verify that the last addresses in use are consistent with the */ /* `top' addresses known to this system. */ daslla_(handle, &lastc, &lastd, &lasti); if (lastc > topc) { dashlu_(handle, &unit); setmsg_("File # has last char address #; `top' = #.", (ftnlen)42); errfnm_("#", &unit, (ftnlen)1); errint_("#", &lastc, (ftnlen)1); errint_("#", &topc, (ftnlen)1); sigerr_("SPICE(INVALIDFORMAT)", (ftnlen)20); chkout_("ZZEKPGCH", (ftnlen)8); return 0; } else if (lastd > topd) { dashlu_(handle, &unit); setmsg_("File # has last d.p. address #; `top' = #.", (ftnlen)42); errfnm_("#", &unit, (ftnlen)1); errint_("#", &lastd, (ftnlen)1); errint_("#", &topd, (ftnlen)1); sigerr_("SPICE(INVALIDFORMAT)", (ftnlen)20); chkout_("ZZEKPGCH", (ftnlen)8); return 0; } else if (lasti > topi) { dashlu_(handle, &unit); setmsg_("File # has last int. address #; `top' = #.", (ftnlen)42); errfnm_("#", &unit, (ftnlen)1); errint_("#", &lasti, (ftnlen)1); errint_("#", &topi, (ftnlen)1); sigerr_("SPICE(INVALIDFORMAT)", (ftnlen)20); chkout_("ZZEKPGCH", (ftnlen)8); return 0; } chkout_("ZZEKPGCH", (ftnlen)8); return 0; } /* zzekpgch_ */