Changeset 1106 for branches/sandbox


Ignore:
Timestamp:
Dec 30, 2010 11:32:05 AM (10 years ago)
Author:
toby
Message:

more fixes to validreal for small nums; add more RB control routines

Location:
branches/sandbox
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • branches/sandbox/rb.tcl

    r1102 r1106  
    44
    55#============================================================================
    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
    720#============================================================================
    821# returns the number of defined rigid bodies
     
    1629
    1730# returns two items:
    18 #   the number of times the rigid body is used
    19 #   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.
    2033# in each element there are four items:
    2134#    a multiplier value for the rigid body coordinates
     
    5871}
    5972
     73# return the number of times rigid body $bodytyp is mapped in phase $phase
    6074proc RigidBodyMappingCount {phase bodytyp} {
    6175    set key "RGBD[ToHex $phase 1][ToHex $bodytyp 1]"
     
    6781}
    6882
    69 # reads rigid body mapping for phase, body # and instance number
     83# reads rigid body mapping parameters for phase ($phase), body type # ($bodytyp) and instance # ($num)
    7084# returns a list of items (most lists) as follows:
    7185#   1) sequence # of first atom in body
     
    149163}
    150164
    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 non-zero (true). Disable if zero
     168proc 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
     218proc 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)
     253proc 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
     281proc 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
     302proc 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
    161316
    162317# AddRigidBody: add a new rigid body definition into the .EXP file
     
    256411}
    257412
    258 # ApplyRigidBody: define an "instance" of a rigid body: meaning that the coordinates
     413# MapRigidBody: define an "instance" of a rigid body: meaning that the coordinates
    259414# (and optionally U values) for a set of atoms will be generated from the rigid body
    260415# arguments:
     
    267422#           cartesian system before the body is translated to position.
    268423# returns the instance # (number of times body $bodytyp has been used in phase $phase)
    269 proc ApplyRigidBody {phase bodytyp firstatom position angles} {
     424proc MapRigidBody {phase bodytyp firstatom position angles} {
    270425    # number of bodies of this type in this phase
    271426    set key "RGBD[ToHex $phase 1][ToHex $bodytyp 1]"
     
    305460}
    306461
    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)
    308463# arguments:
    309464#   phase: phase number (1-9)
    310465#   bodytyp: number of rigid body (1-15) as returned from AddRigidBody
    311 #   bodynum: instance number, as returned by ApplyRigidBody
     466#   bodynum: instance number, as returned by MapRigidBody
    312467#   position: list of three fractional coordinates for the origin of the rigid body coordinates
    313468#   angles: list of 3 angles to rotate the rigid body coordinates around x, y, z of the
    314469#           cartesian system before the body is translated to position.
    315470#
    316 proc EditRigidBody {phase bodytyp bodynum position angles} {
     471proc EditRigidBodyMapping {phase bodytyp bodynum position angles} {
    317472    # number of bodies of this type in this phase
    318473    set key "RGBD[ToHex $phase 1][ToHex $bodytyp 1][ToHex $bodynum 1]"
     
    326481#============================================================================
    327482#============================================================================
     483# Returns a list of the variable numbers used already for rigid body variable parameters
     484proc 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}
    328501
    329502# Use the GSAS geometry program to compute a set of cartesian coordinates for a
     
    8731046#puts [GetRB 1 6 8 "1 2" "X 1 2" "Y 1 3"]
    8741047#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"
    8761049
    8771050
     
    8801053#    {1 1 -1 o} {-1 1 -1 o} {1 -1 -1 o} {-1 -1 -1 o}
    8811054#} }
    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"]
    8831056#puts "body $n created"
    8841057#incr expgui(changed)
     
    8861059#puts "press Enter to continue"
    8871060#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"
    8891062#incr expgui(changed)
    8901063#RunRecalcRBCoords
  • branches/sandbox/readexp.tcl

    r1032 r1106  
    294294            set digits 1
    295295        }
     296        if {$digits <= 0} {set digits 1}
    296297        if {$digits + $sign >= $length} {
    297298            # the number is much too big -- use exponential notation
     
    307308            set decimal [expr {$length - $digits - $sign - 1}]
    308309            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} {
    310311            # for small values, switch to exponential notation (2-$decimal -> three sig figs.)
    311312            set decimal [expr {$length - 6 - $sign}]
Note: See TracChangeset for help on using the changeset viewer.