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

source: trunk/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilListe.c @ 2715

Last change on this file since 2715 was 2715, checked in by rblod, 13 years ago

First attempt to put dynamic allocation on the trunk
  • Property svn:keywords set to Id
File size: 24.1 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   strcpy(var->v_initialvalue       ,"");
55   strcpy(var->v_IntentSpec         ,"");
56   strcpy(var->v_readedlistdimension,"");
57   var->v_nbdim               = 0 ;
58   var->v_common              = 0 ;
59   var->v_positioninblock     = 0 ;
60   var->v_module              = 0 ;
61   var->v_save                = 0 ;
62   var->v_VariableIsParameter = 0 ;
63   var->v_PublicDeclare       = 0 ;
64   var->v_PrivateDeclare      = 0 ;
65   var->v_ExternalDeclare     = 0 ;
66   var->v_pointedvar          = 0 ;
67   var->v_notgrid             = 0 ;
68   var->v_dimensiongiven      = 0 ;
69   var->v_c_star              = 0 ;
70   var->v_indicetabvars       = 0 ;
71   var->v_pointerdeclare      = 0 ;
72   var->v_optionaldeclare     = 0 ;
73   var->v_allocatable         = 0 ;
74   var->v_target              = 0 ;
75   var->v_dimsempty           = 0 ;
76   var->v_dimension = (listdim *)NULL;
77}
78/******************************************************************************/
79/*                            AddListvartolistvar                             */
80/******************************************************************************/
81/* This subroutine is used to add a listvar l at the end of a listvar         */
82/* glob.                                                                      */
83/*                                                                            */
84/******************************************************************************/
85/*        _______     _______     _______     _______     _______             */
86/*       +      +    +      +    +      +    +      +    +      +             */
87/*       + glob +--->+ glob +--->+ glob +--->+ glob +--->+  l   +             */
88/*       +______+    +______+    +______+    +______+    +______+             */
89/*                                                                            */
90/******************************************************************************/
91listvar * AddListvarToListvar(listvar *l,listvar *glob,int ValueFirstpass)
92{
93   listvar *newvar;
94   if ( firstpass == ValueFirstpass )
95   {
96      if ( !glob) glob = l ;
97      else
98      {
99         newvar=glob;
100         while (newvar->suiv) newvar = newvar->suiv;
101         newvar->suiv = l;
102      }
103   }
104   return glob;
105}
106
107/******************************************************************************/
108/*                       CreateAndFillin_Curvar                               */
109/******************************************************************************/
110/* This subroutine is used to create the record corresponding to the          */
111/* list of declaration                                                        */
112/******************************************************************************/
113/*                                                                            */
114/******************************************************************************/
115void CreateAndFillin_Curvar(char *type,variable *curvar)
116{
117   if (!strcasecmp(type,"character") && strcasecmp(CharacterSize,"") )
118   {
119      strcpy(curvar->v_dimchar,CharacterSize);
120      Save_Length(CharacterSize,5);
121   }
122
123  /* On donne la precision de la variable si elle a ete donnee                */
124  curvar->v_c_star = 0;
125  if ( c_star == 1 ) curvar->v_c_star = 1;
126  /*                                                                          */
127  strcpy(curvar->v_vallengspec,"");
128  if ( strcasecmp(vallengspec,"") )
129  {
130     strcpy(curvar->v_vallengspec,vallengspec);
131     Save_Length(vallengspec,8);
132  }
133
134  strcpy(curvar->v_precision,"");
135  if ( strcasecmp(NamePrecision,"") )
136  {
137     strcpy(curvar->v_precision,NamePrecision);
138     Save_Length(NamePrecision,12);
139  }
140  /* Si cette variable a ete declaree dans un module on met curvar->module=1  */
141  if ( inmoduledeclare == 1 || SaveDeclare == 1)
142  {
143      curvar->v_module = 1;
144   }
145   /* Puis on donne le nom du module dans curvar->v_modulename                */
146   strcpy(curvar->v_modulename,curmodulename);
147   Save_Length(curmodulename,6);
148   /* Si cette variable a ete initialisee                                     */
149   if (InitialValueGiven == 1 )
150   {
151      strcpy(curvar->v_initialvalue,InitValue);
152      Save_Length(InitValue,14);
153   }
154   /* Si cette variable est declaree en save                                  */
155   if (SaveDeclare == 1 ) {
156   curvar->v_save = 1;
157   }
158
159   /* Si cette variable est v_allocatable                                     */
160   if (Allocatabledeclare == 1 ) curvar->v_allocatable=1;
161   
162   /* Si cette variable est v_targer                                     */
163   if (Targetdeclare == 1 ) curvar->v_target=1;
164   /* if INTENT spec has been given                                           */
165   if ( strcasecmp(IntentSpec,"") )
166   {
167      strcpy(curvar->v_IntentSpec,IntentSpec);
168      Save_Length(IntentSpec,13);
169   }
170}
171
172
173/******************************************************************************/
174/*                        duplicatelistvar                                    */
175/******************************************************************************/
176/*                                                                            */
177/******************************************************************************/
178void duplicatelistvar(listvar *orig)
179{
180   listvar *parcours;
181   listvar *tmplistvar;
182   listvar *tmplistvarprec;
183   listdim *tmplistdim;
184   variable *tmpvar;
185
186   tmplistvarprec = (listvar *)NULL;
187   parcours = orig;
188   while ( parcours )
189   {
190      tmplistvar = (listvar *)malloc(sizeof(listvar));
191      tmpvar = (variable *)malloc(sizeof(variable));
192      /*                                                                      */
193      Init_Variable(tmpvar);
194      /*                                                                      */
195      strcpy(tmpvar->v_typevar,parcours->var->v_typevar);
196      strcpy(tmpvar->v_nomvar,parcours->var->v_nomvar);
197      strcpy(tmpvar->v_oldname,parcours->var->v_oldname);
198      strcpy(tmpvar->v_dimchar,parcours->var->v_dimchar);
199      if ( parcours->var->v_dimension )
200      {
201         tmplistdim = (listdim *)malloc(sizeof(listdim));
202         tmplistdim = parcours->var->v_dimension;
203         tmpvar->v_dimension = tmplistdim;
204      }
205      tmpvar->v_nbdim=parcours->var->v_nbdim;
206      tmpvar->v_common=parcours->var->v_common;
207      tmpvar->v_positioninblock=parcours->var->v_positioninblock;
208      tmpvar->v_module=parcours->var->v_module;
209      tmpvar->v_save=parcours->var->v_save;
210      tmpvar->v_VariableIsParameter=parcours->var->v_VariableIsParameter;
211      printf("QLKDF\n");
212      tmpvar->v_indicetabvars=parcours->var->v_indicetabvars;
213      strcpy(tmpvar->v_modulename,parcours->var->v_modulename);
214      strcpy(tmpvar->v_commonname,parcours->var->v_commonname);
215      strcpy(tmpvar->v_vallengspec,parcours->var->v_vallengspec);
216
217      strcpy(tmpvar->v_nameinttypename,parcours->var->v_nameinttypename);
218           
219      tmpvar->v_pointedvar=parcours->var->v_pointedvar;
220      strcpy(tmpvar->v_commoninfile,mainfile);
221      Save_Length(mainfile,10);
222      strcpy(tmpvar->v_subroutinename,parcours->var->v_subroutinename);
223      tmpvar->v_dimensiongiven=parcours->var->v_dimensiongiven;
224      tmpvar->v_c_star=parcours->var->v_c_star;
225      strcpy(tmpvar->v_precision,parcours->var->v_precision);
226      strcpy(tmpvar->v_initialvalue,parcours->var->v_initialvalue);
227      tmpvar->v_pointerdeclare=parcours->var->v_pointerdeclare;
228      tmpvar->v_optionaldeclare=parcours->var->v_optionaldeclare;
229      tmpvar->v_allocatable=parcours->var->v_allocatable;
230      tmpvar->v_target=parcours->var->v_target;
231      strcpy(tmpvar->v_IntentSpec,parcours->var->v_IntentSpec);
232      tmpvar->v_dimsempty=parcours->var->v_dimsempty;
233      strcpy(tmpvar->v_readedlistdimension,
234                                          parcours->var->v_readedlistdimension);
235      /*                                                                      */
236      tmplistvar->var = tmpvar;
237      tmplistvar->suiv = NULL;
238      /*                                                                      */
239      if ( !listduplicated )
240      {
241         listduplicated = tmplistvar;
242         tmplistvarprec = listduplicated;
243      }
244      else
245      {
246         tmplistvarprec->suiv = tmplistvar;
247         tmplistvarprec = tmplistvar;
248      }
249      /*                                                                      */
250      parcours = parcours->suiv;
251   }
252}
253
254/******************************************************************************/
255/*                           insertdim                                        */
256/******************************************************************************/
257/* This subroutine is used to insert a record in a list of                    */
258/* struct : listdim                                                           */
259/******************************************************************************/
260/*        _______     _______     _______     _______     _______             */
261/*       +      +    +      +    +      +    +      +    +      +             */
262/*       + NEW  +--->+ lin  +--->+ lin  +--->+ lin  +--->+  lin +             */
263/*       +______+    +______+    +______+    +______+    +______+             */
264/*                                                                            */
265/******************************************************************************/
266listdim * insertdim(listdim *lin,typedim nom)
267{
268   listdim *newdim ;
269   listdim *parcours ;
270
271   newdim=(listdim *) malloc (sizeof (listdim));
272   newdim->dim=nom;
273   newdim->suiv=NULL;
274
275   if ( ! lin )
276   {
277      lin = newdim;
278   }
279   else
280   {
281      parcours = lin;
282      while ( parcours->suiv ) parcours=parcours->suiv;
283      parcours->suiv = newdim;
284   }
285
286   return lin;
287}
288
289/******************************************************************************/
290/*                            change_dim_char                                 */
291/******************************************************************************/
292/* This subroutine is used to change the dimension in the list lin            */
293/******************************************************************************/
294/*        _______     _______                 _______     _______             */
295/*       +  l   +    +  l   +                +  l   +    +   l  +             */
296/*       + old  +--->+ old  +--------------->+ lin  +--->+  lin +             */
297/*       +______+    +______+                +______+    +______+             */
298/*                                                                            */
299/******************************************************************************/
300void change_dim_char(listdim *lin,listvar * l)
301{
302   listvar *parcours_var;
303   variable *v;
304
305   parcours_var=l;
306   while(parcours_var)
307   {
308      v=parcours_var->var;
309      strcpy(v->v_dimchar,(lin->dim).last);
310      Save_Length((lin->dim).last,5);
311      parcours_var=parcours_var->suiv;
312   }
313}
314
315
316/******************************************************************************/
317/*                                num_dims                                    */
318/******************************************************************************/
319/* This subroutine is used to know the dimension of a table                   */
320/******************************************************************************/
321/*                                                                            */
322/*             Dimension(jpi,jpj,jpk) ----------> num_dims = 3                */
323/*                                                                            */
324/******************************************************************************/
325int num_dims(listdim *d)
326{
327   listdim *parcours;
328   int compteur = 0;
329
330   parcours = d;
331   while(parcours)
332   {
333     compteur++;
334     parcours=parcours->suiv;
335   }
336   return compteur;
337}
338
339
340/******************************************************************************/
341/*                          CREATEVAR                                         */
342/******************************************************************************/
343/* This subroutine is used to create and initialized a record of the          */
344/*      struct : variable                                                     */
345/******************************************************************************/
346variable * createvar(char *nom,listdim *d)
347{
348  variable *var;
349  listdim *dims;
350  char ligne[LONG_C];
351  char listdimension[LONG_C];
352
353   var=(variable *) malloc(sizeof(variable));
354   /*                                                                         */
355   Init_Variable(var);
356   /*                                                                         */
357   strcpy(var->v_nomvar,nom);
358   Save_Length(nom,4);
359   /*                                                                         */
360   strcpy(listdimension,"");
361   strcpy(var->v_modulename,curmodulename);
362   Save_Length(curmodulename,6);
363   strcpy(var->v_commoninfile,mainfile);
364   Save_Length(mainfile,10);
365   strcpy(var->v_subroutinename,subroutinename);
366   Save_Length(subroutinename,11);
367   /*                                                                         */
368   if ( strcasecmp(nameinttypename,"") )
369   {
370      strcpy(var->v_nameinttypename,nameinttypename);
371      Save_Length(nameinttypename,9);
372   }
373         
374   if ( optionaldeclare     == 1 ) var->v_optionaldeclare = 1;
375   if ( pointerdeclare      == 1 ) var->v_pointerdeclare = 1;
376   if ( VariableIsParameter == 1 ) var->v_VariableIsParameter = 1 ;
377   if ( PublicDeclare       == 1 ) var->v_PublicDeclare = 1 ;
378   if ( PrivateDeclare      == 1 ) var->v_PrivateDeclare = 1;
379   if ( ExternalDeclare     == 1 ) var->v_ExternalDeclare = 1;
380   /*                                                                         */
381   var->v_dimension=d;
382
383   /* Creation of the string for the dimension of this variable               */
384   dimsempty = 1;
385   if ( d )
386   {
387      var->v_dimensiongiven=1;
388      dims = d;
389      while (dims)
390      {
391         if ( strcasecmp(dims->dim.first,"") || strcasecmp(dims->dim.last,""))
392                                                                  dimsempty = 0;
393         sprintf(ligne,"%s:%s",dims->dim.first,dims->dim.last);
394         strcat(listdimension,ligne);
395         if ( dims->suiv )
396         {
397            strcat(listdimension,",");
398         }
399         dims = dims->suiv;
400      }
401      if ( dimsempty == 1 ) var->v_dimsempty=1;
402   }
403   strcpy(var->v_readedlistdimension,listdimension);
404   Save_Length(listdimension,15);
405   /*                                                                         */
406   var->v_nbdim=num_dims(d);
407   /*                                                                         */
408   return var;
409}
410
411/******************************************************************************/
412/*                            INSERTVAR                                       */
413/******************************************************************************/
414/* This subroutine is used to insert a record in a list of the                */
415/*      struct : listvar                                                      */
416/******************************************************************************/
417/*        _______     _______     _______     _______     _______             */
418/*       +      +    +      +    +      +    +      +    +      +             */
419/*       +  lin +--->+  lin +--->+ lin  +--->+ lin  +--->+ NEW  +             */
420/*       +______+    +______+    +______+    +______+    +______+             */
421/*                                                                            */
422/*                                                                            */
423/******************************************************************************/
424listvar * insertvar(listvar *lin,variable *v)
425{
426   listvar *newvar ;
427   listvar *tmpvar ;
428
429   newvar=(listvar *) malloc (sizeof (listvar));
430   newvar->var=v;
431   newvar->suiv = NULL;
432   if (!lin)
433   {
434      newvar->suiv=NULL;
435      lin = newvar;
436   }
437   else
438   {
439      tmpvar = lin ;
440      while (tmpvar->suiv)
441      {
442         tmpvar = tmpvar ->suiv ;
443      }
444      tmpvar -> suiv = newvar;
445   }
446   return lin;
447}
448
449/******************************************************************************/
450/*                             SETTYPE                                        */
451/******************************************************************************/
452/* This subroutine is used to give the same variable type at each             */
453/*      record of the list of the struct : listvar                            */
454/******************************************************************************/
455/*        _______     _______     _______     _______     _______             */
456/*       + REAL +    + REAL +    + REAL +    + REAL +    + REAL +             */
457/*       +  lin +--->+  lin +--->+ lin  +--->+ lin  +--->+ lin  +             */
458/*       +______+    +______+    +______+    +______+    +______+             */
459/*                                                                            */
460/*                                                                            */
461/******************************************************************************/
462listvar *settype(char *nom,listvar *lin)
463{
464   listvar *newvar;
465   variable *v;
466
467   newvar=lin;
468   while (newvar)
469   {
470      v=newvar->var;
471      strcpy(v->v_typevar,nom);
472      Save_Length(nom,3);
473      newvar=newvar->suiv;
474   }
475   newvar=lin;
476   return newvar ;
477}
478
479/******************************************************************/
480/* printliste  */
481/* print the list given in argulent */
482/******************************************************************/
483
484void printliste(listvar * lin)
485{
486   listvar *newvar;
487   variable *v;
488
489   newvar=lin;
490   while (newvar)
491   {
492      v=newvar->var;
493      printf("nom = %s, allocatable = %d dim = %s\n",v->v_nomvar,v->v_allocatable,(v->v_dimension)->dim.last);
494      newvar=newvar->suiv;
495   }
496}
497
498/******************************************************************************/
499/*   IsinListe : return 1 if name nom is in list lin                          */
500/*                                                                            */
501/******************************************************************************/
502 int IsinListe(listvar *lin,char *nom)
503{
504   listvar *newvar;
505   variable *v;
506   int out ;
507   
508   newvar=lin;
509   out = 0;
510   while (newvar && (out == 0))
511   {
512      v=newvar->var;
513      if (!strcasecmp(v->v_nomvar,nom) && !strcasecmp(v->v_subroutinename,subroutinename)) {
514      out = 1;
515      }
516      newvar=newvar->suiv;
517   }
518
519   return out ;
520}
521
522listname *Insertname(listname *lin,char *nom, int sens)
523{
524   listname *newvar ;
525   listname *tmpvar;
526
527   newvar=(listname *) malloc (sizeof (listname));
528   strcpy(newvar->n_name,nom);
529   newvar->suiv = NULL;
530   if (!lin)
531   {
532      newvar->suiv=NULL;
533      lin = newvar;
534   }
535   else
536   {
537      if (sens == 0)
538      {
539      tmpvar = lin ;
540      while (tmpvar->suiv)
541      {
542         tmpvar = tmpvar ->suiv ;
543      }
544      tmpvar -> suiv = newvar;
545   }
546      else
547      {
548      newvar->suiv = lin;
549      lin = newvar;
550      }
551   }
552   return lin;
553}
554
555listname *concat_listname(listname *l1, listname *l2)
556{
557   listname *tmpvar;
558
559   tmpvar = l1;
560   while (tmpvar->suiv)
561   {
562    tmpvar = tmpvar->suiv;
563   }
564   
565   tmpvar->suiv = l2;
566   
567   return l1;
568}
569
570void *createstringfromlistname(char *ligne, listname *lin)
571{
572listname *tmpvar;
573
574strcpy(ligne,"");
575tmpvar = lin;
576while(tmpvar)
577{
578  strcat(ligne,tmpvar->n_name);
579  if (tmpvar->suiv) strcat(ligne,",");
580  tmpvar=tmpvar->suiv;
581}
582}
583
584/******************************************************************/
585/* printname  */
586/* print the list given in argulent */
587/******************************************************************/
588
589void printname(listname * lin)
590{
591   listname *newvar;
592
593   newvar=lin;
594   while (newvar)
595   {
596      printf("nom = %s \n",newvar->n_name);
597      newvar=newvar->suiv;
598   }
599}
600
601void removeglobfromlist(listname **lin)
602{
603  listname *listemp;
604  listname *parcours1;
605  listvar *parcours2;
606  listname * parcourspres;
607  int out;
608 
609  parcours1 = *lin;
610  parcourspres = (listname *)NULL;
611 
612  while (parcours1)
613  {
614  parcours2 = List_Global_Var;
615  out = 0;
616  while (parcours2 && out == 0)
617  {
618    if (!strcasecmp(parcours2->var->v_nomvar,parcours1->n_name))
619    {
620    out = 1;
621    }
622    parcours2 = parcours2->suiv;
623  }
624  if (out == 1)
625  {
626  if (parcours1 == *lin)
627   {
628   *lin = (*lin)->suiv;
629   parcours1 = *lin;
630   }
631   else
632   {
633   parcourspres->suiv = parcours1->suiv;
634   parcours1 = parcourspres->suiv;
635   }
636   }
637   else
638   {
639   parcourspres = parcours1;
640    parcours1 = parcours1->suiv; 
641    }
642  }
643}
644
645void writelistpublic(listname *lin)
646{
647  listname *parcours1;
648  char ligne[LONG_40M];
649  char tempname[LONG_4M];
650 
651  if (lin)
652  {
653  sprintf(ligne,"public :: ");
654  parcours1 = lin;
655 
656  while (parcours1)
657  {
658    strcat(ligne,parcours1->n_name);
659    if (parcours1->suiv) strcat(ligne,", ");
660    parcours1 = parcours1->suiv; 
661  }
662  tofich(fortranout,ligne,1);
663  }
664
665}
666
667void Init_List_Data_Var()
668{
669listvar *parcours;
670
671parcours = List_Data_Var_Cur;
672
673if (List_Data_Var_Cur)
674{
675while (parcours)
676{
677 List_Data_Var_Cur = List_Data_Var_Cur->suiv;
678 free(parcours);
679 parcours = List_Data_Var_Cur;
680}
681}
682
683List_Data_Var_Cur = NULL;
684
685}
Note: See TracBrowser for help on using the repository browser.