1 /*****************************************************************************
2 *
3 * Elmer, A Finite Element Software for Multiphysical Problems
4 *
5 * Copyright 1st April 1995 - , CSC - IT Center for Science Ltd., Finland
6 *
7 * This program is free software; you can redistribute it and/or
8 * modify it under the terms of the GNU General Public License
9 * as published by the Free Software Foundation; either version 2
10 * of the License, or (at your option) any later version.
11 *
12 * This program is distributed in the hope that it will be useful,
13 * but WITHOUT ANY WARRANTY; without even the implied warranty of
14 * MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE. See the
15 * GNU General Public License for more details.
16 *
17 * You should have received a copy of the GNU General Public License
18 * along with this program (in file fem/GPL-2); if not, write to the
19 * Free Software Foundation, Inc., 51 Franklin Street, Fifth Floor,
20 * Boston, MA 02110-1301, USA.
21 *
22 *****************************************************************************/
23
24 /*******************************************************************************
25 *
26 * MATC variable manipulation.
27 *
28 *******************************************************************************
29 *
30 * Author: Juha Ruokolainen
31 *
32 * Address: CSC - IT Center for Science Ltd.
33 * Keilaranta 14, P.O. BOX 405
34 * 02101 Espoo, Finland
35 * Tel. +358 0 457 2723
36 * Telefax: +358 0 457 2302
37 * EMail: Juha.Ruokolainen@csc.fi
38 *
39 * Date: 30 May 1996
40 *
41 * Modified by:
42 *
43 * Date of modification:
44 *
45 ******************************************************************************/
46 /*********************************************************************
47 |
48 | VARIABLE.C - Last Edited 9. 8. 1988
49 |
50 ***********************************************************************/
51
52 /*======================================================================
53 |Syntax of the manual pages:
54 |
55 |FUNCTION NAME(...) params ...
56 |
57 $ usage of the function and type of the parameters
58 ? explane the effects of the function
59 = return value and the type of value if not of type int
60 @ globals effected directly by this routine
61 ! current known bugs or limitations
62 & functions called by this function
63 ~ these functions may interest you as an alternative function or
64 | because they control this function somehow
65 ^=====================================================================*/
66
67
68 /*
69 * $Id: variable.c,v 1.6 2007/05/11 07:53:32 jpr Exp $
70 *
71 * $Log: variable.c,v $
72 * Revision 1.6 2007/05/11 07:53:32 jpr
73 * *** empty log message ***
74 *
75 * Revision 1.5 2006/02/07 10:21:42 jpr
76 * Changed visibility of some variables to local scope.
77 *
78 * Revision 1.4 2006/02/02 06:54:44 jpr
79 * small formatting changes.
80 *
81 * Revision 1.2 2005/05/27 12:26:22 vierinen
82 * changed header install location
83 *
84 * Revision 1.1.1.1 2005/04/14 13:29:14 vierinen
85 * initial matc automake package
86 *
87 * Revision 1.2 1998/08/01 12:34:58 jpr
88 * Added Id, started Log.
89 *
90 *
91 */
92
93 #include "elmer/matc.h"
94
const_new(name,type,nrow,ncol)95 VARIABLE *const_new(name, type, nrow, ncol) int type, ncol, nrow; char *name;
96 /*======================================================================
97 ? return a new global VARIABLE given name, type, and matrix size.
98 | VARIABLE is linked to CONSTANTS lists.
99 |
100 = pointer to a new VARIABLE
101 & mat_new(), lst_add(), ALLOCMEM, FREEMEM, STRCOPY
102 ^=====================================================================*/
103 {
104 VARIABLE *ptr;
105
106 /*
107 Allocate the structure and link to global list of VARIABLES.
108 */
109
110 ptr = (VARIABLE *)ALLOCMEM(VARIABLESIZE); /* list entry */
111 ptr->this = mat_new(type, nrow, ncol); /* allocate new MATRIX */
112 REFCNT(ptr) = 1; /* one reference */
113 NAME(ptr) = STRCOPY(name); /* name as given */
114
115 lst_add(CONSTANTS, (LIST *)ptr); /* add to list */
116
117 return ptr;
118 }
119
var_new(name,type,nrow,ncol)120 VARIABLE *var_new(name, type, nrow, ncol) int type, ncol, nrow; char *name;
121 /*======================================================================
122 ? return a new global VARIABLE given name, type, and matrix size.
123 | VARIABLE is linked to VARIABLES list.
124 |
125 = pointer to a new VARIABLE
126 & var_check(), lst_add(), ALLOCMEM, FREEMEM, STRCOPY
127 ^=====================================================================*/
128 {
129 VARIABLE *ptr;
130
131 /*
132 * Delete old definition of name if any...
133 */
134 var_delete(name);
135
136 /*
137 * Allocate the structure and link to global list of VARIABLES.
138 */
139 ptr = (VARIABLE *)ALLOCMEM(VARIABLESIZE); /* list entry */
140 ptr->this = mat_new(type, nrow, ncol); /* allocate new MATRIX */
141 REFCNT(ptr) = 1; /* one reference */
142 NAME(ptr) = STRCOPY(name); /* name as given */
143
144 lst_addhead(VARIABLES, (LIST *)ptr); /* add to list */
145
146 return ptr;
147 }
148
var_create_vector(char * name,int ntime,int ncol,double * data)149 void var_create_vector( char *name, int ntime, int ncol, double *data )
150 {
151 VARIABLE *var = var_new( name,TYPE_DOUBLE, ntime, ncol );
152 int i;
153
154 FREEMEM( MATR(var) );
155 MATR(var) = data;
156 }
157
var_rename(ptr,str)158 VARIABLE *var_rename(ptr, str) VARIABLE *ptr; char *str;
159 {
160 VARIABLE *res;
161
162 if (ptr == (VARIABLE *)NULL) return NULL;
163
164 res = (VARIABLE *)lst_find( VARIABLES, str );
165
166 if (res == NULL && REFCNT(ptr) > 1)
167 {
168 res = (VARIABLE *)ALLOCMEM(VARIABLESIZE);
169 NAME(res) = STRCOPY(str);
170 res->this = mat_copy(ptr->this);
171 REFCNT(res) = 1;
172 lst_addhead(VARIABLES, (LIST *)res);
173 }
174 else if (res == NULL)
175 {
176 res = (VARIABLE *)ALLOCMEM(VARIABLESIZE);
177 NAME(res) = STRCOPY(str);
178 res->this = ptr->this;
179 REFCNT(res)++;
180 lst_addhead(VARIABLES, (LIST *)res);
181 }
182 else
183 {
184 if ( res != ptr )
185 {
186 #if 1
187 if ( NROW(res) == NROW(ptr) && NCOL(res) == NCOL(ptr) )
188 {
189 memcpy( MATR(res),MATR(ptr), NROW(res)*NCOL(res)*sizeof(double) );
190 }
191 else
192 #endif
193 {
194 if (--REFCNT(res) == 0)
195 {
196 FREEMEM( (char *)MATR(res) );
197 FREEMEM( (char *)res->this );
198 }
199 res->this = ptr->this;
200 REFCNT(res)++;
201 }
202 }
203 }
204
205 if ( res != ptr ) var_delete_temp(ptr);
206
207 return res;
208 }
209
210 static int var_pprec = 3,
211 var_pinp = FALSE, var_rowintime = FALSE;
212
var_format(var)213 VARIABLE *var_format(var) VARIABLE *var;
214 {
215 if (*MATR(var) > 0 && *MATR(var) < 20)
216 {
217 var_pprec = *MATR(var);
218 }
219
220 if (NEXT(var) != NULL)
221 {
222 char *frm = var_to_string(NEXT(var));
223
224 if (strcmp(frm,"input") == 0)
225 {
226 var_pinp = TRUE;
227 }
228 else
229 {
230 var_pinp = FALSE;
231 if ( strcmp(frm,"rowform") == 0)
232 var_rowintime = TRUE;
233 else
234 var_rowintime = FALSE;
235 }
236 FREEMEM(frm);
237 }
238
239 return (VARIABLE *)NULL;
240 }
241
var_print(ptr)242 void var_print(ptr) VARIABLE *ptr;
243 {
244 double maxp, minp, maxx;
245 int i, j, k;
246 char fmt[80];
247
248 if (ptr == (VARIABLE *)NULL) return;
249
250 if (TYPE(ptr) == TYPE_STRING)
251 {
252 if (var_pinp)
253 PrintOut( "%d %d %% \"",NROW(ptr),NCOL(ptr) );
254
255 for(i = 0; i < NROW(ptr); i++)
256 {
257 for(j = 0; j < NCOL(ptr); j++)
258 PrintOut( "%c", (char)M(ptr,i,j));
259 if (var_pinp)
260 {
261 if (i < NROW(ptr)-1)
262 PrintOut("\"\\");
263 else
264 PrintOut("\"");
265 }
266 PrintOut( "\n");
267 }
268 return;
269 }
270
271 k = 0;
272 do
273 {
274 if (var_pinp)
275 PrintOut("%d %d %% ", NROW(ptr), NCOL(ptr));
276 else if (NCOL(ptr) > 8 && !var_rowintime )
277 PrintOut( "\nColumns %d trough %d\n\n",
278 k, min(NCOL(ptr) - 1, k + 7));
279
280 if (var_pinp || var_rowintime )
281 sprintf(fmt, "%%.%dg",var_pprec );
282 else
283 sprintf(fmt, "%% %d.%dg",var_pprec+7,var_pprec);
284
285 for(i = 0; i < NROW(ptr); i++)
286 {
287 if ( var_rowintime ) {
288 for( j=0; j<NCOL(ptr); j++ ) {
289 if ( j>0 ) PrintOut(" ");
290 PrintOut( fmt, M(ptr,i,j));
291 }
292 } else {
293 for(j = 0; j < 80/(var_pprec+7) && k + j < NCOL(ptr); j++)
294 PrintOut( fmt, M(ptr,i,j+k));
295
296 if (var_pinp)
297 if (i < NROW(ptr)-1) PrintOut("\\");
298 }
299
300 PrintOut("\n");
301 }
302
303 k += j;
304 } while(k < NCOL(ptr));
305 }
306
var_delete(str)307 void var_delete(str) char *str;
308 {
309 VARIABLE *ptr;
310
311 ptr = var_check(str);
312
313 if ( ptr != (VARIABLE *)NULL )
314 {
315 if ( --REFCNT(ptr) == 0 )
316 {
317 FREEMEM((char *)MATR(ptr));
318 FREEMEM((char *)ptr->this);
319 }
320 lst_free(VARIABLES, (LIST *)ptr);
321 }
322
323 return;
324 }
325
var_vdelete(var)326 VARIABLE *var_vdelete( var ) VARIABLE *var;
327 {
328 var_delete( var_to_string( var ) );
329 return (VARIABLE *)NULL;
330 }
331
332
var_free()333 void var_free()
334 {
335 VARIABLE *ptr;
336
337 for( ptr = (VARIABLE *)VAR_HEAD; ptr; ptr = NEXT(ptr) )
338 {
339 if ( --REFCNT(ptr) == 0 )
340 {
341 FREEMEM((char *)MATR(ptr));
342 FREEMEM((char *)ptr->this);
343 }
344 }
345
346 lst_purge(VARIABLES);
347
348 return;
349 }
350
const_free()351 void const_free()
352 {
353 VARIABLE *ptr;
354
355 for( ptr = (VARIABLE *)CONST_HEAD; ptr; ptr = NEXT(ptr) )
356 {
357 if ( --REFCNT(ptr) == 0 )
358 {
359 FREEMEM((char *)MATR(ptr));
360 FREEMEM((char *)ptr->this);
361 }
362 }
363
364 lst_purge(CONSTANTS);
365
366 return;
367 }
368
var_varlist()369 VARIABLE *var_varlist()
370 /*======================================================================
371 ? print a list of VARIABLES for the user
372 |
373 = (VARIABLE *)NULL
374 & lst_print()
375 ^=====================================================================*/
376 {
377 lst_print(CONSTANTS); lst_print(VARIABLES);
378
379 return NULL;
380 }
381
var_ccheck(var)382 VARIABLE *var_ccheck(var) VARIABLE *var;
383 /*======================================================================
384 ? look for a VARIABLE from the global list of VARIABLES and return
385 | it or (VARIABLE *)NULL if not found.
386 |
387 = VARIABLE *
388 & var_check(), var_to_string()
389 ^=====================================================================*/
390 {
391 VARIABLE *res;
392 char *str;
393 int i, n;
394
395 for(n = 0, res = var; res != NULL; n++, res=NEXT(res));
396 res = var_temp_new(TYPE_DOUBLE, 1, n);
397
398 for( i=0; i<n; i++, var=NEXT(var) )
399 {
400 str = var_to_string(var);
401
402 if ( var_check(str) == NULL )
403 M(res,0,i) = FALSE;
404 else
405 M(res,0,i) = TRUE;
406
407 FREEMEM(str);
408 }
409
410 return res;
411 }
412
var_check(str)413 VARIABLE *var_check(str) char *str;
414 /*======================================================================
415 ? look for a VARIABLE from the global list of VARIABLES and return
416 | it or (VARIABLE *)NULL if not found.
417 |
418 = VARIABLE *
419 & lst_find()
420 ^=====================================================================*/
421 {
422 VARIABLE *res;
423
424 if ( (res = (VARIABLE *)lst_find(VARIABLES, str)) == NULL )
425 {
426 res = (VARIABLE *)lst_find(CONSTANTS, str);
427 }
428
429 return res;
430 }
431
var_temp_copy(from)432 VARIABLE *var_temp_copy(from) VARIABLE *from;
433 /*======================================================================
434 ? Make a temporary (not linked to global list of VARIABLES)
435 | copy of a VARIABLE *from and.
436 |
437 = pointer to new VARIABLE
438 & ALLOCMEM
439 ^=====================================================================*/
440 {
441 VARIABLE *to;
442
443 /*
444 * if there's nothing to copy return.
445 */
446 if ( from == NULL ) return NULL;
447
448 to = (VARIABLE *)ALLOCMEM(VARIABLESIZE); /* list entry */
449 to->this = mat_copy(from->this);
450 REFCNT(to) = 1;
451
452 return to;
453 }
454
var_temp_new(type,nrow,ncol)455 VARIABLE *var_temp_new(type,nrow,ncol) int type, nrow, ncol;
456 /*======================================================================
457 ? Make a new temporary (not linked to global list of VARIABLES)
458 | VARIABLE, type and matrix dimensions from function parameters.
459 |
460 = pointer to new VARIABLE entry
461 & ALLOCMEM
462 ^=====================================================================*/
463 {
464 VARIABLE *ptr;
465
466 ptr = (VARIABLE *)ALLOCMEM(VARIABLESIZE); /* list entry */
467 ptr->this = mat_new(type, nrow, ncol);
468 REFCNT( ptr ) = 1;
469
470 return ptr;
471 }
472
var_delete_temp_el(VARIABLE * ptr)473 void var_delete_temp_el( VARIABLE *ptr )
474 {
475 if ( ptr != NULL )
476 {
477 if ( --REFCNT(ptr) == 0 )
478 {
479 FREEMEM((char *)MATR(ptr));
480 FREEMEM((char *)ptr->this);
481 }
482 FREEMEM((char *)ptr);
483 }
484 return;
485 }
486
var_delete_temp(VARIABLE * head)487 void var_delete_temp( VARIABLE *head )
488 {
489 VARIABLE *ptr, *ptr1;
490
491 for( ptr = head; ptr; )
492 {
493 ptr1 = NEXT(ptr);
494 var_delete_temp_el(ptr);
495 ptr = ptr1;
496 }
497 return;
498 }
499
var_to_string(ptr)500 char *var_to_string(ptr) VARIABLE *ptr;
501 {
502 char *str;
503 int i;
504
505 str = ALLOCMEM(NCOL(ptr)+1);
506
507 for( i=0; i<NCOL(ptr); i++ )
508 {
509 str[i] = (char)M(ptr, 0, i);
510 }
511
512 return str;
513 }
514
var_reset_status(char * name)515 void var_reset_status(char *name)
516 {
517 VARIABLE *ptr = var_check(name);
518
519 if ( ptr ) ptr->changed = 0;
520 }
521
522
var_get_status(char * name)523 int var_get_status(char *name)
524 {
525 VARIABLE *ptr = var_check(name);
526
527 if ( ptr )
528 return ptr->changed;
529 else
530 return 0;
531 }
532
var_com_init()533 void var_com_init()
534 {
535 static char *existsHelp =
536 {
537 "exists(name)\n"
538 "Return TRUE if variable by given name exists otherwise return FALSE.\n"
539 };
540
541 static char *whoHelp =
542 {
543 "who\n"
544 "Gives list of currently defined variables.\n"
545 };
546
547 static char *formatHelp =
548 {
549 "format(precision)\n"
550 "Set number of digits used in printing values in MATC.\n\n"
551 };
552
553 static char *deleteHelp =
554 {
555 "delete(name)\n"
556 "Delete a variable with given name.\n"
557 };
558
559 com_init( "exists", FALSE, FALSE, var_ccheck , 1, 1000, existsHelp );
560 com_init( "who" , FALSE, FALSE, var_varlist, 0, 0, whoHelp );
561 com_init( "format" , FALSE, FALSE, var_format, 1, 2, formatHelp );
562 com_init( "delete", FALSE, FALSE, var_vdelete, 1, 1, deleteHelp );
563 }
564