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

source: trunk/AGRIF/LIB/convert.y @ 1200

Last change on this file since 1200 was 1200, checked in by rblod, 16 years ago

Adapt Agrif to the new SBC and correct several bugs for agrif (restart writing and reading), see ticket #133
Note : this fix does not work yet on NEC computerq (sxf90/360)

  • Property svn:eol-style set to native
  • Property svn:keywords set to Author Date Id Revision
File size: 16.9 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%{
36#include <stdlib.h>
37#include <stdio.h>
38#include <string.h>
39#include "decl.h"
40%}
41
42%union {
43       int ival;
44       char na[LONG_C];
45       listnom * ln;
46       }
47
48%token TOK_SEP
49%token TOK_USE
50%token TOK_MODULEMAIN      /* name of the module                              */
51%token TOK_NOTGRIDDEP      /* Variable which are not grid dependent           */
52%token <na> TOK_USEITEM
53%token <na> TOK_NAME
54%token <na> TOK_PROBTYPE   /* dimension of the problem                        */
55%token ','
56%token ';'
57%token ':'
58%token '('
59%token ')'
60%token '['
61%token ']'
62%%
63input :
64      | input line
65;
66line :'\n'
67      | TOK_PROBTYPE TOK_NAME ';'                   {initdimprob(1,$2,"0","0");}
68      | TOK_PROBTYPE TOK_NAME ',' TOK_NAME ';'      {initdimprob(2,$2, $4,"0");}
69      | TOK_PROBTYPE TOK_NAME ',' TOK_NAME ',' TOK_NAME ';'
70                                                    {initdimprob(3,$2, $4, $6);}
71      | TOK_MODULEMAIN TOK_NAME ';'
72                             {listofmodules = Addtolistnom($2,listofmodules,0);
73                                                        Addmoduletothelist($2);}
74      | TOK_NOTGRIDDEP TOK_SEP TOK_NAME ';'       {Add_NotGridDepend_Var_1($3);}
75      | TOK_USE TOK_USEITEM ';'  {
76                                    if (!strcasecmp($2,"FIXED_GRIDS"))
77                                                                 fixedgrids=1;
78                                    if (!strcasecmp($2,"ONLY_FIXED_GRIDS"))
79                                                             onlyfixedgrids=1;
80                                 }
81      ;
82%%
83
84int main(int argc,char *argv[])
85{
86   extern FILE * yyin ;
87   FILE *dependglobaloutput;
88   int i;
89   listnom *parcours;
90   listvar *newvar;
91   int stylegiven = 0;
92   int infreegiven ;
93   int infixedgiven ;
94   int lengthmainfile;
95
96   if (argc < 2)
97   {
98       printf("usage : conv <file> [-rm] [-incdir <directory>] \n");
99       printf(" [-comdirin   <directory>] [-comdirout <directory>]\n");
100       printf(" [-convfile  <FILENAME >] -SubloopScalar -SubloopScalar1 \n");
101       printf(" [-free|-fixed]\n");
102       exit(0);
103   }
104/******************************************************************************/
105/*  1-  Variables initialization                                              */
106/******************************************************************************/
107   List_Global_Var=(listvar *)NULL;
108   List_GlobalParameter_Var=(listvar *)NULL;
109   List_Allocate_Var=(listallocate *)NULL;
110   List_Common_Var=(listvar *)NULL;
111   List_SubroutineWhereAgrifUsed=(listnom *)NULL;
112   List_Subroutine_For_Alloc=(listnom *)NULL;
113   List_Include=(listusemodule *)NULL;
114   List_NameOfModuleUsed=(listusemodule *)NULL;
115   listofmoduletmp=(listusemodule *)NULL;
116   List_SubroutineDeclaration_Var=(listvar *)NULL;
117   List_UsedInSubroutine_Var=(listvar *)NULL;
118   List_NotGridDepend_Var=(listvar *)NULL;
119   Listofavailableindices=(listindice *)NULL;
120   List_CouplePointed_Var=(listvarpointtovar *)NULL;
121   List_ModuleUsed_Var = (listvar *)NULL;
122   List_ModuleUsedInModuleUsed_Var = (listvar *)NULL;
123   List_GlobParamModuleUsed_Var = (listparameter *)NULL;
124   List_GlobParamModuleUsedInModuleUsed_Var = (listparameter *)NULL;
125   List_SubroutineArgument_Var = (listvar *)NULL;
126   List_FunctionType_Var = (listvar *)NULL;
127   tmpuselocallist = (listusemodule *)NULL;
128   List_ContainsSubroutine = (listnom *)NULL;
129   oldfortranout = (FILE *)NULL;
130
131   strcpy(mainfile,argv[1]);
132   strcpy(nomdir,"AGRIF_INC");
133   strcpy(commondirin,".");
134   strcpy(commondirout,".");
135   strcpy(filetoparse," ");
136   strcpy(subofagrifinitgrids,"");
137   strcpy(meetagrifinitgrids,"");
138   strcpy(mpiinitvar,"");
139
140   length_last = 0 ;
141   length_first = 0 ;
142   length_v_typevar = 0 ;
143   length_v_nomvar = 0 ;
144   length_v_dimchar = 0 ;
145   length_v_modulename = 0 ;
146   length_v_commonname = 0 ;
147   length_v_vallengspec = 0 ;
148   length_v_nameinttypename = 0 ;
149   length_v_commoninfile = 0 ;
150   length_v_subroutinename = 0 ;
151   length_v_precision = 0 ;
152   length_v_IntentSpec = 0 ;
153   length_v_initialvalue = 0 ;
154   length_v_readedlistdimension = 0 ;
155   length_u_usemodule = 0 ;
156   length_u_charusemodule = 0 ;
157   length_u_cursubroutine = 0 ;
158   length_u_modulename = 0 ;
159   length_n_name = 0 ;
160   length_c_namevar = 0 ;
161   length_c_namepointedvar = 0 ;
162   length_o_nom = 0 ;
163   length_o_module = 0 ;
164   length_a_nomvar = 0 ;
165   length_a_subroutine = 0 ;
166   length_a_module = 0 ;
167   length_t_usemodule = 0 ;
168   length_t_cursubroutine = 0 ;
169   length_curfilename = 0 ;
170   length_nomfileoutput = 0 ;
171   length_motparse = 0 ;
172   length_mainfile = 0 ;
173   length_nomdir = 0 ;
174   length_commondirout = 0 ;
175   length_commondirin = 0 ;
176   length_filetoparse = 0 ;
177   length_curbuf = 0 ;
178   length_toprintglob = 0 ;
179   length_tmpvargridname = 0 ;
180   length_ligne_Subloop = 0 ;
181   length_lvargridname_toamr = 0 ;
182   length_toprint_utilagrif = 0 ;
183   length_toprinttmp_utilchar = 0 ;
184   length_ligne_writedecl = 0 ;
185   length_newname_toamr = 0 ;
186   length_newname_writedecl = 0 ;
187   length_ligne_toamr = 0 ;
188   length_tmpligne_writedecl = 0 ;
189   value_char_size = 0 ;
190   value_char_size1 = 0 ;
191   value_char_size2 = 0 ;
192   value_char_size3 = 0 ;
193   inallocate = 0;
194   infixed = 1;
195   infree  = 0;
196
197   checkexistcommon=1;
198   todebug=0;
199   onlyfixedgrids=0;
200   fixedgrids=0;
201   InAgrifParentDef = 0;
202   IndicenbmaillesX=0;
203   IndicenbmaillesY=0;
204   IndicenbmaillesZ=0;
205   created_dimensionlist = 1;
206   indicemaxtabvars = 0;   /* current indice in the table tabvars             */
207   SubloopScalar = 0;
208   todebug = 0;
209   todebugfree = 0;
210   retour77 = 1 ;
211   mark = 0 ;
212   shouldincludempif = 0 ;
213   Read_val_max();
214/******************************************************************************/
215/*  2-  Program arguments                                                     */
216/******************************************************************************/
217
218   if ((yyin=fopen(argv[1],"r"))==NULL)
219   {
220      printf("the file %s doesn't exist \n",argv[1]);
221      exit(0);
222   }
223
224   i=2;
225   while (i<argc)
226   {
227      if (!strcasecmp(argv[i],"-incdir"))
228      {
229         strcpy(nomdir,argv[i+1]);
230         i++;
231      }
232      else if (!strcasecmp(argv[i],"-comdirin")) /* input directory           */
233      {
234         strcpy(commondirin,argv[i+1]);
235         i++;
236      }
237      else if (!strcasecmp(argv[i],"-comdirout")) /* output directory         */
238      {
239         strcpy(commondirout,argv[i+1]);
240         i++;
241      }
242      else if (!strcasecmp(argv[i],"-convfile")) /* file to parse             */
243      {
244         strcpy(filetoparse,argv[i+1]);
245         i++;
246         lengthmainfile = strlen(filetoparse);
247         if (!strcasecmp(&filetoparse[lengthmainfile-4],".f90"))
248         {
249         infixed = 0;
250         infree = 1;
251         }
252         else
253         {
254         infixed = 1;
255         infree = 0;
256         }
257      }
258      else if (!strcasecmp(argv[i],"-free")) /* file to parse        */
259      {
260         stylegiven = 1;
261         infreegiven  = 1 ;
262         infixedgiven = 0;
263      }   
264      else if (!strcasecmp(argv[i],"-fixed")) /* file to parse        */
265      {
266         stylegiven = 1;
267         infreegiven  = 0;
268         infixedgiven = 1;
269      }         
270      else if (!strcasecmp(argv[i],"-SubloopScalar")) /* file to parse        */
271      {
272         SubloopScalar = 1 ;
273      }
274      else if (!strcasecmp(argv[i],"-SubloopScalar1")) /* file to parse       */
275      {
276         SubloopScalar = 2 ;
277      }
278      else if (!strcasecmp(argv[i],"-todebug")) /* file to parse       */
279      {
280         todebug = 1 ;
281      }
282      else if (!strcasecmp(argv[i],"-mark")) /* file to parse       */
283      {
284         mark = 1 ;
285      }
286      else if (!strcasecmp(argv[i],"-todebugfree")) /* file to parse       */
287      {
288         todebugfree = 1 ;
289      }
290      else if (!strcasecmp(argv[i],"-rm"))
291      {
292         checkexistcommon=0;
293      }
294      else
295      {
296         printf("Unkwon option : %s\n",argv[i]);
297         exit(0);
298      }
299      i++;
300   }
301
302   if (stylegiven == 1)
303   {
304   infree = infreegiven;
305   infixed = infixedgiven;   
306   }
307   Save_Length(nomdir,34);
308   Save_Length(commondirout,35);
309   Save_Length(commondirin,36);
310   Save_Length(filetoparse,37);
311
312/******************************************************************************/
313/*  3-  Parsing of the  conv file <name>.in                                   */
314/******************************************************************************/
315
316   if ((yyin=fopen(argv[1],"r"))==NULL)
317   {
318       printf("the file %s doesn't exist \n",argv[1]);
319       exit(0);
320   }
321   strcpy(mainfile,argv[1]);
322   Save_Length(mainfile,33);
323
324   if ( strstr(filetoparse,".f90") ||
325        strstr(filetoparse,".F90") ) retour77 = 0;
326
327   yyparse();
328
329/******************************************************************************/
330/*  4-  Preparation of the file parsing                                       */
331/******************************************************************************/
332   if ((yyin=fopen(filetoparse,"r"))==NULL) /* Is the file to parse exist ?   */
333   {
334      printf("the file %s doesn't exist \n",filetoparse);
335      exit(0);
336   }
337   /* mainfile : the name of the file to parse                                */
338   strcpy(mainfile,filetoparse);
339   /*                                                                         */
340   if ((dependglobaloutput=fopen(".dependglobal_agrif","r"))!=NULL)
341   {
342      fscanf(dependglobaloutput,"%d\n",&indicemaxtabvars);
343      fclose(dependglobaloutput);
344   }
345   Readthedependavailablefile();
346   /* Read the .dependnbxnby file which contains indices of nbmaillsX,        */
347   /*    nbmailleY and nbmailleZ                                              */
348   Readthedependnbxnbyfile();
349   Read_Subroutine_For_Alloc();
350/******************************************************************************/
351/*  5-  Parsing of the input file (2 times)                                   */
352/******************************************************************************/
353   /* Record all variable in list                                             */
354   firstpass = 1;
355   processfortran(filetoparse);
356   /*                                                                         */
357   CompleteThelistvarindoloop();
358   /* Read list of module used                                                */
359   RecordUseModulesVariables();
360   /* Read list of module used in module used                                 */
361   RecordUseModulesUseModulesVariables();
362   /* Save variables are considered as globals ones                           */
363   Update_List_Global_Var_From_List_Save_Var();
364   /* Update all lists                                                        */
365   ListUpdate();
366   /*                                                                         */
367   Clean_List_Global_Var();
368   /* Indice tabvars identification                                           */
369   IndiceTabvarsIdentification();
370   /* Update all lists                                                        */
371   ListUpdate();
372   /* The allocation subroutine is necessary ????                             */
373   New_Allocate_Subroutine_Is_Necessary();
374   /* The allocation subroutine is necessary for common list                  */
375   New_Allocate_Subroutine_For_Common_Is_Necessary();
376   /* Sort List_SubroutineArgument_Var                                        */
377   Sort_List_SubroutineArgument_Var();
378   /* Clean all lists                                                         */
379   ListClean();
380   /* Update Indice of List_UsedInSubroutine_Var from module used             */
381   List_UsedInSubroutine_Var_Update_From_Module_Used();
382   /* Update List_SubroutineWhereAgrifUsed                                    */
383   UpdateList_SubroutineWhereAgrifUsed();
384   /* Update List_UsedInSubroutine_Var with v_readedlistdimension             */
385   UpdateList_UsedInSubroutine_With_dimension();;
386   /*                                                                         */
387   ModifyThelistvarindoloop();
388   /*                                                                         */
389   UpdateListDeclarationWithDimensionList();
390   /*                                                                         */
391   GiveTypeOfVariables();
392   Affiche();
393   /* Build new subroutines                                                   */
394   firstpass = 0;
395   processfortran(filetoparse);
396
397   newvar = (listvar *)NULL;
398/*newvar = List_Global_Var; */
399   while ( newvar )
400   {
401      printf("++++ %s %d %s %s %s\n",
402      newvar->var->v_nomvar,
403      newvar->var->v_nbdim,
404      newvar->var->v_subroutinename,
405      newvar->var->v_modulename,
406      newvar->var->v_typevar
407             );
408      newvar = newvar->suiv;
409   }
410/******************************************************************************/
411/*  6-  Write informations in output files                                    */
412/******************************************************************************/
413
414   /* Write the .dependglobal_agrif file which contain the max indice         */
415   /*    of the tabvars table                                                 */
416   dependglobaloutput = fopen(".dependglobal_agrif","w");
417   fprintf(dependglobaloutput,"%d\n",indicemaxtabvars);
418   fclose(dependglobaloutput);
419   /* Write the list of available indice                                      */
420   Writethedependavailablefile();
421   /* Write the .dependnbxnby file which contains indices of nbmaillsX,       */
422   /*    nbmailleY and nbmailleZ                                              */
423   Writethedependnbxnbyfile();
424   /* Write the .depend<namefile> file which contain general informations     */
425   /*    about variable of this file                                          */
426   parcours = List_NameOfModule;
427   while( parcours )
428   {
429      Writethedependlistofmoduleused(parcours->o_nom);
430      WritedependParameterList(parcours->o_nom);
431      Writethedependfile(parcours->o_nom,List_Global_Var);
432      parcours=parcours->suiv;
433   }
434   parcours = List_NameOfCommon;
435   while( parcours )
436   {
437      Writethedependfile(parcours->o_nom,List_Common_Var);
438      parcours=parcours->suiv;
439   }
440   Write_Subroutine_For_Alloc();
441/******************************************************************************/
442/*  7-  Create files in AGRIF_INC directory                                   */
443/******************************************************************************/
444   creefichieramr(NameTamponfile);
445
446   Write_val_max();
447
448   if ( todebug == 1 ) printf("Out of CONV \n");
449   return 0;
450}
Note: See TracBrowser for help on using the repository browser.