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