[533] | 1 | # $Id: import_xtl.tcl 930 2009-12-04 23:14:35Z toby $ |
---|
| 2 | |
---|
| 3 | #------------------------------------------------- |
---|
| 4 | # define info used in addcmds.tcl |
---|
| 5 | set description "MSI .xtl file" |
---|
| 6 | set extensions .xtl |
---|
| 7 | set procname ReadMSIxtlFile |
---|
| 8 | #------------------------------------------------- |
---|
| 9 | |
---|
| 10 | proc 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 | } |
---|