source: branches/sandbox/Geo_Viewer.tcl @ 1139

Last change on this file since 1139 was 1117, checked in by toby, 14 years ago

fail gracefully when DISAGL fails
File size: 15.3 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   set ::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    if {[llength  $::geo_phase_list] == 0} {
151        MyMessageBox -parent . -title "DISAGL Problem" \
152            -message "No output found in DISAGL output. Is something wrong with DISAGL settings or this .EXP file?" \
153            -icon error
154        return
155    }
156     set mcb .maincontrolbox
157     catch {toplevel $mcb}
158     eval destroy [winfo children $mcb]
159     wm title $mcb "Viewer for Bond Distances and Angles"
160
161     raise $mcb
162     set sc $mcb.sortcon
163     set as $mcb.atomselect
164     set ad $mcb.atomdistlist
165     set dc $mcb.disaglcon
166
167     frame $sc -bd 2 -relief groove
168     frame $as -bd 2 -relief groove
169     frame $ad -bd 2 -relief groove
170     frame $dc -bd 2 -relief groove
171     grid $sc -column 0 -row 0 -sticky new
172     grid $as -column 0 -row 1 -sticky new
173     grid $ad -column 1 -row 0 -rowspan 3 -sticky nesw
174     grid $dc -column 0 -row 2
175
176     grid [button $dc.dcon -text "Run DISAGL Program" -command {DA_Control_Panel 1; unset ::geo_phase_list; Geo_Viewer}] \
177        -column 0 -row 0
178        $dc.dcon config -bd 4
179
180
181     grid rowconfigure $mcb 1 -weight 1
182     grid columnconfigure $mcb 1 -weight 1
183
184     label $sc.phlabel -text Phase
185#     eval tk_optionMenu $sc.phase ::geo_entryvar(phase) $::expmap(phaselist)
186     eval tk_optionMenu $sc.phase ::geo_entryvar(phase) $::geo_phase_list
187     label $sc.atom1 -text "Atom Type"
188     label $sc.filterlab -text "Dmax Filter"
189     entry $sc.filterval -textvariable ::geo_filterval
190          $sc.filterval config -width 6
191     #button $sc.engage -text "Print Info" -command Geo_Fill_Display
192     grid $sc.phlabel -row 0 -column 0
193     grid $sc.phase   -row 0 -column 1
194     grid $sc.atom1   -row 1 -column 0
195     grid $sc.filterlab   -row 2 -column 0
196     grid $sc.filterval -row 2 -column 1
197
198     label $as.atom -text "Choose Atom(s)"
199
200     grid $as.atom -row 0 -column 1
201
202     foreach {top main side lbl} [MakeScrollTable $as] {}
203     [winfo parent $main] config -bg [$main cget -bg]
204
205   foreach item [trace vinfo ::geo_entryvar(phase)] {
206       eval trace vdelete ::geo_entryvar(phase) $item
207   }
208   foreach item [trace vinfo ::geo_entryvar(atomtype)] {
209       eval trace vdelete ::geo_entryvar(atomtype) $item
210   }
211   set ::geo_entryvar(phase) [lindex $::geo_phase_list 0]
212   Geo_setPhase $sc $as $main
213   trace variable ::geo_entryvar(phase) w "Geo_setPhase $sc $as $main"
214   trace variable ::geo_entryvar(atomtype) w "Geo_setAtomType $sc $as $main"
215   Geo_Display
216       ResizeScrollTable $as
217       $as.can config -width [lindex [$as.can cget -scrollregion] 2]
218
219   }
220
221proc Geo_setPhase {sc as main args} {
222     catch {destroy $sc.atomtype}
223     catch {eval destroy [winfo children $::geo_main]}
224     catch {eval destroy [winfo children $::geo_side]}
225     set ::geo_entryvar(atomtype) all
226     set ::geo_alist ""
227     eval tk_optionMenu $sc.atomtype ::geo_entryvar(atomtype) \
228          "[lsort [array names ::geo_atomtype${::geo_entryvar(phase)}]]"
229     grid $sc.atomtype -column 1 -row 1
230     Geo_setAtomType  $sc $as $main
231}
232
233proc Geo_setAtomType {sc as main args} {
234   set ::geo_atomlist ""
235   set ::geo_atomlist [set ::geo_atomtype${::geo_entryvar(phase)}($::geo_entryvar(atomtype))]
236   set rownum 1
237   set colnum 1
238   eval destroy [winfo children $main]
239      foreach i $::geo_atomlist {
240             #puts $i
241             if {[expr $colnum % 5] == 0} {incr rownum; set colnum 1}
242             set x [atominfo $::geo_entryvar(phase) $i  label]
243             set xlower [string tolower $x]
244             set ::geo_enable($xlower) $i
245             #parray ::geo_enable
246             button $main.atom_$xlower -text "$x" -width 5 -command "Geo_Enable $main.atom_$xlower $::geo_enable($xlower)"
247             grid $main.atom_$xlower -column $colnum -row $rownum -padx 5 -pady 5
248             incr colnum
249
250             }
251      ResizeScrollTable $as
252      $as.can config -width [lindex [$as.can cget -scrollregion] 2]
253}
254
255proc Geo_Enable {main entry args} {
256
257        if {[$main cget -relief] == "raised"} {
258        lappend ::geo_alist $entry
259        $main config -bg green -relief sunken
260
261        } else {
262          set i [lsearch $::geo_alist $entry]
263          puts "seach = $i"
264          set ::geo_alist [string trim [lreplace $::geo_alist $i $i]]
265#          $main config -bg SystemButtonFace -relief raised
266          $main config -bg LightGray -relief raised
267        }
268   Geo_Fill_Display
269}
270
271proc Geo_Display {args} {
272     catch {destroy $as.$main}
273
274     set ad .maincontrolbox.atomdistlist
275     foreach {top ::geo_main ::geo_side lbl} [MakeScrollTable $ad] {}
276     [winfo parent $::geo_main] config -bg [$::geo_main cget -bg]
277
278     bind $ad <Configure> "catch {ResizeScrollTable $ad}"
279       ResizeScrollTable $ad
280       $ad.can config -width 500
281
282
283     #puts "$ad $::geo_main"
284
285 #    label $top.toplabel0 -text "Atom 1" -width 8
286     label $top.toplabel1 -text "Atom 2" -width 8
287     label $top.toplabel2 -text "symm" -width 8
288     label $top.toplabel3 -text "Distance" -width 10
289     label $top.toplabel4 -text "Angle"
290#     grid $top.toplabel0 -column 0 -row 0
291     grid $top.toplabel1 -column 0 -row 0
292     grid $top.toplabel2 -column 1 -row 0
293     grid $top.toplabel3 -column 2 -row 0
294     grid $top.toplabel4 -column 3 -row 0
295}
296proc Geo_Fill_Display {args} {
297     set rownum 0
298     set colnum 3
299     set bondnum 0
300     set counter 0
301     eval destroy [winfo children $::geo_main]
302     eval destroy [winfo children $::geo_side]
303
304     foreach i $::geo_alist {
305             set slist [lsort -index 7 $::geo_bonds($::geo_entryvar(phase),$i)]
306             set colnum 3
307             set keylist ""
308             set atmlist {}
309             set symlist {}
310             incr rownum
311             if {[string trim $::geo_filterval] == ""} {set ::geo_filterval 5.00}
312             foreach j $slist {
313                 if {[lindex $j 7] <= $::geo_filterval} {
314                    lappend keylist [lindex $j 10]
315                    lappend atmlist [lindex $j 6]
316                    lappend symlist [lindex $j 9]
317                    label $::geo_side.atom1${bondnum} -text [lindex $j 5] -width 8
318                    label $::geo_main.atom2${bondnum} -text [lindex $j 6] -width 8
319                    label $::geo_main.atom2symm${bondnum} -text [lindex $j 9] -width 8
320                    set bonddist [lindex $j 7]
321                    set bondesd  [lindex $j 8]
322                    set bondentry [formatSU $bonddist $bondesd]
323                    label $::geo_main.bonddist${bondnum} -text $bondentry -width 10
324
325                    grid $::geo_side.atom1${bondnum} -row $rownum -column 0
326                    grid $::geo_main.atom2${bondnum} -row $rownum -column 0
327                    grid $::geo_main.atom2symm${bondnum} -row $rownum -column 1
328                    grid $::geo_main.bonddist${bondnum} -row $rownum -column 2
329
330                    set key [lindex $j 10]
331                    set atom [lindex $j 1]
332                    set phase [lindex $j 0]
333
334
335                    foreach k $keylist {
336
337                            if {$key != $k} {
338                            # search for atom 1 - central atom - atom 2 angle.
339                            if {[array name ::geo_angles "$phase,$key,$atom,$k"] != ""} {
340                               set ang  [lindex $::geo_angles($phase,$key,$atom,$k) 7]
341                               set angesd [lindex $::geo_angles($phase,$key,$atom,$k) 8]
342                               set angentry [formatSU $ang $angesd]
343                               label $::geo_main.$counter -text $angentry
344#                               label $::geo_main.$counter -text [lindex $::geo_angles($phase,$key,$atom,$k) 7]
345                               grid $::geo_main.$counter -row $rownum -column $colnum -padx 5
346                               incr colnum
347                               incr counter
348                               # search for atom 2 - central atom - atom 1 angle.
349                            } elseif {[array name ::geo_angles "$phase,$k,$atom,$key"] != ""} {
350                               set ang  [lindex $::geo_angles($phase,$k,$atom,$key) 7]
351                               set angesd [lindex $::geo_angles($phase,$k,$atom,$key) 8]
352                               set angentry [formatSU $ang $angesd]
353                               label $::geo_main.$counter -text $angentry
354#                              label $::geo_main.$counter -text [lindex $::geo_angles($phase,$k,$atom,$key) 7]
355                              grid $::geo_main.$counter -row $rownum -column $colnum -padx 5
356
357                              incr colnum
358                              incr counter
359                            }
360                            }
361                    }
362                 incr bondnum
363                 incr rownum
364                 set colnum 3
365             }
366             }
367                  set colnum 3
368            incr rownum
369             foreach atm [lrange $atmlist 0 end-1] {
370                label $::geo_main.$counter -text $atm
371                grid $::geo_main.$counter -row $rownum -column $colnum
372                    incr colnum
373                    incr counter
374             }
375                 set colnum 3
376             incr rownum
377             foreach sym [lrange $symlist 0 end-1] {
378                label $::geo_main.$counter -text $sym
379                grid $::geo_main.$counter -row $rownum -column $colnum
380                    incr colnum
381                    incr counter
382             }
383              incr rownum
384             grid rowconfigure $::geo_main $rownum  -minsize 10
385}
386ResizeScrollTable [winfo parent [winfo parent $::geo_main]]
387MouseWheelScrollTable [winfo parent [winfo parent $::geo_main]]
388}
389proc Geo_Print {} {
390}
391
392Geo_Initialize
393#Geo_Read TEST.DISAGL
394#Geo_Viewer
395
Note: See TracBrowser for help on using the repository browser.