source: trunk/export_xtl.tcl @ 530

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

# on 2002/01/22 21:45:59, toby did:
Export coordinates in MSI .xtl format (Insight-II & ugh, Cerius2)

  • Property rcs:author set to toby
  • Property rcs:date set to 2002/01/22 21:45:59
  • Property rcs:rev set to 1.1
  • Property rcs:state set to Exp
  • Property svn:keywords set to Author Date Revision Id
File size: 5.2 KB
Line 
1# $Id: export_xtl.tcl 530 2009-12-04 23:07:43Z toby $
2# set local variables that define the proc to execute and the menu label
3set label "MSI .xtl format"
4set action exp2xtl
5# write coordinates in an MSI .xtl file
6proc exp2xtl {} {
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 in MSI .xtl format" \
16            "MakeWWWHelp expgui.html ExportMSI"
17    #------------------------------------------------------------------
18    # special code to get the spacegroup info
19    pack [label .export.special.1 -text "Space Group: "] -side left
20    pack [entry .export.special.2 -textvariable expgui(export_sg) \
21            -width 8] -side left
22    pack [checkbutton .export.special.3 -variable expgui(export_orig) \
23            -text "Origin 2"] -side left
24    trace variable expgui(export_phase) w MSI_SP_convert
25    # force processing of the spacegroup
26    SetExportPhase [lindex $expmap(phaselist) 0] .export
27    # end of special code to get the spacegroup info
28    #------------------------------------------------------------------
29    #
30    # force the window to stay on top
31    putontop .export
32    # Wait for the Write or Quit button to be pressed
33    tkwait window .export
34    afterputontop
35    #------------------------------------------------------------------
36    # special code to get the spacegroup info
37    trace vdelete  expgui(export_phase) w MSI_SP_convert
38    # end of special code to get the spacegroup info
39    #------------------------------------------------------------------
40    # test for Quit
41    if {$expgui(export_phase) == 0} {return}
42    #
43    set phase $expgui(export_phase)
44    #------------------------------------------------------------------
45    # special code to get the spacegroup info
46    set origin $expgui(export_orig)
47    set rhomb $expgui(export_rhomb)
48    set spsymbol $expgui(export_sg)
49    set errmsg {}
50    if {$spsymbol == ""} {
51        set errmsg "Error: invalid Space Group: $spsymbol"
52    }
53    if {$errmsg != ""} {
54        MyMessageBox -parent . -title "Export error" \
55                -message "Export error: $errmsg" -icon warning
56        return
57    }
58    # end of special code to get the spacegroup info
59    #------------------------------------------------------------------
60
61    if [catch {
62        set filnam [file rootname $expgui(expfile)]_${phase}.xtl
63        set fp [open $filnam w]
64        puts $fp "TITLE Phase $phase from $expgui(expfile)"
65        puts $fp "TITLE history [string trim [lindex [exphistory last] 1]]"
66        puts $fp "TITLE phase [phaseinfo $phase name]"
67        puts $fp "CELL"
68        puts $fp "  [phaseinfo $phase a] [phaseinfo $phase b] [phaseinfo $phase c] [phaseinfo $phase alpha] [phaseinfo $phase beta] [phaseinfo $phase gamma]"
69       
70        puts $fp "Symmetry Label $spsymbol"
71        if $origin {
72            puts $fp "Symmetry Qualifier origin_2"
73        }
74        if $rhomb {
75            puts $fp "Symmetry Qualifier rhombohedral"
76        }
77       
78        puts $fp "ATOMS"
79        puts $fp "NAME       X          Y          Z    UISO      OCCUP"
80        if {[lindex $expmap(phasetype) [expr {$phase - 1}]] == 4} {
81            set mm 1
82            set cmd mmatominfo
83        } else {
84            set mm 0
85            set cmd atominfo
86        }
87        foreach atom $expmap(atomlist_$phase) {
88            set label [$cmd $phase $atom label]
89            # remove () characters
90            regsub -all "\[()\]" $label "" label
91            set uiso [$cmd $phase $atom Uiso]
92            # are there anisotropic atoms?
93            if {!$mm} {
94                if {[atominfo $phase $atom temptype] == "A"} {
95                    set uiso [expr \
96                            ([atominfo $phase $atom U11] + \
97                            [atominfo $phase $atom U22] + \
98                            [atominfo $phase $atom U33]) / 3.]
99                }
100            }
101            puts $fp "$label [$cmd $phase $atom x] \
102                        [$cmd $phase $atom y] [$cmd $phase $atom z] \
103                        $uiso  [$cmd $phase $atom frac]"
104        }
105        close $fp
106    } errmsg] {
107        MyMessageBox -parent . -title "Export error" \
108                -message "Export error: $errmsg" -icon warning
109    } else {
110        MyMessageBox -parent . -title "Done" \
111                -message "File [file tail $filnam] was written"
112    }
113}
114
115# process the spacegroup whenever the phase is changed
116proc MSI_SP_convert {args} {
117    global expgui
118    set phase 0
119    catch {set phase $expgui(export_phase)}
120    if {$phase == 0} return
121    set spacegroup [phaseinfo $phase spacegroup]
122    set expgui(export_rhomb) 0
123    # remove final R from rhombohedral space groups
124    if {[string toupper [string range $spacegroup end end]] == "R"} {
125        set expgui(export_rhomb) 1
126        set spacegroup [string range $spacegroup 0 \
127                [expr [string length $spacegroup]-2]] 
128    }
129    # remove spaces from space group
130    regsub -all " " $spacegroup "" spacegroup
131    set expgui(export_sg) $spacegroup
132    set expgui(export_orig) 0
133    # scan through the Origin 1/2 spacegroups for a match
134    set spacegroup [string toupper $spacegroup]
135    # treat bar 3 as the same as 3 (Fd3m <==> Fd-3m)
136    regsub -- "-3" $spacegroup "3" spacegroup
137    set fp [open [file join $expgui(scriptdir) spacegrp.ref] r]
138    # skip over the first section of file
139    set line 0
140    while {[lindex $line 1] != 230} {
141        if {[gets $fp line] < 0} return
142    }
143    while {[gets $fp line] >= 0} {
144        set testsg [string toupper [lindex $line 8]]
145        regsub -all " " $testsg "" testsg
146        regsub -- "-3" $testsg "3" testsg
147        if {$spacegroup == $testsg} {
148            set expgui(export_orig) 1
149            break
150        }
151    }
152    close $fp
153}
Note: See TracBrowser for help on using the repository browser.