Ignore:
Timestamp:
06/21/06 10:33:35 (18 years ago)
Author:
smasson
Message:

add some missing compilation options + small updates

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/SRC/ToBeReviewed/STRING/isnumber.pro

    r18 r115  
    2525;       Johns Hopkins Applied Physics Lab. 
    2626;       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 
    2829; 
    2930; Copyright (C) 1986, Johns Hopkins University/Applied Physics Laboratory 
    … …  
    3536;------------------------------------------------------------- 
    3637  
    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 
    4043          print,' Determine if a text string is a valid number.' 
    4144          print,' i = isnumber(txt, [x])' 
    … …  
    5154        endif 
    5255  
    53         TXT = STRTRIM(TXT0,2)   ; trim blanks. 
    54         X = 0                   ; define X. 
     56        txt = strtrim(txt0,2)   ; trim blanks. 
     57        x = 0                   ; define X. 
    5558  
    56         IF TXT EQ '' THEN RETURN, 0     ; null string not a number. 
     59        if txt eq '' then return, 0     ; null string not a number. 
    5760  
    58         SN = 1 
    59         IF NWRDS(TXT) GT 1 THEN BEGIN   ; get first word if more than one. 
    60           SN = -1 
    61           TXT = GETWRD(TXT,0) 
    62         ENDIF 
     61        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 
    6366           
    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'  -------- 
    9298        if total((b eq 101)+(b eq 69)+(b eq 100)+(b eq 68)) gt 1 then return,0 
    9399        b = byte(t) 
     100        ;-----  Allow no alphabetic characters  ----------- 
    94101        if total((b ge 65) and (b le 122)) ne 0 then return, 0 
    95102  
    … …  
    106113        endelse 
    107114  
    108         END 
     115        end 
Note: See TracChangeset for help on using the changeset viewer.