1 /* cpos.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 CPOS ( Character position ) */
cpos_(char * str,char * chars,integer * start,ftnlen str_len,ftnlen chars_len)9 integer cpos_(char *str, char *chars, integer *start, ftnlen str_len, ftnlen
10 chars_len)
11 {
12 /* System generated locals */
13 integer ret_val;
14
15 /* Builtin functions */
16 integer i_len(char *, ftnlen), i_indx(char *, char *, ftnlen, ftnlen);
17
18 /* Local variables */
19 integer b;
20 logical found;
21 integer lenstr;
22
23 /* $ Abstract */
24
25 /* Find the first occurrence in a string of a character belonging */
26 /* to a collection of characters, starting at a specified location, */
27 /* searching forward. */
28
29 /* $ Disclaimer */
30
31 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
32 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
33 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
34 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
35 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
36 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
37 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
38 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
39 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
40 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
41
42 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
43 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
44 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
45 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
46 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
47 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
48
49 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
50 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
51 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
52 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
53
54 /* $ Required_Reading */
55
56 /* SCANNING */
57
58 /* $ Keywords */
59
60 /* CHARACTER */
61 /* SEARCH */
62 /* UTILITY */
63
64 /* $ Declarations */
65 /* $ Brief_I/O */
66
67 /* VARIABLE I/O DESCRIPTION */
68 /* -------- --- -------------------------------------------------- */
69 /* STR I Any character string. */
70 /* CHARS I A collection of characters. */
71 /* START I Position to begin looking for one of CHARS */
72
73 /* The function returns the index of the first character of STR */
74 /* at or following index START that is in the collection CHARS. */
75
76 /* $ Detailed_Input */
77
78 /* STR is any character string. */
79
80 /* CHARS is a character string containing a collection */
81 /* of characters. Spaces in CHARS are significant. */
82
83 /* START is the position in STR to begin looking for one of */
84 /* the characters in CHARS. */
85
86 /* $ Detailed_Output */
87
88 /* The function returns the index of the first character of STR */
89 /* (at or following index START) that is one of the characters in */
90 /* the string CHARS. If none of the characters is found, the */
91 /* function returns zero. */
92
93 /* $ Parameters */
94
95 /* None. */
96
97 /* $ Exceptions */
98
99 /* Error Free. */
100
101 /* 1) If START is less than 1, the search begins at the first */
102 /* character of the string. */
103
104 /* 2) If START is greater than the length of the string, CPOS */
105 /* returns zero. */
106
107 /* $ Files */
108
109 /* None. */
110
111 /* $ Particulars */
112
113 /* CPOS is case sensitive. */
114
115 /* An entire family of related SPICELIB routines (POS, CPOS, NCPOS, */
116 /* POSR, CPOSR, NCPOSR) is described in the Required Reading. */
117
118 /* Those familiar with the True BASIC language should note that */
119 /* these functions are equivalent to the True BASIC intrinsic */
120 /* functions with the same names. */
121
122 /* $ Examples */
123
124 /* Let STRING = 'BOB, JOHN, TED, AND MARTIN....' */
125 /* 123456789012345678901234567890 */
126
127 /* Normal (sequential) searching */
128 /* ----------------------------- */
129
130 /* CPOS( STRING, ' ,', 1 ) = 4 */
131
132 /* CPOS( STRING, ' ,', 5 ) = 5 */
133
134 /* CPOS( STRING, ' ,', 6 ) = 10 */
135
136 /* CPOS( STRING, ' ,', 11 ) = 11 */
137
138 /* CPOS( STRING, ' ,', 12 ) = 15 */
139
140 /* CPOS( STRING, ' ,', 16 ) = 16 */
141
142 /* CPOS( STRING, ' ,', 17 ) = 20 */
143
144 /* CPOS( STRING, ' ,', 21 ) = 0 */
145
146
147 /* START out of bounds */
148 /* ------------------- */
149
150 /* CPOS( STRING, ' ,', -113 ) = 4 */
151
152 /* CPOS( STRING, ' ,', -1 ) = 4 */
153
154 /* CPOS( STRING, ' ,', 31 ) = 0 */
155
156 /* CPOS( STRING, ' ,', 1231 ) = 0 */
157
158
159 /* Order within CHARS */
160 /* ------------------ */
161
162 /* CPOS( STRING, ',. ', 22 ) = 27 */
163
164 /* CPOS( STRING, ' ,.', 22 ) = 27 */
165
166 /* CPOS( STRING, ', .', 22 ) = 27 */
167
168 /* $ Restrictions */
169
170 /* None. */
171
172 /* $ Literature_References */
173
174 /* None. */
175
176 /* $ Author_and_Institution */
177
178 /* W.L. Taber (JPL) */
179 /* H.A. Neilan (JPL) */
180 /* B.V. Semenov (JPL) */
181
182 /* $ Version */
183
184 /* - SPICELIB Version 1.0.3, 31-JAN-2008 (BVS) */
185
186 /* Removed non-standard end-of-declarations marker */
187 /* 'C%&END_DECLARATIONS' from comments. */
188
189 /* - SPICELIB Version 1.0.2, 10-MAR-1992 (WLT) */
190
191 /* Comment section for permuted index source lines was added */
192 /* following the header. */
193
194 /* - SPICELIB Version 1.0.1, 26-MAR-1991 (HAN) */
195
196 /* The Required Reading file POSITION was renamed to SCANNING. */
197 /* This header was updated to reflect the change. */
198
199 /* - SPICELIB Version 1.0.0, 31-JAN-1990 (WLT) */
200
201 /* -& */
202 /* $ Index_Entries */
203
204 /* forward search for position of character */
205
206 /* -& */
207
208 /* Local variables */
209
210 lenstr = i_len(str, str_len);
211 b = max(1,*start);
212 found = FALSE_;
213 ret_val = 0;
214 while(! found) {
215 if (b > lenstr) {
216 return ret_val;
217 } else if (i_indx(chars, str + (b - 1), chars_len, (ftnlen)1) != 0) {
218 ret_val = b;
219 return ret_val;
220 } else {
221 ++b;
222 }
223 }
224 return ret_val;
225 } /* cpos_ */
226
227