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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 113 - (show annotations) (download) (as text)
Thu Dec 15 03:59:55 2005 UTC (16 years, 5 months ago) by ben.allan
File MIME type: text/x-tcl
File size: 177700 byte(s)
added slv_[un]trapint tcl callbacks which can be used to turn off
ctrl-c trapping of the commandline. in theory this will help gdb.
Note: traps are handled on a stack, so to guarantee the sigint
stack is empty, use slv_untrapint untill you get an error message:
        ascSignal.c:437: Asc_Signal (2) stack pop mismatch.


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 slv_trapint
154 #side effect sets the interrupt trap. need to fix that.
155 slv_untrapfp
156 } {
157 slv_trapfp
158 }
159 }
160
161 set ascSolv32767Vect(monitor) 0 ;# set this to 1 in .ascend.ad
162 Solve_Build_EngineMenus
163 Solve_Build_SaveParsMenus
164 Solve_Update_MenuBar
165 bind .solver <Control-Key-C> Solve_do_Interrupt
166 bind .solver <F5> Solve_do_Solve
167 bind .solver <F6> Solve_do_Iterate
168 bind .solver <F7> Solve_do_Integrate
169 bind .solver <Control-Key-p> Solve_do_Display_Status
170 bind .solver <Control-Key-g> {Solve_do_Parms open General}
171 bind .solver.lbl_frm.lbl_run <B3-ButtonRelease> {Help_button solver.running}
172
173 leavetrace
174 }
175
176
177 #
178 #proc set_defaults {number}
179 #------------------------------------------------------------------
180 # automatically builds procedures for setting up solvers parameter
181 # pages. Calls procedure after creating also.
182 # Desired improvements:
183 # automaticaly detect and set maxlines.
184 # error detection in c code and appropriate bailout in tcl
185 #------------------------------------------------------------------
186 proc set_defaults {number} {
187 entertrace
188 global ascSolvVect
189 # nest call actually gets defaults
190 set list [slv_get_parmsnew $number]
191 set length [llength $list]
192 set name $ascSolvVect(name.$number)
193 set parm_num 0
194 set max_page 0
195 set display_list ""
196 set set_list ""
197 for {set i 0} {$i < $length} {incr i} {
198 if {[string compare [lindex $list $i] "New_Parm"] == 0} {
199 incr i
200 if {[string compare [lindex $list $i] "char_parm"] != 0} {
201 set parm_type {}
202 switch -exact -- [lindex $list $i] {
203 int_parm {
204 set parm_type int
205 }
206 bool_parm {
207 set parm_type bool
208 }
209 real_parm {
210 set parm_type real
211 }
212 default {
213 puts "Big problem in set_defaults: unrecognized type"
214 # need better bailout / error checking here
215 continue
216 }
217 }
218 set j $i
219 incr j
220 set parm_name [lindex $list $j]; incr j
221 set parm_label [lindex $list $j]; incr j
222 set parm_val [lindex $list $j]; incr j
223 set parm_hi [lindex $list $j]; incr j
224 set parm_lo [lindex $list $j]; incr j
225 set parm_page [lindex $list $j]; incr j
226 set parm_help [lindex $list $j]; incr j
227 if {$parm_page > 0} {
228 lappend display_list $parm_name
229 if {$parm_page > $max_page} {
230 set max_page $parm_page
231 }
232 }
233 append set_list \$ascSolv${name}Vect($parm_name)
234 append set_list " "
235 proc ${name}_parm$parm_num {} "
236 entertrace
237 global ascSolv${name}Vect
238 set ascSolv${name}Vect($parm_name) $parm_val
239 set ascSolv${name}Vect($parm_name.type) $parm_type
240 set ascSolv${name}Vect($parm_name.label) \{$parm_label\}
241 set ascSolv${name}Vect($parm_name.lo) $parm_lo
242 set ascSolv${name}Vect($parm_name.hi) $parm_hi
243 set ascSolv${name}Vect($parm_name.page) $parm_page
244 set ascSolv${name}Vect($parm_name.help) \{$parm_help\}
245 "
246 incr parm_num
247 set i [expr $i + 7]
248 } else {
249 set j $i
250 incr j
251 set parm_type string
252 set parm_name [lindex $list $j]; incr j
253 set parm_label [lindex $list $j]; incr j
254 set parm_val [lindex $list $j]; incr j
255 set parm_hi [lindex $list $j]; incr j
256 set parm_list ""
257 for {set j 0} {$j < $parm_hi} {incr j} {
258 lappend parm_list [lindex $list [expr $i + 5 + $j]]
259 }
260 append set_list \$ascSolv${name}Vect($parm_name)
261 append set_list " "
262 set parm_page [lindex $list [expr $i + 5 + $parm_hi]]
263 set parm_help [lindex $list [expr $i + 6 + $parm_hi]]
264 if {$parm_page > 0} {
265 lappend display_list $parm_name
266 if {$parm_page > $max_page} {
267 set max_page $parm_page
268 }
269 }
270 proc ${name}_parm$parm_num {} "
271 entertrace
272 global ascSolv${name}Vect
273 set ascSolv${name}Vect($parm_name) \{$parm_val\}
274 set ascSolv${name}Vect($parm_name.type) $parm_type
275 set ascSolv${name}Vect($parm_name.label) \{$parm_label\}
276 set ascSolv${name}Vect($parm_name.choices) \{$parm_list\}
277 set ascSolv${name}Vect($parm_name.page) $parm_page
278 set ascSolv${name}Vect($parm_name.page) \{$parm_help\}
279 "
280 incr parm_num
281 set i [expr $i + 5 + $parm_hi]
282 }
283 }
284 }
285
286 # define a Defaults proc, which is rather a messy thing to do
287 proc set_${name}_Defaults {} "
288 entertrace
289 global ascSolv${name}Vect
290 set ascSolv${name}Vect(namelist) \{$display_list\}
291 set ascSolv${name}Vect(toplevel) .slv${name}parms
292 set ascSolv${name}Vect(title) \"$name Parameters\"
293 set ascSolv${name}Vect(maxlines) 12
294 set ascSolv${name}Vect(onesize) 0
295 set ascSolv${name}Vect(npages) $max_page
296 set ascSolv${name}Vect(grab) 0
297 set ascSolv${name}Vect(cancellable) 0
298 set ascSolv${name}Vect(helpcommand) \
299 \"Help_button solver.$name.parameters\"
300 set ascSolv${name}Vect(whenokcommand) \"Solve_do_Parms close $name\"
301 for {set p 0} { \$p < $parm_num} {incr p} {
302 ${name}_parm\$p
303 }
304 leavetrace
305 "
306
307 proc Solve_${name}_Downdate_ParmBoxNew {} "
308 entertrace
309 global ascSolv${name}Vect
310 set_slv_parmsnew $number $set_list
311 leavetrace
312 "
313
314 # Now call procedure to set defaults
315 set_${name}_Defaults
316 }
317
318 #
319 # proc set_SolvG_Defaults {}
320 # ----------------------------------------------------------------------
321 # set defaults for control of the General solver, that is, a page full
322 # of parameters for anyone to fall back on if so desired or during
323 # development of the interface to a new solver.
324 # Subparameters, that is solver specific controls should only be mentioned
325 # in ascSolvXVect.
326 #
327 # Not all of the parameters on this page correspond to C variables directly.
328 # ----------------------------------------------------------------------
329 proc set_SolvG_Defaults {} {
330 entertrace
331 global ascSolv32767Vect
332 # General parameter page setup variables
333 set ascSolv32767Vect(namelist) [list \
334 lnmepsilon update_frequency update_time dtmin dtmax dtzero \
335 moststeps newlog checksing showavgs \
336 yfilename obsfilename logsi logcol nearbound farnom]
337 set ascSolv32767Vect(toplevel) .slv32767parms
338 set ascSolv32767Vect(title) "General Parameters"
339 set ascSolv32767Vect(maxlines) 12
340 set ascSolv32767Vect(npages) 2
341 set ascSolv32767Vect(grab) 0
342 set ascSolv32767Vect(cancellable) 0
343 set ascSolv32767Vect(helpcommand) ""
344 set ascSolv32767Vect(whenokcommand) "Solve_do_Parms close General"
345 if {![info exists ascSolv32767Vect(checksing)]} {
346 # set defaults for vars, OTHERWISE assume optoin file set them.
347 set ascSolv32767Vect(checksing) 0
348 set ascSolv32767Vect(showavgs) 0
349 set ascSolv32767Vect(update_frequency) 10
350 set ascSolv32767Vect(update_time) 3
351 set ascSolv32767Vect(lnmepsilon) 1e-8
352 set ascSolv32767Vect(farnom) 10e3
353 set ascSolv32767Vect(nearbound) 1e-3
354 set ascSolv32767Vect(newlog) 1
355 set ascSolv32767Vect(logcol) variable
356 set ascSolv32767Vect(logsi) display
357 set ascSolv32767Vect(obsfilename) "obs.dat"
358 set ascSolv32767Vect(yfilename) "y.dat"
359 set ascSolv32767Vect(dtzero) 0
360 set ascSolv32767Vect(dtmax) 0
361 set ascSolv32767Vect(dtmin) 0
362 set ascSolv32767Vect(moststeps) 0
363 }
364 set ascSolv32767Vect(checksing.type) bool
365 set ascSolv32767Vect(checksing.label) "check numeric rank after solving"
366 set ascSolv32767Vect(checksing.help) \
367 "checks automatically for Jacobian matrix singularity\n"
368 append ascSolv32767Vect(checksing.help) "after solution with a solver that\n"
369 append ascSolv32767Vect(checksing.help) "uses a Jacobian matrix."
370 set ascSolv32767Vect(showavgs.type) bool
371 set ascSolv32767Vect(showavgs.label) "show block summary"
372 set ascSolv32767Vect(showavgs.help) \
373 "automatically displays time and function/gradient statistics\n"
374 append ascSolv32767Vect(showavgs.help) "for solvers which produce them\n"
375 set ascSolv32767Vect(update_frequency.type) int
376 set ascSolv32767Vect(update_frequency.lo) 1
377 set ascSolv32767Vect(update_frequency.label) \
378 "iterations before screen update"
379 set ascSolv32767Vect(update_frequency.help) \
380 "The GUI update at each solver iteration can be expensive sometimes.\n"
381 append ascSolv32767Vect(update_frequency.help) \
382 "For faster performance, with less user feedback, make this number large."
383 append ascSolv32767Vect(update_frequency.help) \
384 "\nFor maximum interactivity, make this number 1."
385 set ascSolv32767Vect(update_time.type) int
386 set ascSolv32767Vect(update_time.lo) 1
387 set ascSolv32767Vect(update_time.label) "cpu sec before screen update"
388 set ascSolv32767Vect(update_time.help) \
389 "This is the maximum time, regardless of iteration count, allowed before \n"
390 append ascSolv32767Vect(update_time.help) \
391 "a GUI update will be scheduled. Once scheduled, the GUI update will\n"
392 append ascSolv32767Vect(update_time.help) \
393 "occur at the end of the next iteration where the solver returns control\n"
394 append ascSolv32767Vect(update_time.help) "to ASCEND."
395
396 set ascSolv32767Vect(lnmepsilon.label) "modified log epsilon"
397 set ascSolv32767Vect(lnmepsilon.lo) 1e-16
398 set ascSolv32767Vect(lnmepsilon.hi) 0.5
399 set ascSolv32767Vect(lnmepsilon.type) real
400 set ascSolv32767Vect(moststeps.page) 2
401 set ascSolv32767Vect(moststeps.label) "most integrator steps per time sample"
402 set ascSolv32767Vect(moststeps.lo) 0
403 set ascSolv32767Vect(moststeps.type) int
404 set ascSolv32767Vect(moststeps.help) \
405 "If this number is 0, integrators will use their built-in limit.\n"
406 append ascSolv32767Vect(moststeps.help) \
407 "You can tell the integrator a different limit by setting this to non-0."
408 set ascSolv32767Vect(dtmin.page) 2
409 set ascSolv32767Vect(dtmin.label) "minimum integrator step (SI units)"
410 set ascSolv32767Vect(dtmin.lo) 0
411 set ascSolv32767Vect(dtmin.hi) 20.0
412 set ascSolv32767Vect(dtmin.type) real
413 set ascSolv32767Vect(dtmin.help) \
414 "If this number is 0, integrators will use their built-in limit.\n"
415 append ascSolv32767Vect(dtmin.help) \
416 "You can tell the integrator a different limit by setting this to non-0."
417 set ascSolv32767Vect(dtmax.page) 2
418 set ascSolv32767Vect(dtmax.label) "maximum integrator step (SI units)"
419 set ascSolv32767Vect(dtmax.lo) 0
420 set ascSolv32767Vect(dtmax.hi) 20.0
421 set ascSolv32767Vect(dtmax.type) real
422 set ascSolv32767Vect(dtmax.help) \
423 "If this number is 0, integrators will use their built-in limit.\n"
424 append ascSolv32767Vect(dtmax.help) \
425 "You can tell the integrator a different limit by setting this to non-0."
426 set ascSolv32767Vect(dtzero.page) 2
427 set ascSolv32767Vect(dtzero.label) "initial integrator step size (SI units)"
428 set ascSolv32767Vect(dtzero.lo) 0
429 set ascSolv32767Vect(dtzero.hi) 20.0
430 set ascSolv32767Vect(dtzero.type) real
431 set ascSolv32767Vect(dtzero.help) \
432 "If this number is 0, integrators will use their built-in initial step.\n"
433 append ascSolv32767Vect(dtzero.help) \
434 "You can tell the integrator a different start by setting this to non-0.\n"
435 append ascSolv32767Vect(dtzero.help) \
436 "If your problem is very stiff, setting this to a small value may help."
437 set ascSolv32767Vect(yfilename.page) 2
438 set ascSolv32767Vect(yfilename.label) "integrator state log"
439 set ascSolv32767Vect(yfilename.type) string
440 set ascSolv32767Vect(yfilename.help) \
441 "directory path and file to store log of state and derivative values"
442 set ascSolv32767Vect(obsfilename.page) 2
443 set ascSolv32767Vect(obsfilename.label) "integrator observation log"
444 set ascSolv32767Vect(obsfilename.type) string
445 set ascSolv32767Vect(obsfilename.help) \
446 "directory path and file to store observation profiles"
447 set ascSolv32767Vect(logsi.page) 2
448 set ascSolv32767Vect(logsi.type) string
449 set ascSolv32767Vect(logsi.label) "integrator log SI units"
450 set ascSolv32767Vect(logsi.choices) "si display"
451 set ascSolv32767Vect(logsi.help) "Observation and state logs are written\n"
452 append ascSolv32767Vect(logsi.help) \
453 "in either SI or your current displayed units"
454 set ascSolv32767Vect(logcol.page) 2
455 set ascSolv32767Vect(logcol.type) string
456 set ascSolv32767Vect(logcol.label) "integrator log columns"
457 set ascSolv32767Vect(logcol.choices) "variable fixed"
458 set ascSolv32767Vect(logcol.help) "Observation and state logs are written\n"
459 append ascSolv32767Vect(logcol.help) \
460 "in either fixed or variable column width for consumption by other software"
461 set ascSolv32767Vect(newlog.page) 2
462 set ascSolv32767Vect(newlog.type) bool
463 set ascSolv32767Vect(newlog.label) "overwrite integrator logs"
464 set ascSolv32767Vect(nearbound.label) "bound check epsilon"
465 set ascSolv32767Vect(nearbound.lo) 0
466 set ascSolv32767Vect(nearbound.type) real
467 set ascSolv32767Vect(farnom.label) "far from nom bignum"
468 set ascSolv32767Vect(farnom.lo) 0
469 set ascSolv32767Vect(farnom.type) real
470 leavetrace
471 }
472
473 #
474 # proc Solve_Build_EngineMenus {}
475 # ----------------------------------------------------------------------
476 # construct choices for all the linked solvers
477 # ----------------------------------------------------------------------
478 proc Solve_Build_EngineMenus {} {
479 entertrace
480 global ascSolvVect
481 for {set s 0} {$s<$ascSolvVect(numberofsolvers)} {incr s} {
482 if {$ascSolvVect(available.$s)} {
483 set state active
484 } else {
485 set state disabled
486 }
487 .solver.lbl_frm.entry5.m add command \
488 -command "Solve_do_Select $ascSolvVect(name.$s)" \
489 -label "$ascSolvVect(name.$s)" \
490 -state $state
491 .solver.lbl_frm.btn_opts.m add command \
492 -command "Solve_do_Parms open $ascSolvVect(name.$s)" \
493 -label "$ascSolvVect(name.$s) ..." \
494 -state $state
495 }
496 leavetrace
497 }
498
499 #
500 # proc Solve_Build_SaveParsMenus {}
501 # ----------------------------------------------------------------------
502 # construct choices for all the linked solvers
503 # ----------------------------------------------------------------------
504 proc Solve_Build_SaveParsMenus {} {
505 entertrace
506 global ascSolvVect
507 for {set s 0} {$s<$ascSolvVect(numberofsolvers)} {incr s} {
508
509 $ascSolvVect(saveparmenu) add command \
510 -command "View_Save_Solver_Params $s" \
511 -label $ascSolvVect(name.$s)
512
513 }
514 leavetrace
515 }
516
517 #
518 # proc set_Solv0_Defaults {}
519 # ----------------------------------------------------------------------
520 # set defaults for control of Slv
521 # ----------------------------------------------------------------------
522 proc set_Solv0_Defaults {} {
523 entertrace
524 global ascSolv0Vect
525 # SLV parameter page setup variables
526 set ascSolv0Vect(namelist) [list partition showlessimportant timelimit \
527 iterationlimit singtol pivottol feastol rho autoresolve \
528 showlessimportantds savlin]
529 set ascSolv0Vect(toplevel) .slv0parms
530 set ascSolv0Vect(title) "Slv Parameters"
531 set ascSolv0Vect(maxlines) 12
532 set ascSolv0Vect(npages) 2
533 set ascSolv0Vect(grab) 0
534 set ascSolv0Vect(helpcommand) "Help_button solver.slv.parameters"
535 set ascSolv0Vect(whenokcommand) "Solve_do_Parms close Slv"
536 # not window page supported Slv parms
537 set ascSolv0Vect(ignorebounds) "0"
538 set ascSolv0Vect(showmoreimportant) "1"
539 set ascSolv0Vect(termtol) 1e-11
540 # SLV parameter page variables
541 set ascSolv0Vect(rho) "100"
542 set ascSolv0Vect(rho.page) 1
543 set ascSolv0Vect(rho.type) real
544 set ascSolv0Vect(rho.lo) 0
545 set ascSolv0Vect(rho.label) "penalty parameter"
546 set ascSolv0Vect(partition) "1"
547 set ascSolv0Vect(partition.page) 1
548 set ascSolv0Vect(partition.type) bool
549 set ascSolv0Vect(partition.label) "partitioning enabled"
550 set ascSolv0Vect(bppivoting) "0"
551 set ascSolv0Vect(bppivoting.page) 2
552 set ascSolv0Vect(bppivoting.type) bool
553 set ascSolv0Vect(bppivoting.label) "bipartial pivoting"
554 set ascSolv0Vect(showlessimportant) "0"
555 set ascSolv0Vect(showlessimportant.page) 1
556 set ascSolv0Vect(showlessimportant.type) bool
557 set ascSolv0Vect(showlessimportant.label) "detailed solving info required"
558 set ascSolv0Vect(showlessimportantds) 0
559 set ascSolv0Vect(showlessimportantds.page) 2
560 set ascSolv0Vect(showlessimportantds.type) bool
561 set ascSolv0Vect(showlessimportantds.label) "show singletons details"
562 set ascSolv0Vect(savlin) 0
563 set ascSolv0Vect(savlin.page) 2
564 set ascSolv0Vect(savlin.type) bool
565 set ascSolv0Vect(savlin.label) "write to file SlvLinsol.dat"
566 set ascSolv0Vect(autoresolve) 1
567 set ascSolv0Vect(autoresolve.page) 1
568 set ascSolv0Vect(autoresolve.type) bool
569 set ascSolv0Vect(autoresolve.label) auto-resolve
570 set ascSolv0Vect(timelimit) 1000
571 set ascSolv0Vect(timelimit.page) 1
572 set ascSolv0Vect(timelimit.type) int
573 set ascSolv0Vect(timelimit.lo) 1
574 set ascSolv0Vect(timelimit.label) "time limit (CPU sec/block)"
575 set ascSolv0Vect(iterationlimit) 20
576 set ascSolv0Vect(iterationlimit.page) 1
577 set ascSolv0Vect(iterationlimit.lo) 1
578 set ascSolv0Vect(iterationlimit.type) int
579 set ascSolv0Vect(iterationlimit.label) "maximum iterations/block"
580 set ascSolv0Vect(stattol) "1e-6"
581 set ascSolv0Vect(stattol.page) 1
582 set ascSolv0Vect(termtol) "1e-12"
583 set ascSolv0Vect(singtol) "1e-12"
584 set ascSolv0Vect(singtol.page) 1
585 set ascSolv0Vect(singtol.type) real
586 set ascSolv0Vect(singtol.lo) 1e-12
587 set ascSolv0Vect(singtol.label) "epsilon (minimum pivot)"
588 set ascSolv0Vect(pivottol) "0.01"
589 set ascSolv0Vect(pivottol.page) 1
590 set ascSolv0Vect(pivottol.label) "pivot tolerance"
591 set ascSolv0Vect(pivottol.lo) 0
592 set ascSolv0Vect(pivottol.hi) 1
593 set ascSolv0Vect(pivottol.type) real
594 set ascSolv0Vect(feastol) "1e-8"
595 set ascSolv0Vect(feastol.page) 1
596 set ascSolv0Vect(feastol.lo) "1e-13"
597 set ascSolv0Vect(feastol.type) real
598 set ascSolv0Vect(feastol.label) "max. residual (absolute)"
599 leavetrace
600 }
601 #
602 # proc set_Solv1_Defaults {}
603 # ----------------------------------------------------------------------
604 # set defaults for control of minos
605 # keep me until we resurrect minos
606 # ----------------------------------------------------------------------
607 proc set_Solv1_Defaults {} {
608 entertrace
609 global ascSolv1Vect
610 # SLV parameter page setup variables
611 set ascSolv1Vect(namelist) [list damp mindamp tolsing tolfeas tolstat \
612 timelimit majits rho showlessimportant autoresolve \
613 completion crash cfreq ffreq uselg lfreq deriv minits mulpr \
614 parpr printJ printF printL printX printB scale param verify \
615 fdiff cdiff fprec lstol lufto luuto ludto lusto luwto \
616 subsp radius objlim steplm summary filesumm \
617 lobjwt soln lcons]
618 set ascSolv1Vect(toplevel) .slv1parms
619 set ascSolv1Vect(title) "MINOS Parameters"
620 set ascSolv1Vect(maxlines) 15
621 set ascSolv1Vect(npages) 4
622 set ascSolv1Vect(grab) 0
623 set ascSolv1Vect(helpcommand) "Help_button solver.minos.parameters"
624 set ascSolv1Vect(whenokcommand) "Solve_do_Parms close MINOS"
625 # not window page supported minos parms
626 set ascSolv1Vect(showmoreimportant) "1"
627 # MINOS parameter page variables
628
629 set ascSolv1Vect(tolsing) "1e-11"
630 set ascSolv1Vect(tolsing.page) 1
631 set ascSolv1Vect(tolsing.type) real
632 set ascSolv1Vect(tolsing.lo) 1e-16
633 set ascSolv1Vect(tolsing.label) "Epsilon (Pivot Tolerance)"
634 set ascSolv1Vect(tolfeas) "1e-8"
635 set ascSolv1Vect(tolfeas.page) 1
636 set ascSolv1Vect(tolfeas.label) "Max. residual"
637 set ascSolv1Vect(tolfeas.lo) 1e-16
638 set ascSolv1Vect(tolfeas.type) real
639 set ascSolv1Vect(tolstat) "1e-8"
640 set ascSolv1Vect(tolstat.page) 2
641 set ascSolv1Vect(tolstat.label) "Optimality tolerance"
642 set ascSolv1Vect(tolstat.lo) 1e-16
643 set ascSolv1Vect(tolstat.type) real
644 set ascSolv1Vect(majits) "20"
645 set ascSolv1Vect(majits.page) "1"
646 set ascSolv1Vect(majits.lo) 1
647 set ascSolv1Vect(majits.type) int
648 set ascSolv1Vect(majits.label) "Major iterations limit"
649
650 set ascSolv1Vect(timelimit) "500"
651 set ascSolv1Vect(timelimit.page) 1
652 set ascSolv1Vect(timelimit.type) int
653 set ascSolv1Vect(timelimit.lo) 1
654 set ascSolv1Vect(timelimit.label) "Time limit (CPU sec)"
655 set ascSolv1Vect(rho) "1e-11"
656 set ascSolv1Vect(rho.page) 1
657 set ascSolv1Vect(rho.type) real
658 set ascSolv1Vect(rho.lo) 0
659 set ascSolv1Vect(rho.label) "Penalty parameter"
660 set ascSolv1Vect(autoresolve) "0"
661 set ascSolv1Vect(autoresolve.page) "1"
662 set ascSolv1Vect(autoresolve.type) bool
663 set ascSolv1Vect(autoresolve.label) auto-resolve
664 set ascSolv1Vect(showlessimportant) 0
665 set ascSolv1Vect(showlessimportant.page) 1
666 set ascSolv1Vect(showlessimportant.type) bool
667 set ascSolv1Vect(showlessimportant.label) "detailed solving info required"
668
669 set ascSolv1Vect(completion) 1
670 set ascSolv1Vect(completion.page) 2
671 set ascSolv1Vect(completion.type) bool
672 set ascSolv1Vect(completion.label) "Full completion"
673 set ascSolv1Vect(crash) 1
674 set ascSolv1Vect(crash.page) 2
675 set ascSolv1Vect(crash.type) int
676 set ascSolv1Vect(crash.lo) 0
677 set ascSolv1Vect(crash.hi) 4
678 set ascSolv1Vect(crash.label) "Crash option"
679 set ascSolv1Vect(deriv) 3
680 set ascSolv1Vect(deriv.page) 4
681 set ascSolv1Vect(deriv.type) int
682 set ascSolv1Vect(deriv.lo) 0
683 set ascSolv1Vect(deriv.hi) 3
684 set ascSolv1Vect(deriv.label) "Derivative level"
685 set ascSolv1Vect(cfreq) 30
686 set ascSolv1Vect(cfreq.page) 4
687 set ascSolv1Vect(cfreq.lo) 1
688 set ascSolv1Vect(cfreq.type) int
689 set ascSolv1Vect(cfreq.label) "Linear check frequency"
690 set ascSolv1Vect(ffreq) 50
691 set ascSolv1Vect(ffreq.page) 4
692 set ascSolv1Vect(ffreq.lo) 0
693 set ascSolv1Vect(ffreq.type) int
694 set ascSolv1Vect(ffreq.label) "Basis factorization frequency"
695 set ascSolv1Vect(efreq) 0
696 set ascSolv1Vect(efreq.page) 4
697 set ascSolv1Vect(efreq.lo) 0
698 set ascSolv1Vect(efreq.type) int
699 set ascSolv1Vect(efreq.label) "Expand frequency"
700 set ascSolv1Vect(uselg) 1
701 set ascSolv1Vect(uselg.page) 2
702 set ascSolv1Vect(uselg.type) bool
703 set ascSolv1Vect(uselg.label) "Lagrangian subproblems"
704 set ascSolv1Vect(lfreq) 10
705 set ascSolv1Vect(lfreq.page) 3
706 set ascSolv1Vect(lfreq.lo) 1
707 set ascSolv1Vect(lfreq.type) int
708 set ascSolv1Vect(lfreq.label) "Log frequency"
709 set ascSolv1Vect(minits) 40
710 set ascSolv1Vect(minits.page) 2
711 set ascSolv1Vect(minits.lo) 0
712 set ascSolv1Vect(minits.type) int
713 set ascSolv1Vect(minits.label) "Minor iterations limit"
714 set ascSolv1Vect(mulpr) 1
715 set ascSolv1Vect(mulpr.page) 2
716 set ascSolv1Vect(mulpr.lo) 0
717 set ascSolv1Vect(mulpr.type) int
718 set ascSolv1Vect(mulpr.label) "Multiple price"
719
720 set ascSolv1Vect(parpr) 0
721 set ascSolv1Vect(parpr.page) 2
722 set ascSolv1Vect(parpr.lo) 0
723 set ascSolv1Vect(parpr.type) int
724 set ascSolv1Vect(parpr.label) "Partial price"
725 set ascSolv1Vect(summary) 0
726 set ascSolv1Vect(summary.page) 3
727 set ascSolv1Vect(summary.type) bool
728 set ascSolv1Vect(summary.label) "Show PRINT output"
729 set ascSolv1Vect(filesumm) 0
730 set ascSolv1Vect(filesumm.page) 3
731 set ascSolv1Vect(filesumm.type) bool
732 set ascSolv1Vect(filesumm.label) "Save summary file"
733 set ascSolv1Vect(printJ) 0
734 set ascSolv1Vect(printJ.page) 3
735 set ascSolv1Vect(printJ.type) bool
736 set ascSolv1Vect(printJ.label) "Print jacobian"
737 set ascSolv1Vect(printF) 0
738 set ascSolv1Vect(printF.page) 3
739 set ascSolv1Vect(printF.type) bool
740 set ascSolv1Vect(printF.label) "Print nonlinear residuals"
741 set ascSolv1Vect(printL) 0
742 set ascSolv1Vect(printL.page) 3
743 set ascSolv1Vect(printL.type) bool
744 set ascSolv1Vect(printL.label) "Print multiplier estimates"
745 set ascSolv1Vect(printX) 0
746 set ascSolv1Vect(printX.page) 3
747 set ascSolv1Vect(printX.type) bool
748 set ascSolv1Vect(printX.label) "Print nonlinear variables"
749 set ascSolv1Vect(soln) 0
750 set ascSolv1Vect(soln.page) 3
751 set ascSolv1Vect(soln.type) bool
752 set ascSolv1Vect(soln.label) "Print solution"
753 set ascSolv1Vect(printB) 0
754 set ascSolv1Vect(printB.page) 3
755 set ascSolv1Vect(printB.type) bool
756 set ascSolv1Vect(printB.label) "Print basis stats"
757 set ascSolv1Vect(scale) 0
758 set ascSolv1Vect(scale.page) 4
759 set ascSolv1Vect(scale.type) bool
760 set ascSolv1Vect(scale.label) "Let minos scale, too"
761 set ascSolv1Vect(param) 0
762 set ascSolv1Vect(param.page) 3
763 set ascSolv1Vect(param.type) bool
764 set ascSolv1Vect(param.label) "Suppress parameter echo"
765 set ascSolv1Vect(verify) -1
766 set ascSolv1Vect(verify.page) 4
767 set ascSolv1Vect(verify.type) int
768 set ascSolv1Vect(verify.lo) -1
769 set ascSolv1Vect(verify.hi) 3
770 set ascSolv1Vect(verify.label) "Verify level"
771 set ascSolv1Vect(lcons) 1
772 set ascSolv1Vect(lcons.page) 3
773 set ascSolv1Vect(lcons.type) bool
774 set ascSolv1Vect(lcons.label) "Force nonlinearity"
775 set ascSolv1Vect(damp) 2.0
776 set ascSolv1Vect(damp.page) 2
777 set ascSolv1Vect(damp.type) real
778 set ascSolv1Vect(damp.lo) 0
779 set ascSolv1Vect(damp.label) "Major damping parameter"
780 set ascSolv1Vect(mindamp) 2.0
781 set ascSolv1Vect(mindamp.page) 2
782 set ascSolv1Vect(mindamp.type) real
783 set ascSolv1Vect(mindamp.lo) 0
784 set ascSolv1Vect(mindamp.label) "Minor damping parameter"
785 set ascSolv1Vect(fdiff) 0
786 set ascSolv1Vect(fdiff.page) 4
787 set ascSolv1Vect(fdiff.type) real
788 set ascSolv1Vect(fdiff.lo) 0
789 set ascSolv1Vect(fdiff.label) "Difference interval"
790 set ascSolv1Vect(cdiff) 0
791 set ascSolv1Vect(cdiff.page) 4
792 set ascSolv1Vect(cdiff.type) real
793 set ascSolv1Vect(cdiff.lo) 0
794 set ascSolv1Vect(cdiff.label) "Central difference interval"
795 set ascSolv1Vect(fprec) 1e-6
796 set ascSolv1Vect(fprec.page) 4
797 set ascSolv1Vect(fprec.type) real
798 set ascSolv1Vect(fprec.lo) 0
799 set ascSolv1Vect(fprec.label) "Function precision"
800 set ascSolv1Vect(lstol) "0.1"
801 set ascSolv1Vect(lstol.page) 2
802 set ascSolv1Vect(lstol.type) real
803 set ascSolv1Vect(lstol.lo) 0
804 set ascSolv1Vect(lstol.hi) 1
805 set ascSolv1Vect(lstol.label) "Linesearch tolerance"
806 set ascSolv1Vect(lufto) 10
807 set ascSolv1Vect(lufto.page) 2
808 set ascSolv1Vect(lufto.type) real
809 set ascSolv1Vect(lufto.lo) 1
810 set ascSolv1Vect(lufto.label) "LU factor tolerance"
811 set ascSolv1Vect(luuto) 10
812 set ascSolv1Vect(luuto.page) 2
813 set ascSolv1Vect(luuto.type) real
814 set ascSolv1Vect(luuto.lo) 1
815 set ascSolv1Vect(luuto.label) "LU update tolerance"
816 set ascSolv1Vect(luwto) 0
817 set ascSolv1Vect(luwto.page) 4
818 set ascSolv1Vect(luwto.type) real
819 set ascSolv1Vect(luwto.lo) 0
820 set ascSolv1Vect(luwto.label) "LU swap tolerance"
821 set ascSolv1Vect(lusto) 0
822 set ascSolv1Vect(lusto.page) 4
823 set ascSolv1Vect(lusto.type) real
824 set ascSolv1Vect(lusto.lo) 0
825 set ascSolv1Vect(lusto.label) "LU singularity tolerance"
826 set ascSolv1Vect(ludto) 0
827 set ascSolv1Vect(ludto.page) 4
828 set ascSolv1Vect(ludto.type) real
829 set ascSolv1Vect(ludto.lo) 0
830 set ascSolv1Vect(ludto.hi) 1
831 set ascSolv1Vect(ludto.label) "LU density tolerance"
832 set ascSolv1Vect(radius) 0.01
833 set ascSolv1Vect(radius.page) 2
834 set ascSolv1Vect(radius.type) real
835 set ascSolv1Vect(radius.lo) 0
836 set ascSolv1Vect(radius.label) "Radius of convergence"
837 set ascSolv1Vect(subsp) 0.5
838 set ascSolv1Vect(subsp.page) 2
839 set ascSolv1Vect(subsp.type) real
840 set ascSolv1Vect(subsp.lo) 0
841 set ascSolv1Vect(subsp.hi) 1
842 set ascSolv1Vect(subsp.label) "Subspace tolerance"
843 set ascSolv1Vect(objlim) 1e20
844 set ascSolv1Vect(objlim.page) 4
845 set ascSolv1Vect(objlim.type) real
846 set ascSolv1Vect(objlim.lo) 0
847 set ascSolv1Vect(objlim.label) "Unbounded obj. value"
848 set ascSolv1Vect(steplm) 1e10
849 set ascSolv1Vect(steplm.page) 4
850 set ascSolv1Vect(steplm.type) real
851 set ascSolv1Vect(steplm.lo) 0
852 set ascSolv1Vect(steplm.label) "Unbounded step size"
853 set ascSolv1Vect(lobjwt) 0
854 set ascSolv1Vect(lobjwt.page) 4
855 set ascSolv1Vect(lobjwt.type) real
856 set ascSolv1Vect(lobjwt.lo) 0
857 set ascSolv1Vect(lobjwt.label) "Weight on linear obj."
858 leavetrace
859 }
860
861 #
862 # proc set_Solv6_Defaults {}
863 # ----------------------------------------------------------------------
864 # keep me until we resurrect mps.
865 # set defaults for control of makeMPS, modified by CWS 5/95
866 # ----------------------------------------------------------------------
867 proc set_Solv6_Defaults {} {
868 entertrace
869 global ascSolv6Vect
870
871 # general parameters
872 set ascSolv6Vect(timelimit) 1000
873 set ascSolv6Vect(iterationlimit) 20
874 set ascSolv6Vect(termtol) 1e-12
875 set ascSolv6Vect(feastol) 1e-8
876 set ascSolv6Vect(pivottol) 0.01
877 set ascSolv6Vect(singtol) 1e-12
878 set ascSolv6Vect(stattol) 1e-6
879 set ascSolv6Vect(rho) 100
880 set ascSolv6Vect(partition) 0
881 set ascSolv6Vect(ignorebounds) 0
882 set ascSolv6Vect(showmoreimportant) 1
883 set ascSolv6Vect(showlessimportant) 0
884 set ascSolv6Vect(bppivoting) 0
885
886 # subparameters
887 # solve nonlinear model by linearizing at current point
888 set ascSolv6Vect(nonlin) 0
889 set ascSolv6Vect(relaxed) 0
890 set ascSolv6Vect(nonneg) 0
891 set ascSolv6Vect(obj) 0
892 set ascSolv6Vect(binary) 0
893 set ascSolv6Vect(integer) 0
894 set ascSolv6Vect(semi) 0
895 set ascSolv6Vect(sos1) 0
896 set ascSolv6Vect(sos2) 0
897 set ascSolv6Vect(sos3) 0
898 set ascSolv6Vect(bo) 0
899 set ascSolv6Vect(eps) 0
900 set ascSolv6Vect(boval) ""
901 set ascSolv6Vect(epsval) ""
902 # Note: pinf and minf should be entered by the user, instead of being
903 # hard coded in
904 set ascSolv6Vect(pinf) 1e+20
905 set ascSolv6Vect(minf) -1e+20
906 set ascSolv6Vect(filename) output.mps
907
908
909 # dialog variables
910
911 set ascSolv6Vect(SOS) 0
912 # filename is what appears in dialog, expandname is exapanded ~/*.mps, etc.
913 set {ascSolv6Vect(expandname)} {output.mps}
914 set {ascSolv6Vect(solver)} {QOMILP}
915
916 # set {symbolicName(ascSolv6Vect(help))} {.mps.frame14.button3}
917 # set {symbolicName(ascSolv6Vect(makemps))} {.mps.frame14.button1}
918 # set {symbolicName(ascSolv6Vect(ok))} {.mps.frame14.button0}
919 # set {symbolicName(ascSolv6Vect(run))} {.mps.frame14.button2}
920
921 # dialogup true when dialog is visible
922 set ascSolv6Vect(dialogup) 0
923
924 # massaged, expanded filenames
925 set ascSolv6Vect(mpsname) output.mps
926 set ascSolv6Vect(mapname) output.map
927 set ascSolv6Vect(errname) output.err
928 set ascSolv6Vect(outname) output.out
929
930 leavetrace
931 }
932
933
934 # can we delete this?
935 # proc set_Solv9a_Defaults {}
936 # ----------------------------------------------------------------------
937 # set defaults for control of LRSlv
938 # ----------------------------------------------------------------------
939 proc set_Solv9a_Defaults {} {
940 entertrace
941 global ascSolv9aVect
942 # LRSlv parameter page setup variables
943 set ascSolv9aVect(namelist) [showlessimportant timelimit \
944 iterationlimit autoresolve]
945 set ascSolv9aVect(toplevel) .slv9aparms
946 set ascSolv9aVect(title) "LRSlv Parameters"
947 set ascSolv9aVect(maxlines) 12
948 set ascSolv9aVect(npages) 2
949 set ascSolv9aVect(grab) 0
950 set ascSolv9aVect(helpcommand) "Help_button solver.LRSlv.parameters"
951 set ascSolv9aVect(whenokcommand) "Solve_do_Parms close LRSlv"
952 # not window page supported Slv parms
953 set ascSolv9aVect(showmoreimportant) "1"
954 set ascSolv9aVect(showlessimportant) "1"
955 set ascSolv9aVect(showlessimportant.page) 2
956 set ascSolv9aVect(showlessimportant.type) bool
957 set ascSolv9aVect(showlessimportant.label) "detailed solving info"
958 set ascSolv9aVect(autoresolve) "1"
959 set ascSolv9aVect(autoresolve.page) 2
960 set ascSolv9aVect(autoresolve.type) bool
961 set ascSolv9aVect(autoresolve.label) auto-resolve
962 set ascSolv9aVect(timelimit) "1500"
963 set ascSolv9aVect(timelimit.type) int
964 set ascSolv9aVect(timelimit.lo) 1
965 set ascSolv9aVect(timelimit.label) "time limit (CPU sec/block)"
966 set ascSolv9aVect(iterationlimit) "30"
967 set ascSolv9aVect(iterationlimit.lo) 1
968 set ascSolv9aVect(iterationlimit.type) int
969 set ascSolv9aVect(iterationlimit.label) "max iterations/block"
970 leavetrace
971 }
972
973
974
975 #
976 #----------------------------------------------------------------------------
977 # Direct callbacks section. procedures are all Solve_do_* and are supposed #
978 # to pertain to the .solver window and environs. Debugger is separated. #
979 # mtxview is separated also. #
980 #----------------------------------------------------------------------------
981
982 #
983 # proc Solve_do_Select {name}
984 #----------------------------------------------------------------------------
985 # Solver Selection buttons action #
986 # If system not empty, downdates control parameters and calls presolve #
987 # does not check sanity of selection wrt problem. #
988 #----------------------------------------------------------------------------
989 proc Solve_do_Select {name} {
990 entertrace
991 global ascSolvVect ascSolvStatVect
992 if { $ascSolvVect($name) == -1 } {
993 puts " Solver $name not available"
994 leavetrace
995 return
996 }
997 set ascSolvStatVect(solver) $name
998 set ascSolvStatVect(solvernum) $ascSolvVect($name)
999 # KHACK: only need to select solver if different from current solver
1000 if {[slv_checksys]} {
1001 if {$name != [Solve_do_SolverCur]} {
1002 slv_select_solver $ascSolvStatVect(solvernum)
1003 }
1004 if {[catch {slv_presolve} ]} {
1005 Solve_FP_error "Initial values,cause float error.,Please fix this."
1006 }
1007 }
1008 Solve_Update_StatusBox
1009 leavetrace
1010 }
1011
1012 #
1013 # proc Solve_Close_Slaves {}
1014 #----------------------------------------------------------------------------
1015 # shut down windows dependent on solve system presence: debug, mtx, debug2
1016 #----------------------------------------------------------------------------
1017 proc Solve_Close_Slaves {} {
1018 entertrace
1019 global ascSolvVect
1020 if {$ascSolvVect(debuggerup)} {
1021 Solve_CloseDebugger
1022 }
1023 if {$ascSolvVect(mtxup)} {
1024 Solve_CloseMtx
1025 }
1026 leavetrace
1027 }
1028 #
1029 # proc Solve_do_Flush {args}
1030 #----------------------------------------------------------------------------
1031 # Solve RemoveInstance (Flush solver) #
1032 # If any args are supplied the HUB is not notified of the flush. #
1033 # This makes for a neater looking script when a call which is #
1034 # being recorded calls this function. #
1035 #----------------------------------------------------------------------------
1036 proc Solve_do_Flush {args} {
1037 entertrace
1038 global ascSolvVect ascSolvStatVect
1039 Solve_Close_Slaves
1040 slv_flush_solver
1041 Solve_destroy_monitors
1042 if {[llength $args] == 0} {
1043 HUB_Message_to_HUB SYSFLUSH
1044 }
1045 set ascSolvStatVect(empty) 1
1046 set ascSolvVect(instname) ""
1047 set ascSolvVect(objvarname) ""
1048 set ascSolvVect(simname) ""
1049 Solve_Update_StatusBox
1050 Solve_Update_Listbox
1051 Solve_Update_MenuBar
1052 leavetrace
1053 }
1054
1055 #
1056 # proc Solve_do_Select_Objective {}
1057 #----------------------------------------------------------------------------
1058 # Select Objective variable #
1059 # list select from free variable list and objs list #
1060 # This needs to be updated to cope with objective vars.
1061 # u_getval and slv_set_objective_var should be useful.
1062 #----------------------------------------------------------------------------
1063 proc Solve_do_Select_Objective {} {
1064 entertrace
1065 if {![slv_checksys]} {leavetrace; return}
1066 Solve_Find_Objectives 1
1067 leavetrace
1068 }
1069
1070 #
1071 # proc Solve_do_Display_Status {}
1072 #----------------------------------------------------------------------------
1073 # Displays solver status button box, #
1074 #----------------------------------------------------------------------------
1075 proc Solve_do_Display_Status {} {
1076 entertrace
1077 global ascGlobalVect
1078
1079 Solve_Update_StatusBox
1080 Solve_Status_Infobox
1081 leavetrace
1082 }
1083
1084 #
1085 # proc Solve_do_Spreadsheet {}
1086 #----------------------------------------------------------------------------
1087 # Display spreadsheet. dumps vars/relations to file #
1088 # rather low priority #
1089 #----------------------------------------------------------------------------
1090 proc Solve_do_Spreadsheet {} {
1091 entertrace
1092 puts "Not yet implemented"
1093 leavetrace
1094 }
1095
1096 #
1097 # proc Solve_do_DispUnattached {}
1098 #----------------------------------------------------------------------------
1099 # Display unattached vars #
1100 #----------------------------------------------------------------------------
1101 proc Solve_do_DispUnattached {} {
1102 entertrace
1103 global ascSolvVect
1104 puts stderr "Unattached variables in $ascSolvVect(instname):"
1105 dbg_write_unattvar 1 $ascSolvVect(simname)
1106 leavetrace
1107 }
1108
1109
1110 #
1111 # proc Solve_do_DispUnincluded {}
1112 #----------------------------------------------------------------------------
1113 # Display unincluded relations #
1114 #----------------------------------------------------------------------------
1115 proc Solve_do_DispUnincluded {} {
1116 entertrace
1117 global ascSolvVect
1118 puts stderr "Unincluded relations in $ascSolvVect(instname):"
1119 foreach i [dbg_list_rels 1 not] {
1120 dbg_write_rel 0 $i 0 $ascSolvVect(simname)
1121 }
1122 leavetrace
1123 }
1124
1125 #
1126 # proc Solve_do_DispIncidence {}
1127 #----------------------------------------------------------------------------
1128 # Display incidence matrix #
1129 #----------------------------------------------------------------------------
1130 proc Solve_do_DispIncidence {} {
1131 entertrace
1132 global ascSolvStatVect
1133 if {$ascSolvStatVect(empty)} {
1134 Solve_CloseMtx
1135 } else {
1136 if {![slv_checksys]} {leavetrace; return}
1137 Solve_OpenMtx
1138 }
1139 leavetrace
1140 }
1141
1142 #
1143 # proc Solve_do_Solve {}
1144 #----------------------------------------------------------------------------
1145 # Solve button #
1146 #----------------------------------------------------------------------------
1147 proc Solve_do_Solve {} {
1148 entertrace
1149 if {![slv_checksys]} {
1150 return
1151 }
1152 Solve_monitor_init
1153 Solve_Solve
1154 Solve_Status_Infobox
1155 leavetrace
1156 }
1157
1158 #
1159 # proc Solve_do_Iterate {}
1160 #----------------------------------------------------------------------------
1161 # Single step button #
1162 #----------------------------------------------------------------------------
1163 proc Solve_do_Iterate {} {
1164 entertrace
1165 if {![slv_checksys]} {leavetrace; return }
1166 Solve_Iterate
1167 leavetrace
1168 }
1169
1170 #
1171 # proc Solve_do_Integrate {}
1172 #----------------------------------------------------------------------------
1173 # Integration button #
1174 #----------------------------------------------------------------------------
1175 proc Solve_do_Integrate {} {
1176 entertrace
1177 if {![slv_checksys]} {leavetrace; return }
1178 Solve_Integrate
1179 leavetrace
1180 }
1181
1182 #
1183 # proc Solve_do_Optimize {}
1184 #----------------------------------------------------------------------------
1185 # Optimization button #
1186 #----------------------------------------------------------------------------
1187 proc Solve_do_Optimize {} {
1188 entertrace
1189 Solve_Optimize
1190 Solve_Status_Infobox
1191 leavetrace
1192 }
1193
1194 #
1195 # proc Solve_do_Debug {}
1196 #----------------------------------------------------------------------------
1197 # Debugger button #
1198 #----------------------------------------------------------------------------
1199 proc Solve_do_Debug {} {
1200 entertrace
1201 if {![slv_checksys]} { leavetrace; return }
1202 global ascSolvVect
1203 set_Debug_Defaults
1204 if {!$ascSolvVect(debuggerup)} {
1205 Solve_OpenDebugger
1206 } else {
1207 Solve_CloseDebugger
1208 Solve_OpenDebugger
1209 }
1210 .debug configure -cursor left_ptr
1211 leavetrace
1212 }
1213
1214 #
1215 # proc Solve_do_Overspecified {}
1216 #----------------------------------------------------------------------------
1217 # Overspecified Button #
1218 #----------------------------------------------------------------------------
1219 proc Solve_do_Overspecified {} {
1220 entertrace
1221 Solve_FindOverspec 1
1222 leavetrace
1223 }
1224 #
1225 # proc Solve_FindOverspec {refresh}
1226 #----------------------------------------------------------------------------
1227 # Overspecified internals if refresh 1 update status after free #
1228 #----------------------------------------------------------------------------
1229 proc Solve_FindOverspec {refresh} {
1230 entertrace
1231 global ascListSelectBox ascSolvVect
1232 set list ""
1233 catch {set list [lindex [dbg_struct_singular 2 -1] 2]}
1234 set ascListSelectBox(grab) 1
1235 set ascListSelectBox(btn3name) ""
1236 set ascListSelectBox(btn4name) ""
1237 set ascListSelectBox(btn5name) ""
1238 set ascListSelectBox(btn3destroy) 1
1239 set ascListSelectBox(btn4destroy) 0
1240 set ascListSelectBox(btn4command) ""
1241 set ascListSelectBox(title) "Overspecified"
1242 set ascListSelectBox(toplevelname) ".solvoverspec"
1243 set ascListSelectBox(font) $ascSolvVect(font)
1244 set ascListSelectBox(selectmode) browse
1245 set ascListSelectBox(headline) "Select to free one of:"
1246 set newlist ""
1247 set pname [slv_get_pathname]
1248 foreach i $list {
1249 lappend newlist "$pname.[stripbraces [dbg_write_var 2 $i 0 0]]"
1250 }
1251 if {$newlist==""} {
1252 if {!$refresh} {
1253 puts stderr "No variables to free."
1254 Solve_do_StrucDepends
1255 }
1256 leavetrace; return
1257 }
1258 set alist [lsort $newlist]
1259 set button [AscListSelectBox $alist \
1260 250x240[setpos .solver 50 20]]
1261 if {$button==2} {
1262 leavetrace
1263 return
1264 }
1265 Solve_OverListSelect $refresh
1266
1267 leavetrace
1268 }
1269
1270 #
1271 # proc Solve_do_NumDepends
1272 #----------------------------------------------------------------------------
1273 # Numeric Dependency Button #
1274 #----------------------------------------------------------------------------
1275 proc Solve_do_NumDepends {} {
1276 entertrace
1277 Solve_Check_RowsPivoted 1
1278 leavetrace
1279 }
1280
1281 #
1282 # proc Solve_do_StrucDepends {}
1283 #----------------------------------------------------------------------------
1284 # Structural Dependency Button #
1285 #----------------------------------------------------------------------------
1286 proc Solve_do_StrucDepends {} {
1287 entertrace
1288
1289 set slist [Solve_get_unassigned_rels]
1290 if {$slist==""} {
1291 puts stderr "There are no unassignable relations."
1292 leavetrace; return
1293 }
1294 #leavetrace; return
1295 # need to box this up.
1296 foreach rel $slist {
1297 set vr [dbg_struct_singular 2 $rel]
1298 set rl [lindex $vr 0]
1299 set vl [lindex $vr 1]
1300 set fl [lindex $vr 2]
1301 puts stdout ""
1302 puts stdout "Unassignable relation [stripbraces [dbg_write_rel 2 $rel 0]]"
1303 puts stdout "is in the structurally singular group:"
1304 foreach i $rl {puts "<$i> [stripbraces [dbg_write_rel 2 $i 0]]"}
1305 if {[llength $vl] > 0} {
1306 puts stdout "This singularity involves variables:"
1307 foreach i $vl {puts stdout "<$i> [stripbraces [dbg_write_var 2 $i 0 0]]"}
1308 }
1309 if {[llength $fl] >0} {
1310 puts stdout "This singularity is reduced by freeing a variable from:"
1311 foreach i $fl {puts stdout "<$i> [stripbraces [dbg_write_var 2 $i 0 0]]"}
1312 }
1313 }
1314 leavetrace
1315 }
1316
1317 #
1318 # proc Solve_Find_Near_Bounds {}
1319 #----------------------------------------------------------------------------
1320 # Near Bounds button. #
1321 # if refresh then update status/presolve after fix #
1322 #----------------------------------------------------------------------------
1323 proc Solve_Find_Near_Bounds {} {
1324 entertrace
1325 if {![slv_checksys]} {leavetrace; return}
1326 global ascSolv32767Vect
1327 set list ""
1328 catch {set list [lindex [slv_near_bounds $ascSolv32767Vect(nearbound) 2] 0]}
1329 set low_violations [lindex $list 0]
1330 set up_violations [lindex $list 1]
1331 set count 2
1332 set pname [slv_get_pathname]
1333 if {$low_violations == 0 && $up_violations == 0} {
1334 puts "\nNO VARS NEAR BOUNDS\n"
1335 }
1336 if {$low_violations > 0} {
1337 puts "\nVARIABLES NEAR LOWER BOUND:"
1338 }
1339 for {set j 0} {$j < $low_violations} {incr j} {
1340 set i [lindex $list $count]
1341 puts "$pname.[stripbraces [dbg_write_var 2 $i 0 0]]"
1342 incr count
1343 }
1344 if {$up_violations > 0} {
1345 puts "\nVARIABLES NEAR UPPER BOUND:"
1346 }
1347 for {set j 0} {$j < $up_violations} {incr j} {
1348 set i [lindex $list $count]
1349 puts "$pname.[stripbraces [dbg_write_var 2 $i 0 0]]"
1350 incr count
1351 }
1352
1353 leavetrace
1354 }
1355
1356
1357 #
1358 # proc Solve_Find_Far_From_Nominals {}
1359 #----------------------------------------------------------------------------
1360 # Far From Nominals button. #
1361 # if refresh then update status/presolve after fix #
1362 #----------------------------------------------------------------------------
1363 proc Solve_Find_Far_From_Nominals {} {
1364 entertrace
1365 if {![slv_checksys]} {leavetrace; return}
1366 global ascSolv32767Vect
1367 set list ""
1368 catch {
1369 set list [lindex [slv_far_from_nominals $ascSolv32767Vect(farnom) 2] 0]
1370 }
1371 set pname [slv_get_pathname]
1372 set length [llength $list]
1373 if {$length == 0} {
1374 puts "\nNO VARS FAR FROM NOMINAL VALUE\n"
1375 return
1376 }
1377 puts "VARIABLES FAR FROM NOMINALS:"
1378 for {set j 0} {$j < $length} {incr j} {
1379 set i [lindex $list $j]
1380 puts "$pname.[stripbraces [dbg_write_var 2 $i 0 0]]"
1381 }
1382 leavetrace
1383 }
1384
1385 #
1386 # proc Solve_do_FindUnAssEqns {}
1387 #----------------------------------------------------------------------------
1388 # Find unassigned eqns Button. unincluded eqns don't count. #
1389 #----------------------------------------------------------------------------
1390 proc Solve_do_FindUnAssEqns {} {
1391 entertrace
1392 if {![slv_checksys]} { leavetrace; return }
1393 global ascSolvVect
1394 puts stderr \
1395 "Included but unpartitioned relations in $ascSolvVect(instname):"
1396 set shlist [Solve_get_unassigned_rels]
1397 foreach i $shlist {
1398 dbg_write_rel 0 $i 2 $ascSolvVect(simname)
1399 }
1400 if {$shlist==""} {
1401 puts stdout "All included equations have been assigned."
1402 }
1403 leavetrace
1404 }
1405
1406 #
1407 # proc Solve_do_EvalUnincluded {}
1408 #----------------------------------------------------------------------------
1409 # evaluate unincluded equations #
1410 #----------------------------------------------------------------------------
1411 proc Solve_do_EvalUnincluded {} {
1412 entertrace
1413 global ascSolvVect
1414 puts stderr "Unincluded relations in $ascSolvVect(instname):"
1415 foreach i [dbg_list_rels 1 not] {
1416 dbg_write_rel 0 $i 2 $ascSolvVect(simname)
1417 }
1418 leavetrace
1419 }
1420
1421 #
1422 # proc Solve_do_Export2Browser {}
1423 #----------------------------------------------------------------------------
1424 # export instance to browser #
1425 #----------------------------------------------------------------------------
1426 proc Solve_do_Export2Browser {} {
1427 entertrace
1428 global ascSolvVect
1429 Brow_Export_Any_2Browser $ascSolvVect(instname)
1430 leavetrace
1431 }
1432
1433 #
1434 # proc Solve_do_Export2Probe {}
1435 #----------------------------------------------------------------------------
1436 # export instance to probe #
1437 #----------------------------------------------------------------------------
1438 proc Solve_do_Export2Probe {} {
1439 entertrace
1440 global ascSolvVect
1441 PROBE ALL $ascSolvVect(instname)
1442 leavetrace
1443 }
1444
1445 #
1446 # proc Solve_do_Interrupt {}
1447 #----------------------------------------------------------------------------
1448 # interrupt button #
1449 #----------------------------------------------------------------------------
1450 proc Solve_do_Interrupt {} {
1451 entertrace
1452 global ascSolvStatVect
1453 if { ! $ascSolvStatVect(empty) } {
1454 set ascSolvStatVect(menubreak) 1
1455 slv_set_haltflag 1
1456 }
1457 leavetrace
1458 }
1459
1460 #
1461 # proc Solve_do_Help
1462 #----------------------------------------------------------------------------
1463 # help button #
1464 #----------------------------------------------------------------------------
1465 proc Solve_do_Help {} {
1466 Help_button solver
1467 }
1468
1469 #
1470 # proc Solve_do_Credit {solver}
1471 #----------------------------------------------------------------------------
1472 # credits button for solver codes #
1473 #----------------------------------------------------------------------------
1474 proc Solve_do_Credit {solver} {
1475 entertrace
1476 switch $solver {
1477 {slv} {Help_button solver.credits slv
1478 leavetrace; return}
1479 {minos} {Help_button solver.credits minos
1480 leavetrace; return}
1481 {opt _opt} {Help_button solver.credits opt
1482 leavetrace; return}
1483 {lsode} {Help_button solver.credits lsode
1484 leavetrace; return}
1485 {lsgrg} {Help_button solver.credits lsgrg
1486 leavetrace; return}
1487 {qrslv} {Help_button solver.credits qrslv
1488 leavetrace; return}
1489 {ngslv} {Help_button solver.credits ngslv
1490 leavetrace; return}
1491 {dslv} {Help_button solver.credits dslv
1492 leavetrace; return}
1493 {makemps} {Help_button solver.credits makemps
1494 leavetrace; return}
1495 {conopt} {Help_button solver.credits conopt
1496 leavetrace; return}
1497 default {puts "credits not yet implemented for $solver"}
1498 }
1499 # endswtich
1500 leavetrace
1501 }
1502
1503 #
1504 # proc Solve_do_Reanalyze {}
1505 #----------------------------------------------------------------------------
1506 # import qlfdid name, if eligible. #
1507 # strip trailing . if needed #
1508 #----------------------------------------------------------------------------
1509 proc Solve_do_Reanalyze {} {
1510 entertrace
1511 global ascSolvStatVect ascSolvVect
1512 if { ! [slv_checksys] } { leavetrace; return 0 }
1513 # cant import from a null system
1514 set tname $ascSolvVect(instname)
1515 leavetrace; return [Solve_Import_Any $tname]
1516 leavetrace
1517 }
1518
1519 #
1520 # proc Solve_do_Import {}
1521 #----------------------------------------------------------------------------
1522 # import qlfdid name, if eligible. #
1523 # strip trailing . if needed #
1524 #----------------------------------------------------------------------------
1525 proc Solve_do_Import {} {
1526 entertrace
1527 global ascSolvStatVect ascSolvVect
1528 if { ! [slv_checksys] } {
1529 leavetrace
1530 return 0
1531 }
1532 # cant import from a null system
1533 set tname [string trim $ascSolvVect(pathname)]
1534 set tname [string trim $tname .]
1535 leavetrace; return [Solve_Import_Any $tname]
1536 leavetrace
1537 }
1538
1539 #
1540 #----------------------------------------------------------------------------
1541 # button internals section. includes parm page procedures, named as #
1542 # Solve_XXX_* where XXX is the 3 letter solver code in all caps. #
1543 #----------------------------------------------------------------------------
1544
1545
1546 #
1547 # proc Solve_EligListSelect {refresh}
1548 #-------------------------------------------------------------------------
1549 # fixes first of any variables selected. if refresh, updates screen #
1550 #-------------------------------------------------------------------------
1551 proc Solve_EligListSelect {refresh} {
1552 entertrace
1553 global ascListSelectBox
1554 set list $ascListSelectBox(itemselected)
1555 if {$list != ""} {
1556 set item [lindex $list 0]
1557 qassgn3 $item.fixed TRUE
1558 HUB_Message_to_HUB BOOLEANUPDATED $item
1559 if {$refresh} {
1560 slv_presolve
1561 Solve_Update_StatusBox
1562 update
1563 Solve_FindEligible 1
1564 }
1565 } else {
1566 Solve_Alert "Input Error" "Make selection or, choose Cancel"
1567 if {$refresh} {
1568 Solve_FindEligible 1
1569 }
1570 }
1571 leavetrace
1572 }
1573
1574 #
1575 # proc Solve_GlobalEligListSelect {refresh}
1576 #-------------------------------------------------------------------------
1577 # fixes first of any variables selected. if refresh, updates screen #
1578 #-------------------------------------------------------------------------
1579 proc Solve_GloablEligListSelect {refresh} {
1580 entertrace
1581 global ascListSelectBox
1582 set list $ascListSelectBox(itemselected)
1583 if {$list != ""} {
1584 set item [lindex $list 0]
1585 qassgn3 $item.fixed TRUE
1586 HUB_Message_to_HUB BOOLEANUPDATED $item
1587 if {$refresh} {
1588 slv_presolve
1589 Solve_Update_StatusBox
1590 update
1591 Solve_FindGlobalEligible 1
1592 }
1593 } else {
1594 Solve_Alert "Input Error" "Make selection or, choose Cancel"
1595 if {$refresh} {
1596 Solve_FindGlobalEligible 1
1597 }
1598 }
1599 leavetrace
1600 }
1601
1602 #
1603 # proc Solve_FixConsistentSet
1604 #-------------------------------------------------------------------------
1605 # Selection of the consistent set of varaibles. It fixes all of the
1606 # variables selected
1607 #-------------------------------------------------------------------------
1608 proc Solve_FixConsistentSet {} {
1609 entertrace
1610 global ascListSelectB1Box
1611 set list $ascListSelectB1Box(itemselected)
1612 if {$list != ""} {
1613 foreach i $list {
1614 qassgn3 $i.fixed TRUE
1615 }
1616 set item [lindex $list 0]
1617 HUB_Message_to_HUB BOOLEANUPDATED $item
1618 slv_presolve
1619 Solve_Update_StatusBox
1620 update
1621 } else {
1622 Solve_Alert "Input Error" "Make Selection or Choose Dismiss"
1623 }
1624 newraise .solvconsistent
1625 leavetrace
1626 }
1627
1628
1629 #
1630 # proc Solve_ConsistentListSelect {refresh}
1631 #-------------------------------------------------------------------------
1632 # fixes all of the variables selected. if refresh, updates screen
1633 # It works with an SelectBox instead of a SelectB1Box (function of
1634 # above )
1635 #-------------------------------------------------------------------------
1636 proc Solve_ConsistentListSelect {refresh} {
1637 entertrace
1638 global ascListSelectBox
1639 set list $ascListSelectBox(itemselected)
1640 if {$list != ""} {
1641
1642 set length [llength $list]
1643 if {$length == 0} {
1644 return
1645 }
1646
1647 for {set j 0} {$j < $length} {incr j} {
1648 set item [lindex $list $j]
1649 qassgn3 $item.fixed TRUE
1650 }
1651
1652 set item [lindex $list 0]
1653 HUB_Message_to_HUB BOOLEANUPDATED $item
1654
1655 if {$refresh} {
1656 slv_presolve
1657 Solve_Update_StatusBox
1658 update
1659 }
1660 } else {
1661 Solve_Alert "Input Error" "Select all or Choose Cancel"
1662 }
1663 leavetrace
1664 }
1665
1666
1667 #
1668 # proc Solve_OverListSelect {refresh}
1669 #-------------------------------------------------------------------------
1670 # frees first of any variables selected. if refresh,updates screen.
1671 #-------------------------------------------------------------------------
1672 proc Solve_OverListSelect {refresh} {
1673 entertrace
1674 global ascListSelectBox
1675 set list $ascListSelectBox(itemselected)
1676 if {$list != ""} {
1677 set item [lindex $list 0]
1678 qassgn3 $item.fixed FALSE
1679 HUB_Message_to_HUB BOOLEANUPDATED $item
1680 if {$refresh} {
1681 slv_presolve
1682 Solve_Update_StatusBox
1683 update
1684 }
1685 Solve_FindOverspec 1
1686 } else {
1687 Solve_Alert "Input Error" "Make selection or, choose Cancel"
1688 Solve_FindOverspec 1
1689 }
1690 leavetrace
1691 }
1692
1693 #
1694 # proc Solve_GetObjeRelNum {name}
1695 #-------------------------------------------------------------------------
1696 # returns the solver list number of the objective which qlfdid 'name' #
1697 # returns -1 if name is "none" and -2 if name not on list #
1698 #-------------------------------------------------------------------------
1699 proc Solve_GetObjRelNum {name} {
1700 entertrace
1701 if {[string match "none" $name]} {
1702 leavetrace
1703 return -1
1704 }
1705 set list ""
1706 catch {set list [lindex [slv_get_obj_list 2] 0]}
1707 set pname [slv_get_pathname]
1708 foreach i $list {
1709 if {[string match \
1710 "$pname.[stripbraces [dbg_write_obj 2 $i 0]]" \
1711 $name]} {
1712 leavetrace
1713 return $i
1714 }
1715 }
1716 return -2
1717 leavetrace
1718 }
1719
1720 #
1721 # proc Solve_ObjListSelect {refresh}
1722 #-------------------------------------------------------------------------
1723 # sets solvers objective to the selected objective function #
1724 #-------------------------------------------------------------------------
1725 proc Solve_ObjListSelect {refresh} {
1726 entertrace
1727 global ascListSelectBox
1728 set list $ascListSelectBox(itemselected)
1729 if {$list != ""} {
1730 set item [lindex $list 0]
1731 set obj_num [Solve_GetObjRelNum $item]
1732 if {$obj_num == -2} {
1733 Solve_Alert "Unexpected Error in Solve_ObjListSelect" \
1734 "choose Cancel and send bug report"
1735 if {$refresh} {
1736 Solve_Find_Objectives 1
1737 }
1738 } else {
1739 set cur_obj_num [slv_get_obj_num 2]
1740 if {$cur_obj_num != $obj_num} {
1741 catch {slv_set_obj_by_num $obj_num}
1742 # may be able to get away without a full presolve when switching objective
1743 # but just go with the full thing for now
1744 catch {slv_presolve}
1745 }
1746 }
1747 } else {
1748 Solve_Alert "Input Error" "Make selection or, choose Cancel"
1749 if {$refresh} {
1750 Solve_Find_Objectives 1
1751 }
1752 }
1753 leavetrace
1754 }
1755
1756
1757 #
1758 # proc Solve_get_unassigned_rels {}
1759 #----------------------------------------------------------------------------
1760 # leavetrace; return a list of indexes of all unassigned, but included,
1761 # relations.
1762 #----------------------------------------------------------------------------
1763 proc Solve_get_unassigned_rels {} {
1764 entertrace
1765 set rlist "[dbg_list_rels 4]"
1766 if {$rlist==""} {
1767 leavetrace
1768 return ""
1769 }
1770 # if nobody assigned, not an assigning solver.
1771 set rlist [dbg_list_rels 4 not]
1772 set uilist [dbg_list_rels 1 not]
1773 set shlist ""
1774 foreach i $rlist {
1775 if {[lsearch $uilist $i]=="-1"} {
1776 lappend shlist $i
1777 }
1778 }
1779 leavetrace
1780 leavetrace; return $shlist
1781 }
1782
1783 #
1784 # proc Solve_Running {n1 n2 mode}
1785 #----------------------------------------------------------------------------
1786 # put the wings and colors on and off the shoes.
1787 # ignores the arguments.
1788 #----------------------------------------------------------------------------
1789 proc Solve_Running {n1 n2 mode} {
1790 entertrace
1791 global ascSolvStatVect
1792 if {$ascSolvStatVect(running)} {
1793 .solver.lbl_frm.lbl_run configure -bitmap wfeet -background green
1794 .solver.lbl_frm.lbl_int configure -background red
1795 .solver.lbl_frm.btn_int configure -background red
1796 } else {
1797 set color [.solver.lbl_frm cget -background]
1798 .solver.lbl_frm.lbl_run configure -bitmap feet -background $color
1799 .solver.lbl_frm.lbl_int configure -background $color
1800 .solver.lbl_frm.btn_int configure -background $color
1801 }
1802 leavetrace
1803 }
1804 #
1805 # proc Solve_Import_Any {qlfdid}
1806 #----------------------------------------------------------------------------
1807 # load qlfdid into the solver, if possible.
1808 # Not possible if:
1809 # - type inappropriate (not model) or not safe (nulls,pendings found)
1810 # - this function called during an interface update called from
1811 # within a non-iterable solver (a halt button check).
1812 # - called with qlfdid==""
1813 # Leavetrace; Returns 0 if succesful, 1 if not. If not, reason will be left in
1814 # global variable ascSolvStatVect(importerror).
1815 #
1816 # Anyone trying to load the solver from anywhere besides here is likely
1817 # to cause errors.
1818 # The sanity this affords far outweighs the cost of the qlfdid search.
1819 #----------------------------------------------------------------------------
1820 proc Solve_Import_Any {qlfdid} {
1821 entertrace
1822 global ascSolvVect ascSolvStatVect
1823
1824 # check running
1825 if {$ascSolvStatVect(running)=="1"} {
1826 puts stderr "Solve in progress."
1827 set sherrmsg "Solve in progress. Cannot import until done or halted."
1828 set halt [asctk_dialog .solvhalt $ascSolvVect(font) \
1829 "Solver Alert:" $sherrmsg "" 1 OK Halt]
1830 if {$halt} {
1831 set ascSolvStatVect(menubreak) 1
1832 slv_set_haltflag 1
1833 }
1834 set ascSolvStatVect(importerror) "Solver is running."
1835 leavetrace; return 1
1836 }
1837 # check qlfdid
1838 if {$qlfdid==""} {
1839 Solve_do_Flush;
1840 set ascSolvStatVect(importerror) "Import called with empty argument."
1841 leavetrace; return 1
1842 }
1843 set ascSolvStatVect(menubreak) 0
1844 slv_set_haltflag 0
1845 set notok [slv_import_qlfdid $qlfdid test]
1846 if {$notok} {
1847 set ascSolvStatVect(importerror) "Instance not a complete model instance."
1848 leavetrace; return 1
1849 }
1850 # set simname
1851 set ascSolvVect(simname) [lindex [split $qlfdid .] 0]
1852 if {$ascSolvVect(visibility)} {
1853 newraise $ascSolvVect(windowname)
1854 }
1855 # import valid system: builds rel/var/obj lists
1856 slv_import_qlfdid $qlfdid
1857 set ascSolvVect(instname) "[slv_get_pathname]"
1858 # put last sets of used parameters into C vect
1859 Solve_Downdate_ParmBox
1860 # verify dimensionality
1861 Solve_Check_Dimensions
1862 # find appropriate solver
1863 Solve_Check_Eligible
1864 # get chosen solver. will be last one used if last one was eligible.
1865 # also presolves, sets status flags
1866 Solve_do_Select $ascSolvStatVect(solver)
1867 # over/under
1868 Solve_Check_DOF
1869 #
1870 # Update active flag of relations
1871 #
1872 Solve_FlagActive
1873 Solve_Update_StatusBox
1874 # redraw windows
1875 Solve_Update_Listbox
1876 Solve_Update_MenuBar
1877 catch {Solve_Update_Slaves}
1878 leavetrace; return 0
1879 leavetrace
1880 }
1881
1882
1883 #
1884 # proc Solve_Update_Slaves {}
1885 #----------------------------------------------------------------------------
1886 # update auxillary windows: debugger, mtx, debugger2
1887 #----------------------------------------------------------------------------
1888 proc Solve_Update_Slaves {} {
1889 entertrace
1890 global ascSolvVect
1891 if {$ascSolvVect(debuggerup)} {
1892 Debug_Trace on
1893 }
1894 if {$ascSolvVect(mtxup)} {
1895 Solve_do_DispIncidence
1896 }
1897 leavetrace
1898 }
1899 #
1900 # proc Solve_Check_Block_Err {}
1901 #----------------------------------------------------------------------------
1902 # Compute the sum and max of block residuals.
1903 # Compute the sum and max of block times.
1904 # Compute the sum of function and jacobian times.
1905 #----------------------------------------------------------------------------
1906 proc Solve_Check_Block_Err {} {
1907 entertrace
1908 global ascSolvStatVect ascSolv32767Vect
1909 set ct 0
1910 set itb 0
1911 set sumbe 0
1912 set sumft 0
1913 set sumjt 0
1914 set maxbe 0
1915 set maxbeblock 0
1916 set maxbt 0
1917 set maxbtblock 0
1918 set gscp [slv_get_cost_page]
1919 foreach i $gscp {
1920 if {[lindex $i 0] > 0} {
1921 set sumbe [expr $sumbe + [lindex $i 5]]
1922 set sumft [expr $sumft + [lindex $i 6]]
1923 set sumjt [expr $sumjt + [lindex $i 7]]
1924 if {[lindex $i 5] > $maxbe} {
1925 set maxbe [lindex $i 5]
1926 set maxbeblock $ct
1927 }
1928 if {[lindex $i 4] > $maxbt} {
1929 set maxbt [lindex $i 4]
1930 set maxbtblock $ct
1931 }
1932 incr ct
1933 if {[lindex $i 0] >1} {
1934 incr itb
1935 }
1936 }
1937 }
1938 set pst [llength $gscp]
1939 set pst [lindex [lindex $gscp [incr pst -1] ] 4]
1940 set ascSolvStatVect(maxblockerr) $maxbe
1941 set ascSolvStatVect(worstblock) $maxbeblock
1942 set ascSolvStatVect(sumblockerr) $sumbe
1943 if {$itb >0} {
1944 set ascSolvStatVect(avgblockerr) [expr $sumbe/$itb]
1945 } else {
1946 set ascSolvStatVect(avgblockerr) 0
1947 }
1948 if {$ascSolv32767Vect(showavgs)} {
1949 puts "Block error total: $sumbe"
1950 puts "Block error max($maxbeblock): $maxbe"
1951 puts "CPU total: $ascSolvStatVect(cpuelapsed)"
1952 puts "Expensive block($maxbtblock): $maxbt"
1953 puts "Presolve: $pst"
1954 puts "Functions: $sumft"
1955 puts "Derivatives: $sumjt"
1956 }
1957 leavetrace
1958 }
1959
1960 #
1961 # proc Solve_Check_Dimensions {}
1962 #----------------------------------------------------------------------------
1963 # Check and derive dimensionality of rellist, varlist in solver.
1964 # this should be a wrapper around something that the browser can
1965 # also use.
1966 #----------------------------------------------------------------------------
1967 proc Solve_Check_Dimensions {} {
1968 entertrace
1969 leavetrace
1970 }
1971 #
1972 # proc Solve_Check_Eligible
1973 #----------------------------------------------------------------------------
1974 # pick appropriate solver. will be last one used if last one was eligible.
1975 # Changes ascSolvStatVect(solvernum) if necessary.
1976 # If noone is eligible, returns SLV as solver; not necessarily a bright
1977 # move, but better the devil you know.
1978 # Should handle menu disabling on edit.selectsolver menu.
1979 #----------------------------------------------------------------------------
1980 proc Solve_Check_Eligible {} {
1981 entertrace
1982 leavetrace; return
1983 global ascSolvVect
1984 set retval [asctk_dialog .solvinel $ascSolvVect(font) \
1985 "Solver diagnostic:" \
1986 "Current solver ($ascSolvStatVect(solver)) not eligible" "" 0 OK Why?]
1987 if {$retval} {
1988 puts stderr "Sorry, no help available on why yet."
1989 }
1990
1991 leavetrace
1992 }
1993
1994 #
1995 # proc Solve_Check_DOF {}
1996 #----------------------------------------------------------------------------
1997 # if DOF change needed pop up dialog.
1998 #----------------------------------------------------------------------------
1999 proc Solve_Check_DOF {} {
2000 entertrace
2001 global ascSolvStatVect
2002 if {$ascSolvStatVect(overdefined)} {
2003 Solve_FindOverspec 1
2004 leavetrace
2005 return
2006 }
2007 if {"[string range $ascSolvStatVect(objval) 0 3]" != "none"} {
2008 leavetrace
2009 return
2010 }
2011 if {$ascSolvStatVect(underdefined)} {
2012 Solve_FindEligible 1
2013 leavetrace
2014 return}
2015 if {$ascSolvStatVect(structsingular)} {
2016 Solve_do_StrucDepends
2017 leavetrace
2018 return}
2019 leavetrace
2020 }
2021
2022 #
2023 # proc Solve_Check_RowsPivoted {noisy}
2024 #----------------------------------------------------------------------------
2025 # look for numeric singularity of rows after solution.
2026 # leavetrace; return 1 if checkable 0 if not inverted >=2 if singularity found
2027 # number of singularities is leavetrace; return value -1
2028 # if noisy is 1, pops up alertbox about uninvertedness
2029 #----------------------------------------------------------------------------
2030 proc Solve_Check_RowsPivoted {noisy} {
2031 entertrace
2032 global ascSolvStatVect
2033 if {$ascSolvStatVect(running)} {
2034 puts stderr "Cannot check for singularity while solver is running."
2035 leavetrace
2036 return 1
2037 }
2038 puts stderr "Checking blocks for numeric row dependency:"
2039 # if QRSlv or NGSlv
2040 if {$ascSolvStatVect(solver) == "QRSlv"
2041 | $ascSolvStatVect(solver)== "NGSlv"} {
2042 set ret 0
2043 for {set blk 0} {$blk < $ascSolvStatVect(block.number)} {incr blk} {
2044 if {![catch {set dep [dbg_num_block_singular 2 $blk r]} msg]} {
2045 foreach r $dep {
2046 incr ret
2047 set eqn [lindex $r 0]
2048 puts stderr \
2049 "=== Found unpivoted relation $eqn in block $blk ==="
2050 puts stderr "Which is the sum of:"
2051 set eqns [lrange $r 1 end]
2052 foreach e $eqns {
2053 puts stderr "Relation ([lindex $e 0]) * [lindex $e 1]"
2054 }
2055 puts stderr "========================================="
2056 }
2057 incr ret
2058 } else {
2059 if {$noisy} {
2060 global ascMsgVect ascSolvVect
2061 set ascMsgVect(grab) 0
2062 set ascMsgVect(title) "Linsol:"
2063 set ascMsgVect(lbl_font) $ascSolvVect(font)
2064 set ascMsgVect(btn_font) $ascSolvVect(font)
2065 set ascMsgVect(btn_label) Dismiss
2066 set ascMsgVect(toplevelname) .linsolmsg
2067 set ascMsgVect(position) [setpos .solver 50 125]
2068 ascMsgBox "Error in singularity\nchecking process."
2069 raise .linsolmsg
2070 puts stderr $msg
2071 }
2072 }
2073 }
2074 if {$noisy} {
2075 puts stderr "All blocks checked."
2076 }
2077 leavetrace
2078 return $ret
2079 }
2080 #else non linsolqr system: print error
2081 if {$noisy} {
2082 global ascMsgVect ascSolvVect
2083 set ascMsgVect(grab) 0
2084 set ascMsgVect(title) "Numeric Depend:"
2085 set ascMsgVect(lbl_font) $ascSolvVect(font)
2086 set ascMsgVect(btn_font) $ascSolvVect(font)
2087 set ascMsgVect(btn_label) Dismiss
2088 set ascMsgVect(toplevelname) .linsolmsg
2089 set ascMsgVect(position) [setpos .solver 50 125]
2090 ascMsgBox "Must call Numeric Dependency Check from QRSlv."
2091 raise .linsolmsg
2092 puts "Error: no blocks checked\n"
2093 }
2094 leavetrace
2095
2096 leavetrace
2097 return 0
2098 }
2099
2100
2101
2102 #
2103 # proc Solve_FindEligible {refresh}
2104 #----------------------------------------------------------------------------
2105 # Find eligible vars button. nonincident don't count #
2106 # if refresh then update status/presolve after fix #
2107 #----------------------------------------------------------------------------
2108 proc Solve_FindEligible {refresh} {
2109 entertrace
2110 global ascListSelectBox ascSolvVect
2111 set list ""
2112 catch {set list [lindex [dbg_find_eligible 2] 0]}
2113 set ascListSelectBox(grab) 1
2114 set ascListSelectBox(btn3name) ""
2115 set ascListSelectBox(btn4name) ""
2116 set ascListSelectBox(btn5name) ""
2117 set ascListSelectBox(title) "Eligible"
2118 set ascListSelectBox(toplevelname) ".solveligible"
2119 set ascListSelectBox(font) $ascSolvVect(font)
2120 set ascListSelectBox(selectmode) browse
2121 set ascListSelectBox(headline) "Select to fix one of:"
2122 set newlist ""
2123 set pname [slv_get_pathname]
2124 foreach i $list {
2125 lappend newlist \
2126 "$pname.[stripbraces [dbg_write_var 2 $i 0 0]]"
2127 }
2128 if {$newlist=="" && !$refresh} {
2129 puts stderr "No variables eligible to be fixed."
2130 leavetrace
2131 return
2132 }
2133 set alist [lsort $newlist]
2134 set button [AscListSelectBox $alist \
2135 250x240[setpos .solver 50 20]]
2136 if {$button==2} {
2137 leavetrace
2138 return
2139 }
2140 Solve_EligListSelect $refresh
2141 leavetrace
2142 }
2143
2144
2145
2146 #
2147 # proc Solve_FindGlobalEligible {refresh}
2148 #----------------------------------------------------------------------------
2149 # Find the set of "globally" (conditional model) eligible vars.
2150 # if refresh then update status/presolve after fix
2151 #----------------------------------------------------------------------------
2152 proc Solve_FindGlobalEligible {refresh} {
2153 entertrace
2154 global ascListSelectBox ascSolvVect
2155 set list ""
2156 catch {set list [lindex [dbg_global_eligible 2] 0]}
2157 set ascListSelectBox(grab) 1
2158 set ascListSelectBox(btn3name) ""
2159 set ascListSelectBox(btn4name) ""
2160 set ascListSelectBox(btn5name) ""
2161 set ascListSelectBox(title) "Globally Eligible"
2162 set ascListSelectBox(toplevelname) ".solvgeligible"
2163 set ascListSelectBox(font) $ascSolvVect(font)
2164 set ascListSelectBox(selectmode) browse
2165 set ascListSelectBox(headline) "Select to fix one of:"
2166 set newlist ""
2167 set pname [slv_get_pathname]
2168 foreach i $list {
2169 lappend newlist \
2170 "$pname.[stripbraces [dbg_write_var 2 $i 0 1]]"
2171 }
2172 if {$newlist=="" && !$refresh} {
2173 puts stderr "No variables eligible to be fixed."
2174 leavetrace
2175 return
2176 }
2177 set alist [lsort $newlist]
2178 set button [AscListSelectBox $alist \
2179 250x240[setpos .solver 50 20]]
2180 if {$button==2} {
2181 leavetrace
2182 return
2183 }
2184 Solve_GlobalEligListSelect $refresh
2185 leavetrace
2186 }
2187
2188 #
2189 # proc Solve_ConsistencyAnalysis {refresh}
2190 #----------------------------------------------------------------------------
2191 # Find the variables which makes a consitent set of decision variables,
2192 # consistent in the "overall" conditional model
2193 #----------------------------------------------------------------------------
2194 proc Solve_ConsistencyAnalysis {refresh} {
2195 entertrace
2196 global ascListSelectB1Box ascSolvVect
2197 set list ""
2198 catch {set list [lindex [dbg_consistency_analysis 2] 0]}
2199 set ascListSelectB1Box(grab) 0
2200 set ascListSelectB1Box(btn2name) "Tag All"
2201 set ascListSelectB1Box(btn3name) "Fix Selection"
2202 set ascListSelectB1Box(btn4name) ""
2203 set ascListSelectB1Box(btn5name) ""
2204 set ascListSelectB1Box(btn2destroy) 0
2205 set ascListSelectB1Box(btn3destroy) 0
2206 set ascListSelectB1Box(btn4destroy) 0
2207 set ascListSelectB1Box(btn2command) Solve_SelectAll
2208 set ascListSelectB1Box(btn3command) Solve_FixConsistentSet
2209 set ascListSelectB1Box(title) "Consistent Set"
2210 set ascListSelectB1Box(toplevelname) ".solvconsistent"
2211 set ascListSelectB1Box(selectmode) extended
2212 set ascListSelectBox(font) $ascSolvVect(font)
2213 set ascListSelectB1Box(headline) "Could Fix the Set:"
2214 set newlist ""
2215 set pname [slv_get_pathname]
2216 foreach i $list {
2217 lappend newlist \
2218 "$pname.[stripbraces [dbg_write_var 2 $i 0 1]]"
2219 }
2220 if {$newlist =="" && !$refresh} {
2221 puts stderr "No set of variables make a consistent partition."
2222 leavetrace
2223 return
2224 }
2225
2226 set alist [lsort $newlist]
2227 set button [AscListSelectB1Box $alist \
2228 250x240[setpos .solver 50 20]]
2229 leavetrace
2230 }
2231
2232
2233 #
2234 # proc Solve_SelectAll {{tl ""}}
2235 #-------------------------------------------------------------------------
2236 # select all in the asclistselectb1box associate with tl, or
2237 # select all in the last asclistselectb1box created if tl == ""
2238 #-------------------------------------------------------------------------
2239 proc Solve_SelectAll {{tl ""}} {
2240 AscListSelectB1SelectAll $tl
2241 }
2242
2243 #
2244 # proc Solve_ConsistencyAnalysis2 {refresh}
2245 #----------------------------------------------------------------------------
2246 # Find the variables which makes a consitent set of decision variables,
2247 # consistent in the "overall" conditional model. It uses a SelectBox
2248 # instead of a SelectB1Box (function of above)
2249 #----------------------------------------------------------------------------
2250 proc Solve_ConsistencyAnalysis2 {refresh} {
2251 entertrace
2252 global ascListSelectBox ascSolvVect
2253 set list ""
2254 catch {set list [lindex [dbg_consistency_analysis 2] 0]}
2255 set ascListSelectBox(grab) 1
2256 set ascListSelectBox(btn3name) ""
2257 set ascListSelectBox(btn4name) ""
2258 set ascListSelectBox(btn5name) ""
2259 set ascListSelectBox(title) "Consistent Set"
2260 set ascListSelectBox(toplevelname) ".solvconsistent"
2261 set ascListSelectBox(font) $ascSolvVect(font)
2262 set ascListSelectBox(selectmode) browse
2263 set ascListSelectBox(headline) "Could Fix the Set:"
2264 set newlist ""
2265 set pname [slv_get_pathname]
2266 foreach i $list {
2267 lappend newlist \
2268 "$pname.[stripbraces [dbg_write_var 2 $i 0 1] ]"
2269 }
2270 if {$newlist =="" || !$refresh} {
2271 puts stderr "No set of variables make a consistent partition."
2272 leavetrace
2273 return
2274 }
2275 set alist [lsort $newlist]
2276 set button [AscListSelectBox $alist \
2277 250x240[setpos .solver 50 20]]
2278 if {$button==2} {
2279 leavetrace
2280 return
2281 }
2282 Solve_ConsistentListSelect $refresh
2283 leavetrace
2284 }
2285
2286 #
2287 # proc Solve_FlagActive {}
2288 #----------------------------------------------------------------------------
2289 # Flag active relations instances.
2290 #----------------------------------------------------------------------------
2291 proc Solve_FlagActive {} {
2292 entertrace
2293
2294 dbg_find_activerels 0
2295
2296 leavetrace
2297 }
2298
2299
2300 #
2301 # proc Solve_Find_Objectives {refresh}
2302 #----------------------------------------------------------------------------
2303 # Select objective button. #
2304 # if refresh then update status/presolve after fix #
2305 #----------------------------------------------------------------------------
2306 proc Solve_Find_Objectives {refresh} {
2307 entertrace
2308 global ascListSelectBox ascSolvVect
2309 set list ""
2310 catch {set list [lindex [slv_get_obj_list 2] 0]}
2311 set ascListSelectBox(grab) 1
2312 set ascListSelectBox(btn3name) ""
2313 set ascListSelectBox(btn4name) ""
2314 set ascListSelectBox(btn5name) ""
2315 set ascListSelectBox(title) "Objectives"
2316 set ascListSelectBox(toplevelname) ".solvobjectives"
2317 set ascListSelectBox(font) $ascSolvVect(font)
2318 set ascListSelectBox(selectmode) browse
2319 set ascListSelectBox(headline) "Select one objective:"
2320 set newlist ""
2321 set pname [slv_get_pathname]
2322 lappend newlist "none"
2323 foreach i $list {
2324 lappend newlist \
2325 "$pname.[stripbraces [dbg_write_obj 2 $i 0]]"
2326 }
2327 if {$newlist=="none" && !$refresh} {
2328 puts stderr "No included objectives."
2329 leavetrace
2330 return
2331 }
2332 set alist [lsort $newlist]
2333 set button [AscListSelectBox $alist \
2334 250x240[setpos .solver 50 20]]
2335 if {$button==2} {
2336 leavetrace
2337 return}
2338 Solve_ObjListSelect $refresh
2339 leavetrace
2340 }
2341
2342 #
2343 # proc Solve_Update_ParmBox {args}
2344 #----------------------------------------------------------------------------
2345 # load parms from C structure for current solver/solve system. If no system,
2346 # do nothing. if args not empty, load parms for system with name in args
2347 #----------------------------------------------------------------------------
2348 proc Solve_Update_ParmBox {args} {
2349 entertrace
2350 global ascSolvStatVect ascSolvVect
2351 if {![slv_checksys]} {
2352 leavetrace
2353 return
2354 }
2355 if {$args!=""} {set name $args} {
2356 set name $ascSolvStatVect(solver)
2357 }
2358 if {$ascSolvVect($name) == -1} {
2359 leavtrace
2360 return
2361 }
2362 switch $name {
2363 {Slv} -
2364 {CSlv} { Solve_SLV_Update_ParmBox}
2365 {MINOS} { Solve_MINOS_Update_ParmBox}
2366 {Opt} { Solve_OPTSQP_Update_ParmBox}
2367 {QRSlv} { Solve_QRSLV_Update_ParmBox}
2368 {makeMPS} { Solve_MPS_Update_ParmBox}
2369 {NGSlv} { Solve_NGSLV_Update_ParmBox}
2370 {CONOPT} { Solve_CONOPT_Update_ParmBox}
2371 {General} { Solve_General_Update_ParmBox}
2372 default {
2373 puts "Don't know how to update solver $ascSolvStatVect(solver) parms."
2374 }
2375 }
2376 leavetrace
2377 }
2378
2379 #
2380 # proc Solve_Downdate_ParmBox {args}
2381 #----------------------------------------------------------------------------
2382 # load parms to C structure for current solver/solve system. If no system,
2383 # do nothing. if args not empty, downdate parms for system with name in args
2384 #----------------------------------------------------------------------------
2385 proc Solve_Downdate_ParmBox {args} {
2386 entertrace
2387 global ascSolvStatVect ascSolvVect
2388 if {![slv_checksys]} {
2389 leavetrace
2390 return
2391 }
2392 if {$args!=""} {
2393 set name $args
2394 } {
2395 set name $ascSolvStatVect(solver)
2396 }
2397 if {$ascSolvVect($name) == -1} {
2398 leavtrace
2399 return
2400 }
2401 if {[catch Solve_${name}_Downdate_ParmBoxNew]} {
2402 puts "Don't know how to downdate solver $ascSolvStatVect(solver) parms."
2403 }
2404 leavetrace
2405 }
2406
2407 #
2408 # proc Solve_Status_Infobox {}
2409 #----------------------------------------------------------------------------
2410 # solve status alertbox #
2411 #----------------------------------------------------------------------------
2412 proc Solve_Status_Infobox {} {
2413 entertrace
2414 global ascSolvVect ascSolvStatVect ascMsgVect ascGlobalVect
2415 #
2416 # Update active flag of relations
2417 #
2418 Solve_FlagActive
2419 set ascMsgVect(lbl_font) $ascSolvVect(font)
2420 set ascMsgVect(btn_font) $ascSolvVect(font)
2421 set ascMsgVect(title) "Solve system status:"
2422 set ascMsgVect(btn_label) "Dismiss"
2423 set ascMsgVect(position) [setpos .solver 50 125]
2424 set ascMsgVect(grab) 0
2425 set ascMsgVect(toplevelname) .solverstatmsg
2426 set slist [join [split [string trim $ascSolvVect(status) ,] ,] \n]
2427 if {$ascSolvVect(statreport)} {
2428 ascMsgBox $slist
2429 raise .solverstatmsg
2430 } else {
2431 puts stdout $slist
2432 }
2433 leavetrace
2434 }
2435
2436 #
2437 # proc Solve_Alert {title msg}
2438 #----------------------------------------------------------------------------
2439 # solve generic alertbox requires title msg #
2440 # msg may be multiline comma separated #
2441 #----------------------------------------------------------------------------
2442 proc Solve_Alert {title msg} {
2443 entertrace
2444 global ascSolvVect ascSolvStatVect ascMsgVect ascGlobalVect
2445 set ascMsgVect(lbl_font) $ascSolvVect(font)
2446 set ascMsgVect(btn_font) $ascSolvVect(font)
2447 set ascMsgVect(title) $title
2448 set ascMsgVect(btn_label) "Dismiss"
2449 set ascMsgVect(position) [setpos .solver 50 125]
2450 set ascMsgVect(grab) 0
2451 set ascMsgVect(toplevelname) .solveralertmsg
2452 set slist [join [split [string trim $msg ,] ,] \n]
2453 ascMsgBox $slist
2454 raise .solveralertmsg
2455 leavetrace
2456 }
2457
2458 #
2459 # proc Solve_FP_error {msg}
2460 #----------------------------------------------------------------------------
2461 # solve floatingpoint error alertbox and analysis. #
2462 #----------------------------------------------------------------------------
2463 proc Solve_FP_error {msg} {
2464 entertrace
2465 global ascSolvVect ascSolvStatVect ascMsgVect ascGlobalVect
2466 set ascSolvStatVect(fpcaught) 1
2467 set ascMsgVect(lbl_font) $ascSolvVect(font)
2468 set ascMsgVect(btn_font) $ascSolvVect(font)
2469 set ascMsgVect(title) "Floating point error:"
2470 set ascMsgVect(btn_label) "Dismiss"
2471 set ascMsgVect(position) [setpos .solver 50 125]
2472 set ascMsgVect(grab) 0
2473 set ascMsgVect(toplevelname) .solvererr
2474 set slist [join [split [string trim $msg ,] ,] \n]
2475 ascMsgBox $slist
2476 raise .solvererr
2477 set elist [dbg_check_rels]
2478 puts "Examining relations for math errors:"
2479 foreach r $elist {
2480 set i [lindex $r 0]
2481 puts stderr "Relation <$i> [dbg_write_rel 2 $i 0] has math errors:"
2482 set ls [lindex $r 1]
2483 set rs [lindex $r 2]
2484 set dls [lindex $r 3]
2485 set drs [lindex $r 4]
2486 if {$ls} {
2487 puts stderr " Error in the LHS"
2488 }
2489 if {$rs} {
2490 puts stderr " Error in the RHS"
2491 }
2492 if {$ls==0 && $dls==1} {
2493 puts stderr " Error in the LHS derivative."
2494 }
2495 if {$rs==0 && $drs==1} {
2496 puts stderr " Error in the RHS derivative."
2497 }
2498 }
2499 leavetrace
2500 }
2501
2502 #
2503 # proc Solve_Solve {}
2504 #----------------------------------------------------------------------------
2505 # Execute/Solve button internals #
2506 #----------------------------------------------------------------------------
2507 proc Solve_Solve {} {
2508 entertrace
2509 if {![slv_checksys]} { leavetrace; return }
2510 # needs better sanity checking and interrupt checking.
2511 global ascSolvVect ascSolvStatVect ascSolv32767Vect ascSolv3Vect
2512 set ascSolvStatVect(menubreak) 0
2513 slv_set_haltflag 0
2514 if {[slv_checksys]} {
2515 set ascSolvStatVect(ready2solve) 1
2516 }
2517 Solve_Downdate_ParmBox
2518 if {[catch {slv_presolve} ]} {
2519 Solve_FP_error "Initial values,cause float error.,Please fix this."
2520 leavetrace
2521 return
2522 }
2523 HUB_Message_to_HUB SOLVINGSTARTED $ascSolvVect(instname) \
2524 [lindex [slv_available] [slv_get_solver]]
2525 Solve_Update_StatusBox
2526 if {!$ascSolvStatVect(calcok)} {
2527 Solve_FP_error "Initial values,cause range error.,Please fix this."
2528 leavetrace
2529 return
2530 }
2531 update
2532 update idletasks
2533 puts "$ascSolvVect(status)"
2534 while {$ascSolvStatVect(ready2solve) && !$ascSolvStatVect(menubreak)} {
2535 set ascSolvStatVect(running) 1
2536 Solve_Running 0 0 0
2537 update idletasks
2538 if {[catch {slv_iterate \
2539 $ascSolv32767Vect(update_frequency) \
2540 $ascSolv32767Vect(update_time)} ermsg]} {
2541 set ascSolvStatVect(running) 0
2542 Solve_Running 0 0 0
2543 Solve_FP_error "Float error.,Check bounds & scaling."
2544 }
2545 Solve_update_monitor
2546 # temporary hack. get this slv3 reference out of here. baa 8/95
2547 # logically disabled 9/95 baa
2548 # set relnom ""
2549 # if {0 && $ascSolv3Vect(relnom) && [slv_get_solver] == 3} {
2550 # set relnom "[dbg_calc_relnoms]"
2551 # }
2552 if {0 && "$relnom" != ""} {
2553 Solve_FP_error \
2554 "Initial values,cause relation,scaling float error.,Please fix this."
2555 puts stderr "relindex lhsbad rhsbad nominal"
2556 foreach i $relnom {
2557 puts stderr $i
2558 }
2559 # leavetrace
2560 return
2561 }
2562 set ascSolvStatVect(running) 0
2563 Solve_Running 0 0 0
2564 Solve_Update_StatusBox 1
2565 Solve_ClearQueue
2566 update
2567 if {!$ascSolvStatVect(calcok)} {
2568 HUB_Message_to_HUB SOLVINGDONE $ascSolvVect(simname)
2569 Solve_FP_error \
2570 "Range error in,functions or derivatives.,Check bounds & scaling."
2571 leavetrace
2572 return
2573 }
2574 }
2575 HUB_Message_to_HUB SOLVINGDONE $ascSolvVect(simname)
2576 if {$ascSolv32767Vect(checksing)} {
2577 Solve_Check_RowsPivoted 0
2578 }
2579 leavetrace
2580 }
2581
2582 #
2583 # proc Solve_Optimize {}
2584 #----------------------------------------------------------------------------
2585 # Execute/Optimize button internals #
2586 #----------------------------------------------------------------------------
2587 proc Solve_Optimize {} {
2588 entertrace
2589 # needs better sanity checking and interrupt checking.
2590 global ascSolvVect ascSolvStatVect ascSolv32767Vect
2591
2592 set ascSolvStatVect(menubreak) 0
2593 slv_set_haltflag 0
2594 if {[slv_checksys]} {
2595 set ascSolvStatVect(ready2solve) 1
2596 }
2597 # something else here might be appropriate
2598 # if {[catch {slv_presolve} ]} {
2599 # Solve_FP_error "Initial values,cause float error.,Please fix this."
2600 # leavetrace
2601 return
2602 # }
2603 HUB_Message_to_HUB SOLVINGSTARTED $ascSolvVect(instname) \
2604 [lindex [slv_available] [slv_get_solver]]
2605 Solve_Update_StatusBox
2606 if {!$ascSolvStatVect(calcok)} {
2607 Solve_FP_error "Initial values,cause range error.,Please fix this."
2608 leavetrace
2609 return
2610 }
2611 update
2612 update idletasks
2613 puts "$ascSolvVect(status)"
2614 while {$ascSolvStatVect(ready2solve) && !$ascSolvStatVect(menubreak)} {
2615 set ascSolvStatVect(running) 1
2616 Solve_Running 0 0 0
2617 update idletasks
2618 if {[catch {slv_iterate \
2619 $ascSolv32767Vect(update_frequency) \
2620 $ascSolv32767Vect(update_time)} ermsg]} {
2621 set ascSolvStatVect(running) 0
2622 Solve_Running 0 0 0
2623 Solve_FP_error "Float error.,Check bounds & scaling."
2624 }
2625 set ascSolvStatVect(running) 0
2626 Solve_Running 0 0 0
2627 Solve_Update_StatusBox 1
2628 Solve_ClearQueue
2629 update
2630 if {!$ascSolvStatVect(calcok)} {
2631 HUB_Message_to_HUB SOLVINGDONE $ascSolvVect(simname)
2632 Solve_FP_error \
2633 "Range error in,functions or derivatives.,Check bounds & scaling."
2634 leavetrace
2635 return
2636 }
2637 }
2638 HUB_Message_to_HUB SOLVINGDONE $ascSolvVect(simname)
2639 if {$ascSolv32767Vect(checksing)} {
2640 Solve_Check_RowsPivoted 0
2641 }
2642 leavetrace
2643 }
2644
2645 #
2646 # proc Solve_Integrate {}
2647 #----------------------------------------------------------------------------
2648 # Execute/Integrate button internals #
2649 #----------------------------------------------------------------------------
2650 proc Solve_Integrate {args} {
2651 entertrace
2652 # needs better sanity checking and interrupt checking.
2653 global ascSolvVect ascSolvStatVect ascSolv32767Vect
2654
2655 set ascSolvStatVect(menubreak) 0
2656 if {[slv_checksys]} {
2657 set ascSolvStatVect(ready2solve) 1
2658 }
2659 if {[catch {slv_presolve} ]} {
2660 Solve_FP_error "Initial values,cause float error.,Please fix this."
2661 leavetrace
2662 return
2663 }
2664 HUB_Message_to_HUB SOLVINGSTARTED $ascSolvVect(instname) \
2665 [lindex [slv_available] [slv_get_solver]]
2666 Solve_Update_StatusBox
2667 if {!$ascSolvStatVect(calcok)} {
2668 Solve_FP_error "Initial values,cause range error.,Please fix this."
2669 leavetrace
2670 return
2671 }
2672 set n1 0
2673 set n2 0
2674 catch {integrate_logunits "$ascSolv32767Vect(logsi)"}
2675 catch {integrate_logformat "$ascSolv32767Vect(logcol)"}
2676 if {$ascSolv32767Vect(newlog)} {
2677 catch {file delete $ascSolv32767Vect(yfilename) \
2678 $ascSolv32767Vect(obsfilename)
2679 } fileerr
2680 }
2681 integrate_set_y_file "$ascSolv32767Vect(yfilename)"
2682 integrate_set_obs_file "$ascSolv32767Vect(obsfilename)"
2683 if {$args != ""} {
2684 if {[llength $args] !=3} {
2685 error "Solve integrate called with incorrect args type i1 i2"
2686 }
2687 set itype "[lindex $args 0]"
2688 set n1 [lindex $args 1]
2689 if {$n1 == "first"} {
2690 set n1 0
2691 }
2692 set n2 [lindex $args 2]
2693 if {$n2 == "last"} {
2694 if {"[string tolower $itype]"=="lsode"} {
2695 set n2 [lindex [lindex [u_getval [slv_get_pathname].nstep] 0] 0]
2696 } else {
2697 if {[catch {set n2 [llength [lindex [integrate_get_samples] 1]]} ]} {
2698 set n2 -1
2699 } else {
2700 incr n2 -1
2701 }
2702 }
2703 }
2704 }
2705 update
2706 update idletasks
2707 puts "$ascSolvVect(status)"
2708 set ascSolvStatVect(running) 1
2709 Solve_Running 0 0 0
2710 update idletasks
2711 if {$args == ""} {
2712 set integ_time [asc_clock "integrate_setup -engine BLSODE \
2713 -dt0 $ascSolv32767Vect(dtzero) \
2714 -dtmin $ascSolv32767Vect(dtmin) \
2715 -dtmax $ascSolv32767Vect(dtmax) \
2716 -moststeps $ascSolv32767Vect(moststeps)"]
2717 } else {
2718 set integ_time \
2719 [asc_clock "integrate_setup -engine $itype -i0 $n1 -i1 $n2 \
2720 -dt0 $ascSolv32767Vect(dtzero) \
2721 -dtmin $ascSolv32767Vect(dtmin) \
2722 -dtmax $ascSolv32767Vect(dtmax) \
2723 -moststeps $ascSolv32767Vect(moststeps)"]
2724 }
2725 integrate_cleanup
2726 puts "Time for integration: $integ_time"
2727 set ascSolvStatVect(running) 0
2728 Solve_Running 0 0 0
2729 Solve_Update_StatusBox
2730 Solve_ClearQueue
2731 update
2732 if {!$ascSolvStatVect(calcok)} {
2733 HUB_Message_to_HUB SOLVINGDONE $ascSolvVect(simname)
2734 Solve_FP_error \
2735 "Range error in,functions or derivatives.,Check bounds & scaling."
2736 leavetrace
2737 return
2738 }
2739 HUB_Message_to_HUB SOLVINGDONE $ascSolvVect(simname)
2740 if {$ascSolv32767Vect(checksing)} {
2741 Solve_Check_RowsPivoted 0
2742 }
2743 leavetrace
2744 }
2745
2746
2747 #
2748 # proc Solve_Iterate {}
2749 #----------------------------------------------------------------------------
2750 # Execute/Iterate button internals does one of karls iterations. #
2751 #----------------------------------------------------------------------------
2752 proc Solve_Iterate {} {
2753 entertrace
2754 global ascSolvVect ascSolvStatVect
2755 set ascSolvStatVect(menubreak) 0
2756 slv_set_haltflag 0
2757 Solve_Update_StatusBox
2758 set ascSolvStatVect(running) 1
2759 Solve_Running 0 0 0
2760 update idletasks
2761 slv_iterate 1
2762 set ascSolvStatVect(running) 0
2763 Solve_Running 0 0 0
2764 Solve_update_monitor
2765 Solve_Update_StatusBox
2766 update idletasks
2767 HUB_Message_to_HUB SOLVINGDONE $ascSolvVect(simname)
2768 leavetrace
2769 }
2770
2771 #
2772 # proc Solve_General_Update_ParmBox {}
2773 #----------------------------------------------------------------------------
2774 # this updates ascSolv32767Vect variables #
2775 #----------------------------------------------------------------------------
2776 proc Solve_General_Update_ParmBox {} {
2777 entertrace
2778 global ascSolv32767Vect
2779 set ascSolv32767Vect(lnmepsilon) [slv_lnmget]
2780 leavetrace
2781 }
2782 #
2783 # proc Solve_General_Downdate_ParmBox {}
2784 #----------------------------------------------------------------------------
2785 # this downdates ascSolv32767Vect variables #
2786 #----------------------------------------------------------------------------
2787 proc Solve_General_Downdate_ParmBox {} {
2788 entertrace
2789 catch {slv_lnmset $ascSolv32767Vect(lnmepsilon)}
2790 leavetrace
2791 }
2792 #
2793 # proc Solve_SLV_Update_ParmBox {}
2794 #----------------------------------------------------------------------------
2795 # this updates ascSolv0Vect variables from the C structure #
2796 #----------------------------------------------------------------------------
2797 proc Solve_SLV_Update_ParmBox {} {
2798 entertrace
2799 global ascSolv0Vect
2800 set tmplist [slv_get_parms 0]
2801 if { [llength $tmplist]==17 && [lindex $tmplist 0]==0} {
2802 set ascSolv0Vect(timelimit) [lindex $tmplist 1]
2803 set ascSolv0Vect(iterationlimit) [lindex $tmplist 2]
2804 set ascSolv0Vect(termtol) [lindex $tmplist 3]
2805 set ascSolv0Vect(feastol) [lindex $tmplist 4]
2806 set ascSolv0Vect(pivottol) [lindex $tmplist 5]
2807 set ascSolv0Vect(singtol) [lindex $tmplist 6]
2808 set ascSolv0Vect(stattol) [lindex $tmplist 7]
2809 set ascSolv0Vect(rho) [lindex $tmplist 8]
2810 set ascSolv0Vect(partition) [lindex $tmplist 9]
2811 set ascSolv0Vect(ignorebounds) [lindex $tmplist 10]
2812 set ascSolv0Vect(showmoreimportant) [lindex $tmplist 11]
2813 set ascSolv0Vect(showlessimportant) [lindex $tmplist 12]
2814 set ascSolv0Vect(bppivoting) [lindex $tmplist 13]
2815 set ascSolv0Vect(showlessimportantds) [lindex $tmplist 14]
2816 set ascSolv0Vect(savlin) [lindex $tmplist 15]
2817 } else {
2818 puts "Error in Slv call to slv_get_parms"
2819 }
2820 leavetrace
2821 }
2822 #
2823 # proc Solve_QRSLV_Update_ParmBox {}
2824 #----------------------------------------------------------------------------
2825 # this updates ascSolv3Vect variables from the C structure #
2826 #----------------------------------------------------------------------------
2827 proc Solve_QRSLV_Update_ParmBox {} {
2828 entertrace
2829 global ascSolv3Vect
2830 global ascSolvVect
2831 set registered_number $ascSolvVect(QRSlv)
2832
2833 if { $registered_number < 0 } {
2834 leavetrace
2835 return
2836 }
2837
2838 set tmplist [slv_get_parms $registered_number]
2839 if { [llength $tmplist]==41 && [lindex $tmplist 0]==$registered_number} {
2840 set ascSolv3Vect(timelimit) [lindex $tmplist 1]
2841 set ascSolv3Vect(iterationlimit) [lindex $tmplist 2]
2842 set ascSolv3Vect(termtol) [lindex $tmplist 3]
2843 set ascSolv3Vect(feastol) [lindex $tmplist 4]
2844 set ascSolv3Vect(pivottol) [lindex $tmplist 5]
2845 set ascSolv3Vect(singtol) [lindex $tmplist 6]
2846 set ascSolv3Vect(stattol) [lindex $tmplist 7]
2847 set ascSolv3Vect(rho) [lindex $tmplist 8]
2848 set ascSolv3Vect(partition) [lindex $tmplist 9]
2849 set ascSolv3Vect(ignorebounds) [lindex $tmplist 10]
2850 set ascSolv3Vect(showmoreimportant) [lindex $tmplist 11]
2851 set ascSolv3Vect(showlessimportant) [lindex $tmplist 12]
2852 set ascSolv3Vect(bppivoting) \
2853 [Solve_QRSLV_int_to_bppivoting [lindex $tmplist 13]]
2854 set ascSolv3Vect(lifds) [lindex $tmplist 14]
2855 set ascSolv3Vect(savlin) [lindex $tmplist 15]
2856 set ascSolv3Vect(relnomscale) [lindex $tmplist 16]
2857 set ascSolv3Vect(cutoff) [lindex $tmplist 17]
2858 set ascSolv3Vect(upjac) [lindex $tmplist 18]
2859 set ascSolv3Vect(upwts) [lindex $tmplist 19]
2860 set ascSolv3Vect(upnom) [lindex $tmplist 20]
2861 set ascSolv3Vect(reduce) [lindex $tmplist 21]
2862 set ascSolv3Vect(exact) [lindex $tmplist 22]
2863 set ascSolv3Vect(cncols) [lindex $tmplist 23]
2864 set ascSolv3Vect(btrunc) [lindex $tmplist 24]
2865 set ascSolv3Vect(reorder) [lindex $tmplist 25]
2866 set ascSolv3Vect(safe_calc) [lindex $tmplist 26]
2867 set ascSolv3Vect(uprelnom) [lindex $tmplist 27]
2868 set ascSolv3Vect(itscalelim) [lindex $tmplist 28]
2869 set ascSolv3Vect(scaleopt) [lindex $tmplist 29]
2870 set ascSolv3Vect(toosmall) [lindex $tmplist 30]
2871 set ascSolv3Vect(cnlow) [lindex $tmplist 31]
2872 set ascSolv3Vect(cnhigh) [lindex $tmplist 32]
2873 set ascSolv3Vect(tobnds) [lindex $tmplist 33]
2874 set ascSolv3Vect(posdef) [lindex $tmplist 34]
2875 set ascSolv3Vect(detzero) [lindex $tmplist 35]
2876 set ascSolv3Vect(steperrmax) [lindex $tmplist 36]
2877 set ascSolv3Vect(prngmin) [lindex $tmplist 37]
2878 set ascSolv3Vect(mincoef) [lindex $tmplist 38]
2879 set ascSolv3Vect(maxcoef) [lindex $tmplist 39]
2880 set ascSolv3Vect(itscaletol) [lindex $tmplist 40]
2881 } else {
2882 puts "Error IN QRSlv call to slv_get_parms"
2883 }
2884 leavetrace
2885 }
2886 # proc Solve_NGSLV_Update_ParmBox {}
2887 #----------------------------------------------------------------------------
2888 # this updates ascSolv7Vect variables from the C structure #
2889 #----------------------------------------------------------------------------
2890 proc Solve_NGSLV_Update_ParmBox {} {
2891 entertrace
2892 global ascSolv7Vect
2893 global ascSolvVect
2894 set registered_number $ascSolvVect(NGSlv)
2895
2896 if { $registered_number < 0 } {
2897 leavetrace
2898 return
2899 }
2900
2901 set tmplist [slv_get_parms $registered_number]
2902 if { [llength $tmplist]==38 && [lindex $tmplist 0]==$registered_number} {
2903 set ascSolv7Vect(timelimit) [lindex $tmplist 1]
2904 set ascSolv7Vect(iterationlimit) [lindex $tmplist 2]
2905 set ascSolv7Vect(termtol) [lindex $tmplist 3]
2906 set ascSolv7Vect(feastol) [lindex $tmplist 4]
2907 set ascSolv7Vect(pivottol) [lindex $tmplist 5]
2908 set ascSolv7Vect(singtol) [lindex $tmplist 6]
2909 set ascSolv7Vect(stattol) [lindex $tmplist 7]
2910 set ascSolv7Vect(rho) [lindex $tmplist 8]
2911 set ascSolv7Vect(partition) [lindex $tmplist 9]
2912 set ascSolv7Vect(ignorebounds) [lindex $tmplist 10]
2913 set ascSolv7Vect(showmoreimportant) [lindex $tmplist 11]
2914 set ascSolv7Vect(showlessimportant) [lindex $tmplist 12]
2915 set ascSolv7Vect(bppivoting) \
2916 [Solve_NGSLV_int_to_bppivoting [lindex $tmplist 13]]
2917 set ascSolv7Vect(lifds) [lindex $tmplist 14]
2918 set ascSolv7Vect(savlin) [lindex $tmplist 15]
2919 set ascSolv7Vect(relnom) [lindex $tmplist 16]
2920 set ascSolv7Vect(cutoff) [lindex $tmplist 17]
2921 set ascSolv7Vect(upjac) [lindex $tmplist 18]
2922 set ascSolv7Vect(upwts) [lindex $tmplist 19]
2923 set ascSolv7Vect(upnom) [lindex $tmplist 20]
2924 set ascSolv7Vect(reduce) [lindex $tmplist 21]
2925 set ascSolv7Vect(exact) [lindex $tmplist 22]
2926 set ascSolv7Vect(cncols) [lindex $tmplist 23]
2927 set ascSolv7Vect(btrunc) [lindex $tmplist 24]
2928 set ascSolv7Vect(reorder) [lindex $tmplist 25]
2929 set ascSolv7Vect(safe_calc) [lindex $tmplist 26]
2930 set ascSolv7Vect(toosmall) [lindex $tmplist 27]
2931 set ascSolv7Vect(cnlow) [lindex $tmplist 28]
2932 set ascSolv7Vect(cnhigh) [lindex $tmplist 29]
2933 set ascSolv7Vect(tobnds) [lindex $tmplist 30]
2934 set ascSolv7Vect(posdef) [lindex $tmplist 31]
2935 set ascSolv7Vect(detzero) [lindex $tmplist 32]
2936 set ascSolv7Vect(steperrmax) [lindex $tmplist 33]
2937 set ascSolv7Vect(prngmin) [lindex $tmplist 34]
2938 set ascSolv7Vect(mincoef) [lindex $tmplist 35]
2939 set ascSolv7Vect(maxcoef) [lindex $tmplist 36]
2940 set ascSolv7Vect(gradmult) [lindex $tmplist 37]
2941 } else {
2942 puts "Error IN NGSlv call to slv_get_parms"
2943 }
2944 leavetrace
2945 }
2946
2947
2948 #
2949 # proc Solve_CONOPT_Update_ParmBox {}
2950 #----------------------------------------------------------------------------
2951 # this updates ascSolv8Vect variables from the C structure #
2952 #----------------------------------------------------------------------------
2953 proc Solve_CONOPT_Update_ParmBox {} {
2954 entertrace
2955 global ascSolv8Vect
2956 global ascSolvVect
2957 set registered_number $ascSolvVect(CONOPT)
2958
2959 if { $registered_number < 0 } {
2960 leavetrace
2961 return
2962 }
2963
2964 set tmplist [slv_get_parms $registered_number]
2965 if { [llength $tmplist]==41 && [lindex $tmplist 0]==$registered_number} {
2966 set ascSolv8Vect(timelimit) [lindex $tmplist 1]
2967 set ascSolv8Vect(iterationlimit) [lindex $tmplist 2]
2968 set ascSolv8Vect(termtol) [lindex $tmplist 3]
2969 set ascSolv8Vect(feastol) [lindex $tmplist 4]
2970 set ascSolv8Vect(pivottol) [lindex $tmplist 5]
2971 set ascSolv8Vect(singtol) [lindex $tmplist 6]
2972 set ascSolv8Vect(stattol) [lindex $tmplist 7]
2973 set ascSolv8Vect(rho) [lindex $tmplist 8]
2974 set ascSolv8Vect(partition) [lindex $tmplist 9]
2975 set ascSolv8Vect(ignorebounds) [lindex $tmplist 10]
2976 set ascSolv8Vect(showmoreimportant) [lindex $tmplist 11]
2977 set ascSolv8Vect(showlessimportant) [lindex $tmplist 12]
2978 set ascSolv8Vect(bppivoting) \
2979 [Solve_CONOPT_int_to_bppivoting [lindex $tmplist 13]]
2980 set ascSolv8Vect(lifds) [lindex $tmplist 14]
2981 set ascSolv8Vect(savlin) [lindex $tmplist 15]
2982 set ascSolv8Vect(relnomscale) [lindex $tmplist 16]
2983 set ascSolv8Vect(cutoff) [lindex $tmplist 17]
2984 set ascSolv8Vect(upjac) [lindex $tmplist 18]
2985 set ascSolv8Vect(upwts) [lindex $tmplist 19]
2986 set ascSolv8Vect(upnom) [lindex $tmplist 20]
2987 set ascSolv8Vect(reduce) [lindex $tmplist 21]
2988 set ascSolv8Vect(exact) [lindex $tmplist 22]
2989 set ascSolv8Vect(cncols) [lindex $tmplist 23]
2990 set ascSolv8Vect(btrunc) [lindex $tmplist 24]
2991 set ascSolv8Vect(reorder) [lindex $tmplist 25]
2992 set ascSolv8Vect(safe_calc) [lindex $tmplist 26]
2993 set ascSolv8Vect(uprelnom) [lindex $tmplist 27]
2994 set ascSolv8Vect(itscalelim) [lindex $tmplist 28]
2995 set ascSolv8Vect(scaleopt) [lindex $tmplist 29]
2996 set ascSolv8Vect(toosmall) [lindex $tmplist 30]
2997 set ascSolv8Vect(cnlow) [lindex $tmplist 31]
2998 set ascSolv8Vect(cnhigh) [lindex $tmplist 32]
2999 set ascSolv8Vect(tobnds) [lindex $tmplist 33]
3000 set ascSolv8Vect(posdef) [lindex $tmplist 34]
3001 set ascSolv8Vect(detzero) [lindex $tmplist 35]
3002 set ascSolv8Vect(steperrmax) [lindex $tmplist 36]
3003 set ascSolv8Vect(prngmin) [lindex $tmplist 37]
3004 set ascSolv8Vect(mincoef) [lindex $tmplist 38]
3005 set ascSolv8Vect(maxcoef) [lindex $tmplist 39]
3006 set ascSolv8Vect(itscaletol) [lindex $tmplist 40]
3007 } else {
3008 puts "Error IN CONOPT call to slv_get_parms"
3009 }
3010 leavetrace
3011 }
3012
3013 #
3014 # proc Solve_LSSLV_Update_ParmBox {}
3015 #----------------------------------------------------------------------------
3016 # this updates ascSolv5Vect variables from the C structure #
3017 #----------------------------------------------------------------------------
3018 proc Solve_LSSLV_Update_ParmBox {} {
3019 entertrace
3020 global ascSolv5Vect
3021 set tmplist [slv_get_parms 5]
3022 if { [llength $tmplist]==16 && [lindex $tmplist 0]==5} {
3023 set ascSolv5Vect(timelimit) [lindex $tmplist 1]
3024 set ascSolv5Vect(iterationlimit) [lindex $tmplist 2]
3025 set ascSolv5Vect(termtol) [lindex $tmplist 3]
3026 set ascSolv5Vect(feastol) [lindex $tmplist 4]
3027 set ascSolv5Vect(pivottol) [lindex $tmplist 5]
3028 set ascSolv5Vect(singtol) [lindex $tmplist 6]
3029 set ascSolv5Vect(stattol) [lindex $tmplist 7]
3030 set ascSolv5Vect(rho) [lindex $tmplist 8]
3031 set ascSolv5Vect(partition) [lindex $tmplist 9]
3032 set ascSolv5Vect(ignorebounds) [lindex $tmplist 10]
3033 set ascSolv5Vect(showmoreimportant) [lindex $tmplist 11]
3034 set ascSolv5Vect(showlessimportant) [lindex $tmplist 12]
3035 set ascSolv5Vect(bppivoting) [lindex $tmplist 13]
3036 set ascSolv5Vect(showlessimportantds) [lindex $tmplist 14]
3037 set ascSolv5Vect(savlin) [lindex $tmplist 15]
3038 } else {
3039 puts "Error IN LSSlv call to slv_get_parms"
3040 }
3041 leavetrace
3042 }
3043
3044 #
3045 # proc Solve_SLV_Downdate_ParmBox {}
3046 #----------------------------------------------------------------------------
3047 # this updates C structure from the ascSolv0Vect #
3048 # hacked for slv4 at the moment
3049 #----------------------------------------------------------------------------
3050 proc Solve_SLV_Downdate_ParmBox {} {
3051 entertrace
3052 global ascSolv0Vect
3053 set_slv_parms 0 \
3054 $ascSolv0Vect(timelimit) \
3055 $ascSolv0Vect(iterationlimit) \
3056 $ascSolv0Vect(termtol) \
3057 $ascSolv0Vect(feastol) \
3058 $ascSolv0Vect(pivottol) \
3059 $ascSolv0Vect(singtol) \
3060 $ascSolv0Vect(stattol) \
3061 $ascSolv0Vect(rho) \
3062 $ascSolv0Vect(partition) \
3063 $ascSolv0Vect(ignorebounds) \
3064 $ascSolv0Vect(showmoreimportant) \
3065 $ascSolv0Vect(showlessimportant) \
3066 $ascSolv0Vect(bppivoting) \
3067 $ascSolv0Vect(showlessimportantds) \
3068 $ascSolv0Vect(savlin)
3069 # set_slv_parms 4 \
3070 # $ascSolv0Vect(timelimit) \
3071 # $ascSolv0Vect(iterationlimit) \
3072 # $ascSolv0Vect(termtol) \
3073 # $ascSolv0Vect(feastol) \
3074 # $ascSolv0Vect(pivottol) \
3075 # $ascSolv0Vect(singtol) \
3076 # $ascSolv0Vect(stattol) \
3077 # $ascSolv0Vect(rho) \
3078 # $ascSolv0Vect(partition) \
3079 # $ascSolv0Vect(ignorebounds) \
3080 # $ascSolv0Vect(showmoreimportant) \
3081 # $ascSolv0Vect(showlessimportant) \
3082 # $ascSolv0Vect(showlessimportantds) \
3083 # $ascSolv0Vect(savlin)
3084 leavetrace
3085 }
3086
3087 #
3088 # proc Solve_QRSLV_bppivoting_to_int {choice}
3089 #----------------------------------------------------------------------------
3090 # this is a total hack. fix it, probably with an appropriate C primitive.
3091 # assumes the 4 methods of interest are in choices 0-3 and slv3 indexes
3092 # its fmethod choice the same way.
3093 #----------------------------------------------------------------------------
3094 proc Solve_QRSLV_bppivoting_to_int {choice} {
3095 entertrace
3096 global ascSolv3Vect
3097 set i [lsearch -exact $ascSolv3Vect(bppivoting.choices) $choice]
3098 if {$i == -1 || $i >4} {
3099 leavetrace
3100 return 4
3101 }
3102 leavetrace
3103 return $i
3104 leavetrace
3105 }
3106
3107 #
3108 # proc Solve_QRSLV_int_to_bppivoting {i}
3109 #----------------------------------------------------------------------------
3110 # this is a total hack. fix it, probably with an appropriate C primitive.
3111 # assumes the 4 methods of interest are in choices 0-3 and slv3 indexes
3112 # its fmethod choice the same way.
3113 #----------------------------------------------------------------------------
3114 proc Solve_QRSLV_int_to_bppivoting {i} {
3115 entertrace
3116 global ascSolv3Vect
3117 if {$i <0 || $i >4} {
3118 leavetrace
3119 return "Fast-SPK1/RANKI+ROW"
3120 }
3121 set choice "[lindex $ascSolv3Vect(bppivoting.choices) $i]"
3122 leavetrace
3123 return $choice
3124 leavetrace
3125 }
3126
3127 #
3128 # proc Solve_QRSLV_Downdate_ParmBox {}
3129 #----------------------------------------------------------------------------
3130 # this updates C structure from the ascSolv3Vect #
3131 #----------------------------------------------------------------------------
3132 proc Solve_QRSLV_Downdate_ParmBox {} {
3133 entertrace
3134 global ascSolv3Vect ascSolvVect
3135
3136 if {$ascSolvVect(QRSlv) == -1} {
3137 leavetrace
3138 return
3139 }
3140 set_slv_parms $ascSolvVect(QRSlv) \
3141 $ascSolv3Vect(timelimit) \
3142 $ascSolv3Vect(iterationlimit) \
3143 $ascSolv3Vect(termtol) \
3144 $ascSolv3Vect(feastol) \
3145 $ascSolv3Vect(pivottol) \
3146 $ascSolv3Vect(singtol) \
3147 $ascSolv3Vect(stattol) \
3148 $ascSolv3Vect(rho) \
3149 $ascSolv3Vect(partition) \
3150 $ascSolv3Vect(ignorebounds) \
3151 $ascSolv3Vect(showmoreimportant) \
3152 $ascSolv3Vect(showlessimportant) \
3153 "[Solve_QRSLV_bppivoting_to_int $ascSolv3Vect(bppivoting)]" \
3154 $ascSolv3Vect(lifds) \
3155 $ascSolv3Vect(savlin) \
3156 $ascSolv3Vect(relnomscale) \
3157 $ascSolv3Vect(cutoff) \
3158 $ascSolv3Vect(upjac) \
3159 $ascSolv3Vect(upwts) \
3160 $ascSolv3Vect(upnom) \
3161 $ascSolv3Vect(reduce) \
3162 $ascSolv3Vect(exact) \
3163 $ascSolv3Vect(cncols) \
3164 $ascSolv3Vect(btrunc) \
3165 $ascSolv3Vect(reorder) \
3166 $ascSolv3Vect(safe_calc) \
3167 $ascSolv3Vect(uprelnom) \
3168 $ascSolv3Vect(itscalelim) \
3169 $ascSolv3Vect(scaleopt) \
3170 $ascSolv3Vect(toosmall) \
3171 $ascSolv3Vect(cnlow) \
3172 $ascSolv3Vect(cnhigh) \
3173 $ascSolv3Vect(tobnds) \
3174 $ascSolv3Vect(posdef) \
3175 $ascSolv3Vect(detzero) \
3176 $ascSolv3Vect(steperrmax) \
3177 $ascSolv3Vect(prngmin) \
3178 $ascSolv3Vect(mincoef) \
3179 $ascSolv3Vect(maxcoef) \
3180 $ascSolv3Vect(itscaletol)
3181 leavetrace
3182 }
3183
3184 #
3185 # proc Solve_NGSLV_bppivoting_to_int {choice}
3186 #----------------------------------------------------------------------------
3187 # this is a total hack. fix it, probably with an appropriate C primitive.
3188 # assumes the 4 methods of interest are in choices 0-3 and slv7 indexes
3189 # its fmethod choice the same way.
3190 #----------------------------------------------------------------------------
3191 proc Solve_NGSLV_bppivoting_to_int {choice} {
3192 entertrace
3193 global ascSolv7Vect
3194 set i [lsearch -exact $ascSolv7Vect(bppivoting.choices) $choice]
3195 if {$i == -1 || $i >3} {
3196 leavetrace
3197 return 2
3198 }
3199 # leavetrace; return $i
3200 leavetrace
3201 return 2
3202 leavetrace
3203 }
3204
3205 #
3206 # proc Solve_NGSLV_int_to_bppivoting {i}
3207 #----------------------------------------------------------------------------
3208 # this is a total hack. fix it, probably with an appropriate C primitive.
3209 # assumes the 4 methods of interest are in choices 0-3 and slv7 indexes
3210 # its fmethod choice the same way.
3211 #----------------------------------------------------------------------------
3212 proc Solve_NGSLV_int_to_bppivoting {i} {
3213 entertrace
3214 global ascSolv7Vect
3215 if {$i <0 || $i >3} {
3216 leavetrace
3217 return "SPK1/RANKI+COL"
3218 }
3219 set choice "[lindex $ascSolv7Vect(bppivoting.choices) $i]"
3220 leavetrace
3221 return $choice
3222 leavetrace
3223 }
3224
3225 #
3226 # proc Solve_NGSLV_Downdate_ParmBox {}
3227 #----------------------------------------------------------------------------
3228 # this updates C structure from the ascSolv7Vect #
3229 #----------------------------------------------------------------------------
3230 proc Solve_NGSLV_Downdate_ParmBox {} {
3231 entertrace
3232 global ascSolv7Vect ascSolvVect
3233 if {$ascSolvVect(NGSlv) == -1} {
3234 leavetrace
3235 return
3236 }
3237 set_slv_parms $ascSolvVect(NGSlv)\
3238 $ascSolv7Vect(timelimit) \
3239 $ascSolv7Vect(iterationlimit) \
3240 $ascSolv7Vect(termtol) \
3241 $ascSolv7Vect(feastol) \
3242 $ascSolv7Vect(pivottol) \
3243 $ascSolv7Vect(singtol) \
3244 $ascSolv7Vect(stattol) \
3245 $ascSolv7Vect(rho) \
3246 $ascSolv7Vect(partition) \
3247 $ascSolv7Vect(ignorebounds) \
3248 $ascSolv7Vect(showmoreimportant) \
3249 $ascSolv7Vect(showlessimportant) \
3250 "[Solve_NGSLV_bppivoting_to_int $ascSolv7Vect(bppivoting)]" \
3251 $ascSolv7Vect(lifds) \
3252 $ascSolv7Vect(savlin) \
3253 $ascSolv7Vect(relnom) \
3254 $ascSolv7Vect(cutoff) \
3255 $ascSolv7Vect(upjac) \
3256 $ascSolv7Vect(upwts) \
3257 $ascSolv7Vect(upnom) \
3258 $ascSolv7Vect(reduce) \
3259 $ascSolv7Vect(exact) \
3260 $ascSolv7Vect(cncols) \
3261 $ascSolv7Vect(btrunc) \
3262 $ascSolv7Vect(reorder) \
3263 $ascSolv7Vect(safe_calc) \
3264 $ascSolv7Vect(toosmall) \
3265 $ascSolv7Vect(cnlow) \
3266 $ascSolv7Vect(cnhigh) \
3267 $ascSolv7Vect(tobnds) \
3268 $ascSolv7Vect(posdef) \
3269 $ascSolv7Vect(detzero) \
3270 $ascSolv7Vect(steperrmax) \
3271 $ascSolv7Vect(prngmin) \
3272 $ascSolv7Vect(mincoef) \
3273 $ascSolv7Vect(maxcoef) \
3274 $ascSolv7Vect(gradmult)
3275 leavetrace
3276 }
3277
3278
3279 #
3280 # proc Solve_CONOPT_bppivoting_to_int {choice}
3281 #----------------------------------------------------------------------------
3282 # this is a total hack. fix it, probably with an appropriate C primitive.
3283 # assumes the 4 methods of interest are in choices 0-3 and slv3 indexes
3284 # its fmethod choice the same way.
3285 #----------------------------------------------------------------------------
3286 proc Solve_CONOPT_bppivoting_to_int {choice} {
3287 entertrace
3288 global ascSolv8Vect
3289 set i [lsearch -exact $ascSolv8Vect(bppivoting.choices) $choice]
3290 if {$i == -1 || $i >4} {
3291 leavetrace
3292 return 4
3293 }
3294 leavetrace
3295 return $i
3296 leavetrace
3297 }
3298
3299
3300
3301 #
3302 # proc Solve_CONOPT_int_to_bppivoting {i}
3303 #----------------------------------------------------------------------------
3304 # this is a total hack. fix it, probably with an appropriate C primitive.
3305 # assumes the 4 methods of interest are in choices 0-3 and slv3 indexes
3306 # its fmethod choice the same way.
3307 #----------------------------------------------------------------------------
3308 proc Solve_CONOPT_int_to_bppivoting {i} {
3309 entertrace
3310 global ascSolv8Vect
3311 if {$i <0 || $i >4} {
3312 leavetrace
3313 return "Fast-SPK1/RANKI+ROW"
3314 }
3315 set choice "[lindex $ascSolv8Vect(bppivoting.choices) $i]"
3316 leavetrace
3317 return $choice
3318 leavetrace
3319 }
3320
3321
3322 #
3323 # proc Solve_CONOPT_Downdate_ParmBox {}
3324 #----------------------------------------------------------------------------
3325 # this updates C structure from the ascSolv8Vect #
3326 #----------------------------------------------------------------------------
3327 proc Solve_CONOPT_Downdate_ParmBox {} {
3328 entertrace
3329 global ascSolv8Vect ascSolvVect
3330
3331 if {$ascSolvVect(CONOPT) == -1} {
3332 leavetrace
3333 return
3334 }
3335 set_slv_parms $ascSolvVect(CONOPT) \
3336 $ascSolv8Vect(timelimit) \
3337 $ascSolv8Vect(iterationlimit) \
3338 $ascSolv8Vect(termtol) \
3339 $ascSolv8Vect(feastol) \
3340 $ascSolv8Vect(pivottol) \
3341 $ascSolv8Vect(singtol) \
3342 $ascSolv8Vect(stattol) \
3343 $ascSolv8Vect(rho) \
3344 $ascSolv8Vect(partition) \
3345 $ascSolv8Vect(ignorebounds) \
3346 $ascSolv8Vect(showmoreimportant) \
3347 $ascSolv8Vect(showlessimportant) \
3348 "[Solve_CONOPT_bppivoting_to_int $ascSolv8Vect(bppivoting)]" \
3349 $ascSolv8Vect(lifds) \
3350 $ascSolv8Vect(savlin) \
3351 $ascSolv8Vect(relnomscale) \
3352 $ascSolv8Vect(cutoff) \
3353 $ascSolv8Vect(upjac) \
3354 $ascSolv8Vect(upwts) \
3355 $ascSolv8Vect(upnom) \
3356 $ascSolv8Vect(reduce) \
3357 $ascSolv8Vect(exact) \
3358 $ascSolv8Vect(cncols) \
3359 $ascSolv8Vect(btrunc) \
3360 $ascSolv8Vect(reorder) \
3361 $ascSolv8Vect(safe_calc) \
3362 $ascSolv8Vect(uprelnom) \
3363 $ascSolv8Vect(itscalelim) \
3364 $ascSolv8Vect(scaleopt) \
3365 $ascSolv8Vect(toosmall) \
3366 $ascSolv8Vect(cnlow) \
3367 $ascSolv8Vect(cnhigh) \
3368 $ascSolv8Vect(tobnds) \
3369 $ascSolv8Vect(posdef) \
3370 $ascSolv8Vect(detzero) \
3371 $ascSolv8Vect(steperrmax) \
3372 $ascSolv8Vect(prngmin) \
3373 $ascSolv8Vect(mincoef) \
3374 $ascSolv8Vect(maxcoef) \
3375 $ascSolv8Vect(itscaletol)
3376 leavetrace
3377 }
3378
3379 #
3380 # proc Solve_LSSLV_Downdate_ParmBox {}
3381 #----------------------------------------------------------------------------
3382 # this updates C structure from the ascSolv5Vect #
3383 #----------------------------------------------------------------------------
3384 proc Solve_LSSLV_Downdate_ParmBox {} {
3385 entertrace
3386 global ascSolv5Vect ascSolvVect
3387 if {!$ascSolvVect(available.5)} {
3388 leavetrace
3389 return
3390 }
3391 set_slv_parms 5 \
3392 $ascSolv5Vect(timelimit) \
3393 $ascSolv5Vect(iterationlimit) \
3394 $ascSolv5Vect(termtol) \
3395 $ascSolv5Vect(feastol) \
3396 $ascSolv5Vect(pivottol) \
3397 $ascSolv5Vect(singtol) \
3398 $ascSolv5Vect(stattol) \
3399 $ascSolv5Vect(rho) \
3400 $ascSolv5Vect(partition) \
3401 $ascSolv5Vect(ignorebounds) \
3402 $ascSolv5Vect(showmoreimportant) \
3403 $ascSolv5Vect(showlessimportant) \
3404 $ascSolv5Vect(bppivoting) \
3405 $ascSolv5Vect(showlessimportantds) \
3406 $ascSolv5Vect(savlin)
3407 leavetrace
3408 }
3409
3410 #
3411 # proc Solve_MPS_Downdate_ParmBox {}
3412 #----------------------------------------------------------------------------
3413 # this updates C structure from the ascSolv6Vect #
3414 # modified by CWS, 5/95
3415 #----------------------------------------------------------------------------
3416 proc Solve_MPS_Downdate_ParmBox {} {
3417 entertrace
3418
3419 global ascSolv6Vect ascSolvVect
3420
3421 if {!$ascSolvVect(available.6)} {
3422 leavetrace
3423 return
3424 }
3425
3426 # DEBUG:
3427 #puts "Starting Solve_MPS_Downdate_ParmBox"
3428
3429 # update stuff: see mps.tcl
3430 Solve_CloseMakeMPS
3431
3432 set_slv_parms 6 \
3433 $ascSolv6Vect(timelimit) \
3434 $ascSolv6Vect(iterationlimit) \
3435 $ascSolv6Vect(termtol) \
3436 $ascSolv6Vect(feastol) \
3437 $ascSolv6Vect(pivottol) \
3438 $ascSolv6Vect(singtol) \
3439 $ascSolv6Vect(stattol) \
3440 $ascSolv6Vect(rho) \
3441 $ascSolv6Vect(partition) \
3442 $ascSolv6Vect(ignorebounds) \
3443 $ascSolv6Vect(showmoreimportant) \
3444 $ascSolv6Vect(showlessimportant) \
3445 $ascSolv6Vect(bppivoting) \
3446 $ascSolv6Vect(nonlin) \
3447 $ascSolv6Vect(relaxed) \
3448 $ascSolv6Vect(nonneg) \
3449 $ascSolv6Vect(obj) \
3450 $ascSolv6Vect(binary) \
3451 $ascSolv6Vect(integer) \
3452 $ascSolv6Vect(semi) \
3453 $ascSolv6Vect(sos1) \
3454 $ascSolv6Vect(sos2) \
3455 $ascSolv6Vect(sos3) \
3456 $ascSolv6Vect(bo) \
3457 $ascSolv6Vect(eps) \
3458 $ascSolv6Vect(boval) \
3459 $ascSolv6Vect(epsval) \
3460 $ascSolv6Vect(pinf) \
3461 $ascSolv6Vect(minf) \
3462 $ascSolv6Vect(mpsname)
3463
3464 leavetrace
3465 }
3466
3467 #
3468 # proc Solve_MINOS_Downdate_ParmBox {}
3469 #----------------------------------------------------------------------------
3470 # this updates C structure from the ascSolv0Vect #
3471 #----------------------------------------------------------------------------
3472 proc Solve_MINOS_Downdate_ParmBox {} {
3473 entertrace
3474 global ascSolv1Vect ascSolvVect
3475 if {!$ascSolvVect(available.1)} {
3476 leavetrace
3477 return
3478 }
3479 set jflxb 0
3480 if {$ascSolv1Vect(printJ)} {
3481 set jflxb 10000
3482 }
3483 if {$ascSolv1Vect(printF)} {
3484 set jflxb [expr $jflxb+1000]
3485 }
3486 if {$ascSolv1Vect(printL)} {
3487 set jflxb [expr $jflxb+100]
3488 }
3489 if {$ascSolv1Vect(printX)} {
3490 set jflxb [expr $jflxb+10]
3491 }
3492 if {$ascSolv1Vect(printB)} {
3493 set jflxb [expr $jflxb+1]
3494 }
3495 set_slv_parms 1 \
3496 $ascSolv1Vect(timelimit) \
3497 $ascSolv1Vect(majits) \
3498 0 \
3499 $ascSolv1Vect(tolfeas) \
3500 0 \
3501 $ascSolv1Vect(tolsing) \
3502 $ascSolv1Vect(tolstat) \
3503 $ascSolv1Vect(rho) \
3504 0 \
3505 0 \
3506 $ascSolv1Vect(showmoreimportant) \
3507 $ascSolv1Vect(showlessimportant) \
3508 0 \
3509 $ascSolv1Vect(completion) \
3510 $ascSolv1Vect(minits) \
3511 $ascSolv1Vect(crash) \
3512 $ascSolv1Vect(deriv) \
3513 $ascSolv1Vect(cfreq) \
3514 $ascSolv1Vect(ffreq) \
3515 $ascSolv1Vect(uselg) \
3516 $ascSolv1Vect(lfreq) \
3517 $ascSolv1Vect(mulpr) \
3518 $ascSolv1Vect(parpr) \
3519 $jflxb \
3520 $ascSolv1Vect(scale) \
3521 $ascSolv1Vect(soln) \
3522 $ascSolv1Vect(param) \
3523 $ascSolv1Vect(verify) \
3524 $ascSolv1Vect(efreq) \
3525 $ascSolv1Vect(summary) \
3526 $ascSolv1Vect(filesumm) \
3527 1 \
3528 $ascSolv1Vect(damp) \
3529 $ascSolv1Vect(fdiff) \
3530 $ascSolv1Vect(cdiff) \
3531 $ascSolv1Vect(fprec) \
3532 $ascSolv1Vect(lstol) \
3533 $ascSolv1Vect(lufto) \
3534 $ascSolv1Vect(luuto) \
3535 $ascSolv1Vect(radius) \
3536 $ascSolv1Vect(subsp) \
3537 $ascSolv1Vect(objlim) \
3538 $ascSolv1Vect(steplm) \
3539 $ascSolv1Vect(lobjwt) \
3540 $ascSolv1Vect(mindamp) \
3541 $ascSolv1Vect(ludto) \
3542 $ascSolv1Vect(lusto) \
3543 $ascSolv1Vect(luwto)
3544 leavetrace
3545 }
3546 #
3547 # proc Solve_MINOS_Update_ParmBox {}
3548 #----------------------------------------------------------------------------
3549 # this updates ascSolv1Vect variables from the C structure #
3550 # if minos not linked, ignores leavetrace; return from C
3551 #----------------------------------------------------------------------------
3552 proc Solve_MINOS_Update_ParmBox {} {
3553 entertrace
3554 global ascSolv1Vect
3555 set tmplist [slv_get_parms 1]
3556 if { [llength $tmplist]==49 && [lindex $tmplist 0]==1} {
3557 set ascSolv1Vect(timelimit) [lindex $tmplist 1]
3558 set ascSolv1Vect(iterationlimit) [lindex $tmplist 2]
3559 set ascSolv1Vect(tolfeas) [lindex $tmplist 4]
3560 set ascSolv1Vect(tolsing) [lindex $tmplist 6]
3561 set ascSolv1Vect(tolstat) [lindex $tmplist 7]
3562 set ascSolv1Vect(rho) [lindex $tmplist 8]
3563 set ascSolv1Vect(showmoreimportant) [lindex $tmplist 11]
3564 set ascSolv1Vect(showlessimportant) [lindex $tmplist 12]
3565 set ascSolv1Vect(completion) [lindex $tmplist 14]
3566 set ascSolv1Vect(minits) [lindex $tmplist 15]
3567 set ascSolv1Vect(crash) [lindex $tmplist 16]
3568 set ascSolv1Vect(deriv) [lindex $tmplist 17]
3569 set ascSolv1Vect(cfreq) [lindex $tmplist 18]
3570 set ascSolv1Vect(ffreq) [lindex $tmplist 19]
3571 set ascSolv1Vect(uselg) [lindex $tmplist 20]
3572 set ascSolv1Vect(lfreq) [lindex $tmplist 21]
3573 set ascSolv1Vect(mulpr) [lindex $tmplist 22]
3574 set ascSolv1Vect(parpr) [lindex $tmplist 23]
3575 set jflxb [lindex $tmplist 24]
3576 set ascSolv1Vect(scale) [lindex $tmplist 25]
3577 set ascSolv1Vect(soln) [lindex $tmplist 26]
3578 set ascSolv1Vect(param) [lindex $tmplist 27]
3579 set ascSolv1Vect(verify) [lindex $tmplist 28]
3580 set ascSolv1Vect(efreq) [lindex $tmplist 29]
3581 set ascSolv1Vect(summary) [lindex $tmplist 30]
3582 set ascSolv1Vect(filesumm) [lindex $tmplist 31]
3583
3584 # set ascSolv1Vect(lcons) [lindex $tmplist 32]
3585 set ascSolv1Vect(lcons) 1
3586
3587 set ascSolv1Vect(damp) [lindex $tmplist 33]
3588 set ascSolv1Vect(fdiff) [lindex $tmplist 34]
3589 set ascSolv1Vect(cdiff) [lindex $tmplist 35]
3590 set ascSolv1Vect(fprec) [lindex $tmplist 36]
3591 set ascSolv1Vect(lstol) [lindex $tmplist 37]
3592 set ascSolv1Vect(lufto) [lindex $tmplist 38]
3593 set ascSolv1Vect(luuto) [lindex $tmplist 39]
3594 set ascSolv1Vect(radius) [lindex $tmplist 40]
3595 set ascSolv1Vect(subsp) [lindex $tmplist 41]
3596 set ascSolv1Vect(objlim) [lindex $tmplist 42]
3597 set ascSolv1Vect(steplm) [lindex $tmplist 43]
3598 set ascSolv1Vect(lobjwt) [lindex $tmplist 44]
3599 set ascSolv1Vect(damp) [lindex $tmplist 45]
3600 set ascSolv1Vect(ludto) [lindex $tmplist 46]
3601 set ascSolv1Vect(lusto) [lindex $tmplist 47]
3602 set ascSolv1Vect(luwto) [lindex $tmplist 48]
3603 # take apart a 5 digit binary number
3604 foreach i {printJ printX printB printL printF} {
3605 set ascSolv1Vect($i) 0
3606 }
3607 if {[string length $jflxb]==5} {
3608 set ascSolv1Vect(printJ) 1
3609 set jflxb [expr 1* [string range $jflxb 1 end]]
3610 }
3611 if {[string length $jflxb]==4} {
3612 set ascSolv1Vect(printF) 1
3613 set jflxb [expr 1* [string range $jflxb 1 end]]
3614 }
3615 if {[string length $jflxb]==3} {
3616 set ascSolv1Vect(printL) 1
3617 set jflxb [expr 1* [string range $jflxb 1 end]]
3618 }
3619 if {[string length $jflxb]==2} {
3620 set ascSolv1Vect(printX) 1
3621 set jflxb [expr 1* [string range $jflxb 1 end]]
3622 }
3623 if {$jflxb==1} {
3624 set ascSolv1Vect(printB) 1
3625 }
3626 } else {
3627 puts "Error in MINOS call to slv_get_parms"
3628 }
3629 leavetrace
3630 }
3631
3632 # proc Solve_OPTSQP_Downdate_ParmBox {}
3633 #----------------------------------------------------------------------------
3634 # this updates C structure from the ascSolv2Vect #
3635 #----------------------------------------------------------------------------
3636 proc Solve_OPTSQP_Downdate_ParmBox {} {
3637 entertrace
3638 global ascSolv2Vect ascSolvVect
3639 if {!$ascSolvVect(available.2)} {
3640 leavetrace
3641 return
3642 }
3643 set_slv_parms 2 \
3644 $ascSolv2Vect(timelimit) \
3645 $ascSolv2Vect(iterationlimit) \
3646 0 \
3647 0 \
3648 0 \
3649 0 \
3650 0 \
3651 0 \
3652 0 \
3653 0 \
3654 $ascSolv2Vect(showmoreimportant) \
3655 0 \
3656 $ascSolv2Vect(linesearch) \
3657 $ascSolv2Vect(iscale) \
3658 $ascSolv2Vect(ichoose) \
3659 $ascSolv2Vect(imult) \
3660 $ascSolv2Vect(isafe) \
3661 $ascSolv2Vect(icorr) \
3662 $ascSolv2Vect(kprint) \
3663 $ascSolv2Vect(iiexact) \
3664 $ascSolv2Vect(idebug) \
3665 $ascSolv2Vect(eps) \
3666 $ascSolv2Vect(vv)
3667 leavetrace
3668 }
3669
3670 #
3671 # proc Solve_OPTSQP_Update_ParmBox {}
3672 #----------------------------------------------------------------------------
3673 # this updates ascSolv2Vect variables from the C structure #
3674 #----------------------------------------------------------------------------