Context Navigation

← Previous Revision
Next Revision →
Blame
Revision Log

source: trunk/addcmds.tcl

Last change on this file was 1251, checked in by toby, 7 years ago
use svn ps svn:eol-style "native" * to change line ends
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Revision Id`
File size: 94.3 KB

Line
1	# $Id: addcmds.tcl 1251 2014-03-10 22:17:29Z toby $
2
3	#----------- Add Phase routines ----------------------------------------
4
5	proc MakeAddPhaseBox {} {
6	global expmap expgui
7
8	set expgui(coordList) {}
9	set nextphase ""
10	foreach p {1 2 3 4 5 6 7 8 9} {
11	if {[lsearch $expmap(phaselist) $p] == -1} {
12	set nextphase $p
13	break
14	}
15	}
16
17	# no more room
18	if {$nextphase == ""} {
19	MyMessageBox -parent . -title "Add Phase Error" \
20	-message "There are already 9 phases. You cannot add more." \
21	-icon error
22	return
23	}
24
25	set np .newphase
26	catch {destroy $np}
27	toplevel $np
28	bind $np <Key-F1> "MakeWWWHelp expgui2.html addphase"
29
30	grid [label $np.l1 -text "Adding phase #$nextphase"] \
31	-column 0 -row 0 -sticky w
32	grid [label $np.l2 -text "Phase title:"] -column 0 -row 1
33	grid [entry $np.t1 -width 68] -column 1 -row 1 -columnspan 8
34	grid [label $np.l3 -text "Space Group:"] -column 0 -row 2
35	grid [entry $np.t2 -width 12] -column 1 -row 2
36	grid [frame $np.ct -bd 2 -relief groove] -column 3 -row 2
37	grid [frame $np.f -bd 4 -relief groove] -column 4 -row 2 -columnspan 8
38	grid [label $np.ct.l -text "Cell\nType"] -column 0 -row 2
39	set menu [tk_optionMenu $np.ct.s expgui(addPhaseCellType) ""]
40	$menu delete 0
41	foreach val {Any Cubic Tetragonal Hexagonal Rhombohedral Orthorhombic Monoclinic} \
42	lbl {Any Cubic Tetrag Hexag Rhomb. Ortho Mono} {
43	$menu add radiobutton -value $lbl -label $val \
44	-command "set expgui(addPhaseCellType) $lbl"
45	}
46	grid $np.ct.s
47	foreach v [ trace vinfo expgui(addPhaseCellType)] {
48	eval trace vdelete expgui(addPhaseCellType) $v
49	}
50	#set expgui(addPhaseCellType) Any
51	$menu invoke 0
52	trace variable expgui(addPhaseCellType) w "SetAddCellSymConstr $np.f"
53
54	set col -1
55	foreach i {a b c} {
56	grid [label $np.f.l1$i -text " $i "] -column [incr col] -row 1
57	grid [entry $np.f.e1$i -width 12] -column [incr col] -row 1
58	}
59	set col -1
60	foreach i {a b g} {
61	grid [label $np.f.l2$i -text $i] -column [incr col] -row 2
62	set font [$np.f.l2$i cget -font]
63	$np.f.l2$i config -font "Symbol [lrange $font 1 end]"
64	grid [entry $np.f.e2$i -width 12] -column [incr col] -row 2
65	$np.f.e2$i insert 0 90.
66	}
67
68	grid [frame $np.bf] -row 3 -column 0 -columnspan 10 -sticky ew
69	grid [button $np.bf.b1 -text Add \
70	-command "addphase $np"] -column 2 -row 3
71	bind $np <Return> "addphase $np"
72	grid [button $np.bf.b2 -text Cancel \
73	-command "destroy $np"] -column 3 -row 3
74	grid columnconfig $np.bf 4 -weight 1
75	grid [button $np.bf.help -text Help -bg yellow \
76	-command "MakeWWWHelp expgui2.html addphase"] \
77	-column 4 -row 3
78
79	# get the input formats if not already defined
80	GetImportFormats
81	if {[llength $expgui(importFormatList)] > 0} {
82	grid [frame $np.bf.fr -bd 4 -relief groove] -column 5 -row 3
83	grid [button $np.bf.fr.b3 -text "Import phase from: " \
84	-command "ImportPhase \$expgui(importFormat) $np"] \
85	-column 0 -row 0 -sticky e
86	set menu [eval tk_optionMenu $np.bf.fr.b4 expgui(importFormat) \
87	$expgui(importFormatList)]
88	for {set i 0} {$i <= [$menu index end]} {incr i} {
89	$menu entryconfig $i -command "ImportPhase \$expgui(importFormat) $np"
90	}
91	grid $np.bf.fr.b4 -column 1 -row 0 -sticky w
92	grid rowconfig $np.bf.fr 0 -pad 10
93	grid columnconfig $np.bf.fr 0 -pad 10
94	grid columnconfig $np.bf.fr 1 -pad 10
95	}
96	wm title $np "add new phase"
97
98	# set grab, etc.
99	putontop $np
100
101	tkwait window $np
102
103	# fix grab...
104	afterputontop
105	}
106	proc SetAddCellSymConstr {box args} {
107	switch $::expgui(addPhaseCellType) {
108	Any {
109	foreach i {a b c} {
110	$box.e1$i configure -textvariable "" -state normal
111	}
112	foreach i {a b g} {
113	$box.e2$i configure -textvariable "" -state normal
114	}
115	}
116	Cubic {
117	set ::expgui(AddCella) [$box.e1a get]
118	foreach i {a b c} {
119	$box.e1$i configure -textvariable expgui(AddCella) -state normal
120	}
121	foreach i {a b g} {
122	$box.e2$i configure -textvariable "" -state normal
123	$box.e2$i delete 0 end
124	$box.e2$i insert 0 90.
125	$box.e2$i configure -textvariable "" -state disabled
126	}
127	}
128	Tetrag {
129	set ::expgui(AddCella) [$box.e1a get]
130	foreach i {a b} {
131	$box.e1$i configure -textvariable expgui(AddCella) -state normal
132	}
133	$box.e1c configure -textvariable "" -state normal
134	foreach i {a b g} {
135	$box.e2$i configure -textvariable "" -state normal
136	$box.e2$i delete 0 end
137	$box.e2$i insert 0 90.
138	$box.e2$i configure -textvariable "" -state disabled
139	}
140	}
141	Hexag {
142	set ::expgui(AddCella) [$box.e1a get]
143	foreach i {a b} {
144	$box.e1$i configure -textvariable expgui(AddCella) -state normal
145	}
146	$box.e1c configure -textvariable "" -state normal
147	foreach i {a b g} {
148	$box.e2$i configure -textvariable "" -state normal
149	$box.e2$i delete 0 end
150	if {$i == "g"} {
151	$box.e2$i insert 0 120.
152	} else {
153	$box.e2$i insert 0 90.
154	}
155	$box.e2$i configure -textvariable "" -state disabled
156	}
157	}
158	Rhomb. {
159	set ::expgui(AddCella) [$box.e1a get]
160	foreach i {a b c} {
161	$box.e1$i configure -textvariable expgui(AddCella) -state normal
162	}
163	set ::expgui(AddCellalpha) [$box.e2a get]
164	foreach i {a b g} {
165	$box.e2$i configure -textvariable expgui(AddCellalpha) -state normal
166	}
167	}
168	Ortho {
169	foreach i {a b c} {
170	$box.e1$i configure -textvariable "" -state normal
171	}
172	foreach i {a b g} {
173	$box.e2$i configure -textvariable "" -state normal
174	$box.e2$i delete 0 end
175	$box.e2$i insert 0 90.
176	$box.e2$i configure -textvariable "" -state disabled
177	}
178	}
179	Mono {
180	foreach i {a b c} {
181	$box.e1$i configure -textvariable "" -state normal
182	}
183	foreach i {a g} {
184	$box.e2$i configure -textvariable "" -state normal
185	$box.e2$i delete 0 end
186	$box.e2$i insert 0 90.
187	$box.e2$i configure -textvariable "" -state disabled
188	}
189	$box.e2b configure -textvariable "" -state normal
190	}
191	}
192	}
193
194
195	proc addphase {np} {
196	global expgui expmap
197	# validate the input
198	set err {}
199	set warn {}
200	set title [$np.t1 get]
201	if {[string trim $title] == ""} {
202	append err " Title cannot be blank\n"
203	}
204	set spg [$np.t2 get]
205	if {[string trim $spg] == ""} {
206	append err " Space group cannot be blank\n"
207	}
208	# check if standard and add spaces, as needed
209	if {[set nspg [CheckSpg $spg]] != ""} {
210	set spg $nspg
211	$np.t2 delete 0 end
212	$np.t2 insert end $nspg
213	}
214	foreach i {a b c} {
215	set cell($i) [$np.f.e1$i get]
216	if {[string trim $cell($i)] == ""} {
217	append err " $i cannot be blank\n"
218	} elseif {[catch {expr $cell($i)}]} {
219	append err " $i is not valid\n"
220	}
221	}
222
223	foreach i {a b g} lbl {alpha beta gamma} {
224	set cell($lbl) [$np.f.e2$i get]
225	if {[string trim $cell($lbl)] == ""} {
226	append err " $lbl cannot be blank\n"
227	} elseif {[catch {expr $cell($lbl)}]} {
228	append err " $lbl is not valid\n"
229	}
230	}
231
232	if {$expgui(addPhaseCellType) == "Rhomb."} {
233	# check for proper use of space group in Rhomb. setting
234	if {[string toupper [string range [string trim $spg] 0 0]] != "R"} {
235	append err "Rhombohedral cell specified, but space group does not start with R\n"
236	}
237	if {[string toupper [string range [string trim $spg] end end]] != "R"} {
238	append spg " R"
239	if {$err == ""} {
240	append warn "Note that a rhombohedral setting was used, the space group symbol ($spg) as been flagged accordingly\n"
241	}
242	}
243	}
244	if {$err != ""} {
245	MyMessageBox -parent . -title "Add Phase Error" \
246	-message "The following error(s) were found in your input:\n$err" \
247	-icon error
248	set expgui(oldphaselist) -1
249	return
250	}
251
252	# check the space group
253	set fp [open spg.in w]
254	puts $fp "N"
255	puts $fp "N"
256	puts $fp $spg
257	puts $fp "Q"
258	close $fp
259	global tcl_platform
260	catch {
261	if {$tcl_platform(platform) == "windows"} {
262	exec [file join $expgui(gsasexe) spcgroup.exe] < spg.in >& spg.out
263	} else {
264	exec [file join $expgui(gsasexe) spcgroup] < spg.in >& spg.out
265	}
266	}
267	set fp [open spg.out r]
268	set out [read $fp]
269	close $fp
270	# attempt to parse out the output (fix up if parse did not work)
271	if {[regexp "space group symbol.>(.)Enter a new space group symbol" \
272	$out a b ] != 1} {set b $out}
273	if {[string first Error $b] != -1} {
274	# got an error, show it
275	ShowBigMessage \
276	$np.error \
277	"Error processing space group\nReview error message below" \
278	$b OK "" 1
279	set expgui(oldphaselist) -1
280	return
281	} else {
282	# show the result and confirm
283	set opt [ShowBigMessage \
284	$np.check \
285	"Check the symmetry operators in the output below" \
286	$b \
287	{Continue Redo} ]
288	if {$opt > 1} {
289	set expgui(oldphaselist) -1
290	return
291	}
292	}
293	file delete spg.in spg.out
294	# ok do it!
295	set errmsg [runAddPhase $title $spg \
296	$cell(a) $cell(b) $cell(c) \
297	$cell(alpha) $cell(beta) $cell(gamma)]
298	RecordMacroEntry "runAddPhase [list $title] [list $spg] \
299	$cell(a) $cell(b) $cell(c) \
300	$cell(alpha) $cell(beta) $cell(gamma)" 0
301	destroy $np
302	if {$expgui(showexptool) \|\| $errmsg != ""} {
303	if {$errmsg != ""} {
304	set err 1
305	append errmsg "\n" $expgui(exptoolout)
306	} else {
307	set err 0
308	set errmsg $expgui(exptoolout)
309	}
310	set msg "Please review the result from adding the phase"
311	if { $errmsg != ""} {append msg "\nIt appears an error occurred!"}
312	ShowBigMessage $np $msg $errmsg OK "" $err
313	}
314	# set the powpref warning (2 = required)
315	set expgui(needpowpref) 2
316	set msg "A phase was added"
317	if {[string first $msg $expgui(needpowpref_why)] == -1} {
318	append expgui(needpowpref_why) "\t$msg\n"
319	}
320	# now select the new phase
321	set phase [lindex $expmap(phaselist) end]
322	SelectOnePhase $phase
323	SpaceGroupWarnings $warn $phase $spg
324	}
325
326	proc runAddPhase {title spg a b c alpha beta gamma} {
327	global expgui expmap tcl_platform
328	set fp [open exptool.in w]
329	puts $fp "P"
330	puts $fp $title
331	puts $fp $spg
332	puts $fp "$a $b $c $alpha $beta $gamma"
333	puts $fp "/"
334	close $fp
335	# Save the current exp file
336	savearchiveexp
337	# disable the file changed monitor
338	set expgui(expModifiedLast) 0
339	set expnam [file root [file tail $expgui(expfile)]]
340	# save the previous phase list
341	set expgui(oldphaselist) $expmap(phaselist)
342	set err [catch {
343	if {$tcl_platform(platform) == "windows"} {
344	exec [file join $expgui(gsasexe) exptool.exe] $expnam \
345	< exptool.in >& exptool.out
346	} else {
347	exec [file join $expgui(gsasexe) exptool] $expnam \
348	< exptool.in >& exptool.out
349	}
350	} errmsg]
351	# load the revised exp file
352	set oldphaselist $expmap(phaselist)
353	loadexp $expgui(expfile)
354	set fp [open exptool.out r]
355	set expgui(exptoolout) [read $fp]
356	close $fp
357	catch {file delete exptool.in exptool.out}
358
359	if {[llength $oldphaselist] == [llength $expmap(phaselist)]} {
360	set err 1
361	if {$errmsg == ""} {set errmsg "No phase added"}
362	}
363	if {$err} {
364	return $errmsg
365	} else {
366	return ""
367	}
368	}
369
370
371	#----------- Add Histogram routines --------------------------------------
372	proc LabelInstParm {args} {
373	global newhist
374	switch $newhist(insttype) {
375	TOF {
376	set newhist(instfiletext) "Neutron Time of Flight"
377	catch {
378	set b $newhist(setnum)
379	append newhist(instfiletext) ", 2theta = $newhist(inst${b}Angle)"
380	}
381	}
382	ED {set newhist(instfiletext) "X-ray Energy Dispersive"}
383	"CW X" {set newhist(instfiletext) "CW X-ray"}
384	"CW N" {set newhist(instfiletext) "CW Neutron"}
385	}
386	}
387	set newhist(LimitMode) 1
388	trace variable newhist(setnum) w LabelInstParm
389	trace variable newhist(LimitMode) w ClearHistLimit
390	set newhist(LimitMode_boxes) {}
391
392	proc ClearHistLimit {args} {
393	global newhist
394	if {$newhist(LimitMode) == 1} {return}
395	foreach box $newhist(LimitMode_boxes) {
396	catch {$box delete 0 end}
397	}
398	}
399
400	proc MakeAddHistBox {} {
401	global expmap newhist expgui
402
403	# --> should check here if room for another histogram, but only texture
404	# folks will ever need that
405
406
407	# set if the CIF import loads OK
408	set OK 1
409	catch {
410	if {[info procs ReadCIF4GSAS] == ""} {
411	set OK 0
412	source [file join $::expgui(scriptdir) cif2fxye.tcl]
413	}
414	} errmsg
415
416	set np .newhist
417	catch {destroy $np}
418	toplevel $np
419	bind $np <Key-F1> "MakeWWWHelp expgui3.html AddHist"
420
421	grid [label $np.l0 -text "Adding a new histogram"] \
422	-column 0 -row 0 -sticky ew -columnspan 7
423	grid [checkbutton $np.d0 -text "Dummy Histogram" -variable newhist(dummy) \
424	-command "PostInstBankopts $np" \
425	] -column 2 -row 0 -columnspan 99 -sticky e
426	grid [label $np.l1 -text "Data file:"] -column 0 -row 2
427	grid [label $np.t1 -textvariable newhist(rawfile) -bd 2 -relief ridge] \
428	-column 1 -row 2 -columnspan 3 -sticky ew
429	grid [button $np.b1 -text "Select File" \
430	-command "getrawfile $np" \
431	] -column 4 -row 2
432	if {$OK} {
433	grid [button $np.b1a -text "Import CIF" \
434	-command "ReadCIF4GSAS $np" \
435	] -column 5 -row 2
436	}
437
438	grid [label $np.lbank -text "Select bank" -anchor w] -column 1 -row 3 -sticky w
439	grid [frame $np.bank] -column 2 -row 3 -columnspan 7 -sticky ew
440
441	grid [label $np.l2 -text "Instrument\nParameter file:"] -column 0 -row 5
442	grid [label $np.t2 -textvariable newhist(instfile) -bd 2 -relief ridge] \
443	-column 1 -row 5 -columnspan 3 -sticky ew
444	grid [button $np.b2 -text "Select File" \
445	-command "getinstfile $np" \
446	] -column 4 -row 5
447	grid [button $np.edit -text "Edit file" \
448	-command {EditInstFile $newhist(instfile)}] \
449	-column 5 -row 5
450
451	grid [label $np.lset -text "Select set" -anchor w] -column 1 -row 6 -sticky w
452	grid [frame $np.set] -column 2 -row 6 -columnspan 7 -sticky ew
453	grid [label $np.t2a -textvariable newhist(instfiletext) \
454	-justify center -anchor center -fg blue] \
455	-column 0 -row 8 -columnspan 99 -sticky ew
456
457	grid [button $np.f6a -text "Run\nRAWPLOT" -command "RunRawplot $np"] \
458	-column 4 -row 18 -rowspan 2
459	grid [label $np.l3 -text "Usable data limit:"] -column 0 -row 18 -rowspan 3
460	grid [entry $np.e3 -width 12 -textvariable newhist(2tLimit) \
461	] -column 1 -row 18 -rowspan 3
462	grid [radiobutton $np.cb3 -text "d-min" -variable newhist(LimitMode) \
463	-value 0] -column 2 -row 18 -sticky w
464	grid [radiobutton $np.cb4 -textvariable newhist(limitLbl) \
465	-variable newhist(LimitMode) -anchor w -justify l \
466	-value 1] -column 2 -row 20 -sticky w
467	set newhist(LimitMode_boxes) $np.e3
468	grid [radiobutton $np.cb5 -text "Q-max" -variable newhist(LimitMode) \
469	-value 2] -column 2 -row 19 -sticky w
470	set newhist(limitLbl) "TOF-min\n2-Theta Max"
471	# spacers
472	grid [frame $np.sp0 -bg white] \
473	-columnspan 20 -column 0 -row 1 -sticky nsew -ipady 2
474	grid [frame $np.sp1 -bg white] \
475	-columnspan 20 -column 0 -row 4 -sticky nsew -ipady 2
476	grid [frame $np.sp2 -bg white] \
477	-columnspan 20 -column 0 -row 17 -sticky nsew -ipady 2
478	grid [frame $np.sp3 -bg white] \
479	-columnspan 20 -column 0 -row 98 -sticky nsew -ipady 2
480	grid [frame $np.f6] -column 0 -row 99 -columnspan 5 -sticky ew
481	grid [button $np.f6.b6a -text Add \
482	-command "addhist $np"] -column 0 -row 0
483	bind $np <Return> "addhist $np"
484	grid [button $np.f6.b6b -text Cancel \
485	-command "destroy $np"] -column 1 -row 0
486	grid [button $np.f6.b6c -text "Add multiple banks" \
487	-command "addMultiplehist $np" -state disabled] -column 2 -row 0
488	grid [button $np.f6.help -text Help -bg yellow \
489	-command "MakeWWWHelp expgui3.html AddHist"] \
490	-column 2 -row 0 -sticky e
491	grid columnconfigure $np.f6 2 -weight 1
492	grid columnconfigure $np 3 -weight 1
493
494	# dummy histogram stuff
495	frame $np.d1
496	grid [label $np.d1.l1 -text min] -column 1 -row 1
497	grid [label $np.d1.l2 -text max] -column 2 -row 1
498	grid [label $np.d1.l3 -text step] -column 3 -row 1
499	grid [label $np.d1.lu -text ""] -column 4 -row 1 -rowspan 2
500	grid [entry $np.d1.e1 -width 10 -textvariable newhist(tmin)] -column 1 -row 2
501	grid [entry $np.d1.e2 -width 10 -textvariable newhist(tmax)] -column 2 -row 2
502	grid [entry $np.d1.e3 -width 10 -textvariable newhist(tstep)] -column 3 -row 2
503	grid [label $np.d1.m1 -anchor w] -column 1 -row 3 -sticky ew
504	grid [label $np.d1.m2 -anchor w] -column 2 -row 3 -sticky ew
505	label $np.dl1 -text "Data range:"
506	label $np.dl2 -text "Allowed"
507	label $np.dl3 -text "\n" -justify left -fg blue
508	wm title $np "add new histogram"
509
510	set newhist(banknum) {}
511	set newhist(setnum) {}
512	if {[string trim $newhist(rawfile)] != {}} {
513	validaterawfile $np $newhist(rawfile)
514	}
515	if {[string trim $newhist(instfile)] != {}} {
516	validateinstfile $np $newhist(instfile)
517	}
518
519	PostInstBankopts $np
520	# set grab, etc.
521	putontop $np
522
523	tkwait window $np
524
525	# fix grab...
526	afterputontop
527	# if no histogram is selected, select the last
528	if {$expgui(curhist) == "" && $expmap(powderlist) != ""} {
529	$expgui(histFrame).hs.lbox select set end
530	set expgui(curhist) [$expgui(histFrame).hs.lbox curselection]
531	DisplayHistogram
532	}
533	}
534
535	# convert a file to Win-95 direct access -- this is not used anymore
536	proc WinCvt {file win} {
537	global expgui
538	if ![file exists $file] {
539	MyMessageBox -parent $win -title "Convert Error" \
540	-message "File $file does not exist" -icon error
541	return
542	}
543
544	set tmpname "[file join [file dirname $file] tempfile.xxx]"
545	set oldname "[file rootname $file].org"
546	if [file exists $oldname] {
547	set ans [MyMessageBox -parent $win -title "OK to overwrite?" \
548	-message "File [file tail $oldname] exists in [file dirname $oldname]. OK to overwrite?" \
549	-icon question -type yesno -default yes]
550	if {$ans == "no"} return
551	catch {file delete $oldname}
552	}
553
554	if [catch {
555	set in [open $file r]
556	# needed to test under UNIX
557	set out [open $tmpname w]
558	fconfigure $out -translation crlf
559	set len [gets $in line]
560	if {$len > 160} {
561	# this is an old-style UNIX file. Hope there are no control characters
562	set i 0
563	set j 79
564	while {$j < $len} {
565	puts $out [string range $line $i $j]
566	incr i 80
567	incr j 80
568	}
569	} else {
570	while {$len >= 0} {
571	append line " "
572	append line " "
573	set line [string range $line 0 79]
574	puts $out $line
575	set len [gets $in line]
576	}
577	}
578	close $in
579	close $out
580	file rename $file $oldname
581	file rename $tmpname $file
582	} errmsg] {
583	MyMessageBox -parent $win -title Notify \
584	-message "Error in conversion:\n$errmsg" -icon warning
585	}
586	return $file
587	}
588
589	proc getrawfile {np} {
590	global newhist tcl_platform
591	if {$tcl_platform(platform) == "windows"} {
592	set inp [
593	tk_getOpenFile -parent $np -initialfile $newhist(rawfile) -filetypes {
594	{"Data files" .GSAS} {"Data files" .GSA}
595	{"Data files" .RAW} {"Data files" .FXYE} {"All files" *}
596	}
597	]
598	} else {
599	set inp [
600	tk_getOpenFile -parent $np -initialfile $newhist(rawfile) -filetypes {
601	{"Data files" .GSA*} {"Data files" .RAW}
602	{"Data files" .gsa*} {"Data files" .raw} {"Data files" .fxye}
603	{"All files" *}
604	}
605	]
606	}
607	validaterawfile $np $inp
608	}
609
610	proc validaterawfile {np inp} {
611	global expgui newhist
612	if {$inp == ""} return
613	if [catch {set in [open $inp r]}] {
614	MyMessageBox -parent $np -title "Open error" \
615	-message "Unable to open file $inp" -icon error
616	return
617	}
618	set newhist(banklist) {}
619	foreach child [winfo children $np.bank] {destroy $child}
620	# is this a properly formatted file?
621	# -- are lines the correct length & terminated with a CR-LF?
622	fconfigure $in -translation lf
623	set i 0
624	while {[set len [gets $in line]] > 0} {
625	incr i
626	#if {$len != 81 \|\| [string range $line end end] != "\r"} {
627	# set ans [MyMessageBox -parent $np -title "Convert?" \
628	# -message "File $inp is not in the correct format for GSAS.\nOK to convert?" \
629	# -icon warning -type {OK Quit} -default OK]
630	# if {$ans == "ok"} {
631	# # convert and reopen the file
632	# close $in
633	# WinCvt $inp $np
634	# set i 0
635	# set in [open $inp r]
636	# fconfigure $in -translation lf
637	# set line {}
638	# } else {
639	# return
640	# }
641	#}
642	# scan for BANK lines
643	if {[string first BANK $line] == 0} {
644	scan $line "BANK%d" num
645	lappend newhist(banklist) $num
646	# compute last point
647	set tmin 0
648	set tmax 0
649	catch {
650	scan $line "BANK%d%d%d%s%f%f" num nchan nrec rest start step
651	set tmin [expr $start/100.]
652	set tmax [expr ($start + $step*($nchan-1))/100.]
653	}
654	set newhist(tmin$num) $tmin
655	set newhist(tmax$num) $tmax
656	}
657	# check for "Instrument parameter file" line
658	if {$i == 2 && [string first "Instrument parameter" $line] == 0} {
659	validateinstfile $np \
660	[file join [file dirname $inp] \
661	[string trim [string range $line 26 end]]]
662	}
663	}
664	# were banks found?
665	if {$newhist(banklist) == ""} {
666	MyMessageBox -parent $np -title "Read error" \
667	-message "File $inp has no BANK lines.\nThis is not a valid GSAS data file." \
668	-icon warning
669	return
670	}
671	# don't use a full path unless needed
672	if {[pwd] == [file dirname $inp]} {
673	set newhist(rawfile) [file tail $inp]
674	} else {
675	set newhist(rawfile) $inp
676	}
677	set row 0
678	set col -1
679	set flag 0
680	foreach i $newhist(banklist) {
681	if {$col > 8} {
682	set col -1
683	incr row
684	}
685	grid [radiobutton $np.bank.$i -text $i -command SetDefaultBank \
686	-variable newhist(banknum) -value $i] \
687	-column [incr col] -row $row -sticky w
688	}
689	# if only 1 choice, set it
690	if {[llength $newhist(banklist)] == 1} {
691	set newhist(banknum) $i
692	SetDefaultBank
693	} else {
694	set flag 1
695	}
696	if {$flag} {
697	set newhist(2tLimit) {}
698	}
699	SetMultipleAdd $np
700	}
701
702	proc SetDefaultBank {} {
703	# set the default instrument parameter set to follow the bank # when the
704	# numbers of banks in each place agree. Do this when the data bank # is set
705	global newhist
706	if {[llength $newhist(banklist)] == $newhist(instbanks)} {
707	set newhist(setnum) $newhist(banknum)
708	}
709	SetTmax
710	}
711
712	proc SetTmax {} {
713	# set the default data range when the data or instrument parameter set is changed
714	global newhist
715	# mode must be t-max or 2theta, at least for now
716	if {$newhist(LimitMode) != 1} return
717	# get data bank number, test if valid
718	set num $newhist(banknum)
719	if {[catch {expr $num}]} {return}
720	if {$newhist(insttype) == "TOF"} {
721	# is a instrument parameter file loaded? If not, try again later
722	if {[string trim $newhist(instfile)] == ""} return
723	set newhist(2tLimit) [expr {$newhist(tmin$num) / 10.}]
724	# at Ashfia's request, override the bank header # with the
725	# value from the instrument parameter file.
726	catch {
727	set s $newhist(setnum)
728	foreach {x tmin tmax x} $newhist(inst${s}ITYP) {}
729	if {$tmin > 0} {set newhist(2tLimit) $tmin}
730	}
731	} else {
732	set newhist(2tLimit) $newhist(tmax$num)
733	}
734	}
735
736	proc getinstfile {np} {
737	global newhist tcl_platform
738	if {$tcl_platform(platform) == "windows"} {
739	set inp [
740	tk_getOpenFile -parent $np -initialfile $newhist(instfile) -filetypes {
741	{"Inst files" .INST} {"Inst files" .INS}
742	{"Inst files" .PRM} {"All files" *}
743	}
744	]
745	} else {
746	set inp [
747	tk_getOpenFile -parent $np -initialfile $newhist(instfile) -filetypes {
748	{"Inst files" .INS} {"Inst files" .ins}
749	{"Inst files" .PRM} {"Inst files" .prm}
750	{"All files" *}
751	}
752	]
753	}
754	set newhist(setnum) {}
755	validateinstfile $np $inp
756	}
757
758	proc validateinstfile {np inp} {
759	global expgui newhist
760	if {$inp == ""} return
761	if [catch {set in [open $inp r]}] {
762	MyMessageBox -parent $np -title "Open error" \
763	-message "Unable to open file $inp" -icon error
764	return
765	}
766	set newhist(instbanks) {}
767	foreach child [winfo children $np.set] {destroy $child}
768	# is this a properly formatted file?
769	# -- are lines the correct length & terminated with a CR-LF?
770	fconfigure $in -translation lf
771	while {[set len [gets $in line]] >= 0} {
772	#if {$len != 81 \|\| [string range $line end end] != "\r"} {
773	# set ans [MyMessageBox -parent $np -title "Convert?" \
774	# -message "File $inp is not in the correct format for GSAS.\nOK to convert?" \
775	# -icon warning -type {OK Quit} -default OK]
776	# if {$ans == "ok"} {
777	# convert and reopen the file
778	# close $in
779	# WinCvt $inp $np
780	# set in [open $inp r]
781	# fconfigure $in -translation lf
782	# set line {}
783	# } else {
784	# return
785	# }
786	#}
787	# scan for the INS BANK line
788	if {[string first "INS BANK" $line] == 0} {
789	set newhist(instbanks) \
790	[string trim [string range $line 12 end]]
791	}
792	# scan for the INS HTYPE line
793	if {[string first "INS HTYPE" $line] == 0} {
794	if {[string index [lindex $line 2] 2] == "T"} {
795	set newhist(insttype) TOF
796	} elseif {[string index [lindex $line 2] 2] == "E"} {
797	set newhist(insttype) ED
798	} elseif {[string index [lindex $line 2] 1] == "X"} {
799	set newhist(insttype) "CW X"
800	} else {
801	set newhist(insttype) "CW N"
802	}
803	}
804	# scan for the instrument constants
805	if {[regexp {INS ([ 1-9][0-9]) ICONS(.*)} $line a b c]} {
806	set b [string trim $b]
807	set newhist(inst${b}ICONS) [string trim $c]
808	}
809	if {[regexp {INS ([ 1-9][0-9])I ITYP(.*)} $line a b c]} {
810	set b [string trim $b]
811	set newhist(inst${b}ITYP) [string trim $c]
812	}
813	if {[regexp {INS ([ 1-9][0-9])BNKPAR(.*)} $line a b c]} {
814	set b [string trim $b]
815	set newhist(inst${b}Angle) [string trim [lindex $c 1]]
816	}
817	}
818	# were banks found?
819	if {$newhist(instbanks) == ""} {
820	MyMessageBox -parent $np -title "Read error" -message \
821	"File $inp has no \"INS BANK\" line.\nThis is not a valid GSAS Instrument Parameter file." \
822	-icon warning
823	return
824	}
825	# don't use a full path unless needed
826	if {[pwd] == [file dirname $inp]} {
827	set newhist(instfile) [file tail $inp]
828	} else {
829	set newhist(instfile) $inp
830	}
831	set col -1
832	set row 0
833	for {set i 1} {$i <= $newhist(instbanks)} {incr i} {
834	if {$col > 8} {
835	set col -1
836	incr row
837	}
838	grid [radiobutton $np.set.$i -text $i \
839	-command "PostInstBankopts $np; ValidateDummyHist $np" \
840	-variable newhist(setnum) -value $i] \
841	-column [incr col] -row $row -sticky w
842	if {$newhist(instbanks) == 1} {set newhist(setnum) $i}
843	}
844	if {$newhist(dummy)} {PostInstBankopts $np; ValidateDummyHist $np}
845	LabelInstParm
846	SetMultipleAdd $np
847	}
848
849	proc addhist {np} {
850	global expgui newhist tcl_platform expmap
851	if {$newhist(dummy)} {
852	AddDummyHist $np
853	return
854	}
855	# validate the input
856	set err {}
857	if {[string trim $newhist(rawfile)] == ""} {
858	append err " No data file specified\n"
859	}
860	if {[string trim $newhist(instfile)] == ""} {
861	append err " No instrument parameter file specified\n"
862	}
863	if {[string trim $newhist(banknum)] == ""} {
864	append err " Bank number must be specified\n"
865	} elseif {[catch {expr $newhist(banknum)}]} {
866	append err " Bank number is not valid\n"
867	}
868	if {[string trim $newhist(setnum)] == ""} {
869	append err " Parameter set number must be specified\n"
870	} elseif {[catch {expr $newhist(setnum)}]} {
871	append err " Parameter set number is not valid\n"
872	}
873	if {[string trim $newhist(2tLimit)] == ""} {
874	append err " 2Theta/d-space limit must be specified\n"
875	} elseif {[catch {expr $newhist(2tLimit)}]} {
876	append err " The 2Theta/d-space limit is not valid\n"
877	} elseif {$newhist(2tLimit) <= 0} {
878	append err " The 2Theta/d-space limit is not valid\n"
879	}
880	if {[string trim $newhist(LimitMode)] == ""} {
881	append err " Please choose between either a 2Theta, Q or d-space limit\n"
882	}
883
884	if {$err != ""} {
885	MyMessageBox -parent $np -title "Add Histogram Error" \
886	-message "The following error(s) were found in your input:\n$err" \
887	-icon error -type ok -default ok \
888	-helplink "expgui3.html AddHistErr"
889	return
890	}
891
892	if {$newhist(LimitMode) == 1} {
893	set mode "T"
894	set value $newhist(2tLimit)
895	} elseif {$newhist(LimitMode) == 2} {
896	set mode "D"
897	set Q 100
898	catch {set Q [expr {4*acos(0)/$newhist(2tLimit)}]}
899	set value $Q
900	} else {
901	set mode "D"
902	set value $newhist(2tLimit)
903	}
904
905	# ok do it!
906	set errmsg [runAddHist $newhist(rawfile) $newhist(instfile) $newhist(banknum) $newhist(setnum) $mode $value]
907	# save call to Macro file
908	RecordMacroEntry "runAddHist [list $newhist(rawfile)] [list $newhist(instfile)] $newhist(banknum) $newhist(setnum) $mode $value" 0
909
910	destroy $np
911	if {$expgui(showexptool) \|\| $errmsg != ""} {
912	if {$errmsg != ""} {
913	set errcode 1
914	append errmsg "\n" $expgui(exptoolout)
915	set err "error"
916	} else {
917	set errcode 0
918	set errmsg $expgui(exptoolout)
919	}
920	set msg "Please review the result from adding the histogram"
921	if {$errmsg != ""} {append msg "\nIt appears an error occurred!"}
922	ShowBigMessage $np $msg $errmsg OK "" $errcode
923	}
924	# select the most recently added histogram
925	if {$err != ""} {
926	# set the powpref warning (2 = required)
927	set expgui(needpowpref) 2
928	set msg "A histogram was added"
929	if {[string first $msg $expgui(needpowpref_why)] == -1} {
930	append expgui(needpowpref_why) "\t$msg\n"
931	}
932	set i [llength $expmap(histlistboxcontents)]
933	if {$i > 0} {
934	incr i -1
935	set expgui(curhist) $i
936	sethistlist
937	}
938	}
939	}
940	proc runAddHist {rawfile instfile banknum setnum mode value} {
941	global expgui expmap tcl_platform
942	set fp [open exptool.in w]
943	puts $fp "H"
944	if {$tcl_platform(platform) == "windows"} {
945	if {[string length $rawfile] > 50} {
946	puts $fp [file attributes $rawfile -shortname]
947	} else {
948	puts $fp $rawfile
949	}
950	if {[string length $instfile] > 50} {
951	puts $fp [file attributes $instfile -shortname]
952	} else {
953	puts $fp $instfile
954	}
955	} else {
956	puts $fp $rawfile
957	puts $fp $instfile
958	}
959	puts $fp $banknum
960	puts $fp $setnum
961	puts $fp $mode
962	puts $fp "$value"
963	puts $fp "/"
964	puts $fp "X"
965	puts $fp "X"
966	close $fp
967	# Save the current exp file
968	savearchiveexp
969	# disable the file changed monitor
970	set expgui(expModifiedLast) 0
971	set expnam [file root [file tail $expgui(expfile)]]
972	set err [catch {
973	if {$tcl_platform(platform) == "windows"} {
974	exec [file join $expgui(gsasexe) exptool.exe] $expnam \
975	< exptool.in >& exptool.out
976	} else {
977	exec [file join $expgui(gsasexe) exptool] $expnam \
978	< exptool.in >& exptool.out
979	}
980	} errmsg]
981	# load the revised exp file
982	set oldpowderlist $expmap(powderlist)
983	loadexp $expgui(expfile)
984	if {[llength $oldpowderlist] == [llength $expmap(powderlist)]} {
985	append errmsg "\nNo histogram added"
986	set err 1
987	}
988	set fp [open exptool.out r]
989	set expgui(exptoolout) [read $fp]
990	close $fp
991	catch {file delete exptool.in exptool.out}
992	if {$err} {
993	return $errmsg
994	} else {
995	return ""
996	}
997	}
998
999	proc RunRawplot {parent} {
1000	global newhist tcl_platform
1001	set f1 $newhist(rawfile)
1002	set f2 $newhist(instfile)
1003	# for Windows put a message on top, in case file names must be shortened
1004	if {$tcl_platform(platform) == "windows"} {
1005	catch {set f1 [file nativename \
1006	[file attributes $newhist(rawfile) -shortname]]}
1007	catch {set f2 [file nativename \
1008	[file attributes $newhist(instfile) -shortname]]}
1009	}
1010	if {$f1 != "" \|\| $f2 != ""} {
1011	#set msg "Note: input to RAWPLOT\n"
1012	#if {$f1 != ""} {append msg "data file: $f1\n"}
1013	#if {$f2 != ""} {append msg "instrument file: $f2"}
1014	catch {toplevel $parent.msg}
1015	catch {eval destroy [winfo children $parent.msg]}
1016	wm title $parent.msg "File names"
1017	grid [label $parent.msg.1 \
1018	-text "File names to be input to RAWPLOT" \
1019	-justify center -anchor center] \
1020	-column 0 -row 0 -columnspan 2
1021	if {$f1 != ""} {
1022	grid [label $parent.msg.2a \
1023	-text "Raw histogram: $f1" \
1024	-justify center -anchor e] \
1025	-column 0 -row 1
1026	grid [button $parent.msg.2b \
1027	-command "clipboard clear; clipboard append $f1" \
1028	-text "put name\nin clipboard"] \
1029	-column 1 -row 1
1030	}
1031	if {$f2 != ""} {
1032	grid [label $parent.msg.3a \
1033	-text "Raw histogram: $f2" \
1034	-justify center -anchor e] \
1035	-column 0 -row 2
1036	grid [button $parent.msg.3b \
1037	-command "clipboard clear; clipboard append $f2" \
1038	-text "put name\nin clipboard"] \
1039	-column 1 -row 2
1040	}
1041	grid [button $parent.msg.4 \
1042	-command "destroy $parent.msg" \
1043	-text "Close"] \
1044	-column 0 -columnspan 2 -row 9
1045	}
1046	# start RAWPLOT
1047	runGSASprog rawplot 1
1048	if {[winfo exists $parent.msg]} {raise $parent.msg}
1049	update
1050	}
1051	#--- Respond to the setting of the bank # for the Instrument parameter file.
1052	proc PostInstBankopts {np} {
1053	global newhist
1054	if {$newhist(dummy)} {
1055	trace variable newhist(tmin) w "ValidateDummyHist $np"
1056	trace variable newhist(tmax) w "ValidateDummyHist $np"
1057	trace variable newhist(tstep) w "ValidateDummyHist $np"
1058	foreach w {l1 t1 lbank} {
1059	$np.$w config -fg grey
1060	}
1061	$np.d1.m1 config -text {}
1062	$np.d1.m2 config -text {}
1063	$np.b1 config -state disabled
1064	$np.b1a config -state disabled
1065	grid forget $np.l3 $np.e3 $np.cb3 $np.cb4 $np.cb5 $np.bank $np.f6a
1066	grid $np.dl1 -column 0 -row 18
1067	grid $np.d1 -column 1 -row 18 -rowspan 2 -columnspan 4 -sticky e
1068	grid $np.dl3 -column 0 -columnspan 99 -row 20 -sticky ew
1069	if {$newhist(insttype) == "TOF"} {
1070	$np.dl1 config -text "Data range:\n(TOF)"
1071	$np.d1.lu config -text millisec
1072	grid $np.dl2 -column 0 -row 19
1073	catch {
1074	set s $newhist(setnum)
1075	foreach {x tmin tmax x} $newhist(inst${s}ITYP) {}
1076	$np.d1.m1 config -text $tmin
1077	$np.d1.m2 config -text $tmax
1078	}
1079	} elseif {[lindex $newhist(insttype) 0] == "CW"} {
1080	$np.dl1 config -text "Data range:\n(2Theta)"
1081	$np.d1.lu config -text degrees
1082	#grid forget $np.dl2
1083	$np.d1.m1 config -text >0.
1084	$np.d1.m2 config -text <180.
1085	} elseif {$newhist(insttype) == "ED"} {
1086	$np.dl1 config -text "Data range:\n(Energy)"
1087	$np.d1.lu config -text KeV
1088	$np.d1.m1 config -text 1.
1089	$np.d1.m2 config -text 200.
1090	grid $np.dl2 -column 0 -row 19
1091	} else {
1092	$np.dl1 config -text "No file\nselected"
1093	$np.d1.lu config -text {}
1094	}
1095	} else {
1096	foreach var {tmin tmax tstep} {
1097	foreach v [ trace vinfo newhist($var)] {
1098	eval trace vdelete newhist($var) $v
1099	}
1100	}
1101	grid forget $np.dl1 $np.d1 $np.dl2 $np.dl3
1102	foreach w {l1 t1 lbank} {
1103	$np.$w config -fg black
1104	}
1105	$np.b1 config -state normal
1106	$np.b1a config -state normal
1107	grid $np.bank -column 2 -row 3 -columnspan 7 -sticky ew
1108	grid $np.f6a -column 4 -row 18 -rowspan 3
1109	grid $np.l3 -column 0 -row 18 -rowspan 3
1110	grid $np.e3 -column 1 -row 18 -rowspan 3
1111	grid $np.cb3 -column 2 -row 18 -sticky w
1112	grid $np.cb4 -column 2 -row 20 -sticky w
1113	grid $np.cb5 -column 2 -row 19 -sticky w
1114	SetTmax
1115	}
1116	}
1117
1118	proc ValidateDummyHist {np args} {
1119	# validate input
1120	global newhist
1121	set msg {}
1122	$np.dl3 config -text "\n"
1123	foreach e {e1 e2 e3} v {tmin tmax tstep} {
1124	if [catch {expr $newhist($v)}] {
1125	$np.d1.$e config -fg red
1126	append msg "Value of $newhist($v) is invalid for $v\n"
1127	} else {
1128	$np.d1.$e config -fg black
1129	}
1130	}
1131	if {[catch {expr $newhist(setnum)}]} {
1132	append msg "An instrument file bank number must be selected\n"
1133	} elseif {$newhist(setnum) <= 0 \|\| \
1134	$newhist(setnum) > $newhist(instbanks)} {
1135	append msg "An invalid instrument file bank has been selected\n"
1136	}
1137
1138	if {$msg != ""} {return $msg}
1139
1140	if {$newhist(tmax) <= $newhist(tmin)} {
1141	$np.d1.e1 config -fg red
1142	$np.d1.e2 config -fg red
1143	return "Tmax <= Tmin\n"
1144	}
1145
1146
1147	set dmin -1
1148	set dmax -1
1149	if {$newhist(insttype) == "TOF"} {
1150	catch {
1151	set s $newhist(setnum)
1152	foreach {x tmin tmax x} $newhist(inst${s}ITYP) {}
1153	if {$newhist(tmin) <$tmin } {
1154	$np.d1.e1 config -fg red
1155	append msg "Min value of $newhist(tmin) msec is invalid.\n"
1156	}
1157	if {$newhist(tmax) >$tmax } {
1158	$np.d1.e2 config -fg red
1159	append msg "Max value of $newhist(tmax) msec is invalid.\n"
1160	}
1161	set s $newhist(setnum)
1162	set dmin [expr {1000. * $newhist(tmin) / \
1163	[lindex $newhist(inst${s}ICONS) 0]}]
1164	set dmax [expr {1000. * $newhist(tmax) / \
1165	[lindex $newhist(inst${s}ICONS) 0]}]
1166	}
1167	} elseif {[lindex $newhist(insttype) 0] == "CW"} {
1168	if {$newhist(tmin) <= 0 } {
1169	$np.d1.e1 config -fg red
1170	append msg "Min value of $newhist(tmin) degrees is invalid.\n"
1171	}
1172	if {$newhist(tmax) >=180 } {
1173	$np.d1.e2 config -fg red
1174	append msg "Max value of $newhist(tmax) degrees is invalid.\n"
1175	}
1176	catch {
1177	set s $newhist(setnum)
1178	set dmin [expr {[lindex $newhist(inst${s}ICONS) 0]\
1179	* 0.5 / sin(acos(0.)*$newhist(tmax)/180.)}]
1180	set dmax [expr {[lindex $newhist(inst${s}ICONS) 0]\
1181	* 0.5 / sin(acos(0.)*$newhist(tmin)/180.)}]
1182	}
1183	} else {
1184	if {$newhist(tmin) <1 } {
1185	$np.d1.e1 config -fg red
1186	append msg "Min value of $newhist(tmin) KeV is invalid.\n"
1187	}
1188	if {$newhist(tmax) >200 } {
1189	$np.d1.e2 config -fg red
1190	append msg "Max value of $newhist(tmax) KeV is invalid.\n"
1191	}
1192	catch {
1193	set s $newhist(setnum)
1194	set ang [lindex $newhist(inst${s}ICONS) 0]
1195	set dmin [expr {12.398/ (2.0sin($angacos(0.)/180) * \
1196	$newhist(tmax))}]
1197	set dmax [expr {12.398/ (2.0sin($angacos(0.)/180) * \
1198	$newhist(tmin))}]
1199	}
1200	}
1201	if {$msg != ""} {return $msg}
1202	set pnts -1
1203	catch {
1204	set pnts [expr {1+int(($newhist(tmax) - $newhist(tmin))/$newhist(tstep))}]
1205	set qmin [expr {4.*acos(0)/$dmax}]
1206	set qmax [expr {4.*acos(0)/$dmin}]
1207	}
1208	if {$pnts <= 0} {
1209	$np.d1.e3 config -fg red
1210	append msg "Step value of $newhist(tstep) is invalid.\n"
1211	}
1212	if {$pnts >20000} {
1213	$np.d1.e3 config -fg red
1214	append msg "Step value of $newhist(tstep) is too small (>20000 points).\n"
1215	}
1216	if {$msg != ""} {return $msg}
1217	if {$dmin > 0 && $dmax > 0} {
1218	catch {
1219	set msg [format \
1220	{ %d points.%s D-space range: %.2f-%.2f A, Q: %.2f-%.2f/A} \
1221	$pnts "\n" $dmin $dmax $qmin $qmax]
1222	$np.dl3 config -text $msg
1223	}
1224	}
1225	if {$msg != ""} {return ""}
1226	$np.dl3 config -text [format { %d points.%s Range: ?} $pnts "\n"]
1227	return "Invalid data range -- something is wrong!"
1228	}
1229
1230	proc AddDummyHist {np} {
1231	global newhist expgui expmap
1232	global tcl_platform
1233	set msg [ValidateDummyHist $np]
1234	if {$msg != ""} {
1235	MyMessageBox -parent $np -title "Add Histogram Error" \
1236	-message "The following error(s) were found in your input:\n$msg" \
1237	-icon error -type ok -default ok \
1238	-helplink "expgui3.html AddHistErr"
1239	return
1240	}
1241
1242	set errmsg [runAddDummyHist $newhist(instfile) $newhist(setnum) \
1243	$newhist(insttype) \
1244	$newhist(tmin) $newhist(tmax) $newhist(tstep)]
1245	RecordMacroEntry "runAddDummyHist [list $newhist(instfile)] $newhist(setnum) $newhist(insttype) $newhist(tmin) $newhist(tmax) $newhist(tstep)" 0
1246
1247	if {[regexp {$P,H,A$} $expgui(exptoolout)]} {
1248	set msg {You must upgrade the EXPTOOL program.}
1249	append msg { This version cannot add dummy histograms.}
1250	MyMessageBox -icon error -title "Old EXPTOOL program" \
1251	-message $msg -parent $np \
1252	-helplink "expguierr.html OldEXPTOOL"
1253	# update the documentation & link
1254	destroy $np
1255	} elseif {$expgui(showexptool) \|\| $errmsg != ""} {
1256	if {$errmsg != ""} {
1257	set err 1
1258	append errmsg "\n" $expgui(exptoolout)
1259	} else {
1260	set err 0
1261	set errmsg $expgui(exptoolout)
1262	}
1263	set msg "Please review the result from adding the dummy histogram"
1264	if {$err} {append msg "\nIt appears an error occurred!"}
1265	ShowBigMessage $np $msg $errmsg OK "" $err
1266	} else {
1267	destroy $np
1268	}
1269	file delete exptool.in exptool.out
1270	# set the powpref warning (2 = required)
1271	set expgui(needpowpref) 2
1272	set msg "A histogram was added"
1273	if {[string first $msg $expgui(needpowpref_why)] == -1} {
1274	append expgui(needpowpref_why) "\t$msg\n"
1275	}
1276	}
1277	proc runAddDummyHist {instfile setnum insttype tmin tmax tstep} {
1278	global expgui expmap tcl_platform
1279	set fp [open exptool.in w]
1280	puts $fp "D"
1281	puts $fp $instfile
1282	puts $fp $setnum
1283	if {$insttype == "TOF"} {
1284	puts $fp "C"
1285	}
1286	puts $fp $tmin
1287	puts $fp $tmax
1288	puts $fp $tstep
1289	puts $fp "X"
1290	puts $fp "0"
1291	close $fp
1292	# Save the current exp file
1293	savearchiveexp
1294	# disable the file changed monitor
1295	set expgui(expModifiedLast) 0
1296	set expnam [file root [file tail $expgui(expfile)]]
1297	set err [catch {
1298	if {$tcl_platform(platform) == "windows"} {
1299	exec [file join $expgui(gsasexe) exptool.exe] $expnam \
1300	< exptool.in >& exptool.out
1301	} else {
1302	exec [file join $expgui(gsasexe) exptool] $expnam \
1303	< exptool.in >& exptool.out
1304	}
1305	} errmsg ]
1306	# load the revised exp file
1307	set oldpowderlist $expmap(powderlist)
1308	loadexp $expgui(expfile)
1309	set fp [open exptool.out r]
1310	set expgui(exptoolout) [read $fp]
1311	close $fp
1312	catch {file delete exptool.in exptool.out}
1313	if {[llength $oldpowderlist] == [llength $expmap(powderlist)]} {
1314	set err 1
1315	if {$errmsg == ""} {set errmsg "No histogram added"}
1316	}
1317	if {$err} {
1318	return $errmsg
1319	} else {
1320	return ""
1321	}
1322	}
1323
1324	#--- multiple histogram stuff
1325	proc SetMultipleAdd {np} {
1326	global newhist
1327	$np.f6.b6c configure -state disabled
1328	catch {
1329	if {$newhist(instbanks) == [llength $newhist(banklist)] \
1330	&& $newhist(instbanks) > 1} {
1331	$np.f6.b6c configure -state normal
1332	}
1333	}
1334	}
1335
1336	proc addMultiplehist {np} {
1337	global newhist
1338	# should not happen, but just in case
1339	if {$newhist(instbanks) != [llength $newhist(banklist)]} {
1340	$np.f6.b6c configure -state disable
1341	return
1342	}
1343	catch {destroy [set top $np.addMult]}
1344	toplevel $top
1345	grid [canvas $top.canvas \
1346	-scrollregion {0 0 5000 500} -width 0 -height 250 \
1347	-yscrollcommand "$top.scroll set"] \
1348	-column 0 -columnspan 2 -row 2 -sticky ns
1349	grid columnconfigure $top 0 -weight 1
1350	grid rowconfigure $top 2 -weight 1
1351	scrollbar $top.scroll \
1352	-command "$top.canvas yview"
1353	frame [set cfr $top.canvas.fr]
1354	$top.canvas create window 0 0 -anchor nw -window $cfr
1355	grid [label $top.top \
1356	-text "Select banks to add; set the\nuseful range of data, limiting\nthe # of reflections." -anchor w -justify left \
1357	-bg beige] -column 0 -columnspan 3 -row 0 -sticky ew
1358	grid [frame $top.vartyp -bd 2 -relief groove] \
1359	-column 0 -columnspan 3 -row 1 -sticky ew
1360	grid [label $top.vartyp.top -text "Data limit units:"] -column 0 -row 0 -columnspan 3 -sticky w
1361	grid [radiobutton $top.vartyp.cb3 -text "d-min\n(A)" -variable newhist(LimitMode) \
1362	-value 0] -column 0 -row 1 -sticky w
1363	grid [radiobutton $top.vartyp.cb4 -textvariable newhist(datalimlbl) \
1364	-variable newhist(LimitMode) -anchor w -justify l \
1365	-value 1] -column 1 -row 1 -sticky w
1366	grid [radiobutton $top.vartyp.cb5 -text "Q-max\n(A-1)" -variable newhist(LimitMode) \
1367	-value 2] -column 2 -row 1 -sticky w
1368
1369	grid [button $top.add -text Add -command "destroy $np"] -column 0 -row 3
1370	grid [button $top.cancel -text Cancel -command "destroy $top"] \
1371	-column 1 -row 3 -columnspan 2
1372	set row 1
1373	grid [label $cfr.t1 -text "Bank\n#"] -column 0 -row 0
1374	switch $newhist(insttype) {
1375	TOF {set newhist(datalimlbl) "T-min\n(ms)"}
1376	ED {set newhist(datalimlbl) "E-max\n(KeV)"}
1377	default {set newhist(datalimlbl) "2theta\nmax"}
1378	}
1379	grid [label $cfr.t2 -text "Upper\ndata limit"] -column 1 -row 0
1380	foreach i $newhist(banklist) {
1381	grid [checkbutton $cfr.c$i -text $i \
1382	-variable newhist(usebank$i)] \
1383	-column 0 -row [incr row] -sticky w
1384	set newhist(usebank$i) 1
1385	grid [entry $cfr.e$i -width 8 -textvariable newhist(tlimit$i)] \
1386	-column 1 -row $row -sticky w
1387	lappend newhist(LimitMode_boxes) $cfr.e$i
1388	if {$newhist(insttype) == "TOF"} {
1389	set newhist(tlimit$i) $newhist(tmin$i)
1390	catch {
1391	foreach {x tmin tmax x} $newhist(inst${i}ITYP) {}
1392	if {$tmin > 0} {set newhist(tlimit$i) $tmin}
1393	}
1394	} else {
1395	set newhist(tlimit$i) $newhist(tmax$i)
1396	}
1397	}
1398	# resize the list
1399	update
1400	set sizes [grid bbox $top.canvas.fr]
1401	$top.canvas config -scrollregion $sizes -width [lindex $sizes 2]
1402	# use the scroll for BIG lists
1403	if {[lindex $sizes 3] > [winfo height $top.canvas]} {
1404	grid $top.scroll -sticky ns -column 3 -row 2
1405	} else {
1406	grid forget $top.scroll
1407	}
1408	update
1409	putontop $top
1410	tkwait window $top
1411	afterputontop
1412
1413	if {[winfo exists $np]} return
1414
1415	# validate the input
1416	set err {}
1417	if {[string trim $newhist(rawfile)] == ""} {
1418	append err " No data file specified\n"
1419	}
1420	if {[string trim $newhist(instfile)] == ""} {
1421	append err " No instrument parameter file specified\n"
1422	}
1423	foreach i $newhist(banklist) {
1424	if {$newhist(usebank$i)} {
1425	if {[catch {expr $newhist(tlimit$i)}]} {
1426	append err " The Max/Min limit is not valid for bank $i\n"
1427	} elseif {$newhist(tlimit$i) <= 0} {
1428	append err " The Max/Min limit is not valid for bank $i\n"
1429	}
1430	}
1431	}
1432	if {$err != ""} {
1433	MyMessageBox -parent $np -title "Add Histogram Error" \
1434	-message "The following error(s) were found in your input:\n$err" \
1435	-icon error -type ok -default ok \
1436	-helplink "expgui3.html AddHistErr"
1437	return
1438	}
1439
1440	# ok do it!
1441	global tcl_platform expmap expgui
1442	# Save the current exp file
1443	savearchiveexp
1444	set oldpowderlist $expmap(powderlist)
1445	# disable the file changed monitor
1446	set expgui(expModifiedLast) 0
1447	set k 0
1448	set added 0
1449	set outlog {}
1450	set err 0
1451	pleasewait "adding histograms" expgui(temp)
1452	foreach i $newhist(banklist) {
1453	incr k
1454	if {$newhist(usebank$i)} {
1455	incr added
1456	set expgui(temp) "adding bank $i"
1457	update
1458
1459	if {$newhist(LimitMode) == 1} {
1460	set mode "T"
1461	set value $newhist(tlimit$i)
1462	} elseif {$newhist(LimitMode) == 2} {
1463	set mode "D"
1464	set Q 100
1465	catch {set Q [expr {4*acos(0)/$newhist(tlimit$i)}]}
1466	set value $Q
1467	} else {
1468	set mode "D"
1469	set value $newhist(tlimit$i)
1470	}
1471	set errmsg [runAddHist $newhist(rawfile) $newhist(instfile) $i $k $mode $value]
1472	# save call to Macro file
1473	RecordMacroEntry "runAddHist [list $newhist(rawfile)] [list $newhist(instfile)] $i $k $mode $value" 0
1474	if {$errmsg != ""} {
1475	append outlog "\n\n\nNOTE ERROR:\n" $errmsg $expgui(exptoolout)
1476	set err 1
1477	} else {
1478	append outlog $expgui(exptoolout)
1479	}
1480	}
1481	}
1482	# load the revised exp file
1483	loadexp $expgui(expfile)
1484	if {[llength $oldpowderlist]+$added != [llength $expmap(powderlist)]} {
1485	set err 1
1486	}
1487	# set the powpref warning (2 = required)
1488	set expgui(needpowpref) 2
1489	set msg "A histogram was added"
1490	if {[string first $msg $expgui(needpowpref_why)] == -1} {
1491	append expgui(needpowpref_why) "\t$msg\n"
1492	}
1493	donewait
1494	if {$expgui(showexptool) \|\| $err} {
1495	set msg "Please review the result from adding the histogram"
1496	if {$err} {append msg "\nIt appears an error occurred!"}
1497	ShowBigMessage $np $msg $outlog OK "" $err
1498	}
1499	# select the most recently added histogram
1500	if {!$err} {
1501	set i [llength $expmap(histlistboxcontents)]
1502	if {$i > 0} {
1503	incr i -1
1504	set expgui(curhist) $i
1505	sethistlist
1506	}
1507	}
1508	}
1509
1510	#----------- Add Atoms routines ----------------------------------------
1511	proc MakeAddAtomsBox {phase "atomlist {}"} {
1512	global expmap expgui
1513
1514	# is there room for more atoms? Well, we will check this someday
1515	if {$phase == ""} return
1516	if {[llength $phase] != 1} return
1517
1518	set top .newatoms
1519	catch {destroy $top}
1520	toplevel $top
1521	bind $top <Key-F1> "MakeWWWHelp expgui2.html addatoms"
1522
1523	grid [label $top.l1 -relief groove -bd 4 -anchor center\
1524	-text "Adding atoms to phase #$phase"] \
1525	-column 0 -row 0 \
1526	-sticky we -columnspan 10
1527
1528	grid [canvas $top.canvas \
1529	-scrollregion {0 0 5000 500} -width 0 -height 250 \
1530	-yscrollcommand "$top.scroll set"] \
1531	-column 0 -row 2 -columnspan 4 -sticky nsew
1532	grid columnconfigure $top 3 -weight 1
1533	grid rowconfigure $top 2 -weight 1
1534	grid rowconfigure $top 1 -pad 5
1535	scrollbar $top.scroll \
1536	-command "$top.canvas yview"
1537	frame $top.canvas.fr
1538	$top.canvas create window 0 0 -anchor nw -window $top.canvas.fr
1539
1540	set np $top.canvas.fr
1541	set row 0
1542	set col 0
1543	grid [label $np.l_${row}0 -text " # "] -column $col -row $row
1544	foreach i {Atom\ntype Name x y z Occ Uiso} \
1545	var {type name x y z occ uiso} {
1546	grid [button $np.l_${row}$i -text $i -padx 0 -pady 0 \
1547	-command "sortAddAtoms $phase $top $var"] \
1548	-column [incr col] -row $row -sticky nsew
1549	}
1550	grid [label $np.l_${row}Use -text Use\nFlag] -column [incr col] -row $row
1551
1552	set expgui(SetAddAtomsScroll) 0
1553	set i [llength $atomlist]
1554	if {$i == 0} {incr i}
1555	for {set j 0} {$j < $i} {incr j} {
1556	MakeAddAtomsRow $top
1557	}
1558	set row 0
1559	foreach item $atomlist {
1560	incr row
1561	foreach val $item w {n x y z t o u} {
1562	if {$val != ""} {
1563	$np.e${row}$w delete 0 end
1564	$np.e${row}$w insert end $val
1565	}
1566	}
1567	}
1568	bind $top <Configure> "SetAddAtomsScroll $top"
1569	grid rowconfigure $top 3 -min 10
1570	grid [button $top.b1 -text "Add Atoms"\
1571	-command "addatom $phase $top"] -column 0 -row 5 -sticky w
1572	bind $top <Return> "addatom $phase $top"
1573	grid [button $top.b2 -text Cancel \
1574	-command "destroy $top"] -column 1 -row 5 -sticky w
1575	grid [button $top.help -text Help -bg yellow \
1576	-command "MakeWWWHelp expgui2.html addatoms"] \
1577	-column 0 -columnspan 2 -row 4
1578
1579	# get the input formats if not already defined
1580	GetImportFormats
1581	if {[llength $expgui(importFormatList)] > 0} {
1582	grid [frame $top.fr -bd 4 -relief groove] \
1583	-column 3 -row 5 -columnspan 2 -sticky e
1584	grid [button $top.fr.b3 -text "Import atoms from: " \
1585	-command "ImportAtoms \$expgui(importFormat) $top $phase"] \
1586	-column 0 -row 0 -sticky e
1587	set menu [eval tk_optionMenu $top.fr.b4 expgui(importFormat) \
1588	$expgui(importFormatList)]
1589	for {set i 0} {$i <= [$menu index end]} {incr i} {
1590	$menu entryconfig $i -command "ImportAtoms \$expgui(importFormat) $top $phase"
1591	}
1592	grid $top.fr.b4 -column 1 -row 0 -sticky w
1593	grid rowconfig $top.fr 0 -pad 10
1594	grid columnconfig $top.fr 0 -pad 10
1595	grid columnconfig $top.fr 1 -pad 10
1596	}
1597
1598	grid [button $top.b3 -text "More atom boxes" \
1599	-command "MakeAddAtomsRow $top"] -column 3 \
1600	-columnspan 2 -row 4 -sticky e
1601
1602	wm title $top "add new atom"
1603
1604	# set grab, etc.
1605	putontop $top
1606
1607	tkwait window $top
1608
1609	# fix grab...
1610	afterputontop
1611	}
1612
1613	proc MakeAddAtomsRow {top} {
1614	set np $top.canvas.fr
1615	set col -1
1616	set row 1
1617	# find an empty row
1618	while {![catch {grid info $np.e${row}t}]} {incr row}
1619	grid [label $np.e${row}num -text $row] -column [incr col] -row $row
1620	grid [entry $np.e${row}t -width 5] -column [incr col] -row $row
1621	grid [entry $np.e${row}n -width 8] -column [incr col] -row $row
1622	foreach i {x y z o u} {
1623	grid [entry $np.e${row}$i -width 9] -column [incr col] -row $row
1624	}
1625	grid [checkbutton $np.e${row}use -variable expgui(UseAtom$row)] \
1626	-column [incr col] -row $row
1627	# default occupancy
1628	$np.e${row}o delete 0 end
1629	$np.e${row}o insert end 1.0
1630	# default Uiso
1631	$np.e${row}u delete 0 end
1632	$np.e${row}u insert end 0.025
1633	# default label
1634	$np.e${row}n delete 0 end
1635	$np.e${row}n insert end (default)
1636	# use by default
1637	$np.e${row}use select
1638
1639	SetAddAtomsScroll $top
1640	return $row
1641	}
1642
1643	proc SetAddAtomsScroll {top} {
1644	global expgui
1645	if $expgui(SetAddAtomsScroll) return
1646	# prevent reentrance
1647	set expgui(SetAddAtomsScroll) 1
1648	update
1649	set sizes [grid bbox $top.canvas.fr]
1650	$top.canvas config -scrollregion $sizes -width [lindex $sizes 2]
1651	# use the scroll for BIG atom lists
1652	if {[lindex $sizes 3] > [winfo height $top.canvas]} {
1653	grid $top.scroll -sticky ns -column 4 -row 2
1654	} else {
1655	grid forget $top.scroll
1656	}
1657	update
1658	set expgui(SetAddAtomsScroll) 0
1659	}
1660
1661	set expgui(atmtypelist) {}
1662	proc GetAtmTypes {} {
1663	set ::expgui(atmtypelist) {}
1664	set ::expgui(magtypelist) {}
1665	catch {
1666	set fp [open [file join $::expgui(gsasdir) data atmdata.dat] r]
1667	while {[gets $fp line] >= 0} {
1668	set token [string toupper [string trim [string range $line 2 8]]]
1669	if {$token == ""} continue
1670	# nuclear/magnetic
1671	if {[lindex $token 1] == "N" \|\| [lindex $token 1] == "M"} {
1672	set magarr([lindex $token 0]) 1
1673	continue
1674	}
1675	if {[string is integer $token]} continue
1676	if {[string first "_" $token] != -1} {
1677	set sp [split $token "_"]
1678	if {[lindex $sp 1] == ""} continue
1679	if {! [string is integer [lindex $sp 1]]} continue
1680	}
1681	set tmparr([string toupper $token]) 1
1682	}
1683	set ::expgui(atmtypelist) [array names tmparr]
1684	set ::expgui(magtypelist) [array names magarr]
1685	close $fp
1686	} errmsg
1687	if {$::expgui(debug) && $errmsg != ""} {
1688	puts "GetAtmTypes error: $errmsg"
1689	}
1690	}
1691
1692	# Validate the atoms in the atoms add/phase replace box
1693	# returns a null string on error or a list of atoms
1694	proc ValidateAtomsBox {top np} {
1695	global expgui
1696	set row 0
1697	# loop over the defined rows
1698	set err {}
1699	set atomlist {}
1700	set validatmtypes {
1701	H H-1 H_1 H_2 D H_3 HE HE_3 HE_4 LI LI+1 LI_6 LI_7 BE BE+2 B B_10
1702	B_11 C CV C_12 C_13 N N_14 N_15 O O-1 O-2 O_16 O_17 O_18 F F-1 F_19 NE
1703	NE_20 NE_21 NE_22 NA NA+1 NA_23 MG MG+2 MG_24 MG_25 MG_26 AL AL+3
1704	AL_27 SI SI+4 SIV SI_28 SI_29 SI_30 P P_31 S S_32 S_33 S_34 CL CL-1
1705	CL_35 CL_37 AR AR_36 AR_40 K K+1 K_39 K_41 CA CA+2 CA_40 CA_44 SC SC+3
1706	SC_45 TI TI+2 TI+3 TI+4 TI_46 TI_47 TI_48 TI_49 TI_50 V V+2 V+3 V+5
1707	V_51 CR CR+2 CR+3 CR_50 CR_52 CR_53 CR_54 MN MN+2 MN+3 MN+4 MN_55 FE
1708	FE+2 FE+3 FE_54 FE_56 FE_57 FE_58 CO CO+2 CO+3 CO_59 NI NI+2 NI+3
1709	NI_58 NI_60 NI_61 NI_62 NI_64 CU CU+1 CU+2 CU_63 CU_65 ZN ZN+2 ZN_64
1710	ZN_66 ZN_67 ZN_68 GA GA+3 GE GE+4 AS AS_75 SE BR BR-1 BR_79 BR_81 KR
1711	RB RB+1 SR SR+2 Y Y+3 Y_89 ZR ZR+4 NB NB+3 NB+5 NB_93 MO MO+3 MO+5
1712	MO+6 TC TC_98 RU RU+3 RU+4 RH RH+3 RH+4 RH_103 PD PD+2 PD+4 AG AG+1
1713	AG+2 CD CD+2 CD_112 CD_113 CD_114 CD_116 IN IN+3 IN_113 IN_115 SN SN+2
1714	SN+4 SB SB+3 SB+5 TE I I-1 I_127 XE CS CS+1 CS_133 BA BA+2 LA LA+3 CE
1715	CE+3 CE+4 PR PR+3 PR+4 PR_141 ND ND+3 PM PM+3 SM SM+3 SM_152
1716	SM_154 EU EU+2 EU+3 EU_153 GD GD+3 GD_160 TB TB+3 TB_159 DY DY+3 HO
1717	HO+3 HO_165 ER ER+3 TM TM+3 TM_169 YB YB+2 YB+3 LU LU+3 HF HF+4 TA
1718	TA+5 TA_181 W W+6 RE OS OS+4 IR IR+3 IR+4 PT PT+2 PT+4 AU AU+1 AU+3
1719	AU_197 HG HG+1 HG+2 TL TL+1 TL+3 PB PB+2 PB+4 BI BI+3 BI+5 BI_209 PO
1720	AT AT_210 RN RN_222 FR FR_223 RA RA+2 RA_226 AC AC+3 AC_227 TH
1721	TH+4 TH_232 PA PA_231 U U+3 U+4 U+6 U_235 U_238 NP NP+3 NP+4 NP+6
1722	NP_237 PU PU+3 PU+4 PU+6 PU_239 PU_240 PU_242 AM AM_243 CM CM_244 BK
1723	BK_247 CF CF_249
1724	}
1725	# loop over the defined rows
1726	while {![catch {grid info $np.e[incr row]t}]} {
1727	if !{$expgui(UseAtom$row)} continue
1728	# ignore blank entries
1729	set line {}
1730	foreach i {t x y z} {
1731	append line [string trim [$np.e${row}$i get]]
1732	}
1733	if {$line == ""} continue
1734
1735	# validate the input
1736	if {[set type [string trim [$np.e${row}t get]]] == ""} {
1737	append err " line $row: No atom type specified\n"
1738	}
1739	if {[lsearch $validatmtypes [string toupper $type]] == -1} {
1740	if {[llength $expgui(atmtypelist)] == 0} GetAtmTypes
1741	if {[lsearch $expgui(atmtypelist) [string toupper $type]] == -1} {
1742	if {[lsearch $expgui(magtypelist) [string toupper $type]] == -1} {
1743	append err " line $row: Atom type $type is not defined in GSAS"
1744	set sym2 [string range [string toupper $type] 0 1]
1745	set sym1 [string range [string toupper $type] 0 0]
1746	if {[lsearch $expgui(atmtypelist) $sym2] != -1} {
1747	$np.e${row}t delete 0 end
1748	$np.e${row}t insert 0 $sym2
1749	append err "; changed to $sym2.\n\n"
1750	} elseif {[lsearch $expgui(atmtypelist) $sym2] != -1} {
1751	$np.e${row}t delete 0 end
1752	$np.e${row}t insert 0 $sym1
1753	append err "; changed to $sym1.\n\n"
1754	} else {
1755	append err ".\n\n"
1756	}
1757	} else {
1758	append err " line $row: Atom type $type is not defined for x-rays in GSAS, but is defined for magnetic/nuclear scattering. If you want to use this symbol choose a different type here and change it later in EXPEDT.\n\n"
1759	}
1760	}
1761	}
1762	set name [string trim [$np.e${row}n get]]
1763	if {$name == "(default)"} {set name "/"}
1764	if {$name == ""} {set name "/"}
1765	foreach i {x y z o u} n {x y z Occ Uiso} {
1766	if {[set $i [string trim [$np.e${row}$i get]]] == ""} {
1767	append err " line $row: No value specified for $n\n"
1768	} elseif {[catch {expr [set $i]}]} {
1769	append err " line $row: The value for $n is invalid\n"
1770	}
1771	}
1772	lappend atomlist "$type $x $y $z $o $name I $u"
1773	}
1774	if {$err != ""} {
1775	MyMessageBox -icon warning -message "Note Errors:\n\n$err" -parent $top
1776	return {}
1777	}
1778	if {[llength $atomlist] == 0} {
1779	MyMessageBox -icon warning -message "No atoms to load!" -parent $top
1780	return {}
1781	}
1782	return $atomlist
1783	}
1784
1785	proc runAddAtoms {phase atomlist} {
1786	global expgui env expmap tcl_platform
1787	# needed in UNIX
1788	set env(ATOMDATA) [file join $expgui(gsasdir) data atmdata.dat]
1789	set env(gsas) [file nativename $expgui(gsasdir)]
1790	# needed in Windows
1791	set env(GSAS) [file nativename $expgui(gsasdir)]
1792
1793	set fp [open exptool.in w]
1794	puts $fp "A"
1795	puts $fp $phase
1796	# number of atoms
1797	puts $fp [llength $atomlist]
1798	foreach atomline $atomlist {
1799	puts $fp $atomline
1800	}
1801	close $fp
1802
1803	# Save the current exp file
1804	savearchiveexp
1805	# disable the file changed monitor
1806	set expgui(expModifiedLast) 0
1807	set expnam [file root [file tail $expgui(expfile)]]
1808
1809	set err [catch {
1810	if {$tcl_platform(platform) == "windows"} {
1811	exec [file join $expgui(gsasexe) exptool.exe] $expnam \
1812	< exptool.in >& exptool.out
1813	} else {
1814	exec [file join $expgui(gsasexe) exptool] $expnam \
1815	< exptool.in >& exptool.out
1816	}
1817	} errmsg]
1818	# load the revised exp file
1819	set oldatomlist $expmap(atomlist_$phase)
1820	loadexp $expgui(expfile)
1821	set fp [open exptool.out r]
1822	set expgui(exptoolout) [read $fp]
1823	close $fp
1824	if {[llength $oldatomlist] == [llength $expmap(atomlist_$phase))]} {
1825	set err 1
1826	if {$errmsg == ""} {set errmsg "No atom(s) added"}
1827	} elseif {! $::expgui(debug)} {
1828	catch {file delete exptool.in exptool.out}
1829	}
1830	return $errmsg
1831	}
1832
1833	proc addatom {phase top} {
1834	global expgui env expmap
1835	set np $top.canvas.fr
1836	# validate the atoms info
1837	set atomlist [ValidateAtomsBox $top $np]
1838	if {$atomlist == ""} return
1839
1840	# ok add the atoms!
1841	set errmsg [runAddAtoms $phase $atomlist]
1842	RecordMacroEntry "runAddAtoms $phase [list $atomlist]" 0
1843
1844	destroy $top
1845	set err 0
1846	if {$errmsg != ""} {
1847	append errmsg "\n" $expgui(exptoolout)
1848	set err 1
1849	} else {
1850	set errmsg $expgui(exptoolout)
1851	}
1852	if {$expgui(showexptool) \|\| $err} {
1853	set msg "Please review the result from adding the atom(s)"
1854	if {$err} {append msg "\nIt appears an error occurred!"}
1855	ShowBigMessage $top $msg $errmsg OK "" $err
1856	}
1857	}
1858
1859	#---------------------------------------------------------------------------
1860	# commands to modify a group of selected atoms
1861	#---------------------------------------------------------------------------
1862
1863	# make the dialog to choose an action
1864	proc MakeXformAtomsBox {phase} {
1865	global expgui expmap
1866	set numberList {}
1867	set p $expgui(curPhase)
1868	foreach AtomIndex $expgui(selectedatomlist) {
1869	# get atom number & phase
1870	set tuple [lindex $expmap(atomlistboxcontents) $AtomIndex]
1871	lappend numberList [lindex $tuple 0]
1872	}
1873	if {$numberList == ""} return
1874	if {[llength $numberList] > 1} {
1875	set suffix s
1876	set suffixy "ies"
1877	} else {
1878	set suffix ""
1879	set suffixy "y"
1880	}
1881	set w .global
1882	catch {destroy $w}
1883	toplevel $w
1884	wm title $w "Edit Atomic Parameter -- phase #$phase"
1885	bind $w <Key-F1> "MakeWWWHelp expgui2.html xform"
1886	# this needs to track by phase
1887	grid [label $w.0 \
1888	-text "Modifying atom${suffix} [CompressList $numberList] Phase $phase" \
1889	-bg yellow -anchor center] -row 0 -column 0 -columnspan 10 \
1890	-sticky nsew
1891	grid rowconfigure $w 0 -pad 5
1892	grid rowconfigure $w 1 -minsize 2
1893
1894	grid [TitleFrame $w.1 -bd 6 -relief groove -text "Modify coordinates"] \
1895	-row 2 -column 0 -columnspan 10 -sticky news
1896	set w1 [$w.1 getframe]
1897	set row 0
1898	foreach v {x y z} {
1899	incr row
1900	set col -1
1901	grid [label $w1.l$v -text "new $v = "] -column [incr col] -row $row
1902	foreach o {x y z} {
1903	grid [entry $w1.e${v}${o} -width 6] -column [incr col] -row $row
1904	$w1.e${v}${o} delete 0 end
1905	if {$v == $o} {
1906	$w1.e${v}${o} insert end "1.0"
1907	} else {
1908	$w1.e${v}${o} insert end "0."
1909	}
1910	grid [label $w1.p${v}${o} -text " $o + "] \
1911	-column [incr col] -row $row
1912	}
1913	grid [entry $w1.e${v} -width 6] -column [incr col] -row $row
1914	$w1.e${v} delete 0 end
1915	$w1.e${v} insert end "0."
1916	}
1917	grid [button $w1.do -text "Transform Coordinates" \
1918	-command "XformAtomsCoord $phase [list $numberList] $w1" \
1919	] -row [incr row] -column 0 -columnspan 10
1920
1921	set shift [GetOrigin1Shift $phase]
1922	grid [button $w1.d1 -text "Xform Origin 1 to Origin 2" \
1923	-command "XformAtoms2Origin2 $phase [list $numberList] $w1 [list $shift]" \
1924	] -row [incr row] -column 3 -columnspan 10 -sticky e
1925	if {$shift == ""} {$w1.d1 config -state disabled}
1926
1927	grid [button $w1.d4 -text "Reset Multiplicities" \
1928	-command "ResetMultiplicities $phase $w" \
1929	] -row $row -column 0 -columnspan 3 -sticky w
1930
1931
1932	grid rowconfigure $w 3 -minsize 5
1933	grid [TitleFrame $w.4 -bd 6 -relief groove -text "Modify occupanc${suffixy}"] \
1934	-row 4 -column 0 -columnspan 10 -sticky news
1935	set w2 [$w.4 getframe]
1936	grid [label $w2.1 -text "Occupancy: "] -row 1 -column 0
1937	grid [entry $w2.e -width 10] -column 1 -row 1
1938	$w2.e delete 0 end
1939	$w2.e insert end 1.0
1940	grid columnconfigure $w2 2 -weight 1
1941	grid [button $w2.do -text "Set Occupanc${suffixy}" \
1942	-command "XformAtomsOcc $phase [list $numberList] $w2" \
1943	] -row 2 -column 0 -columnspan 10
1944
1945	grid rowconfigure $w 5 -minsize 5
1946	grid [TitleFrame $w.6 -bd 6 -relief groove \
1947	-text "Modify Displacement Parameter$suffix"] \
1948	-row 6 -column 0 -columnspan 10 -sticky news
1949	set w2 [$w.6 getframe]
1950	grid [entry $w2.e -width 10] -column 1 -row 1
1951	$w2.e delete 0 end
1952	$w2.e insert end 0.025
1953	grid columnconfigure $w2 2 -weight 1
1954	grid [button $w2.do -text "Set U" \
1955	-command "XformAtomsU $phase [list $numberList] $w2" \
1956	] -row 2 -column 0 -columnspan 10
1957	grid [frame $w2.f] -row 3 -column 0 -columnspan 10
1958
1959	if {[lindex $expmap(phasetype) [expr {$p - 1}]] != 4} {
1960	grid [label $w2.1 -text "Uiso or Uequiv: "] -row 1 -column 0
1961	grid [button $w2.f.iso -text "Set Isotropic" \
1962	-command "XformAtomsU $phase [list $numberList] iso" \
1963	] -row 0 -column 0
1964	grid [button $w2.f.aniso -text "Set Anisotropic" \
1965	-command "XformAtomsU $phase [list $numberList] aniso" \
1966	] -row 0 -column 1
1967	} else {
1968	grid [label $w2.1 -text "Uiso: "] -row 1 -column 0
1969	}
1970
1971	grid rowconfigure $w 7 -minsize 5
1972	if {[lindex $expmap(phasetype) [expr {$p - 1}]] != 4} {
1973	grid [TitleFrame $w.8 -bd 6 -relief groove \
1974	-text "Erase Atom$suffix"] \
1975	-row 8 -column 0 -columnspan 10 -sticky news
1976	set w2 [$w.8 getframe]
1977	grid [button $w2.do -text "Erase Atom${suffix}" \
1978	-command "EraseAtoms $phase [list $numberList] $w" \
1979	] -row 2 -column 0 -columnspan 10
1980	}
1981
1982	# allow fixing of atom coordinates
1983	if {[lindex $expmap(phasetype) [expr {$p - 1}]] != 4} {
1984	grid [TitleFrame $w.10 -bd 6 -relief groove \
1985	-text "Fix Coordinates for Atom$suffix"] \
1986	-row 9 -column 0 -columnspan 10 -sticky news
1987	set fix [$w.10 getframe]
1988	# set button labels
1989	set ::fixbtn_lbl(X) [Fix_State $phase $numberList X]
1990	set ::fixbtn_lbl(Y) [Fix_State $phase $numberList Y]
1991	set ::fixbtn_lbl(Z) [Fix_State $phase $numberList Z]
1992
1993	label $fix.xlab -text " x " -width 8
1994	label $fix.ylab -text " y " -width 8
1995	label $fix.zlab -text " z " -width 8
1996	grid $fix.xlab -row 2 -column 0
1997	grid $fix.ylab -row 2 -column 1
1998	grid $fix.zlab -row 2 -column 2
1999
2000
2001	button $fix.x -textvariable fixbtn_lbl(X) -width 8 \
2002	-command "Fix_Atoms $phase [list $numberList] X"
2003	button $fix.y -textvariable fixbtn_lbl(Y) -width 8 \
2004	-command "Fix_Atoms $phase [list $numberList] Y"
2005	button $fix.z -textvariable fixbtn_lbl(Z) -width 8 \
2006	-command "Fix_Atoms $phase [list $numberList] Z"
2007	grid $fix.x -row 3 -column 0
2008	grid $fix.y -row 3 -column 1
2009	grid $fix.z -row 3 -column 2
2010	}
2011	#xxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxxx
2012
2013	grid rowconfigure $w 11 -minsize 5
2014	grid [frame $w.b] -row 12 -column 0 -columnspan 10 -sticky ew
2015	pack [button $w.b.3 -text Close -command "destroy $w"] -side left \
2016	-padx 5 -pady 5
2017	pack [button $w.b.help -text Help -bg yellow \
2018	-command "MakeWWWHelp expgui2.html xform"] -side right \
2019	-padx 5 -pady 5
2020	bind $w <Return> "destroy $w"
2021
2022	# force the window to stay on top
2023	putontop $w
2024	focus $w.b.3
2025	tkwait window $w
2026	afterputontop
2027	# if there are selected atoms, reset their display
2028	if {[llength $expgui(selectedatomlist)] != 0} editRecord
2029	}
2030
2031	# test the fixed status of variable for several atoms
2032	proc Fix_State {phase numberList coord} {
2033	set status_fixed 0
2034	set status_unfixed 0
2035	#puts "$coord before: $status_fixed $status_unfixed"
2036	foreach i $numberList {
2037	set temp [atom_constraint_get $phase $i $coord]
2038	if {$temp == 0} {
2039	set status_unfixed 1
2040	} else {
2041	set status_fixed 1
2042	}
2043	if {$status_fixed == 1 && $status_unfixed == 1} {
2044	return "fix\nsome"
2045	}
2046	}
2047	#puts "$coord after $status_fixed $status_unfixed"
2048	if {$status_fixed == 0} {return "fix"}
2049	return "release"
2050	}
2051
2052	# fix or release the selected atoms
2053	proc Fix_Atoms {phase numberList coord} {
2054	if {$::fixbtn_lbl($coord) == "release"} {
2055	set ::fixbtn_lbl($coord) "fix"
2056	set mode 0
2057	} else {
2058	set ::fixbtn_lbl($coord) "release"
2059	set mode 1
2060	}
2061	atom_constraint_set $phase $numberList $coord $mode
2062	incr ::expgui(changed)
2063	RecordMacroEntry "atom_constraint_set $phase [list $numberList] $coord $mode" 0
2064	RecordMacroEntry "incr expgui(changed)" 0
2065	DisplayAllAtoms $phase
2066	}
2067
2068
2069	# transform the coordinates
2070	proc XformAtomsCoord {phase numberList w1} {
2071	global expgui expmap
2072	if {[lindex $expmap(phasetype) [expr {$phase - 1}]] == 4} {
2073	set cmd mmatominfo
2074	} else {
2075	set cmd atominfo
2076	}
2077	# get the matrix
2078	foreach v {x y z} {
2079	foreach o {x y z} {
2080	set matrix(${v}${o}) [$w1.e${v}${o} get]
2081	}
2082	set matrix(${v}) [$w1.e${v} get]
2083	}
2084	foreach atom $numberList {
2085	foreach v {x y z} {
2086	set $v [$cmd $phase $atom $v]
2087	}
2088	foreach v {x y z} {
2089	set new$v $matrix(${v})
2090	foreach o {x y z} {
2091	set new$v [expr [set new$v] + $matrix(${v}${o})*[set $o]]
2092	}
2093	$cmd $phase $atom $v set [set new$v]
2094	RecordMacroEntry "$cmd $phase $atom $v set [set new$v]" 0
2095	}
2096	incr expgui(changed)
2097	}
2098	RecordMacroEntry "incr expgui(changed)" 0
2099	# update multiplicities for the phase
2100	set parent [winfo toplevel $w1]
2101	ResetMultiplicities $phase $parent
2102	SelectOnePhase $phase
2103	MyMessageBox -parent $parent -type OK -default ok -title "Transform applied" \
2104	-message "The coordinates of atoms [CompressList $numberList] have been transformed"
2105	# UpdateAtomLine $numberList $phase
2106	destroy $parent
2107	}
2108
2109	# set the occupancies to a single value
2110	proc XformAtomsOcc {phase numberList w2} {
2111	global expgui expmap
2112	if {[lindex $expmap(phasetype) [expr {$phase - 1}]] == 4} {
2113	set cmd mmatominfo
2114	} else {
2115	set cmd atominfo
2116	}
2117	# get the value
2118	set val [$w2.e get]
2119	foreach atom $numberList {
2120	$cmd $phase $atom frac set $val
2121	RecordMacroEntry "$cmd $phase $atom frac set $val" 0
2122	incr expgui(changed)
2123	}
2124	RecordMacroEntry "incr expgui(changed)" 0
2125	UpdateAtomLine $numberList $phase
2126	}
2127
2128	# transform Uiso or Uij; if anisotropic set Uequiv to Uij
2129	proc XformAtomsU {phase numberList w2} {
2130	global expgui
2131	set istart $expgui(changed)
2132	if {$w2 == "iso"} {
2133	foreach atom $numberList {
2134	if {[atominfo $phase $atom temptype] != "I"} {
2135	atominfo $phase $atom temptype set I
2136	RecordMacroEntry "atominfo $phase $atom temptype set I" 0
2137	incr expgui(changed)
2138	}
2139	}
2140	} elseif {$w2 == "aniso"} {
2141	foreach atom $numberList {
2142	if {[atominfo $phase $atom temptype] == "I"} {
2143	atominfo $phase $atom temptype set A
2144	RecordMacroEntry "atominfo $phase $atom temptype set A" 0
2145	incr expgui(changed)
2146	}
2147	}
2148	} else {
2149	# get the value
2150	set val [$w2.e get]
2151	foreach atom $numberList {
2152	global expmap
2153	if {[lindex $expmap(phasetype) [expr {$phase - 1}]] == 4} {
2154	mmatominfo $phase $atom Uiso set $val
2155	RecordMacroEntry "mmatominfo $phase $atom Uiso set $val" 0
2156	} elseif {[atominfo $phase $atom temptype] == "I"} {
2157	atominfo $phase $atom Uiso set $val
2158	RecordMacroEntry "atominfo $phase $atom Uiso set $val" 0
2159	} else {
2160	foreach var {U11 U22 U33} {
2161	atominfo $phase $atom $var set $val
2162	RecordMacroEntry "atominfo $phase $atom $var set $val" 0
2163	}
2164	foreach var {U12 U13 U23} {
2165	atominfo $phase $atom $var set 0.0
2166	RecordMacroEntry "atominfo $phase $atom $var set 0.0" 0
2167	}
2168	}
2169	incr expgui(changed)
2170	}
2171	}
2172	if {$istart != $expgui(changed)} {RecordMacroEntry "incr expgui(changed)" 0}
2173	UpdateAtomLine $numberList $phase
2174	}
2175
2176	# confirm and erase atoms
2177	proc EraseAtoms {phase numberList w2} {
2178	global expgui
2179	if {[llength $numberList] <= 0} return
2180	# make a list of atoms
2181	foreach atom $numberList {
2182	append atomlist "\n\t$atom [atominfo $phase $atom label]"
2183	}
2184	set msg "OK to remove the following [llength $numberList] atoms from phase $phase:$atomlist"
2185	set val [MyMessageBox -parent $w2 -type okcancel -icon warning \
2186	-default cancel -title "Confirm Erase" -message $msg]
2187	if {$val == "ok"} {
2188	foreach atom $numberList {
2189	EraseAtom $atom $phase
2190	RecordMacroEntry "EraseAtom $atom $phase" 0
2191	incr expgui(changed)
2192	}
2193	RecordMacroEntry "incr expgui(changed)" 0
2194	mapexp
2195	RecordMacroEntry "mapexp" 0
2196	DisplayAllAtoms $phase
2197	destroy $w2
2198	}
2199	}
2200
2201	#----------- more Add Phase routines (import) -------------------------------
2202	proc ImportPhase {format np} {
2203	global expgui
2204	if {[llength $expgui(extensions_$format)] == 1} {
2205	lappend typelist [list $format $expgui(extensions_$format)]
2206	} else {
2207	foreach item $expgui(extensions_$format) {
2208	lappend typelist [list "All $format" $item]
2209	lappend typelist [list "$format $item" $item]
2210	}
2211	}
2212	lappend typelist [list "All files" *]
2213	set file [tk_getOpenFile -parent $np -filetypes $typelist]
2214	if {![file exists $file]} return
2215	# read in the file
2216	set expgui(addPhaseCellType) Any
2217	set input [$expgui(proc_$format) $file]
2218	catch {
2219	$np.bf.b1 config -text "Continue" -command "addphase $np; AddAtomsList"
2220	bind $np <Return> "addphase $np; AddAtomsList"
2221	}
2222	catch {
2223	$np.t1 delete 0 end
2224	$np.t1 insert end "from $file"
2225	}
2226	set spg [lindex $input 0]
2227	set expgui(coordList) [lindex $input 2]
2228	set msg [lindex $input 3]
2229
2230	$np.t2 delete 0 end
2231	if {$spg == ""} {
2232	set msg "Warning: a Space Group must be specified."
2233	} elseif {[set nspg [CheckSpg $spg]] == ""} {
2234	$np.t2 insert end $spg
2235	if {$msg != ""} {append msg " "}
2236	append msg "Warning: this space group ($spg) is not recognized as standard short H-M name. It may be correct, but check it carefully."
2237	} else {
2238	$np.t2 insert end $nspg
2239	}
2240	foreach i {.e1a .e1b .e1c .e2a .e2b .e2g} val [lindex $input 1] {
2241	$np.f$i delete 0 end
2242	$np.f$i insert end $val
2243	}
2244	if {$msg != ""} {
2245	catch {destroy $np.msg}
2246	grid [label $np.msg -text $msg -fg red -anchor center -bd 4 -relief raised -wraplength 400] \
2247	-column 0 -columnspan 99 -row 20 -sticky ew
2248	}
2249	}
2250
2251	proc ImportAtoms {format top phase} {
2252	global expgui
2253	if {[llength $expgui(extensions_$format)] == 1} {
2254	lappend typelist [list $format $expgui(extensions_$format)]
2255	} else {
2256	foreach item $expgui(extensions_$format) {
2257	lappend typelist [list "All $format" $item]
2258	lappend typelist [list "$format $item" $item]
2259	}
2260	}
2261	lappend typelist [list "All files" *]
2262	set file [tk_getOpenFile -parent $top -filetypes $typelist]
2263	if {![file exists $file]} return
2264	# disable during read
2265	catch {
2266	foreach b "$top.b1 $top.b2 $top.fr.b3" {
2267	$b config -state disabled
2268	}
2269	}
2270	# read in the file
2271	set input [$expgui(proc_$format) $file]
2272	# add atoms to table
2273	foreach item [lindex $input 2] {
2274	set row [MakeAddAtomsRow $top]
2275	set np $top.canvas.fr
2276	foreach val $item w {n x y z t o u} {
2277	if {$val != ""} {
2278	$np.e${row}$w delete 0 end
2279	$np.e${row}$w insert end $val
2280	}
2281	}
2282	}
2283	# sort the atoms by number, so that empty entries are at the bottom
2284	sortAddAtoms $phase $top number
2285	# reenable
2286	catch {
2287	foreach b "$top.b1 $top.b2 $top.fr.b3" {
2288	$b config -state normal
2289	}
2290	}
2291	}
2292
2293	proc AddAtomsList {} {
2294	global expgui expmap
2295	# skip if we aborted out of addphase
2296	if {$expgui(oldphaselist) == -1} return
2297	# find the new phase
2298	set phase {}
2299	foreach p $expmap(phaselist) {
2300	if {[lsearch $expgui(oldphaselist) $p] == -1} {
2301	set phase $p
2302	break
2303	}
2304	}
2305	if {$phase == ""} return
2306	MakeAddAtomsBox $phase $expgui(coordList)
2307	}
2308
2309	# get the input formats by sourcing files named import_*.tcl
2310	proc GetImportFormats {} {
2311	global expgui tcl_platform
2312	# only needs to be done once
2313	if [catch {set expgui(importFormatList)}] {
2314	set filelist [glob -nocomplain [file join $expgui(scriptdir) import_*.tcl]]
2315	foreach file $filelist {
2316	set description ""
2317	source $file
2318	if {$description != ""} {
2319	lappend expgui(importFormatList) $description
2320	if {$tcl_platform(platform) == "unix"} {
2321	set extensions "[string tolower $extensions] [string toupper $extensions]"
2322	}
2323	set expgui(extensions_$description) $extensions
2324	set expgui(proc_$description) $procname
2325	}
2326	}
2327	}
2328	}
2329
2330	proc MakeReplacePhaseBox {} {
2331	global expmap expgui tcl_platform
2332
2333	set expgui(coordList) {}
2334	# ignore the command if no phase is selected
2335	foreach p {1 2 3 4 5 6 7 8 9} {
2336	if {[lsearch $expmap(phaselist) $expgui(curPhase)] == -1} {
2337	return
2338	}
2339	}
2340
2341	set top .newphase
2342	catch {destroy $top}
2343	toplevel $top
2344	bind $top <Key-F1> "MakeWWWHelp expgui2.html replacephase"
2345
2346	grid [label $top.l1 -text "Replacing phase #$expgui(curPhase)" \
2347	-bg yellow -anchor center] -column 0 -columnspan 8 -row 0 -sticky ew
2348	grid [label $top.l3a -text "Current Space Group: "] \
2349	-column 0 -row 2 -columnspan 2 -sticky e
2350	grid [label $top.l3b -text [phaseinfo $expgui(curPhase) spacegroup]\
2351	-bd 4 -relief groove] \
2352	-column 2 -row 2 -sticky ew
2353	grid [label $top.l4 -text "New Space Group: "] \
2354	-column 0 -row 3 -columnspan 2 -sticky e
2355	grid [entry $top.t2 -width 12] -column 2 -row 3 -sticky w
2356	grid [radiobutton $top.r1 -text "Keep atoms in phase"\
2357	-variable expgui(DeleteAllAtoms) -value 0] \
2358	-column 1 -row 4 -columnspan 8 -sticky w
2359	grid [radiobutton $top.r2 -text "Delete current atoms" \
2360	-variable expgui(DeleteAllAtoms) -value 1] \
2361	-column 1 -row 5 -columnspan 8 -sticky w
2362
2363	grid [frame $top.f -bd 4 -relief groove] \
2364	-column 3 -row 2 -columnspan 3 -rowspan 4
2365	set col -1
2366	foreach i {a b c} {
2367	grid [label $top.f.l1$i -text " $i "] -column [incr col] -row 1
2368	grid [entry $top.f.e1$i -width 12] -column [incr col] -row 1
2369	$top.f.e1$i delete 0 end
2370	$top.f.e1$i insert 0 [phaseinfo $expgui(curPhase) $i]
2371	}
2372	set col -1
2373	foreach i {a b g} var {alpha beta gamma} {
2374	grid [label $top.f.l2$i -text $i] -column [incr col] -row 2
2375	set font [$top.f.l2$i cget -font]
2376	$top.f.l2$i config -font "Symbol [lrange $font 1 end]"
2377	grid [entry $top.f.e2$i -width 12] -column [incr col] -row 2
2378	$top.f.e2$i delete 0 end
2379	$top.f.e2$i insert 0 [phaseinfo $expgui(curPhase) $var]
2380	}
2381
2382	grid [button $top.b1 -text Continue \
2383	-command "replacephase1 $top $expgui(curPhase)"] \
2384	-column 0 -row 6 -sticky w
2385	bind $top <Return> "replacephase1 $top $expgui(curPhase)"
2386	grid [button $top.b2 -text Cancel \
2387	-command "destroy $top"] -column 1 -row 6 -sticky w
2388	grid [button $top.help -text Help -bg yellow \
2389	-command "MakeWWWHelp expgui2.html replacephase"] \
2390	-column 2 -row 6
2391
2392	# get the input formats if not already defined
2393	GetImportFormats
2394	if {[llength $expgui(importFormatList)] > 0} {
2395	grid [frame $top.fr -bd 4 -relief groove] \
2396	-column 2 -row 6 -columnspan 8 -sticky e
2397	grid [button $top.fr.b3 -text "Import phase from: " \
2398	-command "ImportPhase \$expgui(importFormat) $top"] \
2399	-column 0 -row 0 -sticky e
2400	set menu [eval tk_optionMenu $top.fr.b4 expgui(importFormat) \
2401	$expgui(importFormatList)]
2402	for {set i 0} {$i <= [$menu index end]} {incr i} {
2403	$menu entryconfig $i -command "ImportPhase \$expgui(importFormat) $top"
2404	}
2405	grid $top.fr.b4 -column 1 -row 0 -sticky w
2406	grid rowconfig $top.fr 0 -pad 10
2407	grid columnconfig $top.fr 0 -pad 10
2408	grid columnconfig $top.fr 1 -pad 10
2409	# grid columnconfig $top 4 -weight 1
2410	grid columnconfig $top 2 -weight 1
2411	}
2412
2413	wm title $top "Replace phase $expgui(curPhase)"
2414
2415	# set grab, etc.
2416	putontop $top
2417
2418	tkwait window $top
2419
2420	# fix grab...
2421	afterputontop
2422	}
2423
2424	proc replacephase1 {top phase} {
2425	# validate cell & space group & save to pass
2426	global expgui expmap
2427	set expgui(SetAddAtomsScroll) 0
2428	# validate the input
2429	set err {}
2430	set spg [$top.t2 get]
2431	if {[string trim $spg] == ""} {
2432	append err " Space group cannot be blank\n"
2433	}
2434	set cell {}
2435	foreach i {a b c a b g} lbl {a b c alpha beta gamma} n {1 1 1 2 2 2} {
2436	set $lbl [$top.f.e${n}$i get]
2437	if {[string trim [set $lbl]] == ""} {
2438	append err " $lbl cannot be blank\n"
2439	} elseif {[catch {expr [set $lbl]}]} {
2440	append err " [set $lbl] is not valid for $lbl\n"
2441	}
2442	lappend cell [set $lbl]
2443	}
2444
2445	if {$err != ""} {
2446	MyMessageBox -parent $top -title "Replace Phase Error" -icon warning \
2447	-message "The following error(s) were found in your input:\n$err"
2448	return
2449	}
2450
2451	# check the space group
2452	set fp [open spg.in w]
2453	puts $fp "N"
2454	puts $fp "N"
2455	puts $fp $spg
2456	puts $fp "Q"
2457	close $fp
2458	global tcl_platform
2459	catch {
2460	if {$tcl_platform(platform) == "windows"} {
2461	exec [file join $expgui(gsasexe) spcgroup.exe] < spg.in >& spg.out
2462	} else {
2463	exec [file join $expgui(gsasexe) spcgroup] < spg.in >& spg.out
2464	}
2465	}
2466	set fp [open spg.out r]
2467	set out [read $fp]
2468	close $fp
2469	# attempt to parse out the output (fix up if parse did not work)
2470	if {[regexp "space group symbol.>(.)Enter a new space group symbol" \
2471	$out a b ] != 1} {set b $out}
2472	if {[string first Error $b] != -1} {
2473	# got an error, show it
2474	ShowBigMessage \
2475	$top.error \
2476	"Error processing space group\nReview error message below" \
2477	$b OK "" 1
2478	return
2479	} else {
2480	# show the result and confirm
2481	set opt [ShowBigMessage \
2482	$top.check \
2483	"Check the symmetry operators in the output below" \
2484	$b \
2485	{Continue Redo} ]
2486	if {$opt > 1} return
2487	}
2488	file delete spg.in spg.out
2489	# draw coordinates box
2490	eval destroy [winfo children $top]
2491	grid [label $top.l1 -relief groove -bd 4 -anchor center\
2492	-text "Atom list for phase #$phase"] \
2493	-column 0 -row 0 \
2494	-sticky we -columnspan 10
2495	grid [canvas $top.canvas \
2496	-scrollregion {0 0 5000 500} -width 0 -height 250 \
2497	-yscrollcommand "$top.scroll set"] \
2498	-column 0 -row 2 -columnspan 4 -sticky nsew
2499	grid columnconfigure $top 3 -weight 1
2500	grid rowconfigure $top 2 -weight 1
2501	grid rowconfigure $top 1 -pad 5
2502	scrollbar $top.scroll \
2503	-command "$top.canvas yview"
2504	frame $top.canvas.fr
2505	$top.canvas create window 0 0 -anchor nw -window $top.canvas.fr
2506
2507	set np $top.canvas.fr
2508	set row 0
2509	set col 0
2510	grid [label $np.l_${row}0 -text " # "] -column $col -row $row
2511	foreach i {Atom\ntype Name x y z Occ Uiso} \
2512	var {type name x y z occ uiso} {
2513	grid [button $np.l_${row}$i -text $i -padx 0 -pady 0 \
2514	-command "sortAddAtoms $phase $top $var"] \
2515	-column [incr col] -row $row -sticky nsew
2516	}
2517	grid [label $np.l_${row}Use -text Use\nFlag] -column [incr col] -row $row
2518
2519	# add the old atoms, if appropriate
2520	if {!$expgui(DeleteAllAtoms)} {
2521	# loop over all atoms
2522	foreach atom $expmap(atomlist_$phase) {
2523	set row [MakeAddAtomsRow $top]
2524	# add all atoms in the current phase to the list
2525	foreach w {n x y z t o} var {label x y z type frac} {
2526	$np.e${row}$w delete 0 end
2527	$np.e${row}$w insert end [atominfo $phase $atom $var]
2528	}
2529	$np.e${row}u delete 0 end
2530	if {[atominfo $phase $atom temptype] == "I"} {
2531	$np.e${row}u insert end [atominfo $phase $atom Uiso]
2532	} else {
2533	$np.e${row}u insert end [expr ( \
2534	[atominfo $phase $atom U11] + \
2535	[atominfo $phase $atom U22] + \
2536	[atominfo $phase $atom U33]) / 3.]
2537	}
2538	}
2539	}
2540
2541	# add coordinates that have been read in, if any
2542	foreach item $expgui(coordList) {
2543	set row [MakeAddAtomsRow $top]
2544	foreach val $item w {n x y z t o u} {
2545	if {$val != ""} {
2546	$np.e${row}$w delete 0 end
2547	$np.e${row}$w insert end $val
2548	}
2549	}
2550	}
2551	# a blank spot in the table
2552	MakeAddAtomsRow $top
2553
2554	bind $top <Configure> "SetAddAtomsScroll $top"
2555	grid rowconfigure $top 3 -min 10
2556	grid [button $top.b1 -text "Continue"\
2557	-command "replacephase2 $phase $top [list $spg] [list $cell]"] \
2558	-column 0 -row 5 -sticky w
2559	bind $top <Return> "replacephase2 $phase $top [list $spg] [list $cell]"
2560	grid [button $top.b2 -text Cancel \
2561	-command "destroy $top"] -column 1 -row 5 -sticky w
2562	if {[llength $expgui(importFormatList)] > 0} {
2563	grid [frame $top.fr -bd 4 -relief groove] \
2564	-column 3 -row 5 -columnspan 2 -sticky e
2565	grid [button $top.fr.b3 -text "Import atoms from: " \
2566	-command "ImportAtoms \$expgui(importFormat) $top $phase"] \
2567	-column 0 -row 0 -sticky e
2568	set menu [eval tk_optionMenu $top.fr.b4 expgui(importFormat) \
2569	$expgui(importFormatList)]
2570	for {set i 0} {$i <= [$menu index end]} {incr i} {
2571	$menu entryconfig $i -command "ImportAtoms \$expgui(importFormat) $top $phase"
2572	}
2573	grid $top.fr.b4 -column 1 -row 0 -sticky w
2574	grid rowconfig $top.fr 0 -pad 10
2575	grid columnconfig $top.fr 0 -pad 10
2576	grid columnconfig $top.fr 1 -pad 10
2577	}
2578
2579	grid [button $top.b3 -text "More atom boxes" \
2580	-command "MakeAddAtomsRow $top"] -column 3 \
2581	-columnspan 2 -row 4 -sticky e
2582
2583	wm title $top "Replacing phase: Enter atoms"
2584	SetAddAtomsScroll $top
2585
2586	# fix grab for old window
2587	afterputontop
2588	# set grab, etc.
2589	putontop $top
2590	}
2591
2592	proc replacephase2 {phase top spg cell} {
2593	global expgui expmap
2594	# validate coordinates
2595	set np $top.canvas.fr
2596	# validate the atoms info
2597	set atomlist [ValidateAtomsBox $top $np]
2598	if {$atomlist == ""} return
2599
2600	pleasewait "updating phase"
2601	set errmsg [replacephase3 $phase $spg $cell $atomlist]
2602
2603	set err 0
2604	if {[llength $atomlist] != [llength $expmap(atomlist_$phase))]} {
2605	set err 1
2606	}
2607	if {$errmsg != ""} {
2608	set err 1
2609	}
2610	donewait
2611	if {$expgui(showexptool) \|\| $err} {
2612	set msg "Please review the result from adding the atom(s)"
2613	if {$err} {append msg "\nIt appears an error occurred!"}
2614	ShowBigMessage $top $msg $errmsg OK "" $err
2615	}
2616	# set the powpref warning (2 = required)
2617	set expgui(needpowpref) 2
2618	set msg "A phase was replaced"
2619	if {[string first $msg $expgui(needpowpref_why)] == -1} {
2620	append expgui(needpowpref_why) "\t$msg\n"
2621	}
2622	destroy $top
2623	}
2624
2625
2626	proc replacephase3 {phase spg cell atomlist} {
2627	global expgui expmap
2628	# replace spacegroup and cell
2629	if $::expgui(debug) {puts "phaseinfo $phase spacegroup set $spg"}
2630	phaseinfo $phase spacegroup set $spg
2631	RecordMacroEntry "phaseinfo $phase spacegroup set [list $spg]" 0
2632	foreach val $cell var {a b c alpha beta gamma} {
2633	phaseinfo $phase $var set $val
2634	RecordMacroEntry "phaseinfo $phase $var set $val" 0
2635	}
2636	incr expgui(changed)
2637	# delete all atoms
2638	foreach i $expmap(atomlist_$phase) {
2639	EraseAtom $i $phase
2640	RecordMacroEntry "EraseAtom $i $phase" 0
2641	incr expgui(changed)
2642	}
2643	set expmap(atomlist_$phase) {}
2644	RecordMacroEntry "incr expgui(changed)" 0
2645	# write new atoms from table as input to exptool
2646	set errmsg [runAddAtoms $phase $atomlist]
2647	RecordMacroEntry "runAddAtoms $phase [list $atomlist]" 0
2648	SpaceGroupWarnings "" $phase $spg
2649	return $errmsg
2650	}
2651
2652	proc SpaceGroupWarnings {warn phase spg} {
2653	# warning on possible origin 1 setting
2654	set shift [GetOrigin1Shift $phase]
2655	if {$shift != ""} {
2656	append warn "Note that this space group ($spg) has both Origin 1 and Origin 2 settings. Origin 2 must be used in GSAS. Please check atom multiplicities (or use the Results/composition command) to verify you have the correct origin setting. Note that the Xform Atoms/Xform Origin 1 to Origin 2 button can be used to correct this.\n"
2657	} elseif {[CheckSpg $spg] == ""} {
2658	append warn "Note that this space group is not found as a standard short HermannâMauguin name. It still may be correct as input or might not be what you want. After inputting atoms, confirm that the computed density is in the expected range and that atoms have the correct site multiplicities."
2659	}
2660	if {$warn != ""} {
2661	MyMessageBox -parent . -title "Space Group Note" \
2662	-message $warn -icon warning
2663	}
2664	}
2665
2666	proc sortAddAtoms {phase top sortvar} {
2667	global expgui
2668	set np $top.canvas.fr
2669	set validlist {}
2670	set invalidlist {}
2671	set row 0
2672	while {![catch {grid info $np.e[incr row]t}]} {
2673	set valid 1
2674	set line $row
2675	if !{$expgui(UseAtom$row)} {set valid 0}
2676	lappend line $expgui(UseAtom$row)
2677	if {[set type [string trim [$np.e${row}t get]]] == ""} {set valid 0}
2678	lappend line [string trim [$np.e${row}t get]]
2679	lappend line [string trim [$np.e${row}n get]]
2680	foreach i {x y z o u} {
2681	set tmp [string trim [$np.e${row}$i get]]
2682	lappend line $tmp
2683	if {$tmp == "" \|\| [catch {expr $tmp}]} {set valid 0}
2684	}
2685	if {$valid} {
2686	lappend validlist $line
2687	} else {
2688	lappend invalidlist $line
2689	}
2690	}
2691	switch $sortvar {
2692	type {set sortlist [lsort -index 2 -dictionary $validlist]}
2693	name {set sortlist [lsort -index 3 -dictionary $validlist]}
2694	x {set sortlist [lsort -index 4 -real $validlist]}
2695	y {set sortlist [lsort -index 5 -real $validlist]}
2696	z {set sortlist [lsort -index 6 -real $validlist]}
2697	occ {set sortlist [lsort -index 7 -real $validlist]}
2698	uiso {set sortlist [lsort -index 8 -real $validlist]}
2699	default {set sortlist $validlist}
2700	}
2701
2702	if {[llength $invalidlist] > 0} {append sortlist " $invalidlist"}
2703	set row 0
2704	foreach line $sortlist {
2705	incr row
2706	set expgui(UseAtom$row) [lindex $line 1]
2707	foreach item [lrange $line 2 end] \
2708	var {t n x y z o u} {
2709	$np.e${row}$var delete 0 end
2710	$np.e${row}$var insert end $item
2711	}
2712	}
2713	}
2714
2715	proc EditInstFile {"filename {}"} {
2716	global expgui
2717	# on the first call, load the commands
2718	if {[catch {
2719	if {[info procs instMakeWindow] == ""} {
2720	source [file join $expgui(scriptdir) instedit.tcl]
2721	}
2722	} errmsg]} {
2723	MyMessageBox -parent . -title "Load error" \
2724	-message "Unexpected error while sourcing file instedit.tcl: $errmsg" \
2725	-icon error
2726	}
2727	instMakeWindow $filename
2728	}
2729
2730	# load a list of Origin 1/2 space groups
2731	proc GetOrigin12List {} {
2732	# don't need to read the file twice
2733	if {[array names ::Origin1list] != ""} return
2734	set line {}
2735	set fp1 [open [file join $::expgui(scriptdir) spacegrp.ref] r]
2736	while {[lindex $line 1] != 230} {
2737	if {[gets $fp1 line] < 0} break
2738	}
2739	while {[gets $fp1 line] >= 0} {
2740	set key [string tolower [lindex $line 8]]
2741	regsub -all " " $key "" key
2742	regsub -- "-3" $key "3" key
2743	if {$key != ""} {
2744	# puts "$key -- [lindex $line 1] [lindex $line 8] [lindex $line 9]"
2745	set ::Origin1list($key) [lindex $line 9]
2746	}
2747	}
2748	close $fp1
2749	}
2750
2751	# get the shift to be added to origin 1 coordinates to obtain origin 2 settings
2752	proc GetOrigin1Shift {phase} {
2753	GetOrigin12List
2754	set spg [string tolower [phaseinfo $phase spacegroup]]
2755	regsub -all " " $spg "" spg
2756	regsub -- "-3" $spg "3" spg
2757	if {[catch {set shift $::Origin1list($spg)}]} {
2758	return ""
2759	} else {
2760	return $shift
2761	}
2762	}
2763
2764	proc XformAtoms2Origin2 {phase numberList w1 shift} {
2765	global expgui expmap
2766	set parent [winfo toplevel $w1]
2767	if {[llength $numberList] != [llength $expmap(atomlist_$phase)]} {
2768	# not all atoms were selected in phase -- do a sanity check
2769	set msg {You have selected only some atoms to be shifted. Do you want to shift all atoms or only the selected atoms?}
2770	set val [MyMessageBox -parent $parent -icon warning \
2771	-type "{Use all} {Use Selection}" -default "use all" \
2772	-title "Shift all" -message $msg]
2773	# puts "$phase $numberList $w1 $shift"
2774	if {$val == "use all"} {set numberList $expmap(atomlist_$phase)}
2775	}
2776	if {[lindex $expmap(phasetype) [expr {$phase - 1}]] == 4} {
2777	set cmd mmatominfo
2778	} else {
2779	set cmd atominfo
2780	}
2781	foreach atom $numberList {
2782	foreach v {x y z} vs $shift {
2783	set c [$cmd $phase $atom $v]
2784	$cmd $phase $atom $v set [expr {$c + $vs}]
2785	RecordMacroEntry "$cmd $phase $atom $v set [expr {$c + $vs}]" 0
2786	}
2787	incr expgui(changed)
2788	}
2789
2790	RecordMacroEntry "incr expgui(changed)" 0
2791	ResetMultiplicities $phase $parent
2792	SelectOnePhase $phase
2793	MyMessageBox -parent $parent -type OK -default ok -title "Shift applied" \
2794	-message "A shift of \"$shift\" has been added to coordinates of atoms [CompressList $numberList]"
2795	# UpdateAtomLine $numberList $phase
2796	destroy $parent
2797	}
2798
2799	# reset the site multiplicities using the EXPEDT program
2800	proc ResetMultiplicities {phase parent} {
2801	global expgui
2802	set errmsg [RunResetMultiplicities $phase]
2803	RecordMacroEntry "RunResetMultiplicities $phase" 0
2804
2805	if {$expgui(showexptool) \|\| $errmsg != ""} {
2806	if {$errmsg != ""} {
2807	set err 1
2808	append errmsg "\n" $expgui(exptoolout)
2809	} else {
2810	set err 0
2811	set errmsg $expgui(exptoolout)
2812	}
2813	set msg "Please review the result from listing the phase."
2814	if {$errmsg != ""} {append msg "\nIt appears an error occurred!"}
2815	ShowBigMessage $parent.msg $msg $errmsg OK "" $err
2816	}
2817	}
2818	proc RunResetMultiplicities {phase} {
2819	global expgui tcl_platform
2820	set input [open resetmult.inp w]
2821	puts $input "Y"
2822	puts $input "l a p $phase"
2823	puts $input "l"
2824	puts $input "x x x"
2825	puts $input "x"
2826	close $input
2827	# Save the current exp file
2828	savearchiveexp
2829	# disable the file changed monitor
2830	set expgui(expModifiedLast) 0
2831	set expnam [file root [file tail $expgui(expfile)]]
2832	set err [catch {
2833	if {$tcl_platform(platform) == "windows"} {
2834	exec [file join $expgui(gsasexe) expedt.exe] $expnam < resetmult.inp >& resetmult.out
2835	} else {
2836	exec [file join $expgui(gsasexe) expedt] $expnam < resetmult.inp >& resetmult.out
2837	}
2838	} errmsg]
2839	loadexp $expgui(expfile)
2840	set fp [open resetmult.out r]
2841	set out [read $fp]
2842	close $fp
2843	set expgui(exptoolout) $out
2844	catch {file delete resetmult.inp resetmult.out}
2845	if {$err} {
2846	return $errmsg
2847	} else {
2848	return ""
2849	}
2850	}
2851	# space group table
2852	set spglist {
2853	"P 1" "P -1"
2854
2855	"P 2" "P 21" "P m" "P a" "P c" "P n" "P 2/m" "P 21/m"
2856	"P 2/c" "P 2/a" "P 2/n" "P 21/c" "P 21/a" "P 21/n"
2857
2858	"C 2" "C m" "C c" "C n" "C 2/m" "C 2/c" "C 2/n"
2859
2860	"P 2 2 2" "P 2 2 21" "P 2 21 2" "P 21 2 2" "P 21 21 2" "P 21 2 21"
2861	"P 2 21 21" "P 21 21 21" "P m m 2" "P m 2 m" "P 2 m m" "P m c 21"
2862	"P c m 21" "P 21 m a" "P 21 a m" "P b 21 m" "P m 21 b" "P c c 2"
2863	"P 2 a a" "P b 2 b" "P m a 2" "P b m 2" "P 2 m b" "P 2 c m"
2864	"P c 2 m" "P m 2 a" "P c a 21" "P b c 21" "P 21 a b" "P 21 c a"
2865	"P c 21 b" "P b 21 a" "P n c 2" "P c n 2" "P 2 n a" "P 2 a n"
2866	"P b 2 n" "P n 2 b" "P m n 21" "P n m 21" "P 21 m n" "P 21 n m"
2867	"P n 21 m" "P m 21 n" "P b a 2" "P 2 c b" "P c 2 a" "P n a 21"
2868	"P b n 21" "P 21 n b" "P 21 c n" "P c 21 n" "P n 21 a"
2869	"P n n 2" "P 2 n n" "P n 2 n" "P m m m" "P n n n" "P c c m"
2870	"P m a a" "P b m b" "P b a n" "P n c b" "P c n a"
2871	"P m m a" "P m m b" "P b m m" "P c m m" "P m c m" "P m a m"
2872	"P n n a" "P n n b" "P b n n" "P c n n" "P n c n" "P n a n"
2873	"P m n a" "P n m b" "P b m n" "P c n m" "P n c m" "P m a n"
2874	"P c c a" "P c c b" "P b a a" "P c a a" "P b c b" "P b a b"
2875	"P b a m" "P m c b" "P c m a" "P c c n" "P n a a" "P b n b"
2876	"P b c m" "P c a m" "P m c a" "P m a b" "P b m a" "P c m b"
2877	"P n n m" "P m n n" "P n m n" "P m m n" "P n m m" "P m n m"
2878	"P b c n" "P c a n" "P n c a" "P n a b" "P b n a" "P c n b"
2879	"P b c a" "P c a b" "P n m a" "P m n b" "P b n m" "P c m n"
2880	"P m c n" "P n a m"
2881
2882	"C 2 2 21" "C 2 2 2" "C m m 2" "C m c 21" "C c c 2" "C m 2 m" "C 2 m m"
2883	"C m 2 a" "C 2 m b" "C 2 c m" "C c 2 m" "C 2 c m" "C c 2 m"
2884	"C m c a" "C m m m" "C c c m" "C m m a" "C c c a" "C m c m"
2885
2886	"I 2 2 2" "I 21 21 21" "I m m m" "I m m 2" "I m 2 m" "I 2 m m"
2887	"I b a 2" "I 2 c b" "I c 2 a" "I m a 2" "I b m 2" "I 2 m b"
2888	"I 2 c m" "I c 2 m" "I m 2 a" "I b a m" "I m c b" "I c m a"
2889	"I b c a" "I c a b" "I m m a" "I m m b" "I b m m " "I c m m"
2890	"I m c m" "I m a m"
2891
2892	"F 2 2 2" "F m m m" "F d d d" "F m m 2" "F m 2 m" "F 2 m m"
2893	"F d d 2" "F d 2 d" "F 2 d d"
2894
2895	"P 4" "P 41" "P 42" "P 43" "P -4" "P 4/m" "P 42/m" "P 4/n" "P 42/n"
2896	"P 4 2 2" "P 4 21 2" "P 41 2 2" "P 41 21 2" "P 42 2 2"
2897	"P 42 21 2" "P 43 2 2" "P 43 21 2" "P 4 m m" "P 4 b m" "P 42 c m"
2898	"P 42 n m" "P 4 c c" "P 4 n c" "P 42 m c" "P 42 b c" "P -4 2 m"
2899	"P -4 2 c" "P -4 21 m" "P -4 21 c" "P -4 m 2" "P -4 c 2" "P -4 b 2"
2900	"P -4 n 2" "P 4/m m m" "P 4/m c c" "P 4/n b m" "P 4/n n c" "P 4/m b m"
2901	"P 4/m n c" "P 4/n m m" "P 4/n c c" "P 42/m m c" "P 42/m c m"
2902	"P 42/n b c" "P 42/n n m" "P 42/m b c" "P 42/m n m" "P 42/n m c"
2903	"P 42/n c m"
2904
2905	"I 4" "I 41" "I -4" "I 4/m" "I 41/a" "I 4 2 2" "I 41 2 2" "I 4 m m"
2906	"I 4 c m" "I 41 m d" "I 41 c d"
2907	"I -4 m 2" "I -4 c 2" "I -4 2 m" "I -4 2 d" "I 4/m m m" "I 4/m c m"
2908	"I 41/a m d" "I 41/a c d"
2909
2910	"R 3" "R -3" "R 3 2" "R 3 m" "R 3 c" "R -3 m" "R -3 c"
2911
2912	"P 3" "P 31" "P 32" "P -3" "P 3 1 2" "P 3 2 1" "P 31 1 2"
2913	"P 31 2 1" "P 32 1 2" "P 32 2 1" "P 3 m 1" "P 3 1 m" "P 3 c 1"
2914	"P 3 1 c" "P -3 1 m" "P -3 1 c" "P -3 m 1" "P -3 c 1" "P 6" "P 61"
2915	"P 65" "P 62" "P 64" "P 63" "P -6" "P 6/m" "P 63/m" "P 6 2 2"
2916	"P 61 2 2" "P 65 2 2" "P 62 2 2" "P 64 2 2" "P 63 2 2" "P 6 m m"
2917	"P 6 c c" "P 63 c m" "P 63 m c" "P -6 m 2" "P -6 c 2" "P -6 2 m"
2918	"P -6 2 c" "P 6/m m m" "P 6/m c c" "P 63/m c m" "P 63/m m c"
2919
2920	"P 2 3" "P 21 3" "P m 3" "P n 3" "P a 3" "P 4 3 2" "P 42 3 2"
2921	"P 43 3 2" "P 41 3 2" "P -4 3 m" "P -4 3 n" "P m 3 m" "P n 3 n"
2922	"P m 3 n" "P n 3 m"
2923
2924	"I 2 3" "I 21 3" "I m -3" "I a -3" "I 4 3 2" "I 41 3 2"
2925	"I -4 3 m" "I -4 3 d" "I m -3 m" "I a -3 d"
2926
2927	"F 2 3" "F m -3" "F d -3" "F 4 3 2" "F 41 3 2" "F -4 3 m"
2928	"F -4 3 c" "F m -3 m" "F m -3 c" "F d -3 m" "F d -3 c"
2929	}
2930
2931	# check a space group ignoring spaces to see if it matches a
2932	# standard one, if so adjust spaces.
2933	# retain final "R" for rhombodedral settings, but remove the optional "H"
2934	proc CheckSpg {spg} {
2935	set spg [string trim $spg]
2936	set lastchar [string toupper [string range $spg end end]]
2937	if {$lastchar == "R"} {
2938	# truncate cell setting code
2939	set spg [string range $spg 0 end-1]
2940	} elseif {$lastchar == "H"} {
2941	set spg [string range $spg 0 end-1]
2942	set lastchar ""
2943	} else {
2944	set lastchar ""
2945	}
2946	regsub -all { } [string tolower $spg] {} spg
2947	foreach s $::spglist {
2948	if {$spg == [regsub -all { } [string tolower $s] {}]} {
2949	if {$lastchar == ""} {return $s}
2950	return "$s $lastchar"
2951	}
2952	}
2953	return
2954	}
2955
2956	# default values
2957	set newhist(insttype) {}
2958	set newhist(dummy) 0
2959	set newhist(instfiletext) {}
2960	set newhist(instbanks) {}

Note: See TracBrowser for help on using the repository browser.

Context Navigation

source: trunk/addcmds.tcl

Download in other formats: