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

source: trunk/AGRIF/LIB/UtilListe.c @ 396

Last change on this file since 396 was 396, checked in by opalod, 18 years ago

Initial revision

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 19.3 KB
Line 
1/******************************************************************************/
2/*                                                                            */
3/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
4/*                                                                            */
5/*     Copyright (C) 2005 Laurent Debreu (Laurent.Debreu@imag.fr)             */
6/*                        Cyril Mazauric (Cyril.Mazauric@imag.fr)             */
7/*                                                                            */
8/*     This program is free software; you can redistribute it and/or modify   */
9/*    it                                                                      */
10/*                                                                            */
11/*    This program is distributed in the hope that it will be useful,         */
12/*     but WITHOUT ANY WARRANTY; without even the implied warranty of         */
13/*     MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the          */
14/*    GNU General Public License for more details.                            */
15/*                                                                            */
16/******************************************************************************/
17#include <stdio.h>
18#include <stdlib.h>
19#include <string.h>
20#include "decl.h"
21
22
23/******************************************************************************/
24/*                            AddListvartolistvar                             */
25/******************************************************************************/
26/* This subroutine is used to add a listvar l at the end of a listvar         */
27/* glob.                                                                      */
28/*                                                                            */
29/******************************************************************************/
30/*        _______     _______     _______     _______     _______             */
31/*       +      +    +      +    +      +    +      +    +      +             */
32/*       + glob +--->+ glob +--->+ glob +--->+ glob +--->+  l   +             */
33/*       +______+    +______+    +______+    +______+    +______+             */
34/*                                                                            */
35/******************************************************************************/
36listvar * AddListvarToListvar(listvar *l,listvar *glob,int ValueFirstpass)
37{
38   listvar *newvar;
39
40   if ( firstpass == ValueFirstpass )
41   {
42      if ( !glob) glob = l ;
43      else
44      {
45         newvar=glob;
46         while (newvar->suiv) newvar = newvar->suiv;
47         newvar->suiv = l;
48      }
49   }
50   return glob;
51}
52
53/******************************************************************************/
54/*                       CreateAndFillin_Curvar                               */
55/******************************************************************************/
56/* This subroutine is used to create the record corresponding to the          */
57/* list of declaration                                                        */
58/******************************************************************************/
59/*                                                                            */
60/*                                                                            */
61/*                                                                            */
62/*                                                                            */
63/*                                                                            */
64/*                                                                            */
65/******************************************************************************/
66void CreateAndFillin_Curvar(char *type,char *tokname,
67                            listdim *dims,variable *curvar)
68{
69   if (!strcasecmp(type,"character") && CharacterSizeGiven == 1 )   
70                            strcpy(curvar->dimchar,CharacterSize);
71
72  /* On donne la precision de la variable si elle a ete donnee                */
73  curvar->c_star = 0;
74  if ( c_star == 1 ) curvar->c_star = 1;
75  /*                                                                          */
76  if ( lengspecgiven == 1 ) strcpy(curvar->vallengspec,vallengspec);
77  curvar->lengspecgiven=0;
78  if ( lengspecgiven == 1 ) curvar->lengspecgiven=1;
79
80  if ( PrecisionGiven == 1 )  strcpy(curvar->precision,NamePrecision);
81  /* Si cette variable a ete declaree dans un module on met curvar->module=1  */
82  if ( inmoduledeclare == 1 || SaveDeclare == 1)
83  {
84      curvar->module = 1;
85      /* Puis on donne le nom du module dans curvar->modulename               */
86      strcpy(curvar->modulename,curmodulename);
87   }
88   else if (insubroutinedeclare == 1 )
89   /* we give the name of the subroutine to the modulename                    */
90   {
91      strcpy(curvar->modulename,subroutinename);
92   }
93   /* Si cette variable a ete initialisee                                     */
94   if (InitialValueGiven == 1 ) strcpy(curvar->initialvalue,InitValue); 
95   /* Si cette variable est declaree en save                                  */
96   if (SaveDeclare == 1 ) curvar->save = 1;
97   /* Si cette variable est allocatable                                       */
98   if (Allocatabledeclare == 1 ) curvar->allocatable=1;
99   /* if INTENT spec has been given                                           */
100   if ( IntentDeclare == 1 ) strcpy(curvar->IntentSpec,IntentSpec);
101}
102
103
104/******************************************************************************/
105/*                        duplicatelistvar                                    */
106/******************************************************************************/
107/*                                                                            */
108/******************************************************************************/
109listvar * duplicatelistvar(listvar * orig)
110{
111   listvar *newlist;
112   listvar *parcours;
113   listvar *tmplistvar;
114   listvar *tmplistvarprec;
115   listdim *tmplistdim;
116   variable *tmpvar;
117
118   tmplistvarprec = (listvar *)NULL;
119   newlist = (listvar *)NULL;
120   parcours = orig;
121   while ( parcours )
122   {
123      tmplistvar = (listvar *)malloc(sizeof(listvar));
124      tmpvar = (variable *)malloc(sizeof(variable));
125      /*                                                                      */
126      strcpy(tmpvar->typevar,parcours->var->typevar);     
127      strcpy(tmpvar->nomvar,parcours->var->nomvar);     
128      strcpy(tmpvar->oldname,parcours->var->oldname);     
129      strcpy(tmpvar->dimchar,parcours->var->dimchar);     
130      if ( parcours->var->dimension )
131      {
132         tmplistdim = (listdim *)malloc(sizeof(listdim));
133         tmplistdim = parcours->var->dimension;
134         tmpvar->dimension = tmplistdim;
135      }
136      tmpvar->nbdim=parcours->var->nbdim;
137      tmpvar->common=parcours->var->common;
138      tmpvar->positioninblock=parcours->var->positioninblock;
139      tmpvar->module=parcours->var->module;
140      tmpvar->save=parcours->var->save;
141      tmpvar->VariableIsParameter=parcours->var->VariableIsParameter;
142      strcpy(tmpvar->modulename,parcours->var->modulename);     
143      strcpy(tmpvar->commonname,parcours->var->commonname);     
144      strcpy(tmpvar->vallengspec,parcours->var->vallengspec);
145      strcpy(tmpvar->nameinttypename,parcours->var->nameinttypename);
146      tmpvar->lengspecgiven=parcours->var->lengspecgiven;
147      tmpvar->pointedvar=parcours->var->pointedvar;
148      strcpy(tmpvar->commoninfile,parcours->var->commoninfile);     
149      strcpy(tmpvar->subroutinename,parcours->var->subroutinename);     
150      tmpvar->dimensiongiven=parcours->var->dimensiongiven;
151      tmpvar->c_star=parcours->var->c_star;
152      tmpvar->typegiven=parcours->var->typegiven;
153      tmpvar->isparameter=parcours->var->isparameter;
154      strcpy(tmpvar->precision,parcours->var->precision);
155      strcpy(tmpvar->initialvalue,parcours->var->initialvalue);
156      tmpvar->pointerdeclare=parcours->var->pointerdeclare;
157      tmpvar->optionaldeclare=parcours->var->optionaldeclare;
158      tmpvar->allocatable=parcours->var->allocatable;
159      strcpy(tmpvar->IntentSpec,parcours->var->IntentSpec);
160      tmpvar->dimsempty=parcours->var->dimsempty;
161      strcpy(tmpvar->readedlistdimension,parcours->var->readedlistdimension);
162      /*                                                                      */
163      tmplistvar->var = tmpvar;
164      tmplistvar->suiv = NULL;
165      /*                                                                      */
166      if ( !newlist )
167      {
168         newlist = tmplistvar;
169         tmplistvarprec = newlist;
170      }
171      else
172      {
173         tmplistvarprec->suiv = tmplistvar;
174         tmplistvarprec = tmplistvar;
175      }
176      /*                                                                      */
177      parcours = parcours->suiv;
178   }
179   return newlist;
180}
181
182/******************************************************************************/
183/*                           insertdim                                        */
184/******************************************************************************/
185/* This subroutine is used to insert a record in a list of                    */
186/* struct : listdim                                                           */
187/******************************************************************************/
188/*        _______     _______     _______     _______     _______             */
189/*       +      +    +      +    +      +    +      +    +      +             */
190/*       + NEW  +--->+ lin  +--->+ lin  +--->+ lin  +--->+  lin +             */
191/*       +______+    +______+    +______+    +______+    +______+             */
192/*                                                                            */
193/******************************************************************************/
194listdim * insertdim(listdim *lin,typedim nom)
195{
196   listdim *newdim ;
197
198   newdim=(listdim *) malloc (sizeof (listdim));
199   newdim->dim=nom;
200   newdim->suiv=lin;
201   
202   return newdim;
203}
204
205/******************************************************************************/
206/*                           reverse                                          */
207/******************************************************************************/
208/* This subroutine is used to reverse a list                                  */
209/******************************************************************************/
210/*        _______     _______                 _______     _______             */
211/*       +      +    +      +                +      +    +      +             */
212/*       +  A   +--->+   B  +--------------->+  B   +--->+   A  +             */
213/*       +______+    +______+                +______+    +______+             */
214/*                                                                            */
215/******************************************************************************/
216listdim *reverse(listdim *lin)
217{
218   listdim *newdim1;
219   listdim *newdim2;
220   listdim *lout;
221
222   lout=(listdim *) NULL;
223
224   newdim1=lin;
225   while (newdim1)
226   {
227      newdim2=(listdim *) malloc(sizeof(listdim));
228      newdim2->dim=newdim1->dim;
229      newdim2->suiv=lout;
230      lout=newdim2;
231      newdim1=newdim1->suiv;
232   }
233   return lout;
234}
235
236/******************************************************************************/
237/*                            change_dim_char                                 */
238/******************************************************************************/
239/* This subroutine is used to change the dimension in the list lin            */
240/******************************************************************************/
241/*        _______     _______                 _______     _______             */
242/*       +  l   +    +  l   +                +  l   +    +   l  +             */
243/*       + old  +--->+ old  +--------------->+ lin  +--->+  lin +             */
244/*       +______+    +______+                +______+    +______+             */
245/*                                                                            */
246/******************************************************************************/
247void change_dim_char(listdim *lin,listvar * l)
248{
249   listvar *parcours_var;
250   variable *v;
251 
252   
253   parcours_var=l;
254   while(parcours_var)
255   { 
256      v=parcours_var->var;
257      strcpy(v->dimchar,(lin->dim).last);
258      parcours_var=parcours_var->suiv;
259   }
260}
261
262
263/******************************************************************************/
264/*                                num_dims                                    */
265/******************************************************************************/
266/* This subroutine is used to know the dimension of a table                   */
267/******************************************************************************/
268/*                                                                            */
269/*             Dimension(jpi,jpj,jpk) ----------> num_dims = 3                */
270/*                                                                            */
271/******************************************************************************/
272int num_dims(listdim *d)
273{
274   listdim *parcours;
275   int compteur = 0;
276
277   parcours = d;
278   while(parcours)
279   {
280     compteur++;
281     parcours=parcours->suiv;
282   }
283   return compteur; 
284}
285
286
287/******************************************************************************/
288/*                          CREATEVAR                                         */
289/******************************************************************************/
290/* This subroutine is used to create and initialized a record of the          */
291/*      struct : variable                                                     */
292/******************************************************************************/
293variable * createvar(char *nom,listdim *d)
294{
295  variable *var;
296  listdim *dims;
297  char ligne[LONGNOM];
298  char listdimension[LONGNOM];
299
300   var=(variable *) malloc(sizeof(variable));
301   strcpy(var->nomvar,nom);
302   /* Definition of the number of this variable in the table tabvars          */
303   var->indicetabvars = 0;
304   if ( firstpass == 1 && ( aftercontainsdeclare == 0 || 
305                            SaveDeclare == 1          ||
306                            fortran77 == 1 ) 
307      )
308   {
309      indicemaxtabvars = indicemaxtabvars + 1;
310      var->indicetabvars = indicemaxtabvars;
311   }
312   /*                                                                         */
313   var->pointerdeclare=0;
314   var->dimsempty=0;
315   var->optionaldeclare=0;
316   var->dimensiongiven=0;
317   var->isparameter=0;
318   var->positioninblock=0;
319   var->VariableIsParameter = 0;
320   var->PublicDeclare = 0;
321   var->PrivateDeclare = 0;
322   var->ExternalDeclare = 0;
323   var->common=0;
324   var->allocatable=0;
325   var->module=0; 
326   var->typegiven=0;
327   var->save=0;
328   /*                                                                         */
329   strcpy(var->nameinttypename,"");
330   strcpy(listdimension,"");
331   strcpy(var->modulename,"");
332   strcpy(var->commonname,"");
333   strcpy(var->commoninfile,mainfile);
334   strcpy(var->subroutinename,subroutinename);
335   strcpy(var->dimchar,"");
336   strcpy(var->oldname,"");
337   strcpy(var->precision,""); 
338   strcpy(var->initialvalue,""); 
339   strcpy(var->IntentSpec,""); 
340   /*                                                                         */
341   if ( inttypename         == 1 ) strcpy(var->nameinttypename,nameinttypename);
342   if ( optionaldeclare     == 1 ) var->optionaldeclare = 1;
343   if ( pointerdeclare      == 1 ) var->pointerdeclare = 1;
344   if ( VariableIsParameter == 1 ) var->isparameter = 1;
345   if ( VariableIsParameter == 1 ) var->VariableIsParameter = 1 ;
346   if ( PublicDeclare       == 1 ) var->PublicDeclare = 1 ;
347   if ( PrivateDeclare      == 1 ) var->PrivateDeclare = 1;
348   if ( ExternalDeclare     == 1 ) var->ExternalDeclare = 1; 
349   /*                                                                         */
350   var->dimension=d;
351   /* Creation of the string for the dimension of this variable               */
352   dimsempty = 1;
353   if ( d )
354   {
355      var->dimensiongiven=1;
356      dims = d;
357      while (dims)
358      {
359         if ( strcasecmp(dims->dim.first,"") || strcasecmp(dims->dim.last,""))
360                                                                  dimsempty = 0;
361         sprintf(ligne,"%s:%s",dims->dim.first,dims->dim.last);
362         strcat(listdimension,ligne);
363         if ( dims->suiv )
364         {
365            strcat(listdimension,",");     
366         }
367         dims = dims->suiv;
368      }
369      if ( dimsempty == 1 ) var->dimsempty=1;
370   }
371   strcpy(var->readedlistdimension,listdimension);
372   /*                                                                         */
373   var->nbdim=num_dims(d);
374   /*                                                                         */
375   return var;
376}
377
378/******************************************************************************/
379/*                            INSERTVAR                                       */
380/******************************************************************************/
381/* This subroutine is used to insert a record in a list of the                */
382/*      struct : listvar                                                      */
383/******************************************************************************/
384/*        _______     _______     _______     _______     _______             */
385/*       +      +    +      +    +      +    +      +    +      +             */
386/*       +  lin +--->+  lin +--->+ lin  +--->+ lin  +--->+ NEW  +             */
387/*       +______+    +______+    +______+    +______+    +______+             */
388/*                                                                            */
389/*                                                                            */
390/******************************************************************************/
391listvar * insertvar(listvar *lin,variable *v)
392{
393   listvar *newvar ;
394   listvar *tmpvar ;
395
396   newvar=(listvar *) malloc (sizeof (listvar));
397   newvar->var=v;
398   newvar->suiv = NULL;
399   if (!lin)
400   {
401      newvar->suiv=NULL;
402      lin = newvar;
403   }
404   else
405   {
406      tmpvar = lin ;
407      while (tmpvar->suiv)
408      {
409         tmpvar = tmpvar ->suiv ;
410      }
411      tmpvar -> suiv = newvar;   
412   }
413   return lin;
414}
415
416/******************************************************************************/
417/*                             SETTYPE                                        */
418/******************************************************************************/
419/* This subroutine is used to give the same variable type at each             */
420/*      record of the list of the struct : listvar                            */
421/******************************************************************************/
422/*        _______     _______     _______     _______     _______             */
423/*       + REAL +    + REAL +    + REAL +    + REAL +    + REAL +             */
424/*       +  lin +--->+  lin +--->+ lin  +--->+ lin  +--->+ lin  +             */
425/*       +______+    +______+    +______+    +______+    +______+             */
426/*                                                                            */
427/*                                                                            */
428/******************************************************************************/
429listvar *settype(char *nom,listvar *lin)
430{
431   listvar *newvar;
432   variable *v;
433
434   newvar=lin;
435   while (newvar)
436   {
437      v=newvar->var;
438      strcpy(v->typevar,nom);
439      v->typegiven=1;
440      newvar=newvar->suiv;
441   }
442   newvar=lin;
443   return newvar ;
444}
445
Note: See TracBrowser for help on using the repository browser.