Changeset 1189 for branches/sandbox


Ignore:
Timestamp:
Feb 6, 2012 5:03:22 PM (9 years ago)
Author:
toby
Message:

fix bug in releasing fixed atoms; finish interface for fixed parms in readexp

Location:
branches/sandbox
Files:
3 edited

Legend:

Unmodified
Added
Removed
  • branches/sandbox/addcmds.tcl

    r1182 r1189  
    19621962    if {[lindex $expmap(phasetype) [expr {$p - 1}]] != 4} {
    19631963        grid [TitleFrame $w.10 -bd 6 -relief groove \
    1964                 -text "Fix Atom$suffix Coordinates"] \
    1965                 -row 9 -column 0 -columnspan 10 -sticky news
     1964                  -text "Fix Coordinates for Atom$suffix"] \
     1965            -row 9 -column 0 -columnspan 10 -sticky news
    19661966        set fix [$w.10 getframe]
    1967         Fix_Initialize $numberList
     1967        # set button labels
     1968        set ::fixbtn_lbl(X) [Fix_State $phase $numberList X]
     1969        set ::fixbtn_lbl(Y) [Fix_State $phase $numberList Y]
     1970        set ::fixbtn_lbl(Z) [Fix_State $phase $numberList Z]
    19681971
    19691972        label $fix.xlab -text "  x  " -width 8
     
    19751978
    19761979
    1977         button $fix.x -text "$::fix_state_X" -width 8 \
    1978                -command "Fix_Atoms $phase [list $numberList] X $fix.x;
    1979                Fix_Write
    1980                DisplayAllAtoms $phase"
    1981 
    1982         button $fix.y -text "$::fix_state_Y" -width 8 \
    1983                 -command "Fix_Atoms $phase [list $numberList] Y $fix.y
    1984                 Fix_Write
    1985                 DisplayAllAtoms $phase"
    1986         button $fix.z -text "$::fix_state_Z" -width 8 \
    1987                 -command "Fix_Atoms $phase [list $numberList] Z $fix.z
    1988                 Fix_Write
    1989                 DisplayAllAtoms $phase"
     1980        button $fix.x -textvariable fixbtn_lbl(X) -width 8 \
     1981            -command "Fix_Atoms $phase [list $numberList] X"
     1982        button $fix.y -textvariable fixbtn_lbl(Y) -width 8 \
     1983            -command "Fix_Atoms $phase [list $numberList] Y"
     1984        button $fix.z -textvariable fixbtn_lbl(Z) -width 8 \
     1985            -command "Fix_Atoms $phase [list $numberList] Z"
    19901986        grid $fix.x -row 3 -column 0
    19911987        grid $fix.y -row 3 -column 1
     
    20122008}
    20132009
    2014 #xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx x
    2015 
    2016 proc Fix_Initialize {numberList} {
    2017      set phaselist $::expmap(phaselist)
    2018      catch {unset ::fix_param}
    2019      foreach i $phaselist {
    2020              set ::fix_list(X,$i) ""
    2021              set ::fix_list(Y,$i) ""
    2022              set ::fix_list(Z,$i) ""
    2023 
    2024              set temp [atom_constraint_read $i]
    2025              foreach j $temp {
    2026                      set atomnum [string trim [string range $j 2 3]]
    2027                      set param [string trim [string range $j 4 6]]
    2028                      set ::fix_param($i,$atomnum,$param) 1
    2029                      if {$param == "X"} {lappend ::fix_list(X,$i) $atomnum}
    2030                      if {$param == "Y"} {lappend ::fix_list(Y,$i) $atomnum}
    2031                      if {$param == "Z"} {lappend ::fix_list(Z,$i) $atomnum}
    2032              }
    2033      }
    2034     set ::fix_state_X [Fix_State $i $numberList X]
    2035     set ::fix_state_Y [Fix_State $i $numberList Y]
    2036     set ::fix_state_Z [Fix_State $i $numberList Z]
    2037 }
    2038 
     2010# test the fixed status of variable for several atoms
    20392011proc Fix_State {phase numberList coord} {
    2040      set status_fixed "-1"
    2041      set status_unfixed "-1"
    2042      #puts "$coord before: $status_fixed $status_unfixed"
    2043      foreach i $numberList {
    2044          set temp [info exists ::fix_param($phase,$i,$coord)]
    2045          #puts "::fix_param($phase,$i,$coord) is variable present?: $temp"
    2046          if {$temp != 0} {set status_fixed 1}
    2047          if {$temp == 0} {set status_unfixed 1}
    2048      }
    2049      #puts "$coord after $status_fixed $status_unfixed"
    2050      if {$status_fixed == 1 && $status_unfixed != 1} {return "fixed"}
    2051      if {$status_fixed == 1 && $status_unfixed == 1} {return "mixed"}
    2052      if {$status_fixed != 1 && $status_unfixed == 1} {return "unfixed"}
    2053 }
    2054 
    2055 proc Fix_Write {} {
    2056       incr ::expgui(changed)
    2057       #puts "Prepare to write [array names ::fix_Param]"
    2058       foreach j [array names ::fix_param] {
    2059              regexp {[0-9]+} $j  temp_phase
    2060              regexp {,[0-9]+} $j ans
    2061              set temp_atom [string range $ans 1 end]
    2062              regexp {[a-zA-Z]+} $j temp_param
    2063              if {$temp_param == "U"} {regexp {[a-zA-Z]+[0-9]+} $j temp_param}
    2064              set temp_entry [format "%1s %+2s%-4s" $temp_phase $temp_atom $temp_param]
    2065              lappend fix_list($temp_phase) $temp_entry
    2066      }
    2067      set phaselist $::expmap(phaselist)
    2068      foreach i $phaselist {
    2069              catch {atom_constraint_write $i $fix_list($i)}
    2070              catch  {RecordMacroEntry "catch {atom_constraint_write $i $fix_list($i)}" 0}
    2071              #puts $fix_list($i)
    2072      }
    2073 }
    2074 
    2075 proc Fix_Atoms {phase numberList coord but} {
    2076 #     puts "before  ::fix_state_$coord [set ::fix_state_$coord]"
    2077      #puts " before operationi: $::fix_list($coord,$phase)"
    2078      switch [set ::fix_state_$coord] {
    2079      "unfixed" {$but config -text "fixed"
    2080                set ::fix_state_$coord "fixed"
    2081                }
    2082      "fixed"   {$but config -text "unfixed"
    2083                set ::fix_state_$coord "unfixed"
    2084                }
    2085      "mixed"   {$but config -text "unfixed"
    2086                set ::fix_state_$coord "unfixed"
    2087                }
    2088      }
    2089      if {[set ::fix_state_$coord] == "fixed"} {
    2090         #puts "fixing atom number $numberList"
    2091         foreach i $numberList {
    2092                 lappend ::fix_list($coord,$phase) $i
    2093                 set ::fix_list($coord,$phase) [lsort -uniq -integer $::fix_list($coord,$phase)]
    2094                 set ::fix_param($phase,$i,$coord) 1
     2012    set status_fixed 0
     2013    set status_unfixed 0
     2014    #puts "$coord before: $status_fixed $status_unfixed"
     2015    foreach i $numberList {
     2016        set temp [atom_constraint_get $phase $i $coord]
     2017        if {$temp == 0} {
     2018            set status_unfixed 1
     2019        } else {
     2020            set status_fixed 1
    20952021        }
    2096      }
    2097      if {[set ::fix_state_$coord] == "unfixed"} {
    2098         #puts "unfixing atoms $numberList"
    2099         foreach i $numberList {
    2100            set temp [lsearch $::fix_list($coord,$phase) $i]
    2101            if {$temp != -1} {
    2102               set ::fix_list($coord,$phase) [lreplace $::fix_list($coord,$phase) $temp $temp]
    2103               catch {unset ::fix_param($phase,$i,$coord)}
    2104            }
     2022        if {$status_fixed == 1 && $status_unfixed == 1} {
     2023            return "fix\nsome"
    21052024        }
    2106      }
    2107      #puts "after operation: $::fix_list($coord,$phase)"
     2025    }
     2026    #puts "$coord after $status_fixed $status_unfixed"
     2027    if {$status_fixed == 0} {return "fix"}
     2028    return "release"
     2029}
     2030
     2031# fix or release the selected atoms
     2032proc Fix_Atoms {phase numberList coord} {
     2033    if {$::fixbtn_lbl($coord) == "release"} {
     2034        set ::fixbtn_lbl($coord) "fix"
     2035        set mode 0
     2036    } else {
     2037        set ::fixbtn_lbl($coord) "release"
     2038        set mode 1
     2039    }
     2040    atom_constraint_set $phase $numberList $coord $mode
     2041    incr ::expgui(changed)
     2042    RecordMacroEntry "atom_constraint_set $phase [list $numberList] $coord $mode" 0
     2043    RecordMacroEntry "incr expgui(changed)" 0
     2044    DisplayAllAtoms $phase
    21082045}
    21092046
  • branches/sandbox/expgui

    r1182 r1189  
    13371337    # is this fixed?
    13381338    set param [string toupper $var]
    1339     if {[array name ::fix_param "$phase,$atom,$param"] != ""} {
    1340         return [format "%9.5fF" [atominfo $phase $atom $var]]
     1339    if {[atom_constraint_get $phase $atom $param]} {
     1340        return [format "%9.5ff" [atominfo $phase $atom $var]]
    13411341    }
    13421342    # is this atom in a rigid body?
  • branches/sandbox/readexp.tcl

    r1176 r1189  
    22432243}
    22442244
    2245 #  read fixed constraints
    2246 
     2245#  read fixed constraints for a phase
    22472246proc atom_constraint_read {phase} {
    2248     set fix_list ""
     2247    set fixlist ""
    22492248    foreach k {1 2 3 4 5 6 7 8 9} {
    22502249        set key [format "LEQV HOLD%1d%2d" $phase $k]
     
    22522251        foreach j {2 10 18 26 34 42 50 58} {
    22532252            set fix_param [string range $line $j [expr $j+7]]
    2254             if {[string trim $fix_param] == ""} {return $fix_list}
    2255             lappend fix_list $fix_param
    2256         }
    2257     }
     2253            if {[string trim $fix_param] == ""} {return $fixlist}
     2254            lappend fixlist $fix_param
     2255        }
     2256    }
     2257    return $fixlist
    22582258}
    22592259
     
    22712271}
    22722272
    2273 proc atom_constraint_write {phase fix_list} {
     2273# returns 1 if the specified variable is fixed
     2274proc atom_constraint_get {phase atom type} {
     2275    if {[array names ::fix_param "$phase,$atom,$type"] == ""} {
     2276        return 0
     2277    }
     2278    return 1
     2279}
     2280
     2281proc atom_constraint_set {phase atomlist type mode} {
     2282    foreach atom $atomlist {
     2283        set key "$phase,$atom,$type"
     2284        if {$mode} {
     2285            set ::fix_param($key) 1
     2286        } else {
     2287            array unset ::fix_param $key
     2288        }
     2289    }
     2290    set fixlist {}
     2291    foreach key [array names ::fix_param "$phase,*"] {
     2292        foreach {j atom parm} [split $key ","] {}
     2293        lappend fixlist \
     2294            [format "%1s %+2s%-4s" $phase $atom $parm]
     2295    }
    22742296    foreach key [array names ::exparray "LEQV HOLD$phase*"] {
    22752297        delexp $key
     
    22782300    set j 1
    22792301    set line ""
    2280     foreach fix $fix_list {
     2302    foreach fix $fixlist {
    22812303        incr k
    22822304        append line $fix
Note: See TracChangeset for help on using the changeset viewer.