1 /* repsub.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 /* Table of constant values */
9
10 static integer c__3 = 3;
11
12 /* $Procedure REPSUB ( Replace one substring with another ) */
repsub_(char * in,integer * left,integer * right,char * string,char * out,ftnlen in_len,ftnlen string_len,ftnlen out_len)13 /* Subroutine */ int repsub_(char *in, integer *left, integer *right, char *
14 string, char *out, ftnlen in_len, ftnlen string_len, ftnlen out_len)
15 {
16 /* System generated locals */
17 integer i__1, i__2;
18
19 /* Builtin functions */
20 integer i_len(char *, ftnlen);
21 /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
22
23 /* Local variables */
24 integer next, i__;
25 extern /* Subroutine */ int chkin_(char *, ftnlen);
26 integer inlen;
27 extern integer sumai_(integer *, integer *);
28 integer remain;
29 extern /* Subroutine */ int sigerr_(char *, ftnlen), chkout_(char *,
30 ftnlen), setmsg_(char *, ftnlen), errint_(char *, integer *,
31 ftnlen);
32 integer strlen, outlen;
33 extern logical return_(void);
34 integer end, use[3];
35
36 /* $ Abstract */
37
38 /* Replace the substring (LEFT:RIGHT) with a string of any length. */
39
40 /* $ Disclaimer */
41
42 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
43 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
44 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
45 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
46 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
47 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
48 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
49 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
50 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
51 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
52
53 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
54 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
55 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
56 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
57 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
58 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
59
60 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
61 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
62 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
63 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
64
65 /* $ Required_Reading */
66
67 /* None. */
68
69 /* $ Keywords */
70
71 /* ASSIGNMENT */
72 /* CHARACTER */
73 /* STRING */
74
75 /* $ Declarations */
76 /* $ Brief_I/O */
77
78 /* VARIABLE I/O DESCRIPTION */
79 /* -------- --- -------------------------------------------------- */
80 /* IN I Input string. */
81 /* LEFT, */
82 /* RIGHT I Ends of substring to be replaced. */
83 /* STRING I Replacement string. */
84 /* OUT O Resulting string. */
85
86 /* $ Detailed_Input */
87
88 /* IN is an arbitrary character string. */
89
90 /* LEFT, */
91 /* RIGHT are the ends of the substring to be replaced. */
92 /* Legitimate substrings satisfy the following */
93 /* conditions */
94
95 /* RIGHT > LEFT - 2 */
96 /* LEFT > 1 */
97 /* RIGHT < LEN(STRING) + 1 */
98
99 /* This allows users to refer to zero-length substrings */
100 /* (null substrings) of IN. */
101
102 /* STRING is the replacement string. Essentially, the */
103 /* substring (LEFT:RIGHT) is removed from the */
104 /* input string, and STRING is inserted at the */
105 /* point of removal. */
106
107 /* $ Detailed_Output */
108
109 /* OUT is the resulting string. OUT may overwrite IN. */
110
111 /* $ Parameters */
112
113 /* None. */
114
115 /* $ Exceptions */
116
117 /* 1) If RIGHT is one less than LEFT, the substring to */
118 /* replace will be the null substring. In this case, */
119 /* STRING will be inserted between IN(:RIGHT) and IN(LEFT:). */
120
121 /* 2) If LEFT is smaller than one, the error SPICE(BEFOREBEGSTR) */
122 /* is signalled. */
123
124 /* 3) If RIGHT is greater than the length of the input string, */
125 /* the error SPICE(PASTENDSTR) is signalled. */
126
127 /* 4) If RIGHT is less than LEFT-1, the error SPICE(BADSUBSTR) */
128 /* is signalled. */
129
130 /* 5) Whenever the output string is too small to hold the result, */
131 /* the result is truncated on the right. */
132
133 /* $ Files */
134
135 /* None. */
136
137 /* $ Particulars */
138
139 /* Ideally, replacement could be done with simple concatenation, */
140
141 /* OUT = IN(1:LEFT-1) // STRING // IN(RIGHT+1: ) */
142
143 /* but the Fortran 77 standard makes this illegal for strings of */
144 /* unknown length. */
145
146 /* $ Examples */
147
148 /* A typical use for this routine might be to replace all */
149 /* occurrences of one word in a string with another word. */
150 /* For example, the following code fragment replaces every */
151 /* occurrence of the word 'AND' with the word 'OR' in the */
152 /* character string LINE. */
153
154 /* LEFT = WDINDX ( LINE, 'AND' ) */
155
156 /* DO WHILE ( LEFT .NE. 0 ) */
157 /* CALL REPSUB ( LINE, LEFT, LEFT+2, 'OR', LINE ) */
158 /* LEFT = WDINDX ( LINE, 'AND' ) */
159 /* END DO */
160
161 /* This routine can also be used to insert substring between */
162 /* two characters. Consider the string: */
163
164 /* IN = 'The defendent,, was found innocent.' */
165
166 /* to insert ' Emelda Marcos' between the first and second commas */
167 /* determine the location of the pair ',,' */
168
169 /* RIGHT = POS ( IN, ',,', 1 ) */
170 /* LEFT = RIGHT + 1 */
171
172 /* then */
173
174 /* CALL REPSUB ( IN, LEFT, RIGHT, ' Emelda Marcos', OUT ) */
175
176 /* The output (OUT) will have the value: */
177
178 /* 'The defendent, Emelda Marcos, was found innocent.' */
179
180 /* $ Restrictions */
181
182 /* The memory used by STRING and OUT must be disjoint. The memory */
183 /* used by IN and OUT must be identical or disjoint. */
184
185 /* $ Literature_References */
186
187 /* None. */
188
189 /* $ Author_and_Institution */
190
191 /* W.L. Taber (JPL) */
192 /* I.M. Underwood (JPL) */
193
194 /* $ Version */
195
196 /* - SPICELIB Version 1.0.2, 17-JUN-1999 (WLT) */
197
198 /* Fixed example code fragment. */
199
200 /* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
201
202 /* Comment section for permuted index source lines was added */
203 /* following the header. */
204
205 /* - SPICELIB Version 1.0.0, 24-AUG-1990 (WLT) (IMU) */
206
207 /* -& */
208 /* $ Index_Entries */
209
210 /* replace one substring with another substring */
211
212 /* -& */
213
214 /* SPICELIB functions */
215
216
217 /* Local variables */
218
219
220 /* Standard SPICE error handling. */
221
222 if (return_()) {
223 return 0;
224 } else {
225 chkin_("REPSUB", (ftnlen)6);
226 }
227
228 /* Get the lengths of all the strings involved in this transaction. */
229
230 inlen = i_len(in, in_len);
231 strlen = i_len(string, string_len);
232 outlen = i_len(out, out_len);
233
234 /* Reject bad inputs. */
235
236 if (*left < 1) {
237 setmsg_("REPSUB error: LEFT (#) must not be less than 1.", (ftnlen)47)
238 ;
239 errint_("#", left, (ftnlen)1);
240 sigerr_("SPICE(BEFOREBEGSTR)", (ftnlen)19);
241 chkout_("REPSUB", (ftnlen)6);
242 return 0;
243 } else if (*right > inlen) {
244 setmsg_("REPSUB error: RIGHT (#) must not exceed length of IN (#).", (
245 ftnlen)57);
246 errint_("#", right, (ftnlen)1);
247 errint_("#", &inlen, (ftnlen)1);
248 sigerr_("SPICE(PASTENDSTR)", (ftnlen)17);
249 chkout_("REPSUB", (ftnlen)6);
250 return 0;
251 } else if (*right < *left - 1) {
252 setmsg_("REPSUB error: LEFT (#) must not exceed RIGHT+1 (# + 1). ", (
253 ftnlen)56);
254 errint_("#", left, (ftnlen)1);
255 errint_("#", right, (ftnlen)1);
256 sigerr_("SPICE(BADSUBSTR)", (ftnlen)16);
257 chkout_("REPSUB", (ftnlen)6);
258 return 0;
259 }
260
261 /* Consider three separate sections: */
262
263 /* 1) The front of the original string. */
264
265 /* 2) The replacement string. */
266
267 /* 3) The end of the original string. */
268
269 /* Determine how much of each section to use in the output string. */
270 /* REMAIN is the number of characters that will fit in the output */
271 /* string. */
272
273 remain = outlen;
274 /* Computing MIN */
275 i__1 = remain, i__2 = *left - 1;
276 use[0] = min(i__1,i__2);
277 remain -= use[0];
278 use[1] = min(remain,strlen);
279 remain -= use[1];
280 /* Computing MIN */
281 i__1 = remain, i__2 = inlen - *right;
282 use[2] = min(i__1,i__2);
283
284 /* Move the third section first. It gets moved back to front */
285 /* or front to back, depending on whether the replacement string */
286 /* is longer than the original substring. The main thing is to */
287 /* avoid overwriting characters that have yet to be moved. */
288
289 end = sumai_(use, &c__3);
290 if (*left + strlen > *right) {
291 next = end;
292 for (i__ = use[2]; i__ >= 1; --i__) {
293 i__1 = *right + i__ - 1;
294 s_copy(out + (next - 1), in + i__1, (ftnlen)1, *right + i__ -
295 i__1);
296 --next;
297 }
298 } else {
299 next = *left + strlen;
300 i__1 = use[2];
301 for (i__ = 1; i__ <= i__1; ++i__) {
302 i__2 = *right + i__ - 1;
303 s_copy(out + (next - 1), in + i__2, (ftnlen)1, *right + i__ -
304 i__2);
305 ++next;
306 }
307 }
308
309 /* The first two sections can be moved directly to the front of */
310 /* the output string. */
311
312 next = 1;
313 i__1 = use[0];
314 for (i__ = 1; i__ <= i__1; ++i__) {
315 *(unsigned char *)&out[next - 1] = *(unsigned char *)&in[i__ - 1];
316 ++next;
317 }
318 i__1 = use[1];
319 for (i__ = 1; i__ <= i__1; ++i__) {
320 *(unsigned char *)&out[next - 1] = *(unsigned char *)&string[i__ - 1];
321 ++next;
322 }
323
324 /* Pad with blanks, if the output string was not filled. */
325
326 if (end < outlen) {
327 i__1 = end;
328 s_copy(out + i__1, " ", out_len - i__1, (ftnlen)1);
329 }
330 chkout_("REPSUB", (ftnlen)6);
331 return 0;
332 } /* repsub_ */
333
334