- Timestamp:
- Dec 4, 2009 5:10:07 PM (13 years ago)
- File:
-
- 1 edited
Legend:
- Unmodified
- Added
- Removed
-
trunk/readexp.tcl
- Property rcs:date changed from 2002/12/27 18:25:35 to 2003/04/10 22:14:21
- Property rcs:lines changed from +4 -3 to +387 -8
- Property rcs:rev changed from 1.37 to 1.38
r662 r674 263 263 if [catch { 264 264 # for small values, switch to exponential notation 265 set pow [expr .2 - $decimal] 265 # 2 -> three sig figs. 266 set pow [expr 2 - $decimal] 266 267 if {abs($value) < pow(10,$pow) && $length > 6} { 268 # try to make it fit 269 if {$length - $decimal < 5} {set decimal [expr $length -5]} 267 270 set tmp [format "%${length}.${decimal}E" $value] 268 271 } else { … … 1281 1284 if ![validreal value 10 7] {return 0} 1282 1285 setexp "${key} ICONS" $value 1 10 1286 # set the powpref warning (1 = suggested) 1287 catch { 1288 global expgui 1289 if {$expgui(needpowpref) == 0} {set expgui(needpowpref) 1} 1290 set msg "Diffractometer constants" 1291 if {[string first $msg $expgui(needpowpref_why)] == -1} { 1292 append expgui(needpowpref_why) "\t$msg were changed\n" 1293 } 1294 } 1283 1295 } 1284 1296 difa-get - … … 1290 1302 if ![validreal value 10 7] {return 0} 1291 1303 setexp "${key} ICONS" $value 11 10 1304 # set the powpref warning (1 = suggested) 1305 catch { 1306 global expgui 1307 if {$expgui(needpowpref) == 0} {set expgui(needpowpref) 1} 1308 set msg "Diffractometer constants" 1309 if {[string first $msg $expgui(needpowpref_why)] == -1} { 1310 append expgui(needpowpref_why) "\t$msg were changed\n" 1311 } 1312 } 1292 1313 } 1293 1314 zero-get { … … 1297 1318 if ![validreal value 10 5] {return 0} 1298 1319 setexp "${key} ICONS" $value 21 10 1320 # set the powpref warning (1 = suggested) 1321 catch { 1322 global expgui 1323 if {$expgui(needpowpref) == 0} {set expgui(needpowpref) 1} 1324 set msg "Diffractometer constants" 1325 if {[string first $msg $expgui(needpowpref_why)] == -1} { 1326 append expgui(needpowpref_why) "\t$msg were changed\n" 1327 } 1328 } 1299 1329 } 1300 1330 ipola-get { … … 1552 1582 setexp $k ${r1}${r2} 1 20 1553 1583 } 1584 # set the powpref warning (2 = required) 1585 catch { 1586 global expgui 1587 set expgui(needpowpref) 2 1588 set msg "Excluded regions" 1589 if {[string first $msg $expgui(needpowpref_why)] == -1} { 1590 append expgui(needpowpref_why) "\t$msg were changed\n" 1591 } 1592 } 1554 1593 } 1555 1594 file-get { … … 1568 1607 if ![validreal value 10 4] {return 0} 1569 1608 setexp "${key} NREF" $value 6 10 1609 # set the powpref warning (2 = required) 1610 catch { 1611 global expgui 1612 set expgui(needpowpref) 2 1613 set msg "Dmin (reflection range)" 1614 if {[string first $msg $expgui(needpowpref_why)] == -1} { 1615 append expgui(needpowpref_why) "\t$msg was changed\n" 1616 } 1617 } 1570 1618 } 1571 1619 use-get { … … 1585 1633 setexp " EXPR HTYP$k" "*" $j 1 1586 1634 } 1635 # set the powpref warning (2 = required) 1636 catch { 1637 global expgui 1638 set expgui(needpowpref) 2 1639 set msg "Histogram use flags" 1640 if {[string first $msg $expgui(needpowpref_why)] == -1} { 1641 append expgui(needpowpref_why) "\t$msg were changed\n" 1642 } 1643 } 1587 1644 } 1588 1645 dstart-get { … … 1592 1649 if ![validreal value 10 3] {return 0} 1593 1650 setexp "${key} DUMMY" $value 21 10 1651 # set the powpref warning (1 = suggested) 1652 catch { 1653 global expgui 1654 if {$expgui(needpowpref) == 0} {set expgui(needpowpref) 1} 1655 set msg "Dummy histogram parameters" 1656 if {[string first $msg $expgui(needpowpref_why)] == -1} { 1657 append expgui(needpowpref_why) "\t$msg were changed\n" 1658 } 1659 } 1594 1660 } 1595 1661 dstep-get { … … 1599 1665 if ![validreal value 10 3] {return 0} 1600 1666 setexp "${key} DUMMY" $value 31 10 1667 catch { 1668 global expgui 1669 if {$expgui(needpowpref) == 0} {set expgui(needpowpref) 1} 1670 set msg "Dummy histogram parameters" 1671 if {[string first $msg $expgui(needpowpref_why)] == -1} { 1672 append expgui(needpowpref_why) "\t$msg were changed\n" 1673 } 1674 } 1601 1675 } 1602 1676 dpoints-get { … … 1606 1680 if ![validint value 10] {return 0} 1607 1681 setexp "${key} DUMMY" $value 1 10 1682 catch { 1683 global expgui 1684 if {$expgui(needpowpref) == 0} {set expgui(needpowpref) 1} 1685 set msg "Dummy histogram parameters" 1686 if {[string first $msg $expgui(needpowpref_why)] == -1} { 1687 append expgui(needpowpref_why) "\t$msg were changed\n" 1688 } 1689 } 1608 1690 } 1609 1691 dtype-get { … … 1614 1696 } 1615 1697 abscor1-set { 1616 if ![validreal value 15 8] {return 0}1698 if ![validreal value 15 7] {return 0} 1617 1699 setexp "${key}ABSCOR" $value 1 15 1618 1700 } … … 1621 1703 } 1622 1704 abscor2-set { 1623 if ![validreal value 15 8] {return 0}1705 if ![validreal value 15 7] {return 0} 1624 1706 setexp "${key}ABSCOR" $value 16 15 1625 1707 } … … 1637 1719 } 1638 1720 absdamp-set { 1639 setexp "${key}ABSCOR" $value 40 1 1721 if ![validint value 5] {return 0} 1722 setexp "${key}ABSCOR" $value 36 5 1640 1723 } 1641 1724 absref-get { … … 1648 1731 absref-set { 1649 1732 if $value { 1650 setexp "${key}ABSCOR" " Y" 35 11733 setexp "${key}ABSCOR" " Y" 31 5 1651 1734 } else { 1652 setexp "${key}ABSCOR" " N" 35 11735 setexp "${key}ABSCOR" " N" 31 5 1653 1736 } 1654 1737 } … … 1733 1816 if ![validint value 5] {return 0} 1734 1817 setexp "${key}PRCF " $value 1 5 1818 # set the powpref warning (1 = suggested) 1819 catch { 1820 global expgui 1821 if {$expgui(needpowpref) == 0} {set expgui(needpowpref) 1} 1822 set msg "Profile parameters" 1823 if {[string first $msg $expgui(needpowpref_why)] == -1} { 1824 append expgui(needpowpref_why) "\t$msg were changed\n" 1825 } 1826 } 1735 1827 } 1736 1828 profterms-get { … … 1747 1839 makeexprec "${key}PRCF $i" 1748 1840 } 1841 # set the powpref warning (1 = suggested) 1842 catch { 1843 global expgui 1844 if {$expgui(needpowpref) == 0} {set expgui(needpowpref) 1} 1845 set msg "Profile parameters" 1846 if {[string first $msg $expgui(needpowpref_why)] == -1} { 1847 append expgui(needpowpref_why) "\t$msg were changed\n" 1848 } 1849 } 1749 1850 } 1750 1851 pcut-get { … … 1754 1855 if ![validreal value 10 5] {return 0} 1755 1856 setexp "${key}PRCF " $value 11 10 1857 # set the powpref warning (1 = suggested) 1858 catch { 1859 global expgui 1860 if {$expgui(needpowpref) == 0} {set expgui(needpowpref) 1} 1861 set msg "Profile parameters" 1862 if {[string first $msg $expgui(needpowpref_why)] == -1} { 1863 append expgui(needpowpref_why) "\t$msg were changed\n" 1864 } 1865 } 1756 1866 } 1757 1867 pdamp-get { … … 1776 1886 set line [expr {1 + ($num - 1) / 4}] 1777 1887 setexp "${key}PRCF $line" $value $f1 15 1888 # set the powpref warning (1 = suggested) 1889 catch { 1890 global expgui 1891 if {$expgui(needpowpref) == 0} {set expgui(needpowpref) 1} 1892 set msg "Profile parameters" 1893 if {[string first $msg $expgui(needpowpref_why)] == -1} { 1894 append expgui(needpowpref_why) "\t$msg were changed\n" 1895 } 1896 } 1778 1897 } 1779 1898 pref*-get { … … 2605 2724 [expr {$Uequiv * $A(2,3)}]" 2606 2725 } 2726 2727 #====================================================================== 2728 # conversion routines 2729 #====================================================================== 2730 2731 # convert x values to d-space 2732 proc tod {xlist hst} { 2733 global expmap 2734 if {[string range $expmap(htype_$hst) 2 2] == "T"} { 2735 return [toftod $xlist $hst] 2736 } elseif {[string range $expmap(htype_$hst) 2 2] == "C"} { 2737 return [tttod $xlist $hst] 2738 } elseif {[string range $expmap(htype_$hst) 2 2] == "E"} { 2739 return [engtod $xlist $hst] 2740 } else { 2741 return {} 2742 } 2743 } 2744 2745 # convert tof to d-space 2746 proc toftod {toflist hst} { 2747 set difc [expr {[histinfo $hst difc]/1000.}] 2748 set difc2 [expr {$difc*$difc}] 2749 set difa [expr {[histinfo $hst difa]/1000.}] 2750 set zero [expr {[histinfo $hst zero]/1000.}] 2751 set ans {} 2752 foreach tof $toflist { 2753 if {$tof == 0.} { 2754 lappend ans 0. 2755 } elseif {$tof == 1000.} { 2756 lappend ans 1000. 2757 } else { 2758 set td [expr {$tof-$zero}] 2759 lappend ans [expr {$td*($difc2+$difa*$td)/ \ 2760 ($difc2*$difc+2.0*$difa*$td)}] 2761 } 2762 } 2763 return $ans 2764 } 2765 2766 # convert two-theta to d-space 2767 proc tttod {twotheta hst} { 2768 set lamo2 [expr {0.5 * [histinfo $hst lam1]}] 2769 set zero [expr [histinfo $hst zero]/100.] 2770 set ans {} 2771 set cnv [expr {acos(0.)/180.}] 2772 foreach tt $twotheta { 2773 if {$tt == 0.} { 2774 lappend ans 99999. 2775 } elseif {$tt == 1000.} { 2776 lappend ans 0. 2777 } else { 2778 lappend ans [expr {$lamo2 / sin($cnv*($tt-$zero))}] 2779 } 2780 } 2781 return $ans 2782 } 2783 2784 # convert energy (edx-ray) to d-space 2785 # (note that this ignores the zero correction) 2786 proc engtod {eng hst} { 2787 set lam [histinfo $hst lam1] 2788 set zero [histinfo $hst zero] 2789 set ans {} 2790 set v [expr {12.398/(2.0*[sind[expr ($lam/2.0)]])}] 2791 foreach e $eng { 2792 if {$e == 0.} { 2793 lappend ans 1000. 2794 } elseif {$e == 1000.} { 2795 lappend ans 0. 2796 } else { 2797 lappend ans [expr {$v/$e}] 2798 } 2799 } 2800 return $ans 2801 } 2802 2803 # convert x values to Q 2804 proc toQ {xlist hst} { 2805 global expmap 2806 if {[string range $expmap(htype_$hst) 2 2] == "T"} { 2807 return [toftoQ $xlist $hst] 2808 } elseif {[string range $expmap(htype_$hst) 2 2] == "C"} { 2809 return [tttoQ $xlist $hst] 2810 } elseif {[string range $expmap(htype_$hst) 2 2] == "E"} { 2811 return [engtoQ $xlist $hst] 2812 } else { 2813 return {} 2814 } 2815 } 2816 # convert tof to Q 2817 proc toftoQ {toflist hst} { 2818 set difc [expr {[histinfo $hst difc]/1000.}] 2819 set difc2 [expr {$difc*$difc}] 2820 set difa [expr {[histinfo $hst difa]/1000.}] 2821 set zero [expr {[histinfo $hst zero]/1000.}] 2822 set 2pi [expr {4.*acos(0.)}] 2823 set ans {} 2824 foreach tof $toflist { 2825 if {$tof == 0.} { 2826 lappend ans 99999. 2827 } elseif {$tof == 1000.} { 2828 lappend ans 0. 2829 } else { 2830 set td [expr {$tof-$zero}] 2831 lappend ans [expr {$2pi * \ 2832 ($difc2*$difc+2.0*$difa*$td)/($td*($difc2+$difa*$td))}] 2833 } 2834 } 2835 return $ans 2836 } 2837 2838 # convert two-theta to Q 2839 proc tttoQ {twotheta hst} { 2840 set lamo2 [expr {0.5 * [histinfo $hst lam1]}] 2841 set zero [expr [histinfo $hst zero]/100.] 2842 set ans {} 2843 set cnv [expr {acos(0.)/180.}] 2844 set 2pi [expr {4.*acos(0.)}] 2845 foreach tt $twotheta { 2846 if {$tt == 0.} { 2847 lappend ans 0. 2848 } elseif {$tt == 1000.} { 2849 lappend ans 1000. 2850 } else { 2851 lappend ans [expr {$2pi * sin($cnv*($tt-$zero)) / $lamo2}] 2852 } 2853 } 2854 return $ans 2855 } 2856 # convert energy (edx-ray) to Q 2857 # (note that this ignores the zero correction) 2858 proc engtoQ {eng hst} { 2859 set lam [histinfo $hst lam1] 2860 set zero [histinfo $hst zero] 2861 set ans {} 2862 set v [expr {12.398/(2.0*[sind[expr ($lam/2.0)]])}] 2863 set 2pi [expr {4.*acos(0.)}] 2864 foreach e $eng { 2865 if {$e == 0.} { 2866 lappend ans 0. 2867 } elseif {$e == 1000.} { 2868 lappend ans 1000. 2869 } else { 2870 lappend ans [expr {$2pi * $e / $v}] 2871 } 2872 } 2873 return $ans 2874 } 2875 proc sind {angle} { 2876 return [expr {sin($angle*acos(0.)/90.)}] 2877 } 2878 2879 # convert d-space values to 2theta, TOF or KeV 2880 proc fromd {dlist hst} { 2881 global expmap 2882 if {[string range $expmap(htype_$hst) 2 2] == "T"} { 2883 set difc [expr {[histinfo $hst difc]/1000.}] 2884 set difa [expr {[histinfo $hst difa]/1000.}] 2885 set zero [expr {[histinfo $hst zero]/1000.}] 2886 set ans {} 2887 foreach d $dlist { 2888 if {$d == 0.} { 2889 lappend ans 0. 2890 } elseif {$d == 1000.} { 2891 lappend ans 1000. 2892 } else { 2893 lappend ans [expr {$difc*$d + $difa*$d*$d + $zero}] 2894 } 2895 } 2896 return $ans 2897 } elseif {[string range $expmap(htype_$hst) 2 2] == "C"} { 2898 set lamo2 [expr {0.5 * [histinfo $hst lam1]}] 2899 set zero [expr [histinfo $hst zero]/100.] 2900 set ans {} 2901 set cnv [expr {180./acos(0.)}] 2902 foreach d $dlist { 2903 if {$d == 99999.} { 2904 lappend ans 0 2905 } elseif {$d == 0.} { 2906 lappend ans 1000. 2907 } else { 2908 lappend ans [expr {$cnv*asin($lamo2/$d) + $zero}] 2909 } 2910 } 2911 return $ans 2912 } elseif {[string range $expmap(htype_$hst) 2 2] == "E"} { 2913 set lam [histinfo $hst lam1] 2914 set zero [histinfo $hst zero] 2915 set v [expr {12.398/(2.0*[sind[expr ($lam/2.0)]])}] 2916 set ans {} 2917 foreach d $dlist { 2918 if {$d == 1000.} { 2919 lappend ans 0 2920 } elseif {$d == 0.} { 2921 lappend ans 1000. 2922 } else { 2923 lappend ans [expr {$v/$d}] 2924 } 2925 } 2926 return $ans 2927 } else { 2928 return {} 2929 } 2930 } 2931 2932 # convert Q values to 2theta, TOF or KeV 2933 proc fromQ {Qlist hst} { 2934 global expmap 2935 if {[string range $expmap(htype_$hst) 2 2] == "T"} { 2936 set difc [expr {[histinfo $hst difc]/1000.}] 2937 set difa [expr {[histinfo $hst difa]/1000.}] 2938 set zero [expr {[histinfo $hst zero]/1000.}] 2939 set ans {} 2940 foreach Q $Qlist { 2941 if {$Q == 0.} { 2942 lappend ans 1000. 2943 } elseif {$Q == 99999.} { 2944 lappend ans 1000. 2945 } else { 2946 set d [expr {4.*acos(0.)/$Q}] 2947 lappend ans [expr {$difc*$d + $difa*$d*$d + $zero}] 2948 } 2949 } 2950 return $ans 2951 } elseif {[string range $expmap(htype_$hst) 2 2] == "C"} { 2952 set lamo4pi [expr {[histinfo $hst lam1]/(8.*acos(0.))}] 2953 set zero [expr [histinfo $hst zero]/100.] 2954 set ans {} 2955 set cnv [expr {180./acos(0.)}] 2956 foreach Q $Qlist { 2957 if {$Q == 0.} { 2958 lappend ans 0 2959 } elseif {$Q == 1000.} { 2960 lappend ans 1000. 2961 } else { 2962 lappend ans [expr {$cnv*asin($Q*$lamo4pi) + $zero}] 2963 } 2964 } 2965 return $ans 2966 } elseif {[string range $expmap(htype_$hst) 2 2] == "E"} { 2967 set lam [histinfo $hst lam1] 2968 set zero [histinfo $hst zero] 2969 set v [expr {12.398/(2.0*[sind[expr ($lam/2.0)]])}] 2970 set ans {} 2971 set 2pi [expr {4.*acos(0.)}] 2972 foreach Q $Qlist { 2973 if {$Q == 1000.} { 2974 lappend ans 0 2975 } elseif {$Q == 0.} { 2976 lappend ans 1000. 2977 } else { 2978 lappend ans [expr {$Q * $v/$2pi}] 2979 } 2980 } 2981 return $ans 2982 } else { 2983 return {} 2984 } 2985 }
Note: See TracChangeset
for help on using the changeset viewer.