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

source: branches/dev_001_GM/AGRIF/LIB/WorkWithlistvarindoloop.c @ 2793

Last change on this file since 2793 was 663, checked in by opalod, 17 years ago

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