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 vendors/AGRIF/dev_r14312_MPI_Interface/LIB – NEMO

source: vendors/AGRIF/dev_r14312_MPI_Interface/LIB/UtilListe.c @ 14351

Last change on this file since 14351 was 14351, checked in by smasson, 4 years ago

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