1 /* repmi.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 REPMI ( Replace marker with integer ) */
repmi_(char * in,char * marker,integer * value,char * out,ftnlen in_len,ftnlen marker_len,ftnlen out_len)9 /* Subroutine */ int repmi_(char *in, char *marker, integer *value, char *out,
10 ftnlen in_len, ftnlen marker_len, ftnlen out_len)
11 {
12 /* Builtin functions */
13 integer s_cmp(char *, char *, ftnlen, ftnlen);
14 /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
15 integer i_indx(char *, char *, ftnlen, ftnlen);
16
17 /* Local variables */
18 extern /* Subroutine */ int zzrepsub_(char *, integer *, integer *, char *
19 , char *, ftnlen, ftnlen, ftnlen);
20 integer mrknbf;
21 extern integer lastnb_(char *, ftnlen);
22 integer mrknbl;
23 extern integer frstnb_(char *, ftnlen);
24 integer mrkpsb, mrkpse;
25 char substr[11];
26 extern /* Subroutine */ int intstr_(integer *, char *, ftnlen);
27
28 /* $ Abstract */
29
30 /* Replace a marker with an integer. */
31
32 /* $ Disclaimer */
33
34 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
35 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
36 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
37 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
38 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
39 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
40 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
41 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
42 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
43 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
44
45 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
46 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
47 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
48 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
49 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
50 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
51
52 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
53 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
54 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
55 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
56
57 /* $ Required_Reading */
58
59 /* None. */
60
61 /* $ Keywords */
62
63 /* CHARACTER */
64 /* CONVERSION */
65 /* STRING */
66
67 /* $ Declarations */
68 /* $ Brief_I/O */
69
70 /* VARIABLE I/O DESCRIPTION */
71 /* -------- --- -------------------------------------------------- */
72 /* IN I Input string. */
73 /* MARKER I Marker to be replaced. */
74 /* VALUE I Replacement value. */
75 /* OUT O Output string. */
76 /* MAXLI P Maximum length of an integer. */
77
78 /* $ Detailed_Input */
79
80 /* IN is an arbitrary character string. */
81
82 /* MARKER is an arbitrary character string. The first */
83 /* occurrence of MARKER in the input string is */
84 /* to be replaced by VALUE. */
85
86 /* Leading and trailing blanks in MARKER are NOT */
87 /* significant. In particular, no substitution is */
88 /* performed if MARKER is blank. */
89
90 /* VALUE is an arbitrary integer. */
91
92 /* $ Detailed_Output */
93
94 /* OUT is the string obtained by substituting the text */
95 /* representation of VALUE for the first occurrence */
96 /* of MARKER in the input string. */
97
98 /* OUT and IN must be identical or disjoint. */
99
100 /* $ Parameters */
101
102 /* MAXLI is the maximum expected length of the text */
103 /* representation of an integer. 11 characters are */
104 /* sufficient to hold any integer whose absolute */
105 /* value is less than 10 billion. */
106
107 /* $ Exceptions */
108
109 /* Error Free. */
110
111 /* 1) If OUT does not have sufficient length to accommodate the */
112 /* result of the substitution, the result will be truncated on */
113 /* the right. */
114
115 /* 2) If MARKER is blank, or if MARKER is not a substring of IN, */
116 /* no substitution is performed. (OUT and IN are identical.) */
117
118 /* $ Files */
119
120 /* None. */
121
122 /* $ Particulars */
123
124 /* This is one of a family of related routines for inserting values */
125 /* into strings. They are typically to construct messages that */
126 /* are partly fixed, and partly determined at run time. For example, */
127 /* a message like */
128
129 /* 'Fifty-one pictures were found in directory [USER.DATA].' */
130
131 /* might be constructed from the fixed string */
132
133 /* '#1 pictures were found in directory #2.' */
134
135 /* by the calls */
136
137 /* CALL REPMCT ( STRING, '#1', N_PICS, 'C', STRING ) */
138 /* CALL REPMC ( STRING, '#2', DIR_NAME, STRING ) */
139
140 /* which substitute the cardinal text 'Fifty-one' and the character */
141 /* string '[USER.DATA]' for the markers '#1' and '#2' respectively. */
142
143 /* The complete list of routines is shown below. */
144
145 /* REPMC ( Replace marker with character string value ) */
146 /* REPMD ( Replace marker with double precision value ) */
147 /* REPMF ( Replace marker with formatted d.p. value ) */
148 /* REPMI ( Replace marker with integer value ) */
149 /* REPMCT ( Replace marker with cardinal text) */
150 /* REPMOT ( Replace marker with ordinal text ) */
151
152 /* $ Examples */
153
154 /* 1. Let */
155
156 /* IN = 'Invalid operation value. The value was #.' */
157
158 /* Then following the call, */
159
160 /* CALL REPMI ( IN, '#', 5, IN ) */
161
162 /* IN is */
163
164 /* 'Invalid operation value. The value was 5.' */
165
166
167 /* 2. Let */
168
169 /* IN = 'Left endpoint exceeded right endpoint. */
170 /* The left endpoint was: XX. The right */
171 /* endpoint was: XX.' */
172
173 /* Then following the call, */
174
175 /* CALL REPMI ( IN, ' XX ', 5, OUT ) */
176
177 /* OUT is */
178
179 /* 'Left endpoint exceeded right endpoint. The left */
180 /* endpoint was: 5. The right endpoint was: XX. */
181
182
183 /* 3. Let */
184
185 /* NUM = 23 */
186 /* CHANCE = 'fair' */
187 /* SCORE = 4.665D0 */
188
189 /* Then following the sequence of calls, */
190
191 /* CALL REPMI ( 'There are & routines that have a ' // */
192 /* . '& chance of meeting your needs.' // */
193 /* . 'The maximum score was &.', */
194 /* . '&', */
195 /* . NUM, */
196 /* . MSG ) */
197
198 /* CALL REPMC ( MSG, '&', CHANCE, MSG ) */
199
200 /* CALL REPMF ( MSG, '&', SCORE, 4, 'F', MSG ) */
201
202 /* MSG is */
203
204 /* 'There are 23 routines that have a fair chance of */
205 /* meeting your needs. The maximum score was 4.665.' */
206
207 /* $ Restrictions */
208
209 /* None. */
210
211 /* $ Literature_References */
212
213 /* None. */
214
215 /* $ Author_and_Institution */
216
217 /* N.J. Bachman (JPL) */
218 /* B.V. Semenov (JPL) */
219 /* W.L. Taber (JPL) */
220 /* I.M. Underwood (JPL) */
221
222 /* $ Version */
223
224 /* - SPICELIB Version 1.2.0, 21-SEP-2013 (BVS) */
225
226 /* Minor efficiency update: the routine now looks up the first */
227 /* and last non-blank characters only once. */
228
229 /* - SPICELIB Version 1.1.0, 15-AUG-2002 (WLT) */
230
231 /* The routine is now error free. */
232
233 /* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
234
235 /* Comment section for permuted index source lines was added */
236 /* following the header. */
237
238 /* - SPICELIB Version 1.0.0, 30-AUG-1990 (NJB) (IMU) */
239
240 /* -& */
241 /* $ Index_Entries */
242
243 /* replace marker with integer */
244
245 /* -& */
246
247 /* SPICELIB functions */
248
249
250 /* Local variables */
251
252
253 /* If MARKER is blank, no substitution is possible. */
254
255 if (s_cmp(marker, " ", marker_len, (ftnlen)1) == 0) {
256 s_copy(out, in, out_len, in_len);
257 return 0;
258 }
259
260 /* Locate the leftmost occurrence of MARKER, if there is one */
261 /* (ignoring leading and trailing blanks). If MARKER is not */
262 /* a substring of IN, no substitution can be performed. */
263
264 mrknbf = frstnb_(marker, marker_len);
265 mrknbl = lastnb_(marker, marker_len);
266 mrkpsb = i_indx(in, marker + (mrknbf - 1), in_len, mrknbl - (mrknbf - 1));
267 if (mrkpsb == 0) {
268 s_copy(out, in, out_len, in_len);
269 return 0;
270 }
271 mrkpse = mrkpsb + mrknbl - mrknbf;
272
273 /* Okay, MARKER is non-blank and has been found. Convert the */
274 /* integer to text, and substitute the text for the marker. */
275
276 intstr_(value, substr, (ftnlen)11);
277 zzrepsub_(in, &mrkpsb, &mrkpse, substr, out, in_len, lastnb_(substr, (
278 ftnlen)11), out_len);
279 return 0;
280 } /* repmi_ */
281
282