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.
DiversListe.c in trunk/AGRIF/LIB – NEMO

source: trunk/AGRIF/LIB/DiversListe.c @ 663

Last change on this file since 663 was 663, checked in by opalod, 17 years ago

RB: update CONV
  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 23.3 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.6                                                                */
34/******************************************************************************/
35#include <stdio.h>
36#include <stdlib.h>
37#include <string.h>
38#include "decl.h"
39
40/******************************************************************************/
41/*                           Add_Common_var_1                                 */
42/******************************************************************************/
43/*  This subroutines is used to add the variable defined in common in the     */
44/*     List_Common_Var                                                        */
45/******************************************************************************/
46/*                                                                            */
47/******************************************************************************/
48void Add_Common_var_1()
49{
50   listvar *newvar;
51   listvar *newvar2;
52   variable *newvariable;
53   listdim *dims;
54   char listdimension[LONGNOM];
55   char ligne[LONGNOM];
56   int out;
57
58   if ( firstpass == 1 )
59   {
60
61   newvar = (listvar *)malloc(sizeof(listvar));
62   newvariable = (variable *)malloc(sizeof(variable));
63   /*                                                                         */
64   Init_Variable(newvariable);
65   /*                                                                         */
66   strcpy(newvariable->v_nomvar,commonvar);
67   strcpy(newvariable->v_commonname,commonblockname);
68   strcpy(newvariable->v_modulename,curmodulename);
69   strcpy(newvariable->v_subroutinename,subroutinename);
70   newvariable->v_positioninblock= positioninblock;
71   newvariable->v_common=1;
72   strcpy(newvariable->v_commoninfile,mainfile);
73
74   newvar->var = newvariable;
75
76   if ( commondim )
77   {
78      newvariable->v_dimension=commondim;
79      newvariable->v_dimensiongiven=1;
80      newvariable->v_nbdim=num_dims(commondim);
81      /* Creation of the string for the dimension of this variable            */
82      dimsempty = 1;
83      strcpy(listdimension,"");
84
85      if ( commondim )
86      {
87         dims = commondim;
88         while (dims)
89         {
90            if ( strcasecmp(dims->dim.first,"") ||
91                 strcasecmp(dims->dim.last,""))  dimsempty = 0;
92            sprintf(ligne,"%s:%s",dims->dim.first,dims->dim.last);
93            strcat(listdimension,ligne);
94            if ( dims->suiv ) strcat(listdimension,",");
95            dims = dims->suiv;
96         }
97         if ( dimsempty == 1 ) newvariable->v_dimsempty=1;
98      }
99      strcpy(newvariable->v_readedlistdimension,listdimension);
100   }
101
102
103   newvar->suiv = NULL;
104
105   if ( !List_Common_Var )
106   {
107      List_Common_Var = newvar;
108   }
109   else
110   {
111      newvar2 = List_Common_Var;
112      out = 0 ;
113      while ( newvar2 && out == 0 )
114      {
115         if ( !strcasecmp(newvar2->var->v_nomvar,commonvar) &&
116              !strcasecmp(newvar2->var->v_commonname,commonblockname) &&
117              !strcasecmp(newvar2->var->v_subroutinename,subroutinename)
118                          ) out = 1 ;
119         else newvar2 = newvar2->suiv;
120      }
121      if ( out == 0 )
122      {
123         newvar->suiv = List_Common_Var;
124         List_Common_Var = newvar;
125      }
126      else
127      {
128         free(newvar);
129      }
130   }
131   }
132}
133
134/******************************************************************************/
135/*                           Addtolistnom                                     */
136/******************************************************************************/
137/* This subroutine is used to add a variable to the list                      */
138/******************************************************************************/
139/*                                                                            */
140/******************************************************************************/
141listnom *Addtolistnom(char *nom, listnom *listin,int value)
142{
143   listnom *newnom;
144   listnom *parcours;
145   int out;
146
147   newnom=(listnom *) malloc (sizeof (listnom));
148   strcpy(newnom->o_nom,nom);
149   newnom->o_val = value;
150   newnom->suiv = NULL;
151
152   if ( !listin ) listin = newnom;
153   else
154   {
155      parcours = listin;
156      out = 0 ;
157      while ( parcours && out == 0 )
158      {
159         if ( !strcasecmp(parcours->o_nom,nom) ) out = 1 ;
160         else parcours=parcours->suiv;
161      }
162      if ( out == 0 )
163      {
164          newnom->suiv = listin;
165          listin = newnom;
166      }
167      else
168      {
169         free(newnom);
170      }
171   }
172   return listin;
173}
174
175/******************************************************************************/
176/*                           Addtolistname                                    */
177/******************************************************************************/
178/* This subroutine is used to add a        variable to the list               */
179/******************************************************************************/
180/*        _______     _______     _______     _______     _______             */
181/*       +      +    +      +    +      +    +      +    +      +             */
182/*       + NEW  +--->+ glob +--->+ glob +--->+ glob +--->+ glob +             */
183/*       +______+    +______+    +______+    +______+    +______+             */
184/*                                                                            */
185/*                                                                            */
186/*                                                                            */
187/******************************************************************************/
188listname *Addtolistname(char *nom,listname *input)
189{
190   listname *newnom;
191   listname *parcours;
192   int out;
193
194   if ( !input )
195   {
196      newnom=(listname *) malloc (sizeof (listname));
197      strcpy(newnom->n_name,nom);
198      newnom->suiv = NULL;
199      input = newnom;
200   }
201   else
202   {
203      parcours = input;
204      out = 0 ;
205      while ( parcours && out == 0 )
206      {
207         if ( !strcasecmp(parcours->n_name,nom) ) out = 1;
208         else parcours=parcours->suiv;
209      }
210      if ( out == 0 )
211      {
212         newnom=(listname *) malloc (sizeof (listname));
213         strcpy(newnom->n_name,nom);
214         newnom->suiv = input;
215         input = newnom;
216      }
217   }
218   return input;
219}
220
221/******************************************************************************/
222/*                    ModuleIsDefineInInputFile                               */
223/******************************************************************************/
224/* This subroutine is used to know if the module is defined in the input file */
225/******************************************************************************/
226/*                                                                            */
227/*                                                                            */
228/******************************************************************************/
229int ModuleIsDefineInInputFile(char *name)
230{
231   listnom *newnom;
232   int out;
233
234   out = 0;
235   if ( listofmodules )
236   {
237      newnom = listofmodules;
238      while( newnom && out == 0 )
239      {
240         if ( !strcasecmp(newnom->o_nom,name) ) out = 1 ;
241         else newnom=newnom->suiv;
242      }
243   }
244   return out;
245}
246
247/******************************************************************************/
248/*                      Addmoduletothelisttmp                                 */
249/******************************************************************************/
250/* This subroutine is used to add a record to a list of struct                */
251/* listusemodule                                                              */
252/******************************************************************************/
253/*                                                                            */
254/*       subroutine sub ... USE mod1 ===> insert in list                      */
255/*        _______     _______     _______     _______     _______             */
256/*       +      +    +      +    +      +    +      +    +      +             */
257/*       + NEW  +--->+ list +--->+ list +--->+ list +--->+ list +             */
258/*       +______+    +______+    +______+    +______+    +______+             */
259/*                                                                            */
260/*       list =  listofmoduletmp                                              */
261/*                                                                            */
262/******************************************************************************/
263void Addmoduletothelisttmp(char *name)
264{
265  listusemodule *newmodule;
266  listusemodule *parcours;
267  int out;
268
269  if ( !listofmoduletmp)
270  {
271    newmodule =(listusemodule *)malloc(sizeof(listusemodule));
272    strcpy(newmodule->u_usemodule,name);
273    strcpy(newmodule->u_cursubroutine,subroutinename);
274    newmodule->suiv = NULL;
275    listofmoduletmp = newmodule ;
276  }
277  else
278  {
279    parcours = listofmoduletmp;
280    out = 0;
281    while( parcours && out == 0 )
282    {
283       if ( !strcasecmp(parcours->u_usemodule,name) ) out = 1;
284       else parcours = parcours->suiv;
285    }
286    if ( out == 0 )
287    {
288       newmodule =(listusemodule *)malloc(sizeof(listusemodule));
289       strcpy(newmodule->u_usemodule,name);
290       strcpy(newmodule->u_cursubroutine,subroutinename);
291       newmodule->suiv = listofmoduletmp;
292       listofmoduletmp = newmodule;
293    }
294  }
295}
296
297/******************************************************************************/
298/*                          Add_NameOfModule_1                                */
299/******************************************************************************/
300/* This subroutine is used to add a        variable to the list               */
301/******************************************************************************/
302/*        _______     _______     _______     _______     _______             */
303/*       +      +    +      +    +      +    +      +    +      +             */
304/*       + NEW  +--->+ glob +--->+ glob +--->+ glob +--->+ glob +             */
305/*       +______+    +______+    +______+    +______+    +______+             */
306/*                                                                            */
307/*                                                                            */
308/*                                                                            */
309/******************************************************************************/
310void Add_NameOfModule_1(char *nom)
311{
312   listnom *newnom;
313
314   if ( firstpass == 1 )
315   {
316      newnom=(listnom *) malloc (sizeof (listnom));
317      strcpy(newnom->o_nom,nom);
318      newnom->suiv = List_NameOfModule;
319      List_NameOfModule = newnom;
320   }
321}
322
323/******************************************************************************/
324/*                          Add_NameOfCommon_1                                */
325/******************************************************************************/
326/* This subroutine is used to add a        variable to the list               */
327/******************************************************************************/
328/*        _______     _______     _______     _______     _______             */
329/*       +      +    +      +    +      +    +      +    +      +             */
330/*       + NEW  +--->+ glob +--->+ glob +--->+ glob +--->+ glob +             */
331/*       +______+    +______+    +______+    +______+    +______+             */
332/*                                                                            */
333/*                                                                            */
334/*                                                                            */
335/******************************************************************************/
336void Add_NameOfCommon_1(char *nom)
337{
338   listnom *newnom;
339   listnom *parcours;
340
341   if ( firstpass == 1 )
342   {
343      parcours = List_NameOfCommon;
344      while ( parcours && strcasecmp(parcours->o_nom,nom) )
345                                                      parcours = parcours->suiv;
346      if ( !parcours )
347      {
348         newnom=(listnom *) malloc (sizeof (listnom));
349         strcpy(newnom->o_nom,nom);
350         newnom->suiv = List_NameOfCommon;
351         List_NameOfCommon = newnom;
352      }
353   }
354}
355
356/******************************************************************************/
357/*                     Add_CouplePointed_Var_1                                */
358/******************************************************************************/
359/* Firstpass 1                                                                */
360/* We should complete the listvarpointtovar                                   */
361/******************************************************************************/
362/*                                                                            */
363/******************************************************************************/
364void Add_CouplePointed_Var_1(char *namemodule,listcouple *couple)
365{
366   listvarpointtovar *pointtmp;
367
368   if ( firstpass == 1 )
369   {
370      /* we should complete the List_CouplePointed_Var                        */
371      pointtmp=(listvarpointtovar *)malloc(sizeof(listvarpointtovar));
372      strcpy(pointtmp->t_usemodule,namemodule);
373      strcpy(pointtmp->t_cursubroutine,subroutinename);
374      pointtmp->t_couple = couple;
375      if ( List_CouplePointed_Var )
376      {
377         pointtmp->suiv = List_CouplePointed_Var;
378         List_CouplePointed_Var = pointtmp;
379      }
380      else
381      {
382         pointtmp->suiv = NULL;
383         List_CouplePointed_Var = pointtmp;
384      }
385   }
386}
387
388/******************************************************************************/
389/*                           Add_Include_1                                    */
390/******************************************************************************/
391/* This subroutine is used to add a record to a list of struct                */
392/*  List_Include                                                              */
393/******************************************************************************/
394/*                                                                            */
395/*       subroutine sub ... include mod1 ===> insert in list                  */
396/*        _______     _______     _______     _______     _______             */
397/*       +      +    +      +    +      +    +      +    +      +             */
398/*       + NEW  +--->+ list +--->+ list +--->+ list +--->+ list +             */
399/*       +______+    +______+    +______+    +______+    +______+             */
400/*                                                                            */
401/*       list =  List_Include                                                 */
402/*                                                                            */
403/******************************************************************************/
404void Add_Include_1(char *name)
405{
406  listusemodule *newinclude;
407
408  if ( firstpass == 1 )
409  {
410  newinclude =(listusemodule *)malloc(sizeof(listusemodule));
411  strcpy(newinclude->u_usemodule,name);
412  strcpy(newinclude->u_cursubroutine,subroutinename);
413  newinclude->suiv = NULL;
414
415  if ( !List_Include)
416  {
417     List_Include  = newinclude ;
418  }
419  else
420  {
421    newinclude->suiv = List_Include;
422    List_Include = newinclude;
423  }
424  }
425}
426
427/******************************************************************************/
428/*                     Add_ImplicitNoneSubroutine_1                           */
429/******************************************************************************/
430/* This subroutine is used to add a record to a list of struct                */
431/******************************************************************************/
432/*                                                                            */
433/*                                                                            */
434/******************************************************************************/
435void Add_ImplicitNoneSubroutine_1()
436{
437
438  if ( firstpass == 1 )
439  {
440     List_ImplicitNoneSubroutine = Addtolistname(subroutinename,
441                                                   List_ImplicitNoneSubroutine);
442  }
443}
444
445
446/******************************************************************************/
447/*                        WriteIncludeDeclaration                             */
448/******************************************************************************/
449/* Firstpass 0                                                                */
450/******************************************************************************/
451/*                                                                            */
452/******************************************************************************/
453void WriteIncludeDeclaration()
454{
455  listusemodule *newinclude;
456
457  newinclude = List_Include;
458  fprintf(fortranout,"\n");
459  while ( newinclude )
460  {
461     if ( !strcasecmp(newinclude->u_cursubroutine,subroutinename) )
462     {
463        fprintf(fortranout,"      INCLUDE %s \n",newinclude->u_usemodule);
464     }
465     newinclude = newinclude ->suiv;
466  }
467}
468
469/******************************************************************************/
470/*                          Add_Save_Var_1                                    */
471/******************************************************************************/
472/* This subroutine is used to add a record to List_Save_Var                   */
473/******************************************************************************/
474/*        _______     _______     _______     _______     _______             */
475/*       +      +    +      +    +      +    +      +    +      +             */
476/*       + NEW  +--->+ Save +--->+ Save +--->+ Save +--->+  Save+             */
477/*       +______+    +______+    +______+    +______+    +______+             */
478/*                                                                            */
479/******************************************************************************/
480void Add_Save_Var_1 (char *name,listdim *d)
481{
482  listvar *newvar;
483  listdim *dims;
484  char ligne[LONGNOM];
485  char listdimension[LONGNOM];
486
487  if ( firstpass == 1 )
488  {
489     newvar=(listvar *)malloc(sizeof(listvar));
490     newvar->var=(variable *)malloc(sizeof(variable));
491     /*                                                                       */
492     Init_Variable(newvar->var);
493     /*                                                                       */
494     newvar->var->v_save=1;
495     strcpy(newvar->var->v_nomvar,name);
496     strcpy(newvar->var->v_modulename,curmodulename);
497     strcpy(newvar->var->v_subroutinename,subroutinename);
498     strcpy(newvar->var->v_commoninfile,mainfile);
499
500     newvar->var->v_dimension=d;
501     /* Creation of the string for the dimension of this variable             */
502     dimsempty = 1;
503     if ( d )
504     {
505        newvar->var->v_dimensiongiven=1;
506        dims = d;
507        while (dims)
508        {
509           if ( strcasecmp(dims->dim.first,"") || strcasecmp(dims->dim.last,""))
510                                                                  dimsempty = 0;
511           sprintf(ligne,"%s:%s",dims->dim.first,dims->dim.last);
512           strcat(listdimension,ligne);
513           if ( dims->suiv )
514           {
515              strcat(listdimension,",");
516           }
517           dims = dims->suiv;
518        }
519        if ( dimsempty == 1 ) newvar->var->v_dimsempty=1;
520     }
521     strcpy(newvar->var->v_readedlistdimension,listdimension);
522     /*                                                                       */
523     newvar->suiv = NULL;
524
525     if ( !List_Save_Var )
526     {
527        List_Save_Var  = newvar ;
528     }
529     else
530     {
531        newvar->suiv = List_Save_Var;
532        List_Save_Var = newvar;
533     }
534  }
535}
536
537void Add_Save_Var_dcl_1 (listvar *var)
538{
539  listvar *newvar;
540  listvar *parcours;
541  listdim *dims;
542  char ligne[LONGNOM];
543  char listdimension[LONGNOM];
544
545  if ( firstpass == 1 )
546  {
547     parcours = var;
548     while ( parcours )
549     {
550        newvar=(listvar *)malloc(sizeof(listvar));
551        newvar->var=(variable *)malloc(sizeof(variable));
552        /*                                                                    */
553        Init_Variable(newvar->var);
554        /*                                                                    */
555        newvar->var->v_save=1;
556        strcpy(newvar->var->v_nomvar,parcours->var->v_nomvar);
557        strcpy(newvar->var->v_modulename,curmodulename);
558        strcpy(newvar->var->v_subroutinename,subroutinename);
559        strcpy(newvar->var->v_commoninfile,mainfile);
560        /*                                                                    */
561        strcpy(newvar->var->v_readedlistdimension,
562             parcours->var->v_readedlistdimension);
563        newvar->var->v_nbdim = parcours->var->v_nbdim;
564        newvar->var->v_dimension = parcours->var->v_dimension;
565        /*                                                                    */
566        newvar->var->v_dimensiongiven=parcours->var->v_dimensiongiven;
567        /*                                                                    */
568        newvar->suiv = NULL;
569
570        if ( !List_Save_Var ) List_Save_Var  = newvar ;
571        else
572        {
573           newvar->suiv = List_Save_Var;
574           List_Save_Var = newvar;
575        }
576        parcours = parcours->suiv;
577     }
578  }
579}
Note: See TracBrowser for help on using the repository browser.