?  search:
summary | log | graphiclog1 | graphiclog2 | commit | commitdiff | tree | refs | edit | fork
blame | history | raw | HEAD
added README_changes.txt
[wrffire.git] / wrfv2_fire / chem / KPP / kpp / kpp-2.1 / src / code_f90.c
blobb9f4b141a2208e23904dc9ef9e91ba562884e3f2
1 /******************************************************************************
2
3 KPP - The Kinetic PreProcessor
4 Builds simulation code for chemical kinetic systems
5
6 Copyright (C) 1995-1996 Valeriu Damian and Adrian Sandu
7 Copyright (C) 1997-2005 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=12)", /* 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
126 crtident = 2 + ident * 2;
127 bprintf("%*s%s = ", crtident, "", ls);
128 start = strlen( ls ) + 2;
129 linelg = 120 - crtident - start - 1; /* F90 max line length is 132 */
130
131 first = 1;
132 while( strlen(rs) > linelg ) {
133 ifound = 0; jfound = 0;
134 if ( number_of_lines >= MAX_NO_OF_LINES ) {
135 /* If a new line needs to be started.
136 Note: the approach below will create erroneous code if the +/- is within a subexpression, e.g. for
137 A*(B+C) one cannot start a new continuation line by splitting at the + sign */
138 for( j=linelg; j>5; j-- ) /* split row here if +, -, or comma */
139 if ( ( rs[j] == op_plus )||( rs[j] == op_minus )||( rs[j]==',' ) ) {
140 jfound = 1; i=j; break;
141 }
142 }
143 if ( ( number_of_lines < MAX_NO_OF_LINES )||( !jfound ) ) {
144 for( i=linelg; i>10; i-- ) /* split row here if operator or comma */
145 if ( ( rs[i] & 0x80 )||( rs[i]==',' ) ) {
146 ifound = 1; break;
147 }
148 if( i <= 10 ) {
149 printf("\n Warning: double-check continuation lines for:\n %s = %s\n",ls,rs);
150 i = linelg;
151 }
152 }
153 while ( rs[i-1] & 0x80 ) i--; /* put all operators on the next row */
154 while ( rs[i] == ',' ) i++; /* put commas on the current row */
155
156 c = rs[i];
157 rs[i] = 0;
158
159 if ( first ) { /* first line in a split row */
160 bprintf("%s", rs );
161 linelg++;
162 first = 0;
163 } else {/* continuation line in a split row - but not last line*/
164 bprintf("&\n %*s&%s", start, "", rs );
165 if ( jfound ) {
166 bprintf("\n%*s%s = %s", crtident, "", ls, ls);
167 number_of_lines = 1;
168 }
169 }
170 rs[i] = c;
171 rs += i; /* jump to the first not-yet-written character */
172 number_of_lines++;
173 }
174
175 if ( number_of_lines > MAX_NO_OF_LINES ) {
176 printf("\n Warning: %d continuation lines for %s = ...",number_of_lines,ls);
177 }
178
179 if ( first ) bprintf("%s\n", rs ); /* non-split row */
180 else bprintf("&\n %*s&%s\n", start, "", rs ); /* last line in a split row */
181
182
183 FlushBuf();
184 }
185
186
187 /*************************************************************************************************/
188 void F90_WriteComment( char *fmt, ... )
189 {
190 Va_list args;
191 int n;
192 char buf[ MAX_LINE ];
193
194 Va_start( args, fmt );
195 vsprintf( buf, fmt, args );
196 va_end( args );
197 /* remove trailing spaces */
198 /* taken from http://www.cs.bath.ac.uk/~pjw/NOTES/ansi_c/ch10-idioms.pdf */
199 for (n= strlen(buf) - 1; n >= 0; n--)
200 if (buf[n] != ' ') break;
201 buf[n + 1]= '\0';
202 bprintf( "! %s\n", buf );
203 FlushBuf();
204 }
205
206 /*************************************************************************************************/
207 char * F90_Decl( int v )
208 {
209 static char buf[120];
210 VARIABLE *var;
211 char *baseType;
212 char maxi[20];
213 char maxj[20];
214
215 var = varTable[ v ];
216 baseType = F90_types[ var->baseType ];
217
218 *buf = 0;
219
220 switch( var->type ) {
221 case ELM:
222 sprintf( buf, "%s :: %s", baseType, var->name );
223 break;
224 case VELM:
225 if( var->maxi > 0 ) sprintf( maxi, "%d", var->maxi );
226 /* else sprintf( maxi, "%s", varTable[ -var->maxi ]->name); */
227 /*sprintf( buf, "%s, DIMENSION(%s) :: %s", baseType, maxi, var->name );*/
228 if( var->maxi == 0 ) sprintf( maxi, "%d", 1 );
229 /* else sprintf( maxi, "%s", varTable[ -var->maxi ]->name); */
230 if ( var->maxi < 0 ) {
231 if (varTable[ -var->maxi ]->value < 0)
232 sprintf( maxi, "%s", varTable[ -var->maxi ]->name );
233 else
234 sprintf( maxi, "%d", (varTable[-var->maxi]->value)==0?
235 1:varTable[-var->maxi]->value );
236 }
237 sprintf( buf, "%s :: %s(%s)", baseType, var->name, maxi );
238 break;
239 case MELM:
240 if( var->maxi > 0 ) sprintf( maxi, "%d", var->maxi );
241 else {
242 if (varTable[ -var->maxi ]->value < 0)
243 sprintf( maxi, "%s", varTable[ -var->maxi ]->name );
244 else
245 sprintf( maxi, "%d", (varTable[-var->maxi]->value)==0?
246 1:varTable[-var->maxi]->value );
247 }
248 /* else sprintf( maxi, "%s", varTable[ -var->maxi ]->name); */
249 /* if( (var->maxi == 0) ||
250 ((var->maxi < 0) && (varTable[ -var->maxi ]->maxi == 0)) )
251 strcat( maxi, "+1"); */
252 if( var->maxj > 0 ) sprintf( maxj, "%d", var->maxj );
253 else {
254 if (varTable[ -var->maxj ]->value < 0)
255 sprintf( maxj, "%s", varTable[ -var->maxj ]->name );
256 else
257 sprintf( maxj, "%d", (varTable[-var->maxj]->value)==0?
258 1:varTable[-var->maxj]->value );
259 }
260 /* else sprintf( maxj, "%s", varTable[ -var->maxj ]->name); */
261 /*if( (var->maxj == 0) ||
262 ((var->maxj < 0 ) && (varTable[ -var->maxj ]->maxi == 0)) )
263 strcat( maxj, "+1");*/
264 /*sprintf( buf, "%s, DIMENSION(%s,%s) :: %s",
265 baseType, maxi, maxj,var->name ); */
266 sprintf( buf, "%s :: %s(%s,%s)",
267 baseType, var->name, maxi, maxj );
268 break;
269 default:
270 printf( "Can not declare type %d\n", var->type );
271 break;
272 }
273 return buf;
274 }
275
276 /*************************************************************************************************/
277 char * F90_DeclareData( int v, void * values, int n)
278 {
279 int i, j;
280 int nlines;
281 int split;
282 static char buf[120];
283 VARIABLE *var;
284 int * ival;
285 double * dval;
286 char ** cval;
287 char *baseType;
288 char maxi[20];
289 char maxj[20];
290 int maxCols = MAX_COLS;
291 char dsbuf[200];
292
293 int i_from, i_to;
294 int isplit;
295 int splitsize;
296 int maxi_mod;
297 int maxi_div;
298
299 char mynumber[30];
300
301 var = varTable[ v ];
302 ival = (int*) values;
303 dval = (double *) values;
304 cval = (char **) values;
305
306 nlines = 1;
307 split = 0;
308 var -> maxi = max( n, 1 );
309
310 baseType = F90_types[ var->baseType ];
311
312 *buf = 0;
313
314 switch( var->type ) {
315 case ELM:
316 bprintf( " %s :: %s = ", baseType, var->name );
317 switch ( var->baseType ) {
318 case INT: bprintf( "%d", *ival ); break;
319 case DOUBLE: bprintf( "%f", *dval); break;
320 case REAL: bprintf( "%lg", *dval ); break;
321 case STRING: bprintf( "'%3s'", *cval ); break;
322 }
323 break;
324 case VELM:
325 /* define maxCols here already and choose suitable splitsize */
326 switch( var -> baseType ) {
327 case INT: maxCols =12; break;
328 case DOUBLE: maxCols = 5; break;
329 case REAL: maxCols = 5; break;
330 case STRING: maxCols = 3; break;
331 case DOUBLESTRING: maxCols = 1; break;
332 }
333 splitsize = 30 * maxCols; /* elements = lines * columns */
334 maxi_mod = var->maxi % splitsize;
335 maxi_div = var->maxi / splitsize;
336 /* correction if var->maxi is a multiple of splitsize */
337 if ( (maxi_div>0) && (maxi_mod==0) ) {
338 maxi_mod = splitsize;
339 maxi_div--;
340 }
341 for ( isplit=0; isplit <= maxi_div; isplit++ ) {
342 if( var->maxi > 0 ) sprintf( maxi, "%d", var->maxi );
343 else sprintf( maxi, "%s", varTable[ -var->maxi ]->name );
344 if( (var->maxi == 0) ||
345 ((var->maxi < 0) && (varTable[ -var->maxi ]->maxi == 0)) )
346 strcat( maxi, "+1");
347 bprintf( " %s, " , baseType);
348 if( n>0 ) bprintf( "PARAMETER, " ); /* if values are assigned now */
349 if ( maxi_div==0 ) { /* define array in one piece */
350 bprintf( "DIMENSION(%s) :: %s",
351 maxi, var->name) ;
352 } else {/* define partial arrays */
353 if ( isplit==maxi_div ) { /* last part has size maxi_mod */
354 bprintf( "DIMENSION(%d) :: %s_%d",
355 maxi_mod, var->name, isplit) ;
356 } else { /* all other parts have size splitsize */
357 bprintf( "DIMENSION(%d) :: %s_%d",
358 splitsize, var->name, isplit) ;
359 }
360 }
361 if( n<=0 ) break;
362
363 /* now list values */
364 bprintf( " = (/ &\n " );
365 /* if the array is defined in one piece, then the for loop will
366 go from 0 to n. Otherwise, there will be partial arrays from
367 i_from to i_to which are of size splitsize except for the
368 last one which is usually smaller and contains the rest */
369 i_from = isplit * splitsize;
370 i_to = min(i_from+splitsize,n);
371 for ( i=i_from; i < i_to; i++ ) {
372 switch( var -> baseType ) {
373 case INT:
374 bprintf( "%3d", ival[i] ); break;
375 case DOUBLE:
376 /* bprintf( "%4f", dval[i] ); maxCols = 5; break; */
377 sprintf(mynumber, "%12.6e_dp",dval[i]);
378 /* mynumber[ strlen(mynumber)-4 ] = 'd'; */
379 bprintf( " %s", mynumber ); break;
380 case REAL:
381 bprintf( "%12.6e", dval[i] ); break;
382 case STRING:
383 bprintf( "'%-12s'", cval[i] ); break;
384 case DOUBLESTRING:
385 /* strncpy( dsbuf, cval[i], 54 ); dsbuf[54]='\0'; */
386 /* bprintf( "'%48s'", dsbuf ); break; */
387 bprintf( "'%-100.100s'", cval[i] ); break;
388 }
389 if( i < i_to-1 ) {
390 bprintf( "," );
391 if( (i+1) % maxCols == 0 ) {
392 bprintf( " &\n " );
393 nlines++;
394 }
395 }
396 }
397 bprintf( " /)\n" );
398 }
399
400 /* combine the partial arrays */
401 if ( maxi_div != 0 ) {
402 bprintf( " %s, PARAMETER, DIMENSION(%s) :: %s = (/&\n ",
403 baseType, maxi, var->name) ;
404 for ( isplit=0; isplit <= maxi_div; isplit++ ) {
405 bprintf( "%s_%d", var->name, isplit) ;
406 if( isplit < maxi_div ) { /* more parts will follow */
407 bprintf( ", " );
408 /* line break after 5 variables */
409 if( (isplit+1) % 5 == 0 ) bprintf( "&\n " );
410 } else { /* after last part */
411 bprintf( " /)\n" );
412 }
413 }
414 }
415
416 break;
417
418 case MELM: if( var->maxi > 0 ) sprintf( maxi, "%d", var->maxi );
419 else sprintf( maxi, "%s", varTable[ -var->maxi ]->name );
420 if( (var->maxi == 0) ||
421 ((var->maxi < 0) && (varTable[ -var->maxi ]->maxi == 0)) )
422 strcat( maxi, "+1");
423 if( var->maxj > 0 ) sprintf( maxj, "%d", var->maxj );
424 else sprintf( maxj, "%s", varTable[ -var->maxj ]->name );
425 if( (var->maxj == 0) ||
426 ((var->maxj < 0 ) && (varTable[ -var->maxj ]->maxi == 0)) )
427 strcat( maxj, "+1");
428 sprintf( buf, "%s, DIMENSION(%s,%s) :: %s\n", /* changed here */
429 baseType, maxi, maxj,var->name );
430 break;
431 default:
432 printf( "Can not declare type %d", var->type );
433 break;
434 }
435 return buf;
436 }
437
438 /*************************************************************************************************/
439 void F90_Declare( int v )
440 {
441 if( varTable[ v ]->comment ) {
442 F90_WriteComment( "%s - %s",
443 varTable[ v ]->name, varTable[ v ]->comment );
444 }
445 bprintf(" %s\n", F90_Decl(v) );
446
447 FlushBuf();
448 }
449
450 /*************************************************************************************************/
451 void F90_ExternDeclare( int v )
452 {
453 F90_Declare( v );
454 /* !cms bprintf(" COMMON /%s/ %s\n", CommonName, varTable[ v ]->name ); */
455 }
456
457 /*************************************************************************************************/
458 void F90_GlobalDeclare( int v )
459 {
460 }
461
462 /*************************************************************************************************/
463 void F90_DeclareConstant( int v, char *val )
464 {
465 VARIABLE *var;
466 int ival;
467 char dummy_val[100]; /* used just to avoid strange behaviour of
468 sscanf when compiled with gcc */
469
470 strcpy(dummy_val,val);val = dummy_val;
471
472 var = varTable[ v ];
473
474 if( sscanf(val, "%d", &ival) == 1 )
475 if( ival == 0 ) var->maxi = 0;
476 else var->maxi = 1;
477 else
478 var->maxi = -1;
479
480 if( var->comment )
481 F90_WriteComment( "%s - %s", var->name, var->comment );
482
483 switch( var->type ) {
484 case CONST: bprintf(" %s, PARAMETER :: %s = %s \n",
485 F90_types[ var->baseType ], var->name, val );
486 break;
487 default:
488 printf( "Invalid constant %d", var->type );
489 break;
490 }
491
492 FlushBuf();
493 }
494
495
496 /*************************************************************************************************/
497 void F90_WriteVecData( VARIABLE * var, int min, int max, int split )
498 {
499 char buf[80];
500 char *p;
501
502 if( split )
503 sprintf( buf, "%6sdata( %s(i), i = %d, %d ) / &\n%5s",
504 " ", var->name, min, max, " " );
505 else
506 sprintf( buf, "%6sdata %s / &\n%5s",
507 " ", var->name, " " );
508
509 FlushThisBuf( buf );
510 bprintf( " / \n\n" );
511 FlushBuf();
512 }
513
514 /*************************************************************************************************/
515 void F90_DeclareDataOld( int v, int * values, int n )
516 {
517 int i, j;
518 int nlines, min, max;
519 int split;
520 VARIABLE *var;
521 int * ival;
522 double * dval;
523 char **cval;
524 int maxCols = MAX_COLS;
525 char dsbuf[55];
526
527 var = varTable[ v ];
528 ival = (int*) values;
529 dval = (double*) values;
530 cval = (char**) values;
531
532 nlines = 1;
533 min = max = 1;
534 split = 0;
535
536 switch( var->type ) {
537 case VELM: if( n <= 0 ) break;
538 for( i = 0; i < n; i++ ) {
539 switch( var->baseType ) {
540 case INT: bprintf( "%3d", ival[i] ); maxCols=12; break;
541 case DOUBLE:
542 case REAL:bprintf( "%5lg", dval[i] ); maxCols=8; break;
543 case STRING:bprintf( "'%s'", cval[i] ); maxCols=5; break;
544 case DOUBLESTRING:
545 strncpy( dsbuf, cval[i], 54 ); dsbuf[54]='\0';
546 bprintf( "'%48s'", dsbuf ); maxCols=1; break;
547 }
548 if( ( (i+1) % 12 == 0 ) && ( nlines > MAX_LINES ) ) {
549 split = 1; nlines = 1;
550 F90_WriteVecData( var, min, max, split );
551 min = max + 1;
552 }
553 else {
554 if( i < n-1 ) bprintf( "," );
555 if( (i+1) % maxCols == 0 ) {
556 bprintf( "\n%5s", " " );
557 nlines++;
558 }
559 }
560 max ++;
561 }
562 F90_WriteVecData( var, min, max-1, split );
563 break;
564
565 case ELM: bprintf( "%6sdata %s / ", " ", var->name );
566 switch( var->baseType ) {
567 case INT: bprintf( "%d", *ival ); break;
568 case DOUBLE:
569 case REAL:bprintf( "%lg", *dval ); break;
570 case STRING:bprintf( "'%s'", *cval ); break;
571 case DOUBLESTRING:
572 strncpy( dsbuf, *cval, 54 ); dsbuf[54]='\0';
573 bprintf( "'%s'", dsbuf ); maxCols=1; break;
574 /* bprintf( "'%50s'", *cval ); break; */
575 }
576 bprintf( " / \n" );
577 FlushBuf();
578 break;
579 default:
580 printf( "\n Function not defined !\n" );
581 break;
582 }
583 }
584
585 /*************************************************************************************************/
586 void F90_InitDeclare( int v, int n, void * values )
587 {
588 int i;
589 VARIABLE * var;
590
591 var = varTable[ v ];
592 var->maxi = max( n, 1 );
593
594 NewLines(1);
595 F90_DeclareData( v, values, n );
596 }
597
598 /*************************************************************************************************/
599 void F90_FunctionStart( int f, int *vars )
600 {
601 int i;
602 int v;
603 char * name;
604 int narg;
605
606 name = varTable[ f ]->name;
607 narg = varTable[ f ]->maxi;
608
609 bprintf("SUBROUTINE %s ( ", name );
610 for( i = 0; i < narg-1; i++ ) {
611 v = vars[ i ];
612 bprintf("%s, ", varTable[ v ]->name );
613 }
614 if( narg >= 1 ) {
615 v = vars[ narg-1 ];
616 bprintf("%s ", varTable[ v ]->name );
617 }
618 bprintf(")\n");
619
620 FlushBuf();
621 }
622
623 /*************************************************************************************************/
624 void F90_FunctionPrototipe( int f, ... )
625 {
626 char * name;
627 int narg;
628
629 name = varTable[ f ]->name;
630 narg = varTable[ f ]->maxi;
631
632 bprintf(" EXTERNAL %s\n", name );
633
634 FlushBuf();
635 }
636
637 /*************************************************************************************************/
638 void F90_FunctionBegin( int f, ... )
639 {
640 Va_list args;
641 int i;
642 int v;
643 int vars[20];
644 char * name;
645 int narg;
646 FILE *oldf;
647
648 name = varTable[ f ]->name;
649 narg = varTable[ f ]->maxi;
650
651 Va_start( args, f );
652 for( i = 0; i < narg; i++ )
653 vars[ i ] = va_arg( args, int );
654 va_end( args );
655
656 CommentFncBegin( f, vars );
657 F90_FunctionStart( f, vars );
658 NewLines(1);
659 /* bprintf(" USE %s_Precision\n", rootFileName );
660 bprintf(" USE %s_Parameters\n\n", rootFileName ); */
661 /* bprintf(" IMPLICIT NONE\n" ); */
662
663 FlushBuf();
664
665 for( i = 0; i < narg; i++ )
666 F90_Declare( vars[ i ] );
667
668 bprintf("\n");
669 FlushBuf();
670
671 MapFunctionComment( f, vars );
672 }
673
674 /*************************************************************************************************/
675 void F90_FunctionEnd( int f )
676 {
677 bprintf(" \nEND SUBROUTINE %s\n\n", varTable[ f ]->name );
678
679 FlushBuf();
680
681 CommentFunctionEnd( f );
682 }
683
684 /*************************************************************************************************/
685 void F90_Inline( char *fmt, ... )
686 {
687 va_list args;
688 char buf[ 1000 ];
689
690 if( useLang != F90_LANG ) return;
691
692 va_start( args, fmt );
693 vsprintf( buf, fmt, args );
694 va_end( args );
695 bprintf( "%s\n", buf );
696
697 FlushBuf();
698
699 }
700
701 /*************************************************************************************************/
702 void Use_F90()
703 {
704 WriteElm = F90_WriteElm;
705 WriteSymbol = F90_WriteSymbol;
706 WriteAssign = F90_WriteAssign;
707 WriteComment = F90_WriteComment;
708 DeclareConstant = F90_DeclareConstant;
709 Declare = F90_Declare;
710 ExternDeclare = F90_ExternDeclare;
711 GlobalDeclare = F90_GlobalDeclare;
712 InitDeclare = F90_InitDeclare;
713
714 FunctionStart = F90_FunctionStart;
715 FunctionPrototipe = F90_FunctionPrototipe;
716 FunctionBegin = F90_FunctionBegin;
717 FunctionEnd = F90_FunctionEnd;
718
719 OpenFile( &param_headerFile, rootFileName, "_Parameters.f90", "Parameter Module File" );
720 /* mz_rs_20050117+ */
721 OpenFile( &initFile, rootFileName, "_Initialize.f90", "Initialization File" );
722 /* mz_rs_20050117- */
723 /* mz_rs_20050518+ no driver file if driver = none */
724 if( strcmp( driver, "none" ) != 0 )
725 OpenFile( &driverFile, rootFileName, "_Main.f90", "Main Program File" );
726 /* mz_rs_20050518- */
727 OpenFile( &integratorFile, rootFileName, "_Integrator.f90",
728 "Numerical Integrator (Time-Stepping) File" );
729 OpenFile( &linalgFile, rootFileName, "_LinearAlgebra.f90",
730 "Linear Algebra Data and Routines File" );
731 OpenFile( &functionFile, rootFileName, "_Function.f90",
732 "The ODE Function of Chemical Model File" );
733 OpenFile( &jacobianFile, rootFileName, "_Jacobian.f90",
734 "The ODE Jacobian of Chemical Model File" );
735 OpenFile( &rateFile, rootFileName, "_Rates.f90",
736 "The Reaction Rates File" );
737
738 if ( useWRFConform ) {
739 OpenFile( &wrf_UpdateRconstFile, rootFileName, "_Update_Rconst.f90",
740 "The KPP-WRF conform Reaction Rates File" );
741 }
742
743
744 if ( useStochastic )
745 OpenFile( &stochasticFile, rootFileName, "_Stochastic.f90",
746 "The Stochastic Chemical Model File" );
747 if ( useStoicmat ) {
748 OpenFile( &stoichiomFile, rootFileName, "_Stoichiom.f90",
749 "The Stoichiometric Chemical Model File" );
750 OpenFile( &sparse_stoicmFile, rootFileName, "_StoichiomSP.f90",
751 "Sparse Stoichiometric Data Structures File" );
752 }
753 OpenFile( &utilFile, rootFileName, "_Util.f90",
754 "Auxiliary Routines File" );
755 /* OpenFile( &sparse_dataFile, rootFileName, "_Sparse.f90",
756 "Sparse Data Module File" );*/
757 OpenFile( &global_dataFile, rootFileName, "_Global.f90", "Global Data Module File" );
758 if ( useJacSparse ) {
759 OpenFile( &sparse_jacFile, rootFileName, "_JacobianSP.f90",
760 "Sparse Jacobian Data Structures File" );
761 }
762 if ( useHessian ) {
763 OpenFile( &hessianFile, rootFileName, "_Hessian.f90", "Hessian File" );
764 OpenFile( &sparse_hessFile, rootFileName, "_HessianSP.f90",
765 "Sparse Hessian Data Structures File" );
766 }
767 OpenFile( &mapFile, rootFileName, ".map",
768 "Map File with Human-Readable Information" );
769 OpenFile( &monitorFile, rootFileName, "_Monitor.f90",
770 "Utility Data Module File" );
771 }
A coupled weather-fire forecasting model built on top of Weather Research and Forecasting (WRF).