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

Last change on this file since 4843 was 4843, checked in by raasch, 16 months ago

local namelist parameter added to switch off the module although the respective module namelist appears in the namelist file, further copyright updates

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) -2021 996 Valeriu Damian and Adrian Sandu
7  Copyright (C) -2021 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
40char *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/*************************************************************************************************/
49void F90_WriteElm( NODE * n )
50{
51ELEMENT *elm;
52char * name;
53char maxi[20];
54char 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/*************************************************************************************************/
80void 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/*************************************************************************************************/
108void F90_WriteAssign( char *ls, char *rs )
109{
110int start;
111int linelg;
112int i, j;
113int ifound, jfound;
114char c;
115int first;
116int crtident;
117
118/* Max no of continuation lines in F90/F95 differs with compilers, but 39
119                               should work for every compiler*/
120int 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; */               
125char 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/*************************************************************************************************/
189void F90_WriteComment( char *fmt, ... )
190{
191Va_list args;
192int n;
193char 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/*************************************************************************************************/
208char * F90_Decl( int v )
209{
210static char buf[120];
211VARIABLE *var;
212char *baseType;
213char maxi[20];
214char 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/*************************************************************************************************/
278char * F90_DeclareData( int v, void * values, int n)
279{
280int i, j;
281int nlines;
282int split;
283static char buf[120];
284VARIABLE *var;
285int * ival;
286double * dval;
287char ** cval;
288char *baseType;
289char maxi[20];
290char maxj[20];
291int maxCols = MAX_COLS;
292char 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/*************************************************************************************************/
442void 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/*************************************************************************************************/
454void F90_ExternDeclare( int v )
455{
456  F90_Declare( v );
457//  bprintf("      COMMON /%s/ %s\n", CommonName, varTable[ v ]->name );
458}
459
460/*************************************************************************************************/
461void F90_GlobalDeclare( int v )
462{
463}
464
465/*************************************************************************************************/
466void F90_DeclareConstant( int v, char *val ) 
467{
468VARIABLE *var;
469int ival;
470char 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/*************************************************************************************************/
500void F90_WriteVecData( VARIABLE * var, int min, int max, int split )   
501{
502char buf[80];
503char *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/*************************************************************************************************/
518void F90_DeclareDataOld( int v, int * values, int n )
519{
520int i, j;
521int nlines, min, max;
522int split;
523VARIABLE *var;
524int * ival;
525double * dval;
526char **cval;
527int maxCols = MAX_COLS;
528char 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/*************************************************************************************************/
589void F90_InitDeclare( int v, int n, void * values )
590{
591int i;
592VARIABLE * 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/*************************************************************************************************/
602void F90_FunctionStart( int f, int *vars )
603{
604int i;
605int v;
606char * name;
607int 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/*************************************************************************************************/
627void F90_FunctionPrototipe( int f, ... )
628{
629char * name;
630int 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/*************************************************************************************************/
641void F90_FunctionBegin( int f, ... )
642{
643Va_list args;
644int i;
645int v;
646int vars[20];
647char * name;
648int narg;
649FILE *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/*************************************************************************************************/
678void 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/*************************************************************************************************/
688void F90_Inline( char *fmt, ... )
689{
690va_list args;
691char 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/*************************************************************************************************/
705void 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.