Changeset 674 for trunk


Ignore:
Timestamp:
Dec 4, 2009 5:10:07 PM (13 years ago)
Author:
toby
Message:

# on 2003/04/10 22:14:21, toby did:
more sig figs on small numbers (switch to scientific notation earlier)
implement powpref warning
update absorption correction to blank spaces
add data conversion routines (from excledt)

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  
    263263    if [catch {
    264264        # for small values, switch to exponential notation
    265         set pow [expr .2 - $decimal]
     265        # 2 -> three sig figs.
     266        set pow [expr 2 - $decimal]
    266267        if {abs($value) < pow(10,$pow) && $length > 6} {
     268            # try to make it fit
     269            if {$length - $decimal < 5} {set decimal [expr $length -5]}
    267270            set tmp [format "%${length}.${decimal}E" $value]
    268271        } else {
    … …  
    12811284                if ![validreal value 10 7] {return 0}
    12821285                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                }
    12831295            }
    12841296            difa-get -
    … …  
    12901302                if ![validreal value 10 7] {return 0}
    12911303                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                }
    12921313            }
    12931314            zero-get {
    … …  
    12971318                if ![validreal value 10 5] {return 0}
    12981319                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                }
    12991329            }
    13001330            ipola-get {
    … …  
    15521582                    setexp $k ${r1}${r2} 1 20
    15531583                }
     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                }
    15541593            }
    15551594            file-get {
    … …  
    15681607                if ![validreal value 10 4] {return 0}
    15691608                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                }
    15701618            }
    15711619            use-get {
    … …  
    15851633                    setexp " EXPR  HTYP$k" "*" $j 1
    15861634                }
     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                }
    15871644            }
    15881645            dstart-get {
    … …  
    15921649                if ![validreal value 10 3] {return 0}
    15931650                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                }
    15941660            }
    15951661            dstep-get {
    … …  
    15991665                if ![validreal value 10 3] {return 0}
    16001666                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                }
    16011675            }
    16021676            dpoints-get {
    … …  
    16061680                if ![validint value 10] {return 0}
    16071681                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                }
    16081690            }
    16091691            dtype-get {
    … …  
    16141696            }
    16151697            abscor1-set {
    1616                 if ![validreal value 15 8] {return 0}
     1698                if ![validreal value 15 7] {return 0}
    16171699                setexp "${key}ABSCOR" $value 1 15
    16181700            }
    … …  
    16211703            }
    16221704            abscor2-set {
    1623                 if ![validreal value 15 8] {return 0}
     1705                if ![validreal value 15 7] {return 0}
    16241706                setexp "${key}ABSCOR" $value 16 15
    16251707            }
    … …  
    16371719            }
    16381720            absdamp-set {
    1639                 setexp "${key}ABSCOR" $value 40 1
     1721                if ![validint value 5] {return 0}
     1722                setexp "${key}ABSCOR" $value 36 5
    16401723            }
    16411724            absref-get {
    … …  
    16481731            absref-set {
    16491732                if $value {
    1650                     setexp "${key}ABSCOR" "Y" 35 1
     1733                    setexp "${key}ABSCOR" "    Y" 31 5
    16511734                } else {
    1652                     setexp "${key}ABSCOR" "N" 35 1
     1735                    setexp "${key}ABSCOR" "    N" 31 5
    16531736                }
    16541737            }
    … …  
    17331816                if ![validint value 5] {return 0}
    17341817                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                }
    17351827            }
    17361828            profterms-get {
    … …  
    17471839                    makeexprec "${key}PRCF $i"
    17481840                }
     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                }
    17491850            }
    17501851            pcut-get {
    … …  
    17541855                if ![validreal value 10 5] {return 0}
    17551856                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                }
    17561866            }
    17571867            pdamp-get {
    … …  
    17761886                set line  [expr {1 + ($num - 1) / 4}]
    17771887                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                }
    17781897            }
    17791898            pref*-get {
    … …  
    26052724            [expr {$Uequiv * $A(2,3)}]"
    26062725}
     2726
     2727#======================================================================
     2728# conversion routines
     2729#======================================================================
     2730
     2731# convert x values to d-space
     2732proc 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
     2746proc 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
     2767proc 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)
     2786proc 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
     2804proc 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
     2817proc 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
     2839proc 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)
     2858proc 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}
     2875proc sind {angle} {
     2876    return [expr {sin($angle*acos(0.)/90.)}]
     2877}
     2878
     2879# convert d-space values to 2theta, TOF or KeV
     2880proc 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
     2933proc 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.