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

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

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

Last change on this file since 396 was 396, checked in by opalod, 18 years ago

Initial revision
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 21.8 KB
RevLine 
[396]1/******************************************************************************/
2/*                                                                            */
3/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
4/*                                                                            */
5/*     Copyright (C) 2005 Laurent Debreu (Laurent.Debreu@imag.fr)             */
6/*                        Cyril Mazauric (Cyril.Mazauric@imag.fr)             */
7/*                                                                            */
8/*     This program is free software; you can redistribute it and/or modify   */
9/*    it                                                                      */
10/*                                                                            */
11/*    This program is distributed in the hope that it will be useful,         */
12/*     but WITHOUT ANY WARRANTY; without even the implied warranty of         */
13/*     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the          */
14/*    GNU General Public License for more details.                            */
15/*                                                                            */
16/******************************************************************************/
17#include <stdio.h>
18#include <stdlib.h>
19#include <string.h>
20
21#include "decl.h"
22
23/******************************************************************************/
24/*                    OPTI_1_cleanlistvarfordoloop                            */
25/******************************************************************************/
26/* Firstpass 1                                                                */
27/* We should clean all the list used for the do loop OPTImization             */
28/* if endsuborfunc = 1 we are at the end of the subroutine                    */
29/* if endsuborfunc = 0 we are at the end of the function                      */
30/******************************************************************************/
31/*                                                                            */
32/******************************************************************************/
33void OPTI_1_cleanlistvarfordoloop(int endsuborfunc)
34{
35   listvar *tmplist;
36   
37   if ( firstpass == 1 ) 
38   {
39      if ( fortran77 == 1 ) UpdatevarofsubroutinelisteWithcommonlist();
40      if ( fortran77 == 1 ) COM_1_UpdateparameterlistWithlistvarindoloop();
41      if ( fortran77 == 1 ) COM_1_UpdateGloblisteWithcommonlist();
42      if ( endsuborfunc == 1 ) CompleteThelistvarindoloop();
43      if ( fortran77 == 0 ) UpdateIndiceTabvarsofGlobliste();
44      else UpdateIndiceTabvarsofGloblisteFromCommon();
45      CleanThelistvarindoloop();
46      CleanFromThelistvarindoloopTheAgrifSubArguments();
47      tmplist = (listvar *)NULL;
48      if ( fortran77 == 1 ) tmplist = duplicatelistvar(varofsubroutineliste);
49      if ( fortran77 == 1 ) varsubroutine = AddListvarToListvar
50                                                      (tmplist,varsubroutine,1);
51      CleanThelistvarofsubroutineliste();
52      if ( fortran77 == 1 ) COM_1_UpdatevarsubroutineWithvarofsubroutinelist();
53   }
54}
55
56/******************************************************************************/
57/*                    OPTI_1_ajoutevarindoloop                                */
58/******************************************************************************/
59/* Firstpass 1                                                                */
60/* We should complete the listvarindoloop                                     */
61/******************************************************************************/
62/*                                                                            */
63/*                                                                            */
64/*                                                                            */
65/*                                                                            */
66/*                                                                            */
67/*                                                                            */
68/******************************************************************************/
69void OPTI_1_ajoutevarindoloop(char *ident)
70{
71   /* In the first pass we record all variables presents in the do loop       */
72   if (firstpass == 1 && insubroutinedeclare == 1 ) ajoutevarindoloop(ident);
73}
74
75/******************************************************************************/
76/*                        AJOUTEVARINDOLOOP                                   */
77/******************************************************************************/
78/* This subroutine is used to add a listvar to  listvarindoloop               */
79/******************************************************************************/
80void ajoutevarindoloop (char *name)
81{
82  listvar *newvar;
83  listvar *tmpvar;
84  int out;
85 
86  if ( !listvarindoloop )
87  {
88      newvar=(listvar *)malloc(sizeof(listvar));
89      newvar->var=(variable *)malloc(sizeof(variable));
90      newvar->suiv = NULL;
91      strcpy(newvar->var->oldname,"");
92      strcpy(newvar->var->nomvar,name);
93      strcpy(newvar->var->modulename,subroutinename);
94      newvar->var->pointedvar=pointedvar;
95      newvar->var->indicetabvars=0;
96      listvarindoloop = newvar ;
97  }
98  else
99  {
100      /* We should verify that this variable did not added                    */
101      tmpvar = listvarindoloop;
102      out = 0 ;
103      while (tmpvar && out == 0 )
104      {
105         if ( !strcasecmp(tmpvar->var->nomvar,name) && 
106              !strcasecmp(tmpvar->var->modulename,subroutinename)) out  = 1 ; 
107         else tmpvar = tmpvar->suiv;
108      }
109      if ( out == 0 ) 
110      {
111         newvar=(listvar *)malloc(sizeof(listvar));
112         newvar->var=(variable *)malloc(sizeof(variable));
113         strcpy(newvar->var->oldname,"");
114         strcpy(newvar->var->nomvar,name);
115         strcpy(newvar->var->modulename,subroutinename);
116         newvar->var->pointedvar=pointedvar;
117         newvar->var->indicetabvars=0;
118         newvar->suiv = listvarindoloop;
119         listvarindoloop = newvar;
120      }
121  }
122}
123
124/******************************************************************************/
125/*                        AJOUTEVARINDOLOOP_DEFINEDIMENSION                   */
126/******************************************************************************/
127/* This subroutine is used to add a listvar to  listvarindoloop               */
128/******************************************************************************/
129void ajoutevarindoloop_definedimension (char *name)
130{
131  listvar *newvar;
132  listvar *tmpvar;
133  listvar *tmpvarprec;
134  int out;
135  int tablemeet;
136 
137  if ( !listvarindoloop )
138  {
139      newvar=(listvar *)malloc(sizeof(listvar));
140      newvar->var=(variable *)malloc(sizeof(variable));
141      newvar->suiv = NULL;
142      strcpy(newvar->var->oldname,"");
143      strcpy(newvar->var->nomvar,name);
144      strcpy(newvar->var->modulename,subroutinename);
145      newvar->var->indicetabvars=0;
146      newvar->var->pointedvar=pointedvar;
147      listvarindoloop = newvar ;
148  }
149  else
150  {
151      /* We should verify that this variable did not added                    */
152      tmpvarprec = (listvar *)NULL;
153      tmpvar = listvarindoloop;
154      out = 0 ;
155      tablemeet = 0 ;
156      while (tmpvar && out == 0 )
157      {
158         if ( tablemeet == 0 && tmpvar->var->nbdim != 0 ) tablemeet = 1 ;
159         /*                                                                   */
160         if ( !strcasecmp(tmpvar->var->nomvar,name) && 
161              !strcasecmp(tmpvar->var->modulename,subroutinename)) 
162         {
163            out  = 1 ;
164            /* if this variable has been define before a table we doi nothing */
165            /*    else we should remove it                                    */
166            if ( tablemeet == 1 )
167            {
168               tmpvarprec->suiv = tmpvar -> suiv;
169               out = 2;
170            }
171         }
172         else 
173         {
174            tmpvarprec = tmpvar;
175            tmpvar = tmpvar->suiv;
176         }
177      }
178      if ( out == 2 || out == 0 ) 
179      {
180         newvar=(listvar *)malloc(sizeof(listvar));
181         newvar->var=(variable *)malloc(sizeof(variable));
182         strcpy(newvar->var->nomvar,name);
183         strcpy(newvar->var->oldname,"");
184         newvar->var->indicetabvars=0;
185         strcpy(newvar->var->modulename,subroutinename);
186         newvar->var->pointedvar=pointedvar;
187         /* we should find this new variable to know the tabvars indice       */
188         if ( variableisglobal(newvar, globliste) == 1 )
189         {
190            newvar->suiv = listvarindoloop;
191            listvarindoloop = newvar;
192         }
193         else if ( variableisglobal(newvar, globalvarofusefile) == 1 )
194         {
195            newvar->suiv = listvarindoloop;
196            listvarindoloop = newvar;
197         }
198         else
199         {
200            free(newvar);
201         }
202     }
203  }
204}
205
206/******************************************************************************/
207/*        CleanFromThelistvarindoloopTheAgrifSubArguments                     */
208/******************************************************************************/
209/* This subroutine is to remove from the listvarindoloop all variables        */
210/* which has been used in Agrif argument in order to avoid the                */
211/* optimization code on Agrif function or subroutines                         */
212/******************************************************************************/
213void  CleanFromThelistvarindoloopTheAgrifSubArguments()
214{
215   listnom *parcours;
216   listvar *parcoursvar;
217   listvar *parcoursvarprec;
218   
219   parcoursvarprec = (listvar *)NULL;
220   parcoursvar = listvarindoloop;
221   while ( parcoursvar )
222   {
223      if ( !strcasecmp(parcoursvar->var->modulename,subroutinename) )
224      {
225         parcours = Listofvariableinagriffunction;
226         while (parcours && strcasecmp(parcoursvar->var->nomvar,parcours->nom) )
227         {
228            parcours = parcours->suiv;
229         }
230         if ( parcours )
231         {
232            /* if we found the name in the listvarindoloop and                */
233            /* Listofvariableinagriffunction we should remove it from         */
234            /* listvarindoloop                                                */
235            if ( parcoursvar == listvarindoloop )
236            {
237               listvarindoloop = listvarindoloop -> suiv;
238               parcoursvar = listvarindoloop;
239            }
240            else
241            {
242               parcoursvarprec->suiv = parcoursvar->suiv;
243               parcoursvar = parcoursvar->suiv;
244            }
245         }
246         else
247         {
248            parcoursvarprec = parcoursvar;
249            parcoursvar = parcoursvar ->suiv;
250         }
251      }
252      else
253      {
254         parcoursvarprec = parcoursvar;
255         parcoursvar = parcoursvar ->suiv;
256      }
257   }
258   
259}
260
261
262/******************************************************************************/
263/*                      CleanThelistvarindoloop                               */
264/******************************************************************************/
265/* This subroutine is to remove from the listvarindoloop all variables        */
266/* which has not been declared as table in the globliste                      */
267/******************************************************************************/
268void CleanThelistvarindoloop ()
269{
270  listvar *newvar;
271  listvar *newvarPrec;
272  listvar *tmpglobvar;
273  listallocate *parcoursallocate;
274  listnamelist *newnamelist;
275  int not_remove;
276
277  RecordUseModulesVariables();
278  RecordUseModulesUseModulesVariables();
279  /*                                                                          */
280  not_remove = 0 ;
281  newvarPrec = (listvar *)NULL;
282  newvar = listvarindoloop;
283  while ( newvar )
284  {
285  if ( !strcasecmp(newvar->var->modulename,subroutinename))
286  {
287     not_remove = 0;
288     if ( Variableshouldberemove(newvar->var->nomvar) == 0 )
289     {
290/******************************************************************************/
291/*                      look in the globliste                                 */
292/******************************************************************************/
293/******************************************************************************/
294/*                      look in the varofsubroutineliste                      */
295/******************************************************************************/
296        tmpglobvar = varofsubroutineliste;
297        while ( tmpglobvar && not_remove == 0 )
298        {
299           if ( !strcasecmp(tmpglobvar->var->nomvar,newvar->var->nomvar) &&
300                !strcasecmp
301                   (tmpglobvar->var->modulename,newvar->var->modulename)
302              )
303               not_remove = 2;
304          else tmpglobvar = tmpglobvar->suiv;
305       }
306
307     if (not_remove == 0 ) tmpglobvar = globliste;
308     else tmpglobvar = (listvar *)NULL;
309
310     while ( tmpglobvar && not_remove == 0 )
311     {
312        if ( !strcasecmp(tmpglobvar->var->nomvar,newvar->var->nomvar) )
313        {
314           not_remove = 1;
315           /* Now we should give the definition of the variable in the        */
316           /*    table listvarindoloop                                        */
317           strcpy(newvar->var->typevar,tmpglobvar->var->typevar);
318           strcpy(newvar->var->dimchar,tmpglobvar->var->dimchar);
319           newvar->var->nbdim = tmpglobvar->var->nbdim;
320           newvar->var->dimensiongiven = tmpglobvar->var->dimensiongiven;
321           newvar->var->typegiven = tmpglobvar->var->typegiven;
322           newvar->var->allocatable = tmpglobvar->var->allocatable;
323           newvar->var->pointerdeclare = tmpglobvar->var->pointerdeclare;
324           newvar->var->indicetabvars = tmpglobvar->var->indicetabvars;
325           strcpy(newvar->var->precision,tmpglobvar->var->precision);
326           strcpy(newvar->var->readedlistdimension,
327                                          tmpglobvar->var->readedlistdimension);
328           DecomposeTheName(newvar->var->readedlistdimension);
329        }
330        else tmpglobvar = tmpglobvar->suiv;
331     }
332     
333/******************************************************************************/
334/*                      look in the globparam                                 */
335/******************************************************************************/
336     if ( not_remove == 0 )
337     {
338        tmpglobvar = globparam;
339        while ( tmpglobvar && not_remove == 0 )
340        {
341           if ( !strcasecmp(tmpglobvar->var->nomvar,newvar->var->nomvar) &&
342                !strcasecmp(tmpglobvar->var->subroutinename,
343                                                newvar->var->modulename) 
344               ) not_remove = 2;
345           else tmpglobvar = tmpglobvar->suiv;
346        }
347     }
348     
349     if ( not_remove == 0 )
350     {
351/******************************************************************************/
352/*                      look in the listenamelist                             */
353/******************************************************************************/
354        newnamelist = listenamelist;
355        while ( newnamelist && not_remove == 0 )
356        {
357           if ( !strcasecmp(newnamelist->name,newvar->var->nomvar)) not_remove = 2;
358           else newnamelist = newnamelist->suiv;
359        }
360     }
361
362     if ( not_remove == 0 )
363     {
364/******************************************************************************/
365/*                      look in the varofsubroutineliste                      */
366/******************************************************************************/
367        tmpglobvar = varofsubroutineliste;
368        while ( tmpglobvar && not_remove == 0 )
369        {
370           if ( !strcasecmp(tmpglobvar->var->nomvar,newvar->var->nomvar) &&
371                !strcasecmp(tmpglobvar->var->modulename,
372                                                newvar->var->modulename)
373              ) not_remove = 2;
374          else tmpglobvar = tmpglobvar->suiv;
375       }
376     }
377/******************************************************************************/
378/*            look in the .dependfile and .dependparameterfile                */
379/******************************************************************************/
380     if ( not_remove == 0 && not_remove == 0 )
381     {
382        /* la liste des use de cette subroutine                               */
383        not_remove = 0 ;
384
385        if ( variableisparameterglobal(newvar,tmpparameterlocallist) == 1 )
386        {
387           not_remove = 2 ;
388        }
389        else if ( variableisglobal(newvar,globalvarofusefile) == 1 )
390        {
391           not_remove = 1 ;
392           DecomposeTheName(newvar->var->readedlistdimension);
393        }
394
395/******************************************************************************/
396/*    look in the .dependfile and .dependparameterfile of USE modules         */
397/******************************************************************************/
398        if ( not_remove == 0 )
399        {
400           if ( variableisparameterglobal(newvar,tmpparameterlocallist2) == 1 )
401           {
402              not_remove = 2 ;
403           }
404           else if ( variableisglobal(newvar, globalvarofusefile2) == 1 )
405           {
406              not_remove = 1 ;
407              DecomposeTheName(newvar->var->readedlistdimension);
408           }
409        }
410     }
411/******************************************************************************/
412/*                          look if pointer variable                          */
413/******************************************************************************/
414     /* if this variable is a pointer we should remove it                     */
415     if ( not_remove == 1 && newvar->var->pointerdeclare == 1 )
416     {
417        not_remove = 2;
418     }
419     /* if this variable is an allocatable var we should remove it            */
420     if ( not_remove == 1 && newvar->var->allocatable == 1 )
421     {
422        not_remove = 2;
423     }
424/******************************************************************************/
425/*                          look in the AllocateList                          */
426/******************************************************************************/
427     /* if this variable has been used in a allocate we should remove it      */
428     if ( not_remove == 1 && newvar->var->nbdim != 0 )
429     {
430        parcoursallocate = AllocateList;
431        while ( parcoursallocate && not_remove == 1 )
432        {
433           if ( !strcasecmp(parcoursallocate->nomvar,newvar->var->nomvar) &&
434                !strcasecmp(parcoursallocate->subroutine,subroutinename)
435           ) not_remove = 2;
436           else parcoursallocate = parcoursallocate->suiv;
437        }
438     }
439     /*                                                                       */
440     } /* end of strcasecmp(newvar->var->nomvar,"") */
441     else
442     {
443        not_remove = 2;
444     }
445/******************************************************************************/
446/*                          REMOVE                                            */
447/******************************************************************************/
448     if ( (   not_remove == 0 || not_remove == 2 ) && 
449              newvar->var->pointedvar == 0 
450        )
451     {
452        if ( newvar == listvarindoloop )
453        {
454           listvarindoloop = listvarindoloop->suiv;
455           newvar = listvarindoloop;
456        }
457        else
458        {
459           newvarPrec->suiv = newvar->suiv;
460           newvar = newvarPrec->suiv;
461        }
462     }
463     else
464     {       
465        /*                                                                    */
466        newvarPrec = newvar;
467        newvar = newvar->suiv ;
468     }
469  }
470  else
471  {
472     newvarPrec = newvar;
473     newvar = newvar->suiv;
474  }
475  }
476}
477
478
479/******************************************************************************/
480/*                        ModifyThelistvarindoloop                            */
481/******************************************************************************/
482/* This subroutine is to give the old name to the which has been              */
483/* declared as USE MOD, U => V in this case we should replace in the          */
484/* name V by the old name U in the listvarindoloop                            */
485/******************************************************************************/
486void  ModifyThelistvarindoloop()
487{
488  listvar *newvar;
489     
490  newvar = listvarindoloop;
491  while ( newvar )
492  {
493     if ( strcasecmp(newvar->var->oldname,"") )
494     {
495        strcpy(newvar->var->nomvar,newvar->var->oldname);
496     }
497     newvar = newvar->suiv;
498  }
499}
500
501/******************************************************************************/
502/*                          CompleteThelistvarindoloop                        */
503/******************************************************************************/
504/* This subroutine is to add to the listvarindoloop all variables which       */
505/* has been declared as USE MOD, U => V in this case we should replace        */
506/* in the listvarindoloop the word U by the word V                            */
507/******************************************************************************/
508void  CompleteThelistvarindoloop()
509{
510  listvar *newvar;
511  listvarpointtovar *pointtmplist;
512  listcouple *coupletmp;
513  int outvar;
514     
515  pointtmplist = Listofvarpointtovar;
516 
517  while ( pointtmplist )
518  {
519      coupletmp = pointtmplist->couple;
520      while ( coupletmp )
521      {
522         newvar = listvarindoloop;
523         outvar = 0 ;
524         while ( newvar && outvar == 0)
525         {
526           /* we should find the same variable name in the same subroutine    */
527           if ( !strcasecmp(newvar->var->nomvar,coupletmp->namevar) &&
528                !strcasecmp(newvar->var->modulename,
529                                       pointtmplist->cursubroutine) &&
530                 strcasecmp(coupletmp->namepointedvar,"") 
531              )
532           {
533              outvar = 1;
534              strcpy(newvar->var->oldname,newvar->var->nomvar);
535              strcpy(newvar->var->nomvar,coupletmp->namepointedvar);
536           }
537           else
538           {     
539              newvar = newvar->suiv;
540           }
541         }
542         coupletmp = coupletmp->suiv;     
543     }
544     pointtmplist = pointtmplist->suiv;
545  }
546}
Note: See TracBrowser for help on using the repository browser.