Changeset 1119 for branches/sandbox/rb.tcl
 Timestamp:
 Mar 23, 2011 4:57:24 PM (10 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

branches/sandbox/rb.tcl
r1114 r1119 655 655 # Rigid body utility routines 656 656 #============================================================================ 657 <<<<<<< .mine 658 # RigidBodyGetVarNums: Returns a list of the variable numbers in use 659 # for rigid body variable parameters. 660 # RigidBodyAtomNums: returns a list of atom numbers that are mapped to 661 # rigid bodies in a selected phase 662 # RigidStartAtoms: returns a list of atoms that are allowed for creation of RB 663 # ExtractRigidBody: Use the GSAS geometry program to cartesian coordinates & 664 # setting info for a RB from fractional coordinates for atoms in a phase 665 # RunRecalcRBCoords: updates the coordinates in all phases after changes have 666 # been made to rigid parameters. 667 # CalcBody: Convert ortho to fractional coordinates using RB parameters 668 # FitBody: Optimize the origin and Euler angles to match a rigid body to a 669 # set of fractional coordinates 670 # zmat2coord: convert a zmatrix to a set of cartesian coordinates 671 # RB2cart: convert the representation used for rigid bodies into 672 # cartesian coordinates 673 # PlotRBtype: plot a rigid body with DRAWxtl 674 # PlotRBcoords: plot orthogonal coordinates with DRAWxtl 675 # DRAWxtlPlotRBFit: plot a set of fraction coordinates superimposed 676 # on a structure read from a phase with DRAWxtl 677 #============================================================================ 678 #============================================================================ 679 # RigidBodyGetVarNums: Returns a list of the variable numbers used already 680 # for rigid body variable parameters 681 ======= 657 682 # RigidBodyGetVarNums: Returns a list of the variable numbers in use 658 683 # for rigid body variable parameters. … … 678 703 # RigidBodyGetVarNums: Returns a list of the variable numbers used already 679 704 # for rigid body variable parameters 705 >>>>>>> .r1117 680 706 proc RigidBodyGetVarNums {} { 681 707 set varlist {} … … 762 788 # firstatom: sequence # in phase (may be > than number of the atom) 763 789 # originlist: atoms to define origin (where 1 is first atom in group; <= natom) 764 # vector1: list of 3 values with X, Y or Z, atom #a and #b (number as in origin) 790 # vector1: list of 3 values with X, Y or Z, atom #a and #b (number as in origin) (for example {X 1 3}) 765 791 # vector2: list of 3 values with X, Y or Z, atom #a and #b (number as in origin) 766 792 # note that vector2 must define a different axis than vector1 … … 770 796 set fp [open "geom.inp" "w"] 771 797 puts $fp "N" 772 puts $fp "N" 773 puts $fp $phase 774 puts $fp "N" 775 798 if {[llength ::expmap(phaselist)] > 1} { 799 # select phase 800 puts $fp "N" 801 puts $fp $phase 802 puts $fp "N" 803 } 776 804 puts $fp "R" 777 805 puts $fp "$natom" … … 787 815 puts $fp "X" 788 816 close $fp 817 #puts "[file join $expgui(gsasexe) geometry] $expgui(expfile) < geom.inp > geom.out" 789 818 catch { 790 819 exec [file join $expgui(gsasexe) geometry] $expgui(expfile) < geom.inp > geom.out 791 } 792 file delete geom.inp 820 } err 821 #puts $err 822 #file delete geom.inp 793 823 set fp [open geom.out r] 824 set origin {} 825 set Euler {} 826 set coordlist {} 794 827 while {[gets $fp line] >= 0} { 795 828 if {[string first "Cell coordinates of origin" $line] != 1} { 796 829 set origin [lrange [string range $line [string first "are" $line] end] 1 3] 830 #puts "origin in rb = $origin" 797 831 } 798 832 if {[string first "Rotation angles" $line] != 1} { … … 821 855 } 822 856 #file delete geom.out 857 if {[llength $origin] == 0  [llength $Euler] == 0  [llength $coordlist] == 0} { 858 puts "Error: run of GEOMETRY failed" 859 } 823 860 return [list $origin $Euler $coordlist] 824 861 } … … 1060 1097 # note that items 13 are computed with the imput origin, not the revised one 1061 1098 proc FitBodyOrigin {Euler cell ortholist useflag fraclist origin} { 1099 puts $fraclist 1062 1100 set xform [CalcXformMatrix $Euler $cell] 1101 puts "entering FitBodyOrigin" 1063 1102 foreach var {x y z} {set sum($var) 0.0} 1064 1065 1103 set i 0 1066 1104 set sumdvs 0 … … 1068 1106 set rmsout {} 1069 1107 foreach oc $ortholist use $useflag coord $fraclist { 1070 1108 #puts "ortho: $oc" 1071 1109 set frac [lrange [Ortho2Xtal $xform $origin $oc] 3 end] 1072 1110 lappend fracout $frac … … 1074 1112 set dvs 0 1075 1113 foreach var {x y z} v1 $frac v2 $coord abc [lrange $cell 0 2] { 1114 puts "v2 = $v2" 1115 puts "v1 = $v1" 1116 puts "abc = $abc" 1076 1117 set dv [expr {($v2  $v1)*$abc}] 1077 1118 set dvs [expr {$dvs + $dv*$dv}] 1078 1119 set sumdvs [expr {$sumdvs + $dv*$dv}] 1079 1120 if {$use} {set sum($var) [expr {$sum($var) + $dv/$abc}]} 1121 puts "round and round" 1080 1122 } 1081 1123 lappend rmsout [expr {sqrt($dvs)}]
Note: See TracChangeset
for help on using the changeset viewer.