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

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

Parent Directory Parent Directory | Revision Log Revision Log


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