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.
UtilFortran.c in branches/UKMO/smagorinsky_diagnostics/NEMOGCM/EXTERNAL/AGRIF/LIB – NEMO

source: branches/UKMO/smagorinsky_diagnostics/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilFortran.c @ 5699

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

Remove SVN keyword updating from UKMO/smagorinsky_diagnostics branch.

File size: 26.3 KB
Line 
1/******************************************************************************/
2/*                                                                            */
3/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
4/*                                                                            */
5/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
6/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
7/* This software is governed by the CeCILL-C license under French law and     */
8/* abiding by the rules of distribution of free software.  You can  use,      */
9/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
10/* license as circulated by CEA, CNRS and INRIA at the following URL          */
11/* "http://www.cecill.info".                                                  */
12/*                                                                            */
13/* As a counterpart to the access to the source code and  rights to copy,     */
14/* modify and redistribute granted by the license, users are provided only    */
15/* with a limited warranty  and the software's author,  the holder of the     */
16/* economic rights,  and the successive licensors  have only  limited         */
17/* liability.                                                                 */
18/*                                                                            */
19/* In this respect, the user's attention is drawn to the risks associated     */
20/* with loading,  using,  modifying and/or developing or reproducing the      */
21/* software by the user in light of its specific status of free software,     */
22/* that may mean  that it is complicated to manipulate,  and  that  also      */
23/* therefore means  that it is reserved for developers  and  experienced      */
24/* professionals having in-depth computer knowledge. Users are therefore      */
25/* encouraged to load and test the software's suitability as regards their    */
26/* requirements in conditions enabling the security of their systems and/or   */
27/* data to be ensured and,  more generally, to use and operate it in the      */
28/* same conditions as regards security.                                       */
29/*                                                                            */
30/* The fact that you are presently reading this means that you have had       */
31/* knowledge of the CeCILL-C license and that you accept its terms.           */
32/******************************************************************************/
33/* version 1.7                                                                */
34/******************************************************************************/
35#include <stdio.h>
36#include <stdlib.h>
37#include <string.h>
38#include "decl.h"
39
40/******************************************************************************/
41/*                            initdimprob                                     */
42/******************************************************************************/
43/* This subroutine is used to initialized grid dimension variable             */
44/******************************************************************************/
45/*                                                                            */
46/*                                                                            */
47/*                                                                            */
48/******************************************************************************/
49void initdimprob(int dimprobmod, char * nx, char * ny,char* nz)
50{
51  dimprob = dimprobmod;
52
53  strcpy(nbmaillesX,nx);
54  strcpy(nbmaillesY,ny);
55  strcpy(nbmaillesZ,nz);
56}
57
58/******************************************************************************/
59/*                      Variableshouldberemove                                */
60/******************************************************************************/
61/* Firstpass 0                                                                */
62/******************************************************************************/
63/*                                                                            */
64/*               Agrif_<toto>(variable) ====>     Agrif_<toto>(variable)      */
65/*                                                                            */
66/******************************************************************************/
67int Variableshouldberemove(char *nom)
68{
69
70   int remove;
71
72   remove = 0 ;
73
74   if ( remove == 0 && Agrif_in_Tok_NAME(nom) == 1 ) remove = 1 ;
75
76   return remove;
77}
78
79/******************************************************************************/
80/*                          variableisglobal                                  */
81/******************************************************************************/
82/* This subroutine is to know if a variable is global                         */
83/******************************************************************************/
84int variableisglobal(listvar *curvar, listvar *listin)
85{
86  int Globalite;
87  listvar *newvar;
88
89
90  Globalite = 0;
91  newvar = listin;
92  while ( newvar && Globalite == 0 )
93  {
94     if ( !strcasecmp(newvar->var->v_nomvar,curvar->var->v_nomvar) )
95     {
96        Globalite = 1;
97        /* Now we should give the definition of the variable in the           */
98        /* table List_UsedInSubroutine_Var                                    */
99        printf("QDKFLSDFKSLDF\n");
100        strcpy(curvar->var->v_typevar,newvar->var->v_typevar);
101        strcpy(curvar->var->v_dimchar,newvar->var->v_dimchar);
102        curvar->var->v_nbdim = newvar->var->v_nbdim;
103        curvar->var->v_dimensiongiven = newvar->var->v_dimensiongiven;
104        curvar->var->v_allocatable = newvar->var->v_allocatable;
105        curvar->var->v_target = newvar->var->v_target;
106        curvar->var->v_pointerdeclare = newvar->var->v_pointerdeclare;
107        curvar->var->v_indicetabvars = newvar->var->v_indicetabvars;
108        strcpy(curvar->var->v_nameinttypename,newvar->var->v_nameinttypename);
109        strcpy(curvar->var->v_precision,newvar->var->v_precision);
110        strcpy(curvar->var->v_readedlistdimension,
111                                            newvar->var->v_readedlistdimension);
112        strcpy(curvar->var->v_commoninfile,newvar->var->v_commoninfile);
113     }
114     else
115     {
116         newvar = newvar->suiv;
117     }
118  }
119
120  return Globalite ;
121}
122
123int VariableIsInListCommon(listvar *curvar,listvar *listin)
124{
125  int present;
126  listvar *newvar;
127
128  present = 0;
129  newvar = listin;
130  while ( newvar && present == 0 )
131  {
132     if ( !strcasecmp(newvar->var->v_nomvar,curvar->var->v_nomvar) &&
133          !strcasecmp(newvar->var->v_subroutinename,
134                                    curvar->var->v_subroutinename)
135        )
136     {
137        strcpy(curvar->var->v_commoninfile,newvar->var->v_commoninfile);
138        CopyRecord(curvar->var,newvar->var);
139        present = 1;
140     }
141     else newvar = newvar->suiv;
142  }
143
144  return present;
145}
146
147int VariableIsInList(listvar *curvar,listvar *listin)
148{
149  int present;
150  listvar *newvar;
151
152  present = 0;
153  newvar = listin;
154  while ( newvar && present == 0 )
155  {
156     if ( !strcasecmp(newvar->var->v_nomvar,curvar->var->v_nomvar) )
157     {
158        CopyRecord(curvar->var,newvar->var);
159        present = 1;
160     }
161     else newvar = newvar->suiv;
162  }
163
164  return present;
165}
166
167/******************************************************************************/
168/*                      variableisglobalinmodule                              */
169/******************************************************************************/
170/* This subroutine is to know if a variable is global                         */
171/******************************************************************************/
172void variableisglobalinmodule(listcouple *listin, char *module, FILE *fileout, long int oldposcuruse)
173{
174  int Globalite;
175  listcouple *newvar;
176  listcouple *newvarprec;
177  listvar *tempo;
178  listvar *newvar2;
179  int out;
180  char truename[LONG_C]; 
181
182  Globalite = 1;
183  newvarprec = (listcouple *)NULL;
184  tempo = (listvar *)NULL;
185  tempo = Readthedependfile(module,tempo);
186  newvar = listin;
187
188  while ( newvar )
189  {
190     if (!strcmp(newvar->c_namepointedvar,"")) {
191       strcpy(truename,newvar->c_namevar);
192     }
193     else
194     {
195       strcpy(truename,newvar->c_namepointedvar);
196     }
197     
198     out = 0;
199     newvar2 = tempo;
200     while ( newvar2 && out == 0 )
201     {
202        if ( !strcasecmp(newvar2->var->v_nomvar,truename) ) out = 1;
203        else newvar2 = newvar2 ->suiv;
204     }
205     if ( out == 1 )
206     {
207        /* remove from the listin                                             */
208        if ( newvar == listin )
209        {
210           listin = listin->suiv;
211           newvar = listin;
212        }
213        else
214        {
215           newvarprec->suiv = newvar->suiv;
216           newvar = newvar->suiv;
217        }
218     }
219     else
220     {
221         newvarprec = newvar;
222         newvar = newvar->suiv;
223         Globalite = 0;
224     }
225  }
226  if ( Globalite == 0 || !newvar)
227  {
228     pos_end = setposcurname(fileout);
229     RemoveWordSET_0(fileout,oldposcuruse,
230                                pos_end-oldposcuruse);
231                                 
232     newvar = listin;
233     while ( newvar )
234     {
235        fprintf(fileout,"      USE %s, ONLY : %s \n",module,newvar->c_namevar);
236        newvar = newvar->suiv;
237     }
238  }
239}
240
241
242void Remove_Word_Contains_0()
243{
244   if ( firstpass == 0 )
245   {
246      RemoveWordCUR_0(fortranout,(long)(-9),9);
247   }
248}
249
250void Remove_Word_end_module_0(int modulenamelength)
251{
252   if ( firstpass == 0 )
253   {
254      RemoveWordCUR_0(fortranout,(long)(-modulenamelength-12),
255                                         modulenamelength+11);
256   }
257}
258
259void Write_Word_Contains_0()
260{
261   if ( firstpass == 0 )
262   {
263      fprintf(fortranout,"\n      contains\n");
264   }
265}
266
267
268void Write_Word_end_module_0()
269{
270   if ( firstpass == 0 )
271   {
272      fprintf(fortranout,"\n      end module %s",curmodulename);
273   }
274}
275
276void Add_Subroutine_For_Alloc(char *nom)
277{
278   listnom *parcours;
279   listnom *newvar;
280   int out;
281
282   newvar = (listnom *)malloc(sizeof(listnom));
283   strcpy(newvar->o_nom,nom);
284   Save_Length(nom,23);
285   newvar->suiv = NULL;
286
287   if ( !List_Subroutine_For_Alloc )
288   {
289      List_Subroutine_For_Alloc = newvar;
290   }
291   else
292   {
293      parcours = List_Subroutine_For_Alloc;
294      out = 0 ;
295      while ( parcours->suiv && out == 0 )
296      {
297         if ( !strcasecmp(parcours->o_nom,nom) ) out = 1 ;
298         else parcours = parcours ->suiv;
299      }
300      /*                                                                      */
301      if ( out == 0 )
302      {
303         if ( strcasecmp(parcours->o_nom,nom) ) parcours->suiv = newvar;
304      }
305   }
306}
307
308
309void Write_Alloc_Subroutine_0()
310{
311   listnom *parcours_nom;
312   listnom *parcours_nomprec;
313   int out;
314   char ligne[LONG_C];
315
316   if ( firstpass == 0 )
317   {
318      parcours_nomprec = (listnom *)NULL;
319      parcours_nom = List_NameOfModule;
320      out = 0 ;
321      while ( parcours_nom && out == 0 )
322      {
323         /*                                                                   */
324         if ( !strcasecmp(curmodulename,parcours_nom->o_nom) ) out = 1;
325         else parcours_nom = parcours_nom -> suiv;
326      }
327      if ( out == 1 )
328      {
329         if ( parcours_nom->o_val == 1 )
330         {
331            strcpy (ligne, "\n      PUBLIC Alloc_agrif_");
332            strcat (ligne, curmodulename);
333            strcat (ligne, "\n");
334            convert2lower(ligne);
335            fprintf(fortranout,ligne);
336         }
337      }
338      Write_Word_Contains_0();
339      if ( out == 1 )
340      {
341         if ( parcours_nom->o_val == 1 )
342         {
343            sprintf (ligne, "Subroutine Alloc_agrif_%s(Agrif_Gr)",
344                                                                 curmodulename);
345            tofich(fortranout,ligne,1);
346            strcpy(ligne,"Use Agrif_Util");
347            tofich(fortranout,ligne,1);
348            strcpy (ligne, "Type(Agrif_grid), Pointer :: Agrif_Gr");
349            tofich(fortranout,ligne,1);
350            strcpy(ligne, "INTEGER :: i");
351            tofich (fortranout, ligne,1);
352            strcpy (ligne, "\n#include \"alloc_agrif_");
353            strcat (ligne, curmodulename);
354            strcat (ligne, ".h\"\n");
355            convert2lower(ligne);
356            fprintf(fortranout,ligne);
357            strcpy (ligne, "Return");
358            tofich(fortranout,ligne,1);
359            sprintf (ligne, "End Subroutine Alloc_agrif_%s",curmodulename);
360            tofich(fortranout,ligne,1);
361            /* List all Call Alloc_agrif_                                     */
362            Add_Subroutine_For_Alloc(curmodulename);
363         }
364         else
365         {
366            parcours_nom = List_Subroutine_For_Alloc;
367            out = 0;
368            while ( parcours_nom && out == 0 )
369            {
370               if ( !strcasecmp(parcours_nom->o_nom,curmodulename) ) out = 1;
371               else
372               {
373                  parcours_nomprec = parcours_nom;
374                  parcours_nom = parcours_nom->suiv;
375               }
376            }
377            if ( out == 1 )
378            {
379               if ( parcours_nom == List_Subroutine_For_Alloc)
380               {
381                  List_Subroutine_For_Alloc = List_Subroutine_For_Alloc->suiv;
382               }
383               else
384               {
385                  parcours_nomprec->suiv = parcours_nom->suiv;
386                  parcours_nom = parcours_nomprec->suiv ;
387               }
388            }
389         }
390      }
391   }
392}
393
394
395void Write_Alloc_Subroutine_For_End_0()
396{
397   listnom *parcours_nom;
398   listnom *parcours_nomprec;
399   int out;
400   char ligne[LONG_C];
401
402   if ( firstpass == 0 )
403   {
404      parcours_nomprec = (listnom *)NULL;
405      parcours_nom = List_NameOfModule;
406      out = 0 ;
407      while ( parcours_nom && out == 0 )
408      {
409         /*                                                                   */
410         if ( !strcasecmp(curmodulename,parcours_nom->o_nom) ) out = 1;
411         else parcours_nom = parcours_nom -> suiv;
412      }
413      if ( out == 1 )
414      {
415         if ( parcours_nom->o_val == 1 )
416         {
417            strcpy (ligne, "\n      PUBLIC Alloc_agrif_");
418            strcat (ligne, curmodulename);
419            strcat (ligne, "\n");
420            convert2lower(ligne);
421            fprintf(fortranout,ligne);
422            strcpy (ligne, "\n      contains\n");
423            fprintf(fortranout,ligne);
424            sprintf (ligne, "Subroutine Alloc_agrif_%s(Agrif_Gr)",
425                                                                 curmodulename);
426            tofich(fortranout,ligne,1);
427            strcpy(ligne,"Use Agrif_Util");
428            tofich(fortranout,ligne,1);
429            strcpy (ligne, "Type(Agrif_grid), Pointer :: Agrif_Gr");
430            tofich(fortranout,ligne,1);
431            strcpy(ligne, "INTEGER :: i");
432            tofich (fortranout, ligne,1);
433            strcpy (ligne, "\n#include \"alloc_agrif_");
434            strcat (ligne, curmodulename);
435            strcat (ligne, ".h\"\n");
436            convert2lower(ligne);
437            fprintf(fortranout,ligne);
438            strcpy (ligne, "Return");
439            tofich(fortranout,ligne,1);
440            sprintf (ligne, "End Subroutine Alloc_agrif_%s",curmodulename);
441            tofich(fortranout,ligne,1);
442            /* List all Call Alloc_agrif                                      */
443            Add_Subroutine_For_Alloc(parcours_nom->o_nom);
444         }
445         else
446         {
447            parcours_nom = List_Subroutine_For_Alloc;
448            out = 0;
449            while ( parcours_nom && out == 0 )
450            {
451               if ( !strcasecmp(parcours_nom->o_nom,curmodulename) ) out = 1;
452               else
453               {
454                  parcours_nomprec = parcours_nom;
455                  parcours_nom = parcours_nom->suiv;
456               }
457            }
458            if ( out == 1 )
459            {
460               if ( parcours_nom == List_Subroutine_For_Alloc)
461               {
462                  List_Subroutine_For_Alloc = List_Subroutine_For_Alloc->suiv;
463               }
464               else
465               {
466                  parcours_nomprec->suiv = parcours_nom->suiv;
467                  parcours_nom = parcours_nomprec->suiv ;
468               }
469            }
470         }
471      }
472   }
473}
474
475void Write_GlobalParameter_Declaration_0()
476{
477   listvar *parcours;
478
479   if ( firstpass == 0 )
480   {
481      parcours = List_GlobalParameter_Var;
482      while( parcours )
483      {
484         if ( !strcasecmp(parcours->var->v_modulename,curmodulename) )
485         {
486            writevardeclaration(parcours,module_declar,0,1);
487         }
488         parcours = parcours -> suiv;
489      }
490   }
491}
492
493void Write_GlobalType_Declaration_0()
494{
495   listvar *parcours;
496   int out = 0;
497   int headtypewritten = 0;
498   char ligne[LONGNOM];
499   int changeval;
500
501   if ( firstpass == 0 )
502   {
503      parcours = List_Global_Var;
504      while( parcours )
505      {
506         if ( !strcasecmp(parcours->var->v_modulename,curmodulename) )
507         {
508           if (!strcasecmp(parcours->var->v_typevar,"type"))
509           {
510            out = 1;
511            if (headtypewritten == 0)
512              {
513/*RB*/
514                sprintf (ligne, "Module_DeclarType_%s.h",curmodulename);
515                module_declar_type = associate(ligne);
516                sprintf (ligne, " ");
517                tofich (module_declar_type, ligne,1);
518                sprintf(ligne,"TYPE :: Agrif_%s",curmodulename);
519                tofich(module_declar_type,ligne,1);
520                headtypewritten = 1;
521/*RBend*/
522              }
523            changeval = 0;
524            if (parcours->var->v_allocatable == 1)
525             {
526               changeval = 1;
527               parcours->var->v_allocatable = 0;
528               parcours->var->v_pointerdeclare = 1;
529             }
530/*RB*/
531            writevardeclaration(parcours,module_declar_type,0,0);
532/*RBend*/
533            if (changeval == 1)
534              {
535               parcours->var->v_allocatable = 1;
536               parcours->var->v_pointerdeclare = 0;
537              }
538            }
539         }
540         parcours = parcours -> suiv;
541      }
542      if (out == 1)
543        {
544/*RB*/
545                sprintf(ligne,"END TYPE Agrif_%s",curmodulename);
546                tofich(module_declar_type,ligne,1);
547                sprintf(ligne,"TYPE(Agrif_%s), DIMENSION(:), ALLOCATABLE :: Agrif_%s_var",curmodulename,curmodulename); 
548                tofich(module_declar_type,ligne,1);
549                sprintf(ligne,"PUBLIC :: Agrif_%s",curmodulename); 
550                tofich(module_declar_type,ligne,1);
551                sprintf(ligne,"PUBLIC :: Agrif_%s_var",curmodulename); 
552                tofich(module_declar_type,ligne,1);
553/*RBend*/
554        }
555   }
556}
557
558void Write_NotGridDepend_Declaration_0()
559{
560   listvar *parcours;
561
562   if ( firstpass == 0 )
563   {
564      parcours = List_NotGridDepend_Var;
565      while( parcours )
566      {
567         if ( !strcasecmp(parcours->var->v_modulename,curmodulename) )
568         {
569            writevardeclaration(parcours,fortranout,0,1);
570         }
571         parcours = parcours -> suiv;
572      }
573   }
574}
575
576/******************************************************************************/
577/*                          IsTabvarsUseInArgument_0                          */
578/******************************************************************************/
579/* Firstpass 1                                                                */
580/******************************************************************************/
581/*                                                                            */
582/******************************************************************************/
583int IsTabvarsUseInArgument_0()
584{
585   int out;
586   int doloopout;
587   listvar *parcours;
588
589   out=1;
590
591   if ( List_UsedInSubroutine_Var )
592   {
593      doloopout = 0;
594      parcours = List_UsedInSubroutine_Var;
595      while ( parcours && doloopout == 0 )
596      {
597         if ( !strcasecmp(parcours->var->v_subroutinename,subroutinename) )
598                                                                  doloopout = 1;
599         else parcours = parcours->suiv;
600      }
601      if (  doloopout == 0 ) out = 0;
602      else out = 1 ;
603   }
604   else out = 0;
605
606   return out;
607}
608
609
610/******************************************************************************/
611/*                        ImplicitNoneInSubroutine                            */
612/******************************************************************************/
613/* Firstpass 0                                                                */
614/******************************************************************************/
615/*                                                                            */
616/******************************************************************************/
617int ImplicitNoneInSubroutine()
618{
619  listname *parcours;
620  int out;
621
622  parcours= List_ImplicitNoneSubroutine;
623  out = 0 ;
624  while ( parcours && out == 0 )
625  {
626     if ( !strcasecmp(parcours->n_name,subroutinename) ) out = 1;
627     else parcours = parcours->suiv;
628  }
629  return out;
630}
631
632/******************************************************************************/
633/*                            Add_Pointer_Var_From_List_1                     */
634/******************************************************************************/
635/* Firstpass 1                                                                */
636/******************************************************************************/
637/*                                                                            */
638/******************************************************************************/
639void Add_Pointer_Var_From_List_1(listvar *listin)
640{
641   listvar *parcours;
642
643   if ( firstpass == 1 )
644   {
645       parcours = listin;
646       while ( parcours )
647       {
648          Add_Pointer_Var_1(parcours->var->v_nomvar);
649          parcours = parcours -> suiv ;
650       }
651   }
652}
653
654/******************************************************************************/
655/*                            Add_Pointer_Var_1                               */
656/******************************************************************************/
657/* Firstpass 1                                                                */
658/******************************************************************************/
659/*                                                                            */
660/******************************************************************************/
661void Add_Pointer_Var_1(char *nom)
662{
663   listname *newvar;
664   listname *parcours;
665   int out;
666
667   if ( firstpass == 1 )
668   {
669      if ( !List_Pointer_Var )
670      {
671         newvar = (listname *)malloc(sizeof(listname));
672         strcpy(newvar->n_name,nom);
673         Save_Length(nom,20);
674         newvar->suiv = NULL;
675         List_Pointer_Var = newvar;
676      }
677      else
678      {
679         parcours = List_Pointer_Var;
680         out = 0 ;
681         while ( parcours->suiv && out == 0 )
682         {
683            if (  !strcasecmp(parcours->n_name,nom) ) out = 1;
684            else
685               parcours=parcours->suiv;
686         }
687         if ( out == 0 )
688         {
689            if (  !strcasecmp(parcours->n_name,nom) ) out = 1;
690            else
691            {
692               /* add the record                                              */
693              newvar = (listname *)malloc(sizeof(listname));
694              strcpy(newvar->n_name,nom);
695              Save_Length(nom,20);
696              newvar->suiv = NULL;
697              parcours->suiv = newvar;
698            }
699         }
700      }
701   }
702}
703
704/******************************************************************************/
705/*                          varispointer_0                                    */
706/******************************************************************************/
707/* Firstpass 0                                                                */
708/******************************************************************************/
709/*                                                                            */
710/******************************************************************************/
711int varispointer_0(char *ident)
712{
713   listname *newname;
714   int out;
715
716   out =0;
717   if ( firstpass == 0 )
718   {
719      newname = List_Pointer_Var;
720      while( newname && out == 0 )
721      {
722         if ( !strcasecmp(ident,newname->n_name) ) out = 1 ;
723         else newname = newname->suiv;
724      }
725   }
726   return out;
727}
728
729/******************************************************************************/
730/*                          varistyped_0                                    */
731/******************************************************************************/
732/* Firstpass 0                                                                */
733/******************************************************************************/
734/*                                                                            */
735/******************************************************************************/
736int varistyped_0(char *ident)
737{
738   listvar *parcours;
739   int out;
740
741   out =0;
742   if ( firstpass == 0 )
743   {
744      parcours = List_Global_Var;
745      while( parcours && out == 0 )
746      {
747         if ( !strcasecmp(ident,parcours->var->v_nomvar) ) 
748             {
749             if (!strcasecmp(parcours->var->v_typevar,"type")) out = 1;
750             }
751         parcours = parcours->suiv;
752      }
753   }
754   return out;
755}
756
757
758/******************************************************************************/
759/*                          VariableIsNotFunction                             */
760/******************************************************************************/
761/*                                                                            */
762/******************************************************************************/
763int VariableIsNotFunction(char *ident)
764{
765   int out;
766   listvar *newvar;
767
768   out =0;
769
770   if ( !strcasecmp(ident,"size") ||
771        !strcasecmp(ident,"if")   ||
772        !strcasecmp(ident,"max")  ||
773        !strcasecmp(ident,"min")
774      )
775   {
776      newvar = List_SubroutineDeclaration_Var;
777      while ( newvar && out == 0 )
778      {
779         if ( !strcasecmp(subroutinename, newvar->var->v_subroutinename) &&
780              !strcasecmp(ident, newvar->var->v_nomvar) ) out = 1;
781         newvar = newvar -> suiv ;
782      }
783      if ( out == 1 ) out = 0;
784      else out = 1;
785      /* if it has not been found                                             */
786      if ( out == 1 )
787      {
788         out = 0;
789         newvar = List_Global_Var;
790         while ( newvar && out == 0 )
791         {
792            if ( !strcasecmp(ident, newvar->var->v_nomvar) ) out = 1;
793            newvar = newvar -> suiv ;
794         }
795         if ( out == 1 ) out = 0;
796         else out = 1;
797      }
798   }
799   /*                                                                         */
800   return out;
801}
Note: See TracBrowser for help on using the repository browser.