1 | # $Id: readexp.tcl 662 2009-12-04 23:09:55Z toby $ |
---|
2 | # Routines to deal with the .EXP "data structure" |
---|
3 | set expmap(Revision) {$Revision: 662 $ $Date: 2009-12-04 23:09:55 +0000 (Fri, 04 Dec 2009) $} |
---|
4 | |
---|
5 | # The GSAS data is read from an EXP file. |
---|
6 | # ... reading an EXP file into an array |
---|
7 | # returns -1 on error |
---|
8 | # returns 0 if the file is old-style UNIX format (no CR/LF) |
---|
9 | # returns 1 if the file is 80 char/line + cr/lf |
---|
10 | # returns 2 if the file is sequential but not fixed-record length |
---|
11 | proc expload {expfile} { |
---|
12 | global exparray tcl_platform |
---|
13 | # $expfile is the path to the data file. |
---|
14 | |
---|
15 | if [catch {set fil [open "$expfile" r]}] { |
---|
16 | tk_dialog .expFileErrorMsg "File Open Error" \ |
---|
17 | "Unable to open file $expfile" error 0 "Exit" |
---|
18 | return -1 |
---|
19 | } |
---|
20 | fconfigure $fil -translation lf |
---|
21 | set len [gets $fil line] |
---|
22 | if {[string length $line] != $len} { |
---|
23 | tk_dialog .expConvErrorMsg "old tcl" \ |
---|
24 | "You are using an old version of Tcl/Tk and your .EXP file has binary characters; run convstod or upgrade" \ |
---|
25 | error 0 "Exit" |
---|
26 | return -1 |
---|
27 | } |
---|
28 | catch { |
---|
29 | unset exparray |
---|
30 | } |
---|
31 | if {$len > 160} { |
---|
32 | set fmt 0 |
---|
33 | # a UNIX-type file |
---|
34 | set i1 0 |
---|
35 | set i2 79 |
---|
36 | while {$i2 < $len} { |
---|
37 | set nline [string range $line $i1 $i2] |
---|
38 | incr i1 80 |
---|
39 | incr i2 80 |
---|
40 | set key [string range $nline 0 11] |
---|
41 | set exparray($key) [string range $nline 12 end] |
---|
42 | } |
---|
43 | } else { |
---|
44 | set fmt 1 |
---|
45 | while {$len > 0} { |
---|
46 | set key [string range $line 0 11] |
---|
47 | set exparray($key) [string range $line 12 79] |
---|
48 | if {$len != 81 || [string range $line end end] != "\r"} {set fmt 2} |
---|
49 | set len [gets $fil line] |
---|
50 | } |
---|
51 | } |
---|
52 | close $fil |
---|
53 | return $fmt |
---|
54 | } |
---|
55 | |
---|
56 | proc createexp {expfile title} { |
---|
57 | global exparray expmap |
---|
58 | catch {unset exparray} |
---|
59 | foreach key {" VERSION" " DESCR" "ZZZZZZZZZZZZ" " EXPR NPHAS"} \ |
---|
60 | value {" 6" "" " Last EXP file record" ""} { |
---|
61 | # truncate long keys & pad short ones |
---|
62 | set key [string range "$key " 0 11] |
---|
63 | set exparray($key) $value |
---|
64 | } |
---|
65 | expinfo title set $title |
---|
66 | exphistory add " created readexp.tcl [lindex $expmap(Revision) 1] [clock format [clock seconds]]" |
---|
67 | expwrite $expfile |
---|
68 | } |
---|
69 | |
---|
70 | # get information out from an EXP file |
---|
71 | # creates the following entries in global array expmap |
---|
72 | # expmap(phaselist) gives a list of defined phases |
---|
73 | # expmap(phasetype) gives the phase type for each defined phase |
---|
74 | # =1 nuclear; 2 mag+nuc; 3 mag; 4 macro |
---|
75 | # expmap(atomlist_$p) gives a list of defined atoms in phase $p |
---|
76 | # expmap(htype_$n) gives the GSAS histogram type for histogram (all) |
---|
77 | # expmap(powderlist) gives a list of powder histograms in use |
---|
78 | # expmap(phaselist_$n) gives a list of phases used in histogram $n |
---|
79 | # expmap(nhst) the number of GSAS histograms |
---|
80 | # |
---|
81 | proc mapexp {} { |
---|
82 | global expmap exparray |
---|
83 | # clear out the old array |
---|
84 | set expmap_Revision $expmap(Revision) |
---|
85 | unset expmap |
---|
86 | set expmap(Revision) $expmap_Revision |
---|
87 | # get the defined phases |
---|
88 | set line [readexp " EXPR NPHAS"] |
---|
89 | # if {$line == ""} { |
---|
90 | # set msg "No EXPR NPHAS entry. This is an invalid .EXP file" |
---|
91 | # tk_dialog .badexp "Error in EXP" $msg error 0 Exit |
---|
92 | # destroy . |
---|
93 | # } |
---|
94 | set expmap(phaselist) {} |
---|
95 | set expmap(phasetype) {} |
---|
96 | # loop over phases |
---|
97 | foreach iph {1 2 3 4 5 6 7 8 9} { |
---|
98 | set i5s [expr {($iph - 1)*5}] |
---|
99 | set i5e [expr {$i5s + 4}] |
---|
100 | set flag [string trim [string range $line $i5s $i5e]] |
---|
101 | if {$flag == ""} {set flag 0} |
---|
102 | if $flag { |
---|
103 | lappend expmap(phaselist) $iph |
---|
104 | lappend expmap(phasetype) $flag |
---|
105 | } |
---|
106 | } |
---|
107 | # get the list of defined atoms for each phase |
---|
108 | foreach iph $expmap(phaselist) { |
---|
109 | set expmap(atomlist_$iph) {} |
---|
110 | if {[lindex $expmap(phasetype) [expr {$iph - 1}]] != 4} { |
---|
111 | foreach key [array names exparray "CRS$iph AT*A"] { |
---|
112 | regexp { AT *([0-9]+)A} $key a num |
---|
113 | lappend expmap(atomlist_$iph) $num |
---|
114 | } |
---|
115 | } else { |
---|
116 | foreach key [array names exparray "CRS$iph AT*"] { |
---|
117 | scan [string range $key 8 11] %x atm |
---|
118 | lappend expmap(atomlist_$iph) $atm |
---|
119 | } |
---|
120 | } |
---|
121 | # note that sometimes an .EXP file contains more atoms than are actually defined |
---|
122 | # drop the extra ones |
---|
123 | set expmap(atomlist_$iph) [lsort -integer $expmap(atomlist_$iph)] |
---|
124 | set natom [phaseinfo $iph natoms] |
---|
125 | if {$natom != [llength $expmap(atomlist_$iph)]} { |
---|
126 | set expmap(atomlist_$iph) [lrange $expmap(atomlist_$iph) 0 [expr {$natom-1}]] |
---|
127 | } |
---|
128 | } |
---|
129 | # now get the histogram types |
---|
130 | set expmap(nhst) [string trim [readexp { EXPR NHST }]] |
---|
131 | set n 0 |
---|
132 | set expmap(powderlist) {} |
---|
133 | for {set i 0} {$i < $expmap(nhst)} {incr i} { |
---|
134 | set ihist [expr {$i + 1}] |
---|
135 | if {[expr {$i % 12}] == 0} { |
---|
136 | incr n |
---|
137 | set line [readexp " EXPR HTYP$n"] |
---|
138 | if {$line == ""} { |
---|
139 | set msg "No HTYP$n entry for Histogram $ihist. This is an invalid .EXP file" |
---|
140 | tk_dialog .badexp "Error in readexp" $msg error 0 Exit |
---|
141 | } |
---|
142 | set j 0 |
---|
143 | } else { |
---|
144 | incr j |
---|
145 | } |
---|
146 | set expmap(htype_$ihist) [string range $line [expr 2+5*$j] [expr 5*($j+1)]] |
---|
147 | # is this a dummy histogram? |
---|
148 | if {$ihist <=9} { |
---|
149 | set key "HST $ihist DUMMY" |
---|
150 | } else { |
---|
151 | set key "HST $ihist DUMMY" |
---|
152 | } |
---|
153 | # at least for now, ignore non-powder histograms |
---|
154 | if {[string range $expmap(htype_$ihist) 0 0] == "P" && \ |
---|
155 | [string range $expmap(htype_$ihist) 3 3] != "*"} { |
---|
156 | if {[existsexp $key]} { |
---|
157 | set expmap(htype_$ihist) \ |
---|
158 | [string range $expmap(htype_$ihist) 0 2]D |
---|
159 | } |
---|
160 | lappend expmap(powderlist) $ihist |
---|
161 | } |
---|
162 | } |
---|
163 | |
---|
164 | # now process powder histograms |
---|
165 | foreach ihist $expmap(powderlist) { |
---|
166 | # make a 2 digit key -- hh |
---|
167 | if {$ihist < 10} { |
---|
168 | set hh " $ihist" |
---|
169 | } else { |
---|
170 | set hh $ihist |
---|
171 | } |
---|
172 | set line [readexp "HST $hh NPHAS"] |
---|
173 | if {$line == ""} { |
---|
174 | set msg "No NPHAS entry for Histogram $ihist. This is an invalid .EXP file" |
---|
175 | tk_dialog .badexp "Error in readexp" $msg error 0 Exit |
---|
176 | } |
---|
177 | set expmap(phaselist_$ihist) {} |
---|
178 | # loop over phases |
---|
179 | foreach iph {1 2 3 4 5 6 7 8 9} { |
---|
180 | set i5s [expr {($iph - 1)*5}] |
---|
181 | set i5e [expr {$i5s + 4}] |
---|
182 | set flag [string trim [string range $line $i5s $i5e]] |
---|
183 | if {$flag == ""} {set flag 0} |
---|
184 | if $flag {lappend expmap(phaselist_$ihist) $iph} |
---|
185 | } |
---|
186 | } |
---|
187 | } |
---|
188 | |
---|
189 | # return the value for a ISAM key |
---|
190 | proc readexp {key} { |
---|
191 | global exparray |
---|
192 | # truncate long keys & pad short ones |
---|
193 | set key [string range "$key " 0 11] |
---|
194 | if [catch {set val $exparray($key)}] { |
---|
195 | global expgui |
---|
196 | if $expgui(debug) {puts "Error accessing record $key"} |
---|
197 | return "" |
---|
198 | } |
---|
199 | return $val |
---|
200 | } |
---|
201 | |
---|
202 | # return the number of records matching ISAM key (may contain wildcards) |
---|
203 | proc existsexp {key} { |
---|
204 | global exparray |
---|
205 | # key can contain wild cards so don't pad |
---|
206 | return [llength [array names exparray $key]] |
---|
207 | } |
---|
208 | |
---|
209 | |
---|
210 | # replace a section of the exparray with $value |
---|
211 | # replace $char characters starting at character $start (numbered from 1) |
---|
212 | proc setexp {key value start chars} { |
---|
213 | global exparray |
---|
214 | # truncate long keys & pad short ones |
---|
215 | set key [string range "$key " 0 11] |
---|
216 | if [catch {set exparray($key)}] { |
---|
217 | global expgui |
---|
218 | if $expgui(debug) {puts "Error accessing record $key"} |
---|
219 | return "" |
---|
220 | } |
---|
221 | |
---|
222 | # pad value to $chars |
---|
223 | set l0 [expr {$chars - 1}] |
---|
224 | set value [string range "$value " 0 $l0] |
---|
225 | |
---|
226 | if {$start == 1} { |
---|
227 | set ret {} |
---|
228 | set l1 $chars |
---|
229 | } else { |
---|
230 | set l0 [expr {$start - 2}] |
---|
231 | set l1 [expr {$start + $chars - 1}] |
---|
232 | set ret [string range $exparray($key) 0 $l0] |
---|
233 | } |
---|
234 | append ret $value [string range $exparray($key) $l1 end] |
---|
235 | set exparray($key) $ret |
---|
236 | } |
---|
237 | |
---|
238 | proc makeexprec {key} { |
---|
239 | global exparray |
---|
240 | # truncate long keys & pad short ones |
---|
241 | set key [string range "$key " 0 11] |
---|
242 | if [catch {set exparray($key)}] { |
---|
243 | # set to 68 blanks |
---|
244 | set exparray($key) [format %68s " "] |
---|
245 | } |
---|
246 | } |
---|
247 | |
---|
248 | # delete an exp record |
---|
249 | # returns 1 if OK; 0 if not found |
---|
250 | proc delexp {key} { |
---|
251 | global exparray |
---|
252 | # truncate long keys & pad short ones |
---|
253 | set key [string range "$key " 0 11] |
---|
254 | if [catch {unset exparray($key)}] { |
---|
255 | return 0 |
---|
256 | } |
---|
257 | return 1 |
---|
258 | } |
---|
259 | # test an argument if it is a valid number; reform the number to fit |
---|
260 | proc validreal {val length decimal} { |
---|
261 | upvar $val value |
---|
262 | if [catch {expr {$value}}] {return 0} |
---|
263 | if [catch { |
---|
264 | # for small values, switch to exponential notation |
---|
265 | set pow [expr .2 - $decimal] |
---|
266 | if {abs($value) < pow(10,$pow) && $length > 6} { |
---|
267 | set tmp [format "%${length}.${decimal}E" $value] |
---|
268 | } else { |
---|
269 | set tmp [format "%${length}.${decimal}f" $value] |
---|
270 | } |
---|
271 | # if the string will not fit, use scientific notation & drop |
---|
272 | # digits, as needed |
---|
273 | while {[string length $tmp] > $length && $decimal >= 0} { |
---|
274 | set tmp [format "%${length}.${decimal}E" $value] |
---|
275 | incr decimal -1 |
---|
276 | } |
---|
277 | set value $tmp |
---|
278 | }] {return 0} |
---|
279 | return 1 |
---|
280 | } |
---|
281 | |
---|
282 | # test an argument if it is a valid integer; reform the number into |
---|
283 | # an integer, if appropriate -- be sure to pass the name of the variable not the value |
---|
284 | proc validint {val length} { |
---|
285 | upvar $val value |
---|
286 | # FORTRAN type assumption: blank is 0 |
---|
287 | if {$value == ""} {set value 0} |
---|
288 | if [catch { |
---|
289 | set tmp [expr {round($value)}] |
---|
290 | if {$tmp != $value} {return 0} |
---|
291 | set value [format "%${length}d" $tmp] |
---|
292 | }] {return 0} |
---|
293 | return 1 |
---|
294 | } |
---|
295 | |
---|
296 | # process history information |
---|
297 | # action == last |
---|
298 | # returns number and value of last record |
---|
299 | # action == add |
---|
300 | # |
---|
301 | proc exphistory {action "value 0"} { |
---|
302 | global exparray |
---|
303 | if {$action == "last"} { |
---|
304 | set key [lindex [lsort -decreasing [array names exparray *HSTRY*]] 0] |
---|
305 | if {$key == ""} {return ""} |
---|
306 | return [list [string trim [string range $key 9 end]] $exparray($key)] |
---|
307 | } elseif {$action == "add"} { |
---|
308 | set key [lindex [lsort -decreasing [array names exparray *HSTRY*]] 0] |
---|
309 | if {$key == ""} { |
---|
310 | set index 1 |
---|
311 | } else { |
---|
312 | set index [string trim [string range $key 9 end]] |
---|
313 | if {$index != "***"} { |
---|
314 | if {$index < 999} {incr index} |
---|
315 | set key [format " HSTRY%3d" $index] |
---|
316 | set exparray($key) $value |
---|
317 | } |
---|
318 | } |
---|
319 | set key [format " HSTRY%3d" $index] |
---|
320 | set exparray($key) $value |
---|
321 | } |
---|
322 | } |
---|
323 | # get overall info |
---|
324 | # parm: |
---|
325 | # print -- GENLES print option (*) |
---|
326 | # cycles -- number of GENLES cycles (*) |
---|
327 | # title -- the overall title (*) |
---|
328 | # convg -- convergence criterion: -200 to 200 (*) |
---|
329 | # marq -- Marquardt damping factor: 1.0 to 9.99 (*) |
---|
330 | proc expinfo {parm "action get" "value {}"} { |
---|
331 | switch ${parm}-$action { |
---|
332 | title-get { |
---|
333 | return [string trim [readexp " DESCR"]] |
---|
334 | } |
---|
335 | title-set { |
---|
336 | setexp " DESCR" " $value" 2 68 |
---|
337 | } |
---|
338 | cycles-get { |
---|
339 | return [string trim [cdatget MXCY]] |
---|
340 | } |
---|
341 | cycles-set { |
---|
342 | if ![validint value 1] {return 0} |
---|
343 | cdatset MXCY [format %4d $value] |
---|
344 | } |
---|
345 | cyclesrun-get { |
---|
346 | set cycle -1 |
---|
347 | regexp {.*cycles run *([0-9]*) } [readexp " GNLS RUN"] x cycle |
---|
348 | return $cycle |
---|
349 | } |
---|
350 | print-get { |
---|
351 | set print [string trim [cdatget PRNT]] |
---|
352 | if {$print != ""} {return $print} |
---|
353 | return 0 |
---|
354 | } |
---|
355 | print-set { |
---|
356 | if ![validint value 1] {return 0} |
---|
357 | cdatset PRNT [format %3d $value] |
---|
358 | } |
---|
359 | convg-get { |
---|
360 | set cvg [string trim [cdatget CVRG]] |
---|
361 | if {$cvg == ""} {return -200} |
---|
362 | if [catch {expr {$cvg}}] {return -200} |
---|
363 | return $cvg |
---|
364 | } |
---|
365 | convg-set { |
---|
366 | if ![validint value 1] {return 0} |
---|
367 | set value [expr {-200>$value?-200:$value}] |
---|
368 | set value [expr {200<$value?200:$value}] |
---|
369 | cdatset CVRG [format %4d $value] |
---|
370 | } |
---|
371 | marq-get { |
---|
372 | set mar [string trim [cdatget MARQ]] |
---|
373 | if {$mar == ""} {return 1.0} |
---|
374 | if [catch {expr $mar}] {return 1.} |
---|
375 | return $mar |
---|
376 | } |
---|
377 | marq-set { |
---|
378 | if [catch { |
---|
379 | set value [expr {1.0>$value?1.0:$value}] |
---|
380 | set value [expr {9.99<$value?9.99:$value}] |
---|
381 | }] {return 0} |
---|
382 | if ![validreal value 4 2] {return 0} |
---|
383 | cdatset MARQ $value |
---|
384 | } |
---|
385 | default { |
---|
386 | set msg "Unsupported expinfo access: parm=$parm action=$action" |
---|
387 | tk_dialog .badexp "Error in readexp" $msg error 0 Exit |
---|
388 | } |
---|
389 | } |
---|
390 | return 1 |
---|
391 | } |
---|
392 | |
---|
393 | proc cdatget {key} { |
---|
394 | foreach i {1 2 3 4 5 6 7 8 9} { |
---|
395 | if {[existsexp " GNLS CDAT$i"] == 0} break |
---|
396 | set line [readexp " GNLS CDAT$i"] |
---|
397 | if {$line == {}} break |
---|
398 | foreach i1 {2 10 18 26 34 42 50 58 66} \ |
---|
399 | i2 {9 17 25 33 41 49 57 65 73} { |
---|
400 | set item [string range $line $i1 $i2] |
---|
401 | if {[string trim $item] == {}} continue |
---|
402 | if [regexp "${key}(.*)" $item a b] {return $b} |
---|
403 | } |
---|
404 | } |
---|
405 | return {} |
---|
406 | } |
---|
407 | |
---|
408 | proc cdatset {key value} { |
---|
409 | # round 1 see if we can find the string |
---|
410 | foreach i {1 2 3 4 5 6 7 8 9} { |
---|
411 | set line [readexp " GNLS CDAT$i"] |
---|
412 | if {$line == {}} break |
---|
413 | foreach i1 {2 10 18 26 34 42 50 58 66} \ |
---|
414 | i2 {9 17 25 33 41 49 57 65 73} { |
---|
415 | set item [string range $line $i1 $i2] |
---|
416 | if {[string trim $item] == {}} continue |
---|
417 | if [regexp "${key}(.*)" $item a b] { |
---|
418 | # found it now replace it |
---|
419 | incr i1 |
---|
420 | setexp " GNLS CDAT$i" "${key}${value}" $i1 8 |
---|
421 | return |
---|
422 | } |
---|
423 | } |
---|
424 | } |
---|
425 | # not found, take the 1st blank space, creating a card if needed |
---|
426 | foreach i {1 2 3 4 5 6 7 8 9} { |
---|
427 | set line [readexp " GNLS CDAT$i"] |
---|
428 | if {$line == {}} {makeexprec " GNLS CDAT$i"} |
---|
429 | foreach i1 {2 10 18 26 34 42 50 58 66} \ |
---|
430 | i2 {9 17 25 33 41 49 57 65 73} { |
---|
431 | set item [string range $line $i1 $i2] |
---|
432 | if {[string trim $item] == {}} { |
---|
433 | # found a blank space: now replace it |
---|
434 | incr i1 |
---|
435 | setexp " GNLS CDAT$i" "${key}${value}" $i1 8 |
---|
436 | return |
---|
437 | } |
---|
438 | } |
---|
439 | } |
---|
440 | return {} |
---|
441 | } |
---|
442 | |
---|
443 | # get phase information: phaseinfo phase parm action value |
---|
444 | # phase: 1 to 9 (as defined) |
---|
445 | # parm: |
---|
446 | # name -- phase name |
---|
447 | # natoms -- number of atoms (*) |
---|
448 | # a b c alpha beta gamma -- cell parameters (*) |
---|
449 | # cellref -- refinement flag for the unit cell(*) |
---|
450 | # celldamp -- damping for the unit cell refinement (*) |
---|
451 | # spacegroup -- space group symbol (*) |
---|
452 | # ODForder -- spherical harmonic order (*) |
---|
453 | # ODFsym -- sample symmetry (0-3) (*) |
---|
454 | # ODFdampA -- damping for angles (*) |
---|
455 | # ODFdampC -- damping for coefficients (*) |
---|
456 | # ODFomega -- omega oriention angle (*) |
---|
457 | # ODFchi -- chi oriention angle (*) |
---|
458 | # ODFphi -- phi oriention angle (*) |
---|
459 | # ODFomegaRef -- refinement flag for omega (*) |
---|
460 | # ODFchiRef -- refinement flag for chi (*) |
---|
461 | # ODFphiRef -- refinement flag for phi (*) |
---|
462 | # ODFterms -- a list of the {l m n} values for each ODF term (*) |
---|
463 | # ODFcoefXXX -- the ODF coefficient for for ODF term XXX (*) |
---|
464 | # ODFRefcoef -- refinement flag for ODF terms (*) |
---|
465 | # action: get (default) or set |
---|
466 | # value: used only with set |
---|
467 | # * => read+write supported |
---|
468 | proc phaseinfo {phase parm "action get" "value {}"} { |
---|
469 | switch -glob ${parm}-$action { |
---|
470 | |
---|
471 | name-get { |
---|
472 | return [string trim [readexp "CRS$phase PNAM"]] |
---|
473 | } |
---|
474 | |
---|
475 | name-set { |
---|
476 | setexp "CRS$phase PNAM" " $value" 2 68 |
---|
477 | } |
---|
478 | |
---|
479 | spacegroup-get { |
---|
480 | return [string trim [readexp "CRS$phase SG SYM"]] |
---|
481 | } |
---|
482 | |
---|
483 | spacegroup-set { |
---|
484 | setexp "CRS$phase SG SYM" " $value" 2 68 |
---|
485 | } |
---|
486 | |
---|
487 | natoms-get { |
---|
488 | return [string trim [readexp "CRS$phase NATOM"]] |
---|
489 | } |
---|
490 | |
---|
491 | natoms-set { |
---|
492 | if ![validint value 5] {return 0} |
---|
493 | setexp "CRS$phase NATOM" $value 1 5 |
---|
494 | } |
---|
495 | |
---|
496 | a-get { |
---|
497 | return [string trim [string range [readexp "CRS$phase ABC"] 0 9]] |
---|
498 | } |
---|
499 | b-get { |
---|
500 | return [string trim [string range [readexp "CRS$phase ABC"] 10 19]] |
---|
501 | } |
---|
502 | c-get { |
---|
503 | return [string trim [string range [readexp "CRS$phase ABC"] 20 29]] |
---|
504 | } |
---|
505 | alpha-get { |
---|
506 | return [string trim [string range [readexp "CRS$phase ANGLES"] 0 9]] |
---|
507 | } |
---|
508 | beta-get { |
---|
509 | return [string trim [string range [readexp "CRS$phase ANGLES"] 10 19]] |
---|
510 | } |
---|
511 | gamma-get { |
---|
512 | return [string trim [string range [readexp "CRS$phase ANGLES"] 20 29]] |
---|
513 | } |
---|
514 | |
---|
515 | a-set { |
---|
516 | if ![validreal value 10 6] {return 0} |
---|
517 | setexp "CRS$phase ABC" $value 1 10 |
---|
518 | } |
---|
519 | b-set { |
---|
520 | if ![validreal value 10 6] {return 0} |
---|
521 | setexp "CRS$phase ABC" $value 11 10 |
---|
522 | } |
---|
523 | c-set { |
---|
524 | if ![validreal value 10 6] {return 0} |
---|
525 | setexp "CRS$phase ABC" $value 21 10 |
---|
526 | } |
---|
527 | alpha-set { |
---|
528 | if ![validreal value 10 4] {return 0} |
---|
529 | setexp "CRS$phase ANGLES" $value 1 10 |
---|
530 | } |
---|
531 | beta-set { |
---|
532 | if ![validreal value 10 4] {return 0} |
---|
533 | setexp "CRS$phase ANGLES" $value 11 10 |
---|
534 | } |
---|
535 | gamma-set { |
---|
536 | if ![validreal value 10 4] {return 0} |
---|
537 | setexp "CRS$phase ANGLES" $value 21 10 |
---|
538 | } |
---|
539 | cellref-get { |
---|
540 | if {[string toupper [string range [readexp "CRS$phase ABC"] 34 34]] == "Y"} { |
---|
541 | return 1 |
---|
542 | } |
---|
543 | return 0 |
---|
544 | } |
---|
545 | cellref-set { |
---|
546 | if $value { |
---|
547 | setexp "CRS$phase ABC" "Y" 35 1 |
---|
548 | } else { |
---|
549 | setexp "CRS$phase ABC" "N" 35 1 |
---|
550 | } |
---|
551 | } |
---|
552 | celldamp-get { |
---|
553 | set val [string range [readexp "CRS$phase ABC"] 39 39] |
---|
554 | if {$val == " "} {return 0} |
---|
555 | return $val |
---|
556 | } |
---|
557 | celldamp-set { |
---|
558 | setexp "CRS$phase ABC" $value 40 1 |
---|
559 | } |
---|
560 | |
---|
561 | ODForder-get { |
---|
562 | set val [string trim [string range [readexp "CRS$phase ODF"] 0 4]] |
---|
563 | if {$val == " "} {return 0} |
---|
564 | return $val |
---|
565 | } |
---|
566 | ODForder-set { |
---|
567 | if ![validint value 5] {return 0} |
---|
568 | setexp "CRS$phase ODF" $value 1 5 |
---|
569 | } |
---|
570 | ODFsym-get { |
---|
571 | set val [string trim [string range [readexp "CRS$phase ODF"] 10 14]] |
---|
572 | if {$val == " "} {return 0} |
---|
573 | return $val |
---|
574 | } |
---|
575 | ODFsym-set { |
---|
576 | if ![validint value 5] {return 0} |
---|
577 | setexp "CRS$phase ODF" $value 11 5 |
---|
578 | } |
---|
579 | ODFdampA-get { |
---|
580 | set val [string range [readexp "CRS$phase ODF"] 24 24] |
---|
581 | if {$val == " "} {return 0} |
---|
582 | return $val |
---|
583 | } |
---|
584 | ODFdampA-set { |
---|
585 | setexp "CRS$phase ODF" $value 25 1 |
---|
586 | } |
---|
587 | ODFdampC-get { |
---|
588 | set val [string range [readexp "CRS$phase ODF"] 29 29] |
---|
589 | if {$val == " "} {return 0} |
---|
590 | return $val |
---|
591 | } |
---|
592 | ODFdampC-set { |
---|
593 | setexp "CRS$phase ODF" $value 30 1 |
---|
594 | } |
---|
595 | ODFomegaRef-get { |
---|
596 | if {[string toupper [string range [readexp "CRS$phase ODF"] 16 16]] == "Y"} { |
---|
597 | return 1 |
---|
598 | } |
---|
599 | return 0 |
---|
600 | } |
---|
601 | ODFomegaRef-set { |
---|
602 | if $value { |
---|
603 | setexp "CRS$phase ODF" "Y" 17 1 |
---|
604 | } else { |
---|
605 | setexp "CRS$phase ODF" "N" 17 1 |
---|
606 | } |
---|
607 | } |
---|
608 | ODFchiRef-get { |
---|
609 | if {[string toupper [string range [readexp "CRS$phase ODF"] 17 17]] == "Y"} { |
---|
610 | return 1 |
---|
611 | } |
---|
612 | return 0 |
---|
613 | } |
---|
614 | ODFchiRef-set { |
---|
615 | if $value { |
---|
616 | setexp "CRS$phase ODF" "Y" 18 1 |
---|
617 | } else { |
---|
618 | setexp "CRS$phase ODF" "N" 18 1 |
---|
619 | } |
---|
620 | } |
---|
621 | ODFphiRef-get { |
---|
622 | if {[string toupper [string range [readexp "CRS$phase ODF"] 18 18]] == "Y"} { |
---|
623 | return 1 |
---|
624 | } |
---|
625 | return 0 |
---|
626 | } |
---|
627 | ODFphiRef-set { |
---|
628 | if $value { |
---|
629 | setexp "CRS$phase ODF" "Y" 19 1 |
---|
630 | } else { |
---|
631 | setexp "CRS$phase ODF" "N" 19 1 |
---|
632 | } |
---|
633 | } |
---|
634 | ODFcoef*-get { |
---|
635 | regsub ODFcoef $parm {} term |
---|
636 | set k [expr {($term+5)/6}] |
---|
637 | if {$k <= 9} {set k " $k"} |
---|
638 | set j [expr {(($term-1) % 6)+1}] |
---|
639 | set lineB [readexp "CRS$phase ODF${k}B"] |
---|
640 | set j0 [expr { ($j-1) *10}] |
---|
641 | set j1 [expr {$j0 + 9}] |
---|
642 | set val [string trim [string range $lineB $j0 $j1]] |
---|
643 | if {$val == ""} {return 0.0} |
---|
644 | return $val |
---|
645 | } |
---|
646 | ODFcoef*-set { |
---|
647 | regsub ODFcoef $parm {} term |
---|
648 | if ![validreal value 10 3] {return 0} |
---|
649 | set k [expr {($term+5)/6}] |
---|
650 | if {$k <= 9} {set k " $k"} |
---|
651 | set j [expr {(($term-1) % 6)+1}] |
---|
652 | set col [expr { ($j-1)*10 + 1}] |
---|
653 | setexp "CRS$phase ODF${k}B" $value $col 10 |
---|
654 | } |
---|
655 | ODFRefcoef-get { |
---|
656 | if {[string toupper [string range [readexp "CRS$phase ODF"] 19 19]] == "Y"} { |
---|
657 | return 1 |
---|
658 | } |
---|
659 | return 0 |
---|
660 | } |
---|
661 | ODFRefcoef-set { |
---|
662 | if $value { |
---|
663 | setexp "CRS$phase ODF" "Y" 20 1 |
---|
664 | } else { |
---|
665 | setexp "CRS$phase ODF" "N" 20 1 |
---|
666 | } |
---|
667 | } |
---|
668 | ODFomega-get { |
---|
669 | return [string trim [string range [readexp "CRS$phase ODF"] 30 39]] |
---|
670 | } |
---|
671 | ODFchi-get { |
---|
672 | return [string trim [string range [readexp "CRS$phase ODF"] 40 49]] |
---|
673 | } |
---|
674 | ODFphi-get { |
---|
675 | return [string trim [string range [readexp "CRS$phase ODF"] 50 59]] |
---|
676 | } |
---|
677 | ODFomega-set { |
---|
678 | if ![validreal value 10 4] {return 0} |
---|
679 | setexp "CRS$phase ODF" $value 31 10 |
---|
680 | } |
---|
681 | ODFchi-set { |
---|
682 | if ![validreal value 10 4] {return 0} |
---|
683 | setexp "CRS$phase ODF" $value 41 10 |
---|
684 | } |
---|
685 | ODFphi-set { |
---|
686 | if ![validreal value 10 4] {return 0} |
---|
687 | setexp "CRS$phase ODF" $value 51 10 |
---|
688 | } |
---|
689 | |
---|
690 | ODFterms-get { |
---|
691 | set vallist {} |
---|
692 | set val [string trim [string range [readexp "CRS$phase ODF"] 5 9]] |
---|
693 | for {set i 1} {$i <= $val} {incr i 6} { |
---|
694 | set k [expr {1+($i-1)/6}] |
---|
695 | if {$k <= 9} {set k " $k"} |
---|
696 | set lineA [readexp "CRS$phase ODF${k}A"] |
---|
697 | set k 0 |
---|
698 | for {set j $i} {$j <= $val && $j < $i+6} {incr j} { |
---|
699 | set j0 [expr {($k)*10}] |
---|
700 | set j1 [expr {$j0 + 9}] |
---|
701 | lappend vallist [string trim [string range $lineA $j0 $j1]] |
---|
702 | incr k |
---|
703 | } |
---|
704 | } |
---|
705 | return $vallist |
---|
706 | } |
---|
707 | ODFterms-set { |
---|
708 | set key "CRS$phase ODF " |
---|
709 | if {![existsexp $key]} { |
---|
710 | makeexprec $key |
---|
711 | set oldlen 0 |
---|
712 | } else { |
---|
713 | set oldlen [string trim [string range [readexp $key] 5 9]] |
---|
714 | } |
---|
715 | set len [llength $value] |
---|
716 | if ![validint len 5] {return 0} |
---|
717 | setexp $key $len 6 5 |
---|
718 | set j 0 |
---|
719 | set k 0 |
---|
720 | foreach item $value { |
---|
721 | incr j |
---|
722 | if {$j % 6 == 1} { |
---|
723 | incr k |
---|
724 | if {$k <= 9} {set k " $k"} |
---|
725 | set col 1 |
---|
726 | set keyA "CRS$phase ODF${k}A" |
---|
727 | set keyB "CRS$phase ODF${k}B" |
---|
728 | if {![existsexp $keyA]} { |
---|
729 | makeexprec $keyA |
---|
730 | makeexprec $keyB |
---|
731 | } |
---|
732 | } |
---|
733 | set col1 [expr {$col + 1}] |
---|
734 | foreach n [lrange $item 0 2] { |
---|
735 | if ![validint n 3] {return 0} |
---|
736 | setexp $keyA $n $col1 3 |
---|
737 | incr col1 3 |
---|
738 | } |
---|
739 | incr col 10 |
---|
740 | } |
---|
741 | for {incr j} {$j <= $oldlen} {incr j} { |
---|
742 | if {$j % 6 == 1} { |
---|
743 | incr k |
---|
744 | if {$k <= 9} {set k " $k"} |
---|
745 | set col 1 |
---|
746 | set keyA "CRS$phase ODF${k}A" |
---|
747 | set keyB "CRS$phase ODF${k}B" |
---|
748 | delexp $keyA |
---|
749 | delexp $keyB |
---|
750 | } |
---|
751 | if {[existsexp $keyA]} { |
---|
752 | setexp $keyA " " $col 10 |
---|
753 | setexp $keyB " " $col 10 |
---|
754 | } |
---|
755 | incr col 10 |
---|
756 | } |
---|
757 | } |
---|
758 | |
---|
759 | default { |
---|
760 | set msg "Unsupported phaseinfo access: parm=$parm action=$action" |
---|
761 | tk_dialog .badexp "Error in readexp" $msg error 0 Exit |
---|
762 | } |
---|
763 | } |
---|
764 | return 1 |
---|
765 | } |
---|
766 | |
---|
767 | |
---|
768 | # get atom information: atominfo phase atom parm action value |
---|
769 | # phase: 1 to 9 (as defined) |
---|
770 | # atom: a valid atom number [see expmap(atomlist_$phase)] |
---|
771 | # Note that atom and phase can be paired lists, but if there are extra |
---|
772 | # entries in the atoms list, the last phase will be repeated. |
---|
773 | # so that atominfo 1 {1 2 3} xset 1 |
---|
774 | # will set the xflag for atoms 1-3 in phase 1 |
---|
775 | # but atominfo {1 2 3} {1 1 1} xset 1 |
---|
776 | # will set the xflag for atoms 1 in phase 1-3 |
---|
777 | # parm: |
---|
778 | # type -- element code |
---|
779 | # mult -- atom multiplicity |
---|
780 | # label -- atom label (*) |
---|
781 | # x y z -- coordinates (*) |
---|
782 | # frac -- occupancy (*) |
---|
783 | # temptype -- I or A for Isotropic/Anisotropic (*) |
---|
784 | # Uiso -- Isotropic temperature factor (*) |
---|
785 | # U11 -- Anisotropic temperature factor (*) |
---|
786 | # U22 -- Anisotropic temperature factor (*) |
---|
787 | # U33 -- Anisotropic temperature factor (*) |
---|
788 | # U12 -- Anisotropic temperature factor (*) |
---|
789 | # U13 -- Anisotropic temperature factor (*) |
---|
790 | # U23 -- Anisotropic temperature factor (*) |
---|
791 | # xref/xdamp -- refinement flag/damping value for the coordinates (*) |
---|
792 | # uref/udamp -- refinement flag/damping value for the temperature factor(s) (*) |
---|
793 | # fref/fdamp -- refinement flag/damping value for the occupancy (*) |
---|
794 | # action: get (default) or set |
---|
795 | # value: used only with set |
---|
796 | # * => read+write supported |
---|
797 | proc atominfo {phaselist atomlist parm "action get" "value {}"} { |
---|
798 | foreach phase $phaselist atom $atomlist { |
---|
799 | if {$phase == ""} {set phase [lindex $phaselist end]} |
---|
800 | if {$atom < 10} { |
---|
801 | set key "CRS$phase AT $atom" |
---|
802 | } elseif {$atom < 100} { |
---|
803 | set key "CRS$phase AT $atom" |
---|
804 | } else { |
---|
805 | set key "CRS$phase AT$atom" |
---|
806 | } |
---|
807 | switch -glob ${parm}-$action { |
---|
808 | type-get { |
---|
809 | return [string trim [string range [readexp ${key}A] 2 9] ] |
---|
810 | } |
---|
811 | mult-get { |
---|
812 | return [string trim [string range [readexp ${key}A] 58 61] ] |
---|
813 | } |
---|
814 | label-get { |
---|
815 | return [string trim [string range [readexp ${key}A] 50 57] ] |
---|
816 | } |
---|
817 | label-set { |
---|
818 | setexp ${key}A $value 51 8 |
---|
819 | } |
---|
820 | temptype-get { |
---|
821 | return [string trim [string range [readexp ${key}B] 62 62] ] |
---|
822 | } |
---|
823 | temptype-set { |
---|
824 | if {$value == "A"} { |
---|
825 | setexp ${key}B A 63 1 |
---|
826 | # copy the Uiso to the diagonal terms |
---|
827 | set Uiso [string range [readexp ${key}B] 0 9] |
---|
828 | foreach value [CalcAniso $phase $Uiso] \ |
---|
829 | col {1 11 21 31 41 51} { |
---|
830 | validreal value 10 6 |
---|
831 | setexp ${key}B $value $col 10 |
---|
832 | } |
---|
833 | } else { |
---|
834 | setexp ${key}B I 63 1 |
---|
835 | set value 0.0 |
---|
836 | catch { |
---|
837 | # get the trace |
---|
838 | set value [expr {( \ |
---|
839 | [string range [readexp ${key}B] 0 9] + \ |
---|
840 | [string range [readexp ${key}B] 10 19] + \ |
---|
841 | [string range [readexp ${key}B] 20 29])/3.}] |
---|
842 | } |
---|
843 | validreal value 10 6 |
---|
844 | setexp ${key}B $value 1 10 |
---|
845 | # blank out the remaining terms |
---|
846 | set value " " |
---|
847 | setexp ${key}B $value 11 10 |
---|
848 | setexp ${key}B $value 21 10 |
---|
849 | setexp ${key}B $value 31 10 |
---|
850 | setexp ${key}B $value 41 10 |
---|
851 | setexp ${key}B $value 51 10 |
---|
852 | } |
---|
853 | } |
---|
854 | x-get { |
---|
855 | return [string trim [string range [readexp ${key}A] 10 19] ] |
---|
856 | } |
---|
857 | x-set { |
---|
858 | if ![validreal value 10 6] {return 0} |
---|
859 | setexp ${key}A $value 11 10 |
---|
860 | } |
---|
861 | y-get { |
---|
862 | return [string trim [string range [readexp ${key}A] 20 29] ] |
---|
863 | } |
---|
864 | y-set { |
---|
865 | if ![validreal value 10 6] {return 0} |
---|
866 | setexp ${key}A $value 21 10 |
---|
867 | } |
---|
868 | z-get { |
---|
869 | return [string trim [string range [readexp ${key}A] 30 39] ] |
---|
870 | } |
---|
871 | z-set { |
---|
872 | if ![validreal value 10 6] {return 0} |
---|
873 | setexp ${key}A $value 31 10 |
---|
874 | } |
---|
875 | frac-get { |
---|
876 | return [string trim [string range [readexp ${key}A] 40 49] ] |
---|
877 | } |
---|
878 | frac-set { |
---|
879 | if ![validreal value 10 6] {return 0} |
---|
880 | setexp ${key}A $value 41 10 |
---|
881 | } |
---|
882 | U*-get { |
---|
883 | regsub U $parm {} type |
---|
884 | if {$type == "iso" || $type == "11"} { |
---|
885 | return [string trim [string range [readexp ${key}B] 0 9] ] |
---|
886 | } elseif {$type == "22"} { |
---|
887 | return [string trim [string range [readexp ${key}B] 10 19] ] |
---|
888 | } elseif {$type == "33"} { |
---|
889 | return [string trim [string range [readexp ${key}B] 20 29] ] |
---|
890 | } elseif {$type == "12"} { |
---|
891 | return [string trim [string range [readexp ${key}B] 30 39] ] |
---|
892 | } elseif {$type == "13"} { |
---|
893 | return [string trim [string range [readexp ${key}B] 40 49] ] |
---|
894 | } elseif {$type == "23"} { |
---|
895 | return [string trim [string range [readexp ${key}B] 50 59] ] |
---|
896 | } |
---|
897 | } |
---|
898 | U*-set { |
---|
899 | if ![validreal value 10 6] {return 0} |
---|
900 | regsub U $parm {} type |
---|
901 | if {$type == "iso" || $type == "11"} { |
---|
902 | setexp ${key}B $value 1 10 |
---|
903 | } elseif {$type == "22"} { |
---|
904 | setexp ${key}B $value 11 10 |
---|
905 | } elseif {$type == "33"} { |
---|
906 | setexp ${key}B $value 21 10 |
---|
907 | } elseif {$type == "12"} { |
---|
908 | setexp ${key}B $value 31 10 |
---|
909 | } elseif {$type == "13"} { |
---|
910 | setexp ${key}B $value 41 10 |
---|
911 | } elseif {$type == "23"} { |
---|
912 | setexp ${key}B $value 51 10 |
---|
913 | } |
---|
914 | } |
---|
915 | xref-get { |
---|
916 | if {[string toupper [string range [readexp ${key}B] 64 64]] == "X"} { |
---|
917 | return 1 |
---|
918 | } |
---|
919 | return 0 |
---|
920 | } |
---|
921 | xref-set { |
---|
922 | if $value { |
---|
923 | setexp ${key}B "X" 65 1 |
---|
924 | } else { |
---|
925 | setexp ${key}B " " 65 1 |
---|
926 | } |
---|
927 | } |
---|
928 | xdamp-get { |
---|
929 | set val [string range [readexp ${key}A] 64 64] |
---|
930 | if {$val == " "} {return 0} |
---|
931 | return $val |
---|
932 | } |
---|
933 | xdamp-set { |
---|
934 | setexp ${key}A $value 65 1 |
---|
935 | } |
---|
936 | fref-get { |
---|
937 | if {[string toupper [string range [readexp ${key}B] 63 63]] == "F"} { |
---|
938 | return 1 |
---|
939 | } |
---|
940 | return 0 |
---|
941 | } |
---|
942 | fref-set { |
---|
943 | if $value { |
---|
944 | setexp ${key}B "F" 64 1 |
---|
945 | } else { |
---|
946 | setexp ${key}B " " 64 1 |
---|
947 | } |
---|
948 | } |
---|
949 | fdamp-get { |
---|
950 | set val [string range [readexp ${key}A] 63 63] |
---|
951 | if {$val == " "} {return 0} |
---|
952 | return $val |
---|
953 | } |
---|
954 | fdamp-set { |
---|
955 | setexp ${key}A $value 64 1 |
---|
956 | } |
---|
957 | |
---|
958 | uref-get { |
---|
959 | if {[string toupper [string range [readexp ${key}B] 65 65]] == "U"} { |
---|
960 | return 1 |
---|
961 | } |
---|
962 | return 0 |
---|
963 | } |
---|
964 | uref-set { |
---|
965 | if $value { |
---|
966 | setexp ${key}B "U" 66 1 |
---|
967 | } else { |
---|
968 | setexp ${key}B " " 66 1 |
---|
969 | } |
---|
970 | } |
---|
971 | udamp-get { |
---|
972 | set val [string range [readexp ${key}A] 65 65] |
---|
973 | if {$val == " "} {return 0} |
---|
974 | return $val |
---|
975 | } |
---|
976 | udamp-set { |
---|
977 | setexp ${key}A $value 66 1 |
---|
978 | } |
---|
979 | default { |
---|
980 | set msg "Unsupported atominfo access: parm=$parm action=$action" |
---|
981 | tk_dialog .badexp "Error in readexp" $msg error 0 Exit |
---|
982 | } |
---|
983 | } |
---|
984 | } |
---|
985 | return 1 |
---|
986 | } |
---|
987 | |
---|
988 | # get macromolecular atom information: mmatominfo phase atom parm action value |
---|
989 | # phase: 1 (at present only one mm phase can be defined) |
---|
990 | # atom: a valid atom number [see expmap(atomlist_$phase)] |
---|
991 | # Note that atoms can be lists |
---|
992 | # so that mmatominfo 1 {1 2 3} xset 1 |
---|
993 | # will set the xflag for atoms 1-3 in phase 1 |
---|
994 | # parm: |
---|
995 | # type -- element code |
---|
996 | # frac -- occupancy (*) |
---|
997 | # x y z -- coordinates (*) |
---|
998 | # Uiso -- Isotropic temperature factor (*) |
---|
999 | # label -- atom label (*) |
---|
1000 | # residue -- residue label (*) |
---|
1001 | # group -- group label (*) |
---|
1002 | # resnum -- residue number (*) |
---|
1003 | # xref/xdamp -- refinement flag/damping value for the coordinates (*) |
---|
1004 | # uref/udamp -- refinement flag/damping value for the temperature factor(s) (*) |
---|
1005 | # fref/fdamp -- refinement flag/damping value for the occupancy (*) |
---|
1006 | # action: get (default) or set |
---|
1007 | # value: used only with set |
---|
1008 | # * => read+write supported |
---|
1009 | proc mmatominfo {phaselist atomlist parm "action get" "value {}"} { |
---|
1010 | foreach phase $phaselist atom $atomlist { |
---|
1011 | if {$phase == ""} {set phase [lindex $phaselist end]} |
---|
1012 | set num [string toupper [format %.4x $atom]] |
---|
1013 | set key "CRS$phase AT$num" |
---|
1014 | switch -glob ${parm}-$action { |
---|
1015 | type-get { |
---|
1016 | return [string trim [string range [readexp ${key}] 2 9] ] |
---|
1017 | } |
---|
1018 | frac-get { |
---|
1019 | return [string trim [string range [readexp ${key}] 10 15] ] |
---|
1020 | } |
---|
1021 | frac-set { |
---|
1022 | if ![validreal value 6 4] {return 0} |
---|
1023 | setexp ${key} $value 11 6 |
---|
1024 | } |
---|
1025 | x-get { |
---|
1026 | return [string trim [string range [readexp ${key}] 16 23] ] |
---|
1027 | } |
---|
1028 | x-set { |
---|
1029 | if ![validreal value 8 5] {return 0} |
---|
1030 | setexp ${key} $value 17 8 |
---|
1031 | } |
---|
1032 | y-get { |
---|
1033 | return [string trim [string range [readexp ${key}] 24 31] ] |
---|
1034 | } |
---|
1035 | y-set { |
---|
1036 | if ![validreal value 8 5] {return 0} |
---|
1037 | setexp ${key} $value 25 8 |
---|
1038 | } |
---|
1039 | z-get { |
---|
1040 | return [string trim [string range [readexp ${key}] 32 39] ] |
---|
1041 | } |
---|
1042 | z-set { |
---|
1043 | if ![validreal value 8 5] {return 0} |
---|
1044 | setexp ${key} $value 33 8 |
---|
1045 | } |
---|
1046 | Uiso-get { |
---|
1047 | return [string trim [string range [readexp ${key}] 40 45] ] |
---|
1048 | } |
---|
1049 | Uiso-set { |
---|
1050 | if ![validreal value 6 4] {return 0} |
---|
1051 | setexp ${key} $value 41 6 |
---|
1052 | } |
---|
1053 | label-get { |
---|
1054 | return [string trim [string range [readexp ${key}] 46 50] ] |
---|
1055 | } |
---|
1056 | label-set { |
---|
1057 | setexp ${key} $value 47 5 |
---|
1058 | } |
---|
1059 | residue-get { |
---|
1060 | return [string range [readexp ${key}] 51 53] |
---|
1061 | } |
---|
1062 | residue-set { |
---|
1063 | setexp ${key} $value 52 3 |
---|
1064 | } |
---|
1065 | group-get { |
---|
1066 | return [string range [readexp ${key}] 54 55] |
---|
1067 | } |
---|
1068 | group-set { |
---|
1069 | setexp ${key} $value 55 2 |
---|
1070 | } |
---|
1071 | resnum-get { |
---|
1072 | return [string trim [string range [readexp ${key}] 56 59] ] |
---|
1073 | } |
---|
1074 | resnum-set { |
---|
1075 | if ![validint value 4] {return 0} |
---|
1076 | setexp "${key} EPHAS" $value 57 4 |
---|
1077 | } |
---|
1078 | fref-get { |
---|
1079 | if {[string toupper [string range [readexp $key] 60 60]] == "F"} { |
---|
1080 | return 1 |
---|
1081 | } |
---|
1082 | return 0 |
---|
1083 | } |
---|
1084 | fref-set { |
---|
1085 | if $value { |
---|
1086 | setexp $key "F" 61 1 |
---|
1087 | } else { |
---|
1088 | setexp $key " " 61 1 |
---|
1089 | } |
---|
1090 | } |
---|
1091 | xref-get { |
---|
1092 | if {[string toupper [string range [readexp $key] 61 61]] == "X"} { |
---|
1093 | return 1 |
---|
1094 | } |
---|
1095 | return 0 |
---|
1096 | } |
---|
1097 | xref-set { |
---|
1098 | if $value { |
---|
1099 | setexp $key "X" 62 1 |
---|
1100 | } else { |
---|
1101 | setexp ${key}B " " 62 1 |
---|
1102 | } |
---|
1103 | } |
---|
1104 | uref-get { |
---|
1105 | if {[string toupper [string range [readexp $key] 62 62]] == "U"} { |
---|
1106 | return 1 |
---|
1107 | } |
---|
1108 | return 0 |
---|
1109 | } |
---|
1110 | uref-set { |
---|
1111 | if $value { |
---|
1112 | setexp $key "U" 63 1 |
---|
1113 | } else { |
---|
1114 | setexp $key " " 63 1 |
---|
1115 | } |
---|
1116 | } |
---|
1117 | |
---|
1118 | fdamp-get { |
---|
1119 | set val [string range [readexp ${key}] 63 63] |
---|
1120 | if {$val == " "} {return 0} |
---|
1121 | return $val |
---|
1122 | } |
---|
1123 | fdamp-set { |
---|
1124 | setexp ${key} $value 64 1 |
---|
1125 | } |
---|
1126 | xdamp-get { |
---|
1127 | set val [string range [readexp ${key}] 64 64] |
---|
1128 | if {$val == " "} {return 0} |
---|
1129 | return $val |
---|
1130 | } |
---|
1131 | xdamp-set { |
---|
1132 | setexp ${key} $value 65 1 |
---|
1133 | } |
---|
1134 | |
---|
1135 | udamp-get { |
---|
1136 | set val [string range [readexp ${key}] 65 65] |
---|
1137 | if {$val == " "} {return 0} |
---|
1138 | return $val |
---|
1139 | } |
---|
1140 | udamp-set { |
---|
1141 | setexp ${key} $value 66 1 |
---|
1142 | } |
---|
1143 | default { |
---|
1144 | set msg "Unsupported mmatominfo access: parm=$parm action=$action" |
---|
1145 | tk_dialog .badexp "Error in readexp" $msg error 0 Exit |
---|
1146 | } |
---|
1147 | } |
---|
1148 | } |
---|
1149 | return 1 |
---|
1150 | } |
---|
1151 | |
---|
1152 | |
---|
1153 | |
---|
1154 | # get histogram information: histinfo histlist parm action value |
---|
1155 | # histlist is a list of histogram numbers |
---|
1156 | # parm: |
---|
1157 | # title |
---|
1158 | # file -- file name of raw data for histogram (*) |
---|
1159 | # scale (*) |
---|
1160 | # sref/sdamp -- refinement flag/damping value for the scale factor (*) |
---|
1161 | # lam1, lam2 (*) |
---|
1162 | # ttref refinement flag for the 2theta (ED Xray) (*) |
---|
1163 | # wref refinement flag for the wavelength (*) |
---|
1164 | # ratref refinement flag for the wavelength ratio (*) |
---|
1165 | # difc, difa -- TOF calibration constants (*) |
---|
1166 | # dcref,daref -- refinement flag for difc, difa (*) |
---|
1167 | # zero (*) |
---|
1168 | # zref refinement flag for the zero correction (*) |
---|
1169 | # ipola (*) |
---|
1170 | # pola (*) |
---|
1171 | # pref refinement flag for the polarization (*) |
---|
1172 | # kratio (*) |
---|
1173 | # ddamp -- damping value for the diffractometer constants (*) |
---|
1174 | # backtype -- background function number * |
---|
1175 | # backterms -- number of background terms * |
---|
1176 | # bref/bdamp -- refinement flag/damping value for the background (*) |
---|
1177 | # bterm$n -- background term #n (*) |
---|
1178 | # bank -- Bank number |
---|
1179 | # tofangle -- detector angle (TOF only) |
---|
1180 | # foextract -- Fobs extraction flag (*) |
---|
1181 | # LBdamp -- LeBail damping value (*) |
---|
1182 | # tmin/tmax -- minimum & maximum usable 2theta/TOF/energy |
---|
1183 | # excl -- excluded regions (*) |
---|
1184 | # dmin -- minimum d-space for reflection generation (*) |
---|
1185 | # use -- use flag; 1 = use; 0 = do not use (*) |
---|
1186 | # dstart -- dummy histogram starting tmin/emin/2theta (*) |
---|
1187 | # dstep -- dummy histogram step size tmin/emin/2theta (*) |
---|
1188 | # dpoints -- dummy histogram number of points (*) |
---|
1189 | # dtype -- dummy histogram type (CONST or SLOG) |
---|
1190 | # abscor1 -- 1st absorption correction (*) |
---|
1191 | # abscor2 -- 2nd absorption correction (*) |
---|
1192 | # abstype -- absorption correction type (*) |
---|
1193 | # absdamp -- damping for absorption refinement (*) |
---|
1194 | # absref -- refinement damping for absorption refinement (*) |
---|
1195 | # parameters transferred from the instrument parameter file: |
---|
1196 | # ITYP -- returns the contents of the ITYP record |
---|
1197 | proc histinfo {histlist parm "action get" "value {}"} { |
---|
1198 | global expgui |
---|
1199 | foreach hist $histlist { |
---|
1200 | if {$hist < 10} { |
---|
1201 | set key "HST $hist" |
---|
1202 | } else { |
---|
1203 | set key "HST $hist" |
---|
1204 | } |
---|
1205 | switch -glob ${parm}-$action { |
---|
1206 | foextract-get { |
---|
1207 | set line [readexp "${key} EPHAS"] |
---|
1208 | # add a EPHAS if not exists |
---|
1209 | if {$line == {}} { |
---|
1210 | makeexprec "${key} EPHAS" |
---|
1211 | # expedt defaults this to "F", but I think "T" is better |
---|
1212 | setexp "${key} EPHAS" "Y" 50 1 |
---|
1213 | if $expgui(debug) {puts "Warning: creating a ${key} EPHAS record"} |
---|
1214 | } |
---|
1215 | if {[string toupper [string range $line 49 49]] == "T"} { |
---|
1216 | return 1 |
---|
1217 | } |
---|
1218 | # the flag has changed to "Y/N" in the latest versions |
---|
1219 | # of GSAS |
---|
1220 | if {[string toupper [string range $line 49 49]] == "Y"} { |
---|
1221 | return 1 |
---|
1222 | } |
---|
1223 | return 0 |
---|
1224 | } |
---|
1225 | foextract-set { |
---|
1226 | # the flag has changed to "Y/N" in the latest versions |
---|
1227 | # of GSAS |
---|
1228 | if $value { |
---|
1229 | setexp "${key} EPHAS" "Y" 50 1 |
---|
1230 | } else { |
---|
1231 | setexp "${key} EPHAS" "N" 50 1 |
---|
1232 | } |
---|
1233 | } |
---|
1234 | LBdamp-get { |
---|
1235 | set v [string trim [string range [readexp "${key} EPHAS"] 54 54]] |
---|
1236 | if {$v == ""} {return 0} |
---|
1237 | return $v |
---|
1238 | } |
---|
1239 | LBdamp-set { |
---|
1240 | if ![validint value 5] {return 0} |
---|
1241 | setexp "${key} EPHAS" $value 51 5 |
---|
1242 | } |
---|
1243 | title-get { |
---|
1244 | return [string trim [readexp "${key} HNAM"] ] |
---|
1245 | } |
---|
1246 | scale-get { |
---|
1247 | return [string trim [string range [readexp ${key}HSCALE] 0 14]] |
---|
1248 | } |
---|
1249 | scale-set { |
---|
1250 | if ![validreal value 15 6] {return 0} |
---|
1251 | setexp ${key}HSCALE $value 1 15 |
---|
1252 | } |
---|
1253 | sref-get { |
---|
1254 | if {[string toupper [string range [readexp ${key}HSCALE] 19 19]] == "Y"} { |
---|
1255 | return 1 |
---|
1256 | } |
---|
1257 | return 0 |
---|
1258 | } |
---|
1259 | sref-set { |
---|
1260 | if $value { |
---|
1261 | setexp ${key}HSCALE "Y" 20 1 |
---|
1262 | } else { |
---|
1263 | setexp ${key}HSCALE "N" 20 1 |
---|
1264 | } |
---|
1265 | } |
---|
1266 | sdamp-get { |
---|
1267 | set val [string range [readexp ${key}HSCALE] 24 24] |
---|
1268 | if {$val == " "} {return 0} |
---|
1269 | return $val |
---|
1270 | } |
---|
1271 | sdamp-set { |
---|
1272 | setexp ${key}HSCALE $value 25 1 |
---|
1273 | } |
---|
1274 | |
---|
1275 | difc-get - |
---|
1276 | lam1-get { |
---|
1277 | return [string trim [string range [readexp "${key} ICONS"] 0 9]] |
---|
1278 | } |
---|
1279 | difc-set - |
---|
1280 | lam1-set { |
---|
1281 | if ![validreal value 10 7] {return 0} |
---|
1282 | setexp "${key} ICONS" $value 1 10 |
---|
1283 | } |
---|
1284 | difa-get - |
---|
1285 | lam2-get { |
---|
1286 | return [string trim [string range [readexp "${key} ICONS"] 10 19]] |
---|
1287 | } |
---|
1288 | difa-set - |
---|
1289 | lam2-set { |
---|
1290 | if ![validreal value 10 7] {return 0} |
---|
1291 | setexp "${key} ICONS" $value 11 10 |
---|
1292 | } |
---|
1293 | zero-get { |
---|
1294 | return [string trim [string range [readexp "${key} ICONS"] 20 29]] |
---|
1295 | } |
---|
1296 | zero-set { |
---|
1297 | if ![validreal value 10 5] {return 0} |
---|
1298 | setexp "${key} ICONS" $value 21 10 |
---|
1299 | } |
---|
1300 | ipola-get { |
---|
1301 | return [string trim [string range [readexp "${key} ICONS"] 54 54]] |
---|
1302 | } |
---|
1303 | ipola-set { |
---|
1304 | if ![validint value 1] {return 0} |
---|
1305 | setexp "${key} ICONS" $value 55 1 |
---|
1306 | } |
---|
1307 | pola-get { |
---|
1308 | return [string trim [string range [readexp "${key} ICONS"] 40 49]] |
---|
1309 | } |
---|
1310 | pola-set { |
---|
1311 | if ![validreal value 10 5] {return 0} |
---|
1312 | setexp "${key} ICONS" $value 41 10 |
---|
1313 | } |
---|
1314 | kratio-get { |
---|
1315 | return [string trim [string range [readexp "${key} ICONS"] 55 64]] |
---|
1316 | } |
---|
1317 | kratio-set { |
---|
1318 | if ![validreal value 10 5] {return 0} |
---|
1319 | setexp "${key} ICONS" $value 56 10 |
---|
1320 | } |
---|
1321 | |
---|
1322 | wref-get { |
---|
1323 | #------------------------------------------------------ |
---|
1324 | # col 33: refine flag for lambda, difc, ratio and theta |
---|
1325 | #------------------------------------------------------ |
---|
1326 | if {[string toupper [string range \ |
---|
1327 | [readexp "${key} ICONS"] 32 32]] == "L"} { |
---|
1328 | return 1 |
---|
1329 | } |
---|
1330 | return 0 |
---|
1331 | } |
---|
1332 | wref-set { |
---|
1333 | if $value { |
---|
1334 | setexp "${key} ICONS" "L" 33 1 |
---|
1335 | } else { |
---|
1336 | setexp "${key} ICONS" " " 33 1 |
---|
1337 | } |
---|
1338 | } |
---|
1339 | ratref-get { |
---|
1340 | if {[string toupper [string range \ |
---|
1341 | [readexp "${key} ICONS"] 32 32]] == "R"} { |
---|
1342 | return 1 |
---|
1343 | } |
---|
1344 | return 0 |
---|
1345 | } |
---|
1346 | ratref-set { |
---|
1347 | if $value { |
---|
1348 | setexp "${key} ICONS" "R" 33 1 |
---|
1349 | } else { |
---|
1350 | setexp "${key} ICONS" " " 33 1 |
---|
1351 | } |
---|
1352 | } |
---|
1353 | dcref-get { |
---|
1354 | if {[string toupper [string range \ |
---|
1355 | [readexp "${key} ICONS"] 32 32]] == "C"} { |
---|
1356 | return 1 |
---|
1357 | } |
---|
1358 | return 0 |
---|
1359 | } |
---|
1360 | dcref-set { |
---|
1361 | if $value { |
---|
1362 | setexp "${key} ICONS" "C" 33 1 |
---|
1363 | } else { |
---|
1364 | setexp "${key} ICONS" " " 33 1 |
---|
1365 | } |
---|
1366 | } |
---|
1367 | ttref-get { |
---|
1368 | if {[string toupper [string range \ |
---|
1369 | [readexp "${key} ICONS"] 32 32]] == "T"} { |
---|
1370 | return 1 |
---|
1371 | } |
---|
1372 | return 0 |
---|
1373 | } |
---|
1374 | ttref-set { |
---|
1375 | if $value { |
---|
1376 | setexp "${key} ICONS" "T" 33 1 |
---|
1377 | } else { |
---|
1378 | setexp "${key} ICONS" " " 33 1 |
---|
1379 | } |
---|
1380 | } |
---|
1381 | |
---|
1382 | |
---|
1383 | pref-get { |
---|
1384 | #------------------------------------------------------ |
---|
1385 | # col 34: refine flag for POLA & DIFA |
---|
1386 | #------------------------------------------------------ |
---|
1387 | if {[string toupper [string range \ |
---|
1388 | [readexp "${key} ICONS"] 33 33]] == "P"} { |
---|
1389 | return 1 |
---|
1390 | } |
---|
1391 | return 0 |
---|
1392 | } |
---|
1393 | pref-set { |
---|
1394 | if $value { |
---|
1395 | setexp "${key} ICONS" "P" 34 1 |
---|
1396 | } else { |
---|
1397 | setexp "${key} ICONS" " " 34 1 |
---|
1398 | } |
---|
1399 | } |
---|
1400 | daref-get { |
---|
1401 | if {[string toupper [string range \ |
---|
1402 | [readexp "${key} ICONS"] 33 33]] == "A"} { |
---|
1403 | return 1 |
---|
1404 | } |
---|
1405 | return 0 |
---|
1406 | } |
---|
1407 | daref-set { |
---|
1408 | if $value { |
---|
1409 | setexp "${key} ICONS" "A" 34 1 |
---|
1410 | } else { |
---|
1411 | setexp "${key} ICONS" " " 34 1 |
---|
1412 | } |
---|
1413 | } |
---|
1414 | |
---|
1415 | zref-get { |
---|
1416 | #------------------------------------------------------ |
---|
1417 | # col 34: refine flag for zero correction |
---|
1418 | #------------------------------------------------------ |
---|
1419 | if {[string toupper [string range [readexp "${key} ICONS"] 34 34]] == "Z"} { |
---|
1420 | return 1 |
---|
1421 | } |
---|
1422 | return 0 |
---|
1423 | } |
---|
1424 | zref-set { |
---|
1425 | if $value { |
---|
1426 | setexp "${key} ICONS" "Z" 35 1 |
---|
1427 | } else { |
---|
1428 | setexp "${key} ICONS" " " 35 1 |
---|
1429 | } |
---|
1430 | } |
---|
1431 | |
---|
1432 | ddamp-get { |
---|
1433 | set val [string range [readexp "${key} ICONS"] 39 39] |
---|
1434 | if {$val == " "} {return 0} |
---|
1435 | return $val |
---|
1436 | } |
---|
1437 | ddamp-set { |
---|
1438 | setexp "${key} ICONS" $value 40 1 |
---|
1439 | } |
---|
1440 | |
---|
1441 | backtype-get { |
---|
1442 | set val [string trim [string range [readexp "${key}BAKGD "] 0 4]] |
---|
1443 | if {$val == " "} {return 0} |
---|
1444 | return $val |
---|
1445 | } |
---|
1446 | backtype-set { |
---|
1447 | if ![validint value 5] {return 0} |
---|
1448 | setexp "${key}BAKGD " $value 1 5 |
---|
1449 | } |
---|
1450 | backterms-get { |
---|
1451 | set val [string trim [string range [readexp "${key}BAKGD "] 5 9]] |
---|
1452 | if {$val == " "} {return 0} |
---|
1453 | return $val |
---|
1454 | } |
---|
1455 | backterms-set { |
---|
1456 | # this takes a bit of work -- if terms are added, add lines as needed to the .EXP |
---|
1457 | set oldval [string trim [string range [readexp "${key}BAKGD "] 5 9]] |
---|
1458 | if ![validint value 5] {return 0} |
---|
1459 | if {$oldval < $value} { |
---|
1460 | set line1 [expr {2 + ($oldval - 1) / 4}] |
---|
1461 | set line2 [expr {1 + ($value - 1) / 4}] |
---|
1462 | for {set i $line1} {$i <= $line2} {incr i} { |
---|
1463 | # create a blank entry if needed |
---|
1464 | makeexprec ${key}BAKGD$i |
---|
1465 | } |
---|
1466 | incr oldval |
---|
1467 | for {set num $oldval} {$num <= $value} {incr num} { |
---|
1468 | set f1 [expr {15*(($num - 1) % 4)}] |
---|
1469 | set f2 [expr {15*(1 + ($num - 1) % 4)-1}] |
---|
1470 | set line [expr {1 + ($num - 1) / 4}] |
---|
1471 | if {[string trim [string range [readexp ${key}BAKGD$line] $f1 $f2]] == ""} { |
---|
1472 | set f1 [expr {15*(($num - 1) % 4)+1}] |
---|
1473 | setexp ${key}BAKGD$line 0.0 $f1 15 |
---|
1474 | } |
---|
1475 | } |
---|
1476 | } |
---|
1477 | setexp "${key}BAKGD " $value 6 5 |
---|
1478 | |
---|
1479 | } |
---|
1480 | bref-get { |
---|
1481 | if {[string toupper [string range [readexp "${key}BAKGD"] 14 14]] == "Y"} { |
---|
1482 | return 1 |
---|
1483 | } |
---|
1484 | return 0 |
---|
1485 | } |
---|
1486 | bref-set { |
---|
1487 | if $value { |
---|
1488 | setexp "${key}BAKGD " "Y" 15 1 |
---|
1489 | } else { |
---|
1490 | setexp "${key}BAKGD " "N" 15 1 |
---|
1491 | } |
---|
1492 | } |
---|
1493 | bdamp-get { |
---|
1494 | set val [string range [readexp "${key}BAKGD "] 19 19] |
---|
1495 | if {$val == " "} {return 0} |
---|
1496 | return $val |
---|
1497 | } |
---|
1498 | bdamp-set { |
---|
1499 | setexp "${key}BAKGD " $value 20 1 |
---|
1500 | } |
---|
1501 | bterm*-get { |
---|
1502 | regsub bterm $parm {} num |
---|
1503 | set f1 [expr {15*(($num - 1) % 4)}] |
---|
1504 | set f2 [expr {15*(1 + ($num - 1) % 4)-1}] |
---|
1505 | set line [expr {1 + ($num - 1) / 4}] |
---|
1506 | return [string trim [string range [readexp ${key}BAKGD$line] $f1 $f2] ] |
---|
1507 | } |
---|
1508 | bterm*-set { |
---|
1509 | regsub bterm $parm {} num |
---|
1510 | if ![validreal value 15 6] {return 0} |
---|
1511 | set f1 [expr {15*(($num - 1) % 4)+1}] |
---|
1512 | set line [expr {1 + ($num - 1) / 4}] |
---|
1513 | setexp ${key}BAKGD$line $value $f1 15 |
---|
1514 | } |
---|
1515 | bank-get { |
---|
1516 | return [string trim [string range [readexp "${key} BANK"] 0 4]] |
---|
1517 | } |
---|
1518 | tofangle-get { |
---|
1519 | return [string trim [string range [readexp "${key}BNKPAR"] 10 19]] |
---|
1520 | } |
---|
1521 | tmin-get { |
---|
1522 | return [string trim [string range [readexp "${key} TRNGE"] 0 9]] |
---|
1523 | } |
---|
1524 | tmax-get { |
---|
1525 | return [string trim [string range [readexp "${key} TRNGE"] 10 19]] |
---|
1526 | } |
---|
1527 | excl-get { |
---|
1528 | set n [string trim [string range [readexp "${key} NEXC"] 0 4]] |
---|
1529 | set exlist {} |
---|
1530 | for {set i 1} {$i <= $n} {incr i} { |
---|
1531 | set line [readexp [format "${key}EXC%3d" $i]] |
---|
1532 | lappend exlist [list \ |
---|
1533 | [string trim [string range $line 0 9]] \ |
---|
1534 | [string trim [string range $line 10 19]]] |
---|
1535 | } |
---|
1536 | return $exlist |
---|
1537 | } |
---|
1538 | excl-set { |
---|
1539 | set n [llength $value] |
---|
1540 | if ![validint n 5] {return 0} |
---|
1541 | setexp "${key} NEXC" $n 1 5 |
---|
1542 | set i 0 |
---|
1543 | foreach p $value { |
---|
1544 | incr i |
---|
1545 | foreach {r1 r2} $p {} |
---|
1546 | validreal r1 10 3 |
---|
1547 | validreal r2 10 3 |
---|
1548 | set k [format "${key}EXC%3d" $i] |
---|
1549 | if {![existsexp $k]} { |
---|
1550 | makeexprec $k |
---|
1551 | } |
---|
1552 | setexp $k ${r1}${r2} 1 20 |
---|
1553 | } |
---|
1554 | } |
---|
1555 | file-get { |
---|
1556 | return [string trim [readexp "${key} HFIL"] ] |
---|
1557 | } |
---|
1558 | file-set { |
---|
1559 | setexp "${key} HFIL" $value 3 65 |
---|
1560 | } |
---|
1561 | bank-get { |
---|
1562 | return [string trim [string range [readexp "${key} BANK"] 0 4]] |
---|
1563 | } |
---|
1564 | dmin-get { |
---|
1565 | return [string trim [string range [readexp "${key} NREF"] 5 14]] |
---|
1566 | } |
---|
1567 | dmin-set { |
---|
1568 | if ![validreal value 10 4] {return 0} |
---|
1569 | setexp "${key} NREF" $value 6 10 |
---|
1570 | } |
---|
1571 | use-get { |
---|
1572 | set k [expr {($hist+11)/12}] |
---|
1573 | set line [readexp " EXPR HTYP$k"] |
---|
1574 | set j [expr {((($hist-1) % 12)+1)*5}] |
---|
1575 | if {[string range $line $j $j] == "*"} {return 0} |
---|
1576 | return 1 |
---|
1577 | } |
---|
1578 | use-set { |
---|
1579 | set k [expr {($hist+11)/12}] |
---|
1580 | set line [readexp " EXPR HTYP$k"] |
---|
1581 | set j [expr {((($hist-1) % 12)+1)*5+1}] |
---|
1582 | if {$value} { |
---|
1583 | setexp " EXPR HTYP$k" " " $j 1 |
---|
1584 | } else { |
---|
1585 | setexp " EXPR HTYP$k" "*" $j 1 |
---|
1586 | } |
---|
1587 | } |
---|
1588 | dstart-get { |
---|
1589 | return [string trim [string range [readexp "${key} DUMMY"] 20 29]] |
---|
1590 | } |
---|
1591 | dstart-set { |
---|
1592 | if ![validreal value 10 3] {return 0} |
---|
1593 | setexp "${key} DUMMY" $value 21 10 |
---|
1594 | } |
---|
1595 | dstep-get { |
---|
1596 | return [string trim [string range [readexp "${key} DUMMY"] 30 39]] |
---|
1597 | } |
---|
1598 | dstep-set { |
---|
1599 | if ![validreal value 10 3] {return 0} |
---|
1600 | setexp "${key} DUMMY" $value 31 10 |
---|
1601 | } |
---|
1602 | dpoints-get { |
---|
1603 | return [string trim [string range [readexp "${key} DUMMY"] 0 9]] |
---|
1604 | } |
---|
1605 | dpoints-set { |
---|
1606 | if ![validint value 10] {return 0} |
---|
1607 | setexp "${key} DUMMY" $value 1 10 |
---|
1608 | } |
---|
1609 | dtype-get { |
---|
1610 | return [string trim [string range [readexp "${key} DUMMY"] 10 19]] |
---|
1611 | } |
---|
1612 | abscor1-get { |
---|
1613 | return [string trim [string range [readexp "${key}ABSCOR"] 0 14]] |
---|
1614 | } |
---|
1615 | abscor1-set { |
---|
1616 | if ![validreal value 15 8] {return 0} |
---|
1617 | setexp "${key}ABSCOR" $value 1 15 |
---|
1618 | } |
---|
1619 | abscor2-get { |
---|
1620 | return [string trim [string range [readexp "${key}ABSCOR"] 15 29]] |
---|
1621 | } |
---|
1622 | abscor2-set { |
---|
1623 | if ![validreal value 15 8] {return 0} |
---|
1624 | setexp "${key}ABSCOR" $value 16 15 |
---|
1625 | } |
---|
1626 | abstype-get { |
---|
1627 | return [string trim [string range [readexp "${key}ABSCOR"] 40 44]] |
---|
1628 | } |
---|
1629 | abstype-set { |
---|
1630 | if ![validint value 5] {return 0} |
---|
1631 | setexp "${key}ABSCOR" $value 41 5 |
---|
1632 | } |
---|
1633 | absdamp-get { |
---|
1634 | set val [string range [readexp "${key}ABSCOR"] 39 39] |
---|
1635 | if {$val == " "} {return 0} |
---|
1636 | return $val |
---|
1637 | } |
---|
1638 | absdamp-set { |
---|
1639 | setexp "${key}ABSCOR" $value 40 1 |
---|
1640 | } |
---|
1641 | absref-get { |
---|
1642 | if {[string toupper \ |
---|
1643 | [string range [readexp "${key}ABSCOR"] 34 34]] == "Y"} { |
---|
1644 | return 1 |
---|
1645 | } |
---|
1646 | return 0 |
---|
1647 | } |
---|
1648 | absref-set { |
---|
1649 | if $value { |
---|
1650 | setexp "${key}ABSCOR" "Y" 35 1 |
---|
1651 | } else { |
---|
1652 | setexp "${key}ABSCOR" "N" 35 1 |
---|
1653 | } |
---|
1654 | } |
---|
1655 | ITYP-get { |
---|
1656 | return [string trim [readexp "${key}I ITYP"]] |
---|
1657 | } |
---|
1658 | default { |
---|
1659 | set msg "Unsupported histinfo access: parm=$parm action=$action" |
---|
1660 | tk_dialog .badexp "Error in readexp" $msg error 0 Exit |
---|
1661 | } |
---|
1662 | } |
---|
1663 | } |
---|
1664 | return 1 |
---|
1665 | } |
---|
1666 | |
---|
1667 | # read the information that differs by both histogram and phase (profile & phase fraction) |
---|
1668 | # use: hapinfo hist phase parm action value |
---|
1669 | # |
---|
1670 | # frac -- phase fraction (*) |
---|
1671 | # frref/frdamp -- refinement flag/damping value for the phase fraction (*) |
---|
1672 | # proftype -- profile function number (*) |
---|
1673 | # profterms -- number of profile terms (*) |
---|
1674 | # pdamp -- damping value for the profile (*) |
---|
1675 | # pcut -- cutoff value for the profile (*) |
---|
1676 | # pterm$n -- profile term #n (*) |
---|
1677 | # pref$n -- refinement flag value for profile term #n (*) |
---|
1678 | # extmeth -- Fobs extraction method (*) |
---|
1679 | # POnaxis -- number of defined M-D preferred axes |
---|
1680 | proc hapinfo {histlist phaselist parm "action get" "value {}"} { |
---|
1681 | foreach phase $phaselist hist $histlist { |
---|
1682 | if {$phase == ""} {set phase [lindex $phaselist end]} |
---|
1683 | if {$hist == ""} {set hist [lindex $histlist end]} |
---|
1684 | if {$hist < 10} { |
---|
1685 | set hist " $hist" |
---|
1686 | } |
---|
1687 | set key "HAP${phase}${hist}" |
---|
1688 | switch -glob ${parm}-$action { |
---|
1689 | extmeth-get { |
---|
1690 | set i1 [expr {($phase - 1)*5}] |
---|
1691 | set i2 [expr {$i1 + 4}] |
---|
1692 | return [string trim [string range [readexp "HST $hist EPHAS"] $i1 $i2]] |
---|
1693 | } |
---|
1694 | extmeth-set { |
---|
1695 | set i1 [expr {($phase - 1)*5 + 1}] |
---|
1696 | if ![validint value 5] {return 0} |
---|
1697 | setexp "HST $hist EPHAS" $value $i1 5 |
---|
1698 | } |
---|
1699 | frac-get { |
---|
1700 | return [string trim [string range [readexp ${key}PHSFR] 0 14]] |
---|
1701 | } |
---|
1702 | frac-set { |
---|
1703 | if ![validreal value 15 6] {return 0} |
---|
1704 | setexp ${key}PHSFR $value 1 15 |
---|
1705 | } |
---|
1706 | frref-get { |
---|
1707 | if {[string toupper [string range [readexp ${key}PHSFR] 19 19]] == "Y"} { |
---|
1708 | return 1 |
---|
1709 | } |
---|
1710 | return 0 |
---|
1711 | } |
---|
1712 | frref-set { |
---|
1713 | if $value { |
---|
1714 | setexp ${key}PHSFR "Y" 20 1 |
---|
1715 | } else { |
---|
1716 | setexp ${key}PHSFR "N" 20 1 |
---|
1717 | } |
---|
1718 | } |
---|
1719 | frdamp-get { |
---|
1720 | set val [string range [readexp ${key}PHSFR] 24 24] |
---|
1721 | if {$val == " "} {return 0} |
---|
1722 | return $val |
---|
1723 | } |
---|
1724 | frdamp-set { |
---|
1725 | setexp ${key}PHSFR $value 25 1 |
---|
1726 | } |
---|
1727 | proftype-get { |
---|
1728 | set val [string range [readexp "${key}PRCF "] 0 4] |
---|
1729 | if {$val == " "} {return 0} |
---|
1730 | return $val |
---|
1731 | } |
---|
1732 | proftype-set { |
---|
1733 | if ![validint value 5] {return 0} |
---|
1734 | setexp "${key}PRCF " $value 1 5 |
---|
1735 | } |
---|
1736 | profterms-get { |
---|
1737 | set val [string range [readexp "${key}PRCF "] 5 9] |
---|
1738 | if {$val == " "} {return 0} |
---|
1739 | return $val |
---|
1740 | } |
---|
1741 | profterms-set { |
---|
1742 | if ![validint value 5] {return 0} |
---|
1743 | setexp "${key}PRCF " $value 6 5 |
---|
1744 | # now check that all needed entries exist |
---|
1745 | set lines [expr {1 + ($value - 1) / 4}] |
---|
1746 | for {set i 1} {$i <= $lines} {incr i} { |
---|
1747 | makeexprec "${key}PRCF $i" |
---|
1748 | } |
---|
1749 | } |
---|
1750 | pcut-get { |
---|
1751 | return [string trim [string range [readexp "${key}PRCF "] 10 19]] |
---|
1752 | } |
---|
1753 | pcut-set { |
---|
1754 | if ![validreal value 10 5] {return 0} |
---|
1755 | setexp "${key}PRCF " $value 11 10 |
---|
1756 | } |
---|
1757 | pdamp-get { |
---|
1758 | set val [string range [readexp "${key}PRCF "] 24 24] |
---|
1759 | if {$val == " "} {return 0} |
---|
1760 | return $val |
---|
1761 | } |
---|
1762 | pdamp-set { |
---|
1763 | setexp "${key}PRCF " $value 25 1 |
---|
1764 | } |
---|
1765 | pterm*-get { |
---|
1766 | regsub pterm $parm {} num |
---|
1767 | set f1 [expr {15*(($num - 1) % 4)}] |
---|
1768 | set f2 [expr {15*(1 + ($num - 1) % 4)-1}] |
---|
1769 | set line [expr {1 + ($num - 1) / 4}] |
---|
1770 | return [string trim [string range [readexp "${key}PRCF $line"] $f1 $f2] ] |
---|
1771 | } |
---|
1772 | pterm*-set { |
---|
1773 | if ![validreal value 15 6] {return 0} |
---|
1774 | regsub pterm $parm {} num |
---|
1775 | set f1 [expr {1+ 15*(($num - 1) % 4)}] |
---|
1776 | set line [expr {1 + ($num - 1) / 4}] |
---|
1777 | setexp "${key}PRCF $line" $value $f1 15 |
---|
1778 | } |
---|
1779 | pref*-get { |
---|
1780 | regsub pref $parm {} num |
---|
1781 | set f [expr {24+$num}] |
---|
1782 | if {[string toupper [string range [readexp "${key}PRCF "] $f $f]] == "Y"} { |
---|
1783 | return 1 |
---|
1784 | } |
---|
1785 | return 0 |
---|
1786 | } |
---|
1787 | pref*-set { |
---|
1788 | regsub pref $parm {} num |
---|
1789 | set f [expr {25+$num}] |
---|
1790 | if $value { |
---|
1791 | setexp ${key}PRCF "Y" $f 1 |
---|
1792 | } else { |
---|
1793 | setexp ${key}PRCF "N" $f 1 |
---|
1794 | } |
---|
1795 | } |
---|
1796 | POnaxis-get { |
---|
1797 | set val [string trim \ |
---|
1798 | [string range [readexp "${key}NAXIS"] 0 4]] |
---|
1799 | if {$val == ""} {return 0} |
---|
1800 | return $val |
---|
1801 | } |
---|
1802 | POnaxis-set { |
---|
1803 | if ![validint value 5] {return 0} |
---|
1804 | # there should be a NAXIS record, but if not make one |
---|
1805 | if {![existsexp "${key}NAXIS"]} { |
---|
1806 | makeexprec "${key}NAXIS" |
---|
1807 | } |
---|
1808 | setexp "${key}NAXIS " $value 1 5 |
---|
1809 | } |
---|
1810 | default { |
---|
1811 | set msg "Unsupported hapinfo access: parm=$parm action=$action" |
---|
1812 | tk_dialog .badexp "Error in readexp" $msg error 0 Exit |
---|
1813 | } |
---|
1814 | } |
---|
1815 | } |
---|
1816 | return 1 |
---|
1817 | } |
---|
1818 | |
---|
1819 | # get a logical constraint |
---|
1820 | # |
---|
1821 | # type action |
---|
1822 | # ----------- |
---|
1823 | # atom get number returns a list of constraints. |
---|
1824 | # " set number value replaces a list of constraints |
---|
1825 | # (value is a list of constraints) |
---|
1826 | # " add number value inserts a new list of constraints |
---|
1827 | # (number is ignored) |
---|
1828 | # " delete number deletes a set of constraint entries |
---|
1829 | # Each item in the list of constraints is composed of 4 items: |
---|
1830 | # phase, atom, variable, multiplier |
---|
1831 | # If variable=UISO atom can be ALL, otherwise atom is a number |
---|
1832 | # legal variable names: FRAC, X, Y, Z, UISO, U11, U22, U33, U12, U23, U13, |
---|
1833 | # MX, MY, MZ |
---|
1834 | # |
---|
1835 | # type action |
---|
1836 | # ----------- |
---|
1837 | # profileXX get number returns a list of constraints for term XX=1-36 |
---|
1838 | # use number=0 to get # of defined |
---|
1839 | # constraints for term XX |
---|
1840 | # " set number value replaces a list of constraints |
---|
1841 | # (value is a list of constraints) |
---|
1842 | # " add number value inserts a new list of constraints |
---|
1843 | # (number is ignored) |
---|
1844 | # " delete number deletes a set of constraint entries |
---|
1845 | # Each item in the list of constraints is composed of 3 items: |
---|
1846 | # phase-list, histogram-list, multiplier |
---|
1847 | # Note that phase-list and/or histogram-list can be ALL |
---|
1848 | |
---|
1849 | proc constrinfo {type action number "value {}"} { |
---|
1850 | global expmap |
---|
1851 | if {[lindex $expmap(phasetype) 0] == 4} { |
---|
1852 | set mm 1 |
---|
1853 | } else { |
---|
1854 | set mm 0 |
---|
1855 | } |
---|
1856 | switch -glob ${type}-$action { |
---|
1857 | atom-get { |
---|
1858 | # does this constraint exist? |
---|
1859 | set key [format "LNCN%4d%4d" $number 1] |
---|
1860 | if {![existsexp $key]} {return -1} |
---|
1861 | set clist {} |
---|
1862 | for {set i 1} {$i < 999} {incr i} { |
---|
1863 | set key [format "LNCN%4d%4d" $number $i] |
---|
1864 | if {![existsexp $key]} break |
---|
1865 | set line [readexp $key] |
---|
1866 | set j1 2 |
---|
1867 | set j2 17 |
---|
1868 | set seg [string range $line $j1 $j2] |
---|
1869 | while {[string trim $seg] != ""} { |
---|
1870 | set p [string range $seg 0 0] |
---|
1871 | if {$p == 1 && $mm} { |
---|
1872 | set atom [string trim [string range $seg 1 4]] |
---|
1873 | set var [string trim [string range $seg 5 7]] |
---|
1874 | if {$atom == "ALL"} { |
---|
1875 | set var UIS |
---|
1876 | } else { |
---|
1877 | scan $atom %x atom |
---|
1878 | } |
---|
1879 | lappend clist [list $p $atom $var \ |
---|
1880 | [string trim [string range $seg 8 end]]] |
---|
1881 | } else { |
---|
1882 | lappend clist [list $p \ |
---|
1883 | [string trim [string range $seg 1 3]] \ |
---|
1884 | [string trim [string range $seg 4 7]] \ |
---|
1885 | [string trim [string range $seg 8 end]]] |
---|
1886 | } |
---|
1887 | incr j1 16 |
---|
1888 | incr j2 16 |
---|
1889 | set seg [string range $line $j1 $j2] |
---|
1890 | } |
---|
1891 | } |
---|
1892 | return $clist |
---|
1893 | } |
---|
1894 | atom-set { |
---|
1895 | # delete records for current constraint |
---|
1896 | for {set i 1} {$i < 999} {incr i} { |
---|
1897 | set key [format "LNCN%4d%4d" $number $i] |
---|
1898 | if {![existsexp $key]} break |
---|
1899 | delexp $key |
---|
1900 | } |
---|
1901 | set line {} |
---|
1902 | set i 1 |
---|
1903 | foreach tuple $value { |
---|
1904 | set p [lindex $tuple 0] |
---|
1905 | if {$p == 1 && $mm && \ |
---|
1906 | [string toupper [lindex $tuple 1]] == "ALL"} { |
---|
1907 | set seg [format %1dALL UIS%8.4f \ |
---|
1908 | [lindex $tuple 0] \ |
---|
1909 | [lindex $tuple 3]] |
---|
1910 | } elseif {$p == 1 && $mm} { |
---|
1911 | set seg [eval format %1d%.4X%-3s%8.4f $tuple] |
---|
1912 | } elseif {[string toupper [lindex $tuple 1]] == "ALL"} { |
---|
1913 | set seg [format %1dALL%-4s%8.4f \ |
---|
1914 | [lindex $tuple 0] \ |
---|
1915 | [lindex $tuple 2] \ |
---|
1916 | [lindex $tuple 3]] |
---|
1917 | } else { |
---|
1918 | set seg [eval format %1d%3d%-4s%8.4f $tuple] |
---|
1919 | } |
---|
1920 | append line $seg |
---|
1921 | if {[string length $line] > 50} { |
---|
1922 | set key [format "LNCN%4d%4d" $number $i] |
---|
1923 | makeexprec $key |
---|
1924 | setexp $key $line 3 68 |
---|
1925 | set line {} |
---|
1926 | incr i |
---|
1927 | } |
---|
1928 | } |
---|
1929 | if {$line != ""} { |
---|
1930 | set key [format "LNCN%4d%4d" $number $i] |
---|
1931 | makeexprec $key |
---|
1932 | setexp $key $line 3 68 |
---|
1933 | } |
---|
1934 | return |
---|
1935 | } |
---|
1936 | atom-add { |
---|
1937 | # loop over defined constraints |
---|
1938 | for {set j 1} {$j < 9999} {incr j} { |
---|
1939 | set key [format "LNCN%4d%4d" $j 1] |
---|
1940 | if {![existsexp $key]} break |
---|
1941 | } |
---|
1942 | set number $j |
---|
1943 | # save the constraint |
---|
1944 | set line {} |
---|
1945 | set i 1 |
---|
1946 | foreach tuple $value { |
---|
1947 | set p [lindex $tuple 0] |
---|
1948 | if {$p == 1 && $mm && \ |
---|
1949 | [string toupper [lindex $tuple 1]] == "ALL"} { |
---|
1950 | set seg [format %1dALL UIS%8.4f \ |
---|
1951 | [lindex $tuple 0] \ |
---|
1952 | [lindex $tuple 3]] |
---|
1953 | } elseif {$p == 1 && $mm} { |
---|
1954 | set seg [eval format %1d%.4X%-3s%8.4f $tuple] |
---|
1955 | } elseif {[string toupper [lindex $tuple 1]] == "ALL"} { |
---|
1956 | set seg [format %1dALL%-4s%8.4f \ |
---|
1957 | [lindex $tuple 0] \ |
---|
1958 | [lindex $tuple 2] \ |
---|
1959 | [lindex $tuple 3]] |
---|
1960 | } else { |
---|
1961 | set seg [eval format %1d%3d%-4s%8.4f $tuple] |
---|
1962 | } |
---|
1963 | append line $seg |
---|
1964 | if {[string length $line] > 50} { |
---|
1965 | set key [format "LNCN%4d%4d" $number $i] |
---|
1966 | makeexprec $key |
---|
1967 | setexp $key $line 3 68 |
---|
1968 | set line {} |
---|
1969 | incr i |
---|
1970 | } |
---|
1971 | } |
---|
1972 | if {$line != ""} { |
---|
1973 | set key [format "LNCN%4d%4d" $number $i] |
---|
1974 | makeexprec $key |
---|
1975 | setexp $key $line 3 68 |
---|
1976 | } |
---|
1977 | return |
---|
1978 | } |
---|
1979 | atom-delete { |
---|
1980 | for {set j $number} {$j < 9999} {incr j} { |
---|
1981 | # delete records for current constraint |
---|
1982 | for {set i 1} {$i < 999} {incr i} { |
---|
1983 | set key [format "LNCN%4d%4d" $j $i] |
---|
1984 | if {![existsexp $key]} break |
---|
1985 | delexp $key |
---|
1986 | } |
---|
1987 | # now copy records, from the next entry, if any |
---|
1988 | set j1 $j |
---|
1989 | incr j1 |
---|
1990 | set key1 [format "LNCN%4d%4d" $j1 1] |
---|
1991 | # if there is no record, there is nothing to copy -- done |
---|
1992 | if {![existsexp $key1]} return |
---|
1993 | for {set i 1} {$i < 999} {incr i} { |
---|
1994 | set key1 [format "LNCN%4d%4d" $j1 $i] |
---|
1995 | if {![existsexp $key1]} break |
---|
1996 | set key [format "LNCN%4d%4d" $j $i] |
---|
1997 | makeexprec $key |
---|
1998 | setexp $key [readexp $key1] 1 68 |
---|
1999 | } |
---|
2000 | } |
---|
2001 | } |
---|
2002 | profile*-delete { |
---|
2003 | regsub profile $type {} term |
---|
2004 | if {$term < 10} { |
---|
2005 | set term " $term" |
---|
2006 | } |
---|
2007 | set key "LEQV PF$term " |
---|
2008 | # return nothing if no term exists |
---|
2009 | if {![existsexp $key]} {return 0} |
---|
2010 | |
---|
2011 | # number of constraint terms |
---|
2012 | set nterms [string trim [string range [readexp ${key}] 0 4] ] |
---|
2013 | # don't delete a non-existing entry |
---|
2014 | if {$number > $nterms} {return 0} |
---|
2015 | set val [expr {$nterms - 1}] |
---|
2016 | validint val 5 |
---|
2017 | setexp $key $val 1 5 |
---|
2018 | for {set i1 $number} {$i1 < $nterms} {incr i1} { |
---|
2019 | set i2 [expr {1 + $i1}] |
---|
2020 | # move the contents of constraint #i2 -> i1 |
---|
2021 | if {$i1 > 9} { |
---|
2022 | set k1 [expr {($i1+1)/10}] |
---|
2023 | set l1 $i1 |
---|
2024 | } else { |
---|
2025 | set k1 " " |
---|
2026 | set l1 " $i1" |
---|
2027 | } |
---|
2028 | set key1 "LEQV PF$term $k1" |
---|
2029 | # number of constraint lines for #i1 |
---|
2030 | set n1 [string trim [string range [readexp ${key1}] \ |
---|
2031 | [expr {($i1%10)*5}] [expr {4+(($i1%10)*5)}]] ] |
---|
2032 | if {$i2 > 9} { |
---|
2033 | set k2 [expr {($i2+1)/10}] |
---|
2034 | set l2 $i2 |
---|
2035 | } else { |
---|
2036 | set k2 " " |
---|
2037 | set l2 " $i2" |
---|
2038 | } |
---|
2039 | set key2 "LEQV PF$term $k2" |
---|
2040 | # number of constraint lines for #i2 |
---|
2041 | set n2 [string trim [string range [readexp ${key2}] \ |
---|
2042 | [expr {($i2%10)*5}] [expr {4+(($i2%10)*5)}]] ] |
---|
2043 | set val $n2 |
---|
2044 | validint val 5 |
---|
2045 | # move the # of terms |
---|
2046 | setexp $key1 $val [expr {1+(($i1%10)*5)}] 5 |
---|
2047 | # move the terms |
---|
2048 | for {set j 1} {$j <= $n2} {incr j 1} { |
---|
2049 | set key "LEQV PF${term}${l1}$j" |
---|
2050 | makeexprec $key |
---|
2051 | setexp $key [readexp "LEQV PF${term}${l2}$j"] 1 68 |
---|
2052 | } |
---|
2053 | # delete any remaining lines |
---|
2054 | for {set j [expr {$n2+1}]} {$j <= $n1} {incr j 1} { |
---|
2055 | delexp "LEQV PF${term}${l1}$j" |
---|
2056 | } |
---|
2057 | } |
---|
2058 | |
---|
2059 | # clear the last term |
---|
2060 | if {$nterms > 9} { |
---|
2061 | set i [expr {($nterms+1)/10}] |
---|
2062 | } else { |
---|
2063 | set i " " |
---|
2064 | } |
---|
2065 | set key "LEQV PF$term $i" |
---|
2066 | set cb [expr {($nterms%10)*5}] |
---|
2067 | set ce [expr {4+(($nterms%10)*5)}] |
---|
2068 | set n2 [string trim [string range [readexp ${key}] $cb $ce] ] |
---|
2069 | incr cb |
---|
2070 | setexp $key " " $cb 5 |
---|
2071 | # delete any remaining lines |
---|
2072 | for {set j 1} {$j <= $n2} {incr j 1} { |
---|
2073 | delexp "LEQV PF${term}${nterms}$j" |
---|
2074 | } |
---|
2075 | } |
---|
2076 | profile*-set { |
---|
2077 | regsub profile $type {} term |
---|
2078 | if {$term < 10} { |
---|
2079 | set term " $term" |
---|
2080 | } |
---|
2081 | set key "LEQV PF$term " |
---|
2082 | # get number of constraint terms |
---|
2083 | set nterms [string trim [string range [readexp ${key}] 0 4] ] |
---|
2084 | # don't change a non-existing entry |
---|
2085 | if {$number > $nterms} {return 0} |
---|
2086 | if {$number > 9} { |
---|
2087 | set k1 [expr {($number+1)/10}] |
---|
2088 | set l1 $number |
---|
2089 | } else { |
---|
2090 | set k1 " " |
---|
2091 | set l1 " $number" |
---|
2092 | } |
---|
2093 | set key1 "LEQV PF$term $k1" |
---|
2094 | # old number of constraint lines |
---|
2095 | set n1 [string trim [string range [readexp ${key1}] \ |
---|
2096 | [expr {($number%10)*5}] [expr {4+(($number%10)*5)}]] ] |
---|
2097 | # number of new constraints |
---|
2098 | set j2 [llength $value] |
---|
2099 | # number of new constraint lines |
---|
2100 | set val [set n2 [expr {($j2 + 2)/3}]] |
---|
2101 | # store the new # of lines |
---|
2102 | validint val 5 |
---|
2103 | setexp $key1 $val [expr {1+(($number%10)*5)}] 5 |
---|
2104 | |
---|
2105 | # loop over the # of lines in the old or new, whichever is greater |
---|
2106 | set v0 0 |
---|
2107 | for {set j 1} {$j <= [expr {($n1 > $n2) ? $n1 : $n2}]} {incr j 1} { |
---|
2108 | set key "LEQV PF${term}${l1}$j" |
---|
2109 | # were there more lines in the old? |
---|
2110 | if {$j > $n2} { |
---|
2111 | # this line is not needed |
---|
2112 | if {$j % 3 == 1} { |
---|
2113 | delexp %key |
---|
2114 | } |
---|
2115 | continue |
---|
2116 | } |
---|
2117 | # are we adding new lines? |
---|
2118 | if {$j > $n1} { |
---|
2119 | makeexprec $key |
---|
2120 | } |
---|
2121 | # add the three constraints to the line |
---|
2122 | foreach s {3 23 43} \ |
---|
2123 | item [lrange $value $v0 [expr {2+$v0}]] { |
---|
2124 | if {$item != ""} { |
---|
2125 | set val [format %-10s%9.3f \ |
---|
2126 | [lindex $item 0],[lindex $item 1] \ |
---|
2127 | [lindex $item 2]] |
---|
2128 | setexp $key $val $s 19 |
---|
2129 | } else { |
---|
2130 | setexp $key " " $s 19 |
---|
2131 | } |
---|
2132 | } |
---|
2133 | incr v0 3 |
---|
2134 | } |
---|
2135 | } |
---|
2136 | profile*-add { |
---|
2137 | regsub profile $type {} term |
---|
2138 | if {$term < 10} { |
---|
2139 | set term " $term" |
---|
2140 | } |
---|
2141 | set key "LEQV PF$term " |
---|
2142 | if {![existsexp $key]} {makeexprec $key} |
---|
2143 | set nterms [string trim [string range [readexp ${key}] 0 4] ] |
---|
2144 | if {$nterms == ""} { |
---|
2145 | set nterms 1 |
---|
2146 | } elseif {$nterms >= 99} { |
---|
2147 | return 0 |
---|
2148 | } else { |
---|
2149 | incr nterms |
---|
2150 | } |
---|
2151 | # store the new # of constraints |
---|
2152 | set val $nterms |
---|
2153 | validint val 5 |
---|
2154 | setexp $key $val 1 5 |
---|
2155 | |
---|
2156 | if {$nterms > 9} { |
---|
2157 | set k1 [expr {($nterms+1)/10}] |
---|
2158 | set l1 $nterms |
---|
2159 | } else { |
---|
2160 | set k1 " " |
---|
2161 | set l1 " $nterms" |
---|
2162 | } |
---|
2163 | set key1 "LEQV PF$term $k1" |
---|
2164 | |
---|
2165 | # number of new constraints |
---|
2166 | set j2 [llength $value] |
---|
2167 | # number of new constraint lines |
---|
2168 | set val [set n2 [expr {($j2 + 2)/3}]] |
---|
2169 | # store the new # of lines |
---|
2170 | validint val 5 |
---|
2171 | setexp $key1 $val [expr {1+(($nterms%10)*5)}] 5 |
---|
2172 | |
---|
2173 | # loop over the # of lines to be added |
---|
2174 | set v0 0 |
---|
2175 | for {set j 1} {$j <= $n2} {incr j 1} { |
---|
2176 | set key "LEQV PF${term}${l1}$j" |
---|
2177 | makeexprec $key |
---|
2178 | # add the three constraints to the line |
---|
2179 | foreach s {3 23 43} \ |
---|
2180 | item [lrange $value $v0 [expr {2+$v0}]] { |
---|
2181 | if {$item != ""} { |
---|
2182 | set val [format %-10s%9.3f \ |
---|
2183 | [lindex $item 0],[lindex $item 1] \ |
---|
2184 | [lindex $item 2]] |
---|
2185 | setexp $key $val $s 19 |
---|
2186 | } else { |
---|
2187 | setexp $key " " $s 19 |
---|
2188 | } |
---|
2189 | } |
---|
2190 | incr v0 3 |
---|
2191 | } |
---|
2192 | } |
---|
2193 | profile*-get { |
---|
2194 | regsub profile $type {} term |
---|
2195 | if {$term < 10} { |
---|
2196 | set term " $term" |
---|
2197 | } |
---|
2198 | if {$number > 9} { |
---|
2199 | set i [expr {($number+1)/10}] |
---|
2200 | } else { |
---|
2201 | set i " " |
---|
2202 | } |
---|
2203 | set key "LEQV PF$term $i" |
---|
2204 | # return nothing if no term exists |
---|
2205 | if {![existsexp $key]} {return 0} |
---|
2206 | # number of constraint lines |
---|
2207 | |
---|
2208 | set numline [string trim [string range [readexp ${key}] \ |
---|
2209 | [expr {($number%10)*5}] [expr {4+(($number%10)*5)}]] ] |
---|
2210 | if {$number == 0} {return $numline} |
---|
2211 | set clist {} |
---|
2212 | if {$number < 10} { |
---|
2213 | set number " $number" |
---|
2214 | } |
---|
2215 | for {set i 1} {$i <= $numline} {incr i} { |
---|
2216 | set key "LEQV PF${term}${number}$i" |
---|
2217 | set line [readexp ${key}] |
---|
2218 | foreach s {1 21 41} e {20 40 60} { |
---|
2219 | set seg [string range $line $s $e] |
---|
2220 | if {[string trim $seg] == ""} continue |
---|
2221 | # parse the string segment |
---|
2222 | set parse [regexp { *([0-9AL]+),([0-9AL]+) +([0-9.]+)} \ |
---|
2223 | $seg junk phase hist mult] |
---|
2224 | # was parse successful |
---|
2225 | if {!$parse} {continue} |
---|
2226 | lappend clist [list $phase $hist $mult] |
---|
2227 | } |
---|
2228 | } |
---|
2229 | return $clist |
---|
2230 | } |
---|
2231 | default { |
---|
2232 | set msg "Unsupported constrinfo access: type=$type action=$action" |
---|
2233 | tk_dialog .badexp "Error in readexp access" $msg error 0 OK |
---|
2234 | } |
---|
2235 | |
---|
2236 | } |
---|
2237 | } |
---|
2238 | |
---|
2239 | # read the default profile information for a histogram |
---|
2240 | # use: profdefinfo hist set# parm action |
---|
2241 | # |
---|
2242 | # proftype -- profile function number |
---|
2243 | # profterms -- number of profile terms |
---|
2244 | # pdamp -- damping value for the profile (*) |
---|
2245 | # pcut -- cutoff value for the profile (*) |
---|
2246 | # pterm$n -- profile term #n |
---|
2247 | # pref$n -- refinement flag value for profile term #n (*) |
---|
2248 | |
---|
2249 | proc profdefinfo {hist set parm "action get"} { |
---|
2250 | global expgui |
---|
2251 | if {$hist < 10} { |
---|
2252 | set key "HST $hist" |
---|
2253 | } else { |
---|
2254 | set key "HST $hist" |
---|
2255 | } |
---|
2256 | switch -glob ${parm}-$action { |
---|
2257 | proftype-get { |
---|
2258 | set val [string range [readexp "${key}PRCF$set"] 0 4] |
---|
2259 | if {$val == " "} {return 0} |
---|
2260 | return $val |
---|
2261 | } |
---|
2262 | profterms-get { |
---|
2263 | set val [string range [readexp "${key}PRCF$set"] 5 9] |
---|
2264 | if {$val == " "} {return 0} |
---|
2265 | return $val |
---|
2266 | } |
---|
2267 | pcut-get { |
---|
2268 | return [string trim [string range [readexp "${key}PRCF$set"] 10 19]] |
---|
2269 | } |
---|
2270 | pdamp-get { |
---|
2271 | set val [string range [readexp "${key}PRCF$set"] 24 24] |
---|
2272 | if {$val == " "} {return 0} |
---|
2273 | return $val |
---|
2274 | } |
---|
2275 | pterm*-get { |
---|
2276 | regsub pterm $parm {} num |
---|
2277 | set f1 [expr {15*(($num - 1) % 4)}] |
---|
2278 | set f2 [expr {15*(1 + ($num - 1) % 4)-1}] |
---|
2279 | set line [expr {1 + ($num - 1) / 4}] |
---|
2280 | return [string trim [string range [\ |
---|
2281 | readexp "${key}PRCF${set}$line"] $f1 $f2] ] |
---|
2282 | } |
---|
2283 | pref*-get { |
---|
2284 | regsub pref $parm {} num |
---|
2285 | set f [expr {24+$num}] |
---|
2286 | if {[string toupper [string range [readexp "${key}PRCF$set"] $f $f]] == "Y"} { |
---|
2287 | return 1 |
---|
2288 | } |
---|
2289 | return 0 |
---|
2290 | } |
---|
2291 | default { |
---|
2292 | set msg "Unsupported profdefinfo access: parm=$parm action=$action" |
---|
2293 | tk_dialog .badexp "Code Error" $msg error 0 Exit |
---|
2294 | } |
---|
2295 | } |
---|
2296 | } |
---|
2297 | |
---|
2298 | # get March-Dollase preferred orientation information |
---|
2299 | # use MDprefinfo hist phase axis-number parm action value |
---|
2300 | # ratio -- ratio of xtallites in PO direction vs random (>1 for more) |
---|
2301 | # fraction -- fraction in this direction, when more than one axis is used |
---|
2302 | # h k & l -- indices of P.O. axis |
---|
2303 | # ratioref -- flag to vary ratio |
---|
2304 | # fracref -- flag to vary fraction |
---|
2305 | # damp -- damping value |
---|
2306 | # type -- model type (0 = P.O. _|_ to beam, 1 = || to beam) |
---|
2307 | # new -- creates a new record with default values (set only) |
---|
2308 | proc MDprefinfo {histlist phaselist axislist parm "action get" "value {}"} { |
---|
2309 | foreach phase $phaselist hist $histlist axis $axislist { |
---|
2310 | if {$phase == ""} {set phase [lindex $phaselist end]} |
---|
2311 | if {$hist == ""} {set hist [lindex $histlist end]} |
---|
2312 | if {$axis == ""} {set axis [lindex $axislist end]} |
---|
2313 | if {$hist < 10} { |
---|
2314 | set hist " $hist" |
---|
2315 | } |
---|
2316 | if {$axis > 9} { |
---|
2317 | set axis "0" |
---|
2318 | } |
---|
2319 | set key "HAP${phase}${hist}PREFO${axis}" |
---|
2320 | switch -glob ${parm}-$action { |
---|
2321 | ratio-get { |
---|
2322 | return [string trim [string range [readexp $key] 0 9]] |
---|
2323 | } |
---|
2324 | ratio-set { |
---|
2325 | if ![validreal value 10 6] {return 0} |
---|
2326 | setexp $key $value 1 10 |
---|
2327 | } |
---|
2328 | fraction-get { |
---|
2329 | return [string trim [string range [readexp $key] 10 19]] |
---|
2330 | } |
---|
2331 | fraction-set { |
---|
2332 | if ![validreal value 10 6] {return 0} |
---|
2333 | setexp $key $value 11 10 |
---|
2334 | } |
---|
2335 | h-get { |
---|
2336 | set h [string trim [string range [readexp $key] 20 29]] |
---|
2337 | # why not allow negative h values? |
---|
2338 | # if {$h < 1} {return 0} |
---|
2339 | return $h |
---|
2340 | } |
---|
2341 | h-set { |
---|
2342 | if ![validreal value 10 2] {return 0} |
---|
2343 | setexp $key $value 21 10 |
---|
2344 | } |
---|
2345 | k-get { |
---|
2346 | set k [string trim [string range [readexp $key] 30 39]] |
---|
2347 | # if {$k < 1} {return 0} |
---|
2348 | return $k |
---|
2349 | } |
---|
2350 | k-set { |
---|
2351 | if ![validreal value 10 2] {return 0} |
---|
2352 | setexp $key $value 31 10 |
---|
2353 | } |
---|
2354 | l-get { |
---|
2355 | set l [string trim [string range [readexp $key] 40 49]] |
---|
2356 | #if {$l < 1} {return 0} |
---|
2357 | return $l |
---|
2358 | } |
---|
2359 | l-set { |
---|
2360 | if ![validreal value 10 2] {return 0} |
---|
2361 | setexp $key $value 41 10 |
---|
2362 | } |
---|
2363 | ratioref-get { |
---|
2364 | if {[string toupper \ |
---|
2365 | [string range [readexp $key] 53 53]] == "Y"} { |
---|
2366 | return 1 |
---|
2367 | } |
---|
2368 | return 0 |
---|
2369 | } |
---|
2370 | ratioref-set { |
---|
2371 | if $value { |
---|
2372 | setexp $key "Y" 54 1 |
---|
2373 | } else { |
---|
2374 | setexp $key "N" 54 1 |
---|
2375 | } |
---|
2376 | } |
---|
2377 | fracref-get { |
---|
2378 | if {[string toupper \ |
---|
2379 | [string range [readexp $key] 54 54]] == "Y"} { |
---|
2380 | return 1 |
---|
2381 | } |
---|
2382 | return 0 |
---|
2383 | } |
---|
2384 | fracref-set { |
---|
2385 | if $value { |
---|
2386 | setexp $key "Y" 55 1 |
---|
2387 | } else { |
---|
2388 | setexp $key "N" 55 1 |
---|
2389 | } |
---|
2390 | } |
---|
2391 | damp-get { |
---|
2392 | set val [string trim [string range [readexp $key] 59 59]] |
---|
2393 | if {$val == " "} {return 0} |
---|
2394 | return $val |
---|
2395 | } |
---|
2396 | damp-set { |
---|
2397 | setexp $key $value 60 1 |
---|
2398 | } |
---|
2399 | type-get { |
---|
2400 | set val [string trim [string range [readexp $key] 64 64]] |
---|
2401 | if {$val == " "} {return 0} |
---|
2402 | return $val |
---|
2403 | } |
---|
2404 | type-set { |
---|
2405 | # only valid settings are 0 & 1 |
---|
2406 | if {$value != "0" && $value != "1"} {set value "0"} |
---|
2407 | setexp $key $value 65 1 |
---|
2408 | } |
---|
2409 | new-set { |
---|
2410 | makeexprec $key |
---|
2411 | setexp $key \ |
---|
2412 | { 1.000000 1.000000 0.000000 0.000000 1.000000 NN 0 0} \ |
---|
2413 | 1 68 |
---|
2414 | } |
---|
2415 | default { |
---|
2416 | set msg "Unsupported MDprefinfo access: parm=$parm action=$action" |
---|
2417 | tk_dialog .badexp "Error in readexp" $msg error 0 Exit |
---|
2418 | } |
---|
2419 | |
---|
2420 | } |
---|
2421 | |
---|
2422 | } |
---|
2423 | } |
---|
2424 | |
---|
2425 | # write the .EXP file |
---|
2426 | proc expwrite {expfile} { |
---|
2427 | global exparray |
---|
2428 | set blankline \ |
---|
2429 | " " |
---|
2430 | set fp [open ${expfile} w] |
---|
2431 | fconfigure $fp -translation crlf |
---|
2432 | set keylist [lsort [array names exparray]] |
---|
2433 | # reorder the keys so that VERSION comes 1st |
---|
2434 | set pos [lsearch -exact $keylist { VERSION}] |
---|
2435 | set keylist "{ VERSION} [lreplace $keylist $pos $pos]" |
---|
2436 | foreach key $keylist { |
---|
2437 | puts $fp [string range \ |
---|
2438 | "$key$exparray($key)$blankline" 0 79] |
---|
2439 | } |
---|
2440 | close $fp |
---|
2441 | } |
---|
2442 | |
---|
2443 | # history commands -- delete all but last $keep history records, |
---|
2444 | # renumber if $renumber is true |
---|
2445 | proc DeleteHistory {keep renumber} { |
---|
2446 | global exparray |
---|
2447 | foreach y [lrange [lsort -decreasing \ |
---|
2448 | [array names exparray { HSTRY*}]] $keep end] { |
---|
2449 | unset exparray($y) |
---|
2450 | } |
---|
2451 | if !$renumber return |
---|
2452 | # renumber |
---|
2453 | set i 0 |
---|
2454 | foreach y [lsort -increasing \ |
---|
2455 | [array names exparray { HSTRY*}]] { |
---|
2456 | set key [format " HSTRY%3d" [incr i]] |
---|
2457 | set exparray($key) $exparray($y) |
---|
2458 | unset exparray($y) |
---|
2459 | } |
---|
2460 | # list all history |
---|
2461 | # foreach y [lsort -decreasing [array names exparray { HSTRY*}]] {puts "$y $exparray($y)"} |
---|
2462 | } |
---|
2463 | |
---|
2464 | proc CountHistory {} { |
---|
2465 | global exparray |
---|
2466 | return [llength [array names exparray { HSTRY*}]] |
---|
2467 | } |
---|
2468 | |
---|
2469 | # set the phase flags for histogram $hist to $plist |
---|
2470 | proc SetPhaseFlag {hist plist} { |
---|
2471 | # make a 2 digit key -- hh |
---|
2472 | if {$hist < 10} { |
---|
2473 | set hh " $hist" |
---|
2474 | } else { |
---|
2475 | set hh $hist |
---|
2476 | } |
---|
2477 | set key "HST $hh NPHAS" |
---|
2478 | set str {} |
---|
2479 | foreach iph {1 2 3 4 5 6 7 8 9} { |
---|
2480 | if {[lsearch $plist $iph] != -1} { |
---|
2481 | append str { 1} |
---|
2482 | } else { |
---|
2483 | append str { 0} |
---|
2484 | } |
---|
2485 | } |
---|
2486 | setexp $key $str 1 68 |
---|
2487 | } |
---|
2488 | |
---|
2489 | # erase atom $atom from phase $phase |
---|
2490 | # update the list of atom types, erasing the record if not needed. |
---|
2491 | proc EraseAtom {atom phase} { |
---|
2492 | set type [atominfo $phase $atom type] |
---|
2493 | if {$type == ""} return |
---|
2494 | if {$atom < 10} { |
---|
2495 | set key "CRS$phase AT $atom" |
---|
2496 | } elseif {$atom < 100} { |
---|
2497 | set key "CRS$phase AT $atom" |
---|
2498 | } else { |
---|
2499 | set key "CRS$phase AT$atom" |
---|
2500 | } |
---|
2501 | # delete the records for the atom |
---|
2502 | global exparray |
---|
2503 | foreach k [array names exparray ${key}*] { |
---|
2504 | delexp $k |
---|
2505 | } |
---|
2506 | # change the number of atoms in the phase |
---|
2507 | phaseinfo $phase natoms set [expr {[phaseinfo $phase natoms] -1}] |
---|
2508 | |
---|
2509 | # now adjust numbers in "EXPR ATYP" records and delete, if needed. |
---|
2510 | set natypes [readexp " EXPR NATYP"] |
---|
2511 | if {$natypes == ""} return |
---|
2512 | set j 0 |
---|
2513 | for {set i 1} {$i <= $natypes} {incr i} { |
---|
2514 | incr j |
---|
2515 | if {$j <10} { |
---|
2516 | set key " EXPR ATYP $j" |
---|
2517 | } else { |
---|
2518 | set key " EXPR ATYP$j" |
---|
2519 | } |
---|
2520 | while {![existsexp $key]} { |
---|
2521 | incr j |
---|
2522 | if {$j > 99} { |
---|
2523 | return |
---|
2524 | } elseif {$j <10} { |
---|
2525 | set key " EXPR ATYP $j" |
---|
2526 | } else { |
---|
2527 | set key " EXPR ATYP$j" |
---|
2528 | } |
---|
2529 | } |
---|
2530 | set keytype [string trim [string range $exparray($key) 2 9]] |
---|
2531 | if {$type == $keytype} { |
---|
2532 | # found the type record |
---|
2533 | set val [string trim [string range $exparray($key) 10 14]] |
---|
2534 | incr val -1 |
---|
2535 | # if this is the last reference, remove the record, |
---|
2536 | # otherwise, decrement the counter |
---|
2537 | if {$val <= 0} { |
---|
2538 | incr natypes -1 |
---|
2539 | validint natypes 5 |
---|
2540 | setexp " EXPR NATYP" $natypes 1 5 |
---|
2541 | delexp $key |
---|
2542 | } else { |
---|
2543 | validint val 5 |
---|
2544 | setexp $key $val 11 5 |
---|
2545 | } |
---|
2546 | return |
---|
2547 | } |
---|
2548 | } |
---|
2549 | } |
---|
2550 | |
---|
2551 | # compute equivalent anisotropic temperature factor for Uequiv |
---|
2552 | proc CalcAniso {phase Uequiv} { |
---|
2553 | foreach var {a b c alpha beta gamma} { |
---|
2554 | set $var [phaseinfo $phase $var] |
---|
2555 | } |
---|
2556 | |
---|
2557 | set G(1,1) [expr {$a * $a}] |
---|
2558 | set G(2,2) [expr {$b * $b}] |
---|
2559 | set G(3,3) [expr {$c * $c}] |
---|
2560 | set G(1,2) [expr {$a * $b * cos($gamma*0.017453292519943)}] |
---|
2561 | set G(2,1) $G(1,2) |
---|
2562 | set G(1,3) [expr {$a * $c * cos($beta *0.017453292519943)}] |
---|
2563 | set G(3,1) $G(1,3) |
---|
2564 | set G(2,3) [expr {$b * $c * cos($alpha*0.017453292519943)}] |
---|
2565 | set G(3,2) $G(2,3) |
---|
2566 | |
---|
2567 | # Calculate the volume**2 |
---|
2568 | set v2 0.0 |
---|
2569 | foreach i {1 2 3} { |
---|
2570 | set J [expr {($i%3) + 1}] |
---|
2571 | set K [expr {(($i+1)%3) + 1}] |
---|
2572 | set v2 [expr {$v2+ $G(1,$i)*($G(2,$J)*$G(3,$K)-$G(3,$J)*$G(2,$K))}] |
---|
2573 | } |
---|
2574 | if {$v2 > 0} { |
---|
2575 | set v [expr {sqrt($v2)}] |
---|
2576 | foreach i {1 2 3} { |
---|
2577 | set i1 [expr {($i%3) + 1}] |
---|
2578 | set i2 [expr {(($i+1)%3) + 1}] |
---|
2579 | foreach j {1 2 3} { |
---|
2580 | set j1 [expr {($j%3) + 1}] |
---|
2581 | set j2 [expr {(($j+1)%3) + 1}] |
---|
2582 | set C($j,$i) [expr {(\ |
---|
2583 | $G($i1,$j1) * $G($i2,$j2) - \ |
---|
2584 | $G($i1,$j2) * $G($i2,$j1)\ |
---|
2585 | )/ $v}] |
---|
2586 | } |
---|
2587 | } |
---|
2588 | set A(1,2) [expr {0.5 * ($C(1,2)+$C(2,1)) / sqrt( $C(1,1)* $C(2,2) )}] |
---|
2589 | set A(1,3) [expr {0.5 * ($C(1,3)+$C(3,1)) / sqrt( $C(1,1)* $C(3,3) )}] |
---|
2590 | set A(2,3) [expr {0.5 * ($C(2,3)+$C(3,2)) / sqrt( $C(2,2)* $C(3,3) )}] |
---|
2591 | foreach i {1 1 2} j {2 3 3} { |
---|
2592 | set A($i,$j) [expr {0.5 * ($C($i,$j) + $C($j,$i)) / \ |
---|
2593 | sqrt( $C($i,$i)* $C($j,$j) )}] |
---|
2594 | # clean up roundoff |
---|
2595 | if {abs($A($i,$j)) < 1e-5} {set A($i,$j) 0.0} |
---|
2596 | } |
---|
2597 | } else { |
---|
2598 | set A(1,2) 0.0 |
---|
2599 | set A(1,3) 0.0 |
---|
2600 | set A(2,3) 0.0 |
---|
2601 | } |
---|
2602 | return "$Uequiv $Uequiv $Uequiv \ |
---|
2603 | [expr {$Uequiv * $A(1,2)}] \ |
---|
2604 | [expr {$Uequiv * $A(1,3)}] \ |
---|
2605 | [expr {$Uequiv * $A(2,3)}]" |
---|
2606 | } |
---|