source: branches/UKMO/dev_r5518_v3.6_asm_nemovar_community_ersem_hem08/NEMOGCM/EXTERNAL/AGRIF/LEX/fortran.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: 67.5 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%{
37#define YYMAXDEPTH 1000
38#include <stdlib.h>
39#include <stdio.h>
40#include <string.h>
41#include "decl.h"
42
43extern int line_num_input;
44extern char *fortran_text;
45
46char c_selectorname[LONG_M];
47char ligne[LONG_M];
48char truename[LONG_VNAME];
49char identcopy[LONG_VNAME];
50int c_selectorgiven=0;
51listvar *curlistvar;
52typedim c_selectordim;
53listcouple *coupletmp;
54int removeline=0;
55listvar *test;
56
57int fortran_error(const char *s)
58{
59    printf("%s line %d, file %s motclef = |%s|\n", s, line_num_input, cur_filename, fortran_text);
60    exit(1);
61}
62
63%}
64
65%union {
66    char        na[LONG_M];
67    listdim     *d;
68    listvar     *l;
69    listcouple  *lc;
70    listname    *lnn;
71    typedim     dim1;
72    variable    *v;
73}
74
75%left ','
76%nonassoc ':'
77%right '='
78%left TOK_EQV TOK_NEQV
79%left TOK_OR TOK_XOR
80%left TOK_AND
81%left TOK_NOT
82%nonassoc TOK_LT TOK_GT TOK_LE TOK_GE TOK_EQ TOK_NE
83%left TOK_DSLASH
84%left '+' '-'
85%left '*' TOK_SLASH
86%right TOK_DASTER
87
88%token TOK_SEMICOLON
89%token TOK_PARAMETER
90%token TOK_RESULT
91%token TOK_ONLY
92%token TOK_INCLUDE
93%token TOK_SUBROUTINE
94%token TOK_PROGRAM
95%token TOK_FUNCTION
96%token TOK_FORMAT
97%token TOK_MAX
98%token TOK_TANH
99%token TOK_WHERE
100%token TOK_ELSEWHEREPAR
101%token TOK_ELSEWHERE
102%token TOK_ENDWHERE
103%token TOK_MAXVAL
104%token TOK_TRIM
105%token TOK_NULL_PTR
106%token TOK_SUM
107%token TOK_SQRT
108%token TOK_CASE
109%token TOK_SELECTCASE
110%token TOK_FILE
111%token TOK_UNIT
112%token TOK_FMT
113%token TOK_NML
114%token TOK_END
115%token TOK_EOR
116%token TOK_ERR
117%token TOK_EXIST
118%token TOK_MIN
119%token TOK_FLOAT
120%token TOK_EXP
121%token TOK_COS
122%token TOK_COSH
123%token TOK_ACOS
124%token TOK_NINT
125%token TOK_CYCLE
126%token TOK_SIN
127%token TOK_SINH
128%token TOK_ASIN
129%token TOK_EQUIVALENCE
130%token TOK_BACKSPACE
131%token TOK_LOG
132%token TOK_TAN
133%token TOK_ATAN
134%token TOK_RECURSIVE
135%token TOK_ABS
136%token TOK_MOD
137%token TOK_SIGN
138%token TOK_MINLOC
139%token TOK_MAXLOC
140%token TOK_EXIT
141%token TOK_MINVAL
142%token TOK_PUBLIC
143%token TOK_PRIVATE
144%token TOK_ALLOCATABLE
145%token TOK_RETURN
146%token TOK_THEN
147%token TOK_ELSEIF
148%token TOK_ELSE
149%token TOK_ENDIF
150%token TOK_PRINT
151%token TOK_PLAINGOTO
152%token TOK_LOGICALIF
153%token TOK_PLAINDO
154%token TOK_CONTAINS
155%token TOK_ENDDO
156%token TOK_MODULE
157%token TOK_ENDMODULE
158%token TOK_WHILE
159%token TOK_CONCURRENT
160%token TOK_ALLOCATE
161%token TOK_OPEN
162%token TOK_CLOSE
163%token TOK_INQUIRE
164%token TOK_WRITE
165%token TOK_FLUSH
166%token TOK_READ
167%token TOK_REWIND
168%token TOK_DEALLOCATE
169%token TOK_NULLIFY
170%token TOK_DIMENSION
171%token TOK_ENDSELECT
172%token TOK_EXTERNAL
173%token TOK_INTENT
174%token TOK_INTRINSIC
175%token TOK_NAMELIST
176%token TOK_DEFAULT
177%token TOK_OPTIONAL
178%token TOK_POINTER
179%token TOK_CONTINUE
180%token TOK_SAVE
181%token TOK_TARGET
182%token TOK_IMPLICIT
183%token TOK_NONE
184%token TOK_CALL
185%token TOK_STAT
186%token TOK_POINT_TO
187%token TOK_COMMON
188%token TOK_GLOBAL
189%token TOK_LEFTAB
190%token TOK_RIGHTAB
191%token TOK_PAUSE
192%token TOK_PROCEDURE
193%token TOK_STOP
194%token TOK_REAL8
195%token TOK_FOURDOTS
196%token <na> TOK_HEXA
197%token <na> TOK_ASSIGNTYPE
198%token <na> TOK_OUT
199%token <na> TOK_INOUT
200%token <na> TOK_IN
201%token <na> TOK_USE
202%token <na> TOK_DSLASH
203%token <na> TOK_DASTER
204%token <na> TOK_EQ
205%token <na> TOK_EQV
206%token <na> TOK_GT
207%token <na> TOK_LT
208%token <na> TOK_GE
209%token <na> TOK_NE
210%token <na> TOK_NEQV
211%token <na> TOK_LE
212%token <na> TOK_OR
213%token <na> TOK_XOR
214%token <na> TOK_NOT
215%token <na> TOK_AND
216%token <na> TOK_TRUE
217%token <na> TOK_FALSE
218%token <na> TOK_LABEL
219%token <na> TOK_TYPE
220%token <na> TOK_TYPEPAR
221%token <na> TOK_ENDTYPE
222%token <na> TOK_REAL
223%token <na> TOK_INTEGER
224%token <na> TOK_LOGICAL
225%token <na> TOK_DOUBLEPRECISION
226%token <na> TOK_ENDSUBROUTINE
227%token <na> TOK_ENDFUNCTION
228%token <na> TOK_ENDPROGRAM
229%token <na> TOK_ENDUNIT
230%token <na> TOK_CHARACTER
231%token <na> TOK_CHAR_CONSTANT
232%token <na> TOK_CHAR_CUT
233%token <na> TOK_DATA
234%token <na> TOK_CHAR_MESSAGE
235%token <na> TOK_CSTREAL
236%token <na> TOK_COMPLEX
237%token <na> TOK_DOUBLECOMPLEX
238%token <na> TOK_NAME
239%token <na> TOK_SLASH
240%token <na> TOK_CSTINT
241%token ','
242%token ':'
243%token '('
244%token ')'
245%token '<'
246%token '>'
247%type <l> dcl
248%type <l> after_type
249%type <l> dimension
250%type <l> paramlist
251%type <l> args
252%type <l> arglist
253%type <lc> only_list
254%type <lc> only_name
255%type <lc> rename_list
256%type <lc> rename_name
257%type <d> dims
258%type <d> dimlist
259%type <dim1> dim
260%type <v> paramitem
261%type <na> comblock
262%type <na> name_routine
263%type <na> opt_name
264%type <na> type
265%type <na> word_endsubroutine
266%type <na> word_endfunction
267%type <na> word_endprogram
268%type <na> word_endunit
269%type <na> typespec
270%type <na> string_constant
271%type <na> simple_const
272%type <na> ident
273%type <na> intent_spec
274%type <na> signe
275%type <na> opt_signe
276%type <na> filename
277%type <na> attribute
278%type <na> complex_const
279%type <na> begin_array
280%type <na> clause
281%type <na> arg
282%type <na> uexpr
283%type <na> minmaxlist
284%type <na> lhs
285%type <na> vec
286%type <na> outlist
287%type <na> other
288%type <na> dospec
289%type <na> expr_data
290%type <na> structure_component
291%type <na> array_ele_substring_func_ref
292%type <na> funarglist
293%type <na> funarg
294%type <na> funargs
295%type <na> triplet
296%type <na> substring
297%type <na> opt_substring
298%type <na> opt_expr
299%type <na> optexpr
300%type <lnn> data_stmt_value_list
301%type <lnn> datanamelist
302%type <na> after_slash
303%type <na> after_equal
304%type <na> predefinedfunction
305%type <na> expr
306%type <na> ubound
307%type <na> operation
308%type <na> proper_lengspec
309%type <lnn> use_name_list
310%type <lnn> public
311
312%%
313input :
314      | input line
315      ;
316line :  line-break
317      | suite_line_list
318      | TOK_LABEL suite_line_list
319      | error {yyerrok;yyclearin;}
320      ;
321line-break:
322        '\n' fin_line
323      | TOK_SEMICOLON
324      | line-break '\n' fin_line
325      | line-break TOK_SEMICOLON
326      | line-break TOK_LABEL
327      ;
328suite_line_list :
329        suite_line
330      | suite_line_list TOK_SEMICOLON '\n'
331      | suite_line_list TOK_SEMICOLON suite_line
332      ;
333suite_line :
334        entry fin_line     /* subroutine, function, module                    */
335      | spec fin_line      /* declaration                                     */
336      | TOK_INCLUDE filename fin_line
337        {
338            if (inmoduledeclare == 0 )
339            {
340                pos_end = setposcur();
341                RemoveWordSET_0(fortran_out,pos_curinclude,pos_end-pos_curinclude);
342            }
343        }
344      | execution-part-construct
345      ;
346
347fin_line : { pos_cur = setposcur(); }
348      ;
349
350opt_recursive :         { isrecursive = 0; }
351      | TOK_RECURSIVE   { isrecursive = 1; }
352      ;
353
354opt_result :                                { is_result_present = 0; }
355      | TOK_RESULT arglist_after_result     { is_result_present = 1; }
356      ;
357
358entry : opt_recursive TOK_SUBROUTINE name_routine arglist
359        {
360            insubroutinedeclare = 1;
361            if ( firstpass )
362                Add_SubroutineArgument_Var_1($4);
363            else
364                WriteBeginof_SubLoop();
365        }
366      | TOK_PROGRAM name_routine
367        {
368            insubroutinedeclare = 1;
369            inprogramdeclare = 1;
370            /* in the second step we should write the head of       */
371            /*    the subroutine sub_loop_<subroutinename>          */
372            if ( ! firstpass )
373                WriteBeginof_SubLoop();
374        }
375      | opt_recursive TOK_FUNCTION name_routine arglist opt_result
376        {
377            insubroutinedeclare = 1;
378            strcpy(DeclType, "");
379            /* we should to list of the subroutine argument the  */
380            /*    name of the function which has to be defined   */
381            if ( firstpass )
382            {
383                Add_SubroutineArgument_Var_1($4);
384                if ( ! is_result_present )
385                    Add_FunctionType_Var_1($3);
386            }
387            else
388            /* in the second step we should write the head of    */
389            /*    the subroutine sub_loop_<subroutinename>       */
390                WriteBeginof_SubLoop();
391        }
392      | TOK_MODULE TOK_NAME
393        {
394            GlobalDeclaration = 0;
395            strcpy(curmodulename,$2);
396            strcpy(subroutinename,"");
397            Add_NameOfModule_1($2);
398            if ( inmoduledeclare == 0 )
399            {
400                /* To know if there are in the module declaration    */
401                inmoduledeclare = 1;
402                /* to know if a module has been met                  */
403                inmodulemeet = 1;
404                /* to know if we are after the keyword contains      */
405                aftercontainsdeclare = 0 ;
406            }
407        }
408      ;
409
410/* R312 : label */
411label: TOK_CSTINT
412     | label TOK_CSTINT
413     ;
414
415name_routine :  TOK_NAME    { strcpy($$, $1); strcpy(subroutinename, $1); }
416      ;
417filename :      TOK_CHAR_CONSTANT { Add_Include_1($1); }
418      ;
419arglist :               { if ( firstpass ) $$=NULL; }
420      | '(' ')'         { if ( firstpass ) $$=NULL; }
421      | '(' args ')'    { if ( firstpass ) $$=$2; }
422      ;
423arglist_after_result:
424      | '(' ')'
425      | '(' args ')'    { if ( firstpass ) Add_SubroutineArgument_Var_1($2); }
426      ;
427args :  arg
428        {
429            if ( firstpass == 1 )
430            {
431                strcpy(nameinttypenameback,nameinttypename);
432                strcpy(nameinttypename,"");
433                curvar = createvar($1,NULL);
434                strcpy(nameinttypename,nameinttypenameback);
435                curlistvar = insertvar(NULL,curvar);
436                $$ = settype("",curlistvar);
437            }
438        }
439      | args ',' arg
440        {
441            if ( firstpass == 1 )
442            {
443                strcpy(nameinttypenameback,nameinttypename);
444                strcpy(nameinttypename,"");
445                curvar = createvar($3,NULL);
446                strcpy(nameinttypename,nameinttypenameback);
447                $$ = insertvar($1,curvar);
448            }
449        }
450      ;
451arg : TOK_NAME  { strcpy($$,$1);  }
452      | '*'     { strcpy($$,"*"); }
453      ;
454spec :  type after_type
455      | TOK_TYPE opt_spec opt_sep opt_name  { inside_type_declare = 1; }
456      | TOK_ENDTYPE opt_name                { inside_type_declare = 0; }
457      | TOK_POINTER list_couple
458      | before_parameter '(' paramlist ')'
459        {
460            if ( ! inside_type_declare )
461            {
462                if ( firstpass )
463                {
464                    if ( insubroutinedeclare )  Add_Parameter_Var_1($3);
465                    else                        Add_GlobalParameter_Var_1($3);
466                }
467                else
468                {
469                    pos_end = setposcur();
470                    RemoveWordSET_0(fortran_out, pos_cur_decl, pos_end-pos_cur_decl);
471                }
472            }
473            VariableIsParameter =  0 ;
474        }
475      | before_parameter paramlist
476        {
477            if ( ! inside_type_declare )
478            {
479                if ( firstpass )
480                {
481                    if ( insubroutinedeclare )  Add_Parameter_Var_1($2);
482                    else                        Add_GlobalParameter_Var_1($2);
483                }
484                else
485                {
486                    pos_end = setposcur();
487                    RemoveWordSET_0(fortran_out,pos_cur_decl,pos_end-pos_cur_decl);
488                }
489            }
490            VariableIsParameter =  0 ;
491        }
492      | common
493      | save
494        {
495            pos_end = setposcur();
496            RemoveWordSET_0(fortran_out,pos_cursave,pos_end-pos_cursave);
497        }
498      | implicit
499      | dimension
500        {
501            /* if the variable is a parameter we can suppose that is   */
502            /*    value is the same on each grid. It is not useless to */
503            /*    create a copy of it on each grid                     */
504            if ( ! inside_type_declare )
505            {
506                if ( firstpass )
507                {
508                    Add_Globliste_1($1);
509                    /* if variableparamlists has been declared in a subroutine   */
510                    if ( insubroutinedeclare )     Add_Dimension_Var_1($1);
511                }
512                else
513                {
514                    pos_end = setposcur();
515                    RemoveWordSET_0(fortran_out,pos_curdimension,pos_end-pos_curdimension);
516                }
517            }
518            PublicDeclare = 0;
519            PrivateDeclare = 0;
520            ExternalDeclare = 0;
521            strcpy(NamePrecision,"");
522            c_star = 0;
523            InitialValueGiven = 0 ;
524            strcpy(IntentSpec,"");
525            VariableIsParameter =  0 ;
526            Allocatabledeclare = 0 ;
527            Targetdeclare = 0 ;
528            SaveDeclare = 0;
529            pointerdeclare = 0;
530            optionaldeclare = 0 ;
531            dimsgiven=0;
532            c_selectorgiven=0;
533            strcpy(nameinttypename,"");
534            strcpy(c_selectorname,"");
535        }
536      | public
537        {
538            if (firstpass == 0)
539            {
540                if ($1)
541                {
542                    removeglobfromlist(&($1));
543                    pos_end = setposcur();
544                    RemoveWordSET_0(fortran_out,pos_cur,pos_end-pos_cur);
545                    writelistpublic($1);
546                }
547            }
548        }
549      | private
550      | use_stat
551      | module_proc_stmt
552      | namelist
553      | TOK_BACKSPACE '(' expr ')'
554      | TOK_EXTERNAL opt_sep use_name_list
555      | TOK_INTRINSIC opt_sep use_intrinsic_list
556      | TOK_EQUIVALENCE list_expr_equi
557      | data_stmt '\n'
558        {
559            /* we should remove the data declaration                */
560            pos_end = setposcur();
561            RemoveWordSET_0(fortran_out,pos_curdata,pos_end-pos_curdata);
562
563            if ( aftercontainsdeclare == 1  && firstpass == 0 )
564            {
565                ReWriteDataStatement_0(fortran_out);
566                pos_end = setposcur();
567            }
568        }
569      ;
570opt_spec :
571      | access_spec
572        {
573            PublicDeclare = 0 ;
574            PrivateDeclare = 0 ;
575        }
576      ;
577name_intrinsic :
578        TOK_SUM
579      | TOK_TANH
580      | TOK_MAXVAL
581      | TOK_MIN
582      | TOK_MINVAL
583      | TOK_TRIM
584      | TOK_SQRT
585      | TOK_NINT
586      | TOK_FLOAT
587      | TOK_EXP
588      | TOK_COS
589      | TOK_COSH
590      | TOK_ACOS
591      | TOK_SIN
592      | TOK_SINH
593      | TOK_ASIN
594      | TOK_LOG
595      | TOK_TAN
596      | TOK_ATAN
597      | TOK_MOD
598      | TOK_SIGN
599      | TOK_MINLOC
600      | TOK_MAXLOC
601      | TOK_NAME
602      ;
603use_intrinsic_list :
604                               name_intrinsic
605      | use_intrinsic_list ',' name_intrinsic
606      ;
607list_couple :
608                        '(' list_expr ')'
609      | list_couple ',' '(' list_expr ')'
610      ;
611list_expr_equi :
612                           expr_equi
613      | list_expr_equi ',' expr_equi
614      ;
615expr_equi : '(' list_expr_equi1 ')'
616      ;
617list_expr_equi1 :
618                            ident dims
619      | list_expr_equi1 ',' ident dims
620      ;
621list_expr :
622                      expr
623      | list_expr ',' expr
624      ;
625opt_sep :
626      | TOK_FOURDOTS
627      ;
628after_type :
629        dcl nodimsgiven
630        {
631            /* if the variable is a parameter we can suppose that is*/
632            /*    value is the same on each grid. It is not useless */
633            /*    to create a copy of it on each grid               */
634            if ( ! inside_type_declare )
635            {
636                pos_end = setposcur();
637                RemoveWordSET_0(fortran_out,pos_cur_decl,pos_end-pos_cur_decl);
638                ReWriteDeclarationAndAddTosubroutine_01($1);
639                pos_cur_decl = setposcur();
640                if ( firstpass == 0 && GlobalDeclaration == 0
641                                    && insubroutinedeclare == 0 )
642                {
643                    fprintf(fortran_out,"\n#include \"Module_Declar_%s.h\"\n", curmodulename);
644                    sprintf(ligne, "Module_Declar_%s.h", curmodulename);
645                    module_declar = open_for_write(ligne);
646                    GlobalDeclaration = 1 ;
647                    pos_cur_decl = setposcur();
648                }
649                $$ = $1;
650
651                if ( firstpass )
652                {
653                    Add_Globliste_1($1);
654                    if ( insubroutinedeclare )
655                    {
656                        if ( pointerdeclare ) Add_Pointer_Var_From_List_1($1);
657                        Add_Parameter_Var_1($1);
658                    }
659                    else
660                        Add_GlobalParameter_Var_1($1);
661
662                    /* If there's a SAVE declaration in module's subroutines we should    */
663                    /*    remove it from the subroutines declaration and add it in the    */
664                    /*    global declarations                                             */
665                    if ( aftercontainsdeclare && SaveDeclare )
666                    {
667                        if ( inmodulemeet ) Add_SubroutineDeclarationSave_Var_1($1);
668                        else                Add_Save_Var_dcl_1($1);
669                    }
670                }
671            }
672            else
673            {
674                $$ = (listvar *) NULL;
675            }
676            PublicDeclare = 0;
677            PrivateDeclare = 0;
678            ExternalDeclare = 0;
679            strcpy(NamePrecision,"");
680            c_star = 0;
681            InitialValueGiven = 0 ;
682            strcpy(IntentSpec,"");
683            VariableIsParameter =  0 ;
684            Allocatabledeclare = 0 ;
685            Targetdeclare = 0 ;
686            SaveDeclare = 0;
687            pointerdeclare = 0;
688            optionaldeclare = 0 ;
689            dimsgiven=0;
690            c_selectorgiven=0;
691            strcpy(nameinttypename,"");
692            strcpy(c_selectorname,"");
693            GlobalDeclarationType = 0;
694        }
695      | before_function name_routine arglist
696        {
697            insubroutinedeclare = 1;
698
699            if ( firstpass )
700            {
701                Add_SubroutineArgument_Var_1($3);
702                Add_FunctionType_Var_1($2);
703            }
704            else
705                WriteBeginof_SubLoop();
706
707            strcpy(nameinttypename,"");
708        }
709      ;
710before_function :   TOK_FUNCTION    { functiondeclarationisdone = 1; }
711      ;
712before_parameter :  TOK_PARAMETER   { VariableIsParameter = 1; pos_curparameter = setposcur()-9; }
713      ;
714
715data_stmt :             /* R534 */
716        TOK_DATA data_stmt_set_list
717
718data_stmt_set_list :
719        data_stmt_set
720      | data_stmt_set_list opt_comma data_stmt_set
721
722data_stmt_set :         /* R535 */
723        TOK_NAME TOK_SLASH data_stmt_value_list TOK_SLASH
724        {
725            createstringfromlistname(ligne,$3);
726            if (firstpass == 1) Add_Data_Var_1(&List_Data_Var,$1,ligne);
727            else                Add_Data_Var_1(&List_Data_Var_Cur,$1,ligne);
728        }
729      | datanamelist TOK_SLASH data_stmt_value_list TOK_SLASH
730        {
731            if (firstpass == 1)  Add_Data_Var_Names_01(&List_Data_Var,$1,$3);
732            else                 Add_Data_Var_Names_01(&List_Data_Var_Cur,$1,$3);
733        }
734      | '(' lhs ',' dospec ')' TOK_SLASH data_stmt_value_list TOK_SLASH
735        {
736            createstringfromlistname(ligne,$7);
737            printf("###################################################################################################################\n");
738            printf("## CONV Error : data_implied_do statements (R537) are not yet supported. Please complain to the proper authorities.\n");
739            printf("l.%4d -- data_stmt_set : ( lhs , dospec ) /data_stmt_value_list/ -- lhs=|%s| dospec=|%s| data_stmt_value_list=|%s|\n",
740                line_num_input,$2,$4,ligne);
741            printf("## But, are you SURE you NEED a DATA construct ?\n");
742            printf("###################################################################################################################\n");
743            exit(1);
744        }
745      ;
746
747data_stmt_value_list :
748        expr_data                           { $$ = Insertname(NULL,$1,0); }
749      | expr_data ',' data_stmt_value_list  { $$ = Insertname($3,$1,1);   }
750      ;
751
752save :  before_save varsave
753      | before_save comblock varsave
754      | save opt_comma comblock opt_comma varsave
755      | save ',' varsave
756      ;
757before_save :
758        TOK_SAVE        { pos_cursave = setposcur()-4; }
759      ;
760varsave :
761      | TOK_NAME dims   { if ( ! inside_type_declare ) Add_Save_Var_1($1,$2); }
762      ;
763datanamelist :
764        TOK_NAME                        { $$ = Insertname(NULL,$1,0); }
765      | TOK_NAME '(' expr ')'           { printf("l.%4d -- INSTRUCTION NON TRAITEE : INITIALISATION DE DATA AVEC EXPRESSION\n",line_num_input); exit(0); }
766      | datanamelist ',' datanamelist   { $$ = concat_listname($1,$3); }
767      ;
768expr_data :
769        opt_signe simple_const      { sprintf($$,"%s%s",$1,$2);  }
770      | expr_data '+' expr_data     { sprintf($$,"%s+%s",$1,$3); }
771      | expr_data '-' expr_data     { sprintf($$,"%s-%s",$1,$3); }
772      | expr_data '*' expr_data     { sprintf($$,"%s*%s",$1,$3); }
773      | expr_data '/' expr_data     { sprintf($$,"%s/%s",$1,$3); }
774      ;
775opt_signe :     { strcpy($$,""); }
776      | signe   { strcpy($$,$1); }
777      ;
778namelist :
779        TOK_NAMELIST ident
780      | TOK_NAMELIST comblock ident
781      | namelist opt_comma comblock opt_comma ident
782      | namelist ',' ident
783      ;
784before_dimension :
785        TOK_DIMENSION
786        {
787            positioninblock = 0;
788            pos_curdimension = setposcur()-9;
789        }
790
791dimension :
792        before_dimension opt_comma TOK_NAME dims lengspec
793        {
794            printf("l.%4d -- dimension : before_dimension opt_comma TOK_NAME = |%s| -- MHCHECK\n",line_num_input,$3);
795            if ( inside_type_declare ) break;
796            curvar = createvar($3,$4);
797            CreateAndFillin_Curvar("", curvar);
798            curlistvar=insertvar(NULL, curvar);
799            $$ = settype("",curlistvar);
800            strcpy(vallengspec,"");
801        }
802      | dimension ',' TOK_NAME dims lengspec
803        {
804            printf("l.%4d -- dimension : dimension ',' TOK_NAME dims lengspec = |%s| -- MHCHECK\n",line_num_input,$3);
805            if ( inside_type_declare ) break;
806            curvar = createvar($3,$4);
807            CreateAndFillin_Curvar("", curvar);
808            curlistvar = insertvar($1, curvar);
809            $$ = curlistvar;
810            strcpy(vallengspec,"");
811        }
812      ;
813private :
814        TOK_PRIVATE '\n'
815      | TOK_PRIVATE opt_sep use_name_list
816      ;
817public :
818        TOK_PUBLIC '\n'                     { $$ = (listname *) NULL; }
819      | TOK_PUBLIC opt_sep use_name_list    { $$ = $3; }
820      ;
821use_name_list :
822        TOK_NAME                            { $$ = Insertname(NULL,$1,0); }
823      | TOK_ASSIGNTYPE                      { $$ = Insertname(NULL,$1,0); }
824      | use_name_list ',' TOK_NAME          { $$ = Insertname($1,$3,0);   }
825      | use_name_list ',' TOK_ASSIGNTYPE    { $$ = Insertname($1,$3,0);   }
826      ;
827common :
828        before_common var_common_list
829        {
830            if ( inside_type_declare ) break;
831            pos_end = setposcur();
832            RemoveWordSET_0(fortran_out,pos_curcommon,pos_end-pos_curcommon);
833        }
834      | before_common comblock var_common_list
835        {
836            if ( inside_type_declare ) break;
837            sprintf(charusemodule,"%s",$2);
838            Add_NameOfCommon_1($2,subroutinename);
839            pos_end = setposcur();
840            RemoveWordSET_0(fortran_out,pos_curcommon,pos_end-pos_curcommon);
841        }
842      | common opt_comma comblock opt_comma var_common_list
843        {
844            if ( inside_type_declare ) break;
845            sprintf(charusemodule,"%s",$3);
846            Add_NameOfCommon_1($3,subroutinename);
847            pos_end = setposcur();
848            RemoveWordSET_0(fortran_out,pos_curcommon,pos_end-pos_curcommon);
849        }
850      ;
851before_common :
852        TOK_COMMON              { positioninblock = 0; pos_curcommon = setposcur()-6;   }
853      | TOK_GLOBAL TOK_COMMON   { positioninblock = 0; pos_curcommon = setposcur()-6-7; }
854      ;
855var_common_list :
856        var_common                      { if ( ! inside_type_declare ) Add_Common_var_1(); }
857      | var_common_list ',' var_common  { if ( ! inside_type_declare ) Add_Common_var_1(); }
858      ;
859var_common :
860        TOK_NAME dims
861        {
862            positioninblock = positioninblock + 1 ;
863            strcpy(commonvar,$1);
864            commondim = $2;
865        }
866      ;
867comblock :
868        TOK_DSLASH
869        {
870            strcpy($$,"");
871            positioninblock=0;
872            strcpy(commonblockname,"");
873        }
874      | TOK_SLASH TOK_NAME TOK_SLASH
875        {
876            strcpy($$,$2);
877            positioninblock=0;
878            strcpy(commonblockname,$2);
879        }
880      ;
881opt_comma :
882      | ','
883      ;
884paramlist :
885        paramitem                   { $$=insertvar(NULL,$1); }
886      | paramlist ',' paramitem     { $$=insertvar($1,$3);   }
887      ;
888paramitem :
889        TOK_NAME '=' expr
890        {
891            if ( inside_type_declare ) break;
892            curvar=(variable *) calloc(1,sizeof(variable));
893            Init_Variable(curvar);
894            curvar->v_VariableIsParameter = 1;
895            strcpy(curvar->v_nomvar,$1);
896            strcpy(curvar->v_subroutinename,subroutinename);
897            strcpy(curvar->v_modulename,curmodulename);
898            strcpy(curvar->v_initialvalue,$3);
899            strcpy(curvar->v_commoninfile,cur_filename);
900            Save_Length($3,14);
901            $$ = curvar;
902        }
903      ;
904module_proc_stmt :
905        TOK_PROCEDURE proc_name_list
906      ;
907proc_name_list :
908        TOK_NAME
909      | proc_name_list ',' TOK_NAME
910      ;
911implicit :
912        TOK_IMPLICIT TOK_NONE
913        {
914            if ( insubroutinedeclare == 1 )
915            {
916                Add_ImplicitNoneSubroutine_1();
917                pos_end = setposcur();
918                RemoveWordSET_0(fortran_out,pos_end-13,13);
919            }
920        }
921      | TOK_IMPLICIT TOK_REAL8
922      ;
923dcl :   options TOK_NAME dims lengspec initial_value
924        {
925            if ( ! inside_type_declare )
926            {
927                if (dimsgiven == 1) curvar = createvar($2,curdim);
928                else                curvar = createvar($2,$3);
929                CreateAndFillin_Curvar(DeclType, curvar);
930                curlistvar = insertvar(NULL, curvar);
931                if (!strcasecmp(DeclType,"character"))
932                {
933                    if (c_selectorgiven == 1)
934                    {
935                        strcpy(c_selectordim.first,"1");
936                        strcpy(c_selectordim.last,c_selectorname);
937                        Save_Length(c_selectorname,1);
938                        change_dim_char(insertdim(NULL,c_selectordim),curlistvar);
939                    }
940                }
941                $$=settype(DeclType,curlistvar);
942            }
943            strcpy(vallengspec,"");
944        }
945      | dcl ',' TOK_NAME dims lengspec initial_value
946        {
947            if ( ! inside_type_declare )
948            {
949                if (dimsgiven == 1) curvar = createvar($3, curdim);
950                else                curvar = createvar($3, $4);
951                CreateAndFillin_Curvar($1->var->v_typevar,curvar);
952                strcpy(curvar->v_typevar, $1->var->v_typevar);
953                curvar->v_catvar = get_cat_var(curvar);
954                curlistvar = insertvar($1, curvar);
955                if (!strcasecmp(DeclType,"character"))
956                {
957                    if (c_selectorgiven == 1)
958                    {
959                        strcpy(c_selectordim.first,"1");
960                        strcpy(c_selectordim.last,c_selectorname);
961                        Save_Length(c_selectorname,1);
962                        change_dim_char(insertdim(NULL,c_selectordim),curlistvar);
963                    }
964                }
965                $$=curlistvar;
966            }
967            strcpy(vallengspec,"");
968        }
969      ;
970nodimsgiven : { dimsgiven = 0; }
971      ;
972type :  typespec selector               { strcpy(DeclType,$1);  }
973      | before_character c_selector     { strcpy(DeclType,"character");  }
974      | typespec '*' TOK_CSTINT         { strcpy(DeclType,$1); strcpy(nameinttypename,$3);  }
975      | TOK_TYPEPAR attribute ')'       { strcpy(DeclType,"type"); GlobalDeclarationType = 1;  }
976      ;
977c_selector :
978      | '*' TOK_CSTINT              { c_selectorgiven = 1; strcpy(c_selectorname,$2); }
979      | '*' '(' c_attribute ')'     { c_star = 1;}
980      | '(' c_attribute ')'
981      ;
982c_attribute :
983        TOK_NAME clause opt_clause
984      | TOK_NAME '=' clause opt_clause
985      | clause opt_clause
986      ;
987before_character : TOK_CHARACTER    { pos_cur_decl = setposcur()-9; }
988      ;
989typespec :
990        TOK_INTEGER         { strcpy($$,"integer"); pos_cur_decl = setposcur()-7; }
991      | TOK_LOGICAL         { strcpy($$,"logical"); pos_cur_decl = setposcur()-7; }
992      | TOK_REAL            { strcpy($$,"real");    pos_cur_decl = setposcur()-4; }
993      | TOK_COMPLEX         { strcpy($$,"complex"); pos_cur_decl = setposcur()-7; }
994      | TOK_DOUBLECOMPLEX   { strcpy($$,"double complex"); pos_cur_decl = setposcur()-14; }
995      | TOK_DOUBLEPRECISION { pos_cur_decl = setposcur()-16; strcpy($$,"real"); strcpy(nameinttypename,"8"); }
996      ;
997lengspec :
998      | '*' proper_lengspec {strcpy(vallengspec,$2);}
999      ;
1000proper_lengspec :
1001        expr        { sprintf($$,"*%s",$1); }
1002      | '(' '*' ')' { strcpy($$,"*(*)"); }
1003      ;
1004selector :
1005      | '*' proper_selector
1006      | '(' attribute ')'
1007      ;
1008proper_selector : expr
1009      | '(' '*' ')'
1010      ;
1011attribute :
1012        TOK_NAME clause
1013      | TOK_NAME '=' clause
1014        {
1015            if ( strstr($3,"0.d0") )
1016            {
1017                strcpy(nameinttypename,"8");
1018                strcpy(NamePrecision,"");
1019            }
1020            else
1021                sprintf(NamePrecision,"%s = %s",$1,$3);
1022        }
1023      | TOK_NAME        { strcpy(NamePrecision,$1); }
1024      | TOK_CSTINT      { strcpy(NamePrecision,$1); }
1025      | TOK_ASSIGNTYPE  { strcpy(NamePrecision,$1); }
1026      ;
1027clause :
1028        expr   { strcpy(CharacterSize,$1);  strcpy($$,$1);  }
1029      | '*'    { strcpy(CharacterSize,"*"); strcpy($$,"*"); }
1030      ;
1031opt_clause :
1032      | ',' TOK_NAME clause
1033      ;
1034options :
1035      | TOK_FOURDOTS
1036      | ',' attr_spec_list TOK_FOURDOTS
1037      ;
1038attr_spec_list : attr_spec
1039      | attr_spec_list ',' attr_spec
1040      ;
1041attr_spec :
1042        TOK_PARAMETER       { VariableIsParameter = 1; }
1043      | access_spec
1044      | TOK_ALLOCATABLE     { Allocatabledeclare = 1; }
1045      | TOK_DIMENSION dims  { dimsgiven = 1; curdim = $2; }
1046      | TOK_EXTERNAL        { ExternalDeclare = 1; }
1047      | TOK_INTENT '(' intent_spec ')'
1048                            { strcpy(IntentSpec,$3); }
1049      | TOK_INTRINSIC
1050      | TOK_OPTIONAL        { optionaldeclare = 1 ; }
1051      | TOK_POINTER         { pointerdeclare = 1 ; }
1052      | TOK_SAVE            { SaveDeclare = 1 ; }
1053      | TOK_TARGET          { Targetdeclare = 1; }
1054      ;
1055intent_spec :
1056        TOK_IN          { strcpy($$,$1); }
1057      | TOK_OUT         { strcpy($$,$1); }
1058      | TOK_INOUT       { strcpy($$,$1); }
1059      ;
1060access_spec :
1061        TOK_PUBLIC      { PublicDeclare = 1;  }
1062      | TOK_PRIVATE     { PrivateDeclare = 1; }
1063      ;
1064dims :  { $$ = (listdim*) NULL; }
1065      | '(' dimlist ')'
1066        {
1067            $$ = (listdim*) NULL;
1068            if ( inside_type_declare ) break;
1069            if ( created_dimensionlist == 1 || agrif_parentcall == 1 )  $$=$2;
1070        }
1071      ;
1072dimlist :
1073        dim
1074        {
1075            $$ = (listdim*) NULL;
1076            if ( inside_type_declare ) break;
1077            if ( created_dimensionlist == 1 || agrif_parentcall == 1 )  $$=insertdim(NULL,$1);
1078        }
1079      | dimlist ',' dim
1080        {
1081            $$ = (listdim*) NULL;
1082            if ( inside_type_declare ) break;
1083            if ( (!inside_type_declare) && created_dimensionlist == 1 ) $$=insertdim($1,$3);
1084        }
1085      ;
1086dim :   ubound              { strcpy($$.first,"1"); strcpy($$.last,$1); Save_Length($1,1); }
1087      | ':'                 { strcpy($$.first,"");  strcpy($$.last,"");                    }
1088      | expr ':'            { strcpy($$.first,$1);  Save_Length($1,2); strcpy($$.last,""); }
1089      | ':' expr            { strcpy($$.first,"");  strcpy($$.last,$2); Save_Length($2,1); }
1090      | expr ':' ubound     { strcpy($$.first,$1);  Save_Length($1,2); strcpy($$.last,$3); Save_Length($3,1); }
1091      ;
1092ubound :
1093        '*'                 { strcpy($$,"*"); }
1094      | expr                { strcpy($$,$1);  }
1095      ;
1096expr :  uexpr               { strcpy($$,$1); }
1097      | complex_const       { strcpy($$,$1); }
1098      | predefinedfunction  { strcpy($$,$1); }
1099      | '(' expr ')'        { sprintf($$,"(%s)",$2); }
1100      ;
1101
1102predefinedfunction :
1103        TOK_SUM minmaxlist ')'          { sprintf($$,"SUM(%s)",$2);}
1104      | TOK_MAX minmaxlist ')'          { sprintf($$,"MAX(%s)",$2);}
1105      | TOK_TANH '(' minmaxlist ')'     { sprintf($$,"TANH(%s)",$3);}
1106      | TOK_MAXVAL '(' minmaxlist ')'   { sprintf($$,"MAXVAL(%s)",$3);}
1107      | TOK_MIN minmaxlist ')'          { sprintf($$,"MIN(%s)",$2);}
1108      | TOK_MINVAL '(' minmaxlist ')'   { sprintf($$,"MINVAL(%s)",$3);}
1109      | TOK_TRIM '(' expr ')'           { sprintf($$,"TRIM(%s)",$3);}
1110      | TOK_SQRT expr ')'               { sprintf($$,"SQRT(%s)",$2);}
1111      | TOK_REAL '(' minmaxlist ')'     { sprintf($$,"REAL(%s)",$3);}
1112      | TOK_NINT '(' expr ')'           { sprintf($$,"NINT(%s)",$3);}
1113      | TOK_FLOAT '(' expr ')'          { sprintf($$,"FLOAT(%s)",$3);}
1114      | TOK_EXP '(' expr ')'            { sprintf($$,"EXP(%s)",$3);}
1115      | TOK_COS '(' expr ')'            { sprintf($$,"COS(%s)",$3);}
1116      | TOK_COSH '(' expr ')'           { sprintf($$,"COSH(%s)",$3);}
1117      | TOK_ACOS '(' expr ')'           { sprintf($$,"ACOS(%s)",$3);}
1118      | TOK_SIN '(' expr ')'            { sprintf($$,"SIN(%s)",$3);}
1119      | TOK_SINH '(' expr ')'           { sprintf($$,"SINH(%s)",$3);}
1120      | TOK_ASIN '(' expr ')'           { sprintf($$,"ASIN(%s)",$3);}
1121      | TOK_LOG '(' expr ')'            { sprintf($$,"LOG(%s)",$3);}
1122      | TOK_TAN '(' expr ')'            { sprintf($$,"TAN(%s)",$3);}
1123      | TOK_ATAN '(' expr ')'           { sprintf($$,"ATAN(%s)",$3);}
1124      | TOK_ABS expr ')'                { sprintf($$,"ABS(%s)",$2);}
1125      | TOK_MOD '(' minmaxlist ')'      { sprintf($$,"MOD(%s)",$3);}
1126      | TOK_SIGN minmaxlist ')'         { sprintf($$,"SIGN(%s)",$2);}
1127      | TOK_MINLOC '(' minmaxlist ')'   { sprintf($$,"MINLOC(%s)",$3);}
1128      | TOK_MAXLOC '(' minmaxlist ')'   { sprintf($$,"MAXLOC(%s)",$3);}
1129      ;
1130minmaxlist : expr {strcpy($$,$1);}
1131      | minmaxlist ',' expr     { sprintf($$,"%s,%s",$1,$3); }
1132      ;
1133uexpr : lhs                     { strcpy($$,$1); }
1134      | simple_const            { strcpy($$,$1); }
1135      | vec                     { strcpy($$,$1); }
1136      | expr operation          { sprintf($$,"%s%s",$1,$2); }
1137      | signe expr %prec '*'    { sprintf($$,"%s%s",$1,$2); }
1138      | TOK_NOT expr            { sprintf($$,"%s%s",$1,$2); }
1139      ;
1140signe : '+'        { strcpy($$,"+"); }
1141      | '-'        { strcpy($$,"-"); }
1142      ;
1143
1144operation :
1145        '+' expr %prec '+'          { sprintf($$,"+%s",$2); }
1146      | '-' expr %prec '+'          { sprintf($$,"-%s",$2); }
1147      | '*' expr                    { sprintf($$,"*%s",$2); }
1148      | TOK_DASTER expr             { sprintf($$,"%s%s",$1,$2); }
1149      | TOK_EQ expr %prec TOK_EQ    { sprintf($$,"%s%s",$1,$2); }
1150      | TOK_EQV expr %prec TOK_EQV  { sprintf($$,"%s%s",$1,$2); }
1151      | TOK_GT expr %prec TOK_EQ    { sprintf($$,"%s%s",$1,$2); }
1152      | '>' expr %prec TOK_EQ       { sprintf($$," > %s",$2); }
1153      | '<' expr %prec TOK_EQ       { sprintf($$," < %s",$2); }
1154      | '>''=' expr %prec TOK_EQ    { sprintf($$," >= %s",$3); }
1155      | '<''=' expr %prec TOK_EQ    { sprintf($$," <= %s",$3); }
1156      | TOK_LT expr %prec TOK_EQ    { sprintf($$,"%s%s",$1,$2); }
1157      | TOK_GE expr %prec TOK_EQ    { sprintf($$,"%s%s",$1,$2); }
1158      | TOK_LE expr %prec TOK_EQ    { sprintf($$,"%s%s",$1,$2); }
1159      | TOK_NE expr %prec TOK_EQ    { sprintf($$,"%s%s",$1,$2); }
1160      | TOK_NEQV expr %prec TOK_EQV { sprintf($$,"%s%s",$1,$2); }
1161      | TOK_XOR expr                { sprintf($$,"%s%s",$1,$2); }
1162      | TOK_OR expr                 { sprintf($$,"%s%s",$1,$2); }
1163      | TOK_AND expr                { sprintf($$,"%s%s",$1,$2); }
1164      | TOK_SLASH after_slash       { sprintf($$,"%s",$2); }
1165      | '=' after_equal             { sprintf($$,"%s",$2); }
1166
1167after_slash :                   { strcpy($$,""); }
1168      | expr                    { sprintf($$,"/%s",$1); }
1169      | '=' expr %prec TOK_EQ   { sprintf($$,"/= %s",$2);}
1170      | TOK_SLASH expr          { sprintf($$,"//%s",$2); }
1171      ;
1172after_equal :
1173        '=' expr %prec TOK_EQ   { sprintf($$,"==%s",$2); }
1174      | expr                    { sprintf($$,"= %s",$1); }
1175      ;
1176
1177lhs :   ident                           { strcpy($$,$1); }
1178      | structure_component             { strcpy($$,$1); }
1179      | array_ele_substring_func_ref    { strcpy($$,$1); }
1180      ;
1181
1182beforefunctionuse :
1183        {
1184            agrif_parentcall = 0;
1185            if ( !strcasecmp(identcopy, "Agrif_Parent") )   agrif_parentcall = 1;
1186            if ( Agrif_in_Tok_NAME(identcopy) )
1187            {
1188                inagrifcallargument = 1;
1189                Add_SubroutineWhereAgrifUsed_1(subroutinename, curmodulename);
1190            }
1191        }
1192      ;
1193array_ele_substring_func_ref :
1194        begin_array                                         { strcpy($$,$1); if ( incalldeclare == 0 ) inagrifcallargument = 0;   }
1195      | begin_array substring                               { sprintf($$," %s %s ",$1,$2); }
1196      | structure_component '(' funarglist ')'              { sprintf($$," %s ( %s )",$1,$3); }
1197      | structure_component '(' funarglist ')' substring    { sprintf($$," %s ( %s ) %s ",$1,$3,$5); }
1198      ;
1199begin_array :
1200        ident '(' funarglist ')'
1201        {
1202            if ( inside_type_declare ) break;
1203            sprintf($$," %s ( %s )",$1,$3);
1204            ModifyTheAgrifFunction_0($3);
1205            agrif_parentcall = 0;
1206        }
1207      ;
1208structure_component :
1209        lhs '%' declare_after_percent lhs
1210        {
1211            sprintf($$," %s %% %s ",$1,$4);
1212            if ( incalldeclare == 0 ) inagrifcallargument = 0;
1213        }
1214      ;
1215vec :
1216        TOK_LEFTAB outlist TOK_RIGHTAB   { sprintf($$,"(/%s/)",$2); }
1217      ;
1218funarglist :
1219        beforefunctionuse           { strcpy($$," "); }
1220      | beforefunctionuse funargs   { strcpy($$,$2); }
1221      ;
1222funargs :
1223        funarg              {  strcpy($$,$1); }
1224      | funargs ',' funarg  {  sprintf($$,"%s,%s",$1,$3); }
1225      ;
1226funarg :
1227        expr       {strcpy($$,$1);}
1228      | triplet    {strcpy($$,$1);}
1229      ;
1230triplet :
1231        expr ':' expr           {  sprintf($$,"%s :%s",$1,$3);}
1232      | expr ':' expr ':' expr  {  sprintf($$,"%s :%s :%s",$1,$3,$5);}
1233      | ':' expr ':' expr       {  sprintf($$,":%s :%s",$2,$4);}
1234      | ':' ':' expr            {  sprintf($$,": : %s",$3);}
1235      | ':' expr                {  sprintf($$,":%s",$2);}
1236      | expr ':'                {  sprintf($$,"%s :",$1);}
1237      | ':'                     {  sprintf($$,":");}
1238      ;
1239ident : TOK_NAME
1240        {
1241            if ( afterpercent == 0 )
1242            {
1243                if ( Agrif_in_Tok_NAME($1) ) Add_SubroutineWhereAgrifUsed_1(subroutinename, curmodulename);
1244                if ( !strcasecmp($1,"Agrif_Parent") )   agrif_parentcall = 1;
1245                if ( VariableIsFunction($1) )
1246                {
1247                    if ( inagrifcallargument == 1 )
1248                    {
1249                        if ( !strcasecmp($1,identcopy) )
1250                        {
1251                            strcpy(sameagrifname,identcopy);
1252                            sameagrifargument = 1;
1253                        }
1254                    }
1255                    strcpy(identcopy,$1);
1256                    pointedvar = 0;
1257
1258                    if (variscoupled_0($1)) strcpy(truename, getcoupledname_0($1));
1259                    else                    strcpy(truename, $1);
1260
1261                    if ( VarIsNonGridDepend(truename) == 0 && (! Variableshouldberemoved(truename)) )
1262                    {
1263                        if ( inagrifcallargument == 1 || varispointer_0(truename) == 1 )
1264                        {
1265                            if ( (IsinListe(List_UsedInSubroutine_Var,$1) == 1) || (inagrifcallargument == 1) )
1266                            {
1267                                if (varistyped_0(truename) == 0)    ModifyTheVariableName_0(truename,strlen($1));
1268                            }
1269                        }
1270                        if ( inagrifcallargument != 1 || sameagrifargument ==1 )
1271                        {
1272                            Add_UsedInSubroutine_Var_1(truename);
1273                        }
1274                    }
1275                    NotifyAgrifFunction_0(truename);
1276                }
1277            }
1278            else
1279            {
1280                afterpercent = 0;
1281            }
1282        }
1283      ;
1284simple_const :
1285        TOK_TRUE     { strcpy($$,".TRUE.");}
1286      | TOK_FALSE    { strcpy($$,".FALSE.");}
1287      | TOK_NULL_PTR { strcpy($$,"NULL()"); }
1288      | TOK_CSTINT   { strcpy($$,$1); }
1289      | TOK_CSTREAL  { strcpy($$,$1); }
1290      | TOK_HEXA     { strcpy($$,$1); }
1291      | simple_const TOK_NAME
1292                     { sprintf($$,"%s%s",$1,$2); }
1293      | string_constant opt_substring
1294      ;
1295string_constant :
1296        TOK_CHAR_CONSTANT                   { strcpy($$,$1);}
1297      | string_constant TOK_CHAR_CONSTANT
1298      | TOK_CHAR_MESSAGE                    { strcpy($$,$1);}
1299      | TOK_CHAR_CUT                        { strcpy($$,$1);}
1300      ;
1301opt_substring :     { strcpy($$," ");}
1302      | substring   { strcpy($$,$1);}
1303      ;
1304substring :
1305        '(' optexpr ':' optexpr ')' { sprintf($$,"(%s :%s)",$2,$4);}
1306      ;
1307optexpr :           { strcpy($$," ");}
1308      | expr        { strcpy($$,$1);}
1309      ;
1310opt_expr :
1311        '\n'        { strcpy($$," ");}
1312      | expr        { strcpy($$,$1);}
1313      ;
1314initial_value :     { InitialValueGiven = 0; }
1315      | '=' expr
1316        {
1317            if ( inside_type_declare ) break;
1318            strcpy(InitValue,$2);
1319            InitialValueGiven = 1;
1320        }
1321      | TOK_POINT_TO expr
1322        {
1323            if ( inside_type_declare ) break;
1324            strcpy(InitValue,$2);
1325            InitialValueGiven = 2;
1326        }
1327      ;
1328complex_const :
1329        '(' uexpr ',' uexpr ')' {sprintf($$,"(%s,%s)",$2,$4); }
1330      ;
1331use_stat :
1332        word_use TOK_NAME
1333        {
1334            /* if variables has been declared in a subroutine       */
1335            sprintf(charusemodule, "%s", $2);
1336            if ( firstpass )
1337            {
1338                Add_NameOfModuleUsed_1($2);
1339            }
1340            else
1341            {
1342                if ( insubroutinedeclare )
1343                    copyuse_0($2);
1344
1345                if ( inmoduledeclare == 0 )
1346                {
1347                    pos_end = setposcur();
1348                    RemoveWordSET_0(fortran_out,pos_curuse,pos_end-pos_curuse);
1349                }
1350            }
1351        }
1352      | word_use TOK_NAME ',' rename_list
1353        {
1354            if ( firstpass )
1355            {
1356                if ( insubroutinedeclare )
1357                {
1358                    Add_CouplePointed_Var_1($2,$4);
1359                    coupletmp = $4;
1360                    strcpy(ligne,"");
1361                    while ( coupletmp )
1362                    {
1363                        strcat(ligne, coupletmp->c_namevar);
1364                        strcat(ligne, " => ");
1365                        strcat(ligne, coupletmp->c_namepointedvar);
1366                        coupletmp = coupletmp->suiv;
1367                        if ( coupletmp ) strcat(ligne,",");
1368                    }
1369                    sprintf(charusemodule,"%s",$2);
1370                }
1371                Add_NameOfModuleUsed_1($2);
1372            }
1373            if ( inmoduledeclare == 0 )
1374            {
1375                pos_end = setposcur();
1376                RemoveWordSET_0(fortran_out,pos_curuse,pos_end-pos_curuse);
1377            }
1378        }
1379      | word_use TOK_NAME ',' TOK_ONLY ':' '\n'
1380        {
1381            /* if variables has been declared in a subroutine       */
1382            sprintf(charusemodule,"%s",$2);
1383            if ( firstpass )
1384            {
1385                Add_NameOfModuleUsed_1($2);
1386            }
1387            else
1388            {
1389                if ( insubroutinedeclare )
1390                    copyuseonly_0($2);
1391
1392                if ( inmoduledeclare == 0 )
1393                {
1394                    pos_end = setposcur();
1395                    RemoveWordSET_0(fortran_out,pos_curuse,pos_end-pos_curuse);
1396                }
1397            }
1398        }
1399      | word_use  TOK_NAME ',' TOK_ONLY ':' only_list
1400        {
1401            /* if variables has been declared in a subroutine      */
1402            if ( firstpass )
1403            {
1404                if ( insubroutinedeclare )
1405                {
1406                    Add_CouplePointed_Var_1($2,$6);
1407                    coupletmp = $6;
1408                    strcpy(ligne,"");
1409                    while ( coupletmp )
1410                    {
1411                        strcat(ligne,coupletmp->c_namevar);
1412                        if ( strcasecmp(coupletmp->c_namepointedvar,"") )   strcat(ligne," => ");
1413                        strcat(ligne,coupletmp->c_namepointedvar);
1414                        coupletmp = coupletmp->suiv;
1415                        if ( coupletmp ) strcat(ligne,",");
1416                    }
1417                    sprintf(charusemodule,"%s",$2);
1418                }
1419                Add_NameOfModuleUsed_1($2);
1420            }
1421            else /* if ( firstpass == 0 ) */
1422            {
1423                if ( inmoduledeclare == 0 )
1424                {
1425                    pos_end = setposcur();
1426                    RemoveWordSET_0(fortran_out,pos_curuse,pos_end-pos_curuse);
1427                    if (oldfortran_out)  variableisglobalinmodule($6,$2,oldfortran_out,pos_curuseold);
1428                }
1429                else
1430                {
1431                    /* if we are in the module declare and if the    */
1432                    /* onlylist is a list of global variable         */
1433                    variableisglobalinmodule($6, $2, fortran_out,pos_curuse);
1434                }
1435            }
1436        }
1437      ;
1438word_use :
1439        TOK_USE
1440        {
1441            pos_curuse = setposcur()-strlen($1);
1442            if (firstpass == 0 && oldfortran_out) pos_curuseold = setposcurname(oldfortran_out);
1443        }
1444      ;
1445rename_list :
1446        rename_name
1447        {
1448            $$ = $1;
1449        }
1450      | rename_list ',' rename_name
1451        {
1452            /* insert the variable in the list $1                 */
1453            $3->suiv = $1;
1454            $$ = $3;
1455        }
1456      ;
1457rename_name : TOK_NAME TOK_POINT_TO TOK_NAME
1458        {
1459            coupletmp = (listcouple *) calloc(1,sizeof(listcouple));
1460            strcpy(coupletmp->c_namevar,$1);
1461            strcpy(coupletmp->c_namepointedvar,$3);
1462            coupletmp->suiv = NULL;
1463            $$ = coupletmp;
1464        }
1465      ;
1466only_list :
1467        only_name   {  $$ = $1; }
1468      | only_list ',' only_name
1469        {
1470            /* insert the variable in the list $1                 */
1471            $3->suiv = $1;
1472            $$ = $3;
1473        }
1474      ;
1475only_name :
1476        TOK_NAME TOK_POINT_TO TOK_NAME
1477        {
1478            coupletmp = (listcouple *)calloc(1,sizeof(listcouple));
1479            strcpy(coupletmp->c_namevar,$1);
1480            strcpy(coupletmp->c_namepointedvar,$3);
1481            coupletmp->suiv = NULL;
1482            $$ = coupletmp;
1483            pointedvar = 1;
1484            Add_UsedInSubroutine_Var_1($1);
1485        }
1486      | TOK_NAME
1487        {
1488            coupletmp = (listcouple *)calloc(1,sizeof(listcouple));
1489            strcpy(coupletmp->c_namevar,$1);
1490            strcpy(coupletmp->c_namepointedvar,"");
1491            coupletmp->suiv = NULL;
1492            $$ = coupletmp;
1493        }
1494      ;
1495
1496/* R209 : execution-part-construct */
1497execution-part-construct:
1498        executable-construct
1499      | format-stmt
1500      ;
1501
1502/* R213 : executable-construct */
1503executable-construct:
1504        action-stmt
1505      | do-construct
1506      | case-construct
1507      | if-construct
1508      | where-construct
1509      ;
1510
1511/* R214 : action-stmt */
1512action-stmt :
1513        TOK_CONTINUE
1514      | ident_dims after_ident_dims
1515      | goto
1516      | call
1517      | iofctl ioctl
1518      | read option_read
1519      | TOK_WRITE ioctl
1520      | TOK_WRITE ioctl outlist
1521      | TOK_REWIND after_rewind
1522      | TOK_ALLOCATE '(' allocation_list opt_stat_spec ')'          { inallocate = 0; }
1523      | TOK_DEALLOCATE '(' allocate_object_list opt_stat_spec ')'   { inallocate = 0; }
1524      | TOK_EXIT optexpr
1525      | TOK_RETURN opt_expr
1526      | TOK_CYCLE opt_expr
1527      | stop opt_expr
1528      | int_list
1529      | TOK_NULLIFY '(' pointer_name_list ')'
1530      | word_endunit
1531        {
1532            GlobalDeclaration = 0 ;
1533            if ( firstpass == 0 && strcasecmp(subroutinename,"") )
1534            {
1535                if ( module_declar && insubroutinedeclare == 0 )    fclose(module_declar);
1536            }
1537            if ( strcasecmp(subroutinename,"") )
1538            {
1539                if ( inmodulemeet == 1 )
1540                {
1541                    /* we are in a module                                */
1542                    if ( insubroutinedeclare == 1 )
1543                    {
1544                        /* it is like an end subroutine <name>            */
1545                        insubroutinedeclare = 0 ;
1546                        pos_cur = setposcur();
1547                        closeandcallsubloopandincludeit_0(1);
1548                        functiondeclarationisdone = 0;
1549                    }
1550                    else
1551                    {
1552                        /* it is like an end module <name>                */
1553                        inmoduledeclare = 0 ;
1554                        inmodulemeet = 0 ;
1555                    }
1556                }
1557                else
1558                {
1559                    insubroutinedeclare = 0;
1560                    pos_cur = setposcur();
1561                    closeandcallsubloopandincludeit_0(2);
1562                    functiondeclarationisdone = 0;
1563                }
1564            }
1565            strcpy(subroutinename,"");
1566        }
1567      | word_endprogram opt_name
1568        {
1569            insubroutinedeclare = 0;
1570            inprogramdeclare = 0;
1571            pos_cur = setposcur();
1572            closeandcallsubloopandincludeit_0(3);
1573            functiondeclarationisdone = 0;
1574            strcpy(subroutinename,"");
1575        }
1576      | word_endsubroutine opt_name
1577        {
1578            if ( strcasecmp(subroutinename,"") )
1579            {
1580                insubroutinedeclare = 0;
1581                pos_cur = setposcur();
1582                closeandcallsubloopandincludeit_0(1);
1583                functiondeclarationisdone = 0;
1584                strcpy(subroutinename,"");
1585            }
1586        }
1587      | word_endfunction opt_name
1588        {
1589            insubroutinedeclare = 0;
1590            pos_cur = setposcur();
1591            closeandcallsubloopandincludeit_0(0);
1592            functiondeclarationisdone = 0;
1593            strcpy(subroutinename,"");
1594        }
1595      | TOK_ENDMODULE opt_name
1596        {
1597            /* if we never meet the contains keyword               */
1598            if ( firstpass == 0 )
1599            {
1600                RemoveWordCUR_0(fortran_out, strlen($2)+11);    // Remove word "end module"
1601                if ( inmoduledeclare && ! aftercontainsdeclare )
1602                {
1603                    Write_Closing_Module(1);
1604                }
1605                fprintf(fortran_out,"\n      end module %s\n", curmodulename);
1606                if ( module_declar && insubroutinedeclare == 0 )
1607                {
1608                    fclose(module_declar);
1609                }
1610            }
1611            inmoduledeclare = 0 ;
1612            inmodulemeet = 0 ;
1613            aftercontainsdeclare = 1;
1614            strcpy(curmodulename, "");
1615            GlobalDeclaration = 0 ;
1616        }
1617      | if-stmt
1618      | where-stmt
1619      | TOK_CONTAINS
1620        {
1621            if ( inside_type_declare ) break;
1622            if ( inmoduledeclare )
1623            {
1624                if ( firstpass == 0 )
1625                {
1626                    RemoveWordCUR_0(fortran_out,9);   // Remove word 'contains'
1627                    Write_Closing_Module(0);
1628                }
1629                inmoduledeclare = 0 ;
1630                aftercontainsdeclare = 1;
1631            }
1632            else if ( insubroutinedeclare )
1633            {
1634                incontainssubroutine = 1;
1635                insubroutinedeclare  = 0;
1636                incontainssubroutine = 0;
1637                functiondeclarationisdone = 0;
1638
1639                if ( firstpass )
1640                    List_ContainsSubroutine = Addtolistnom(subroutinename, List_ContainsSubroutine, 0);
1641                else
1642                    closeandcallsubloop_contains_0();
1643
1644                strcpy(subroutinename, "");
1645            }
1646            else printf("l.%4d -- TOK_CONTAINS -- MHCHECK\n",line_num_input);
1647        }
1648      ;
1649
1650/* R601 : variable */
1651//variable : expr
1652//       ;
1653
1654/* R734 : assignment-stmt */
1655// assignment-stmt: variable '=' expr
1656//       ;
1657assignment-stmt: expr
1658      ;
1659
1660/* R741 : where-stmt */
1661where-stmt: TOK_WHERE '(' mask-expr ')' where-assignment-stmt
1662      ;
1663
1664/* R742 : where-construct */
1665where-construct: where-construct-stmt line-break opt-where-body-construct opt-masked-elsewhere-construct opt-elsewhere-construct end-where-stmt
1666      ;
1667
1668opt-where-body-construct:
1669      | opt-where-body-construct where-body-construct line-break
1670      ;
1671
1672opt-masked-elsewhere-construct :
1673      | opt-masked-elsewhere-construct masked-elsewhere-stmt line-break opt-where-body-construct
1674      ;
1675
1676opt-elsewhere-construct:
1677      | opt-elsewhere-construct elsewhere-stmt line-break opt-where-body-construct
1678      ;
1679
1680/* R743 : where-construct-stmt */
1681where-construct-stmt:
1682        TOK_WHERE '(' mask-expr ')'
1683      ;
1684
1685/* R744 : where-body-construct */
1686where-body-construct: where-assignment-stmt
1687      | where-stmt
1688      | where-construct
1689      ;
1690
1691/* R745 : where-assignment-stmt */
1692where-assignment-stmt: assignment-stmt
1693      ;
1694
1695/* R746 : mask-expr */
1696mask-expr: expr
1697      ;
1698
1699/* R747 : masked-elsewhere-stmt */
1700masked-elsewhere-stmt:
1701        TOK_ELSEWHEREPAR mask-expr ')'
1702      | TOK_ELSEWHEREPAR mask-expr ')' TOK_NAME
1703      ;
1704
1705/* R748: elsewhere-stmt */
1706elsewhere-stmt:
1707        TOK_ELSEWHERE
1708      | TOK_ELSEWHERE TOK_NAME
1709      ;
1710
1711/* R749: end-where-stmt */
1712end-where-stmt:
1713        TOK_ENDWHERE
1714      | TOK_ENDWHERE TOK_NAME
1715      ;
1716
1717/* R752 : forall-header */
1718forall-header :
1719     ;
1720
1721/* R801 : block */
1722block:
1723      |block execution-part-construct
1724      |block execution-part-construct line-break
1725      ;
1726
1727/* R813 : do-construct */
1728do-construct:
1729        block-do-construct
1730      ;
1731
1732/* R814 : block-do-construct */
1733block-do-construct:
1734        do-stmt line-break do-block end-do
1735      ;
1736
1737/* R815 : do-stmt */
1738do-stmt:
1739        label-do-stmt
1740      | nonlabel-do-stmt
1741      ;
1742
1743/* R816 : label-do-stmt */
1744label-do-stmt:
1745        TOK_NAME ':' TOK_PLAINDO label
1746      |              TOK_PLAINDO label
1747      | TOK_NAME ':' TOK_PLAINDO label loop-control
1748      |              TOK_PLAINDO label loop-control
1749      ;
1750
1751/* R817 : nonlabel-do-stmt */
1752nonlabel-do-stmt:
1753        TOK_NAME ':' TOK_PLAINDO
1754      |              TOK_PLAINDO
1755      | TOK_NAME ':' TOK_PLAINDO loop-control
1756      |              TOK_PLAINDO loop-control
1757      ;
1758
1759/* R818 : loop-control */
1760loop-control:
1761        opt_comma do-variable '=' expr ',' expr
1762      | opt_comma do-variable '=' expr ',' expr ',' expr
1763      | opt_comma TOK_WHILE '(' expr ')'
1764      | opt_comma TOK_CONCURRENT forall-header
1765      ;
1766
1767/* R819 : do-variable */
1768do-variable : ident
1769     ;
1770
1771/* R820 : do-block */
1772do-block: block
1773     ;
1774
1775/* R821 : end-do */
1776end-do: end-do-stmt
1777     | continue-stmt
1778     ;
1779
1780/* R822 : end-do-stmt */
1781end-do-stmt:
1782        TOK_ENDDO
1783      | TOK_ENDDO TOK_NAME
1784      ;
1785
1786/* R832 : if-construct */
1787if-construct: if-then-stmt line-break block opt-else-if-stmt-block opt-else-stmt-block end-if-stmt
1788      ;
1789
1790opt-else-if-stmt-block:
1791      | else-if-stmt-block
1792      | opt-else-if-stmt-block else-if-stmt-block
1793      ;
1794
1795else-if-stmt-block:
1796        else-if-stmt line-break block
1797      ;
1798
1799opt-else-stmt-block:
1800      | else-stmt-block
1801      | opt-else-stmt-block else-if-stmt-block
1802      ;
1803
1804else-stmt-block: else-stmt line-break block
1805        ;
1806
1807/* R833 : if-then-stmt */
1808if-then-stmt:
1809         TOK_NAME ':' TOK_LOGICALIF '(' expr ')' TOK_THEN
1810      |               TOK_LOGICALIF '(' expr ')' TOK_THEN
1811      ;
1812
1813/* R834 : else-if-stmt */
1814else-if-stmt:
1815        TOK_ELSEIF '(' expr ')' TOK_THEN
1816      | TOK_ELSEIF '(' expr ')' TOK_THEN TOK_NAME
1817      ;
1818
1819/* R835 : else-stmt */
1820else-stmt:
1821        TOK_ELSE
1822      | TOK_ELSE TOK_NAME
1823      ;
1824
1825/* R836 : end-if-stmt */
1826end-if-stmt:
1827        TOK_ENDIF
1828      | TOK_ENDIF TOK_NAME
1829      ;
1830
1831/* R837 : if-stmt */
1832if-stmt: TOK_LOGICALIF '(' expr ')' action-stmt
1833        ;
1834
1835/* R838 : case-construct */
1836case-construct: select-case-stmt line-break opt_case-stmt-block end-select-stmt
1837        ;
1838
1839opt_case-stmt-block:
1840        | case-stmt-block
1841        | opt_case-stmt-block case-stmt-block
1842        ;
1843
1844case-stmt-block: case-stmt line-break block
1845        ;
1846
1847/* R839 : select-case-stmt */
1848select-case-stmt :
1849          TOK_NAME ':' TOK_SELECTCASE '(' expr ')'
1850        |              TOK_SELECTCASE '(' expr ')'
1851        ;
1852
1853/* R840 : case-stmt */
1854case-stmt:
1855          TOK_CASE case-selector
1856        | TOK_CASE case-selector TOK_NAME
1857        ;
1858
1859/* R840 : end-select-stmt */
1860end-select-stmt:
1861          TOK_ENDSELECT
1862        | TOK_ENDSELECT TOK_NAME
1863        ;
1864
1865/* R843 : case-selector */
1866case-selector:
1867          '(' case-value-range-list ')'
1868        | TOK_DEFAULT
1869        ;
1870
1871case-value-range-list:
1872        case-value-range
1873      | case-value-range-list ',' case-value-range
1874      ;
1875
1876/* R844: case-value-range */
1877case-value-range :
1878        case-value
1879      | case-value ':'
1880      | ':' case-value
1881      | case-value ':' case-value
1882      ;
1883
1884/* R845 : case-value */
1885case-value: expr
1886        ;
1887
1888/* R854 : continue-stmt */
1889continue-stmt: TOK_CONTINUE
1890        ;
1891
1892/* R1001 : format-stmt */
1893format-stmt: TOK_FORMAT
1894        ;
1895
1896word_endsubroutine :
1897        TOK_ENDSUBROUTINE
1898        {
1899            strcpy($$,$1);
1900            pos_endsubroutine = setposcur()-strlen($1);
1901            functiondeclarationisdone = 0;
1902        }
1903      ;
1904word_endunit :
1905        TOK_ENDUNIT
1906        {
1907            strcpy($$,$1);
1908            pos_endsubroutine = setposcur()-strlen($1);
1909        }
1910      ;
1911word_endprogram :
1912        TOK_ENDPROGRAM
1913        {
1914            strcpy($$,$1);
1915            pos_endsubroutine = setposcur()-strlen($1);
1916        }
1917      ;
1918word_endfunction :
1919        TOK_ENDFUNCTION
1920        {
1921            strcpy($$,$1);
1922            pos_endsubroutine = setposcur()-strlen($1);
1923        }
1924      ;
1925
1926opt_name : '\n'  {strcpy($$,"");}
1927      | TOK_NAME {strcpy($$,$1);}
1928      ;
1929
1930before_dims : { created_dimensionlist = 0; }
1931      ;
1932ident_dims :
1933        ident before_dims dims dims
1934        {
1935            created_dimensionlist = 1;
1936            if ( ($3 == NULL) || ($4 == NULL) ) break;
1937            if  ( agrif_parentcall == 1 )
1938            {
1939                ModifyTheAgrifFunction_0($3->dim.last);
1940                agrif_parentcall = 0;
1941                fprintf(fortran_out," = ");
1942            }
1943        }
1944      | ident_dims '%' declare_after_percent ident before_dims dims dims
1945        {
1946            created_dimensionlist = 1;
1947        }
1948      ;
1949int_list :
1950        TOK_CSTINT
1951      | int_list ',' TOK_CSTINT
1952      ;
1953after_ident_dims :
1954        '=' expr
1955      | TOK_POINT_TO expr
1956      ;
1957call :  keywordcall opt_call
1958        {
1959            inagrifcallargument = 0 ;
1960            incalldeclare=0;
1961            if ( oldfortran_out && (callagrifinitgrids == 1) && (firstpass == 0) )
1962            {
1963                pos_end = setposcur();
1964                RemoveWordSET_0(fortran_out,pos_curcall,pos_end-pos_curcall);
1965                strcpy(subofagrifinitgrids,subroutinename);
1966            }
1967            Instanciation_0(sameagrifname);
1968        }
1969      ;
1970opt_call :
1971      | '(' opt_callarglist  ')'
1972      ;
1973opt_callarglist :
1974      | callarglist
1975      ;
1976keywordcall :
1977        before_call TOK_FLUSH
1978      | before_call TOK_NAME
1979        {
1980            if (!strcasecmp($2,"MPI_Init") )    callmpiinit = 1;
1981            else                                callmpiinit = 0;
1982
1983            if (!strcasecmp($2,"Agrif_Init_Grids") )
1984            {
1985                callagrifinitgrids = 1;
1986                strcpy(meetagrifinitgrids,subroutinename);
1987            }
1988            else
1989            {
1990                callagrifinitgrids = 0;
1991            }
1992            if ( Vartonumber($2) == 1 )
1993            {
1994                incalldeclare = 1;
1995                inagrifcallargument = 1 ;
1996                Add_SubroutineWhereAgrifUsed_1(subroutinename, curmodulename);
1997            }
1998        }
1999      ;
2000before_call : TOK_CALL  { pos_curcall=setposcur()-4; }
2001      ;
2002callarglist :
2003        callarg
2004      | callarglist ',' callarg
2005      ;
2006callarg :
2007        expr
2008        {
2009            if ( callmpiinit == 1 )
2010            {
2011                strcpy(mpiinitvar,$1);
2012                if ( firstpass == 1 )  Add_UsedInSubroutine_Var_1 (mpiinitvar);
2013            }
2014        }
2015      | '*' TOK_CSTINT
2016      ;
2017
2018stop :  TOK_PAUSE
2019      | TOK_STOP
2020      ;
2021
2022option_inlist :
2023      | inlist
2024      ;
2025option_read :
2026        ioctl option_inlist
2027      | infmt opt_inlist
2028      ;
2029opt_inlist :
2030      | ',' inlist
2031      ;
2032ioctl : '(' ctllist ')'
2033      ;
2034after_rewind :
2035        '(' ident ')'
2036      | '(' TOK_CSTINT ')'
2037      | TOK_CSTINT
2038      | '(' uexpr ')'
2039      | TOK_NAME
2040      ;
2041ctllist :
2042        ioclause
2043      | ctllist ',' ioclause
2044      ;
2045ioclause :
2046        fexpr
2047      | '*'
2048      | TOK_DASTER
2049      | ident expr dims
2050      | ident expr '%' declare_after_percent ident_dims
2051      | ident '(' triplet ')'
2052      | ident '*'
2053      | ident TOK_DASTER
2054      ;
2055
2056declare_after_percent:      { afterpercent = 1; }
2057      ;
2058iofctl :
2059        TOK_OPEN
2060      | TOK_CLOSE
2061      | TOK_FLUSH
2062      ;
2063infmt :  unpar_fexpr
2064      | '*'
2065      ;
2066
2067read :  TOK_READ
2068      | TOK_INQUIRE
2069      | TOK_PRINT
2070      ;
2071
2072fexpr : unpar_fexpr
2073      | '(' fexpr ')'
2074      ;
2075unpar_fexpr :
2076        lhs
2077      | simple_const
2078      | fexpr addop fexpr %prec '+'
2079      | fexpr '*' fexpr
2080      | fexpr TOK_SLASH fexpr
2081      | fexpr TOK_DASTER fexpr
2082      | addop fexpr %prec '*'
2083      | fexpr TOK_DSLASH fexpr
2084      | TOK_FILE expr
2085      | TOK_UNIT expr
2086      | TOK_NML expr
2087      | TOK_FMT expr
2088      | TOK_EXIST expr
2089      | TOK_ERR expr
2090      | TOK_END expr
2091      | TOK_NAME '=' expr
2092      | predefinedfunction
2093      ;
2094addop : '+'
2095      | '-'
2096      ;
2097inlist : inelt
2098      | inlist ',' inelt
2099      ;
2100// opt_lhs :
2101//       | lhs
2102//       ;
2103inelt : //opt_lhs opt_operation
2104        lhs opt_operation
2105      | '(' inlist ')' opt_operation
2106      | predefinedfunction opt_operation
2107      | simple_const opt_operation
2108      | '(' inlist ',' dospec ')'
2109      ;
2110opt_operation :
2111      | operation
2112      | opt_operation operation
2113      ;
2114outlist :
2115        complex_const       { strcpy($$,$1); }
2116      | predefinedfunction  { strcpy($$,$1); }
2117      | uexpr               { strcpy($$,$1); }
2118      | other               { strcpy($$,$1); }
2119      | uexpr   ',' expr    { sprintf($$,"%s,%s",$1,$3); }
2120      | uexpr   ',' other   { sprintf($$,"%s,%s",$1,$3); }
2121      | other   ',' expr    { sprintf($$,"%s,%s",$1,$3); }
2122      | other   ',' other   { sprintf($$,"%s,%s",$1,$3); }
2123      | outlist ',' expr    { sprintf($$,"%s,%s",$1,$3); }
2124      | outlist ',' other   { sprintf($$,"%s,%s",$1,$3); }
2125      ;
2126other :
2127        '(' uexpr   ',' dospec ')'    { sprintf($$,"(%s,%s)",$2,$4); }
2128      | '(' outlist ',' dospec ')'    { sprintf($$,"(%s,%s)",$2,$4); }
2129      | '(' other   ',' dospec ')'    { sprintf($$,"(%s,%s)",$2,$4); }
2130dospec :
2131        TOK_NAME '=' expr ',' expr           { sprintf($$,"%s=%s,%s)",$1,$3,$5);}
2132      | TOK_NAME '=' expr ',' expr ',' expr  { sprintf($$,"%s=%s,%s,%s)",$1,$3,$5,$7);}
2133      ;
2134goto :  TOK_PLAINGOTO '(' expr ',' expr ')' ',' expr
2135      | TOK_PLAINGOTO TOK_CSTINT
2136      ;
2137allocation_list :
2138        allocate_object
2139      | allocation_list ',' allocate_object
2140      ;
2141allocate_object :
2142        lhs     { Add_Allocate_Var_1($1,curmodulename); }
2143      ;
2144allocate_object_list :
2145        allocate_object
2146      | allocate_object_list ',' allocate_object
2147      ;
2148opt_stat_spec :
2149      | ',' TOK_STAT '=' lhs
2150      ;
2151pointer_name_list :
2152        ident
2153      | pointer_name_list ',' ident
2154      ;
2155
2156%%
2157
2158void process_fortran(const char *input_file)
2159{
2160    extern FILE *fortran_in;
2161    extern FILE *fortran_out;
2162
2163    char output_file[LONG_FNAME];
2164    char input_fullpath[LONG_FNAME];
2165
2166    if ( todebug == 1 ) printf("Firstpass == %d \n", firstpass);
2167
2168     yydebug=0;
2169/******************************************************************************/
2170/*  1-  Open input file                                                       */
2171/******************************************************************************/
2172
2173    strcpy(cur_filename, input_file);
2174    sprintf(input_fullpath, "%s/%s", input_dir, input_file);
2175
2176    fortran_in = fopen(input_fullpath, "r");
2177    if (! fortran_in)
2178    {
2179        printf("Error : File %s does not exist\n", input_fullpath);
2180        exit(1);
2181    }
2182
2183/******************************************************************************/
2184/*  2-  Variables initialization                                              */
2185/******************************************************************************/
2186
2187    line_num_input = 1;
2188    PublicDeclare = 0;
2189    PrivateDeclare = 0;
2190    ExternalDeclare = 0;
2191    SaveDeclare = 0;
2192    pointerdeclare = 0;
2193    optionaldeclare = 0;
2194    incalldeclare = 0;
2195    inside_type_declare = 0;
2196    Allocatabledeclare = 0 ;
2197    Targetdeclare = 0 ;
2198    VariableIsParameter =  0 ;
2199    strcpy(NamePrecision,"");
2200    c_star = 0 ;
2201    functiondeclarationisdone = 0;
2202    insubroutinedeclare = 0 ;
2203    strcpy(subroutinename," ");
2204    isrecursive = 0;
2205    InitialValueGiven = 0 ;
2206    GlobalDeclarationType = 0;
2207    inmoduledeclare = 0;
2208    incontainssubroutine = 0;
2209    afterpercent = 0;
2210    aftercontainsdeclare = 1;
2211    strcpy(nameinttypename,"");
2212
2213/******************************************************************************/
2214/*  3-  Parsing of the input file (1 time)                                    */
2215/******************************************************************************/
2216
2217    sprintf(output_file, "%s/%s", output_dir, input_file);
2218
2219    if (firstpass == 0) fortran_out = fopen(output_file,"w");
2220
2221    fortran_parse();
2222
2223    if (firstpass == 0) NewModule_Creation_0();
2224    if (firstpass == 0) fclose(fortran_out);
2225}
Note: See TracBrowser for help on using the repository browser.