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

Annotation of /trunk/ascend4/TK/ascStudy.tcl

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1 - (hide annotations) (download) (as text)
Fri Oct 29 20:54:12 2004 UTC (17 years, 8 months ago) by aw0a
File MIME type: text/x-tcl
File size: 23079 byte(s)
Setting up web subdirectory in repository
1 aw0a 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