- Adding first working version of the McStas SICS connection to cvs

SKIPPED: psi/polterwrite.c
2005-06-22 07:09:59 +00:00
parent 734577e394
commit ef6c04e6b8
42 changed files with 3268 additions and 18 deletions
--- a/mcstas/dmc/nxdmc.tcl
+++ b/mcstas/dmc/nxdmc.tcl
@ -0,0 +1,108 @@
+#--------------------------------------------------------------------------
+# NeXus file writing for DMC
+#
+# This is the scripted version using nxscript
+#
+# Mark Koennecke, May 2004
+#---------------------------------------------------------------------------
+
+proc storeMonochromator {} {
+    nxscript puttext mname "Pyrolithic Graphite 002"
+    writeFloatVar mtheta OmegaM
+    writeFloatVar mttheta TwoThetaM
+    writeFloatVar mlambda lambda
+    writeFloatVar mcurve  CurveM
+    writeFloatVar monox MonoX
+    writeFloatVar monoy MonoY
+    writeFloatVar mchi MonoChi
+    writeFloatVar mphi MonoPhi
+    set dd [SplitReply [mono dd]]
+    set dd [string trim $dd]
+    set ret [catch {expr $dd * 1.0} msg]
+    if {$ret != 0} {
+	clientput "ERROR: failed to read monochromator d spacing"
+    } else {
+	nxscript putfloat mdd $dd
+    }
+}
+#------------------------------------------------------------------------
+proc storeSample {} {
+     writeTextVar saname sample
+     writeFloatVar saangle Table
+     set ret [catch {set temp [SplitReply [temperature]]} msg]
+     if {$ret == 0} {
+	 nxscript putfloat stemp $temp
+         set dname [string trim [SplitReply [temperature driver]]]
+         if {"$dname" == "tecs"} {
+           set dname [SplitReply [temperature device]]
+         }
+         nxscript puttext devname $dname 
+	 set ret [catch {temperature log getmean} msg]
+	 if {$ret == 0} {
+	     set l [split $msg =]
+	     set stddev [string trim [lindex $l 2]]
+	     set l2 [split [string trim [lindex $l 1]]]
+	     set mean [string trim [lindex $l2 0]]
+	     nxscript putfloat smean $mean
+	     nxscript putfloat stddev $stddev
+	 }
+     }
+     writeFloatVar smur sample_mur
+     set ret [catch {set mtemp [SplitReply [magfield]]} msg]
+     if {$ret == 0} {
+	nxscript putfloat mfield $mtemp
+     }
+}
+#---------------------------------------------------------------------
+proc storeDetector {ndet stepwidth} {
+    nxscript udpatedictvar noofdetectors $ndet
+    set start [string trim [SplitReply [TwoThetaD]]]
+    for {set i 0} { $i < $ndet} {incr i} {
+	set th($i) [expr $start + $i * $stepwidth]
+    }
+    nxscript putfloat dthst $start
+    nxscript putfloat dtstep $stepwidth
+    nxscript putint dtnstep [string trim $ndet]
+    nxscript putarray dtheta th 400
+    nxscript puthm dcounts banana
+}
+#----------------------------------------------------------------------
+proc makeLinks {} {
+    nxscript makelink dana dcounts
+    nxscript makelink dana dtheta
+    nxscript makelink dana dthst
+    nxscript makelink dana dtstep
+    nxscript makelink dana dtnstep
+    nxscript makelink dana mlambda
+ }
+#-------------------------------------------------------------------------
+# store DMC data
+#-------------------------------------------------------------------------
+proc storedata {} {
+    global home
+    set fil [newFileName]
+    clientput "Opening $fil for writing"
+    nxscript create4 $fil $home/dmc.dic
+
+    writeStandardAttributes $fil
+    writeTextVar etitle title
+    nxscript puttext estart [sicstime]
+    nxscript puttext iname "DMC at SINQ"
+    nxscript puttext sname "SINQ"
+    nxscript puttext stype "Continuous flux spallation source"
+
+    nxscript updatedictvar inst DMC
+    nxscript updatedictvar detector "DMC-BF3-Detector"
+    
+    storeMonochromator
+
+    storeSample
+
+    nxscript putcounter cter counter
+    
+    storeDetector 400 .2
+
+    makeLinks
+
+    nxscript close
+}