/[ascend]/trunk/models/test/blackbox/bboxtest.c
ViewVC logotype

Contents of /trunk/models/test/blackbox/bboxtest.c

Parent Directory Parent Directory | Revision Log Revision Log


Revision 1039 - (show annotations) (download) (as text)
Thu Jan 4 23:21:20 2007 UTC (15 years, 7 months ago) by johnpye
File MIME type: text/x-csrc
File size: 8365 byte(s)
Fixed up some #includes in compiler .[ch] files.
Switched instantiate.c to using 'asc_assert' instead of 'assert'.
Added some missing GPL headers in C++ code.
Silenced some slv3.c debug output.
Switch void-return to int-return in slv9_presolve etc (slv9.c)
Attemping to fix solvernotes.py for the commandline environment (browser==None)
Removed redundant solve(SELF) in thermalequilibrium2.a4c.
Some error reporting from addone_calc (extfntest.c).
Expanded test size in extrelfor.a4c.
Big rearrangement of bboxtest.c for top-down style.
Fixed TestFreesteam.testintegrator, added end-value checks.

1 /* ASCEND modelling environment
2 Copyright (C) 2006 Carnegie Mellon University
3
4 This program is free software; you can redistribute it and/or modify
5 it under the terms of the GNU General Public License as published by
6 the Free Software Foundation; either version 2, or (at your option)
7 any later version.
8
9 This program is distributed in the hope that it will be useful,
10 but WITHOUT ANY WARRANTY; without even the implied warranty of
11 MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
12 GNU General Public License for more details.
13
14 You should have received a copy of the GNU General Public License
15 along with this program; if not, write to the Free Software
16 Foundation, Inc., 59 Temple Place - Suite 330,
17 Boston, MA 02111-1307, USA.
18 *//**
19 @file
20 black box semantics test.
21 *//*
22 by Ben Allan
23 Created: July 4, 2006
24 Version: $Revision: 1.5 $
25 Date last modified: $Date: 1997/07/18 12:20:07 $
26 */
27
28 #include <utilities/ascConfig.h>
29 #include <utilities/ascMalloc.h>
30 #include <compiler/compiler.h>
31 #include <compiler/packages.h>
32 #include <compiler/instance_enum.h>
33 #include <utilities/ascPanic.h>
34 /* next 4 needed only because we use RealAtomValue on the DATA instance. */
35 #include <compiler/fractions.h>
36 #include <compiler/dimen.h>
37 #include <compiler/atomvalue.h>
38 #include <compiler/instquery.h>
39
40 #include <compiler/extcall.h>
41
42 /* #define BBOXTEST_DEBUG */
43
44 ExtBBoxInitFunc bboxtest_preslv;
45 ExtBBoxFunc bboxtest_fex;
46 ExtBBoxFunc bboxtest_jex;
47 ExtBBoxFinalFunc bboxtest_final;
48 #define N_INPUT_ARGS 1 /* formal arg count */
49 #define N_OUTPUT_ARGS 1 /* formal arg count */
50
51 extern
52 ASC_EXPORT(int) bboxtest_register(void){
53 double epsilon = 1.0e-14;
54
55 char bboxtest_help[] = "This tests a simple black box y=k*x."
56 " The value 'k' is provided to the blackbox as a data argument.";
57
58 return CreateUserFunctionBlackBox("bboxtest"
59 ,&bboxtest_preslv
60 ,&bboxtest_fex, &bboxtest_jex
61 ,NULL, &bboxtest_final
62 ,N_INPUT_ARGS, N_OUTPUT_ARGS
63 ,bboxtest_help
64 ,epsilon
65 );
66 }
67
68 /*------------------------------------------------------------------------------
69 forward decls
70 */
71
72 struct BBOXTEST_problem {
73 double coef; /* coef in y=coef*x*/
74 int n; /* number of equations. */
75 };
76
77 static int GetCoef( struct Instance *data, struct BBOXTEST_problem *problem);
78
79 static int CheckArgsOK(struct Instance *data
80 ,struct gl_list_t *arglist, struct BBOXTEST_problem *problem
81 );
82
83 static int DoCalculation(struct BBoxInterp *interp
84 ,int ninputs, int noutputs
85 ,double *inputs, double *outputs
86 );
87
88 int DoDeriv(struct BBoxInterp *interp, int ninputs, double *jacobian);
89
90 #ifndef EXTERNAL_EPSILON
91 #define EXTERNAL_EPSILON 1.0e-12
92 #endif
93
94 /*----------------------------------------------------------------------------*/
95
96 /**
97 This function is one of the registered functions. It operates in
98 mode 'last_call'.
99
100 In 'last_call' mode, the memory associated with the problem is
101 released.
102 */
103 void bboxtest_final(struct BBoxInterp *interp){
104 struct BBOXTEST_problem *problem;
105
106 if(interp->task != bb_last_call){
107 ERROR_REPORTER_HERE(ASC_PROG_ERR,"Unexpected call to last_call fn");
108 return;
109 }
110
111 if(interp->user_data != NULL) {
112 problem = (struct BBOXTEST_problem *)interp->user_data;
113 problem->coef *= -1;
114 problem->n *= -1;
115 ASC_FREE(problem);
116 interp->user_data = NULL;
117 }
118 }
119 /**
120 This function is one of the registered functions. It operates in
121 mode first_call.
122 It creates a BBOXTEST_problem and calls a number of routines to check
123 the arguments (data and arglist) and to cache the information
124 processed away in the BBOXTEST_problem structure.
125
126 In last_call mode, the memory associated with the problem is
127 released.
128
129 @return 0 on success
130 */
131 int bboxtest_preslv(struct BBoxInterp *interp,
132 struct Instance *data,
133 struct gl_list_t *arglist
134
135 ){
136 struct BBOXTEST_problem *problem;
137
138 if(interp->task != bb_first_call){
139 ERROR_REPORTER(ASC_PROG_ERR,"Unexpected call to first_call fn");
140 return -1;
141 }
142
143 if(interp->user_data!=NULL){
144 #ifdef BBOXTEST_DEBUG
145 CONSOLE_DEBUG("user_data has already been allocated, no need to reallocate");
146 #endif
147 return 0;
148 }
149
150 problem = ASC_NEW(struct BBOXTEST_problem);
151 if(CheckArgsOK(data,arglist,problem)){
152 CONSOLE_DEBUG("Problem with arguments");
153 ASC_FREE(problem);
154 return -2;
155 }
156
157 /* store the BBTEST_problem in the user_data pointer */
158 interp->user_data = (void *)problem;
159 return 0; /* success */
160 }
161
162 /*----------------------------------------------------------------------------*/
163
164 /**
165 Evaluate residuals
166
167 @return 0 on success
168 */
169 int bboxtest_fex(struct BBoxInterp *interp,
170 int ninputs,
171 int noutputs,
172 double *inputs,
173 double *outputs,
174 double *jacobian
175 ){
176 (void)jacobian;
177 return DoCalculation(interp, ninputs, noutputs, inputs, outputs);
178 }
179
180 /*
181 Evaluate jacobian
182 @return 0 on success
183 */
184 int bboxtest_jex(struct BBoxInterp *interp,
185 int ninputs,
186 int noutputs,
187 double *inputs,
188 double *outputs,
189 double *jacobian
190 ){
191 (void)noutputs;
192 (void)outputs;
193 (void)inputs;
194
195 return DoDeriv(interp, ninputs, jacobian);
196 }
197
198 /*------------------------------------------------------------------------------
199 utility routines
200 */
201
202 static int GetCoef( struct Instance *data, struct BBOXTEST_problem *problem){
203
204 if(!data){
205 ERROR_REPORTER_HERE(ASC_USER_ERROR,"expecting a data instance to be provided");
206 return 5;
207 }
208 if(InstanceKind(data)!=REAL_CONSTANT_INST) {
209 ERROR_REPORTER_HERE(ASC_USER_ERROR,"expecting a real constant instance.");
210 return 6;
211 }
212
213 problem->coef = RealAtomValue(data);
214 return 0;
215 }
216
217 static int CheckArgsOK(struct Instance *data,
218 struct gl_list_t *arglist,
219 struct BBOXTEST_problem *problem
220 ){
221 unsigned long len,ninputs,noutputs;
222
223 if (!arglist) {
224 ERROR_REPORTER_HERE(ASC_USER_ERROR,"External function argument list does not exist.");
225 return 1;
226 }
227 len = gl_length(arglist);
228 if (!len) {
229 ERROR_REPORTER_HERE(ASC_USER_ERROR,"No arguments to external function statement.");
230 return 2;
231 }
232 if ((len!=(N_INPUT_ARGS+N_OUTPUT_ARGS))) {
233 ERROR_REPORTER_HERE(ASC_USER_ERROR,"Number of arguments does not match"
234 " the external function"
235 " prototype(array_of_realatom[set],array_of_realatom[set],real_constant"
236 );
237 return 3;
238 }
239
240 ninputs = CountNumberOfArgs(arglist,1,N_INPUT_ARGS);
241 noutputs = CountNumberOfArgs(arglist,N_INPUT_ARGS+1,
242 N_INPUT_ARGS+N_OUTPUT_ARGS);
243 if (ninputs != noutputs) {
244 ERROR_REPORTER_HERE(ASC_USER_ERROR,"Length of input, output arguments mismatched.");
245 return 4;
246 }
247
248 problem->n = (int)ninputs;
249
250 return GetCoef(data,problem); /* get the coef, return 0 on success means all was ok */
251 }
252
253 /*
254 This function provides support to bboxtest_fex which is one of the
255 registered functions. The input variables are x[set]
256 The output variables are y[set]. We do our loop
257 based on the ascend standard that sets are arbitrarily but
258 consistently ordered if they contain the same values.
259 */
260
261 static int DoCalculation(struct BBoxInterp *interp,
262 int ninputs, int noutputs,
263 double *inputs,
264 double *outputs
265 ){
266 struct BBOXTEST_problem *problem;
267 int c;
268 double coef;
269
270 if(ninputs != noutputs){
271 ERROR_REPORTER_HERE(ASC_PROG_ERR,"ninputs != noutputs");
272 return -1;
273 }
274 if(interp->user_data == NULL){
275 ERROR_REPORTER_HERE(ASC_PROG_ERR,"user_data not supplied");
276 return -2;
277 }
278 problem = (struct BBOXTEST_problem *)interp->user_data;
279 coef = problem->coef;
280
281 for (c=0; c < ninputs; c++) {
282 outputs[c] = coef * inputs[c];
283 }
284
285 #ifdef BBOXTEST_DEBUG
286 CONSOLE_DEBUG("instance = %p",interp->user_data);
287 for(c=0;c<ninputs;c++) {
288 CONSOLE_DEBUG("x[%d] = %12.8g",c,inputs[c]);
289 }
290 for (c=0;c<noutputs;c++) {
291 CONSOLE_DEBUG("y[%d] = %20.8g",c,outputs[c]);
292 }
293 #endif /* BBOXTEST_DEBUG */
294
295 interp->status = calc_all_ok;
296 return 0;
297 }
298
299 int DoDeriv(struct BBoxInterp *interp, int ninputs, double *jacobian){
300 int i; int len;
301 double coef;
302 if(interp==NULL){
303 ERROR_REPORTER_HERE(ASC_PROG_ERR,"interp==NULL");
304 return -1;
305 }
306 if(interp->user_data==NULL){
307 ERROR_REPORTER_HERE(ASC_PROG_ERR,"interp->user_data==NULL");
308 return -2;
309 }
310 coef = ((struct BBOXTEST_problem *)interp->user_data)->coef;
311 len = ninputs*ninputs;
312
313 #ifdef BBOXTEST_DEBUG
314 CONSOLE_DEBUG("instance = %p",interp->user_data);
315 #endif
316 for (i = 0; i< len; i++) {
317 jacobian[i] = 0;
318 }
319
320 for (i = 0; i< ninputs; i++) {
321 jacobian[i*ninputs+i] = coef;
322 }
323 #ifdef BBOXTEST_DEBUG
324 for(i=0; i<len; i++) {
325 CONSOLE_DEBUG("J[%d] = %12.8g", i, jacobian[i]);
326 }
327 #endif
328 return 0;
329 }

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