Changeset 252


Ignore:
Timestamp:
Dec 4, 2009 5:02:56 PM (11 years ago)
Author:
toby
Message:

# on 2000/08/04 18:19:37, toby did:
redo error msgs
phaseinfo: change atoms and spacegroup
atominfo: change iso/aniso flag
new routine: SetPhaseFlag? (control which phases are used in a histogram)
new routine: EraseAtom?

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/readexp.tcl

    • Property rcs:date changed from 2000/07/20 22:09:56 to 2000/08/04 18:19:37
    • Property rcs:lines changed from +344 -5 to +139 -23
    • Property rcs:rev changed from 1.17 to 1.18
    r236 r252  
    122122            if {$line == ""} {
    123123                set msg "No HTYP$n entry for Histogram $ihist. This is an invalid .EXP file"
    124                 tk_dialog .badexp "Error in EXP" $msg error 0 Exit
    125                 destroy .
     124                tk_dialog .badexp "Error in readexp" $msg error 0 Exit
    126125            }
    127126            set j 0
     
    148147        if {$line == ""} {
    149148            set msg "No NPHAS entry for Histogram $ihist. This is an invalid .EXP file"
    150             tk_dialog .badexp "Error in EXP" $msg error 0 Exit
    151             destroy .
     149            tk_dialog .badexp "Error in readexp" $msg error 0 Exit
    152150        }
    153151        set expmap(phaselist_$ihist) {}
     
    321319        default {
    322320            set msg "Unsupported expinfo access: parm=$parm action=$action"
    323             tk_dialog .badexp "Error in EXP" $msg error 0 Exit
    324             destroy .
     321            tk_dialog .badexp "Error in readexp" $msg error 0 Exit
    325322        }
    326323    }
     
    382379#   parm:
    383380#     name -- phase name
    384 #     natoms -- number of atoms
     381#     natoms -- number of atoms (*)
    385382#     a b c alpha beta gamma -- cell parameters (*)
    386383#     cellref -- refinement flag for the unit cell(*)
    387384#     celldamp  -- damping for the unit cell refinement (*)
    388 #     spacegroup -- space group symbol
     385#     spacegroup -- space group symbol (*)
    389386#     ODForder -- spherical harmonic order (*)
    390387#     ODFsym   -- sample symmetry (0-3) (*)
     
    410407        }
    411408
     409        name-set {
     410            setexp "CRS$phase    PNAM" " $value" 2 68
     411        }
     412
    412413        spacegroup-get {
    413414            return [string trim [readexp "CRS$phase  SG SYM"]]
    414415        }
    415416
    416         name-set {
    417             setexp "CRS$phase    PNAM" " $value" 2 68
     417        spacegroup-set {
     418            setexp "CRS$phase  SG SYM" " $value" 2 68
    418419        }
    419420
    420421        natoms-get {
    421422            return [string trim [readexp "CRS$phase   NATOM"]]     
     423        }
     424
     425        natoms-set {
     426            if ![validint value 5] {return 0}
     427            setexp "CRS$phase   NATOM" $value 1 5
    422428        }
    423429
     
    687693        default {
    688694            set msg "Unsupported phaseinfo access: parm=$parm action=$action"
    689             tk_dialog .badexp "Error in EXP" $msg error 0 Exit
    690 #           destroy .
     695            tk_dialog .badexp "Error in readexp" $msg error 0 Exit
    691696        }
    692697    }
     
    751756                return [string trim [string range [readexp ${key}B] 62 62] ]
    752757            }
     758            temptype-set {
     759                if {$value == "A"} {
     760                    setexp ${key}B A 63 1
     761                    # copy the Uiso to the diagonal terms
     762                    set value [string range [readexp ${key}B] 0 9]
     763                    setexp ${key}B $value 11 10
     764                    setexp ${key}B $value 21 10
     765                    set value 0.0
     766                    validreal value 10 6
     767                    setexp ${key}B $value 31 10
     768                    setexp ${key}B $value 41 10
     769                    setexp ${key}B $value 51 10
     770                } else {
     771                    setexp ${key}B I 63 1
     772                    set value 0.0
     773                    catch {
     774                        # get the trace
     775                        set value [expr ( \
     776                                [string range [readexp ${key}B] 0 9] + \
     777                                [string range [readexp ${key}B] 10 19] + \
     778                                [string range [readexp ${key}B] 20 29])/3.]
     779                    }
     780                    validreal value 10 6
     781                    setexp ${key}B $value 1 10
     782                    # blank out the remaining terms
     783                    set value " "
     784                    setexp ${key}B $value 11 10
     785                    setexp ${key}B $value 21 10
     786                    setexp ${key}B $value 31 10
     787                    setexp ${key}B $value 41 10
     788                    setexp ${key}B $value 51 10
     789                }
     790            }
    753791            x-get {
    754792                return [string trim [string range [readexp ${key}A] 10 19] ]
     
    878916            default {
    879917                set msg "Unsupported atominfo access: parm=$parm action=$action"
    880                 tk_dialog .badexp "Error in EXP" $msg error 0 Exit
    881                 destroy .
     918                tk_dialog .badexp "Error in readexp" $msg error 0 Exit
    882919            }
    883920        }
     
    12221259            default {
    12231260                set msg "Unsupported histinfo access: parm=$parm action=$action"
    1224                 tk_dialog .badexp "Error in EXP" $msg error 0 Exit
    1225                 destroy .
     1261                tk_dialog .badexp "Error in readexp" $msg error 0 Exit
    12261262            }
    12271263        }
     
    13751411            default {
    13761412                set msg "Unsupported hapinfo access: parm=$parm action=$action"
    1377                 tk_dialog .badexp "Error in EXP" $msg error 0 Exit
    1378                 destroy .
     1413                tk_dialog .badexp "Error in readexp" $msg error 0 Exit
    13791414            }
    13801415        }
     
    17631798        default {
    17641799            set msg "Unsupported constrinfo access: type=$type action=$action"
    1765             tk_dialog .badexp "Error in EXP access" $msg error 0 OK
     1800            tk_dialog .badexp "Error in readexp access" $msg error 0 OK
    17661801        }
    17671802
     
    19471982            default {
    19481983                set msg "Unsupported MDprefinfo access: parm=$parm action=$action"
    1949                 tk_dialog .badexp "Error in EXP" $msg error 0 Exit
    1950                 destroy .
     1984                tk_dialog .badexp "Error in readexp" $msg error 0 Exit
    19511985            }
    19521986
     
    20052039    return [llength [array names exparray {    HSTRY*}]]
    20062040}
     2041
     2042# set the phase flags for histogram $hist to $plist
     2043proc SetPhaseFlag {hist plist} {
     2044    # make a 2 digit key -- hh
     2045    if {$hist < 10} {
     2046        set hh " $hist"
     2047    } else {
     2048        set hh $hist
     2049    }
     2050    set key "HST $hh NPHAS"
     2051    set str {}
     2052    foreach iph {1 2 3 4 5 6 7 8 9} {
     2053        if {[lsearch $plist $iph] != -1} {
     2054            append str {    1}
     2055        } else {
     2056            append str {    0}     
     2057        }
     2058    }
     2059    setexp $key $str 1 68
     2060}
     2061
     2062# erase atom $atom from phase $phase
     2063# update the list of atom types, erasing the record if not needed.
     2064proc EraseAtom {atom phase} {
     2065    set type [atominfo $phase $atom type]
     2066    if {$type == ""} return
     2067    if {$atom < 10} {
     2068        set key "CRS$phase  AT  $atom"
     2069    } elseif {$atom < 100} {
     2070        set key "CRS$phase  AT $atom"
     2071    } else {
     2072        set key "CRS$phase  AT$atom"
     2073    }
     2074    # delete the records for the atom
     2075    global exparray
     2076    foreach k [array names exparray ${key}*] {
     2077        delexp $k
     2078    }
     2079    # change the number of atoms in the phase
     2080    phaseinfo $phase natoms set [expr [phaseinfo $phase natoms] -1]
     2081
     2082    # now adjust numbers in "EXPR ATYP" records and delete, if needed.
     2083    set natypes [readexp " EXPR  NATYP"]
     2084    if {$natypes == ""} return
     2085    set j 0
     2086    for {set i 1} {$i <= $natypes} {incr i} {
     2087        incr j
     2088        if {$j <10} {
     2089            set key " EXPR ATYP $j"
     2090        } else {
     2091            set key " EXPR ATYP$j"
     2092        }
     2093        while {![existsexp $key]} {
     2094            incr j
     2095            if {$j > 99} {
     2096                return
     2097            } elseif {$j <10} {
     2098                set key " EXPR ATYP $j"
     2099            } else {
     2100                set key " EXPR ATYP$j"
     2101            }
     2102        }
     2103        set keytype [string trim [string range $exparray($key) 2 9]]
     2104        if {$type == $keytype} {
     2105            # found the type record
     2106            set val [string trim [string range $exparray($key) 10 14]]
     2107            incr val -1
     2108            # if this is the last reference, remove the record,
     2109            # otherwise, decrement the counter
     2110            if {$val <= 0} {
     2111                incr natypes -1
     2112                validint natypes 5
     2113                setexp " EXPR  NATYP" $natypes 1 5
     2114                delexp $key
     2115            } else {
     2116                validint val 5
     2117                setexp $key $val 11 5
     2118            }
     2119            return
     2120        }
     2121    }
     2122}
Note: See TracChangeset for help on using the changeset viewer.