Changeset 115 for trunk/SRC/ToBeReviewed/STRING/isnumber.pro
- Timestamp:
- 06/21/06 10:33:35 (18 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/SRC/ToBeReviewed/STRING/isnumber.pro
r18 r115 25 25 ; Johns Hopkins Applied Physics Lab. 26 26 ; R. Sterner, 12 Mar, 1990 --- upgraded. 27 ; Richard Garrett, 14 June, 1992 --- fixed bug in returned float value. 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 28 29 ; 29 30 ; Copyright (C) 1986, Johns Hopkins University/Applied Physics Laboratory … … 35 36 ;------------------------------------------------------------- 36 37 37 FUNCTION ISNUMBER, TXT0, X, help=hlp 38 39 if (n_params(0) lt 1) or keyword_set(hlp) then begin 38 function isnumber, txt0, x, help=hlp 39 ; 40 compile_opt idl2, strictarrsubs 41 ; 42 if (n_params(0) lt 1) or keyword_set(hlp) then begin 40 43 print,' Determine if a text string is a valid number.' 41 44 print,' i = isnumber(txt, [x])' … … 51 54 endif 52 55 53 TXT = STRTRIM(TXT0,2) ; trim blanks.54 X= 0 ; define X.56 txt = strtrim(txt0,2) ; trim blanks. 57 x = 0 ; define X. 55 58 56 IF TXT EQ '' THEN RETURN, 0 ; null string not a number.59 if txt eq '' then return, 0 ; null string not a number. 57 60 58 SN= 159 IF NWRDS(TXT) GT 1 THEN BEGIN; get first word if more than one.60 SN= -161 TXT = GETWRD(TXT,0)62 ENDIF61 sn = 1 62 if nwrds(txt) gt 1 then begin ; get first word if more than one. 63 sn = -1 64 txt = getwrd(txt,0) 65 endif 63 66 64 f_flag = 0 ; Floating flag. 65 b = byte(txt) 66 w = where(b eq 43, cnt) 67 if cnt gt 1 then return, 0 68 t = delchr(txt,'+') 69 w = where(b eq 45, cnt) 70 if cnt gt 1 then return, 0 71 t = delchr(t,'-') 72 w = where(b eq 46, cnt) ; '.' 73 if cnt gt 1 then return, 0 ; May only be 1. 74 if cnt eq 1 then f_flag = 1 ; If one then floating. 75 t = delchr(t,'.') 76 w = where(b eq 101, cnt) ; 'e' 77 if cnt gt 1 then return, 0 78 if cnt eq 1 then f_flag = 1 79 t = delchr(t,'e') 80 w = where(b eq 69, cnt) ; 'E' 81 if cnt gt 1 then return, 0 82 if cnt eq 1 then f_flag = 1 83 t = delchr(t,'E') 84 w = where(b eq 100, cnt) ; 'd' 85 if cnt gt 1 then return, 0 86 if cnt eq 1 then f_flag = 1 87 t = delchr(t,'d') 88 w = where(b eq 68, cnt) ; 'D' 89 if cnt gt 1 then return, 0 90 if cnt eq 1 then f_flag = 1 91 t = delchr(t,'D') 67 f_flag = 0 ; Floating flag. 68 b = byte(txt) ; Convert to byte array. 69 if b[0] eq 45 then b=b[1:*] ; Drop leading '-'. ; Kristian Kjaer 70 if b[0] eq 43 then b=b[1:*] ; Drop leading '+'. ; bug fix. 71 w = where(b eq 43, cnt) ; Look for '+' 72 if cnt gt 1 then return, 0 ; Alow only 1. 73 t = delchr(txt,'+') ; Drop it. 74 w = where(b eq 45, cnt) ; Look for '-' 75 if cnt gt 1 then return, 0 ; Allow only 1. 76 t = delchr(t,'-') ; Drop it. 77 w = where(b eq 46, cnt) ; Look for '.' 78 if cnt gt 1 then return, 0 ; Allow only 1. 79 if cnt eq 1 then f_flag = 1 ; If one then floating. 80 t = delchr(t,'.') ; Drop it. 81 w = where(b eq 101, cnt) ; Look for 'e' 82 if cnt gt 1 then return, 0 ; Allow only 1. 83 if cnt eq 1 then f_flag = 1 ; If 1 then assume float. 84 t = delchr(t,'e') ; Drop it. 85 w = where(b eq 69, 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 100, cnt) ; Look for 'd' 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,'d') ; Drop it. 93 w = where(b eq 68, 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 ;----- Allow only one 'e', 'E', 'd', or 'D' -------- 92 98 if total((b eq 101)+(b eq 69)+(b eq 100)+(b eq 68)) gt 1 then return,0 93 99 b = byte(t) 100 ;----- Allow no alphabetic characters ----------- 94 101 if total((b ge 65) and (b le 122)) ne 0 then return, 0 95 102 … … 106 113 endelse 107 114 108 END115 end
Note: See TracChangeset
for help on using the changeset viewer.