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

Last change on this file since 142 was 142, checked in by navarro, 18 years ago

english and nicer header (2a)

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