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

source: branches/nemo_v3_3_beta/NEMOGCM/EXTERNAL/AGRIF/LIB/WorkWithlistvarindoloop.c @ 2281

Last change on this file since 2281 was 2281, checked in by smasson, 14 years ago

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