185 lines
5.3 KiB
Tcl
185 lines
5.3 KiB
Tcl
#---------------------------------------------------------------
|
|
# This is for testing the new coordinated single crystal stuff
|
|
# for SICS.
|
|
#
|
|
# Mark Koennecke, July - August 2008
|
|
#---------------------------------------------------------------
|
|
puts stdout "Testing Four Circle Codes"
|
|
|
|
set testub ".1215666 -.138694 -.0021278 -.1386887 -.1216454 .0010515 -.0049867 .0020612 -.081156"
|
|
set testcell "5.4202 5.4202 12.3228 90. 90. 90."
|
|
singlex mode bi
|
|
|
|
#---------------------------------------------------------------
|
|
proc testReflection {ref} {
|
|
drive h [lindex $ref 0] k [lindex $ref 1] l [lindex $ref 2]
|
|
set stt [SICSValue a4]
|
|
compareValue $stt [lindex $ref 3]
|
|
set om [SICSValue a3]
|
|
compareValue $om [lindex $ref 4]
|
|
set chi [SICSValue chi]
|
|
compareValue $chi [lindex $ref 5]
|
|
set phi [SICSValue phi]
|
|
compareValue $phi [lindex $ref 6]
|
|
}
|
|
#--------------------------------------------------------------
|
|
proc testAng {ref} {
|
|
set stt [SICSValue a4]
|
|
compareValue $stt [lindex $ref 0]
|
|
set om [SICSValue a3]
|
|
compareValue $om [lindex $ref 1]
|
|
set chi [SICSValue chi]
|
|
compareValue $chi [lindex $ref 2]
|
|
set phi [SICSValue phi]
|
|
compareValue $phi [lindex $ref 3]
|
|
}
|
|
#======================= Tests =================================
|
|
test singlex-1.0 {Testing Setting Lambda} -body {
|
|
testPar "singlex lambda" 1.1785 User
|
|
return OK
|
|
} -result OK
|
|
|
|
test singlex-1.1 {Testing Mode Setting} -body {
|
|
testPar "singlex mode" bi User
|
|
testPar "singlex mode" nb User
|
|
testPar "singlex mode" tas User
|
|
set test [catch {singlex mode shitty} msg]
|
|
if {$test == 0} {
|
|
if {[string first ERROR $msg] < 0} {
|
|
error "Test for shitty mode failed"
|
|
}
|
|
}
|
|
return OK
|
|
} -result OK
|
|
|
|
test singlex-1.2 {Testing Setting Cell} -body {
|
|
testMultiPar "singlex cell" $testcell User
|
|
return OK
|
|
} -result OK
|
|
|
|
test singlex-1.3 {Testing Setting UB} -body {
|
|
testMultiPar "singlex ub" $testub User
|
|
return OK
|
|
} -result OK
|
|
|
|
config rights User User
|
|
singlex ub $testub
|
|
singlex lambda 1.178
|
|
|
|
test singlex-1.4 {Driving Reflection} -body {
|
|
set ref [list 2 2 0 35.80 17.90 180.6425 86.229]
|
|
testReflection $ref
|
|
return OK
|
|
} -result OK
|
|
|
|
test singlex-1.5 {Driving Reflection though hkl} -body {
|
|
hkl drive 2 2 0
|
|
set ref [list 35.80 17.90 180.6425 86.229]
|
|
testAng $ref
|
|
return OK
|
|
} -result OK
|
|
|
|
|
|
test singlex-1.6 {UB Calculation, 2 Reflections, Cell} -body {
|
|
singlex cell $testcell
|
|
ref clear
|
|
ref addax 2 2 0 35.80 17.90 180.642 86.229
|
|
ref addax 0 0 3 16.498 8.249 268.331 333.714
|
|
ubcalc ub2ref 0000 0001
|
|
ubcalc activate
|
|
set ubr [SICSValue "singlex ub"]
|
|
compareMultiValue $ubr $testub
|
|
return OK
|
|
} -result OK
|
|
|
|
test singlex-1.7 {UB Calculation, 3 Reflections} -body {
|
|
ref clear
|
|
ref addax 2 2 0 35.80 17.90 180.642 86.229
|
|
ref addax 0 0 3 16.498 8.249 268.331 333.714
|
|
ref addax 1 0 0 12.478 6.239 181.549 131.232
|
|
ubcalc ub3ref 0000 0001 0002
|
|
ubcalc activate
|
|
set ubr [SICSValue "singlex ub"]
|
|
compareMultiValue $ubr $testub
|
|
return OK
|
|
} -result OK
|
|
|
|
test singlex-1.8 {Cell from UB} -body {
|
|
ref clear
|
|
ref addax 2 2 0 35.80 17.90 180.642 86.229
|
|
ref addax 0 0 3 16.498 8.249 268.331 333.714
|
|
ref addax 1 0 0 12.478 6.239 181.549 131.232
|
|
ubcalc ub3ref 0000 0001 0002
|
|
set cell [ubcalc cellub]
|
|
compareMultiValue $cell $testcell .03
|
|
return OK
|
|
} -result OK
|
|
|
|
#-------------------------------------------------------------
|
|
# more tests for NB mode
|
|
#-------------------------------------------------------------
|
|
config rights Mugger Mugger
|
|
singlex mode nb
|
|
config rights User User
|
|
|
|
singlex ub 0.0228379 0.0773564 0.0476423 -0.1007840 0.0437923 0.0051331 -0.0213284 -0.0568516 0.0940093
|
|
set testub "0.0228379 0.0773564 0.0476423 -0.1007840 0.0437923 0.0051331 -0.0213284 -0.0568516 0.0940093"
|
|
singlex cell 9.663 9.663 9.663 81.496 81.496 81.496
|
|
ref clear
|
|
ref addax 1 -2 -1 17.889732 -123.9175 -0.1104
|
|
ref addax 1 1 1 10.621792 -14.005692 0.804147
|
|
ref addax -1 2 1 17.8897 56.069 -.154
|
|
|
|
proc testNBReflection {ref} {
|
|
drive h [lindex $ref 0] k [lindex $ref 1] l [lindex $ref 2]
|
|
set stt [SICSValue a4]
|
|
compareValue $stt [lindex $ref 3]
|
|
set om [SICSValue a3]
|
|
compareValue $om [lindex $ref 4]
|
|
set nu [SICSValue nu]
|
|
compareValue $nu [lindex $ref 5]
|
|
}
|
|
#--------------------------------------------------------------
|
|
proc testNBAng {ref} {
|
|
set stt [SICSValue a4]
|
|
compareValue $stt [lindex $ref 0]
|
|
set om [SICSValue a3]
|
|
compareValue $om [lindex $ref 1]
|
|
set nu [SICSValue nu]
|
|
compareValue $nu [lindex $ref 2]
|
|
}
|
|
|
|
test singlex-1.9 {Driving NB Reflection} -body {
|
|
set ref [list 1 -2 -1 17.889 -123.9175 -0.1104]
|
|
testNBReflection $ref
|
|
return OK
|
|
} -result OK
|
|
|
|
|
|
test singlex-1.10 {Driving NB- Reflection though hkl} -body {
|
|
hkl drive 1 -2 -1
|
|
set ref [list 17.889 -123.9175 -0.1104]
|
|
testNBAng $ref
|
|
return OK
|
|
} -result OK
|
|
|
|
test singlex-1.11 {UB Calculation,NB, 2 Reflections, Cell} -body {
|
|
ubcalc ub2ref 0000 0001
|
|
ubcalc activate
|
|
set ubr [SICSValue "singlex ub"]
|
|
compareMultiValue $ubr $testub
|
|
return OK
|
|
} -result OK
|
|
|
|
test singlex-1.12 {UB Calculation,NB, 3 Reflections} -body {
|
|
ubcalc ub3ref 0000 0001 0002
|
|
ubcalc activate
|
|
set ubr [SICSValue "singlex ub"]
|
|
compareMultiValue $ubr $testub
|
|
return OK
|
|
} -result OK
|
|
|
|
config rights Mugger Mugger
|
|
singlex mode bi
|
|
config rights User User
|