Changeset 1101
- Timestamp:
- Dec 20, 2010 9:27:56 AM (13 years ago)
- File:
-
- 1 edited
-
branches/sandbox/rb.tcl (modified) (1 diff)
Legend:
- Unmodified
- Added
- Removed
-
branches/sandbox/rb.tcl
r1100 r1101 2 2 # rigid body EXP editing (to move into readexp.tcl) 3 3 #============================================================================ 4 # returns the number of defined rigid bodies 5 proc RigidBodyCount {} { 6 set n [string trim [readexp "RGBD NRBDS"]] 7 if {$n == ""} { 8 set n 0 9 } 10 return $n 11 } 12 13 # returns two items: 14 # the number of times the rigid body is used 15 # a list containing an element for each multiplier in rigid body #rbnum. 16 # in each element there are four items: 17 # a multiplier value for the rigid body coordinates 18 # a damping value (0-9) for the refinement of the multiplier 19 # a variable number if the multiplier will be refined 20 # a list of cartesian coordinates coordinates 21 # each cartesian coordinate contains 4 items: x,y,z and a label 22 # note that the label is present only when the RB is created in EXPGUI and is 23 # not used in GSAS. 24 proc ReadRigidBody {rbnum} { 25 if {[RigidBodyCount] > $rbnum} { 26 return "" 27 } 28 set value $rbnum 29 validint value 2 30 set key "RGBD${value}" 31 set n [string trim [string range [readexp "$key NATR"] 0 4]] 32 set used [string trim [string range [readexp "$key NBDS"] 0 4]] 33 set nmult [string trim [string range [readexp "$key NSMP"] 0 4]] 34 set out $used 35 for {set i 1} {$i <= $nmult} {incr i} { 36 set line [readexp "${key}${i}PARM"] 37 set mult [string trim [string range $line 0 9]] 38 set var [string trim [string range $line 10 14]] 39 set damp [string trim [string range $line 15 19]] 40 set coordlist {} 41 for {set j 1} {$j <= $n} {incr j} { 42 set value $j 43 validint value 3 44 set line [readexp "${key}${i}SC$value"] 45 set x [string trim [string range $line 0 9]] 46 set y [string trim [string range $line 10 19]] 47 set z [string trim [string range $line 20 29]] 48 set lbl [string trim [string range $line 30 39]] 49 lappend coordlist [list $x $y $x $lbl] 50 } 51 lappend out [list $mult $damp $var $coordlist] 52 } 53 return $out 54 } 55 56 proc RigidBodyMappingCount {phase bodytyp} { 57 set key "RGBD[ToHex $phase 1][ToHex $bodytyp 1]" 58 set n [string trim [readexp "$key NBDS"]] 59 if {$n == ""} { 60 set n 0 61 } 62 return $n 63 } 64 65 # reads rigid body mapping for phase, body # and instance number 66 # returns a list of items (most lists) as follows: 67 # 1) sequence # of first atom in body 68 # 2) origin of body in fractional coordinates (3 elements) 69 # 3) Euler angles as 6 pairs of numbers (see below) 70 # 4) variable numbers for the 9 position variables (origin followed by rotations) 71 # 5) damping vals for the 9 position variables (origin followed by rotations) 72 # 6) the TLS values, in order below (empty list if TLS is not in use) 73 # 7) the variable numbers for each TLS values, in order below (or empty) 74 # 8) three damping values for the T, L and S terms. 75 # returns an empty list if no such body exists. 76 # 77 # Euler angles are a list of axes and angles to rotate: 78 # { {axis1 angle1} {axis2 angle2} ...} 79 # where axis1,... can be 1, 2 or 3 corresponding to the cartesian X, Y or Z axes 80 # 81 # The 20 TLS terms are ordered: 82 # T11, T22, T33, T12, T13, T23 83 # L11, L22, L33, L12, L13, L23 84 # S12, S13, S21, S23, S31, S32, SAA, SBB 85 # 86 proc ReadRigidBodyMapping {phase bodytyp num} { 87 if {[RigidBodyMappingCount $phase $bodytyp] < $num} { 88 return "" 89 } 90 set key "RGBD[ToHex $phase 1][ToHex $bodytyp 1][ToHex $num 1]" 91 set first [string trim [string range [readexp "$key NDA"] 0 4]] 92 set line [readexp "$key BDFL"] 93 set varlist {} 94 set damplist {} 95 foreach i {0 1 2 3 4 5 6 7 8} { 96 lappend varlist [string trim [string range $line [expr {5*$i}] [expr {4 + 5*$i}] ]] 97 lappend damplist [string trim [string range $line [expr {45 + $i}] [expr {45 + $i}] ]] 98 } 99 set TLSdamplist {} 100 foreach i {54 55 56} { 101 lappend TLSdamplist [string trim [string range $line $i $i ]] 102 } 103 set line [readexp "${key} BDLC"] 104 set x [string trim [string range $line 0 9]] 105 set y [string trim [string range $line 10 19]] 106 set z [string trim [string range $line 20 29]] 107 set origin [list $x $y $z] 108 set line [readexp "${key} BDOR"] 109 set rotations {} 110 foreach i {0 10 20 30 40 50} { 111 set angle [string trim [string range $line $i [expr {$i+7}]]] 112 set axis [string trim [string range $line [expr {$i+8}] [expr {$i+9}]]] 113 lappend rotations [list $angle $axis] 114 } 115 set TLS [string trim [string range [readexp "${key} LSTF"] 0 4]] 116 set tlsvars {} 117 set tlsvals {} 118 if {$TLS != 0} { 119 set line [readexp "${key}TLSF1"] 120 for {set j 0} {$j < 20} {incr j} { 121 lappend tlsvars [string trim [string range $line [expr {3*$j}] [expr {3*$j+2}]]] 122 } 123 for {set j 0} {$j < 20} {incr j} { 124 set i 0 125 if {$j == 0} { 126 set i 1 127 } elseif {$j == 8} { 128 set i 2 129 } elseif {$j == 16} { 130 set i 3 131 } 132 if {$i != 0} { 133 set line [readexp "${key}TLSP$i"] 134 set i 0 135 set j1 0 136 set j2 7 137 } else { 138 incr j1 8 139 incr j2 8 140 } 141 lappend tlsvals [string trim [string range $line $j1 $j2]] 142 } 143 } 144 return [list $first $origin $rotations $varlist $damplist $tlsvals $tlsvars $TLSdamplist] 145 } 146 147 #--------------------------- 148 # routines to write 149 # setTLS on/off 150 # vary body flags 151 # vary TLS flags 152 # edit TLS values 153 # set body damping 154 # set TLS damping 155 #--------------------------- 156 4 157 5 158 # AddRigidBody: add a new rigid body definition into the .EXP file
Note: See TracChangeset
for help on using the changeset viewer.
