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_r12970_AGRIF_CMEMS/LIB – NEMO

source: vendors/AGRIF/dev_r12970_AGRIF_CMEMS/LIB/WorkWithlistvarindoloop.c @ 13027

Last change on this file since 13027 was 13027, checked in by rblod, 4 years ago

New AGRIF library, see ticket #2129

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