New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
WorkWithlistvarindoloop.c in branches/UKMO/dev_r5107_mld_zint/NEMOGCM/EXTERNAL/AGRIF/LIB – NEMO

source: branches/UKMO/dev_r5107_mld_zint/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistvarindoloop.c @ 5450

Last change on this file since 5450 was 5450, checked in by davestorkey, 9 years ago

Clear SVn keywords from UKMO/dev_r5107_mld_zint branch.

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