Changeset 1219 for trunk/readexp.tcl


Ignore:
Timestamp:
Aug 19, 2012 1:24:43 PM (8 years ago)
Author:
toby
Message:

Major new release: bug fixes for rigid bodies; Split Restraints from Constraints; add chemistry restraints; edit f' & f; fixes for fixing atoms; start work on Absorption constraints and interface for Fourier maps

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/readexp.tcl

    r1177 r1219  
    22432243}
    22442244
    2245 #  read fixed constraints
    2246 
     2245#  read fixed constraints for a phase
    22472246proc atom_constraint_read {phase} {
    2248     set fix_list ""
     2247    set fixlist ""
    22492248    foreach k {1 2 3 4 5 6 7 8 9} {
    22502249        set key [format "LEQV HOLD%1d%2d" $phase $k]
    … …  
    22522251        foreach j {2 10 18 26 34 42 50 58} {
    22532252            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
    22582258}
    22592259
    … …  
    22712271}
    22722272
    2273 proc atom_constraint_write {phase fix_list} {
     2273# returns 1 if the specified variable is fixed
     2274proc atom_constraint_get {phase atom type} {
     2275    if {[array names ::fix_param "$phase,$atom,$type"] == ""} {
     2276        return 0
     2277    }
     2278    return 1
     2279}
     2280
     2281proc 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    }
    22742296    foreach key [array names ::exparray "LEQV HOLD$phase*"] {
    22752297        delexp $key
    … …  
    22782300    set j 1
    22792301    set line ""
    2280     foreach fix $fix_list {
     2302    foreach fix $fixlist {
    22812303        incr k
    22822304        append line $fix
    … …  
    23272349#              phase-list, histogram-list, multiplier
    23282350# Note that phase-list and/or histogram-list 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"
    23292368
    23302369proc constrinfo {type action number "value {}"} {
    … …  
    25922631                    # this line is not needed
    25932632                    if {$j % 3 == 1} {
    2594                         delexp %key
     2633                        delexp $key
    25952634                    }
    25962635                    continue
    … …  
    27102749            return $clist
    27112750        }
     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 non-existing 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        }
    27122958        default {
    27132959            set msg "Unsupported constrinfo access: type=$type action=$action"
    … …  
    27162962
    27172963    }
     2964}
     2965proc 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}
     2981proc 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
    27182996}
    27192997
    … …  
    33113589        default {
    33123590            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
     3617proc 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*(($HST-1) % 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        weight-get {
     3677            return [string trim [string range [readexp "$key FACTR"] 0 14]]
     3678        }
     3679        weight-set {
     3680            # update FACTR
     3681            if ![validreal value 15 6] {return 0}
     3682            setexp "$key FACTR" $value 1 15
     3683        }
     3684        restraintlist-get {
     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*(($j-1)%3)}]
     3699                    set o2 [expr {19 + 20*(($j-1)%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        restraintlist-set {
     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
    33133763            tk_dialog .badexp "Error in readexp" $msg error 0 Exit
    33143764        }
    … …  
    42874737}
    42884738
     4739# return a list of defined Fourier maps
     4740proc 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 (1-9)
     4755#   3: DMIN (usually 0.0)
     4756#   4: DMAX (usually 999.99)
     4757proc 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 (1-9)
     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: (1-9)
     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
     4782proc 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 (1-9)
     4811#     dmin    -- d-space for highest order reflection to use (usually 0.0)
     4812#     dmax    -- d-space for lowest order reflection to use (usually 999.99)
     4813# all parameters may be read or set
     4814proc 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        type-get {
     4821            # type of map (DELF,FCLC,FOBS,NFDF,PTSN,DPTS)
     4822            return [string trim [string range [readexp $key] 2 6]]
     4823        }
     4824        type-set {
     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        section-get {
     4837            # section (X,Y or Z)
     4838            return [string range [readexp $key] 7 8]
     4839        }
     4840        section-set {
     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        phase-get {
     4853            # phase (1-9)
     4854            return [string trim [string range [readexp $key] 8 13]]
     4855        }
     4856        phase-set {
     4857            validint value 5
     4858            setexp $key $value 9 5
     4859        }
     4860        dmin-get {
     4861            # DMIN (usually 0.0)
     4862            return [string trim [string range [readexp $key] 18 25]]
     4863        }
     4864        dmin-set {
     4865            validreal value 7 2
     4866            setexp $key $value 19 7
     4867        }
     4868        dmax-get {
     4869            # DMAX (usually 999.99)
     4870            return [string trim [string range [readexp $key] 30 37]]
     4871        }
     4872        dmax-set {
     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
     4894proc 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
     4918proc 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
     4951proc 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.