/* $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_ */
Z gcd_(Z a, Z b) {
if(a == 0) return b;
return gcd_(b % a, a);
}
/* $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_ */
/// 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));
}
