Changeset 843
 Timestamp:
 Dec 4, 2009 5:12:59 PM (13 years ago)
 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 257 257 return 1 258 258 } 259 259 260 # test an argument if it is a valid number; reform the number to fit 260 261 proc validreal {val length decimal} { 261 262 upvar $val value 263 # is this a number? 262 264 if [catch {expr {$value}}] {return 0} 263 265 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 270 280 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 } 271 298 } else { 299 # use format as specified 272 300 set tmp [format "%${length}.${decimal}f" $value] 273 301 } 274 # if the string will not fit, use scientific notation & drop275 # digits, as needed276 while {[string length $tmp] > $length && $decimal >= 0} {277 set tmp [format "%${length}.${decimal}E" $value]278 incr decimal 1279 }280 302 set value $tmp 281 } ] {return 0}303 } errmsg] {return 0} 282 304 return 1 283 305 } … … 331 353 # convg  convergence criterion: 200 to 200 (*) 332 354 # marq  Marquardt damping factor: 1.0 to 9.99 (*) 355 # mbw  LS matrix bandwidth; =0 for full matrix (*) 333 356 proc expinfo {parm "action get" "value {}"} { 334 357 switch ${parm}$action { … … 358 381 printset { 359 382 if ![validint value 1] {return 0} 360 cdatset PRNT [format % 3d $value]383 cdatset PRNT [format %4d $value] 361 384 } 362 385 convgget { … … 385 408 if ![validreal value 4 2] {return 0} 386 409 cdatset MARQ $value 410 } 411 mbwget { 412 set mbw [string trim [cdatget MBW]] 413 if {$mbw == ""} {return 0} 414 if [catch {expr $mbw}] {return 0} 415 return $mbw 416 } 417 mbwset { 418 if ![validint value 1] {return 0} 419 if {$value < 0} {return 0} 420 cdatset MBW [format %5d $value] 387 421 } 388 422 default {
Note: See TracChangeset
for help on using the changeset viewer.