1 /* dpstrf.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_n1 = -1;
11 static logical c_false = FALSE_;
12 static logical c_true = TRUE_;
13
14 /* $Procedure DPSTRF ( Double Precision Number to Character ) */
dpstrf_(doublereal * x,integer * sigdig,char * format,char * string,ftnlen format_len,ftnlen string_len)15 /* Subroutine */ int dpstrf_(doublereal *x, integer *sigdig, char *format,
16 char *string, ftnlen format_len, ftnlen string_len)
17 {
18 /* System generated locals */
19 integer i__1, i__2;
20
21 /* Builtin functions */
22 /* Subroutine */ int s_copy(char *, char *, ftnlen, ftnlen);
23 integer i_len(char *, ftnlen);
24
25 /* Local variables */
26 integer last, i__, j;
27 extern /* Subroutine */ int zzvsbstr_(integer *, integer *, logical *,
28 char *, logical *, ftnlen);
29 doublereal y;
30 extern /* Subroutine */ int zzvststr_(doublereal *, char *, integer *,
31 ftnlen);
32 integer first;
33 extern /* Subroutine */ int dpstr_(doublereal *, integer *, char *,
34 ftnlen);
35 integer maxdig, lastch;
36 logical ovflow;
37 integer exp__;
38
39 /* $ Abstract */
40
41 /* Take a double precision number and convert it to an */
42 /* equivalent formatted character string representation (base 10). */
43
44 /* $ Disclaimer */
45
46 /* THIS SOFTWARE AND ANY RELATED MATERIALS WERE CREATED BY THE */
47 /* CALIFORNIA INSTITUTE OF TECHNOLOGY (CALTECH) UNDER A U.S. */
48 /* GOVERNMENT CONTRACT WITH THE NATIONAL AERONAUTICS AND SPACE */
49 /* ADMINISTRATION (NASA). THE SOFTWARE IS TECHNOLOGY AND SOFTWARE */
50 /* PUBLICLY AVAILABLE UNDER U.S. EXPORT LAWS AND IS PROVIDED "AS-IS" */
51 /* TO THE RECIPIENT WITHOUT WARRANTY OF ANY KIND, INCLUDING ANY */
52 /* WARRANTIES OF PERFORMANCE OR MERCHANTABILITY OR FITNESS FOR A */
53 /* PARTICULAR USE OR PURPOSE (AS SET FORTH IN UNITED STATES UCC */
54 /* SECTIONS 2312-2313) OR FOR ANY PURPOSE WHATSOEVER, FOR THE */
55 /* SOFTWARE AND RELATED MATERIALS, HOWEVER USED. */
56
57 /* IN NO EVENT SHALL CALTECH, ITS JET PROPULSION LABORATORY, OR NASA */
58 /* BE LIABLE FOR ANY DAMAGES AND/OR COSTS, INCLUDING, BUT NOT */
59 /* LIMITED TO, INCIDENTAL OR CONSEQUENTIAL DAMAGES OF ANY KIND, */
60 /* INCLUDING ECONOMIC DAMAGE OR INJURY TO PROPERTY AND LOST PROFITS, */
61 /* REGARDLESS OF WHETHER CALTECH, JPL, OR NASA BE ADVISED, HAVE */
62 /* REASON TO KNOW, OR, IN FACT, SHALL KNOW OF THE POSSIBILITY. */
63
64 /* RECIPIENT BEARS ALL RISK RELATING TO QUALITY AND PERFORMANCE OF */
65 /* THE SOFTWARE AND ANY RELATED MATERIALS, AND AGREES TO INDEMNIFY */
66 /* CALTECH AND NASA FOR ALL THIRD-PARTY CLAIMS RESULTING FROM THE */
67 /* ACTIONS OF RECIPIENT IN THE USE OF THE SOFTWARE. */
68
69 /* $ Required_Reading */
70
71 /* None. */
72
73 /* $ Keywords */
74
75 /* CHARACTER */
76 /* CONVERSION */
77 /* PARSING */
78
79 /* $ Declarations */
80 /* $ Brief_I/O */
81
82 /* VARIABLE I/O DESCRIPTION */
83 /* -------- --- -------------------------------------------------- */
84 /* X I A double precision number */
85 /* SIGDIG I The number of significant digits saved for output */
86 /* FORMAT I 'E' for scientific, 'F' for floating point. */
87 /* STRING O A character string representation of X */
88
89 /* $ Detailed_Input */
90
91 /* X is a double precision number. */
92
93 /* SIGDIG is the number of significant digits that are desired */
94 /* for the output string. */
95
96 /* FORMAT is a character flag that indicates how the double */
97 /* precision number should be represented. The two */
98 /* acceptable inputs are 'E' and 'F'. If the input */
99 /* is 'E' then the number will be displayed with an */
100 /* exponent in scientific notation. It will have the */
101 /* form 'sx.xxx - - - xxxxxEsyy' where there are */
102 /* SIGDIG x's and s is ' ' or '-' at its first occurrence */
103 /* and '-' or '+' in the second. */
104
105 /* If the input is 'F' then the number will be */
106 /* displayed without an exponent --- the representation */
107 /* will be strictly decimal. The first symbol will be */
108 /* a sign ('-' or ' '). */
109
110 /* $ Detailed_Output */
111
112
113 /* STRING is a character representation of X to the number of */
114 /* significant digits specified by SIGDIG. The number of */
115 /* spaces required to return the requested character */
116 /* string is SIGDIG + 6. If STRING is not declared to */
117 /* have adequate length, the number returned will be */
118 /* truncated on the right. */
119
120 /* $ Parameters */
121
122 /* None. */
123
124 /* $ Particulars */
125
126 /* This routine computes an approximate character representation */
127 /* of the input string X. The maximum number of significant */
128 /* digits returned is 14 (in F format there may be many extra */
129 /* zeros returned but only a maximum of 14 digits will be */
130 /* significant. */
131
132 /* The output string is left justified. */
133
134 /* This routine has the advantage that it does not use an internal */
135 /* file and is about twice 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 /* IF you want the character string representation of a double */
141 /* precision number to be the same as that produced by a formatted */
142 /* write statement use a FORTRAN write statement. */
143
144 /* For example the number represented by the string */
145
146 /* 1.245454545454545454545E+01 */
147
148 /* when read (via a FORTRAN READ statement) into the DP variable X */
149 /* and converted back to a character string having 14 significant */
150 /* digits by this routine yields */
151
152 /* 1.2454545454545E+01 in E format */
153 /* 12.454545454545 in F format */
154
155 /* The FORTRAN write statement */
156
157 /* WRITE ( 6, FMT='(P1E)' ) X */
158
159 /* yields */
160
161 /* 1.2454545454545454E+01 */
162
163 /* If this is too much error for your application DO NOT use this */
164 /* routine. You should be aware however, that a character string */
165 /* read into a double precision number may not WRITE out with an */
166 /* equivalent character representation as was input. */
167
168 /* For example on a VAX 11/780 if you */
169
170 /* READ (5,*) X */
171 /* WRITE (6,FMT='(E)') X */
172
173 /* and enter a value of 7.00000001 for the read statement */
174 /* the output written will be 0.7000000010000001E+01 */
175
176
177 /* $ Examples */
178
179 /* Suppose that you wished to insert the character representation */
180 /* of some DOUBLE PRECISION number into a line of text. */
181
182 /* For example suppose X contains the double precision number */
183 /* 4.268176872928187 and you would like to insert the character */
184 /* representation of this number to 2 places between the strings */
185
186 /* 'There are', 'meters between lamp posts' */
187
188 /* You could perform the following sequence of steps */
189
190
191 /* DOUBLE PRECISION X */
192 /* CHARACTER*5 DISTANCE */
193 /* CHARACTER*80 MESSAGE */
194
195 /* CALL DPSTRF ( X, 2, 'F', DISTANCE ) */
196
197 /* MESSAGE = 'There are ' // */
198 /* . DISTANCE // */
199 /* . 'meters between lamp posts' */
200 /* . */
201
202 /* C */
203 /* C Squeeze any extra spaces out of the message string. */
204 /* C */
205 /* CALL CMPRSS ( ' ', 1, MESSAGE, MESSAGE ) */
206
207
208
209 /* The string MESSAGE would contain: */
210
211 /* 'There are 4.2 meters between lamp posts' */
212
213 /* $ Restrictions */
214
215 /* The maximum number of significant digits returned is 14. */
216
217 /* If the output string is not declared to be adequately large */
218 /* the numeric string will be truncated to the side opposite its */
219 /* justification (At least SIGDIG + 6 characters are needed in E */
220 /* format, in F format the size required is dependent upon the */
221 /* input X and the number of significant digits requested. */
222 /* In extreme cases up to 56 characters may be required.) */
223
224 /* This routine makes explicit use of the format of the string */
225 /* returned by DPSTR, should that routine change, substantial */
226 /* work may be required to bring this routine back up to snuff. */
227
228 /* $ Exceptions */
229
230 /* Error free. */
231
232 /* If SIGDIG is less than one, this routine returns one significant */
233 /* digit in the output string. */
234
235 /* $ Files */
236
237 /* None. */
238
239 /* $ Author_and_Institution */
240
241 /* W.L. Taber (JPL) */
242
243 /* $ Literature_References */
244
245 /* None. */
246
247 /* $ Version */
248
249 /* - SPICELIB Version 1.2.0, 17-SEP-1996 (WLT) */
250
251 /* Upgraded routine to handle arbitrary magnitude d.p. numbers. */
252
253 /* - SPICELIB Version 1.1.1, 10-MAR-1992 (WLT) */
254
255 /* Comment section for permuted index source lines was added */
256 /* following the header. */
257
258 /* - SPICELIB Version 1.1.0, 30-JUL-1990 (WLT) */
259
260 /* The routine was repaired so that references to zero-length */
261 /* strings ( for example STRING(4:3) ) are not made. */
262
263 /* - SPICELIB Version 1.0.0, 31-JAN-1990 (WLT) */
264
265 /* -& */
266 /* $ Index_Entries */
267
268 /* d.p. number to character with formatting */
269
270 /* -& */
271 /* $ Revisions */
272
273 /* - SPICELIB Version 1.1.0, 30-JUL-1990 (WLT) */
274
275 /* As previously implemented, one would occasionally reference */
276 /* a zero length substring of the variable NUMSTR. This was */
277 /* O.K. under VAX Fortran, because it allows such references. */
278 /* However, most implementations of Fortran are not as forgiving. */
279
280 /* -& */
281
282 /* Local variables */
283
284 /* Computing MIN */
285 i__1 = 14, i__2 = max(1,*sigdig);
286 maxdig = min(i__1,i__2);
287
288 /* If the format is 'E' we just let DPSTR handle the problem. */
289
290 if (*(unsigned char *)format == 'E') {
291 dpstr_(x, &maxdig, string, string_len);
292 return 0;
293 }
294
295 /* If we're still here, we have a decimal format requested. Set */
296 /* the sign for the number. */
297
298 if (*x < 0.) {
299 s_copy(string, "-", string_len, (ftnlen)1);
300 } else {
301 s_copy(string, " ", string_len, (ftnlen)1);
302 }
303
304 /* If X is zero, we can handle this without any regard to the */
305 /* exponent. */
306
307 if (*x == 0.) {
308 zzvststr_(x, " ", &exp__, (ftnlen)1);
309 zzvsbstr_(&c_n1, &maxdig, &c_false, string + 1, &ovflow, string_len -
310 1);
311 return 0;
312 }
313
314 /* We've already set the sign, now we deal with the unsigned */
315 /* portion of X. */
316
317 y = abs(*x);
318
319 /* Create a virtual decimal string for Y. */
320
321 zzvststr_(&y, " ", &exp__, (ftnlen)1);
322
323 /* Now we can just fill in the string by reading the appropriate */
324 /* substring from the virtual decimal string. We need to compute */
325 /* the first and last virtual digits to retrieve. To do this */
326 /* we look at EXP. */
327
328 if (exp__ >= 0) {
329 first = -exp__ - 1;
330 } else {
331 first = -exp__;
332 }
333 last = first + maxdig - 1;
334 if (first < 0 && last >= 0) {
335 ++last;
336 }
337 first = min(-1,first);
338 zzvsbstr_(&first, &last, &c_true, string + 1, &ovflow, string_len - 1);
339 if (ovflow) {
340 --first;
341 zzvsbstr_(&first, &last, &c_true, string + 1, &ovflow, string_len - 1)
342 ;
343
344 /* We need to blank out the last digit of string. */
345
346 lastch = last - first + 2;
347 if (last > 0 && lastch <= i_len(string, string_len)) {
348 s_copy(string + (lastch - 1), " ", string_len - (lastch - 1), (
349 ftnlen)1);
350 }
351 }
352 if (last < 0) {
353 j = last - first + 3;
354 for (i__ = last + 1; i__ <= -1; ++i__) {
355 if (j <= i_len(string, string_len)) {
356 *(unsigned char *)&string[j - 1] = '0';
357 }
358 ++j;
359 }
360 if (j <= i_len(string, string_len)) {
361 *(unsigned char *)&string[j - 1] = '.';
362 }
363 }
364 return 0;
365 } /* dpstrf_ */
366
367