source: branches/UKMO/dev_r5518_v3.6_asm_nemovar_community_ersem_hem08/NEMOGCM/EXTERNAL/AGRIF/LEX/convert.y @ 9319

Last change on this file since 9319 was 7731, checked in by dford, 4 years ago

Merge in revisions 6625:7726 of dev_r5518_v3.4_asm_nemovar_community, so this branch will be identical to revison 7726 of dev_r5518_v3.6_asm_nemovar_community.

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