Changeset 843 for trunk/readexp.tcl

Timestamp:

Dec 4, 2009 5:12:59 PM (14 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:

• trunk/readexp.tcl (modified) (4 diffs, 3 props)

trunk/readexp.tcl

@@ -257 +257 @@
     return 1
 }
+
 # test an argument if it is a valid number; reform the number to fit
 proc validreal {val length decimal} {
     upvar $val value
+    # is this a number?
     if [catch {expr {$value}}] {return 0}
     if [catch {
-        # for small values, switch to exponential notation
-        # 2 -> three sig figs.
-        set pow [expr 2 - $decimal]
-        if {abs($value) < pow(10,$pow) && $length > 6} {
-            # try to make it fit
-            if {$length - $decimal < 5} {set decimal [expr $length -5]}
+        # how many digits are needed to the left of the decimal?
+        set sign 0
+        if {$value > 0} {
+            set digits [expr {1 + int(log10($value))}]
+        } elseif {$value < 0} {
+            set digits [expr {1 + int(log10(-$value))}]
+            set sign 1
+        } else {
+            set digits 1
+        }
+        if {$digits + $sign >= $length} {
+            # the number is much too big -- use exponential notation
+            set decimal [expr {$length - 6 - $sign}]
+            # drop more decimal places, as needed
             set tmp [format "%${length}.${decimal}E" $value]
+            while {[string length $tmp] > $length && $decimal >= 0} {
+                incr decimal -1
+                set tmp [format "%${length}.${decimal}E" $value]
+            }
+        } elseif {$digits + $sign >= $length - $decimal} {
+            # we will have to trim the number of decimal digits
+            set decimal [expr {$length - $digits - $sign - 1}]
+            set tmp [format "%#.${decimal}f" $value]
+        } elseif {abs($value) < pow(10,2-$decimal) && $length > 6} {
+            # for small values, switch to exponential notation (2-$decimal -> three sig figs.)
+            set decimal [expr {$length - 6 - $sign}]
+            # drop more decimal places, as needed
+            set tmp [format "%${length}.${decimal}E" $value]
+            while {[string length $tmp] > $length && $decimal >= 0} {
+                incr decimal -1
+                set tmp [format "%${length}.${decimal}E" $value]
+            }
         } else {
+            # use format as specified
             set tmp [format "%${length}.${decimal}f" $value]
         }
-        # if the string will not fit, use scientific notation & drop 
-        # digits, as needed
-        while {[string length $tmp] > $length && $decimal >= 0} {
-            set tmp [format "%${length}.${decimal}E" $value]
-            incr decimal -1
-        }
         set value $tmp
-    }] {return 0}
+    } errmsg] {return 0}
     return 1
 }
@@ -331 +353 @@
 #     convg     -- convergence criterion: -200 to 200 (*)
 #     marq      -- Marquardt damping factor: 1.0 to 9.99 (*)
+#     mbw       -- LS matrix bandwidth; =0 for full matrix (*)
 proc expinfo {parm "action get" "value {}"} {
     switch ${parm}-$action {
@@ -358 +381 @@
         print-set {
             if ![validint value 1] {return 0}
-            cdatset PRNT [format %3d $value]
+            cdatset PRNT [format %4d $value]
         }
         convg-get {
@@ -385 +408 @@
             if ![validreal value 4 2] {return 0}
             cdatset MARQ $value
+        }
+        mbw-get {
+            set mbw [string trim [cdatget MBW]]
+            if {$mbw == ""} {return 0}
+            if [catch {expr $mbw}] {return 0}
+            return $mbw
+        }
+        mbw-set {
+            if ![validint value 1] {return 0}
+            if {$value < 0} {return 0}
+            cdatset MBW [format %5d $value]
         }
         default {