move folder tasmad
r3086 | jgn | 2011-03-29 15:32:07 +1100 (Tue, 29 Mar 2011) | 1 line
This commit is contained in:
Jing Chen
committed by
Douglas Clowes
Douglas Clowes
parent
e92dce3948
commit
66e3096b24
348
site_ansto/instrument/tas/config/tasmad/taspub_sics/nxtas.tcl
Normal file
348
site_ansto/instrument/tas/config/tasmad/taspub_sics/nxtas.tcl
Normal file
@@ -0,0 +1,348 @@
|
||||
#-------------------------------------------------------------------------
|
||||
# Functions for writing NeXus files for a triple axis spectrometer and
|
||||
# configuration of the internal scan object to support this.
|
||||
#
|
||||
# Mark Koennecke, May 2005
|
||||
# reworked to new NeXus standards, Mark Koennecke, February 2007
|
||||
#-----------------------------------------------------------------------
|
||||
catch {sicsdatafactory new __transfer}
|
||||
set __tasdata(out) ""
|
||||
#----------------------------------------------------------------------
|
||||
proc appendMotor {np motor alias} {
|
||||
set val [tasSplit [$motor]]
|
||||
if { [string length $val] > 0} {
|
||||
__transfer putfloat 0 $val
|
||||
nxscript putslab $alias [list $np] [list 1] __transfer
|
||||
} else {
|
||||
clientput "WARNING: failed to read $motor"
|
||||
}
|
||||
}
|
||||
#------------------------------------------------------------------
|
||||
proc appendIfPresent {np obj alias} {
|
||||
# sea_get is defined in ~/sea/tcl/remob.tcl
|
||||
set status [catch {sea_get val $obj} msg]
|
||||
if {$status != 0} {
|
||||
return
|
||||
}
|
||||
if {$msg} {
|
||||
__transfer putfloat 0 $val
|
||||
nxscript putslab $alias [list $np] [list 1] __transfer
|
||||
}
|
||||
}
|
||||
#------------------------------------------------------------------
|
||||
proc appendFloat {np alias val} {
|
||||
if {[string length $val] > 0} {
|
||||
__transfer putfloat 0 $val
|
||||
nxscript putslab $alias [list $np] [list 1] __transfer
|
||||
} else {
|
||||
clientput "WARNING: failed to read $alias"
|
||||
}
|
||||
}
|
||||
#-------------------------------------------------------------------
|
||||
proc appendCount {np value alias} {
|
||||
__transfer putint 0 $value
|
||||
nxscript putslab $alias [list $np] [list 1] __transfer
|
||||
}
|
||||
#--------------------------------------------------------------------
|
||||
proc donothing {obj userobj} {
|
||||
}
|
||||
#---------------------------------------------------------------------
|
||||
proc xmlprepare {obj userobj} {
|
||||
global __tasdata
|
||||
#------- normal prepare
|
||||
tasscan prepare $obj $userobj
|
||||
|
||||
#--------- parse out variable
|
||||
set out [tasSplit [output]]
|
||||
if {[string compare [string toupper $out] "UNKNOWN"]==0} {
|
||||
set out ""
|
||||
}
|
||||
set out [string map { "=" " " "," " "} $out]
|
||||
set outlist [split $out]
|
||||
foreach var $outlist {
|
||||
if { [string length $var] > 1} {
|
||||
set ret [catch {tasSplit [$var]} msg]
|
||||
if {$ret == 0} {
|
||||
lappend __tasdata(out) $var
|
||||
}
|
||||
}
|
||||
}
|
||||
#------- build Header
|
||||
append head " PNT "
|
||||
set scanvars [split [tasSplit [iscan getscanvars]]]
|
||||
foreach var $scanvars {
|
||||
if { [string length $var] > 1} {
|
||||
append head [format "%9s " [string toupper $var]]
|
||||
}
|
||||
}
|
||||
foreach var $__tasdata(out) {
|
||||
append head [format "%9s " [string toupper $var]]
|
||||
}
|
||||
append head [format "%8s " M1]
|
||||
append head [format "%8s " M2]
|
||||
append head [format "%8s " TIME]
|
||||
append head [format "%8s " CNTS]
|
||||
append head [format "%8s " CTOT]
|
||||
clientput $head
|
||||
|
||||
set __tasdata(starttime) [sicstime]
|
||||
|
||||
xmltaswrite $obj $userobj
|
||||
}
|
||||
#--------------------------------------------------------------------
|
||||
proc xmlwritepoint {obj userobj np} {
|
||||
global __tasdata scripthome
|
||||
|
||||
nxscript reopen $__tasdata(file) $scripthome/tasub.dic
|
||||
|
||||
append line [format " %3d" $np]
|
||||
set scanvars [split [tasSplit [iscan getscanvars]]]
|
||||
foreach var $scanvars {
|
||||
if { [string length $var] > 1} {
|
||||
set val [tasSplit [eval $var]]
|
||||
append line [format "%9.4f " [tasSplit [$var]]]
|
||||
appendMotor $np $var sc_$var
|
||||
lappend storedvars $var
|
||||
}
|
||||
}
|
||||
foreach var $__tasdata(out) {
|
||||
append line [format "%9.4f " [tasSplit [eval $var]]]
|
||||
appendMotor $np $var sc_$var
|
||||
lappend storedvars $var
|
||||
|
||||
}
|
||||
|
||||
|
||||
append line [format "%8d " [tasSplit [counter getmonitor 1]]]
|
||||
append line [format "%8d " [tasSplit [counter getmonitor 2]]]
|
||||
append line [format "%8.2f " [tasSplit [counter gettime]]]
|
||||
append line [format "%8d " [tasSplit [counter getcounts]]]
|
||||
clientput $line
|
||||
|
||||
appendCount $np [tasSplit [counter getcounts]] counts
|
||||
appendCount $np [tasSplit [counter getmonitor 1]] cter_01
|
||||
appendCount $np [tasSplit [counter getcounts]] cter_02
|
||||
appendFloat $np motime [tasSplit [counter gettime]]
|
||||
|
||||
set varlist [list qh qk ql qm en ei ef a1 a2 a3 a4 a5 a6 sgu sgl]
|
||||
|
||||
foreach var $varlist {
|
||||
if {[lsearch $storedvars $var] < 0} {
|
||||
appendMotor $np $var sc_${var}
|
||||
}
|
||||
}
|
||||
|
||||
if {$np == 0} {
|
||||
makeTASLinks
|
||||
}
|
||||
|
||||
nxscript close
|
||||
}
|
||||
#====================== actual XML stuff ============================
|
||||
proc writeUserData {} {
|
||||
writeTextVar usnam user
|
||||
writeTextVar usaff affiliation
|
||||
writeTextVar usadd address
|
||||
writeTextVar usmail email
|
||||
writeTextVar lonam local
|
||||
}
|
||||
#-------------------------------------------------------------------
|
||||
proc writeMonochromator {} {
|
||||
global __tasdata
|
||||
nxscript puttext mono_type "Pyrolytic Graphite"
|
||||
appendMotor 0 mcv sc_mcv
|
||||
nxscript putfloat mono_dd [tasSplit [tasub mono dd]]
|
||||
}
|
||||
#-------------------------------------------------------------------
|
||||
proc writeAnalyzer {} {
|
||||
global __tasdata
|
||||
nxscript puttext ana_type "Pyrolytic Graphite"
|
||||
nxscript putfloat ana_dd [tasSplit [tasub ana dd]]
|
||||
set sa [tasSplit [tasub ss]]
|
||||
if {$sa == 1} {
|
||||
set az 0.
|
||||
} else {
|
||||
set az 180.
|
||||
}
|
||||
nxscript putfloat ana_az $az
|
||||
}
|
||||
#-------------------------------------------------------------------
|
||||
proc writeDetector {} {
|
||||
global __tasdata
|
||||
set sa [tasSplit [tasub ana ss]]
|
||||
if {$sa == 1} {
|
||||
set az 0.
|
||||
} else {
|
||||
set az 180.
|
||||
}
|
||||
nxscript putfloat det_az $az
|
||||
}
|
||||
#-------------------------------------------------------------------
|
||||
proc writeMonitor {} {
|
||||
nxscript putcounter cter counter
|
||||
}
|
||||
#-----------------------------------------------------------------
|
||||
proc writeSample {} {
|
||||
global __tasdata
|
||||
tasscan nxdump nxscript sa
|
||||
writeTextVar sanam sample
|
||||
set sa [tasSplit [tasub mono ss]]
|
||||
if {$sa == 1} {
|
||||
set az 0.
|
||||
} else {
|
||||
set az 180.
|
||||
}
|
||||
nxscript putfloat saaz $az
|
||||
}
|
||||
#-----------------------------------------------------------------
|
||||
proc writePowderSample {} {
|
||||
global __tasdata
|
||||
tasscan nxdump nxscript sa
|
||||
writeTextVar sanam sample
|
||||
set sa [tasSplit [tasub mono ss]]
|
||||
if {$sa == 1} {
|
||||
set az 0.
|
||||
} else {
|
||||
set az 180.
|
||||
}
|
||||
nxscript putfloat saaz $az
|
||||
}
|
||||
#------------------------------------------------------------------
|
||||
proc makeTASLinks {} {
|
||||
nxscript makelink dana sc_ei
|
||||
nxscript makelink dana sc_ef
|
||||
nxscript makelink dana sc_qh
|
||||
nxscript makelink dana sc_qk
|
||||
nxscript makelink dana sc_ql
|
||||
nxscript makelink dana sc_en
|
||||
nxscript makelink dana counts
|
||||
}
|
||||
#------------------------------------------------------------------
|
||||
proc makePowderLinks {} {
|
||||
nxscript makelink dana sc_ei
|
||||
nxscript makelink dana sc_ef
|
||||
nxscript makelink dana sc_qm
|
||||
nxscript makelink dana sc_en
|
||||
nxscript makelink dana counts
|
||||
}
|
||||
#-------------------------------------------------------------------
|
||||
proc makeScanLinks {} {
|
||||
set alreadyLinked [list sc_ei sc_ef sc_qh sc_qf sc_qk sc_en sc_qm]
|
||||
set nscan [tasSplit [iscan noscanvar]]
|
||||
set axis 0
|
||||
for {set i 0} {$i < $nscan} {incr i } {
|
||||
set varpar [iscan getvarpar $i]
|
||||
set l [split $varpar =]
|
||||
set var [lindex $l 0]
|
||||
set idx [string first . $var]
|
||||
set var [string range $var [expr $idx + 1] end]
|
||||
set alias [format "sc_%s" [string trim $var]]
|
||||
set testalias [string trim [tasSplit [nxscript isalias $alias]]]
|
||||
if {[lsearch $alreadyLinked $alias] < 0} {
|
||||
if {$testalias == 1} {
|
||||
nxscript makelink dana $alias
|
||||
}
|
||||
}
|
||||
if {$axis == 0} {
|
||||
set step [string trim [lindex $l 2]]
|
||||
if {abs($step) > .001} {
|
||||
if {$testalias == 1} {
|
||||
nxscript putattribute $alias axis 1
|
||||
set axis 1
|
||||
}
|
||||
}
|
||||
}
|
||||
}
|
||||
# if axis = 0 there is no alias; so we create something in here from the
|
||||
# scan data in iscan
|
||||
if {$axis == 0} {
|
||||
set data [tasSplit [iscan getvardata 0]]
|
||||
set count 0
|
||||
foreach e $data {
|
||||
set ar($count) [string trim $e]
|
||||
incr count
|
||||
}
|
||||
nxscript putarray danascanvar ar [llength $data]
|
||||
}
|
||||
}
|
||||
#--------------------------------------------------------------------
|
||||
proc xmltaswrite {obj userobj} {
|
||||
global home __tasdata
|
||||
|
||||
set fil [string trim [tasSplit [iscan getfile]]]
|
||||
nxscript createxml $fil $home/tasub.dic
|
||||
set __tasdata(file) $fil
|
||||
|
||||
writeTextVar etitle title
|
||||
nxscript puttext estart $__tasdata(starttime)
|
||||
nxscript puttext eend [sicstime]
|
||||
nxscript puttext edef NXmonotas
|
||||
nxscript putglobal file_name $fil
|
||||
nxscript putglobal file_time [sicstime]
|
||||
|
||||
nxscript updatedictvar NP [tasSplit [iscan np]]
|
||||
nxscript updatedictvar INSTRUMENT [tasSplit [instrument]]
|
||||
|
||||
writeUserData
|
||||
|
||||
writeMonochromator
|
||||
|
||||
writeMonitor
|
||||
|
||||
writeSample
|
||||
|
||||
writeAnalyzer
|
||||
|
||||
writeDetector
|
||||
|
||||
|
||||
nxscript close
|
||||
}
|
||||
#--------------------------------------------------------------------
|
||||
proc xmlpowderwrite {obj userobj} {
|
||||
global home __tasdata
|
||||
|
||||
set fil [string trim [tasSplit [iscan getfile]]]
|
||||
nxscript createxml $fil $home/tasub.dic
|
||||
set __tasData(file) $fil
|
||||
|
||||
writeTextVar etitle title
|
||||
nxscript puttext estart $__tasdata(starttime)
|
||||
nxscript puttext eend [sicstime]
|
||||
nxscript puttext edef NXmonotas
|
||||
nxscript putglobal file_name $fil
|
||||
nxscript putglobal file_time [sicstime]
|
||||
|
||||
nxscript updatedictvar NP [tasSplit [iscan np]]
|
||||
nxscript updatedictvar INSTRUMENT [tasSplit [instrument]]
|
||||
|
||||
writeUserData
|
||||
|
||||
writeMonochromator
|
||||
|
||||
writeMonitor
|
||||
|
||||
writePowderSample
|
||||
|
||||
writeAnalyzer
|
||||
|
||||
writeDetector
|
||||
|
||||
makePowderLinks
|
||||
|
||||
nxscript close
|
||||
}
|
||||
#--------------------------------------------------------------------
|
||||
proc xmlfinish {obj userobj} {
|
||||
}
|
||||
#----------------------------------------------------------------------
|
||||
proc initxmlscan {} {
|
||||
iscan configure script
|
||||
iscan function writeheader donothing
|
||||
iscan function prepare xmlprepare
|
||||
iscan function drive tasscan drive
|
||||
iscan function count tasscan count
|
||||
iscan function collect tasscan collect
|
||||
iscan function writepoint xmlwritepoint
|
||||
iscan function finish xmlfinish
|
||||
}
|
||||
Reference in New Issue
Block a user