1 /* lx4uns.f -- translated by f2c (version 19980913).
2 You must link the resulting object file with the libraries:
3 -lf2c -lm (in that order)
4 */
5
6 #include "f2c.h"
7
8 /* $Procedure LX4UNS (Scan for unsigned integer) */
lx4uns_(char * string,integer * first,integer * last,integer * nchar,ftnlen string_len)9 /* Subroutine */ int lx4uns_(char *string, integer *first, integer *last,
10 integer *nchar, ftnlen string_len)
11 {
12 /* Initialized data */
13
14 static logical doinit = TRUE_;
15
16 /* System generated locals */
17 integer i__1, i__2;
18
19 /* Builtin functions */
20 integer s_rnge(char *, integer, char *, integer), i_len(char *, ftnlen);
21
22 /* Local variables */
23 static integer i__, l;
24 static logical digit[384];
25
26 /* $ Abstract */
27
28 /* Scan a string from a specified starting position for the */
29 /* end of an unsigned integer. */
30
31 /* $ Disclaimer */
32
33 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
34 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
35 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
36 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
37 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
38 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
39 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
40 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
41 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
42 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
43
44 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
45 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
46 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
47 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
48 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
49 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
50
51 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
52 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
53 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
54 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
55
56 /* $ Required_Reading */
57
58 /* None. */
59
60 /* $ Keywords */
61
62 /* PARSING */
63
64 /* $ Declarations */
65 /* $ Brief_I/O */
66
67 /* VARIABLE I/O DESCRIPTION */
68 /* -------- --- -------------------------------------------------- */
69 /* STRING I any character string */
70 /* FIRST I first character to scan from in STRING */
71 /* LAST O last character that is part of an unsigned integer */
72 /* NCHAR O number of characters in the unsigned integer. */
73
74 /* $ Detailed_Input */
75
76 /* STRING is any character string. */
77
78 /* FIRST is the location in the string to beginning scanning */
79 /* for an unsigned integer. It is assumed that the */
80 /* unsigned integer begins at FIRST. */
81
82 /* $ Detailed_Output */
83
84 /* LAST is the last character at or after FIRST such that */
85 /* the substring STRING(FIRST:LAST) is an unsigned */
86 /* integer. If there is no such substring, LAST */
87 /* will be returned with the value FIRST-1. */
88
89 /* NCHAR is the number of characters in the unsigned integer */
90 /* that begins at FIRST and ends at last. If there */
91 /* is no such string NCHAR will be given the value 0. */
92
93 /* $ Parameters */
94
95 /* None. */
96
97 /* $ Files */
98
99 /* None. */
100
101 /* $ Exceptions */
102
103 /* Error free. */
104
105 /* 1) If FIRST is beyond either end of the string, then */
106 /* LAST will be returned with the value FIRST and NCHAR */
107 /* will be returned with the value 0. */
108
109 /* 2) If STRING(FIRST:FIRST) is not part of an unsigned integer */
110 /* then LAST will be returned with the value FIRST-1 and NCHAR */
111 /* will be returned with the value 0. */
112
113 /* $ Particulars */
114
115 /* This routine allows you to scan forward in a string to locate */
116 /* an unsigned integer that begins on the input character FIRST. */
117
118
119 /* $ Examples */
120
121 /* Suppose you believe that a string has the form */
122
123 /* X%Y%Z */
124
125 /* where X, Y, and Z are unsigned integers of some unknown */
126 /* length and % stands for some non-digit character. You could */
127 /* use this routine to locate the unsigned integers in the */
128 /* string as shown below. We'll keep track of the beginning and */
129 /* ending of the unsigned integers in the integer arrays B and E. */
130
131 /* FIRST = 1 */
132 /* I = 0 */
133
134 /* DO WHILE ( FIRST .LT. LEN(STRING) ) */
135
136 /* CALL LX4UNS ( STRING, FIRST, LAST, NCHAR ) */
137
138 /* IF ( NCHAR .GT. 0 ) THEN */
139
140 /* I = I + 1 */
141 /* B(I) = FIRST */
142 /* E(I) = LAST */
143 /* FIRST = LAST + 2 */
144
145 /* ELSE */
146
147 /* FIRST = FIRST + 1 */
148
149 /* END IF */
150
151 /* END DO */
152
153
154 /* $ Restrictions */
155
156 /* 1) Assumes ICHAR returns values in the range [-128, 255]. */
157
158 /* $ Author_and_Institution */
159
160 /* N.J. Bachman (JPL) */
161 /* W.L. Taber (JPL) */
162
163 /* $ Literature_References */
164
165 /* None. */
166
167 /* $ Version */
168
169 /* - SPICELIB Version 1.1.0, 03-DEC-2001 (NJB) */
170
171 /* Updated to work if non-printing characters are present in */
172 /* the input string. Updated Restrictions section. */
173
174 /* - SPICELIB Version 1.0.0, 12-JUL-1994 (WLT) */
175
176 /* -& */
177 /* $ Index_Entries */
178
179 /* Scan a string for an unsigned integer. */
180
181 /* -& */
182
183 /* Local parameters */
184
185
186 /* Local variables */
187
188
189 /* Saved variables */
190
191
192 /* Initial values */
193
194
195 /* First we perform some initializations that are needed on */
196 /* each pass through this routine. */
197
198 if (doinit) {
199 doinit = FALSE_;
200 for (i__ = -128; i__ <= 255; ++i__) {
201 digit[(i__1 = i__ + 128) < 384 && 0 <= i__1 ? i__1 : s_rnge("dig"
202 "it", i__1, "lx4uns_", (ftnlen)206)] = FALSE_;
203 }
204 digit[(i__1 = '0' + 128) < 384 && 0 <= i__1 ? i__1 : s_rnge("digit",
205 i__1, "lx4uns_", (ftnlen)209)] = TRUE_;
206 digit[(i__1 = '1' + 128) < 384 && 0 <= i__1 ? i__1 : s_rnge("digit",
207 i__1, "lx4uns_", (ftnlen)210)] = TRUE_;
208 digit[(i__1 = '2' + 128) < 384 && 0 <= i__1 ? i__1 : s_rnge("digit",
209 i__1, "lx4uns_", (ftnlen)211)] = TRUE_;
210 digit[(i__1 = '3' + 128) < 384 && 0 <= i__1 ? i__1 : s_rnge("digit",
211 i__1, "lx4uns_", (ftnlen)212)] = TRUE_;
212 digit[(i__1 = '4' + 128) < 384 && 0 <= i__1 ? i__1 : s_rnge("digit",
213 i__1, "lx4uns_", (ftnlen)213)] = TRUE_;
214 digit[(i__1 = '5' + 128) < 384 && 0 <= i__1 ? i__1 : s_rnge("digit",
215 i__1, "lx4uns_", (ftnlen)214)] = TRUE_;
216 digit[(i__1 = '6' + 128) < 384 && 0 <= i__1 ? i__1 : s_rnge("digit",
217 i__1, "lx4uns_", (ftnlen)215)] = TRUE_;
218 digit[(i__1 = '7' + 128) < 384 && 0 <= i__1 ? i__1 : s_rnge("digit",
219 i__1, "lx4uns_", (ftnlen)216)] = TRUE_;
220 digit[(i__1 = '8' + 128) < 384 && 0 <= i__1 ? i__1 : s_rnge("digit",
221 i__1, "lx4uns_", (ftnlen)217)] = TRUE_;
222 digit[(i__1 = '9' + 128) < 384 && 0 <= i__1 ? i__1 : s_rnge("digit",
223 i__1, "lx4uns_", (ftnlen)218)] = TRUE_;
224 }
225 *last = *first - 1;
226 l = i_len(string, string_len);
227
228 /* If start is beyond the ends of the string, we can quit now. */
229
230 if (*first < 1 || *first > l) {
231 *nchar = 0;
232 return 0;
233 }
234
235 /* Now for the real work of the routine. Examine characters one */
236 /* at a time... */
237
238 i__1 = l;
239 for (i__ = *first; i__ <= i__1; ++i__) {
240
241 /* If this character is a digit, move the LAST pointe one */
242 /* further down on the string. Otherwise set NCHAR and return. */
243
244 if (digit[(i__2 = *(unsigned char *)&string[i__ - 1] + 128) < 384 &&
245 0 <= i__2 ? i__2 : s_rnge("digit", i__2, "lx4uns_", (ftnlen)
246 241)]) {
247 ++(*last);
248 } else {
249 *nchar = *last + 1 - *first;
250 return 0;
251 }
252 }
253 *nchar = *last + 1 - *first;
254 return 0;
255 } /* lx4uns_ */
256
257