Changeset 261
 Timestamp:
 Dec 4, 2009 5:03:06 PM (11 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

trunk/readexp.tcl
 Property rcs:date changed from 2000/08/04 18:25:05 to 2000/08/08 23:21:55
 Property rcs:lines changed from +3 3 to +66 11
 Property rcs:rev changed from 1.19 to 1.20
r253 r261 760 760 setexp ${key}B A 63 1 761 761 # copy the Uiso to the diagonal terms 762 set value [string range [readexp ${key}B] 0 9] 763 setexp ${key}B $value 11 10 764 setexp ${key}B $value 21 10 765 set value 0.0 766 validreal value 10 6 767 setexp ${key}B $value 31 10 768 setexp ${key}B $value 41 10 769 setexp ${key}B $value 51 10 762 set Uiso [string range [readexp ${key}B] 0 9] 763 foreach value [CalcAniso $phase $Uiso] \ 764 col {1 11 21 31 41 51} { 765 validreal value 10 6 766 setexp ${key}B $value $col 10 767 } 770 768 } else { 771 769 setexp ${key}B I 63 1 … … 2121 2119 } 2122 2120 } 2121 2122 # compute equivalent anisotropic temperature factor for Uequiv 2123 proc CalcAniso {phase Uequiv} { 2124 foreach var {a b c alpha beta gamma} { 2125 set $var [phaseinfo $phase $var] 2126 } 2127 2128 set G(1,1) [expr $a * $a] 2129 set G(2,2) [expr $b * $b] 2130 set G(3,3) [expr $c * $c] 2131 set G(1,2) [expr $a * $b * cos($gamma*0.017453292519943)] 2132 set G(2,1) $G(1,2) 2133 set G(1,3) [expr $a * $c * cos($beta *0.017453292519943)] 2134 set G(3,1) $G(1,3) 2135 set G(2,3) [expr $b * $c * cos($alpha*0.017453292519943)] 2136 set G(3,2) $G(2,3) 2137 2138 # Calculate the volume**2 2139 set v2 0.0 2140 foreach i {1 2 3} { 2141 set J [expr ($i%3) + 1] 2142 set K [expr (($i+1)%3) + 1] 2143 set v2 [expr $v2+ $G(1,$i)*($G(2,$J)*$G(3,$K)$G(3,$J)*$G(2,$K))] 2144 } 2145 if {$v2 > 0} { 2146 set v [expr sqrt($v2)] 2147 foreach i {1 2 3} { 2148 set i1 [expr ($i%3) + 1] 2149 set i2 [expr (($i+1)%3) + 1] 2150 foreach j {1 2 3} { 2151 set j1 [expr ($j%3) + 1] 2152 set j2 [expr (($j+1)%3) + 1] 2153 set C($j,$i) [expr (\ 2154 $G($i1,$j1) * $G($i2,$j2)  \ 2155 $G($i1,$j2) * $G($i2,$j1)\ 2156 )/ $v] 2157 } 2158 } 2159 set A(1,2) [expr 0.5 * ($C(1,2) + $C(2,1)) / sqrt( $C(1,1)* $C(2,2) )] 2160 set A(1,3) [expr 0.5 * ($C(1,3) + $C(3,1)) / sqrt( $C(1,1)* $C(3,3) )] 2161 set A(2,3) [expr 0.5 * ($C(2,3) + $C(3,2)) / sqrt( $C(2,2)* $C(3,3) )] 2162 foreach i {1 1 2} j {2 3 3} { 2163 set A($i,$j) [expr 0.5 * ($C($i,$j) + $C($j,$i)) / \ 2164 sqrt( $C($i,$i)* $C($j,$j) )] 2165 # clean up roundoff 2166 if {abs($A($i,$j)) < 1e5} {set A($i,$j) 0.0} 2167 } 2168 } else { 2169 set A(1,2) 0.0 2170 set A(1,3) 0.0 2171 set A(2,3) 0.0 2172 } 2173 return "$Uequiv $Uequiv $Uequiv \ 2174 [expr $Uequiv * $A(1,2)] \ 2175 [expr $Uequiv * $A(1,3)] \ 2176 [expr $Uequiv * $A(2,3)]" 2177 }
Note: See TracChangeset
for help on using the changeset viewer.