[527] | 1 | # a sample coordinate export utility for EXPGUI |
---|
| 2 | # |
---|
| 3 | # To make this file useful, one will need to modify the lines containing |
---|
| 4 | # "example" and then rewrite the "section that will need changing" below. |
---|
| 5 | # Finally save it as file named export_<something>.tcl |
---|
| 6 | # |
---|
| 7 | # $Id: export_example.example 527 2009-12-04 23:07:40Z toby $ |
---|
| 8 | # set local variables that define the proc to execute and the menu label |
---|
| 9 | set label "export <example> format" |
---|
| 10 | set action export_example |
---|
| 11 | proc export_example {} { |
---|
| 12 | global expmap expgui |
---|
| 13 | # don't bother if there are no phases to write |
---|
| 14 | if {[llength $expmap(phaselist)] == 0} { |
---|
| 15 | MyMessageBox -parent . -title "No phases" \ |
---|
| 16 | -message "Sorry, no phases are present to write" \ |
---|
| 17 | -icon warning |
---|
| 18 | return |
---|
| 19 | } |
---|
| 20 | MakeExportBox .export "Export coordinates in <example> format" \ |
---|
| 21 | "MakeWWWHelp expgui.html export" |
---|
| 22 | # note, change export in the line above to the name anchor for a |
---|
| 23 | # section documenenting the format added to expgui.html, if added |
---|
| 24 | # |
---|
| 25 | # force the window to stay on top |
---|
| 26 | putontop .export |
---|
| 27 | # Wait for the Write or Quit button to be pressed |
---|
| 28 | tkwait window .export |
---|
| 29 | afterputontop |
---|
| 30 | # test for Quit |
---|
| 31 | if {$expgui(export_phase) == 0} {return} |
---|
| 32 | |
---|
| 33 | # now open the file and write it |
---|
| 34 | set phase $expgui(export_phase) |
---|
| 35 | if [catch { |
---|
| 36 | set filnam [file rootname $expgui(expfile)]_${phase}.example |
---|
| 37 | set fp [open $filnam w] |
---|
| 38 | # deal with macromolecular phases |
---|
| 39 | if {[lindex $expmap(phasetype) [expr {$phase - 1}]] == 4} { |
---|
| 40 | set mm 1 |
---|
| 41 | set cmd mmatominfo |
---|
| 42 | } else { |
---|
| 43 | set mm 0 |
---|
| 44 | set cmd atominfo |
---|
| 45 | } |
---|
| 46 | #============================================================== |
---|
| 47 | # v v v v v v v v v v Section that will need changing v v v v v |
---|
| 48 | # title info from GSAS title & phase title |
---|
| 49 | puts $fp "[expinfo title]" |
---|
| 50 | puts $fp "phase = [phaseinfo $phase name]" |
---|
| 51 | # write out cell parameters |
---|
| 52 | foreach p {a b c alpha beta gamma} { |
---|
| 53 | puts $fp "$p = [phaseinfo $phase $p]" |
---|
| 54 | } |
---|
| 55 | # write out GSAS spacegroup |
---|
| 56 | puts $fp "Space Group = [phaseinfo $phase spacegroup]" |
---|
| 57 | # write a header |
---|
| 58 | puts $fp "label \t type \t x \t y \t z \t Uiso \t frac" |
---|
| 59 | # now loop over atoms |
---|
| 60 | foreach atom $expmap(atomlist_$phase) { |
---|
| 61 | set uiso [$cmd $phase $atom Uiso] |
---|
| 62 | # are there anisotropic atoms? If so convert them to Uequiv |
---|
| 63 | if {!$mm} { |
---|
| 64 | if {[atominfo $phase $atom temptype] == "A"} { |
---|
| 65 | set uiso [expr \ |
---|
| 66 | ([atominfo $phase $atom U11] + \ |
---|
| 67 | [atominfo $phase $atom U22] + \ |
---|
| 68 | [atominfo $phase $atom U33]) / 3.] |
---|
| 69 | } |
---|
| 70 | } |
---|
| 71 | foreach var {x y z frac label type} { |
---|
| 72 | set $var [$cmd $phase $atom $var] |
---|
| 73 | } |
---|
| 74 | #write out the atom, tab delimited |
---|
| 75 | puts $fp "$label \t $type \t $x \t $y \t $z \t $uiso \t $frac" |
---|
| 76 | } |
---|
| 77 | # ^ ^ ^ ^ ^ ^ ^ end of Section that will need changing ^ ^ ^ ^ |
---|
| 78 | #============================================================== |
---|
| 79 | close $fp |
---|
| 80 | } errmsg] { |
---|
| 81 | MyMessageBox -parent . -title "Export error" \ |
---|
| 82 | -message "Export error: $errmsg" -icon warning |
---|
| 83 | } else { |
---|
| 84 | MyMessageBox -parent . -title "Done" \ |
---|
| 85 | -message "File [file tail $filnam] was written" |
---|
| 86 | } |
---|
| 87 | } |
---|