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/UKMO/dev_r8600_nn_etau_options/NEMOGCM/EXTERNAL/AGRIF/LIB – NEMO

source: branches/UKMO/dev_r8600_nn_etau_options/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistvarindoloop.c @ 8875

Last change on this file since 8875 was 8875, checked in by davestorkey, 6 years ago

UKMO/dev_r8600_nn_etau_options branch: remove SVN keywords.

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