source: branches/2015/dev_r5021_UKMO1_CICE_coupling/NEMOGCM/EXTERNAL/AGRIF/LIB/convert.y @ 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: 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.