Changeset 1106 for branches/sandbox
 Timestamp:
 Dec 30, 2010 11:32:05 AM (10 years ago)
 Location:
 branches/sandbox
 Files:

 2 edited
Legend:
 Unmodified
 Added
 Removed

branches/sandbox/rb.tcl
r1102 r1106 4 4 5 5 #============================================================================ 6 # rigid body EXP editing (to move into readexp.tcl) 6 # rigid body EXP editing routines (to move into readexp.tcl) 7 # RigidBodyCount  returns the number of defined rigid bodies (body types) 8 # ReadRigidBody  # of times a body is mapped & scaling factors 9 # RigidBodyMappingCount  # of times a rigid body is mapped in phase 10 # RigidBodyEnableTLS  Enable or Disable TLS use for a rigid body mapping 11 # RigidBodySetTLS  change the TLS values for a rigid body mapping 12 # RigidBodySetDamp  change the damping values for a rigid body mapping 13 # RigidBodyVary  set refinement variable numbers for a rigid body mapping 14 # RigidBodyTLSVary  set TLS refinement variable nums for a rigid body mapping 15 # AddRigidBody  defines a new rigid body type 16 # ReplaceRigidBody  replaces a previous rigid body type 17 # ReadRigidBodyMapping  get parameters for a rigid body mapping 18 # MapRigidBody  map a rigid body type into a phase 19 # EditRigidBodyMapping  change the parameters in a rigid body mapping 7 20 #============================================================================ 8 21 # returns the number of defined rigid bodies … … 16 29 17 30 # returns two items: 18 # the number of times the rigid body is used19 # a list containing an element for each multiplier in rigid body #rbnum.31 # the number of times the rigid body is mapped 32 # a list containing an element for each scaling factor in rigid body #rbnum. 20 33 # in each element there are four items: 21 34 # a multiplier value for the rigid body coordinates … … 58 71 } 59 72 73 # return the number of times rigid body $bodytyp is mapped in phase $phase 60 74 proc RigidBodyMappingCount {phase bodytyp} { 61 75 set key "RGBD[ToHex $phase 1][ToHex $bodytyp 1]" … … 67 81 } 68 82 69 # reads rigid body mapping for phase, body # and instance number83 # reads rigid body mapping parameters for phase ($phase), body type # ($bodytyp) and instance # ($num) 70 84 # returns a list of items (most lists) as follows: 71 85 # 1) sequence # of first atom in body … … 149 163 } 150 164 151 # 152 # routines to write 153 # setTLS on/off 154 # vary body flags 155 # vary TLS flags 156 # edit TLS values 157 # set body damping 158 # set TLS damping 159 # 160 165 # Control TLS representation for phase, body # and instance number of a Rigid body mapping 166 # for mapping with phase ($phase), body type # ($bodytyp) and instance # ($num) 167 # Enable TLS use if TLS is nonzero (true). Disable if zero 168 proc RigidBodyEnableTLS {phase bodytyp num TLS} { 169 if {[RigidBodyMappingCount $phase $bodytyp] < $num} { 170 return "" 171 } 172 set key "RGBD[ToHex $phase 1][ToHex $bodytyp 1][ToHex $num 1]" 173 if {$TLS} { 174 setexp "${key} LSTF" [format "%5d" 1] 1 5 175 if {![existsexp "${key}TLSF1"]} {makeexprec "${key}TLSF1"} 176 if {![existsexp "${key}TLSP1"]} { 177 makeexprec "${key}TLSP1" 178 set str {} 179 foreach v {.01 .01 .01 0 0 0 0 0} d {4 4 4 4 4 4 2 2} { 180 validreal v 8 $d 181 append str $v 182 } 183 setexp "${key}TLSP1" $str 1 64 184 } 185 if {![existsexp "${key}TLSP2"]} { 186 makeexprec "${key}TLSP2" 187 set str {} 188 set v 0 189 foreach d {2 2 2 2 4 4 4 4} { 190 validreal v 8 $d 191 append str $v 192 } 193 setexp "${key}TLSP2" $str 1 64 194 } 195 if {![existsexp "${key}TLSP3"]} { 196 makeexprec "${key}TLSP3" 197 set str {} 198 set v 0 199 foreach d {4 4 4 4} { 200 validreal v 8 $d 201 append str $v 202 } 203 setexp "${key}TLSP3" $str 1 64 204 } 205 } else { 206 setexp "${key} LSTF" [format "%5d" 0] 1 5 207 } 208 return 1 209 } 210 211 # Control the TLS values for Rigid body mapping for mapping with 212 # phase ($phase), body type # ($bodytyp) and instance # ($num) 213 # set the 20 TLS values to the values in TLSvals 214 # There must be exactly 20 TLS terms, which are ordered: 215 # T11, T22, T33, T12, T13, T23 216 # L11, L22, L33, L12, L13, L23 217 # S12, S13, S21, S23, S31, S32, SAA, SBB 218 proc RigidBodySetTLS {phase bodytyp num TLSvals} { 219 if {[RigidBodyMappingCount $phase $bodytyp] < $num} { 220 return "" 221 } 222 if {[llength $TLSvals] != 20} {return ""} 223 set key "RGBD[ToHex $phase 1][ToHex $bodytyp 1][ToHex $num 1]" 224 set TLS [string trim [string range [readexp "${key} LSTF"] 0 4]] 225 if {$TLS == 0} {return ""} 226 if {![existsexp "${key}TLSF1"]} {makeexprec "${key}TLSF1"} 227 foreach n {1 2 3} { 228 if {![existsexp "${key}TLSP$n"]} {makeexprec "${key}TLSP$n"} 229 } 230 set str {} 231 set n 1 232 set i 0 233 foreach v $TLSvals d {4 4 4 4 4 4 2 2 2 2 2 2 4 4 4 4 4 4 4 4} { 234 incr i 235 validreal v 8 $d 236 append str $v 237 if {$i == 8} { 238 set i 0 239 setexp "${key}TLSP$n" $str 1 64 240 incr n 241 set str {} 242 } 243 } 244 setexp "${key}TLSP$n" $str 1 64 245 return 1 246 } 247 248 # set damping values for a Rigid body mapping 249 # for mapping with phase ($phase), body type # ($bodytyp) and instance # ($num) 250 # there must be 9 damping values in RBdamp for the 9 position variables (origin followed by rotations) 251 # Use of TLSdamp is optional, but to be used, TLS representation must be enabled and there must be 252 # three damping terms (for all T terms; for all L terms and for all S terms) 253 proc RigidBodySetDamp {phase bodytyp num RBdamp "TLSdamp {}"} { 254 if {[RigidBodyMappingCount $phase $bodytyp] < $num} { 255 return "" 256 } 257 set key "RGBD[ToHex $phase 1][ToHex $bodytyp 1][ToHex $num 1]" 258 if {[llength $RBdamp] != 9} {return ""} 259 set str {} 260 foreach v $RBdamp { 261 if {[validint v 1] != 1} {set v " "} 262 append str $v 263 } 264 setexp "$key BDFL" $str 46 9 265 set TLS [string trim [string range [readexp "${key} LSTF"] 0 4]] 266 if {$TLS != 0 && [llength $TLSdamp] == 3} { 267 set str {} 268 foreach v $TLSdamp { 269 if {[validint v 1] != 1} {set v " "} 270 append str $v 271 } 272 setexp "$key BDFL" $str 55 3 273 } 274 return 1 275 } 276 277 # set refinement variable numbers for a Rigid body mapping 278 # for mapping with phase ($phase), body type # ($bodytyp) and instance # ($num) 279 # there must be 9 variable values in RBvar for the 9 position variables (origin followed by rotations) 280 # note that the variable values should be unique integers 281 proc RigidBodyVary {phase bodytyp num RBvar} { 282 if {[RigidBodyMappingCount $phase $bodytyp] < $num} { 283 return "" 284 } 285 set key "RGBD[ToHex $phase 1][ToHex $bodytyp 1][ToHex $num 1]" 286 if {[llength $RBvar] != 9} {return ""} 287 set str {} 288 foreach v $RBvar { 289 if {[validint v 5] != 1} {set v " "} 290 append str $v 291 } 292 setexp "$key BDFL" $str 1 45 293 } 294 295 # set TLS refinement variable numbers for a Rigid body mapping 296 # for mapping with phase ($phase), body type # ($bodytyp) and instance # ($num) 297 # there must be 20 variable values in TLSvar for the 20 parameters: 298 # T11, T22, T33, T12, T13, T23 299 # L11, L22, L33, L12, L13, L23 300 # S12, S13, S21, S23, S31, S32, SAA, SBB 301 # note that the variable values should be unique integers 302 proc RigidBodyTLSVary {phase bodytyp num TLSvar} { 303 if {[RigidBodyMappingCount $phase $bodytyp] < $num} { 304 return "" 305 } 306 set key "RGBD[ToHex $phase 1][ToHex $bodytyp 1][ToHex $num 1]" 307 if {[llength $TLSvar] != 20} {return ""} 308 set TLS [string trim [string range [readexp "${key} LSTF"] 0 4]] 309 if {$TLS == 0} {return ""} 310 set str {} 311 foreach v $TLSvar { 312 if {[validint v 3] != 1} {set v " "} 313 append str $v 314 } 315 setexp "${key}TLSF1" $str 1 60 161 316 162 317 # AddRigidBody: add a new rigid body definition into the .EXP file … … 256 411 } 257 412 258 # ApplyRigidBody: define an "instance" of a rigid body: meaning that the coordinates413 # MapRigidBody: define an "instance" of a rigid body: meaning that the coordinates 259 414 # (and optionally U values) for a set of atoms will be generated from the rigid body 260 415 # arguments: … … 267 422 # cartesian system before the body is translated to position. 268 423 # returns the instance # (number of times body $bodytyp has been used in phase $phase) 269 proc ApplyRigidBody {phase bodytyp firstatom position angles} {424 proc MapRigidBody {phase bodytyp firstatom position angles} { 270 425 # number of bodies of this type in this phase 271 426 set key "RGBD[ToHex $phase 1][ToHex $bodytyp 1]" … … 305 460 } 306 461 307 # EditRigidBody : edit parameters that define an "instance" of a rigid body (see ApplyRigidBody)462 # EditRigidBodyMapping: edit parameters that define an "instance" of a rigid body (see MapRigidBody) 308 463 # arguments: 309 464 # phase: phase number (19) 310 465 # bodytyp: number of rigid body (115) as returned from AddRigidBody 311 # bodynum: instance number, as returned by ApplyRigidBody466 # bodynum: instance number, as returned by MapRigidBody 312 467 # position: list of three fractional coordinates for the origin of the rigid body coordinates 313 468 # angles: list of 3 angles to rotate the rigid body coordinates around x, y, z of the 314 469 # cartesian system before the body is translated to position. 315 470 # 316 proc EditRigidBody {phase bodytyp bodynum position angles} {471 proc EditRigidBodyMapping {phase bodytyp bodynum position angles} { 317 472 # number of bodies of this type in this phase 318 473 set key "RGBD[ToHex $phase 1][ToHex $bodytyp 1][ToHex $bodynum 1]" … … 326 481 #============================================================================ 327 482 #============================================================================ 483 # Returns a list of the variable numbers used already for rigid body variable parameters 484 proc RigidBodyGetVarNums {} { 485 set varlist {} 486 set bodies [RigidBodyCount] 487 for {set type 1} {$type <= $bodies} {incr type} { 488 foreach phase $::expmap(phaselist) { 489 set count [RigidBodyMappingCount $phase $type] 490 for {set i 1} {$i <= $bodies} {incr i} { 491 set items [ReadRigidBodyMapping $phase $type $i] 492 set varlist [concat $varlist [lindex $items 3]] 493 if {[llength [lindex $items 6]] > 0} { 494 set varlist [concat $varlist [lindex $items 6]] 495 } 496 } 497 } 498 } 499 return [lsort unique $varlist] 500 } 328 501 329 502 # Use the GSAS geometry program to compute a set of cartesian coordinates for a … … 873 1046 #puts [GetRB 1 6 8 "1 2" "X 1 2" "Y 1 3"] 874 1047 #puts [GetRB 1 4 8 "1" "X 1 2" "Z 3 4"] 875 # ApplyRigidBody 1 1 7 ".11 .22 .33" "11 12 13"1048 #MapRigidBody 1 1 7 ".11 .22 .33" "11 12 13" 876 1049 877 1050 … … 880 1053 # {1 1 1 o} {1 1 1 o} {1 1 1 o} {1 1 1 o} 881 1054 #} } 882 #set n [ ApplyRigidBody 1 1 1 ".2 .3 .4" "13 17 19"]1055 #set n [MapRigidBody 1 1 1 ".2 .3 .4" "13 17 19"] 883 1056 #puts "body $n created" 884 1057 #incr expgui(changed) … … 886 1059 #puts "press Enter to continue" 887 1060 #gets stdin line 888 # ApplyRigidBody 1 1 $n ".5 .5 .5" "0 0 0"1061 #MapRigidBody 1 1 $n ".5 .5 .5" "0 0 0" 889 1062 #incr expgui(changed) 890 1063 #RunRecalcRBCoords 
branches/sandbox/readexp.tcl
r1032 r1106 294 294 set digits 1 295 295 } 296 if {$digits <= 0} {set digits 1} 296 297 if {$digits + $sign >= $length} { 297 298 # the number is much too big  use exponential notation … … 307 308 set decimal [expr {$length  $digits  $sign  1}] 308 309 set tmp [format "%#.${decimal}f" $value] 309 } elseif {abs($value) < pow(10,2$decimal) && $length > 6 } {310 } elseif {abs($value) < pow(10,2$decimal) && $length > 6 && $value != 0} { 310 311 # for small values, switch to exponential notation (2$decimal > three sig figs.) 311 312 set decimal [expr {$length  6  $sign}]
Note: See TracChangeset
for help on using the changeset viewer.