source: trunk/SRC/ToBeReviewed/STRING/isnumber.pro @ 232

Last change on this file since 232 was 232, checked in by pinsard, 17 years ago

improvements/corrections of some *.pro headers

  • Property svn:eol-style set to native
  • Property svn:keywords set to Id
File size: 3.9 KB
Line 
1;+
2;
3; @file_comments
4; Determine if a text string is a valid number.
5;
6; @categories
7;
8; @param TXT0 {in}{required}
9; text string to test.
10;
11; @param X {in}{required}
12;
13; @keyword HELP
14;
15; @returns
16;       x = optionaly returned numeric value if valid. 
17;       i = test flag:                                 
18;           0: not a number.
19;           1: txt is a long integer.
20;           2: txt is a float.
21;           -1: first word of txt is a long integer.
22;           -2: first word of txt is a float.
23;
24; @history
25;       R. Sterner.  15 Oct, 1986.
26;       Johns Hopkins Applied Physics Lab.
27;       R. Sterner, 12 Mar, 1990 --- upgraded.
28;       Richard Garrett, 14 June, 1992 --- fixed bug in returned float value.
29;       R. Sterner, 1999 Nov 30 --- Fixed a bug found by Kristian Kjaer, Denmark
30;
31; Copyright (C) 1986, Johns Hopkins University/Applied Physics Laboratory
32; This software may be used, copied, or redistributed as long as it is not
33; sold and this copyright notice is reproduced on each copy made.  This
34; routine is provided as is without any express or implied warranties
35; whatsoever.  Other limitations apply as described in the file disclaimer.txt.
36;
37; @version
38; $Id$
39;
40;-
41;
42        function isnumber, txt0, x, help=hlp
43;
44  compile_opt idl2, strictarrsubs
45;
46        if (n_params(0) lt 1) or keyword_set(hlp) then begin
47          print,' Determine if a text string is a valid number.'
48          print,' i = isnumber(txt, [x])'
49          print,'   txt = text string to test.                      in'
50          print,'   x = optionaly returned numeric value if valid.  out'
51          print,'   i = test flag:                                  out'
52          print,'       0: not a number.'
53          print,'       1: txt is a long integer.'
54          print,'       2: txt is a float.'
55          print,'       -1: first word of txt is a long integer.'
56          print,'       -2: first word of txt is a float.'
57          return, -1
58        endif
59 
60        txt = strtrim(txt0,2)   ; trim blanks.
61        x = 0                   ; define X.
62 
63        if txt eq '' then return, 0     ; null string not a number.
64 
65        sn = 1
66        if nwrds(txt) gt 1 then begin   ; get first word if more than one.
67          sn = -1
68          txt = getwrd(txt,0)
69        endif
70         
71        f_flag = 0                      ; Floating flag.
72        b = byte(txt)                   ; Convert to byte array.
73        if b[0] eq 45 then b=b[1:*]     ; Drop leading '-'.   ; Kristian Kjaer
74        if b[0] eq 43 then b=b[1:*]     ; Drop leading '+'.   ; bug fix.
75        w = where(b eq 43, cnt)         ; Look for '+'
76        if cnt gt 1 then return, 0      ; Alow only 1.
77        t = delchr(txt,'+')             ; Drop it.
78        w = where(b eq 45, cnt)         ; Look for '-'
79        if cnt gt 1 then return, 0      ; Allow only 1.
80        t = delchr(t,'-')               ; Drop it.
81        w = where(b eq 46, cnt)         ; Look for '.'
82        if cnt gt 1 then return, 0      ; Allow only 1.
83        if cnt eq 1 then f_flag = 1     ; If one then floating.
84        t = delchr(t,'.')               ; Drop it.
85        w = where(b eq 101, cnt)        ; Look for 'e'
86        if cnt gt 1 then return, 0      ; Allow only 1.
87        if cnt eq 1 then f_flag = 1     ; If 1 then assume float.
88        t = delchr(t,'e')               ; Drop it.
89        w = where(b eq 69, cnt)         ; Look for 'E'
90        if cnt gt 1 then return, 0      ; Allow only 1.
91        if cnt eq 1 then f_flag = 1     ; If 1 then assume float.
92        t = delchr(t,'E')               ; Drop it.
93        w = where(b eq 100, cnt)        ; Look for 'd'
94        if cnt gt 1 then return, 0      ; Allow only 1.
95        if cnt eq 1 then f_flag = 1     ; If 1 then assume float.
96        t = delchr(t,'d')               ; Drop it.
97        w = where(b eq 68, cnt)         ; Look for 'D'
98        if cnt gt 1 then return, 0      ; Allow only 1.
99        if cnt eq 1 then f_flag = 1     ; If 1 then assume float.
100        t = delchr(t,'D')               ; Drop it.
101        ;-----  Allow only one 'e', 'E', 'd', or 'D'  --------
102        if total((b eq 101)+(b eq 69)+(b eq 100)+(b eq 68)) gt 1 then return,0
103        b = byte(t)
104        ;-----  Allow no alphabetic characters  -----------
105        if total((b ge 65) and (b le 122)) ne 0 then return, 0
106 
107        c = strmid(t,0,1)
108        if (c lt '0') or (c gt '9') then return, 0  ; First char not a digit.
109 
110        x = txt + 0.0                               ; Convert to a float.
111        if f_flag eq 1 then return, 2*sn            ; Was floating.
112        if x eq long(x) then begin
113          x = long(x)
114          return, sn
115        endif else begin
116          return, 2*sn
117        endelse
118 
119        end
Note: See TracBrowser for help on using the repository browser.