505 lines
15 KiB
Tcl
505 lines
15 KiB
Tcl
#----------------------------------------------------------------------------
|
|
# VDMC instrument special scripted commands
|
|
#
|
|
# Mark Koennecke, June 2005
|
|
#---------------------------------------------------------------------------
|
|
source $home/mcsupport.tcl
|
|
|
|
if { [info exists vdmcinit] == 0 } {
|
|
set vdmcinit 1
|
|
Publish LogBook Spy
|
|
Publish count User
|
|
Publish Repeat User
|
|
Publish storedmcdata User
|
|
Publish rundmcsim User
|
|
Publish copydmcdata User
|
|
Publish sample User
|
|
Publish wwwsics Spy
|
|
Publish wwwfilefornumber Spy
|
|
mcinstall
|
|
Publish gethm Spy
|
|
Publish hdbscan User
|
|
Publish hdbprepare User
|
|
Publish hdbcollect User
|
|
Publish mgbatch Spy
|
|
Publish loadmgbatch Spy
|
|
Publish listbatchfiles Spy
|
|
}
|
|
source $home/log.tcl
|
|
source $home/nxsupport.tcl
|
|
source $home/nxdmc.tcl
|
|
source $home/gumxml.tcl
|
|
source $home/gumibatch.tcl
|
|
#------------------------------------------------------------------------
|
|
proc SplitReply { text } {
|
|
set l [split $text =]
|
|
return [lindex $l 1]
|
|
}
|
|
#---------------------------------------------------------------------
|
|
# load a lazy pulverix file
|
|
#---------------------------------------------------------------------
|
|
proc washlazy {name} {
|
|
global home
|
|
set newNam [file rootname [file tail $name]]
|
|
set in [open $name r]
|
|
set out [open $home/$newNam.q w]
|
|
#------- proceed to first header line
|
|
while { [gets $in line] >= 0} {
|
|
if { [string first "H K L THETA 2THETA D VALUE" $line] > 0} {
|
|
break
|
|
}
|
|
#-------- A second version to treat the messed up lazy pulverix files
|
|
# uploaded through the WWW-interface
|
|
if { [string first "H K L THETA" $line] >= 0} {
|
|
break
|
|
}
|
|
}
|
|
#------- process data lines
|
|
puts $out "// mult Q(hkl) F2 DW w"
|
|
clientput "HKL found at: $line"
|
|
while { [gets $in line] >= 0} {
|
|
set num [scan $line "%d %d %d %f %f %f %f %f %d %d %d %f %f %f %f %f %d"\
|
|
h k l th th2 d di sin h2 k2 l2 I F A B ang mul]
|
|
clientput "Line = $num, $line"
|
|
if { $num == 17} {
|
|
set q [expr (2.*3.14159265358979323846)/$d]
|
|
set f2 [expr $F * $F]
|
|
puts $out [format "%d %f %f 1 0" $mul $q $f2]
|
|
}
|
|
}
|
|
close $in
|
|
close $out
|
|
}
|
|
#----------------------------------------------------------------------
|
|
# script for setting the sample. We only allow samples for which
|
|
# there is a corresponing q data file
|
|
#------------------------------------------------------------------------
|
|
proc sample args {
|
|
global home
|
|
if { [llength $args] < 1} {
|
|
set sa [SplitReply [sampleintern]]
|
|
return "sample = $sa"
|
|
}
|
|
set txt [lindex $args 0]
|
|
#-------- list
|
|
if { [string compare $txt list] == 0} {
|
|
set l [glob $home/*.q]
|
|
foreach f $l {
|
|
append out [file rootname [file tail $f]] "\n"
|
|
}
|
|
return $out
|
|
}
|
|
#--------- load
|
|
if { [string compare $txt load] == 0} {
|
|
if { [llength $args] < 2} {
|
|
error "Need path to lazy pulverix output file to load"
|
|
}
|
|
set nam [lindex $args 1]
|
|
washlazy $nam
|
|
set nam2 [file rootname [file tail $nam]]
|
|
eval sampleintern $nam2
|
|
return OK
|
|
}
|
|
if { ![file exists $home/$txt.q] } {
|
|
error "No Q data for sample $txt"
|
|
} else {
|
|
eval sampleintern $txt
|
|
return OK
|
|
}
|
|
}
|
|
#-----------------------------------------------------------------------
|
|
# Scripts required for controlling McStas simulations
|
|
#-----------------------------------------------------------------------
|
|
proc rundmcsim {mode preset} {
|
|
global home
|
|
append command $home/dmc_sics05 " -f $home/dmc.xml --format=\"XML\""
|
|
append command " -n 1e10 "
|
|
append command " lambda=[string trim [SplitReply [lambda]]]"
|
|
append command " Det_start=[string trim [SplitReply [TwoThetaD]]]"
|
|
append command " samplefile=$home/[string trim [SplitReply [sampleintern]]].q"
|
|
append command " monfile=$home/monfile "
|
|
append command " >& $home/dmc.log &"
|
|
clientput "Starting McStas.. "
|
|
# clientput $command
|
|
set ret [catch {eval exec $command} msg]
|
|
if {$ret != 0} {
|
|
error $msg
|
|
} else {
|
|
return $msg
|
|
}
|
|
}
|
|
#------------------------------------------------------------------------
|
|
# Run the DMC simulation in an optimized mode with neutrons
|
|
# precalculated for various wave length until the sample slit
|
|
#------------------------------------------------------------------------
|
|
set dmcdata(2.56) dmc256.dat
|
|
set dmcdata(4.2) dmc420.dat
|
|
set dmcdata(2.45) dmc245.dat
|
|
set dmcdata(3.8) dmc380.dat
|
|
#-------------------------------------------------------------------------
|
|
proc rundmcoptsim {mode preset } {
|
|
global home dmcdata
|
|
#--------- locate closest precalculated neutron data file
|
|
set lambda [SplitReply [lambda]]
|
|
set myLambda $lambda
|
|
set wv [array names dmcdata]
|
|
set diff 999999.99
|
|
set lambdafile $dmcdata(2.56)
|
|
foreach w $wv {
|
|
set tmp [expr abs($w - $lambda)]
|
|
if { $tmp < $diff} {
|
|
set diff $tmp
|
|
set lambdafile $dmcdata($w)
|
|
set myLambda $w
|
|
}
|
|
}
|
|
#-------- build McStas command line
|
|
append command $home/dmcafter " -f $home/dmc.xml --format=\"XML\""
|
|
append command " -n 1e10 "
|
|
append command " lambdafile=$home/$lambdafile"
|
|
append command " Det_start=[string trim [SplitReply [TwoThetaD]]]"
|
|
append command " samplefile=$home/[string trim [SplitReply [sampleintern]]].q"
|
|
append command " monfile=$home/monfile "
|
|
append command " repeat=1000000000 "
|
|
append command " >& $home/dmc.log &"
|
|
#--------- start McStas
|
|
clientput "Starting McStas.. "
|
|
clientput "Coercing $lambda to precalculated $myLambda"
|
|
# clientput $command
|
|
set ret [catch {eval exec $command} msg]
|
|
if {$ret != 0} {
|
|
error "ERROR: $msg"
|
|
} else {
|
|
return $msg
|
|
}
|
|
wait 5
|
|
}
|
|
#------------------------------------------------------------------------
|
|
proc copydmcdataold { } {
|
|
global home
|
|
set mcversion "McStas 1.8 - Mar. 05, 2004"
|
|
washsimfile $home/dmc.xml
|
|
mcreader open $home/dmc.xml
|
|
mcreader insertmon \
|
|
"/$mcversion/DMC_diff/dmc.xml/PSD_sample/values" \
|
|
counter 1 [expr 1./350]
|
|
mcreader insertmon \
|
|
"/$mcversion/DMC_diff/dmc.xml/Det9/det9.dat/values" \
|
|
counter 5
|
|
set hmScale [SplitReply [counter getmonitor 5]]
|
|
if { $hmScale <= 0} {
|
|
set hmScale 1e9
|
|
} else {
|
|
set hmScale [expr $hmScale * 5e4]
|
|
}
|
|
clientput "HM scale = $hmScale"
|
|
mcreader inserthm \
|
|
"/$mcversion/DMC_diff/dmc.xml/Det9/det9.dat/data" banana $hmScale
|
|
mcreader close
|
|
}
|
|
#------------------------------------------------------------------------
|
|
proc copydmcdata { } {
|
|
global home
|
|
set mcversion "McStas 1.8 - Mar. 05, 2004"
|
|
#---- loop till the file can be opened
|
|
for {set i 0} {$i < 20} {incr i} {
|
|
washsimfile $home/dmc.xml
|
|
set stat [catch {mcreader open $home/dmc.xml} msg]
|
|
if {$stat == 0} {
|
|
break
|
|
} else {
|
|
file copy -force $home/dmc.xml $home/brokenfile.xml
|
|
wait 1
|
|
}
|
|
}
|
|
mcreader insertmon \
|
|
"/$mcversion/DMC_diff/dmc.xml/PSD_sample/values" \
|
|
counter 1 [expr 1./350]
|
|
# mcreader insertmon \
|
|
# "/$mcversion/DMC_diff/dmc.xml/Det9/det9.dat/values" \
|
|
# counter 4
|
|
set val [mcreader getfield\
|
|
"/$mcversion/DMC_diff/dmc.xml/Det9/det9.dat/values"]
|
|
set l [split $val]
|
|
set a [lindex $l 0]
|
|
set b [lindex $val 2]
|
|
if {$b > .0} {
|
|
set hmScale [expr $b / $a]
|
|
set hmScale [expr $hmScale / 6.]
|
|
} else {
|
|
set hmScale 1e9
|
|
}
|
|
clientput "HM scale = $hmScale"
|
|
mcreader inserthm \
|
|
"/$mcversion/DMC_diff/dmc.xml/Det9/det9.dat/data" banana $hmScale
|
|
mcreader close
|
|
}
|
|
#-------------------------------------------------------------------------
|
|
proc dmcdump {pid} {
|
|
#--do nothing: progress is doing it for us
|
|
}
|
|
#--------------------------------------------------------------------------
|
|
mccontrol configure mcstart rundmcoptsim
|
|
mccontrol configure mccopydata copydmcdata
|
|
mccontrol configure update 30
|
|
mccontrol configure mcmonfile $home/monfile
|
|
mccontrol configure monitorscale [expr 1. /350]
|
|
mccontrol configure mcdump mcstasdump
|
|
#--------------------------------------------------------------------------
|
|
# A count command for VDMC
|
|
# All arguments are optional. The current values will be used if not
|
|
# specified
|
|
# Dr. Mark Koennecke, Juli 1997
|
|
#--------------------------------------------------------------------------
|
|
proc count { {mode NULL } { preset NULL } } {
|
|
starttime [sicstime]
|
|
catch {temperature log clear} msg
|
|
#----- deal with mode
|
|
set mode2 [string toupper $mode]
|
|
set mode3 [string trim $mode2]
|
|
set mc [string index $mode2 0]
|
|
if { [string compare $mc T] == 0 } {
|
|
banana CountMode Timer
|
|
} elseif { [string compare $mc M] == 0 } {
|
|
banana CountMode Monitor
|
|
}
|
|
#------ deal with preset
|
|
if { [string compare $preset NULL] != 0 } {
|
|
banana preset $preset
|
|
}
|
|
#------ prepare a count message
|
|
set a [banana preset]
|
|
set aa [SplitReply $a]
|
|
set b [banana CountMode]
|
|
set bb [SplitReply $b]
|
|
ClientPut [format " Starting counting in %s mode with a preset of %s" \
|
|
$bb $aa]
|
|
#------- count
|
|
banana InitVal 0
|
|
wait 1
|
|
hupdate /graphics/powder_diagram/counts
|
|
banana count
|
|
set ret [catch {Success} msg]
|
|
#------- StoreData
|
|
storedata
|
|
if { $ret != 0 } {
|
|
error [format "Counting ended with error"]
|
|
}
|
|
}
|
|
#---------------- Repeat -----------------------------------------------
|
|
proc repeat { num {mode NULL} {preset NULL} } {
|
|
for { set i 0 } { $i < $num } { incr i } {
|
|
set ret [catch {count $mode $preset} msg]
|
|
if {$ret != 0} {
|
|
error "Counting ended with error"
|
|
}
|
|
}
|
|
}
|
|
#--------------------------------------------------------------------------
|
|
proc GetNum { text } {
|
|
set list [split $text =]
|
|
return [lindex $list 1]
|
|
}
|
|
#------------------------------------------------------------------------
|
|
# This implements the wwwsics command which generates a listing of
|
|
# important experiment parameters in html format for the SICS WWW Status
|
|
# application. This version is for the powder diffractometers DMC and
|
|
# HRPT.
|
|
#
|
|
# Mark Koennecke, March 2000
|
|
#------------------------------------------------------------------------
|
|
proc wwwsics {} {
|
|
#----- get all the data we need
|
|
set user [GetNum [user]]
|
|
set sample [GetNum [sample]]
|
|
set tit [GetNum [title]]
|
|
set ret [catch {lambda} msg]
|
|
if {$ret != 0 } {
|
|
set lam Undetermined
|
|
} else {
|
|
set lam [GetNum $msg]
|
|
}
|
|
set ret [catch {temperature} msg]
|
|
if {$ret != 0 } {
|
|
set tem Undetermined
|
|
} else {
|
|
set tem [GetNum $msg]
|
|
}
|
|
set run [GetNum [sicsdatanumber]]
|
|
catch {incr run} msg
|
|
set stat [GetNum [status]]
|
|
#------- html format the reply
|
|
append result "<table BORDER=2>"
|
|
append result <tr> <th>Run Number</th> <td> $run </td> </tr>
|
|
append result <tr> <th>Title</th> <td> $tit </td> </tr>
|
|
append result <tr> <th>User</th> <td> $user </td> </tr>
|
|
append result <tr> <th>Sample </th> <td> $sample </td> </tr>
|
|
append result <tr> <th>wavelength</th> <td> $lam</td> </tr>
|
|
append result <tr> <th>Sample Temperature</th> <td> $tem</td> </tr>
|
|
append result <tr> <th>Status</th> <td> $stat</td> </tr>
|
|
append result </table>
|
|
return $result
|
|
}
|
|
#----------------------------------------------------------------------------
|
|
# wwpar formats a parameter for display in the WWW-control.
|
|
#
|
|
# Mark Koennecke, June 2000
|
|
#---------------------------------------------------------------------------
|
|
set ret [catch {wwwpar motor a4} msg]
|
|
if {$ret != 0} {
|
|
Publish wwwpar Spy
|
|
Publish wwwuser Spy
|
|
}
|
|
#--------------------------------------------------------------------------
|
|
proc WWWNum { text } {
|
|
set list [split $text =]
|
|
return [lindex $list 1]
|
|
}
|
|
#---------------------------------------------------------------------------
|
|
proc wwwpar {type mot} {
|
|
append txt $mot ,
|
|
#----- get lowerlimit, either from motor or temperature controller
|
|
if { [string compare $type motor] == 0} {
|
|
set ret [catch {$mot softlowerlim} msg]
|
|
} else {
|
|
set ret [catch {$mot lowerlimit} msg]
|
|
}
|
|
if {$ret != 0 } {
|
|
append txt UNKNOWN ,
|
|
} else {
|
|
append txt [WWWNum $msg] ,
|
|
}
|
|
#------- get value
|
|
set ret [catch {$mot} msg]
|
|
if {$ret == 0} {
|
|
append txt [WWWNum $msg] ,
|
|
} else {
|
|
append txt UNKNOWN ,
|
|
}
|
|
#----- get upperlimit, either from motor or temperature controller
|
|
if {[string compare $type motor] == 0} {
|
|
set ret [catch {$mot softupperlim} msg]
|
|
} else {
|
|
set ret [catch {$mot upperlimit} msg]
|
|
}
|
|
if {$ret != 0 } {
|
|
append txt UNKNOWN
|
|
} else {
|
|
append txt [WWWNum $msg]
|
|
}
|
|
return $txt
|
|
}
|
|
#------------- wwwuser formats user information into a html table
|
|
proc wwwuser {} {
|
|
lappend list title user email phone adress
|
|
append txt "<table>"
|
|
foreach e $list {
|
|
set ret [catch {$e} msg]
|
|
if {$ret == 0} {
|
|
set l [split $msg =]
|
|
append txt "<tr><th>" [lindex $l 0] "</th><td> \n"
|
|
append txt "<INPUT type=text name=[lindex $l 0] value=\"[lindex $l 1]\" "
|
|
append txt "\n LENGTH=40 MAXLENGTH=80></td></tr>\n "
|
|
}
|
|
}
|
|
return $txt
|
|
}
|
|
#------------- wwwfilefornumber returns the path to a data file for a
|
|
# number
|
|
proc wwwfilefornumber {num} {
|
|
return [makeSimForNum $num]
|
|
}
|
|
#-------------------------------------------------------------------
|
|
proc gethm {} {
|
|
banana uuget 0
|
|
}
|
|
#--------------------------------------------------------------------
|
|
proc hdbscan {scanvars scanstart scanincr np mode preset} {
|
|
xxxscan clear
|
|
xxxscan configure script
|
|
xxxscan function prepare hdbprepare
|
|
xxxscan function collect hdbcollect
|
|
set varlist [split $scanvars ,]
|
|
set startlist [split $scanstart ,]
|
|
set incrlist [split $scanincr ,]
|
|
set count 0
|
|
foreach var $varlist {
|
|
if {[string first / $var] >= 0} {
|
|
set var [string trim [SplitReply [hgetprop $var sicsdev]]]
|
|
}
|
|
xxxscan add $var [lindex $startlist $count] [lindex $incrlist $count]
|
|
incr count
|
|
}
|
|
set status [catch {xxxscan run $np $mode $preset} msg]
|
|
if {$status == 0} {
|
|
return $msg
|
|
} else {
|
|
error $msg
|
|
}
|
|
}
|
|
#------------------------------------------------------------------------------
|
|
proc hdbprepare {obj userdata } {
|
|
stdscan prepare $obj userdata
|
|
hupdate /graphics/scan_data/dim
|
|
}
|
|
#------------------------------------------------------------------------------
|
|
proc hdbcollect {obj userobj np} {
|
|
stdscan collect $obj $userobj $np
|
|
hupdate /graphics/scan_data/scan_variable
|
|
hupdate /graphics/scan_data/counts
|
|
}
|
|
#-----------------------------------------------------------------------------
|
|
proc gethdbscanvardata {no} {
|
|
set np [string trim [SplitReply [xxxscan np]]]
|
|
if {$np == 0} {
|
|
return ".0 .0 .0"
|
|
}
|
|
set status [catch {SplitReply [xxxscan getvardata $no]} txt]
|
|
if {$status == 0} {
|
|
return [join $txt]
|
|
} else {
|
|
return ".0 .0 .0"
|
|
}
|
|
}
|
|
#----------------------------------------------------------------------------
|
|
proc gethdbscancounts {} {
|
|
set np [string trim [SplitReply [xxxscan np]]]
|
|
if {$np == 0} {
|
|
return "0 0 0"
|
|
}
|
|
set status [catch {SplitReply [xxxscan getcounts]} txt]
|
|
if {$status == 0} {
|
|
return [join $txt]
|
|
} else {
|
|
return "0 0 0"
|
|
}
|
|
}
|
|
#================= helper to get the list of batch files =================
|
|
proc listbatchfiles {} {
|
|
set ext [list *.tcl *.job]
|
|
set txt [SplitReply [exe batchpath]]
|
|
set dirlist [split $txt :]
|
|
set txt [SplitReply [exe syspath]]
|
|
set dirlist [concat $dirlist [split $txt :]]
|
|
set result [list ""]
|
|
foreach dir $dirlist {
|
|
foreach e $ext {
|
|
set status [catch {glob [string trim $dir]/$e} filetxt]
|
|
if {$status == 0} {
|
|
set filelist [split $filetxt]
|
|
foreach f $filelist {
|
|
set nam [file tail $f]
|
|
if { [lsearch $result $nam] < 0} {
|
|
lappend result $nam
|
|
}
|
|
}
|
|
}
|
|
}
|
|
}
|
|
foreach bf $result {
|
|
append resulttxt $bf ,
|
|
}
|
|
return [string trim $resulttxt ,]
|
|
}
|
|
#-----------------------------------------------------------------------
|