/[ascend]/trunk/tcltk98/TK/SolverProc.tcl
ViewVC logotype

Annotation of /trunk/tcltk98/TK/SolverProc.tcl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 10 - (hide annotations) (download) (as text)
Sat Nov 13 16:40:11 2004 UTC (17 years, 2 months ago) by aw0a
File MIME type: text/x-tcl
File size: 177682 byte(s)
try again to commit moving tcl stuff
1 aw0a 1 # SolverProc.tcl: Solver Tcl Code
2     # by Benjamin A. Allan and Kirk A. Abbott
3     # Created: January 1994
4     # Part of ASCEND
5     # Revision: $Revision: 1.80 $
6     # Last modified on: $Date: 1998/06/18 15:55:00 $
7     # Last modified by: $Author: mthomas $
8     # Revision control file: $RCSfile: SolverProc.tcl,v $
9     #
10     # This file is part of the ASCEND Tcl/Tk Interface.
11     #
12     # Copyright (C) 1994-1998 Carnegie Mellon University
13     #
14     # The ASCEND Tcl/Tk Interface is free software; you can redistribute
15     # it and/or modify it under the terms of the GNU General Public
16     # License as published by the Free Software Foundation; either
17     # version 2 of the License, or (at your option) any later version.
18     #
19     # The ASCEND Tcl/Tk Interface is distributed in hope that it will be
20     # useful, but WITHOUT ANY WARRANTY; without even the implied warranty
21     # of MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
22     # GNU General Public License for more details.
23     #
24     # You should have received a copy of the GNU General Public License
25     # along with the program; if not, write to the Free Software
26     # Foundation, Inc., 675 Mass Ave, Cambridge, MA 02139 USA. Check the
27     # file named COPYING. COPYING is found in ../compiler.
28    
29     # File structure:
30     # default set procedures
31     # menu button direct callbacks
32     # menu button internals
33     # utility routines
34     # routines that should be in other files
35    
36     global SolverNames
37     set SolverNames [list Slv MINOS Opt QRSlv CSlv makeMPS NGSlv CMSlv LRSlv]
38    
39    
40     #
41     #
42     # proc set_Solver_Defaults {}
43     #------------------------------------------------------------------------
44     # set vars/bindings on solver
45     #------------------------------------------------------------------------
46     proc set_Solver_Defaults {} {
47     entertrace
48     # puts "setting solver buttons"
49     # solver defaults vectors
50     # G(32767): general
51     # 0:slv, 1:MINOS, 2:opt, 3:QRSlv beta, 4: cslv
52     # 5:LSSLv beta, 6:makeMPS, 7:NGSlv, 8:CONOPT, 9: CMSlv, 9a: LRSlv
53     global ascSolvVect
54     global ascSolv32767Vect
55     global ascSolv0Vect
56     global ascSolv1Vect
57     global ascSolv2Vect
58     global ascSolv3Vect
59     global ascSolv4Vect
60     global ascSolv5Vect
61     global ascSolv6Vect
62     global ascSolv7Vect
63     global ascSolv8Vect
64     global ascSolv9Vect
65     global ascSolv9aVect
66     global ascSolvStatVect
67    
68     Solve_set_SolverRegisteredNumbers
69    
70     if {[catch {set ascSolvStatVect(empty)} ]} {
71     # not a restart. set things
72     # solver window miscellany: buckets of this should come from option get
73     set ascSolvVect(modeltype) ""
74     # set in globaldefs
75     # set ascSolvVect(modelbar) 1
76     set ascSolvVect(pathname) ""
77     set ascSolvVect(statVisible) 1
78     set ascSolvVect(instname) ""
79     set ascSolvVect(objvarname) ""
80     set ascSolvVect(simname) ""
81     set ascSolvVect(windowname) ".solver"
82     set ascSolvVect(debuggerup) 0
83     set ascSolvVect(mtxup) 0
84     # status box information and related detail
85     set ascSolvStatVect(statreport) 1
86     set ascSolvStatVect(empty) 1
87     set ascSolvStatVect(eventqueue) ""
88     set ascSolvStatVect(running) 0
89     set ascSolvStatVect(objval) none
90     set ascSolvStatVect(solvernum) 0
91     set ascSolvStatVect(ok) 1
92     set ascSolvStatVect(menubreak) 0
93     set ascSolvStatVect(overdefined) 1
94     set ascSolvStatVect(underdefined) 1
95     set ascSolvStatVect(structsingular) 1
96     set ascSolvStatVect(fpcaught) 0
97     set ascSolvStatVect(ready2solve) 1
98     set ascSolvStatVect(converged) 1
99     set ascSolvStatVect(diverged) 1
100     set ascSolvStatVect(inconsistent) 1
101     set ascSolvStatVect(calcok) 1
102     set ascSolvStatVect(itnlim_exceeded) 1
103     set ascSolvStatVect(timlim_exceeded) 1
104     set ascSolvStatVect(iteration) 1
105     set ascSolvStatVect(cpuelapsed) 1
106     set ascSolvStatVect(iterations) "0/0"
107    
108     set ascSolvStatVect(block.number) ""
109     set ascSolvStatVect(block.current) ""
110     set ascSolvStatVect(block.size) ""
111     set ascSolvStatVect(block.prevtotsize) ""
112     set ascSolvStatVect(block.iteration) ""
113     set ascSolvStatVect(block.cpuelapsed) ""
114     set ascSolvStatVect(block.residual) ""
115    
116     set ascSolvStatVect(totalrels) ""
117     set ascSolvStatVect(rels) ""
118     set ascSolvStatVect(in_rels) ""
119     set ascSolvStatVect(inc_rels) ""
120     set ascSolvStatVect(eqals) ""
121     set ascSolvStatVect(inc_eqals) ""
122     set ascSolvStatVect(ineqals) ""
123     set ascSolvStatVect(inc_ineqals) ""
124     set ascSolvStatVect(in_inc_eqals) ""
125     set ascSolvStatVect(in_inc_ineqals) ""
126     set ascSolvStatVect(uninc_rels) ""
127     set ascSolvStatVect(totalvars) ""
128     set ascSolvStatVect(in_vars) ""
129     set ascSolvStatVect(vars) ""
130     set ascSolvStatVect(inc_vars) ""
131     set ascSolvStatVect(un_vars) ""
132     set ascSolvStatVect(free_vars) ""
133     set ascSolvStatVect(fixed_vars) ""
134     set ascSolvStatVect(in_free_vars) ""
135     set ascSolvStatVect(in_fixed_vars) ""
136     set ascSolvStatVect(solver) "QRSlv"
137     set ascSolvStatVect(solved_vars) ""
138     set ascSolvStatVect(state) ""
139     set ascSolvStatVect(start_block) ""
140     set ascSolvStatVect(stop_block) ""
141    
142     set_SolvG_Defaults
143     # set_Solv0_Defaults
144     # set_Solv1_Defaults
145     # set_Solv6_Defaults
146     for {set s 0} {$s<$ascSolvVect(numberofsolvers)} {incr s} {
147     set_defaults $s
148     }
149    
150     set fpe [string tolower $ascSolvVect(trapFPEdefault)]
151     if {$fpe=="no" || $fpe=="0" || $fpe=="false"} {
152     slv_trapfp
153     #side effect sets the interrupt trap. need to fix that.
154     slv_untrapfp
155     } {
156     slv_trapfp
157     }
158     }
159    
160     set ascSolv32767Vect(monitor) 0 ;# set this to 1 in .ascend.ad
161     Solve_Build_EngineMenus
162     Solve_Build_SaveParsMenus
163     Solve_Update_MenuBar
164     bind .solver <Control-Key-C> Solve_do_Interrupt
165     bind .solver <F5> Solve_do_Solve
166     bind .solver <F6> Solve_do_Iterate
167     bind .solver <F7> Solve_do_Integrate
168     bind .solver <Control-Key-p> Solve_do_Display_Status
169     bind .solver <Control-Key-g> {Solve_do_Parms open General}
170     bind .solver.lbl_frm.lbl_run <B3-ButtonRelease> {Help_button solver.running}
171    
172     leavetrace
173     }
174    
175    
176     #
177     #proc set_defaults {number}
178     #------------------------------------------------------------------
179     # automatically builds procedures for setting up solvers parameter
180     # pages. Calls procedure after creating also.
181     # Desired improvements:
182     # automaticaly detect and set maxlines.
183     # error detection in c code and appropriate bailout in tcl
184     #------------------------------------------------------------------
185     proc set_defaults {number} {
186     entertrace
187     global ascSolvVect
188     # nest call actually gets defaults
189     set list [slv_get_parmsnew $number]
190     set length [llength $list]
191     set name $ascSolvVect(name.$number)
192     set parm_num 0
193     set max_page 0
194     set display_list ""
195     set set_list ""
196     for {set i 0} {$i < $length} {incr i} {
197     if {[string compare [lindex $list $i] "New_Parm"] == 0} {
198     incr i
199     if {[string compare [lindex $list $i] "char_parm"] != 0} {
200     set parm_type {}
201     switch -exact -- [lindex $list $i] {
202     int_parm {
203     set parm_type int
204     }
205     bool_parm {
206     set parm_type bool
207     }
208     real_parm {
209     set parm_type real
210     }
211     default {
212     puts "Big problem in set_defaults: unrecognized type"
213     # need better bailout / error checking here
214     continue
215     }
216     }
217     set j $i
218     incr j
219     set parm_name [lindex $list $j]; incr j
220     set parm_label [lindex $list $j]; incr j
221     set parm_val [lindex $list $j]; incr j
222     set parm_hi [lindex $list $j]; incr j
223     set parm_lo [lindex $list $j]; incr j
224     set parm_page [lindex $list $j]; incr j
225     set parm_help [lindex $list $j]; incr j
226     if {$parm_page > 0} {
227     lappend display_list $parm_name
228     if {$parm_page > $max_page} {
229     set max_page $parm_page
230     }
231     }
232     append set_list \$ascSolv${name}Vect($parm_name)
233     append set_list " "
234     proc ${name}_parm$parm_num {} "
235     entertrace
236     global ascSolv${name}Vect
237     set ascSolv${name}Vect($parm_name) $parm_val
238     set ascSolv${name}Vect($parm_name.type) $parm_type
239     set ascSolv${name}Vect($parm_name.label) \{$parm_label\}
240     set ascSolv${name}Vect($parm_name.lo) $parm_lo
241     set ascSolv${name}Vect($parm_name.hi) $parm_hi
242     set ascSolv${name}Vect($parm_name.page) $parm_page
243     set ascSolv${name}Vect($parm_name.help) \{$parm_help\}
244     "
245     incr parm_num
246     set i [expr $i + 7]
247     } else {
248     set j $i
249     incr j
250     set parm_type string
251     set parm_name [lindex $list $j]; incr j
252     set parm_label [lindex $list $j]; incr j
253     set parm_val [lindex $list $j]; incr j
254     set parm_hi [lindex $list $j]; incr j
255     set parm_list ""
256     for {set j 0} {$j < $parm_hi} {incr j} {
257     lappend parm_list [lindex $list [expr $i + 5 + $j]]
258     }
259     append set_list \$ascSolv${name}Vect($parm_name)
260     append set_list " "
261     set parm_page [lindex $list [expr $i + 5 + $parm_hi]]
262     set parm_help [lindex $list [expr $i + 6 + $parm_hi]]
263     if {$parm_page > 0} {
264     lappend display_list $parm_name
265     if {$parm_page > $max_page} {
266     set max_page $parm_page
267     }
268     }
269     proc ${name}_parm$parm_num {} "
270     entertrace
271     global ascSolv${name}Vect
272     set ascSolv${name}Vect($parm_name) \{$parm_val\}
273     set ascSolv${name}Vect($parm_name.type) $parm_type
274     set ascSolv${name}Vect($parm_name.label) \{$parm_label\}
275     set ascSolv${name}Vect($parm_name.choices) \{$parm_list\}
276     set ascSolv${name}Vect($parm_name.page) $parm_page
277     set ascSolv${name}Vect($parm_name.page) \{$parm_help\}
278     "
279     incr parm_num
280     set i [expr $i + 5 + $parm_hi]
281     }
282     }
283     }
284    
285     # define a Defaults proc, which is rather a messy thing to do
286     proc set_${name}_Defaults {} "
287     entertrace
288     global ascSolv${name}Vect
289     set ascSolv${name}Vect(namelist) \{$display_list\}
290     set ascSolv${name}Vect(toplevel) .slv${name}parms
291     set ascSolv${name}Vect(title) \"$name Parameters\"
292     set ascSolv${name}Vect(maxlines) 12
293     set ascSolv${name}Vect(onesize) 0
294     set ascSolv${name}Vect(npages) $max_page
295     set ascSolv${name}Vect(grab) 0
296     set ascSolv${name}Vect(cancellable) 0
297     set ascSolv${name}Vect(helpcommand) \
298     \"Help_button solver.$name.parameters\"
299     set ascSolv${name}Vect(whenokcommand) \"Solve_do_Parms close $name\"
300     for {set p 0} { \$p < $parm_num} {incr p} {
301     ${name}_parm\$p
302     }
303     leavetrace
304     "
305    
306     proc Solve_${name}_Downdate_ParmBoxNew {} "
307     entertrace
308     global ascSolv${name}Vect
309     set_slv_parmsnew $number $set_list
310     leavetrace
311     "
312    
313     # Now call procedure to set defaults
314     set_${name}_Defaults
315     }
316    
317     #
318     # proc set_SolvG_Defaults {}
319     # ----------------------------------------------------------------------
320     # set defaults for control of the General solver, that is, a page full
321     # of parameters for anyone to fall back on if so desired or during
322     # development of the interface to a new solver.
323     # Subparameters, that is solver specific controls should only be mentioned
324     # in ascSolvXVect.
325     #
326     # Not all of the parameters on this page correspond to C variables directly.
327     # ----------------------------------------------------------------------
328     proc set_SolvG_Defaults {} {
329     entertrace
330     global ascSolv32767Vect
331     # General parameter page setup variables
332     set ascSolv32767Vect(namelist) [list \
333     lnmepsilon update_frequency update_time dtmin dtmax dtzero \
334     moststeps newlog checksing showavgs \
335     yfilename obsfilename logsi logcol nearbound farnom]
336     set ascSolv32767Vect(toplevel) .slv32767parms
337     set ascSolv32767Vect(title) "General Parameters"
338     set ascSolv32767Vect(maxlines) 12
339     set ascSolv32767Vect(npages) 2
340     set ascSolv32767Vect(grab) 0
341     set ascSolv32767Vect(cancellable) 0
342     set ascSolv32767Vect(helpcommand) ""
343     set ascSolv32767Vect(whenokcommand) "Solve_do_Parms close General"
344     if {![info exists ascSolv32767Vect(checksing)]} {
345     # set defaults for vars, OTHERWISE assume optoin file set them.
346     set ascSolv32767Vect(checksing) 0
347     set ascSolv32767Vect(showavgs) 0
348     set ascSolv32767Vect(update_frequency) 10
349     set ascSolv32767Vect(update_time) 3
350     set ascSolv32767Vect(lnmepsilon) 1e-8
351     set ascSolv32767Vect(farnom) 10e3
352     set ascSolv32767Vect(nearbound) 1e-3
353     set ascSolv32767Vect(newlog) 1
354     set ascSolv32767Vect(logcol) variable
355     set ascSolv32767Vect(logsi) display
356     set ascSolv32767Vect(obsfilename) "obs.dat"
357     set ascSolv32767Vect(yfilename) "y.dat"
358     set ascSolv32767Vect(dtzero) 0
359     set ascSolv32767Vect(dtmax) 0
360     set ascSolv32767Vect(dtmin) 0
361     set ascSolv32767Vect(moststeps) 0
362     }
363     set ascSolv32767Vect(checksing.type) bool
364     set ascSolv32767Vect(checksing.label) "check numeric rank after solving"
365     set ascSolv32767Vect(checksing.help) \
366     "checks automatically for Jacobian matrix singularity\n"
367     append ascSolv32767Vect(checksing.help) "after solution with a solver that\n"
368     append ascSolv32767Vect(checksing.help) "uses a Jacobian matrix."
369     set ascSolv32767Vect(showavgs.type) bool
370     set ascSolv32767Vect(showavgs.label) "show block summary"
371     set ascSolv32767Vect(showavgs.help) \
372     "automatically displays time and function/gradient statistics\n"
373     append ascSolv32767Vect(showavgs.help) "for solvers which produce them\n"
374     set ascSolv32767Vect(update_frequency.type) int
375     set ascSolv32767Vect(update_frequency.lo) 1
376     set ascSolv32767Vect(update_frequency.label) \
377     "iterations before screen update"
378     set ascSolv32767Vect(update_frequency.help) \
379     "The GUI update at each solver iteration can be expensive sometimes.\n"
380     append ascSolv32767Vect(update_frequency.help) \
381     "For faster performance, with less user feedback, make this number large."
382     append ascSolv32767Vect(update_frequency.help) \
383     "\nFor maximum interactivity, make this number 1."
384     set ascSolv32767Vect(update_time.type) int
385     set ascSolv32767Vect(update_time.lo) 1
386     set ascSolv32767Vect(update_time.label) "cpu sec before screen update"
387     set ascSolv32767Vect(update_time.help) \
388     "This is the maximum time, regardless of iteration count, allowed before \n"
389     append ascSolv32767Vect(update_time.help) \
390     "a GUI update will be scheduled. Once scheduled, the GUI update will\n"
391     append ascSolv32767Vect(update_time.help) \
392     "occur at the end of the next iteration where the solver returns control\n"
393     append ascSolv32767Vect(update_time.help) "to ASCEND."
394    
395     set ascSolv32767Vect(lnmepsilon.label) "modified log epsilon"
396     set ascSolv32767Vect(lnmepsilon.lo) 1e-16
397     set ascSolv32767Vect(lnmepsilon.hi) 0.5
398     set ascSolv32767Vect(lnmepsilon.type) real
399     set ascSolv32767Vect(moststeps.page) 2
400     set ascSolv32767Vect(moststeps.label) "most integrator steps per time sample"
401     set ascSolv32767Vect(moststeps.lo) 0
402     set ascSolv32767Vect(moststeps.type) int
403     set ascSolv32767Vect(moststeps.help) \
404     "If this number is 0, integrators will use their built-in limit.\n"
405     append ascSolv32767Vect(moststeps.help) \
406     "You can tell the integrator a different limit by setting this to non-0."
407     set ascSolv32767Vect(dtmin.page) 2
408     set ascSolv32767Vect(dtmin.label) "minimum integrator step (SI units)"
409     set ascSolv32767Vect(dtmin.lo) 0
410     set ascSolv32767Vect(dtmin.hi) 20.0
411     set ascSolv32767Vect(dtmin.type) real
412     set ascSolv32767Vect(dtmin.help) \
413     "If this number is 0, integrators will use their built-in limit.\n"
414     append ascSolv32767Vect(dtmin.help) \
415     "You can tell the integrator a different limit by setting this to non-0."
416     set ascSolv32767Vect(dtmax.page) 2
417     set ascSolv32767Vect(dtmax.label) "maximum integrator step (SI units)"
418     set ascSolv32767Vect(dtmax.lo) 0
419     set ascSolv32767Vect(dtmax.hi) 20.0
420     set ascSolv32767Vect(dtmax.type) real
421     set ascSolv32767Vect(dtmax.help) \
422     "If this number is 0, integrators will use their built-in limit.\n"
423     append ascSolv32767Vect(dtmax.help) \
424     "You can tell the integrator a different limit by setting this to non-0."
425     set ascSolv32767Vect(dtzero.page) 2
426     set ascSolv32767Vect(dtzero.label) "initial integrator step size (SI units)"
427     set ascSolv32767Vect(dtzero.lo) 0
428     set ascSolv32767Vect(dtzero.hi) 20.0
429     set ascSolv32767Vect(dtzero.type) real
430     set ascSolv32767Vect(dtzero.help) \
431     "If this number is 0, integrators will use their built-in initial step.\n"
432     append ascSolv32767Vect(dtzero.help) \
433     "You can tell the integrator a different start by setting this to non-0.\n"
434     append ascSolv32767Vect(dtzero.help) \
435     "If your problem is very stiff, setting this to a small value may help."
436     set ascSolv32767Vect(yfilename.page) 2
437     set ascSolv32767Vect(yfilename.label) "integrator state log"
438     set ascSolv32767Vect(yfilename.type) string
439     set ascSolv32767Vect(yfilename.help) \
440     "directory path and file to store log of state and derivative values"
441     set ascSolv32767Vect(obsfilename.page) 2
442     set ascSolv32767Vect(obsfilename.label) "integrator observation log"
443     set ascSolv32767Vect(obsfilename.type) string
444     set ascSolv32767Vect(obsfilename.help) \
445     "directory path and file to store observation profiles"
446     set ascSolv32767Vect(logsi.page) 2
447     set ascSolv32767Vect(logsi.type) string
448     set ascSolv32767Vect(logsi.label) "integrator log SI units"
449     set ascSolv32767Vect(logsi.choices) "si display"
450     set ascSolv32767Vect(logsi.help) "Observation and state logs are written\n"
451     append ascSolv32767Vect(logsi.help) \
452     "in either SI or your current displayed units"
453     set ascSolv32767Vect(logcol.page) 2
454     set ascSolv32767Vect(logcol.type) string
455     set ascSolv32767Vect(logcol.label) "integrator log columns"
456     set ascSolv32767Vect(logcol.choices) "variable fixed"
457     set ascSolv32767Vect(logcol.help) "Observation and state logs are written\n"
458     append ascSolv32767Vect(logcol.help) \
459     "in either fixed or variable column width for consumption by other software"
460     set ascSolv32767Vect(newlog.page) 2
461     set ascSolv32767Vect(newlog.type) bool
462     set ascSolv32767Vect(newlog.label) "overwrite integrator logs"
463     set ascSolv32767Vect(nearbound.label) "bound check epsilon"
464     set ascSolv32767Vect(nearbound.lo) 0
465     set ascSolv32767Vect(nearbound.type) real
466     set ascSolv32767Vect(farnom.label) "far from nom bignum"
467     set ascSolv32767Vect(farnom.lo) 0
468     set ascSolv32767Vect(farnom.type) real
469     leavetrace
470     }
471    
472     #
473     # proc Solve_Build_EngineMenus {}
474     # ----------------------------------------------------------------------
475     # construct choices for all the linked solvers
476     # ----------------------------------------------------------------------
477     proc Solve_Build_EngineMenus {} {
478     entertrace
479     global ascSolvVect
480     for {set s 0} {$s<$ascSolvVect(numberofsolvers)} {incr s} {
481     if {$ascSolvVect(available.$s)} {
482     set state active
483     } else {
484     set state disabled
485     }
486     .solver.lbl_frm.entry5.m add command \
487     -command "Solve_do_Select $ascSolvVect(name.$s)" \
488     -label "$ascSolvVect(name.$s)" \
489     -state $state
490     .solver.lbl_frm.btn_opts.m add command \
491     -command "Solve_do_Parms open $ascSolvVect(name.$s)" \
492     -label "$ascSolvVect(name.$s) ..." \
493     -state $state
494     }
495     leavetrace
496     }
497    
498     #
499     # proc Solve_Build_SaveParsMenus {}
500     # ----------------------------------------------------------------------
501     # construct choices for all the linked solvers
502     # ----------------------------------------------------------------------
503     proc Solve_Build_SaveParsMenus {} {
504     entertrace
505     global ascSolvVect
506     for {set s 0} {$s<$ascSolvVect(numberofsolvers)} {incr s} {
507    
508     $ascSolvVect(saveparmenu) add command \
509     -command "View_Save_Solver_Params $s" \
510     -label $ascSolvVect(name.$s)
511    
512     }
513     leavetrace
514     }
515    
516     #
517     # proc set_Solv0_Defaults {}
518     # ----------------------------------------------------------------------
519     # set defaults for control of Slv
520     # ----------------------------------------------------------------------
521     proc set_Solv0_Defaults {} {
522     entertrace
523     global ascSolv0Vect
524     # SLV parameter page setup variables
525     set ascSolv0Vect(namelist) [list partition showlessimportant timelimit \
526     iterationlimit singtol pivottol feastol rho autoresolve \
527     showlessimportantds savlin]
528     set ascSolv0Vect(toplevel) .slv0parms
529     set ascSolv0Vect(title) "Slv Parameters"
530     set ascSolv0Vect(maxlines) 12
531     set ascSolv0Vect(npages) 2
532     set ascSolv0Vect(grab) 0
533     set ascSolv0Vect(helpcommand) "Help_button solver.slv.parameters"
534     set ascSolv0Vect(whenokcommand) "Solve_do_Parms close Slv"
535     # not window page supported Slv parms
536     set ascSolv0Vect(ignorebounds) "0"
537     set ascSolv0Vect(showmoreimportant) "1"
538     set ascSolv0Vect(termtol) 1e-11
539     # SLV parameter page variables
540     set ascSolv0Vect(rho) "100"
541     set ascSolv0Vect(rho.page) 1
542     set ascSolv0Vect(rho.type) real
543     set ascSolv0Vect(rho.lo) 0
544     set ascSolv0Vect(rho.label) "penalty parameter"
545     set ascSolv0Vect(partition) "1"
546     set ascSolv0Vect(partition.page) 1
547     set ascSolv0Vect(partition.type) bool
548     set ascSolv0Vect(partition.label) "partitioning enabled"
549     set ascSolv0Vect(bppivoting) "0"
550     set ascSolv0Vect(bppivoting.page) 2
551     set ascSolv0Vect(bppivoting.type) bool
552     set ascSolv0Vect(bppivoting.label) "bipartial pivoting"
553     set ascSolv0Vect(showlessimportant) "0"
554     set ascSolv0Vect(showlessimportant.page) 1
555     set ascSolv0Vect(showlessimportant.type) bool
556     set ascSolv0Vect(showlessimportant.label) "detailed solving info required"
557     set ascSolv0Vect(showlessimportantds) 0
558     set ascSolv0Vect(showlessimportantds.page) 2
559     set ascSolv0Vect(showlessimportantds.type) bool
560     set ascSolv0Vect(showlessimportantds.label) "show singletons details"
561     set ascSolv0Vect(savlin) 0
562     set ascSolv0Vect(savlin.page) 2
563     set ascSolv0Vect(savlin.type) bool
564     set ascSolv0Vect(savlin.label) "write to file SlvLinsol.dat"
565     set ascSolv0Vect(autoresolve) 1
566     set ascSolv0Vect(autoresolve.page) 1
567     set ascSolv0Vect(autoresolve.type) bool
568     set ascSolv0Vect(autoresolve.label) auto-resolve
569     set ascSolv0Vect(timelimit) 1000
570     set ascSolv0Vect(timelimit.page) 1
571     set ascSolv0Vect(timelimit.type) int
572     set ascSolv0Vect(timelimit.lo) 1
573     set ascSolv0Vect(timelimit.label) "time limit (CPU sec/block)"
574     set ascSolv0Vect(iterationlimit) 20
575     set ascSolv0Vect(iterationlimit.page) 1
576     set ascSolv0Vect(iterationlimit.lo) 1
577     set ascSolv0Vect(iterationlimit.type) int
578     set ascSolv0Vect(iterationlimit.label) "maximum iterations/block"
579     set ascSolv0Vect(stattol) "1e-6"
580     set ascSolv0Vect(stattol.page) 1
581     set ascSolv0Vect(termtol) "1e-12"
582     set ascSolv0Vect(singtol) "1e-12"
583     set ascSolv0Vect(singtol.page) 1
584     set ascSolv0Vect(singtol.type) real
585     set ascSolv0Vect(singtol.lo) 1e-12
586     set ascSolv0Vect(singtol.label) "epsilon (minimum pivot)"
587     set ascSolv0Vect(pivottol) "0.01"
588     set ascSolv0Vect(pivottol.page) 1
589     set ascSolv0Vect(pivottol.label) "pivot tolerance"
590     set ascSolv0Vect(pivottol.lo) 0
591     set ascSolv0Vect(pivottol.hi) 1
592     set ascSolv0Vect(pivottol.type) real
593     set ascSolv0Vect(feastol) "1e-8"
594     set ascSolv0Vect(feastol.page) 1
595     set ascSolv0Vect(feastol.lo) "1e-13"
596     set ascSolv0Vect(feastol.type) real
597     set ascSolv0Vect(feastol.label) "max. residual (absolute)"
598     leavetrace
599     }
600     #
601     # proc set_Solv1_Defaults {}
602     # ----------------------------------------------------------------------
603     # set defaults for control of minos
604     # keep me until we resurrect minos
605     # ----------------------------------------------------------------------
606     proc set_Solv1_Defaults {} {
607     entertrace
608     global ascSolv1Vect
609     # SLV parameter page setup variables
610     set ascSolv1Vect(namelist) [list damp mindamp tolsing tolfeas tolstat \
611     timelimit majits rho showlessimportant autoresolve \
612     completion crash cfreq ffreq uselg lfreq deriv minits mulpr \
613     parpr printJ printF printL printX printB scale param verify \
614     fdiff cdiff fprec lstol lufto luuto ludto lusto luwto \
615     subsp radius objlim steplm summary filesumm \
616     lobjwt soln lcons]
617     set ascSolv1Vect(toplevel) .slv1parms
618     set ascSolv1Vect(title) "MINOS Parameters"
619     set ascSolv1Vect(maxlines) 15
620     set ascSolv1Vect(npages) 4
621     set ascSolv1Vect(grab) 0
622     set ascSolv1Vect(helpcommand) "Help_button solver.minos.parameters"
623     set ascSolv1Vect(whenokcommand) "Solve_do_Parms close MINOS"
624     # not window page supported minos parms
625     set ascSolv1Vect(showmoreimportant) "1"
626     # MINOS parameter page variables
627    
628     set ascSolv1Vect(tolsing) "1e-11"
629     set ascSolv1Vect(tolsing.page) 1
630     set ascSolv1Vect(tolsing.type) real
631     set ascSolv1Vect(tolsing.lo) 1e-16
632     set ascSolv1Vect(tolsing.label) "Epsilon (Pivot Tolerance)"
633     set ascSolv1Vect(tolfeas) "1e-8"
634     set ascSolv1Vect(tolfeas.page) 1
635     set ascSolv1Vect(tolfeas.label) "Max. residual"
636     set ascSolv1Vect(tolfeas.lo) 1e-16
637     set ascSolv1Vect(tolfeas.type) real
638     set ascSolv1Vect(tolstat) "1e-8"
639     set ascSolv1Vect(tolstat.page) 2
640     set ascSolv1Vect(tolstat.label) "Optimality tolerance"
641     set ascSolv1Vect(tolstat.lo) 1e-16
642     set ascSolv1Vect(tolstat.type) real
643     set ascSolv1Vect(majits) "20"
644     set ascSolv1Vect(majits.page) "1"
645     set ascSolv1Vect(majits.lo) 1
646     set ascSolv1Vect(majits.type) int
647     set ascSolv1Vect(majits.label) "Major iterations limit"
648    
649     set ascSolv1Vect(timelimit) "500"
650     set ascSolv1Vect(timelimit.page) 1
651     set ascSolv1Vect(timelimit.type) int
652     set ascSolv1Vect(timelimit.lo) 1
653     set ascSolv1Vect(timelimit.label) "Time limit (CPU sec)"
654     set ascSolv1Vect(rho) "1e-11"
655     set ascSolv1Vect(rho.page) 1
656     set ascSolv1Vect(rho.type) real
657     set ascSolv1Vect(rho.lo) 0
658     set ascSolv1Vect(rho.label) "Penalty parameter"
659     set ascSolv1Vect(autoresolve) "0"
660     set ascSolv1Vect(autoresolve.page) "1"
661     set ascSolv1Vect(autoresolve.type) bool
662     set ascSolv1Vect(autoresolve.label) auto-resolve
663     set ascSolv1Vect(showlessimportant) 0
664     set ascSolv1Vect(showlessimportant.page) 1
665     set ascSolv1Vect(showlessimportant.type) bool
666     set ascSolv1Vect(showlessimportant.label) "detailed solving info required"
667    
668     set ascSolv1Vect(completion) 1
669     set ascSolv1Vect(completion.page) 2
670     set ascSolv1Vect(completion.type) bool
671     set ascSolv1Vect(completion.label) "Full completion"
672     set ascSolv1Vect(crash) 1
673     set ascSolv1Vect(crash.page) 2
674     set ascSolv1Vect(crash.type) int
675     set ascSolv1Vect(crash.lo) 0
676     set ascSolv1Vect(crash.hi) 4
677     set ascSolv1Vect(crash.label) "Crash option"
678     set ascSolv1Vect(deriv) 3
679     set ascSolv1Vect(deriv.page) 4
680     set ascSolv1Vect(deriv.type) int
681     set ascSolv1Vect(deriv.lo) 0
682     set ascSolv1Vect(deriv.hi) 3
683     set ascSolv1Vect(deriv.label) "Derivative level"
684     set ascSolv1Vect(cfreq) 30
685     set ascSolv1Vect(cfreq.page) 4
686     set ascSolv1Vect(cfreq.lo) 1
687     set ascSolv1Vect(cfreq.type) int
688     set ascSolv1Vect(cfreq.label) "Linear check frequency"
689     set ascSolv1Vect(ffreq) 50
690     set ascSolv1Vect(ffreq.page) 4
691     set ascSolv1Vect(ffreq.lo) 0
692     set ascSolv1Vect(ffreq.type) int
693     set ascSolv1Vect(ffreq.label) "Basis factorization frequency"
694     set ascSolv1Vect(efreq) 0
695     set ascSolv1Vect(efreq.page) 4
696     set ascSolv1Vect(efreq.lo) 0
697     set ascSolv1Vect(efreq.type) int
698     set ascSolv1Vect(efreq.label) "Expand frequency"
699     set ascSolv1Vect(uselg) 1
700     set ascSolv1Vect(uselg.page) 2
701     set ascSolv1Vect(uselg.type) bool
702     set ascSolv1Vect(uselg.label) "Lagrangian subproblems"
703     set ascSolv1Vect(lfreq) 10
704     set ascSolv1Vect(lfreq.page) 3
705     set ascSolv1Vect(lfreq.lo) 1
706     set ascSolv1Vect(lfreq.type) int
707     set ascSolv1Vect(lfreq.label) "Log frequency"
708     set ascSolv1Vect(minits) 40
709     set ascSolv1Vect(minits.page) 2
710     set ascSolv1Vect(minits.lo) 0
711     set ascSolv1Vect(minits.type) int
712     set ascSolv1Vect(minits.label) "Minor iterations limit"
713     set ascSolv1Vect(mulpr) 1
714     set ascSolv1Vect(mulpr.page) 2
715     set ascSolv1Vect(mulpr.lo) 0
716     set ascSolv1Vect(mulpr.type) int
717     set ascSolv1Vect(mulpr.label) "Multiple price"
718    
719     set ascSolv1Vect(parpr) 0
720     set ascSolv1Vect(parpr.page) 2
721     set ascSolv1Vect(parpr.lo) 0
722     set ascSolv1Vect(parpr.type) int
723     set ascSolv1Vect(parpr.label) "Partial price"
724     set ascSolv1Vect(summary) 0
725     set ascSolv1Vect(summary.page) 3
726     set ascSolv1Vect(summary.type) bool
727     set ascSolv1Vect(summary.label) "Show PRINT output"
728     set ascSolv1Vect(filesumm) 0
729     set ascSolv1Vect(filesumm.page) 3
730     set ascSolv1Vect(filesumm.type) bool
731     set ascSolv1Vect(filesumm.label) "Save summary file"
732     set ascSolv1Vect(printJ) 0
733     set ascSolv1Vect(printJ.page) 3
734     set ascSolv1Vect(printJ.type) bool
735     set ascSolv1Vect(printJ.label) "Print jacobian"
736     set ascSolv1Vect(printF) 0
737     set ascSolv1Vect(printF.page) 3
738     set ascSolv1Vect(printF.type) bool
739     set ascSolv1Vect(printF.label) "Print nonlinear residuals"
740     set ascSolv1Vect(printL) 0
741     set ascSolv1Vect(printL.page) 3
742     set ascSolv1Vect(printL.type) bool
743     set ascSolv1Vect(printL.label) "Print multiplier estimates"
744     set ascSolv1Vect(printX) 0
745     set ascSolv1Vect(printX.page) 3
746     set ascSolv1Vect(printX.type) bool
747     set ascSolv1Vect(printX.label) "Print nonlinear variables"
748     set ascSolv1Vect(soln) 0
749     set ascSolv1Vect(soln.page) 3
750     set ascSolv1Vect(soln.type) bool
751     set ascSolv1Vect(soln.label) "Print solution"
752     set ascSolv1Vect(printB) 0
753     set ascSolv1Vect(printB.page) 3
754     set ascSolv1Vect(printB.type) bool
755     set ascSolv1Vect(printB.label) "Print basis stats"
756     set ascSolv1Vect(scale) 0
757     set ascSolv1Vect(scale.page) 4
758     set ascSolv1Vect(scale.type) bool
759     set ascSolv1Vect(scale.label) "Let minos scale, too"
760     set ascSolv1Vect(param) 0
761     set ascSolv1Vect(param.page) 3
762     set ascSolv1Vect(param.type) bool
763     set ascSolv1Vect(param.label) "Suppress parameter echo"
764     set ascSolv1Vect(verify) -1
765     set ascSolv1Vect(verify.page) 4
766     set ascSolv1Vect(verify.type) int
767     set ascSolv1Vect(verify.lo) -1
768     set ascSolv1Vect(verify.hi) 3
769     set ascSolv1Vect(verify.label) "Verify level"
770     set ascSolv1Vect(lcons) 1
771     set ascSolv1Vect(lcons.page) 3
772     set ascSolv1Vect(lcons.type) bool
773     set ascSolv1Vect(lcons.label) "Force nonlinearity"
774     set ascSolv1Vect(damp) 2.0
775     set ascSolv1Vect(damp.page) 2
776     set ascSolv1Vect(damp.type) real
777     set ascSolv1Vect(damp.lo) 0
778     set ascSolv1Vect(damp.label) "Major damping parameter"
779     set ascSolv1Vect(mindamp) 2.0
780     set ascSolv1Vect(mindamp.page) 2
781     set ascSolv1Vect(mindamp.type) real
782     set ascSolv1Vect(mindamp.lo) 0
783     set ascSolv1Vect(mindamp.label) "Minor damping parameter"
784     set ascSolv1Vect(fdiff) 0
785     set ascSolv1Vect(fdiff.page) 4
786     set ascSolv1Vect(fdiff.type) real
787     set ascSolv1Vect(fdiff.lo) 0
788     set ascSolv1Vect(fdiff.label) "Difference interval"
789     set ascSolv1Vect(cdiff) 0
790     set ascSolv1Vect(cdiff.page) 4
791     set ascSolv1Vect(cdiff.type) real
792     set ascSolv1Vect(cdiff.lo) 0
793     set ascSolv1Vect(cdiff.label) "Central difference interval"
794     set ascSolv1Vect(fprec) 1e-6
795     set ascSolv1Vect(fprec.page) 4
796     set ascSolv1Vect(fprec.type) real
797     set ascSolv1Vect(fprec.lo) 0
798     set ascSolv1Vect(fprec.label) "Function precision"
799     set ascSolv1Vect(lstol) "0.1"
800     set ascSolv1Vect(lstol.page) 2
801     set ascSolv1Vect(lstol.type) real
802     set ascSolv1Vect(lstol.lo) 0
803     set ascSolv1Vect(lstol.hi) 1
804     set ascSolv1Vect(lstol.label) "Linesearch tolerance"
805     set ascSolv1Vect(lufto) 10
806     set ascSolv1Vect(lufto.page) 2
807     set ascSolv1Vect(lufto.type) real
808     set ascSolv1Vect(lufto.lo) 1
809     set ascSolv1Vect(lufto.label) "LU factor tolerance"
810     set ascSolv1Vect(luuto) 10
811     set ascSolv1Vect(luuto.page) 2
812     set ascSolv1Vect(luuto.type) real
813     set ascSolv1Vect(luuto.lo) 1
814     set ascSolv1Vect(luuto.label) "LU update tolerance"
815     set ascSolv1Vect(luwto) 0
816     set ascSolv1Vect(luwto.page) 4
817     set ascSolv1Vect(luwto.type) real
818     set ascSolv1Vect(luwto.lo) 0
819     set ascSolv1Vect(luwto.label) "LU swap tolerance"
820     set ascSolv1Vect(lusto) 0
821     set ascSolv1Vect(lusto.page) 4
822     set ascSolv1Vect(lusto.type) real
823     set ascSolv1Vect(lusto.lo) 0
824     set ascSolv1Vect(lusto.label) "LU singularity tolerance"
825     set ascSolv1Vect(ludto) 0
826     set ascSolv1Vect(ludto.page) 4
827     set ascSolv1Vect(ludto.type) real
828     set ascSolv1Vect(ludto.lo) 0
829     set ascSolv1Vect(ludto.hi) 1
830     set ascSolv1Vect(ludto.label) "LU density tolerance"
831     set ascSolv1Vect(radius) 0.01
832     set ascSolv1Vect(radius.page) 2
833     set ascSolv1Vect(radius.type) real
834     set ascSolv1Vect(radius.lo) 0
835     set ascSolv1Vect(radius.label) "Radius of convergence"
836     set ascSolv1Vect(subsp) 0.5
837     set ascSolv1Vect(subsp.page) 2
838     set ascSolv1Vect(subsp.type) real
839     set ascSolv1Vect(subsp.lo) 0
840     set ascSolv1Vect(subsp.hi) 1
841     set ascSolv1Vect(subsp.label) "Subspace tolerance"
842     set ascSolv1Vect(objlim) 1e20
843     set ascSolv1Vect(objlim.page) 4
844     set ascSolv1Vect(objlim.type) real
845     set ascSolv1Vect(objlim.lo) 0
846     set ascSolv1Vect(objlim.label) "Unbounded obj. value"
847     set ascSolv1Vect(steplm) 1e10
848     set ascSolv1Vect(steplm.page) 4
849     set ascSolv1Vect(steplm.type) real
850     set ascSolv1Vect(steplm.lo) 0
851     set ascSolv1Vect(steplm.label) "Unbounded step size"
852     set ascSolv1Vect(lobjwt) 0
853     set ascSolv1Vect(lobjwt.page) 4
854     set ascSolv1Vect(lobjwt.type) real
855     set ascSolv1Vect(lobjwt.lo) 0
856     set ascSolv1Vect(lobjwt.label) "Weight on linear obj."
857     leavetrace
858     }
859    
860     #
861     # proc set_Solv6_Defaults {}
862     # ----------------------------------------------------------------------
863     # keep me until we resurrect mps.
864     # set defaults for control of makeMPS, modified by CWS 5/95
865     # ----------------------------------------------------------------------
866     proc set_Solv6_Defaults {} {
867     entertrace
868     global ascSolv6Vect
869    
870     # general parameters
871     set ascSolv6Vect(timelimit) 1000
872     set ascSolv6Vect(iterationlimit) 20
873     set ascSolv6Vect(termtol) 1e-12
874     set ascSolv6Vect(feastol) 1e-8
875     set ascSolv6Vect(pivottol) 0.01
876     set ascSolv6Vect(singtol) 1e-12
877     set ascSolv6Vect(stattol) 1e-6
878     set ascSolv6Vect(rho) 100
879     set ascSolv6Vect(partition) 0
880     set ascSolv6Vect(ignorebounds) 0
881     set ascSolv6Vect(showmoreimportant) 1
882     set ascSolv6Vect(showlessimportant) 0
883     set ascSolv6Vect(bppivoting) 0
884    
885     # subparameters
886     # solve nonlinear model by linearizing at current point
887     set ascSolv6Vect(nonlin) 0
888     set ascSolv6Vect(relaxed) 0
889     set ascSolv6Vect(nonneg) 0
890     set ascSolv6Vect(obj) 0
891     set ascSolv6Vect(binary) 0
892     set ascSolv6Vect(integer) 0
893     set ascSolv6Vect(semi) 0
894     set ascSolv6Vect(sos1) 0
895     set ascSolv6Vect(sos2) 0
896     set ascSolv6Vect(sos3) 0
897     set ascSolv6Vect(bo) 0
898     set ascSolv6Vect(eps) 0
899     set ascSolv6Vect(boval) ""
900     set ascSolv6Vect(epsval) ""
901     # Note: pinf and minf should be entered by the user, instead of being
902     # hard coded in
903     set ascSolv6Vect(pinf) 1e+20
904     set ascSolv6Vect(minf) -1e+20
905     set ascSolv6Vect(filename) output.mps
906    
907    
908     # dialog variables
909    
910     set ascSolv6Vect(SOS) 0
911     # filename is what appears in dialog, expandname is exapanded ~/*.mps, etc.
912     set {ascSolv6Vect(expandname)} {output.mps}
913     set {ascSolv6Vect(solver)} {QOMILP}
914    
915     # set {symbolicName(ascSolv6Vect(help))} {.mps.frame14.button3}
916     # set {symbolicName(ascSolv6Vect(makemps))} {.mps.frame14.button1}
917     # set {symbolicName(ascSolv6Vect(ok))} {.mps.frame14.button0}
918     # set {symbolicName(ascSolv6Vect(run))} {.mps.frame14.button2}
919    
920     # dialogup true when dialog is visible
921     set ascSolv6Vect(dialogup) 0
922    
923     # massaged, expanded filenames
924     set ascSolv6Vect(mpsname) output.mps
925     set ascSolv6Vect(mapname) output.map
926     set ascSolv6Vect(errname) output.err
927     set ascSolv6Vect(outname) output.out
928    
929     leavetrace
930     }
931    
932    
933     # can we delete this?
934     # proc set_Solv9a_Defaults {}
935     # ----------------------------------------------------------------------
936     # set defaults for control of LRSlv
937     # ----------------------------------------------------------------------
938     proc set_Solv9a_Defaults {} {
939     entertrace
940     global ascSolv9aVect
941     # LRSlv parameter page setup variables
942     set ascSolv9aVect(namelist) [showlessimportant timelimit \
943     iterationlimit autoresolve]
944     set ascSolv9aVect(toplevel) .slv9aparms
945     set ascSolv9aVect(title) "LRSlv Parameters"
946     set ascSolv9aVect(maxlines) 12
947     set ascSolv9aVect(npages) 2
948     set ascSolv9aVect(grab) 0
949     set ascSolv9aVect(helpcommand) "Help_button solver.LRSlv.parameters"
950     set ascSolv9aVect(whenokcommand) "Solve_do_Parms close LRSlv"
951     # not window page supported Slv parms
952     set ascSolv9aVect(showmoreimportant) "1"
953     set ascSolv9aVect(showlessimportant) "1"
954     set ascSolv9aVect(showlessimportant.page) 2
955     set ascSolv9aVect(showlessimportant.type) bool
956     set ascSolv9aVect(showlessimportant.label) "detailed solving info"
957     set ascSolv9aVect(autoresolve) "1"
958     set ascSolv9aVect(autoresolve.page) 2
959     set ascSolv9aVect(autoresolve.type) bool
960     set ascSolv9aVect(autoresolve.label) auto-resolve
961     set ascSolv9aVect(timelimit) "1500"
962     set ascSolv9aVect(timelimit.type) int
963     set ascSolv9aVect(timelimit.lo) 1
964     set ascSolv9aVect(timelimit.label) "time limit (CPU sec/block)"
965     set ascSolv9aVect(iterationlimit) "30"
966     set ascSolv9aVect(iterationlimit.lo) 1
967     set ascSolv9aVect(iterationlimit.type) int
968     set ascSolv9aVect(iterationlimit.label) "max iterations/block"
969     leavetrace
970     }
971    
972    
973    
974     #
975     #----------------------------------------------------------------------------
976     # Direct callbacks section. procedures are all Solve_do_* and are supposed #
977     # to pertain to the .solver window and environs. Debugger is separated. #
978     # mtxview is separated also. #
979     #----------------------------------------------------------------------------
980    
981     #
982     # proc Solve_do_Select {name}
983     #----------------------------------------------------------------------------
984     # Solver Selection buttons action #
985     # If system not empty, downdates control parameters and calls presolve #
986     # does not check sanity of selection wrt problem. #
987     #----------------------------------------------------------------------------
988     proc Solve_do_Select {name} {
989     entertrace
990     global ascSolvVect ascSolvStatVect
991     if { $ascSolvVect($name) == -1 } {
992     puts " Solver $name not available"
993     leavetrace
994     return
995     }
996     set ascSolvStatVect(solver) $name
997     set ascSolvStatVect(solvernum) $ascSolvVect($name)
998     # KHACK: only need to select solver if different from current solver
999     if {[slv_checksys]} {
1000     if {$name != [Solve_do_SolverCur]} {
1001     slv_select_solver $ascSolvStatVect(solvernum)
1002     }
1003     if {[catch {slv_presolve} ]} {
1004     Solve_FP_error "Initial values,cause float error.,Please fix this."
1005     }
1006     }
1007     Solve_Update_StatusBox
1008     leavetrace
1009     }
1010    
1011     #
1012     # proc Solve_Close_Slaves {}
1013     #----------------------------------------------------------------------------
1014     # shut down windows dependent on solve system presence: debug, mtx, debug2
1015     #----------------------------------------------------------------------------
1016     proc Solve_Close_Slaves {} {
1017     entertrace
1018     global ascSolvVect
1019     if {$ascSolvVect(debuggerup)} {
1020     Solve_CloseDebugger
1021     }
1022     if {$ascSolvVect(mtxup)} {
1023     Solve_CloseMtx
1024     }
1025     leavetrace
1026     }
1027     #
1028     # proc Solve_do_Flush {args}
1029     #----------------------------------------------------------------------------
1030     # Solve RemoveInstance (Flush solver) #
1031     # If any args are supplied the HUB is not notified of the flush. #
1032     # This makes for a neater looking script when a call which is #
1033     # being recorded calls this function. #
1034     #----------------------------------------------------------------------------
1035     proc Solve_do_Flush {args} {
1036     entertrace
1037     global ascSolvVect ascSolvStatVect
1038     Solve_Close_Slaves
1039     slv_flush_solver
1040     Solve_destroy_monitors
1041     if {[llength $args] == 0} {
1042     HUB_Message_to_HUB SYSFLUSH
1043     }
1044     set ascSolvStatVect(empty) 1
1045     set ascSolvVect(instname) ""
1046     set ascSolvVect(objvarname) ""
1047     set ascSolvVect(simname) ""
1048     Solve_Update_StatusBox
1049     Solve_Update_Listbox
1050     Solve_Update_MenuBar
1051     leavetrace
1052     }
1053    
1054     #
1055     # proc Solve_do_Select_Objective {}
1056     #----------------------------------------------------------------------------
1057     # Select Objective variable #
1058     # list select from free variable list and objs list #
1059     # This needs to be updated to cope with objective vars.
1060     # u_getval and slv_set_objective_var should be useful.
1061     #----------------------------------------------------------------------------
1062     proc Solve_do_Select_Objective {} {
1063     entertrace
1064     if {![slv_checksys]} {leavetrace; return}
1065     Solve_Find_Objectives 1
1066     leavetrace
1067     }
1068    
1069     #
1070     # proc Solve_do_Display_Status {}
1071     #----------------------------------------------------------------------------
1072     # Displays solver status button box, #
1073     #----------------------------------------------------------------------------
1074     proc Solve_do_Display_Status {} {
1075     entertrace
1076     global ascGlobalVect
1077    
1078     Solve_Update_StatusBox
1079     Solve_Status_Infobox
1080     leavetrace
1081     }
1082    
1083     #
1084     # proc Solve_do_Spreadsheet {}
1085     #----------------------------------------------------------------------------
1086     # Display spreadsheet. dumps vars/relations to file #
1087     # rather low priority #
1088     #----------------------------------------------------------------------------
1089     proc Solve_do_Spreadsheet {} {
1090     entertrace
1091     puts "Not yet implemented"
1092     leavetrace
1093     }
1094    
1095     #
1096     # proc Solve_do_DispUnattached {}
1097     #----------------------------------------------------------------------------
1098     # Display unattached vars #
1099     #----------------------------------------------------------------------------
1100     proc Solve_do_DispUnattached {} {
1101     entertrace
1102     global ascSolvVect
1103     puts stderr "Unattached variables in $ascSolvVect(instname):"
1104     dbg_write_unattvar 1 $ascSolvVect(simname)
1105     leavetrace
1106     }
1107    
1108    
1109     #
1110     # proc Solve_do_DispUnincluded {}
1111     #----------------------------------------------------------------------------
1112     # Display unincluded relations #
1113     #----------------------------------------------------------------------------
1114     proc Solve_do_DispUnincluded {} {
1115     entertrace
1116     global ascSolvVect
1117     puts stderr "Unincluded relations in $ascSolvVect(instname):"
1118     foreach i [dbg_list_rels 1 not] {
1119     dbg_write_rel 0 $i 0 $ascSolvVect(simname)
1120     }
1121     leavetrace
1122     }
1123    
1124     #
1125     # proc Solve_do_DispIncidence {}
1126     #----------------------------------------------------------------------------
1127     # Display incidence matrix #
1128     #----------------------------------------------------------------------------
1129     proc Solve_do_DispIncidence {} {
1130     entertrace
1131     global ascSolvStatVect
1132     if {$ascSolvStatVect(empty)} {
1133     Solve_CloseMtx
1134     } else {
1135     if {![slv_checksys]} {leavetrace; return}
1136     Solve_OpenMtx
1137     }
1138     leavetrace
1139     }
1140    
1141     #
1142     # proc Solve_do_Solve {}
1143     #----------------------------------------------------------------------------
1144     # Solve button #
1145     #----------------------------------------------------------------------------
1146     proc Solve_do_Solve {} {
1147     entertrace
1148     if {![slv_checksys]} {
1149     return
1150     }
1151     Solve_monitor_init
1152     Solve_Solve
1153     Solve_Status_Infobox
1154     leavetrace
1155     }
1156    
1157     #
1158     # proc Solve_do_Iterate {}
1159     #----------------------------------------------------------------------------
1160     # Single step button #
1161     #----------------------------------------------------------------------------
1162     proc Solve_do_Iterate {} {
1163     entertrace
1164     if {![slv_checksys]} {leavetrace; return }
1165     Solve_Iterate
1166     leavetrace
1167     }
1168    
1169     #
1170     # proc Solve_do_Integrate {}
1171     #----------------------------------------------------------------------------
1172     # Integration button #
1173     #----------------------------------------------------------------------------
1174     proc Solve_do_Integrate {} {
1175     entertrace
1176     if {![slv_checksys]} {leavetrace; return }
1177     Solve_Integrate
1178     leavetrace
1179     }
1180    
1181     #
1182     # proc Solve_do_Optimize {}
1183     #----------------------------------------------------------------------------
1184     # Optimization button #
1185     #----------------------------------------------------------------------------
1186     proc Solve_do_Optimize {} {
1187     entertrace
1188     Solve_Optimize
1189     Solve_Status_Infobox
1190     leavetrace
1191     }
1192    
1193     #
1194     # proc Solve_do_Debug {}
1195     #----------------------------------------------------------------------------
1196     # Debugger button #
1197     #----------------------------------------------------------------------------
1198     proc Solve_do_Debug {} {
1199     entertrace
1200     if {![slv_checksys]} { leavetrace; return }
1201     global ascSolvVect
1202     set_Debug_Defaults
1203     if {!$ascSolvVect(debuggerup)} {
1204     Solve_OpenDebugger
1205     } else {
1206     Solve_CloseDebugger
1207     Solve_OpenDebugger
1208     }
1209     .debug configure -cursor left_ptr
1210     leavetrace
1211     }
1212    
1213     #
1214     # proc Solve_do_Overspecified {}
1215     #----------------------------------------------------------------------------
1216     # Overspecified Button #
1217     #----------------------------------------------------------------------------
1218     proc Solve_do_Overspecified {} {
1219     entertrace
1220     Solve_FindOverspec 1
1221     leavetrace
1222     }
1223     #
1224     # proc Solve_FindOverspec {refresh}
1225     #----------------------------------------------------------------------------
1226     # Overspecified internals if refresh 1 update status after free #
1227     #----------------------------------------------------------------------------
1228     proc Solve_FindOverspec {refresh} {
1229     entertrace
1230     global ascListSelectBox ascSolvVect
1231     set list ""
1232     catch {set list [lindex [dbg_struct_singular 2 -1] 2]}
1233     set ascListSelectBox(grab) 1
1234     set ascListSelectBox(btn3name) ""
1235     set ascListSelectBox(btn4name) ""
1236     set ascListSelectBox(btn5name) ""
1237     set ascListSelectBox(btn3destroy) 1
1238     set ascListSelectBox(btn4destroy) 0
1239     set ascListSelectBox(btn4command) ""
1240     set ascListSelectBox(title) "Overspecified"
1241     set ascListSelectBox(toplevelname) ".solvoverspec"
1242     set ascListSelectBox(font) $ascSolvVect(font)
1243     set ascListSelectBox(selectmode) browse
1244     set ascListSelectBox(headline) "Select to free one of:"
1245     set newlist ""
1246     set pname [slv_get_pathname]
1247     foreach i $list {
1248     lappend newlist "$pname.[stripbraces [dbg_write_var 2 $i 0 0]]"
1249     }
1250     if {$newlist==""} {
1251     if {!$refresh} {
1252     puts stderr "No variables to free."
1253     Solve_do_StrucDepends
1254     }
1255     leavetrace; return
1256     }
1257     set alist [lsort $newlist]
1258     set button [AscListSelectBox $alist \
1259     250x240[setpos .solver 50 20]]
1260     if {$button==2} {
1261     leavetrace
1262     return
1263     }
1264     Solve_OverListSelect $refresh
1265    
1266     leavetrace
1267     }
1268    
1269     #
1270     # proc Solve_do_NumDepends
1271     #----------------------------------------------------------------------------
1272     # Numeric Dependency Button #
1273     #----------------------------------------------------------------------------
1274     proc Solve_do_NumDepends {} {
1275     entertrace
1276     Solve_Check_RowsPivoted 1
1277     leavetrace
1278     }
1279    
1280     #
1281     # proc Solve_do_StrucDepends {}
1282     #----------------------------------------------------------------------------
1283     # Structural Dependency Button #
1284     #----------------------------------------------------------------------------
1285     proc Solve_do_StrucDepends {} {
1286     entertrace
1287    
1288     set slist [Solve_get_unassigned_rels]
1289     if {$slist==""} {
1290     puts stderr "There are no unassignable relations."
1291     leavetrace; return
1292     }
1293     #leavetrace; return
1294     # need to box this up.
1295     foreach rel $slist {
1296     set vr [dbg_struct_singular 2 $rel]
1297     set rl [lindex $vr 0]
1298     set vl [lindex $vr 1]
1299     set fl [lindex $vr 2]
1300     puts stdout ""
1301     puts stdout "Unassignable relation [stripbraces [dbg_write_rel 2 $rel 0]]"
1302     puts stdout "is in the structurally singular group:"
1303     foreach i $rl {puts "<$i> [stripbraces [dbg_write_rel 2 $i 0]]"}
1304     if {[llength $vl] > 0} {
1305     puts stdout "This singularity involves variables:"
1306     foreach i $vl {puts stdout "<$i> [stripbraces [dbg_write_var 2 $i 0 0]]"}
1307     }
1308     if {[llength $fl] >0} {
1309     puts stdout "This singularity is reduced by freeing a variable from:"
1310     foreach i $fl {puts stdout "<$i> [stripbraces [dbg_write_var 2 $i 0 0]]"}
1311     }
1312     }
1313     leavetrace
1314     }
1315    
1316     #
1317     # proc Solve_Find_Near_Bounds {}
1318     #----------------------------------------------------------------------------
1319     # Near Bounds button. #
1320     # if refresh then update status/presolve after fix #
1321     #----------------------------------------------------------------------------
1322     proc Solve_Find_Near_Bounds {} {
1323     entertrace
1324     if {![slv_checksys]} {leavetrace; return}
1325     global ascSolv32767Vect
1326     set list ""
1327     catch {set list [lindex [slv_near_bounds $ascSolv32767Vect(nearbound) 2] 0]}
1328     set low_violations [lindex $list 0]
1329     set up_violations [lindex $list 1]
1330     set count 2
1331     set pname [slv_get_pathname]
1332     if {$low_violations == 0 && $up_violations == 0} {
1333     puts "\nNO VARS NEAR BOUNDS\n"
1334     }
1335     if {$low_violations > 0} {
1336     puts "\nVARIABLES NEAR LOWER BOUND:"
1337     }
1338     for {set j 0} {$j < $low_violations} {incr j} {
1339     set i [lindex $list $count]
1340     puts "$pname.[stripbraces [dbg_write_var 2 $i 0 0]]"
1341     incr count
1342     }
1343     if {$up_violations > 0} {
1344     puts "\nVARIABLES NEAR UPPER BOUND:"
1345     }
1346     for {set j 0} {$j < $up_violations} {incr j} {
1347     set i [lindex $list $count]
1348     puts "$pname.[stripbraces [dbg_write_var 2 $i 0 0]]"
1349     incr count
1350     }
1351    
1352     leavetrace
1353     }
1354    
1355    
1356     #
1357     # proc Solve_Find_Far_From_Nominals {}
1358     #----------------------------------------------------------------------------
1359     # Far From Nominals button. #
1360     # if refresh then update status/presolve after fix #
1361     #----------------------------------------------------------------------------
1362     proc Solve_Find_Far_From_Nominals {} {
1363     entertrace
1364     if {![slv_checksys]} {leavetrace; return}
1365     global ascSolv32767Vect
1366     set list ""
1367     catch {
1368     set list [lindex [slv_far_from_nominals $ascSolv32767Vect(farnom) 2] 0]
1369     }
1370     set pname [slv_get_pathname]
1371     set length [llength $list]
1372     if {$length == 0} {
1373     puts "\nNO VARS FAR FROM NOMINAL VALUE\n"
1374     return
1375     }
1376     puts "VARIABLES FAR FROM NOMINALS:"
1377     for {set j 0} {$j < $length} {incr j} {
1378     set i [lindex $list $j]
1379     puts "$pname.[stripbraces [dbg_write_var 2 $i 0 0]]"
1380     }
1381     leavetrace
1382     }
1383    
1384     #
1385     # proc Solve_do_FindUnAssEqns {}
1386     #----------------------------------------------------------------------------
1387     # Find unassigned eqns Button. unincluded eqns don't count. #
1388     #----------------------------------------------------------------------------
1389     proc Solve_do_FindUnAssEqns {} {
1390     entertrace
1391     if {![slv_checksys]} { leavetrace; return }
1392     global ascSolvVect
1393     puts stderr \
1394     "Included but unpartitioned relations in $ascSolvVect(instname):"
1395     set shlist [Solve_get_unassigned_rels]
1396     foreach i $shlist {
1397     dbg_write_rel 0 $i 2 $ascSolvVect(simname)
1398     }
1399     if {$shlist==""} {
1400     puts stdout "All included equations have been assigned."
1401     }
1402     leavetrace
1403     }
1404    
1405     #
1406     # proc Solve_do_EvalUnincluded {}
1407     #----------------------------------------------------------------------------
1408     # evaluate unincluded equations #
1409     #----------------------------------------------------------------------------
1410     proc Solve_do_EvalUnincluded {} {
1411     entertrace
1412     global ascSolvVect
1413     puts stderr "Unincluded relations in $ascSolvVect(instname):"
1414     foreach i [dbg_list_rels 1 not] {
1415     dbg_write_rel 0 $i 2 $ascSolvVect(simname)
1416     }
1417     leavetrace
1418     }
1419    
1420     #
1421     # proc Solve_do_Export2Browser {}
1422     #----------------------------------------------------------------------------
1423     # export instance to browser #
1424     #----------------------------------------------------------------------------
1425     proc Solve_do_Export2Browser {} {
1426     entertrace
1427     global ascSolvVect
1428     Brow_Export_Any_2Browser $ascSolvVect(instname)
1429     leavetrace
1430     }
1431    
1432     #
1433     # proc Solve_do_Export2Probe {}
1434     #----------------------------------------------------------------------------
1435     # export instance to probe #
1436     #----------------------------------------------------------------------------
1437     proc Solve_do_Export2Probe {} {
1438     entertrace
1439     global ascSolvVect
1440     PROBE ALL $ascSolvVect(instname)
1441     leavetrace
1442     }
1443    
1444     #
1445     # proc Solve_do_Interrupt {}
1446     #----------------------------------------------------------------------------
1447     # interrupt button #
1448     #----------------------------------------------------------------------------
1449     proc Solve_do_Interrupt {} {
1450     entertrace
1451     global ascSolvStatVect
1452     if { ! $ascSolvStatVect(empty) } {
1453     set ascSolvStatVect(menubreak) 1
1454     slv_set_haltflag 1
1455     }
1456     leavetrace
1457     }
1458    
1459     #
1460     # proc Solve_do_Help
1461     #----------------------------------------------------------------------------
1462     # help button #
1463     #----------------------------------------------------------------------------
1464     proc Solve_do_Help {} {
1465     Help_button solver
1466     }
1467    
1468     #
1469     # proc Solve_do_Credit {solver}
1470     #----------------------------------------------------------------------------
1471     # credits button for solver codes #
1472     #----------------------------------------------------------------------------
1473     proc Solve_do_Credit {solver} {
1474     entertrace
1475     switch $solver {
1476     {slv} {Help_button solver.credits slv
1477     leavetrace; return}
1478     {minos} {Help_button solver.credits minos
1479     leavetrace; return}
1480     {opt _opt} {Help_button solver.credits opt
1481     leavetrace; return}
1482     {lsode} {Help_button solver.credits lsode
1483     leavetrace; return}
1484     {lsgrg} {Help_button solver.credits lsgrg
1485     leavetrace; return}
1486     {qrslv} {Help_button solver.credits qrslv
1487     leavetrace; return}
1488     {ngslv} {Help_button solver.credits ngslv
1489     leavetrace; return}
1490     {dslv} {Help_button solver.credits dslv
1491     leavetrace; return}
1492     {makemps} {Help_button solver.credits makemps
1493     leavetrace; return}
1494     {conopt} {Help_button solver.credits conopt
1495     leavetrace; return}
1496     default {puts "credits not yet implemented for $solver"}
1497     }
1498     # endswtich
1499     leavetrace
1500     }
1501    
1502     #
1503     # proc Solve_do_Reanalyze {}
1504     #----------------------------------------------------------------------------
1505     # import qlfdid name, if eligible. #
1506     # strip trailing . if needed #
1507     #----------------------------------------------------------------------------
1508     proc Solve_do_Reanalyze {} {
1509     entertrace
1510     global ascSolvStatVect ascSolvVect
1511     if { ! [slv_checksys] } { leavetrace; return 0 }
1512     # cant import from a null system
1513     set tname $ascSolvVect(instname)
1514     leavetrace; return [Solve_Import_Any $tname]
1515     leavetrace
1516     }
1517    
1518     #
1519     # proc Solve_do_Import {}
1520     #----------------------------------------------------------------------------
1521     # import qlfdid name, if eligible. #
1522     # strip trailing . if needed #
1523     #----------------------------------------------------------------------------
1524     proc Solve_do_Import {} {
1525     entertrace
1526     global ascSolvStatVect ascSolvVect
1527     if { ! [slv_checksys] } {
1528     leavetrace
1529     return 0
1530     }
1531     # cant import from a null system
1532     set tname [string trim $ascSolvVect(pathname)]
1533     set tname [string trim $tname .]
1534     leavetrace; return [Solve_Import_Any $tname]
1535     leavetrace
1536     }
1537    
1538     #
1539     #----------------------------------------------------------------------------
1540     # button internals section. includes parm page procedures, named as #
1541     # Solve_XXX_* where XXX is the 3 letter solver code in all caps. #
1542     #----------------------------------------------------------------------------
1543    
1544    
1545     #
1546     # proc Solve_EligListSelect {refresh}
1547     #-------------------------------------------------------------------------
1548     # fixes first of any variables selected. if refresh, updates screen #
1549     #-------------------------------------------------------------------------
1550     proc Solve_EligListSelect {refresh} {
1551     entertrace
1552     global ascListSelectBox
1553     set list $ascListSelectBox(itemselected)
1554     if {$list != ""} {
1555     set item [lindex $list 0]
1556     qassgn3 $item.fixed TRUE
1557     HUB_Message_to_HUB BOOLEANUPDATED $item
1558     if {$refresh} {
1559     slv_presolve
1560     Solve_Update_StatusBox
1561     update
1562     Solve_FindEligible 1
1563     }
1564     } else {
1565     Solve_Alert "Input Error" "Make selection or, choose Cancel"
1566     if {$refresh} {
1567     Solve_FindEligible 1
1568     }
1569     }
1570     leavetrace
1571     }
1572    
1573     #
1574     # proc Solve_GlobalEligListSelect {refresh}
1575     #-------------------------------------------------------------------------
1576     # fixes first of any variables selected. if refresh, updates screen #
1577     #-------------------------------------------------------------------------
1578     proc Solve_GloablEligListSelect {refresh} {
1579     entertrace
1580     global ascListSelectBox
1581     set list $ascListSelectBox(itemselected)
1582     if {$list != ""} {
1583     set item [lindex $list 0]
1584     qassgn3 $item.fixed TRUE
1585     HUB_Message_to_HUB BOOLEANUPDATED $item
1586     if {$refresh} {
1587     slv_presolve
1588     Solve_Update_StatusBox
1589     update
1590     Solve_FindGlobalEligible 1
1591     }
1592     } else {
1593     Solve_Alert "Input Error" "Make selection or, choose Cancel"
1594     if {$refresh} {
1595     Solve_FindGlobalEligible 1
1596     }
1597     }
1598     leavetrace
1599     }
1600    
1601     #
1602     # proc Solve_FixConsistentSet
1603     #-------------------------------------------------------------------------
1604     # Selection of the consistent set of varaibles. It fixes all of the
1605     # variables selected
1606     #-------------------------------------------------------------------------
1607     proc Solve_FixConsistentSet {} {
1608     entertrace
1609     global ascListSelectB1Box
1610     set list $ascListSelectB1Box(itemselected)
1611     if {$list != ""} {
1612     foreach i $list {
1613     qassgn3 $i.fixed TRUE
1614     }
1615     set item [lindex $list 0]
1616     HUB_Message_to_HUB BOOLEANUPDATED $item
1617     slv_presolve
1618     Solve_Update_StatusBox
1619     update
1620     } else {
1621     Solve_Alert "Input Error" "Make Selection or Choose Dismiss"
1622     }
1623     newraise .solvconsistent
1624     leavetrace
1625     }
1626    
1627    
1628     #
1629     # proc Solve_ConsistentListSelect {refresh}
1630     #-------------------------------------------------------------------------
1631     # fixes all of the variables selected. if refresh, updates screen
1632     # It works with an SelectBox instead of a SelectB1Box (function of
1633     # above )
1634     #-------------------------------------------------------------------------
1635     proc Solve_ConsistentListSelect {refresh} {
1636     entertrace
1637     global ascListSelectBox
1638     set list $ascListSelectBox(itemselected)
1639     if {$list != ""} {
1640    
1641     set length [llength $list]
1642     if {$length == 0} {
1643     return
1644     }
1645    
1646     for {set j 0} {$j < $length} {incr j} {
1647     set item [lindex $list $j]
1648     qassgn3 $item.fixed TRUE
1649     }
1650    
1651     set item [lindex $list 0]
1652     HUB_Message_to_HUB BOOLEANUPDATED $item
1653    
1654     if {$refresh} {
1655     slv_presolve
1656     Solve_Update_StatusBox
1657     update
1658     }
1659     } else {
1660     Solve_Alert "Input Error" "Select all or Choose Cancel"
1661     }
1662     leavetrace
1663     }
1664    
1665    
1666     #
1667     # proc Solve_OverListSelect {refresh}
1668     #-------------------------------------------------------------------------
1669     # frees first of any variables selected. if refresh,updates screen.
1670     #-------------------------------------------------------------------------
1671     proc Solve_OverListSelect {refresh} {
1672     entertrace
1673     global ascListSelectBox
1674     set list $ascListSelectBox(itemselected)
1675     if {$list != ""} {
1676     set item [lindex $list 0]
1677     qassgn3 $item.fixed FALSE
1678     HUB_Message_to_HUB BOOLEANUPDATED $item
1679     if {$refresh} {
1680     slv_presolve
1681     Solve_Update_StatusBox
1682     update
1683     }
1684     Solve_FindOverspec 1
1685     } else {
1686     Solve_Alert "Input Error" "Make selection or, choose Cancel"
1687     Solve_FindOverspec 1
1688     }
1689     leavetrace
1690     }
1691    
1692     #
1693     # proc Solve_GetObjeRelNum {name}
1694     #-------------------------------------------------------------------------
1695     # returns the solver list number of the objective which qlfdid 'name' #
1696     # returns -1 if name is "none" and -2 if name not on list #
1697     #-------------------------------------------------------------------------
1698     proc Solve_GetObjRelNum {name} {
1699     entertrace
1700     if {[string match "none" $name]} {
1701     leavetrace
1702     return -1
1703     }
1704     set list ""
1705     catch {set list [lindex [slv_get_obj_list 2] 0]}
1706     set pname [slv_get_pathname]
1707     foreach i $list {
1708     if {[string match \
1709     "$pname.[stripbraces [dbg_write_obj 2 $i 0]]" \
1710     $name]} {
1711     leavetrace
1712     return $i
1713     }
1714     }
1715     return -2
1716     leavetrace
1717     }
1718    
1719     #
1720     # proc Solve_ObjListSelect {refresh}
1721     #-------------------------------------------------------------------------
1722     # sets solvers objective to the selected objective function #
1723     #-------------------------------------------------------------------------
1724     proc Solve_ObjListSelect {refresh} {
1725     entertrace
1726     global ascListSelectBox
1727     set list $ascListSelectBox(itemselected)
1728     if {$list != ""} {
1729     set item [lindex $list 0]
1730     set obj_num [Solve_GetObjRelNum $item]
1731     if {$obj_num == -2} {
1732     Solve_Alert "Unexpected Error in Solve_ObjListSelect" \
1733     "choose Cancel and send bug report"
1734     if {$refresh} {
1735     Solve_Find_Objectives 1
1736     }
1737     } else {
1738     set cur_obj_num [slv_get_obj_num 2]
1739     if {$cur_obj_num != $obj_num} {
1740     catch {slv_set_obj_by_num $obj_num}
1741     # may be able to get away without a full presolve when switching objective
1742     # but just go with the full thing for now
1743     catch {slv_presolve}
1744     }
1745     }
1746     } else {
1747     Solve_Alert "Input Error" "Make selection or, choose Cancel"
1748     if {$refresh} {
1749     Solve_Find_Objectives 1
1750     }
1751     }
1752     leavetrace
1753     }
1754    
1755    
1756     #
1757     # proc Solve_get_unassigned_rels {}
1758     #----------------------------------------------------------------------------
1759     # leavetrace; return a list of indexes of all unassigned, but included,
1760     # relations.
1761     #----------------------------------------------------------------------------
1762     proc Solve_get_unassigned_rels {} {
1763     entertrace
1764     set rlist "[dbg_list_rels 4]"
1765     if {$rlist==""} {
1766     leavetrace
1767     return ""
1768     }
1769     # if nobody assigned, not an assigning solver.
1770     set rlist [dbg_list_rels 4 not]
1771     set uilist [dbg_list_rels 1 not]
1772     set shlist ""
1773     foreach i $rlist {
1774     if {[lsearch $uilist $i]=="-1"} {
1775     lappend shlist $i
1776     }
1777     }
1778     leavetrace
1779     leavetrace; return $shlist
1780     }
1781    
1782     #
1783     # proc Solve_Running {n1 n2 mode}
1784     #----------------------------------------------------------------------------
1785     # put the wings and colors on and off the shoes.
1786     # ignores the arguments.
1787     #----------------------------------------------------------------------------
1788     proc Solve_Running {n1 n2 mode} {
1789     entertrace
1790     global ascSolvStatVect
1791     if {$ascSolvStatVect(running)} {
1792     .solver.lbl_frm.lbl_run configure -bitmap wfeet -background green
1793     .solver.lbl_frm.lbl_int configure -background red
1794     .solver.lbl_frm.btn_int configure -background red
1795     } else {
1796     set color [.solver.lbl_frm cget -background]
1797     .solver.lbl_frm.lbl_run configure -bitmap feet -background $color
1798     .solver.lbl_frm.lbl_int configure -background $color
1799     .solver.lbl_frm.btn_int configure -background $color
1800     }
1801     leavetrace
1802     }
1803     #
1804     # proc Solve_Import_Any {qlfdid}
1805     #----------------------------------------------------------------------------
1806     # load qlfdid into the solver, if possible.
1807     # Not possible if:
1808     # - type inappropriate (not model) or not safe (nulls,pendings found)
1809     # - this function called during an interface update called from
1810     # within a non-iterable solver (a halt button check).
1811     # - called with qlfdid==""
1812     # Leavetrace; Returns 0 if succesful, 1 if not. If not, reason will be left in
1813     # global variable ascSolvStatVect(importerror).
1814     #
1815     # Anyone trying to load the solver from anywhere besides here is likely
1816     # to cause errors.
1817     # The sanity this affords far outweighs the cost of the qlfdid search.
1818     #----------------------------------------------------------------------------
1819     proc Solve_Import_Any {qlfdid} {
1820     entertrace
1821     global ascSolvVect ascSolvStatVect
1822    
1823     # check running
1824     if {$ascSolvStatVect(running)=="1"} {
1825     puts stderr "Solve in progress."
1826     set sherrmsg "Solve in progress. Cannot import until done or halted."
1827     set halt [asctk_dialog .solvhalt $ascSolvVect(font) \
1828     "Solver Alert:" $sherrmsg "" 1 OK Halt]
1829     if {$halt} {
1830     set ascSolvStatVect(menubreak) 1
1831     slv_set_haltflag 1
1832     }
1833     set ascSolvStatVect(importerror) "Solver is running."
1834     leavetrace; return 1
1835     }
1836     # check qlfdid
1837     if {$qlfdid==""} {
1838     Solve_do_Flush;
1839     set ascSolvStatVect(importerror) "Import called with empty argument."
1840     leavetrace; return 1
1841     }
1842     set ascSolvStatVect(menubreak) 0
1843     slv_set_haltflag 0
1844     set notok [slv_import_qlfdid $qlfdid test]
1845     if {$notok} {
1846     set ascSolvStatVect(importerror) "Instance not a complete model instance."
1847     leavetrace; return 1
1848     }
1849     # set simname
1850     set ascSolvVect(simname) [lindex [split $qlfdid .] 0]
1851     if {$ascSolvVect(visibility)} {
1852     newraise $ascSolvVect(windowname)
1853     }
1854     # import valid system: builds rel/var/obj lists
1855     slv_import_qlfdid $qlfdid
1856     set ascSolvVect(instname) "[slv_get_pathname]"
1857     # put last sets of used parameters into C vect
1858     Solve_Downdate_ParmBox
1859     # verify dimensionality
1860     Solve_Check_Dimensions
1861     # find appropriate solver
1862     Solve_Check_Eligible
1863     # get chosen solver. will be last one used if last one was eligible.
1864     # also presolves, sets status flags
1865     Solve_do_Select $ascSolvStatVect(solver)
1866     # over/under
1867     Solve_Check_DOF
1868     #
1869     # Update active flag of relations
1870     #
1871     Solve_FlagActive
1872     Solve_Update_StatusBox
1873     # redraw windows
1874     Solve_Update_Listbox
1875     Solve_Update_MenuBar
1876     catch {Solve_Update_Slaves}
1877     leavetrace; return 0
1878     leavetrace
1879     }
1880    
1881    
1882     #
1883     # proc Solve_Update_Slaves {}
1884     #----------------------------------------------------------------------------
1885     # update auxillary windows: debugger, mtx, debugger2
1886     #----------------------------------------------------------------------------
1887     proc Solve_Update_Slaves {} {
1888     entertrace
1889     global ascSolvVect
1890     if {$ascSolvVect(debuggerup)} {
1891     Debug_Trace on
1892     }
1893     if {$ascSolvVect(mtxup)} {
1894     Solve_do_DispIncidence
1895     }
1896     leavetrace
1897     }
1898     #
1899     # proc Solve_Check_Block_Err {}
1900     #----------------------------------------------------------------------------
1901     # Compute the sum and max of block residuals.
1902     # Compute the sum and max of block times.
1903     # Compute the sum of function and jacobian times.
1904     #----------------------------------------------------------------------------
1905     proc Solve_Check_Block_Err {} {
1906     entertrace
1907     global ascSolvStatVect ascSolv32767Vect
1908     set ct 0
1909     set itb 0
1910     set sumbe 0
1911     set sumft 0
1912     set sumjt 0
1913     set maxbe 0
1914     set maxbeblock 0
1915     set maxbt 0
1916     set maxbtblock 0
1917     set gscp [slv_get_cost_page]
1918     foreach i $gscp {
1919     if {[lindex $i 0] > 0} {
1920     set sumbe [expr $sumbe + [lindex $i 5]]
1921     set sumft [expr $sumft + [lindex $i 6]]
1922     set sumjt [expr $sumjt + [lindex $i 7]]
1923     if {[lindex $i 5] > $maxbe} {
1924     set maxbe [lindex $i 5]
1925     set maxbeblock $ct
1926     }
1927     if {[lindex $i 4] > $maxbt} {
1928     set maxbt [lindex $i 4]
1929     set maxbtblock $ct
1930     }
1931     incr ct
1932     if {[lindex $i 0] >1} {
1933     incr itb
1934     }
1935     }
1936     }
1937     set pst [llength $gscp]
1938     set pst [lindex [lindex $gscp [incr pst -1] ] 4]
1939     set ascSolvStatVect(maxblockerr) $maxbe
1940     set ascSolvStatVect(worstblock) $maxbeblock
1941     set ascSolvStatVect(sumblockerr) $sumbe
1942     if {$itb >0} {
1943     set ascSolvStatVect(avgblockerr) [expr $sumbe/$itb]
1944     } else {
1945     set ascSolvStatVect(avgblockerr) 0
1946     }
1947     if {$ascSolv32767Vect(showavgs)} {
1948     puts "Block error total: $sumbe"
1949     puts "Block error max($maxbeblock): $maxbe"
1950     puts "CPU total: $ascSolvStatVect(cpuelapsed)"
1951     puts "Expensive block($maxbtblock): $maxbt"
1952     puts "Presolve: $pst"
1953     puts "Functions: $sumft"
1954     puts "Derivatives: $sumjt"
1955     }
1956     leavetrace
1957     }
1958    
1959     #
1960     # proc Solve_Check_Dimensions {}
1961     #----------------------------------------------------------------------------
1962     # Check and derive dimensionality of rellist, varlist in solver.
1963     # this should be a wrapper around something that the browser can
1964     # also use.
1965     #----------------------------------------------------------------------------
1966     proc Solve_Check_Dimensions {} {
1967     entertrace
1968     leavetrace
1969     }
1970     #
1971     # proc Solve_Check_Eligible
1972     #----------------------------------------------------------------------------
1973     # pick appropriate solver. will be last one used if last one was eligible.
1974     # Changes ascSolvStatVect(solvernum) if necessary.
1975     # If noone is eligible, returns SLV as solver; not necessarily a bright
1976     # move, but better the devil you know.
1977     # Should handle menu disabling on edit.selectsolver menu.
1978     #----------------------------------------------------------------------------
1979     proc Solve_Check_Eligible {} {
1980     entertrace
1981     leavetrace; return
1982     global ascSolvVect
1983     set retval [asctk_dialog .solvinel $ascSolvVect(font) \
1984     "Solver diagnostic:" \
1985     "Current solver ($ascSolvStatVect(solver)) not eligible" "" 0 OK Why?]
1986     if {$retval} {
1987     puts stderr "Sorry, no help available on why yet."
1988     }
1989    
1990     leavetrace
1991     }
1992    
1993     #
1994     # proc Solve_Check_DOF {}
1995     #----------------------------------------------------------------------------
1996     # if DOF change needed pop up dialog.
1997     #----------------------------------------------------------------------------
1998     proc Solve_Check_DOF {} {
1999     entertrace
2000     global ascSolvStatVect
2001     if {$ascSolvStatVect(overdefined)} {
2002     Solve_FindOverspec 1
2003     leavetrace
2004     return
2005     }
2006     if {"[string range $ascSolvStatVect(objval) 0 3]" != "none"} {
2007     leavetrace
2008     return
2009     }
2010     if {$ascSolvStatVect(underdefined)} {
2011     Solve_FindEligible 1
2012     leavetrace
2013     return}
2014     if {$ascSolvStatVect(structsingular)} {
2015     Solve_do_StrucDepends
2016     leavetrace
2017     return}
2018     leavetrace
2019     }
2020    
2021     #
2022     # proc Solve_Check_RowsPivoted {noisy}
2023     #----------------------------------------------------------------------------
2024     # look for numeric singularity of rows after solution.
2025     # leavetrace; return 1 if checkable 0 if not inverted >=2 if singularity found
2026     # number of singularities is leavetrace; return value -1
2027     # if noisy is 1, pops up alertbox about uninvertedness
2028     #----------------------------------------------------------------------------
2029     proc Solve_Check_RowsPivoted {noisy} {
2030     entertrace
2031     global ascSolvStatVect
2032     if {$ascSolvStatVect(running)} {
2033     puts stderr "Cannot check for singularity while solver is running."
2034     leavetrace
2035     return 1
2036     }
2037     puts stderr "Checking blocks for numeric row dependency:"
2038     # if QRSlv or NGSlv
2039     if {$ascSolvStatVect(solver) == "QRSlv"
2040     | $ascSolvStatVect(solver)== "NGSlv"} {
2041     set ret 0
2042     for {set blk 0} {$blk < $ascSolvStatVect(block.number)} {incr blk} {
2043     if {![catch {set dep [dbg_num_block_singular 2 $blk r]} msg]} {
2044     foreach r $dep {
2045     incr ret
2046     set eqn [lindex $r 0]
2047     puts stderr \
2048     "=== Found unpivoted relation $eqn in block $blk ==="
2049     puts stderr "Which is the sum of:"
2050     set eqns [lrange $r 1 end]
2051     foreach e $eqns {
2052     puts stderr "Relation ([lindex $e 0]) * [lindex $e 1]"
2053     }
2054     puts stderr "========================================="
2055     }
2056     incr ret
2057     } else {
2058     if {$noisy} {
2059     global ascMsgVect ascSolvVect
2060     set ascMsgVect(grab) 0
2061     set ascMsgVect(title) "Linsol:"
2062     set ascMsgVect(lbl_font) $ascSolvVect(font)
2063     set ascMsgVect(btn_font) $ascSolvVect(font)
2064     set ascMsgVect(btn_label) Dismiss
2065     set ascMsgVect(toplevelname) .linsolmsg
2066     set ascMsgVect(position) [setpos .solver 50 125]
2067     ascMsgBox "Error in singularity\nchecking process."
2068     raise .linsolmsg
2069     puts stderr $msg
2070     }
2071     }
2072     }
2073     if {$noisy} {
2074     puts stderr "All blocks checked."
2075     }
2076     leavetrace
2077     return $ret
2078     }
2079     #else non linsolqr system: print error
2080     if {$noisy} {
2081     global ascMsgVect ascSolvVect
2082     set ascMsgVect(grab) 0
2083     set ascMsgVect(title) "Numeric Depend:"
2084     set ascMsgVect(lbl_font) $ascSolvVect(font)
2085     set ascMsgVect(btn_font) $ascSolvVect(font)
2086     set ascMsgVect(btn_label) Dismiss
2087     set ascMsgVect(toplevelname) .linsolmsg
2088     set ascMsgVect(position) [setpos .solver 50 125]
2089     ascMsgBox "Must call Numeric Dependency Check from QRSlv."
2090     raise .linsolmsg
2091     puts "Error: no blocks checked\n"
2092     }
2093     leavetrace
2094    
2095     leavetrace
2096     return 0
2097     }
2098    
2099    
2100    
2101     #
2102     # proc Solve_FindEligible {refresh}
2103     #----------------------------------------------------------------------------
2104     # Find eligible vars button. nonincident don't count #
2105     # if refresh then update status/presolve after fix #
2106     #----------------------------------------------------------------------------
2107     proc Solve_FindEligible {refresh} {
2108     entertrace
2109     global ascListSelectBox ascSolvVect
2110     set list ""
2111     catch {set list [lindex [dbg_find_eligible 2] 0]}
2112     set ascListSelectBox(grab) 1
2113     set ascListSelectBox(btn3name) ""
2114     set ascListSelectBox(btn4name) ""
2115     set ascListSelectBox(btn5name) ""
2116     set ascListSelectBox(title) "Eligible"
2117     set ascListSelectBox(toplevelname) ".solveligible"
2118     set ascListSelectBox(font) $ascSolvVect(font)
2119     set ascListSelectBox(selectmode) browse
2120     set ascListSelectBox(headline) "Select to fix one of:"
2121     set newlist ""
2122     set pname [slv_get_pathname]
2123     foreach i $list {
2124     lappend newlist \
2125     "$pname.[stripbraces [dbg_write_var 2 $i 0 0]]"
2126     }
2127     if {$newlist=="" && !$refresh} {
2128     puts stderr "No variables eligible to be fixed."
2129     leavetrace
2130     return
2131     }
2132     set alist [lsort $newlist]
2133     set button [AscListSelectBox $alist \
2134     250x240[setpos .solver 50 20]]
2135     if {$button==2} {
2136     leavetrace
2137     return
2138     }
2139     Solve_EligListSelect $refresh
2140     leavetrace
2141     }
2142    
2143    
2144    
2145     #
2146     # proc Solve_FindGlobalEligible {refresh}
2147     #----------------------------------------------------------------------------
2148     # Find the set of "globally" (conditional model) eligible vars.
2149     # if refresh then update status/presolve after fix
2150     #----------------------------------------------------------------------------
2151     proc Solve_FindGlobalEligible {refresh} {
2152     entertrace
2153     global ascListSelectBox ascSolvVect
2154     set list ""
2155     catch {set list [lindex [dbg_global_eligible 2] 0]}
2156     set ascListSelectBox(grab) 1
2157     set ascListSelectBox(btn3name) ""
2158     set ascListSelectBox(btn4name) ""
2159     set ascListSelectBox(btn5name) ""
2160     set ascListSelectBox(title) "Globally Eligible"
2161     set ascListSelectBox(toplevelname) ".solvgeligible"
2162     set ascListSelectBox(font) $ascSolvVect(font)
2163     set ascListSelectBox(selectmode) browse
2164     set ascListSelectBox(headline) "Select to fix one of:"
2165     set newlist ""
2166     set pname [slv_get_pathname]
2167     foreach i $list {
2168     lappend newlist \
2169     "$pname.[stripbraces [dbg_write_var 2 $i 0 1]]"
2170     }
2171     if {$newlist=="" && !$refresh} {
2172     puts stderr "No variables eligible to be fixed."
2173     leavetrace
2174     return
2175     }
2176     set alist [lsort $newlist]
2177     set button [AscListSelectBox $alist \
2178     250x240[setpos .solver 50 20]]
2179     if {$button==2} {
2180     leavetrace
2181     return
2182     }
2183     Solve_GlobalEligListSelect $refresh
2184     leavetrace
2185     }
2186    
2187     #
2188     # proc Solve_ConsistencyAnalysis {refresh}
2189     #----------------------------------------------------------------------------
2190     # Find the variables which makes a consitent set of decision variables,
2191     # consistent in the "overall" conditional model
2192     #----------------------------------------------------------------------------
2193     proc Solve_ConsistencyAnalysis {refresh} {
2194     entertrace
2195     global ascListSelectB1Box ascSolvVect
2196     set list ""
2197     catch {set list [lindex [dbg_consistency_analysis 2] 0]}
2198     set ascListSelectB1Box(grab) 0
2199     set ascListSelectB1Box(btn2name) "Tag All"
2200     set ascListSelectB1Box(btn3name) "Fix Selection"
2201     set ascListSelectB1Box(btn4name) ""
2202     set ascListSelectB1Box(btn5name) ""
2203     set ascListSelectB1Box(btn2destroy) 0
2204     set ascListSelectB1Box(btn3destroy) 0
2205     set ascListSelectB1Box(btn4destroy) 0
2206     set ascListSelectB1Box(btn2command) Solve_SelectAll
2207     set ascListSelectB1Box(btn3command) Solve_FixConsistentSet
2208     set ascListSelectB1Box(title) "Consistent Set"
2209     set ascListSelectB1Box(toplevelname) ".solvconsistent"
2210     set ascListSelectB1Box(selectmode) extended
2211     set ascListSelectBox(font) $ascSolvVect(font)
2212     set ascListSelectB1Box(headline) "Could Fix the Set:"
2213     set newlist ""
2214     set pname [slv_get_pathname]
2215     foreach i $list {
2216     lappend newlist \
2217     "$pname.[stripbraces [dbg_write_var 2 $i 0 1]]"
2218     }
2219     if {$newlist =="" && !$refresh} {
2220     puts stderr "No set of variables make a consistent partition."
2221     leavetrace
2222     return
2223     }
2224    
2225     set alist [lsort $newlist]
2226     set button [AscListSelectB1Box $alist \
2227     250x240[setpos .solver 50 20]]
2228     leavetrace
2229     }
2230    
2231    
2232     #
2233     # proc Solve_SelectAll {{tl ""}}
2234     #-------------------------------------------------------------------------
2235     # select all in the asclistselectb1box associate with tl, or
2236     # select all in the last asclistselectb1box created if tl == ""
2237     #-------------------------------------------------------------------------
2238     proc Solve_SelectAll {{tl ""}} {
2239     AscListSelectB1SelectAll $tl
2240     }
2241    
2242     #
2243     # proc Solve_ConsistencyAnalysis2 {refresh}
2244     #----------------------------------------------------------------------------
2245     # Find the variables which makes a consitent set of decision variables,
2246     # consistent in the "overall" conditional model. It uses a SelectBox
2247     # instead of a SelectB1Box (function of above)
2248     #----------------------------------------------------------------------------
2249     proc Solve_ConsistencyAnalysis2 {refresh} {
2250     entertrace
2251     global ascListSelectBox ascSolvVect
2252     set list ""
2253     catch {set list [lindex [dbg_consistency_analysis 2] 0]}
2254     set ascListSelectBox(grab) 1
2255     set ascListSelectBox(btn3name) ""
2256     set ascListSelectBox(btn4name) ""
2257     set ascListSelectBox(btn5name) ""
2258     set ascListSelectBox(title) "Consistent Set"
2259     set ascListSelectBox(toplevelname) ".solvconsistent"
2260     set ascListSelectBox(font) $ascSolvVect(font)
2261     set ascListSelectBox(selectmode) browse
2262     set ascListSelectBox(headline) "Could Fix the Set:"
2263     set newlist ""
2264     set pname [slv_get_pathname]
2265     foreach i $list {
2266     lappend newlist \
2267     "$pname.[stripbraces [dbg_write_var 2 $i 0 1] ]"
2268     }
2269     if {$newlist =="" || !$refresh} {
2270     puts stderr "No set of variables make a consistent partition."
2271     leavetrace
2272     return
2273     }
2274     set alist [lsort $newlist]
2275     set button [AscListSelectBox $alist \
2276     250x240[setpos .solver 50 20]]
2277     if {$button==2} {
2278     leavetrace
2279     return
2280     }
2281     Solve_ConsistentListSelect $refresh
2282     leavetrace
2283     }
2284    
2285     #
2286     # proc Solve_FlagActive {}
2287     #----------------------------------------------------------------------------
2288     # Flag active relations instances.
2289     #----------------------------------------------------------------------------
2290     proc Solve_FlagActive {} {
2291     entertrace
2292    
2293     dbg_find_activerels 0
2294    
2295     leavetrace
2296     }
2297    
2298    
2299     #
2300     # proc Solve_Find_Objectives {refresh}
2301     #----------------------------------------------------------------------------
2302     # Select objective button. #
2303     # if refresh then update status/presolve after fix #
2304     #----------------------------------------------------------------------------
2305     proc Solve_Find_Objectives {refresh} {
2306     entertrace
2307     global ascListSelectBox ascSolvVect
2308     set list ""
2309     catch {set list [lindex [slv_get_obj_list 2] 0]}
2310     set ascListSelectBox(grab) 1
2311     set ascListSelectBox(btn3name) ""
2312     set ascListSelectBox(btn4name) ""
2313     set ascListSelectBox(btn5name) ""
2314     set ascListSelectBox(title) "Objectives"
2315     set ascListSelectBox(toplevelname) ".solvobjectives"
2316     set ascListSelectBox(font) $ascSolvVect(font)
2317     set ascListSelectBox(selectmode) browse
2318     set ascListSelectBox(headline) "Select one objective:"
2319     set newlist ""
2320     set pname [slv_get_pathname]
2321     lappend newlist "none"
2322     foreach i $list {
2323     lappend newlist \
2324     "$pname.[stripbraces [dbg_write_obj 2 $i 0]]"
2325     }
2326     if {$newlist=="none" && !$refresh} {
2327     puts stderr "No included objectives."
2328     leavetrace
2329     return
2330     }
2331     set alist [lsort $newlist]
2332     set button [AscListSelectBox $alist \
2333     250x240[setpos .solver 50 20]]
2334     if {$button==2} {
2335     leavetrace
2336     return}
2337     Solve_ObjListSelect $refresh
2338     leavetrace
2339     }
2340    
2341     #
2342     # proc Solve_Update_ParmBox {args}
2343     #----------------------------------------------------------------------------
2344     # load parms from C structure for current solver/solve system. If no system,
2345     # do nothing. if args not empty, load parms for system with name in args
2346     #----------------------------------------------------------------------------
2347     proc Solve_Update_ParmBox {args} {
2348     entertrace
2349     global ascSolvStatVect ascSolvVect
2350     if {![slv_checksys]} {
2351     leavetrace
2352     return
2353     }
2354     if {$args!=""} {set name $args} {
2355     set name $ascSolvStatVect(solver)
2356     }
2357     if {$ascSolvVect($name) == -1} {
2358     leavtrace
2359     return
2360     }
2361     switch $name {
2362     {Slv} -
2363     {CSlv} { Solve_SLV_Update_ParmBox}
2364     {MINOS} { Solve_MINOS_Update_ParmBox}
2365     {Opt} { Solve_OPTSQP_Update_ParmBox}
2366     {QRSlv} { Solve_QRSLV_Update_ParmBox}
2367     {makeMPS} { Solve_MPS_Update_ParmBox}
2368     {NGSlv} { Solve_NGSLV_Update_ParmBox}
2369     {CONOPT} { Solve_CONOPT_Update_ParmBox}
2370     {General} { Solve_General_Update_ParmBox}
2371     default {
2372     puts "Don't know how to update solver $ascSolvStatVect(solver) parms."
2373     }
2374     }
2375     leavetrace
2376     }
2377    
2378     #
2379     # proc Solve_Downdate_ParmBox {args}
2380     #----------------------------------------------------------------------------
2381     # load parms to C structure for current solver/solve system. If no system,
2382     # do nothing. if args not empty, downdate parms for system with name in args
2383     #----------------------------------------------------------------------------
2384     proc Solve_Downdate_ParmBox {args} {
2385     entertrace
2386     global ascSolvStatVect ascSolvVect
2387     if {![slv_checksys]} {
2388     leavetrace
2389     return
2390     }
2391     if {$args!=""} {
2392     set name $args
2393     } {
2394     set name $ascSolvStatVect(solver)
2395     }
2396     if {$ascSolvVect($name) == -1} {
2397     leavtrace
2398     return
2399     }
2400     if {[catch Solve_${name}_Downdate_ParmBoxNew]} {
2401     puts "Don't know how to downdate solver $ascSolvStatVect(solver) parms."
2402     }
2403     leavetrace
2404     }
2405    
2406     #
2407     # proc Solve_Status_Infobox {}
2408     #----------------------------------------------------------------------------
2409     # solve status alertbox #
2410     #----------------------------------------------------------------------------
2411     proc Solve_Status_Infobox {} {
2412     entertrace
2413     global ascSolvVect ascSolvStatVect ascMsgVect ascGlobalVect
2414     #
2415     # Update active flag of relations
2416     #
2417     Solve_FlagActive
2418     set ascMsgVect(lbl_font) $ascSolvVect(font)
2419     set ascMsgVect(btn_font) $ascSolvVect(font)
2420     set ascMsgVect(title) "Solve system status:"
2421     set ascMsgVect(btn_label) "Dismiss"
2422     set ascMsgVect(position) [setpos .solver 50 125]
2423     set ascMsgVect(grab) 0
2424     set ascMsgVect(toplevelname) .solverstatmsg
2425     set slist [join [split [string trim $ascSolvVect(status) ,] ,] \n]
2426     if {$ascSolvVect(statreport)} {
2427     ascMsgBox $slist
2428     raise .solverstatmsg
2429     } else {
2430     puts stdout $slist
2431     }
2432     leavetrace
2433     }
2434    
2435     #
2436     # proc Solve_Alert {title msg}
2437     #----------------------------------------------------------------------------
2438     # solve generic alertbox requires title msg #
2439     # msg may be multiline comma separated #
2440     #----------------------------------------------------------------------------
2441     proc Solve_Alert {title msg} {
2442     entertrace
2443     global ascSolvVect ascSolvStatVect ascMsgVect ascGlobalVect
2444     set ascMsgVect(lbl_font) $ascSolvVect(font)
2445     set ascMsgVect(btn_font) $ascSolvVect(font)
2446     set ascMsgVect(title) $title
2447     set ascMsgVect(btn_label) "Dismiss"
2448     set ascMsgVect(position) [setpos .solver 50 125]
2449     set ascMsgVect(grab) 0
2450     set ascMsgVect(toplevelname) .solveralertmsg
2451     set slist [join [split [string trim $msg ,] ,] \n]
2452     ascMsgBox $slist
2453     raise .solveralertmsg
2454     leavetrace
2455     }
2456    
2457     #
2458     # proc Solve_FP_error {msg}
2459     #----------------------------------------------------------------------------
2460     # solve floatingpoint error alertbox and analysis. #
2461     #----------------------------------------------------------------------------
2462     proc Solve_FP_error {msg} {
2463     entertrace
2464     global ascSolvVect ascSolvStatVect ascMsgVect ascGlobalVect
2465     set ascSolvStatVect(fpcaught) 1
2466     set ascMsgVect(lbl_font) $ascSolvVect(font)
2467     set ascMsgVect(btn_font) $ascSolvVect(font)
2468     set ascMsgVect(title) "Floating point error:"
2469     set ascMsgVect(btn_label) "Dismiss"
2470     set ascMsgVect(position) [setpos .solver 50 125]
2471     set ascMsgVect(grab) 0
2472     set ascMsgVect(toplevelname) .solvererr
2473     set slist [join [split [string trim $msg ,] ,] \n]
2474     ascMsgBox $slist
2475     raise .solvererr
2476     set elist [dbg_check_rels]
2477     puts "Examining relations for math errors:"
2478     foreach r $elist {
2479     set i [lindex $r 0]
2480     puts stderr "Relation <$i> [dbg_write_rel 2 $i 0] has math errors:"
2481     set ls [lindex $r 1]
2482     set rs [lindex $r 2]
2483     set dls [lindex $r 3]
2484     set drs [lindex $r 4]
2485     if {$ls} {
2486     puts stderr " Error in the LHS"
2487     }
2488     if {$rs} {
2489     puts stderr " Error in the RHS"
2490     }
2491     if {$ls==0 && $dls==1} {
2492     puts stderr " Error in the LHS derivative."
2493     }
2494     if {$rs==0 && $drs==1} {
2495     puts stderr " Error in the RHS derivative."
2496     }
2497     }
2498     leavetrace
2499     }
2500    
2501     #
2502     # proc Solve_Solve {}
2503     #----------------------------------------------------------------------------
2504     # Execute/Solve button internals #
2505     #----------------------------------------------------------------------------
2506     proc Solve_Solve {} {
2507     entertrace
2508     if {![slv_checksys]} { leavetrace; return }
2509     # needs better sanity checking and interrupt checking.
2510     global ascSolvVect ascSolvStatVect ascSolv32767Vect ascSolv3Vect
2511     set ascSolvStatVect(menubreak) 0
2512     slv_set_haltflag 0
2513     if {[slv_checksys]} {
2514     set ascSolvStatVect(ready2solve) 1
2515     }
2516     Solve_Downdate_ParmBox
2517     if {[catch {slv_presolve} ]} {
2518     Solve_FP_error "Initial values,cause float error.,Please fix this."
2519     leavetrace
2520     return
2521     }
2522     HUB_Message_to_HUB SOLVINGSTARTED $ascSolvVect(instname) \
2523     [lindex [slv_available] [slv_get_solver]]
2524     Solve_Update_StatusBox
2525     if {!$ascSolvStatVect(calcok)} {
2526     Solve_FP_error "Initial values,cause range error.,Please fix this."
2527     leavetrace
2528     return
2529     }
2530     update
2531     update idletasks
2532     puts "$ascSolvVect(status)"
2533     while {$ascSolvStatVect(ready2solve) && !$ascSolvStatVect(menubreak)} {
2534     set ascSolvStatVect(running) 1
2535     Solve_Running 0 0 0
2536     update idletasks
2537     if {[catch {slv_iterate \
2538     $ascSolv32767Vect(update_frequency) \
2539     $ascSolv32767Vect(update_time)} ermsg]} {
2540     set ascSolvStatVect(running) 0
2541     Solve_Running 0 0 0
2542     Solve_FP_error "Float error.,Check bounds & scaling."
2543     }
2544     Solve_update_monitor
2545     # temporary hack. get this slv3 reference out of here. baa 8/95
2546     # logically disabled 9/95 baa
2547     # set relnom ""
2548     # if {0 && $ascSolv3Vect(relnom) && [slv_get_solver] == 3} {
2549     # set relnom "[dbg_calc_relnoms]"
2550     # }
2551     if {0 && "$relnom" != ""} {
2552     Solve_FP_error \
2553     "Initial values,cause relation,scaling float error.,Please fix this."
2554     puts stderr "relindex lhsbad rhsbad nominal"
2555     foreach i $relnom {
2556     puts stderr $i
2557     }
2558     # leavetrace
2559     return
2560     }
2561     set ascSolvStatVect(running) 0
2562     Solve_Running 0 0 0
2563     Solve_Update_StatusBox 1
2564     Solve_ClearQueue
2565     update
2566     if {!$ascSolvStatVect(calcok)} {
2567     HUB_Message_to_HUB SOLVINGDONE $ascSolvVect(simname)
2568     Solve_FP_error \
2569     "Range error in,functions or derivatives.,Check bounds & scaling."
2570     leavetrace
2571     return
2572     }
2573     }
2574     HUB_Message_to_HUB SOLVINGDONE $ascSolvVect(simname)
2575     if {$ascSolv32767Vect(checksing)} {
2576     Solve_Check_RowsPivoted 0
2577     }
2578     leavetrace
2579     }
2580    
2581     #
2582     # proc Solve_Optimize {}
2583     #----------------------------------------------------------------------------
2584     # Execute/Optimize button internals #
2585     #----------------------------------------------------------------------------
2586     proc Solve_Optimize {} {
2587     entertrace
2588     # needs better sanity checking and interrupt checking.
2589     global ascSolvVect ascSolvStatVect ascSolv32767Vect
2590    
2591     set ascSolvStatVect(menubreak) 0
2592     slv_set_haltflag 0
2593     if {[slv_checksys]} {
2594     set ascSolvStatVect(ready2solve) 1
2595     }
2596     # something else here might be appropriate
2597     # if {[catch {slv_presolve} ]} {
2598     # Solve_FP_error "Initial values,cause float error.,Please fix this."
2599     # leavetrace
2600     return
2601     # }
2602     HUB_Message_to_HUB SOLVINGSTARTED $ascSolvVect(instname) \
2603     [lindex [slv_available] [slv_get_solver]]
2604     Solve_Update_StatusBox
2605     if {!$ascSolvStatVect(calcok)} {
2606     Solve_FP_error "Initial values,cause range error.,Please fix this."
2607     leavetrace
2608     return
2609     }
2610     update
2611     update idletasks
2612     puts "$ascSolvVect(status)"
2613     while {$ascSolvStatVect(ready2solve) && !$ascSolvStatVect(menubreak)} {
2614     set ascSolvStatVect(running) 1
2615     Solve_Running 0 0 0
2616     update idletasks
2617     if {[catch {slv_iterate \
2618     $ascSolv32767Vect(update_frequency) \
2619     $ascSolv32767Vect(update_time)} ermsg]} {
2620     set ascSolvStatVect(running) 0
2621     Solve_Running 0 0 0
2622     Solve_FP_error "Float error.,Check bounds & scaling."
2623     }
2624     set ascSolvStatVect(running) 0
2625     Solve_Running 0 0 0
2626     Solve_Update_StatusBox 1
2627     Solve_ClearQueue
2628     update
2629     if {!$ascSolvStatVect(calcok)} {
2630     HUB_Message_to_HUB SOLVINGDONE $ascSolvVect(simname)
2631     Solve_FP_error \
2632     "Range error in,functions or derivatives.,Check bounds & scaling."
2633     leavetrace
2634     return
2635     }
2636     }
2637     HUB_Message_to_HUB SOLVINGDONE $ascSolvVect(simname)
2638     if {$ascSolv32767Vect(checksing)} {
2639     Solve_Check_RowsPivoted 0
2640     }
2641     leavetrace
2642     }
2643    
2644     #
2645     # proc Solve_Integrate {}
2646     #----------------------------------------------------------------------------
2647     # Execute/Integrate button internals #
2648     #----------------------------------------------------------------------------
2649     proc Solve_Integrate {args} {
2650     entertrace
2651     # needs better sanity checking and interrupt checking.
2652     global ascSolvVect ascSolvStatVect ascSolv32767Vect
2653    
2654     set ascSolvStatVect(menubreak) 0
2655     if {[slv_checksys]} {
2656     set ascSolvStatVect(ready2solve) 1
2657     }
2658     if {[catch {slv_presolve} ]} {
2659     Solve_FP_error "Initial values,cause float error.,Please fix this."
2660     leavetrace
2661     return
2662     }
2663     HUB_Message_to_HUB SOLVINGSTARTED $ascSolvVect(instname) \
2664     [lindex [slv_available] [slv_get_solver]]
2665     Solve_Update_StatusBox
2666     if {!$ascSolvStatVect(calcok)} {
2667     Solve_FP_error "Initial values,cause range error.,Please fix this."
2668     leavetrace
2669     return
2670     }
2671     set n1 0
2672     set n2 0
2673     catch {integrate_logunits "$ascSolv32767Vect(logsi)"}
2674     catch {integrate_logformat "$ascSolv32767Vect(logcol)"}
2675     if {$ascSolv32767Vect(newlog)} {
2676     catch {file delete $ascSolv32767Vect(yfilename) \
2677     $ascSolv32767Vect(obsfilename)
2678     } fileerr
2679     }
2680     integrate_set_y_file "$ascSolv32767Vect(yfilename)"
2681     integrate_set_obs_file "$ascSolv32767Vect(obsfilename)"
2682     if {$args != ""} {
2683     if {[llength $args] !=3} {
2684     error "Solve integrate called with incorrect args type i1 i2"
2685     }
2686     set itype "[lindex $args 0]"
2687     set n1 [lindex $args 1]
2688     if {$n1 == "first"} {
2689     set n1 0
2690     }
2691     set n2 [lindex $args 2]
2692     if {$n2 == "last"} {
2693     if {"[string tolower $itype]"=="lsode"} {
2694     set n2 [lindex [lindex [u_getval [slv_get_pathname].nstep] 0] 0]
2695     } else {
2696     if {[catch {set n2 [llength [lindex [integrate_get_samples] 1]]} ]} {
2697     set n2 -1
2698     } else {
2699     incr n2 -1
2700     }
2701     }
2702     }
2703     }
2704     update
2705     update idletasks
2706     puts "$ascSolvVect(status)"
2707     set ascSolvStatVect(running) 1
2708     Solve_Running 0 0 0
2709     update idletasks
2710     if {$args == ""} {
2711     set integ_time [asc_clock "integrate_setup -engine BLSODE \
2712     -dt0 $ascSolv32767Vect(dtzero) \
2713     -dtmin $ascSolv32767Vect(dtmin) \
2714     -dtmax $ascSolv32767Vect(dtmax) \
2715     -moststeps $ascSolv32767Vect(moststeps)"]
2716     } else {
2717     set integ_time \
2718     [asc_clock "integrate_setup -engine $itype -i0 $n1 -i1 $n2 \
2719     -dt0 $ascSolv32767Vect(dtzero) \
2720     -dtmin $ascSolv32767Vect(dtmin) \
2721     -dtmax $ascSolv32767Vect(dtmax) \
2722     -moststeps $ascSolv32767Vect(moststeps)"]
2723     }
2724     integrate_cleanup
2725     puts "Time for integration: $integ_time"
2726     set ascSolvStatVect(running) 0
2727     Solve_Running 0 0 0
2728     Solve_Update_StatusBox
2729     Solve_ClearQueue
2730     update
2731     if {!$ascSolvStatVect(calcok)} {
2732     HUB_Message_to_HUB SOLVINGDONE $ascSolvVect(simname)
2733     Solve_FP_error \
2734     "Range error in,functions or derivatives.,Check bounds & scaling."
2735     leavetrace
2736     return
2737     }
2738     HUB_Message_to_HUB SOLVINGDONE $ascSolvVect(simname)
2739     if {$ascSolv32767Vect(checksing)} {
2740     Solve_Check_RowsPivoted 0
2741     }
2742     leavetrace
2743     }
2744    
2745    
2746     #
2747     # proc Solve_Iterate {}
2748     #----------------------------------------------------------------------------
2749     # Execute/Iterate button internals does one of karls iterations. #
2750     #----------------------------------------------------------------------------
2751     proc Solve_Iterate {} {
2752     entertrace
2753     global ascSolvVect ascSolvStatVect
2754     set ascSolvStatVect(menubreak) 0
2755     slv_set_haltflag 0
2756     Solve_Update_StatusBox
2757     set ascSolvStatVect(running) 1
2758     Solve_Running 0 0 0
2759     update idletasks
2760     slv_iterate 1
2761     set ascSolvStatVect(running) 0
2762     Solve_Running 0 0 0
2763     Solve_update_monitor
2764     Solve_Update_StatusBox
2765     update idletasks
2766     HUB_Message_to_HUB SOLVINGDONE $ascSolvVect(simname)
2767     leavetrace
2768     }
2769    
2770     #
2771     # proc Solve_General_Update_ParmBox {}
2772     #----------------------------------------------------------------------------
2773     # this updates ascSolv32767Vect variables #
2774     #----------------------------------------------------------------------------
2775     proc Solve_General_Update_ParmBox {} {
2776     entertrace
2777     global ascSolv32767Vect
2778     set ascSolv32767Vect(lnmepsilon) [slv_lnmget]
2779     leavetrace
2780     }
2781     #
2782     # proc Solve_General_Downdate_ParmBox {}
2783     #----------------------------------------------------------------------------
2784     # this downdates ascSolv32767Vect variables #
2785     #----------------------------------------------------------------------------
2786     proc Solve_General_Downdate_ParmBox {} {
2787     entertrace
2788     catch {slv_lnmset $ascSolv32767Vect(lnmepsilon)}
2789     leavetrace
2790     }
2791     #
2792     # proc Solve_SLV_Update_ParmBox {}
2793     #----------------------------------------------------------------------------
2794     # this updates ascSolv0Vect variables from the C structure #
2795     #----------------------------------------------------------------------------
2796     proc Solve_SLV_Update_ParmBox {} {
2797     entertrace
2798     global ascSolv0Vect
2799     set tmplist [slv_get_parms 0]
2800     if { [llength $tmplist]==17 && [lindex $tmplist 0]==0} {
2801     set ascSolv0Vect(timelimit) [lindex $tmplist 1]
2802     set ascSolv0Vect(iterationlimit) [lindex $tmplist 2]
2803     set ascSolv0Vect(termtol) [lindex $tmplist 3]
2804     set ascSolv0Vect(feastol) [lindex $tmplist 4]
2805     set ascSolv0Vect(pivottol) [lindex $tmplist 5]
2806     set ascSolv0Vect(singtol) [lindex $tmplist 6]
2807     set ascSolv0Vect(stattol) [lindex $tmplist 7]
2808     set ascSolv0Vect(rho) [lindex $tmplist 8]
2809     set ascSolv0Vect(partition) [lindex $tmplist 9]
2810     set ascSolv0Vect(ignorebounds) [lindex $tmplist 10]
2811     set ascSolv0Vect(showmoreimportant) [lindex $tmplist 11]
2812     set ascSolv0Vect(showlessimportant) [lindex $tmplist 12]
2813     set ascSolv0Vect(bppivoting) [lindex $tmplist 13]
2814     set ascSolv0Vect(showlessimportantds) [lindex $tmplist 14]
2815     set ascSolv0Vect(savlin) [lindex $tmplist 15]
2816     } else {
2817     puts "Error in Slv call to slv_get_parms"
2818     }
2819     leavetrace
2820     }
2821     #
2822     # proc Solve_QRSLV_Update_ParmBox {}
2823     #----------------------------------------------------------------------------
2824     # this updates ascSolv3Vect variables from the C structure #
2825     #----------------------------------------------------------------------------
2826     proc Solve_QRSLV_Update_ParmBox {} {
2827     entertrace
2828     global ascSolv3Vect
2829     global ascSolvVect
2830     set registered_number $ascSolvVect(QRSlv)
2831    
2832     if { $registered_number < 0 } {
2833     leavetrace
2834     return
2835     }
2836    
2837     set tmplist [slv_get_parms $registered_number]
2838     if { [llength $tmplist]==41 && [lindex $tmplist 0]==$registered_number} {
2839     set ascSolv3Vect(timelimit) [lindex $tmplist 1]
2840     set ascSolv3Vect(iterationlimit) [lindex $tmplist 2]
2841     set ascSolv3Vect(termtol) [lindex $tmplist 3]
2842     set ascSolv3Vect(feastol) [lindex $tmplist 4]
2843     set ascSolv3Vect(pivottol) [lindex $tmplist 5]
2844     set ascSolv3Vect(singtol) [lindex $tmplist 6]
2845     set ascSolv3Vect(stattol) [lindex $tmplist 7]
2846     set ascSolv3Vect(rho) [lindex $tmplist 8]
2847     set ascSolv3Vect(partition) [lindex $tmplist 9]
2848     set ascSolv3Vect(ignorebounds) [lindex $tmplist 10]
2849     set ascSolv3Vect(showmoreimportant) [lindex $tmplist 11]
2850     set ascSolv3Vect(showlessimportant) [lindex $tmplist 12]
2851     set ascSolv3Vect(bppivoting) \
2852     [Solve_QRSLV_int_to_bppivoting [lindex $tmplist 13]]
2853     set ascSolv3Vect(lifds) [lindex $tmplist 14]
2854     set ascSolv3Vect(savlin) [lindex $tmplist 15]
2855     set ascSolv3Vect(relnomscale) [lindex $tmplist 16]
2856     set ascSolv3Vect(cutoff) [lindex $tmplist 17]
2857     set ascSolv3Vect(upjac) [lindex $tmplist 18]
2858     set ascSolv3Vect(upwts) [lindex $tmplist 19]
2859     set ascSolv3Vect(upnom) [lindex $tmplist 20]
2860     set ascSolv3Vect(reduce) [lindex $tmplist 21]
2861     set ascSolv3Vect(exact) [lindex $tmplist 22]
2862     set ascSolv3Vect(cncols) [lindex $tmplist 23]
2863     set ascSolv3Vect(btrunc) [lindex $tmplist 24]
2864     set ascSolv3Vect(reorder) [lindex $tmplist 25]
2865     set ascSolv3Vect(safe_calc) [lindex $tmplist 26]
2866     set ascSolv3Vect(uprelnom) [lindex $tmplist 27]
2867     set ascSolv3Vect(itscalelim) [lindex $tmplist 28]
2868     set ascSolv3Vect(scaleopt) [lindex $tmplist 29]
2869     set ascSolv3Vect(toosmall) [lindex $tmplist 30]
2870     set ascSolv3Vect(cnlow) [lindex $tmplist 31]
2871     set ascSolv3Vect(cnhigh) [lindex $tmplist 32]
2872     set ascSolv3Vect(tobnds) [lindex $tmplist 33]
2873     set ascSolv3Vect(posdef) [lindex $tmplist 34]
2874     set ascSolv3Vect(detzero) [lindex $tmplist 35]
2875     set ascSolv3Vect(steperrmax) [lindex $tmplist 36]
2876     set ascSolv3Vect(prngmin) [lindex $tmplist 37]
2877     set ascSolv3Vect(mincoef) [lindex $tmplist 38]
2878     set ascSolv3Vect(maxcoef) [lindex $tmplist 39]
2879     set ascSolv3Vect(itscaletol) [lindex $tmplist 40]
2880     } else {
2881     puts "Error IN QRSlv call to slv_get_parms"
2882     }
2883     leavetrace
2884     }
2885     # proc Solve_NGSLV_Update_ParmBox {}
2886     #----------------------------------------------------------------------------
2887