Changeset 1101 for branches/sandbox


Ignore:
Timestamp:
Dec 20, 2010 9:27:56 AM (10 years ago)
Author:
toby
Message:

new routines for RB editing, more to come

File:
1 edited

Legend:

Unmodified
Added
Removed
  • branches/sandbox/rb.tcl

    r1100 r1101  
    22# rigid body EXP editing (to move into readexp.tcl)
    33#============================================================================
     4# returns the number of defined rigid bodies
     5proc 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.
     24proc 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
     56proc 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#
     86proc 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
    4157
    5158# AddRigidBody: add a new rigid body definition into the .EXP file
Note: See TracChangeset for help on using the changeset viewer.