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

source: NEMO/releases/CMIP5_IPSL/AGRIF/LIB/WorkWithlistvarindoloop.c @ 11998

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

Adapt Agrif to the new SBC and correct several bugs for agrif (restart writing and reading), see ticket #133
Note : this fix does not work yet on NEC computerq (sxf90/360)
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
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.