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.
UtilListe.c in branches/2017/dev_r8126_UKMO_AGRIF_vert_interp/NEMOGCM/EXTERNAL/AGRIF/LIB – NEMO

source: branches/2017/dev_r8126_UKMO_AGRIF_vert_interp/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilListe.c @ 8139

Last change on this file since 8139 was 8139, checked in by timgraham, 7 years ago

Updates to conv library as received from Laurent - required for vertical refinement
  • Property svn:keywords set to Id
File size: 26.5 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
41void Init_Variable(variable *var)
42{
43   strcpy(var->v_typevar            , "");
44   strcpy(var->v_nomvar             , "");
45   strcpy(var->v_oldname            , "");
46   strcpy(var->v_dimchar            , "");
47   strcpy(var->v_modulename         , "");
48   strcpy(var->v_commonname         , "");
49   strcpy(var->v_vallengspec        , "");
50   strcpy(var->v_nameinttypename    , "");
51   strcpy(var->v_commoninfile       , "");
52   strcpy(var->v_subroutinename     , "");
53   strcpy(var->v_precision          , "");
54   var->v_initialvalue = (listname *)NULL;
55   var->v_initialvalue_array = (listname *)NULL;
56   var->v_do_loop = NULL;
57   strcpy(var->v_IntentSpec         , "");
58   strcpy(var->v_readedlistdimension, "");
59   var->v_nbdim               = 0 ;
60   var->v_common              = 0 ;
61   var->v_positioninblock     = 0 ;
62   var->v_module              = 0 ;
63   var->v_save                = 0 ;
64   var->v_catvar              = 0 ;
65   var->v_VariableIsParameter = 0 ;
66   var->v_PublicDeclare       = 0 ;
67   var->v_PrivateDeclare      = 0 ;
68   var->v_ExternalDeclare     = 0 ;
69   var->v_pointedvar          = 0 ;
70   var->v_notgrid             = 0 ;
71   var->v_dimensiongiven      = 0 ;
72   var->v_c_star              = 0 ;
73   var->v_indicetabvars       = 0 ;
74   var->v_pointerdeclare      = 0 ;
75   var->v_optionaldeclare     = 0 ;
76   var->v_allocatable         = 0 ;
77   var->v_target              = 0 ;
78   var->v_dimsempty           = 0 ;
79   var->v_dimension = (listdim *) NULL;
80}
81/******************************************************************************/
82/*                            AddListvartolistvar                             */
83/******************************************************************************/
84/* This subroutine is used to add a listvar l at the end of a listvar         */
85/* glob.                                                                      */
86/*                                                                            */
87/******************************************************************************/
88/*        _______     _______     _______     _______     _______             */
89/*       +      +    +      +    +      +    +      +    +      +             */
90/*       + glob +--->+ glob +--->+ glob +--->+ glob +--->+  l   +             */
91/*       +______+    +______+    +______+    +______+    +______+             */
92/*                                                                            */
93/******************************************************************************/
94listvar * AddListvarToListvar ( listvar *l, listvar *glob, int ValueFirstpass )
95{
96    listvar *newvar;
97    if ( firstpass == ValueFirstpass )
98    {
99        if ( !glob ) glob = l;
100        else
101        {
102            newvar = glob;
103            while (newvar->suiv)
104                newvar = newvar->suiv;
105            newvar->suiv = l;
106        }
107        newvar=glob;
108        while (newvar)
109        {
110        newvar=newvar->suiv;
111        }
112    }
113    return glob;
114}
115
116/******************************************************************************/
117/*                       CreateAndFillin_Curvar                               */
118/******************************************************************************/
119/* This subroutine is used to create the record corresponding to the          */
120/* list of declaration                                                        */
121/******************************************************************************/
122/*                                                                            */
123/******************************************************************************/
124void CreateAndFillin_Curvar(const char *type, variable *curvar)
125{
126listname *newvar;
127
128    if ( !strcasecmp(type, "character") && strcasecmp(CharacterSize, "") )
129    {
130        strcpy(curvar->v_dimchar, CharacterSize);
131    }
132
133    /* On donne la precision de la variable si elle a ete donnee                */
134    curvar->v_c_star = 0;
135    if ( c_star == 1 )  curvar->v_c_star = 1;
136
137    strcpy(curvar->v_vallengspec,"");
138    if ( strcasecmp(vallengspec,"") )
139    {
140        strcpy(curvar->v_vallengspec,vallengspec);
141        Save_Length(vallengspec,8);
142    }
143
144    strcpy(curvar->v_precision,"");
145    if ( strcasecmp(NamePrecision,"") )
146    {
147        strcpy(curvar->v_precision,NamePrecision);
148        addprecision_derivedfromkind(curvar);
149        Save_Length(NamePrecision,12);
150    }
151    /* Si cette variable a ete declaree dans un module on met curvar->module=1  */
152    if ( inmoduledeclare == 1 || SaveDeclare == 1 )
153    {
154        curvar->v_module = 1;
155    }
156    /* Puis on donne le nom du module dans curvar->v_modulename                */
157    strcpy(curvar->v_modulename,curmodulename);
158    /* Si cette variable a ete initialisee                                     */
159    if (InitialValueGiven == 1 )
160    {
161    curvar->v_initialvalue=Insertname(curvar->v_initialvalue,InitValue,0);
162   
163//        strcpy(curvar->v_initialvalue,InitValue);
164       
165        Save_Length(InitValue,14);
166    }
167    /* Si cette variable est declaree en save                                  */
168    if (SaveDeclare == 1 && !strcasecmp(curvar->v_typevar,"type")) curvar->v_save = 1;
169
170    /* Si cette variable est v_allocatable                                     */
171    if (Allocatabledeclare == 1 ) curvar->v_allocatable=1;
172
173    /* Si cette variable est v_target                                     */
174    if (Targetdeclare == 1 ) curvar->v_target=1;
175
176    /* if INTENT spec has been given                                           */
177    if ( strcasecmp(IntentSpec,"") )
178    {
179        strcpy(curvar->v_IntentSpec,IntentSpec);
180        Save_Length(IntentSpec,13);
181    }
182}
183
184
185void addprecision_derivedfromkind(variable *curvar)
186{
187    listnom *parcours;
188    char kind[LONG_VNAME];
189    char kind_val[LONG_C];
190
191    sscanf(curvar->v_precision, "%100s =", kind_val);
192
193    if ( !strcasecmp(kind_val, "kind") )
194        sscanf(curvar->v_precision, "%50s = %50s", kind, kind_val);
195
196    parcours = listofkind;
197    while (parcours)
198    {
199        if ( !strcasecmp(parcours->o_nom, kind_val) )
200        {
201            sprintf(curvar->v_nameinttypename, "%d", parcours->o_val);
202        }
203        parcours=parcours->suiv;
204    }
205}
206
207/******************************************************************************/
208/*                        duplicatelistvar                                    */
209/******************************************************************************/
210/*                                                                            */
211/******************************************************************************/
212// void duplicatelistvar(listvar *orig)
213// {
214//    listvar *parcours;
215//    listvar *tmplistvar;
216//    listvar *tmplistvarprec;
217//    listdim *tmplistdim;
218//    variable *tmpvar;
219//
220//    tmplistvarprec = (listvar *)NULL;
221//    parcours = orig;
222//    while ( parcours )
223//    {
224//       tmplistvar = (listvar *)calloc(1,sizeof(listvar));
225//       tmpvar = (variable *)calloc(1,sizeof(variable));
226//       /*                                                                      */
227//       Init_Variable(tmpvar);
228//       /*                                                                      */
229//       strcpy(tmpvar->v_typevar, parcours->var->v_typevar);
230//       strcpy(tmpvar->v_nomvar,  parcours->var->v_nomvar);
231//       strcpy(tmpvar->v_oldname, parcours->var->v_oldname);
232//       strcpy(tmpvar->v_dimchar, parcours->var->v_dimchar);
233//       if ( parcours->var->v_dimension )
234//       {
235//          tmplistdim = (listdim*) calloc(1,sizeof(listdim));
236//          tmplistdim = parcours->var->v_dimension;
237//          tmpvar->v_dimension = tmplistdim;
238//       }
239//       tmpvar->v_nbdim  = parcours->var->v_nbdim;
240//       tmpvar->v_common = parcours->var->v_common;
241//       tmpvar->v_module = parcours->var->v_module;
242//       tmpvar->v_save   = parcours->var->v_save;
243//       tmpvar->v_positioninblock = parcours->var->v_positioninblock;
244//       tmpvar->v_VariableIsParameter = parcours->var->v_VariableIsParameter;
245//       tmpvar->v_indicetabvars = parcours->var->v_indicetabvars;
246//       tmpvar->v_pointedvar    = parcours->var->v_pointedvar;
247//       tmpvar->v_dimensiongiven = parcours->var->v_dimensiongiven;
248//       tmpvar->v_c_star = parcours->var->v_c_star;
249//       tmpvar->v_catvar = parcours->var->v_catvar;
250//       tmpvar->v_pointerdeclare = parcours->var->v_pointerdeclare;
251//       tmpvar->v_optionaldeclare = parcours->var->v_optionaldeclare;
252//       tmpvar->v_allocatable = parcours->var->v_allocatable;
253//       tmpvar->v_target      = parcours->var->v_target;
254//       tmpvar->v_dimsempty   = parcours->var->v_dimsempty;
255//       strcpy(tmpvar->v_modulename,  parcours->var->v_modulename);
256//       strcpy(tmpvar->v_commonname,  parcours->var->v_commonname);
257//       strcpy(tmpvar->v_vallengspec, parcours->var->v_vallengspec);
258//       strcpy(tmpvar->v_nameinttypename, parcours->var->v_nameinttypename);
259//       strcpy(tmpvar->v_commoninfile, cur_filename);
260//       strcpy(tmpvar->v_subroutinename, parcours->var->v_subroutinename);
261//       strcpy(tmpvar->v_precision, parcours->var->v_precision);
262//       strcpy(tmpvar->v_initialvalue, parcours->var->v_initialvalue);
263//       strcpy(tmpvar->v_IntentSpec, parcours->var->v_IntentSpec);
264//       strcpy(tmpvar->v_readedlistdimension, parcours->var->v_readedlistdimension);
265//
266//       tmplistvar->var = tmpvar;
267//       tmplistvar->suiv = NULL;
268//
269//       if ( !listduplicated )
270//       {
271//          listduplicated = tmplistvar;
272//          tmplistvarprec = listduplicated;
273//       }
274//       else
275//       {
276//          tmplistvarprec->suiv = tmplistvar;
277//          tmplistvarprec = tmplistvar;
278//       }
279//       parcours = parcours->suiv;
280//    }
281// }
282
283/******************************************************************************/
284/*                           insertdim                                        */
285/******************************************************************************/
286/* This subroutine is used to insert a record in a list of                    */
287/* struct : listdim                                                           */
288/******************************************************************************/
289/*        _______     _______     _______     _______     _______             */
290/*       +      +    +      +    +      +    +      +    +      +             */
291/*       + NEW  +--->+ lin  +--->+ lin  +--->+ lin  +--->+  lin +             */
292/*       +______+    +______+    +______+    +______+    +______+             */
293/*                                                                            */
294/******************************************************************************/
295listdim * insertdim(listdim *lin,typedim nom)
296{
297   listdim *newdim ;
298   listdim *parcours ;
299
300   newdim=(listdim *) calloc(1,sizeof(listdim));
301   newdim->dim=nom;
302   newdim->suiv=NULL;
303
304   if ( ! lin )
305   {
306      lin = newdim;
307   }
308   else
309   {
310      parcours = lin;
311      while ( parcours->suiv ) parcours=parcours->suiv;
312      parcours->suiv = newdim;
313   }
314
315   return lin;
316}
317
318/******************************************************************************/
319/*                            change_dim_char                                 */
320/******************************************************************************/
321/* This subroutine is used to change the dimension in the list lin            */
322/******************************************************************************/
323/*        _______     _______                 _______     _______             */
324/*       +  l   +    +  l   +                +  l   +    +   l  +             */
325/*       + old  +--->+ old  +--------------->+ lin  +--->+  lin +             */
326/*       +______+    +______+                +______+    +______+             */
327/*                                                                            */
328/******************************************************************************/
329void change_dim_char(listdim *lin,listvar * l)
330{
331   listvar *parcours_var;
332   variable *v;
333
334   parcours_var=l;
335   while(parcours_var)
336   {
337      v = parcours_var->var;
338      strcpy(v->v_dimchar,(lin->dim).last);
339      parcours_var=parcours_var->suiv;
340   }
341}
342
343
344/******************************************************************************/
345/*                              get_num_dims                                  */
346/******************************************************************************/
347/* This subroutine is used to know the dimension of a table                   */
348/******************************************************************************/
349/*                                                                            */
350/*             Dimension(jpi,jpj,jpk) ----------> get_num_dims = 3            */
351/*                                                                            */
352/******************************************************************************/
353int get_num_dims ( const listdim *d )
354{
355    listdim *parcours;
356    int compteur = 0;
357
358    parcours = (listdim *) d;
359    while(parcours)
360    {
361        compteur++;
362        parcours = parcours->suiv;
363    }
364    return compteur;
365}
366
367
368/******************************************************************************/
369/*                          CREATEVAR                                         */
370/******************************************************************************/
371/* This subroutine is used to create and initialized a record of the          */
372/*      struct : variable                                                     */
373/******************************************************************************/
374variable * createvar(const char *nom, listdim *d)
375{
376    variable *var;
377    listdim *dims;
378    char ligne[LONG_M];
379    char listdimension[LONG_M];
380
381    var = (variable *) calloc(1,sizeof(variable));
382
383    Init_Variable(var);
384
385    strcpy(listdimension,"");
386    strcpy(var->v_nomvar,nom);
387    strcpy(var->v_modulename,curmodulename);
388    strcpy(var->v_commoninfile,cur_filename);
389    strcpy(var->v_subroutinename,subroutinename);
390
391    if ( strcasecmp(nameinttypename,"") )
392    {
393        strcpy(var->v_nameinttypename,nameinttypename);
394    }
395
396    if ( optionaldeclare     == 1 ) var->v_optionaldeclare = 1;
397    if ( pointerdeclare      == 1 ) var->v_pointerdeclare = 1;
398    if ( VariableIsParameter == 1 ) var->v_VariableIsParameter = 1 ;
399    if ( PublicDeclare       == 1 ) var->v_PublicDeclare = 1 ;
400    if ( PrivateDeclare      == 1 ) var->v_PrivateDeclare = 1;
401    if ( ExternalDeclare     == 1 ) var->v_ExternalDeclare = 1;
402
403   var->v_dimension = d;
404
405   /* Creation of the string for the dimension of this variable               */
406    dimsempty = 1;
407    if ( d )
408    {
409        var->v_dimensiongiven = 1;
410        dims = d;
411        while (dims)
412        {
413            if ( strcasecmp(dims->dim.first,"") || strcasecmp(dims->dim.last,""))
414            {
415                dimsempty = 0;
416            }
417            sprintf(ligne,"%s:%s",dims->dim.first,dims->dim.last);
418            strcat(listdimension,ligne);
419            if ( dims->suiv )
420            {
421                strcat(listdimension,",");
422            }
423            dims = dims->suiv;
424        }
425        if ( dimsempty == 1 || GlobalDeclarationType == 1 ) var->v_dimsempty = 1;
426    }
427    strcpy(var->v_readedlistdimension,listdimension);
428    Save_Length(listdimension,15);
429    var->v_nbdim = get_num_dims(d);
430
431    return var;
432}
433
434/******************************************************************************/
435/*                            INSERTVAR                                       */
436/******************************************************************************/
437/* This subroutine is used to insert a record in a list of the                */
438/*      struct : listvar                                                      */
439/******************************************************************************/
440/*        _______     _______     _______     _______     _______             */
441/*       +      +    +      +    +      +    +      +    +      +             */
442/*       +  lin +--->+  lin +--->+ lin  +--->+ lin  +--->+ NEW  +             */
443/*       +______+    +______+    +______+    +______+    +______+             */
444/*                                                                            */
445/*                                                                            */
446/******************************************************************************/
447listvar * insertvar(listvar *lin,variable *v)
448{
449   listvar *newvar ;
450   listvar *tmpvar ;
451
452   newvar=(listvar *) calloc(1,sizeof(listvar));
453   newvar->var=v;
454   newvar->suiv = NULL;
455   if (!lin)
456   {
457      newvar->suiv=NULL;
458      lin = newvar;
459   }
460   else
461   {
462      tmpvar = lin ;
463      while (tmpvar->suiv)
464      {
465         tmpvar = tmpvar ->suiv ;
466      }
467      tmpvar -> suiv = newvar;
468   }
469   return lin;
470}
471
472/******************************************************************************/
473/*                             SETTYPE                                        */
474/******************************************************************************/
475/* This subroutine is used to give the same variable type at each             */
476/*      record of the list of the struct : listvar                            */
477/******************************************************************************/
478/*        _______     _______     _______     _______     _______             */
479/*       + REAL +    + REAL +    + REAL +    + REAL +    + REAL +             */
480/*       +  lin +--->+  lin +--->+ lin  +--->+ lin  +--->+ lin  +             */
481/*       +______+    +______+    +______+    +______+    +______+             */
482/*                                                                            */
483/*                                                                            */
484/******************************************************************************/
485listvar *settype(const char *nom, listvar *lin)
486{
487   listvar *newvar;
488   variable *v;
489
490   newvar = lin;
491   while (newvar)
492   {
493      v = newvar->var;
494      strcpy(v->v_typevar,nom);
495     
496      v->v_catvar = get_cat_var(v);
497
498      newvar = newvar->suiv;
499   }
500   newvar = lin;
501   return newvar ;
502}
503
504/******************************************************************/
505/* printliste  */
506/* print the list given in argulent */
507/******************************************************************/
508
509void printliste(listvar * lin)
510{
511   listvar *newvar;
512   variable *v;
513
514   newvar=lin;
515   while (newvar)
516   {
517      v=newvar->var;
518      newvar=newvar->suiv;
519   }
520}
521
522/******************************************************************************/
523/*   IsinListe : return 1 if name nom is in list lin                          */
524/*                                                                            */
525/******************************************************************************/
526 int IsinListe(listvar *lin,char *nom)
527{
528   listvar *newvar;
529   variable *v;
530   int out ;
531
532   newvar=lin;
533   out = 0;
534   while (newvar && (out == 0))
535   {
536      v=newvar->var;
537      if (!strcasecmp(v->v_nomvar,nom) && !strcasecmp(v->v_subroutinename,subroutinename)) {
538      out = 1;
539      }
540      newvar=newvar->suiv;
541   }
542
543   return out ;
544}
545
546listname *Insertname(listname *lin,char *nom, int sens)
547{
548   listname *newvar ;
549   listname *tmpvar;
550
551   newvar=(listname *) calloc(1,sizeof(listname));
552   strcpy(newvar->n_name,nom);
553   newvar->suiv = NULL;
554   if (!lin)
555   {
556      newvar->suiv=NULL;
557      lin = newvar;
558   }
559   else
560   {
561      if (sens == 0)
562      {
563      tmpvar = lin ;
564      while (tmpvar->suiv)
565      {
566         tmpvar = tmpvar ->suiv ;
567      }
568      tmpvar -> suiv = newvar;
569      }
570      else
571      {
572      newvar->suiv = lin;
573      lin = newvar;
574      }
575   }
576   return lin;
577}
578
579int testandextractfromlist(listname **lin, char*nom)
580{
581listname *newvar;
582int val_1, val_2;
583int return_stmt;
584
585printname(*lin);
586if (!(*lin))
587 {
588  return 0;
589 }
590else
591 {
592 sscanf(nom,"%d",&val_1);
593 sscanf((*lin)->n_name,"%d",&val_2);
594 if (val_1==val_2)
595   {
596/*   newvar = *lin;
597   *lin = (*lin)->suiv;
598   free(newvar);*/
599   /* continue to remove while the label stays the same */
600/*   return_stmt=testandextractfromlist(lin,nom);*/
601   return 1;
602   }
603 else
604  {
605  return 0;
606  }
607 }
608}
609
610void removefromlist(listname **lin, char*nom)
611{
612listname *newvar,*prev;
613int val_1, val_2;
614int return_stmt;
615int out;
616
617printname(*lin);
618if (*lin)
619 {
620 sscanf(nom,"%d",&val_1);
621 prev=(listname *) calloc(1,sizeof(listname));
622 prev->suiv=*lin;
623 *lin=prev;
624 newvar=(*lin)->suiv;
625 out = 0;
626 while (newvar && out == 0)
627 {
628 sscanf((newvar)->n_name,"%d",&val_2);
629 if (val_1==val_2)
630   {
631   prev->suiv=newvar->suiv;
632   free(newvar);
633   }
634  if (prev->suiv) 
635    {
636    prev=prev->suiv;
637    newvar=prev->suiv;
638    }
639   else
640   {
641   out = 1;
642   }
643  }
644 prev=*lin;
645 *lin=(*lin)->suiv;
646 free(prev);
647 }
648}
649
650listname *concat_listname(listname *l1, listname *l2)
651{
652   listname *tmpvar;
653
654   tmpvar = l1;
655   while (tmpvar->suiv)
656   {
657    tmpvar = tmpvar->suiv;
658   }
659
660   tmpvar->suiv = l2;
661
662   return l1;
663}
664
665void createstringfromlistname(char *ligne, listname *lin)
666{
667    listname *tmpvar;
668
669    strcpy(ligne,"");
670    tmpvar = lin;
671
672    while(tmpvar)
673    {
674        strcat(ligne,tmpvar->n_name);
675        if (tmpvar->suiv) strcat(ligne,",");
676        tmpvar=tmpvar->suiv;
677    }
678}
679
680/******************************************************************/
681/* printname  */
682/* print the list given in argulent */
683/******************************************************************/
684
685void printname(listname * lin)
686{
687   listname *newvar;
688
689   newvar=lin;
690   while (newvar)
691   {
692      newvar=newvar->suiv;
693   }
694}
695
696void removeglobfromlist(listname **lin)
697{
698  listname *parcours1;
699  listvar *parcours2;
700  listname * parcourspres;
701  int out;
702
703  parcours1 = *lin;
704  parcourspres = (listname *)NULL;
705
706  while (parcours1)
707  {
708  parcours2 = List_Global_Var;
709  out = 0;
710  while (parcours2 && out == 0)
711  {
712    if (!strcasecmp(parcours2->var->v_nomvar,parcours1->n_name))
713    {
714    out = 1;
715    }
716    parcours2 = parcours2->suiv;
717  }
718  if (out == 1)
719  {
720  if (parcours1 == *lin)
721   {
722   *lin = (*lin)->suiv;
723   parcours1 = *lin;
724   }
725   else
726   {
727   parcourspres->suiv = parcours1->suiv;
728   parcours1 = parcourspres->suiv;
729   }
730   }
731   else
732   {
733   parcourspres = parcours1;
734    parcours1 = parcours1->suiv;
735    }
736  }
737}
738
739void writelistpublic(listname *lin)
740{
741    listname *parcours1;
742    char ligne[LONG_M];
743
744    if (lin)
745    {
746        sprintf(ligne,"public :: ");
747        parcours1 = lin;
748
749        while ( parcours1 )
750        {
751            strcat(ligne, parcours1->n_name);
752            if ( parcours1->suiv ) strcat(ligne,", ");
753            parcours1 = parcours1->suiv;
754        }
755        tofich(fortran_out,ligne,1);
756    }
757}
758
759void Init_List_Data_Var()
760{
761    listvar *parcours;
762
763    parcours = List_Data_Var_Cur;
764
765    if (List_Data_Var_Cur)
766    {
767        while (parcours)
768        {
769            List_Data_Var_Cur = List_Data_Var_Cur->suiv;
770            free(parcours);
771            parcours = List_Data_Var_Cur;
772        }
773    }
774    List_Data_Var_Cur = NULL;
775}
776
777int get_cat_var(variable *var)
778{
779
780    if (!strcasecmp(var->v_typevar, "CHARACTER"))
781        return 1;
782    else if ((var->v_nbdim == 0 ) && (!strcasecmp(var->v_typevar, "REAL")))
783        return 2;
784    else if (!strcasecmp(var->v_typevar, "LOGICAL"))
785        return 3;
786    else if (!strcasecmp(var->v_typevar, "INTEGER"))
787        return 4;
788    else
789        return 0;
790}
791
792void Insertdoloop(variable *var,char *do_var,char *do_begin, char *do_end, char *do_step)
793{
794listdoloop *new_do_loop;
795listdoloop *tmploop;
796new_do_loop = (listdoloop *) calloc(1,sizeof(listdoloop));
797
798new_do_loop->cur_do_loop = (do_loop *) calloc(1,sizeof(do_loop));
799
800strcpy(new_do_loop->cur_do_loop->do_variable,do_var);
801strcpy(new_do_loop->cur_do_loop->do_begin,do_begin);
802strcpy(new_do_loop->cur_do_loop->do_end,do_end);
803strcpy(new_do_loop->cur_do_loop->do_step,do_step);
804new_do_loop->suiv = NULL;
805
806if (!var->v_do_loop)
807{
808  var->v_do_loop = new_do_loop;
809}
810else
811{
812  new_do_loop->suiv = var->v_do_loop;
813  var->v_do_loop = new_do_loop;
814     
815//   tmploop = var->v_do_loop;
816//   while (tmploop->suiv)
817//   {
818//     tmploop=tmploop->suiv;
819//   }
820//   tmploop->suiv = new_do_loop ;
821//   }
822}
823}
Note: See TracBrowser for help on using the repository browser.