Changeset 843 for trunk/readexp.tcl


Ignore:
Timestamp:
Dec 4, 2009 5:12:59 PM (11 years ago)
Author:
toby
Message:

# on 2005/03/24 21:59:06, toby did:
new validreal
support LS Band parameter (in part RBVD)
add xtra digit to PRNT (RBVD)

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/readexp.tcl

    • Property rcs:date changed from 2004/11/17 14:20:26 to 2005/03/24 21:59:06
    • Property rcs:lines changed from +3 -3 to +50 -16
    • Property rcs:rev changed from 1.43 to 1.44
    r830 r843  
    257257    return 1
    258258}
     259
    259260# test an argument if it is a valid number; reform the number to fit
    260261proc validreal {val length decimal} {
    261262    upvar $val value
     263    # is this a number?
    262264    if [catch {expr {$value}}] {return 0}
    263265    if [catch {
    264         # for small values, switch to exponential notation
    265         # 2 -> three sig figs.
    266         set pow [expr 2 - $decimal]
    267         if {abs($value) < pow(10,$pow) && $length > 6} {
    268             # try to make it fit
    269             if {$length - $decimal < 5} {set decimal [expr $length -5]}
     266        # how many digits are needed to the left of the decimal?
     267        set sign 0
     268        if {$value > 0} {
     269            set digits [expr {1 + int(log10($value))}]
     270        } elseif {$value < 0} {
     271            set digits [expr {1 + int(log10(-$value))}]
     272            set sign 1
     273        } else {
     274            set digits 1
     275        }
     276        if {$digits + $sign >= $length} {
     277            # the number is much too big -- use exponential notation
     278            set decimal [expr {$length - 6 - $sign}]
     279            # drop more decimal places, as needed
    270280            set tmp [format "%${length}.${decimal}E" $value]
     281            while {[string length $tmp] > $length && $decimal >= 0} {
     282                incr decimal -1
     283                set tmp [format "%${length}.${decimal}E" $value]
     284            }
     285        } elseif {$digits + $sign >= $length - $decimal} {
     286            # we will have to trim the number of decimal digits
     287            set decimal [expr {$length - $digits - $sign - 1}]
     288            set tmp [format "%#.${decimal}f" $value]
     289        } elseif {abs($value) < pow(10,2-$decimal) && $length > 6} {
     290            # for small values, switch to exponential notation (2-$decimal -> three sig figs.)
     291            set decimal [expr {$length - 6 - $sign}]
     292            # drop more decimal places, as needed
     293            set tmp [format "%${length}.${decimal}E" $value]
     294            while {[string length $tmp] > $length && $decimal >= 0} {
     295                incr decimal -1
     296                set tmp [format "%${length}.${decimal}E" $value]
     297            }
    271298        } else {
     299            # use format as specified
    272300            set tmp [format "%${length}.${decimal}f" $value]
    273301        }
    274         # if the string will not fit, use scientific notation & drop
    275         # digits, as needed
    276         while {[string length $tmp] > $length && $decimal >= 0} {
    277             set tmp [format "%${length}.${decimal}E" $value]
    278             incr decimal -1
    279         }
    280302        set value $tmp
    281     }] {return 0}
     303    } errmsg] {return 0}
    282304    return 1
    283305}
     
    331353#     convg     -- convergence criterion: -200 to 200 (*)
    332354#     marq      -- Marquardt damping factor: 1.0 to 9.99 (*)
     355#     mbw       -- LS matrix bandwidth; =0 for full matrix (*)
    333356proc expinfo {parm "action get" "value {}"} {
    334357    switch ${parm}-$action {
     
    358381        print-set {
    359382            if ![validint value 1] {return 0}
    360             cdatset PRNT [format %3d $value]
     383            cdatset PRNT [format %4d $value]
    361384        }
    362385        convg-get {
     
    385408            if ![validreal value 4 2] {return 0}
    386409            cdatset MARQ $value
     410        }
     411        mbw-get {
     412            set mbw [string trim [cdatget MBW]]
     413            if {$mbw == ""} {return 0}
     414            if [catch {expr $mbw}] {return 0}
     415            return $mbw
     416        }
     417        mbw-set {
     418            if ![validint value 1] {return 0}
     419            if {$value < 0} {return 0}
     420            cdatset MBW [format %5d $value]
    387421        }
    388422        default {
Note: See TracChangeset for help on using the changeset viewer.