New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
WorkWithlistvarindoloop.c in vendors/AGRIF/dev/LIB – NEMO

source: vendors/AGRIF/dev/LIB/WorkWithlistvarindoloop.c

Last change on this file was 14431, checked in by smasson, 3 years ago

agrif: merge AGRIF/dev_r14312_MPI_Interface into AGRIF/dev, ticket:2598#comment:21
  • Property svn:keywords set to Id
File size: 68.3 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
39#include "decl.h"
40
41/******************************************************************************/
42/*                         Add_UsedInSubroutine_Var_1                         */
43/******************************************************************************/
44/* Firstpass 1                                                                */
45/* We should complete the List_UsedInSubroutine_Var                           */
46/******************************************************************************/
47/*                                                                            */
48/******************************************************************************/
49void Add_UsedInSubroutine_Var_1 (const char *ident)
50{
51  listvar *newvar;
52  listvar *tmpvar;
53  int out;
54
55   /* In the first pass we record all variables presents in the do loop       */
56   if (firstpass == 1 && insubroutinedeclare == 1 )
57   {
58
59  if ( !List_UsedInSubroutine_Var )
60  {
61      newvar=(listvar *)calloc(1,sizeof(listvar));
62      newvar->var=(variable *)calloc(1,sizeof(variable));
63      /*                                                                      */
64      Init_Variable(newvar->var);
65      /*                                                                      */
66      newvar->suiv = NULL;
67      strcpy(newvar->var->v_nomvar,ident);
68      strcpy(newvar->var->v_modulename,curmodulename);
69      strcpy(newvar->var->v_commoninfile,cur_filename);
70      strcpy(newvar->var->v_subroutinename,subroutinename);
71      newvar->var->v_pointedvar=pointedvar;
72      List_UsedInSubroutine_Var = newvar ;
73  }
74  else
75  {
76      /* We should verify that this variable did not added                    */
77      tmpvar = List_UsedInSubroutine_Var;
78      out = 0 ;
79      while (tmpvar && out == 0 )
80      {
81         if ( !strcasecmp(tmpvar->var->v_nomvar,ident) &&
82              !strcasecmp(tmpvar->var->v_subroutinename,subroutinename))
83                                                                      out  = 1 ;
84         else tmpvar = tmpvar->suiv;
85      }
86      if ( out == 0 )
87      {
88         newvar=(listvar *)calloc(1,sizeof(listvar));
89         newvar->var=(variable *)calloc(1,sizeof(variable));
90         /*                                                                   */
91         Init_Variable(newvar->var);
92         /*                                                                   */
93         strcpy(newvar->var->v_nomvar,ident);
94         strcpy(newvar->var->v_commoninfile,cur_filename);
95         strcpy(newvar->var->v_modulename,curmodulename);
96         strcpy(newvar->var->v_subroutinename,subroutinename);
97         newvar->var->v_pointedvar=pointedvar;
98         newvar->suiv = List_UsedInSubroutine_Var;
99         List_UsedInSubroutine_Var = newvar;
100      }
101  }
102
103   }
104}
105
106/******************************************************************************/
107/*                        AJOUTEVARINDOLOOP_DEFINEDIMENSION                   */
108/******************************************************************************/
109/* This subroutine is used to add a listvar to  List_UsedInSubroutine_Var     */
110/******************************************************************************/
111void ajoutevarindoloop_definedimension (char *name)
112{
113  listvar *newvar;
114  listvar *tmpvar;
115  listvar *tmpvarprec;
116  int out;
117  int tablemeet;
118
119  if ( !List_UsedInSubroutine_Var )
120  {
121  printf("LISTE VIDE\n");
122      newvar=(listvar *)calloc(1,sizeof(listvar));
123      newvar->var=(variable *)calloc(1,sizeof(variable));
124      /*                                                                      */
125      Init_Variable(newvar->var);
126      /*                                                                      */
127      newvar->suiv = NULL;
128      strcpy(newvar->var->v_nomvar,name);
129      strcpy(newvar->var->v_modulename,curmodulename);
130      strcpy(newvar->var->v_commoninfile,cur_filename);
131      strcpy(newvar->var->v_subroutinename,subroutinename);
132      newvar->var->v_pointedvar=pointedvar;
133      List_UsedInSubroutine_Var = newvar ;
134  }
135  else
136  {
137      /* We should verify that this variable did not added                    */
138      tmpvarprec = (listvar *)NULL;
139      tmpvar = List_UsedInSubroutine_Var;
140      out = 0 ;
141      tablemeet = 0 ;
142      while (tmpvar && out == 0 )
143      {
144         if ( tablemeet == 0 && tmpvar->var->v_nbdim != 0 ) tablemeet = 1 ;
145         /*                                                                   */
146         if ( !strcasecmp(tmpvar->var->v_nomvar,name) &&
147              !strcasecmp(tmpvar->var->v_subroutinename,subroutinename))
148         {
149            out  = 1 ;
150            /* if this variable has been define before a table we do nothing  */
151            /*    else we should remove it                                    */
152            if ( tablemeet == 1 )
153            {
154               tmpvarprec->suiv = tmpvar -> suiv;
155               out = 2;
156            }
157         }
158         else
159         {
160            tmpvarprec = tmpvar;
161            tmpvar = tmpvar->suiv;
162         }
163      }
164     
165      if ( out == 2 || out == 0 )
166      {
167         newvar=(listvar *)calloc(1,sizeof(listvar));
168         newvar->var=(variable *)calloc(1,sizeof(variable));
169         /*                                                                   */
170         Init_Variable(newvar->var);
171         /*                                                                   */
172         strcpy(newvar->var->v_nomvar,name);
173         strcpy(newvar->var->v_modulename,curmodulename);
174         strcpy(newvar->var->v_commoninfile,cur_filename);
175         strcpy(newvar->var->v_subroutinename,subroutinename);
176         newvar->var->v_pointedvar=pointedvar;
177
178         /* we should find this new variable to know the tabvars indice       */
179
180         if ( variableisglobal(newvar, List_Global_Var) == 1 )
181         {
182            newvar->suiv = List_UsedInSubroutine_Var;
183            List_UsedInSubroutine_Var = newvar;
184         }
185         else if ( variableisglobal(newvar, List_ModuleUsed_Var) == 1 )
186         {
187            newvar->suiv = List_UsedInSubroutine_Var;
188            List_UsedInSubroutine_Var = newvar;
189         }
190         else if ( variableisglobal(newvar, List_Common_Var) == 1 )
191         {
192            newvar->suiv = List_UsedInSubroutine_Var;
193            List_UsedInSubroutine_Var = newvar;
194         }
195         else
196         {
197            free(newvar);
198         }
199     }
200  }
201}
202
203/******************************************************************************/
204/*                        ModifyThelistvarindoloop                            */
205/******************************************************************************/
206/* This subroutine is to give the old name to the which has been              */
207/* declared as USE MOD, U => V in this case we should replace in the          */
208/* name V by the old name U in the List_UsedInSubroutine_Var                  */
209/******************************************************************************/
210void  ModifyThelistvarindoloop()
211{
212  listvar *newvar;
213
214  newvar = List_UsedInSubroutine_Var;
215  while ( newvar )
216  {
217     if ( strcasecmp(newvar->var->v_oldname,"") )
218     {
219        strcpy(newvar->var->v_nomvar,newvar->var->v_oldname);
220     }
221     newvar = newvar->suiv;
222  }
223}
224
225/******************************************************************************/
226/*                          CompleteThelistvarindoloop                        */
227/******************************************************************************/
228/* This subroutine is to add to the List_UsedInSubroutine_Var all variables   */
229/* which has been declared as USE MOD, U => V in this case we should replace  */
230/* in the List_UsedInSubroutine_Var the word U by the word V                  */
231/******************************************************************************/
232void  CompleteThelistvarindoloop()
233{
234    listvar *newvar;
235    listvarpointtovar *pointtmplist;
236    listcouple *coupletmp;
237    int outvar;
238
239    pointtmplist = List_CouplePointed_Var;
240    while ( pointtmplist )
241    {
242        coupletmp = pointtmplist->t_couple;
243        while ( coupletmp )
244        {
245            newvar = List_UsedInSubroutine_Var;
246            outvar = 0 ;
247            while ( newvar && outvar == 0)
248            {
249                /* we should find the same variable name in the same subroutine    */
250                if ( !strcasecmp(newvar->var->v_nomvar, coupletmp->c_namevar) &&
251                     !strcasecmp(newvar->var->v_subroutinename, pointtmplist->t_cursubroutine) &&
252                      strcasecmp(coupletmp->c_namepointedvar, "") )
253                {
254                    outvar = 1;
255                    strcpy(newvar->var->v_oldname, newvar->var->v_nomvar);
256                    strcpy(newvar->var->v_nomvar, coupletmp->c_namepointedvar);
257                }
258                else
259                {
260                    newvar = newvar->suiv;
261                }
262            }
263            coupletmp = coupletmp->suiv;
264        }
265        pointtmplist = pointtmplist->suiv;
266    }
267}
268
269/******************************************************************************/
270/*                             Merge_Variables                                */
271/******************************************************************************/
272/*                                                                            */
273/******************************************************************************/
274void Merge_Variables(variable *var1, variable *var2)
275{
276
277    if ( !strcasecmp(var1->v_typevar,"") )
278            strcpy(var1->v_typevar,var2->v_typevar);
279    else    strcpy(var2->v_typevar,var1->v_typevar);
280
281    if ( !strcasecmp(var1->v_oldname,"") )
282            strcpy(var1->v_oldname,var2->v_oldname);
283    else    strcpy(var2->v_oldname,var1->v_oldname);
284
285    if ( !strcasecmp(var1->v_dimchar,"") )
286            strcpy(var1->v_dimchar,var2->v_dimchar);
287    else    strcpy(var2->v_dimchar,var1->v_dimchar);
288
289    if ( !strcasecmp(var1->v_commonname,"") )
290            strcpy(var1->v_commonname,var2->v_commonname);
291    else    strcpy(var2->v_commonname,var1->v_commonname);
292
293    if ( !strcasecmp(var1->v_modulename,"") || (var1->v_module ==0))
294            strcpy(var1->v_modulename,var2->v_modulename);
295    else    strcpy(var2->v_modulename,var1->v_modulename);
296
297    if ( !strcasecmp(var1->v_vallengspec,"") )
298            strcpy(var1->v_vallengspec,var2->v_vallengspec);
299    else    strcpy(var2->v_vallengspec,var1->v_vallengspec);
300
301    if ( !strcasecmp(var1->v_nameinttypename,"") )
302            strcpy(var1->v_nameinttypename,var2->v_nameinttypename);
303    else    strcpy(var2->v_nameinttypename,var1->v_nameinttypename);
304
305    if ( !strcasecmp(var1->v_commoninfile,"") )
306            strcpy(var1->v_commoninfile,var2->v_commoninfile);
307    else    strcpy(var2->v_commoninfile,var1->v_commoninfile);
308
309    if ( !strcasecmp(var1->v_precision,"") )
310            strcpy(var1->v_precision,var2->v_precision);
311    else    strcpy(var2->v_precision,var1->v_precision);
312
313//     if ( !strcasecmp(var1->v_initialvalue,"") )
314//             strcpy(var1->v_initialvalue,var2->v_initialvalue);
315//     else    strcpy(var2->v_initialvalue,var1->v_initialvalue);
316
317    if ( var1->v_initialvalue )
318            var2->v_initialvalue = var1->v_initialvalue;
319    else    var1->v_initialvalue = var2->v_initialvalue;
320
321    if ( var1->v_initialvalue_array )
322            var2->v_initialvalue_array = var1->v_initialvalue_array;
323    else    var1->v_initialvalue_array = var2->v_initialvalue_array;
324   
325    if ( var1->v_do_loop )
326            var2->v_do_loop = var1->v_do_loop;
327    else    var1->v_do_loop = var2->v_do_loop;
328   
329//     if ( !strcasecmp(var1->v_initialvalue_array,"") )
330//             strcpy(var1->v_initialvalue_array,var2->v_initialvalue_array);
331//     else    strcpy(var2->v_initialvalue_array,var1->v_initialvalue_array);
332   
333    if ( !strcasecmp(var1->v_IntentSpec,"") )
334            strcpy(var1->v_IntentSpec,var2->v_IntentSpec);
335    else    strcpy(var2->v_IntentSpec,var1->v_IntentSpec);
336
337    if ( !strcasecmp(var1->v_readedlistdimension,"") )
338            strcpy(var1->v_readedlistdimension,var2->v_readedlistdimension);
339    else    strcpy(var2->v_readedlistdimension,var1->v_readedlistdimension);
340
341    if ( var1->v_dimension )
342            var2->v_dimension = var1->v_dimension ;
343    else    var1->v_dimension = var2->v_dimension ;
344
345    if ( var1->v_nbdim == 0 )
346            var1->v_nbdim = var2->v_nbdim ;
347    else    var2->v_nbdim = var1->v_nbdim ;
348
349    if ( var1->v_common == 0 )
350            var1->v_common = var2->v_common ;
351    else    var2->v_common = var1->v_common ;
352
353    if ( var1->v_positioninblock == 0 )
354            var1->v_positioninblock = var2->v_positioninblock ;
355    else    var2->v_positioninblock = var1->v_positioninblock ;
356
357    if ( var1->v_module == 0 )
358            var1->v_module = var2->v_module ;
359    else    var2->v_module = var1->v_module ;
360
361    if ( var1->v_save == 0 )
362            var1->v_save = var2->v_save ;
363    else    var2->v_save = var1->v_save ;
364
365    if ( var1->v_VariableIsParameter == 0 )
366            var1->v_VariableIsParameter = var2->v_VariableIsParameter ;
367    else    var2->v_VariableIsParameter = var1->v_VariableIsParameter ;
368
369    if ( var1->v_indicetabvars == 0 )
370            var1->v_indicetabvars = var2->v_indicetabvars ;
371    else    var2->v_indicetabvars = var1->v_indicetabvars ;
372
373    if ( var1->v_ExternalDeclare == 0 )
374            var1->v_ExternalDeclare = var2->v_ExternalDeclare ;
375    else    var2->v_ExternalDeclare = var1->v_ExternalDeclare ;
376
377    if ( var1->v_pointedvar == 0 )
378            var1->v_pointedvar = var2->v_pointedvar ;
379    else    var2->v_pointedvar = var1->v_pointedvar ;
380
381    if ( var1->v_dimensiongiven == 0 )
382            var1->v_dimensiongiven = var2->v_dimensiongiven;
383    else    var2->v_dimensiongiven = var1->v_dimensiongiven ;
384
385    if ( var1->v_c_star == 0 )
386            var1->v_c_star = var2->v_c_star;
387    else    var2->v_c_star = var1->v_c_star ;
388
389    if ( var1->v_catvar == 0 )
390            var1->v_catvar = var2->v_catvar;
391    else    var2->v_catvar = var1->v_catvar ;
392
393    if ( var1->v_pointerdeclare == 0 )
394            var1->v_pointerdeclare = var2->v_pointerdeclare ;
395    else    var2->v_pointerdeclare = var1->v_pointerdeclare ;
396
397    if ( var1->v_notgrid == 0 )
398            var1->v_notgrid = var2->v_notgrid ;
399    else    var2->v_notgrid = var1->v_notgrid;
400
401    if ( var1->v_optionaldeclare == 0 )
402            var1->v_optionaldeclare = var2->v_optionaldeclare;
403    else    var2->v_optionaldeclare = var1->v_optionaldeclare ;
404
405    if ( var1->v_contiguousdeclare == 0 )
406            var1->v_contiguousdeclare = var2->v_contiguousdeclare;
407    else    var2->v_contiguousdeclare = var1->v_contiguousdeclare ;
408
409    if ( var1->v_allocatable == 0 )
410            var1->v_allocatable = var2->v_allocatable ;
411    else    var2->v_allocatable = var1->v_allocatable ;
412
413    if ( var1->v_target == 0 )
414            var1->v_target = var2->v_target ;
415    else    var2->v_target = var1->v_target ;
416
417    if ( var1->v_dimsempty == 0 )
418            var1->v_dimsempty = var2->v_dimsempty ;
419    else    var2->v_dimsempty = var1->v_dimsempty ;
420}
421
422
423/******************************************************************************/
424/*                      Update_List_Subroutine_Var                            */
425/******************************************************************************/
426/*                                                                            */
427/******************************************************************************/
428void Update_List_Subroutine_Var(listvar *list_to_modify)
429{
430   listvar *parcours;
431   listvar *parcoursprec;
432   listvar *parcours1;
433   int out;
434
435   parcoursprec = (listvar *)NULL;
436   parcours = list_to_modify;
437   while( parcours )
438   {
439      /* looking in List_SubroutineDeclaration_Var                            */
440      parcours1 = List_SubroutineDeclaration_Var;
441      out = 0;
442      while ( parcours1 && out == 0 )
443      {
444         if ( !strcasecmp(parcours->var->v_nomvar,         parcours1->var->v_nomvar)         &&
445              !strcasecmp(parcours->var->v_subroutinename, parcours1->var->v_subroutinename) &&
446              !strcasecmp(parcours->var->v_modulename,     parcours1->var->v_modulename)
447            ) out = 1;
448         else parcours1 = parcours1->suiv;
449      }
450      /* if variable has been found                                           */
451
452      if ( out == 1 ) Merge_Variables(parcours->var,parcours1->var);
453
454      /* looking in List_Dimension_Var                                        */
455      if (out == 0 )
456      {
457        parcours1 = List_Dimension_Var;
458        out = 0;
459        while ( parcours1 && out == 0 )
460        {
461           if ( !strcasecmp(parcours->var->v_nomvar,
462                            parcours1->var->v_nomvar)         &&
463                !strcasecmp(parcours->var->v_subroutinename,
464                            parcours1->var->v_subroutinename) &&
465                !strcasecmp(parcours->var->v_modulename,
466                            parcours1->var->v_modulename)
467              ) out = 1;
468           else
469           {
470              parcoursprec = parcours1;
471              parcours1 = parcours1->suiv;
472           }
473        }
474        /* if variable has been found                                         */
475
476        if ( out == 1 )
477        {
478           Merge_Variables(parcours->var,parcours1->var);
479           /* we should remove this record from the List_Dimension_Var        */
480           if ( parcours1 == List_Dimension_Var )
481           {
482              List_Dimension_Var = List_Dimension_Var -> suiv;
483           }
484           else
485           {
486              parcoursprec->suiv = parcours1 -> suiv;
487           }
488        }
489      }
490      /*                                                                      */
491      parcours = parcours->suiv;
492   }
493}
494
495void Update_List_Global_Var_From_List_Save_Var()
496{
497   listvar *parcours;
498   listvar *newvar;
499   char tmpname[LONG_VNAME];
500
501   parcours = List_Save_Var;
502   while( parcours )
503   {
504      if ( !strcasecmp(parcours->var->v_modulename,"") )
505      /* Save in subroutine which is not defined in a module                  */
506      {
507         newvar = (listvar *)calloc(1,sizeof(listvar));
508         newvar->var = (variable *)calloc(1,sizeof(variable));
509         /*                                                                   */
510         Init_Variable(newvar->var);
511         /*                                                                   */
512         newvar->suiv = NULL;
513
514         Merge_Variables(parcours->var,newvar->var);
515         strcpy(newvar->var->v_subroutinename,parcours->var->v_subroutinename);
516         strcpy(newvar->var->v_nomvar,parcours->var->v_nomvar);
517         newvar->var->v_catvar=parcours->var->v_catvar;
518         sprintf(tmpname,"save_%s",parcours->var->v_subroutinename);
519         Add_NameOfCommon_1(tmpname,parcours->var->v_subroutinename);
520         strcpy(newvar->var->v_commonname,tmpname);
521         List_Common_Var = AddListvarToListvar(newvar,List_Common_Var,1);
522      }
523      else
524      /* Save in subroutine which is defined in a module                      */
525      {
526         newvar = (listvar *)calloc(1,sizeof(listvar));
527         newvar->var = (variable *)calloc(1,sizeof(variable));
528         /*                                                                   */
529         Init_Variable(newvar->var);
530         /*                                                                   */
531         newvar->suiv = NULL;
532
533         Merge_Variables(parcours->var,newvar->var);
534         strcpy(newvar->var->v_subroutinename,parcours->var->v_subroutinename);
535
536         strcpy(newvar->var->v_nomvar,parcours->var->v_nomvar);
537
538         newvar->var->v_catvar=parcours->var->v_catvar;
539         strcpy(newvar->var->v_modulename,parcours->var->v_modulename);
540         List_Global_Var = AddListvarToListvar(newvar,List_Global_Var,1);
541      }
542      parcours = parcours->suiv;
543   }
544}
545
546/******************************************************************************/
547/*                      Update_List_From_Common_Var                           */
548/******************************************************************************/
549/*                                                                            */
550/******************************************************************************/
551void Update_List_From_Common_Var(listvar *list_to_modify)
552{
553   listvar *parcours;
554   listvar *parcours1;
555   int out;
556   parcours = list_to_modify;
557   while( parcours )
558   {
559      /* looking in List_Global_Var                                           */
560      parcours1 = List_Common_Var;
561      out = 0;
562      while ( parcours1 && out == 0 )
563      {
564
565         if ( !strcasecmp(parcours->var->v_nomvar,         parcours1->var->v_nomvar) &&
566              !strcasecmp(parcours->var->v_subroutinename, parcours1->var->v_subroutinename) )
567         {
568            out = 1;
569         }
570         else parcours1 = parcours1->suiv;
571      }
572      /* if variable has been found                                           */
573      if ( out == 1 )
574      {
575         strcpy(parcours->var->v_commoninfile,parcours1->var->v_commoninfile);
576
577         Merge_Variables(parcours->var,parcours1->var);
578      }
579      parcours = parcours->suiv;
580   }
581}
582
583/******************************************************************************/
584/*                          Update_List_Var                                   */
585/******************************************************************************/
586/*                                                                            */
587/******************************************************************************/
588void Update_List_Var(listvar *list_to_modify)
589{
590    listvar *parcours;
591    listvar *parcours1;
592    int out;
593
594    parcours = list_to_modify;
595
596    while( parcours )
597    {
598        /*printf("LE NOM EST %s\n",parcours->var->v_nomvar);*/
599        /* looking in List_Global_Var                                           */
600        out = 0;
601        parcours1 = List_Global_Var;
602
603        while ( parcours1 && out == 0 )
604        {
605            if ( !strcasecmp(parcours->var->v_nomvar, parcours1->var->v_nomvar)         &&
606                 !strcasecmp(parcours->var->v_subroutinename, parcours1->var->v_subroutinename) &&
607                 !strcasecmp(parcours->var->v_modulename, parcours1->var->v_modulename) )
608            {
609                out = 1;
610            }
611            else parcours1 = parcours1->suiv;
612        }
613
614        /* if variable has been found                                           */
615        if ( out == 1 )
616        {
617            Merge_Variables(parcours->var,parcours1->var);
618        }
619        /* looking in List_SubroutineDeclaration_Var                            */
620        else
621        {
622            parcours1 = List_SubroutineDeclaration_Var ;
623            out = 0;
624            while ( parcours1 )
625            {
626                if ( !strcasecmp(parcours->var->v_nomvar, parcours1->var->v_nomvar)                 &&
627                     !strcasecmp(parcours->var->v_subroutinename, parcours1->var->v_subroutinename) &&
628                     !strcasecmp(parcours->var->v_modulename, parcours1->var->v_modulename) )
629                {
630                    out = 1;
631                    break;
632                }
633                else parcours1 = parcours1->suiv;
634            }
635            /* if variable has been found                                        */
636            if ( out == 1 )
637            {
638                Merge_Variables(parcours->var,parcours1->var);
639            }
640            else
641            {
642                parcours1 = List_Common_Var ;
643                out = 0;
644                while ( parcours1 && out == 0 )
645                {
646                    if ( !strcasecmp(parcours->var->v_nomvar, parcours1->var->v_nomvar)                 &&
647                         !strcasecmp(parcours->var->v_subroutinename, parcours1->var->v_subroutinename) &&
648                         !strcasecmp(parcours->var->v_modulename, parcours1->var->v_modulename) )
649                    {
650                        out = 1;
651                    }
652                    else parcours1 = parcours1->suiv;
653                }
654                /* if variable has been found                                     */
655                if ( out == 1 )
656                {
657                    Merge_Variables(parcours->var,parcours1->var);
658                }
659            }
660        }
661        parcours = parcours->suiv;
662    }
663}
664
665
666void List_UsedInSubroutine_Var_Update_From_Module_Used()
667{
668   listvar *parcours;
669   listvar *parcours3;
670   listusemodule *parcours2;
671   int out;
672
673
674   parcours = List_UsedInSubroutine_Var;
675   while( parcours )
676   {
677      out = 0 ;
678      if ( parcours->var->v_indicetabvars == 0 )
679      {
680         parcours2 = List_NameOfModuleUsed;
681         while( parcours2 )
682         {
683            if ( !strcasecmp(parcours2->u_cursubroutine, "") &&
684                 !strcasecmp(parcours2->u_modulename, parcours->var->v_modulename) )
685            {
686               parcours3 = List_Global_Var;
687               out = 0 ;
688               while ( parcours3 && out == 0 )
689               {
690                  if ( !strcasecmp(parcours->var->v_nomvar,
691                                   parcours3->var->v_nomvar)
692                     ) out = 1 ;
693                  else parcours3 = parcours3->suiv;
694               }
695               if ( out == 1 ) Merge_Variables(parcours->var,parcours3->var);
696            }
697            else if ( !strcasecmp(parcours2->u_cursubroutine, parcours->var->v_subroutinename) &&
698                      !strcasecmp(parcours2->u_modulename,    parcours->var->v_modulename) )
699            {
700               parcours3 = List_Global_Var;
701               out = 0 ;
702               while ( parcours3 && out == 0 )
703               {
704                  if ( !strcasecmp(parcours->var->v_nomvar,
705                                   parcours3->var->v_nomvar)
706                     ) out = 1 ;
707                  else parcours3 = parcours3->suiv;
708               }
709               if ( out == 1 ) Merge_Variables(parcours->var,parcours3->var);
710            }
711            parcours2 = parcours2->suiv;
712         }
713         /*                                                                   */
714         if ( out == 0 )
715         {
716            parcours3 = List_ModuleUsed_Var;
717            out = 0 ;
718            while ( parcours3 && out == 0 )
719            {
720               if ( !strcasecmp(parcours->var->v_nomvar,
721                                parcours3->var->v_nomvar)
722                  ) out = 1 ;
723               else parcours3 = parcours3->suiv;
724            }
725            if ( out == 1 ) Merge_Variables(parcours->var,parcours3->var);
726         }
727         /*                                                                   */
728      }
729      parcours = parcours->suiv;
730   }
731}
732
733
734
735/******************************************************************************/
736/*                       Update_NotGridDepend_Var                             */
737/******************************************************************************/
738/*                                                                            */
739/******************************************************************************/
740void Update_NotGridDepend_Var(listvar *list_to_modify)
741{
742   listvar *parcours;
743   listvar *parcours1;
744   int out;
745
746   parcours = list_to_modify;
747   while( parcours )
748   {
749      /* looking in List_Global_Var                                           */
750      parcours1 = List_Global_Var;
751      out = 0;
752      while ( parcours1 && out == 0 )
753      {
754         if ( !strcasecmp(parcours->var->v_nomvar,
755                          parcours1->var->v_nomvar)
756            ) out = 1;
757         else parcours1 = parcours1->suiv;
758      }
759      /* if variable has been found                                           */
760      if ( out == 1 )
761      {
762         Merge_Variables(parcours->var,parcours1->var);
763         strcpy(parcours->var->v_subroutinename,
764                parcours1->var->v_subroutinename);
765         strcpy(parcours->var->v_modulename,parcours1->var->v_modulename);
766      }
767      parcours = parcours->suiv;
768   }
769}
770
771int LookingForVariableInList(listvar *listin,variable *var)
772{
773   listvar *parcours1;
774   int out;
775
776   parcours1 = listin;
777   out = 0 ;
778   while ( parcours1 && out == 0 )
779   {
780      if ( !strcasecmp(var->v_nomvar,parcours1->var->v_nomvar)                &&
781           !strcasecmp(var->v_subroutinename,parcours1->var->v_subroutinename)&&
782           !strcasecmp(var->v_modulename,parcours1->var->v_modulename)        &&
783                       var->v_save == 0                                       &&
784                       var->v_common == 0
785         ) out = 1 ;
786      else parcours1 = parcours1 -> suiv;
787   }
788
789   return out;
790}
791
792int LookingForVariableInListGlobal(listvar *listin,variable *var)
793{
794   listvar *parcours1;
795   int out;
796
797   parcours1 = listin;
798   out = 0 ;
799   while ( parcours1 && out == 0 )
800   {
801      if ( !strcasecmp(var->v_nomvar,parcours1->var->v_nomvar)                &&
802           !strcasecmp(var->v_subroutinename,parcours1->var->v_subroutinename)&&
803           !strcasecmp(var->v_modulename,parcours1->var->v_modulename)
804         ) out = 1 ;
805      else parcours1 = parcours1 -> suiv;
806   }
807
808   return out;
809}
810
811int LookingForVariableInListName(listvar *listin,const char *name)
812{
813   listvar *parcours1;
814   int out;
815
816   parcours1 = listin;
817   out = 0 ;
818   while ( parcours1 && out == 0 )
819   {
820      if ( !strcasecmp(name,parcours1->var->v_nomvar) &&
821           ( !strcasecmp(subroutinename,parcours1->var->v_subroutinename) ||
822             !strcasecmp(subroutinename,"") )
823         ) out = 1 ;
824      else parcours1 = parcours1 -> suiv;
825   }
826
827   return out;
828}
829
830variable *get_variable_in_list_from_name( listvar *listin, const char *name )
831{
832    listvar *parcours = listin;
833    variable *var = NULL;
834
835    while ( parcours && (!var) )
836    {
837        if ( !strcasecmp(name,parcours->var->v_nomvar) &&
838           ( !strcasecmp(subroutinename,parcours->var->v_subroutinename) ||
839             !strcasecmp(subroutinename,"") ) )
840        {
841            var = parcours->var;
842        }
843        else parcours = parcours -> suiv;
844   }
845   return var;
846}
847
848int LookingForVariableInListGlob(listvar *listin,variable *var)
849{
850   listvar *parcours1;
851   int out;
852
853   parcours1 = listin;
854   out = 0 ;
855   while ( parcours1 && out == 0 )
856   {
857      if ( !strcasecmp(var->v_nomvar,parcours1->var->v_nomvar)                &&
858           !strcasecmp(var->v_modulename,parcours1->var->v_modulename)
859         ) out = 1 ;
860      else parcours1 = parcours1 -> suiv;
861   }
862
863   return out;
864}
865
866int LookingForVariableInListParamGlob(listparameter *listin,variable *var)
867{
868   listparameter *parcours1;
869   int out;
870
871   parcours1 = listin;
872   out = 0 ;
873   while ( parcours1 && out == 0 )
874   {
875      if ( !strcasecmp(var->v_nomvar,parcours1->p_name)
876         ) out = 1 ;
877      else parcours1 = parcours1 -> suiv;
878   }
879
880   return out;
881}
882
883void UpdateListDeclarationWithDimensionList()
884{
885   List_SubroutineDeclaration_Var = AddListvarToListvar(List_Dimension_Var, List_SubroutineDeclaration_Var,1);
886}
887
888
889/* Remove from List_UsedInSubroutine_Var all variables comming from :         */
890/*       - List_SubroutineArgument_Var                                        */
891/*       - List_SubroutineDeclaration_Var                                     */
892/*       - List_Parameter_Var                                                 */
893/*       - List_FunctionType_Var                                              */
894/*       - List_GlobalParameter_Var                                           */
895/*       -                                                                    */
896/*       -                                                                    */
897void Clean_List_UsedInSubroutine_Var()
898{
899   listvar *parcours;
900   listvar *parcoursprec;
901   int remove;
902
903   parcoursprec = (listvar *)NULL;
904   parcours = List_UsedInSubroutine_Var;
905   while ( parcours )
906   {
907      remove = LookingForVariableInListGlobal(List_SubroutineArgument_Var,   parcours->var);
908      if ( remove == 0 )
909           remove = LookingForVariableInList(List_SubroutineDeclaration_Var, parcours->var);
910      if ( remove == 0 )
911           remove = LookingForVariableInList(List_Parameter_Var, parcours->var);
912      if ( remove == 0 )
913           remove = LookingForVariableInList(List_FunctionType_Var, parcours->var);
914      if ( remove == 0 )
915           remove = LookingForVariableInListGlob(List_GlobalParameter_Var, parcours->var);
916      if ( remove == 0 )
917           remove = LookingForVariableInListParamGlob(List_GlobParamModuleUsed_Var, parcours->var);
918      if ( remove == 0 )
919      {
920         if ( VariableIsInList(parcours,List_Global_Var)                 == 1 ||
921              VariableIsInListCommon(parcours,List_Common_Var)           == 1 ||
922              VariableIsInList(parcours,List_ModuleUsed_Var)             == 1 ||
923              VariableIsInList(parcours,List_ModuleUsedInModuleUsed_Var) == 1
924            ) remove = 0;
925         else remove = 1;
926      }
927
928      /************************************************************************/
929      /*                         Remove                                       */
930      /************************************************************************/
931
932      if ( remove == 1 )
933      {
934         if ( parcours == List_UsedInSubroutine_Var )
935         {
936           List_UsedInSubroutine_Var = List_UsedInSubroutine_Var -> suiv;
937           parcours = List_UsedInSubroutine_Var;
938         }
939         else
940         {
941            parcoursprec->suiv = parcours->suiv;
942            parcours = parcoursprec -> suiv ;
943         }
944      }
945      else
946      {
947         parcoursprec = parcours;
948         parcours = parcours -> suiv ;
949      }
950   }
951}
952
953
954void Clean_List_ModuleUsed_Var()
955{
956   listvar *parcours;
957   listvar *parcours1;
958   listvar *parcoursprec;
959   int remove;
960
961   parcoursprec = (listvar *)NULL;
962   parcours = List_ModuleUsed_Var;
963   while ( parcours )
964   {
965      /*                                                                      */
966      parcours1 = List_GlobalParameter_Var;
967      remove = 0 ;
968      while ( parcours1 && remove == 0 )
969      {
970         if ( !strcasecmp(parcours->var->v_nomvar,parcours1->var->v_nomvar)
971            ) remove = 1 ;
972         else parcours1 = parcours1 -> suiv;
973      }
974      /************************************************************************/
975      /*                         Remove                                       */
976      /************************************************************************/
977      if ( remove == 1 )
978      {
979         if ( parcours == List_ModuleUsed_Var )
980         {
981           List_ModuleUsed_Var = List_ModuleUsed_Var -> suiv;
982           parcours = List_ModuleUsed_Var;
983         }
984         else
985         {
986            parcoursprec->suiv = parcours->suiv;
987            parcours = parcoursprec -> suiv ;
988         }
989      }
990      else
991      {
992         parcoursprec = parcours;
993         parcours = parcours -> suiv ;
994      }
995   }
996}
997
998void Clean_List_SubroutineDeclaration_Var()
999{
1000   listvar *parcours;
1001   listvar *parcours1;
1002   listvar *parcoursprec;
1003   int out ;
1004
1005   parcoursprec = (listvar *)NULL;
1006   parcours = List_SubroutineDeclaration_Var;
1007   while ( parcours )
1008   {
1009      parcours1 = List_FunctionType_Var;
1010      out = 0 ;
1011      while ( parcours1 && out == 0 )
1012      {
1013         if ( !strcasecmp(parcours->var->v_subroutinename,parcours1->var->v_subroutinename) &&
1014              !strcasecmp(parcours->var->v_nomvar,parcours1->var->v_nomvar)
1015            ) out = 1;
1016         else parcours1 = parcours1->suiv;
1017      }
1018      if ( out == 0 )
1019      {
1020         parcours1 = List_SubroutineArgument_Var;
1021         out = 0 ;
1022         while ( parcours1 && out == 0 )
1023         {
1024            if ( !strcasecmp(parcours->var->v_subroutinename,parcours1->var->v_subroutinename) &&
1025                 !strcasecmp(parcours->var->v_nomvar,parcours1->var->v_nomvar)
1026               ) out = 1;
1027            else parcours1 = parcours1->suiv;
1028         }
1029      }
1030
1031      if ( out == 1 )
1032      {
1033          if ( parcours == List_SubroutineDeclaration_Var )
1034          {
1035             List_SubroutineDeclaration_Var =
1036                                         List_SubroutineDeclaration_Var -> suiv;
1037             parcours = List_SubroutineDeclaration_Var;
1038          }
1039          else
1040          {
1041             parcoursprec->suiv = parcours->suiv;
1042             parcours = parcoursprec->suiv;
1043          }
1044      }
1045      else
1046      {
1047         parcoursprec = parcours;
1048         parcours = parcours -> suiv;
1049      }
1050   }
1051}
1052
1053void Clean_List_Global_Var()
1054{
1055   listvar *parcours;
1056   listvar *parcours2;
1057   listvar *parcoursprec;
1058   listvar *parcours2prec;
1059
1060   parcoursprec = (listvar *)NULL;
1061   parcours2prec = (listvar *)NULL;
1062   parcours = List_Global_Var;
1063   while ( parcours )
1064   {
1065      if ( parcours->var->v_VariableIsParameter == 1 )
1066      {
1067         /* remove                                                            */
1068         if ( parcours == List_Global_Var )
1069         {
1070            List_Global_Var = List_Global_Var->suiv;
1071            free(parcours);
1072            parcours = List_Global_Var;
1073         }
1074         else
1075         {
1076            parcoursprec->suiv = parcours->suiv;
1077            free(parcours);
1078            parcours = parcoursprec->suiv;
1079         }
1080      }
1081      else
1082      {
1083         parcoursprec = parcours;
1084         parcours = parcours->suiv;
1085      }
1086   }
1087   /* looking for sevral declaration of the same variable                     */
1088   parcours = List_Global_Var;
1089   while ( parcours )
1090   {
1091      parcours2prec = parcours;
1092      parcours2 = parcours->suiv;
1093      while ( parcours2 )
1094      {
1095         if ( !strcasecmp(parcours->var->v_nomvar,
1096                         parcours2->var->v_nomvar)     &&
1097              !strcasecmp(parcours->var->v_modulename,
1098                         parcours2->var->v_modulename) )
1099         {
1100            Merge_Variables(parcours->var,parcours2->var);
1101            /* remove var from the parcours2                                  */
1102            parcours2prec ->suiv = parcours2->suiv;
1103            free(parcours2);
1104            parcours2 = parcours2prec ->suiv;
1105         }
1106         else
1107         {
1108            parcours2prec = parcours2;
1109            parcours2 = parcours2->suiv;
1110         }
1111      }
1112      parcours = parcours->suiv;
1113   }
1114}
1115/******************************************************************************/
1116/*                             ListClean                                      */
1117/******************************************************************************/
1118/*                                                                            */
1119/******************************************************************************/
1120void ListClean()
1121{
1122   listvar *newvar;
1123
1124   Clean_List_ModuleUsed_Var();
1125   Clean_List_UsedInSubroutine_Var();
1126   Clean_List_SubroutineDeclaration_Var();
1127
1128   newvar = (listvar *)NULL;
1129/*   newvar = List_Common_Var;*/
1130   while(newvar)
1131   {
1132      printf("----- %s --- %s ---%s---%s---\n",newvar->var->v_nomvar,
1133         newvar->var->v_commonname,
1134         newvar->var->v_readedlistdimension,
1135         newvar->var->v_subroutinename
1136      );
1137      newvar = newvar -> suiv;
1138      printf("+++++++++++++++++++++++++\n");
1139   }
1140
1141}
1142
1143
1144/******************************************************************************/
1145/*                             ListUpdate                                     */
1146/******************************************************************************/
1147/*                                                                            */
1148/******************************************************************************/
1149void ListUpdate()
1150{
1151    listvar *newvar;
1152
1153    Update_List_Subroutine_Var(List_SubroutineArgument_Var);
1154    Update_List_Subroutine_Var(List_FunctionType_Var);
1155    Update_List_Var(List_Parameter_Var);
1156    Update_List_Var(List_Dimension_Var);
1157    Update_List_Var(List_Data_Var);
1158    Update_List_Var(List_Save_Var);
1159    Update_List_Var(List_GlobalParameter_Var);
1160    Update_List_Var(List_Common_Var);
1161    Update_List_Var(List_SubroutineDeclaration_Var);
1162    Update_List_Var(List_UsedInSubroutine_Var);
1163    Update_List_From_Common_Var(List_UsedInSubroutine_Var);
1164    Update_List_From_Common_Var(List_SubroutineDeclaration_Var);
1165    Update_NotGridDepend_Var(List_NotGridDepend_Var);
1166
1167    newvar = (listvar * ) NULL;
1168//   newvar = List_Common_Var;
1169//   newvar = List_UsedInSubroutine_Var;
1170//   newvar = List_Data_Var;
1171    while ( newvar )
1172    {
1173        printf("++++ %s - %s - %s - %d - %s - %s\n",
1174                newvar->var->v_modulename,
1175                newvar->var->v_subroutinename,
1176                newvar->var->v_nomvar,
1177                newvar->var->v_VariableIsParameter,
1178                newvar->var->v_typevar,
1179                newvar->var->v_initialvalue->n_name );
1180        newvar = newvar->suiv;
1181    }
1182}
1183
1184void GiveTypeOfVariables()
1185{
1186   listvar *parcours;
1187
1188   /*                                                                         */
1189   parcours = List_Common_Var;
1190   while ( parcours )
1191   {
1192      if ( !strcasecmp(parcours->var->v_typevar,"") )
1193      {
1194         if ( IsVariableReal(parcours->var->v_nomvar) == 1 )
1195                                        strcpy(parcours->var->v_typevar,"REAL");
1196         else strcpy(parcours->var->v_typevar,"INTEGER");
1197         parcours->var->v_catvar = get_cat_var(parcours->var);
1198      }
1199      parcours = parcours -> suiv ;
1200   }
1201   /*                                                                         */
1202   parcours = List_UsedInSubroutine_Var;
1203   while ( parcours )
1204   {
1205      if ( !strcasecmp(parcours->var->v_typevar,"") )
1206      {
1207         if ( IsVariableReal(parcours->var->v_nomvar) == 1 )
1208                                        strcpy(parcours->var->v_typevar,"REAL");
1209         else strcpy(parcours->var->v_typevar,"INTEGER");
1210         parcours->var->v_catvar = get_cat_var(parcours->var);
1211      }
1212      parcours = parcours -> suiv ;
1213   }
1214   /*                                                                         */
1215   parcours = List_SubroutineArgument_Var;
1216   while ( parcours )
1217   {
1218      if ( !strcasecmp(parcours->var->v_typevar,"") )
1219      {
1220         if ( IsVariableReal(parcours->var->v_nomvar) == 1 )
1221                                        strcpy(parcours->var->v_typevar,"REAL");
1222         else strcpy(parcours->var->v_typevar,"INTEGER");
1223         parcours->var->v_catvar = get_cat_var(parcours->var);
1224      }
1225      parcours = parcours -> suiv ;
1226   }
1227   /*                                                                         */
1228   parcours = List_SubroutineDeclaration_Var;
1229   while ( parcours )
1230   {
1231      if ( !strcasecmp(parcours->var->v_typevar,"") )
1232      {
1233         if ( IsVariableReal(parcours->var->v_nomvar) == 1 )
1234                                        strcpy(parcours->var->v_typevar,"REAL");
1235         else strcpy(parcours->var->v_typevar,"INTEGER");
1236         parcours->var->v_catvar = get_cat_var(parcours->var);
1237      }
1238      parcours = parcours -> suiv ;
1239   }
1240   
1241   /*                                                                         */
1242   parcours = List_Parameter_Var;
1243   while ( parcours )
1244   {
1245      if ( !strcasecmp(parcours->var->v_typevar,"") )
1246      {
1247         if ( IsVariableReal(parcours->var->v_nomvar) == 1 )
1248                                        strcpy(parcours->var->v_typevar,"REAL");
1249         else strcpy(parcours->var->v_typevar,"INTEGER");
1250         parcours->var->v_catvar = get_cat_var(parcours->var);
1251      }
1252      parcours = parcours -> suiv ;
1253   }
1254   
1255   /*                                                                         */
1256   parcours = List_GlobalParameter_Var;
1257   while ( parcours )
1258   {
1259      if ( !strcasecmp(parcours->var->v_typevar,"") )
1260      {
1261         if ( IsVariableReal(parcours->var->v_nomvar) == 1 )
1262                                        strcpy(parcours->var->v_typevar,"REAL");
1263         else strcpy(parcours->var->v_typevar,"INTEGER");
1264         parcours->var->v_catvar = get_cat_var(parcours->var);
1265      }
1266      parcours = parcours -> suiv ;
1267   }
1268
1269}
1270
1271
1272
1273void Sort_List_SubroutineArgument_Var()
1274{
1275   listvar *parcours;
1276   listvar *parcours1;
1277   int position;
1278   int out;
1279   char name_sub[LONG_M];
1280
1281   parcours = List_SubroutineArgument_Var;
1282   position = 1;
1283   while ( parcours )
1284   {
1285      parcours1 = List_SubroutineDeclaration_Var;
1286      out = 0;
1287      while ( parcours1 && out == 0 )
1288      {
1289         if ( !strcasecmp(parcours->var->v_nomvar,
1290                         parcours1->var->v_nomvar)  &&
1291              !strcasecmp(parcours->var->v_subroutinename,
1292                         parcours1->var->v_subroutinename)
1293             )
1294         {
1295            parcours1->var->v_positioninblock = position;
1296            position = position +1 ;
1297            out = 1;
1298         }
1299         else parcours1 = parcours1->suiv;
1300      }
1301      parcours = parcours->suiv;
1302   }
1303   /*                                                                         */
1304   parcours = List_SubroutineDeclaration_Var;
1305   strcpy(name_sub,"");
1306   while ( parcours )
1307   {
1308      if ( !strcasecmp(name_sub,"") )
1309      {
1310         strcpy(name_sub,parcours->var->v_subroutinename);
1311         position = 1;
1312      }
1313
1314      if ( parcours->var->v_positioninblock != 0 )
1315      {
1316         parcours1 = List_SubroutineArgument_Var;
1317         out = 0;
1318         while ( parcours1 && out == 0 )
1319         {
1320            if ( !strcasecmp(parcours->var->v_nomvar,
1321                            parcours1->var->v_nomvar)  &&
1322                 !strcasecmp(parcours->var->v_subroutinename,
1323                            parcours1->var->v_subroutinename)
1324                )
1325            {
1326               parcours1->var->v_positioninblock = position;
1327               position = position +1 ;
1328               out = 1;
1329            }
1330            else parcours1 = parcours1->suiv;
1331         }
1332      }
1333      if ( parcours->suiv )
1334         if ( strcasecmp(name_sub,parcours->suiv->var->v_subroutinename) )
1335            strcpy(name_sub,"");
1336      parcours = parcours->suiv;
1337   }
1338
1339}
1340
1341
1342
1343/******************************************************************************/
1344/*                      IndiceTabvars_Global_Var_Treated                      */
1345/******************************************************************************/
1346/*                                                                            */
1347/******************************************************************************/
1348void IndiceTabvars_Global_Var_Treated(char *nom)
1349{
1350   listvar *parcours;
1351   listvar *parcoursprec;
1352   listvar *parcours1;
1353   listvar *List_ModuleUsed_Var;
1354   listindice *newindice;
1355   int out;
1356
1357   parcoursprec = (listvar *)NULL;
1358
1359   if ( todebug == 1 ) printf("MODULE Treated %s \n",nom);
1360
1361   List_ModuleUsed_Var = (listvar *)NULL;
1362   List_ModuleUsed_Var = Readthedependfile(nom,List_ModuleUsed_Var);
1363
1364   parcours = List_Global_Var;
1365   while( parcours )
1366   {
1367      if ( !strcasecmp(parcours->var->v_modulename,nom) )
1368      {
1369         parcours1 = List_ModuleUsed_Var;
1370         out = 0 ;
1371         while ( parcours1 && out == 0 )
1372         {
1373            if ( !strcasecmp(parcours->var->v_nomvar,parcours1->var->v_nomvar)
1374               ) out = 1;
1375            else
1376            {
1377               parcoursprec = parcours1 ;
1378               parcours1 = parcours1->suiv;
1379            }
1380         }
1381         /* if we found the var Module name in the old list                   */
1382         if ( out == 1 )
1383         {
1384            Merge_Variables(parcours->var,parcours1->var);
1385            /* Remove this variable from the List_ModuleUsed_Var              */
1386            if ( parcours1 == List_ModuleUsed_Var )
1387            {
1388               List_ModuleUsed_Var = List_ModuleUsed_Var->suiv ;
1389            }
1390            else
1391            {
1392               parcoursprec->suiv = parcours1->suiv;
1393               free(parcours1);
1394               parcours1 = parcoursprec->suiv;
1395            }
1396         }
1397         else
1398         /* if we do not found the var Module name in the old list            */
1399         {
1400  //       update_indicemaxtabvars(parcours->var,Listofavailableindices);
1401         update_indicemaxtabvars(parcours->var,Listofavailableindices_glob);
1402  //          if ( Listofavailableindices )
1403  //          {
1404  //             parcours->var->v_indicetabvars = Listofavailableindices ->
1405  //                                                                     i_indice;
1406  //             if ( Listofavailableindices->suiv )
1407  //                        Listofavailableindices = Listofavailableindices->suiv;
1408  //             else
1409  //                        Listofavailableindices = (listindice *)NULL;
1410  //          }
1411  //          else
1412  //          {
1413  //             indicemaxtabvars = indicemaxtabvars + 1 ;
1414  //             parcours->var->v_indicetabvars = indicemaxtabvars;
1415  //          }
1416         }
1417      }
1418      parcours = parcours->suiv;
1419   }
1420   /* if List_ModuleUsed_Var is not empty, some var have been removed from    */
1421   /*    the last treatement                                                  */
1422  parcours1 = List_ModuleUsed_Var;
1423  while ( parcours1 )
1424  {
1425     newindice=(listindice *) calloc(1,sizeof(listindice));
1426     newindice -> i_indice = parcours1 -> var -> v_indicetabvars;
1427     newindice -> suiv = Listofavailableindices_glob[parcours1 -> var -> v_catvar];
1428     Listofavailableindices_glob[parcours1 -> var -> v_catvar] = newindice;
1429     parcours1 = parcours1->suiv;
1430  }
1431}
1432/******************************************************************************/
1433/*                       IndiceTabvars_Global_Var_No_Treated                  */
1434/******************************************************************************/
1435/*                                                                            */
1436/******************************************************************************/
1437void IndiceTabvars_Global_Var_No_Treated(char *nom)
1438{
1439   listvar *parcours;
1440
1441   if ( todebug == 1 ) printf("MODULE No Treated %s \n",nom);
1442
1443   parcours = List_Global_Var;
1444   while( parcours )
1445   {
1446      if ( !strcasecmp(parcours->var->v_modulename,nom) &&
1447           parcours->var->v_VariableIsParameter == 0    &&
1448           parcours->var->v_notgrid == 0
1449          )
1450      {
1451         indicemaxtabvars[parcours->var->v_catvar] = indicemaxtabvars[parcours->var->v_catvar] + 1 ;
1452         parcours->var->v_indicetabvars = indicemaxtabvars[parcours->var->v_catvar];
1453      }
1454      parcours = parcours->suiv;
1455   }
1456}
1457
1458
1459void UpdateTheRemainingList(listvar *record)
1460{
1461   listvar *parcours;
1462
1463   parcours = record;
1464   while ( parcours )
1465   {
1466      if ( !strcasecmp(parcours->var->v_nomvar,record->var->v_nomvar) &&
1467           !strcasecmp(parcours->var->v_commonname,record->var->v_commonname)
1468         )
1469      {
1470         strcpy(parcours->var->v_commoninfile,record->var->v_commoninfile);
1471         Merge_Variables(parcours->var,record->var);
1472      }
1473      parcours = parcours -> suiv;
1474   }
1475}
1476
1477
1478
1479/******************************************************************************/
1480/*                      IndiceTabvars_Common_Var_Treated                      */
1481/******************************************************************************/
1482/*                                                                            */
1483/******************************************************************************/
1484void IndiceTabvars_Common_Var_Treated(char *nom)
1485{
1486   listvar *parcours;
1487   listvar *parcours1;
1488   listvar *List_CommonUsed_Var;
1489   listindice *newindice;
1490   int out;
1491
1492   if ( todebug == 1 ) printf("COMMON Treated %s \n",nom);
1493
1494   List_CommonUsed_Var = (listvar *)NULL;
1495   List_CommonUsed_Var = Readthedependfile(nom,List_CommonUsed_Var);
1496
1497   parcours = List_Common_Var;
1498   while( parcours )
1499   {
1500      if ( !strcasecmp(parcours->var->v_commonname,nom) )
1501      {
1502         parcours1 = List_CommonUsed_Var;
1503         out = 0 ;
1504         while ( parcours1 && out == 0 )
1505         {
1506
1507            if ( !strcasecmp(parcours1->var->v_commonname,nom) &&
1508                 !strcasecmp(parcours->var->v_nomvar,parcours1->var->v_nomvar)
1509               ) out = 1;
1510            else
1511            {
1512               parcours1 = parcours1->suiv;
1513            }
1514         }
1515         /* if we found the var common name in the old list                   */
1516         if ( out == 1 )
1517         {
1518            strcpy(parcours->var->v_commoninfile,
1519                   parcours1->var->v_commoninfile);
1520            Merge_Variables(parcours->var,parcours1->var);
1521         }
1522         else
1523         /* if we do not found the var common name in the old list            */
1524         {
1525    //     update_indicemaxtabvars(parcours->var,Listofavailableindices);
1526         update_indicemaxtabvars(parcours->var,Listofavailableindices_glob);
1527    //        if ( Listofavailableindices )
1528    //        {
1529    //           parcours->var->v_indicetabvars = Listofavailableindices ->
1530    //                                                                   i_indice;
1531    //           if ( Listofavailableindices->suiv )
1532    //                      Listofavailableindices = Listofavailableindices->suiv;
1533    //           else
1534    //                      Listofavailableindices = (listindice *)NULL;
1535    //        }
1536    //        else
1537    //        {
1538    //           indicemaxtabvars = indicemaxtabvars + 1 ;
1539    //           parcours->var->v_indicetabvars = indicemaxtabvars;
1540    //        }
1541         }
1542         /* Look in the remaining list in the variable is define              */
1543         UpdateTheRemainingList(parcours);
1544      }
1545      parcours = parcours->suiv;
1546   }
1547   /* if List_CommonUsed_Var is not empty, some var have been removed from    */
1548   /*    the last treatement                                                  */
1549  parcours1 = List_CommonUsed_Var;
1550  while ( parcours1 )
1551  {
1552     if ( parcours1 -> var -> v_indicetabvars == 0 )
1553     {
1554        newindice=(listindice *) calloc(1,sizeof(listindice));
1555        newindice -> i_indice = parcours1 -> var -> v_indicetabvars;
1556        newindice -> suiv = Listofavailableindices_glob[parcours1 -> var -> v_catvar];
1557        Listofavailableindices_glob[parcours1 -> var -> v_catvar] = newindice;
1558     }
1559     parcours1 = parcours1->suiv;
1560  }
1561}
1562
1563void update_indicemaxtabvars(variable *var,listindice **Listofindices)
1564{
1565            if ( Listofindices[var->v_catvar] )
1566            {
1567               var->v_indicetabvars = Listofindices[var->v_catvar] -> i_indice;
1568               if ( Listofindices[var->v_catvar]->suiv )
1569                          Listofindices[var->v_catvar] = Listofindices[var->v_catvar]->suiv;
1570               else
1571                          Listofindices[var->v_catvar] = (listindice *)NULL;
1572            }
1573            else
1574            {
1575               indicemaxtabvars[var->v_catvar] = indicemaxtabvars[var->v_catvar] + 1 ;
1576               var->v_indicetabvars = indicemaxtabvars[var->v_catvar];
1577            }
1578
1579}
1580
1581/******************************************************************************/
1582/*                     IndiceTabvars_Common_Var_No_Treated                    */
1583/******************************************************************************/
1584/*                                                                            */
1585/******************************************************************************/
1586void IndiceTabvars_Common_Var_No_Treated(char *nom)
1587{
1588   listvar *parcours;
1589   listvar *parcours2;
1590
1591   if ( todebug == 1 ) printf("COMMON No Treated %s \n",nom);
1592
1593   parcours = List_Common_Var;
1594   while( parcours )
1595   {
1596      if ( !strcasecmp(parcours->var->v_commonname,nom) &&
1597           strcasecmp(parcours->var->v_subroutinename,"") &&
1598           parcours->var->v_indicetabvars == 0
1599          )
1600      {
1601            /* The type may has not been given if the variable was only declared with dimension */
1602
1603            if ( !strcasecmp(parcours->var->v_typevar,"") )
1604            {
1605                  if ( IsVariableReal(parcours->var->v_nomvar) == 1 )
1606                                        strcpy(parcours->var->v_typevar,"REAL");
1607                  else strcpy(parcours->var->v_typevar,"INTEGER");
1608                  parcours->var->v_catvar = get_cat_var(parcours->var);
1609             }
1610             
1611         indicemaxtabvars[parcours->var->v_catvar] = indicemaxtabvars[parcours->var->v_catvar] + 1 ;
1612         parcours->var->v_indicetabvars = indicemaxtabvars[parcours->var->v_catvar];
1613         parcours2 = parcours;
1614         while ( parcours2 )
1615         {
1616            if ( !strcasecmp(parcours->var->v_nomvar,
1617                             parcours2->var->v_nomvar) &&
1618                 !strcasecmp(parcours->var->v_commonname,
1619                             parcours2->var->v_commonname)
1620               )
1621               parcours2->var->v_indicetabvars = parcours->var->v_indicetabvars;
1622            parcours2 = parcours2->suiv;
1623         }
1624      }
1625      parcours = parcours->suiv;
1626   }
1627}
1628
1629
1630/******************************************************************************/
1631/*                       IndiceTabvarsIdentification                          */
1632/******************************************************************************/
1633/*                                                                            */
1634/******************************************************************************/
1635void IndiceTabvarsIdentification()
1636{
1637   listnom *parcours_nom;
1638
1639   /* Identification of tabvars indices in List_Global_Var                    */
1640   parcours_nom = List_NameOfModule;
1641   while ( parcours_nom )
1642   {
1643      if ( is_dependfile_created(parcours_nom->o_nom) == 1 )
1644      {
1645         IndiceTabvars_Global_Var_Treated(parcours_nom->o_nom);
1646      }
1647      else
1648      {
1649         IndiceTabvars_Global_Var_No_Treated(parcours_nom->o_nom);
1650      }
1651      parcours_nom = parcours_nom -> suiv;
1652   }
1653   /* Identification of tabvars indices in List_Common_Var                    */
1654   parcours_nom = List_NameOfCommon;
1655   while ( parcours_nom )
1656   {
1657      if ( is_dependfile_created(parcours_nom->o_nom) == 1 )
1658      {
1659         IndiceTabvars_Common_Var_Treated(parcours_nom->o_nom);
1660      }
1661      else
1662      {
1663         IndiceTabvars_Common_Var_No_Treated(parcours_nom->o_nom);
1664      }
1665      parcours_nom = parcours_nom -> suiv;
1666   }
1667
1668}
1669
1670void New_Allocate_Subroutine_Is_Necessary()
1671{
1672   listnom *parcours_nom;
1673   listvar *parcours;
1674   int out;
1675
1676   parcours_nom = List_NameOfModule;
1677   while ( parcours_nom )
1678   {
1679      /*                                                                      */
1680      parcours = List_Global_Var;
1681      out = 0 ;
1682      while( parcours && out == 0 )
1683      {
1684         if ( !strcasecmp(parcours->var->v_modulename,parcours_nom->o_nom) &&
1685              !strcasecmp(parcours->var->v_subroutinename,"")            &&
1686              parcours->var->v_VariableIsParameter == 0                  &&
1687              ( parcours->var->v_allocatable == 0 || !strcasecmp(parcours->var->v_typevar,"type"))      &&
1688              parcours->var->v_notgrid == 0                              &&
1689              ( ( parcours->var->v_nbdim != 0 || !strcasecmp(parcours->var->v_typevar,"type") )
1690              || parcours->var->v_initialvalue )
1691            )
1692         {
1693            out = 1;
1694         }
1695         else parcours = parcours -> suiv;
1696      }
1697      if ( out )
1698      {
1699         parcours_nom->o_val = 1 ;
1700      }
1701      parcours_nom = parcours_nom -> suiv;
1702   }
1703}
1704
1705void New_Allocate_Subroutine_For_Common_Is_Necessary()
1706{
1707   listnom *parcours_nom;
1708   listvar *parcours;
1709   int out;
1710
1711   parcours_nom = List_NameOfCommon;
1712   while ( parcours_nom )
1713   {
1714      parcours = List_Common_Var;
1715      out = 0 ;
1716      while( parcours && out == 0 )
1717      {
1718         if ( !strcasecmp(parcours->var->v_commonname,parcours_nom->o_nom)  &&
1719              strcasecmp(parcours->var->v_subroutinename,"")                &&
1720              !strcasecmp(parcours->var->v_commoninfile,cur_filename)       &&
1721              ( ( parcours->var->v_nbdim != 0 || !strcasecmp(parcours->var->v_typevar,"type") )
1722              || parcours->var->v_initialvalue )
1723            )
1724         {
1725            out = 1;
1726         }
1727         else parcours = parcours -> suiv;
1728      }
1729      if ( out == 1 )
1730      {
1731         parcours_nom->o_val = 1 ;
1732      }
1733      parcours_nom = parcours_nom -> suiv;
1734   }
1735}
1736
1737void NewModule_Creation_0()
1738{
1739   listnom *parcours_nom;
1740
1741   parcours_nom = List_NameOfCommon;
1742   while ( parcours_nom )
1743   {
1744      if ( parcours_nom->o_val == 1 )
1745      {
1746         fprintf(fortran_out, "      module %s\n\n", parcours_nom->o_nom);
1747         WriteUsemoduleDeclaration(parcours_nom->o_subroutinename);
1748         fprintf(fortran_out, "        implicit none\n");
1749         fprintf(fortran_out, "        public :: Alloc_agrif_%s\n", parcours_nom->o_nom);
1750         fprintf(fortran_out, "      contains\n");
1751         fprintf(fortran_out, "      subroutine Alloc_agrif_%s(Agrif_Gr)\n", parcours_nom->o_nom);
1752         fprintf(fortran_out, "        use Agrif_Util\n");
1753         fprintf(fortran_out, "        type(Agrif_grid), pointer :: Agrif_Gr\n");
1754         fprintf(fortran_out, "        integer :: i\n");
1755         fprintf(fortran_out, "#include \"alloc_agrif_%s.h\"\n", parcours_nom->o_nom);
1756         fprintf(fortran_out, "      end subroutine Alloc_agrif_%s\n", parcours_nom->o_nom);
1757         fprintf(fortran_out, "      end module %s\n", parcours_nom->o_nom);
1758         /* List all Call Alloc_agrif                                      */
1759         Add_Subroutine_For_Alloc(parcours_nom->o_nom);
1760      }
1761      parcours_nom = parcours_nom->suiv;
1762   }
1763}
1764
1765void UpdateList_SubroutineWhereAgrifUsed()
1766{
1767   listnom *parcours;
1768   listusemodule *parcours1;
1769   listallocate *parcours2;
1770   listname *parcours3;
1771   listvar *parcours4;
1772   int out;
1773   char name_module[LONG_M];
1774
1775   /* We should integrate allocate and pointer variables                      */
1776//    parcours2 = List_Allocate_Var;
1777//    while ( parcours2 )
1778//    {
1779//       parcours4 = List_UsedInSubroutine_Var;
1780//       out = 0 ;
1781//       while ( parcours4 && out == 0 )
1782//       {
1783//          if ( !strcasecmp(parcours2->a_nomvar,parcours4->var->v_nomvar) )
1784//          {
1785//             Add_SubroutineWhereAgrifUsed_1(parcours4->var->v_subroutinename, parcours4->var->v_modulename);
1786//             out = 1;
1787//          }
1788//          else parcours4 = parcours4 -> suiv ;
1789//       }
1790//       parcours2 = parcours2->suiv;
1791//    }
1792//
1793//    parcours3 = List_Pointer_Var;
1794//    while ( parcours3 )
1795//    {
1796//       parcours4 = List_UsedInSubroutine_Var;
1797//       out = 0 ;
1798//       while ( parcours4 && out == 0 )
1799//       {
1800//          if ( !strcasecmp(parcours3->n_name, parcours4->var->v_nomvar) )
1801//          {
1802//             Add_SubroutineWhereAgrifUsed_1(parcours4->var->v_subroutinename, parcours4->var->v_modulename);
1803//             out = 1;
1804//          }
1805//          else parcours4 = parcours4 -> suiv ;
1806//       }
1807//       parcours3 = parcours3 -> suiv;
1808//    }
1809//    parcours4 = List_UsedInSubroutine_Var;
1810//    while ( parcours4 )
1811//    {
1812//       if ( parcours4->var->v_allocatable == 1 && strcasecmp(parcours4->var->v_typevar,"type"))
1813//       {
1814//          Add_SubroutineWhereAgrifUsed_1(parcours4->var->v_subroutinename, parcours4->var->v_modulename);
1815//       }
1816//       parcours4 = parcours4 -> suiv ;
1817//    }
1818
1819   parcours = List_SubroutineWhereAgrifUsed;
1820   while ( parcours )
1821   {
1822      parcours1 = List_NameOfModuleUsed;
1823      out = 0 ;
1824      strcpy(name_module,"");
1825      while ( parcours1 && out == 0 )
1826      {
1827         if ( !strcasecmp(parcours->o_nom,parcours1->u_cursubroutine) &&
1828              !strcasecmp(parcours1->u_usemodule,"Agrif_Util")
1829            ) out = 1;
1830         else
1831         {
1832            if ( !strcasecmp(parcours->o_nom,parcours1->u_cursubroutine) )
1833            {
1834               strcpy(name_module, parcours->o_module);
1835            }
1836            parcours1 = parcours1->suiv;
1837         }
1838      }
1839      if ( out == 0 )   /* we should look in the module declaration */
1840      {
1841         parcours1 = List_NameOfModuleUsed;
1842         out = 0 ;
1843         while ( parcours1 && out == 0 )
1844         {
1845            if ( !strcasecmp(name_module,parcours1->u_modulename) &&
1846                 !strcasecmp(parcours1->u_cursubroutine,"")&&
1847                 !strcasecmp(parcours1->u_usemodule,"Agrif_Util")
1848               ) out = 1;
1849            else parcours1 = parcours1->suiv;
1850         }
1851      }
1852      if ( out == 0 ) parcours->o_val = 1;
1853
1854      parcours = parcours->suiv;
1855   }
1856}
1857
1858
1859void UpdateList_UsedInSubroutine_With_dimension()
1860{
1861   listvar *parcours;
1862
1863   parcours = List_UsedInSubroutine_Var;
1864   while ( parcours )
1865   {
1866      if ( parcours->var->v_nbdim != 0 )
1867      {
1868         strcpy(subroutinename,parcours->var->v_subroutinename);
1869         DecomposeTheName(parcours->var->v_readedlistdimension);
1870         strcpy(subroutinename,"");
1871      }
1872      parcours = parcours -> suiv;
1873   }
1874}
1875
1876void Affiche(listvar *in_parcours)
1877{
1878/*   parcours = List_Global_Var;                  */
1879/*   parcours = List_SubroutineDeclaration_Var;   */
1880/*   parcours = List_SubroutineArgument_Var;      */
1881/*   parcours = List_FunctionType_Var;            */
1882/*   parcours = List_Data_Var;                    */
1883/*   parcours = List_Save_Var;                    */
1884/*   parcours = List_UsedInSubroutine_Var;        */
1885/*   parcours = List_Parameter_Var;               */
1886/*   parcours = List_GlobalParameter_Var;         */
1887/*   parcours = List_NotGridDepend_Var;           */
1888/*   parcours = List_Common_Var;                  */
1889   listvar *parcours = in_parcours;
1890
1891   while( parcours )
1892   {
1893      printf("modulename     - %s \n", parcours->var->v_modulename);
1894      printf("subroutinename - %s \n", parcours->var->v_subroutinename);
1895      printf("nomvar         - %s \n", parcours->var->v_nomvar);
1896      printf("commonname     - %s \n", parcours->var->v_commonname);
1897      printf("commoninfile   - %s \n", parcours->var->v_commoninfile);
1898      printf("typevar        - %s \n", parcours->var->v_typevar);
1899      printf("catvar         - %d \n", parcours->var->v_catvar);
1900      printf("indicetabvars  - %d \n", parcours->var->v_indicetabvars);
1901      printf("isparameter    - %d \n", parcours->var->v_VariableIsParameter);
1902      printf("module         - %d \n", parcours->var->v_module);
1903      printf("save           - %d \n", parcours->var->v_save);
1904      printf("notgrid        - %d \n", parcours->var->v_notgrid);
1905      printf("nbdim          - %d \n", parcours->var->v_nbdim);
1906      printf("common         - %d \n", parcours->var->v_common);
1907      printf("dimensiongiven - %d \n", parcours->var->v_dimensiongiven);
1908      printf("dimsempty      - %d \n", parcours->var->v_dimsempty);
1909      printf("initialvalue   - %s \n", parcours->var->v_initialvalue->n_name);
1910      printf("readedlistdim  - %s \n", parcours->var->v_readedlistdimension);
1911      printf("-------------------------------------\n");
1912
1913      parcours = parcours -> suiv ;
1914   }
1915   if ( todebug == 1 ) printf("Indicemaxtabvars = %d \n",indicemaxtabvars[0]);
1916}
1917
1918int SubInList_ContainsSubroutine()
1919{
1920   int out;
1921   listnom *parcours;
1922
1923   out = 0 ;
1924   parcours = List_ContainsSubroutine;
1925   while ( parcours && out == 0 )
1926   {
1927      if ( !strcasecmp(parcours->o_nom,subroutinename) ) out = 1 ;
1928      else parcours = parcours -> suiv;
1929   }
1930
1931   return out;
1932}
Note: See TracBrowser for help on using the repository browser.