Changeset 544


Ignore:
Timestamp:
Dec 4, 2009 5:07:57 PM (14 years ago)
Author:
toby
Message:

# on 2002/01/22 23:02:55, toby did:
writing of real values: if a field has more than 6 characters &
too few significant digits will show, switch to scientific notation
-- example: set val .001234; validreal val 8 4 -- val is 0.0012

set val .0001234; validreal val 8 4 -- val is 1.23E-04

new routine for MM phases: mmatominfo
add abs correction parameters to histinfo
handle mm constraints in constrinfo

File:
1 edited

Legend:

Unmodified
Added
Removed

  • trunk/readexp.tcl

    • Property rcs:date changed from 2001/10/31 20:08:54 to 2002/01/22 23:02:55
    • Property rcs:lines changed from +16 -2 to +240 -15
    • Property rcs:rev changed from 1.33 to 1.34
    r480 r544  
    108108    foreach iph $expmap(phaselist) {
    109109        set expmap(atomlist_$iph) {}
    110         foreach key [array names exparray "CRS$iph  AT*A"] {
    111             regexp { AT *([0-9]+)A} $key a num
    112             lappend expmap(atomlist_$iph) $num
     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                lappend expmap(atomlist_$iph) [scan [string range $key 8 11] %x]
     118            }
    113119        }
    114120        # note that sometimes an .EXP file contains more atoms than are actually defined
    … …  
    255261    if [catch {expr {$value}}] {return 0}
    256262    if [catch {
    257         set tmp [format "%${length}.${decimal}f" $value]
    258         while {[string length $tmp] > $length} {
     263        # for small values, switch to exponential notation
     264        set pow [expr .2 - $decimal]
     265        if {abs($value) < pow(10,$pow) && $length > 6} {
     266            set tmp [format "%${length}.${decimal}E" $value]
     267        } else {
     268            set tmp [format "%${length}.${decimal}f" $value]
     269        }
     270        # if the string will not fit, use scientific notation & drop
     271        # digits, as needed
     272        while {[string length $tmp] > $length && $decimal >= 0} {
    259273            set tmp [format "%${length}.${decimal}E" $value]
    260274            incr decimal -1
    … …  
    780794#  value: used only with set
    781795#  * =>  read+write supported
    782 
    783796proc atominfo {phaselist atomlist parm "action get" "value {}"} {
    784797    foreach phase $phaselist atom $atomlist {
    … …  
    971984    return 1
    972985}
     986
     987# get macromolecular atom information: mmatominfo phase atom parm action value
     988#   phase: 1 (at present only one mm phase can be defined)
     989#   atom: a valid atom number [see expmap(atomlist_$phase)]
     990#      Note that atoms can be lists
     991#      so that mmatominfo 1 {1 2 3} xset 1
     992#               will set the xflag for atoms 1-3 in phase 1
     993#   parm:
     994#     type -- element code
     995#     frac --  occupancy (*)
     996#     x y z -- coordinates (*)
     997#     Uiso  -- Isotropic temperature factor (*)
     998#     label -- atom label (*)
     999#     residue -- residue label (*)
     1000#     group -- group label (*)
     1001#     resnum -- residue number (*)
     1002#     xref/xdamp -- refinement flag/damping value for the coordinates (*)
     1003#     uref/udamp -- refinement flag/damping value for the temperature factor(s)  (*)
     1004#     fref/fdamp -- refinement flag/damping value for the occupancy (*)
     1005#  action: get (default) or set
     1006#  value: used only with set
     1007#  * =>  read+write supported
     1008proc mmatominfo {phaselist atomlist parm "action get" "value {}"} {
     1009    foreach phase $phaselist atom $atomlist {
     1010        if {$phase == ""} {set phase [lindex $phaselist end]}
     1011        set num [string toupper [format %.4x $atom]]
     1012        set key "CRS$phase  AT$num"
     1013        switch -glob ${parm}-$action {
     1014            type-get {
     1015                return [string trim [string range [readexp ${key}] 2 9] ]
     1016            }
     1017            frac-get {
     1018                return [string trim [string range [readexp ${key}] 10 15] ]
     1019            }
     1020            frac-set {
     1021                if ![validreal value 6 4] {return 0}
     1022                setexp ${key} $value 11 6
     1023            }
     1024            x-get {
     1025                return [string trim [string range [readexp ${key}] 16 23] ]
     1026            }
     1027            x-set {
     1028                if ![validreal value 8 5] {return 0}
     1029                setexp ${key} $value 17 8
     1030            }
     1031            y-get {
     1032                return [string trim [string range [readexp ${key}] 24 31] ]
     1033            }
     1034            y-set {
     1035                if ![validreal value 8 5] {return 0}
     1036                setexp ${key} $value 25 8
     1037            }
     1038            z-get {
     1039                return [string trim [string range [readexp ${key}] 32 39] ]
     1040            }
     1041            z-set {
     1042                if ![validreal value 8 5] {return 0}
     1043                setexp ${key} $value 33 8
     1044            }
     1045            Uiso-get {
     1046                return [string trim [string range [readexp ${key}] 40 45] ]
     1047            }
     1048            Uiso-set {
     1049                if ![validreal value 6 4] {return 0}
     1050                setexp ${key} $value 41 6
     1051            }
     1052            label-get {
     1053                return [string trim [string range [readexp ${key}] 46 50] ]
     1054            }
     1055            label-set {
     1056                setexp ${key} $value 47 5
     1057            }
     1058            residue-get {
     1059                return [string range [readexp ${key}] 51 53]
     1060            }
     1061            residue-set {
     1062                setexp ${key} $value 52 3
     1063            }
     1064            group-get {
     1065                return [string range [readexp ${key}] 54 55]
     1066            }
     1067            group-set {
     1068                setexp ${key} $value 55 2
     1069            }
     1070            resnum-get {
     1071                return [string trim [string range [readexp ${key}] 56 59] ]
     1072            }
     1073            resnum-set {
     1074                if ![validint value 4] {return 0}
     1075                setexp "${key} EPHAS" $value 57 4
     1076            }
     1077            fref-get {
     1078                if {[string toupper [string range [readexp $key] 60 60]] == "F"} {
     1079                    return 1
     1080                }
     1081                return 0
     1082            }
     1083            fref-set {
     1084                if $value {
     1085                    setexp $key "F" 61 1
     1086                } else {
     1087                    setexp $key " " 61 1
     1088                }           
     1089            }
     1090            xref-get {
     1091                if {[string toupper [string range [readexp $key] 61 61]] == "X"} {
     1092                    return 1
     1093                }
     1094                return 0
     1095            }
     1096            xref-set {
     1097                if $value {
     1098                    setexp $key "X" 62 1
     1099                } else {
     1100                    setexp ${key}B " " 62 1
     1101                }           
     1102            }
     1103            uref-get {
     1104                if {[string toupper [string range [readexp $key] 62 62]] == "U"} {
     1105                    return 1
     1106                }
     1107                return 0
     1108            }
     1109            uref-set {
     1110                if $value {
     1111                    setexp $key "U" 63 1
     1112                } else {
     1113                    setexp $key " " 63 1
     1114                }           
     1115            }
     1116
     1117            fdamp-get {
     1118                set val [string range [readexp ${key}] 63 63]
     1119                if {$val == " "} {return 0}
     1120                return $val
     1121            }
     1122            fdamp-set {
     1123                setexp ${key} $value 64 1
     1124            }
     1125            xdamp-get {
     1126                set val [string range [readexp ${key}] 64 64]
     1127                if {$val == " "} {return 0}
     1128                return $val
     1129            }
     1130            xdamp-set {
     1131                setexp ${key} $value 65 1
     1132            }
     1133
     1134            udamp-get {
     1135                set val [string range [readexp ${key}] 65 65]
     1136                if {$val == " "} {return 0}
     1137                return $val
     1138            }
     1139            udamp-set {
     1140                setexp ${key} $value 66 1
     1141            }
     1142            default {
     1143                set msg "Unsupported mmatominfo access: parm=$parm action=$action"
     1144                tk_dialog .badexp "Error in readexp" $msg error 0 Exit
     1145            }
     1146        }
     1147    }
     1148    return 1
     1149}
     1150
     1151
    9731152
    9741153# get histogram information: histinfo histlist parm action value
    … …  
    10081187#     dpoints -- dummy histogram number of points (*)
    10091188#     dtype   -- dummy histogram type (CONST or SLOG)
     1189#     abscor1 -- 1st absorption correction
     1190#     abscor2 -- 2nd absorption correction
     1191#     abstype -- absorption correction type
    10101192#   parameters transferred from the instrument parameter file:
    10111193#     ITYP    -- returns the contents of the ITYP record
    … …  
    14221604            dtype-get {
    14231605                return [string trim [string range [readexp "${key} DUMMY"] 10 19]]
     1606            }
     1607            abscor1-get {
     1608                return [string trim [string range [readexp "${key}ABSCOR"] 0 14]]
     1609            }
     1610            abscor2-get {
     1611                return [string trim [string range [readexp "${key}ABSCOR"] 15 29]]
     1612            }
     1613            abstype-get {
     1614                return [string trim [string range [readexp "${key}ABSCOR"] 40 44]]
    14241615            }
    14251616            ITYP-get {
    … …  
    16181809
    16191810proc constrinfo {type action number "value {}"} {
     1811    global expmap
     1812    if {[lindex $expmap(phasetype) 0] == 4} {
     1813        set mm 1
     1814    } else {
     1815        set mm 0
     1816    }
    16201817    switch -glob ${type}-$action {
    16211818        atom-get {
    … …  
    16321829                set seg [string range $line $j1 $j2]
    16331830                while {[string trim $seg] != ""} {
    1634                     lappend clist [list \
    1635                             [string range $seg 0 0] \
    1636                             [string trim [string range $seg 1 3]] \
    1637                             [string trim [string range $seg 4 7]] \
    1638                             [string trim [string range $seg 8 end]]]
     1831                    set p [string range $seg 0 0]
     1832                    if {$p == 1 && $mm} {
     1833                        set atom [string trim [string range $seg 1 4]]
     1834                        set var [string trim [string range $seg 5 7]]
     1835                        if {$atom == "ALL"} {
     1836                            set var UIS
     1837                        } else {
     1838                            scan $atom %x atom
     1839                        }
     1840                        lappend clist [list $p $atom $var \
     1841                                [string trim [string range $seg 8 end]]]
     1842                    } else {
     1843                        lappend clist [list $p \
     1844                                [string trim [string range $seg 1 3]] \
     1845                                [string trim [string range $seg 4 7]] \
     1846                                [string trim [string range $seg 8 end]]]
     1847                    }
    16391848                    incr j1 16
    16401849                    incr j2 16
    … …  
    16541863            set i 1
    16551864            foreach tuple $value {
    1656                 if {[string toupper [lindex $tuple 1]] == "ALL"} {
     1865                set p [lindex $tuple 0]
     1866                if {$p == 1 && $mm && \
     1867                        [string toupper [lindex $tuple 1]] == "ALL"} {
     1868                    set seg [format %1dALL UIS%8.4f \
     1869                            [lindex $tuple 0] \
     1870                            [lindex $tuple 3]]
     1871                } elseif {$p == 1 && $mm} {
     1872                    set seg [eval format %1d%.4X%-3s%8.4f $tuple]
     1873                } elseif {[string toupper [lindex $tuple 1]] == "ALL"} {
    16571874                    set seg [format %1dALL%-4s%8.4f \
    16581875                            [lindex $tuple 0] \
    … …  
    16891906            set i 1
    16901907            foreach tuple $value {
    1691                 if {[string toupper [lindex $tuple 1]] == "ALL"} {
     1908                set p [lindex $tuple 0]
     1909                if {$p == 1 && $mm && \
     1910                        [string toupper [lindex $tuple 1]] == "ALL"} {
     1911                    set seg [format %1dALL UIS%8.4f \
     1912                            [lindex $tuple 0] \
     1913                            [lindex $tuple 3]]
     1914                } elseif {$p == 1 && $mm} {
     1915                    set seg [eval format %1d%.4X%-3s%8.4f $tuple]
     1916                } elseif {[string toupper [lindex $tuple 1]] == "ALL"} {
    16921917                    set seg [format %1dALL%-4s%8.4f \
    16931918                            [lindex $tuple 0] \
Note: See TracChangeset for help on using the changeset viewer.