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

Last change on this file since 4777 was 4777, checked in by rblod, 7 years ago

Load working_directory into vendors/AGRIF/current.

File size: 22.9 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_M];
55    char ligne[LONG_M];
56    int out;
57
58    if ( firstpass == 1 )
59    {
60        newvar = (listvar *) calloc(1,sizeof(listvar));
61        newvariable = (variable *) calloc(1,sizeof(variable));
62
63        Init_Variable(newvariable);
64
65        strcpy(newvariable->v_nomvar,commonvar);
66        strcpy(newvariable->v_commonname,commonblockname);
67        strcpy(newvariable->v_modulename,curmodulename);
68        strcpy(newvariable->v_subroutinename,subroutinename);
69        strcpy(newvariable->v_commoninfile,cur_filename);
70        newvariable->v_positioninblock = positioninblock;
71        newvariable->v_common = 1;
72        newvar->var = newvariable;
73
74        if ( commondim )
75        {
76            newvariable->v_dimension = commondim;
77            newvariable->v_dimensiongiven = 1;
78            newvariable->v_nbdim = get_num_dims(commondim);
79
80            /* Creation of the string for the dimension of this variable            */
81            dimsempty = 1;
82            strcpy(listdimension,"");
83
84            dims = commondim;
85            while (dims)
86            {
87                if ( strcasecmp(dims->dim.first,"") ||
88                     strcasecmp(dims->dim.last,""))  dimsempty = 0;
89                sprintf(ligne,"%s:%s",dims->dim.first,dims->dim.last);
90                strcat(listdimension,ligne);
91                if ( dims->suiv ) strcat(listdimension,",");
92                dims = dims->suiv;
93            }
94            if ( dimsempty == 1 ) newvariable->v_dimsempty = 1;
95
96            strcpy(newvariable->v_readedlistdimension,listdimension);
97            Save_Length(listdimension,15);
98        }
99
100        newvar->suiv = NULL;
101
102        if ( !List_Common_Var )
103        {
104            List_Common_Var = newvar;
105        }
106        else
107        {
108            newvar2 = List_Common_Var;
109            out = 0 ;
110            while ( newvar2 && out == 0 )
111            {
112                if ( !strcasecmp(newvar2->var->v_nomvar,commonvar) &&
113                     !strcasecmp(newvar2->var->v_commonname,commonblockname) &&
114                     !strcasecmp(newvar2->var->v_subroutinename,subroutinename)
115                   ) out = 1 ;
116                else newvar2 = newvar2->suiv;
117            }
118            if ( out == 0 )
119            {
120                newvar->suiv = List_Common_Var;
121                List_Common_Var = newvar;
122            }
123            else
124            {
125                free(newvar);
126            }
127        }
128    }
129}
130
131/******************************************************************************/
132/*                           Addtolistnom                                     */
133/******************************************************************************/
134/* This subroutine is used to add a variable to the list                      */
135/******************************************************************************/
136/*                                                                            */
137/******************************************************************************/
138listnom *Addtolistnom(const char *nom, listnom *listin, int value)
139{
140    listnom *newnom;
141    listnom *parcours;
142    int out;
143
144    newnom = (listnom*) calloc(1, sizeof(listnom));
145    strcpy(newnom->o_nom, nom);
146    newnom->o_val = value;
147    newnom->suiv = NULL;
148
149    if ( listin == NULL )
150    {
151        listin = newnom;
152    }
153    else
154    {
155        parcours = listin;
156        out = 0 ;
157        while ( parcours && out == 0 )
158        {
159            if ( !strcasecmp(parcours->o_nom, nom) ) out = 1 ;
160            else parcours = parcours->suiv;
161        }
162        if ( out == 0 )
163        {
164            newnom->suiv = listin;
165            listin = newnom;
166        }
167        else
168        {
169            free(newnom);
170        }
171    }
172    return listin;
173}
174
175/******************************************************************************/
176/*                           Addtolistname                                    */
177/******************************************************************************/
178/* This subroutine is used to add a        variable to the list               */
179/******************************************************************************/
180/*        _______     _______     _______     _______     _______             */
181/*       +      +    +      +    +      +    +      +    +      +             */
182/*       + NEW  +--->+ glob +--->+ glob +--->+ glob +--->+ glob +             */
183/*       +______+    +______+    +______+    +______+    +______+             */
184/*                                                                            */
185/*                                                                            */
186/*                                                                            */
187/******************************************************************************/
188listname *Addtolistname(const char *nom, listname *input)
189{
190    listname *newnom;
191    listname *parcours;
192    int out;
193
194    if ( !input )
195    {
196        newnom = (listname*) calloc(1, sizeof(listname));
197        strcpy(newnom->n_name, nom);
198        newnom->suiv = NULL;
199        input = newnom;
200    }
201    else
202    {
203        parcours = input;
204        out = 0 ;
205        while ( parcours && out == 0 )
206        {
207            if ( !strcasecmp(parcours->n_name,nom) ) out = 1;
208            else parcours=parcours->suiv;
209        }
210        if ( out == 0 )
211        {
212            newnom = (listname*) calloc(1,sizeof(listname));
213            strcpy(newnom->n_name, nom);
214            newnom->suiv = input;
215            input = newnom;
216        }
217    }
218    return input;
219}
220
221/******************************************************************************/
222/*                    ModuleIsDefineInInputFile                               */
223/******************************************************************************/
224/* This subroutine is used to know if the module is defined in the input file */
225/******************************************************************************/
226/*                                                                            */
227/*                                                                            */
228/******************************************************************************/
229int ModuleIsDefineInInputFile(const char *name)
230{
231    listnom *newnom;
232    int out;
233
234    out = 0;
235    if ( listofmodules )
236    {
237        newnom = listofmodules;
238        while( newnom && out == 0 )
239        {
240            if ( !strcasecmp(newnom->o_nom,name) ) out = 1 ;
241            else newnom = newnom->suiv;
242        }
243    }
244    return out;
245}
246
247/******************************************************************************/
248/*                      Addmoduletothelisttmp                                 */
249/******************************************************************************/
250/* This subroutine is used to add a record to a list of struct                */
251/* listusemodule                                                              */
252/******************************************************************************/
253/*                                                                            */
254/*       subroutine sub ... USE mod1 ===> insert in list                      */
255/*        _______     _______     _______     _______     _______             */
256/*       +      +    +      +    +      +    +      +    +      +             */
257/*       + NEW  +--->+ list +--->+ list +--->+ list +--->+ list +             */
258/*       +______+    +______+    +______+    +______+    +______+             */
259/*                                                                            */
260/*       list =  listofmoduletmp                                              */
261/*                                                                            */
262/******************************************************************************/
263void Addmoduletothelisttmp(const char *name)
264{
265    listusemodule *newmodule;
266    listusemodule *parcours;
267    int out;
268
269    if ( !listofmoduletmp )
270    {
271        newmodule = (listusemodule*) calloc(1, sizeof(listusemodule));
272        strcpy(newmodule->u_usemodule, name);
273        strcpy(newmodule->u_cursubroutine, subroutinename);
274        newmodule->suiv = NULL;
275        listofmoduletmp = newmodule ;
276    }
277    else
278    {
279        parcours = listofmoduletmp;
280        out = 0;
281        while( parcours && out == 0 )
282        {
283            if ( !strcasecmp(parcours->u_usemodule, name) ) out = 1;
284            else parcours = parcours->suiv;
285        }
286        if ( out == 0 )
287        {
288            newmodule = (listusemodule*) calloc(1, sizeof(listusemodule));
289            strcpy(newmodule->u_usemodule, name);
290            strcpy(newmodule->u_cursubroutine, subroutinename);
291            newmodule->suiv = listofmoduletmp;
292            listofmoduletmp = newmodule;
293        }
294    }
295}
296
297/******************************************************************************/
298/*                          Add_NameOfModule_1                                */
299/******************************************************************************/
300/* This subroutine is used to add a        variable to the list               */
301/******************************************************************************/
302/*        _______     _______     _______     _______     _______             */
303/*       +      +    +      +    +      +    +      +    +      +             */
304/*       + NEW  +--->+ glob +--->+ glob +--->+ glob +--->+ glob +             */
305/*       +______+    +______+    +______+    +______+    +______+             */
306/*                                                                            */
307/*                                                                            */
308/*                                                                            */
309/******************************************************************************/
310void Add_NameOfModule_1(const char *nom)
311{
312    listnom *newnom;
313
314    if ( firstpass == 1 )
315    {
316        newnom = (listnom *) calloc(1,sizeof(listnom));
317        strcpy(newnom->o_nom,nom);
318        newnom->suiv = List_NameOfModule;
319        List_NameOfModule = newnom;
320    }
321}
322
323/******************************************************************************/
324/*                          Add_NameOfCommon_1                                */
325/******************************************************************************/
326/* This subroutine is used to add a        variable to the list               */
327/******************************************************************************/
328/*        _______     _______     _______     _______     _______             */
329/*       +      +    +      +    +      +    +      +    +      +             */
330/*       + NEW  +--->+ glob +--->+ glob +--->+ glob +--->+ glob +             */
331/*       +______+    +______+    +______+    +______+    +______+             */
332/*                                                                            */
333/*                                                                            */
334/*                                                                            */
335/******************************************************************************/
336void Add_NameOfCommon_1(const char *nom, const char *cursubroutinename)
337{
338    listnom *newnom;
339    listnom *parcours;
340
341    if ( firstpass == 1 )
342    {
343        parcours = List_NameOfCommon;
344        while ( parcours && strcasecmp(parcours->o_nom,nom) )
345            parcours = parcours->suiv;
346        if ( !parcours )
347        {
348            newnom = (listnom *) calloc(1,sizeof(listnom));
349            strcpy(newnom->o_nom,nom);
350            strcpy(newnom->o_subroutinename,cursubroutinename);
351            newnom->suiv = List_NameOfCommon;
352            List_NameOfCommon = newnom;
353        }
354    }
355}
356
357/******************************************************************************/
358/*                     Add_CouplePointed_Var_1                                */
359/******************************************************************************/
360/* Firstpass 1                                                                */
361/* We should complete the listvarpointtovar                                   */
362/******************************************************************************/
363/*                                                                            */
364/******************************************************************************/
365void Add_CouplePointed_Var_1(const char *namemodule, listcouple *couple)
366{
367    listvarpointtovar *pointtmp;
368
369    /* we should complete the List_CouplePointed_Var                        */
370    pointtmp = (listvarpointtovar*) calloc(1, sizeof(listvarpointtovar));
371    strcpy(pointtmp->t_usemodule, namemodule);
372    strcpy(pointtmp->t_cursubroutine, subroutinename);
373    pointtmp->t_couple = couple;
374    if ( List_CouplePointed_Var )
375    {
376        pointtmp->suiv = List_CouplePointed_Var;
377    }
378    else
379    {
380        pointtmp->suiv = NULL;
381    }
382    List_CouplePointed_Var = pointtmp;
383}
384
385/******************************************************************************/
386/*                           Add_Include_1                                    */
387/******************************************************************************/
388/* This subroutine is used to add a record to a list of struct                */
389/*  List_Include                                                              */
390/******************************************************************************/
391/*                                                                            */
392/*       subroutine sub ... include mod1 ===> insert in list                  */
393/*        _______     _______     _______     _______     _______             */
394/*       +      +    +      +    +      +    +      +    +      +             */
395/*       + NEW  +--->+ list +--->+ list +--->+ list +--->+ list +             */
396/*       +______+    +______+    +______+    +______+    +______+             */
397/*                                                                            */
398/*       list =  List_Include                                                 */
399/*                                                                            */
400/******************************************************************************/
401void Add_Include_1(const char *name)
402{
403    listusemodule *newinclude;
404
405    if ( firstpass == 1 )
406    {
407        newinclude = (listusemodule*) calloc(1, sizeof(listusemodule));
408        strcpy(newinclude->u_usemodule,name);
409        strcpy(newinclude->u_cursubroutine,subroutinename);
410
411        newinclude->suiv = List_Include;
412        List_Include  = newinclude ;
413    }
414}
415
416/******************************************************************************/
417/*                     Add_ImplicitNoneSubroutine_1                           */
418/******************************************************************************/
419/* This subroutine is used to add a record to a list of struct                */
420/******************************************************************************/
421/*                                                                            */
422/*                                                                            */
423/******************************************************************************/
424void Add_ImplicitNoneSubroutine_1()
425{
426    if ( firstpass == 1 )
427        List_ImplicitNoneSubroutine = Addtolistname(subroutinename,List_ImplicitNoneSubroutine);
428}
429
430/******************************************************************************/
431/*                        WriteIncludeDeclaration                             */
432/******************************************************************************/
433/* Firstpass 0                                                                */
434/******************************************************************************/
435/*                                                                            */
436/******************************************************************************/
437void WriteIncludeDeclaration(FILE* tofile)
438{
439  listusemodule *newinclude;
440
441  newinclude = List_Include;
442  fprintf(tofile,"\n");
443  while ( newinclude )
444  {
445     if ( !strcasecmp(newinclude->u_cursubroutine,subroutinename) )
446     {
447        fprintf(tofile, "      include %s\n",newinclude->u_usemodule);
448     }
449     newinclude = newinclude ->suiv;
450  }
451}
452
453/******************************************************************************/
454/*                          Add_Save_Var_1                                    */
455/******************************************************************************/
456/* This subroutine is used to add a record to List_Save_Var                   */
457/******************************************************************************/
458/*        _______     _______     _______     _______     _______             */
459/*       +      +    +      +    +      +    +      +    +      +             */
460/*       + NEW  +--->+ Save +--->+ Save +--->+ Save +--->+  Save+             */
461/*       +______+    +______+    +______+    +______+    +______+             */
462/*                                                                            */
463/******************************************************************************/
464void Add_Save_Var_1 (const char *name, listdim *d)
465{
466    listvar *newvar;
467    listdim *dims;
468    char ligne[LONG_M];
469    char listdimension[LONG_M];
470
471    if ( firstpass == 1 )
472    {
473        newvar = (listvar *) calloc(1,sizeof(listvar));
474        newvar->var = (variable *) calloc(1,sizeof(variable));
475
476        Init_Variable(newvar->var);
477
478        newvar->var->v_save = 1;
479        strcpy(newvar->var->v_nomvar,name);
480        strcpy(newvar->var->v_modulename,curmodulename);
481        strcpy(newvar->var->v_subroutinename,subroutinename);
482        strcpy(newvar->var->v_commoninfile,cur_filename);
483
484        newvar->var->v_dimension = d;
485
486        /* Creation of the string for the dimension of this variable             */
487        dimsempty = 1;
488
489        if ( d )
490        {
491            newvar->var->v_dimensiongiven = 1;
492            dims = d;
493            while (dims)
494            {
495                if ( strcasecmp(dims->dim.first,"") || strcasecmp(dims->dim.last,""))
496                    dimsempty = 0;
497                sprintf(ligne,"%s:%s",dims->dim.first,dims->dim.last);
498                strcat(listdimension,ligne);
499                if ( dims->suiv )   strcat(listdimension,",");
500                dims = dims->suiv;
501            }
502            if ( dimsempty == 1 ) newvar->var->v_dimsempty = 1;
503        }
504
505        newvar->suiv = List_Save_Var;
506        List_Save_Var = newvar;
507    }
508}
509
510void Add_Save_Var_dcl_1 (listvar *var)
511{
512    listvar *newvar;
513    listvar *parcours;
514
515    if ( firstpass == 1 )
516    {
517        parcours = var;
518        while ( parcours )
519        {
520            newvar = (listvar *) calloc(1,sizeof(listvar));
521            newvar->var = (variable *) calloc(1,sizeof(variable));
522
523            Init_Variable(newvar->var);
524
525            newvar->var->v_save = 1;
526            strcpy(newvar->var->v_nomvar,parcours->var->v_nomvar);
527            strcpy(newvar->var->v_modulename,curmodulename);
528            strcpy(newvar->var->v_subroutinename,subroutinename);
529            strcpy(newvar->var->v_commoninfile,cur_filename);
530            strcpy(newvar->var->v_readedlistdimension,parcours->var->v_readedlistdimension);
531
532            newvar->var->v_nbdim = parcours->var->v_nbdim;
533            newvar->var->v_catvar = parcours->var->v_catvar;
534            newvar->var->v_dimension = parcours->var->v_dimension;
535            newvar->var->v_dimensiongiven=parcours->var->v_dimensiongiven;
536            newvar->suiv = List_Save_Var;
537            List_Save_Var = newvar;
538
539            parcours = parcours->suiv;
540        }
541    }
542}
Note: See TracBrowser for help on using the repository browser.