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/2015/dev_r5803_UKMO_AGRIF_Vert_interp/NEMOGCM/EXTERNAL/AGRIF/LIB – NEMO

source: branches/2015/dev_r5803_UKMO_AGRIF_Vert_interp/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilListe.c @ 6258

Last change on this file since 6258 was 6258, checked in by timgraham, 8 years ago

First inclusion of Laurent Debreu's modified code for vertical refinement.
Still a lot of outstanding issues:
1) conv preprocessor fails for limrhg.F90 at the moment (for now I've run without ice model)
2) conv preprocessor fails for STO code - removed this code from testing for now
3) conv preprocessor fails for cpl_oasis.F90 - can work round this by modifying code but the preprocessor should be fixed to deal with this.

After that code compiles and can be run for horizontal grid refinement. Not yet working for vertical refinement.

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.