Changeset 1219 for trunk/readexp.tcl
 Timestamp:
 Aug 19, 2012 1:24:43 PM (8 years ago)
 File:

 1 edited
Legend:
 Unmodified
 Added
 Removed

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