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.
fortran.y in vendors/AGRIF/dev/LEX – NEMO

source: vendors/AGRIF/dev/LEX/fortran.y @ 13680

Last change on this file since 13680 was 12420, checked in by smueller, 4 years ago

Reintegration of the AGRIF development branch associated with NEMO development branch 2019/dev_r11613_ENHANCE-04_namelists_as_internalfiles (/vendors/AGRIF/dev_r11615_ENHANCE-04_namelists_as_internalfiles_agrif) into /vendors/AGRIF/dev
  • Property svn:mime-type set to text/x-csrc
File size: 67.6 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      | ':'    { strcpy(CharacterSize,":"); strcpy($$,":"); }
1031      ;
1032opt_clause :
1033      | ',' TOK_NAME clause
1034      ;
1035options :
1036      | TOK_FOURDOTS
1037      | ',' attr_spec_list TOK_FOURDOTS
1038      ;
1039attr_spec_list : attr_spec
1040      | attr_spec_list ',' attr_spec
1041      ;
1042attr_spec :
1043        TOK_PARAMETER       { VariableIsParameter = 1; }
1044      | access_spec
1045      | TOK_ALLOCATABLE     { Allocatabledeclare = 1; }
1046      | TOK_DIMENSION dims  { dimsgiven = 1; curdim = $2; }
1047      | TOK_EXTERNAL        { ExternalDeclare = 1; }
1048      | TOK_INTENT '(' intent_spec ')'
1049                            { strcpy(IntentSpec,$3); }
1050      | TOK_INTRINSIC
1051      | TOK_OPTIONAL        { optionaldeclare = 1 ; }
1052      | TOK_POINTER         { pointerdeclare = 1 ; }
1053      | TOK_SAVE            { SaveDeclare = 1 ; }
1054      | TOK_TARGET          { Targetdeclare = 1; }
1055      ;
1056intent_spec :
1057        TOK_IN          { strcpy($$,$1); }
1058      | TOK_OUT         { strcpy($$,$1); }
1059      | TOK_INOUT       { strcpy($$,$1); }
1060      ;
1061access_spec :
1062        TOK_PUBLIC      { PublicDeclare = 1;  }
1063      | TOK_PRIVATE     { PrivateDeclare = 1; }
1064      ;
1065dims :  { $$ = (listdim*) NULL; }
1066      | '(' dimlist ')'
1067        {
1068            $$ = (listdim*) NULL;
1069            if ( inside_type_declare ) break;
1070            if ( created_dimensionlist == 1 || agrif_parentcall == 1 )  $$=$2;
1071        }
1072      ;
1073dimlist :
1074        dim
1075        {
1076            $$ = (listdim*) NULL;
1077            if ( inside_type_declare ) break;
1078            if ( created_dimensionlist == 1 || agrif_parentcall == 1 )  $$=insertdim(NULL,$1);
1079        }
1080      | dimlist ',' dim
1081        {
1082            $$ = (listdim*) NULL;
1083            if ( inside_type_declare ) break;
1084            if ( (!inside_type_declare) && created_dimensionlist == 1 ) $$=insertdim($1,$3);
1085        }
1086      ;
1087dim :   ubound              { strcpy($$.first,"1"); strcpy($$.last,$1); Save_Length($1,1); }
1088      | ':'                 { strcpy($$.first,"");  strcpy($$.last,"");                    }
1089      | expr ':'            { strcpy($$.first,$1);  Save_Length($1,2); strcpy($$.last,""); }
1090      | ':' expr            { strcpy($$.first,"");  strcpy($$.last,$2); Save_Length($2,1); }
1091      | expr ':' ubound     { strcpy($$.first,$1);  Save_Length($1,2); strcpy($$.last,$3); Save_Length($3,1); }
1092      ;
1093ubound :
1094        '*'                 { strcpy($$,"*"); }
1095      | expr                { strcpy($$,$1);  }
1096      ;
1097expr :  uexpr               { strcpy($$,$1); }
1098      | complex_const       { strcpy($$,$1); }
1099      | predefinedfunction  { strcpy($$,$1); }
1100      | '(' expr ')'        { sprintf($$,"(%s)",$2); }
1101      ;
1102
1103predefinedfunction :
1104        TOK_SUM minmaxlist ')'          { sprintf($$,"SUM(%s)",$2);}
1105      | TOK_MAX minmaxlist ')'          { sprintf($$,"MAX(%s)",$2);}
1106      | TOK_TANH '(' minmaxlist ')'     { sprintf($$,"TANH(%s)",$3);}
1107      | TOK_MAXVAL '(' minmaxlist ')'   { sprintf($$,"MAXVAL(%s)",$3);}
1108      | TOK_MIN minmaxlist ')'          { sprintf($$,"MIN(%s)",$2);}
1109      | TOK_MINVAL '(' minmaxlist ')'   { sprintf($$,"MINVAL(%s)",$3);}
1110      | TOK_TRIM '(' expr ')'           { sprintf($$,"TRIM(%s)",$3);}
1111      | TOK_SQRT expr ')'               { sprintf($$,"SQRT(%s)",$2);}
1112      | TOK_REAL '(' minmaxlist ')'     { sprintf($$,"REAL(%s)",$3);}
1113      | TOK_NINT '(' expr ')'           { sprintf($$,"NINT(%s)",$3);}
1114      | TOK_FLOAT '(' expr ')'          { sprintf($$,"FLOAT(%s)",$3);}
1115      | TOK_EXP '(' expr ')'            { sprintf($$,"EXP(%s)",$3);}
1116      | TOK_COS '(' expr ')'            { sprintf($$,"COS(%s)",$3);}
1117      | TOK_COSH '(' expr ')'           { sprintf($$,"COSH(%s)",$3);}
1118      | TOK_ACOS '(' expr ')'           { sprintf($$,"ACOS(%s)",$3);}
1119      | TOK_SIN '(' expr ')'            { sprintf($$,"SIN(%s)",$3);}
1120      | TOK_SINH '(' expr ')'           { sprintf($$,"SINH(%s)",$3);}
1121      | TOK_ASIN '(' expr ')'           { sprintf($$,"ASIN(%s)",$3);}
1122      | TOK_LOG '(' expr ')'            { sprintf($$,"LOG(%s)",$3);}
1123      | TOK_TAN '(' expr ')'            { sprintf($$,"TAN(%s)",$3);}
1124      | TOK_ATAN '(' expr ')'           { sprintf($$,"ATAN(%s)",$3);}
1125      | TOK_ABS expr ')'                { sprintf($$,"ABS(%s)",$2);}
1126      | TOK_MOD '(' minmaxlist ')'      { sprintf($$,"MOD(%s)",$3);}
1127      | TOK_SIGN minmaxlist ')'         { sprintf($$,"SIGN(%s)",$2);}
1128      | TOK_MINLOC '(' minmaxlist ')'   { sprintf($$,"MINLOC(%s)",$3);}
1129      | TOK_MAXLOC '(' minmaxlist ')'   { sprintf($$,"MAXLOC(%s)",$3);}
1130      ;
1131minmaxlist : expr {strcpy($$,$1);}
1132      | minmaxlist ',' expr     { sprintf($$,"%s,%s",$1,$3); }
1133      ;
1134uexpr : lhs                     { strcpy($$,$1); }
1135      | simple_const            { strcpy($$,$1); }
1136      | vec                     { strcpy($$,$1); }
1137      | expr operation          { sprintf($$,"%s%s",$1,$2); }
1138      | signe expr %prec '*'    { sprintf($$,"%s%s",$1,$2); }
1139      | TOK_NOT expr            { sprintf($$,"%s%s",$1,$2); }
1140      ;
1141signe : '+'        { strcpy($$,"+"); }
1142      | '-'        { strcpy($$,"-"); }
1143      ;
1144
1145operation :
1146        '+' expr %prec '+'          { sprintf($$,"+%s",$2); }
1147      | '-' expr %prec '+'          { sprintf($$,"-%s",$2); }
1148      | '*' expr                    { sprintf($$,"*%s",$2); }
1149      | TOK_DASTER expr             { sprintf($$,"%s%s",$1,$2); }
1150      | TOK_EQ expr %prec TOK_EQ    { sprintf($$,"%s%s",$1,$2); }
1151      | TOK_EQV expr %prec TOK_EQV  { sprintf($$,"%s%s",$1,$2); }
1152      | TOK_GT expr %prec TOK_EQ    { sprintf($$,"%s%s",$1,$2); }
1153      | '>' expr %prec TOK_EQ       { sprintf($$," > %s",$2); }
1154      | '<' expr %prec TOK_EQ       { sprintf($$," < %s",$2); }
1155      | '>''=' expr %prec TOK_EQ    { sprintf($$," >= %s",$3); }
1156      | '<''=' expr %prec TOK_EQ    { sprintf($$," <= %s",$3); }
1157      | TOK_LT expr %prec TOK_EQ    { sprintf($$,"%s%s",$1,$2); }
1158      | TOK_GE expr %prec TOK_EQ    { sprintf($$,"%s%s",$1,$2); }
1159      | TOK_LE expr %prec TOK_EQ    { sprintf($$,"%s%s",$1,$2); }
1160      | TOK_NE expr %prec TOK_EQ    { sprintf($$,"%s%s",$1,$2); }
1161      | TOK_NEQV expr %prec TOK_EQV { sprintf($$,"%s%s",$1,$2); }
1162      | TOK_XOR expr                { sprintf($$,"%s%s",$1,$2); }
1163      | TOK_OR expr                 { sprintf($$,"%s%s",$1,$2); }
1164      | TOK_AND expr                { sprintf($$,"%s%s",$1,$2); }
1165      | TOK_SLASH after_slash       { sprintf($$,"%s",$2); }
1166      | '=' after_equal             { sprintf($$,"%s",$2); }
1167
1168after_slash :                   { strcpy($$,""); }
1169      | expr                    { sprintf($$,"/%s",$1); }
1170      | '=' expr %prec TOK_EQ   { sprintf($$,"/= %s",$2);}
1171      | TOK_SLASH expr          { sprintf($$,"//%s",$2); }
1172      ;
1173after_equal :
1174        '=' expr %prec TOK_EQ   { sprintf($$,"==%s",$2); }
1175      | expr                    { sprintf($$,"= %s",$1); }
1176      ;
1177
1178lhs :   ident                           { strcpy($$,$1); }
1179      | structure_component             { strcpy($$,$1); }
1180      | array_ele_substring_func_ref    { strcpy($$,$1); }
1181      ;
1182
1183beforefunctionuse :
1184        {
1185            agrif_parentcall = 0;
1186            if ( !strcasecmp(identcopy, "Agrif_Parent") )   agrif_parentcall = 1;
1187            if ( Agrif_in_Tok_NAME(identcopy) )
1188            {
1189                inagrifcallargument = 1;
1190                Add_SubroutineWhereAgrifUsed_1(subroutinename, curmodulename);
1191            }
1192        }
1193      ;
1194array_ele_substring_func_ref :
1195        begin_array                                         { strcpy($$,$1); if ( incalldeclare == 0 ) inagrifcallargument = 0;   }
1196      | begin_array substring                               { sprintf($$," %s %s ",$1,$2); }
1197      | structure_component '(' funarglist ')'              { sprintf($$," %s ( %s )",$1,$3); }
1198      | structure_component '(' funarglist ')' substring    { sprintf($$," %s ( %s ) %s ",$1,$3,$5); }
1199      ;
1200begin_array :
1201        ident '(' funarglist ')'
1202        {
1203            if ( inside_type_declare ) break;
1204            sprintf($$," %s ( %s )",$1,$3);
1205            ModifyTheAgrifFunction_0($3);
1206            agrif_parentcall = 0;
1207        }
1208      ;
1209structure_component :
1210        lhs '%' declare_after_percent lhs
1211        {
1212            sprintf($$," %s %% %s ",$1,$4);
1213            if ( incalldeclare == 0 ) inagrifcallargument = 0;
1214        }
1215      ;
1216vec :
1217        TOK_LEFTAB outlist TOK_RIGHTAB   { sprintf($$,"(/%s/)",$2); }
1218      ;
1219funarglist :
1220        beforefunctionuse           { strcpy($$," "); }
1221      | beforefunctionuse funargs   { strcpy($$,$2); }
1222      ;
1223funargs :
1224        funarg              {  strcpy($$,$1); }
1225      | funargs ',' funarg  {  sprintf($$,"%s,%s",$1,$3); }
1226      ;
1227funarg :
1228        expr       {strcpy($$,$1);}
1229      | triplet    {strcpy($$,$1);}
1230      ;
1231triplet :
1232        expr ':' expr           {  sprintf($$,"%s :%s",$1,$3);}
1233      | expr ':' expr ':' expr  {  sprintf($$,"%s :%s :%s",$1,$3,$5);}
1234      | ':' expr ':' expr       {  sprintf($$,":%s :%s",$2,$4);}
1235      | ':' ':' expr            {  sprintf($$,": : %s",$3);}
1236      | ':' expr                {  sprintf($$,":%s",$2);}
1237      | expr ':'                {  sprintf($$,"%s :",$1);}
1238      | ':'                     {  sprintf($$,":");}
1239      ;
1240ident : TOK_NAME
1241        {
1242            if ( afterpercent == 0 )
1243            {
1244                if ( Agrif_in_Tok_NAME($1) ) Add_SubroutineWhereAgrifUsed_1(subroutinename, curmodulename);
1245                if ( !strcasecmp($1,"Agrif_Parent") )   agrif_parentcall = 1;
1246                if ( VariableIsFunction($1) )
1247                {
1248                    if ( inagrifcallargument == 1 )
1249                    {
1250                        if ( !strcasecmp($1,identcopy) )
1251                        {
1252                            strcpy(sameagrifname,identcopy);
1253                            sameagrifargument = 1;
1254                        }
1255                    }
1256                    strcpy(identcopy,$1);
1257                    pointedvar = 0;
1258
1259                    if (variscoupled_0($1)) strcpy(truename, getcoupledname_0($1));
1260                    else                    strcpy(truename, $1);
1261
1262                    if ( VarIsNonGridDepend(truename) == 0 && (! Variableshouldberemoved(truename)) )
1263                    {
1264                        if ( inagrifcallargument == 1 || varispointer_0(truename) == 1 )
1265                        {
1266                            if ( (IsinListe(List_UsedInSubroutine_Var,$1) == 1) || (inagrifcallargument == 1) )
1267                            {
1268                                if (varistyped_0(truename) == 0)    ModifyTheVariableName_0(truename,strlen($1));
1269                            }
1270                        }
1271                        if ( inagrifcallargument != 1 || sameagrifargument ==1 )
1272                        {
1273                            Add_UsedInSubroutine_Var_1(truename);
1274                        }
1275                    }
1276                    NotifyAgrifFunction_0(truename);
1277                }
1278            }
1279            else
1280            {
1281                afterpercent = 0;
1282            }
1283        }
1284      ;
1285simple_const :
1286        TOK_TRUE     { strcpy($$,".TRUE.");}
1287      | TOK_FALSE    { strcpy($$,".FALSE.");}
1288      | TOK_NULL_PTR { strcpy($$,"NULL()"); }
1289      | TOK_CSTINT   { strcpy($$,$1); }
1290      | TOK_CSTREAL  { strcpy($$,$1); }
1291      | TOK_HEXA     { strcpy($$,$1); }
1292      | simple_const TOK_NAME
1293                     { sprintf($$,"%s%s",$1,$2); }
1294      | string_constant opt_substring
1295      ;
1296string_constant :
1297        TOK_CHAR_CONSTANT                   { strcpy($$,$1);}
1298      | string_constant TOK_CHAR_CONSTANT
1299      | TOK_CHAR_MESSAGE                    { strcpy($$,$1);}
1300      | TOK_CHAR_CUT                        { strcpy($$,$1);}
1301      ;
1302opt_substring :     { strcpy($$," ");}
1303      | substring   { strcpy($$,$1);}
1304      ;
1305substring :
1306        '(' optexpr ':' optexpr ')' { sprintf($$,"(%s :%s)",$2,$4);}
1307      ;
1308optexpr :           { strcpy($$," ");}
1309      | expr        { strcpy($$,$1);}
1310      ;
1311opt_expr :
1312        '\n'        { strcpy($$," ");}
1313      | expr        { strcpy($$,$1);}
1314      ;
1315initial_value :     { InitialValueGiven = 0; }
1316      | '=' expr
1317        {
1318            if ( inside_type_declare ) break;
1319            strcpy(InitValue,$2);
1320            InitialValueGiven = 1;
1321        }
1322      | TOK_POINT_TO expr
1323        {
1324            if ( inside_type_declare ) break;
1325            strcpy(InitValue,$2);
1326            InitialValueGiven = 2;
1327        }
1328      ;
1329complex_const :
1330        '(' uexpr ',' uexpr ')' {sprintf($$,"(%s,%s)",$2,$4); }
1331      ;
1332use_stat :
1333        word_use TOK_NAME
1334        {
1335            /* if variables has been declared in a subroutine       */
1336            sprintf(charusemodule, "%s", $2);
1337            if ( firstpass )
1338            {
1339                Add_NameOfModuleUsed_1($2);
1340            }
1341            else
1342            {
1343                if ( insubroutinedeclare )
1344                    copyuse_0($2);
1345
1346                if ( inmoduledeclare == 0 )
1347                {
1348                    pos_end = setposcur();
1349                    RemoveWordSET_0(fortran_out,pos_curuse,pos_end-pos_curuse);
1350                }
1351            }
1352        }
1353      | word_use TOK_NAME ',' rename_list
1354        {
1355            if ( firstpass )
1356            {
1357                if ( insubroutinedeclare )
1358                {
1359                    Add_CouplePointed_Var_1($2,$4);
1360                    coupletmp = $4;
1361                    strcpy(ligne,"");
1362                    while ( coupletmp )
1363                    {
1364                        strcat(ligne, coupletmp->c_namevar);
1365                        strcat(ligne, " => ");
1366                        strcat(ligne, coupletmp->c_namepointedvar);
1367                        coupletmp = coupletmp->suiv;
1368                        if ( coupletmp ) strcat(ligne,",");
1369                    }
1370                    sprintf(charusemodule,"%s",$2);
1371                }
1372                Add_NameOfModuleUsed_1($2);
1373            }
1374            if ( inmoduledeclare == 0 )
1375            {
1376                pos_end = setposcur();
1377                RemoveWordSET_0(fortran_out,pos_curuse,pos_end-pos_curuse);
1378            }
1379        }
1380      | word_use TOK_NAME ',' TOK_ONLY ':' '\n'
1381        {
1382            /* if variables has been declared in a subroutine       */
1383            sprintf(charusemodule,"%s",$2);
1384            if ( firstpass )
1385            {
1386                Add_NameOfModuleUsed_1($2);
1387            }
1388            else
1389            {
1390                if ( insubroutinedeclare )
1391                    copyuseonly_0($2);
1392
1393                if ( inmoduledeclare == 0 )
1394                {
1395                    pos_end = setposcur();
1396                    RemoveWordSET_0(fortran_out,pos_curuse,pos_end-pos_curuse);
1397                }
1398            }
1399        }
1400      | word_use  TOK_NAME ',' TOK_ONLY ':' only_list
1401        {
1402            /* if variables has been declared in a subroutine      */
1403            if ( firstpass )
1404            {
1405                if ( insubroutinedeclare )
1406                {
1407                    Add_CouplePointed_Var_1($2,$6);
1408                    coupletmp = $6;
1409                    strcpy(ligne,"");
1410                    while ( coupletmp )
1411                    {
1412                        strcat(ligne,coupletmp->c_namevar);
1413                        if ( strcasecmp(coupletmp->c_namepointedvar,"") )   strcat(ligne," => ");
1414                        strcat(ligne,coupletmp->c_namepointedvar);
1415                        coupletmp = coupletmp->suiv;
1416                        if ( coupletmp ) strcat(ligne,",");
1417                    }
1418                    sprintf(charusemodule,"%s",$2);
1419                }
1420                Add_NameOfModuleUsed_1($2);
1421            }
1422            else /* if ( firstpass == 0 ) */
1423            {
1424                if ( inmoduledeclare == 0 )
1425                {
1426                    pos_end = setposcur();
1427                    RemoveWordSET_0(fortran_out,pos_curuse,pos_end-pos_curuse);
1428                    if (oldfortran_out)  variableisglobalinmodule($6,$2,oldfortran_out,pos_curuseold);
1429                }
1430                else
1431                {
1432                    /* if we are in the module declare and if the    */
1433                    /* onlylist is a list of global variable         */
1434                    variableisglobalinmodule($6, $2, fortran_out,pos_curuse);
1435                }
1436            }
1437        }
1438      ;
1439word_use :
1440        TOK_USE
1441        {
1442            pos_curuse = setposcur()-strlen($1);
1443            if (firstpass == 0 && oldfortran_out) pos_curuseold = setposcurname(oldfortran_out);
1444        }
1445      ;
1446rename_list :
1447        rename_name
1448        {
1449            $$ = $1;
1450        }
1451      | rename_list ',' rename_name
1452        {
1453            /* insert the variable in the list $1                 */
1454            $3->suiv = $1;
1455            $$ = $3;
1456        }
1457      ;
1458rename_name : TOK_NAME TOK_POINT_TO TOK_NAME
1459        {
1460            coupletmp = (listcouple *) calloc(1,sizeof(listcouple));
1461            strcpy(coupletmp->c_namevar,$1);
1462            strcpy(coupletmp->c_namepointedvar,$3);
1463            coupletmp->suiv = NULL;
1464            $$ = coupletmp;
1465        }
1466      ;
1467only_list :
1468        only_name   {  $$ = $1; }
1469      | only_list ',' only_name
1470        {
1471            /* insert the variable in the list $1                 */
1472            $3->suiv = $1;
1473            $$ = $3;
1474        }
1475      ;
1476only_name :
1477        TOK_NAME TOK_POINT_TO TOK_NAME
1478        {
1479            coupletmp = (listcouple *)calloc(1,sizeof(listcouple));
1480            strcpy(coupletmp->c_namevar,$1);
1481            strcpy(coupletmp->c_namepointedvar,$3);
1482            coupletmp->suiv = NULL;
1483            $$ = coupletmp;
1484            pointedvar = 1;
1485            Add_UsedInSubroutine_Var_1($1);
1486        }
1487      | TOK_NAME
1488        {
1489            coupletmp = (listcouple *)calloc(1,sizeof(listcouple));
1490            strcpy(coupletmp->c_namevar,$1);
1491            strcpy(coupletmp->c_namepointedvar,"");
1492            coupletmp->suiv = NULL;
1493            $$ = coupletmp;
1494        }
1495      ;
1496
1497/* R209 : execution-part-construct */
1498execution-part-construct:
1499        executable-construct
1500      | format-stmt
1501      ;
1502
1503/* R213 : executable-construct */
1504executable-construct:
1505        action-stmt
1506      | do-construct
1507      | case-construct
1508      | if-construct
1509      | where-construct
1510      ;
1511
1512/* R214 : action-stmt */
1513action-stmt :
1514        TOK_CONTINUE
1515      | ident_dims after_ident_dims
1516      | goto
1517      | call
1518      | iofctl ioctl
1519      | read option_read
1520      | TOK_WRITE ioctl
1521      | TOK_WRITE ioctl outlist
1522      | TOK_REWIND after_rewind
1523      | TOK_ALLOCATE '(' allocation_list opt_stat_spec ')'          { inallocate = 0; }
1524      | TOK_DEALLOCATE '(' allocate_object_list opt_stat_spec ')'   { inallocate = 0; }
1525      | TOK_EXIT optexpr
1526      | TOK_RETURN opt_expr
1527      | TOK_CYCLE opt_expr
1528      | stop opt_expr
1529      | int_list
1530      | TOK_NULLIFY '(' pointer_name_list ')'
1531      | word_endunit
1532        {
1533            GlobalDeclaration = 0 ;
1534            if ( firstpass == 0 && strcasecmp(subroutinename,"") )
1535            {
1536                if ( module_declar && insubroutinedeclare == 0 )    fclose(module_declar);
1537            }
1538            if ( strcasecmp(subroutinename,"") )
1539            {
1540                if ( inmodulemeet == 1 )
1541                {
1542                    /* we are in a module                                */
1543                    if ( insubroutinedeclare == 1 )
1544                    {
1545                        /* it is like an end subroutine <name>            */
1546                        insubroutinedeclare = 0 ;
1547                        pos_cur = setposcur();
1548                        closeandcallsubloopandincludeit_0(1);
1549                        functiondeclarationisdone = 0;
1550                    }
1551                    else
1552                    {
1553                        /* it is like an end module <name>                */
1554                        inmoduledeclare = 0 ;
1555                        inmodulemeet = 0 ;
1556                    }
1557                }
1558                else
1559                {
1560                    insubroutinedeclare = 0;
1561                    pos_cur = setposcur();
1562                    closeandcallsubloopandincludeit_0(2);
1563                    functiondeclarationisdone = 0;
1564                }
1565            }
1566            strcpy(subroutinename,"");
1567        }
1568      | word_endprogram opt_name
1569        {
1570            insubroutinedeclare = 0;
1571            inprogramdeclare = 0;
1572            pos_cur = setposcur();
1573            closeandcallsubloopandincludeit_0(3);
1574            functiondeclarationisdone = 0;
1575            strcpy(subroutinename,"");
1576        }
1577      | word_endsubroutine opt_name
1578        {
1579            if ( strcasecmp(subroutinename,"") )
1580            {
1581                insubroutinedeclare = 0;
1582                pos_cur = setposcur();
1583                closeandcallsubloopandincludeit_0(1);
1584                functiondeclarationisdone = 0;
1585                strcpy(subroutinename,"");
1586            }
1587        }
1588      | word_endfunction opt_name
1589        {
1590            insubroutinedeclare = 0;
1591            pos_cur = setposcur();
1592            closeandcallsubloopandincludeit_0(0);
1593            functiondeclarationisdone = 0;
1594            strcpy(subroutinename,"");
1595        }
1596      | TOK_ENDMODULE opt_name
1597        {
1598            /* if we never meet the contains keyword               */
1599            if ( firstpass == 0 )
1600            {
1601                RemoveWordCUR_0(fortran_out, strlen($2)+11);    // Remove word "end module"
1602                if ( inmoduledeclare && ! aftercontainsdeclare )
1603                {
1604                    Write_Closing_Module(1);
1605                }
1606                fprintf(fortran_out,"\n      end module %s\n", curmodulename);
1607                if ( module_declar && insubroutinedeclare == 0 )
1608                {
1609                    fclose(module_declar);
1610                }
1611            }
1612            inmoduledeclare = 0 ;
1613            inmodulemeet = 0 ;
1614            aftercontainsdeclare = 1;
1615            strcpy(curmodulename, "");
1616            GlobalDeclaration = 0 ;
1617        }
1618      | if-stmt
1619      | where-stmt
1620      | TOK_CONTAINS
1621        {
1622            if ( inside_type_declare ) break;
1623            if ( inmoduledeclare )
1624            {
1625                if ( firstpass == 0 )
1626                {
1627                    RemoveWordCUR_0(fortran_out,9);   // Remove word 'contains'
1628                    Write_Closing_Module(0);
1629                }
1630                inmoduledeclare = 0 ;
1631                aftercontainsdeclare = 1;
1632            }
1633            else if ( insubroutinedeclare )
1634            {
1635                incontainssubroutine = 1;
1636                insubroutinedeclare  = 0;
1637                incontainssubroutine = 0;
1638                functiondeclarationisdone = 0;
1639
1640                if ( firstpass )
1641                    List_ContainsSubroutine = Addtolistnom(subroutinename, List_ContainsSubroutine, 0);
1642                else
1643                    closeandcallsubloop_contains_0();
1644
1645                strcpy(subroutinename, "");
1646            }
1647            else printf("l.%4d -- TOK_CONTAINS -- MHCHECK\n",line_num_input);
1648        }
1649      ;
1650
1651/* R601 : variable */
1652//variable : expr
1653//       ;
1654
1655/* R734 : assignment-stmt */
1656// assignment-stmt: variable '=' expr
1657//       ;
1658assignment-stmt: expr
1659      ;
1660
1661/* R741 : where-stmt */
1662where-stmt: TOK_WHERE '(' mask-expr ')' where-assignment-stmt
1663      ;
1664
1665/* R742 : where-construct */
1666where-construct: where-construct-stmt line-break opt-where-body-construct opt-masked-elsewhere-construct opt-elsewhere-construct end-where-stmt
1667      ;
1668
1669opt-where-body-construct:
1670      | opt-where-body-construct where-body-construct line-break
1671      ;
1672
1673opt-masked-elsewhere-construct :
1674      | opt-masked-elsewhere-construct masked-elsewhere-stmt line-break opt-where-body-construct
1675      ;
1676
1677opt-elsewhere-construct:
1678      | opt-elsewhere-construct elsewhere-stmt line-break opt-where-body-construct
1679      ;
1680
1681/* R743 : where-construct-stmt */
1682where-construct-stmt:
1683        TOK_WHERE '(' mask-expr ')'
1684      ;
1685
1686/* R744 : where-body-construct */
1687where-body-construct: where-assignment-stmt
1688      | where-stmt
1689      | where-construct
1690      ;
1691
1692/* R745 : where-assignment-stmt */
1693where-assignment-stmt: assignment-stmt
1694      ;
1695
1696/* R746 : mask-expr */
1697mask-expr: expr
1698      ;
1699
1700/* R747 : masked-elsewhere-stmt */
1701masked-elsewhere-stmt:
1702        TOK_ELSEWHEREPAR mask-expr ')'
1703      | TOK_ELSEWHEREPAR mask-expr ')' TOK_NAME
1704      ;
1705
1706/* R748: elsewhere-stmt */
1707elsewhere-stmt:
1708        TOK_ELSEWHERE
1709      | TOK_ELSEWHERE TOK_NAME
1710      ;
1711
1712/* R749: end-where-stmt */
1713end-where-stmt:
1714        TOK_ENDWHERE
1715      | TOK_ENDWHERE TOK_NAME
1716      ;
1717
1718/* R752 : forall-header */
1719forall-header :
1720     ;
1721
1722/* R801 : block */
1723block:
1724      |block execution-part-construct
1725      |block execution-part-construct line-break
1726      ;
1727
1728/* R813 : do-construct */
1729do-construct:
1730        block-do-construct
1731      ;
1732
1733/* R814 : block-do-construct */
1734block-do-construct:
1735        do-stmt line-break do-block end-do
1736      ;
1737
1738/* R815 : do-stmt */
1739do-stmt:
1740        label-do-stmt
1741      | nonlabel-do-stmt
1742      ;
1743
1744/* R816 : label-do-stmt */
1745label-do-stmt:
1746        TOK_NAME ':' TOK_PLAINDO label
1747      |              TOK_PLAINDO label
1748      | TOK_NAME ':' TOK_PLAINDO label loop-control
1749      |              TOK_PLAINDO label loop-control
1750      ;
1751
1752/* R817 : nonlabel-do-stmt */
1753nonlabel-do-stmt:
1754        TOK_NAME ':' TOK_PLAINDO
1755      |              TOK_PLAINDO
1756      | TOK_NAME ':' TOK_PLAINDO loop-control
1757      |              TOK_PLAINDO loop-control
1758      ;
1759
1760/* R818 : loop-control */
1761loop-control:
1762        opt_comma do-variable '=' expr ',' expr
1763      | opt_comma do-variable '=' expr ',' expr ',' expr
1764      | opt_comma TOK_WHILE '(' expr ')'
1765      | opt_comma TOK_CONCURRENT forall-header
1766      ;
1767
1768/* R819 : do-variable */
1769do-variable : ident
1770     ;
1771
1772/* R820 : do-block */
1773do-block: block
1774     ;
1775
1776/* R821 : end-do */
1777end-do: end-do-stmt
1778     | continue-stmt
1779     ;
1780
1781/* R822 : end-do-stmt */
1782end-do-stmt:
1783        TOK_ENDDO
1784      | TOK_ENDDO TOK_NAME
1785      ;
1786
1787/* R832 : if-construct */
1788if-construct: if-then-stmt line-break block opt-else-if-stmt-block opt-else-stmt-block end-if-stmt
1789      ;
1790
1791opt-else-if-stmt-block:
1792      | else-if-stmt-block
1793      | opt-else-if-stmt-block else-if-stmt-block
1794      ;
1795
1796else-if-stmt-block:
1797        else-if-stmt line-break block
1798      ;
1799
1800opt-else-stmt-block:
1801      | else-stmt-block
1802      | opt-else-stmt-block else-if-stmt-block
1803      ;
1804
1805else-stmt-block: else-stmt line-break block
1806        ;
1807
1808/* R833 : if-then-stmt */
1809if-then-stmt:
1810         TOK_NAME ':' TOK_LOGICALIF '(' expr ')' TOK_THEN
1811      |               TOK_LOGICALIF '(' expr ')' TOK_THEN
1812      ;
1813
1814/* R834 : else-if-stmt */
1815else-if-stmt:
1816        TOK_ELSEIF '(' expr ')' TOK_THEN
1817      | TOK_ELSEIF '(' expr ')' TOK_THEN TOK_NAME
1818      ;
1819
1820/* R835 : else-stmt */
1821else-stmt:
1822        TOK_ELSE
1823      | TOK_ELSE TOK_NAME
1824      ;
1825
1826/* R836 : end-if-stmt */
1827end-if-stmt:
1828        TOK_ENDIF
1829      | TOK_ENDIF TOK_NAME
1830      ;
1831
1832/* R837 : if-stmt */
1833if-stmt: TOK_LOGICALIF '(' expr ')' action-stmt
1834        ;
1835
1836/* R838 : case-construct */
1837case-construct: select-case-stmt line-break opt_case-stmt-block end-select-stmt
1838        ;
1839
1840opt_case-stmt-block:
1841        | case-stmt-block
1842        | opt_case-stmt-block case-stmt-block
1843        ;
1844
1845case-stmt-block: case-stmt line-break block
1846        ;
1847
1848/* R839 : select-case-stmt */
1849select-case-stmt :
1850          TOK_NAME ':' TOK_SELECTCASE '(' expr ')'
1851        |              TOK_SELECTCASE '(' expr ')'
1852        ;
1853
1854/* R840 : case-stmt */
1855case-stmt:
1856          TOK_CASE case-selector
1857        | TOK_CASE case-selector TOK_NAME
1858        ;
1859
1860/* R840 : end-select-stmt */
1861end-select-stmt:
1862          TOK_ENDSELECT
1863        | TOK_ENDSELECT TOK_NAME
1864        ;
1865
1866/* R843 : case-selector */
1867case-selector:
1868          '(' case-value-range-list ')'
1869        | TOK_DEFAULT
1870        ;
1871
1872case-value-range-list:
1873        case-value-range
1874      | case-value-range-list ',' case-value-range
1875      ;
1876
1877/* R844: case-value-range */
1878case-value-range :
1879        case-value
1880      | case-value ':'
1881      | ':' case-value
1882      | case-value ':' case-value
1883      ;
1884
1885/* R845 : case-value */
1886case-value: expr
1887        ;
1888
1889/* R854 : continue-stmt */
1890continue-stmt: TOK_CONTINUE
1891        ;
1892
1893/* R1001 : format-stmt */
1894format-stmt: TOK_FORMAT
1895        ;
1896
1897word_endsubroutine :
1898        TOK_ENDSUBROUTINE
1899        {
1900            strcpy($$,$1);
1901            pos_endsubroutine = setposcur()-strlen($1);
1902            functiondeclarationisdone = 0;
1903        }
1904      ;
1905word_endunit :
1906        TOK_ENDUNIT
1907        {
1908            strcpy($$,$1);
1909            pos_endsubroutine = setposcur()-strlen($1);
1910        }
1911      ;
1912word_endprogram :
1913        TOK_ENDPROGRAM
1914        {
1915            strcpy($$,$1);
1916            pos_endsubroutine = setposcur()-strlen($1);
1917        }
1918      ;
1919word_endfunction :
1920        TOK_ENDFUNCTION
1921        {
1922            strcpy($$,$1);
1923            pos_endsubroutine = setposcur()-strlen($1);
1924        }
1925      ;
1926
1927opt_name : '\n'  {strcpy($$,"");}
1928      | TOK_NAME {strcpy($$,$1);}
1929      ;
1930
1931before_dims : { created_dimensionlist = 0; }
1932      ;
1933ident_dims :
1934        ident before_dims dims dims
1935        {
1936            created_dimensionlist = 1;
1937            if ( ($3 == NULL) || ($4 == NULL) ) break;
1938            if  ( agrif_parentcall == 1 )
1939            {
1940                ModifyTheAgrifFunction_0($3->dim.last);
1941                agrif_parentcall = 0;
1942                fprintf(fortran_out," = ");
1943            }
1944        }
1945      | ident_dims '%' declare_after_percent ident before_dims dims dims
1946        {
1947            created_dimensionlist = 1;
1948        }
1949      ;
1950int_list :
1951        TOK_CSTINT
1952      | int_list ',' TOK_CSTINT
1953      ;
1954after_ident_dims :
1955        '=' expr
1956      | TOK_POINT_TO expr
1957      ;
1958call :  keywordcall opt_call
1959        {
1960            inagrifcallargument = 0 ;
1961            incalldeclare=0;
1962            if ( oldfortran_out && (callagrifinitgrids == 1) && (firstpass == 0) )
1963            {
1964                pos_end = setposcur();
1965                RemoveWordSET_0(fortran_out,pos_curcall,pos_end-pos_curcall);
1966                strcpy(subofagrifinitgrids,subroutinename);
1967            }
1968            Instanciation_0(sameagrifname);
1969        }
1970      ;
1971opt_call :
1972      | '(' opt_callarglist  ')'
1973      ;
1974opt_callarglist :
1975      | callarglist
1976      ;
1977keywordcall :
1978        before_call TOK_FLUSH
1979      | before_call TOK_NAME
1980        {
1981            if (!strcasecmp($2,"MPI_Init") )    callmpiinit = 1;
1982            else                                callmpiinit = 0;
1983
1984            if (!strcasecmp($2,"Agrif_Init_Grids") )
1985            {
1986                callagrifinitgrids = 1;
1987                strcpy(meetagrifinitgrids,subroutinename);
1988            }
1989            else
1990            {
1991                callagrifinitgrids = 0;
1992            }
1993            if ( Vartonumber($2) == 1 )
1994            {
1995                incalldeclare = 1;
1996                inagrifcallargument = 1 ;
1997                Add_SubroutineWhereAgrifUsed_1(subroutinename, curmodulename);
1998            }
1999        }
2000      ;
2001before_call : TOK_CALL  { pos_curcall=setposcur()-4; }
2002      ;
2003callarglist :
2004        callarg
2005      | callarglist ',' callarg
2006      ;
2007callarg :
2008        expr
2009        {
2010            if ( callmpiinit == 1 )
2011            {
2012                strcpy(mpiinitvar,$1);
2013                if ( firstpass == 1 )  Add_UsedInSubroutine_Var_1 (mpiinitvar);
2014            }
2015        }
2016      | '*' TOK_CSTINT
2017      ;
2018
2019stop :  TOK_PAUSE
2020      | TOK_STOP
2021      ;
2022
2023option_inlist :
2024      | inlist
2025      ;
2026option_read :
2027        ioctl option_inlist
2028      | infmt opt_inlist
2029      ;
2030opt_inlist :
2031      | ',' inlist
2032      ;
2033ioctl : '(' ctllist ')'
2034      ;
2035after_rewind :
2036        '(' ident ')'
2037      | '(' TOK_CSTINT ')'
2038      | TOK_CSTINT
2039      | '(' uexpr ')'
2040      | TOK_NAME
2041      ;
2042ctllist :
2043        ioclause
2044      | ctllist ',' ioclause
2045      ;
2046ioclause :
2047        fexpr
2048      | '*'
2049      | TOK_DASTER
2050      | ident expr dims
2051      | ident expr '%' declare_after_percent ident_dims
2052      | ident '(' triplet ')'
2053      | ident '*'
2054      | ident TOK_DASTER
2055      ;
2056
2057declare_after_percent:      { afterpercent = 1; }
2058      ;
2059iofctl :
2060        TOK_OPEN
2061      | TOK_CLOSE
2062      | TOK_FLUSH
2063      ;
2064infmt :  unpar_fexpr
2065      | '*'
2066      ;
2067
2068read :  TOK_READ
2069      | TOK_INQUIRE
2070      | TOK_PRINT
2071      ;
2072
2073fexpr : unpar_fexpr
2074      | '(' fexpr ')'
2075      ;
2076unpar_fexpr :
2077        lhs
2078      | simple_const
2079      | fexpr addop fexpr %prec '+'
2080      | fexpr '*' fexpr
2081      | fexpr TOK_SLASH fexpr
2082      | fexpr TOK_DASTER fexpr
2083      | addop fexpr %prec '*'
2084      | fexpr TOK_DSLASH fexpr
2085      | TOK_FILE expr
2086      | TOK_UNIT expr
2087      | TOK_NML expr
2088      | TOK_FMT expr
2089      | TOK_EXIST expr
2090      | TOK_ERR expr
2091      | TOK_END expr
2092      | TOK_NAME '=' expr
2093      | predefinedfunction
2094      ;
2095addop : '+'
2096      | '-'
2097      ;
2098inlist : inelt
2099      | inlist ',' inelt
2100      ;
2101// opt_lhs :
2102//       | lhs
2103//       ;
2104inelt : //opt_lhs opt_operation
2105        lhs opt_operation
2106      | '(' inlist ')' opt_operation
2107      | predefinedfunction opt_operation
2108      | simple_const opt_operation
2109      | '(' inlist ',' dospec ')'
2110      ;
2111opt_operation :
2112      | operation
2113      | opt_operation operation
2114      ;
2115outlist :
2116        complex_const       { strcpy($$,$1); }
2117      | predefinedfunction  { strcpy($$,$1); }
2118      | uexpr               { strcpy($$,$1); }
2119      | other               { strcpy($$,$1); }
2120      | uexpr   ',' expr    { sprintf($$,"%s,%s",$1,$3); }
2121      | uexpr   ',' other   { sprintf($$,"%s,%s",$1,$3); }
2122      | other   ',' expr    { sprintf($$,"%s,%s",$1,$3); }
2123      | other   ',' other   { sprintf($$,"%s,%s",$1,$3); }
2124      | outlist ',' expr    { sprintf($$,"%s,%s",$1,$3); }
2125      | outlist ',' other   { sprintf($$,"%s,%s",$1,$3); }
2126      ;
2127other :
2128        '(' uexpr   ',' dospec ')'    { sprintf($$,"(%s,%s)",$2,$4); }
2129      | '(' outlist ',' dospec ')'    { sprintf($$,"(%s,%s)",$2,$4); }
2130      | '(' other   ',' dospec ')'    { sprintf($$,"(%s,%s)",$2,$4); }
2131dospec :
2132        TOK_NAME '=' expr ',' expr           { sprintf($$,"%s=%s,%s)",$1,$3,$5);}
2133      | TOK_NAME '=' expr ',' expr ',' expr  { sprintf($$,"%s=%s,%s,%s)",$1,$3,$5,$7);}
2134      ;
2135goto :  TOK_PLAINGOTO '(' expr ',' expr ')' ',' expr
2136      | TOK_PLAINGOTO TOK_CSTINT
2137      ;
2138allocation_list :
2139        allocate_object
2140      | allocation_list ',' allocate_object
2141      ;
2142allocate_object :
2143        lhs     { Add_Allocate_Var_1($1,curmodulename); }
2144      ;
2145allocate_object_list :
2146        allocate_object
2147      | allocate_object_list ',' allocate_object
2148      ;
2149opt_stat_spec :
2150      | ',' TOK_STAT '=' lhs
2151      ;
2152pointer_name_list :
2153        ident
2154      | pointer_name_list ',' ident
2155      ;
2156
2157%%
2158
2159void process_fortran(const char *input_file)
2160{
2161    extern FILE *fortran_in;
2162    extern FILE *fortran_out;
2163
2164    char output_file[LONG_FNAME];
2165    char input_fullpath[LONG_FNAME];
2166
2167    if ( todebug == 1 ) printf("Firstpass == %d \n", firstpass);
2168
2169     yydebug=0;
2170/******************************************************************************/
2171/*  1-  Open input file                                                       */
2172/******************************************************************************/
2173
2174    strcpy(cur_filename, input_file);
2175    sprintf(input_fullpath, "%s/%s", input_dir, input_file);
2176
2177    fortran_in = fopen(input_fullpath, "r");
2178    if (! fortran_in)
2179    {
2180        printf("Error : File %s does not exist\n", input_fullpath);
2181        exit(1);
2182    }
2183
2184/******************************************************************************/
2185/*  2-  Variables initialization                                              */
2186/******************************************************************************/
2187
2188    line_num_input = 1;
2189    PublicDeclare = 0;
2190    PrivateDeclare = 0;
2191    ExternalDeclare = 0;
2192    SaveDeclare = 0;
2193    pointerdeclare = 0;
2194    optionaldeclare = 0;
2195    incalldeclare = 0;
2196    inside_type_declare = 0;
2197    Allocatabledeclare = 0 ;
2198    Targetdeclare = 0 ;
2199    VariableIsParameter =  0 ;
2200    strcpy(NamePrecision,"");
2201    c_star = 0 ;
2202    functiondeclarationisdone = 0;
2203    insubroutinedeclare = 0 ;
2204    strcpy(subroutinename," ");
2205    isrecursive = 0;
2206    InitialValueGiven = 0 ;
2207    GlobalDeclarationType = 0;
2208    inmoduledeclare = 0;
2209    incontainssubroutine = 0;
2210    afterpercent = 0;
2211    aftercontainsdeclare = 1;
2212    strcpy(nameinttypename,"");
2213
2214/******************************************************************************/
2215/*  3-  Parsing of the input file (1 time)                                    */
2216/******************************************************************************/
2217
2218    sprintf(output_file, "%s/%s", output_dir, input_file);
2219
2220    if (firstpass == 0) fortran_out = fopen(output_file,"w");
2221
2222    fortran_parse();
2223
2224    if (firstpass == 0) NewModule_Creation_0();
2225    if (firstpass == 0) fclose(fortran_out);
2226}
Note: See TracBrowser for help on using the repository browser.