370 lines
9.3 KiB
Tcl
370 lines
9.3 KiB
Tcl
namespace eval mom {
|
|
}
|
|
|
|
if {![namespace exists lsc]} {
|
|
source drivers/lsc.tcl
|
|
}
|
|
|
|
# multichannel ohm meter with innovative self heat- and thermo-electric adjustment
|
|
proc stdConfig::mom_sensor args {
|
|
variable mom_cfg
|
|
variable mom_color
|
|
variable name
|
|
variable path
|
|
|
|
scanargs $args var -channel -label -curve 0 -adjust 0 -color 0
|
|
if {![info exists mom_cfg($channel)]} {
|
|
error "illegal MOM channel: $channel"
|
|
}
|
|
set mom_cfg($channel) 1
|
|
if {$color eq "0"} {
|
|
set color $mom_color
|
|
incr mom_color
|
|
}
|
|
node $channel upd
|
|
prop v0 0
|
|
if {$label eq "0"} {
|
|
set enable 0
|
|
} else {
|
|
set enable 1
|
|
if {$curve eq "0"} {
|
|
set unit Ohm
|
|
} else {
|
|
set unit K_2
|
|
}
|
|
GraphAdd ${name}.${channel} $unit $label $color
|
|
}
|
|
kids "$label settings" {
|
|
|
|
node enable par $enable
|
|
prop enum 1
|
|
|
|
node r upd
|
|
|
|
node curve out -text
|
|
prop width 32
|
|
prop model 0
|
|
prop check mom::curve
|
|
prop write stdSct::completeUpdate
|
|
|
|
kids hidden {
|
|
node adjust out -text
|
|
default 0
|
|
prop width 32
|
|
prop check mom::adjust
|
|
prop write stdSct::completeUpdate
|
|
hfactory $path/points plain mugger floatvarar 1
|
|
hfactory $path/cpoints plain mugger floatvarar 1
|
|
}
|
|
}
|
|
hupdate $path/$channel/curve/adjust $adjust
|
|
hset $path/$channel/curve $curve
|
|
}
|
|
|
|
proc stdConfig::mom {cfgscript} {
|
|
variable name
|
|
variable node
|
|
variable path
|
|
variable mom_cfg
|
|
variable mom_color
|
|
|
|
if {[controller std "\r" 2]} {
|
|
controllerDesc "MOM controller"
|
|
}
|
|
|
|
pollperiod 5
|
|
obj mom rd
|
|
prop read mom::read
|
|
prop extmax 7
|
|
prop extidx -1
|
|
|
|
array set mom_cfg {ta 0 tb 0 tc 0 td 0 ref 0}
|
|
foreach ch [array names mom_cfg] {
|
|
set mom_cfg($ch) 0
|
|
}
|
|
set mom_color 11
|
|
|
|
kids hidden {
|
|
node excitation out
|
|
default 100
|
|
prop check mom::checkexcit
|
|
prop write stdSct::completeUpdate
|
|
|
|
if {[catch $cfgscript msg]} {
|
|
clientput $msg
|
|
}
|
|
foreach ch [array names mom_cfg] {
|
|
if {!$mom_cfg($ch)} {
|
|
mom_sensor $ch 0
|
|
}
|
|
}
|
|
|
|
node ext upd
|
|
prop v0 0
|
|
node com upd
|
|
prop v0 0
|
|
node gnd upd
|
|
prop v0 0
|
|
}
|
|
return "MOM multichannel ohm meter"
|
|
}
|
|
|
|
proc mom::start {} {
|
|
# set adc rate to 11
|
|
sct send ":10000D000102000B.."
|
|
return mom::start2
|
|
}
|
|
|
|
proc mom::start2 {} {
|
|
# set all i/o to output / push-pull / low
|
|
sct send ":10000000030600FF00FF0000.."
|
|
return mom::getidn
|
|
}
|
|
|
|
proc mom::getidn {} {
|
|
sct send ":0300030001.."
|
|
return stdSct::completeStart
|
|
}
|
|
|
|
proc mom::read {} {
|
|
sct send ":0400000008.."
|
|
return mom::update
|
|
}
|
|
|
|
|
|
proc mom::adjustcurve {} {
|
|
set adjust [sctval [sct]/adjust]
|
|
set points [sctval [sct]/points]
|
|
if {$adjust ne "0"} {
|
|
# if {[llength $adjust] == 2} {
|
|
# set radj [list 0 0]
|
|
# } else {
|
|
set radj [list]
|
|
# }
|
|
foreach {r t} $adjust {
|
|
lappend radj [interpolate $points 1 $t logx logy extrapolate] $r
|
|
}
|
|
#clientput "ADJUST $radj"
|
|
set cpoints [list]
|
|
foreach {r t} $points {
|
|
#if {abs($t - 77) < 20} {
|
|
# clientput "T $t R $r R [interpolate $radj 0 $r 1.0]"
|
|
#}
|
|
lappend cpoints [interpolate $radj 0 $r 1.0] $t
|
|
}
|
|
hupdate [sct]/cpoints $cpoints
|
|
} else {
|
|
hupdate [sct]/cpoints $points
|
|
}
|
|
}
|
|
|
|
proc mom::curve {} {
|
|
if {[sct requested] ne "0"} {
|
|
lsc::read_curve
|
|
mom::adjustcurve
|
|
}
|
|
}
|
|
|
|
proc mom::adjust {} {
|
|
hset [sct parent] [sctval [sct parent]]
|
|
}
|
|
|
|
proc mom::toKelvin {r channel} {
|
|
set t [interpolate [hvali [sct]/$channel/curve/cpoints] 0 $r logx logy extrapolate]
|
|
return $t
|
|
}
|
|
|
|
proc mom::toOhm {t channel} {
|
|
set r [interpolate [hvali [sct]/$channel/curve/cpoints] 1 $t logx logy extrapolate]
|
|
return $r
|
|
}
|
|
|
|
proc mom::update {} {
|
|
if {[scan [sct result] ":0410%4x%4x%4x%4x%4x%4x%4x%4x" gnd ref com ext ta tb tc td] != 8} {
|
|
error "bad response to '[sct send]': '[sct result]'"
|
|
}
|
|
set extidx [sct extidx]
|
|
# clientput "$extidx gnd $gnd ref $ref com $com ext $ext r $ta $tb $tc $td"
|
|
|
|
#<<< debug
|
|
# if {$extidx > 0} {
|
|
# incr extidx -1
|
|
# } else {
|
|
# set extidx 13
|
|
# }
|
|
# if {0==1} {
|
|
#>>>
|
|
|
|
sct update $extidx
|
|
set excitation [expr [hvali [sct]/excitation]*65535./2500.]
|
|
if {$extidx <= 0} {
|
|
foreach channel {gnd com ext} {
|
|
sct ${channel}0 [set $channel]
|
|
# clientput "$channel zero [set $channel]"
|
|
}
|
|
foreach channel {ref ta tb tc td} {
|
|
if {[silent 0 hgetpropval [sct]/$channel emx] == 0} {
|
|
updateerror [sct]/$channel undefined
|
|
updateerror [sct]/$channel/r undefined
|
|
}
|
|
set vi [set $channel]
|
|
hsetprop [sct]/$channel v0 $vi
|
|
# clientput "${channel}0 $vi"
|
|
hsetprop [sct]/$channel emx 0
|
|
}
|
|
if {$extidx < 0} {
|
|
incr extidx
|
|
} else {
|
|
set extidx [sct extmax]
|
|
}
|
|
#clientput "new extidx $extidx"
|
|
} else {
|
|
sct gnd$extidx $gnd
|
|
set com [expr $com - [sct com0]]
|
|
sct com$extidx $com
|
|
set ext [expr $ext - [sct ext0] - $com]
|
|
if {$ext <= 0} {
|
|
set ext 1
|
|
}
|
|
sct ext$extidx $ext
|
|
set minvi 99999
|
|
set done 1
|
|
foreach channel {ref ta tb tc td} {
|
|
set vi [expr [set $channel] - [hgetpropval [sct]/$channel v0] - $com]
|
|
hsetprop [sct]/$channel v$extidx $vi
|
|
set vilim [expr $ext / (1.0 + 2./100.)]
|
|
# clientput "ext $ext $channel $vi < lim $vilim"
|
|
if {[hvali [sct]/$channel/enable] && $vi < $vilim} {
|
|
# resistivity < 100kOhm
|
|
set r [expr 2000.0*$vi/($ext - $vi)]
|
|
if {$vi <= 0 && $extidx > 0} {
|
|
# mom has been reset: restart
|
|
sct extidx -1
|
|
return idle
|
|
}
|
|
# clientput "$channel ( $extidx ) $excitation $vi $ext r=$r"
|
|
if {$vi < $minvi} {
|
|
set minvi $vi
|
|
}
|
|
if {$vi >= $excitation || $extidx == 13} {
|
|
#clientput "$extidx e13"
|
|
set done 0
|
|
hsetprop [sct]/$channel emx $extidx
|
|
hsetprop [sct]/$channel vmx $vi
|
|
hsetprop [sct]/$channel rmx $r
|
|
if {$extidx == 1} {
|
|
hupdate [sct]/$channel/r $r
|
|
set temp [mom::toKelvin $r $channel]
|
|
}
|
|
} else {
|
|
if {$extidx+1 == [silent 0 hgetpropval [sct]/$channel emx]} {
|
|
if {[hvali [sct]/$channel/curve] ne "0"} {
|
|
set vmx [hgetpropval [sct]/$channel vmx]
|
|
set rmx [hgetpropval [sct]/$channel rmx]
|
|
if {$rmx <= 0} {
|
|
clientput "rmx $rmx vmx $vmx"
|
|
set rmx 200
|
|
set vmx [expr 2 * $vi]
|
|
}
|
|
set w [expr ($excitation - $vi) / ($vmx - $vi)]
|
|
if {$w > 1} {
|
|
set w 1
|
|
} elseif {$w < 0} {
|
|
set w 0
|
|
}
|
|
set tmx [mom::toKelvin $rmx $channel]
|
|
hsetprop [sct]/$channel tmx $tmx
|
|
set tmn [mom::toKelvin $r $channel]
|
|
if {[silent 0 sct disablesh] == 0} {
|
|
# self heat calc (K/uW) (687.17 = 65535/2500 ^ 2):
|
|
set sh [expr ($tmx - $tmn) * 687.17 / ($vmx * $vmx / $rmx - $vi * $vi / $r)]
|
|
set sh0 [silent 0 hgetpropval [sct]/$channel selfheatcoef]
|
|
if {$sh0 != 0} {
|
|
set sh [expr $sh0 * 0.9 + $sh * 0.1]
|
|
}
|
|
} else {
|
|
set sh 0
|
|
}
|
|
hsetprop [sct]/$channel selfheatcoef $sh
|
|
if {$sh < 0} {
|
|
set sh 0
|
|
}
|
|
|
|
set t0 [mom::toKelvin $r $channel]
|
|
set t [expr $w * ($tmx - $sh * $vmx * $vmx / $rmx / 687.17) \
|
|
+ (1 - $w) * ($t0 - $sh * $vi * $vi / $r / 687.17)]
|
|
set r [mom::toOhm $t $channel]
|
|
hsetprop [sct]/$channel selfheatcorr [expr $t0 - $t]
|
|
} else {
|
|
set t $r
|
|
}
|
|
updateval [sct]/$channel $t
|
|
updateval [sct]/$channel/r $r
|
|
}
|
|
}
|
|
}
|
|
}
|
|
if {$minvi < 99999} {
|
|
if {$minvi < $excitation && $extidx == [sct extmax] && $extidx < 13} {
|
|
# clientput INCREASE
|
|
while {$extidx < 13 && $minvi < $excitation} {
|
|
incr extidx
|
|
set minvi [expr $minvi * 1.6]
|
|
}
|
|
sct extmax $extidx
|
|
} else {
|
|
if {$done} {
|
|
# clientput END
|
|
set extidx 0
|
|
} else {
|
|
# clientput DOWN
|
|
if {$extidx > 1 && [sct extmax] > $extidx && $minvi >= $excitation} {
|
|
# clientput "REDUCE $extidx"
|
|
sct extmax $extidx
|
|
}
|
|
incr extidx -1
|
|
}
|
|
}
|
|
}
|
|
}
|
|
#}
|
|
set extidx [silent $extidx sct fixedext]
|
|
sct extidx $extidx
|
|
if {$extidx < 0} {
|
|
set extcode 0
|
|
} else {
|
|
set extlist {0 1 2 3 4 7 8 15 16 31 36 63 71 127}
|
|
if {$extidx >= [llength $extlist]} {
|
|
set extcode 0
|
|
} else {
|
|
set extcode [lindex $extlist $extidx]
|
|
}
|
|
}
|
|
sct send [format ":10000000030600FF00FF00%2.2X.." $extcode]
|
|
return stdSct::complete
|
|
}
|
|
|
|
proc mom::calib {obj channel r1 t1 r2 t2} {
|
|
set rn1 [expr exp(pow($t1,-0.731)*7.03)]
|
|
set rn2 [expr exp(pow($t2,-0.731)*7.03)]
|
|
if {$t1 > 85 || $t2 > 85} {
|
|
clientput "not precise for T > 85"
|
|
}
|
|
set r0 [expr ($r2-$r1)/($rn2-$rn1)]
|
|
set offset [expr $r1 - $r0 * $rn1]
|
|
$obj $channel/r0 $r0
|
|
$obj $channel/offset $offset
|
|
return "r0 $r0 offset $offset"
|
|
}
|
|
|
|
|
|
proc mom::checkexcit {} {
|
|
catch {hsetprop [sct parent]/ta selfheatcoef 0}
|
|
catch {hsetprop [sct parent]/tb selfheatcoef 0}
|
|
catch {hsetprop [sct parent]/tc selfheatcoef 0}
|
|
catch {hsetprop [sct parent]/td selfheatcoef 0}
|
|
catch {hsetprop [sct parent]/ref selfheatcoef 0}
|
|
}
|
|
|
|
publishLazy mom::calib
|