Changeset 236

Timestamp:

Dec 4, 2009 5:02:40 PM (14 years ago)

Author:

toby

Message:

# on 2000/07/20 22:09:56, toby did:
Add odf (spherical harmonic) support
move March-Dollase support here from orient

File:

• trunk/readexp.tcl (modified) (4 diffs, 3 props)

trunk/readexp.tcl

@@ -387 +387 @@
 #     celldamp  -- damping for the unit cell refinement (*)
 #     spacegroup -- space group symbol
+#     ODForder -- spherical harmonic order (*)
+#     ODFsym   -- sample symmetry (0-3) (*)
+#     ODFdampA -- damping for angles (*)
+#     ODFdampC -- damping for coefficients (*)
+#     ODFomega -- omega oriention angle (*)
+#     ODFchi -- chi oriention angle (*)
+#     ODFphi -- phi oriention angle (*)
+#     ODFomegaRef -- refinement flag for omega (*)
+#     ODFchiRef -- refinement flag for chi (*)
+#     ODFphiRef -- refinement flag for phi (*)
+#     ODFterms -- a list of the {l m n} values for each ODF term (*)
+#     ODFcoefXXX -- the ODF coefficient for for ODF term XXX (*)
+#     ODFRefcoef -- refinement flag for ODF terms (*)
 #  action: get (default) or set
 #  value: used only with set
 #  * =>  read+write supported
 proc phaseinfo {phase parm "action get" "value {}"} {
-    switch ${parm}-$action {
+    switch -glob ${parm}-$action {
 
         name-get {
@@ -474 +487 @@
         }
 
+        ODForder-get {
+            set val [string trim [string range [readexp "CRS$phase  ODF"] 0 4]]
+            if {$val == " "} {return 0}
+            return $val
+        }
+        ODForder-set {
+            if ![validint value 5] {return 0}
+            setexp "CRS$phase  ODF" $value 1 5
+        }
+        ODFsym-get {
+            set val [string trim [string range [readexp "CRS$phase  ODF"] 10 14]]
+            if {$val == " "} {return 0}
+            return $val
+        }
+        ODFsym-set {
+            if ![validint value 5] {return 0}
+            setexp "CRS$phase  ODF" $value 11 5
+        }
+        ODFdampA-get {
+            set val [string range [readexp "CRS$phase  ODF"] 24 24]
+            if {$val == " "} {return 0}
+            return $val
+        }
+        ODFdampA-set {
+            setexp "CRS$phase  ODF" $value 25 1
+        }
+        ODFdampC-get {
+            set val [string range [readexp "CRS$phase  ODF"] 29 29]
+            if {$val == " "} {return 0}
+            return $val
+        }
+        ODFdampC-set {
+            setexp "CRS$phase  ODF" $value 30 1
+        }
+        ODFomegaRef-get {
+            if {[string toupper [string range [readexp "CRS$phase  ODF"] 16 16]] == "Y"} {
+                return 1
+            }
+            return 0
+        }
+        ODFomegaRef-set {
+            if $value {
+                setexp "CRS$phase  ODF" "Y" 17 1
+            } else {
+                setexp "CRS$phase  ODF" "N" 17 1
+            }       
+        }
+        ODFchiRef-get {
+            if {[string toupper [string range [readexp "CRS$phase  ODF"] 17 17]] == "Y"} {
+                return 1
+            }
+            return 0
+        }
+        ODFchiRef-set {
+            if $value {
+                setexp "CRS$phase  ODF" "Y" 18 1
+            } else {
+                setexp "CRS$phase  ODF" "N" 18 1
+            }       
+        }
+        ODFphiRef-get {
+            if {[string toupper [string range [readexp "CRS$phase  ODF"] 18 18]] == "Y"} {
+                return 1
+            }
+            return 0
+        }
+        ODFphiRef-set {
+            if $value {
+                setexp "CRS$phase  ODF" "Y" 19 1
+            } else {
+                setexp "CRS$phase  ODF" "N" 19 1
+            }       
+        }
+        ODFcoef*-get {
+            regsub ODFcoef $parm {} term
+            set k [expr ($term+5)/6]
+            if {$k <= 9} {set k " $k"}
+            set j [expr (($term-1) % 6)+1]
+            set lineB [readexp "CRS$phase  ODF${k}B"]
+            set j0 [expr  ($j-1) *10]
+            set j1 [expr $j0 + 9]
+            set val [string trim [string range $lineB $j0 $j1]]
+            if {$val == ""} {return 0.0}
+            return $val
+        }
+        ODFcoef*-set {
+            regsub ODFcoef $parm {} term
+            if ![validreal value 10 3] {return 0}
+            set k [expr ($term+5)/6]
+            if {$k <= 9} {set k " $k"}
+            set j [expr (($term-1) % 6)+1]
+            set col [expr  ($j-1)*10 + 1]
+            setexp "CRS$phase  ODF${k}B" $value $col 10
+        }
+        ODFRefcoef-get {
+            if {[string toupper [string range [readexp "CRS$phase  ODF"] 19 19]] == "Y"} {
+                return 1
+            }
+            return 0
+        }
+        ODFRefcoef-set {
+            if $value {
+                setexp "CRS$phase  ODF" "Y" 20 1
+            } else {
+                setexp "CRS$phase  ODF" "N" 20 1
+            }       
+        }
+        ODFomega-get {
+           return [string trim [string range [readexp "CRS$phase  ODF"] 30 39]]
+        }
+        ODFchi-get {
+           return [string trim [string range [readexp "CRS$phase  ODF"] 40 49]]
+        }
+        ODFphi-get {
+           return [string trim [string range [readexp "CRS$phase  ODF"] 50 59]]
+        }
+        ODFomega-set {
+            if ![validreal value 10 4] {return 0}
+            setexp "CRS$phase  ODF" $value 31 10
+        }
+        ODFchi-set {
+            if ![validreal value 10 4] {return 0}
+            setexp "CRS$phase  ODF" $value 41 10
+        }
+        ODFphi-set {
+            if ![validreal value 10 4] {return 0}
+            setexp "CRS$phase  ODF" $value 51 10
+        }
+
+        ODFterms-get {
+            set vallist {}
+            set val [string trim [string range [readexp "CRS$phase  ODF"] 5 9]]
+            for {set i 1} {$i <= $val} {incr i 6} {
+                set k [expr 1+($i-1)/6]
+                if {$k <= 9} {set k " $k"}
+                set lineA [readexp "CRS$phase  ODF${k}A"]
+                set k 0
+                for {set j $i} {$j <= $val && $j < $i+6} {incr j} {
+                    set j0 [expr ($k)*10]
+                    set j1 [expr $j0 + 9]
+                    lappend vallist [string trim [string range $lineA $j0 $j1]]
+                    incr k
+                }
+            }
+            return $vallist
+        }
+        ODFterms-set {
+            set key "CRS$phase  ODF   "
+            if {![existsexp $key]} {
+                makeexprec $key
+                set oldlen 0
+            } else {
+                set oldlen [string trim [string range [readexp $key] 5 9]]
+            }
+            set len [llength $value]
+            if ![validint len 5] {return 0}
+            setexp $key $len 6 5
+            set j 0
+            set k 0
+            foreach item $value {
+                incr j
+                if {$j % 6 == 1} {
+                    incr k
+                    if {$k <= 9} {set k " $k"}
+                    set col 1
+                    set keyA "CRS$phase  ODF${k}A"
+                    set keyB "CRS$phase  ODF${k}B"
+                    if {![existsexp $keyA]} {
+                        makeexprec $keyA
+                        makeexprec $keyB
+                    }
+                }
+                set col1 [expr $col + 1]
+                foreach n [lrange $item 0 2] {
+                    if ![validint n 3] {return 0}
+                    setexp $keyA $n $col1 3
+                    incr col1 3
+                }
+                incr col 10
+            }
+            for {incr j} {$j <= $oldlen} {incr j} {
+                if {$j % 6 == 1} {
+                    incr k
+                    if {$k <= 9} {set k " $k"}
+                    set col 1
+                    set keyA "CRS$phase  ODF${k}A"
+                    set keyB "CRS$phase  ODF${k}B"
+                    delexp $keyA
+                    delexp $keyB
+                }
+                if {[existsexp $keyA]} {
+                    setexp $keyA "          " $col 10
+                    setexp $keyB "          " $col 10
+                }
+                incr col 10
+            }
+        }
+
         default {
             set msg "Unsupported phaseinfo access: parm=$parm action=$action"
             tk_dialog .badexp "Error in EXP" $msg error 0 Exit 
-            destroy .
+#           destroy .
         }
     }
     return 1
 }
+
 
 # get atom information: atominfo phase atom parm action value
@@ -1552 +1764 @@
             set msg "Unsupported constrinfo access: type=$type action=$action"
             tk_dialog .badexp "Error in EXP access" $msg error 0 OK
-#           destroy .
         }
 
@@ -1614 +1825 @@
             tk_dialog .badexp "Code Error" $msg error 0 Exit 
         }
+    }
+}
+
+# get March-Dollase preferred orientation information
+# use MDprefinfo hist phase axis-number parm action value
+#    ratio    -- ratio of xtallites in PO direction vs random (>1 for more)
+#    fraction -- fraction in this direction, when more than one axis is used
+#    h k & l  -- indices of P.O. axis
+#    ratioref -- flag to vary ratio
+#    fracref  -- flag to vary fraction
+#    damp     -- damping value
+#    type     -- model type (0 = P.O. _|_ to beam, 1 = || to beam)
+#    new      -- creates a new record with default values (set only)
+proc MDprefinfo {histlist phaselist axislist parm "action get" "value {}"} {
+    foreach phase $phaselist hist $histlist axis $axislist {
+        if {$phase == ""} {set phase [lindex $phaselist end]}
+        if {$hist == ""} {set hist [lindex $histlist end]}
+        if {$axis == ""} {set axis [lindex $axislist end]}
+        if {$hist < 10} {
+            set hist " $hist"
+        }
+        if {$axis > 9} {
+            set axis "0"
+        }
+        set key "HAP${phase}${hist}PREFO${axis}"
+        switch -glob ${parm}-$action {
+            ratio-get {
+                return [string trim [string range [readexp $key] 0 9]]
+            }
+            ratio-set {
+                if ![validreal value 10 6] {return 0}
+                setexp $key $value 1 10
+            }
+            fraction-get {
+                return [string trim [string range [readexp $key] 10 19]]
+            }
+            fraction-set {
+                if ![validreal value 10 6] {return 0}
+                setexp $key $value 11 10
+            }
+            h-get {
+                set h [string trim [string range [readexp $key] 20 29]]
+                # why not allow negative h values?
+                #               if {$h < 1} {return 0}
+                return $h
+            }
+            h-set {
+                if ![validreal value 10 2] {return 0}
+                setexp $key $value 21 10
+            }
+            k-get {
+                set k [string trim [string range [readexp $key] 30 39]]
+                #               if {$k < 1} {return 0} 
+                return $k
+            }
+            k-set {
+                if ![validreal value 10 2] {return 0}
+                setexp $key $value 31 10
+            }
+            l-get {
+                set l [string trim [string range [readexp $key] 40 49]]
+                #if {$l < 1} {return 0}
+                return $l
+            }
+            l-set {
+                if ![validreal value 10 2] {return 0}
+                setexp $key $value 41 10
+            }
+            ratioref-get {
+                if {[string toupper \
+                        [string range [readexp $key] 53 53]] == "Y"} {
+                    return 1
+                }
+                return 0
+            }
+            ratioref-set {
+                if $value {
+                    setexp $key "Y" 54 1
+                } else {
+                    setexp $key "N" 54 1
+                }
+            }
+            fracref-get {
+                if {[string toupper \
+                        [string range [readexp $key] 54 54]] == "Y"} {
+                    return 1
+                }
+                return 0
+            }
+            fracref-set {
+                if $value {
+                    setexp $key "Y" 55 1
+                } else {
+                    setexp $key "N" 55 1
+              }
+            }
+            damp-get {
+                set val [string trim [string range [readexp $key] 59 59]]
+                if {$val == " "} {return 0}
+                return $val
+            }
+            damp-set {
+                setexp $key $value 60 1
+            }
+            type-get {
+                set val [string trim [string range [readexp $key] 64 64]]
+                if {$val == " "} {return 0}
+                return $val
+            }
+            type-set {
+                # only valid settings are 0 & 1
+                if {$value != "0" && $value != "1"} {set value "0"}
+                setexp $key $value 65 1
+            }
+            new-set {
+                makeexprec $key
+                setexp $key \
+                        {  1.000000  1.000000  0.000000  0.000000  1.000000   NN    0    0} \
+                        1 68
+            }
+            default {
+                set msg "Unsupported MDprefinfo access: parm=$parm action=$action"
+                tk_dialog .badexp "Error in EXP" $msg error 0 Exit 
+                destroy .
+            }
+
+        }
+
     }
 }