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

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

Parent Directory Parent Directory | Revision Log Revision Log


Revision 10 - (show annotations) (download) (as text)
Sat Nov 13 16:40:11 2004 UTC (17 years ago) by aw0a
File MIME type: text/x-tcl
File size: 23079 byte(s)
try again to commit moving tcl stuff
1 # ascStudy.tcl: Script for handling case studies
2 # By Benjamin Allan
3 # Created: January 1998
4 # Part of ASCEND
5 # Revision: $Revision: 1.6 $
6 # Last modified on: $Date: 1998/06/18 15:55:12 $
7 # Last modified by: $Author: mthomas $
8 # Revision control file: $RCSfile: ascStudy.tcl,v $
9 #
10 # This file is part of the ASCEND Tcl/Tk Interface.
11 #
12 # Copyright (C) 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 # Script for handling case studies of the form:
30 # STUDY {annual_profit} {tc.conv} {tc.fs.fl1.vap_to_feed_ratio} \
31 # IN tfc VARYING {tc.fs.sp1.split[1] 0.1 0.2 0.3 0.4 0.5 0.6 0.7} \
32 # USING {QRSlv} OUTFILE study.dat ERROR stop;
33 #
34 # This could be connected to interactivity through ascplot, and should.
35 # But first we script it.
36
37 proc Study_keyword {word} {
38 switch [string tolower $word] {
39 study -
40 in -
41 varying -
42 cases -
43 using -
44 outfile -
45 error {
46 return 1;
47 }
48 default {
49 return 0;
50 }
51 }
52 }
53
54 proc Study_syntax {} {
55 puts stderr "syntax:\
56 STUDY variable-list \\\n\tIN simulation-context \\\n\
57 \tVARYING parameter-variation-list \\\n\
58 \tUSING solver-name OUTFILE disk-file-name \\\n\
59 \tERROR <STOP,IGNORE,WARN>;"
60
61 puts stderr "For example:"
62 puts stderr "Variable-list could be: {annual_cost} {recycle_rate}"
63 puts stderr \
64 "Simulation-context could be: {myflowsheet.plant2.reactor\[4\]}"
65 puts stderr "Parameter-variation-list could be items that look like:"
66 puts stderr "\t{purge_rate {0.01 {mole/s}} {0.02 {mole/s}}}"
67 puts stderr "Solver-name: one of the Solver names available, eg. QRSlv."
68 puts stderr "Disk-File-Name could be: {c:\\temp\\mystudy.dat}"
69 puts stderr \
70 "ERROR specifies what you want the study to do if a case cannot solve."
71 error "Parametric case study specified incorrectly"
72 }
73
74 # proc study
75 # STUDY varlist IN rootname VARYING var-range-list
76 # USING solvername OUTFILE pathname ERROR <STOP,IGNORE,WARN,userfunc>;
77 # notes:
78 # it's big, it's ugly, it's a parser, you expect miracles?
79 #
80 proc STUDY {args} {
81 global ascStudyVect ;# for autoplot only
82 # parse states:
83 # 0 varlist, 1 rootname, 2 var-range, 3 solver, 4 path, 5 errhandle
84 set mode 0;
85 set rootname -1
86 set vstart -1
87 set vend -1
88 set vrstart -1
89 set vrend -1
90 set solvername -1
91 set pathname -1
92 set error -1
93 set counter -1
94 foreach i $args {
95 incr counter
96 if {[Study_keyword $i]} {
97 # check keyword order and change modes
98 switch $mode {
99 0 {
100 if {$vstart < 0} {
101 puts stderr \
102 "STUDY keyword $i not allowed before variable list."
103 Study_syntax
104 }
105 if {[string compare "in" [string tolower $i]] == 0} {
106 set mode 1
107 continue;
108 }
109 puts stderr "STUDY keyword $i not allowed before IN"
110 Study_syntax
111 }
112 1 {
113 if {[string compare $rootname "-1"]==0} {
114 puts stderr \
115 "STUDY needs a simulation or part name to search for vars."
116 Study_syntax
117 }
118 if {[string compare "varying" [string tolower $i]] == 0} {
119 set mode 2
120 continue;
121 }
122 puts stderr "STUDY keyword $i not allowed before VARYING"
123 Study_syntax
124 }
125 2 {
126 if {$vrstart < 0} {
127 puts stderr \
128 "STUDY keyword $i not allowed before parameter list."
129 Study_syntax
130 }
131 if {[string compare "using" [string tolower $i]] == 0} {
132 set mode 3
133 continue;
134 }
135 puts stderr "STUDY keyword $i not allowed before USING"
136 Study_syntax
137 }
138 3 {
139 if {[string compare $solvername "-1"]==0} {
140 puts stderr \
141 "STUDY needs the name of a known solver to use before $i"
142 Study_syntax
143 }
144 if {[string compare "outfile" [string tolower $i]] == 0} {
145 set mode 4
146 continue;
147 }
148 puts stderr "STUDY keyword $i not allowed before OUTFILE"
149 Study_syntax
150 }
151 4 {
152 if {[string compare $pathname "-1"]==0} {
153 puts stderr "STUDY needs the name of a file to use before $i"
154 Study_syntax
155 }
156 if {[string compare "error" [string tolower $i]] == 0} {
157 set mode 5
158 continue;
159 }
160 puts stderr "STUDY keyword $i not allowed before ERROR keyword"
161 Study_syntax
162 }
163 default {
164 puts stderr "Unrecognized or misplaced keyword $i"
165 Study_syntax;
166 break;
167 }
168 }
169 } else {
170 # eat an argument for the current mode.
171 # 0 varlist, 1 rootname, 2 par-range, 3 solver, 4 path, 5 errhandle
172 switch $mode {
173 0 {
174 if {$vend >= 0} {
175 incr vend
176 } else {
177 set vstart $counter
178 set vend $counter
179 }
180 }
181 1 {
182 if {[string compare $rootname "-1"]==0} {
183 set rootname $i;
184 # check instance exists, is MODEL/array of MODEL
185 } else {
186 puts stderr "STUDY given more than 1 rootname:"
187 puts stderr "\t$rootname"
188 puts stderr "\t$i"
189 Study_syntax
190 }
191 }
192 2 {
193 if {$vrend >= 0} {
194 incr vrend
195 } else {
196 set vrstart $counter
197 set vrend $counter
198 }
199 }
200 3 {
201 if {[string compare $solvername "-1"]==0} {
202 set solvername $i;
203 # check solver exists
204 } else {
205 puts stderr "STUDY given more than 1 solver name:"
206 puts stderr "\t$solvername"
207 puts stderr "\t$i"
208 Study_syntax
209 }
210 }
211 4 {
212 if {[string compare $pathname "-1"]==0} {
213 set pathname $i;
214 # check path is writable
215 } else {
216 puts stderr "STUDY given more than 1 disk file name:"
217 puts stderr "\t$pathname"
218 puts stderr "\t$i"
219 puts stderr "\tPerhaps the path needs {} around it."
220 Study_syntax
221 }
222 }
223 5 {
224 if {[string compare $error "-1"]==0} {
225 set error $i;
226 # check error is in list
227 } else {
228 puts stderr \
229 "STUDY given more than 1 error handling specification:"
230 puts stderr "\t$error"
231 puts stderr "\t$i"
232 Study_syntax
233 }
234 }
235 default {
236 puts stderr "Unknown STUDY parser state at $i"
237 Study_syntax
238 }
239 }
240 }
241 }
242 # 0 varlist, 1 rootname, 2 par-range, 3 solver, 4 path, 5 errhandle
243 if {$vstart < 0} {
244 puts stderr "STUDY missing output variable list"
245 Study_syntax
246 }
247 if {[string compare $rootname "-1"]==0} {
248 puts stderr "STUDY missing simulation or part context name"
249 Study_syntax
250 }
251 if {$vrstart < 0} {
252 puts stderr "STUDY missing parameter variation list"
253 Study_syntax
254 }
255 if {[string compare $solvername "-1"]==0} {
256 puts stderr "STUDY missing solver name"
257 Study_syntax
258 }
259 if {[string compare $pathname "-1"]==0} {
260 puts stderr "STUDY missing output file name"
261 Study_syntax
262 }
263 if {[string compare $error "-1"]==0} {
264 puts stderr "STUDY missing error handling specification"
265 Study_syntax
266 }
267 # vstart -1 set vend -1 set vrstart -1 set vrend -1
268 # collect vstart to vend in a userdata and vrstart to vrend also
269 # write recursive tcl function to vary over vrlist and generate
270 # potentially multidimensional independent variable data sets.
271 # iterate over vrend fastest, vrstart slowest, save last successful
272 # solution at each level by read/write virtual for recoveries.
273 # bypass ui updates except at solution or really long times.
274 # pop up a little box with cases solved, cases failed and update
275 # only these vars. watch ^C. if hit twice in same case, stop.
276 puts stderr "STUDY $args"
277 puts -nonewline "STUDY "
278 puts [lrange $args $vstart $vend]
279 puts stderr "IN $rootname"
280 puts -nonewline "VARYING "
281 puts [lrange $args $vrstart $vrend]
282 puts stderr "USING $solvername"
283 puts stderr "OUTFILE $pathname"
284 puts stderr "ERROR $error"
285 # check da solver option
286 if {[lsearch [string tolower [slv_available]] \
287 [string tolower $solvername]] == -1} {
288 puts stderr "STUDY cannot use unknown solver $solvername"
289 puts stderr "Known solvers are: [slv_available]."
290 Study_syntax
291 }
292 # check da error option
293 set handler funcdummy
294 switch [string tolower $error] {
295 ignore {
296 set handler Study_ignore
297 }
298 stop {
299 set handler Study_stop
300 }
301 warn {
302 set handler Study_warn
303 }
304 default {
305 puts stderr "STUDY ERROR option must be one of: IGNORE, WARN, STOP"
306 Study_syntax
307 }
308 }
309 # check da file option
310 # could add an append option later
311 if {[file exists $pathname]} {
312 if {![file writable $pathname] || [file isdir $pathname]} {
313 puts stderr "STUDY cannot write to file $pathname."
314 Study_syntax
315 }
316 } else {
317 if {[catch {open $pathname w+} ferr]} {
318 puts stderr "STUDY cannot write to file $pathname:\n$ferr"
319 Study_syntax
320 } else {
321 close $ferr
322 }
323 }
324 set outlist {}
325 set parlist {}
326 # set up independent variables in left columns
327 foreach i [lrange $args $vrstart $vrend] {
328 lappend outlist $rootname.[lindex $i 0]
329 lappend parlist $rootname.[lindex $i 0]
330 }
331 # set up dependent variables in right columns
332 foreach i [lrange $args $vstart $vend] {
333 lappend outlist $rootname.$i
334 }
335 # set a log gl_list in C land
336 foreach i $outlist {
337 if {[catch {qlfdid $i} errmsg]} {
338 puts stderr "STUDY cannot find variable $i"
339 Study_syntax
340 } else {
341 switch [inst kind search] {
342 BOOLEAN_INST -
343 REAL_INST -
344 INTEGER_INST -
345 SYMBOL_INST -
346 SET_ATOM_INST -
347 WHEN_INST -
348 MODEL_INST -
349 ARRAY_INT_INST -
350 ARRAY_ENUM_INST {
351 puts stderr "STUDY cannot monitor non-variable:\n\t$i"
352 Study_syntax
353 }
354 BOOLEAN_ATOM_INST -
355 SYMBOL_ATOM_INST {
356 puts stderr "STUDY cannot monitor discrete variables yet:\n\t$i"
357 return
358 }
359 }
360 }
361 }
362 # check for relevant and fixed and assignable as given
363 set counter [expr $vrstart -1]
364 foreach i $parlist {
365 incr counter;
366 qlfdid $i;
367 switch [inst kind search] {
368 REAL_ATOM_INST {
369 # check if solvervar and fixed != TRUE -> error.
370 if {[lsearch [libr_query -ancestors -type [inst type search]] \
371 solver_var] != -1 && \
372 [catch {qlfdid $i.fixed} errmessage] == 0 && \
373 [string compare [inst atomvalue search] "TRUE"]} {
374 puts stderr "STUDY: Unfixed parameter $i. $i.fixed must be TRUE"
375 return
376 }
377 qlfdid $i;
378 set check 0
379 set oldval [inst atomvalue search]
380 foreach tuple [lrange [lindex $args $counter] 1 end] {
381 if {[ catch {
382 qassgn2 $i [lindex $tuple 0] [lindex $tuple 1]
383 } errmsg
384 ]} {
385 puts stderr "Unable to assign value $tuple to $i because:"
386 puts stderr "\t$errmsg"
387 return
388 } else {
389 incr check
390 }
391 }
392 catch {qassgn2 $i [lindex $oldval 0] [lindex $oldval 1]}
393 if {$check == 0} {
394 puts stderr "No case values specified for parameter $i"
395 Study_syntax
396 }
397 }
398 BOOLEAN_ATOM_INST -
399 INTEGER_ATOM_INST -
400 SYMBOL_ATOM_INST {
401 puts stderr "Incorrect parameter $i."
402 puts stderr "STUDY over discrete parameters not yet supported."
403 puts stderr "Fix ascStudy.tcl"
404 return
405 }
406 BOOLEAN_INST {
407 puts stderr "Incorrect parameter $i."
408 puts stderr "STUDY over degrees of freedom is not supported."
409 return
410 }
411 default {
412 puts stderr "STUDY parameter $i cannot affect solution."
413 return
414 }
415 }
416 }
417 # So vars/parameters/file/error and solver are ok.
418 # set global array of iteration information
419 # call recursive function head to set values and call solver
420 # f {rootname, oblistid, args, vrstart, vrend, solvername}
421 set oblist [asc_study_create_observations]
422 foreach i $outlist {
423 asc_study_add_observation $oblist $i
424 }
425 if {[catch {asc_study_observations_file $oblist $pathname} errm]} {
426 puts stderr "STUDY unable to start log file $pathname"
427 return;
428 }
429 set noplot [catch {Study_cases $oblist $rootname $solvername \
430 $vrstart $vrend \
431 $parlist $args $handler} err]
432 puts stderr $err
433 asc_study_destroy_observations $oblist
434 if {!$noplot && $ascStudyVect(autoplot)} {
435 ASCPLOT $pathname
436 }
437 }
438
439 # args are:
440 # C id oblistid, rootinst of solve system, solver, index of
441 # parameter this call will vary over, index of last parameter,
442 # list of varied parameters
443 # argument list from the call to STUDY, error handling function.
444 #
445 global ascStudyVect
446
447 # set up study constants and message protocols, then call recursion
448 proc Study_cases {oblistid rootinst solver vrstart \
449 vrend parlist pardata handler} {
450 global ascStudyVect ascSolv32767Vect
451 set ascStudyVect(autoplot) 0
452 set ascStudyVect(nextobs) 0
453 set ascStudyVect(tried) 0
454 set ascStudyVect(failed) 0
455 set ascStudyVect(lastsolution) study_virtual_file
456 if {[__userdata_query exists $ascStudyVect(lastsolution)]} {
457 __userdata_destroy one $ascStudyVect(lastsolution)
458 }
459 # most times to repush the solve button magically
460 set ascStudyVect(retrymax) 5
461 # if writeset 0, does not write line of junk at END of solution attempt
462 set ascStudyVect(writeset) 1
463 set ascStudyVect(vrstart) $vrstart
464 set ascStudyVect(vrend) $vrend
465 set counter $vrstart
466 foreach i $parlist {
467 set ascStudyVect($counter) $i
468 incr counter
469 }
470 # override the general UI speed parameters
471 # these should perhaps become persistent general options
472 set ascStudyVect(lasttime) $ascSolv32767Vect(update_time)
473 set ascStudyVect(lastfreq) $ascSolv32767Vect(update_frequency)
474 set ascStudyVect(timelimit) 15
475 set ascStudyVect(iterlimit) 200
476 set ascSolv32767Vect(update_time) $ascStudyVect(timelimit)
477 set ascSolv32767Vect(update_frequency) $ascStudyVect(iterlimit)
478 # do it
479 if {[catch {Study_cases_recursion $oblistid $rootinst $solver \
480 $vrstart $vrend $pardata $handler} err]} {
481 puts "SCR fail: $err"
482 error $err
483 }
484 set ascSolv32767Vect(update_time) $ascStudyVect(lasttime)
485 set ascSolv32767Vect(update_frequency) $ascStudyVect(lastfreq)
486 return "CASE STUDIES completed"
487 }
488
489 # stops on interrupt, OTHERWISE, just suppresses bogus data
490 # output and moves back to last solution and moves back to last solution.
491 proc Study_ignore {root} {
492 global ascSolvStatVect ascStudyVect
493 if {$ascSolvStatVect(menubreak)} {
494 error "USER halted case-studies"
495 }
496 incr ascStudyVect(failed)
497 set ascStudyVect(writeset) 0
498 puts stderr "Case $ascStudyVect(tried) failed. Output ignored."
499 READ_VIRTUAL $ascStudyVect(lastsolution)
500 }
501
502 # stops on interrupt. composes a failure message, and sends it to user
503 # reloads last saved point. suppresses output of failure point.
504 # then returns for continuation of cases
505 proc Study_warn {root} {
506 global ascSolvStatVect ascStudyVect
507 set ascStudyVect(writeset) 0
508 incr ascStudyVect(failed)
509 if {$ascSolvStatVect(menubreak)} {
510 error "USER halted case-studies"
511 } else {
512 set msg "Warning of unsolved case $ascStudyVect(tried). "
513 append msg "Output suppressed. Parameters:"
514 for {set i $ascStudyVect(vrstart); $i <= $ascStudyVect(vrend); incr i} {
515 append msg "\n\t$ascStudyVect(par_$i) = $ascStudyVect($i)"
516 }
517 puts stderr $msg; # should be popup
518 }
519 # should offer a popup that lets user choose to keep last or
520 # examine failure point.
521 READ_VIRTUAL $ascStudyVect(lastsolution)
522 }
523
524 # stops on interrupt, composes a failure message, and returns it as
525 # an error. clears last saved point buffer, as it is assumed the
526 # user will want to see a failure point. this is not necessarily
527 # a good assumption. suppresses output of failure point.
528 proc Study_stop {root} {
529 global ascSolvStatVect ascStudyVect
530 incr ascStudyVect(failed)
531 set ascStudyVect(writeset) 0
532 if {$ascSolvStatVect(menubreak)} {
533 error "USER halted case-studies"
534 } else {
535 set msg "Stopping at unsolved case $ascStudyVect(tried). Values:"
536 for {set i $ascStudyVect(vrstart); $i <= $ascStudyVect(vrend); incr i} {
537 append msg "\n\t$ascStudyVect(par_$i) = $ascStudyVect($i)"
538 }
539 error $msg
540 }
541 # should offer a popup that lets user choose to keep last or
542 # examine failure point.
543 __userdata_destroy one $ascStudyVect(lastsolution)
544 }
545
546 proc Study_extra_iterations {} {
547 global ascStudyVect
548 puts stderr "STUDY: extra iterations on case $ascStudyVect(tried)."
549 }
550
551 # solves all cases. iterates fastest over last parameter given.
552 # so VARYING {a {1} {2} {3}} {b {4} {6}} will yield output that
553 # looks like (if foo is the output variables being monitored)
554 # 1 4 foo
555 # 1 6 foo
556 # 2 4 foo
557 # 2 6 foo
558 # 3 4 foo
559 # 3 6 foo
560 #
561 proc Study_cases_recursion {oblistid rootinst solver currentpar \
562 lastpar pardata handler} {
563 global ascStudyVect ascSolvStatVect
564 # puts "SCRin: $oblistid $rootinst $solver $currentpar $lastpar"
565 set i $ascStudyVect($currentpar);
566 qlfdid $i;
567 if {$lastpar <= $currentpar} {
568 foreach tuple [lrange [lindex $pardata $lastpar] 1 end] {
569 set counter 0
570 qassgn2 $i [lindex $tuple 0] [lindex $tuple 1]
571 set ascStudyVect(par_$lastpar) $tuple ;# for messages
572 WRITE_VIRTUAL $rootinst $ascStudyVect(lastsolution)
573 incr ascStudyVect(tried)
574 # probably need a catch here.
575 SOLVE $rootinst WITH $solver;
576 while {$ascSolvStatVect(ready2solve) &&
577 !$ascSolvStatVect(menubreak) &&
578 $counter < $ascStudyVect(retrymax)} {
579 incr counter
580 Study_extra_iterations
581 Solve_do_Solve $rootinst WITH $solver;
582 }
583 # should catch {RUN inst.check_self} here and include that
584 # in the RUN part. make check optional and user defined?
585 if {$ascSolvStatVect(converged) != 1} {
586 $handler $rootinst
587 }
588 __userdata_destroy one $ascStudyVect(lastsolution)
589 if {$ascStudyVect(writeset)} {
590 asc_study_write_observation $oblistid
591 } else {
592 # suppressed. unsuppress for next point.
593 set ascStudyVect(writeset) 1
594 }
595 }
596 } else {
597 # may need some catch/err foo here to avoid deep stack messages.
598 set nextpar $currentpar
599 incr nextpar
600 foreach tuple [lrange [lindex $pardata $currentpar] 1 end] {
601 qassgn2 $i [lindex $tuple 0] [lindex $tuple 1]
602 set ascStudyVect(par_$currentpar) $tuple ;# for messages
603 Study_cases_recursion $oblistid $rootinst $solver $nextpar \
604 $lastpar $pardata $handler
605 }
606 }
607 }
608
609 # set to 0 if in ascend
610 if 0 {
611 global ascSolv32767Vect
612 set ascSolv32767Vect(update_frequency) 10
613 set ascSolv32767Vect(update_time) 10
614 proc qlfdid {args} {
615 puts "qlfdid $args"
616 }
617 proc inst {what where} {
618 switch $what {
619 type { return solver_var }
620 kind { return REAL_ATOM_INST }
621 atomvalue { return TRUE }
622 }
623 }
624 proc libr_type_ancestors {args} {
625 return solver_var
626 }
627 proc SOLVE {args} {
628 global ascSolvStatVect
629 set ascSolvStatVect(ready2solve) 0
630 set ascSolvStatVect(converged) 1
631 set ascSolvStatVect(menubreak) 0
632 }
633 proc qassgn2 {args} {
634 puts "assign $args"
635 }
636 proc Solve_do_Solve {args} {
637 SOLVE
638 }
639 proc slv_available {} {
640 return "QRSlv CONOPT"
641 }
642 proc READ_VIRTUAL {args} {
643 puts "LOAD $args"
644 }
645 proc WRITE_VIRTUAL {args} {
646 puts "SAVE $args"
647 }
648 proc __userdata_destroy {args} {
649 puts "destroy $args"
650 }
651 proc __userdata_query {args} {
652 return 1
653 }
654 }
655 # set 0 when implemented in C as
656 # set token [asc_study -create]
657 # asc_study -add $token $qlfdid
658 # asc_study -destroy [$token,all]
659 # asc_study -prolog $token $filename
660 # asc_study -write $token
661 if 1 {
662 set ascStudyVect(nextobs) 0
663 # closes output file and destroys tcl overhead
664 proc asc_study_destroy_observations {num} {
665 global __asvdata
666 close $__asvdata(fid.$num)
667 catch {unset $__asvdata(fid.$num)} err
668 # catch {unset $__asvdata(file.$num)} err
669 # catch {unset $__asvdata(nobs.$num)} err
670 # catch {unset $__asvdata(obslist.$num)} err
671 }
672 # writes a line of values to an already setup observation file
673 proc asc_study_write_observation {num} {
674 global __asvdata
675 set fid $__asvdata(fid.$num)
676 foreach i $__asvdata(obslist.$num) {
677 puts -nonewline $fid "\t"
678 puts -nonewline $fid [lindex [lindex [u_getval $i] 0] 0]
679 }
680 puts $fid ""
681 }
682 # opens file and writes header. vars must be defined first.
683 proc asc_study_observations_file {num fname} {
684 global __asvdata ascStudyVect
685 set __asvdata(file.$num) $fname
686 set __asvdata(fid.$num) [open $fname w+]
687 set fid $__asvdata(fid.$num)
688 set datevar [clock format [clock seconds] -format "%a %b %d %H:%M:%S %Y"]
689 puts $fid "DATASET $datevar"
690 puts $fid "Observations: (user index) (name) (units)"
691 set var [lindex $__asvdata(obslist.$num) 0]
692 set units [lindex [lindex [u_getval $var] 0] 1]
693 puts $fid "{indvar}\t\{[lindex $__asvdata(obslist.$num) 0]\}\t\{$units\}"
694 for {set i 1} {$i < $__asvdata(nobs.$num)} {incr i} {
695 set var [lindex $__asvdata(obslist.$num) $i]
696 set units [lindex [lindex [u_getval $var] 0] 1]
697 puts $fid "\{$i\}\t\{$var\}\t\{$units\}"
698 }
699 puts -nonewline $fid "\tindvar"
700 for {set i 1} {$i < $__asvdata(nobs.$num)} {incr i} {
701 puts -nonewline $fid "\t$i"
702 }
703 puts $fid ""
704 for {set i 0} {$i < $__asvdata(nobs.$num)} {incr i} {
705 puts -nonewline $fid "\t---"
706 }
707 puts $fid ""
708 }
709 # adds an observation to the list studied
710 proc asc_study_add_observation {num var} {
711 global __asvdata
712 lappend __asvdata(obslist.$num) $var
713 incr __asvdata(nobs.$num)
714 }
715 # sets up output overhead
716 proc asc_study_create_observations {args} {
717 global ascStudyVect __asvdata
718 incr ascStudyVect(nextobs)
719 set __asvdata(fid.$ascStudyVect(nextobs)) stdout
720 set __asvdata(file.$ascStudyVect(nextobs)) ""
721 set __asvdata(nobs.$ascStudyVect(nextobs)) 0
722 set __asvdata(obslist.$ascStudyVect(nextobs)) {}
723 return $ascStudyVect(nextobs)
724 }
725 };#END dummies

john.pye@anu.edu.au
ViewVC Help
Powered by ViewVC 1.1.22