source: branches/2015/dev_r5021_UKMO1_CICE_coupling/NEMOGCM/EXTERNAL/AGRIF/LIB/UtilListe.c @ 5445

Last change on this file since 5445 was 5445, checked in by davestorkey, 5 years ago

Clear SVN keywords from 2015/dev_r5021_UKMO1_CICE_coupling branch.

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