Changeset 1112

Timestamp:

Jan 21, 2011 4:43:16 PM (12 years ago)

Author:

toby

Message:

fix save as bug, expand rb.tcl to delete & handle gaps in body lists; likewise in rigid.tcl

Location:

branches/sandbox

Files:

• expgui (modified) (1 diff)
• rb.tcl (modified) (28 diffs)
• rigid.tcl (modified) (14 diffs)

branches/sandbox/expgui

@@ -494 +494 @@
     if {$newexpfile == ""} return
     expwrite $newexpfile
+    set expgui(expfile) $newexpfile
     # change the icon and assign an app to this .EXP file
     if {$tcl_platform(os) == "Darwin" && $expgui(MacAssignApp)} {

branches/sandbox/rb.tcl

@@ -5 +5 @@
 #============================================================================
 # rigid body EXP editing routines (to move into readexp.tcl)
-# RigidBodyCount -- returns the number of defined rigid bodies (body types)
-# ReadRigidBody  -- # of times a body is mapped & scaling factors
-# RigidBodyMappingCount -- # of times a rigid body is mapped in phase
+# RigidBodyList -- returns a list of the defined rigid body types 
+# ReadRigidBody  -- # of times a body is mapped, scaling factors, var #s & coordinates
+# RigidBodyMappingList - return a list instances where a RB is mapped in phase
 # RigidBodyEnableTLS -- Enable or Disable TLS use for a rigid body mapping
 # RigidBodySetTLS  -- change the TLS values for a rigid body mapping
@@ -14 +14 @@
 # RigidBodyTLSVary -- set TLS refinement variable nums for a rigid body mapping
 # AddRigidBody -- defines a new rigid body type
+# DeleteRigidBody -- remove a rigid body definition
 # ReplaceRigidBody -- replaces a previous rigid body type
 # ReadRigidBodyMapping  -- get parameters for a rigid body mapping
 # MapRigidBody -- map a rigid body type into a phase
 # EditRigidBodyMapping -- change the parameters in a rigid body mapping
-#  need to unmap a rigid body
-#  delete rigid body
+# UnMapRigidBody --remove a rigid body constraint by removing a RB "instance"
+#----- note that these older routines should not be used ------
+# RigidBodyCount -- returns the number of defined rigid bodies (body types)
+#    use RigidBodyList instead
+# RigidBodyMappingCount -- # of times a rigid body is mapped in phase
+#    use RigidBodyMappingList instead
 #============================================================================
 # returns the number of defined rigid bodies 
@@ -28 +33 @@
     }
     return $n
+}
+
+# returns a list of the defined rigid body types 
+proc RigidBodyList {} {
+    set n [string trim [readexp "RGBD  NRBDS"]]
+    if {$n == ""} {
+        set n 0
+    }
+    set rblist {}
+    foreach rbnum {1 2 3 4 5 6 7 8 9 10 11 12 13 14 15} {
+        set value $rbnum
+        validint value 2
+        set key "RGBD${value}"
+        if {[existsexp "$key NATR "]} {
+            lappend rblist $rbnum
+        }
+        if {[llength $rblist] == $n} break
+    }
+    return $rblist
 }
 
@@ -42 +66 @@
 #  not used in GSAS.
 proc ReadRigidBody {rbnum} {
-    if {[RigidBodyCount] < $rbnum} {
+    if {[lsearch [RigidBodyList] $rbnum] == -1} {
         return ""
     }
@@ -83 +107 @@
     return $n
 }
+# return a list of the instances where rigid body $bodytyp is mapped in phase $phase
+proc RigidBodyMappingList {phase bodytyp} {
+    set key "RGBD[ToHex $phase 1][ToHex $bodytyp 1]"
+    if {! [existsexp "$key  NBDS"]} {return {}}
+    set n [string trim [readexp "$key  NBDS"]]
+    if {$n == ""} {
+        set n 0
+    }
+    set rblist {}
+    foreach rbnum {1 2 3 4 5 6 7 8 9 10 11 12 13 14 15} {
+        set value $rbnum
+        validint value 2
+        set key "RGBD[ToHex $phase 1][ToHex $bodytyp 1][ToHex $rbnum 1]"
+        if {[existsexp "$key  NDA"]} {
+            lappend rblist $rbnum
+        }
+        if {[llength $rblist] == $n} break
+    }
+    return $rblist
+}
+
+
 
 # reads rigid body mapping parameters for phase ($phase), body type # ($bodytyp) and instance # ($num)
@@ -106 +152 @@
 #
 proc ReadRigidBodyMapping {phase bodytyp num} {
-    if {[RigidBodyMappingCount $phase $bodytyp] < $num} {
+    if {[lsearch [RigidBodyMappingList $phase $bodytyp] $num] == -1} {
         return ""
     }
@@ -170 +216 @@
 # Enable TLS use if TLS is non-zero (true). Disable if zero
 proc RigidBodyEnableTLS {phase bodytyp num TLS} {
-    if {[RigidBodyMappingCount $phase $bodytyp] < $num} {
+    if {[lsearch [RigidBodyMappingList $phase $bodytyp] $num] == -1} {
         return ""
     }
@@ -220 +266 @@
 #    S12, S13, S21, S23, S31, S32, SAA, SBB
 proc RigidBodySetTLS {phase bodytyp num TLSvals} {
-    if {[RigidBodyMappingCount $phase $bodytyp] < $num} {
+    if {[lsearch [RigidBodyMappingList $phase $bodytyp] $num] == -1} {
         return ""
     }
@@ -255 +301 @@
 # three damping terms (for all T terms; for all L terms and for all S terms)
 proc RigidBodySetDamp {phase bodytyp num RBdamp "TLSdamp {}"} {
-    if {[RigidBodyMappingCount $phase $bodytyp] < $num} {
+    if {[lsearch [RigidBodyMappingList $phase $bodytyp] $num] == -1} {
         return ""
     }
@@ -283 +329 @@
 # note that the variable values should be unique integers 
 proc RigidBodyVary {phase bodytyp num RBvar} {
-    if {[RigidBodyMappingCount $phase $bodytyp] < $num} {
+    if {[lsearch [RigidBodyMappingList $phase $bodytyp] $num] == -1} {
         return ""
     }
@@ -304 +350 @@
 # note that the variable values should be unique integers 
 proc RigidBodyTLSVary {phase bodytyp num TLSvar} {
-    if {[RigidBodyMappingCount $phase $bodytyp] < $num} {
+    if {[lsearch [RigidBodyMappingList $phase $bodytyp] $num] == -1} {
         return ""
     }
@@ -336 +382 @@
 # Returns the number of the rigid body that has been created
 proc AddRigidBody {multlist coordlist} {
-    # 
+    # find the first unused body #
+    foreach rbnum {1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16} {
+        set value $rbnum
+        validint value 2
+        set key "RGBD${value}"
+        if {! [existsexp "$key NATR "]} {break}
+    }
+    # did we go too far?
+    if {$rbnum == 16} {return ""} 
+    # increment the RB counter
     set n [string trim [readexp "RGBD  NRBDS"]]
     if {$n == ""} {
@@ -345 +400 @@
     validint n 5
     setexp "RGBD  NRBDS" $n 1 5
-    SetRigidBody $n $multlist $coordlist
-    return $n
+    SetRigidBody $rbnum $multlist $coordlist
+    return $rbnum
+}
+
+# DeleteRigidBody: remove a rigid body definition from the .EXP file
+# The body may not be mapped. I am not sure if GSAS allows more than 9 bodies, 
+# but if it does, the simplifed approach used here will fail, so this 
+# is not allowed. 
+# Input:
+#   Rigid body number
+# Returns:
+#   1 on success
+#   -1 if the body number is 11 or greater
+#   -2 if the body is mapped
+#   -3 if the body is not defined
+proc DeleteRigidBody {rbnum} {
+    # can't delete bodies with numbers higher than 10, since the key prefix
+    # (RGBD11... will overlap with rigid body instance records, which would be
+    # deleted below
+    if {$rbnum > 10} {
+        return -1
+    }
+    set value $rbnum
+    validint value 2
+    set key "RGBD${value}"
+    if {![existsexp "$key NATR "]} {
+        return -2
+    }
+    # make sure the body is not mapped
+    if {[string trim [string range [readexp "$key NBDS"] 0 4]] != 0} {
+        return -3
+    }
+    # delete the records starting with "RGBD x" or "RGBD10" 
+    foreach key [array names ::exparray "${key}*"] {
+        #puts $key
+        delexp $key
+    }
+    # decrement the RB counter
+    set n [string trim [readexp "RGBD  NRBDS"]]
+    if {$n == ""} {
+        set n 0
+    }
+    incr n -1
+    validint n 5
+    if {$n > 0} {
+        setexp "RGBD  NRBDS" $n 1 5
+    } else {
+        delexp "RGBD  NRBDS"
+    }
+    return 1
 }
 
@@ -432 +535 @@
 # returns the instance # (number of times body $bodytyp has been used in phase $phase)
 proc MapRigidBody {phase bodytyp firstatom position angles} {
-    # number of bodies of this type in this phase
+    # find the first unused body # for this phase & type
+    foreach rbnum {1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16} {
+        set key "RGBD[ToHex $phase 1][ToHex $bodytyp 1][ToHex $rbnum 1]"
+        if {! [existsexp "$key  NDA"]} {break}
+    }
+    # did we go too far?
+    if {$rbnum == 16} {return ""} 
+    # increment number of mapped bodies of this type overall
+    set value $bodytyp
+    validint value 2
+    set key "RGBD${value}"
+    set used [string trim [string range [readexp "$key NBDS"] 0 4]]
+    incr used
+    set value $used
+    validint value 5
+    setexp "$key NBDS" $value 1 5
+    # increment number of mapped bodies of this type in this phase
     set key "RGBD[ToHex $phase 1][ToHex $bodytyp 1]"
-    set n [string trim [readexp "$key  NBDS"]]
-    if {$n == ""} {
+    if {[existsexp "$key  NBDS"]} {
+        set used [string trim [string range [readexp "$key  NBDS"] 0 4]]
+    } else {
         makeexprec "$key  NBDS"
-        set n 0
-    }
-    incr n
-    set value $n
+        set used 0
+    }
+    incr used
+    set value $used
     validint value 5
     setexp "$key  NBDS" $value 1 5
-    set key "RGBD[ToHex $phase 1][ToHex $bodytyp 1][ToHex $n 1]"
+    # now write the mapping parameters
+    set key "RGBD[ToHex $phase 1][ToHex $bodytyp 1][ToHex $rbnum 1]"
     set value $firstatom
     validint value 5
@@ -466 +587 @@
     makeexprec "${key} LSTF"
     setexp "${key} LSTF" [format "%5d" 0] 1 5
-    return $n
+    return $rbnum
 }
 
@@ -488 +609 @@
     setexp "${key} BDOR" $l1 1 60
 }
+
+# UnMapRigidBody: remove a rigid body constraint by removing a RB "instance"
+# (undoes MapRigidBody)
+# arguments:
+#   phase: phase number (1-9)
+#   bodytyp: number of rigid body (1-15) as returned from AddRigidBody
+#   bodynum: instance number, as returned by MapRigidBody
+proc UnMapRigidBody {phase bodytyp mapnum} {
+    if {[lsearch [RigidBodyMappingList $phase $bodytyp] $mapnum] == -1} {
+        return ""
+    }
+    # decrement number of mapped bodies of this type overall
+    set value $bodytyp
+    validint value 2
+    set key "RGBD${value}"
+    set used [string trim [string range [readexp "$key NBDS"] 0 4]]
+    incr used -1
+    set value $used
+    validint value 5
+    setexp "$key NBDS" $value 1 5
+    # decrement number of mapped bodies of this type in this phase
+    set key "RGBD[ToHex $phase 1][ToHex $bodytyp 1]"
+    if {[existsexp "$key  NBDS"]} {
+        set used [string trim [string range [readexp "$key  NBDS"] 0 4]]
+    } else {
+        set used 0
+    }
+    incr used -1
+    set value $used
+    validint value 5
+    if {$used > 0} {
+        setexp "$key  NBDS" $value 1 5
+    } else {
+        delexp "$key  NBDS"
+    }
+    # now delete the mapping parameter records
+    set key "RGBD[ToHex $phase 1][ToHex $bodytyp 1][ToHex $mapnum 1]"
+    foreach key [array names ::exparray "${key}*"] {
+        delexp $key
+    }
+    return $used
+}
+
+#============================================================================
+# Rigid body utility routines
+#============================================================================
+# RigidBodyGetVarNums: Returns a list of the variable numbers in use 
+#       for rigid body variable parameters. 
+# RigidBodyAtomNums: returns a list of atom numbers that are mapped to 
+#       rigid bodies in a selected phase
+# RigidStartAtoms: returns a list of atoms that are allowed for creation of RB
+# ExtractRigidBody: Use the GSAS geometry program to cartesian coordinates & 
+#       setting info for a RB from fractional coordinates for atoms in a phase
+# RunRecalcRBCoords: updates the coordinates in all phases after changes have 
+#       been made to rigid parameters.
+# CalcBody: Convert ortho to fractional coordinates using RB parameters
+# FitBody: Optimize the origin and Euler angles to match a rigid body to a 
+#       set of fractional coordinates
+# zmat2coord: convert a z-matrix to a set of cartesian coordinates
+# RB2cart: convert the representation used for rigid bodies into 
+#       cartesian coordinates
+# PlotRBtype: plot a rigid body with DRAWxtl
+# PlotRBcoords: plot orthogonal coordinates with DRAWxtl
+# DRAWxtlPlotRBFit: plot a set of fraction coordinates superimposed 
+#       on a structure read from a phase with DRAWxtl
 #============================================================================
 #============================================================================
-# Returns a list of the variable numbers used already for rigid body variable parameters
+# RigidBodyGetVarNums: Returns a list of the variable numbers used already 
+# for rigid body variable parameters
 proc RigidBodyGetVarNums {} {
     set varlist {}
-    set bodies [RigidBodyCount]
-    for {set type 1} {$type <= $bodies} {incr type} {
+    foreach type [RigidBodyList] {
         foreach phase $::expmap(phaselist) {
-            set count [RigidBodyMappingCount $phase $type]
-            for {set i 1} {$i <= $bodies} {incr i} {
+            foreach i [RigidBodyMappingList $phase $type] {
                 set items [ReadRigidBodyMapping $phase $type $i]
                 set varlist [concat $varlist [lindex $items 3]]
@@ -506 +691 @@
         }
     }
-    return [lsort -unique $varlist]
-}
-
-# Use the GSAS geometry program to compute a set of cartesian coordinates for a 
+    return [lsort -integer -unique $varlist]
+}
+
+# RigidBodyAtomNums: Returns a list of the atoms mapped to rigid bodies in 
+# phase $phase
+proc RigidBodyAtomNums {phase} {
+    if {[lsearch $::expmap(phaselist) $phase] == -1} {return ""}
+    set allatoms $::expmap(atomlist_$phase)
+    # get matching atoms coordinate range
+    set mappedlist {}
+    foreach type [RigidBodyList] {
+        foreach i [RigidBodyMappingList $phase $type] {
+            # get the number of atoms in this type of body
+            set natoms [llength [lindex [lindex [lindex [ReadRigidBody $type] 1] 0] 3]]
+            set natom1 [expr {$natoms - 1}]
+            set items [ReadRigidBodyMapping $phase $type $i]
+            set firstatom [lindex $items 0]
+            set firstind [lsearch $allatoms $firstatom]
+            set mappedlist [concat $mappedlist \
+                                [lrange \
+                                     [lrange $allatoms $firstind end] \
+                                     0 $natom1] \
+                               ]
+        }
+    }
+    return [lsort -integer $mappedlist]
+}
+
+# RigidStartAtoms: Find allowed starting atoms for a rigid body in a phase
+# Input: 
+#   phase is the phase number
+#   natoms is the number of atoms in the RB to be mapped
+# Returns a list of valid "start" atoms.
+# Example: if the atom numbers in the phase are {2 4 5 6 7 8} and no rigid bodies
+# are mapped, then a 4-atom body can be mapped starting with atom 2, 4 or 5 only,
+# so {2 4 5} is returned
+# If atoms 2-6 were already mapped, then this routine would return an empty
+# list, as it is not possible to map the body.
+proc RigidStartAtoms {phase natoms} {
+    if {[lsearch $::expmap(phaselist) $phase] == -1} {return ""}
+    set allatoms $::expmap(atomlist_$phase)
+    set usedatoms [RigidBodyAtomNums $phase]
+    set startatomlist {}
+    for {set i 0} {$i < [llength $allatoms]} {incr i} {
+        set al [lrange $allatoms $i [expr {$i+$natoms-1}]]
+        if {[llength $al] < $natoms} break
+        set ok 1
+        foreach atom $al {
+            if {[lsearch $usedatoms $atom] != -1} {
+                set ok 0
+                break
+            }
+        }
+        if $ok {lappend startatomlist [lindex $al 0]}
+    }
+    return $startatomlist
+}
+
+# ExtractRigidBody: Use the GSAS geometry program to compute a set of cartesian coordinates for a 
 # set of atoms in a .EXP file and provide the origin shift and Euler angles needed to 
 # place the cartesian system into the crystal coordinates. Used for setting up a rigid body.
@@ -584 +824 @@
 }
 
-# updates the coordinates in a .EXP file after a rigid body instance has been added/changed
+# RunRecalcRBCoords: updates the coordinates in a .EXP file after a rigid 
+# body has been changed, mapped or the setting info is changed
 proc RunRecalcRBCoords { } {
     global expgui tcl_platform
@@ -776 +1017 @@
 }
 
-#calc rigid body fractional coordinates
+# CalcBody: Calculate fractional coordinates using rigid body setting parameters
 # arguments: 
 #  Euler: a list of axes and angles to rotate: { {axis1 angle1} {axis2 angle2} ...} 
@@ -896 +1137 @@
 }
 
-# fit a rigid body's Origin and Euler angles
+# FitBody: fit a rigid body's Origin and Euler angles
 # arguments: 
 #  Euler: a list of axes and angles to rotate: { {axis1 angle1} {axis2 angle2} ...} 
@@ -947 +1188 @@
 }
 
-# zmat2coord converts a z-matrix to a set of cartesian coordinates
+# zmat2coord: convert a z-matrix to a set of cartesian coordinates
 #   a z-matrix is also known as "internal coordinates" or "torsion space"
 #   (see Journal of Computational Chemistry, Vol 26, #10, p. 1063–1068, 2005 or
@@ -1074 +1315 @@
 }
  
-# convert the rigid body representation reported as the 2nd element in ReadRigidBody
-# into cartesian coordinates
+# RB2cart: convert the rigid body representation reported as the 2nd element 
+# in ReadRigidBody into cartesian coordinates
 #   rblist: a list containing an element for each scaling factor
 # in each element there are four items: 
@@ -1127 +1368 @@
 }
 
-# plot orthogonal coordinates in DRAWxtl
+# DRAWxtlPlotOrtho: plot orthogonal coordinates in DRAWxtl
 # input:
 #  filename: file name for the .str file to create
@@ -1197 +1438 @@
 }
 
-# plot a rigid body in DRAWxtl
+# PlotRBtype: plot a rigid body in DRAWxtl
 # input:
 #  rbtype: # of rigid body
@@ -1221 +1462 @@
 }
 
-# plot orthogonal coordinates in DRAWxtl
+# PlotRBcoords: plot orthogonal coordinates in DRAWxtl
 # input:
 #  coords: cartesian coordinates
@@ -1244 +1485 @@
 }
 
-# plot a rigid body superimposed on a structure
+# DRAWxtlPlotRBFit: plot a set of fraction coordinates superimposed 
+# on a structure read from a phase
 # input:
 #  RBcoords: fractional coordinates for rigid body
 #  phase:# of phase to plot
-#  firstatom: # of 1st atom in structure matching rigid body
+#  firstatom: seq # of 1st atom in structure to be mapped to rigid body
 #  allatoms: 0 to plot only atoms in phase that are in the rigid body, 
 #      otherwise plot all atoms
@@ -1295 +1537 @@
                       [expr {($zmin+$zmax)/2}] ]
     # get matching atoms coordinate range
+    set firstind [lsearch $::expmap(atomlist_$phase) $firstatom]
     foreach atom [lrange \
-                      [lrange $::expmap(atomlist_$phase) [expr {$firstatom-1}] end] \
+                      [lrange $::expmap(atomlist_$phase) $firstind end] \
                       0 [expr {$natom-1}]] {
         foreach s {x y z} {
@@ -1334 +1577 @@
         set atoms $::expmap(atomlist_$phase)
     } else {
+        set firstind [lsearch $::expmap(atomlist_$phase) $firstatom]
         set atoms [lrange \
-                       [lrange $::expmap(atomlist_$phase) [expr {$firstatom-1}] end] \
+                       [lrange $::expmap(atomlist_$phase) $firstind end] \
                        0 [expr {$natom-1}]]
     }

branches/sandbox/rigid.tcl

@@ -5 +5 @@
  #proc RB_Populate
 
-lappend auto_path c:/gsas/expgui
-package require Tk
-package require BWidget
-#package require La
-#namespace import La::*
-source c:/gsas/sandboxexpgui/readexp.tcl
-source c:/gsas/sandboxexpgui/gsascmds.tcl
-source c:/gsas/sandboxexpgui/rb.tcl
-
-
-expload rb6.exp
-mapexp
+# debug code to load test files when run as an independent script
+if {[array name expgui shell] == ""} {
+    lappend auto_path c:/gsas/expgui
+    package require Tk
+    package require BWidget
+    #package require La
+    #namespace import La::*
+    source c:/gsas/sandboxexpgui/readexp.tcl
+    source c:/gsas/sandboxexpgui/gsascmds.tcl
+    source c:/gsas/sandboxexpgui/rb.tcl
+    expload rb6.exp
+    mapexp
+} else {
+    source [file join $expgui(scriptdir) rb.tcl]
+}
 
 ############################################################
@@ -22 +25 @@
 #                                       y = matrix number
 #                                       z = coordinate number
-#          ::rb_number          number of rigid bodies.
 #          ::rb_map(x)          number of times rigid body is mapped.
 #          ::rb_matrix_num(x)   number of matrices in rigid body.
@@ -34 +36 @@
 proc RB_Load_RBdata {args} {
      catch {unset ::rb}
-#Read the number of rigid bodies in EXP file
-     set ::rb_number [RigidBodyCount]
-
-#Read the Rigid Body Information
-     for {set i 1} {$i <= $::rb_number} {incr i} {
+#Loop over the rigid body types in EXP file
+    foreach i [RigidBodyList] {
              set rb($i) [ReadRigidBody $i]
              #Set the number of times rigid body is mapped.
@@ -208 +207 @@
 
      set rb_body_list [NoteBook $rb_nb -side top]
-     for {set x 1} {$x <= $::rb_number} {incr x} {
+    # loop over rigid body types
+    set pagelist {}
+    foreach x [RigidBodyList] {
          $rb_body_list insert $x rb_body$x -text "Rigid Body Type $x"  \
          -raisecmd "RB_Populate $rb_body_list $x"
+        lappend pagelist rb_body$x
      }
      $rb_body_list insert 16 rb_body16 -text "Create Rigid Body"
+    lappend pagelist rb_body16
      grid $rb_body_list -sticky news -column 0 -row 1 -columnspan 2
      grid columnconfig $rcb 1 -weight 1
      grid rowconfig    $rcb 1 -weight 1
-     $rb_body_list raise rb_body$panelnum
+    $rb_body_list raise [lindex $pagelist 0]
 }
 
@@ -230 +233 @@
      #Rigid body mapping control panel along with matrix multipliers and damping factor labels
      grid [label  $con.rb_num -text "Rigid Body Type $x"] -row 0 -column 0 -padx 5 -pady 5
-     grid [button $con.rb_newmap -text "Map New Body" -command "RB_Map_New $x"] -row 0 -column 1 -padx 5 -pady 5
+     grid [button $con.rb_newmap -text "Map Body $x" -command "RB_Map_New $x"] -row 0 -column 1 -padx 5 -pady 5
 
      grid [label $con.rb_mlbl1 -text "Matrix"] -row 1 -column 0
@@ -249 +252 @@
      grid [label $main.rb_origin -text "Origin"] -row 0 -column 3 -columnspan 3
      grid [label $main.rb_euler -text "Euler Angles"] -row 0 -column 6 -columnspan 3
-     grid [label $main.rb_ref -text "Refinement"] -row 1 -column 2
+     grid [label $main.rb_ref -text "Phase"] -row 1 -column 2
+     #grid [label $main.rb_ref -text "Refinement"] -row 1 -column 2
      grid [label $main.rb_map -text "Map"] -row 1 -column 1
      grid [label $main.rb_x   -text "x"] -row 1 -column 3
@@ -270 +274 @@
      foreach p $phase {
              incr row
-             set count [RigidBodyMappingCount $p $x]
-             for {set z 1} {$z <= $count} {incr z} {
+             foreach z [RigidBodyMappingList $p $x] {
                       set row [expr $row + $z]
                       RB_Load_Mapdata $p $x $z
                       grid [label $main.rb_map$p$z -text "$z"] -row $row -column 1
-                      grid [button $main.rb_cb$p$z -text "off" -command "RB_View_Parameters $p $x $z"] -row $row -column 2
+                      grid [label $main.rb_cb$p$z -text $p] -row $row -column 2
+
+                      #grid [button $main.rb_cb$p$z -text "off" -command "RB_View_Parameters $p $x $z"] -row $row -column 2
                       set origin $::rb_map_origin($p,$x,$z)
                       puts $origin
@@ -298 +303 @@
                       set atomnum $::rb_map_beginning($p,$x,$z)
                       for {set j 1} {$j <=$::rb_coord_num($x,$y)} {incr j} {
-                          set atom [atominfo $p $atomnum type]
+                          set atom [atominfo $p $atomnum label]
                           grid [label $main.rb_site$p$z$j -text "$atom"] -row $row -column $col
                           incr atomnum
@@ -310 +315 @@
 }
 
-proc RB_Choose_Atom {phase args} {
+proc RB_Choose_Atom {rbnum args} {
 #     set ::rb_finput ""
+    set phase $::rb_phase
+    # get the number of atoms in this type of body
+    set natoms [llength [lindex [lindex [lindex [ReadRigidBody $rbnum] 1] 0] 3]]
+    set atomlist [RigidStartAtoms $::rb_phase $natoms]
+    if {[llength $atomlist] == 0} {
+        RB_ProcessPhase $rbnum
+        return
+    }
      catch {destroy .chooseatom}
      set ca .chooseatom
      toplevel $ca
      wm title $ca "Choose Atom"
-     set atomlist $::expmap(atomlist_$phase)
 #     puts $atomlist
      foreach {top main side lbl} [MakeScrollTable $ca] {}
@@ -347 +359 @@
     set nm .newmap
     toplevel $nm
-    wm title $nm "Rigid Body Mapping"
+    wm title $nm "Map Rigid Body #$x"
     set ::phase 1
     set nmap [expr $::rb_map($x) + 1]
@@ -365 +377 @@
     trace variable ::rb_finput w "RB_Atom_List \$::rb_phase \$::rb_finput $nm $x 1"
 
-    grid [button $nm.finput -text "list atoms" -command {RB_Choose_Atom $::rb_phase}] -row 4 -column 3
+    grid [button $nm.finput -text "list allowed" -command "RB_Choose_Atom $x"] -row 4 -column 3
     grid [label $nm.o1l -text "x"] -row 5 -column 2
     grid [label $nm.o2l -text "y"] -row 5 -column 3
@@ -381 +393 @@
 
     grid [button $nm.plot -text "Plot Rigid Body & Phase" -command "PlotStrBody $x"] -row 8 -column 2 -columnspan 3
-    button $nm.save -text "Save" -width 6 -command {RB_Write_Map}
-
-
-    grid $nm.save -row 9 -column 3
+    grid [frame $nm.l] -row 9 -column 2 -columnspan 3
+    grid [button $nm.l.s -text "Save" -width 6 -command {RB_Write_Map}] -column 1 -row 1
+    grid [button $nm.l.q -text "Quit" -width 6 -command "destroy $nm"] -column 2  -row 1
+
+    foreach item [trace vinfo ::rb_phase] {
+            eval trace vdelete ::rb_phase $item
+    }
+    trace variable ::rb_phase w "RB_ProcessPhase $x"
+    set ::rb_phase ""
 }
 
@@ -414 +431 @@
    MapRigidBody $::rb_phase $::body_type $::rb_finput $origin $euler
    incr ::rb_map($::body_type)
+    incr ::expgui(changed)
    RB_Control_Panel $::body_type
    destroy .newmap
@@ -423 +441 @@
      }
      set col 8
-     grid [label $address.atomlbl -text "Atoms Mapped to Rigid Body"] -row 3 -column 8 -columnspan $::rb_coord_num($x,$y)
-     for {set j 1} {$j <=$::rb_coord_num($x,$y)} {incr j} {
-         set atom [atominfo $phase $atomnum type]
-         grid [label $address.atom$phase$x$j -text "$atom"] -row 4 -column $col
-         incr atomnum
-         incr col
-     }
-}
-
+    if {$atomnum == ""} return
+     grid [label $address.atomlbl -text "Atoms Mapped to Rigid Body"] -row 3 -column 8 -columnspan 99
+    # get the number of atoms in this type of body
+    set natoms [llength [lindex [lindex [lindex [ReadRigidBody $x] 1] 0] 3]]    
+    set atoms [RigidStartAtoms $phase $natoms]
+    if {[lsearch $atoms $atomnum] == -1} {
+         grid [label $address.atomerr -text "(invalid 1st atom)"] -row 4 -column $col
+        return
+    }
+    set atoms [lrange $::expmap(atomlist_$phase) \
+                   [lsearch $::expmap(atomlist_$phase) $atomnum] end]
+    foreach j [lrange $atoms 0 [expr {$natoms - 1}]] {
+        set atom [atominfo $phase $j label]
+        grid [label $address.atom$phase$x$j -text $atom] -row 4 -column $col
+        incr col
+     }
+}
+
+proc RB_ProcessPhase {rbnum args} {
+    if {$::rb_phase == ""} {
+        set atoms {}
+    } else {
+        # get the number of atoms in this type of body
+        set natoms [llength [lindex [lindex [lindex [ReadRigidBody $rbnum] 1] 0] 3]]
+
+        set atoms [RigidStartAtoms $::rb_phase $natoms]
+    }
+    set nm .newmap
+    if {[llength $atoms] == 0} {
+        foreach w "$nm.finputm $nm.plot $nm.l.s" {
+            $w config -state disabled
+        }
+        $nm.finput config -text "None allowed" -state disabled
+    } else {
+        foreach w "$nm.finputm $nm.plot $nm.l.s" {
+            $w config -state normal
+        }
+        $nm.finput config -text "Show allowed" -state normal
+    }
+}
 
 RB_Load_RBdata