source: trunk/odf.tcl @ 304

Last change on this file since 304 was 304, checked in by toby, 11 years ago

# on 2000/10/03 23:29:29, toby did:
Add definitions and implementation for entrybox array so that invalid
numbers are set to red. Valid ones, or when numbers are reread from
the .EXP are turned back to black

  • Property rcs:author set to toby
  • Property rcs:date set to 2000/10/03 23:29:29
  • Property rcs:lines set to +7 -3
  • Property rcs:rev set to 1.4
  • Property rcs:state set to Exp
  • Property svn:keywords set to Author Date Revision Id
File size: 12.6 KB
Line 
1# $Id: odf.tcl 304 2009-12-04 23:03:49Z toby $
2proc LaueCode2number {laueaxis} {
3    switch -exact $laueaxis {
4        1bar {return 1}
5        2/ma -
6        2/mb -
7        2/mc {return 2}
8        mmm  {return 3}
9        4/{return 4}
10        4/mmm {return 5}
11        3barR     {return 6}
12        "3bar mR" {return 7}
13        3bar    {return 8} 
14        3barm1 {return 9}
15        3bar1m  {return 10}
16        6/m    {return 11}
17        6/mmm  {return 12}
18        "m 3"  {return 13}
19        m3m    {return 14}
20        default {return ""}
21    }
22}
23
24# computes a list of ODF (l,m,n) terms for a given spherical harmonic order,
25#   sample symmetry and Laue symmetry
26proc ComputeODFterms {order ISAMSYM laueaxis} {
27
28    set laue [LaueCode2number $laueaxis]
29
30    set odflist {}
31    set ITOT 0
32    for {set I 2} {$I <= $order} {incr I 2} {
33        for {set M -$I} {$M <= $I} {incr M 1} {
34            if {[odfchk $ISAMSYM $I $M]} {
35                for {set N -$I} {$N <= $I} {incr N 1} {
36                    if {[odfchk $laue $I $N]} {
37                        incr ITOT
38                        lappend odflist [list $I $M $N]
39                    }
40                }
41            }
42        }
43    }
44    return $odflist
45}
46
47#PURPOSE: To determine if spherical harmonic term C(l,m) is allowed
48#   in LAUE group
49# based on GSAS FUNCTION ODFCHK(LAUE,L,M)
50proc odfchk {laue l m} {
51
52    set ODFCHK 0
53    if { $l % 2 == 0 && abs($m) <= $l } {
54        if { $laue == 0 } {
55            #Cylindricaly symmetric
56            if { $m == 0 } {set ODFCHK 1}
57        } elseif { $laue == 1 } {
58            #1-bar
59            set ODFCHK 1
60        } elseif { $laue == 2 } {
61            #2/m
62            if { abs($m) % 2 == 0 } {set ODFCHK 1}
63        } elseif { $laue == 3 } {
64            #mmm
65            if { abs($m) % 2 == 0 && $m >= 0 } {set ODFCHK 1}
66        } elseif { $laue == 4 } {
67            #4/m
68            if { abs($m) % 4 == 0 } {set ODFCHK 1}
69        } elseif { $laue == 5 } {
70            #4/mmm
71            if { abs($m) % 4 == 0 && $m >= 0 } {set ODFCHK 1}
72        } elseif { $laue == 6 } {
73            #R-3 R
74            if { abs($m) % 3 == 0 } {set ODFCHK 1}
75        } elseif { $laue == 7 } {
76            #R-3m R
77            if { abs($m) % 3 == 0 && $m >= 0 } {set ODFCHK 1}
78        } elseif { $laue == 8 } {
79            #-3
80            if { abs($m) % 3 == 0 } {set ODFCHK 1}
81        } elseif { $laue == 9 } {
82            #-3m1
83            if { abs($m) % 3 == 0 && $m >= 0 } {set ODFCHK 1}
84        } elseif { $laue == 10 } {
85            #-31m
86            if { abs($m) % 3 == 0 && $m >= 0 } {set ODFCHK 1}
87        } elseif { $laue == 11 } {
88            #6/m
89            if { abs($m) % 6 == 0 } {set ODFCHK 1}
90        } elseif { $laue == 12 } {
91            #6/mmm
92            if { abs($m) % 6 == 0 && $m >= 0 } {set ODFCHK 1}
93        } elseif { $laue == 13 } {
94            #m3
95            if { $m > 0 } {
96                if { $l % 12 == 2 } {
97                    if {$m <= ($l/12) } {set ODFCHK 1}
98                } else {
99                    if {$m <= ($l/12+1) } {set ODFCHK 1}
100                }
101            }
102        } elseif { $laue == 14 } {
103            #m3m
104            if { $m > 0 } {
105                if { $l % 12 == 2 } {
106                    if {$m <= ($l/12) } {set ODFCHK 1}
107                } else {
108                    if {$m <= ($l/12+1) } {set ODFCHK 1}
109                }
110            }
111        }
112    }
113    return $ODFCHK
114}
115
116proc MakeODFPane {} {
117    global expgui entryvar entrycmd entrybox
118    if $expgui(haveBW) {
119        pack [TitleFrame $expgui(odfFrame).f1 -bd 4 \
120                -text "Spherical Harmonic (ODF) Preferential Orientation" \
121                -relief groove] -side top -expand yes -fill x -anchor n
122        set expgui(odfFrameTop) [$expgui(odfFrame).f1 getframe]
123    } else {
124        pack [label $expgui(odfFrame).f0 \
125                -text "Spherical Harmonic (ODF) Preferential Orientation"] \
126                -side top -expand yes -fill x -anchor n
127        set expgui(odfFrameTop) [frame $expgui(odfFrame).top]
128        grid $expgui(odfFrameTop) -side top -expand yes -fill x -anchor n
129    }
130
131    grid [frame  $expgui(odfFrameTop).ps] -column 0 -row 0 -sticky w
132    # this is where the buttons will go
133    pack [label $expgui(odfFrameTop).ps.0 -text "No Phases"] -side left
134   
135    grid [label $expgui(odfFrameTop).lA -text " title:" \
136            -fg blue ] -column 1 -row 0 -sticky e
137    grid columnconfig $expgui(odfFrameTop) 1 -weight 1
138    grid [entry $expgui(odfFrameTop).lB -textvariable entryvar(phasename) \
139            -fg blue -width 45] -column 2 -columnspan 10 -row 0 -sticky e
140    grid columnconfigure $expgui(odfFrameTop) 1 -weight 1
141
142    set row 1
143    set angframe [frame $expgui(odfFrameTop).ang]
144    grid $angframe -row 2 -column 0 -columnspan 10
145    grid [label $angframe.l -text "Setting\nangles: "] \
146            -column 0 -row $row
147    foreach col {1 4 7} var {omega chi phi} lbl {w c f} {
148        grid [label $angframe.l$var -text $lbl -font symbol] \
149                -column $col -row $row -padx 5 -sticky e
150        incr col
151        grid [checkbutton $angframe.r$var \
152                -variable entryvar(ODF${var}Ref)] \
153                -column $col -row $row 
154        incr col
155        grid [entry $angframe.e$var \
156                -textvariable entryvar(ODF$var) -width 10] \
157                -column $col -row $row -padx 5
158        set entrybox(ODF$var) $angframe.e$var
159    }
160    grid [label $angframe.lDamp -text "Damping  "] \
161            -column [incr col] -row $row
162    tk_optionMenu $angframe.om entryvar(ODFdampA) 0 1 2 3 4 5 6 7 8 9
163    grid $angframe.om -column [incr col] -row $row
164
165    #
166    set ordframe [frame $expgui(odfFrameTop).ord]
167    grid $ordframe -row 1 -column 0 -columnspan 10
168    set col -1
169    grid [label $ordframe.lo -text "Spherical\nHarmonic Order: "] \
170            -column [incr col] -row $row
171    set ordmenu [tk_optionMenu $ordframe.ord expgui(ODForder) 0]
172    $ordmenu delete 0 end
173    for {set i 0} {$i <= 34} {incr i 2} {
174        $ordmenu insert end radiobutton -variable expgui(ODForder) \
175                -label $i -value $i -command SetODFTerms
176    }
177    $ordframe.ord config -width 3
178    grid $ordframe.ord -column [incr col] -row $row
179
180    grid [label $ordframe.ls -text "Sample\nsymmetry: "] \
181            -column [incr col] -row $row
182    set expgui(ODFsym) {}
183    set expgui(symmenu) [tk_optionMenu $ordframe.sym expgui(ODFsymLbl) \
184            Cylindrical None "Shear (2/m)" "Rolling (mmm)"]
185    grid $ordframe.sym -column [incr col] -row $row
186    for {set i 0} {$i <= [$expgui(symmenu) index end]} {incr i} {
187        $expgui(symmenu) entryconfigure $i -command "SetODFSym $i"
188    }
189    $ordframe.sym config -width 12
190    grid [label $ordframe.lr -text "Refine ODF\ncoefficients"] \
191                -column [incr col] -row $row -padx 5 -sticky e
192    grid [checkbutton $ordframe.r \
193                -variable entryvar(ODFRefcoef)] \
194                -column [incr col] -row $row 
195    grid [label $ordframe.lDamp -text "Damping  "] \
196            -column [incr col] -row $row
197    tk_optionMenu $ordframe.om entryvar(ODFdampC) 0 1 2 3 4 5 6 7 8 9
198    grid $ordframe.om -column [incr col] -row $row
199    if $expgui(haveBW) {
200        pack [TitleFrame $expgui(odfFrame).f2 -bd 4 \
201                -text "Spherical Harmonic Terms: (l,m,n) & coeff's" \
202                -relief groove] -side top -fill both -expand yes -anchor n
203        set canvasfr [$expgui(odfFrame).f2 getframe]
204    } else {
205        set canvasfr [frame $expgui(odfFrame).f3 -bd 4 -relief groove]
206        pack $canvasfr -side top -expand yes -fill both -anchor n
207        grid [label $canvasfr.l \
208                -text "Spherical Harmonic Terms: (l,m,n) & coeff's"] \
209                -sticky news -row 0 -column 0 
210    }
211
212    set expgui(odfFrameCanvas) $canvasfr.canvas
213    set expgui(odfFrameScroll) $canvasfr.scroll
214    grid [canvas $expgui(odfFrameCanvas) \
215            -scrollregion {0 0 5000 500} -width 0 -height 250 \
216            -yscrollcommand "$expgui(odfFrameScroll) set"] \
217            -row 3 -column 0 -sticky ns
218    grid rowconfigure $expgui(odfFrameTop) 3 -weight 1
219    scrollbar $expgui(odfFrameScroll) \
220            -command "$expgui(odfFrameCanvas) yview"
221    frame $expgui(odfFrameCanvas).fr
222    $expgui(odfFrameCanvas) create window 0 0 -anchor nw -window $expgui(odfFrameCanvas).fr
223}
224
225proc SetODFSym {i} {
226    global expgui
227    if {$expgui(ODFsym) == $i} return
228    set expgui(ODFsym) $i
229    set expgui(ODForder) 0
230    SetODFTerms
231}
232
233proc SetODFTerms {} {
234    global expgui
235    if {$expgui(curPhase) == ""} return
236    set curterms [phaseinfo $expgui(curPhase) ODFterms]
237    set laueaxis [GetLaue [phaseinfo $expgui(curPhase) spacegroup]]
238    set newterms [ComputeODFterms $expgui(ODForder) $expgui(ODFsym) $laueaxis]
239    phaseinfo $expgui(curPhase) ODFterms set $newterms
240    phaseinfo $expgui(curPhase) ODForder set $expgui(ODForder)
241    phaseinfo $expgui(curPhase) ODFsym set $expgui(ODFsym)
242    # zero out the new terms
243    for {set i [expr [llength $curterms]+1]} \
244            {$i <= [llength $newterms]} {incr i} {
245        phaseinfo $expgui(curPhase) ODFcoef$i set 0.
246   }
247    incr expgui(changed)
248    SelectODFPhase $expgui(curPhase)
249}
250
251proc DisplayODFPane {} {
252    global expgui expmap
253    eval destroy [winfo children $expgui(odfFrameTop).ps]
254    pack [label $expgui(odfFrameTop).ps.0 -text Phase:] -side left
255    foreach num $expmap(phaselist) type $expmap(phasetype) {
256        pack [button $expgui(odfFrameTop).ps.$num -text $num \
257                -command "SelectODFPhase $num" -padx 1.5m] -side left
258        if {$type > 3} {
259            $expgui(odfFrameTop).ps.$num config -state disabled
260        }
261    }
262    # select the current phase
263    SelectODFPhase $expgui(curPhase)
264}
265
266proc SelectODFPhase {num} {
267    global entryvar entrycmd entrybox expmap expgui
268    set crsPhase {}
269    foreach n $expmap(phaselist) type $expmap(phasetype) {
270        if {$n == $num && $type <= 3} {
271            set crsPhase $num
272            catch {$expgui(odfFrameTop).ps.$num config -relief sunken}
273        } else { 
274            catch {$expgui(odfFrameTop).ps.$n config -relief raised}
275        }
276    }
277
278    # disable traces on entryvar until we are ready
279    set entrycmd(trace) 0
280
281    eval destroy [winfo children $expgui(odfFrameCanvas).fr]
282
283    if {$crsPhase == "" || [llength $expmap(phaselist)] == 0} {
284        # blank out the page
285        set expgui(ODFsymLbl) {}
286        set expgui(ODForder) {}
287        foreach var {omega chi phi omegaRef chiRef phiRef \
288                dampC dampA Refcoef} {
289            set entrycmd(ODF$var) {}
290            set entryvar(ODF$var) {}
291        }
292        set entryvar(phasename) {}
293        set entryvar(phasename) {}
294        grid forget $expgui(odfFrameScroll) 
295        set entrycmd(trace) 1
296        return
297    }
298    # phase name
299    set entrycmd(phasename) "phaseinfo $crsPhase name"
300    set entryvar(phasename) [phaseinfo $crsPhase name]
301    # ODFsym   -- sample symmetry (0-3) (*)
302    # prevent SetODFTerms from being run
303    set expgui(curPhase) {}
304    catch {$expgui(symmenu) invoke 0}
305    catch {$expgui(symmenu) invoke [phaseinfo $crsPhase ODFsym]}
306    set expgui(curPhase) $crsPhase
307    # ODForder -- spherical harmonic order (*)
308    set expgui(ODForder) [phaseinfo $expgui(curPhase) ODForder]
309    # ODFomega -- omega oriention angle (*)
310    # ODFchi -- chi oriention angle (*)
311    # ODFphi -- phi oriention angle (*)
312    # ODFomegaRef -- refinement flag for omega (*)
313    # ODFchiRef -- refinement flag for chi (*)
314    # ODFphiRef -- refinement flag for phi (*)
315    # ODFdampA -- damping for angles (*)
316    # ODFdampC -- damping for coefficients (*)
317    # ODFRefcoef -- refinement flag for ODF terms (*)
318    foreach var {omega chi phi omegaRef chiRef phiRef dampC dampA Refcoef} {
319        set entrycmd(ODF$var) "phaseinfo $expgui(curPhase) ODF$var"
320        set entryvar(ODF$var) [eval $entrycmd(ODF$var)]
321        # reset to black
322        catch {$entrybox(ODF$var) config -fg black}
323    }
324    #
325    set row 0
326    set term 0
327    set col 99
328    #     ODFterms -- a list of the {l m n} values for each ODF term (*)
329    #     ODFcoefXXX -- the ODF coefficient for for ODF term XXX (*)
330    set textureindex 1.0
331    foreach lmn [phaseinfo $expgui(curPhase) ODFterms] {
332        # make sure that numbers are separated by spaces
333        regsub -all -- "-" $lmn " -" lmn
334        incr term
335        if {$col > 5} {
336            incr row 2
337            grid rowconfig $expgui(odfFrameCanvas).fr $row \
338                    -minsize 2 -pad 10
339            set col 0
340        }
341        set lbl [eval format (%d,%d,%d) $lmn]
342        grid [label $expgui(odfFrameCanvas).fr.l$term -text $lbl] \
343                -column [incr col] -row $row -sticky s
344#       grid columnconfig $expgui(odfFrameCanvas).fr $col -pad 4
345        grid [entry $expgui(odfFrameCanvas).fr.e$term \
346                -width 10 -textvariable entryvar(ODFcoef$term)] \
347                -column $col -row [expr $row+1]
348        set entrycmd(ODFcoef$term) "phaseinfo $expgui(curPhase) ODFcoef$term"
349        set entryvar(ODFcoef$term) [eval $entrycmd(ODFcoef$term)]
350        set entrybox(ODFcoef$term) $expgui(odfFrameCanvas).fr.e$term
351        grid columnconfig $expgui(odfFrameCanvas).fr $col -pad 12
352        set textureindex [expr {$textureindex + \
353                ($entryvar(ODFcoef$term) * $entryvar(ODFcoef$term)) \
354                / ((2. * [lindex $lmn 0]) + 1.)}]
355    }
356
357    if {$term == 0} {
358        grid [label $expgui(odfFrameCanvas).fr.no -text "no terms" \
359                -anchor center] \
360                -column 0 -row 0 -sticky nsew
361    } else {
362        incr row 2
363        grid [label $expgui(odfFrameCanvas).fr.last \
364                -bd 2 -relief sunken -anchor center \
365                -text "Texture index = [format %.4f $textureindex]" ] \
366                -column 1 -columnspan 6 -row $row -sticky ew
367        grid rowconfig $expgui(odfFrameCanvas).fr $row -pad 12
368    }
369    # resize
370    update 
371    set sizes [grid bbox $expgui(odfFrameCanvas).fr]
372    set maxhgt 220
373    # use the scroll for BIG atom lists
374    if {[lindex $sizes 3] > $maxhgt} {
375        grid $expgui(odfFrameScroll) -sticky ns -column 1 -row 3
376        set height $maxhgt
377    } else {
378        grid forget $expgui(odfFrameScroll) 
379        set height [lindex $sizes 3]
380    }
381    $expgui(odfFrameCanvas) config -scrollregion $sizes \
382            -width [lindex $sizes 2] -height $height
383    set entrycmd(trace) 1
384}
385
386#debug code
387#set expgui(odfFrame) .test
388#catch {destroy $expgui(odfFrame)}
389#toplevel $expgui(odfFrame)
390#MakeODFPane
391#DisplayODFPane
Note: See TracBrowser for help on using the repository browser.