source: vendors/AGRIF/current/LIB/DiversListe.c @ 1901

Last change on this file since 1901 was 1901, checked in by flavoni, 11 years ago

importing AGRIF vendor

File size: 24.1 KB
Line 
1/******************************************************************************/
2/*                                                                            */
3/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
4/*                                                                            */
5/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
6/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
7/* This software is governed by the CeCILL-C license under French law and     */
8/* abiding by the rules of distribution of free software.  You can  use,      */
9/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
10/* license as circulated by CEA, CNRS and INRIA at the following URL          */
11/* "http://www.cecill.info".                                                  */
12/*                                                                            */
13/* As a counterpart to the access to the source code and  rights to copy,     */
14/* modify and redistribute granted by the license, users are provided only    */
15/* with a limited warranty  and the software's author,  the holder of the     */
16/* economic rights,  and the successive licensors  have only  limited         */
17/* liability.                                                                 */
18/*                                                                            */
19/* In this respect, the user's attention is drawn to the risks associated     */
20/* with loading,  using,  modifying and/or developing or reproducing the      */
21/* software by the user in light of its specific status of free software,     */
22/* that may mean  that it is complicated to manipulate,  and  that  also      */
23/* therefore means  that it is reserved for developers  and  experienced      */
24/* professionals having in-depth computer knowledge. Users are therefore      */
25/* encouraged to load and test the software's suitability as regards their    */
26/* requirements in conditions enabling the security of their systems and/or   */
27/* data to be ensured and,  more generally, to use and operate it in the      */
28/* same conditions as regards security.                                       */
29/*                                                                            */
30/* The fact that you are presently reading this means that you have had       */
31/* knowledge of the CeCILL-C license and that you accept its terms.           */
32/******************************************************************************/
33/* version 1.7                                                                */
34/******************************************************************************/
35#include <stdio.h>
36#include <stdlib.h>
37#include <string.h>
38#include "decl.h"
39
40/******************************************************************************/
41/*                           Add_Common_var_1                                 */
42/******************************************************************************/
43/*  This subroutines is used to add the variable defined in common in the     */
44/*     List_Common_Var                                                        */
45/******************************************************************************/
46/*                                                                            */
47/******************************************************************************/
48void Add_Common_var_1()
49{
50   listvar *newvar;
51   listvar *newvar2;
52   variable *newvariable;
53   listdim *dims;
54   char listdimension[LONG_C];
55   char ligne[LONG_C];
56   int out;
57
58   if ( firstpass == 1 )
59   {
60
61   newvar = (listvar *)malloc(sizeof(listvar));
62   newvariable = (variable *)malloc(sizeof(variable));
63   /*                                                                         */
64   Init_Variable(newvariable);
65   /*                                                                         */
66   strcpy(newvariable->v_nomvar,commonvar);
67   Save_Length(commonvar,4);
68   strcpy(newvariable->v_commonname,commonblockname);
69   Save_Length(commonblockname,7);
70   strcpy(newvariable->v_modulename,curmodulename);
71   Save_Length(curmodulename,6);
72   strcpy(newvariable->v_subroutinename,subroutinename);
73   Save_Length(subroutinename,11);
74   newvariable->v_positioninblock= positioninblock;
75   newvariable->v_common=1;
76   strcpy(newvariable->v_commoninfile,mainfile);
77   Save_Length(mainfile,10);
78
79   newvar->var = newvariable;
80
81   if ( commondim )
82   {
83      newvariable->v_dimension=commondim;
84      newvariable->v_dimensiongiven=1;
85      newvariable->v_nbdim=num_dims(commondim);
86      /* Creation of the string for the dimension of this variable            */
87      dimsempty = 1;
88      strcpy(listdimension,"");
89
90      if ( commondim )
91      {
92         dims = commondim;
93         while (dims)
94         {
95            if ( strcasecmp(dims->dim.first,"") ||
96                 strcasecmp(dims->dim.last,""))  dimsempty = 0;
97            sprintf(ligne,"%s:%s",dims->dim.first,dims->dim.last);
98            strcat(listdimension,ligne);
99            if ( dims->suiv ) strcat(listdimension,",");
100            dims = dims->suiv;
101         }
102         if ( dimsempty == 1 ) newvariable->v_dimsempty=1;
103      }
104      strcpy(newvariable->v_readedlistdimension,listdimension);
105      Save_Length(listdimension,15);
106   }
107
108
109   newvar->suiv = NULL;
110
111   if ( !List_Common_Var )
112   {
113      List_Common_Var = newvar;
114   }
115   else
116   {
117      newvar2 = List_Common_Var;
118      out = 0 ;
119      while ( newvar2 && out == 0 )
120      {
121         if ( !strcasecmp(newvar2->var->v_nomvar,commonvar) &&
122              !strcasecmp(newvar2->var->v_commonname,commonblockname) &&
123              !strcasecmp(newvar2->var->v_subroutinename,subroutinename)
124                          ) out = 1 ;
125         else newvar2 = newvar2->suiv;
126      }
127      if ( out == 0 )
128      {
129         newvar->suiv = List_Common_Var;
130         List_Common_Var = newvar;
131      }
132      else
133      {
134         free(newvar);
135      }
136   }
137   }
138}
139
140/******************************************************************************/
141/*                           Addtolistnom                                     */
142/******************************************************************************/
143/* This subroutine is used to add a variable to the list                      */
144/******************************************************************************/
145/*                                                                            */
146/******************************************************************************/
147listnom *Addtolistnom(char *nom, listnom *listin,int value)
148{
149   listnom *newnom;
150   listnom *parcours;
151   int out;
152
153   newnom=(listnom *) malloc (sizeof (listnom));
154   strcpy(newnom->o_nom,nom);
155   Save_Length(nom,23);
156   newnom->o_val = value;
157   newnom->suiv = NULL;
158
159   if ( !listin ) listin = newnom;
160   else
161   {
162      parcours = listin;
163      out = 0 ;
164      while ( parcours && out == 0 )
165      {
166         if ( !strcasecmp(parcours->o_nom,nom) ) out = 1 ;
167         else parcours=parcours->suiv;
168      }
169      if ( out == 0 )
170      {
171          newnom->suiv = listin;
172          listin = newnom;
173      }
174      else
175      {
176         free(newnom);
177      }
178   }
179   return listin;
180}
181
182/******************************************************************************/
183/*                           Addtolistname                                    */
184/******************************************************************************/
185/* This subroutine is used to add a        variable to the list               */
186/******************************************************************************/
187/*        _______     _______     _______     _______     _______             */
188/*       +      +    +      +    +      +    +      +    +      +             */
189/*       + NEW  +--->+ glob +--->+ glob +--->+ glob +--->+ glob +             */
190/*       +______+    +______+    +______+    +______+    +______+             */
191/*                                                                            */
192/*                                                                            */
193/*                                                                            */
194/******************************************************************************/
195listname *Addtolistname(char *nom,listname *input)
196{
197   listname *newnom;
198   listname *parcours;
199   int out;
200
201   if ( !input )
202   {
203      newnom=(listname *) malloc (sizeof (listname));
204      strcpy(newnom->n_name,nom);
205      Save_Length(nom,20);
206      newnom->suiv = NULL;
207      input = newnom;
208   }
209   else
210   {
211      parcours = input;
212      out = 0 ;
213      while ( parcours && out == 0 )
214      {
215         if ( !strcasecmp(parcours->n_name,nom) ) out = 1;
216         else parcours=parcours->suiv;
217      }
218      if ( out == 0 )
219      {
220         newnom=(listname *) malloc (sizeof (listname));
221         strcpy(newnom->n_name,nom);
222         Save_Length(nom,20);
223         newnom->suiv = input;
224         input = newnom;
225      }
226   }
227   return input;
228}
229
230/******************************************************************************/
231/*                    ModuleIsDefineInInputFile                               */
232/******************************************************************************/
233/* This subroutine is used to know if the module is defined in the input file */
234/******************************************************************************/
235/*                                                                            */
236/*                                                                            */
237/******************************************************************************/
238int ModuleIsDefineInInputFile(char *name)
239{
240   listnom *newnom;
241   int out;
242
243   out = 0;
244   if ( listofmodules )
245   {
246      newnom = listofmodules;
247      while( newnom && out == 0 )
248      {
249         if ( !strcasecmp(newnom->o_nom,name) ) out = 1 ;
250         else newnom=newnom->suiv;
251      }
252   }
253   return out;
254}
255
256/******************************************************************************/
257/*                      Addmoduletothelisttmp                                 */
258/******************************************************************************/
259/* This subroutine is used to add a record to a list of struct                */
260/* listusemodule                                                              */
261/******************************************************************************/
262/*                                                                            */
263/*       subroutine sub ... USE mod1 ===> insert in list                      */
264/*        _______     _______     _______     _______     _______             */
265/*       +      +    +      +    +      +    +      +    +      +             */
266/*       + NEW  +--->+ list +--->+ list +--->+ list +--->+ list +             */
267/*       +______+    +______+    +______+    +______+    +______+             */
268/*                                                                            */
269/*       list =  listofmoduletmp                                              */
270/*                                                                            */
271/******************************************************************************/
272void Addmoduletothelisttmp(char *name)
273{
274  listusemodule *newmodule;
275  listusemodule *parcours;
276  int out;
277
278  if ( !listofmoduletmp)
279  {
280    newmodule =(listusemodule *)malloc(sizeof(listusemodule));
281    strcpy(newmodule->u_usemodule,name);
282    Save_Length(name,16);
283    strcpy(newmodule->u_cursubroutine,subroutinename);
284    Save_Length(subroutinename,18);
285    newmodule->suiv = NULL;
286    listofmoduletmp = newmodule ;
287  }
288  else
289  {
290    parcours = listofmoduletmp;
291    out = 0;
292    while( parcours && out == 0 )
293    {
294       if ( !strcasecmp(parcours->u_usemodule,name) ) out = 1;
295       else parcours = parcours->suiv;
296    }
297    if ( out == 0 )
298    {
299       newmodule =(listusemodule *)malloc(sizeof(listusemodule));
300       strcpy(newmodule->u_usemodule,name);
301       Save_Length(name,16);
302       strcpy(newmodule->u_cursubroutine,subroutinename);
303       Save_Length(subroutinename,18);
304       newmodule->suiv = listofmoduletmp;
305       listofmoduletmp = newmodule;
306    }
307  }
308}
309
310/******************************************************************************/
311/*                          Add_NameOfModule_1                                */
312/******************************************************************************/
313/* This subroutine is used to add a        variable to the list               */
314/******************************************************************************/
315/*        _______     _______     _______     _______     _______             */
316/*       +      +    +      +    +      +    +      +    +      +             */
317/*       + NEW  +--->+ glob +--->+ glob +--->+ glob +--->+ glob +             */
318/*       +______+    +______+    +______+    +______+    +______+             */
319/*                                                                            */
320/*                                                                            */
321/*                                                                            */
322/******************************************************************************/
323void Add_NameOfModule_1(char *nom)
324{
325   listnom *newnom;
326
327   if ( firstpass == 1 )
328   {
329      newnom=(listnom *) malloc (sizeof (listnom));
330      strcpy(newnom->o_nom,nom);
331      Save_Length(nom,23);
332      newnom->suiv = List_NameOfModule;
333      List_NameOfModule = newnom;
334   }
335}
336
337/******************************************************************************/
338/*                          Add_NameOfCommon_1                                */
339/******************************************************************************/
340/* This subroutine is used to add a        variable to the list               */
341/******************************************************************************/
342/*        _______     _______     _______     _______     _______             */
343/*       +      +    +      +    +      +    +      +    +      +             */
344/*       + NEW  +--->+ glob +--->+ glob +--->+ glob +--->+ glob +             */
345/*       +______+    +______+    +______+    +______+    +______+             */
346/*                                                                            */
347/*                                                                            */
348/*                                                                            */
349/******************************************************************************/
350void Add_NameOfCommon_1(char *nom)
351{
352   listnom *newnom;
353   listnom *parcours;
354
355   if ( firstpass == 1 )
356   {
357      parcours = List_NameOfCommon;
358      while ( parcours && strcasecmp(parcours->o_nom,nom) )
359                                                      parcours = parcours->suiv;
360      if ( !parcours )
361      {
362         newnom=(listnom *) malloc (sizeof (listnom));
363         strcpy(newnom->o_nom,nom);
364         Save_Length(nom,23);
365         newnom->suiv = List_NameOfCommon;
366         List_NameOfCommon = newnom;
367      }
368   }
369}
370
371/******************************************************************************/
372/*                     Add_CouplePointed_Var_1                                */
373/******************************************************************************/
374/* Firstpass 1                                                                */
375/* We should complete the listvarpointtovar                                   */
376/******************************************************************************/
377/*                                                                            */
378/******************************************************************************/
379void Add_CouplePointed_Var_1(char *namemodule,listcouple *couple)
380{
381   listvarpointtovar *pointtmp;
382
383   if ( firstpass == 1 )
384   {
385      /* we should complete the List_CouplePointed_Var                        */
386      pointtmp=(listvarpointtovar *)malloc(sizeof(listvarpointtovar));
387      strcpy(pointtmp->t_usemodule,namemodule);
388      Save_Length(namemodule,28);
389      strcpy(pointtmp->t_cursubroutine,subroutinename);
390      Save_Length(subroutinename,29);
391      pointtmp->t_couple = couple;
392      if ( List_CouplePointed_Var )
393      {
394         pointtmp->suiv = List_CouplePointed_Var;
395         List_CouplePointed_Var = pointtmp;
396      }
397      else
398      {
399         pointtmp->suiv = NULL;
400         List_CouplePointed_Var = pointtmp;
401      }
402   }
403}
404
405/******************************************************************************/
406/*                           Add_Include_1                                    */
407/******************************************************************************/
408/* This subroutine is used to add a record to a list of struct                */
409/*  List_Include                                                              */
410/******************************************************************************/
411/*                                                                            */
412/*       subroutine sub ... include mod1 ===> insert in list                  */
413/*        _______     _______     _______     _______     _______             */
414/*       +      +    +      +    +      +    +      +    +      +             */
415/*       + NEW  +--->+ list +--->+ list +--->+ list +--->+ list +             */
416/*       +______+    +______+    +______+    +______+    +______+             */
417/*                                                                            */
418/*       list =  List_Include                                                 */
419/*                                                                            */
420/******************************************************************************/
421void Add_Include_1(char *name)
422{
423  listusemodule *newinclude;
424
425  if ( firstpass == 1 )
426  {
427  newinclude =(listusemodule *)malloc(sizeof(listusemodule));
428  strcpy(newinclude->u_usemodule,name);
429  Save_Length(name,16);
430  strcpy(newinclude->u_cursubroutine,subroutinename);
431  Save_Length(subroutinename,18);
432  newinclude->suiv = NULL;
433
434  if ( !List_Include)
435  {
436     List_Include  = newinclude ;
437  }
438  else
439  {
440    newinclude->suiv = List_Include;
441    List_Include = newinclude;
442  }
443  }
444}
445
446/******************************************************************************/
447/*                     Add_ImplicitNoneSubroutine_1                           */
448/******************************************************************************/
449/* This subroutine is used to add a record to a list of struct                */
450/******************************************************************************/
451/*                                                                            */
452/*                                                                            */
453/******************************************************************************/
454void Add_ImplicitNoneSubroutine_1()
455{
456
457  if ( firstpass == 1 )
458  {
459     List_ImplicitNoneSubroutine = Addtolistname(subroutinename,
460                                                   List_ImplicitNoneSubroutine);
461  }
462}
463
464
465/******************************************************************************/
466/*                        WriteIncludeDeclaration                             */
467/******************************************************************************/
468/* Firstpass 0                                                                */
469/******************************************************************************/
470/*                                                                            */
471/******************************************************************************/
472void WriteIncludeDeclaration()
473{
474  listusemodule *newinclude;
475
476  newinclude = List_Include;
477  fprintf(fortranout,"\n");
478  while ( newinclude )
479  {
480     if ( !strcasecmp(newinclude->u_cursubroutine,subroutinename) )
481     {
482        fprintf(fortranout,"      INCLUDE %s \n",newinclude->u_usemodule);
483     }
484     newinclude = newinclude ->suiv;
485  }
486}
487
488/******************************************************************************/
489/*                          Add_Save_Var_1                                    */
490/******************************************************************************/
491/* This subroutine is used to add a record to List_Save_Var                   */
492/******************************************************************************/
493/*        _______     _______     _______     _______     _______             */
494/*       +      +    +      +    +      +    +      +    +      +             */
495/*       + NEW  +--->+ Save +--->+ Save +--->+ Save +--->+  Save+             */
496/*       +______+    +______+    +______+    +______+    +______+             */
497/*                                                                            */
498/******************************************************************************/
499void Add_Save_Var_1 (char *name,listdim *d)
500{
501  listvar *newvar;
502  listdim *dims;
503  char ligne[LONG_C];
504  char listdimension[LONG_C];
505
506  if ( firstpass == 1 )
507  {
508     newvar=(listvar *)malloc(sizeof(listvar));
509     newvar->var=(variable *)malloc(sizeof(variable));
510     /*                                                                       */
511     Init_Variable(newvar->var);
512     /*                                                                       */
513     newvar->var->v_save=1;
514     strcpy(newvar->var->v_nomvar,name);
515     Save_Length(name,4);
516     strcpy(newvar->var->v_modulename,curmodulename);
517     Save_Length(curmodulename,6);
518     strcpy(newvar->var->v_subroutinename,subroutinename);
519     Save_Length(subroutinename,11);
520     strcpy(newvar->var->v_commoninfile,mainfile);
521     Save_Length(mainfile,10);
522
523     newvar->var->v_dimension=d;
524     /* Creation of the string for the dimension of this variable             */
525     dimsempty = 1;
526     if ( d )
527     {
528        newvar->var->v_dimensiongiven=1;
529        dims = d;
530        while (dims)
531        {
532           if ( strcasecmp(dims->dim.first,"") || strcasecmp(dims->dim.last,""))
533                                                                  dimsempty = 0;
534           sprintf(ligne,"%s:%s",dims->dim.first,dims->dim.last);
535           strcat(listdimension,ligne);
536           if ( dims->suiv )
537           {
538              strcat(listdimension,",");
539           }
540           dims = dims->suiv;
541        }
542        if ( dimsempty == 1 ) newvar->var->v_dimsempty=1;
543     }
544     strcpy(newvar->var->v_readedlistdimension,listdimension);
545     Save_Length(listdimension,15);
546     /*                                                                       */
547     newvar->suiv = NULL;
548
549     if ( !List_Save_Var )
550     {
551        List_Save_Var  = newvar ;
552     }
553     else
554     {
555        newvar->suiv = List_Save_Var;
556        List_Save_Var = newvar;
557     }
558  }
559}
560
561void Add_Save_Var_dcl_1 (listvar *var)
562{
563  listvar *newvar;
564  listvar *parcours;
565
566  if ( firstpass == 1 )
567  {
568     parcours = var;
569     while ( parcours )
570     {
571        newvar=(listvar *)malloc(sizeof(listvar));
572        newvar->var=(variable *)malloc(sizeof(variable));
573        /*                                                                    */
574        Init_Variable(newvar->var);
575        /*                                                                    */
576        newvar->var->v_save=1;
577        strcpy(newvar->var->v_nomvar,parcours->var->v_nomvar);
578        strcpy(newvar->var->v_modulename,curmodulename);
579        Save_Length(curmodulename,6);
580        strcpy(newvar->var->v_subroutinename,subroutinename);
581        Save_Length(subroutinename,11);
582        strcpy(newvar->var->v_commoninfile,mainfile);
583        Save_Length(mainfile,10);
584        /*                                                                    */
585        strcpy(newvar->var->v_readedlistdimension,
586             parcours->var->v_readedlistdimension);
587        newvar->var->v_nbdim = parcours->var->v_nbdim;
588        newvar->var->v_dimension = parcours->var->v_dimension;
589        /*                                                                    */
590        newvar->var->v_dimensiongiven=parcours->var->v_dimensiongiven;
591        /*                                                                    */
592        newvar->suiv = NULL;
593
594        if ( !List_Save_Var ) List_Save_Var  = newvar ;
595        else
596        {
597           newvar->suiv = List_Save_Var;
598           List_Save_Var = newvar;
599        }
600        parcours = parcours->suiv;
601     }
602  }
603}
Note: See TracBrowser for help on using the repository browser.