Changeset 1219 for trunk


Ignore:
Timestamp:
Aug 19, 2012 1:24:43 PM (8 years ago)
Author:
toby
Message:

Major new release: bug fixes for rigid bodies; Split Restraints from Constraints; add chemistry restraints; edit f' & f; fixes for fixing atoms; start work on Absorption constraints and interface for Fourier maps

Location:
trunk
Files:
2 added
8 edited

Legend:

Unmodified
Added
Removed
  • trunk/addcmds.tcl

    r1188 r1219  
    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
  • trunk/atomcons.tcl

    r1025 r1219  
    1111    grid [NoteBook $expgui(consFrame).n -bd 2 -side bottom] -sticky news
    1212    source [file join $expgui(scriptdir) profcons.tcl]
    13     source [file join $expgui(scriptdir) distrest.tcl]
    1413}
    1514
     
    2120    catch {$expgui(consFrame).n delete macro}
    2221    catch {$expgui(consFrame).n delete profile}
    23     catch {$expgui(consFrame).n delete distrest}
    2422    set atom normal
    2523    set mm disabled
     
    4745            -createcmd "MakeProfileConstraintsPane" \
    4846            -raisecmd "DisplayProfileConstraints"]   
    49     set expcons(distmaster) [\
    50             $expgui(consFrame).n insert end distrest -text "Distance Restraints" \
    51             -state $atom \
    52             -createcmd "" \
    53             -raisecmd "DisplayDistanceRestraints"]
    54  
     47
    5548    set page [$expgui(consFrame).n raise]
    5649    # open the atom constraints page if no page is open
     
    829822    DisplayAtomConstraints $mode
    830823}
     824######################################################################
     825# restraints codes
     826######################################################################
     827# this is used once to create the constraint page
     828proc MakeRestraintsPane {} {
     829    global expgui expcons expmap
     830    # create the notebook
     831    grid [NoteBook $expgui(restrFrame).n -bd 2 -side bottom] -sticky news
     832    source [file join $expgui(scriptdir) distrest.tcl]
     833    source [file join $expgui(scriptdir) chemrest.tcl]
     834}
     835
     836# this is used to update the contents of the constraint page when displayed
     837proc DisplayRestraintsPane {} {
     838    global expgui expcons expmap
     839    # create pages for each of the constraint "subpages"
     840    catch {$expgui(restrFrame).n delete distrest}
     841    catch {$expgui(restrFrame).n delete chemrest}
     842    set atom normal
     843    set mm disabled
     844    if {[llength $expmap(phasetype)] == 0} {
     845        set atom disabled
     846    } elseif {[lindex $expmap(phasetype) 0] == 4} {
     847        set mm normal
     848        if {[llength $expmap(phasetype)] == 1} {
     849            set atom disabled
     850        }
     851    }
     852    set expcons(distmaster) [\
     853            $expgui(restrFrame).n insert end distrest -text "Distance Restraints" \
     854            -state $atom \
     855            -createcmd "" \
     856            -raisecmd "DisplayDistanceRestraints"]
     857 
     858    set expcons(chemmaster) [\
     859            $expgui(restrFrame).n insert end chemrest -text "Chemical Restraints" \
     860            -state $atom \
     861            -createcmd "" \
     862            -raisecmd "DisplayChemRestraints"]
     863 
     864    set page [$expgui(restrFrame).n raise]
     865    # open the atom constraints page if no page is open
     866    if {$page == ""} {
     867        foreach page [$expgui(restrFrame).n pages] {
     868            # loop to the first non-disabled page
     869            if {[$expgui(restrFrame).n itemcget $page -state] == "normal"} {
     870                $expgui(restrFrame).n raise $page
     871                return
     872            }
     873        }
     874    } else {
     875        set pageupdate [$expgui(restrFrame).n itemcget $page -raisecmd]
     876        catch $pageupdate
     877    }
     878}
  • trunk/distrest.tcl

    r1166 r1219  
    3636#SR_Build
    3737
     38set ::sr_atom1_button 1
     39set ::sr_atom2_button 1
     40set ::sr_distance_button 1
     41set ::sr_entryvar(choicenum) 0
     42#    set ::sr_entryvar(softphase) "1"
     43#    set ::sr_phaselist $::expmap(phaselist)
     44set ::sr_entryvar(softatom1) "all"
     45set ::sr_entryvar(softatom2) "all"
     46set ::sr_phaselist $::expmap(phaselist)
     47set ::sr_error 0
     48set ::sr_bond_list ""
     49set ::sr_dminvalue 0
     50set ::sr_dmaxvalue 1000
     51set ::sr_display_mode noedit
     52set ::sr_key_list ""
     53
    3854proc DisplayDistanceRestraints {args} {
    3955    #puts DisplayDistanceRestraints
     
    8399    set ::entrycmd(trace) 0
    84100    set ::entryvar(distrestweight) [SoftConst weight]
    85     RecordMacroEntry "set ::entryvar(distrestweight) [SoftConst weight]" 0
     101    #RecordMacroEntry "set ::entryvar(distrestweight) [SoftConst weight]" 0
    86102    set ::entrycmd(trace) 1
    87     incr ::expgui(changed)
     103    #incr ::expgui(changed)
    88104
    89105    #Run Disagl Commands *****************************************************
     
    104120
    105121
    106     foreach {top main side lbl} [MakeScrollTable $rightfr] {}
     122    foreach {top main side lbl} [MakeScrollTable $rightfr 450 300] {}
    107123    MouseWheelScrollTable $rightfr
    108124    set atom1_state  1
     
    724740    putontop $mrb
    725741}
    726 #************************************************************************
    727 #Procedure to Initialize variables ***************************************
    728 #*************************************************************************
    729 proc SR_Initialize {} {
    730     set ::sr_atom1_button 1
    731     set ::sr_atom2_button 1
    732     set ::sr_distance_button 1
    733     set ::sr_entryvar(choicenum) 0
    734     #    set ::sr_entryvar(softphase) "1"
    735     #    set ::sr_phaselist $::expmap(phaselist)
    736     set ::sr_entryvar(softatom1) "all"
    737     set ::sr_entryvar(softatom2) "all"
    738     set ::sr_phaselist $::expmap(phaselist)
    739     set ::sr_error 0
    740     set ::sr_bond_list ""
    741     set ::sr_dminvalue 0
    742     set ::sr_dmaxvalue 1000
    743     set ::sr_display_mode noedit
    744     set ::sr_key_list ""
    745     #SR_Rest_Only
    746 }
    747742
    748743# load restraints w/o distances
     
    783778    donewait
    784779}
    785 
    786 #expload TEST3.EXP
    787 #mapexp
    788 SR_Initialize
    789 #SR_Read_Distances test2.disagl
    790 #SR_Load_Restraints
    791 #SR_Main_Editor
    792 #SR_Load_Restraints
    793 
    794 
  • trunk/expgui

    r1188 r1219  
    6868catch {if $env(DEBUG) {set expgui(debug) 1}}
    6969#set expgui(debug) 1
    70 
     70set expgui(HistSelectList) {}
    7171# location for web pages, if not found locally
    7272set expgui(website) 11bm.xor.aps.anl.gov/expguidoc/
     
    159159source [file join $expgui(scriptdir) disagledit.tcl]
    160160source [file join $expgui(scriptdir) Geo_Viewer.tcl]
     161# setup Anomalous Dispersion Coefficent Editor
     162source [file join $expgui(scriptdir) anomal.tcl]
    161163#---------------------------------------------------------------------------
    162164# override options with locally defined values
     
    13371339    # is this fixed?
    13381340    set param [string toupper $var]
    1339     if {[array name ::fix_param "$phase,$atom,$param"] != ""} {
    1340         return [format "%9.5fF" [atominfo $phase $atom $var]]
     1341    if {[atom_constraint_get $phase $atom $param]} {
     1342        return [format "%9.5ff" [atominfo $phase $atom $var]]
    13411343    }
    13421344    # is this atom in a rigid body?
     
    16351637            -yscrollcommand "$frm.y set" \
    16361638            ] -row 2 -column 0 -sticky news
    1637     lappend expgui(HistSelectList) $frm
     1639    if {[lsearch $expgui(HistSelectList) $frm] < 0} {
     1640        lappend expgui(HistSelectList) $frm
     1641    }
    16381642    grid [scrollbar $frm.x -orient horizontal \
    16391643            -command "move2boxesX \" $frm.title $frm.lbox \" "
     
    16591663    }
    16601664    foreach lbox $expgui(HistSelectList) {
     1665        if {! [winfo exists $lbox]} continue
    16611666        $lbox.title delete 0 end
    16621667        $lbox.lbox delete 0 end
     
    17211726    # title field needs to match longest title
    17221727    foreach lbox $expgui(HistSelectList) {
     1728        if {! [winfo exists $lbox]} continue
    17231729        $lbox.title insert end [format "%2s %s %4s %8s  %-67s" \
    17241730                "h#" \
     
    17561762        }
    17571763        foreach lbox $expgui(HistSelectList) {
     1764            if {! [winfo exists $lbox]} continue
    17581765            $lbox.lbox insert end [format "%2d  %s %4d %8s  %-67s" \
    17591766                    $h \
     
    17931800            } else {
    17941801                $c configure -state normal
    1795             } 
     1802            }
    17961803        }
    17971804    }
     
    18151822        set expgui(backtermlbl) ""
    18161823        set expgui(backtypelbl) ""
    1817         set expgui(abstypelbl) "" 
     1824        set expgui(abstypelbl) ""
    18181825        foreach var {bref bdamp absref absdamp} {
    18191826            set entrycmd($var) ""
     
    18211828        }
    18221829        $expgui(histFrame).top.txt config -text "No Selected Histograms"
    1823         grid $expgui(histFrame).top -column 1 -row 0 -sticky nsew       
     1830        grid $expgui(histFrame).top -column 1 -row 0 -sticky nsew
    18241831        set expgui(bkglbl) ""
    18251832        set expgui(abslbl) ""
     
    18321839        set expgui(backtermlbl) ""
    18331840        set expgui(backtypelbl) ""
    1834         set expgui(abstypelbl) "" 
     1841        set expgui(abstypelbl) ""
    18351842        foreach var {bref bdamp absref absdamp} {
    18361843            set entrycmd($var) "histinfo [list $histlist] $var"
    18371844            set entryvar($var) [histinfo [lindex $histlist 0] $var]
    18381845        }
     1846        $expgui(histFrame).bb.anom config -state disabled
    18391847    } else {
    18401848        set hist $histlist
     
    18691877            set expgui(abstypelbl) "  Model #$abstype, value: [histinfo $hist abscor1]"
    18701878        }
     1879        $expgui(histFrame).bb.anom config -state normal
    18711880    }
    18721881    # Top box
     
    33283337            DisplayProfile \
    33293338            1  expgui5.html ""}
    3330     {consFrame    "Re/Constraints" \
     3339    {consFrame    "Constraints" \
    33313340            "source [file join $expgui(scriptdir) atomcons.tcl]; MakeConstraintsPane" \
    33323341            DisplayConstraintsPane \
     3342            0  expgui6.html ""}
     3343    {restrFrame    "Restraints" \
     3344            "source [file join $expgui(scriptdir) atomcons.tcl]; MakeRestraintsPane" \
     3345            DisplayRestraintsPane \
    33333346            0  expgui6.html ""}
    33343347    {rbFrame   "Rigid Body" \
     
    38933906            -command SetHistUseFlags
    38943907    grid $expgui(histFrame).bb.use -column 2 -row 1
     3908    button $expgui(histFrame).bb.anom -text "Edit\n\u0394f' and \u0394f\""\
     3909            -command Edit_Anomalous
     3910    grid $expgui(histFrame).bb.anom -column 3 -row 1
    38953911
    38963912    # BACKGROUND information.
  • trunk/gsascmds.tcl

    r1195 r1219  
    24272427# creates a table that is scrollable in both x and y, use ResizeScrollTable
    24282428# to set sizes after gridding the widgets
    2429 proc MakeScrollTable {box} {
     2429proc MakeScrollTable {box {width 200} {height 200}} {
    24302430    proc sync2boxes {cmd master slave scroll args} {
    24312431        $slave $cmd moveto [lindex [$master $cmd] 0]
     
    24462446            -yscrollcommand "sync2boxes yview $box.can $box.side $box.yscroll" \
    24472447            -xscrollcommand "sync2boxes xview $box.can $box.top $box.scroll" \
    2448             -width 200 -height 200 -bg lightgrey] -sticky news -row 1 -column 1
     2448            -width $width -height $height -bg lightgrey] -sticky news -row 1 -column 1
    24492449    grid [set sxbox [scrollbar $box.scroll -orient horizontal \
    24502450                         -command "move2boxes xview $box.can $box.top"]] \
  • trunk/rbimport_zmatrix.tcl

    r1166 r1219  
    2828
    2929     grid [button $zmat.con.but -text "Load Z-Matrix" -width 22 -command "RB_Zmat $zmat.display"] -row 2 -column 1
    30      grid [button $zmat.save.but2 -text "Convert to Cartesian \n Coordnates" -width 17 -command "RB_Zmat_Convert"] -row 2 -column 1 -padx 5
     30     grid [button $zmat.save.but2 -text "Continue" -width 17 -command "RB_Zmat_Convert"] -row 2 -column 1 -padx 5
    3131          $zmat.save.but2 config -state disable
    3232     grid [button $zmat.save.but3 -text "Abort" -width 17 -command "destroy .zmatrix"] -row 2 -column 2 -padx 5 -sticky ns
  • trunk/readexp.tcl

    r1177 r1219  
    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
     
    23272349#              phase-list, histogram-list, multiplier
    23282350# Note that phase-list and/or histogram-list can be ALL
     2351#
     2352#  type action
     2353#  -----------
     2354#  absorbX get number         returns a list of constraints for term X=1 or 2
     2355#   returns a the number of constraints for number = 0
     2356#   returns a list of lists {{hist mult} {hist mult} ...}
     2357
     2358#  absorbX set number value   replaces a list of constraints
     2359#      number corresponds to a specific constraint see "absorbX get 0"
     2360#      value is a list of lists {{hist mult} {hist mult} ...}
     2361#  absorbX add number value   inserts a new list of constraints
     2362#                               (number is ignored)
     2363#  absorbX  delete number      deletes a set of constraint entries and renumbers
     2364# note that hist can be:
     2365#      a histogram number (such as 2) or
     2366#      range of histograms (such as 1:10 or 11:99, etc.) or
     2367#      the string "ALL"
    23292368
    23302369proc constrinfo {type action number "value {}"} {
     
    25922631                    # this line is not needed
    25932632                    if {$j % 3 == 1} {
    2594                         delexp %key
     2633                        delexp $key
    25952634                    }
    25962635                    continue
     
    27102749            return $clist
    27112750        }
     2751        absorb*-delete {
     2752            regsub absorb $type {} term
     2753            set key "LEQV ABS$term   "
     2754            if {! [existsexp $key]} {return 0}
     2755            # current number of constraints
     2756            set nterm [string trim [string range [readexp $key] 0 5]]
     2757            if {$nterm == ""} {return 0}
     2758            # does the entry exist?
     2759            if {$nterm < $number} {
     2760                puts "deleted!"
     2761                return $nterm
     2762            }
     2763            for {set target $number} {$target < $nterm} {incr target} {
     2764                set source [expr {$target + 1}]
     2765                set recs [GetAbsCount $term $source]
     2766                SetAbsCount $term $target [expr {3*$recs}]
     2767                validint source 2
     2768                validint target 2
     2769                for {set i 1} {$i <= $recs} {incr i} {
     2770                    set keyin "LEQV ABS${term}${source}$i"
     2771                    set keyout "LEQV ABS${term}${target}$i"
     2772                    set ::exparray($keyout) $::exparray($keyin)
     2773                }
     2774            }
     2775            SetAbsCount $term $nterm 0
     2776            # delete the last entry
     2777            validint nterm 2
     2778            foreach i {1 2 3 4 5 6 7 8 9} {
     2779                set key "LEQV ABS${term}${nterm}$i"
     2780                delexp $key
     2781            }
     2782            # decrease the count by one
     2783            set nterm [expr {[string trim $nterm] - 1}]
     2784            if {$nterm == 0} {
     2785                delexp "LEQV ABS$term   "
     2786            } else {
     2787                validint nterm 5
     2788                setexp "LEQV ABS$term   " $nterm 1 5                   
     2789            }
     2790            return [string trim $nterm]
     2791
     2792            if {$term < 10} {
     2793                set term " $term"
     2794            }
     2795            set key "LEQV PF$term   "
     2796            # return nothing if no term exists
     2797            if {![existsexp $key]} {return 0}
     2798
     2799            # number of constraint terms
     2800            set nterms [string trim [string range [readexp ${key}] 0 4] ]
     2801            # don't delete a non-existing entry
     2802            if {$number > $nterms} {return 0}
     2803            set val [expr {$nterms - 1}]
     2804            validint val 5
     2805            setexp $key $val 1 5
     2806            for {set i1 $number} {$i1 < $nterms} {incr i1} {
     2807                set i2 [expr {1 + $i1}]
     2808                # move the contents of constraint #i2 -> i1
     2809                if {$i1 > 9} {
     2810                    set k1 [expr {($i1+1)/10}]
     2811                    set l1 $i1
     2812                } else {
     2813                    set k1 " "
     2814                    set l1 " $i1"
     2815                }
     2816                set key1 "LEQV PF$term  $k1"
     2817                # number of constraint lines for #i1
     2818                set n1 [string trim [string range [readexp ${key1}] \
     2819                        [expr {($i1%10)*5}] [expr {4+(($i1%10)*5)}]] ]
     2820                if {$i2 > 9} {
     2821                    set k2 [expr {($i2+1)/10}]
     2822                    set l2 $i2
     2823                } else {
     2824                    set k2 " "
     2825                    set l2 " $i2"
     2826                }
     2827                set key2 "LEQV PF$term  $k2"
     2828                # number of constraint lines for #i2
     2829                set n2 [string trim [string range [readexp ${key2}] \
     2830                        [expr {($i2%10)*5}] [expr {4+(($i2%10)*5)}]] ]
     2831                set val $n2
     2832                validint val 5
     2833                # move the # of terms
     2834                setexp $key1 $val [expr {1+(($i1%10)*5)}] 5
     2835                # move the terms
     2836                for {set j 1} {$j <= $n2} {incr j 1} {
     2837                    set key "LEQV PF${term}${l1}$j"
     2838                    makeexprec $key
     2839                    setexp $key [readexp "LEQV PF${term}${l2}$j"] 1 68
     2840                }
     2841                # delete any remaining lines
     2842                for {set j [expr {$n2+1}]} {$j <= $n1} {incr j 1} {
     2843                    delexp "LEQV PF${term}${l1}$j"
     2844                }
     2845            }
     2846
     2847            # clear the last term
     2848            if {$nterms > 9} {
     2849                set i [expr {($nterms+1)/10}]
     2850            } else {
     2851                set i " "
     2852            }
     2853            set key "LEQV PF$term  $i"
     2854            set cb [expr {($nterms%10)*5}]
     2855            set ce [expr {4+(($nterms%10)*5)}]
     2856            set n2 [string trim [string range [readexp ${key}] $cb $ce] ]
     2857            incr cb
     2858            setexp $key "     " $cb 5
     2859            # delete any remaining lines
     2860            for {set j 1} {$j <= $n2} {incr j 1} {
     2861                delexp "LEQV PF${term}${nterms}$j"
     2862            }
     2863        }
     2864        absorb*-set {
     2865            regsub absorb $type {} term
     2866            if {$number < 1} return   
     2867            # delete old records
     2868            set l [GetAbsCount $term $number]
     2869            set num $number
     2870            validint num 2
     2871            for {set i 1} {$i <= $l} {incr i} {
     2872                delexp "LEQV ABS${term}${num}$i"
     2873            }
     2874            # record the new number of records
     2875            SetAbsCount $term $number [llength $value]
     2876            # save the new records
     2877            set i 1
     2878            set offh 2
     2879            set offm 14
     2880            foreach set $value {
     2881                set hist [string trim [lindex $set 0]]
     2882                set mult [string trim [lindex $set 1]]
     2883                validreal mult 8 4
     2884                set key "LEQV ABS${term}${num}$i"
     2885                if {$offh == 2} {
     2886                    makeexprec $key
     2887                }
     2888                setexp $key $hist [expr {$offh+1}] 11
     2889                setexp $key $mult [expr {$offm+1}] 8
     2890                incr offh 21
     2891                incr offm 21
     2892                if {$offm > 67} {
     2893                    incr i
     2894                    set offh 2
     2895                    set offm 14
     2896                }
     2897            }
     2898            return
     2899        }
     2900        absorb*-add {
     2901            regsub absorb $type {} term
     2902            set key "LEQV ABS$term   "
     2903            if {! [existsexp $key]} {makeexprec $key}
     2904            # current number of constraints
     2905            set nterm [string trim [string range [readexp $key] 0 5]]
     2906            if {$nterm == ""} {set nterm 0}
     2907            if {$nterm >= 99} {
     2908                return $nterm
     2909            }
     2910            incr nterm
     2911            validint nterm 5
     2912            setexp $key $nterm 1 5
     2913            constrinfo $type set [string trim $nterm] $value
     2914            return [string trim $nterm]
     2915        }
     2916        absorb*-get {
     2917            regsub absorb $type {} term
     2918            # no constraints, return blank
     2919            set key "LEQV ABS$term   "
     2920            if {! [existsexp $key]} {return ""}
     2921            # requesting number of constraints
     2922            if {$number == 0} {
     2923                set l [string trim [string range [readexp ${key}] 0 5]]
     2924                if {$l == ""} {return 0}
     2925                return $l
     2926            }
     2927            #
     2928            if {$number > 9} {
     2929                set num $number
     2930                set i [expr {($number+1)/10}]
     2931                set off [expr {5*($number % 10)}]
     2932                set key "LEQV ABS$term  $i"
     2933            } else {
     2934                set num " $number"
     2935                set i " "
     2936                set off [expr {5*($number % 10)}]
     2937            }
     2938            set off1 [expr {$off + 5}]
     2939            set l [string trim [string range [readexp ${key}] $off $off1]]
     2940            if {$l == ""} {return {}}
     2941            # now look up those records
     2942            set res {}
     2943            for {set i 1} {$i <= $l} {incr i} {
     2944                set key "LEQV ABS${term}${num}$i"
     2945                for {set j 0} {$j < 3} {incr j} {
     2946                    set off [expr {2 + 21*$j}]
     2947                    set off1 [expr {$off + 11}]
     2948                    set hist [string trim [string range [readexp ${key}] $off $off1]]
     2949                    set off [expr {14 + 21*$j}]
     2950                    set off1 [expr {$off + 7}]
     2951                    set mult [string trim [string range [readexp ${key}] $off $off1]]
     2952                    if {$mult == ""} break
     2953                    lappend res [list $hist $mult]
     2954                }
     2955            }
     2956            return $res
     2957        }
    27122958        default {
    27132959            set msg "Unsupported constrinfo access: type=$type action=$action"
     
    27162962
    27172963    }
     2964}
     2965proc GetAbsCount {term number} {
     2966    if {$number > 9} {
     2967        set num $number
     2968        set off [expr {5*($number % 10)}]
     2969        set i [expr {($number+1)/10}]
     2970        set key "LEQV ABS$term  $i"
     2971    } else {
     2972        set num " $number"
     2973        set off [expr {5*($number % 10)}]
     2974        set key "LEQV ABS$term   "
     2975    }
     2976    set off1 [expr {$off + 5}]
     2977    set l [string trim [string range [readexp ${key}] $off $off1]]
     2978    if {$l == ""} {set l 0}
     2979    return $l
     2980}
     2981proc SetAbsCount {term number len} {
     2982    if {$number > 9} {
     2983        set num $number
     2984        set off [expr {1 + 5*($number % 10)}]
     2985        set i [expr {($number+1)/10}]
     2986        set key "LEQV ABS$term  $i"
     2987    } else {
     2988        set num " $number"
     2989        set off [expr {1 + 5*($number % 10)}]
     2990        set key "LEQV ABS$term   "
     2991    }
     2992    set l [expr {($len + 2)/3}]
     2993    set val $l
     2994    validint val 5
     2995    setexp $key $val $off 5
    27182996}
    27192997
     
    33113589        default {
    33123590            set msg "Unsupported phaseinfo access: parm=$parm action=$action"
     3591            tk_dialog .badexp "Error in readexp" $msg error 0 Exit
     3592        }
     3593    return 1
     3594    }
     3595}
     3596
     3597# read/edit chemical restraint info
     3598#  parm:
     3599#    weight -- histogram weight (factr) *
     3600#    restraintlist -- list of restraints *
     3601#  action: get (default) or set
     3602#  value: used only with set
     3603#      value is a list of constraints
     3604#      each constrain contains {sum esd cons1 cons2...}
     3605#      each consN contains {phase atomnum multiplier}
     3606#  * =>  read+write supported
     3607# Examples:
     3608#
     3609#ChemConst restraintlist set { {10 1.1 {1 1 2} {2 2 3}} {0 1 {1 1 1} {1 2 -2}} }
     3610#
     3611#ChemConst restraintlist get
     3612#{10.00000 1.10000 {1 1 2.00000} {2 2 3.00000}} {0.00000 1.00000 {1 1 1.00000} {1 2 -2.00000}}
     3613# constraint one 2*(1:1) + 3*(2:2) = 10(1.1)
     3614# constraint two 1*(1:1) - 2*(1:2) = 0(1)
     3615#   where (1:2) is the total number of atoms (multiplicity*occupancy) for atom 2 in phase 1
     3616
     3617proc ChemConst {parm "action get" "value {}"} {
     3618    set HST {}
     3619    # look for CMP record
     3620    set n 0
     3621    for {set i 0} {$i < $::expmap(nhst)} {incr i} {
     3622        set ihist [expr {$i + 1}]
     3623        if {[expr {$i % 12}] == 0} {
     3624            incr n
     3625            set line [readexp " EXPR  HTYP$n"]
     3626            if {$line == ""} {
     3627                set msg "No HTYP$n entry for Histogram $ihist. This is an invalid .EXP file"
     3628                tk_dialog .badexp "Error in readexp" $msg error 0 Exit
     3629            }
     3630            set j 0
     3631        } else {
     3632            incr j
     3633        }
     3634        if {[string range $line [expr 2+5*$j] [expr 5*($j+1)]] == "CMP "} {
     3635            set HST $ihist
     3636        }
     3637    }
     3638    if {$HST <=9} {
     3639        set key "HST  $HST"
     3640    } else {
     3641        set key "HST $HST"
     3642    }
     3643    if {$HST == "" && $action == "set"} {
     3644        # no CMP found need to add the soft constr. histogram
     3645        # increment number of histograms
     3646        set hst [string trim [string range [readexp { EXPR  NHST }] 0 4]]
     3647        incr hst
     3648        set HST $hst
     3649        if ![validint hst 5] {return 0}
     3650        setexp  { EXPR  NHST } $hst 1 5
     3651        # add to EXPR HTYPx rec, creating if needed
     3652        set n [expr { 1+ (($HST - 1) / 12) }]
     3653        set key " EXPR  HTYP$n"
     3654        if {[array names ::exparray $key] == ""} {
     3655            makeexprec $key
     3656        }
     3657        setexp $key "CMP " [expr 3 + 5*(($HST-1) % 12)] 5
     3658        # create other HST  xx recs
     3659        if {$HST <=9} {
     3660            set key "HST  $HST"
     3661        } else {
     3662            set key "HST $HST"
     3663        }
     3664        makeexprec "$key  HNAM"
     3665        setexp "$key  HNAM" "Chemical composition restraints" 3 31
     3666        makeexprec "$key FACTR"
     3667#       makeexprec "$key NBNDS"
     3668        makeexprec "$key NCMPS"
     3669        mapexp
     3670    } elseif {$HST == ""} {
     3671        if $::expgui(debug) {puts "no restraints"}
     3672        return "1"
     3673    }
     3674
     3675    switch -glob ${parm}-$action {
     3676        weight-get {
     3677            return [string trim [string range [readexp "$key FACTR"] 0 14]]
     3678        }
     3679        weight-set {
     3680            # update FACTR
     3681            if ![validreal value 15 6] {return 0}
     3682            setexp "$key FACTR" $value 1 15
     3683        }
     3684        restraintlist-get {
     3685            set ncons [string trim [string range [readexp "$key NCMPS"] 0 4]]
     3686            set conslist {}
     3687            for {set i 1} {$i <= $ncons} {incr i} {
     3688                set const {}
     3689                set line [readexp "${key} CM$i  "]
     3690                # number of terms
     3691                set nterm [string trim [string range $line 0 4]]
     3692                if {$nterm == ""} {set nterm 0}
     3693                # chemical sum and esd
     3694                lappend const [string trim [string range $line 5 14]]
     3695                lappend const [string trim [string range $line 15 24]]
     3696                for {set j 1} {$j <= $nterm} {incr j} {
     3697                    set n [expr {($j + 2)/3}]
     3698                    set o1 [expr {20*(($j-1)%3)}]
     3699                    set o2 [expr {19 + 20*(($j-1)%3)}]
     3700                    validint n 2
     3701                    if {$o1 == 0} {
     3702                        set line [readexp "${key} CM${i}${n}"]
     3703                    }
     3704                    set frag [string range $line $o1 $o2]                   
     3705                    lappend const [list \
     3706                                       [string trim [string range $frag 0 4]] \
     3707                                       [string trim [string range $frag 5 9]] \
     3708                                       [string trim [string range $frag 10 19]] \
     3709                                   ]
     3710                }
     3711                lappend conslist $const
     3712            }
     3713            return $conslist
     3714        }
     3715        restraintlist-set {
     3716            set num [llength $value]
     3717            if ![validint num 5] {return 0}
     3718            setexp "$key NCMPS" $num 1 5
     3719            # delete all old records
     3720            foreach i [array names ::exparray "${key} CM*"] {
     3721                unset ::exparray($i)
     3722            }
     3723            set i 0
     3724            foreach cons $value {
     3725                incr i
     3726                set sum [lindex $cons 0]
     3727                set esd [lindex $cons 1]
     3728                set terms [lrange $cons 2 end]
     3729                set nterms [llength $terms]
     3730                validint nterms 5
     3731                validreal sum 10 5
     3732                validreal esd 10 5
     3733                makeexprec "${key} CM$i  "
     3734                setexp "${key} CM$i  " "${nterms}${sum}${esd}" 1 25
     3735                set j 0
     3736                set str {}
     3737                foreach term $terms {
     3738                    incr j
     3739                    set n [expr {($j + 2)/3}]
     3740                    if {$n > 99} break
     3741                    validint n 2
     3742                    foreach {phase atom mult} $term {}
     3743                    validint phase 5
     3744                    validint atom 5
     3745                    validreal mult 10 5
     3746                    append str "${phase}${atom}${mult}"
     3747                    if {[expr {$j%3}] == 0} {
     3748                        #puts [readexp "${key} CM${i}${n}"]
     3749                        makeexprec "${key} CM${i}${n}"
     3750                        setexp "${key} CM${i}${n}" $str 1 60
     3751                        set str {}
     3752                    }
     3753                }
     3754                if {[string length $str] > 0} {
     3755                    makeexprec "${key} CM${i}${n}"
     3756                    setexp "${key} CM${i}${n}" $str 1 60
     3757                }
     3758            }
     3759        }
     3760        default {
     3761            set msg "Unsupported phaseinfo access: parm=$parm action=$action"
     3762            puts $msg
    33133763            tk_dialog .badexp "Error in readexp" $msg error 0 Exit
    33143764        }
     
    42874737}
    42884738
     4739# return a list of defined Fourier maps
     4740proc listFourier {} {
     4741    set l {}
     4742    foreach i {1 2 3 4 5 6 7 8 9} {
     4743        if {[existsexp "  FOUR CDAT$i"]} {
     4744            lappend l $i
     4745        }
     4746    }
     4747    return $l
     4748}
     4749
     4750# read a Fourier map entry
     4751# returns five values:
     4752#   0: type of map (DELF,FCLC,FOBS,NFDF,PTSN,DPTS)
     4753#   1: section (X,Y or Z)
     4754#   2: phase (1-9)
     4755#   3: DMIN (usually 0.0)
     4756#   4: DMAX (usually 999.99)
     4757proc readFourier {num} {
     4758    set key "  FOUR CDAT$num"
     4759    if {![existsexp $key]} {
     4760        return {}
     4761    }
     4762    set vals {}
     4763    # 0: type of map (DELF,FCLC,FOBS,NFDF,PTSN,DPTS)
     4764    lappend vals [string trim [string range [readexp $key] 2 6]]
     4765    # 1: section (X,Y or Z)
     4766    lappend vals [string trim [string range [readexp $key] 7 8]]
     4767    # 2: phase (1-9)
     4768    lappend vals [string trim [string range [readexp $key] 8 13]]
     4769    # 3: DMIN (usually 0.0)
     4770    lappend vals [string trim [string range [readexp $key] 18 25]]
     4771    # 4: DMAX (usually 999.99)
     4772    lappend vals [string trim [string range [readexp $key] 30 37]]
     4773    return $vals
     4774}
     4775
     4776# add a new Fourier map computation type
     4777#   arguments:
     4778#      phase: (1-9)
     4779#      type: type of map (DELF,FCLC,FOBS,NFDF,PTSN,DPTS) - default DELF
     4780#      section: (X,Y or Z) - default Z
     4781#   returns the number of the map that is added
     4782proc addFourier {phase {type "DELF"} {section "Z"}} {
     4783    set num {}
     4784    foreach i {1 2 3 4 5 6 7 8 9} {
     4785        set key "  FOUR CDAT$i"
     4786        if {! [existsexp "  FOUR CDAT$i"]} {
     4787            set num $i
     4788            break
     4789        }
     4790    }
     4791    if {$num == ""} {return {}}
     4792    set key "  FOUR CDAT$num"
     4793    makeexprec $key
     4794    setexp $key $type 3 4
     4795    setexp $key $section 8 1
     4796    validint phase 5
     4797    setexp $key $phase 9 5
     4798    setexp $key "NOPR   0.00      999.99" 15 23
     4799    return $num
     4800}
     4801
     4802# read/set a Fourier computation value
     4803# use: Fourierinfo num parm
     4804#  or: Fourierinfo num parm set value
     4805#
     4806#  num is the Fourier entry
     4807#  parm is one of the following
     4808#     type    -- type of map (DELF,FCLC,FOBS,NFDF,PTSN,DPTS)
     4809#     section -- last running map direction (X,Y or Z)
     4810#     phase   -- phase (1-9)
     4811#     dmin    -- d-space for highest order reflection to use (usually 0.0)
     4812#     dmax    -- d-space for lowest order reflection to use (usually 999.99)
     4813# all parameters may be read or set
     4814proc Fourierinfo {num parm "action get" "value {}"} {
     4815    set key "  FOUR CDAT$num"
     4816    if {![existsexp $key]} {
     4817        return {}
     4818    }
     4819    switch -glob ${parm}-$action {
     4820        type-get {
     4821            # type of map (DELF,FCLC,FOBS,NFDF,PTSN,DPTS)
     4822            return [string trim [string range [readexp $key] 2 6]]
     4823        }
     4824        type-set {
     4825            set found 0
     4826            foreach val {DELF FCLC FOBS NFDF PTSN DPTS} {
     4827                if {$val == $value} {
     4828                    set found 1
     4829                    break
     4830                }
     4831            }
     4832            if $found {
     4833                setexp $key $value 3 4
     4834            }
     4835        }
     4836        section-get {
     4837            # section (X,Y or Z)
     4838            return [string range [readexp $key] 7 8]
     4839        }
     4840        section-set {
     4841            set found 0
     4842            foreach val {X Y Z} {
     4843                if {$val == $value} {
     4844                    set found 1
     4845                    break
     4846                }
     4847            }
     4848            if $found {
     4849                setexp $key $value 8 1
     4850            }
     4851        }
     4852        phase-get {
     4853            # phase (1-9)
     4854            return [string trim [string range [readexp $key] 8 13]]
     4855        }
     4856        phase-set {
     4857            validint value 5
     4858            setexp $key $value 9 5
     4859        }
     4860        dmin-get {
     4861            # DMIN (usually 0.0)
     4862            return [string trim [string range [readexp $key] 18 25]]
     4863        }
     4864        dmin-set {
     4865            validreal value 7 2
     4866            setexp $key $value 19 7
     4867        }
     4868        dmax-get {
     4869            # DMAX (usually 999.99)
     4870            return [string trim [string range [readexp $key] 30 37]]
     4871        }
     4872        dmax-set {
     4873            validreal value 7 2
     4874            setexp $key $value 31 7
     4875        }
     4876        default {
     4877            set msg "Unsupported Fourierinfo access: parm=$parm action=$action"
     4878            puts $msg
     4879            tk_dialog .badexp "Error in readexp" $msg error 0 Exit
     4880        }
     4881    }
     4882}
     4883
     4884# set histograms used in Fourier computation
     4885#  use:
     4886#     FourierHists $phase
     4887#     FourierHists $phase set {4 3 2 1}
     4888# returns a list of histograms to be used to compute that phase's Fourier map
     4889# or sets a list of histograms to be used to compute that phase's Fourier map
     4890#
     4891# Note that the histograms are loaded in the order specified with reflections in
     4892# the last histogram overwriting those in earlier ones, where a reflection
     4893# occurs in more than one place
     4894proc FourierHists {phase "action get" "value {}"} {
     4895    # note that in theory one can have more than one CRSm  FMHSTn record
     4896    # if more than 22 histograms are used but we will ignore this
     4897    set key "CRS$phase  FMHST1"
     4898    if {![existsexp $key]} {
     4899        makeexprec $key
     4900    }
     4901    if {$action == "get"} {
     4902        return [string trim [readexp $key]]
     4903    } else {
     4904        set hlist {}
     4905        foreach hist $value {
     4906            validint hist 3
     4907            append hlist $hist
     4908        }
     4909        setexp $key $hlist 0 67
     4910    }
     4911}
     4912# get the Fourier map computation step and limits
     4913# returns 4 lists:
     4914#   {stepx stepy stepz} : step size in Angstroms
     4915#   {xmin xmax} : min and max x in fractional coordinates
     4916#   {ymin ymax} : min and max y in fractional coordinates
     4917#   {zmin zmax} : min and max z in fractional coordinates
     4918proc getFourierLimits {phase} {
     4919    set key "CRS$phase  FMPCTL"
     4920    if {![existsexp $key]} {
     4921        setFourierLimits $phase
     4922    }
     4923    set i 0
     4924    set line [readexp $key]
     4925    foreach v {x y z} cell {a b c} {
     4926        set cell_$v [phaseinfo $phase $cell]
     4927    }
     4928    foreach typ {step min max} {
     4929        foreach v {x y z} {
     4930            set val [string trim [string range $line $i [expr $i+5]]]
     4931            if {$val == ""} {set val 0}
     4932            set ${typ}_${v} $val
     4933            incr i 5
     4934        }           
     4935    }
     4936    set steps {}
     4937    foreach v {x y z} {
     4938        set range_$v {}
     4939        lappend steps [expr {[set cell_$v] / [set step_$v]}]
     4940        lappend range_$v [expr {[set min_$v] * 1. / [set step_$v] }]
     4941        lappend range_$v [expr {[set max_$v] * 1. / [set step_$v] }]
     4942    }
     4943    return [list $steps $range_x $range_y $range_z]
     4944}
     4945
     4946# set the Fourier map computation step and limits
     4947#   Asteps contains {stepx stepy stepz} : step size in Angstroms
     4948#   range_x contains {xmin xmax} : min and max x in fractional coordinates
     4949#   range_y contains {ymin ymax} : min and max y in fractional coordinates
     4950#   range_z contains {zmin zmax} : min and max z in fractional coordinates
     4951proc setFourierLimits {phase \
     4952                           {Asteps {.2 .2 .2}} \
     4953                           {range_x {0 1}} \
     4954                           {range_y {0 1}} \
     4955                           {range_z {0 1}} } {
     4956    set key "CRS$phase  FMPCTL"
     4957    if {![existsexp $key]} {
     4958        makeexprec $key
     4959    }
     4960    set i 1
     4961    # steps across map
     4962    foreach v {x y z} cell {a b c} As $Asteps {
     4963        set s [expr {1 + int([phaseinfo $phase $cell] / $As)}]
     4964        set s [expr {$s + ($s % 2)}]
     4965        set step_$v $s
     4966        lappend steps [set step_$v]
     4967        validint s 5
     4968        setexp $key $s $i 5
     4969        incr i 5
     4970    }
     4971    # x,y,z min in steps
     4972    foreach v {x y z} {
     4973        foreach {min max} [set range_$v] {}
     4974        set s [expr {int($min * [set step_$v]-.5)}]
     4975        validint s 5
     4976        setexp $key $s $i 5
     4977        incr i 5
     4978    }
     4979    # x,y,z max in steps
     4980    foreach v {x y z} {
     4981        foreach {min max} [set range_$v] {}
     4982        set s [expr {int($max * [set step_$v]+.5)}]
     4983        validint s 5
     4984        setexp $key $s $i 5
     4985        incr i 5
     4986    }
     4987}
  • trunk/rigid.tcl

    r1188 r1219  
    7575#          ::rb_firstatom                             contains first atom on active rigid body.  Must be gobal for variable has trace.
    7676#$         ::rb_phase                                 phase for active map
     77#          ::rb(phase,bodnum,mapnum,x)                origin x coord
     78#          ::rb(phase,bodnum,mapnum,y)                origin y coord
     79#          ::rb(phase,bodnum,mapnum,z)                origin z coord
     80#          ::rb(phase,bodnum,mapnum,e1)               euler angle 1
     81#          ::rb(phase,bodnum,mapnum,e2)               euler angle 2
     82#          ::rb(phase,bodnum,mapnum,e3)               euler angle 3
     83
    7784
    7885# debug code to load test files when run as an independent script
     
    109116    if {$::rbtypelist == ""} {
    110117        MyMessageBox -parent . -title "Installation error" -icon warning \
    111             -message "No rigid body import routines were found.\nSomething is wrong with the EXPGUI installation" 
     118            -message "No rigid body import routines were found.\nSomething is wrong with the EXPGUI installation"
    112119        set ::rbtypelist " "
    113120    }
     
    188195     set ::rb_map_positionvars($phase,$bodnum,$mapnum) [lindex $rb_map 3]
    189196     set ::rb_map_damping($phase,$bodnum,$mapnum) [lindex $rb_map 4]
     197
     198     set ::rb_damp_origin [lindex $::rb_map_damping($phase,$bodnum,$mapnum) 6]
     199     set ::rb_damp_euler [lindex $::rb_map_damping($phase,$bodnum,$mapnum) 0]
     200
    190201     set ::rb_map_tls($phase,$bodnum,$mapnum) [lindex $rb_map 5]
    191202     set ::rb_map_tls_var($phase,$bodnum,$mapnum) [lindex $rb_map 6]
    192203     set ::rb_map_tls_damp($phase,$bodnum,$mapnum) [lindex $rb_map 7]
     204     
     205     set ::rb_damp_t [lindex $::rb_map_tls_damp($phase,$bodnum,$mapnum) 0]
     206     set ::rb_damp_l [lindex $::rb_map_tls_damp($phase,$bodnum,$mapnum) 1]
     207     set ::rb_damp_s [lindex $::rb_map_tls_damp($phase,$bodnum,$mapnum) 2]
    193208}
    194209
     
    454469     button $con.rb_vmatrix -text "Edit Matrix" -command "RB_Edit_Matrix $bodnum" -width 18
    455470     grid   $con.rb_vmatrix -row 4 -column 1 -padx 5 -pady 5
    456      grid [button $con.refine -text "Refinement \n Flags" -command "RB_Refine_Con" -width 18 ] -row 5 -column 1
     471     grid [button $con.refine -text "Refinement \n Controls" -command "RB_Refine_Con" -width 18 ] -row 5 -column 1
    457472
    458473     # create header for mapping data
     
    466481     grid [label $main.rb_y   -text "y"] -row 1 -column 4
    467482     grid [label $main.rb_z   -text "z"] -row 1 -column 5
    468      grid [label $main.rb_euler_x -text "x"] -row 1 -column 6
    469      grid [label $main.rb_euler_y -text "y"] -row 1 -column 7
    470      grid [label $main.rb_euler_z -text "z"] -row 1 -column 8
     483     grid [label $main.rb_euler_x -text "R1"] -row 1 -column 6
     484     grid [label $main.rb_euler_y -text "R2"] -row 1 -column 7
     485     grid [label $main.rb_euler_z -text "R3"] -row 1 -column 8
    471486     set col 11
    472487     for {set coordnum 1} {$coordnum <= $::rb_coord_num($bodnum,1)} {incr coordnum} {
     
    17441759
    17451760#                         puts $main
    1746                          grid [button $main.cfefx($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.cfefx($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,x) -width 5] -row $row -column 4
    1747                          grid [button $main.cfefy($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.cfefy($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,y) -width 5]  -row $row -column 5
    1748                          grid [button $main.cfefz($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.cfefz($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,z) -width 5] -row $row -column 6
     1761                         grid [button $main.cfefx($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.cfefx($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,x) -width 8] -row $row -column 4
     1762                         grid [entry $main.cfefxentry($phasenum,$bodnum,$mapnum) -textvariable ::rb($phasenum,$bodnum,$mapnum,x) -width 8] -row [expr $row + 1] -column 4
     1763                         grid [button $main.cfefy($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.cfefy($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,y) -width 8]  -row $row -column 5
     1764                         grid [entry $main.cfefyentry($phasenum,$bodnum,$mapnum) -textvariable ::rb($phasenum,$bodnum,$mapnum,y) -width 8] -row [expr $row + 1] -column 5
     1765                         grid [button $main.cfefz($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.cfefz($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,z) -width 8] -row $row -column 6
     1766                         grid [entry $main.cfefzentry($phasenum,$bodnum,$mapnum) -textvariable ::rb($phasenum,$bodnum,$mapnum,z) -width 8] -row [expr $row + 1] -column 6
    17491767                         grid [label $main.b1($phasenum,$bodnum,$mapnum) -text "   "] -row $row -column 7
    17501768
    1751                          grid [button $main.eref1($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.eref1($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,e1) -width 5] -row $row -column 8
    1752                          grid [button $main.eref2($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.eref2($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,e2) -width 5] -row $row -column 9
    1753                          grid [button $main.eref3($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.eref3($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,e3) -width 5] -row $row -column 10
     1769                         grid [button $main.eref1($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.eref1($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,e1) -width 8] -row $row -column 8
     1770                         grid [entry $main.eref1entry($phasenum,$bodnum,$mapnum) -textvariable ::rb($phasenum,$bodnum,$mapnum,e1) -width 8] -row [expr $row + 1] -column 8
     1771                         grid [button $main.eref2($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.eref2($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,e2) -width 8] -row $row -column 9
     1772                         grid [entry $main.eref2entry($phasenum,$bodnum,$mapnum) -textvariable ::rb($phasenum,$bodnum,$mapnum,e2) -width 8] -row [expr $row + 1] -column 9
     1773                         grid [button $main.eref3($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.eref3($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,e3) -width 8] -row $row -column 10
     1774                         grid [entry $main.eref3entry($phasenum,$bodnum,$mapnum) -textvariable ::rb($phasenum,$bodnum,$mapnum,e3) -width 8] -row [expr $row + 1] -column 10
    17541775#                         grid [label $main.b2($phasenum,$bodnum,$mapnum) -text "   "] -row $row -column 11
    17551776
     
    17571778
    17581779
    1759                          grid [button $main.t11ref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.t11ref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,t11) -width 5] -row $row -column 12
    1760                          grid [button $main.t22ref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.t22ref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,t22) -width 5] -row $row -column 13
    1761                          grid [button $main.t33ref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.t33ref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,t33) -width 5] -row $row -column 14
    1762                          grid [button $main.t12ref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.t12ref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,t12) -width 5] -row $row -column 15
    1763                          grid [button $main.t13ref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.t13ref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,t13) -width 5] -row $row -column 16
    1764                          grid [button $main.t23ref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.t23ref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,t23) -width 5] -row $row -column 17
    1765                          grid [label $main.b3($phasenum,$bodnum,$mapnum) -text "   "] -row $row -column 18
    1766 
    1767                          grid [button $main.l11ref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.l11ref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,l11) -width 5] -row $row -column 19
    1768                          grid [button $main.l22ref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.l22ref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,l22) -width 5] -row $row -column 20
    1769                          grid [button $main.l33ref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.l33ref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,l33) -width 5] -row $row -column 21
    1770                          grid [button $main.l12ref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.l12ref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,l12) -width 5] -row $row -column 22
    1771                          grid [button $main.l13ref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.l13ref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,l13) -width 5] -row $row -column 23
    1772                          grid [button $main.l23ref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.l23ref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,l23) -width 5] -row $row -column 24
     1780                         grid [button $main.t11ref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.t11ref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,t11) -width 8] -row $row -column 12
     1781                         grid [entry $main.t11entry($phasenum,$bodnum,$mapnum) -textvariable ::rb_tls($phasenum,$bodnum,$mapnum,t11) -width 8] -row [expr $row + 1] -column 12
     1782                         grid [button $main.t22ref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.t22ref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,t22) -width 8] -row $row -column 13
     1783                         grid [entry $main.t22entry($phasenum,$bodnum,$mapnum) -textvariable ::rb_tls($phasenum,$bodnum,$mapnum,t22) -width 8] -row [expr $row + 1] -column 13
     1784                         grid [button $main.t33ref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.t33ref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,t33) -width 8] -row $row -column 14
     1785                         grid [entry $main.t33entry($phasenum,$bodnum,$mapnum) -textvariable ::rb_tls($phasenum,$bodnum,$mapnum,t33) -width 8] -row [expr $row + 1] -column 14
     1786                         grid [button $main.t12ref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.t12ref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,t12) -width 8] -row $row -column 15
     1787                         grid [entry $main.t12entry($phasenum,$bodnum,$mapnum) -textvariable ::rb_tls($phasenum,$bodnum,$mapnum,t12) -width 8] -row [expr $row + 1] -column 15
     1788                         grid [button $main.t13ref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.t13ref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,t13) -width 8] -row $row -column 16
     1789                         grid [entry $main.t13entry($phasenum,$bodnum,$mapnum) -textvariable ::rb_tls($phasenum,$bodnum,$mapnum,t13) -width 8] -row [expr $row + 1] -column 16
     1790                         grid [button $main.t23ref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.t23ref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,t23) -width 8] -row $row -column 17
     1791                         grid [entry $main.t23entry($phasenum,$bodnum,$mapnum) -textvariable ::rb_tls($phasenum,$bodnum,$mapnum,t23) -width 8] -row [expr $row + 1] -column 17
     1792
     1793                         grid [button $main.l11ref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.l11ref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,l11) -width 8] -row $row -column 19
     1794                         grid [entry $main.l11entry($phasenum,$bodnum,$mapnum) -textvariable ::rb_tls($phasenum,$bodnum,$mapnum,l11) -width 8] -row [expr $row + 1] -column 19
     1795                         grid [button $main.l22ref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.l22ref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,l22) -width 8] -row $row -column 20
     1796                         grid [entry $main.l22entry($phasenum,$bodnum,$mapnum) -textvariable ::rb_tls($phasenum,$bodnum,$mapnum,l22) -width 8] -row [expr $row + 1] -column 20
     1797                         grid [button $main.l33ref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.l33ref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,l33) -width 8] -row $row -column 21
     1798                         grid [entry $main.l33entry($phasenum,$bodnum,$mapnum) -textvariable ::rb_tls($phasenum,$bodnum,$mapnum,l33) -width 8] -row [expr $row + 1] -column 21
     1799                         grid [button $main.l12ref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.l12ref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,l12) -width 8] -row $row -column 22
     1800                         grid [entry $main.l12entry($phasenum,$bodnum,$mapnum) -textvariable ::rb_tls($phasenum,$bodnum,$mapnum,l12) -width 8] -row [expr $row + 1] -column 22
     1801                         grid [button $main.l13ref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.l13ref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,l13) -width 8] -row $row -column 23
     1802                         grid [entry $main.l13entry($phasenum,$bodnum,$mapnum) -textvariable ::rb_tls($phasenum,$bodnum,$mapnum,l13) -width 8] -row [expr $row + 1] -column 23
     1803                         grid [button $main.l23ref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.l23ref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,l23) -width 8] -row $row -column 24
     1804                         grid [entry $main.l23entry($phasenum,$bodnum,$mapnum) -textvariable ::rb_tls($phasenum,$bodnum,$mapnum,l23) -width 8] -row [expr $row + 1] -column 24
     1805
    17731806                         grid [label $main.b4($phasenum,$bodnum,$mapnum) -text "   "] -row $row -column 25
    17741807
    1775                          grid [button $main.s12ref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.s12ref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,s12) -width 5] -row $row -column 26
    1776                          grid [button $main.s13ref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.s13ref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,s13) -width 5] -row $row -column 27
    1777                          grid [button $main.s21ref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.s21ref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,s21) -width 5] -row $row -column 28
    1778                          grid [button $main.s23ref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.s23ref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,s23) -width 5] -row $row -column 29
    1779                          grid [button $main.s31ref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.s31ref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,s31) -width 5] -row $row -column 30
    1780                          grid [button $main.s32ref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.s32ref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,s32) -width 5] -row $row -column 31
    1781                          grid [button $main.saaref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.saaref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,saa) -width 5] -row $row -column 32
    1782                          grid [button $main.sbbref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.sbbref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,sbb) -width 5] -row $row -column 33
     1808                         grid [button $main.s12ref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.s12ref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,s12) -width 8] -row $row -column 26
     1809                         grid [entry $main.s12entry($phasenum,$bodnum,$mapnum) -textvariable ::rb_tls($phasenum,$bodnum,$mapnum,s12) -width 8] -row [expr $row + 1] -column 26
     1810                         grid [button $main.s13ref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.s13ref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,s13) -width 8] -row $row -column 27
     1811                         grid [entry $main.s13entry($phasenum,$bodnum,$mapnum) -textvariable ::rb_tls($phasenum,$bodnum,$mapnum,s13) -width 8] -row [expr $row + 1] -column 27
     1812                         grid [button $main.s21ref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.s21ref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,s21) -width 8] -row $row -column 28
     1813                         grid [entry $main.s21entry($phasenum,$bodnum,$mapnum) -textvariable ::rb_tls($phasenum,$bodnum,$mapnum,s21) -width 8] -row [expr $row + 1] -column 28
     1814                         grid [button $main.s23ref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.s23ref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,s23) -width 8] -row $row -column 29
     1815                         grid [entry $main.s23entry($phasenum,$bodnum,$mapnum) -textvariable ::rb_tls($phasenum,$bodnum,$mapnum,s23) -width 8] -row [expr $row + 1] -column 29
     1816                         grid [button $main.s31ref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.s31ref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,s31) -width 8] -row $row -column 30
     1817                         grid [entry $main.s31entry($phasenum,$bodnum,$mapnum) -textvariable ::rb_tls($phasenum,$bodnum,$mapnum,s31) -width 8] -row [expr $row + 1] -column 30
     1818                         grid [button $main.s32ref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.s32ref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,s32) -width 8] -row $row -column 31
     1819                         grid [entry $main.s32entry($phasenum,$bodnum,$mapnum) -textvariable ::rb_tls($phasenum,$bodnum,$mapnum,s32) -width 8] -row [expr $row + 1] -column 31
     1820                         grid [button $main.saaref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.saaref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,saa) -width 8] -row $row -column 32
     1821                         grid [entry $main.saaentry($phasenum,$bodnum,$mapnum) -textvariable ::rb_tls($phasenum,$bodnum,$mapnum,saa) -width 8] -row [expr $row + 1] -column 32
     1822                         grid [button $main.sbbref($phasenum,$bodnum,$mapnum) -command "RB_Con_Button $main.sbbref($phasenum,$bodnum,$mapnum)" -textvariable ::rb_var($phasenum,$bodnum,$mapnum,sbb) -width 8] -row $row -column 33
     1823                         grid [entry $main.sbbentry($phasenum,$bodnum,$mapnum) -textvariable ::rb_tls($phasenum,$bodnum,$mapnum,sbb) -width 8] -row [expr $row + 1] -column 33
    17831824
    17841825                         RB_TLS_Onoff $phasenum $main $bodnum $mapnum
     
    18011842                        grid [label $main.rb_site$phasenum$bodnum$mapnum \
    18021843                                  -text "atoms in rigid body:    $atomlist"] \
    1803                              -row [expr $row + 1] -column 4 -padx 5 -columnspan 999 -sticky w
    1804                         incr row 2
     1844                             -row [expr $row + 2] -column 4 -padx 5 -columnspan 999 -sticky w
     1845                        incr row 3
    18051846                     }
    18061847                 }
     
    18211862
    18221863             grid [label $con.terminate.originlabel -text "Origin Damping Factor "] -row 5 -column 1
     1864
     1865
    18231866             eval tk_optionMenu $con.terminate.origindamp ::rb_damp_origin 0 1 2 3 4 5 6 7 8 9
    1824              grid $con.terminate.origindamp -row 5 -column 2
    1825              $con.terminate.origindamp config -width 4 -state disable
     1867             grid $con.terminate.origindamp -row 5 -column 3
     1868#             $con.terminate.origindamp config -width 4 -state disable
    18261869
    18271870             grid [label $con.terminate.anglelabel -text "Angle Damping Factor "] -row 6 -column 1
    1828              eval tk_optionMenu $con.terminate.angledamp ::rb_damp_angle 0 1 2 3 4 5 6 7 8 9
    1829              grid $con.terminate.angledamp -row 6 -column 2
    1830              $con.terminate.angledamp config -width 4 -state disable
    1831 
    1832              grid [button $con.terminate.save -width 22 -text "Assign Variables and Save" -command RB_Var_Assign] -row 7 -column 1 -columnspan 2
    1833              grid [button $con.terminate.abort -width 22 -text "Abort" -command  {destroy .refcon}] -row 8 -column 1 -columnspan 2
     1871             eval tk_optionMenu $con.terminate.angledamp ::rb_damp_euler 0 1 2 3 4 5 6 7 8 9
     1872             grid $con.terminate.angledamp -row 6 -column 3
     1873 #            $con.terminate.angledamp config -width 4 -state disable
     1874
     1875             grid [label $con.terminate.tls -text "TLS Damping Factors "] -row 7 -column 1
     1876             eval tk_optionMenu $con.terminate.t ::rb_damp_t "" 0 1 2 3 4 5 6 7 8 9
     1877             eval tk_optionMenu $con.terminate.l ::rb_damp_l "" 0 1 2 3 4 5 6 7 8 9
     1878             eval tk_optionMenu $con.terminate.s ::rb_damp_s "" 0 1 2 3 4 5 6 7 8 9
     1879             grid [label $con.terminate.t1 -text "T"] -row 7 -column 2
     1880             grid $con.terminate.t -row 7 -column 3
     1881#             $con.terminate.t config -state disable
     1882             grid [label $con.terminate.l1 -text "L"] -row 7 -column 4
     1883             grid $con.terminate.l -row 7 -column 5
     1884#             $con.terminate.l config -state disable
     1885             grid [label $con.terminate.s1 -text "S"] -row 7 -column 6
     1886             grid $con.terminate.s -row 7 -column 7
     1887#             $con.terminate.s config -state disable
     1888
     1889             grid [button $con.terminate.save -width 22 -text "Assign Variables and Save" -command RB_Var_Assign] -row 8 -column 1 -columnspan 2
     1890             grid [button $con.terminate.abort -width 22 -text "Abort" -command  {destroy .refcon}] -row 9 -column 1 -columnspan 2
    18341891
    18351892}
     
    18941951                     if {[lsearch $varlist [set $var]] == -1} {
    18951952                        lappend varlist [set $var]
    1896 #                        puts $varlist
     1953                        puts $varlist
    18971954                        set rb_variable([set $var]) [RB_Var_Gen $varcount]
    18981955                        set $var $rb_variable([set $var])
     
    19532010                       set refcoordflag 0
    19542011                       set reftlsflag 0
    1955                        set rb_list "$::rb_var($phasenum,$bodnum,$mapnum,x) \
    1956                            $::rb_var($phasenum,$bodnum,$mapnum,y) $::rb_var($phasenum,$bodnum,$mapnum,z) \
    1957                            $::rb_var($phasenum,$bodnum,$mapnum,e1) $::rb_var($phasenum,$bodnum,$mapnum,e2) \
    1958                            $::rb_var($phasenum,$bodnum,$mapnum,e3) 0 0 0"
     2012                       set rb_list "$::rb_var($phasenum,$bodnum,$mapnum,e1) \
     2013                           $::rb_var($phasenum,$bodnum,$mapnum,e2) $::rb_var($phasenum,$bodnum,$mapnum,e3) \
     2014                           0 0 0 $::rb_var($phasenum,$bodnum,$mapnum,x) $::rb_var($phasenum,$bodnum,$mapnum,y) \
     2015                           $::rb_var($phasenum,$bodnum,$mapnum,z)"
     2016#                       puts "param saved for map $phasenum $bodnum $mapnum is vvvvvvv $rb_list"
    19592017                       RigidBodyVary $phasenum $bodnum $mapnum $rb_list
    19602018                       RecordMacroEntry "incr expgui(changed); RigidBodyVary $phasenum $bodnum $mapnum [list $rb_list]" 0
     
    19772035                               $::rb_var($phasenum,$bodnum,$mapnum,s31) $::rb_var($phasenum,$bodnum,$mapnum,s32) \
    19782036                               $::rb_var($phasenum,$bodnum,$mapnum,saa) $::rb_var($phasenum,$bodnum,$mapnum,sbb)"
    1979 #                           puts "TLS param save for $rb_tls"
     2037                           set rb_tls_vals "$::rb_tls($phasenum,$bodnum,$mapnum,t11) $::rb_tls($phasenum,$bodnum,$mapnum,t22) \
     2038                               $::rb_tls($phasenum,$bodnum,$mapnum,t33) $::rb_tls($phasenum,$bodnum,$mapnum,t12) \
     2039                               $::rb_tls($phasenum,$bodnum,$mapnum,t13) $::rb_tls($phasenum,$bodnum,$mapnum,t23) \
     2040                               $::rb_tls($phasenum,$bodnum,$mapnum,l11) $::rb_tls($phasenum,$bodnum,$mapnum,l22) \
     2041                               $::rb_tls($phasenum,$bodnum,$mapnum,l33) $::rb_tls($phasenum,$bodnum,$mapnum,l12) \
     2042                               $::rb_tls($phasenum,$bodnum,$mapnum,l13) $::rb_tls($phasenum,$bodnum,$mapnum,l23) \
     2043                               $::rb_tls($phasenum,$bodnum,$mapnum,s12) $::rb_tls($phasenum,$bodnum,$mapnum,s13) \
     2044                               $::rb_tls($phasenum,$bodnum,$mapnum,s21) $::rb_tls($phasenum,$bodnum,$mapnum,s23) \
     2045                               $::rb_tls($phasenum,$bodnum,$mapnum,s31) $::rb_tls($phasenum,$bodnum,$mapnum,s32) \
     2046                               $::rb_tls($phasenum,$bodnum,$mapnum,saa) $::rb_tls($phasenum,$bodnum,$mapnum,sbb)"
     2047
     2048                            set rb_damping "$::rb_damp_euler $::rb_damp_euler $::rb_damp_euler \
     2049                                $::rb_damp_euler $::rb_damp_euler $::rb_damp_euler \
     2050                                $::rb_damp_origin $::rb_damp_origin $::rb_damp_origin"
     2051                            set rb_damping_tls "$::rb_damp_t $::rb_damp_l $::rb_damp_s"
     2052                            puts "tls damping = $rb_damping_tls"
     2053#                            puts "rb damping = $rb_damping"
     2054
     2055
     2056#                            RigidBodySetDamp $phasenum $bodnum $mapnum $rb_damping $rb_damping_tls
     2057                           
     2058                            if {$::rb_var($phasenum,$bodnum,$mapnum,tls) == 0} {
     2059                                  RigidBodySetDamp $phasenum $bodnum $mapnum $rb_damping
     2060                            } else {
     2061                                  RigidBodySetDamp $phasenum $bodnum $mapnum $rb_damping $rb_damping_tls
     2062                            }
     2063
     2064#                           puts "TLS Values to be saved = $rb_tls_vals"
     2065                            set rb_tls_positions "$::rb($phasenum,$bodnum,$mapnum,x) $::rb($phasenum,$bodnum,$mapnum,y) \
     2066                               $::rb($phasenum,$bodnum,$mapnum,z)"
     2067                            set rb_tls_euler "$::rb($phasenum,$bodnum,$mapnum,e1) $::rb($phasenum,$bodnum,$mapnum,e2) \
     2068                               $::rb($phasenum,$bodnum,$mapnum,e3)"
     2069#                           puts "origin positions = $rb_tls_positions"
     2070#                           puts "euler angles = $rb_tls_euler"
     2071
     2072#                           puts "TLS param save for $mapnum $bodnum $mapnum is vvvvvvvv $rb_tls"
     2073                           RigidBodySetTLS $phasenum $bodnum $mapnum $rb_tls_vals
     2074                           EditRigidBodyMapping $phasenum $bodnum $mapnum $rb_tls_positions $rb_tls_euler
     2075#                           RecordMacroEntry "RigidBodySetTLS $phasenum $bodnum $mapnum $rb_tls_vals"
     2076
    19802077                           RigidBodyTLSVary $phasenum $bodnum $mapnum $rb_tls
    19812078                           RecordMacroEntry "RigidBodyTLSVary $phasenum $bodnum $mapnum [list $rb_tls]" 0
     
    20102107              $main.s23ref($phasenum,$bodnum,$mapnum) $main.s31ref($phasenum,$bodnum,$mapnum) $main.s32ref($phasenum,$bodnum,$mapnum) \
    20112108              $main.saaref($phasenum,$bodnum,$mapnum) $main.sbbref($phasenum,$bodnum,$mapnum)
     2109
     2110      lappend tlsentry $main.t11entry($phasenum,$bodnum,$mapnum) $main.t22entry($phasenum,$bodnum,$mapnum) $main.t33entry($phasenum,$bodnum,$mapnum) \
     2111              $main.t12entry($phasenum,$bodnum,$mapnum) $main.t13entry($phasenum,$bodnum,$mapnum) $main.t23entry($phasenum,$bodnum,$mapnum) \
     2112              $main.l11entry($phasenum,$bodnum,$mapnum) $main.l22entry($phasenum,$bodnum,$mapnum) $main.l33entry($phasenum,$bodnum,$mapnum) \
     2113              $main.l12entry($phasenum,$bodnum,$mapnum) $main.l13entry($phasenum,$bodnum,$mapnum) $main.l23entry($phasenum,$bodnum,$mapnum) \
     2114              $main.s12entry($phasenum,$bodnum,$mapnum) $main.s13entry($phasenum,$bodnum,$mapnum) $main.s21entry($phasenum,$bodnum,$mapnum) \
     2115              $main.s23entry($phasenum,$bodnum,$mapnum) $main.s31entry($phasenum,$bodnum,$mapnum) $main.s32entry($phasenum,$bodnum,$mapnum) \
     2116              $main.saaentry($phasenum,$bodnum,$mapnum) $main.sbbentry($phasenum,$bodnum,$mapnum)
     2117
    20122118#      puts $tlsparam
    20132119              if {$::rb_var($phasenum,$bodnum,$mapnum,tls) == 0} {
     
    20162122                                $x config -state disable -relief sunken
    20172123                        }
     2124                        foreach x $tlsentry {
     2125                                $x config -state disable
     2126                        }
    20182127              } else {
    20192128                        RigidBodyEnableTLS $phasenum $bodnum $mapnum 1
     
    20212130                                $x config -state normal -relief raised
    20222131                        }
     2132                        foreach x $tlsentry {
     2133                                $x config -state normal
     2134                        }
    20232135              }
    20242136}
     
    20262138
    20272139proc RB_Load_Vars {phasenum bodnum mapnum args} {
    2028      foreach var $::rb_map_positionvars($phasenum,$bodnum,$mapnum) {
    2029              catch {unset temp($var)}
    2030      }
    2031 
    2032      foreach var $::rb_map_positionvars($phasenum,$bodnum,$mapnum) {
    2033              if {[info exists temp($var)] == "0"} {
    2034                 set temp($var) $var
    2035                 } else {
    2036                   lappend mulvarlist $var
    2037              }
    2038      }
    2039 
    2040      foreach var $::rb_map_tls_var($phasenum,$bodnum,$mapnum) {
    2041              if {[info exists temp($var)] == "0"} {
    2042                 set temp($var) $var
    2043              } else {
    2044                 lappend mulvarlist $var
    2045              }
    2046      }
    2047 
    2048      set ::rb_var($phasenum,$bodnum,$mapnum,x) [RB_VarSet [lindex $::rb_map_positionvars($phasenum,$bodnum,$mapnum) 0] $mulvarlist]
    2049      set ::rb_var($phasenum,$bodnum,$mapnum,y) [RB_VarSet [lindex $::rb_map_positionvars($phasenum,$bodnum,$mapnum) 1] $mulvarlist]
    2050      set ::rb_var($phasenum,$bodnum,$mapnum,z) [RB_VarSet [lindex $::rb_map_positionvars($phasenum,$bodnum,$mapnum) 2] $mulvarlist]
     2140#     foreach var $::rb_map_positionvars($phasenum,$bodnum,$mapnum) {
     2141#             catch {unset temp($var)}
     2142#     }
     2143#
     2144#     foreach var $::rb_map_positionvars($phasenum,$bodnum,$mapnum) {
     2145#            if {[info exists temp($var)] == "0"} {
     2146#                set temp($var) $var
     2147#                } else {
     2148#                  lappend mulvarlist $var
     2149#             }
     2150#    }
     2151#
     2152#    foreach var $::rb_map_tls_var($phasenum,$bodnum,$mapnum) {
     2153#             if {[info exists temp($var)] == "0"} {
     2154#                set temp($var) $var
     2155#             } else {
     2156#                lappend mulvarlist $var
     2157#             }
     2158#     }
     2159#     puts "the mulvarlist is     $mulvarlist"
     2160
     2161#     8Aug12    new code to determine variable names
     2162     set rb_num [RigidBodyList]
     2163     set varlist ""
     2164     set mvarlist ""
     2165     foreach phase $::expmap(phaselist) {
     2166          foreach bod $rb_num {
     2167               set rb_map_num($phase,$bod) [RigidBodyMappingList $phase $bod]
     2168               if {$rb_map_num($phase,$bod) != ""} {
     2169                  foreach map $rb_map_num($phase,$bod) {
     2170                           foreach var $::rb_map_positionvars($phase,$bod,$map) {
     2171                                    set temp1 [lsearch $varlist $var]
     2172                                    if {$temp1 == "-1"} {lappend varlist $var
     2173                                       } else {
     2174                                           if {[lsearch $mvarlist $var] == "-1"} {lappend mvarlist $var}
     2175                                       }
     2176                           }
     2177                           foreach var $::rb_map_tls_var($phase,$bod,$map) {
     2178                                    set temp1 [lsearch $varlist $var]
     2179                                    if {$temp1 == "-1"} {lappend varlist $var
     2180                                       } else {
     2181                                           if {[lsearch $mvarlist $var] == "-1"} {lappend mvarlist $var}
     2182                                       }
     2183                          }
     2184                   }
     2185               }
     2186          }
     2187     }
     2188#     puts "varlist    $varlist"
     2189#     puts "mvarlist   $mvarlist"
     2190
     2191     set ::rb_var($phasenum,$bodnum,$mapnum,x) [RB_VarSet [lindex $::rb_map_positionvars($phasenum,$bodnum,$mapnum) 6] $mvarlist $varlist]
     2192     set ::rb_var($phasenum,$bodnum,$mapnum,y) [RB_VarSet [lindex $::rb_map_positionvars($phasenum,$bodnum,$mapnum) 7] $mvarlist $varlist]
     2193     set ::rb_var($phasenum,$bodnum,$mapnum,z) [RB_VarSet [lindex $::rb_map_positionvars($phasenum,$bodnum,$mapnum) 8] $mvarlist $varlist]
    20512194
    20522195     lappend ::rb_var_list ::rb_var($phasenum,$bodnum,$mapnum,x) ::rb_var($phasenum,$bodnum,$mapnum,y) ::rb_var($phasenum,$bodnum,$mapnum,z)
    20532196
    2054      set ::rb_var($phasenum,$bodnum,$mapnum,e1) [RB_VarSet [lindex $::rb_map_positionvars($phasenum,$bodnum,$mapnum) 3] $mulvarlist]
    2055      set ::rb_var($phasenum,$bodnum,$mapnum,e2) [RB_VarSet [lindex $::rb_map_positionvars($phasenum,$bodnum,$mapnum) 4] $mulvarlist]
    2056      set ::rb_var($phasenum,$bodnum,$mapnum,e3) [RB_VarSet [lindex $::rb_map_positionvars($phasenum,$bodnum,$mapnum) 5] $mulvarlist]
     2197     set ::rb_var($phasenum,$bodnum,$mapnum,e1) [RB_VarSet [lindex $::rb_map_positionvars($phasenum,$bodnum,$mapnum) 0] $mvarlist $varlist]
     2198     set ::rb_var($phasenum,$bodnum,$mapnum,e2) [RB_VarSet [lindex $::rb_map_positionvars($phasenum,$bodnum,$mapnum) 1] $mvarlist $varlist]
     2199     set ::rb_var($phasenum,$bodnum,$mapnum,e3) [RB_VarSet [lindex $::rb_map_positionvars($phasenum,$bodnum,$mapnum) 2] $mvarlist $varlist]
    20572200
    20582201     lappend ::rb_var_list ::rb_var($phasenum,$bodnum,$mapnum,e1) ::rb_var($phasenum,$bodnum,$mapnum,e2) ::rb_var($phasenum,$bodnum,$mapnum,e3)
    20592202
     2203     ### create variables containing origin, euler angles and tls terms 14 Aug 2012
     2204
     2205     set ::rb($phasenum,$bodnum,$mapnum,x) [lindex $::rb_map_origin($phasenum,$bodnum,$mapnum) 0]
     2206     set ::rb($phasenum,$bodnum,$mapnum,y) [lindex $::rb_map_origin($phasenum,$bodnum,$mapnum) 1]
     2207     set ::rb($phasenum,$bodnum,$mapnum,z) [lindex $::rb_map_origin($phasenum,$bodnum,$mapnum) 2]
     2208
     2209     set ::rb($phasenum,$bodnum,$mapnum,e1) [lindex [lindex $::rb_map_euler($phasenum,$bodnum,$mapnum) 0] 0]
     2210     set ::rb($phasenum,$bodnum,$mapnum,e2) [lindex [lindex $::rb_map_euler($phasenum,$bodnum,$mapnum) 1] 0]
     2211     set ::rb($phasenum,$bodnum,$mapnum,e3) [lindex [lindex $::rb_map_euler($phasenum,$bodnum,$mapnum) 2] 0]
     2212
     2213     set ::rb_tls($phasenum,$bodnum,$mapnum,t11) [lindex $::rb_map_tls($phasenum,$bodnum,$mapnum) 0]
     2214     set ::rb_tls($phasenum,$bodnum,$mapnum,t22) [lindex $::rb_map_tls($phasenum,$bodnum,$mapnum) 1]
     2215     set ::rb_tls($phasenum,$bodnum,$mapnum,t33) [lindex $::rb_map_tls($phasenum,$bodnum,$mapnum) 2]
     2216     set ::rb_tls($phasenum,$bodnum,$mapnum,t12) [lindex $::rb_map_tls($phasenum,$bodnum,$mapnum) 3]
     2217     set ::rb_tls($phasenum,$bodnum,$mapnum,t13) [lindex $::rb_map_tls($phasenum,$bodnum,$mapnum) 4]
     2218     set ::rb_tls($phasenum,$bodnum,$mapnum,t23) [lindex $::rb_map_tls($phasenum,$bodnum,$mapnum) 5]
     2219     set ::rb_tls($phasenum,$bodnum,$mapnum,l11) [lindex $::rb_map_tls($phasenum,$bodnum,$mapnum) 6]
     2220     set ::rb_tls($phasenum,$bodnum,$mapnum,l22) [lindex $::rb_map_tls($phasenum,$bodnum,$mapnum) 7]
     2221     set ::rb_tls($phasenum,$bodnum,$mapnum,l33) [lindex $::rb_map_tls($phasenum,$bodnum,$mapnum) 8]
     2222     set ::rb_tls($phasenum,$bodnum,$mapnum,l12) [lindex $::rb_map_tls($phasenum,$bodnum,$mapnum) 9]
     2223     set ::rb_tls($phasenum,$bodnum,$mapnum,l13) [lindex $::rb_map_tls($phasenum,$bodnum,$mapnum) 10]
     2224     set ::rb_tls($phasenum,$bodnum,$mapnum,l23) [lindex $::rb_map_tls($phasenum,$bodnum,$mapnum) 11]
     2225     set ::rb_tls($phasenum,$bodnum,$mapnum,s12) [lindex $::rb_map_tls($phasenum,$bodnum,$mapnum) 12]
     2226     set ::rb_tls($phasenum,$bodnum,$mapnum,s13) [lindex $::rb_map_tls($phasenum,$bodnum,$mapnum) 13]
     2227     set ::rb_tls($phasenum,$bodnum,$mapnum,s21) [lindex $::rb_map_tls($phasenum,$bodnum,$mapnum) 14]
     2228     set ::rb_tls($phasenum,$bodnum,$mapnum,s23) [lindex $::rb_map_tls($phasenum,$bodnum,$mapnum) 15]
     2229     set ::rb_tls($phasenum,$bodnum,$mapnum,s31) [lindex $::rb_map_tls($phasenum,$bodnum,$mapnum) 16]
     2230     set ::rb_tls($phasenum,$bodnum,$mapnum,s32) [lindex $::rb_map_tls($phasenum,$bodnum,$mapnum) 17]
     2231     set ::rb_tls($phasenum,$bodnum,$mapnum,saa) [lindex $::rb_map_tls($phasenum,$bodnum,$mapnum) 18]
     2232     set ::rb_tls($phasenum,$bodnum,$mapnum,sbb) [lindex $::rb_map_tls($phasenum,$bodnum,$mapnum) 19]
     2233
     2234
    20602235     if {$::rb_map_tls_var($phasenum,$bodnum,$mapnum) != ""} {
    20612236
    20622237
    2063           set ::rb_var($phasenum,$bodnum,$mapnum,t11) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 0] $mulvarlist]
    2064           set ::rb_var($phasenum,$bodnum,$mapnum,t22) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 1] $mulvarlist]
    2065           set ::rb_var($phasenum,$bodnum,$mapnum,t33) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 2] $mulvarlist]
    2066           set ::rb_var($phasenum,$bodnum,$mapnum,t12) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 3] $mulvarlist]
    2067           set ::rb_var($phasenum,$bodnum,$mapnum,t13) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 4] $mulvarlist]
    2068           set ::rb_var($phasenum,$bodnum,$mapnum,t23) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 5] $mulvarlist]
     2238          set ::rb_var($phasenum,$bodnum,$mapnum,t11) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 0] $mvarlist $varlist]
     2239          set ::rb_var($phasenum,$bodnum,$mapnum,t22) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 1] $mvarlist $varlist]
     2240          set ::rb_var($phasenum,$bodnum,$mapnum,t33) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 2] $mvarlist $varlist]
     2241          set ::rb_var($phasenum,$bodnum,$mapnum,t12) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 3] $mvarlist $varlist]
     2242          set ::rb_var($phasenum,$bodnum,$mapnum,t13) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 4] $mvarlist $varlist]
     2243          set ::rb_var($phasenum,$bodnum,$mapnum,t23) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 5] $mvarlist $varlist]
    20692244
    20702245          lappend ::rb_var_list_tls ::rb_var($phasenum,$bodnum,$mapnum,t11) ::rb_var($phasenum,$bodnum,$mapnum,t22) ::rb_var($phasenum,$bodnum,$mapnum,t33)
    20712246          lappend ::rb_var_list_tls ::rb_var($phasenum,$bodnum,$mapnum,t12) ::rb_var($phasenum,$bodnum,$mapnum,t13) ::rb_var($phasenum,$bodnum,$mapnum,t23)
    20722247
    2073           set ::rb_var($phasenum,$bodnum,$mapnum,l11) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 6] $mulvarlist]
    2074           set ::rb_var($phasenum,$bodnum,$mapnum,l22) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 7] $mulvarlist]
    2075           set ::rb_var($phasenum,$bodnum,$mapnum,l33) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 8] $mulvarlist]
    2076           set ::rb_var($phasenum,$bodnum,$mapnum,l12) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 9] $mulvarlist]
    2077           set ::rb_var($phasenum,$bodnum,$mapnum,l13) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 10] $mulvarlist]
    2078           set ::rb_var($phasenum,$bodnum,$mapnum,l23) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 11] $mulvarlist]
     2248          set ::rb_var($phasenum,$bodnum,$mapnum,l11) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 6] $mvarlist $varlist]
     2249          set ::rb_var($phasenum,$bodnum,$mapnum,l22) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 7] $mvarlist $varlist]
     2250          set ::rb_var($phasenum,$bodnum,$mapnum,l33) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 8] $mvarlist $varlist]
     2251          set ::rb_var($phasenum,$bodnum,$mapnum,l12) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 9] $mvarlist $varlist]
     2252          set ::rb_var($phasenum,$bodnum,$mapnum,l13) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 10] $mvarlist $varlist]
     2253          set ::rb_var($phasenum,$bodnum,$mapnum,l23) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 11] $mvarlist $varlist]
    20792254
    20802255          lappend ::rb_var_list_tls ::rb_var($phasenum,$bodnum,$mapnum,l11) ::rb_var($phasenum,$bodnum,$mapnum,l22) ::rb_var($phasenum,$bodnum,$mapnum,l33)
    20812256          lappend ::rb_var_list_tls ::rb_var($phasenum,$bodnum,$mapnum,l12) ::rb_var($phasenum,$bodnum,$mapnum,l13) ::rb_var($phasenum,$bodnum,$mapnum,l23)
    20822257
    2083           set ::rb_var($phasenum,$bodnum,$mapnum,s12) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 12] $mulvarlist]
    2084           set ::rb_var($phasenum,$bodnum,$mapnum,s13) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 13] $mulvarlist]
    2085           set ::rb_var($phasenum,$bodnum,$mapnum,s21) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 14] $mulvarlist]
    2086           set ::rb_var($phasenum,$bodnum,$mapnum,s23) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 15] $mulvarlist]
    2087           set ::rb_var($phasenum,$bodnum,$mapnum,s31) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 16] $mulvarlist]
    2088           set ::rb_var($phasenum,$bodnum,$mapnum,s32) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 17] $mulvarlist]
    2089           set ::rb_var($phasenum,$bodnum,$mapnum,saa) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 18] $mulvarlist]
    2090           set ::rb_var($phasenum,$bodnum,$mapnum,sbb) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 19] $mulvarlist]
     2258          set ::rb_var($phasenum,$bodnum,$mapnum,s12) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 12] $mvarlist $varlist]
     2259          set ::rb_var($phasenum,$bodnum,$mapnum,s13) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 13] $mvarlist $varlist]
     2260          set ::rb_var($phasenum,$bodnum,$mapnum,s21) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 14] $mvarlist $varlist]
     2261          set ::rb_var($phasenum,$bodnum,$mapnum,s23) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 15] $mvarlist $varlist]
     2262          set ::rb_var($phasenum,$bodnum,$mapnum,s31) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 16] $mvarlist $varlist]
     2263          set ::rb_var($phasenum,$bodnum,$mapnum,s32) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 17] $mvarlist $varlist]
     2264          set ::rb_var($phasenum,$bodnum,$mapnum,saa) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 18] $mvarlist $varlist]
     2265          set ::rb_var($phasenum,$bodnum,$mapnum,sbb) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 19] $mvarlist $varlist]
    20912266
    20922267          lappend ::rb_var_list_tls ::rb_var($phasenum,$bodnum,$mapnum,s12) ::rb_var($phasenum,$bodnum,$mapnum,s13) ::rb_var($phasenum,$bodnum,$mapnum,s21)
     
    21352310}
    21362311
    2137 proc RB_VarSet {varin mulvarlist args} {
    2138      if {$varin == 0} {set varout ""
     2312proc RB_VarSet {varin mvarlist varlist args} {
     2313     set temp [lsearch $mvarlist $varin]
     2314     if {$temp == "-1"} {set varout "free"
    21392315        } else {
    2140           set temp [lsearch $mulvarlist $varin]
    2141           if {$temp == "-1"} {set varout "free"
    2142                  } else {
    2143                    set varout var$varin
    2144               }
    2145      }
     2316          set varout var$varin
     2317        }
     2318     if {$varin == 0} {set varout ""}
    21462319     return $varout
     2320
     2321
     2322 #    if {$varin == 0} {set varout ""
     2323 #       } else {
     2324 #         set temp [lsearch $mulvarlist $varin]
     2325 #         if {$temp == "-1"} {set varout "free"
     2326 #                } else {
     2327 #                  set varout var$varin
     2328 #             }
     2329 #    }
     2330 #    return $varout
    21472331}
    21482332
Note: See TracChangeset for help on using the changeset viewer.