Changeset 236 for trunk/readexp.tcl


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

# on 2000/07/20 22:09:56, toby did:
Add odf (spherical harmonic) support
move March-Dollase support here from orient

File:
1 edited

Legend:

Unmodified
Added
Removed
  • trunk/readexp.tcl

    • Property rcs:date changed from 2000/07/06 20:35:35 to 2000/07/20 22:09:56
    • Property rcs:lines changed from +335 -12 to +344 -5
    • Property rcs:rev changed from 1.16 to 1.17
    r229 r236  
    387387#     celldamp  -- damping for the unit cell refinement (*)
    388388#     spacegroup -- space group symbol
     389#     ODForder -- spherical harmonic order (*)
     390#     ODFsym   -- sample symmetry (0-3) (*)
     391#     ODFdampA -- damping for angles (*)
     392#     ODFdampC -- damping for coefficients (*)
     393#     ODFomega -- omega oriention angle (*)
     394#     ODFchi -- chi oriention angle (*)
     395#     ODFphi -- phi oriention angle (*)
     396#     ODFomegaRef -- refinement flag for omega (*)
     397#     ODFchiRef -- refinement flag for chi (*)
     398#     ODFphiRef -- refinement flag for phi (*)
     399#     ODFterms -- a list of the {l m n} values for each ODF term (*)
     400#     ODFcoefXXX -- the ODF coefficient for for ODF term XXX (*)
     401#     ODFRefcoef -- refinement flag for ODF terms (*)
    389402#  action: get (default) or set
    390403#  value: used only with set
    391404#  * =>  read+write supported
    392405proc phaseinfo {phase parm "action get" "value {}"} {
    393     switch ${parm}-$action {
     406    switch -glob ${parm}-$action {
    394407
    395408        name-get {
     
    474487        }
    475488
     489        ODForder-get {
     490            set val [string trim [string range [readexp "CRS$phase  ODF"] 0 4]]
     491            if {$val == " "} {return 0}
     492            return $val
     493        }
     494        ODForder-set {
     495            if ![validint value 5] {return 0}
     496            setexp "CRS$phase  ODF" $value 1 5
     497        }
     498        ODFsym-get {
     499            set val [string trim [string range [readexp "CRS$phase  ODF"] 10 14]]
     500            if {$val == " "} {return 0}
     501            return $val
     502        }
     503        ODFsym-set {
     504            if ![validint value 5] {return 0}
     505            setexp "CRS$phase  ODF" $value 11 5
     506        }
     507        ODFdampA-get {
     508            set val [string range [readexp "CRS$phase  ODF"] 24 24]
     509            if {$val == " "} {return 0}
     510            return $val
     511        }
     512        ODFdampA-set {
     513            setexp "CRS$phase  ODF" $value 25 1
     514        }
     515        ODFdampC-get {
     516            set val [string range [readexp "CRS$phase  ODF"] 29 29]
     517            if {$val == " "} {return 0}
     518            return $val
     519        }
     520        ODFdampC-set {
     521            setexp "CRS$phase  ODF" $value 30 1
     522        }
     523        ODFomegaRef-get {
     524            if {[string toupper [string range [readexp "CRS$phase  ODF"] 16 16]] == "Y"} {
     525                return 1
     526            }
     527            return 0
     528        }
     529        ODFomegaRef-set {
     530            if $value {
     531                setexp "CRS$phase  ODF" "Y" 17 1
     532            } else {
     533                setexp "CRS$phase  ODF" "N" 17 1
     534            }       
     535        }
     536        ODFchiRef-get {
     537            if {[string toupper [string range [readexp "CRS$phase  ODF"] 17 17]] == "Y"} {
     538                return 1
     539            }
     540            return 0
     541        }
     542        ODFchiRef-set {
     543            if $value {
     544                setexp "CRS$phase  ODF" "Y" 18 1
     545            } else {
     546                setexp "CRS$phase  ODF" "N" 18 1
     547            }       
     548        }
     549        ODFphiRef-get {
     550            if {[string toupper [string range [readexp "CRS$phase  ODF"] 18 18]] == "Y"} {
     551                return 1
     552            }
     553            return 0
     554        }
     555        ODFphiRef-set {
     556            if $value {
     557                setexp "CRS$phase  ODF" "Y" 19 1
     558            } else {
     559                setexp "CRS$phase  ODF" "N" 19 1
     560            }       
     561        }
     562        ODFcoef*-get {
     563            regsub ODFcoef $parm {} term
     564            set k [expr ($term+5)/6]
     565            if {$k <= 9} {set k " $k"}
     566            set j [expr (($term-1) % 6)+1]
     567            set lineB [readexp "CRS$phase  ODF${k}B"]
     568            set j0 [expr  ($j-1) *10]
     569            set j1 [expr $j0 + 9]
     570            set val [string trim [string range $lineB $j0 $j1]]
     571            if {$val == ""} {return 0.0}
     572            return $val
     573        }
     574        ODFcoef*-set {
     575            regsub ODFcoef $parm {} term
     576            if ![validreal value 10 3] {return 0}
     577            set k [expr ($term+5)/6]
     578            if {$k <= 9} {set k " $k"}
     579            set j [expr (($term-1) % 6)+1]
     580            set col [expr  ($j-1)*10 + 1]
     581            setexp "CRS$phase  ODF${k}B" $value $col 10
     582        }
     583        ODFRefcoef-get {
     584            if {[string toupper [string range [readexp "CRS$phase  ODF"] 19 19]] == "Y"} {
     585                return 1
     586            }
     587            return 0
     588        }
     589        ODFRefcoef-set {
     590            if $value {
     591                setexp "CRS$phase  ODF" "Y" 20 1
     592            } else {
     593                setexp "CRS$phase  ODF" "N" 20 1
     594            }       
     595        }
     596        ODFomega-get {
     597           return [string trim [string range [readexp "CRS$phase  ODF"] 30 39]]
     598        }
     599        ODFchi-get {
     600           return [string trim [string range [readexp "CRS$phase  ODF"] 40 49]]
     601        }
     602        ODFphi-get {
     603           return [string trim [string range [readexp "CRS$phase  ODF"] 50 59]]
     604        }
     605        ODFomega-set {
     606            if ![validreal value 10 4] {return 0}
     607            setexp "CRS$phase  ODF" $value 31 10
     608        }
     609        ODFchi-set {
     610            if ![validreal value 10 4] {return 0}
     611            setexp "CRS$phase  ODF" $value 41 10
     612        }
     613        ODFphi-set {
     614            if ![validreal value 10 4] {return 0}
     615            setexp "CRS$phase  ODF" $value 51 10
     616        }
     617
     618        ODFterms-get {
     619            set vallist {}
     620            set val [string trim [string range [readexp "CRS$phase  ODF"] 5 9]]
     621            for {set i 1} {$i <= $val} {incr i 6} {
     622                set k [expr 1+($i-1)/6]
     623                if {$k <= 9} {set k " $k"}
     624                set lineA [readexp "CRS$phase  ODF${k}A"]
     625                set k 0
     626                for {set j $i} {$j <= $val && $j < $i+6} {incr j} {
     627                    set j0 [expr ($k)*10]
     628                    set j1 [expr $j0 + 9]
     629                    lappend vallist [string trim [string range $lineA $j0 $j1]]
     630                    incr k
     631                }
     632            }
     633            return $vallist
     634        }
     635        ODFterms-set {
     636            set key "CRS$phase  ODF   "
     637            if {![existsexp $key]} {
     638                makeexprec $key
     639                set oldlen 0
     640            } else {
     641                set oldlen [string trim [string range [readexp $key] 5 9]]
     642            }
     643            set len [llength $value]
     644            if ![validint len 5] {return 0}
     645            setexp $key $len 6 5
     646            set j 0
     647            set k 0
     648            foreach item $value {
     649                incr j
     650                if {$j % 6 == 1} {
     651                    incr k
     652                    if {$k <= 9} {set k " $k"}
     653                    set col 1
     654                    set keyA "CRS$phase  ODF${k}A"
     655                    set keyB "CRS$phase  ODF${k}B"
     656                    if {![existsexp $keyA]} {
     657                        makeexprec $keyA
     658                        makeexprec $keyB
     659                    }
     660                }
     661                set col1 [expr $col + 1]
     662                foreach n [lrange $item 0 2] {
     663                    if ![validint n 3] {return 0}
     664                    setexp $keyA $n $col1 3
     665                    incr col1 3
     666                }
     667                incr col 10
     668            }
     669            for {incr j} {$j <= $oldlen} {incr j} {
     670                if {$j % 6 == 1} {
     671                    incr k
     672                    if {$k <= 9} {set k " $k"}
     673                    set col 1
     674                    set keyA "CRS$phase  ODF${k}A"
     675                    set keyB "CRS$phase  ODF${k}B"
     676                    delexp $keyA
     677                    delexp $keyB
     678                }
     679                if {[existsexp $keyA]} {
     680                    setexp $keyA "          " $col 10
     681                    setexp $keyB "          " $col 10
     682                }
     683                incr col 10
     684            }
     685        }
     686
    476687        default {
    477688            set msg "Unsupported phaseinfo access: parm=$parm action=$action"
    478689            tk_dialog .badexp "Error in EXP" $msg error 0 Exit
    479             destroy .
     690#           destroy .
    480691        }
    481692    }
    482693    return 1
    483694}
     695
    484696
    485697# get atom information: atominfo phase atom parm action value
     
    15521764            set msg "Unsupported constrinfo access: type=$type action=$action"
    15531765            tk_dialog .badexp "Error in EXP access" $msg error 0 OK
    1554 #           destroy .
    15551766        }
    15561767
     
    16141825            tk_dialog .badexp "Code Error" $msg error 0 Exit
    16151826        }
     1827    }
     1828}
     1829
     1830# get March-Dollase preferred orientation information
     1831# use MDprefinfo hist phase axis-number parm action value
     1832#    ratio    -- ratio of xtallites in PO direction vs random (>1 for more)
     1833#    fraction -- fraction in this direction, when more than one axis is used
     1834#    h k & l  -- indices of P.O. axis
     1835#    ratioref -- flag to vary ratio
     1836#    fracref  -- flag to vary fraction
     1837#    damp     -- damping value
     1838#    type     -- model type (0 = P.O. _|_ to beam, 1 = || to beam)
     1839#    new      -- creates a new record with default values (set only)
     1840proc MDprefinfo {histlist phaselist axislist parm "action get" "value {}"} {
     1841    foreach phase $phaselist hist $histlist axis $axislist {
     1842        if {$phase == ""} {set phase [lindex $phaselist end]}
     1843        if {$hist == ""} {set hist [lindex $histlist end]}
     1844        if {$axis == ""} {set axis [lindex $axislist end]}
     1845        if {$hist < 10} {
     1846            set hist " $hist"
     1847        }
     1848        if {$axis > 9} {
     1849            set axis "0"
     1850        }
     1851        set key "HAP${phase}${hist}PREFO${axis}"
     1852        switch -glob ${parm}-$action {
     1853            ratio-get {
     1854                return [string trim [string range [readexp $key] 0 9]]
     1855            }
     1856            ratio-set {
     1857                if ![validreal value 10 6] {return 0}
     1858                setexp $key $value 1 10
     1859            }
     1860            fraction-get {
     1861                return [string trim [string range [readexp $key] 10 19]]
     1862            }
     1863            fraction-set {
     1864                if ![validreal value 10 6] {return 0}
     1865                setexp $key $value 11 10
     1866            }
     1867            h-get {
     1868                set h [string trim [string range [readexp $key] 20 29]]
     1869                # why not allow negative h values?
     1870                #               if {$h < 1} {return 0}
     1871                return $h
     1872            }
     1873            h-set {
     1874                if ![validreal value 10 2] {return 0}
     1875                setexp $key $value 21 10
     1876            }
     1877            k-get {
     1878                set k [string trim [string range [readexp $key] 30 39]]
     1879                #               if {$k < 1} {return 0}
     1880                return $k
     1881            }
     1882            k-set {
     1883                if ![validreal value 10 2] {return 0}
     1884                setexp $key $value 31 10
     1885            }
     1886            l-get {
     1887                set l [string trim [string range [readexp $key] 40 49]]
     1888                #if {$l < 1} {return 0}
     1889                return $l
     1890            }
     1891            l-set {
     1892                if ![validreal value 10 2] {return 0}
     1893                setexp $key $value 41 10
     1894            }
     1895            ratioref-get {
     1896                if {[string toupper \
     1897                        [string range [readexp $key] 53 53]] == "Y"} {
     1898                    return 1
     1899                }
     1900                return 0
     1901            }
     1902            ratioref-set {
     1903                if $value {
     1904                    setexp $key "Y" 54 1
     1905                } else {
     1906                    setexp $key "N" 54 1
     1907                }
     1908            }
     1909            fracref-get {
     1910                if {[string toupper \
     1911                        [string range [readexp $key] 54 54]] == "Y"} {
     1912                    return 1
     1913                }
     1914                return 0
     1915            }
     1916            fracref-set {
     1917                if $value {
     1918                    setexp $key "Y" 55 1
     1919                } else {
     1920                    setexp $key "N" 55 1
     1921              }
     1922            }
     1923            damp-get {
     1924                set val [string trim [string range [readexp $key] 59 59]]
     1925                if {$val == " "} {return 0}
     1926                return $val
     1927            }
     1928            damp-set {
     1929                setexp $key $value 60 1
     1930            }
     1931            type-get {
     1932                set val [string trim [string range [readexp $key] 64 64]]
     1933                if {$val == " "} {return 0}
     1934                return $val
     1935            }
     1936            type-set {
     1937                # only valid settings are 0 & 1
     1938                if {$value != "0" && $value != "1"} {set value "0"}
     1939                setexp $key $value 65 1
     1940            }
     1941            new-set {
     1942                makeexprec $key
     1943                setexp $key \
     1944                        {  1.000000  1.000000  0.000000  0.000000  1.000000   NN    0    0} \
     1945                        1 68
     1946            }
     1947            default {
     1948                set msg "Unsupported MDprefinfo access: parm=$parm action=$action"
     1949                tk_dialog .badexp "Error in EXP" $msg error 0 Exit
     1950                destroy .
     1951            }
     1952
     1953        }
     1954
    16161955    }
    16171956}
Note: See TracChangeset for help on using the changeset viewer.