source: branches/sandbox/rigid.tcl @ 1133

Last change on this file since 1133 was 1133, checked in by lake, 10 years ago

Bug fixes:
1 - sorter in Edit Matrix works correctly.
2 - the last coordinate is no longer dropped when reading in coordinates imported from cartesian and zmatrix.

File size: 83.9 KB
Line 
1 #proc RB_Load_RBdata   loads rigid body data
2 #proc RB_Load_Mapdata  loads rigid body mapping data
3 #proc RB_Control_Panel
4 #proc RB_View_Matrix
5 #proc RB_Populate
6
7# debug code to load test files when run as an independent script
8if {[array name expgui shell] == ""} {
9    lappend auto_path c:/gsas/expgui
10    package require Tk
11    package require BWidget
12    set expgui(debug) 1
13    #package require La
14    #namespace import La::*
15    source c:/gsas/sandboxexpgui/readexp.tcl
16    source c:/gsas/sandboxexpgui/gsascmds.tcl
17    source C:/gsas/sandboxexpgui/rb.tcl
18#    puts beforeread
19    expload c:/crystals/expgui/rigid/rb6norb.exp
20    mapexp
21#    puts after
22} else {
23    source [file join $expgui(scriptdir) rb.tcl]
24}
25################################################################
26# Procedure to determine possible RB file formats available
27
28proc RB_Import_Data_Type {args} {
29    global expgui tcl_platform
30    # only needs to be done once
31    set ::rbtypelist ""
32
33    set files [glob -nocomplain [file join $expgui(scriptdir) rbimport_*.tcl]]
34    foreach filetype $files {
35          set temp [lindex [string map {_ " "} $filetype] 1]
36          lappend ::rbtypelist $temp
37    }
38    if {$::rbtypelist == ""} {lappend ::rbtypelist "no rigid body file types available"}
39    foreach filetype $::rbtypelist {
40            source $::expgui(scriptdir)/rbimport_$filetype
41    }
42    return $::rbtypelist
43}
44############################################################
45#global variables generated by RB_Load         (x = rigid body number
46#                                              y = matrix number
47#                                              z = coordinate number
48#          ::rb_map(bodytyp)                   number of times rigid body is mapped.
49#          ::rb_matrix_num(bodytyp)            number of matrices in rigid body.
50#          ::rb_mult(bodytyp,matrixnum)        multiplier for matrix.
51#          ::rb_damp(bodytyp,matrixnum)        damping factor for matrix.
52#          ::rb_var(bodytyp,matrixnum)         variable for matrix.
53#          ::rb_coord_num(bodytyp,matrixnum)   number of coordinates associated with matrix.
54#          ::rb_coord(bodytyp,matrixnum,coord) coordinates
55#          ::rb_x(bodytyp,matrixnum,coordnum)  x coordinate
56#          ::rb_y(bodytyp,matrixnum,coordnum)  y coordinate
57#          ::rb_z(bodytyp,matrixnum,coordnum   z coordinate
58#          ::rb_lbl(bodytyp,matrixnum,coordnum label for coordinate triplet
59
60proc RB_Load_RBdata {args} {
61    catch {unset ::rb}
62    #Loop over the rigid body types in EXP file
63    foreach bodytyp [RigidBodyList] {
64             set rb($bodytyp) [ReadRigidBody $bodytyp]
65             #Set the number of times rigid body is mapped.
66             set ::rb_map($bodytyp) [lindex $rb($bodytyp) 0]
67
68             #define the matrices
69             set rb_mat [lindex $rb($bodytyp) 1]
70             set ::rb_matrix_num($bodytyp) [llength $rb_mat]
71             for {set matrixnum 1} {$matrixnum <= $::rb_matrix_num($bodytyp)} {incr matrixnum} {
72                 set temp [lindex $rb_mat [expr $matrixnum - 1]]
73                 set ::rb_mult($bodytyp,$matrixnum) [lindex $temp 0]
74                 set ::rb_damp($bodytyp,$matrixnum) [lindex $temp 1]
75                 set ::rb_var($bodytyp,$matrixnum)  [lindex $temp 2]
76                 set coords [lindex $temp 3]
77                 set ::rb_coord_num($bodytyp,$matrixnum) [llength $coords]
78                 #load all coordniate information for matrix matrixnum
79                 for {set coordnum 0} {$coordnum < $::rb_coord_num($bodytyp,$matrixnum)} {incr coordnum} {
80                     set ::rb_coord($bodytyp,$matrixnum,$coordnum) [lindex $coords $coordnum]
81                     set ::rb_x($bodytyp,$matrixnum,$coordnum) [lindex $::rb_coord($bodytyp,$matrixnum,$coordnum) 0]
82                     set ::rb_y($bodytyp,$matrixnum,$coordnum) [lindex $::rb_coord($bodytyp,$matrixnum,$coordnum) 0]
83                     set ::rb_z($bodytyp,$matrixnum,$coordnum) [lindex $::rb_coord($bodytyp,$matrixnum,$coordnum) 0]
84                     set ::rb_lbl($bodytyp,$matrixnum,$coordnum) [lindex $::rb_coord($bodytyp,$matrixnum,$coordnum) 0]
85                 }
86             }
87     }
88}
89
90############################################
91#           ::rb_map_beginning(phase,bodytyp,mapnum)   first atom in list
92#           ::rb_map_origin(phase,bodytyp,mapnum)      origin of rigid body
93#           ::rb_map_euler(phase,bodytyp,mapnum)       euler angles of rigid body
94#           ::rb_map_positions(phase,bodytyp,mapnum)   positions
95#           ::rb_map_damping(phase,bodytyp,mapnum)     damping
96#           ::rb_map_tls(phase,bodytyp,mapnum)         tls
97#           ::rb_map_tls_var(phase,bodytyp,mapnum)
98#           ::rb_map_tls_damp(phase,bodytyp,mapnum)
99proc RB_Load_Mapdata {phase bodytyp mapnum} {
100     set rb_map [ReadRigidBodyMapping $phase $bodytyp $mapnum]
101     set ::rb_map_beginning($phase,$bodytyp,$mapnum) [lindex $rb_map 0]
102     set ::rb_map_origin($phase,$bodytyp,$mapnum) [lindex $rb_map 1]
103     set ::rb_map_euler($phase,$bodytyp,$mapnum) [lindex $rb_map 2]
104     set ::rb_map_positionvars($phase,$bodytyp,$mapnum) [lindex $rb_map 3]
105     set ::rb_map_damping($phase,$bodytyp,$mapnum) [lindex $rb_map 4]
106     set ::rb_map_tls($phase,$bodytyp,$mapnum) [lindex $rb_map 5]
107     set ::rb_map_tls_var($phase,$bodytyp,$mapnum) [lindex $rb_map 6]
108     set ::rb_map_tls_damp($phase,$bodytyp,$mapnum) [lindex $rb_map 7]
109}
110
111#############################################
112#   rcb     .a               initial rigid body control panel.
113#   panelnum                 the notebook panel to be accessed.
114#::rb_notebook              the notebook containing all rigid body panels.
115
116proc RB_Control_Panel {panelnum args} {
117     #set rcb .a
118     #destroy $rcb
119     #catch {toplevel $rcb} err
120     set rcb $::expgui(rbFrame)
121     eval destroy [winfo children $rcb]
122     #wm title $rcb "Rigid Body Control Panel"
123     #wm geometry $rcb 700x600+10+10
124     set rb_nb $rcb.nb
125
126     # Enable NoteBook from BWidget package
127
128     set ::rb_notebook [NoteBook $rb_nb -side bottom]
129     # loop over rigid body types, create notebook pages
130     set pagelist {}
131
132     # add create rigid body page and populate page
133     $::rb_notebook insert 0 rb_body0 -text "Create Rigid Body" \
134     -raisecmd "RB_Create"
135     lappend pagelist rb_body0
136
137
138     foreach bodnum [RigidBodyList] {
139         $::rb_notebook insert $bodnum rb_body$bodnum -text "Rigid Body Type $bodnum"  \
140         -raisecmd "RB_Populate $::rb_notebook $bodnum"
141        lappend pagelist rb_body$bodnum
142     }
143
144    # grid notebook
145    grid $::rb_notebook -sticky news -column 0 -row 1 -columnspan 2
146    grid columnconfig $rcb 1 -weight 1
147    grid rowconfig    $rcb 1 -weight 1
148    $::rb_notebook raise [lindex $pagelist $panelnum]
149}
150
151############################################
152# Procedure to create new rigid body
153
154proc RB_Create {args} {
155     RB_Import_Data_Type
156     $::rb_notebook raise [$::rb_notebook page 0]
157     #sets the new rigidbody number
158     set bodytyp [expr [llength [RigidBodyList]] + 1]
159     #sets the phase list
160     set phase $::expmap(phaselist)
161     set pane [$::rb_notebook getframe rb_body0]
162     eval destroy [winfo children $pane]
163     set con0 $pane.con0
164     #set con1 $pane.con1
165     #set con2 $pane.con2
166     #set con3 $pane.con3
167
168     #initialize matrix number, multiplier and number of coordinates
169     set ::rb_matrix_num($bodytyp) 1
170     set ::rb_mult($bodytyp,1) 1.000
171
172     if {[info vars ::rb_coord_num($bodytyp,1)] == ""} {set ::rb_coord_num($bodytyp,1) 1}
173
174     #set check variables to see if number of matricies or coordinates incremented.
175     set ::rb_mat_num_check 0
176     set ::rb_atom_num_check 0
177
178     #building rigid body creation frames
179     pack [frame $con0 -bd 2 -relief groove] -side top -pady 10
180     
181      set ::rb_loader(manual) NewBodyTypeWindow
182     set ::rb_descriptor(manual) "Manual Input"
183
184
185     set filedescriptors ""
186     set filearray [array names ::rb_descriptor]
187     foreach file $filearray {
188             lappend filedescriptors $::rb_descriptor($file)
189     }
190
191     set filecount 0
192     set ::rb_file_loader "File Descriptions"
193     grid [label $con0.lbl -text "Data Input Type: "] -row 0 -column 0
194     set menu [eval tk_optionMenu $con0.filematrix ::rb_file_loader $filedescriptors]
195         foreach file $filearray {
196                 $menu entryconfig $filecount -command "eval $::rb_loader($file)"
197                 incr filecount
198         }
199     $con0.filematrix configure -width 17
200     grid $con0.filematrix -row 0 -column 1
201
202
203     #grid [button $con0.but -text "Create from window" -width 20 -command NewBodyTypeWindow] -row 2 -column 0 -padx 5 -pady 5 -columnspan 2
204     #grid [button $con0.cartload -text "Create from file \n cartesian coordinates" -width 20 -command "RB_Cartesian_Load"] -row 0 -column 1
205     #grid [button $con0.cartz -text "Create from \n Z-Matrix" -width 20 -command "RB_Zmat_Load"] -row 1 -column 1 -padx 5 -pady 5
206     grid [button $con0.fixfrag -text "Fix Molecular \n Fragment" -width 20 -command "RB_Fixfrag_Load"] -row 1 -column 0 -padx 5 -pady 5 -columnspan 2
207
208
209}
210
211############################################################
212#procedure to create tables of cartesian coordinates
213
214proc RB_Create_Cart {bodytyp location args} {
215     if {$::rb_matrix_num($bodytyp) == $::rb_mat_num_check && $::rb_coord_num($bodytyp,1) == $::rb_atom_num_check} {return}
216     if {[catch {expr $::rb_matrix_num($bodytyp)}] == 1 || [catch {expr $::rb_coord_num($bodytyp,1)}] == 1} {return}
217     if {$::rb_matrix_num($bodytyp) != int($::rb_matrix_num($bodytyp)) || $::rb_coord_num($bodytyp,1) != int($::rb_coord_num($bodytyp,1)) } {return}
218     eval destroy [winfo children $location]
219
220     foreach {top main side lbl} [MakeScrollTable $location] {}
221     set ::rb_atom_num_check $::rb_coord_num($bodytyp,1)
222     set ::rb_mat_num_check $::rb_matrix_num($bodytyp)
223     set col 0
224     grid [label $top.multilbl -text "Matrix Multiplier"] -row 1 -column 0
225     grid [label $top.damplbl -text "Damping Factor"] -row 2 -column 0
226     for {set matrixnum 1} {$matrixnum <= $::rb_matrix_num($bodytyp)} {incr matrixnum} {
227          grid [label $top.matlbl$matrixnum -text "Matrix $matrixnum"] -row 0 -column [expr $col + 2]
228          grid [entry $top.multi$matrixnum -textvariable ::rb_mult($bodytyp,$matrixnum) -width 7 -takefocus 1] -row 1 -column [expr $col +2]
229          grid [entry $top.damp$matrixnum -textvariable ::rb_damp($bodytyp,$matrixnum) -width 7 -takefocus 1] -row 2 -column  [expr $col +2]
230          if {$::rb_mult($bodytyp,$matrixnum) == ""} {set ::rb_mult($bodytyp,$matrixnum) 1.000}
231          if {$::rb_damp($bodytyp,$matrixnum) == ""} {set ::rb_damp($bodytyp,$matrixnum) 0}
232
233          grid [label $main.x$matrixnum -text "X"] -row 0 -column [expr $col + 1]
234          grid [label $main.y$matrixnum -text "Y"] -row 0 -column [expr $col + 2]
235          grid [label $main.z$matrixnum -text "Z"] -row 0 -column [expr $col + 3]
236          grid [label $main.b$matrixnum -text "    "] -row 0 -column [expr $col +4]
237          incr col 4
238     }
239
240     for {set coordnum 1} {$coordnum <= $::rb_coord_num($bodytyp,1)} {incr coordnum} {
241          grid [label $main.lbl$coordnum -text "Site $coordnum"] -row [expr $coordnum+10] -column 0
242          set col 0
243          for {set matrixnum 1} {$matrixnum <= $::rb_matrix_num($bodytyp)} {incr matrixnum} {
244              grid [entry $main.x($matrixnum,$coordnum) -textvariable ::rb_x($bodytyp,$matrixnum,$coordnum) -width 8 -takefocus 1] -row [expr $coordnum+10] -column [expr $col + 1]
245              if {$::rb_x($bodytyp,$matrixnum,$coordnum) == ""} {set ::rb_x($bodytyp,$matrixnum,$coordnum) 0}
246              grid [entry $main.y($matrixnum,$coordnum) -textvariable ::rb_y($bodytyp,$matrixnum,$coordnum) -width 8 -takefocus 1] -row [expr $coordnum+10] -column [expr $col + 2]
247              if {$::rb_y($bodytyp,$matrixnum,$coordnum) == ""} {set ::rb_y($bodytyp,$matrixnum,$coordnum) 0}
248              grid [entry $main.z($matrixnum,$coordnum) -textvariable ::rb_z($bodytyp,$matrixnum,$coordnum) -width 8 -takefocus 1] -row [expr $coordnum+10] -column [expr $col + 3]
249              if {$::rb_z($bodytyp,$matrixnum,$coordnum) == ""} {set ::rb_z($bodytyp,$matrixnum,$coordnum) 0}
250              grid [label $main.b($matrixnum,$coordnum) -text "    "] -row [expr $coordnum+10]  -column [expr $col +4]
251              incr col 4
252          }
253          ResizeScrollTable $location
254     }
255}
256########################################################
257# Procedure to save new rigid body to EXP file.
258
259proc RB_Create_Save {bodytyp args} {
260     set temp_mat ""
261     set temp_car ""
262     set temp_mat_group ""
263     set temp_car_group ""
264     set total ""
265#     puts $::::rb_coord_num($bodytyp,1)
266     for {set matrixnum 1} {$matrixnum <= $::rb_matrix_num($bodytyp)} {incr matrixnum} {
267         lappend temp_mat $::rb_mult($bodytyp,$matrixnum)
268     }
269
270     for {set matrixnum 1} {$matrixnum <= $::rb_matrix_num($bodytyp)} {incr matrixnum} {
271         for {set coordnum 1} {$coordnum <= $::rb_coord_num($bodytyp,1)} {incr coordnum} {
272                  set temp_cart_triplet "$::rb_x($bodytyp,$matrixnum,$coordnum) $::rb_y($bodytyp,$matrixnum,$coordnum) $::rb_z($bodytyp,$matrixnum,$coordnum)"
273                  lappend temp $temp_cart_triplet
274         }
275         lappend temp_car $temp
276     }
277#     puts "sites: $::rb_coord_num($bodytyp,1)"
278#     puts "matrix multiplier:  $temp_mat"
279#     puts "cartesian coords:   $temp_car"
280     AddRigidBody $temp_mat $temp_car
281
282     incr ::expgui(changed)
283     destroy .nbt
284     RB_Load_RBdata
285     RB_Control_Panel $bodytyp
286}
287
288###################################################
289# Procedures to delete rigid bodies
290
291proc RB_Delete_Body {bodytyp location args} {
292     destroy $location.delete
293     set really $location.delete
294     toplevel $really
295#     putontop $really
296     wm title $really "Delete Rigid Body"
297     #wm geometry $really 250x250+10+10
298     grid [label $really.lbl -text "Confirm \n Is rigid body $bodytyp to be deleted?"] -row 0 -column 0 -columnspan 2 -pady 15
299
300     grid [button $really.save -text "Delete" -bg red -command "RB_Delete_Body_Confirm $bodytyp $location.delete"] \
301          -row 1 -column 0 -padx 5 -pady 5
302     grid [button $really.abort -text "Abort" -bg green -command "RB_Control_Panel $bodytyp"] -row 1 -column 1 \
303          -padx 5 -pady 5
304}
305
306proc RB_Delete_Body_Confirm {bodytyp location args} {
307
308 #   unmap all instances of the rigid body
309     foreach p $::expmap(phaselist) {
310             foreach map [RigidBodyMappingList $p $bodytyp] {
311                     UnMapRigidBody $p $bodytyp $map
312             }
313#       lappend pagelist rb_body$x
314     }
315#    delete the rigid body
316#     puts "delete rigid body number $bodytyp"
317     DeleteRigidBody $bodytyp
318#     puts "destroy location $location"
319     destroy $location
320#    increment expgui
321     incr ::expgui(changed)
322     RB_Load_RBdata
323     RB_Control_Panel 0
324}
325
326############################################################
327# Procedure to populate notebook pages
328
329proc RB_Populate {rb_notebook bodytyp args} {
330     RB_Load_RBdata
331     set ::rb_panel $bodytyp
332     set phaselist $::expmap(phaselist)
333     # set notebook frame
334     set pane [$rb_notebook getframe rb_body$bodytyp]
335     eval destroy [winfo children $pane]
336     set con $pane.con
337     grid [frame $con -bd 2 -relief groove] -row 0 -column 1 -pady 10
338
339     #Rigid body mapping control panel along with matrix multipliers and damping factor labels
340     grid [label  $con.rb_num -text "Rigid Body Type $bodytyp"] -row 0 -column 0 -padx 5 -pady 5
341     grid [button $con.rb_newmap -text "Map Body $bodytyp" -command "RB_Map_New $bodytyp" -width 18] -row 0 -column 1 -padx 5 -pady 5
342     grid [button $con.rb_unmap -text "Unmap Body $bodytyp" -command "RB_Unmap $bodytyp" -width 18] -row 0 -column 2 -padx 5 -pady 5
343     button $con.rb_delete -text "Delete Body $bodytyp" -command "RB_Delete_Body $bodytyp $con.rb_delete" -width 18
344     grid   $con.rb_delete -row 4 -column 2 -padx 5 -pady 5
345
346
347     grid [label $con.rb_mlbl1 -text "Matrix"] -row 1 -column 0
348     grid [label $con.rb_mlbl2 -text "Multiplier"] -row 2 -column 0
349     grid [label $con.rb_mlbl3 -text "Damping Factor"] -row 3 -column 0
350     grid [button $con.plot -text "Plot Rigid Body" -command "PlotRBtype $bodytyp" -width 18] -row 4 -column 0
351
352     set matrixnum 0
353     for {set mnum 1} {$mnum <= $::rb_matrix_num($bodytyp)} {incr mnum} {
354        incr matrixnum
355        grid [label $con.rb_mm$mnum   -text "$mnum"]                -row 1 -column $matrixnum
356        grid [label $con.rb_mult$mnum -text "$::rb_mult($bodytyp,$mnum)"] -row 2 -column $matrixnum
357        grid [label $con.rb_damp$mnum -text "$::rb_damp($bodytyp,$mnum)"] -row 3 -column $matrixnum
358     }
359
360     button $con.rb_vmatrix -text "Edit Matrix" -command "RB_Edit_Matrix $bodytyp" -width 18
361     grid   $con.rb_vmatrix -row 4 -column 1 -padx 5 -pady 5
362     grid [button $con.refine -text "Refinement \n Flags" -command "RB_Refine_Con" -width 18 ] -row 5 -column 1
363
364     # create header for mapping data
365     foreach {top main side lbl} [MakeScrollTable $pane] {}
366     grid [label $main.rb_origin -text "Origin"] -row 0 -column 3 -columnspan 3
367     grid [label $main.rb_euler -text "Euler Angles"] -row 0 -column 6 -columnspan 3
368     grid [label $main.rb_site -text "Sites"] -row 0 -column 10 -columnspan 3
369     grid [label $main.rb_ref -text "Phase"] -row 1 -column 2
370     grid [label $main.rb_map -text "Map"] -row 1 -column 1
371     grid [label $main.rb_x   -text "x"] -row 1 -column 3
372     grid [label $main.rb_y   -text "y"] -row 1 -column 4
373     grid [label $main.rb_z   -text "z"] -row 1 -column 5
374     grid [label $main.rb_euler_x -text "x"] -row 1 -column 6
375     grid [label $main.rb_euler_y -text "y"] -row 1 -column 7
376     grid [label $main.rb_euler_z -text "z"] -row 1 -column 8
377#     grid [label $main.rb_opt     -text "Refine"] -row 1 -column 9 -padx 8
378     set col 11
379     for {set coordnum 1} {$coordnum <= $::rb_coord_num($bodytyp,1)} {incr coordnum} {
380        label $main.rb_site$coordnum -text "$coordnum"
381        grid $main.rb_site$coordnum -row 1 -column $col -padx 5
382        incr col
383     }
384
385     # populate mapping data table
386     set row 2
387     foreach phase $phaselist {
388             incr row
389             foreach mapnum [RigidBodyMappingList $phase $bodytyp] {
390                      set row [expr $row + $mapnum]
391                      RB_Load_Mapdata $phase $bodytyp $mapnum
392                      grid [label $main.rb_map$phase$mapnum -text "$mapnum"] -row $row -column 1
393                      grid [label $main.rb_cb$phase$mapnum -text $phase] -row $row -column 2
394                      set origin $::rb_map_origin($phase,$bodytyp,$mapnum)
395
396                      grid [label $main.rb_x$phase$mapnum   -text "[format %1.3f [lindex $origin 0]]"] -row $row -column 3 -padx 5
397                      grid [label $main.rb_y$phase$mapnum   -text "[format %1.3f [lindex $origin 1]]"] -row $row -column 4 -padx 5
398                      grid [label $main.rb_z$phase$mapnum   -text "[format %1.3f [lindex $origin 2]]"] -row $row -column 5 -padx 5
399                      set euler $::rb_map_euler($phase,$bodytyp,$mapnum)
400                      for {set j 0} {$j < 3} {incr j} {
401                                  set euler1 [lindex $euler $j]
402                                  set angle  [lindex $euler1 0]
403                                  set axis   [lindex $euler1 1]
404                                  label $main.rb_euler_$phase$mapnum$axis -text "[format %1.2f $angle]"
405                      }
406#                      grid [button $main.rb_tls$phase$mapnum -text "Refine" -command "RB_Refine_Con" -width 7] -row $row -column 9
407                       grid [label $main.rb_tls$phase$mapnum -text "     "] -row $row -column 9
408                      set q 1
409                      grid $main.rb_euler_$phase$mapnum$q -row $row -column 6  -padx 5
410                      set q 2
411                      grid $main.rb_euler_$phase$mapnum$q -row $row -column 7 -padx 5
412                      set q 3
413                      grid $main.rb_euler_$phase$mapnum$q -row $row -column 8 -padx 5
414                      set col 11
415                      set atomnum $::rb_map_beginning($phase,$bodytyp,$mapnum)
416                      for {set j 1} {$j <=$::rb_coord_num($bodytyp,1)} {incr j} {
417                          set atom [atominfo $phase $atomnum label]
418                          grid [label $main.rb_site$phase$mapnum$j -text "$atom"] -row $row -column $col -padx 5
419                          incr atomnum
420                          incr col
421                      }
422             }
423     incr row
424     }
425     ResizeScrollTable $pane
426}
427
428
429#######################################################################
430# New Mapping Event
431# not updated
432
433proc RB_Map_New {bodytyp args} {
434    catch {unset ::rb_finput}
435    set ::rb_finput ""
436    set ::body_type $bodytyp
437    catch {destroy .newmap}
438    set nm .newmap
439    toplevel $nm
440    putontop $nm
441    wm title $nm "Map Rigid Body #$bodytyp"
442
443    foreach item [trace vinfo ::rb_phase] {
444            eval trace vdelete ::rb_phase $item
445    }
446
447    set ::rb_phase [lindex $::expmap(phaselist) 0]
448    set nmap [expr $::rb_map($bodytyp) + 1]
449    eval tk_optionMenu $nm.pinput ::rb_phase $::expmap(phaselist)
450    grid [label $nm.phase -text "Phase: "] -row 3 -column 1
451    grid [label $nm.f_atom -text "Choose first atom Number"] -row 4 -column 1
452    grid [label $nm.origin -text "input origin in fractional coordinates: "] -row 6 -column 1
453    grid [label $nm.euler -text "input Euler angles: "] -row 7 -column 1
454    grid [entry $nm.finputm -textvariable ::rb_finput -width 8 -takefocus 1] -row 4 -column 2
455
456    foreach item [trace vinfo ::rb_finput] {
457            eval trace vdelete ::rb_finput $item
458    }
459    trace variable ::rb_finput w "RB_Atom_List \$::rb_phase \$::rb_finput $nm $bodytyp 1"
460
461    grid [button $nm.finput -text "list allowed" -command "RB_Choose_Atom $bodytyp"] -row 4 -column 3
462    grid [label $nm.o1l -text "x"] -row 5 -column 2
463    grid [label $nm.o2l -text "y"] -row 5 -column 3
464    grid [label $nm.o3l -text "z"] -row 5 -column 4
465    grid [entry $nm.o1 -width 8 -textvariable ::origin1 -takefocus 1] -row 6 -column 2
466    grid [entry $nm.o2 -width 8 -textvariable ::origin2 -takefocus 1] -row 6 -column 3
467    grid [entry $nm.o3 -width 8 -textvariable ::origin3 -takefocus 1] -row 6 -column 4
468    grid [entry $nm.e1 -width 8 -textvariable ::euler1 -takefocus 1] -row 7 -column 2
469    grid [entry $nm.e2 -width 8 -textvariable ::euler2 -takefocus 1] -row 7 -column 3
470    grid [entry $nm.e3 -width 8 -textvariable ::euler3 -takefocus 1] -row 7 -column 4
471
472    grid $nm.pinput -row 3 -column 3
473
474    grid [frame $nm.p] -row 8 -column 1 -columnspan 4 -sticky e
475    grid [button $nm.p.fit -text "Fit rigid body to phase" -command "FitBody2coords $bodytyp $nm"] -row 0 -column 1
476    grid [button $nm.p.plot -text "Plot rigid body & phase" -command "PlotStrBody $bodytyp $nm"] -row 1 -column 1
477    grid [label $nm.p.l -text "Bonds: "] -row 1 -column 2
478    grid [entry $nm.p.e] -row 1 -column 3
479    $nm.p.e delete 0 end
480    $nm.p.e insert 0 "0.9-1.1, 1.3-1.6"
481
482    grid [frame $nm.l] -row 9 -column 2 -columnspan 3
483    grid [button $nm.l.s -text "map update" -width 12 -command {RB_Write_Map}] -column 1 -row 1
484    grid [button $nm.l.q -text "Quit" -width 6 -command "destroy $nm"] -column 2  -row 1
485
486    foreach item [trace vinfo ::rb_phase] {
487            eval trace vdelete ::rb_phase $item
488    }
489    trace variable ::rb_phase w "RB_ProcessPhase $bodytyp"
490
491
492}
493
494###########################################################
495# Procedure for choosing first atom during mapping event.
496# not updated
497
498proc RB_Choose_Atom {bodytyp args} {
499#     set ::rb_finput ""
500    set phase $::rb_phase
501    # get the number of atoms in this type of body
502    set natoms [llength [lindex [lindex [lindex [ReadRigidBody $bodytyp] 1] 0] 3]]
503    set atomlist [RigidStartAtoms $::rb_phase $natoms]
504    if {[llength $atomlist] == 0} {
505        RB_ProcessPhase $bodytyp
506        return
507    }
508     catch {destroy .chooseatom}
509     set ca .chooseatom
510     toplevel $ca
511     wm title $ca "Choose Atom"
512#     puts $atomlist
513     foreach {top main side lbl} [MakeScrollTable $ca] {}
514     set row 0
515     set column 0
516     foreach atom $atomlist {
517        set label "[atominfo $phase $atom label] \($atom\)"
518# fix next line need global variable to send.
519#        button $main.$atom -text "$label" -command "set ::rb_finput [list $label]; destroy $ca"
520        button $main.$atom -text $label -command "set ::rb_finput $atom; destroy $ca"
521        incr row
522        if {$row > 5} {
523           set row 1
524           incr column
525        }
526      grid $main.$atom -row $row -column $column -padx 5 -pady 5
527      }
528      ResizeScrollTable $ca
529      putontop $ca
530      tkwait window $ca
531      afterputontop
532      raise .newmap
533}
534
535
536
537##########################################################
538##########################################################
539
540 
541proc FitBody2coords {rbtype menu} {
542    set warn ""
543    foreach i {1 2 3} lbl {x y z} {
544        if {[string trim [set ::euler$i]] == ""} {
545            set ::euler$i 0.0
546        }
547        if {[string trim [set ::origin$i]] == ""} {
548            set ::origin$i .0
549        }
550        if {[catch {expr [set ::euler$i]}]} {
551            append warn "\tError in Euler angle around $lbl\n"
552        }
553        if {[catch {expr [set ::origin$i]}]} {
554            append warn "\tError in origin $lbl\n"
555        }
556    }
557    if {[catch {expr $::rb_finput}]} {
558        append warn "\tError in 1st atom number\n"
559    }
560    if {$warn != ""} {
561        MyMessageBox -parent $menu -title "Input error" \
562                -message "Invalid input:\n$warn" -icon warning
563        return
564    }
565    set Euler [list "1 $::euler1" "2 $::euler2" "3 $::euler3"]
566    set origin "$::origin1 $::origin2 $::origin3"
567    set phase $::rb_phase
568    set cell {}
569    foreach p {a b c alpha beta gamma} {
570        lappend cell [phaseinfo $phase $p]
571    }
572    set coords [RB2cart [lindex [ReadRigidBody $rbtype] 1]]
573    set natom [llength $coords]
574    set firstind [lsearch $::expmap(atomlist_$phase) $::rb_finput]
575    set atoms [lrange \
576                   [lrange $::expmap(atomlist_$phase) $firstind end] \
577                   0 [expr {$natom-1}]]
578    # now loop over atoms
579    set frcoords {}
580    foreach atom $atoms {
581        set xyz {}
582        foreach v {x y z} {
583            lappend xyz [atominfo $phase $atom $v]
584        }
585        lappend frcoords $xyz
586    }
587    # it would be nice to have checkboxes for each atom, but for now use em all
588    set useflags {}
589    foreach i $coords {lappend useflags 1}
590#    puts "frcoords $frcoords"
591#    puts "coords $coords"
592    # do the fit
593    foreach {neworigin newEuler rmsdev newfrac rmsbyatom} \
594        [FitBody $Euler $cell $coords $useflags $frcoords $origin] {}
595    foreach i {1 2 3} val $neworigin pair $newEuler {
596        set ::origin$i $val
597        set ::euler$i [lindex $pair 1]
598    }
599    # show deviations
600   
601    foreach atom $atoms rms $rmsbyatom {
602        puts "[atominfo $phase $atom label]\t$rms"
603    }
604    #puts "CalcBody $Euler $cell $coords $origin"
605    #puts $coords
606    #puts $frcoords
607    #DRAWxtlPlotRBFit $frcoords $phase $::rb_finput 0 $bondlist $bondlist
608 }
609
610proc PlotStrBody {rbtype menu} {
611    set warn ""
612    foreach i {1 2 3} lbl {x y z} {
613        if {[catch {expr [set ::euler$i]}]} {
614            append warn "\tError in Euler angle around $lbl\n"
615        }
616        if {[catch {expr [set ::origin$i]}]} {
617            append warn "\tError in origin $lbl\n"
618        }
619    }
620    if {[catch {expr $::rb_finput}]} {
621        append warn "\tError in 1st atom number\n"
622    }
623    if {$warn != ""} {
624        MyMessageBox -parent $menu -title "Input error" \
625                -message "Invalid input:\n$warn" -icon warning
626        return
627    }
628    # translate bond list
629    set bl [$menu.p.e get]
630    regsub -all "," $bl " " bl
631    set bondlist {}
632    set warn ""
633    foreach b $bl {
634        if {[llength [split $b "-"]] == 2} {
635            lappend bondlist [split $b "-"]
636        } else {
637            set warn "error parsing bond list"
638        }
639    }
640    if {$warn != ""} {
641        MyMessageBox -parent . -title "Input warning" \
642                -message "Invalid bond input" -icon warning
643    }
644     set Euler [list "1 $::euler1" "2 $::euler2" "3 $::euler3"]
645     set origin "$::origin1 $::origin2 $::origin3"
646     set phase $::rb_phase
647     set cell {}
648     foreach p {a b c alpha beta gamma} {
649        lappend cell [phaseinfo $phase $p]
650    }
651    set coords [RB2cart [lindex [ReadRigidBody $rbtype] 1]]
652    set frcoords [CalcBody $Euler $cell $coords $origin]
653    #puts "CalcBody $Euler $cell $coords $origin"
654    #puts $coords
655    #puts $frcoords
656    DRAWxtlPlotRBFit $frcoords $phase $::rb_finput 0 $bondlist $bondlist
657 }
658#
659
660proc RB_Write_Map {args} {
661   set origin "$::origin1 $::origin2 $::origin3"
662   set euler "$::euler1 $::euler2 $::euler3"
663#   puts "phase = $::rb_phase"
664#   puts "bodytyp = $::body_type"
665#   puts "firstatom = $::rb_finput"
666#   puts "position = $origin"
667#   puts "Euler = $euler"
668   MapRigidBody $::rb_phase $::body_type $::rb_finput $origin $euler
669   incr ::rb_map($::body_type)
670   incr ::expgui(changed)
671   set curpage [$::rb_notebook raise]
672   $::rb_notebook raise [$::rb_notebook page end]
673   $::rb_notebook raise $curpage
674#   RB_Control_Panel $::body_type
675   destroy .newmap
676   RunRecalcRBCoords
677   incr ::expgui(changed)
678   RB_Control_Panel $::body_type
679
680}
681
682proc RB_Atom_List {phase atomnum address x y args} {
683     foreach w [winfo children $address] {
684             if {[string first ".atom" $w] != -1} {destroy $w}
685     }
686     set col 8
687    if {$atomnum == ""} return
688     grid [label $address.atomlbl -text "Atoms Mapped to Rigid Body"] -row 3 -column 8 -columnspan 99
689    # get the number of atoms in this type of body
690    set natoms [llength [lindex [lindex [lindex [ReadRigidBody $x] 1] 0] 3]]
691    set atoms [RigidStartAtoms $phase $natoms]
692    if {[lsearch $atoms $atomnum] == -1} {
693         grid [label $address.atomerr -text "(invalid 1st atom)"] -row 4 -column $col
694        return
695    }
696    set atoms [lrange $::expmap(atomlist_$phase) \
697                   [lsearch $::expmap(atomlist_$phase) $atomnum] end]
698    foreach j [lrange $atoms 0 [expr {$natoms - 1}]] {
699        set atom [atominfo $phase $j label]
700        grid [label $address.atom$phase$x$j -text $atom] -row 4 -column $col
701        incr col
702     }
703}
704
705proc RB_ProcessPhase {rbnum args} {
706    if {$::rb_phase == ""} {
707        set atoms {}
708    } else {
709        # get the number of atoms in this type of body
710        set natoms [llength [lindex [lindex [lindex [ReadRigidBody $rbnum] 1] 0] 3]]
711
712        set atoms [RigidStartAtoms $::rb_phase $natoms]
713    }
714    set nm .newmap
715    if {[llength $atoms] == 0} {
716        foreach w "$nm.finputm $nm.p.plot $nm.p.fit $nm.p.e $nm.l.s" {
717            $w config -state disabled
718        }
719        $nm.finput config -text "None allowed" -state disabled
720    } else {
721        foreach w "$nm.finputm $nm.p.plot $nm.p.fit $nm.p.e $nm.l.s" {
722            $w config -state normal
723        }
724        $nm.finput config -text "Show allowed" -state normal
725    }
726}
727
728proc RB_Unmap {x args} {
729    catch {unset ::rb_finput}
730    set ::rb_finput ""
731    set ::body_type $x
732    catch {destroy .unmap}
733    set um .unmap
734    toplevel $um
735    putontop $um
736    wm title $um "Map Rigid Body #$x"
737    set ::phase 1
738    set umap $::rb_map($x)
739#    eval tk_optionMenu $um.pinput ::rb_phase $::expmap(phaselist)
740#    grid [label $um.phase -text "Phase: "] -row 3 -column 1
741#    grid $um.pinput -row 3 -column 2
742
743    set mapnumber $::rb_map($x)
744    set unpane $um.pane
745    foreach {top main side lbl} [MakeScrollTable $um] {}
746    grid [label $main.cb -text "unmap"] -row 1 -column 0 -padx 5
747    grid [label $main.map -text "map"] -row 1 -column 1 -padx 5
748    grid [label $main.ph -text "Phase"] -row 1 -column 2 -padx 5
749    set y $::rb_matrix_num($x)
750    for {set z 1} {$z <= $::rb_coord_num($x,$y)} {incr z} {
751        label $main.rb_site$z -text "Site $z"
752        grid $main.rb_site$z -row 1 -column [expr 2 + $z]
753    }
754    set row 2
755    foreach p $::expmap(phaselist) {
756        incr row
757        foreach z [RigidBodyMappingList $p $x] {
758                set row [expr $row + $z]
759                RB_Load_Mapdata $p $x $z
760                checkbutton $main.unmap$p$z -variable ::rb_unmap($p,$x,$z)
761                grid $main.unmap$p$z -row $row -column 0
762                grid [label $main.rb_map$p$z -text "$z"] -row $row -column 1
763                grid [label $main.rb_cb$p$z -text $p] -row $row -column 2
764                      set atomnum $::rb_map_beginning($p,$x,$z)
765                      set col 3
766                      for {set j 1} {$j <=$::rb_coord_num($x,$y)} {incr j} {
767                          set atom [atominfo $p $atomnum label]
768                          grid [label $main.rb_site$p$z$j -text "$atom"] -row $row -column $col
769                          incr atomnum
770                          incr col
771                      }
772             }
773     incr row
774     }
775     ResizeScrollTable $um
776
777     grid [frame $um.update -bd 2 -relief groove] -row 0 -column 1 -pady 10
778     button $um.update.con -text "Update Rigid Body Mapping" -command "RB_unmap_delete $um $x"
779     button $um.update.quit -text "Quit" -command "destroy $um"
780     grid $um.update.con -row 0 -column 0 -padx 5 -pady 5
781     grid $um.update.quit -row 0 -column 1
782     incr ::expgui(changed)
783
784#     UnMapRigidBody $phase $bodytyp $mapnum
785#     incr ::expgui(changed)
786#     RB_Control_Panel $bodytyp
787}
788
789proc RB_unmap_delete {panel x args} {
790#     puts $panel
791     foreach p $::expmap(phaselist) {
792        foreach z [RigidBodyMappingList $p $x] {
793                if {$::rb_unmap($p,$x,$z) == 1} {
794                   UnMapRigidBody $p $x $z
795                }
796        }
797        incr ::expgui(changed)
798        destroy $panel
799        set curpage [$::rb_notebook raise]
800        $::rb_notebook raise [$::rb_notebook page end]
801        $::rb_notebook raise $curpage
802        RB_Control_Panel $x
803     }
804}
805
806
807proc RB_Edit_Matrix {bodnum args} {
808     puts "Bodnum = $bodnum"
809     catch {destroy .viewmatrix}
810     set em .viewmatrix
811     toplevel $em
812     putontop $em
813     wm title $em "Edit Matrices for Rigid Body $bodnum"
814
815     set vm $em.entry
816     set um $em.update
817     set sm $em.sort
818     grid [frame $vm -bd 2 -relief groove] -row 0 -column 0 -columnspan 2
819     grid [frame $um -bd 2 -relief groove] -row 1 -column 1
820     grid [frame $sm -bd 2 -relief groove] -row 1 -column 0
821
822     grid [label $sm.sort -text "Sort Matrix"] -row 1 -column 0 -columnspan 2
823     grid [button $sm.inc -text "\u2191" -command "RB_Sort_Inc $bodnum inc"] -row 2 -column 0
824     grid [button $sm.dec -text "\u2193" -command "RB_Sort_Inc $bodnum dec"] -row 2 -column 1
825
826     grid [button $um.update -text "Update Matrix Info" -bg green -command "RB_Matrix_Update $bodnum"] -row 0 -column 0
827 #    grid [button $um.sort -text "Sort Matrix Info" -command "RB_Cart_Sort $bodnum"] -row 0 -column 1
828     grid [button $um.abort -text "Abort" -command "destroy $em"] -row 0 -column 2
829
830     grid [label $vm.lbldamp -text "Matrix Multiplier"] -row 3 -column 2
831     grid [label $vm.lblvar -text "Damping Factor"] -row 4 -column 2
832
833     set w 1
834     grid [label $vm.site -text "sort"] -row 5 -column 0 -columnspan 2
835
836     for {set z 0} {$z < $::rb_coord_num($bodnum,$w)} {incr z} {
837         grid [checkbutton $vm.sort$z -variable ::rb_sort($z)] -row [expr $z + 6] -column 1
838         grid [label $vm.lbls$z -text "Site [expr $z+ 1]"] -row [expr $z+6] -column 2
839     }
840     set col 3
841     for {set i 1} {$i <= $::rb_matrix_num($bodnum)} {incr i} {
842         grid [label $vm.lblm$i -text "Matrix #$i"] -row 2 -column [expr $col +1]
843         grid [entry $vm.mult$i -textvariable ::rb_mult($bodnum,$i) -width 8 -takefocus 1] -row 3 -column [expr $col + 1]
844         grid [entry $vm.damp$i -textvariable ::rb_damp($bodnum,$i) -width 8 -takefocus 1 -state disable] -row 4 -column [expr $col + 1]
845
846         grid [label $vm.x$i -text "X"] -row 5 -column [expr $col]
847         grid [label $vm.y$i -text "Y"] -row 5 -column [expr $col + 1]
848         grid [label $vm.z$i -text "Z"] -row 5 -column [expr $col + 2]
849         for {set j 0} {$j < $::rb_coord_num($bodnum,$w)} {incr j} {
850#             puts $::rb_coord($bodnum,$i,$j)
851             set ::x($i,$j) [lindex $::rb_coord($bodnum,$i,$j) 0]
852             set ::y($i,$j) [lindex $::rb_coord($bodnum,$i,$j) 1]
853             set ::z($i,$j) [lindex $::rb_coord($bodnum,$i,$j) 2]
854             set ::lbl($i,$j) [lindex $::rb_coord($bodnum,$i,$j) 3]
855
856             grid [entry $vm.lblcx$i$j -textvariable ::x($i,$j) -width 8 -takefocus 1] -row [expr $j+6] -column [expr $col]
857             grid [entry $vm.lblcy$i$j -textvariable ::y($i,$j) -width 8 -takefocus 1] -row [expr $j+6] -column [expr $col + 1]
858             grid [entry $vm.lblcz$i$j -textvariable ::z($i,$j) -width 8 -takefocus 1] -row [expr $j+6] -column [expr $col + 2]
859             grid [label $vm.lblcb$i$j -text "    "] -row [expr  $j+6] -column [expr $col + 3]
860         }
861     incr col 4
862     }
863}
864
865
866
867proc RB_Sort_Inc {bodnum dir args} {
868     set sortlist ""
869     for {set count 0} {$count < $::rb_coord_num($bodnum,1)} {incr count} {
870         if {$::rb_sort($count) == 1} {
871            lappend sortlist $count
872         }
873     }
874     puts $sortlist
875
876     foreach check $sortlist {
877             set checkup [expr $check - 1]
878             set checkdwn [expr $check + 1]
879             if {$checkup < 0} {
880                if {$dir == "inc"} {
881                   bell
882                   return
883                }
884             }
885             if {$checkdwn >= $::rb_coord_num($bodnum,1)} {
886                if {$dir == "dec"} {
887                   bell
888                   return
889                }
890             }
891     }
892     if {$dir == "dec"} {set sortlist [RB_String_Reverse $sortlist]}
893
894     for {set i 1} {$i <= $::rb_matrix_num($bodnum)} {incr i} {
895         foreach sort $sortlist {
896             if {$dir == "inc"} {set line1 [expr $sort - 1]}
897             if {$dir == "dec"} {set line1 [expr $sort + 1]}
898             set x1dum $::x($i,$line1)
899             set y1dum $::y($i,$line1)
900             set z1dum $::z($i,$line1)
901             set ::x($i,$line1) $::x($i,$sort)
902             set ::y($i,$line1) $::y($i,$sort)
903             set ::z($i,$line1) $::z($i,$sort)
904             set ::x($i,$sort) $x1dum
905             set ::y($i,$sort) $y1dum
906             set ::z($i,$sort) $z1dum
907
908             set ::rb_sort($sort) 0
909             if {$dir == "inc"} {set ::rb_sort([expr $sort - 1]) 1}
910             if {$dir == "dec"} {
911                foreach relabel $sortlist {
912                    set ::rb_sort([expr $relabel +1]) 1
913                }
914             }
915        }
916     }
917
918}
919
920proc RB_String_Reverse {string args} {
921    puts "$string"
922    set rstring ""
923    set len [expr [llength $string] - 1]
924    while {$len > -1} {
925        lappend rstring [lindex $string $len]
926        incr len -1
927    }
928    puts "contents of rstring = $rstring"
929    return $rstring
930}
931
932proc RB_Matrix_Update {bodnum args} {
933     set temp_mat ""
934     set temp_car ""
935     set temp_mat_group ""
936     set temp_car_group ""
937     set total ""
938
939     for {set matrixnum 1} {$matrixnum <= $::rb_matrix_num($bodnum)} {incr matrixnum} {
940         lappend temp_mat "$::rb_mult($bodnum,$matrixnum)"
941     }
942
943     for {set matrixnum 1} {$matrixnum <= $::rb_matrix_num($bodnum)} {incr matrixnum} {
944         set temp ""
945         for {set atomnum 0} {$atomnum < $::::rb_coord_num($bodnum,1)} {incr atomnum} {
946                  set temp_cart_triplet "$::x($matrixnum,$atomnum) $::y($matrixnum,$atomnum) $::z($matrixnum,$atomnum)"
947                  lappend temp $temp_cart_triplet
948                           }
949         lappend temp_car $temp
950     }
951     puts "Matrix Update Info = $bodnum $temp_mat $temp_car"
952     ReplaceRigidBody $bodnum $temp_mat $temp_car
953     incr ::expgui(changed)
954     RB_Load_RBdata
955     RB_Control_Panel $bodnum
956     destroy .viewmatrix
957
958}
959
960############################################################################################
961proc RB_View_Parameters {phase x y args} {
962   set euler     $::rb_map_euler($phase,$x,$y)
963   set positions $::rb_map_positions($phase,$x,$y)
964   set damping   $::rb_map_damping($phase,$x,$y)
965   catch {destroy .viewparam}
966   set vp .viewparam
967   toplevel $vp
968   wm title $vp "Refinement Options"
969   frame $vp.con -bd 2 -relief groove
970   frame $vp.spa -bd 2 -relief groove
971   frame $vp.refflag -bd 2 -relief groove
972   grid $vp.con -row 0 -column 0
973
974   grid $vp.spa -row 2 -column 0
975   grid $vp.refflag -row 1 -column 0
976
977   set con $vp.con
978   label $con.lbl -text "Refine: "
979   button $con.tog -text "off"
980   grid $con.lbl -row 0 -column 0
981   grid $con.tog -row 0 -column 1
982
983   grid [label $vp.spa.lbl1 -text "Supplemental Position Angles"] row 0 -column 0 -columnspan 3
984   set ::e_angle1$y [lindex [lindex $euler 3] 0]
985
986   set ::e_angle2$y [lindex [lindex $euler 4] 0]
987   set ::e_angle3$y [lindex [lindex $euler 5] 0]
988   grid [label $vp.spa.angle1l -text "Sup. Angle 1"] -row 1 -column 0
989   grid [label $vp.spa.angle2l -text "Sup. Angle 2"] -row 2 -column 0
990   grid [label $vp.spa.angle3l -text "Sup. Angle 3"] -row 3 -column 0
991   grid [entry $vp.spa.angle1 -textvariable ::e_angle1$y] -row 1 -column 1
992   grid [entry $vp.spa.angle2 -textvariable ::e_angle2$y] -row 2 -column 1
993   grid [entry $vp.spa.angle3 -textvariable ::e_angle3$y] -row 3 -column 1
994
995   set e_axis1 [lindex [lindex $euler 3] 1]
996   set e_axis2 [lindex [lindex $euler 4] 1]
997   set e_axis3 [lindex [lindex $euler 5] 1]
998
999   grid [label $vp.refflag.lbl1 -text "Refinement Flags"] -row 0 -column 0 -columnspan 3
1000   grid [label $vp.refflag.x_axis -text "X-axis"] -row 1 -column 0
1001   grid [label $vp.refflag.y_axis -text "Y-axis"] -row 1 -column 1
1002   grid [label $vp.refflag.z_axis -text "Z-axis"] -row 1 -column 2
1003   grid [label $vp.refflag.euler1 -text "Euler Angle 1"] -row 3 -column 0
1004   grid [label $vp.refflag.euler2 -text "Euler Angle 2"] -row 3 -column 1
1005   grid [label $vp.refflag.euler3 -text "Euler Angle 3"] -row 3 -column 2
1006   grid [label $vp.refflag.sup1 -text "Sup. Angle 1"] -row 5 -column 0
1007   grid [label $vp.refflag.sup2 -text "Sup. Angle 2"] -row 5 -column 1
1008   grid [label $vp.refflag.sup3 -text "Sup. Angle 3"] -row 5 -column 2
1009
1010   for {set j 0} {$j < 9} {incr j} {
1011       label $vp.refflag.$j -text [lindex $positions $j]
1012   }
1013   grid $vp.refflag.0 -row 2 -column 0
1014   grid $vp.refflag.1 -row 2 -column 1
1015   grid $vp.refflag.2 -row 2 -column 2
1016   grid $vp.refflag.3 -row 4 -column 0
1017   grid $vp.refflag.4 -row 4 -column 1
1018   grid $vp.refflag.5 -row 4 -column 2
1019   grid $vp.refflag.6 -row 6 -column 0
1020   grid $vp.refflag.7 -row 6 -column 1
1021   grid $vp.refflag.8 -row 6 -column 2
1022
1023
1024
1025   putontop $vp
1026}
1027   proc GetImportFormats {} {
1028    global expgui tcl_platform
1029    # only needs to be done once
1030    if [catch {set expgui(importFormatList)}] {
1031        set filelist [glob -nocomplain [file join $expgui(scriptdir) import_*.tcl]]
1032        foreach file $filelist {
1033            set description ""
1034            source $file
1035            if {$description != ""} {
1036                lappend expgui(importFormatList) $description
1037                if {$tcl_platform(platform) == "unix"} {
1038                    set extensions "[string tolower $extensions] [string toupper $extensions]"
1039                }
1040                set expgui(extensions_$description) $extensions
1041                set expgui(proc_$description) $procname
1042            }
1043        }
1044    }
1045}
1046
1047
1048
1049proc RB_Load_File {location args} {
1050#     eval destroy [winfo children $location]
1051      destroy $location.display
1052      set filelist [RB_Import_Data_Type]
1053#      puts $filelist
1054#     menubutton $location.but -text "File Type" -menu $location.but.menu
1055#      grid [frame $location.display -bd 2 -relief groove] -row 1 -column 0
1056
1057#      set menuloc $location.display
1058#      menu $menuloc.menu
1059#      grid $menuloc.menu -row 1 -column 0
1060#     foreach filetype $filelist {
1061#             $location.but.menu add command -label $filetype -command "puts $filetype"
1062#     }
1063}
1064
1065proc NewBodyTypeWindow {} {
1066     destroy .nbt
1067     toplevel .nbt
1068     putontop .nbt
1069     set con1 .nbt.1
1070     set con2 .nbt.2
1071     set con3 .nbt.3
1072     set bodytyp [expr [llength [RigidBodyList]] + 1]
1073     pack [frame $con1 -bd 2 -relief groove] -side top -pady 10
1074     pack [frame $con2 -bd 2 -relief groove] -side top -expand 1 -fill both
1075     pack [frame $con3 -bd 2 -relief groove] -side top
1076     grid [label $con1.lbl -text "New Rigid Body Type $bodytyp"] -row 0 -column 0
1077     grid [label $con1.mat -text "Number of Matricies Describing Rigid Body"] -row 1 -column 0
1078
1079
1080
1081     spinbox $con1.matnum -from 0 -to 10 -textvariable ::rb_matrix_num($bodytyp) -width 5 -command "RB_Create_Cart $bodytyp $con2"
1082     grid $con1.matnum -row 1 -column 1 -padx 10
1083     grid [label $con1.atoms -text "Number of Cartesian Sites"] -row 2 -column 0
1084     spinbox $con1.atomsnum -from 0 -to 1000 -textvariable ::rb_coord_num($bodytyp,1) -width 5 -command "RB_Create_Cart $bodytyp $con2"
1085     grid $con1.atomsnum -row 2 -column 1 -padx 10
1086
1087
1088     grid [button $con3.save -text "Save \n Rigid Body" -command "RB_Create_Save $bodytyp"] -row 0 -column 2 -padx 5 -pady 5
1089     grid [button $con3.abort -text "Abort \n Rigid Body" -command "destroy .nbt; RB_Control_Panel end"] -row 0 -column 3 -padx 5 -pady 5
1090
1091     RB_Create_Cart $bodytyp $con2
1092     bind $con1.atomsnum <Leave> "RB_Create_Cart $bodytyp $con2"
1093     bind $con1.atomsnum <Return> "RB_Create_Cart $bodytyp $con2"
1094     bind $con1.matnum <Leave> "RB_Create_Cart $bodytyp $con2"
1095     bind $con1.matnum <Return> "RB_Create_Cart $bodytyp $con2"
1096}
1097
1098proc RB_Fixfrag_Load {args} {
1099     destroy .geometry
1100     toplevel .geometry
1101     set geo .geometry
1102
1103     pack [frame $geo.con2 -bd 2 -relief groove] -side top
1104     pack [frame $geo.con -bd 2 -relief groove] -side top
1105     pack [frame $geo.display -bd 2 -relief groove] -side top -expand 1 -fill both
1106
1107     wm title $geo "Fix Molecular Fragment from EXP File"
1108     wm geometry $geo 800x400+10+10
1109
1110     set phase 1
1111     set gcon $geo.con
1112     set gcon2 $geo.con2
1113     set gdisplay $geo.display
1114     set ::gcon_atoms 3
1115
1116     eval tk_optionMenu $geo.con.phaseinput ::rb_phase $::expmap(phaselist)
1117     grid [label $gcon.phaselbl -text "Input Phase"] -row 0 -column 0
1118     grid $gcon.phaseinput -row 0 -column 1
1119     set ::gcon_atoms_total $::expmap(atomlist_$phase)
1120     grid [label $gcon.atomlbl -text "Number of atoms in fragment: "] -row 1 -column 0
1121     spinbox $gcon.atom -from 3 -to [lrange $::expmap(atomlist_$phase) end end] -textvariable ::gcon_atoms -width 5
1122     grid $gcon.atom -row 1 -column 1 -padx 5
1123     grid [button $gcon.atomchoice -text "Choose Start Atom" -command "RB_FixStartAtom $phase $gdisplay $gcon2"] -row 1 -column 2
1124     grid [button $gcon2.save -text "Save Rigid Body" -width 22 -command "RB_Geom_Save"] -row 0 -column 0
1125          $gcon2.save config -state disable
1126     grid [button $gcon2.abort -text "Quit" -width 22 -command "destroy .geometry"] -row 1 -column 0
1127
1128}
1129
1130proc RB_FixStartAtom {phase gdisplay gcon2 args} {
1131     set possible_start [RigidStartAtoms $phase $::gcon_atoms]
1132
1133     catch {destroy .chooseatom}
1134     set ca .chooseatom
1135     toplevel $ca
1136     wm title $ca "Choose Atom"
1137#     puts $atomlist
1138     foreach {top main side lbl} [MakeScrollTable $ca] {}
1139
1140     set row 0
1141     set column 0
1142     foreach atom $possible_start {
1143        set label "[atominfo $phase $atom label] \($atom\)"
1144        button $main.$atom -text $label -command "set ::gcon_start $atom; destroy $ca"
1145        incr row
1146        if {$row > 5} {
1147           set row 1
1148           incr column
1149        }
1150      grid $main.$atom -row $row -column $column -padx 5 -pady 5
1151      }
1152      ResizeScrollTable $ca
1153      putontop $ca
1154      tkwait window $ca
1155      afterputontop
1156      $gcon2.save config -state normal
1157      RB_Atom_Fixlist $phase $gdisplay
1158}
1159
1160proc RB_Atom_Fixlist {phase gdisplay} {
1161
1162     set start_loc [lsearch $::expmap(atomlist_$phase) $::gcon_start]
1163     set ::rb_atom_range [lrange $::expmap(atomlist_$phase) $start_loc [expr $start_loc + $::gcon_atoms - 1]]
1164#     puts "location = $start_loc  range = $::rb_atom_range"
1165     set rownum 1
1166     set colnum 1
1167
1168     eval destroy [winfo children $gdisplay]
1169     grid [frame $gdisplay.lbl -bd 2 -relief groove] -row 0 -column 0
1170     grid [frame $gdisplay.atoms -bd 2 -relief groove] -row 1 -column 0
1171     grid [frame $gdisplay.param -bd 2 -relief groove] -row 1 -column 1
1172
1173     grid [label $gdisplay.lbl.state -text "Select atoms to define centroid for origin"] -row 0 -column 0
1174  #   grid [button $gdisplay.lbl.set -text "Set Origin" -command "RB_Atom_Origin_Set"] -row 3 -column 0
1175
1176     foreach {top main side lbl} [MakeScrollTable $gdisplay.atoms] {}
1177     eval destroy [winfo children $main]
1178     foreach atom $::rb_atom_range {
1179
1180
1181             if {[expr $colnum % 4] == 0} {incr rownum; set colnum 1}
1182             set atomid [atominfo $phase $atom  label]
1183#             puts $atomid
1184             set ::rb_atom_origin_set($atom) 1
1185             grid [checkbutton $main.$atom -text "$atomid" -variable ::rb_atom_origin_set($atom)] -row $rownum -column $colnum
1186             incr colnum
1187
1188             }
1189      ResizeScrollTable $gdisplay.atoms
1190
1191
1192  set paramlist $gdisplay.param
1193# [atominfo $phase $::rb_atom_range label]
1194  grid [label $paramlist.lbl -text "Define Axes"] -row 0 -column 0 -columnspan 2
1195  grid [label $paramlist.lbl1 -text "Atom 1"] -row 1 -column 0
1196  grid [label $paramlist.lbl2 -text "Atom 2"] -row 1 -column 1
1197  grid [label $paramlist.lblx -text "Choose two atoms to define vector for x-axis: "] -row 2 -column 0 -pady 10 -columnspan 2
1198  grid [label $paramlist.lbly -text "Choose two atoms to define second vector defining xy plane: "] -row 4 -column 0 -pady 10 -columnspan 2
1199
1200  set atom_info_list ""
1201  set atom_list ""
1202  foreach atom $::rb_atom_range {
1203          lappend atom_info_list $atom
1204          lappend atom_info_list [atominfo $phase $atom label]
1205          lappend atom_list [atominfo $phase $atom label]
1206  }
1207
1208#                  puts $atom_info_list
1209       set ::rb_param_x1 [lindex $atom_list 0]
1210       set ::rb_param_x2 [lindex $atom_list 1]
1211       set ::rb_param_y1 [lindex $atom_list 0]
1212       set ::rb_param_y2 [lindex $atom_list 2]
1213       set ::geom_x1     [lindex $::rb_atom_range 0]
1214       set ::geom_x2     [lindex $::rb_atom_range 1]
1215       set ::geom_y1     [lindex $::rb_atom_range 0]
1216       set ::geom_y2     [lindex $::rb_atom_range 2]
1217
1218       set menu [eval tk_optionMenu $paramlist.x1 ::rb_param_x1 $atom_list]
1219           foreach item $atom {
1220              set max [llength $atom]
1221              for {set count 0} {$count <= [expr $max - 1]} {incr count} {
1222                 $menu entryconfig $count -command "set ::geom_x1 [lindex $atom_info_list [expr $count*2]]"
1223              }
1224       }
1225
1226       set menu [eval tk_optionMenu $paramlist.x2 ::rb_param_x2 $atom_list]
1227           foreach item $atom {
1228              set max [llength $atom]
1229              for {set count 0} {$count <= [expr $max - 1]} {incr count} {
1230                 $menu entryconfig $count -command "set ::geom_x2 [lindex $atom_info_list [expr $count*2]]"
1231              }
1232       }
1233
1234       set menu [eval tk_optionMenu $paramlist.y1 ::rb_param_y1 $atom_list]
1235           foreach item $atom {
1236              set max [llength $atom]
1237              for {set count 0} {$count <= [expr $max - 1]} {incr count} {
1238                 $menu entryconfig $count -command "set ::geom_y1 [lindex $atom_info_list [expr $count*2]]"
1239              }
1240       }
1241
1242       set menu [eval tk_optionMenu $paramlist.y2 ::rb_param_y2 $atom_list]
1243           foreach item $atom {
1244              set max [llength $atom]
1245              for {set count 0} {$count <= [expr $max - 1]} {incr count} {
1246                 $menu entryconfig $count -command "set ::geom_y2 [lindex $atom_info_list [expr $count*2]]"
1247              }
1248       }
1249
1250
1251       grid $paramlist.x1 -row 3 -column 0
1252       grid $paramlist.x2 -row 3 -column 1
1253       grid $paramlist.y1 -row 5 -column 0
1254       grid $paramlist.y2 -row 5 -column 1
1255
1256
1257         $paramlist.x1 config -width 4
1258         $paramlist.x2 config -width 4
1259         $paramlist.y1 config -width 4
1260         $paramlist.y2 config -width 4
1261
1262  }
1263
1264
1265proc RB_Atom_Origin_Set {args} {
1266        set ::rb_origin_list ""
1267        foreach item $::rb_atom_range {
1268                if {$::rb_atom_origin_set($item) == 1} {
1269                   lappend ::rb_origin_list $item
1270                }
1271        }
1272#        puts "Origin list = $::rb_origin_list"
1273}
1274
1275proc RB_Geom_Save {args} {
1276# number of atoms in rigid body  ::gcon_atoms
1277# first atom in rigid body       ::gcon_start
1278# origin list                    ::gcon_origin_list
1279
1280     set vector1list "X"
1281     set vector2list "Y"
1282   
1283     lappend vector1list [expr $::geom_x1 - [expr $::gcon_start -1]]
1284     lappend vector1list [expr $::geom_x2 - [expr $::gcon_start -1]]
1285     lappend vector2list [expr $::geom_y1 - [expr $::gcon_start -1]]
1286     lappend vector2list [expr $::geom_y2 - [expr $::gcon_start -1]]
1287
1288     set ::gcon_origin_list ""
1289        foreach item $::rb_atom_range {
1290                if {$::rb_atom_origin_set($item) == 1} {
1291                set temp [expr $item - [expr $::gcon_start - 1]]
1292                   lappend ::gcon_origin_list $temp
1293                }
1294        }
1295#        puts "Origin list = $::gcon_origin_list"
1296#        puts "vector 1 list = $vector1list"
1297#        puts "vector 2 list = $vector2list"
1298#        puts "number atoms = $::gcon_atoms"
1299#        puts "start atom  = $::gcon_start"
1300
1301set temp1 [ExtractRigidBody $::rb_phase $::gcon_atoms $::gcon_start $::gcon_origin_list $vector1list $vector2list]
1302if {[lindex $temp1 0] == {} || [lindex $temp1 1] == {} || [lindex $temp1 2] == {}} {
1303#   puts "Geometry Crashed"
1304   }
1305#puts "string 1 = [lindex $temp1 0]"
1306#puts "string 2 = [lindex $temp1 1]"
1307#puts "string 3 = [lindex $temp1 2]"
1308
1309set cartesian ""
1310lappend cartesian [lindex $temp1 2]
1311#puts "Cartesian = $cartesian"
1312
1313set bodytyp [AddRigidBody 1 $cartesian]
1314set ::rb_damp($bodytyp,1) 0
1315set ::rb_coord_num($bodytyp,1) $::gcon_atoms
1316
1317MapRigidBody $::rb_phase $bodytyp $::gcon_start [lindex $temp1 0] [lindex $temp1 1]
1318
1319destroy .geometry
1320
1321
1322RB_Control_Panel 0
1323}
1324
1325
1326proc MakeRBPane {} {     ;# called to create the panel intially
1327#    label $::expgui(rbFrame).l -text "RB Parameters"
1328#    grid $::expgui(rbFrame).l -column 1 -row 1
1329#    ResizeNotebook
1330}
1331
1332proc DisplayRB {} {     ;# called each time the panel is raised
1333    eval destroy [winfo children $::expgui(rbFrame)]
1334     RB_Load_RBdata
1335     RB_Control_Panel 0
1336    #label $::expgui(rbFrame).l -text "RB Parameters"
1337    #grid $::expgui(rbFrame).l -column 1 -row 1
1338    ResizeNotebook
1339}
1340
1341proc RB_Refine_Con {args} {
1342     catch {destroy .refcon}
1343     set con .refcon
1344     toplevel $con
1345     wm title $con "Rigid Body Refinement Controls"
1346     wm geometry $con 1150x600+10+10
1347     set ::rb_var_list ""
1348     set ::rb_var_list_tls ""
1349     set ::varnum 1
1350     set ::rb_var_name "var$::varnum"
1351#     putontop $con
1352      grid [frame $con.info -bd 2 -relief groove] -row 1 -column 0 -sticky news
1353      grid columnconfig $con 0 -weight 1
1354      grid [frame $con.con -bd 2 -relief groove] -row 0 -column 0 
1355      grid [frame $con.terminate -bd 2 -relief groove] -row 2 -column 0
1356
1357
1358
1359      #grid rowconfig $con 0 -weight 1
1360
1361     foreach {top main side lbl} [MakeScrollTable $con.info] {}
1362             grid [label $top.rb -text "Body"] -row 1 -column 1 -padx 3
1363             grid [label $top.phase -text "Ph"] -row 1 -column 2 -padx 3
1364             grid [label $top.mapnum -text "Map"] -row 1 -column 3 -padx 3
1365             grid [label $top.x -text "X"] -row 1 -column 4 -padx 3
1366             grid [label $top.y -text "Y"] -row 1 -column 5 -padx 3
1367             grid [label $top.z -text "Z"] -row 1 -column 6 -padx 3
1368             grid [label $top.b1 -text "   "] -row 1 -column 7 -padx 3
1369             grid [label $top.e1 -text "E1"] -row 1 -column 8 -padx 3
1370             grid [label $top.e2 -text "E2"] -row 1 -column 9 -padx 3
1371             grid [label $top.e3 -text "E3"] -row 1 -column 10 -padx 3
1372             grid [label $top.tlscon1 -text "on/off"] -row 1 -column 11 -padx 3
1373#             grid [label $top.b2 -text "   "] -row 1 -column 11 -padx 3
1374             grid [label $top.t11 -text "T11"] -row 1 -column 12 -padx 3
1375             grid [label $top.t22 -text "T22"] -row 1 -column 13 -padx 3
1376             grid [label $top.t33 -text "T33"] -row 1 -column 14 -padx 3
1377             grid [label $top.t12 -text "T12"] -row 1 -column 15 -padx 3
1378             grid [label $top.t13 -text "T13"] -row 1 -column 16 -padx 3
1379             grid [label $top.t23 -text "T23"] -row 1 -column 17 -padx 3
1380             grid [label $top.b3 -text "   "] -row 1 -column 18 -padx 3
1381             grid [label $top.l11 -text "L11"] -row 1 -column 19 -padx 3
1382             grid [label $top.l22 -text "L22"] -row 1 -column 20 -padx 3
1383             grid [label $top.l33 -text "L33"] -row 1 -column 21 -padx 3
1384             grid [label $top.l12 -text "L12"] -row 1 -column 22 -padx 3
1385             grid [label $top.l13 -text "L13"] -row 1 -column 23 -padx 3
1386             grid [label $top.l23 -text "L23"] -row 1 -column 24 -padx 3
1387             grid [label $top.zb4 -text "   "] -row 1 -column 25 -padx 3
1388             grid [label $top.s12 -text "S12"] -row 1 -column 26 -padx 3
1389             grid [label $top.s13 -text "S13"] -row 1 -column 27 -padx 3
1390             grid [label $top.s21 -text "S21"] -row 1 -column 28 -padx 3
1391             grid [label $top.s23 -text "S23"] -row 1 -column 29 -padx 3
1392             grid [label $top.s31 -text "S31"] -row 1 -column 30 -padx 3
1393             grid [label $top.s32 -text "S32"] -row 1 -column 31 -padx 3
1394             grid [label $top.saa -text "SAA"] -row 1 -column 32 -padx 3
1395             grid [label $top.sbb -text "SBB"] -row 1 -column 33 -padx 3
1396
1397             grid [label $top.refcoord -text "Origin"] -row 0 -column 4 -padx 5 -columnspan 3
1398             grid [label $top.refeuler -text "Euler Angles"] -row 0 -column 8 -padx 5 -columnspan 3
1399             grid [label $top.tlscon2 -text "TLS"] -row 0 -column 11
1400             grid [label $top.tls -text "TLS"] -row 0 -column 12 -padx 5 -columnspan 6
1401#             grid [label $top.atoms -text "Atoms in Mapping"] -row 0 -column 6 -padx 5 -columnspan 10
1402
1403             #Determine number of rigid bodies and rigid body mappings
1404             set rb_num [RigidBodyList]
1405             set row 1
1406             foreach phasenum $::expmap(phaselist) {
1407                 foreach bodnum $rb_num {
1408                     set rb_map_num($phasenum,$bodnum) [RigidBodyMappingList $phasenum $bodnum]
1409
1410                  foreach mapnum $rb_map_num($phasenum,$bodnum) {
1411#                         puts "mapnum = $mapnum"
1412#                         grid [checkbutton $main.check($phasenum,$bodnum,$mapnum)] -row $row -column 0
1413                         grid [label $main.body($phasenum,$bodnum,$mapnum) -text $bodnum] -row $row -column 1
1414                         grid [label $main.phase($phasenum,$bodnum,$mapnum) -text $phasenum] -row $row -column 2
1415                         grid [label $main.map($phasenum,$bodnum,$mapnum) -text $mapnum] -row $row -column 3
1416                         RB_Load_Vars $phasenum $bodnum $mapnum
1417#                         puts "the checkbutton variable is $::rb_var($phasenum,$bodnum,$mapnum,tls)"
1418
1419#                         puts $main
1420                         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
1421                         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
1422                         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
1423                         grid [label $main.b1($phasenum,$bodnum,$mapnum) -text "   "] -row $row -column 7
1424
1425                         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
1426                         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
1427                         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
1428#                         grid [label $main.b2($phasenum,$bodnum,$mapnum) -text "   "] -row $row -column 11
1429
1430                         grid [checkbutton $main.tlscon($phasenum,$bodnum,$mapnum) -variable ::rb_var($phasenum,$bodnum,$mapnum,tls) -command "RB_TLS_Onoff $phasenum $main $bodnum $mapnum" -width 5] -row $row -column 11
1431
1432
1433                         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
1434                         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
1435                         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
1436                         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
1437                         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
1438                         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
1439                         grid [label $main.b3($phasenum,$bodnum,$mapnum) -text "   "] -row $row -column 18
1440
1441                         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
1442                         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
1443                         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
1444                         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
1445                         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
1446                         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
1447                         grid [label $main.b4($phasenum,$bodnum,$mapnum) -text "   "] -row $row -column 25
1448
1449                         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
1450                         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
1451                         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
1452                         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
1453                         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
1454                         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
1455                         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
1456                         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
1457
1458                         RB_TLS_Onoff $phasenum $main $bodnum $mapnum
1459
1460
1461#                         set col 4
1462                         set atomnum $::rb_map_beginning($phasenum,$bodnum,$mapnum)
1463#                         puts "first atom = $atomnum"
1464#                         set atomlist "atoms in rigid body #$bodnum:    "
1465                         set atomlist "atoms in rigid body:    "
1466                         for {set j 1} {$j <=$::rb_coord_num($bodnum,1)} {incr j} {
1467                             set atom [atominfo $phasenum $atomnum label]
1468                             lappend atomlist $atom
1469#                            grid [label $main.rb_site$phasenum$mapnum$j -text "$atom"] -row [expr $row +1] -column $col -padx 5
1470                             incr atomnum
1471#                             incr col
1472                        }
1473                        grid [label $main.rb_site$phasenum$mapnum$j -text "$atomlist"] -row [expr $row + 1] -column 4 -padx 5 -columnspan 999 -sticky w
1474                        incr row 2
1475                     }
1476                 }
1477             }
1478             ResizeScrollTable $con.info
1479             set ::rbaddresses [winfo children .refcon.info.can.f]
1480
1481             set ::rb_var_name "var$::varnum"
1482             set free "free"
1483             set const ""
1484
1485             grid [label $con.con.lbl -text "Set Variables Selected Below"] -row 1 -column 1
1486             grid [button $con.con.free -width 22 -text "Set Free Variable" -command {RB_Con_But_Proc $::rbaddresses free}] -row 2 -column 1
1487             grid [button $con.con.const -width 22 -text "Do Not Refine Variables" -command {RB_Con_But_Proc $::rbaddresses ""}] -row 3 -column 1
1488             grid [button $con.con.var -width 22 -text "Set Constrained Variables" -command {RB_Con_But_Proc $::rbaddresses $::rb_var_name; incr ::varnum; set ::rb_var_name "var$::varnum"}] -row 4 -column 1
1489             grid [entry $con.con.vare -textvariable ::rb_var_name -width 5] -row 4 -column 2
1490             grid [button $con.con.clear -width 22 -text "Clear All Variables" -command {RB_Variable_Clear}] -row 5 -column 1
1491             grid [button $con.terminate.save -width 22 -text "Assign Variables and Save" -command RB_Var_Assign] -row 5 -column 1
1492             grid [button $con.terminate.quit -width 22 -text "Quit" -command  {destroy .refcon}] -row 6 -column 1
1493
1494}
1495
1496proc RB_Variable_Clear {} {
1497     foreach var $::rb_var_list {
1498             set $var ""
1499     }
1500     foreach var $::rb_var_list_tls {
1501             set $var ""
1502     }
1503
1504}
1505
1506proc RB_Con_But_Proc {addresses change args} {
1507#     puts "$addresses $change"
1508     foreach address $addresses {
1509             set a [eval $address cget -bg]
1510             if {$a == "yellow"} {
1511                set var [eval $address cget -textvariable]
1512                set $var $change
1513                $address config -relief raised -bg lightgray
1514              }
1515     }
1516}
1517
1518#procedure to turn buttons on (sunken yellow) and off (lightgray raised).
1519proc RB_Con_Button {address args} {
1520     set a [eval $address cget -relief]
1521     if {$a == "raised"} {
1522        $address config -relief sunken -bg yellow
1523     }
1524     if {$a == "sunken"} {
1525        $address config -relief raised
1526        $address config -bg lightgray
1527     }
1528}
1529
1530
1531
1532#procedure to determine next available variable number for GSAS
1533proc RB_Var_Gen {varcount args} {
1534     while {[lsearch $::rb_varlist $varcount] != -1} {incr varcount}
1535     lappend ::rb_varlist $varcount
1536     return $varcount
1537}
1538
1539#procedure to assign variable names to relationships
1540proc RB_Var_Assign {args} {
1541     set ::rb_varlist [RigidBodyGetVarNums]
1542     set varcount 1
1543     set varlist ""
1544     catch {array unset rb_var_temp}
1545     foreach var $::rb_var_list {
1546            if {[set $var] == ""} {
1547               set $var 0
1548            } elseif {[set $var] == "free"} {
1549                     set $var [RB_Var_Gen $varcount]
1550                     set varcount [set $var]
1551            } else {
1552#                     puts [lsearch $varlist [set $var]]
1553                     if {[lsearch $varlist [set $var]] == -1} {
1554                        lappend varlist [set $var]
1555#                        puts $varlist
1556                        set rb_variable([set $var]) [RB_Var_Gen $varcount]
1557                        set $var $rb_variable([set $var])
1558
1559                     } else {
1560                        set $var $rb_variable([set $var])
1561                     }
1562             }
1563     }
1564
1565          foreach var $::rb_var_list_tls {
1566            if {[set $var] == ""} {
1567               set $var 0
1568            } elseif {[set $var] == "free"} {
1569                     set $var [RB_Var_Gen $varcount]
1570                     set varcount [set $var]
1571            } else {
1572#                     puts [lsearch $varlist [set $var]]
1573                     if {[lsearch $varlist [set $var]] == -1} {
1574                        lappend varlist [set $var]
1575#                        puts $varlist
1576                        set rb_variable([set $var]) [RB_Var_Gen $varcount]
1577                        set $var $rb_variable([set $var])
1578
1579                     } else {
1580                        set $var $rb_variable([set $var])
1581                     }
1582             }
1583     }
1584
1585     RB_Var_Save
1586     incr ::expgui(changed)
1587     destroy .refcon
1588}
1589
1590#procedure for enabling refinement flags
1591proc RB_Ref_FlagEnable {phasenum bodnum mapnum var val args} {
1592          set atomlist ""
1593          set atomnum $::rb_map_beginning($phasenum,$bodnum,$mapnum)
1594          for {set j 1} {$j <=$::rb_coord_num($bodnum,1)} {incr j} {
1595               lappend atomlist $atomnum
1596               incr atomnum
1597          }
1598          atominfo $phasenum $atomlist $var set $val
1599
1600 }
1601
1602
1603
1604
1605#procedure to send variable numbers to EXP file.
1606proc RB_Var_Save {args} {
1607
1608     #Determine number of rigid bodies and rigid body mappings
1609     set rb_num [RigidBodyList]
1610     foreach phasenum $::expmap(phaselist) {
1611          foreach bodnum $rb_num {
1612               set rb_map_num($phasenum,$bodnum) [RigidBodyMappingList $phasenum $bodnum]
1613               foreach mapnum $rb_map_num($phasenum,$bodnum) {
1614                       set refcoordflag 0
1615                       set reftlsflag 0
1616                       set rb_list "$::rb_var($phasenum,$bodnum,$mapnum,x) \
1617                           $::rb_var($phasenum,$bodnum,$mapnum,y) $::rb_var($phasenum,$bodnum,$mapnum,z) \
1618                           $::rb_var($phasenum,$bodnum,$mapnum,e1) $::rb_var($phasenum,$bodnum,$mapnum,e2) \
1619                           $::rb_var($phasenum,$bodnum,$mapnum,e3) 0 0 0"
1620                       RigidBodyVary $phasenum $bodnum $mapnum $rb_list
1621
1622                       foreach test $rb_list {
1623                            if {$test != 0} {
1624                               set refcoordflag 1
1625                            }
1626                       }
1627                          RB_Ref_FlagEnable $phasenum $bodnum $mapnum xref $refcoordflag
1628
1629                       if {$::rb_var($phasenum,$bodnum,$mapnum,tls) == 1} {
1630                           set rb_tls "$::rb_var($phasenum,$bodnum,$mapnum,t11) $::rb_var($phasenum,$bodnum,$mapnum,t22) \
1631                               $::rb_var($phasenum,$bodnum,$mapnum,t33) $::rb_var($phasenum,$bodnum,$mapnum,t12) \
1632                               $::rb_var($phasenum,$bodnum,$mapnum,t13) $::rb_var($phasenum,$bodnum,$mapnum,t23) \
1633                               $::rb_var($phasenum,$bodnum,$mapnum,l11) $::rb_var($phasenum,$bodnum,$mapnum,l22) \
1634                               $::rb_var($phasenum,$bodnum,$mapnum,l33) $::rb_var($phasenum,$bodnum,$mapnum,l12) \
1635                               $::rb_var($phasenum,$bodnum,$mapnum,l13) $::rb_var($phasenum,$bodnum,$mapnum,l23) \
1636                               $::rb_var($phasenum,$bodnum,$mapnum,s12) $::rb_var($phasenum,$bodnum,$mapnum,s13) \
1637                               $::rb_var($phasenum,$bodnum,$mapnum,s21) $::rb_var($phasenum,$bodnum,$mapnum,s23) \
1638                               $::rb_var($phasenum,$bodnum,$mapnum,s31) $::rb_var($phasenum,$bodnum,$mapnum,s32) \
1639                               $::rb_var($phasenum,$bodnum,$mapnum,saa) $::rb_var($phasenum,$bodnum,$mapnum,sbb)"
1640                           puts "TLS param save for $rb_tls"
1641                           RigidBodyTLSVary $phasenum $bodnum $mapnum $rb_tls
1642
1643                           foreach test $rb_tls {
1644                            if {$test != 0} {
1645                               set reftlsflag 1
1646                            }
1647                       }
1648                          RB_Ref_FlagEnable $phasenum $bodnum $mapnum uref $reftlsflag
1649                       }
1650                       incr ::expgui(changed)
1651
1652               }
1653          }
1654#     puts "phasenumber is $phasenum"
1655     DisplayAllAtoms $phasenum
1656#need to track body number from button on notebook page.  Below is a temporary fix
1657      RB_Control_Panel $::rb_panel
1658#     RB_Populate $::rb_notebook 1
1659     }
1660}
1661
1662# procedure to turn tls buttons on or off
1663proc RB_TLS_Onoff {phasenum main bodnum mapnum} {
1664
1665      lappend tlsparam $main.t11ref($phasenum,$bodnum,$mapnum) $main.t22ref($phasenum,$bodnum,$mapnum) $main.t33ref($phasenum,$bodnum,$mapnum) \
1666              $main.t12ref($phasenum,$bodnum,$mapnum) $main.t13ref($phasenum,$bodnum,$mapnum) $main.t23ref($phasenum,$bodnum,$mapnum) \
1667              $main.l11ref($phasenum,$bodnum,$mapnum) $main.l22ref($phasenum,$bodnum,$mapnum) $main.l33ref($phasenum,$bodnum,$mapnum) \
1668              $main.l12ref($phasenum,$bodnum,$mapnum) $main.l13ref($phasenum,$bodnum,$mapnum) $main.l23ref($phasenum,$bodnum,$mapnum) \
1669              $main.s12ref($phasenum,$bodnum,$mapnum) $main.s13ref($phasenum,$bodnum,$mapnum) $main.s21ref($phasenum,$bodnum,$mapnum) \
1670              $main.s23ref($phasenum,$bodnum,$mapnum) $main.s31ref($phasenum,$bodnum,$mapnum) $main.s32ref($phasenum,$bodnum,$mapnum) \
1671              $main.saaref($phasenum,$bodnum,$mapnum) $main.sbbref($phasenum,$bodnum,$mapnum)
1672#      puts $tlsparam
1673              if {$::rb_var($phasenum,$bodnum,$mapnum,tls) == 0} {
1674                        RigidBodyEnableTLS $phasenum $bodnum $mapnum 0
1675                        foreach x $tlsparam {
1676                                $x config -state disable -relief sunken
1677                        }
1678              } else {
1679                        RigidBodyEnableTLS $phasenum $bodnum $mapnum 1
1680                        foreach x $tlsparam {
1681                                $x config -state normal -relief raised
1682                        }
1683              }
1684}
1685
1686
1687
1688
1689
1690proc RB_Load_Vars {phasenum bodnum mapnum args} {
1691     foreach var $::rb_map_positionvars($phasenum,$bodnum,$mapnum) {
1692             catch {unset temp($var)}
1693     }
1694
1695     foreach var $::rb_map_positionvars($phasenum,$bodnum,$mapnum) {
1696             if {[info exists temp($var)] == "0"} {
1697                set temp($var) $var
1698                } else {
1699                  lappend mulvarlist $var
1700             }
1701     }
1702
1703          foreach var $::rb_map_tls_var($phasenum,$bodnum,$mapnum) {
1704             if {[info exists temp($var)] == "0"} {
1705                set temp($var) $var
1706                } else {
1707                  lappend mulvarlist $var
1708             }
1709          }
1710
1711
1712
1713     set ::rb_var($phasenum,$bodnum,$mapnum,x) [RB_VarSet [lindex $::rb_map_positionvars($phasenum,$bodnum,$mapnum) 0] $mulvarlist]
1714     set ::rb_var($phasenum,$bodnum,$mapnum,y) [RB_VarSet [lindex $::rb_map_positionvars($phasenum,$bodnum,$mapnum) 1] $mulvarlist]
1715     set ::rb_var($phasenum,$bodnum,$mapnum,z) [RB_VarSet [lindex $::rb_map_positionvars($phasenum,$bodnum,$mapnum) 2] $mulvarlist]
1716
1717     lappend ::rb_var_list ::rb_var($phasenum,$bodnum,$mapnum,x) ::rb_var($phasenum,$bodnum,$mapnum,y) ::rb_var($phasenum,$bodnum,$mapnum,z)
1718
1719     set ::rb_var($phasenum,$bodnum,$mapnum,e1) [RB_VarSet [lindex $::rb_map_positionvars($phasenum,$bodnum,$mapnum) 3] $mulvarlist]
1720     set ::rb_var($phasenum,$bodnum,$mapnum,e2) [RB_VarSet [lindex $::rb_map_positionvars($phasenum,$bodnum,$mapnum) 4] $mulvarlist]
1721     set ::rb_var($phasenum,$bodnum,$mapnum,e3) [RB_VarSet [lindex $::rb_map_positionvars($phasenum,$bodnum,$mapnum) 5] $mulvarlist]
1722
1723     lappend ::rb_var_list ::rb_var($phasenum,$bodnum,$mapnum,e1) ::rb_var($phasenum,$bodnum,$mapnum,e2) ::rb_var($phasenum,$bodnum,$mapnum,e3)
1724
1725     if {$::rb_map_tls_var($phasenum,$bodnum,$mapnum) != ""} {
1726
1727
1728          set ::rb_var($phasenum,$bodnum,$mapnum,t11) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 0] $mulvarlist]
1729          set ::rb_var($phasenum,$bodnum,$mapnum,t22) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 1] $mulvarlist]
1730          set ::rb_var($phasenum,$bodnum,$mapnum,t33) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 2] $mulvarlist]
1731          set ::rb_var($phasenum,$bodnum,$mapnum,t12) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 3] $mulvarlist]
1732          set ::rb_var($phasenum,$bodnum,$mapnum,t13) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 4] $mulvarlist]
1733          set ::rb_var($phasenum,$bodnum,$mapnum,t23) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 5] $mulvarlist]
1734
1735          lappend ::rb_var_list_tls ::rb_var($phasenum,$bodnum,$mapnum,t11) ::rb_var($phasenum,$bodnum,$mapnum,t22) ::rb_var($phasenum,$bodnum,$mapnum,t33)
1736          lappend ::rb_var_list_tls ::rb_var($phasenum,$bodnum,$mapnum,t12) ::rb_var($phasenum,$bodnum,$mapnum,t13) ::rb_var($phasenum,$bodnum,$mapnum,t23)
1737
1738          set ::rb_var($phasenum,$bodnum,$mapnum,l11) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 6] $mulvarlist]
1739          set ::rb_var($phasenum,$bodnum,$mapnum,l22) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 7] $mulvarlist]
1740          set ::rb_var($phasenum,$bodnum,$mapnum,l33) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 8] $mulvarlist]
1741          set ::rb_var($phasenum,$bodnum,$mapnum,l12) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 9] $mulvarlist]
1742          set ::rb_var($phasenum,$bodnum,$mapnum,l13) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 10] $mulvarlist]
1743          set ::rb_var($phasenum,$bodnum,$mapnum,l23) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 11] $mulvarlist]
1744
1745          lappend ::rb_var_list_tls ::rb_var($phasenum,$bodnum,$mapnum,l11) ::rb_var($phasenum,$bodnum,$mapnum,l22) ::rb_var($phasenum,$bodnum,$mapnum,l33)
1746          lappend ::rb_var_list_tls ::rb_var($phasenum,$bodnum,$mapnum,l12) ::rb_var($phasenum,$bodnum,$mapnum,l13) ::rb_var($phasenum,$bodnum,$mapnum,l23)
1747
1748          set ::rb_var($phasenum,$bodnum,$mapnum,s12) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 12] $mulvarlist]
1749          set ::rb_var($phasenum,$bodnum,$mapnum,s13) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 13] $mulvarlist]
1750          set ::rb_var($phasenum,$bodnum,$mapnum,s21) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 14] $mulvarlist]
1751          set ::rb_var($phasenum,$bodnum,$mapnum,s23) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 15] $mulvarlist]
1752          set ::rb_var($phasenum,$bodnum,$mapnum,s31) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 16] $mulvarlist]
1753          set ::rb_var($phasenum,$bodnum,$mapnum,s32) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 17] $mulvarlist]
1754          set ::rb_var($phasenum,$bodnum,$mapnum,saa) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 18] $mulvarlist]
1755          set ::rb_var($phasenum,$bodnum,$mapnum,sbb) [RB_VarSet [lindex $::rb_map_tls_var($phasenum,$bodnum,$mapnum) 19] $mulvarlist]
1756
1757          lappend ::rb_var_list_tls ::rb_var($phasenum,$bodnum,$mapnum,s12) ::rb_var($phasenum,$bodnum,$mapnum,s13) ::rb_var($phasenum,$bodnum,$mapnum,s21)
1758          lappend ::rb_var_list_tls ::rb_var($phasenum,$bodnum,$mapnum,s23) ::rb_var($phasenum,$bodnum,$mapnum,s31) ::rb_var($phasenum,$bodnum,$mapnum,s32)
1759          lappend ::rb_var_list_tls ::rb_var($phasenum,$bodnum,$mapnum,saa) ::rb_var($phasenum,$bodnum,$mapnum,sbb)
1760
1761          set ::rb_var($phasenum,$bodnum,$mapnum,tls) 1
1762
1763     } else {
1764          set ::rb_var($phasenum,$bodnum,$mapnum,t11) ""
1765          set ::rb_var($phasenum,$bodnum,$mapnum,t22) ""
1766          set ::rb_var($phasenum,$bodnum,$mapnum,t33) ""
1767          set ::rb_var($phasenum,$bodnum,$mapnum,t12) ""
1768          set ::rb_var($phasenum,$bodnum,$mapnum,t13) ""
1769          set ::rb_var($phasenum,$bodnum,$mapnum,t23) ""
1770
1771          lappend ::rb_var_list_tls ::rb_var($phasenum,$bodnum,$mapnum,t11) ::rb_var($phasenum,$bodnum,$mapnum,t22) ::rb_var($phasenum,$bodnum,$mapnum,t33)
1772          lappend ::rb_var_list_tls ::rb_var($phasenum,$bodnum,$mapnum,t12) ::rb_var($phasenum,$bodnum,$mapnum,t13) ::rb_var($phasenum,$bodnum,$mapnum,t23)
1773
1774          set ::rb_var($phasenum,$bodnum,$mapnum,l11) ""
1775          set ::rb_var($phasenum,$bodnum,$mapnum,l22) ""
1776          set ::rb_var($phasenum,$bodnum,$mapnum,l33) ""
1777          set ::rb_var($phasenum,$bodnum,$mapnum,l12) ""
1778          set ::rb_var($phasenum,$bodnum,$mapnum,l13) ""
1779          set ::rb_var($phasenum,$bodnum,$mapnum,l23) ""
1780
1781          lappend ::rb_var_list_tls ::rb_var($phasenum,$bodnum,$mapnum,l11) ::rb_var($phasenum,$bodnum,$mapnum,l22) ::rb_var($phasenum,$bodnum,$mapnum,l33)
1782          lappend ::rb_var_list_tls ::rb_var($phasenum,$bodnum,$mapnum,l12) ::rb_var($phasenum,$bodnum,$mapnum,l13) ::rb_var($phasenum,$bodnum,$mapnum,l23)
1783
1784          set ::rb_var($phasenum,$bodnum,$mapnum,s12) ""
1785          set ::rb_var($phasenum,$bodnum,$mapnum,s13) ""
1786          set ::rb_var($phasenum,$bodnum,$mapnum,s21) ""
1787          set ::rb_var($phasenum,$bodnum,$mapnum,s23) ""
1788          set ::rb_var($phasenum,$bodnum,$mapnum,s31) ""
1789          set ::rb_var($phasenum,$bodnum,$mapnum,s32) ""
1790          set ::rb_var($phasenum,$bodnum,$mapnum,saa) ""
1791          set ::rb_var($phasenum,$bodnum,$mapnum,sbb) ""
1792
1793          lappend ::rb_var_list_tls ::rb_var($phasenum,$bodnum,$mapnum,s12) ::rb_var($phasenum,$bodnum,$mapnum,s13) ::rb_var($phasenum,$bodnum,$mapnum,s21)
1794          lappend ::rb_var_list_tls ::rb_var($phasenum,$bodnum,$mapnum,s23) ::rb_var($phasenum,$bodnum,$mapnum,s31) ::rb_var($phasenum,$bodnum,$mapnum,s32)
1795          lappend ::rb_var_list_tls ::rb_var($phasenum,$bodnum,$mapnum,saa) ::rb_var($phasenum,$bodnum,$mapnum,sbb)
1796
1797          set ::rb_var($phasenum,$bodnum,$mapnum,tls) 0
1798     }
1799
1800}
1801
1802proc RB_VarSet {varin mulvarlist args} {
1803     if {$varin == 0} {set varout ""
1804        } else {
1805          set temp [lsearch $mulvarlist $varin]
1806          if {$temp == "-1"} {set varout "free"
1807                 } else {
1808                   set varout var$varin
1809              }
1810     }
1811     return $varout
1812}
1813#RB_Refine_Con - sets matrix to set refinement constrols
1814#RB_Var_Assign - assigns variable numbers to refinement parameters
1815#RB_Var_Set    - sends variable numbers back to EXP file.
Note: See TracBrowser for help on using the repository browser.