source: trunk/AGRIF/LIB/Writedeclarations.c @ 396

Last change on this file since 396 was 396, checked in by opalod, 15 years ago

Initial revision

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 23.1 KB
Line 
1/******************************************************************************/
2/*                                                                            */
3/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
4/*                                                                            */
5/*     Copyright (C) 2005 Laurent Debreu (Laurent.Debreu@imag.fr)             */
6/*                        Cyril Mazauric (Cyril.Mazauric@imag.fr)             */
7/*                                                                            */
8/*     This program is free software; you can redistribute it and/or modify   */
9/*    it                                                                      */
10/*                                                                            */
11/*    This program is distributed in the hope that it will be useful,         */
12/*     but WITHOUT ANY WARRANTY; without even the implied warranty of         */
13/*     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the          */
14/*    GNU General Public License for more details.                            */
15/*                                                                            */
16/******************************************************************************/
17#include <stdio.h>
18#include <stdlib.h>
19#include <string.h>
20
21#include "decl.h"
22
23/******************************************************************************/
24/*                         WriteBeginDeclaration                              */
25/******************************************************************************/
26/* This subroutine is used to write the begin of a declaration                */
27/* taken in a variable record                                                 */
28/*                                                                            */
29/******************************************************************************/
30/*                                                                            */
31/*       integer variable ----------->   INTEGER                              */
32/*                                                                            */
33/******************************************************************************/
34void WriteBeginDeclaration(variable *v,char ligne[LONGLIGNE])
35{
36  char tmpligne[LONGLIGNE];
37
38  sprintf (ligne, "%s", v->typevar);
39  if ( v->c_star == 1 ) strcat(ligne,"*");
40  /* We should give the precision of the variable if it has been given        */
41  if ( strcasecmp(v->precision,"") )
42  {
43     sprintf(tmpligne,"(%s)",v->precision);
44     strcat(ligne,tmpligne);
45  }
46  if (strcasecmp(v->dimchar,""))
47  {
48     sprintf(tmpligne,"(%s)",v->dimchar);
49     strcat(ligne,tmpligne);
50  }
51  if ( strcasecmp(v->nameinttypename,"") )
52  {
53     sprintf(tmpligne,"*%s",v->nameinttypename);
54     strcat(ligne,tmpligne);
55  }
56  if (strcasecmp (v->IntentSpec, ""))
57  {
58     sprintf(tmpligne,",INTENT(%s)",v->IntentSpec);
59     strcat(ligne,tmpligne);
60  }   
61  if ( v->VariableIsParameter == 1 ) strcat(ligne, ", PARAMETER");
62  if ( v->PublicDeclare       == 1 ) strcat(ligne, ", PUBLIC"); 
63  if ( v->PrivateDeclare      == 1 ) strcat(ligne, ", PRIVATE"); 
64  if ( v->ExternalDeclare     == 1 ) strcat(ligne, ", EXTERNAL"); 
65  if ( v->allocatable == 1 && v->save ==0 ) strcat(ligne,", ALLOCATABLE");
66  if ( v->optionaldeclare == 1 ) strcat(ligne,", OPTIONAL");
67  if ( v->pointerdeclare == 1 ) strcat(ligne,", POINTER");
68}
69
70
71/******************************************************************************/
72/*                         WriteScalarDeclaration                             */
73/******************************************************************************/
74/* This subroutine is used to write a scalar declaration                      */
75/* taken in a variable record                                                 */
76/*                                                                            */
77/******************************************************************************/
78/*                                                                            */
79/*       integer variable ----------->   INTEGER :: VARIABLE                  */
80/*                                                                            */
81/******************************************************************************/
82void  WriteScalarDeclaration(variable *v,char ligne[LONGLIGNE])
83{
84
85  strcat (ligne, " :: ");
86  strcat (ligne, v->nomvar);
87  if ( v->lengspecgiven == 1 ) strcat(ligne,v->vallengspec);
88  if ( v->VariableIsParameter == 1 ) 
89  {
90     strcat(ligne," = ");
91     strcat(ligne,v->initialvalue);
92  }
93}
94
95
96/******************************************************************************/
97/*                         WriteTableDeclaration                              */
98/******************************************************************************/
99/* This subroutine is used to write a Table declaration                       */
100/* taken in a variable record                                                 */
101/*                                                                            */
102/******************************************************************************/
103/*                                                                            */
104/*  integer variable(nb) ----------->                                         */
105/*                      INTEGER, DIMENSION(1:nb) :: variable                  */
106/*                                                                            */
107/******************************************************************************/
108void  WriteTableDeclaration(variable * v,char ligne[LONGLIGNE],int tmpok)
109{
110  char newname[LONGNOM];
111
112  strcat (ligne, ", Dimension(");
113  if ( v->dimensiongiven == 1 && tmpok == 1 )
114                                           strcat(ligne,v->readedlistdimension);
115  if ( v->dimensiongiven == 1 && tmpok == 0 )
116  {
117     strcpy(newname,ChangeTheInitalvaluebyTabvarsName
118                                          (v->readedlistdimension,globliste,0));
119     if ( !strcasecmp(newname,v->readedlistdimension) )
120     {
121        strcpy(newname,"");     
122        /* la liste des use de cette subroutine                               */
123        strcpy(newname,ChangeTheInitalvaluebyTabvarsName
124                                 (v->readedlistdimension,globalvarofusefile,0));
125        if ( !strcasecmp(newname,"") ) strcat(newname,v->readedlistdimension);
126     }
127     strcat(ligne,newname);
128  }
129  strcat (ligne, ")");
130  strcat (ligne, " :: ");
131  strcat (ligne, v->nomvar); 
132  if ( v->lengspecgiven == 1 ) strcat(ligne,v->vallengspec);
133  if ( !strcasecmp (v->typevar, "character") ) strcat(ligne,vargridparam(v,0));
134}
135
136
137/******************************************************************************/
138/*                         ModifTableDeclaration                              */
139/******************************************************************************/
140/* This subroutine is used to write a Table declaration                       */
141/* taken in a variable record                                                 */
142/*                                                                            */
143/******************************************************************************/
144/*                                                                            */
145/*  integer variable(nb) ----------->                                         */
146/*                      INTEGER, DIMENSION(:),Pointer :: variable             */
147/*                                                                            */
148/******************************************************************************/
149void  ModifTableDeclaration(variable * v,char ligne[LONGLIGNE])
150{
151
152  if ( strcasecmp (v->typevar, "character") )
153  {
154     if ( v->nbdim == 0 )
155     {
156        strcat (ligne, ", Dimension");
157        strcat (ligne, vargridparam (v,0));
158     }
159     else if ((v->nbdim) == 1) strcat (ligne, ", Dimension(:)");
160     else if ((v->nbdim) == 2) strcat (ligne, ", Dimension(:,:)");
161     else if ((v->nbdim) == 3) strcat (ligne, ", Dimension(:,:,:)");
162     else if ((v->nbdim) == 4) strcat (ligne, ", Dimension(:,:,:,:)");
163     else if ((v->nbdim) == 5) strcat (ligne, ", Dimension(:,:,:,:,:)");
164     else if ((v->nbdim) == 6) strcat (ligne, ", Dimension(:,:,:,:,:,:)"); 
165
166     if ( v->nbdim >=  1 ) strcat (ligne, ", pointer");
167  }
168  strcat (ligne, " :: ");
169  strcat (ligne, v->nomvar); 
170  if ( v->lengspecgiven == 1 ) strcat(ligne,v->vallengspec);
171  if ( !strcasecmp (v->typevar, "character") ) strcat(ligne,vargridparam(v,0)); 
172}
173
174/******************************************************************************/
175/*                        writevardeclaration                                 */
176/******************************************************************************/
177/* This subroutine is used to write the initial declaration in the file       */
178/* fileout of a variable                                                      */
179/*                                                                            */
180/******************************************************************************/
181/*                                                                            */
182/*  integer variable(nb) ----------->                                         */
183/*                      INTEGER, DIMENSION(1:nb),Pointer :: variable          */
184/*                                                                            */
185/******************************************************************************/
186void writevardeclaration (listvar * var_record, FILE *fileout)
187{
188  FILE *filecommon;
189  listvar *newvar;
190  variable *v;
191  char ligne[LONGNOM];
192
193  filecommon=fileout;
194  newvar = var_record;
195
196  if ( newvar->var->save == 0 || inmodulemeet == 0 )
197  {
198     v = newvar->var;
199     WriteBeginDeclaration(v,ligne);
200     if ( v->nbdim == 0 ) WriteScalarDeclaration(v,ligne);
201     else WriteTableDeclaration(v,ligne,0);
202
203     if ( strcasecmp(v->initialvalue,"") )
204     {
205        strcat(ligne," = ");
206        strcat(ligne,v->initialvalue);
207     } 
208     tofich (filecommon, ligne,1);
209  }
210}
211
212
213/******************************************************************************/
214/*                      NonGridDepDeclaration                                 */
215/******************************************************************************/
216/* This subroutine is used to change the variables declaration                */
217/*                                                                            */
218/******************************************************************************/
219/*                                                                            */
220/*  integer variable(nb) ----------->                                         */
221/*                      INTEGER, DIMENSION(:),Pointer :: variable             */
222/*                                                                            */
223/******************************************************************************/
224void NonGridDepDeclaration(listvar * deb_common)
225{
226  listvar *newvar;
227
228  if ( ( SaveDeclare == 0 || aftercontainsdeclare == 0 ) && listenotgriddepend ) 
229  {
230     newvar = deb_common;
231     while (newvar)
232     {
233        if ( VarIsNonGridDepend(newvar->var->nomvar) == 1 ) 
234                                       writevardeclaration (newvar, fortranout);
235        newvar = newvar->suiv;
236     }
237  }
238}
239
240
241/******************************************************************************/
242/*                       writedeclaration                                     */
243/******************************************************************************/
244/* This subroutine is used to write the declaration if variable present in    */
245/*    the deb_common and also in the presentinthislist list file              */
246/******************************************************************************/
247/*                                                                            */
248/*  integer variable(nb) ----------->                                         */
249/*                      INTEGER, DIMENSION(1:nb),Pointer :: variable          */
250/*                                                                            */
251/******************************************************************************/
252void writedeclaration (listvar * deb_common, FILE *fileout, listvar *presentinthislist)
253{
254  FILE *filecommon;
255  listvar *newvar;
256  listvar *parcours;
257  variable *v;
258  char ligne[LONGLIGNE];
259  int out;
260
261  filecommon=fileout;
262
263  newvar = deb_common;
264  while (newvar)
265  {
266     if ( newvar->var->save == 0 || inmodulemeet == 0 )
267     {
268        parcours = presentinthislist;
269        /* we should write declaration of variable present in the list        */
270        /* presentinthislist                                                  */
271        /* if presentinthislist is empty we should write all declarations     */
272        out = 0 ;
273        while ( parcours && out == 0 )
274        {
275            /* if we find this variable in the presentinthislist, we          */
276            /* could write it                                                 */
277           if ( !strcasecmp(parcours->var->nomvar,newvar->var->nomvar) &&
278                !strcasecmp(parcours->var->subroutinename,
279                                          newvar->var->subroutinename) 
280               ) out = 1;
281           else parcours =parcours ->suiv;
282        }
283        if ( out == 0 || !presentinthislist)
284        {
285           /* if the variable has not been found or if the                    */
286           /* presentinthislist is empty, we do not write the declaration     */
287        }
288        else
289        {
290           /* else we could write it                                          */
291           v = newvar->var;
292           WriteBeginDeclaration(v,ligne);
293           if ( v->nbdim == 0 ) WriteScalarDeclaration(v,ligne);
294           else WriteTableDeclaration(v,ligne,0);
295           
296           if ( strcasecmp(v->initialvalue,"") )
297           {
298              strcat(ligne, "=");
299              strcat(ligne, v->initialvalue);
300           }
301           tofich (filecommon, ligne,1);
302        }
303     }
304     newvar = newvar->suiv;
305  }
306}
307
308/******************************************************************************/
309/*                       writesub_loopdeclaration                             */
310/******************************************************************************/
311/* This subroutine is used to write the declaration part of subloop           */
312/*    subroutines                                                             */
313/******************************************************************************/
314/*                                                                            */
315/*  integer variable(nb) ----------->                                         */
316/*                                                                            */
317/*          INTEGER, DIMENSION(1:nb)         :: variable                      */
318/*                                                                            */
319/******************************************************************************/
320void writesub_loopdeclaration (listvar * deb_common, FILE *fileout)
321{
322  listvar *newvar;
323  variable *v;
324  char ligne[LONGLIGNE];
325  int changeval;
326
327  tofich (fileout, "",1);
328  newvar = deb_common;
329  while (newvar)
330  {
331     if ( !strcasecmp(newvar->var->modulename,subroutinename) )
332     {
333        changeval = 0;
334        v = newvar->var;
335        if ( v->allocatable == 1 && fortran77 == 0 ) 
336        {
337           changeval = 1;
338           v->allocatable = 0; 
339        }
340        WriteBeginDeclaration(v,ligne);
341        if ( v->nbdim == 0 ) WriteScalarDeclaration(v,ligne);
342        else WriteTableDeclaration(v,ligne,1);
343
344        tofich (fileout, ligne,1);
345        if ( changeval == 1 ) 
346        {
347           v->allocatable = 1;
348        }
349     }
350     newvar = newvar->suiv;
351  }
352}
353
354/******************************************************************************/
355/*                      writedeclarationintoamr                               */
356/******************************************************************************/
357/* This subroutine is used to write the declaration of parameters needed in   */
358/*    allocation subroutines creates in toamr.c                               */
359/******************************************************************************/
360/*                                                                            */
361/*                                                                            */
362/******************************************************************************/
363void writedeclarationintoamr (listvar * deb_common, FILE *fileout,
364                              listvar *listin , char commonname[LONGNOM])
365{
366  listvar *newvar;
367  variable *v;
368  char ligne[LONGLIGNE];
369  int changeval;
370  char firstmodule[LONGNOM];
371  int out;
372  listnom *neededparameter;
373  int writeit;
374  listnom *parcours;
375  listnom *parcoursprec;
376 
377  neededparameter = (listnom * )NULL;
378  /* we should list the needed parameter                                      */
379  newvar = listin;
380  out = 0 ;
381  while ( newvar && out == 0 )
382  {
383     if ( strcmp(newvar->var->commonname,commonname) ) out = 1;
384     else 
385     {
386        /* add the name to the list of needed parameter                       */
387        neededparameter = DecomposeTheNameinlistnom(
388                 newvar->var->readedlistdimension,
389                 neededparameter );
390        newvar = newvar->suiv;
391     }
392  }
393  /*                                                                          */
394  parcours = neededparameter;
395  while (parcours)
396  {
397     newvar = deb_common;
398     out = 0 ;
399     while ( newvar && out == 0 )
400     {
401        if ( !strcasecmp(parcours->nom,newvar->var->nomvar) ) 
402        {
403           out=1; 
404        /* add the name to the list of needed parameter                       */
405           neededparameter = DecomposeTheNameinlistnom(
406                 newvar->var->initialvalue,
407                 neededparameter );
408        }
409        else newvar=newvar->suiv;
410     }
411     parcours=parcours->suiv;
412   }     
413  /*                                                                          */
414  parcours = neededparameter;
415  while (parcours)
416  {
417     newvar = deb_common;
418     out = 0 ;
419     while ( newvar && out == 0 )
420     {
421        if ( !strcasecmp(parcours->nom,newvar->var->nomvar) ) 
422        {
423           out=1; 
424        /* add the name to the list of needed parameter                       */
425           neededparameter = DecomposeTheNameinlistnom(
426                 newvar->var->initialvalue,
427                 neededparameter );
428        }
429        else newvar=newvar->suiv;
430     }
431     parcours=parcours->suiv;
432   }     
433  /*                                                                          */
434  strcpy(firstmodule,"");
435  tofich (fileout, "",1);
436  newvar = deb_common;
437  while (newvar)
438  {
439     writeit = 0;
440     parcours = neededparameter;
441     while ( parcours && writeit == 0 )
442     {
443        if ( !strcasecmp(parcours->nom,newvar->var->nomvar) )
444        {
445           writeit=1;
446           if ( parcours == neededparameter )
447           {
448              neededparameter = neededparameter->suiv;
449           }
450           else
451           {
452              parcoursprec->suiv= parcours->suiv;           
453           }
454        }
455        else
456        {
457           parcoursprec=parcours;
458           parcours=parcours->suiv;
459        }
460     }
461     
462     if ( writeit == 1  )
463     {
464        changeval = 0;
465        v = newvar->var;
466        if ( v->allocatable == 1 && fortran77 == 0 ) 
467        {
468           changeval = 1;
469           v->allocatable = 0; 
470        }
471        WriteBeginDeclaration(v,ligne);
472        if ( v->nbdim == 0 ) WriteScalarDeclaration(v,ligne);
473        else WriteTableDeclaration(v,ligne,1);
474
475        tofich (fileout, ligne,1);
476        if ( changeval == 1 ) 
477        {
478           v->allocatable = 1;
479        }
480     }
481     newvar = newvar->suiv;
482  }
483}
484
485
486
487/******************************************************************************/
488/*                     writedeclarationsubroutinedeclaration                  */
489/******************************************************************************/
490/* This subroutine is used to write the declaration of parameters needed in   */
491/*    in the table definition. This subroutine is used for the declaration    */
492/*    part of original subroutines                                            */
493/******************************************************************************/
494/*                                                                            */
495/*                                                                            */
496/******************************************************************************/
497void  writedeclarationsubroutinedeclaration(listvar * deb_common, FILE *fileout,
498                              listvar *listin)
499{
500  listvar *newvar;
501  variable *v;
502  char ligne[LONGLIGNE];
503  int changeval;
504  char firstmodule[LONGNOM];
505  int out;
506  listnom *neededparameter;
507  int writeit;
508  listnom *parcours;
509  listnom *parcoursprec;
510 
511  neededparameter = (listnom * )NULL;
512  /* we should list the needed parameter                                      */
513  newvar = listin;
514  while ( newvar )
515  {
516     if ( !strcmp(newvar->var->subroutinename,subroutinename) )
517     {
518        /* add the name to the list of needed parameter                       */
519        neededparameter = DecomposeTheNameinlistnom(
520                 newvar->var->readedlistdimension,
521                 neededparameter );
522     }
523     newvar = newvar->suiv;
524  }
525  /*                                                                          */
526  parcours = neededparameter;
527  while (parcours)
528  {
529     newvar = deb_common;
530     out = 0 ;
531     while ( newvar && out == 0 )
532     {
533        if ( !strcasecmp(parcours->nom,newvar->var->nomvar) ) 
534        {
535           out=1; 
536        /* add the name to the list of needed parameter                       */
537           neededparameter = DecomposeTheNameinlistnom(
538                 newvar->var->initialvalue,
539                 neededparameter );
540        }
541        else newvar=newvar->suiv;
542     }
543     parcours=parcours->suiv;
544   }     
545   /*                                                                         */
546  strcpy(firstmodule,"");
547  tofich (fileout, "",1);
548  newvar = deb_common;
549  while (newvar)
550  {
551     writeit = 0;
552     parcours = neededparameter;
553     while ( parcours && writeit == 0 )
554     {
555        if ( !strcasecmp(parcours->nom,newvar->var->nomvar) )
556        {
557           writeit=1;
558           if ( parcours == neededparameter )
559           {
560              neededparameter = neededparameter->suiv;
561           }
562           else
563           {
564              parcoursprec->suiv= parcours->suiv;           
565           }
566        }
567        else
568        {
569           parcoursprec=parcours;
570           parcours=parcours->suiv;
571        }
572     }
573     
574     if ( writeit == 1  )
575     {
576        changeval = 0;
577        v = newvar->var;
578        if ( v->allocatable == 1 && fortran77 == 0 ) 
579        {
580           changeval = 1;
581           v->allocatable = 0; 
582        }
583        WriteBeginDeclaration(v,ligne);
584        if ( v->nbdim == 0 ) WriteScalarDeclaration(v,ligne);
585        else WriteTableDeclaration(v,ligne,1);
586
587        tofich (fileout, ligne,1);
588        if ( changeval == 1 ) 
589        {
590           v->allocatable = 1;
591        }
592     }
593     newvar = newvar->suiv;
594  }
595}
Note: See TracBrowser for help on using the repository browser.