Home

Context Navigation

source: palm/trunk/UTIL/chemistry/gasphase_preproc/kpp/src/code_f90.c @ 4617

Last change on this file since 4617 was 4481, checked in by maronga, 5 years ago
Bugfix for copyright updates in document_changes; copyright update applied to all files
File size: 24.6 KB

Line
1	/******************************************************************************
2
3	KPP - The Kinetic PreProcessor
4	Builds simulation code for chemical kinetic systems
5
6	Copyright (C) -2020 996 Valeriu Damian and Adrian Sandu
7	Copyright (C) -2020 005 Adrian Sandu
8
9	KPP is free software; you can redistribute it and/or modify it under the
10	terms of the GNU General Public License as published by the Free Software
11	Foundation (http://www.gnu.org/copyleft/gpl.html); either version 2 of the
12	License, or (at your option) any later version.
13
14	KPP is distributed in the hope that it will be useful, but WITHOUT ANY
15	WARRANTY; without even the implied warranty of MERCHANTABILITY or FITNESS
16	FOR A PARTICULAR PURPOSE. See the GNU General Public License for more
17	details.
18
19	You should have received a copy of the GNU General Public License along
20	with this program; if not, consult http://www.gnu.org/copyleft/gpl.html or
21	write to the Free Software Foundation, Inc., 59 Temple Place - Suite 330,
22	Boston, MA 02111-1307, USA.
23
24	Adrian Sandu
25	Computer Science Department
26	Virginia Polytechnic Institute and State University
27	Blacksburg, VA 24060
28	E-mail: sandu@cs.vt.edu
29
30	******************************************************************************/
31
32
33	#include "gdata.h"
34	#include "code.h"
35	#include <string.h>
36	#include <stdio.h>
37
38	#define MAX_LINE 120
39
40	char F90_types[] = { "", / VOID */
41	"INTEGER", /* INT */
42	"REAL(kind=sp)", /* FLOAT */
43	"REAL(kind=dp)", /* DOUBLE */
44	"CHARACTER(LEN=15)", /* STRING */
45	"CHARACTER(LEN=100)" /* DOUBLESTRING */
46	};
47
48	/*************************************************************************************************/
49	void F90_WriteElm( NODE * n )
50	{
51	ELEMENT *elm;
52	char * name;
53	char maxi[20];
54	char maxj[20];
55
56	elm = n->elm;
57	name = varTable[ elm->var ]->name;
58
59	switch( n->type ) {
60	case CONST: bprintf("%g", elm->val.cnst);
61	break;
62	case ELM: bprintf("%s", name);
63	break;
64	case VELM: if( elm->val.idx.i >= 0 ) sprintf( maxi, "%d", elm->val.idx.i+1 );
65	else sprintf( maxi, "%s", varTable[ -elm->val.idx.i ]->name );
66	bprintf("%s(%s)", name, maxi );
67	break;
68	case MELM: if( elm->val.idx.i >= 0 ) sprintf( maxi, "%d", elm->val.idx.i+1 );
69	else sprintf( maxi, "%s", varTable[ -elm->val.idx.i ]->name );
70	if( elm->val.idx.j >= 0 ) sprintf( maxj, "%d", elm->val.idx.j+1 );
71	else sprintf( maxj, "%s", varTable[ -elm->val.idx.j ]->name );
72	bprintf("%s(%s,%s)", name, maxi, maxj );
73	break;
74	case EELM: bprintf("(%s)", elm->val.expr );
75	break;
76	}
77	}
78
79	/*************************************************************************************************/
80	void F90_WriteSymbol( int op )
81	{
82	switch( op ) {
83	case ADD: bprintf("+");
84	AllowBreak();
85	break;
86	case SUB: bprintf("-");
87	AllowBreak();
88	break;
89	case MUL: bprintf("*");
90	AllowBreak();
91	break;
92	case DIV: bprintf("/");
93	AllowBreak();
94	break;
95	case POW: bprintf("power");
96	break;
97	case O_PAREN: bprintf("(");
98	AllowBreak();
99	break;
100	case C_PAREN: bprintf(")");
101	break;
102	case NONE:
103	break;
104	}
105	}
106
107	/*************************************************************************************************/
108	void F90_WriteAssign( char ls, char rs )
109	{
110	int start;
111	int linelg;
112	int i, j;
113	int ifound, jfound;
114	char c;
115	int first;
116	int crtident;
117
118	/* Max no of continuation lines in F90/F95 differs with compilers, but 39
119	should work for every compiler*/
120	int number_of_lines = 1, MAX_NO_OF_LINES = 36;
121
122	/* Operator Mapping: 0xaa = '*' \| 0xab = '+' \| 0xac = ','
123	0xad = '-' \| 0xae ='.' \| 0xaf = '/' */
124	/* char op_mult=0xaa, op_plus=0xab, op_minus=0xad, op_dot=0xae, op_div=0xaf; */
125	char op_mult='*', op_plus='+', op_minus='-', op_dot='.', op_div='/';
126
127	crtident = 2 + ident * 2;
128	bprintf("%*s%s = ", crtident, "", ls);
129	start = strlen( ls ) + 2;
130	linelg = 120 - crtident - start - 1; /* F90 max line length is 132 */
131
132	first = 1;
133	while( strlen(rs) > linelg ) {
134	ifound = 0; jfound = 0;
135	if ( number_of_lines >= MAX_NO_OF_LINES ) {
136	/* If a new line needs to be started.
137	Note: the approach below will create erroneous code if the +/- is within a subexpression, e.g. for
138	A(B+C) one cannot start a new continuation line by splitting at the + sign /
139	for( j=linelg; j>5; j-- ) /* split row here if +, -, or comma */
140	if ( ( rs[j] == op_plus )\|\|( rs[j] == op_minus )\|\|( rs[j]==',' ) ) {
141	jfound = 1; i=j; break;
142	}
143	}
144	if ( ( number_of_lines < MAX_NO_OF_LINES )\|\|( !jfound ) ) {
145	for( i=linelg; i>10; i-- ) /* split row here if operator or comma */
146	if ( ( rs[i] & 0x80 )\|\|( rs[i]==',' ) ) {
147	ifound = 1; break;
148	}
149	if( i <= 10 ) {
150	printf("\n Warning: double-check continuation lines for:\n %s = %s\n",ls,rs);
151	i = linelg;
152	}
153	}
154	while ( rs[i-1] & 0x80 ) i--; /* put all operators on the next row */
155	while ( rs[i] == ',' ) i++; /* put commas on the current row */
156
157	c = rs[i];
158	rs[i] = 0;
159
160	if ( first ) { /* first line in a split row */
161	bprintf("%s", rs );
162	linelg++;
163	first = 0;
164	} else {/* continuation line in a split row - but not last line*/
165	bprintf("&\n %*s&%s", start, "", rs );
166	if ( jfound ) {
167	bprintf("\n%*s%s = %s", crtident, "", ls, ls);
168	number_of_lines = 1;
169	}
170	}
171	rs[i] = c;
172	rs += i; /* jump to the first not-yet-written character */
173	number_of_lines++;
174	}
175
176	if ( number_of_lines > MAX_NO_OF_LINES ) {
177	printf("\n Warning: %d continuation lines for %s = ...",number_of_lines,ls);
178	}
179
180	if ( first ) bprintf("%s\n", rs ); /* non-split row */
181	else bprintf("&\n %s&%s\n", start, "", rs ); / last line in a split row */
182
183
184	FlushBuf();
185	}
186
187
188	/*************************************************************************************************/
189	void F90_WriteComment( char *fmt, ... )
190	{
191	Va_list args;
192	int n;
193	char buf[ MAX_LINE ];
194
195	Va_start( args, fmt );
196	vsprintf( buf, fmt, args );
197	va_end( args );
198	/* remove trailing spaces */
199	/* taken from http://www.cs.bath.ac.uk/~pjw/NOTES/ansi_c/ch10-idioms.pdf */
200	for (n= strlen(buf) - 1; n >= 0; n--)
201	if (buf[n] != ' ') break;
202	buf[n + 1]= '\0';
203	bprintf( "! %s\n", buf );
204	FlushBuf();
205	}
206
207	/*************************************************************************************************/
208	char * F90_Decl( int v )
209	{
210	static char buf[120];
211	VARIABLE *var;
212	char *baseType;
213	char maxi[20];
214	char maxj[20];
215
216	var = varTable[ v ];
217	baseType = F90_types[ var->baseType ];
218
219	*buf = 0;
220
221	switch( var->type ) {
222	case ELM:
223	sprintf( buf, "%s :: %s", baseType, var->name );
224	break;
225	case VELM:
226	if( var->maxi > 0 ) sprintf( maxi, "%d", var->maxi );
227	/* else sprintf( maxi, "%s", varTable[ -var->maxi ]->name); */
228	/sprintf( buf, "%s, DIMENSION(%s) :: %s", baseType, maxi, var->name );/
229	if( var->maxi == 0 ) sprintf( maxi, "%d", 1 );
230	/* else sprintf( maxi, "%s", varTable[ -var->maxi ]->name); */
231	if ( var->maxi < 0 ) {
232	if (varTable[ -var->maxi ]->value < 0)
233	sprintf( maxi, "%s", varTable[ -var->maxi ]->name );
234	else
235	sprintf( maxi, "%d", (varTable[-var->maxi]->value)==0?
236	1:varTable[-var->maxi]->value );
237	}
238	sprintf( buf, "%s :: %s(%s)", baseType, var->name, maxi );
239	break;
240	case MELM:
241	if( var->maxi > 0 ) sprintf( maxi, "%d", var->maxi );
242	else {
243	if (varTable[ -var->maxi ]->value < 0)
244	sprintf( maxi, "%s", varTable[ -var->maxi ]->name );
245	else
246	sprintf( maxi, "%d", (varTable[-var->maxi]->value)==0?
247	1:varTable[-var->maxi]->value );
248	}
249	/* else sprintf( maxi, "%s", varTable[ -var->maxi ]->name); */
250	/* if( (var->maxi == 0) \|\|
251	((var->maxi < 0) && (varTable[ -var->maxi ]->maxi == 0)) )
252	strcat( maxi, "+1"); */
253	if( var->maxj > 0 ) sprintf( maxj, "%d", var->maxj );
254	else {
255	if (varTable[ -var->maxj ]->value < 0)
256	sprintf( maxj, "%s", varTable[ -var->maxj ]->name );
257	else
258	sprintf( maxj, "%d", (varTable[-var->maxj]->value)==0?
259	1:varTable[-var->maxj]->value );
260	}
261	/* else sprintf( maxj, "%s", varTable[ -var->maxj ]->name); */
262	/*if( (var->maxj == 0) \|\|
263	((var->maxj < 0 ) && (varTable[ -var->maxj ]->maxi == 0)) )
264	strcat( maxj, "+1");*/
265	/*sprintf( buf, "%s, DIMENSION(%s,%s) :: %s",
266	baseType, maxi, maxj,var->name ); */
267	sprintf( buf, "%s :: %s(%s,%s)",
268	baseType, var->name, maxi, maxj );
269	break;
270	default:
271	printf( "Can not declare type %d\n", var->type );
272	break;
273	}
274	return buf;
275	}
276
277	/*************************************************************************************************/
278	char * F90_DeclareData( int v, void * values, int n)
279	{
280	int i, j;
281	int nlines;
282	int split;
283	static char buf[120];
284	VARIABLE *var;
285	int * ival;
286	double * dval;
287	char ** cval;
288	char *baseType;
289	char maxi[20];
290	char maxj[20];
291	int maxCols = MAX_COLS;
292	char dsbuf[200];
293
294	int i_from, i_to;
295	int isplit;
296	int splitsize;
297	int maxi_mod;
298	int maxi_div;
299
300	char mynumber[30];
301
302	var = varTable[ v ];
303	ival = (int*) values;
304	dval = (double *) values;
305	cval = (char **) values;
306
307	nlines = 1;
308	split = 0;
309	var -> maxi = max( n, 1 );
310
311	baseType = F90_types[ var->baseType ];
312
313	*buf = 0;
314
315	switch( var->type ) {
316	case ELM:
317	bprintf( " %s :: %s = ", baseType, var->name );
318	switch ( var->baseType ) {
319	case INT: bprintf( "%d", *ival ); break;
320	case DOUBLE: bprintf( "%f", *dval); break;
321	case REAL: bprintf( "%lg", *dval ); break;
322	case STRING: bprintf( "'%3s'", *cval ); break;
323	}
324	break;
325	case VELM:
326	/* define maxCols here already and choose suitable splitsize */
327	switch( var -> baseType ) {
328	case INT: maxCols =12; break;
329	case DOUBLE: maxCols = 5; break;
330	case REAL: maxCols = 5; break;
331	case STRING: maxCols = 3; break;
332	case DOUBLESTRING: maxCols = 1; break;
333	}
334	splitsize = 30 * maxCols; /* elements = lines * columns */
335	maxi_mod = var->maxi % splitsize;
336	maxi_div = var->maxi / splitsize;
337	/* correction if var->maxi is a multiple of splitsize */
338	if ( (maxi_div>0) && (maxi_mod==0) ) {
339	maxi_mod = splitsize;
340	maxi_div--;
341	}
342	for ( isplit=0; isplit <= maxi_div; isplit++ ) {
343	if( var->maxi > 0 ) sprintf( maxi, "%d", var->maxi );
344	else sprintf( maxi, "%s", varTable[ -var->maxi ]->name );
345	if( (var->maxi == 0) \|\|
346	((var->maxi < 0) && (varTable[ -var->maxi ]->maxi == 0)) )
347	strcat( maxi, "+1");
348	bprintf( " %s, " , baseType);
349	if( n>0 ) bprintf( "PARAMETER, " ); /* if values are assigned now */
350	if ( maxi_div==0 ) { /* define array in one piece */
351	bprintf( "DIMENSION(%s) :: %s",
352	maxi, var->name) ;
353	} else {/* define partial arrays */
354	if ( isplit==maxi_div ) { /* last part has size maxi_mod */
355	bprintf( "DIMENSION(%d) :: %s_%d",
356	maxi_mod, var->name, isplit) ;
357	} else { /* all other parts have size splitsize */
358	bprintf( "DIMENSION(%d) :: %s_%d",
359	splitsize, var->name, isplit) ;
360	}
361	}
362	if( n<=0 ) break;
363
364	/* now list values */
365	bprintf( " = (/ &\n " );
366	/* if the array is defined in one piece, then the for loop will
367	go from 0 to n. Otherwise, there will be partial arrays from
368	i_from to i_to which are of size splitsize except for the
369	last one which is usually smaller and contains the rest */
370	i_from = isplit * splitsize;
371	i_to = min(i_from+splitsize,n);
372	for ( i=i_from; i < i_to; i++ ) {
373	switch( var -> baseType ) {
374	case INT:
375	bprintf( "%3d", ival[i] ); break;
376	case DOUBLE:
377	/* bprintf( "%4f", dval[i] ); maxCols = 5; break; */
378	sprintf(mynumber, "%12.6e_dp",dval[i]);
379	/* mynumber[ strlen(mynumber)-4 ] = 'd'; */
380	bprintf( " %s", mynumber ); break;
381	case REAL:
382	bprintf( "%12.6e", dval[i] ); break;
383	case STRING:
384	bprintf( "'%-15s'", cval[i] ); break;
385	case DOUBLESTRING:
386	/* strncpy( dsbuf, cval[i], 54 ); dsbuf[54]='\0'; */
387	/* bprintf( "'%48s'", dsbuf ); break; */
388	bprintf( "'%-100.100s'", cval[i] ); break;
389	}
390	if( i < i_to-1 ) {
391	bprintf( "," );
392	if( (i+1) % maxCols == 0 ) {
393	bprintf( " &\n " );
394	nlines++;
395	}
396	}
397	}
398	bprintf( " /)\n" );
399	/* mz_rs added FlushBuf, otherwise MAX_OUTBUF would have to be very large */
400	FlushBuf();
401	}
402
403	/* combine the partial arrays */
404	if ( maxi_div != 0 ) {
405	bprintf( " %s, PARAMETER, DIMENSION(%s) :: %s = (/&\n ",
406	baseType, maxi, var->name) ;
407	for ( isplit=0; isplit <= maxi_div; isplit++ ) {
408	bprintf( "%s_%d", var->name, isplit) ;
409	if( isplit < maxi_div ) { /* more parts will follow */
410	bprintf( ", " );
411	/* line break after 5 variables */
412	if( (isplit+1) % 5 == 0 ) bprintf( "&\n " );
413	} else { /* after last part */
414	bprintf( " /)\n" );
415	}
416	}
417	}
418
419	break;
420
421	case MELM: if( var->maxi > 0 ) sprintf( maxi, "%d", var->maxi );
422	else sprintf( maxi, "%s", varTable[ -var->maxi ]->name );
423	if( (var->maxi == 0) \|\|
424	((var->maxi < 0) && (varTable[ -var->maxi ]->maxi == 0)) )
425	strcat( maxi, "+1");
426	if( var->maxj > 0 ) sprintf( maxj, "%d", var->maxj );
427	else sprintf( maxj, "%s", varTable[ -var->maxj ]->name );
428	if( (var->maxj == 0) \|\|
429	((var->maxj < 0 ) && (varTable[ -var->maxj ]->maxi == 0)) )
430	strcat( maxj, "+1");
431	sprintf( buf, "%s, DIMENSION(%s,%s) :: %s\n", /* changed here */
432	baseType, maxi, maxj,var->name );
433	break;
434	default:
435	printf( "Can not declare type %d", var->type );
436	break;
437	}
438	return buf;
439	}
440
441	/*************************************************************************************************/
442	void F90_Declare( int v )
443	{
444	if( varTable[ v ]->comment ) {
445	F90_WriteComment( "%s - %s",
446	varTable[ v ]->name, varTable[ v ]->comment );
447	}
448	bprintf(" %s\n", F90_Decl(v) );
449
450	FlushBuf();
451	}
452
453	/*************************************************************************************************/
454	void F90_ExternDeclare( int v )
455	{
456	F90_Declare( v );
457	// bprintf(" COMMON /%s/ %s\n", CommonName, varTable[ v ]->name );
458	}
459
460	/*************************************************************************************************/
461	void F90_GlobalDeclare( int v )
462	{
463	}
464
465	/*************************************************************************************************/
466	void F90_DeclareConstant( int v, char *val )
467	{
468	VARIABLE *var;
469	int ival;
470	char dummy_val[100]; /* used just to avoid strange behaviour of
471	sscanf when compiled with gcc */
472
473	strcpy(dummy_val,val);val = dummy_val;
474
475	var = varTable[ v ];
476
477	if( sscanf(val, "%d", &ival) == 1 )
478	if( ival == 0 ) var->maxi = 0;
479	else var->maxi = 1;
480	else
481	var->maxi = -1;
482
483	if( var->comment )
484	F90_WriteComment( "%s - %s", var->name, var->comment );
485
486	switch( var->type ) {
487	case CONST: bprintf(" %s, PARAMETER :: %s = %s \n",
488	F90_types[ var->baseType ], var->name, val );
489	break;
490	default:
491	printf( "Invalid constant %d", var->type );
492	break;
493	}
494
495	FlushBuf();
496	}
497
498
499	/*************************************************************************************************/
500	void F90_WriteVecData( VARIABLE * var, int min, int max, int split )
501	{
502	char buf[80];
503	char *p;
504
505	if( split )
506	sprintf( buf, "%6sdata( %s(i), i = %d, %d ) / &\n%5s",
507	" ", var->name, min, max, " " );
508	else
509	sprintf( buf, "%6sdata %s / &\n%5s",
510	" ", var->name, " " );
511
512	FlushThisBuf( buf );
513	bprintf( " / \n\n" );
514	FlushBuf();
515	}
516
517	/*************************************************************************************************/
518	void F90_DeclareDataOld( int v, int * values, int n )
519	{
520	int i, j;
521	int nlines, min, max;
522	int split;
523	VARIABLE *var;
524	int * ival;
525	double * dval;
526	char **cval;
527	int maxCols = MAX_COLS;
528	char dsbuf[55];
529
530	var = varTable[ v ];
531	ival = (int*) values;
532	dval = (double*) values;
533	cval = (char**) values;
534
535	nlines = 1;
536	min = max = 1;
537	split = 0;
538
539	switch( var->type ) {
540	case VELM: if( n <= 0 ) break;
541	for( i = 0; i < n; i++ ) {
542	switch( var->baseType ) {
543	case INT: bprintf( "%3d", ival[i] ); maxCols=12; break;
544	case DOUBLE:
545	case REAL:bprintf( "%5lg", dval[i] ); maxCols=8; break;
546	case STRING:bprintf( "'%s'", cval[i] ); maxCols=5; break;
547	case DOUBLESTRING:
548	strncpy( dsbuf, cval[i], 54 ); dsbuf[54]='\0';
549	bprintf( "'%48s'", dsbuf ); maxCols=1; break;
550	}
551	if( ( (i+1) % 12 == 0 ) && ( nlines > MAX_LINES ) ) {
552	split = 1; nlines = 1;
553	F90_WriteVecData( var, min, max, split );
554	min = max + 1;
555	}
556	else {
557	if( i < n-1 ) bprintf( "," );
558	if( (i+1) % maxCols == 0 ) {
559	bprintf( "\n%5s", " " );
560	nlines++;
561	}
562	}
563	max ++;
564	}
565	F90_WriteVecData( var, min, max-1, split );
566	break;
567
568	case ELM: bprintf( "%6sdata %s / ", " ", var->name );
569	switch( var->baseType ) {
570	case INT: bprintf( "%d", *ival ); break;
571	case DOUBLE:
572	case REAL:bprintf( "%lg", *dval ); break;
573	case STRING:bprintf( "'%s'", *cval ); break;
574	case DOUBLESTRING:
575	strncpy( dsbuf, *cval, 54 ); dsbuf[54]='\0';
576	bprintf( "'%s'", dsbuf ); maxCols=1; break;
577	/* bprintf( "'%50s'", cval ); break; /
578	}
579	bprintf( " / \n" );
580	FlushBuf();
581	break;
582	default:
583	printf( "\n Function not defined !\n" );
584	break;
585	}
586	}
587
588	/*************************************************************************************************/
589	void F90_InitDeclare( int v, int n, void * values )
590	{
591	int i;
592	VARIABLE * var;
593
594	var = varTable[ v ];
595	var->maxi = max( n, 1 );
596
597	NewLines(1);
598	F90_DeclareData( v, values, n );
599	}
600
601	/*************************************************************************************************/
602	void F90_FunctionStart( int f, int *vars )
603	{
604	int i;
605	int v;
606	char * name;
607	int narg;
608
609	name = varTable[ f ]->name;
610	narg = varTable[ f ]->maxi;
611
612	bprintf("SUBROUTINE %s ( ", name );
613	for( i = 0; i < narg-1; i++ ) {
614	v = vars[ i ];
615	bprintf("%s, ", varTable[ v ]->name );
616	}
617	if( narg >= 1 ) {
618	v = vars[ narg-1 ];
619	bprintf("%s ", varTable[ v ]->name );
620	}
621	bprintf(")\n");
622
623	FlushBuf();
624	}
625
626	/*************************************************************************************************/
627	void F90_FunctionPrototipe( int f, ... )
628	{
629	char * name;
630	int narg;
631
632	name = varTable[ f ]->name;
633	narg = varTable[ f ]->maxi;
634
635	bprintf(" EXTERNAL %s\n", name );
636
637	FlushBuf();
638	}
639
640	/*************************************************************************************************/
641	void F90_FunctionBegin( int f, ... )
642	{
643	Va_list args;
644	int i;
645	int v;
646	int vars[20];
647	char * name;
648	int narg;
649	FILE *oldf;
650
651	name = varTable[ f ]->name;
652	narg = varTable[ f ]->maxi;
653
654	Va_start( args, f );
655	for( i = 0; i < narg; i++ )
656	vars[ i ] = va_arg( args, int );
657	va_end( args );
658
659	CommentFncBegin( f, vars );
660	F90_FunctionStart( f, vars );
661	NewLines(1);
662	/* bprintf(" USE %s_Precision\n", rootFileName );
663	bprintf(" USE %s_Parameters\n\n", rootFileName ); */
664	/* bprintf(" IMPLICIT NONE\n" ); */
665
666	FlushBuf();
667
668	for( i = 0; i < narg; i++ )
669	F90_Declare( vars[ i ] );
670
671	bprintf("\n");
672	FlushBuf();
673
674	MapFunctionComment( f, vars );
675	}
676
677	/*************************************************************************************************/
678	void F90_FunctionEnd( int f )
679	{
680	bprintf(" \nEND SUBROUTINE %s\n\n", varTable[ f ]->name );
681
682	FlushBuf();
683
684	CommentFunctionEnd( f );
685	}
686
687	/*************************************************************************************************/
688	void F90_Inline( char *fmt, ... )
689	{
690	va_list args;
691	char buf[ 1000 ];
692
693	if( useLang != F90_LANG ) return;
694
695	va_start( args, fmt );
696	vsprintf( buf, fmt, args );
697	va_end( args );
698	bprintf( "%s\n", buf );
699
700	FlushBuf();
701
702	}
703
704	/*************************************************************************************************/
705	void Use_F90()
706	{
707	WriteElm = F90_WriteElm;
708	WriteSymbol = F90_WriteSymbol;
709	WriteAssign = F90_WriteAssign;
710	WriteComment = F90_WriteComment;
711	DeclareConstant = F90_DeclareConstant;
712	Declare = F90_Declare;
713	ExternDeclare = F90_ExternDeclare;
714	GlobalDeclare = F90_GlobalDeclare;
715	InitDeclare = F90_InitDeclare;
716
717	FunctionStart = F90_FunctionStart;
718	FunctionPrototipe = F90_FunctionPrototipe;
719	FunctionBegin = F90_FunctionBegin;
720	FunctionEnd = F90_FunctionEnd;
721
722	OpenFile( &param_headerFile, rootFileName, "_Parameters.f90", "Parameter Module File" );
723	/* mz_rs_20050117+ */
724	OpenFile( &initFile, rootFileName, "_Initialize.f90", "Initialization File" );
725	/* mz_rs_20050117- */
726	/* mz_rs_20050518+ no driver file if driver = none */
727	if( strcmp( driver, "none" ) != 0 )
728	OpenFile( &driverFile, rootFileName, "_Main.f90", "Main Program File" );
729	/* mz_rs_20050518- */
730	OpenFile( &integratorFile, rootFileName, "_Integrator.f90",
731	"Numerical Integrator (Time-Stepping) File" );
732	OpenFile( &linalgFile, rootFileName, "_LinearAlgebra.f90",
733	"Linear Algebra Data and Routines File" );
734	OpenFile( &functionFile, rootFileName, "_Function.f90",
735	"The ODE Function of Chemical Model File" );
736	OpenFile( &jacobianFile, rootFileName, "_Jacobian.f90",
737	"The ODE Jacobian of Chemical Model File" );
738	OpenFile( &rateFile, rootFileName, "_Rates.f90",
739	"The Reaction Rates File" );
740	if ( useStochastic )
741	OpenFile( &stochasticFile, rootFileName, "_Stochastic.f90",
742	"The Stochastic Chemical Model File" );
743	if ( useStoicmat ) {
744	OpenFile( &stoichiomFile, rootFileName, "_Stoichiom.f90",
745	"The Stoichiometric Chemical Model File" );
746	OpenFile( &sparse_stoicmFile, rootFileName, "_StoichiomSP.f90",
747	"Sparse Stoichiometric Data Structures File" );
748	}
749	OpenFile( &utilFile, rootFileName, "_Util.f90",
750	"Auxiliary Routines File" );
751	/* OpenFile( &sparse_dataFile, rootFileName, "_Sparse.f90",
752	"Sparse Data Module File" );*/
753	OpenFile( &global_dataFile, rootFileName, "_Global.f90", "Global Data Module File" );
754	if ( useJacSparse ) {
755	OpenFile( &sparse_jacFile, rootFileName, "_JacobianSP.f90",
756	"Sparse Jacobian Data Structures File" );
757	}
758	if ( useHessian ) {
759	OpenFile( &hessianFile, rootFileName, "_Hessian.f90", "Hessian File" );
760	OpenFile( &sparse_hessFile, rootFileName, "_HessianSP.f90",
761	"Sparse Hessian Data Structures File" );
762	}
763	OpenFile( &mapFile, rootFileName, ".map",
764	"Map File with Human-Readable Information" );
765	OpenFile( &monitorFile, rootFileName, "_Monitor.f90",
766	"Utility Data Module File" );
767	}

Note: See TracBrowser for help on using the repository browser.

Download in other formats:

| Impressum | ©Leibniz Universität Hannover |