source: trunk/MESOSCALE/PLOT/MINIMAL/fsc/dbltostr.pro @ 205

Last change on this file since 205 was 85, checked in by aslmd, 14 years ago

LMD_MM_MARS et LMD_LES_MARS: ajout des routines IDL pour tracer les sorties --> voir mesoscale/PLOT

File size: 4.0 KB
Line 
1;+
2; NAME:
3;       DBLTOSTR
4;
5; PURPOSE:
6;
7;       This is a program for converting a double precision numerical value
8;       to a string. It was originally offered by BioPhys on the IDL newsgroup.
9;
10; AUTHOR:
11;
12;       FANNING SOFTWARE CONSULTING
13;       David Fanning,  Ph.D.
14;       1645 Sheely Drive
15;       Fort Collins,  CO 80526 USA
16;       Phone: 970-221-0438
17;       E-mail: davidf@dfanning.com
18;       Coyote's Guide to IDL Programming: http://www.dfanning.com
19;
20; CATEGORY:
21;
22;       Utility
23;
24; CALLING SEQUENCE:
25;
26;       stringValue  =  DblToStr(value)
27;
28; INPUTS:
29;
30;       value - A double-precision or floating point value to be converted to a string.
31;
32; OUTPUTS:
33;
34;       stringValue - The converted string value.
35;
36; KEYWORDS:
37;
38;       None.
39;
40; RESTRICTIONS:
41;
42;       Assumes 14 significant digits of precision.
43;
44; MODIFICATION HISTORY:
45;
46;       Written by BioPhys and offered to the IDL newsgroup,  7 November 2005.
47;       Slightly modified and renamed by David Fanning,  30 November,  2005.
48;-
49;
50;###########################################################################
51;
52; LICENSE
53;
54; This software is OSI Certified Open Source Software.
55; OSI Certified is a certification mark of the Open Source Initiative.
56;
57; Copyright © 2005 Fanning Software Consulting.
58;
59; This software is provided "as-is",  without any express or
60; implied warranty. In no event will the authors be held liable
61; for any damages arising from the use of this software.
62;
63; Permission is granted to anyone to use this software for any
64; purpose,  including commercial applications,  and to alter it and
65; redistribute it freely,  subject to the following restrictions:
66;
67; 1. The origin of this software must not be misrepresented; you must
68;    not claim you wrote the original software. If you use this software
69;    in a product,  an acknowledgment in the product documentation
70;    would be appreciated,  but is not required.
71;
72; 2. Altered source versions must be plainly marked as such,  and must
73;    not be misrepresented as being the original software.
74;
75; 3. This notice may not be removed or altered from any source distribution.
76;
77; For more information on Open Source Software,  visit the Open Source
78; web site: http://www.opensource.org.
79;
80;###########################################################################
81
82
83FUNCTION DBLTOSTR,  value
84
85   ; Error handling.
86   On_Error,  2
87   IF N_Elements(value) EQ 0 THEN Message,  'Double precision or floaing value must be passed to the function.'
88
89   ; Get the data type.
90   theType = Size(value, /Type)
91   IF theType NE 4 AND theType NE 5 THEN BEGIN
92       value = Double(value)
93       theType = 5
94   ENDIF
95
96   ; Data extension.
97   typeExt = theType EQ 4?'E':'D'
98
99   ; Create a string, using the full-widtet G format.
100   rawstr = StrTrim(String(value, Format = '(g)'), 2)
101
102   ; Extract the sign from the string and remove it for the moment.
103   sign = StrMid(rawstr, 0, 1) EQ '-'?'-':''
104   rawstr = sign EQ ''?rawstr:StrMid(rawstr, 1)
105
106   ; Is there an exponent in the string? If so, remove that for the moment.
107   epos = StrPos(rawstr, 'e')
108   indx = epos gt -1?StrMid(rawstr, epos+1):''
109   rawstr = indx EQ ''?rawstr:StrMid(rawstr, 0, epos)
110
111   ; Find the position of the decimal point.
112   dpos = StrPos(rawstr, '.')
113
114   ; Rounding process (assumes 14 significant digits).
115   outstr = StrArr(15)
116   FOR i = 0, 14 DO outstr[i] = StrMid(rawstr, i, 1)
117   aux = Fix(StrMid(rawstr, 16, 1)) GE 5?1:0
118   FOR i = 14,  0,  -1 DO BEGIN
119      IF i NE dpos then BEGIN
120         sumstr = StrTrim(String(aux+fix(outstr[i])), 2)
121         sumlen = StrLen(sumstr)
122         outstr[i] = StrMid(sumstr, sumlen-1, 1)
123         aux = sumlen EQ 1?0:1
124      ENDIF
125   ENDFOR
126
127   ; Throw away '0's at the end.
128   ii = 14
129   WHILE outstr[ii] EQ '0' DO BEGIN
130      ii = ii-1
131   ENDWHILE
132
133   ; Reconstruct the string.
134   saux = aux NE 0?'1':''
135   outstr = sign + saux + StrJoin(outstr[0:ii]) + typeExt + indx
136
137   ; Return it.
138   RETURN, outstr
139
140END
141
Note: See TracBrowser for help on using the repository browser.