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