source: trunk/export_cif.tcl @ 798

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

# on 2004/09/08 14:08:22, toby did:
quicky CIF export routine

  • Property rcs:author set to toby
  • Property rcs:date set to 2004/09/08 14:08:22
  • Property rcs:rev set to 1.1
  • Property rcs:state set to Exp
  • Property svn:keywords set to Author Date Revision Id
File size: 2.6 KB
RevLine 
[798]1# $Id: export_cif.tcl 798 2009-12-04 23:12:12Z toby $
2# set local variables that define the proc to execute and the menu label
3set label "coords-only CIF"
4set action exp2cif
5# write coordinates in an XML for FOX
6proc exp2cif {} {
7    global expmap expgui
8    # don't bother if there are no phases to write
9    if {[llength $expmap(phaselist)] == 0} {
10        MyMessageBox -parent . -title "No phases" \
11                -message "Sorry, no phases are present to write" \
12                -icon warning
13        return
14    }
15    MakeExportBox .export "Export coordinates (only) in CIF" \
16            "MakeWWWHelp expgui.html ExportCIF"
17    # force the window to stay on top
18    putontop .export
19    # Wait for the Write or Quit button to be pressed
20    tkwait window .export
21    afterputontop
22    # test for Quit
23    if {$expgui(export_phase) == 0} {return}
24    #
25    set phase $expgui(export_phase)
26    #------------------------------------------------------------------
27    if [catch {
28        set filnam [file rootname $expgui(expfile)]_${phase}.cif
29        set fp [open $filnam w]
30        puts $fp "\# from $expgui(expfile) "
31        puts $fp "_audit_creation_date                [clock format [clock seconds] -format "%Y-%m-%dT%T"]"
32
33        set spacegroup [phaseinfo $phase spacegroup]
34        # remove final R from rhombohedral space groups
35        if {[string toupper [string range $spacegroup end end]] == "R"} {
36            set spacegroup [string range $spacegroup 0 \
37                                [expr [string length $spacegroup]-2]] 
38        }
39        puts $fp "_symmetry_space_group_name_H-M      '${spacegroup}'"
40        foreach var {a b c} {
41            puts $fp "_cell_length_$var      [phaseinfo $phase $var]"
42        }
43        foreach var {alpha beta gamma} {
44            puts $fp "_cell_angle_$var      [phaseinfo $phase $var]"
45        }
46           
47        if {[lindex $expmap(phasetype) [expr {$phase - 1}]] == 4} {
48            set cmd mmatominfo
49        } else {
50            set cmd atominfo
51        }
52
53        puts $fp "loop_\n  _atom_site_label\n _atom_site_type_symbol"
54        puts $fp " _atom_site_fract_x\n _atom_site_fract_y\n _atom_site_fract_z"
55        puts $fp " _atom_site_B_iso_or_equiv\n _atom_site_occupancy"
56
57        foreach atom $expmap(atomlist_$phase) {
58            set label [$cmd $phase $atom label]
59            set elem [$cmd $phase $atom type]
60            # remove spaces
61            regsub -all " " $label "" label
62            regsub -all " " $elem "" elem
63            set Biso [expr 8 * 3.14159 * 3.14159 * [$cmd $phase $atom Uiso]]
64            foreach var {x y z frac} {
65                set $var  [format %.5f [$cmd $phase $atom $var]]
66            }
67            puts $fp "$label $elem $x $y $z $Biso $frac"
68        }
69        close $fp
70    } errmsg] {
71        MyMessageBox -parent . -title "Export error" \
72                -message "Export error: $errmsg" -icon warning
73    } else {
74        MyMessageBox -parent . -title "Done" \
75            -message "File [file tail $filnam] was written"
76    }
77}
78
Note: See TracBrowser for help on using the repository browser.