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

Last change on this file since 495 was 495, checked in by pinsard, 10 years ago

fix thanks to coding rules; typo; dupe empty lines; trailing blanks

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