Changeset 1119 for branches/sandbox


Ignore:
Timestamp:
Mar 23, 2011 4:57:24 PM (10 years ago)
Author:
toby
Message:

conflicted

Location:
branches/sandbox
Files:
2 edited

Legend:

Unmodified
Added
Removed
  • branches/sandbox/gsascmds.tcl

    r1115 r1119  
    26962696    return
    26972697}
     2698<<<<<<< .mine
    26982699
    26992700proc ScanEXPforError {"ns {}"} {
     
    27052706    foreach key [array names ${ns}::exparray] {
    27062707        if {[string first "***" [set ${ns}::exparray($key)]] != -1 ||
     2708            [string first "#IN" [set ${ns}::exparray($key)]] != -1 ||
    27072709            [string first "nan" [set ${ns}::exparray($key)]] != -1 ||
    27082710            [string first "NAN" [set ${ns}::exparray($key)]] != -1
     
    27202722                foreach str [list [string range [set ${ns}::exparray($key)] 0 49]
    27212723                             [string range [set ${ns}::exparray($key)] 58 end]] {
    2722                     if {[string first "***" $str] || [string first "nan" $str] || [string first "NAN" $str]} {
     2724                    if {[string first "***" $str] ||
     2725                        [string first "#INF" $str] ||
     2726                        [string first "nan" $str] ||
     2727                        [string first "NAN" $str]} {
    27232728                        append warn "  Record \"$key\": [set ${ns}::exparray($key)]\n"
    27242729                        lappend badkeylist $key
     
    28332838}
    28342839
     2840=======
     2841
     2842proc ScanEXPforError {"ns {}"} {
     2843    # record types to ignore
     2844    set ignorelist {DESCR HSTRY PNAM HNAM "REFN STATS"}
     2845    set warn {}
     2846    set badkeylist {}
     2847    # scan file for warnings
     2848    foreach key [array names ${ns}::exparray] {
     2849        if {[string first "***" [set ${ns}::exparray($key)]] != -1 ||
     2850            [string first "nan" [set ${ns}::exparray($key)]] != -1 ||
     2851            [string first "NAN" [set ${ns}::exparray($key)]] != -1
     2852        } {
     2853            #puts [set ${ns}::exparray($key)]
     2854            set OK 0
     2855            foreach i $ignorelist {
     2856                if {[string first $i $key] != -1} {
     2857                    set OK 1
     2858                    break
     2859                }
     2860            }
     2861            # ignore atom name section of Atom records
     2862            if {(! $OK) && [string match  "CRS*AT*A" $key]} {
     2863                foreach str [list [string range [set ${ns}::exparray($key)] 0 49]
     2864                             [string range [set ${ns}::exparray($key)] 58 end]] {
     2865                    if {[string first "***" $str] || [string first "nan" $str] || [string first "NAN" $str]} {
     2866                        append warn "  Record \"$key\": [set ${ns}::exparray($key)]\n"
     2867                        lappend badkeylist $key
     2868                        break
     2869                    }
     2870                }
     2871                continue
     2872            }
     2873            if {! $OK} {
     2874                append warn "  Record \"$key\": [set ${ns}::exparray($key)]\n"
     2875                lappend badkeylist $key
     2876            }
     2877        }
     2878    }
     2879    if {$warn == ""} return
     2880    set hint ""
     2881    set unknown ""
     2882    foreach key $badkeylist {
     2883        if {[string match  "CRS*AT*" $key]} {
     2884            if {[string first "atomic parameter" $hint] == -1} {
     2885                append hint "\t* An atomic parameter (coordinate, occupancy or U) appears out of range\n"
     2886            }
     2887        } elseif {[string match  "CRS*ABC*" $key] ||
     2888                  [string match  "CRS*ANGLES*" $key] ||
     2889                  [string match  "CRS*CELVOL*" $key]} {
     2890            if {[string first "cell parameter" $hint] == -1} {
     2891                append hint "\t* A unit cell parameter appears out of range\n"
     2892            }
     2893        } elseif {[string match  "CRS*ODF*" $key]} {
     2894            if {[string first "spherical harmonic" $hint] == -1} {
     2895                append hint "\t* A spherical harmonic (ODF) parameter appears out of range\n"
     2896            }
     2897        } elseif {[string match  "HST*ICONS" $key]} {
     2898            if {[string first "diffractometer constant" $hint] == -1} {
     2899                append hint "\t* A diffractometer constant (wave, DIFC,...) appears out of range\n"
     2900            }
     2901        } elseif {[string match  "HST*TRNGE" $key]} {
     2902            if {[string first "histogram data range" $hint] == -1} {
     2903                append hint "\t* A histogram data range value appears out of range\n"
     2904            }
     2905        } elseif {[string match "*GNLS  RUN*" $key] ||
     2906                  [string match "*GNLS SHFTS" $key] ||
     2907                  [string match "HST*RPOWD" $key] ||
     2908                  [string match " REFN RPOWD " $key] ||
     2909                  [string match " REFN GDNFT " $key]
     2910              } {
     2911            if {[string first "refinement statistics" $hint] == -1} {
     2912                append hint "\t* The refinement statistics imply the last refinement diverged\n"
     2913            }
     2914        } else {
     2915            lappend unknown $key
     2916        }
     2917    }
     2918    if {$unknown != ""} {
     2919        append hint "\t* The following less common problem record(s) appear out of range:\n\t\t"
     2920        foreach key $unknown {
     2921            append hint "\"" [string trim $key] "\" "
     2922        }
     2923    }
     2924    return "Likely error(s) noted:\n$hint\nDetails of problem(s):\n$warn"
     2925}
     2926
     2927proc ExplainEXPerror {parent message file} {
     2928    if {$parent == "."} {
     2929        set w .experr
     2930    } else {
     2931        set w $parent.experr
     2932    }
     2933    catch {destroy $w}
     2934    toplevel $w -class Dialog
     2935    wm title $w "Corrupt .EXP file"
     2936    wm iconname $w Dialog
     2937    wm protocol $w WM_DELETE_WINDOW { }
     2938    # Make the message box transient if the parent is viewable.
     2939    if {[winfo viewable [winfo toplevel $parent]] } {
     2940        wm transient $w $parent
     2941    }
     2942    frame $w.bot
     2943    pack $w.bot -side bottom -fill both
     2944    frame $w.top
     2945    pack $w.top -side top -fill both -expand 1
     2946    frame $w.msg
     2947    pack $w.msg -in $w.top -side right -expand 1 -fill both -padx 3m -pady 3m
     2948    set txt {Likely errors were noted when reading this file}
     2949    append txt " ([file tail $file]). "
     2950    append txt "These problems probably\narose from the last refinement, "
     2951    append txt "based on settings applied in the previous saved file.\n"
     2952    append txt "It is probably not possible to continue with this file.\n"
     2953    append txt "You likely need to revert at least two archived versions back."
     2954    grid [label $w.msg.s -text $txt -justify left] -row 0 -column 0 -sticky nws
     2955    grid [button $w.msg.1 -text Help -bg yellow \
     2956              -command "MakeWWWHelp expgui.html badexp"] -row 0 -column 1 -columnspan 2 -sticky ne
     2957    bind $w <Key-F1> "MakeWWWHelp expgui.html badexp"
     2958    set filelist [lsort -dictionary -decreasing \
     2959                      [glob -nocomplain \
     2960                           [file root $file.O* ]]]
     2961    grid [text  $w.msg.t -font {Times 12} \
     2962              -height 10 -width 90 -relief flat -wrap word \
     2963              -yscrollcommand "$w.msg.rscr set" \
     2964             ] -row 1 -column 0  -columnspan 2 -sticky news
     2965    grid [scrollbar $w.msg.rscr  -command "$w.msg.t yview" \
     2966             ] -row 1 -column 2 -sticky ns
     2967    # give extra space to the text box
     2968    grid columnconfigure $w.msg 0 -weight 1
     2969    grid rowconfigure $w.msg 1 -weight 1
     2970    $w.msg.t insert end $message
     2971    button $w.ok -command [list destroy $w] -text OK -default active
     2972    pack $w.ok -in $w.bot -side left -expand 1 -padx 3m -pady 2m
     2973    putontop $w
     2974    tkwait window $w
     2975    afterputontop
     2976}
     2977
     2978>>>>>>> .r1118
    28352979proc UpdateInfoBox {} {
    28362980    global expgui
     
    37123856    global expgui
    37133857    if {$expgui(MacroChanged)} {
     3858
    37143859        set ans [MyMessageBox -parent $txt -title "Save macro file?" \
    37153860                     -message "Macro file has been changed, do you want to save it?" \
  • branches/sandbox/rb.tcl

    r1114 r1119  
    655655# Rigid body utility routines
    656656#============================================================================
     657<<<<<<< .mine
     658# RigidBodyGetVarNums: Returns a list of the variable numbers in use
     659#       for rigid body variable parameters.
     660# RigidBodyAtomNums: returns a list of atom numbers that are mapped to
     661#       rigid bodies in a selected phase
     662# RigidStartAtoms: returns a list of atoms that are allowed for creation of RB
     663# ExtractRigidBody: Use the GSAS geometry program to cartesian coordinates &
     664#       setting info for a RB from fractional coordinates for atoms in a phase
     665# RunRecalcRBCoords: updates the coordinates in all phases after changes have
     666#       been made to rigid parameters.
     667# CalcBody: Convert ortho to fractional coordinates using RB parameters
     668# FitBody: Optimize the origin and Euler angles to match a rigid body to a
     669#       set of fractional coordinates
     670# zmat2coord: convert a z-matrix to a set of cartesian coordinates
     671# RB2cart: convert the representation used for rigid bodies into
     672#       cartesian coordinates
     673# PlotRBtype: plot a rigid body with DRAWxtl
     674# PlotRBcoords: plot orthogonal coordinates with DRAWxtl
     675# DRAWxtlPlotRBFit: plot a set of fraction coordinates superimposed
     676#       on a structure read from a phase with DRAWxtl
     677#============================================================================
     678#============================================================================
     679# RigidBodyGetVarNums: Returns a list of the variable numbers used already
     680# for rigid body variable parameters
     681=======
    657682# RigidBodyGetVarNums: Returns a list of the variable numbers in use
    658683#       for rigid body variable parameters.
     
    678703# RigidBodyGetVarNums: Returns a list of the variable numbers used already
    679704# for rigid body variable parameters
     705>>>>>>> .r1117
    680706proc RigidBodyGetVarNums {} {
    681707    set varlist {}
     
    762788    # firstatom: sequence # in phase (may be > than number of the atom)
    763789    # originlist: atoms to define origin (where 1 is first atom in group; <= natom)
    764     # vector1: list of 3 values with X, Y or Z, atom #a and #b (number as in origin)
     790    # vector1: list of 3 values with X, Y or Z, atom #a and #b (number as in origin)  (for example {X 1 3})
    765791    # vector2: list of 3 values with X, Y or Z, atom #a and #b (number as in origin)
    766792    # note that vector2 must define a different axis than vector1
     
    770796    set fp [open "geom.inp" "w"]
    771797    puts $fp "N"
    772     puts $fp "N"
    773     puts $fp $phase
    774     puts $fp "N"
    775 
     798    if {[llength ::expmap(phaselist)] > 1} {
     799       # select phase
     800       puts $fp "N"
     801       puts $fp $phase
     802       puts $fp "N"
     803    }
    776804    puts $fp "R"
    777805    puts $fp "$natom"
     
    787815    puts $fp "X"
    788816    close $fp
     817    #puts "[file join $expgui(gsasexe) geometry] $expgui(expfile) < geom.inp > geom.out"
    789818    catch {
    790819        exec [file join $expgui(gsasexe) geometry] $expgui(expfile) < geom.inp > geom.out
    791     }
    792     file delete geom.inp
     820    } err
     821    #puts $err
     822    #file delete geom.inp
    793823    set fp [open geom.out r]
     824    set origin {}
     825    set Euler {}
     826    set coordlist {}
    794827    while {[gets $fp line] >= 0} {
    795828        if {[string first "Cell coordinates of origin" $line] != -1} {
    796829            set origin [lrange [string range $line [string first "are" $line] end] 1 3]
     830            #puts "origin in rb = $origin"
    797831        }
    798832        if {[string first "Rotation angles" $line] != -1} {
     
    821855    }
    822856    #file delete geom.out
     857    if {[llength $origin] == 0 || [llength $Euler] == 0 || [llength $coordlist] == 0} {
     858       puts "Error: run of GEOMETRY failed"
     859    }
    823860    return [list $origin $Euler $coordlist]
    824861}
     
    10601097# note that items 1-3 are computed with the imput origin, not the revised one
    10611098proc FitBodyOrigin {Euler cell ortholist useflag fraclist origin} {
     1099puts $fraclist
    10621100    set xform [CalcXformMatrix $Euler $cell]
     1101    puts "entering FitBodyOrigin"
    10631102    foreach var {x y z} {set sum($var) 0.0}
    1064 
    10651103    set i 0
    10661104    set sumdvs 0
     
    10681106    set rmsout {}
    10691107    foreach oc $ortholist use $useflag coord $fraclist {
    1070         #puts "ortho: $oc"
     1108        #puts "ortho: $oc"
    10711109        set frac [lrange [Ortho2Xtal $xform $origin $oc] 3 end]
    10721110        lappend fracout $frac
     
    10741112        set dvs 0
    10751113        foreach var {x y z} v1 $frac v2 $coord abc [lrange $cell 0 2] {
     1114puts "v2 = $v2"
     1115puts "v1 = $v1"
     1116puts "abc = $abc"
    10761117            set dv [expr {($v2 - $v1)*$abc}]
    10771118            set dvs [expr {$dvs + $dv*$dv}]
    10781119            set sumdvs [expr {$sumdvs + $dv*$dv}]
    10791120            if {$use} {set sum($var) [expr {$sum($var) + $dv/$abc}]}
     1121            puts "round and round"
    10801122        }
    10811123        lappend rmsout [expr {sqrt($dvs)}]
Note: See TracChangeset for help on using the changeset viewer.