source: branches/sandbox/import_xtl.tcl

Last change on this file was 1250, checked in by toby, 7 years ago

use svn ps svn:eol-style "native" expgui to change line ends

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Revision Id
File size: 5.6 KB
Line 
1# $Id: import_xtl.tcl 1250 2014-03-10 21:23:13Z toby $
2
3#-------------------------------------------------
4# define info used in addcmds.tcl
5set description "MSI .xtl file"
6set extensions .xtl
7set procname ReadMSIxtlFile
8#-------------------------------------------------
9
10proc ReadMSIxtlFile {filename} {
11    set fp [open $filename r]
12    set spg {}
13    set cell {}
14    set atomlist {}
15    set shift {}
16    set sgnum {}
17    set sglbl {}
18    set sgqual {}
19    set head {}
20    while {[gets $fp line] >= 0} {
21        if {$head == ""} {
22            set token [string toupper [lindex $line 0] ]
23        } else {
24            set token ParseAtom
25        }
26        switch $token {
27            TITLE {continue}
28            DIMENSION {continue}
29            CELL {
30                # cell parameters are usually on the next line (always?)
31                if {[lrange $line 1 end] == ""} {
32                    gets $fp cell
33                } else {
34                    set cell [lrange $line 1 end]
35                }
36            }
37            SYMMETRY {
38                # scan line for either the flag number or label
39                set i 0
40                while {[lindex $line [incr i]] != ""} {
41                    if {[string toupper [lindex $line $i]] == "NUMBER"} {
42                        set sgnum [lindex $line [incr i]]
43                    } elseif {[string toupper [lindex $line $i]] == "LABEL"} {
44                        set sglbl [lindex $line [incr i]]
45                    } elseif {[string toupper [lindex $line $i]] == "QUALIFIER"} {
46                        set sgqual [lindex $line [incr i]]
47                    }
48                }   
49            }
50            ATOMS {
51                gets $fp head
52                set head [string toupper $head]
53                # process the space group now, so that we can establish
54                # a shift for coordinates
55                set fp1 {}
56                if {$sgnum !=  ""} {
57                    global expgui
58                    set fp1 [open [file join \
59                            $expgui(scriptdir) spacegrp.ref] r]
60                    while {[gets $fp1 line] >= 0} {
61                        if {$sgnum == [lindex $line 1]} {
62                            set spg [lindex $line 8]
63                            break
64                        }
65                    }
66                } elseif {$sglbl !=  ""} {
67                    global expgui
68                    set sgtmp [string toupper $sglbl]
69                    # remove spaces from space group
70                    regsub -all " " $sgtmp "" sgtmp
71                    # make a copy where we treat bar 3 as the same as 3
72                    regsub -- "-3" $sgtmp "3" sgtmp3
73                    set fp1 [open [file join \
74                            $expgui(scriptdir) spacegrp.ref] r]
75                    while {[gets $fp1 line] >= 0} {
76                        set testsg [string toupper [lindex $line 8]]
77                        regsub -all " " $testsg "" testsg
78                        if {$testsg == $sgtmp} {
79                            set spg [lindex $line 8]
80                            set sgnum [lindex $line 1]
81                            break
82                        } elseif {[lindex $line 1] >= 200} {
83                            regsub -- "-3" $testsg "3" testsg3
84                            if {$testsg3 == $sgtmp3} {
85                                set spg [lindex $line 8]
86                                set sgnum [lindex $line 1]
87                                break
88                            }
89                        } elseif {[lindex $line 1] <= 18} {
90                            # monoclinic: change operators of form "1 xxx 1" to "xxx"
91                            regsub -- " 1 (.*) 1" [string toupper [lindex $line 8]] "\\1" testsg
92                            # remove spaces from space group
93                            regsub -all " " $testsg "" testsg
94                            if {$testsg == $sgtmp} {
95                                set spg [lindex $line 8]
96                                set sgnum [lindex $line 1]
97                                break
98                            }
99                        }
100                    }
101                }
102                # is this an origin 1 setting where a choice exists?
103                if {$spg != "" && [string tolower $sgqual] == "origin_1"} {
104                    # advance to the 2nd part of the file
105                    while {[lindex $line 1] != 230} {
106                        if {[gets $fp1 line] < 0} break
107                    }
108                    while {[gets $fp1 line] >= 0} {
109                        if {$sgnum == [lindex $line 1]} {
110                            set spg [lindex $line 8]
111                            set shift [lindex $line 9]
112                            break
113                        }
114                    }
115                }
116                if {$fp1 != ""} {close $fp1}
117            }
118            ParseAtom {
119                # ignore blank lines
120
121                if {[string trim $line] == ""} continue
122                set label {}
123                set type {}
124                # get label & element type from name or better -- Scat field
125                set n [lsearch $head NAME]
126                if {$n != -1} {
127                    set label [lindex $line $n]
128                    regsub -all {[0-9 ]} $label "" type
129                }
130                set l2 $label
131                set n [lsearch $head SCAT]
132                if {$n != -1} {
133                    if {[lindex $line $n] != ""} {
134                        set type [lindex $line $n]
135                        regsub -all {[0-9 +-]} $type "" type
136                    }
137                }
138                foreach p {X Y Z} s $shift {
139                    set n [lsearch $head $p]
140                    if {$n == -1} {
141                        lappend l2 {}
142                    } else {
143                        set v [lindex $line $n]
144                        if {$s != ""} {set v [expr $v + $s]}
145                        lappend l2 $v
146                    }
147                }
148                lappend l2 $type
149                set n [lsearch $head OCCUP]
150                if {$n == -1} {
151                    lappend l2 {}
152                } else {
153                    lappend l2 [lindex $line $n]
154                }
155                set uiso {}
156                # get temperature factor, if present
157                set n [lsearch $head TEMP]
158                if {$n != -1} {
159                    if {[catch {
160                        set uiso [expr [lindex $line $n] / 78.9567]
161                        set uiso [format %.5f $uiso]
162                    }]} {set uiso ""}
163                }
164                set n [lsearch $head UISO]
165                if {$n != -1} {
166                    if {[catch {
167                        set uiso [expr [lindex $line $n]]
168                        set uiso [format %.5f $uiso]
169                    }]} {set uiso ""}
170                }
171                if {$uiso != ""} {
172                    lappend l2 $uiso
173                }
174                lappend atomlist $l2
175            }
176            default {}
177        }
178    }
179    close $fp
180
181    set msg {}
182    # spacegroup was not found
183    if {$spg == ""} {
184        # did not find the spacegroup
185        if {$sglbl != ""} {
186            MyMessageBox -parent . -type ok -icon warning \
187                -message "Error: The space group ($sglbl) in file $filename could not be converted to match GSAS input; please edit it"
188            set spg $sglbl
189            set msg "Note: You must check the space group & edit to conform to GSAS input"
190        } else {
191            MyMessageBox -parent . -type ok -icon warning \
192                -message "Error: The space group number information in file $filename is missing or invalid!"
193            set msg "Note: You must set the space group"
194        }
195    } elseif {$shift != ""} {
196        # don't have the correct setting
197        MyMessageBox -parent . -type ok -icon warning \
198                -message "Note: an origin shift ($shift) has been added to the coordinates to convert them to the Origin Choice 2 setting (-1 at 000)"
199    }
200    # adjust space group for rhombohedral settings
201    if {$spg != "" && [string tolower $sgqual] == "rhombohedral"} {
202        append spg " R"
203    }
204    return "[list $spg] [list $cell] [list $atomlist] [list $msg]"
205}
Note: See TracBrowser for help on using the repository browser.