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 branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/EXTERNAL/AGRIF/LIB – NEMO

source: branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistvarindoloop.c @ 4779

Last change on this file since 4779 was 4779, checked in by rblod, 10 years ago

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