source: trunk/import_spf.tcl @ 1251

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

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

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Revision Id
File size: 4.1 KB
Line 
1# $Id: import_spf.tcl 1251 2014-03-10 22:17:29Z toby $
2
3#-------------------------------------------------
4# define info used in addcmds.tcl
5set description "Platon .spf file"
6set extensions .spf
7set procname ReadSPFFile
8#-------------------------------------------------
9
10proc ReadSPFFile {filename} {
11    set fp [open $filename r]
12    set cell {}
13    set atomlist {}
14    set spg {}
15    set shift {}
16    set sglbl {}
17    set msg {}
18
19    while {[gets $fp line] >= 0} {
20        set token [lindex $line 0] 
21        switch [string toupper $token] {
22            CELL {
23                set cell [lrange $line 1 end]
24                # drop wavelength if present
25                if {[llength $cell] == 7} {
26                    set cell [lrange $cell 1 end]
27                }
28            }
29            SPGR {
30                set sglbl [lrange $line 1 end]
31            }
32            UIJ {
33                catch {
34                    set sum 0
35                    foreach a [lrange $line 1 3] {
36                        set sum [expr {$sum + $a/3.}]
37                    }
38                    set lbl [lindex $line 1]
39                    set Uarray($lbl) $sum
40                }
41            }
42            BIJ {
43                catch {
44                    set sum 0
45                    foreach a [lrange $line 1 3] {
46                        set sum [expr {$sum + $a/3.}]
47                    }
48                    set sum [expr {$sum/(8*3.14159*3.14159)}]
49                    set lbl [lindex $line 1]
50                    set Uarray($lbl) $sum
51                }
52            }
53            U {
54                catch {
55                    set lbl [lindex $line 1]
56                    set Ueq [expr {[lindex $line 1]}]
57                    set Uarray($lbl) $Ueq
58                }
59            }
60            B {
61                catch {
62                    set lbl [lindex $line 1]
63                    set Ueq [expr {[lindex $line 1]/(8*3.14159*3.14159)}]
64                    set Uarray($lbl) $Ueq
65                }
66            }
67            ignore {# the entries below are ignored}
68            TITL {}
69            CESD {}
70            LATT {}
71            SYMM {}
72            SUIJ {}
73            SBIJ {}
74            TRNS {}
75            ATOM {
76                set lbl [lindex $line 1]
77                set atomarray($lbl) [lrange $line 2 4]
78            }
79            default {
80                set lbl [lindex $line 0]
81                # ignore black lines
82                if {$lbl != ""} {
83                    set atomarray($lbl) [lrange $line 1 3]
84                }
85            }
86        }
87    }
88    close $fp
89    if {[catch {array names atomarray}]} {
90        MyMessageBox -parent . -type ok -icon warning \
91                -message "Warning: no atoms were found!"
92        return
93    }
94    set typelist {
95        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
96        NI CU ZN GA GE AS SE BR KR RB SR Y ZR NB MO TC RU RH PD AG CD IN SN SB
97        TE I XE CS BA LA CE PR ND PM SM EU GD TB DY HO ER TM YB LU HF TA W RE
98        OS IR PT AU HG TL PB BI PO AT RN FR RA AC TH PA U NP PU AM CM BK CF
99        D
100    }
101    # create the atoms list
102    foreach lbl [array names atomarray] {
103        # set the type from the first or first two letters of the label
104        foreach type "[string range $lbl 0 1] [string range $lbl 0 0]" {
105            if {[lsearch $typelist [string toupper $type]] >= 0} {
106                break
107            }
108            set type {}
109        }
110        # set x y & z
111        set l "$lbl $atomarray($lbl) [list $type]"
112        catch {lappend lbl $Uarray($lbl)}
113        lappend atomlist $l
114    }
115    # check the spacegroup
116    if {$sglbl !=  ""} {
117        global expgui
118        set sgtmp [string toupper $sglbl]
119        # remove spaces from space group
120        regsub -all " " $sgtmp "" sgtmp
121        # make a copy where we treat bar 3 as the same as 3
122        regsub -- "-3" $sgtmp "3" sgtmp3
123        set fp1 [open [file join \
124                $expgui(scriptdir) spacegrp.ref] r]
125        while {[gets $fp1 line] >= 0} {
126            set testsg [string toupper [lindex $line 8]]
127            regsub -all " " $testsg "" testsg
128            if {$testsg == $sgtmp} {
129                set spg [lindex $line 8]
130                set sgnum [lindex $line 1]
131                break
132            } elseif {[lindex $line 1] >= 200} {
133                regsub -- "-3" $testsg "3" testsg3
134                if {$testsg3 == $sgtmp3} {
135                    set spg [lindex $line 8]
136                    set sgnum [lindex $line 1]
137                    break
138                }
139            } elseif {[lindex $line 1] <= 18} {
140                # monoclinic: change operators of form "1 xxx 1" to "xxx"
141                regsub -- " 1 (.*) 1" [string toupper [lindex $line 8]] "\\1" testsg
142                # remove spaces from space group
143                regsub -all " " $testsg "" testsg
144                if {$testsg == $sgtmp} {
145                    set spg [lindex $line 8]
146                    set sgnum [lindex $line 1]
147                    break
148                }
149            }
150        }
151        close $fp1
152        # exact spacegroup was not found
153        if {$spg == ""} {
154            MyMessageBox -parent . -type ok -icon warning \
155                    -message "Warning: The space group ($sglbl) was not found and likely needs to be edited"
156            set msg "Check space group"
157        }
158    } else {
159        MyMessageBox -parent . -type ok -icon warning \
160                -message "Warning: No space group found"
161            set msg "Input a space group"
162    }
163    return "[list $spg] [list $cell] [list $atomlist] [list $msg]"
164}
Note: See TracBrowser for help on using the repository browser.