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 @ 2528

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

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