source: branches/sandbox/Geo_Viewer.tcl @ 1028

Last change on this file since 1028 was 1027, checked in by chlake, 11 years ago

Added standard uncertainties, Dmax filter and fixed a few bugs.

File size: 15.0 KB
Line 
1#Revision 1 Prints Bond Distances, no ability to sort.
2
3#List of Global Variables:
4#::geo_atomtype($atype1)        contains atom id codes for a particular atom type (atype1)
5#::geo_atomlabel($alabel1)      contains atom id code for a particular atom  (alabel1)
6#::geo_enable($x)               switch to enable bond angle/distance determination.
7#::geo_atomtype                 filtered atom type
8
9#::geo_bond_list   list of bond lengths
10#                  0    phase number
11#                  1    atom 1 code
12#                  2    atom 2 code
13#                  3    atom 1 type
14#                  4    atom 2 type
15#                  5    atom 1 label
16#                  6    atom 2 label
17#                  7    distance
18#                  8    esd
19#                  9    symm code
20#                  10   tranlational symm
21#::geo_angle_list list of bond angles
22#                  0    phase number
23#                  1    atom 1 code (central)
24#                  2    atom 2 code
25#                  3    atom 3 code
26#                  4    atom 1 type (central)
27#                  5    atom 2 type
28#                  6    atom 3 type
29#                  7    atom 1 label (central)
30#                  8    atom 2 label
31#                  9    atom 3 label
32#                  10   angle
33#                  11   esd
34#                  12   symm atom 2
35#                  13   trans atom 2
36#                  14   symm atom 3
37#                  15   trans atom 3
38
39proc Geo_Initialize {} {
40     set ::geo_entryvar(atomtype) "all"
41     catch {unset ::geo_enable}
42     catch {unset ::geo_angles}
43     catch {unset ::geo_bonds}
44     catch {unset ::geo_angle_keys}
45     catch {unset ::geo_phase_list}
46     array set ::geo_angles ""
47     array set ::geo_bonds ""
48     set ::geo_alist ""
49     set ::geo_filterval 5.00
50}
51
52proc Geo_Read {filename} {
53
54   if {[file exists $filename]} {
55   set fh [open $filename r]
56   } else {
57     puts "$filename not found in directory [pwd]"
58   }
59
60   set bond_total -1
61   set angle_total -1
62
63   catch {unset ::geo_phase_list}
64   catch {unset ::geo_angles}
65   catch {unset ::geo_bonds}
66   array set ::geo_bonds ""
67   array set ::geo_angles ""
68   array set ::geo_angle_keys ""
69
70
71   while {[gets $fh line] >= 0} {
72        if {[lindex $line 2] == 0} {
73            incr bond_total
74            set temp $line
75            set t1 ""
76            set phase [lindex $temp 1]
77            set b_dist [lindex $temp 3]
78            set b_esd [lindex $temp 4]
79            set atom1 [lindex $temp 5]
80            set atom2 [lindex $temp 6]
81            set atype1 [atominfo $phase [lindex $temp 5] type]
82            set atype2 [atominfo $phase [lindex $temp 6] type]
83            set atype1 [lindex [split $atype1 {+-}] 0]
84            set atype2 [lindex [split $atype2 {+-}] 0]
85            set alabel1 [atominfo $phase [lindex $temp 5] label]
86            set alabel2 [atominfo $phase [lindex $temp 6] label]
87            set symmcode [string map {" " ""} [set t2 "[lindex $temp 7][lindex $temp 8]"]]
88            set key1 [string map {" " ""} [set t2 "${symmcode}_[lindex $atom2]"]]
89            lappend t1 $phase $atom1 $atom2 $atype1 $atype2 $alabel1 $alabel2 $b_dist $b_esd $symmcode $key1
90            lappend ::geo_bonds($phase,$atom1) $t1
91            lappend ::geo_phase_list $phase
92
93            #create atom lists, remove duplicates
94            lappend ::geo_atomtype${phase}(all) [lindex $temp 5]
95            lappend ::geo_atomtype${phase}($atype1) [lindex $temp 5]
96            set ::geo_atomtype${phase}(all) [lsort -integer -uniq [set ::geo_atomtype${phase}(all)]]
97            set ::geo_atomtype${phase}($atype1) [lsort -integer -uniq [set ::geo_atomtype${phase}($atype1)]]
98
99        } elseif {[lindex $line 2] == 1} {
100            incr angle_total
101            set temp $line
102            set t1 ""
103            set phase [lindex $temp 1]
104            set b_angle [lindex $temp 3]
105            set b_esd [lindex $temp 4]
106            set atom1 [lindex $temp 5]
107            set atom2 [lindex $temp 6]
108            set atom3 [lindex $temp 7]
109            set alabel1 [atominfo $phase [lindex $temp 5] label]
110            set alabel2 [atominfo $phase [lindex $temp 6] label]
111            set alabel3 [atominfo $phase [lindex $temp 7] label]
112            set symmcode1 [string map {" " ""} [set t2 "[lindex $temp 8][lindex $temp 9]"]]
113            set symmcode3 [string map {" " ""} [set t3 "[lindex $temp 10][lindex $temp 11]"]]
114            set key1 [string map {" " ""} [set t2 "${symmcode1}_[lindex $atom1]"]]
115            set key3 [string map {" " ""} [set t3 "${symmcode3}_[lindex $atom3]"]]
116            lappend t1 $phase $atom1 $atom2 $atom3 $alabel1 $alabel2 $alabel3 \
117                         $b_angle $b_esd $key1 $key3
118            lappend ::geo_phase_list $phase
119            set ::geo_angles($phase,$key1,$atom2,$key3) $t1
120        }
121   }
122   set ::geo_phase_list [lsort -integer -uniq $::geo_phase_list]
123   close $fh
124}
125
126proc Geo_Viewer {args} {
127
128    # Run DISAGL
129    global expgui
130    pleasewait "searching interatomic distances"
131    # save EXP file if changed
132    savearchiveexp
133    set root [file root $expgui(expfile)]
134    catch {file delete -force $root.disagl}
135    close [open disagl.inp w]
136    catch {exec [file join $expgui(gsasexe) disagl] \
137               [file tail $root] < disagl.inp > disagl.out}
138    catch {file delete -force disagl.inp disagl.out}
139    if {! [file exists $root.disagl]} {
140        MyMessageBox -parent . -title "DISAGL Problem" \
141            -message "Unable to run DISAGL. Do you have problems writing files in [pwd]?" \
142            -icon error
143        donewait
144        return
145    }
146
147    # load DISAGL distances
148    Geo_Read $root.disagl
149    donewait
150     set mcb .maincontrolbox
151     catch {toplevel $mcb}
152     eval destroy [winfo children $mcb]
153     wm title $mcb "Viewer for Bond Distances and Angles"
154
155     raise $mcb
156     set sc $mcb.sortcon
157     set as $mcb.atomselect
158     set ad $mcb.atomdistlist
159     set dc $mcb.disaglcon
160
161     frame $sc -bd 2 -relief groove
162     frame $as -bd 2 -relief groove
163     frame $ad -bd 2 -relief groove
164     frame $dc -bd 2 -relief groove
165     grid $sc -column 0 -row 0 -sticky new
166     grid $as -column 0 -row 1 -sticky new
167     grid $ad -column 1 -row 0 -rowspan 3 -sticky nesw
168     grid $dc -column 0 -row 2
169
170     grid [button $dc.dcon -text "Run DISAGL Program" -command {DA_Control_Panel 1; unset ::geo_phase_list; Geo_Viewer}] \
171        -column 0 -row 0
172        $dc.dcon config -bd 4
173
174
175     grid rowconfigure $mcb 1 -weight 1
176     grid columnconfigure $mcb 1 -weight 1
177
178     label $sc.phlabel -text Phase
179#     eval tk_optionMenu $sc.phase ::geo_entryvar(phase) $::expmap(phaselist)
180     eval tk_optionMenu $sc.phase ::geo_entryvar(phase) $::geo_phase_list
181     label $sc.atom1 -text "Atom Type"
182     label $sc.filterlab -text "Dmax Filter"
183     entry $sc.filterval -textvariable ::geo_filterval
184          $sc.filterval config -width 6
185     #button $sc.engage -text "Print Info" -command Geo_Fill_Display
186     grid $sc.phlabel -row 0 -column 0
187     grid $sc.phase   -row 0 -column 1
188     grid $sc.atom1   -row 1 -column 0
189     grid $sc.filterlab   -row 2 -column 0
190     grid $sc.filterval -row 2 -column 1
191
192     label $as.atom -text "Choose Atom(s)"
193
194     grid $as.atom -row 0 -column 1
195
196     foreach {top main side lbl} [MakeScrollTable $as] {}
197     [winfo parent $main] config -bg [$main cget -bg]
198
199   foreach item [trace vinfo ::geo_entryvar(phase)] {
200       eval trace vdelete ::geo_entryvar(phase) $item
201   }
202   foreach item [trace vinfo ::geo_entryvar(atomtype)] {
203       eval trace vdelete ::geo_entryvar(atomtype) $item
204   }
205   set ::geo_entryvar(phase) [lindex $::geo_phase_list 0]
206   Geo_setPhase $sc $as $main
207   trace variable ::geo_entryvar(phase) w "Geo_setPhase $sc $as $main"
208   trace variable ::geo_entryvar(atomtype) w "Geo_setAtomType $sc $as $main"
209   Geo_Display
210       ResizeScrollTable $as
211       $as.can config -width [lindex [$as.can cget -scrollregion] 2]
212
213   }
214
215proc Geo_setPhase {sc as main args} {
216     catch {destroy $sc.atomtype}
217     catch {eval destroy [winfo children $::geo_main]}
218     catch {eval destroy [winfo children $::geo_side]}
219     set ::geo_entryvar(atomtype) all
220     set ::geo_alist ""
221     eval tk_optionMenu $sc.atomtype ::geo_entryvar(atomtype) \
222          "[lsort [array names ::geo_atomtype${::geo_entryvar(phase)}]]"
223     grid $sc.atomtype -column 1 -row 1
224     Geo_setAtomType  $sc $as $main
225}
226
227proc Geo_setAtomType {sc as main args} {
228   set ::geo_atomlist ""
229   set ::geo_atomlist [set ::geo_atomtype${::geo_entryvar(phase)}($::geo_entryvar(atomtype))]
230   set rownum 1
231   set colnum 1
232   eval destroy [winfo children $main]
233      foreach i $::geo_atomlist {
234             #puts $i
235             if {[expr $colnum % 5] == 0} {incr rownum; set colnum 1}
236             set x [atominfo $::geo_entryvar(phase) $i  label]
237             set xlower [string tolower $x]
238             set ::geo_enable($xlower) $i
239             #parray ::geo_enable
240             button $main.atom_$xlower -text "$x" -width 5 -command "Geo_Enable $main.atom_$xlower $::geo_enable($xlower)"
241             grid $main.atom_$xlower -column $colnum -row $rownum -padx 5 -pady 5
242             incr colnum
243
244             }
245      ResizeScrollTable $as
246      $as.can config -width [lindex [$as.can cget -scrollregion] 2]
247}
248
249proc Geo_Enable {main entry args} {
250
251        if {[$main cget -relief] == "raised"} {
252        lappend ::geo_alist $entry
253        $main config -bg green -relief sunken
254
255        } else {
256          set i [lsearch $::geo_alist $entry]
257          puts "seach = $i"
258          set ::geo_alist [string trim [lreplace $::geo_alist $i $i]]
259#          $main config -bg SystemButtonFace -relief raised
260          $main config -bg LightGray -relief raised
261        }
262   Geo_Fill_Display
263}
264
265proc Geo_Display {args} {
266     catch {destroy $as.$main}
267
268     set ad .maincontrolbox.atomdistlist
269     foreach {top ::geo_main ::geo_side lbl} [MakeScrollTable $ad] {}
270     [winfo parent $::geo_main] config -bg [$::geo_main cget -bg]
271
272     bind $ad <Configure> "catch {ResizeScrollTable $ad}"
273       ResizeScrollTable $ad
274       $ad.can config -width 500
275
276
277     #puts "$ad $::geo_main"
278
279 #    label $top.toplabel0 -text "Atom 1" -width 8
280     label $top.toplabel1 -text "Atom 2" -width 8
281     label $top.toplabel2 -text "symm" -width 8
282     label $top.toplabel3 -text "Distance" -width 8
283     label $top.toplabel4 -text "Angle"
284#     grid $top.toplabel0 -column 0 -row 0
285     grid $top.toplabel1 -column 0 -row 0
286     grid $top.toplabel2 -column 1 -row 0
287     grid $top.toplabel3 -column 2 -row 0
288     grid $top.toplabel4 -column 3 -row 0
289}
290proc Geo_Fill_Display {args} {
291     set rownum 0
292     set colnum 3
293     set bondnum 0
294     set counter 0
295     eval destroy [winfo children $::geo_main]
296     eval destroy [winfo children $::geo_side]
297
298     foreach i $::geo_alist {
299             set slist [lsort -index 7 $::geo_bonds($::geo_entryvar(phase),$i)]
300             set colnum 3
301             set keylist ""
302             set atmlist {}
303             set symlist {}
304             incr rownum
305             if {[string trim $::geo_filterval] == ""} {set ::geo_filterval 5.00}
306             foreach j $slist {
307                 if {[lindex $j 7] <= $::geo_filterval} {
308                    lappend keylist [lindex $j 10]
309                    lappend atmlist [lindex $j 6]
310                    lappend symlist [lindex $j 9]
311                    label $::geo_side.atom1${bondnum} -text [lindex $j 5] -width 8
312                    label $::geo_main.atom2${bondnum} -text [lindex $j 6] -width 8
313                    label $::geo_main.atom2symm${bondnum} -text [lindex $j 9] -width 8
314                    set bonddist [lindex $j 7]
315                    set bondesd  [lindex $j 8]
316                    set bondentry [formatSU $bonddist $bondesd]
317                    label $::geo_main.bonddist${bondnum} -text $bondentry -width 8
318
319                    grid $::geo_side.atom1${bondnum} -row $rownum -column 0
320                    grid $::geo_main.atom2${bondnum} -row $rownum -column 0
321                    grid $::geo_main.atom2symm${bondnum} -row $rownum -column 1
322                    grid $::geo_main.bonddist${bondnum} -row $rownum -column 2
323
324                    set key [lindex $j 10]
325                    set atom [lindex $j 1]
326                    set phase [lindex $j 0]
327
328
329                    foreach k $keylist {
330
331                            if {$key != $k} {
332                            # search for atom 1 - central atom - atom 2 angle.
333                            if {[array name ::geo_angles "$phase,$key,$atom,$k"] != ""} {
334                               set ang  [lindex $::geo_angles($phase,$key,$atom,$k) 7]
335                               set angesd [lindex $::geo_angles($phase,$key,$atom,$k) 8]
336                               set angentry [formatSU $ang $angesd]
337                               label $::geo_main.$counter -text $angentry
338#                               label $::geo_main.$counter -text [lindex $::geo_angles($phase,$key,$atom,$k) 7]
339                               grid $::geo_main.$counter -row $rownum -column $colnum -padx 5
340                               incr colnum
341                               incr counter
342                               # search for atom 2 - central atom - atom 1 angle.
343                            } elseif {[array name ::geo_angles "$phase,$k,$atom,$key"] != ""} {
344                               set ang  [lindex $::geo_angles($phase,$k,$atom,$key) 7]
345                               set angesd [lindex $::geo_angles($phase,$k,$atom,$key) 8]
346                               set angentry [formatSU $ang $angesd]
347                               label $::geo_main.$counter -text $angentry
348#                              label $::geo_main.$counter -text [lindex $::geo_angles($phase,$k,$atom,$key) 7]
349                              grid $::geo_main.$counter -row $rownum -column $colnum -padx 5
350
351                              incr colnum
352                              incr counter
353                            }
354                            }
355                    }
356                 incr bondnum
357                 incr rownum
358                 set colnum 3
359             }
360             }
361                  set colnum 3
362            incr rownum
363             foreach atm [lrange $atmlist 0 end-1] {
364                label $::geo_main.$counter -text $atm
365                grid $::geo_main.$counter -row $rownum -column $colnum
366                    incr colnum
367                    incr counter
368             }
369                 set colnum 3
370             incr rownum
371             foreach sym [lrange $symlist 0 end-1] {
372                label $::geo_main.$counter -text $sym
373                grid $::geo_main.$counter -row $rownum -column $colnum
374                    incr colnum
375                    incr counter
376             }
377              incr rownum
378             grid rowconfigure $::geo_main $rownum  -minsize 10
379}
380ResizeScrollTable [winfo parent [winfo parent $::geo_main]]
381MouseWheelScrollTable [winfo parent [winfo parent $::geo_main]]
382}
383proc Geo_Print {} {
384}
385
386Geo_Initialize
387#Geo_Read TEST.DISAGL
388#Geo_Viewer
389
Note: See TracBrowser for help on using the repository browser.