1 | # $Id: import_cell.tcl 1251 2014-03-10 22:17:29Z toby $ |
---|
2 | |
---|
3 | #------------------------------------------------- |
---|
4 | # define info used in addcmds.tcl |
---|
5 | set description "PowderCell .CEL file" |
---|
6 | set extensions .cel |
---|
7 | set procname ReadPowderCellFile |
---|
8 | #------------------------------------------------- |
---|
9 | |
---|
10 | proc ReadPowderCellFile {filename} { |
---|
11 | set fp [open $filename r] |
---|
12 | set cell {} |
---|
13 | set atomlist {} |
---|
14 | set spg {} |
---|
15 | set shift {} |
---|
16 | set sgnum {} |
---|
17 | set setting {} |
---|
18 | set warnlist { |
---|
19 | 3 4 5 6 7 8 10 11 12 13 14 16 17 18 19 20 21 22 23 24 25 27 32 34 35 |
---|
20 | 37 42 43 44 45 47 48 49 50 55 56 58 59 65 66 68 69 70 71 72 |
---|
21 | } |
---|
22 | |
---|
23 | while {[gets $fp line] >= 0} { |
---|
24 | set token [lindex $line 0] |
---|
25 | switch [string toupper $token] { |
---|
26 | CELL { |
---|
27 | set cell [lrange $line 1 end] |
---|
28 | } |
---|
29 | RGNR { |
---|
30 | set sgnum [lindex $line 1] |
---|
31 | set setting [lindex $line 2] |
---|
32 | if {$setting == ""} {set setting 1} |
---|
33 | # note that RGNR comes at the end of the file; ignore |
---|
34 | # anything beyond here |
---|
35 | close $fp |
---|
36 | global expgui |
---|
37 | set fp [open [file join $expgui(scriptdir) spacegrp.ref] r] |
---|
38 | while {[gets $fp line] >= 0} { |
---|
39 | if {$sgnum == [lindex $line 1] && \ |
---|
40 | $setting == [lindex $line 2]} { |
---|
41 | set spg [lindex $line 8] |
---|
42 | set shift [lindex $line 9] |
---|
43 | break |
---|
44 | } |
---|
45 | } |
---|
46 | close $fp |
---|
47 | break |
---|
48 | } |
---|
49 | default { |
---|
50 | set lbl [lindex $line 0] |
---|
51 | set type [lindex $line 1] |
---|
52 | # if the type is a number, convert it to an element symbol |
---|
53 | catch {set type [lindex { |
---|
54 | dummy-entry |
---|
55 | H HE LI BE B C N O F NE NA MG AL SI P S CL AR K CA SC TI V CR MN FE CO |
---|
56 | NI CU ZN GA GE AS SE BR KR RB SR Y ZR NB MO TC RU RH PD AG CD IN SN SB |
---|
57 | TE I XE CS BA LA CE PR ND PM SM EU GD TB DY HO ER TM YB LU HF TA W RE |
---|
58 | OS IR PT AU HG TL PB BI PO AT RN FR RA AC TH PA U NP PU AM CM BK CF |
---|
59 | } $type]} |
---|
60 | # convert F-, K+ and Al3+ to F, K and Al |
---|
61 | regsub {[1-9]*\+} $type {} type |
---|
62 | regsub {[1-9]*-} $type {} type |
---|
63 | lappend typelist $type |
---|
64 | lappend lbllist $lbl |
---|
65 | lappend xyzlist [lrange $line 2 4] |
---|
66 | } |
---|
67 | } |
---|
68 | } |
---|
69 | # create the atomlist |
---|
70 | foreach type $typelist lbl $lbllist xyz $xyzlist { |
---|
71 | if {$shift == ""} { |
---|
72 | set l "$lbl $xyz $type" |
---|
73 | } else { |
---|
74 | set l $lbl |
---|
75 | foreach x $xyz offset $shift { |
---|
76 | lappend l [expr $x + $offset] |
---|
77 | } |
---|
78 | lappend l $type |
---|
79 | } |
---|
80 | lappend atomlist $l |
---|
81 | } |
---|
82 | # exact spacegroup was not found |
---|
83 | if {$spg == ""} { |
---|
84 | # how did this happen |
---|
85 | MyMessageBox -parent . -type ok -icon error \ |
---|
86 | -message "Error: The space group number ($sgnum) and setting ($setting) in file $filename is invalid!" |
---|
87 | } elseif {$shift != ""} { |
---|
88 | # don't have the correct setting |
---|
89 | MyMessageBox -parent . -type ok -icon warning \ |
---|
90 | -message "Note: an origin shift ($shift) has been added to the coordinates to convert them to the Origin Choice 2 setting (-1 at 000)" |
---|
91 | } |
---|
92 | return "[list $spg] [list $cell] [list $atomlist]" |
---|
93 | } |
---|