| 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 | |
|---|
| 83 | FUNCTION 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 | |
|---|
| 140 | END |
|---|
| 141 | |
|---|