Changeset 1109


Ignore:
Timestamp:
Jan 18, 2011 4:19:26 PM (13 years ago)
Author:
toby
Message:

recent changes: fix coordinates, rb start

Location:
branches/sandbox
Files:
5 edited

Legend:

Unmodified
Added
Removed

  • branches/sandbox/Geo_Viewer.tcl

    r1027 r1109  
    280280     label $top.toplabel1 -text "Atom 2" -width 8
    281281     label $top.toplabel2 -text "symm" -width 8
    282      label $top.toplabel3 -text "Distance" -width 8
     282     label $top.toplabel3 -text "Distance" -width 10
    283283     label $top.toplabel4 -text "Angle"
    284284#     grid $top.toplabel0 -column 0 -row 0
    … …  
    315315                    set bondesd  [lindex $j 8]
    316316                    set bondentry [formatSU $bonddist $bondesd]
    317                     label $::geo_main.bonddist${bondnum} -text $bondentry -width 8
     317                    label $::geo_main.bonddist${bondnum} -text $bondentry -width 10
    318318
    319319                    grid $::geo_side.atom1${bondnum} -row $rownum -column 0

  • branches/sandbox/addcmds.tcl

    r1103 r1109  
    19361936                ] -row 2 -column 0 -columnspan 10
    19371937    }
     1938#xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx x
     1939
     1940proc Fix_Initialize {numberList} {
     1941     set phaselist $::expmap(phaselist)
     1942     catch {unset ::fix_param}
     1943     foreach i $phaselist {
     1944             set ::fix_list(X,$i) ""
     1945             set ::fix_list(Y,$i) ""
     1946             set ::fix_list(Z,$i) ""
     1947
     1948             set temp [atom_constraint_read $i]
     1949             foreach j $temp {
     1950                     set atomnum [string trim [string range $j 2 3]]
     1951                     set param [string trim [string range $j 4 6]]
     1952                     set ::fix_param($i,$atomnum,$param) 1
     1953                     if {$param == "X"} {lappend ::fix_list(X,$i) $atomnum}
     1954                     if {$param == "Y"} {lappend ::fix_list(Y,$i) $atomnum}
     1955                     if {$param == "Z"} {lappend ::fix_list(Z,$i) $atomnum}
     1956             }
     1957     }
     1958
     1959             set ::fix_state_X [Fix_State 1 $numberList X]
     1960             set ::fix_state_Y [Fix_State 1 $numberList Y]
     1961             set ::fix_state_Z [Fix_State 1 $numberList Z]
     1962
     1963}
     1964
     1965proc Fix_State {phase numberList coord} {
     1966     set status_fixed "-1"
     1967     set status_unfixed "-1"
     1968     puts "$coord before: $status_fixed $status_unfixed"
     1969     foreach i $numberList {
     1970             set temp [info exists ::fix_param($phase,$i,$coord)]
     1971             puts "::fix_param($phase,$i,$coord) is variable present?: $temp"
     1972             if {$temp != 0} {set status_fixed 1}
     1973             if {$temp == 0} {set status_unfixed 1}
     1974     }
     1975     puts "$coord after $status_fixed $status_unfixed"
     1976     if {$status_fixed == 1 && $status_unfixed != 1} {return "fixed"}
     1977     if {$status_fixed == 1 && $status_unfixed == 1} {return "mixed"}
     1978     if {$status_fixed != 1 && $status_unfixed == 1} {return "unfixed"}
     1979}
     1980
     1981proc Fix_Write {} {
     1982      incr ::expgui(changed)
     1983      puts "Prepare to write [array names ::fix_Param]"
     1984      foreach j [array names ::fix_param] {
     1985             regexp {[0-9]+} $j  temp_phase
     1986             regexp {,[0-9]+} $j ans
     1987             set temp_atom [string range $ans 1 end]
     1988             regexp {[a-zA-Z]+} $j temp_param
     1989             if {$temp_param == "U"} {regexp {[a-zA-Z]+[0-9]+} $j temp_param}
     1990             set temp_entry [format "%1s %+2s%-4s" $temp_phase $temp_atom $temp_param]
     1991             lappend fix_list($temp_phase) $temp_entry
     1992     }
     1993     set phaselist $::expmap(phaselist)
     1994     foreach i $phaselist {
     1995             catch {atom_constraint_write $i $fix_list($i)}
     1996             puts $fix_list($i)
     1997     }
     1998}
     1999
     2000proc Fix_Atoms {phase numberList coord but} {
     2001#     puts "before  ::fix_state_$coord [set ::fix_state_$coord]"
     2002     puts " before operationi: $::fix_list($coord,$phase)"
     2003     switch [set ::fix_state_$coord] {
     2004     "unfixed" {$but config -text "fixed"
     2005               set ::fix_state_$coord "fixed"
     2006               }
     2007     "fixed"   {$but config -text "unfixed"
     2008               set ::fix_state_$coord "unfixed"
     2009               }
     2010     "mixed"   {$but config -text "unfixed"
     2011               set ::fix_state_$coord "unfixed"
     2012               }
     2013     }
     2014     if {[set ::fix_state_$coord] == "fixed"} {
     2015        puts "fixing atom number $numberList"
     2016        foreach i $numberList {
     2017                lappend ::fix_list($coord,$phase) $i
     2018                set ::fix_list($coord,$phase) [lsort -uniq -integer $::fix_list($coord,$phase)]
     2019                set ::fix_param($phase,$i,$coord) 1
     2020        }
     2021     }
     2022     if {[set ::fix_state_$coord] == "unfixed"} {
     2023        puts "unfixing atoms $numberList"
     2024        foreach i $numberList {
     2025           set temp [lsearch $::fix_list($coord,$phase) $i]
     2026           if {$temp != -1} {
     2027              set ::fix_list($coord,$phase) [lreplace $::fix_list($coord,$phase) $temp $temp]
     2028              catch {unset ::fix_param($phase,$i,$coord)}
     2029           }
     2030        }
     2031     }
     2032     puts "after operation: $::fix_list($coord,$phase)"
     2033
     2034
     2035}
     2036
     2037#******Main Fixing Program
     2038    if {[lindex $expmap(phasetype) [expr {$p - 1}]] != 4} {
     2039        grid [TitleFrame $w.10 -bd 6 -relief groove \
     2040                -text "Fix Atom$suffix Coordinates"] \
     2041                -row 9 -column 0 -columnspan 10 -sticky news
     2042        set fix [$w.10 getframe]
     2043        Fix_Initialize $numberList
     2044
     2045        label $fix.xlab -text "  x  " -width 8
     2046        label $fix.ylab -text "  y  " -width 8
     2047        label $fix.zlab -text "  z  " -width 8
     2048        grid $fix.xlab -row 2 -column 0
     2049        grid $fix.ylab -row 2 -column 1
     2050        grid $fix.zlab -row 2 -column 2
     2051
     2052
     2053        button $fix.x -text "$::fix_state_X" -width 8 \
     2054               -command "Fix_Atoms $phase [list $numberList] X $fix.x;
     2055               Fix_Write
     2056               DisplayAllAtoms $phase"
     2057
     2058        button $fix.y -text "$::fix_state_Y" -width 8 \
     2059                -command "Fix_Atoms $phase [list $numberList] Y $fix.y
     2060                Fix_Write
     2061                DisplayAllAtoms $phase"
     2062        button $fix.z -text "$::fix_state_Z" -width 8 \
     2063                -command "Fix_Atoms $phase [list $numberList] Z $fix.z
     2064                Fix_Write
     2065                DisplayAllAtoms $phase"
     2066        grid $fix.x -row 3 -column 0
     2067        grid $fix.y -row 3 -column 1
     2068        grid $fix.z -row 3 -column 2
     2069    }
     2070
     2071
     2072
     2073
     2074#xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
    19382075
    19392076    grid rowconfigure $w 11 -minsize 5
    … …  
    19542091    if {[llength $expgui(selectedatomlist)] != 0} editRecord
    19552092}
     2093
     2094
    19562095
    19572096# transform the coordinates

  • branches/sandbox/distrest.tcl

    r1032 r1109  
    115115
    116116    label  $top.rlabel1 -text "Restraint" -width 9 -anchor center
    117     label  $top.rlabel2 -text "esd"      -width 9 -anchor center
     117    label  $top.rlabel2 -text "Tolerance" -width 9 -anchor center
    118118
    119119    grid $top.alabel1 -column 1 -row 2 -padx 3
    … …  
    338338
    339339    label  $sr_top.rlabel1 -text "Restraint"
    340     label  $sr_top.rlabel2 -text "esd"
     340    label  $sr_top.rlabel2 -text "Tolerance"
    341341    grid $sr_top.rlabel1 -column 4 -row 2 -padx 20
    342342    grid $sr_top.rlabel2 -column 5 -row 2 -padx 20

  • branches/sandbox/expgui

    r1108 r1109  
    12481248            } else {
    12491249                append refflag " [mmatominfo $phase $atom ${type}damp] "
    1250             }   
     1250            }
    12511251        }
    12521252        set line [format \
    … …  
    12631263                [mmatominfo $phase $atom z] \
    12641264                [mmatominfo $phase $atom frac] \
    1265                 [mmatominfo $phase $atom Uiso] 
     1265                [mmatominfo $phase $atom Uiso]
    12661266        ]
    12671267    } elseif {[atominfo $phase $atom temptype] == "A"} {
    … …  
    12771277        set maxline A
    12781278        # aniso
    1279         set line [format "%3d %-6s %-6s %8s %10.6f%10.6f%10.6f%4d%9.4f" \
     1279        set fmt "%3d %-6s %-6s %8s %s%s%s%4d%9.4f"
     1280        set line [format $fmt \
    12801281                $atom \
    12811282                [atominfo $phase $atom label] \
    12821283                [atominfo $phase $atom type] \
    12831284                $refflag \
    1284                 [atominfo $phase $atom x] \
    1285                 [atominfo $phase $atom y] \
    1286                 [atominfo $phase $atom z] \
     1285                [ShowFixAtom $phase $atom x] \
     1286                [ShowFixAtom $phase $atom y] \
     1287                [ShowFixAtom $phase $atom z] \
    12871288                [atominfo $phase $atom mult] \
    1288                 [atominfo $phase $atom frac] 
     1289                [atominfo $phase $atom frac]
    12891290        ]
    12901291        append line [format "  %9.5f%9.5f%9.5f%9.5f%9.5f%9.5f" \
    … …  
    12941295                [atominfo $phase $atom U12] \
    12951296                [atominfo $phase $atom U23] \
    1296                 [atominfo $phase $atom U13] 
     1297                [atominfo $phase $atom U13]
    12971298        ]
    12981299    } else {
    … …  
    13021303            } else {
    13031304                append refflag " [atominfo $phase $atom ${type}damp] "
    1304             }   
    1305         }
    1306         set line [format \
    1307                 "%3d %-6s %-6s %8s %10.6f%10.6f%10.6f%4d%9.4f  %9.5f" \
     1305            }
     1306        }
     1307        #set fmt "%3d %-6s %-6s %8s %10.6f%10.6f%10.6f%4d%9.4f  %9.5f"
     1308        set fmt "%3d %-6s %-6s %8s %s%s%s%4d%9.4f  %9.5f"
     1309        set line [format $fmt \
    13081310                $atom \
    13091311                [atominfo $phase $atom label] \
    13101312                [atominfo $phase $atom type] \
    13111313                $refflag \
    1312                 [atominfo $phase $atom x] \
    1313                 [atominfo $phase $atom y] \
    1314                 [atominfo $phase $atom z] \
     1314                [ShowFixAtom $phase $atom x] \
     1315                [ShowFixAtom $phase $atom y] \
     1316                [ShowFixAtom $phase $atom z] \
    13151317                [atominfo $phase $atom mult] \
    13161318                [atominfo $phase $atom frac] \
    1317                 [atominfo $phase $atom Uiso] 
     1319                [atominfo $phase $atom Uiso]
    13181320        ]
    13191321    }
    13201322    return $line
     1323}
     1324
     1325# format a coordinate from a non-mm phase as 10 chars; mark fixed coordinates differently
     1326proc ShowFixAtom {phase atom var} {
     1327  # is this fixed?
     1328  set param [string toupper $var]
     1329  if {[array name ::fix_param "$phase,$atom,$param"] != ""} {
     1330    return [format "%9.5fF" [atominfo $phase $atom $var]]
     1331  } else {
     1332    return [format "%10.6f" [atominfo $phase $atom $var]]
     1333  }
    13211334}
    13221335

  • branches/sandbox/readexp.tcl

    r1106 r1109  
    187187        }
    188188    }
     189    # load the constrained parameters
     190    atom_constraint_load
    189191    set expgui(mapstat) 1
    190192}
    … …  
    21622164}
    21632165
     2166#  read fixed constraints
     2167
     2168proc atom_constraint_read {phase} {
     2169
     2170         set fix_list ""
     2171         foreach k {1 2 3 4 5 6 7 8 9} {
     2172                  set key [format "LEQV HOLD%1d%2d" $phase $k]
     2173                  set line [readexp $key]
     2174                  foreach j {2 10 18 26 34 42 50 58} {
     2175                           set fix_param [string range $line $j [expr $j+7]]
     2176                           if {[string trim $fix_param] == ""} {return $fix_list}
     2177                           lappend fix_list $fix_param
     2178                  }
     2179         }
     2180}
     2181
     2182# load all atom constraints into global array fix_param
     2183proc atom_constraint_load { } {
     2184     catch {unset ::fix_param}
     2185     foreach i $::expmap(phaselist) {
     2186             set temp [atom_constraint_read $i]
     2187             foreach j $temp {
     2188                     set atomnum [string trim [string range $j 2 3]]
     2189                     set param [string trim [string range $j 4 6]]
     2190                     set ::fix_param($i,$atomnum,$param) 1
     2191
     2192                     }
     2193     }
     2194}
     2195
     2196proc atom_constraint_write {phase fix_list} {
     2197
     2198     foreach key [array names ::exparray "LEQV HOLD$phase*"] {
     2199             delexp $key
     2200     }
     2201     set k 0
     2202     set j 1
     2203     set line ""
     2204     foreach fix $fix_list {
     2205             incr k
     2206             append line $fix
     2207             if {$k == 8} {
     2208                set key [format "LEQV HOLD%1d%2d" $phase $j]
     2209                makeexprec $key
     2210                setexp $key $line 3 [expr ($k * 8) + 2]
     2211                set k 0
     2212                incr j
     2213                set line ""
     2214             }
     2215     }
     2216     if {$line != ""} {
     2217        set key [format "LEQV HOLD%1d%2d" $phase $j]
     2218        makeexprec $key
     2219        setexp $key $line 3 [expr ($k * 8) + 2]
     2220     }
     2221
     2222}
     2223
     2224
     2225
    21642226#  get a logical constraint
    21652227#
Note: See TracChangeset for help on using the changeset viewer.