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 vendors/AGRIF/dev_r12970_AGRIF_CMEMS/LEX – NEMO

source: vendors/AGRIF/dev_r12970_AGRIF_CMEMS/LEX/convert.y @ 13027

Last change on this file since 13027 was 13027, checked in by rblod, 4 years ago

New AGRIF library, see ticket #2129

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