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