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