Beispiel #1
0
/* $Procedure      CYCLEC ( Cycle a character string ) */
/* Subroutine */ int cyclec_(char *instr, char *dir, integer *ncycle, char *
	outstr, ftnlen instr_len, ftnlen dir_len, ftnlen outstr_len)
{
    /* System generated locals */
    integer i__1, i__2;

    /* Builtin functions */
    integer i_len(char *, ftnlen);

    /* Local variables */
    char last[1], temp[1];
    integer g, i__, j, k, l, m, n;
    extern /* Subroutine */ int chkin_(char *, ftnlen), errch_(char *, char *,
	     ftnlen, ftnlen);
    integer limit;
    extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, 
	    ftnlen), setmsg_(char *, ftnlen);
    extern logical return_(void);
    extern integer gcd_(integer *, integer *);

/* $ Abstract */

/*      Cycle the contents of a character string to the left or right. */

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

/*     None. */

/* $ Keywords */

/*      CHARACTER,  UTILITY */

/* $ Declarations */
/* $ Brief_I/O */

/*      VARIABLE  I/O  DESCRIPTION */
/*      --------  ---  -------------------------------------------------- */
/*      INSTR      I   String to be cycled. */
/*      DIR        I   Direction to cycle. */
/*      NCYCLE     I   Number of times to cycle. */
/*      OUTSTR     O   Cycled string. */

/* $ Detailed_Input */

/*      DIR         is the direction in which the characters in the */
/*                  string are to be cycled. */

/*                        'L' or 'l'  to cycle left. */
/*                        'R' or 'r'  to cycle right. */

/*      NCYCLE      is the number of times the characters in the string */
/*                  are to be cycled. */

/*      INSTR       is the string to be cycled. */

/* $ Detailed_Output */

/*      OUTSTR      the input string after it has been cycled. */

/* $ Parameters */

/*      None. */

/* $ Particulars */

/*      A string is cycled when its contents are shifted to the left */
/*      or right by one place. A character pushed off one end of the */
/*      string is brought around to the other end of the string instead */
/*      of disappearing. */

/*      Leading and trailing blanks are treated just like any other */
/*      characters. */

/*      If the output string is not large enough to contain the input */
/*      string, the cycled string is truncated on the right. */

/* $ Examples */

/*      'abcde'   cycled left twice becomes               'cdeab' */
/*      'abcde '  cycled left twice becomes               'cde ab' */
/*      'abcde'   cycled right once becomes               'eabcd' */
/*      'Apple '  cycled left six times becomes           'Apple ' */
/*      'Apple '  cycled right twenty-four times becomes  'Apple ' */

/* $ Restrictions */

/*      The memory used for the output string must be identical to that */
/*      used for the input string or be disjoint from the input string */
/*      memory. */

/*      That is: */

/*           CALL CYCLEN ( STRING, DIR, NCYCLE, STRING ) */

/*      will produce correct results with output overwriting input. */

/*           CALL CYCLEN ( STRING(4:20), DIR, NCYCLE, STRING(2:18) ) */

/*      will produce garbage results. */

/* $ Exceptions */

/*     1) If the direction flag is not one of the acceptable values */
/*        'r', 'R', 'l', 'L',  the error 'SPICE(INVALIDDIRECTION)' is */
/*        signalled. */

/* $ Files */

/*      None. */

/* $ Author_and_Institution */

/*      W.L. Taber      (JPL) */
/*      I.M. Underwood  (JPL) */

/* $ Literature_References */

/*      None. */

/* $ Version */

/* -     SPICELIB Version 1.1.0, 18-JUN-1999 (WLT) */

/*         Fixed problem with unbalanced CHKIN/CHKOUT calls. */

/* -     SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */

/*         Comment section for permuted index source lines was added */
/*         following the header. */

/* -     SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) (WLT) */

/* -& */
/* $ Index_Entries */

/*     cycle a character_string */

/* -& */
/* $ Revisions */

/* -     Beta Version 1.1.0, 6-FEB-1989 (WLT) */

/*      Error handling for bad direction flag added. */

/* -& */

/*     SPICELIB functions */


/*     Local variables */

    if (return_()) {
	return 0;
    } else {
	chkin_("CYCLEC", (ftnlen)6);
    }

/*     Get the length of the input string. */

    n = i_len(instr, instr_len);
    limit = i_len(outstr, outstr_len);

/*     A left cycle is the same as a right cycle by the opposite of */
/*     NCYCLE.  Moreover a cycle by K is the same as a cycle by */
/*     K + m*N for any integer m.  Thus we compute the value of the */
/*     minimum positive right cycle that is equivalent to the inputs. */

    if (*(unsigned char *)dir == 'L' || *(unsigned char *)dir == 'l') {
	k = -(*ncycle) % n;
    } else if (*(unsigned char *)dir == 'R' || *(unsigned char *)dir == 'r') {
	k = *ncycle % n;
    } else {
	setmsg_("The direction flag should be one of the following: 'r', 'R'"
		", 'l', 'L'.  It was #.", (ftnlen)81);
	errch_("#", dir, (ftnlen)1, (ftnlen)1);
	sigerr_("SPICE(INVALIDDIRECTION)", (ftnlen)23);
	chkout_("CYCLEC", (ftnlen)6);
	return 0;
    }
    if (k < 0) {
	k += n;
    } else if (k == 0) {
	chkout_("CYCLEC", (ftnlen)6);
	return 0;
    }

/*     As to the method for performing the cycle in place, we need a */
/*     few preliminaries. */

/*        1.  Since we are performing a cycle on the input string we */
/*            can regard the letters of the string as being attached */
/*            to a circle at N equally spaced points.  Thus a cycle */
/*            by K has the effect of moving the position of each letter */
/*            to the K'th point from its current position along the */
/*            circle.  (The first point from its position is the */
/*            adjacent point.) */

/*        2.  If we start at some point on the circle and begin moves to */
/*            other points of the circle by always moving K points */
/*            at a time, how long will it take until we get back to */
/*            the starting point?  Answer: N/gcd(K,N) */

/*               Justification of the above answer. */

/*               a.  If we count all of the points that we move past or */
/*                   onto in such a trip (counting second, third, ... */
/*                   passes), we will find that we have */
/*                   moved past or onto i*K points after i steps. */

/*               b.  In order to get back to the starting point we will */
/*                   have to move past or onto a multiple of N points. */

/*               c.  The first time we will get back to the starting */
/*                   point is the smallest value of i such that i*K */
/*                   is a multiple of N.  That value is N/g.c.d.(K,N) */
/*                   where g.c.d stands for the greatest common divisor */
/*                   of K and N. Lets call this number M. */

/*                      i.  To see that this is the smallest number we */
/*                          first show that K*M is in fact a multiple of */
/*                          N.  The product K*M = K * ( N / gcd(K,N) ) */
/*                                              = N * ( K / gcd(K,N) ) */

/*                          Since gcd(K,N) evenly divides K, K/gcd(K,N) */
/*                          is an integer.  Thus K*M = N*I for some */
/*                          integer I ( = K / gcd(K,N) ). */

/*                      ii. The least common multiple of K and N is: */
/*                          K*N / gcd(K,N)  thus the first multiple */
/*                          of K that is also a multiple of N is the */
/*                          N/ gcd(K,N) 'th multiple of K. */

/*        3.  The closest stopping point on the circle will be gcd(K,N) */
/*            points away from our starting point.  To see this recall */
/*            that we make N/gcd(K,N) moves of size K inorder to get */
/*            back to the starting point.  The stopping points must */
/*            be equally spaced around the circle since the set of */
/*            points must look the same from any one of the points */
/*            visited --- after all we could get the same set by just */
/*            starting at one of those visited and making N/gcd(K,N) */
/*            moves.  But the set of N/gcd(K,N) equally space points */
/*            out of the original N must be gcd(K,N) points apart. */

/*        4.  To visit every point on the circle we could */

/*            a.  Pick a starting point */
/*            b.  Take N/gcd(K,N) steps of size K (bringing us back */
/*                to our starting point. */
/*            c.  move forward 1 point */
/*            d.  repeat steps a. b. and c. gcd(K,N) times. */

/*        5.  If in addition to moving around the circle by the */
/*            prescription of 4. above we: */
/*               a. pick up the letter at a position when we stop there */
/*                  (starting being the same as stopping) */
/*               b. put down the letter we had picked up at a previous */
/*                  point. */
/*            then we will cycle every letter by the prescribed value */
/*            of K. */

/*     In this case the code is much shorter than its explanation. */

    g = gcd_(&k, &n);
    m = n / g;
    i__1 = g;
    for (i__ = 1; i__ <= i__1; ++i__) {
	l = i__;
	*(unsigned char *)last = *(unsigned char *)&instr[l - 1];
	i__2 = m;
	for (j = 1; j <= i__2; ++j) {
	    l += k;

/*           Compute L mod N. */

	    if (l > n) {
		l -= n;
	    }
	    *(unsigned char *)temp = *(unsigned char *)&instr[l - 1];

/*           Make sure there is someplace to put the letter picked up */
/*           in the previous pass through the loop. */

	    if (l <= limit) {
		*(unsigned char *)&outstr[l - 1] = *(unsigned char *)last;
	    }
	    *(unsigned char *)last = *(unsigned char *)temp;
	}
    }
    chkout_("CYCLEC", (ftnlen)6);
    return 0;
} /* cyclec_ */
Beispiel #2
0
Z gcd_(Z a, Z b) {
	if(a == 0) return b;
	return gcd_(b % a, a);
}
Beispiel #3
0
/* $Procedure      CYCLAC ( Cycle the elements of a character array ) */
/* Subroutine */ int cyclac_(char *array, integer *nelt, char *dir, integer *
	ncycle, char *out, ftnlen array_len, ftnlen dir_len, ftnlen out_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 */
    char last[1], temp[1];
    integer c__, g, i__, j, k, l, m;
    extern /* Subroutine */ int chkin_(char *, ftnlen);
    extern integer nbwid_(char *, integer *, ftnlen);
    extern /* Subroutine */ int errch_(char *, char *, ftnlen, ftnlen), 
	    movec_(char *, integer *, char *, ftnlen, ftnlen);
    integer limit;
    extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *, 
	    ftnlen);
    integer widest;
    extern /* Subroutine */ int setmsg_(char *, ftnlen);
    integer outlen;
    extern logical return_(void);
    extern integer gcd_(integer *, integer *);

/* $ Abstract */

/*      Cycle the elements of a character array forward or backward. */

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

/*      None. */

/* $ Keywords */

/*      ARRAY */

/* $ Declarations */
/* $ Brief_I/O */

/*      VARIABLE  I/O  DESCRIPTION */
/*      --------  ---  -------------------------------------------------- */
/*      ARRAY      I   Input array. */
/*      NELT       I   Number of elements. */
/*      DIR        I   Direction to cycle: 'F' or 'B'. */
/*      NCYCLE     I   Number of times to cycle. */
/*      OUT        O   Cycled array. */

/* $ Detailed_Input */

/*      ARRAY       is the array to be cycled. */

/*      NELT        is the number of elements in the input array. */

/*      DIR         is the direction in which the elements in the */
/*                  array are to be cycled. */

/*                        'F' or 'f'  to cycle forward. */
/*                        'B' or 'b'  to cycle backward. */

/*      NCYCLE      is the number of times the elements in the array */
/*                  are to be cycled. */

/* $ Detailed_Output */

/*      OUT         is the input array after it has been cycled. */
/*                  OUT may overwrite ARRAY. */

/* $ Parameters */

/*     None. */

/* $ Exceptions */

/*      1) If the value of DIR is not recognized, the error */
/*         SPICE(INVALIDDIRECTION) is signalled. */

/*      2) If NELT is less than 1, the output array is not modified. */

/*      3) If NCYCLE is negative, the array is cycled NCYCLE times in */
/*         the opposite direction of DIR. */

/* $ Files */

/*      None. */

/* $ Particulars */

/*      An array is cycled when its contents are shifted forward or */
/*      backward by one place. An element pushed off one end of the */
/*      array is brought around to the other end of the array instead */
/*      of disappearing. */

/* $ Examples */

/*      Let the integer array A contain the following elements. */

/*            A(1) = 'apple' */
/*            A(2) = 'bear' */
/*            A(3) = 'cake' */
/*            A(4) = 'dragon' */

/*      Cycling A forward once yields the array */

/*            A(1) = 'dragon' */
/*            A(2) = 'apple' */
/*            A(3) = 'bear' */
/*            A(4) = 'cake' */

/*      Cycling A backward once yields the array */

/*            A(1) = 'bear' */
/*            A(2) = 'cake' */
/*            A(3) = 'dragon' */
/*            A(4) = 'apple' */

/*      Cycling by any multiple of the number of elements in the array */
/*      yields the same array. */

/* $ Restrictions */

/*      The memory used for the output array must be identical to or */
/*      disjoint from the memory used for the input array. */

/*      That is: */

/*           CALL CYCLAC ( ARRAY, NELT, DIR, NCYCLE, ARRAY ) */

/*      will produce correct results, while */

/*           CALL CYCLAC ( ARRAY, NELT-3, DIR, NCYCLE, ARRAY(4) ) */

/*      will produce garbage. */

/* $ Literature_References */

/*      None. */

/* $ Author_and_Institution */

/*      H.A. Neilan     (JPL) */
/*      W.L. Taber      (JPL) */
/*      I.M. Underwood  (JPL) */

/* $ Version */

/* -     SPICELIB Version 1.0.2, 18-MAY-2010 (BVS) */

/*        Removed "C$" marker from text in the header. */

/* -     SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */

/*         Comment section for permuted index source lines was added */
/*         following the header. */

/* -     SPICELIB Version 1.0.0, 31-JAN-1990 (IMU) (WLT) */

/* -& */
/* $ Index_Entries */

/*     cycle the elements of a character array */

/* -& */
/* $ Revisions */

/* -     Beta Version 2.0.0, 16-JAN-1989 (HAN) */

/*         Error handling was added to detect an invalid value for */
/*         the cycling direction. If the direction is not recognized */
/*         the error SPICE(INVALIDDIRECTION) is signalled and the */
/*         output array is not modified. (The routine used to copy the */
/*         input array into the output array if the direction was not */
/*         recognized.) */

/*         The "Exceptions" section was filled out in more detail. */

/* -& */

/*     SPICELIB functions */


/*     Local variables */


/*     Standard SPICE error handling. */

    if (return_()) {
	return 0;
    } else {
	chkin_("CYCLAC", (ftnlen)6);
    }

/*     Don't even screw around if there are no elements in the array. */

    if (*nelt < 1) {
	chkout_("CYCLAC", (ftnlen)6);
	return 0;
    }

/*     A backward cycle is the same as a forward cycle by the opposite */
/*     of NCYCLE.  Moreover a cycle by K is the same as a cycle by */
/*     K + m*N for any integer m.  Thus we compute the value of the */
/*     minimum forward right cycle that is equivalent to the inputs. */
/*     If the cycling direction is not recognized, signal an error. */

    if (*(unsigned char *)dir == 'B' || *(unsigned char *)dir == 'b') {
	k = -(*ncycle) % *nelt;
    } else if (*(unsigned char *)dir == 'F' || *(unsigned char *)dir == 'f') {
	k = *ncycle % *nelt;
    } else {
	setmsg_("Cycling direction was *.", (ftnlen)24);
	errch_("*", dir, (ftnlen)1, (ftnlen)1);
	sigerr_("SPICE(INVALIDDIRECTION)", (ftnlen)23);
	chkout_("CYCLAC", (ftnlen)6);
	return 0;
    }
    if (k < 0) {
	k += *nelt;
    } else if (k == 0) {
	movec_(array, nelt, out, array_len, out_len);
	chkout_("CYCLAC", (ftnlen)6);
	return 0;
    }

/*     The algorithm used to cycle arrays is identical to the one used */
/*     to cycle character strings in CYCLEC. We won't repeat the (rather */
/*     lengthy) description here. */

/*     The character version of CYCLAx differs from the other */
/*     versions in that a single character is cycled at a time. That */
/*     is, the first trip through the outermost loop cycles the first */
/*     characters of the array elements; the second trip cycles the */
/*     second characters; and so on. This allows the same algorithm to */
/*     be used for all the routines. The local storage required is just */
/*     a couple of characters. */


/*     Don't swap the ends of strings if they're just blank padded. */
/*     And don't overwrite the elements of the output array, if they */
/*     happen to be shorter thAn those in the input array. */

    outlen = i_len(out, out_len);
    widest = nbwid_(array, nelt, array_len);
    limit = min(outlen,widest);

/*     The greatest common divisor need only be computed once. */

    g = gcd_(&k, nelt);
    m = *nelt / g;

/*     To make this a non-character routine, remove all references to C. */

    i__1 = limit;
    for (c__ = 1; c__ <= i__1; ++c__) {
	i__2 = g;
	for (i__ = 1; i__ <= i__2; ++i__) {
	    l = i__;
	    *(unsigned char *)last = *(unsigned char *)&array[(l - 1) * 
		    array_len + (c__ - 1)];
	    i__3 = m;
	    for (j = 1; j <= i__3; ++j) {
		l += k;
		if (l > *nelt) {
		    l -= *nelt;
		}
		*(unsigned char *)temp = *(unsigned char *)&array[(l - 1) * 
			array_len + (c__ - 1)];
		*(unsigned char *)&out[(l - 1) * out_len + (c__ - 1)] = *(
			unsigned char *)last;
		*(unsigned char *)last = *(unsigned char *)temp;
	    }
	}
    }

/*     If needed, pad the output array with blanks. */

    if (outlen > limit) {
	i__1 = *nelt;
	for (i__ = 1; i__ <= i__1; ++i__) {
	    i__2 = limit;
	    s_copy(out + ((i__ - 1) * out_len + i__2), " ", out_len - i__2, (
		    ftnlen)1);
	}
    }
    chkout_("CYCLAC", (ftnlen)6);
    return 0;
} /* cyclac_ */
Beispiel #4
0
/// Return the greatest common divisor of two integers. Returns 0 if a and b
/// are zero, otherwise result is always positive.
Z gcd(Z a, Z b) {
	return gcd_(abs(a), abs(b));
}