Changeset 129 for trunk

Timestamp:

Dec 4, 2009 5:00:53 PM (14 years ago)

Author:

toby

Message:

# on 2000/05/16 21:53:20, toby did:
add constrinfo for atom constraint processing

File:

• trunk/readexp.tcl (modified) (1 diff, 3 props)

trunk/readexp.tcl

@@ -1139 +1139 @@
 }
 
+#  get a logical constraint
+#  type action
+#  -----------
+#  atom get    returns a list of constraints.
+#       set    replaces a list of constraints.
+#       add    inserts a new list of constraints 
+#       delete deletes a set of constraint entries
+# Each item in the list of constraints is composed of 4 items: 
+#   phase, atom, variable, multiplier
+#      if variable=UISO atom can be ALL, otherwise atom is a number
+# legal variable names: FRAC, X, Y, Z, UISO, U11, U22, U33, U12, U23, U13,
+#                       MX, MY, MZ
+proc constrinfo {type action number "value {}"} {
+    switch -glob ${type}-$action {
+        atom-get {
+            # does this constraint exist?
+            set key [format "LNCN%4d%4d" $number 1]
+            if {![existsexp $key]} {return -1}
+            set clist {}
+            for {set i 1} {$i < 999} {incr i} {
+                set key [format "LNCN%4d%4d" $number $i]
+                if {![existsexp $key]} break
+                set line [readexp $key]
+                set j1 2
+                set j2 17
+                set seg [string range $line $j1 $j2]
+                while {[string trim $seg] != ""} {
+                    lappend clist [list \
+                            [string range $seg 0 0] \
+                            [string trim [string range $seg 1 3]] \
+                            [string trim [string range $seg 4 7]] \
+                            [string trim [string range $seg 8 end]]]
+                    incr j1 16
+                    incr j2 16
+                    set seg [string range $line $j1 $j2]
+                }
+            }
+            return $clist
+        }
+        atom-set {
+            # delete records for current constraint
+            for {set i 1} {$i < 999} {incr i} {
+                set key [format "LNCN%4d%4d" $number $i]
+                if {![existsexp $key]} break
+                delexp $key
+            }
+            set line {}
+            set i 1
+            foreach tuple $value {
+                if {[string toupper [lindex $tuple 1]] == "ALL"} {
+                    set seg [format %1dALL%-4s%8.4f \
+                            [lindex $tuple 0] \
+                            [lindex $tuple 2] \
+                            [lindex $tuple 3]]
+                } else {
+                    set seg [eval format %1d%3d%-4s%8.4f $tuple]
+                }
+                append line $seg
+                if {[string length $line] > 50} {
+                    set key  [format "LNCN%4d%4d" $number $i]
+                    makeexprec $key
+                    setexp $key $line 3 68
+                    set line {}
+                    incr i
+                }
+            }
+            if {$line != ""} {
+                set key  [format "LNCN%4d%4d" $number $i]
+                makeexprec $key
+                setexp $key $line 3 68
+            }
+            return
+        }
+        atom-add {
+            # loop over defined constraints
+            for {set j 1} {$j < 9999} {incr j} {
+                set key [format "LNCN%4d%4d" $j 1]
+                if {![existsexp $key]} break
+            }
+            set number $j
+            # save the constraint 
+            set line {}
+            set i 1
+            foreach tuple $value {
+                if {[string toupper [lindex $tuple 1]] == "ALL"} {
+                    set seg [format %1dALL%-4s%8.4f \
+                            [lindex $tuple 0] \
+                            [lindex $tuple 2] \
+                            [lindex $tuple 3]]
+                } else {
+                    set seg [eval format %1d%3d%-4s%8.4f $tuple]
+                }
+                append line $seg
+                if {[string length $line] > 50} {
+                    set key  [format "LNCN%4d%4d" $number $i]
+                    makeexprec $key
+                    setexp $key $line 3 68
+                    set line {}
+                    incr i
+                }
+            }
+            if {$line != ""} {
+                set key  [format "LNCN%4d%4d" $number $i]
+                makeexprec $key
+                setexp $key $line 3 68
+            }
+            return
+        }
+        atom-delete {
+            for {set j $number} {$j < 9999} {incr j} {
+                # delete records for current constraint
+                for {set i 1} {$i < 999} {incr i} {
+                    set key [format "LNCN%4d%4d" $j $i]
+                    if {![existsexp $key]} break
+                    delexp $key
+                }
+                # now copy records, from the next entry, if any
+                set j1 $j
+                incr j1
+                set key1 [format "LNCN%4d%4d" $j1 1]
+                # if there is no record, there is nothing to copy -- done
+                if {![existsexp $key1]} return
+                for {set i 1} {$i < 999} {incr i} {
+                    set key1 [format "LNCN%4d%4d" $j1 $i]
+                    if {![existsexp $key1]} break
+                    set key  [format "LNCN%4d%4d" $j  $i]
+                    makeexprec $key
+                    setexp $key [readexp $key1] 1 68
+                }
+            }
+        }
+        default {
+            set msg "Unsupported constrinfo access: type=$type action=$action"
+#           tk_dialog .badexp "Error in EXP" $msg error 0 Exit 
+#           destroy .
+        }
+
+    }
+}
+
 # write the .EXP file
 proc expwrite {expfile} {