1 /* dpstr.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__2 = 2;
11
12 /* $Procedure DPSTR ( Double Precision Number to Character ) */
dpstr_(doublereal * x,integer * sigdig,char * string,ftnlen string_len)13 /* Subroutine */ int dpstr_(doublereal *x, integer *sigdig, char *string,
14 ftnlen string_len)
15 {
16 /* Initialized data */
17
18 static doublereal power[18] = { 1.,10.,100.,1e3,1e4,1e5,1e6,1e7,1e8,1e9,
19 1e10,1e11,1e12,1e13,1e14,1e15,1e16,1e17 };
20 static doublereal ipower[18] = { 1.,.1,.01,.001,1e-4,1e-5,1e-6,1e-7,1e-8,
21 1e-9,1e-10,1e-11,1e-12,1e-13,1e-14,1e-15,1e-16,1e-17 };
22 static char digits[1*10] = "0" "1" "2" "3" "4" "5" "6" "7" "8" "9";
23 static doublereal values[10] = { 0.,1.,2.,3.,4.,5.,6.,7.,8.,9. };
24 static char vaxexp[2*41] = "00" "01" "02" "03" "04" "05" "06" "07" "08"
25 "09" "10" "11" "12" "13" "14" "15" "16" "17" "18" "19" "20" "21"
26 "22" "23" "24" "25" "26" "27" "28" "29" "30" "31" "32" "33" "34"
27 "35" "36" "37" "38" "39" "40";
28
29 /* System generated locals */
30 address a__1[2];
31 integer i__1, i__2, i__3[2];
32 doublereal d__1;
33
34 /* Builtin functions */
35 /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen), s_cat(char *,
36 char **, integer *, integer *, ftnlen);
37 double d_lg10(doublereal *);
38 integer s_rnge(char *, integer, char *, integer);
39 double d_nint(doublereal *);
40
41 /* Local variables */
42 doublereal exp10;
43 char expc[20];
44 integer last;
45 doublereal copy;
46 char zero[28];
47 integer i__, k, postn, maxsig, expont;
48 extern /* Subroutine */ int intstr_(integer *, char *, ftnlen);
49 char numstr[32];
50
51 /* $ Abstract */
52
53 /* Take a double precision number and convert it to */
54 /* an equivalent character string representation (base 10). */
55
56 /* $ Disclaimer */
57
58 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
59 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
60 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
61 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
62 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
63 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
64 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
65 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
66 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
67 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
68
69 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
70 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
71 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
72 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
73 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
74 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
75
76 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
77 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
78 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
79 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
80
81 /* $ Required_Reading */
82
83 /* None. */
84
85 /* $ Keywords */
86
87 /* CHARACTER */
88 /* CONVERSION */
89 /* PARSING */
90
91 /* $ Declarations */
92 /* $ Brief_I/O */
93
94 /* VARIABLE I/O DESCRIPTION */
95 /* -------- --- -------------------------------------------------- */
96 /* X I A double precision number */
97 /* SIGDIG I The number of significant digits placed in output */
98 /* STRING O A character string representation of X */
99
100 /* $ Detailed_Input */
101
102 /* X is a double precision number. */
103
104 /* SIGDIG is the number of significant digits that are desired */
105 /* for the output string. */
106
107 /* $ Detailed_Output */
108
109
110 /* STRING is a character representation of X to the number of */
111 /* significant digits specified by SIGDIG. The number of */
112 /* spaces required to return the requested character */
113 /* string is SIGDIG + 6. If STRING is not declared to */
114 /* have adequate length, the number returned will be */
115 /* truncated on the right. */
116
117 /* $ Parameters */
118
119 /* None. */
120
121 /* $ Particulars */
122
123 /* This routine computes an approximate character representation */
124 /* of the input string X. The maximum number of significant */
125 /* digits returned is 14. The representation returned will be */
126 /* the same as that given by the FORTRAN write statement */
127
128 /* WRITE ( STRING, FMT=(P1E23.xx) */
129
130 /* where xx is a two digit number that represents MIN(14,SIGDIG). */
131 /* The last decimal place is rounded. The output string is left */
132 /* justified. */
133
134 /* This routine has the advantage that it does not use an internal */
135 /* file and is about 2.3 times as fast as an internal write. It can */
136 /* be used as part of character function without fear of introducing */
137 /* recursive I/O conflicts. It is intended to be an approximate */
138 /* inverse to the subroutine NPARSD. */
139
140 /* There is of course no formatting of the output string. All */
141 /* outputs are written in scientific notation. */
142
143 /* IF you want the character string representation of a double */
144 /* precision number to be the same as that produced by a formatted */
145 /* write statement use a FORTRAN write statement. */
146
147 /* For example the number represented by the string */
148
149 /* 1.245454545454545454545E+01 */
150
151 /* when read (via a FORTRAN READ statement) into the DP variable X */
152 /* and converted back to a character string having 14 significant */
153 /* digits by this routine yields */
154
155 /* 1.2454545454545E+01 */
156
157 /* The FORTRAN write statement */
158
159 /* WRITE ( 6, FMT='(P1E)' ) X */
160
161 /* yields */
162
163 /* 1.2454545454545454E+01 */
164
165 /* If this is too much error for your application DO NOT use this */
166 /* routine. You should be aware however, that a character string */
167 /* read into a double precision number may not WRITE out with an */
168 /* equivalent character representation as was input. */
169
170 /* For example on a VAX 11/780 if you */
171
172 /* READ (5,*) X */
173 /* WRITE (6,FMT='(E)') X */
174
175 /* and enter a value of 7.00000001 for the read statement */
176 /* the output written will be 0.7000000010000001E+01 */
177
178
179 /* $ Examples */
180
181 /* This routine is intended for use by routines that manipulate */
182 /* character strings. For example, it may be desirable for a */
183 /* routine to be able to take a character string input such as */
184
185 /* 12 miles */
186
187 /* and convert it to the string */
188
189 /* 1.932E+02 km */
190
191 /* or to simply */
192
193 /* 1.932E+02 */
194
195 /* The arithmetic is of course most easily handled using numeric */
196 /* variables. However, it may be that a string is required for */
197 /* subsequent processing of the input. A SPICELIB routine NPARSD */
198 /* exists that will take a character representation of a number */
199 /* and convert it to a DOUBLE PRECISION number. The 12 above */
200 /* can be converted to double precision using NPARSD, the d.p. */
201 /* number can then be multiplied by the 1.61... and the result */
202 /* converted back to a string using this routine. */
203
204 /* Suppose the following declarations are made */
205
206 /* CHARACTER*(80) TEXT */
207 /* CHARACTER*(80) NUMBER */
208 /* CHARACTER*(80) SCRATCH */
209
210 /* DOUBLE PRECISION X */
211 /* INTEGER I */
212
213 /* and that TEXT contains the string '12 mi'. Then the following */
214 /* code would produce a character string '1.932E+01 KM' */
215
216 /* CALL NEXTWD ( TEXT, NUMBER, SCRATCH ) */
217 /* CALL NPARSD ( NUMBER, X, ERROR, I ) */
218
219 /* IF ( ERROR .EQ. ' ' ) THEN */
220
221 /* X = X * 1.61D0 */
222 /* CALL DPSTR ( X, 5, NUMBER ) */
223 /* TEXT = NUMBER(1:10) // 'KM' */
224
225 /* ELSE */
226 /* . */
227 /* . */
228 /* create an error message, try again, etc. */
229 /* . */
230 /* . */
231 /* END IF */
232
233
234 /* $ Restrictions */
235
236 /* Note: The format of the string returned by this routine is */
237 /* used in DPSTRF which is in the call tree to DPFMT. Changes */
238 /* to the format of the output string may have unexpected */
239 /* consequences for these SPICE routines. Please check those */
240 /* routines before modifying this routine. */
241
242 /* The maximum number of significant digits returned is 14. */
243
244 /* If the output string is not declared to be adequately large */
245 /* (at least SIGDIG + 6), the numeric string will be truncated */
246 /* to the side opposite its justification. */
247
248 /* $ Exceptions */
249
250 /* Error free. */
251
252 /* If SIGDIG is less than one, this routine returns one significant */
253 /* digit in the output string. */
254
255 /* $ Files */
256
257 /* None. */
258
259 /* $ Author_and_Institution */
260
261 /* N.J. Bachman (JPL) */
262 /* H.A. Neilan (JPL) */
263 /* W.L. Taber (JPL) */
264
265 /* $ Literature_References */
266
267 /* None. */
268
269 /* $ Version */
270
271 /* - SPICELIB Version 1.1.1, 09-SEP-1996 (WLT) */
272
273 /* Added a reference to the header concerning the dependency */
274 /* of the SPICE routines DPSTRF and DPFMT on the format of */
275 /* the string produced by this routine. */
276
277 /* - SPICELIB Version 1.1.0, 11-JUN-1992 (WLT) */
278
279 /* A bug that caused this routine to have a floating point */
280 /* overflow for values of X close to zero was corrected. In */
281 /* addition the restriction on range of exponents supported */
282 /* has been removed. */
283
284 /* - SPICELIB Version 1.0.1, 10-MAR-1992 (WLT) */
285
286 /* Comment section for permuted index source lines was added */
287 /* following the header. */
288
289 /* - SPICELIB Version 1.0.0, 31-JAN-1990 (WLT) */
290
291 /* -& */
292 /* $ Index_Entries */
293
294 /* d.p. number to character */
295
296 /* -& */
297 /* $ Revisions */
298
299 /* - SPICELIB Version 1.1.0, 14-OCT-1992 (WLT) */
300
301 /* A bug that caused this routine to have a floating point */
302 /* overflow for values of X close to zero was corrected. In */
303 /* addition the restriction on range of exponents supported */
304 /* has been removed. */
305
306 /* - Beta Version 1.1.0, 16-FEB-1989 (HAN) (NJB) */
307
308 /* Header was changed to reflect the "error free" status */
309 /* of the module, and a comment was added stating what the */
310 /* routine does if SIGIDG is less than one. */
311
312 /* Declaration of the unused variable FRAC removed. */
313
314 /* -& */
315
316 /* Maximum number of allowed significant digits. */
317
318
319 /* Local variables */
320
321
322 /* Transfer X to the local variable COPY and leave X alone for the */
323 /* rest of the routine. */
324
325 copy = *x;
326
327 /* Wipe out anything sitting in NUMSTR */
328
329 s_copy(numstr, " ", (ftnlen)32, (ftnlen)1);
330
331 /* At least 1 significant digit is required. The most allowed is 14. */
332 /* MAXSIG is the integer in this range that is closest to SIGDIG. */
333
334 /* Computing MIN */
335 i__1 = 14, i__2 = max(1,*sigdig);
336 maxsig = min(i__1,i__2);
337
338 /* Examine COPY to see if its positive, zero, or negative. */
339 /* This determines whether we need a minus sign and where the */
340 /* decimal point needs to go in the output string. */
341
342 if (copy < 0.) {
343 *(unsigned char *)numstr = '-';
344 copy = -copy;
345 postn = 2;
346 *(unsigned char *)&numstr[2] = '.';
347 } else if (copy > 0.) {
348 *(unsigned char *)numstr = ' ';
349 postn = 2;
350 *(unsigned char *)&numstr[2] = '.';
351 } else {
352 s_copy(zero, " 0.0000000000000000000000000", (ftnlen)28, (ftnlen)28);
353 /* Writing concatenation */
354 i__3[0] = maxsig + 2, a__1[0] = zero;
355 i__3[1] = 4, a__1[1] = "E+00";
356 s_cat(numstr, a__1, i__3, &c__2, (ftnlen)32);
357 s_copy(string, numstr, string_len, (ftnlen)32);
358 return 0;
359 }
360
361 /* We need a first guess at the exponent string. Compute the LOG */
362 /* base 10 of COPY */
363
364 exp10 = d_lg10(©);
365
366 /* Scale our copy of the input into the range 1 to 10. */
367
368 if (exp10 < 0.) {
369
370 /* In this case the exponent will be negative. We want the */
371 /* largest integer exponent less than EXP10, but the FORTRAN */
372 /* INT function gives the INTEGER closest to EXP10 between EXP10 */
373 /* and zero. As a result we have to subtract 1 from INT(EXP10). */
374
375 expont = (integer) exp10 - 1;
376 k = -expont;
377 while(k > 16) {
378 copy *= 1e16;
379 k += -16;
380 }
381 if (k != 0) {
382 copy *= power[(i__1 = k) < 18 && 0 <= i__1 ? i__1 : s_rnge("power"
383 , i__1, "dpstr_", (ftnlen)434)];
384 }
385 } else {
386 expont = (integer) exp10;
387 k = expont;
388 while(k > 16) {
389 copy *= 1e-16;
390 k += -16;
391 }
392 if (k != 0) {
393 copy *= ipower[(i__1 = k) < 18 && 0 <= i__1 ? i__1 : s_rnge("ipo"
394 "wer", i__1, "dpstr_", (ftnlen)449)];
395 }
396 }
397
398 /* Round off the last significant digit. */
399
400 d__1 = copy * power[(i__1 = maxsig - 1) < 18 && 0 <= i__1 ? i__1 : s_rnge(
401 "power", i__1, "dpstr_", (ftnlen)460)];
402 copy = (d_nint(&d__1) + .125) * ipower[(i__2 = maxsig - 1) < 18 && 0 <=
403 i__2 ? i__2 : s_rnge("ipower", i__2, "dpstr_", (ftnlen)460)];
404
405 /* We might have accidently made copy as big as 10 by the */
406 /* round off process. If we did we need to divide by 10 and add 1 */
407 /* to the exponent value. (COPY must always remain between 0 and 10) */
408
409 if (copy >= 10.) {
410 copy *= .1;
411 ++expont;
412 }
413
414 /* Get the first digit of the decimal expansion of X. */
415
416 i__ = (integer) copy;
417 *(unsigned char *)&numstr[postn - 1] = *(unsigned char *)&digits[(i__1 =
418 i__) < 10 && 0 <= i__1 ? i__1 : s_rnge("digits", i__1, "dpstr_", (
419 ftnlen)476)];
420 copy = (copy - values[(i__1 = i__) < 10 && 0 <= i__1 ? i__1 : s_rnge(
421 "values", i__1, "dpstr_", (ftnlen)478)]) * 10.;
422
423 /* Set the string pointer to the next position and compute the */
424 /* position of the last significant digit */
425
426 postn += 2;
427 last = postn + maxsig - 1;
428
429 /* Fetch digits until we fill in the last available slot for */
430 /* significant digits. */
431
432 while(postn < last) {
433 i__ = (integer) copy;
434 *(unsigned char *)&numstr[postn - 1] = *(unsigned char *)&digits[(
435 i__1 = i__) < 10 && 0 <= i__1 ? i__1 : s_rnge("digits", i__1,
436 "dpstr_", (ftnlen)494)];
437 copy = (copy - values[(i__1 = i__) < 10 && 0 <= i__1 ? i__1 : s_rnge(
438 "values", i__1, "dpstr_", (ftnlen)495)]) * 10.;
439 ++postn;
440 }
441
442 /* Tack on the exponent to the output. Note that the rather odd */
443 /* if, else if, else construction below is done to maintain backward */
444 /* compatibility of the "look" of the output. */
445
446 /* First get the exponent symbol and sign of the exponent. */
447
448 if (expont >= 0) {
449 s_copy(numstr + (postn - 1), "E+", 32 - (postn - 1), (ftnlen)2);
450 } else {
451 expont = -expont;
452 s_copy(numstr + (postn - 1), "E-", 32 - (postn - 1), (ftnlen)2);
453 }
454 postn += 2;
455
456 /* Now get the numeric representation. */
457
458 if (expont <= 40) {
459 s_copy(expc, vaxexp + (((i__1 = expont) < 41 && 0 <= i__1 ? i__1 :
460 s_rnge("vaxexp", i__1, "dpstr_", (ftnlen)524)) << 1), (ftnlen)
461 20, (ftnlen)2);
462 } else {
463 intstr_(&expont, expc, (ftnlen)20);
464 }
465 s_copy(numstr + (postn - 1), expc, 32 - (postn - 1), (ftnlen)20);
466 s_copy(string, numstr, string_len, (ftnlen)32);
467
468 /* That's all folks. */
469
470 return 0;
471 } /* dpstr_ */
472
473