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

source: trunk/AGRIF/LIB/WorkWithlistvarindoloop.c @ 774

Last change on this file since 774 was 774, checked in by rblod, 16 years ago

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