/* dasadc.f -- translated by f2c (version 19980913).
   You must link the resulting object file with the libraries:
	-lf2c -lm   (in that order)
*/

#include "f2c.h"

/* Table of constant values */

static integer c__1 = 1;

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

