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