Home


About us
PALM
PALM-4U
Installation
Release notes
Documentation
Getting Help
Gallery
Developers area

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

Last change on this file since 4869 was 4843, checked in by raasch, 4 years 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.
                                                                                                                                                                                                                                                                                                                                                                               
  | Impressum | ©Leibniz Universität Hannover |