Changeset 1213

Timestamp:

Aug 16, 2012 11:44:38 PM (10 years ago)

Author:

toby

Message:

routine for chemical restraint added (ChemConst?)

File:

• branches/sandbox/readexp.tcl (modified) (1 diff)

branches/sandbox/readexp.tcl

@@ -3589 +3589 @@
         default {
             set msg "Unsupported phaseinfo access: parm=$parm action=$action"
+            tk_dialog .badexp "Error in readexp" $msg error 0 Exit 
+        }
+    return 1
+    }
+}
+
+# read/edit chemical restraint info
+#  parm:
+#    weight -- histogram weight (factr) * 
+#    restraintlist -- list of restraints *
+#  action: get (default) or set
+#  value: used only with set
+#      value is a list of constraints
+#      each constrain contains {sum esd cons1 cons2...}
+#      each consN contains {phase atomnum multiplier}
+#  * =>  read+write supported 
+# Examples:
+#
+#ChemConst restraintlist set { {10 1.1 {1 1 2} {2 2 3}} {0 1 {1 1 1} {1 2 -2}} }
+#
+#ChemConst restraintlist get
+#{10.00000 1.10000 {1 1 2.00000} {2 2 3.00000}} {0.00000 1.00000 {1 1 1.00000} {1 2 -2.00000}}
+# constraint one 2*(1:1) + 3*(2:2) = 10(1.1)
+# constraint two 1*(1:1) - 2*(1:2) = 0(1)
+#   where (1:2) is the total number of atoms (multiplicity*occupancy) for atom 2 in phase 1
+
+proc ChemConst {parm "action get" "value {}"} {
+    set HST {}
+    # look for CMP record
+    set n 0
+    for {set i 0} {$i < $::expmap(nhst)} {incr i} {
+        set ihist [expr {$i + 1}]
+        if {[expr {$i % 12}] == 0} {
+            incr n
+            set line [readexp " EXPR  HTYP$n"]
+            if {$line == ""} {
+                set msg "No HTYP$n entry for Histogram $ihist. This is an invalid .EXP file"
+                tk_dialog .badexp "Error in readexp" $msg error 0 Exit 
+            }
+            set j 0
+        } else {
+            incr j
+        }
+        if {[string range $line [expr 2+5*$j] [expr 5*($j+1)]] == "CMP "} {
+            set HST $ihist
+        }
+    }
+    if {$HST <=9} {
+        set key "HST  $HST"
+    } else {
+        set key "HST $HST"
+    }
+    if {$HST == "" && $action == "set"} {
+        # no CMP found need to add the soft constr. histogram
+        # increment number of histograms
+        set hst [string trim [string range [readexp { EXPR  NHST }] 0 4]]
+        incr hst
+        set HST $hst
+        if ![validint hst 5] {return 0}
+        setexp  { EXPR  NHST } $hst 1 5
+        # add to EXPR HTYPx rec, creating if needed 
+        set n [expr { 1+ (($HST - 1) / 12) }]
+        set key " EXPR  HTYP$n"
+        if {[array names ::exparray $key] == ""} {
+            makeexprec $key
+        }
+        setexp $key "CMP " [expr 3 + 5*(($HST-1) % 12)] 5
+        # create other HST  xx recs
+        if {$HST <=9} {
+            set key "HST  $HST"
+        } else {
+            set key "HST $HST"
+        }
+        makeexprec "$key  HNAM"
+        setexp "$key  HNAM" "Chemical composition restraints" 3 31
+        makeexprec "$key FACTR"
+#       makeexprec "$key NBNDS"
+        makeexprec "$key NCMPS"
+        mapexp
+    } elseif {$HST == ""} {
+        if $::expgui(debug) {puts "no restraints"}
+        return "1"
+    }
+
+    switch -glob ${parm}-$action {
+        weight-get {
+            return [string trim [string range [readexp "$key FACTR"] 0 14]]
+        }
+        weight-set {
+            # update FACTR
+            if ![validreal value 15 6] {return 0}
+            setexp "$key FACTR" $value 1 15
+        }
+        restraintlist-get {
+            set ncons [string trim [string range [readexp "$key NCMPS"] 0 4]]
+            set conslist {}
+            for {set i 1} {$i <= $ncons} {incr i} {
+                set const {}
+                set line [readexp "${key} CM$i  "]
+                # number of terms
+                set nterm [string trim [string range $line 0 4]]
+                if {$nterm == ""} {set nterm 0}
+                # chemical sum and esd
+                lappend const [string trim [string range $line 5 14]]
+                lappend const [string trim [string range $line 15 24]]
+                for {set j 1} {$j <= $nterm} {incr j} {
+                    set n [expr {($j + 2)/3}]
+                    set o1 [expr {20*(($j-1)%3)}]
+                    set o2 [expr {19 + 20*(($j-1)%3)}]
+                    validint n 2
+                    if {$o1 == 0} {
+                        set line [readexp "${key} CM${i}${n}"]
+                    }
+                    set frag [string range $line $o1 $o2]                    
+                    lappend const [list \
+                                       [string trim [string range $frag 0 4]] \
+                                       [string trim [string range $frag 5 9]] \
+                                       [string trim [string range $frag 10 19]] \
+                                   ]
+                }
+                lappend conslist $const
+            }
+            return $conslist
+        }
+        restraintlist-set {
+            set num [llength $value]
+            if ![validint num 5] {return 0}
+            setexp "$key NCMPS" $num 1 5
+            # delete all old records
+            foreach i [array names ::exparray "${key} CM*"] {
+                unset ::exparray($i)
+            }
+            set i 0
+            foreach cons $value {
+                incr i
+                set sum [lindex $cons 0]
+                set esd [lindex $cons 1]
+                set terms [lrange $cons 2 end]
+                set nterms [llength $terms]
+                validint nterms 5
+                validreal sum 10 5
+                validreal esd 10 5
+                makeexprec "${key} CM$i  " 
+                setexp "${key} CM$i  " "${nterms}${sum}${esd}" 1 25
+                set j 0
+                set str {}
+                foreach term $terms {
+                    incr j
+                    set n [expr {($j + 2)/3}]
+                    validint n 2
+                    foreach {phase atom mult} $term {}
+                    validint phase 5
+                    validint atom 5
+                    validreal mult 10 5
+                    append str "${phase}${atom}${mult}"
+                    if {[expr {$j%3}] == 0} {
+                        #puts [readexp "${key} CM${i}${n}"]
+                        makeexprec "${key} CM${i}${n}"
+                        setexp "${key} CM${i}${n}" $str 1 60
+                        set str {}
+                    }
+                }
+                if {[string length $str] > 0} {
+                    makeexprec "${key} CM${i}${n}"
+                    setexp "${key} CM${i}${n}" $str 1 60
+                }
+            }
+        }
+        default {
+            set msg "Unsupported phaseinfo access: parm=$parm action=$action"
+            puts $msg
             tk_dialog .badexp "Error in readexp" $msg error 0 Exit 
         }