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

Last change on this file since 13027 was 13027, checked in by rblod, 9 months ago

New AGRIF library, see ticket #2129

  • Property svn:mime-type set to text/x-csrc
File size: 133.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;
44
45char c_selectorname[LONG_M];
46char ligne[LONG_M];
47char truename[LONG_VNAME];
48char identcopy[LONG_VNAME];
49int c_selectorgiven=0;
50listvar *curlistvar;
51int in_select_case_stmt=0;
52typedim c_selectordim;
53listcouple *coupletmp;
54int removeline=0;
55int token_since_endofstmt = 0;
56int increment_nbtokens = 1;
57int in_complex_literal = 0;
58int close_or_connect = 0;
59int in_io_control_spec = 0;
60int intent_spec = 0;
61long int my_position;
62long int my_position_before;
63int suborfun = 0;
64int indeclaration = 0;
65int endoffile = 0;
66int in_inquire = 0;
67int in_char_selector = 0;
68int in_kind_selector =0;
69int char_length_toreset = 0;
70
71typedim my_dim;
72
73listvar *test;
74
75char linebuf1[1024];
76char linebuf2[1024];
77
78int fortran_error(const char *s)
79{
80  if (endoffile == 1) 
81  {
82  endoffile = 0;
83  return 0;
84  }
85    printf("%s line %d, file %s culprit = |%s|\n", s, line_num_input, cur_filename, strcat(linebuf1, linebuf2));
86    exit(1);
87}
88
89%}
90
91%union {
92    char        na[LONG_M];
93    listdim     *d;
94    listvar     *l;
95    listcouple  *lc;
96    listname    *lnn;
97    typedim     dim1;
98    variable    *v;
99}
100
101%left ','
102%nonassoc ':'
103%right '='
104%left TOK_EQV TOK_NEQV
105%left TOK_OR TOK_XOR
106%left TOK_AND
107%left TOK_NOT
108%nonassoc TOK_LT TOK_GT TOK_LE TOK_GE TOK_EQ TOK_NE
109%left TOK_DSLASH
110%left '+' '-'
111%left '*' TOK_SLASH
112%right TOK_DASTER
113
114%token TOK_SEMICOLON
115%token TOK_PARAMETER
116%token TOK_RESULT
117%token TOK_ONLY
118%token TOK_INCLUDE
119%token TOK_SUBROUTINE
120%token TOK_PROGRAM
121%token TOK_FUNCTION
122%token TOK_LABEL_FORMAT
123%token TOK_LABEL_CONTINUE
124%token TOK_LABEL_END_DO
125%token TOK_MAX
126%token TOK_TANH
127%token TOK_COMMENT
128%token TOK_WHERE
129%token TOK_ELSEWHEREPAR
130%token TOK_ELSEWHERE
131%token TOK_ENDWHERE
132%token TOK_MAXVAL
133%token TOK_TRIM
134%token TOK_NULL_PTR
135%token TOK_SUM
136%token TOK_SQRT
137%token TOK_CASE
138%token TOK_SELECTCASE
139%token TOK_FILE
140%token TOK_REC
141%token TOK_NAME_EQ
142%token TOK_IOLENGTH
143%token TOK_ACCESS
144%token TOK_ACTION
145%token TOK_FORM
146%token TOK_RECL
147%token TOK_STATUS
148%token TOK_UNIT
149%token TOK_OPENED
150%token TOK_FMT
151%token TOK_NML
152%token TOK_END
153%token TOK_EOR
154%token TOK_EOF
155%token TOK_ERR
156%token TOK_POSITION
157%token TOK_IOSTAT
158%token TOK_IOMSG
159%token TOK_EXIST
160%token TOK_MIN
161%token TOK_FLOAT
162%token TOK_EXP
163%token TOK_LEN
164%token TOK_COS
165%token TOK_COSH
166%token TOK_ACOS
167%token TOK_NINT
168%token TOK_CYCLE
169%token TOK_SIN
170%token TOK_SINH
171%token TOK_ASIN
172%token TOK_EQUIVALENCE
173%token TOK_BACKSPACE
174%token TOK_LOG
175%token TOK_TAN
176%token TOK_ATAN
177%token TOK_RECURSIVE
178%token TOK_ABS
179%token TOK_MOD
180%token TOK_SIGN
181%token TOK_MINLOC
182%token TOK_MAXLOC
183%token TOK_EXIT
184%token TOK_KIND
185%token TOK_MOLD
186%token TOK_SOURCE
187%token TOK_ERRMSG
188%token TOK_MINVAL
189%token TOK_PUBLIC
190%token TOK_PRIVATE
191%token TOK_ALLOCATABLE
192%token TOK_RETURN
193%token TOK_THEN
194%token TOK_ELSEIF
195%token TOK_ELSE
196%token TOK_ENDIF
197%token TOK_PRINT
198%token TOK_PLAINGOTO
199%token <na> TOK_LOGICALIF
200%token <na> TOK_LOGICALIF_PAR
201%token TOK_PLAINDO
202%token TOK_CONTAINS
203%token TOK_ENDDO
204%token TOK_MODULE
205%token TOK_ENDMODULE
206%token TOK_WHILE
207%token TOK_CONCURRENT
208%token TOK_ALLOCATE
209%token TOK_OPEN
210%token TOK_CLOSE
211%token TOK_INQUIRE
212%token TOK_WRITE_PAR
213%token TOK_WRITE
214%token <na> TOK_FLUSH
215%token TOK_READ_PAR
216%token TOK_READ
217%token TOK_REWIND
218%token TOK_DEALLOCATE
219%token TOK_NULLIFY
220%token TOK_DIMENSION
221%token TOK_ENDSELECT
222%token TOK_EXTERNAL
223%token TOK_INTENT
224%token TOK_INTRINSIC
225%token TOK_NAMELIST
226%token TOK_DEFAULT
227%token TOK_OPTIONAL
228%token TOK_POINTER
229%token TOK_CONTINUE
230%token TOK_SAVE
231%token TOK_TARGET
232%token TOK_IMPLICIT
233%token TOK_NONE
234%token TOK_CALL
235%token TOK_STAT
236%token TOK_POINT_TO
237%token TOK_COMMON
238%token TOK_GLOBAL
239%token TOK_LEFTAB
240%token TOK_RIGHTAB
241%token TOK_PAUSE
242%token TOK_PROCEDURE
243%token TOK_STOP
244%token TOK_FOURDOTS
245%token <na> TOK_HEXA
246%token <na> TOK_ASSIGNTYPE
247%token <na> TOK_OUT
248%token <na> TOK_INOUT
249%token <na> TOK_IN
250%token <na> TOK_USE
251%token <na> TOK_DSLASH
252%token <na> TOK_DASTER
253%token <na> TOK_EQ
254%token <na> TOK_EQV
255%token <na> TOK_GT
256%token <na> TOK_LT
257%token <na> TOK_GE
258%token <na> TOK_NE
259%token <na> TOK_NEQV
260%token <na> TOK_LE
261%token <na> TOK_OR
262%token <na> TOK_XOR
263%token <na> TOK_NOT
264%token <na> TOK_AND
265%token <na> TOK_EQUALEQUAL
266%token <na> TOK_SLASHEQUAL
267%token <na> TOK_INFEQUAL
268%token <na> TOK_SUPEQUAL
269%token <na> TOK_TRUE
270%token <na> TOK_FALSE
271%token <na> TOK_LABEL
272%token <na> TOK_LABEL_DJVIEW
273%token <na> TOK_PLAINDO_LABEL_DJVIEW
274%token <na> TOK_PLAINDO_LABEL
275%token <na> TOK_TYPE
276%token <na> TOK_TYPEPAR
277%token <na> TOK_ENDTYPE
278%token TOK_COMMACOMPLEX
279%token <na> TOK_REAL
280%token <na> TOK_INTEGER
281%token <na> TOK_LOGICAL
282%token <na> TOK_DOUBLEPRECISION
283%token <na> TOK_ENDSUBROUTINE
284%token <na> TOK_ENDFUNCTION
285%token <na> TOK_ENDPROGRAM
286%token <na> TOK_ENDUNIT
287%token <na> TOK_CHARACTER
288%token <na> TOK_CHAR_CONSTANT
289%token <na> TOK_CHAR_CUT
290%token <na> TOK_DATA
291%token <na> TOK_CHAR_MESSAGE
292%token <na> TOK_CSTREAL
293%token <na> TOK_COMPLEX
294%token <na> TOK_DOUBLECOMPLEX
295%token <na> TOK_NAME
296%token <na> TOK_SLASH
297%token <na> TOK_CSTINT
298%token ','
299%token ':'
300%token '('
301%token ')'
302%token '<'
303%token '>'
304%type <l> dcl
305%type <l> dimension
306%type <l> array-name-spec-list
307%type <l> paramlist
308%type <l> args
309%type <na> declaration-type-spec
310%type <l> arglist
311%type <lc> only_list
312%type <lc> only-list
313%type <lc> opt-only-list
314%type <lc> only
315%type <lc> only_name
316%type <lc> rename-list
317%type <lc> opt-rename-list
318%type <lc> rename
319%type <d> dims
320%type <d> dimlist
321%type <dim1> dim
322%type <v> paramitem
323%type <na> comblock
324%type <na> name_routine
325%type <na> type-param-value
326%type <na> opt_name
327%type <na> constant-expr
328%type <na> ac-implied-do
329%type <na> subroutine-name
330%type <l> opt-dummy-arg-list-par
331%type <l> opt-dummy-arg-list
332%type <l> dummy-arg-list
333%type <l> named-constant-def-list
334%type <v> named-constant-def
335%type <na> ac-do-variable
336%type <na> data-i-do-variable
337%type <na> data-stmt-constant
338%type <na> do-variable
339%type <na> ac-implied-do-control
340%type <na> label
341%type <na> opt-label
342%type <na> label-djview
343%type <na> opt-label-djview
344%type <na> type
345%type <na> real-literal-constant
346%type <l> type-declaration-stmt
347%type <d> array-spec
348%type <d> assumed-shape-spec-list
349%type <d> deferred-shape-spec-list
350%type <d> assumed-size-spec
351%type <d> implied-shape-spec-list
352%type <na> typespec
353%type <na> null-init
354%type <na> initial-data-target
355%type <na> intent-spec
356%type <na> string_constant
357%type <na> access-id
358%type <na> dummy-arg-name
359%type <na> common-block-name
360%type <na> function-name
361%type <na> dummy-arg
362%type <na> lower-bound
363%type <na> upper-bound
364%type <na> scalar-constant-subobject
365%type <na> opt-data-stmt-star
366%type <na> simple_const
367%type <na> opt-char-selector
368%type <na> char-selector
369%type <na> ident
370%type <na> intent_spec
371%type <na> kind-param
372%type <na> signe
373%type <na> scalar-int-constant-expr
374%type <na> opt_signe
375%type <dim1> explicit-shape-spec
376%type <d> explicit-shape-spec-list
377%type <dim1> assumed-shape-spec
378%type <dim1> deferred-shape-spec
379%type <na> filename
380%type <na> attribute
381%type <na> complex_const
382%type <na> begin_array
383%type <na> clause
384%type <na> only-use-name
385%type <na> generic-spec
386%type <na> arg
387%type <d> opt-array-spec-par
388%type <d> opt-explicit-shape-spec-list-comma
389%type <d> explicit-shape-spec-list-comma
390%type <na> uexpr
391%type <na> section_subscript_ambiguous
392%type <na> minmaxlist
393%type <na> subscript
394%type <na> subscript-triplet
395%type <na> vector-subscript
396%type <na> lhs
397%type <na> outlist
398%type <na> other
399%type <na> int-constant-expr
400%type <na> dospec
401%type <na> expr_data
402%type <na> structure_component
403%type <na> array_ele_substring_func_ref
404%type <na> funarglist
405%type <na> funarg
406%type <na> funargs
407%type <na> triplet
408%type <na> substring
409%type <na> opt_substring
410%type <na> opt_expr
411%type <na> optexpr
412%type <v> entity-decl
413%type <l> entity-decl-list
414%type <lnn> data_stmt_value_list
415%type <lnn> data-stmt-value-list
416%type <lnn> access-id-list
417%type <lnn> opt-access-id-list
418%type <na> data-stmt-value
419%type <l> data-stmt-object-list
420%type <l> data-i-do-object-list
421%type <v> data-stmt-object
422%type <v> data-i-do-object
423%type <lnn> datanamelist
424%type <na> after_slash
425%type <na> after_equal
426%type <na> predefinedfunction
427%type <na> equiv-op
428%type <na> or-op
429%type <na> and-op
430%type <na> not-op
431%type <na> equiv-operand
432%type <na> or-operand
433%type <na> and-operand
434%type <na> mult-operand
435%type <na> rel-op
436%type <na> concat-op
437%type <na> add-operand
438%type <na> add-op
439%type <na> power-op
440%type <na> section-subscript-list
441%type <na> opt-lower-bound-2points
442%type <na> mult-op
443%type <na> array-constructor
444%type <na> expr
445%type <na> function-reference
446%type <na> literal-constant
447%type <na> named-constant
448%type <na> ac-value-list
449%type <na> ac-value
450%type <na> intrinsic-type-spec
451%type <na> opt-kind-selector
452%type <na> char-literal-constant
453%type <na> logical-literal-constant
454%type <na> real-part
455%type <na> imag-part
456%type <na> sign
457%type <na> signed-int-literal-constant
458%type <na> int-literal-constant
459%type <na> signed-real-literal-constant
460%type <na> complex-literal-constant
461%type <na> actual-arg-spec-list
462%type <na> procedure-designator
463%type <na> constant
464%type <na> data-ref
465%type <v> structure-component
466%type <v> scalar-structure-component
467%type <na> int-expr
468%type <na> ac-spec
469%type <na> type-spec
470%type <na> derived-type-spec
471%type <v> part-ref
472%type <na> opt-part-ref
473%type <na> actual-arg-spec
474%type <na> kind-selector
475%type <na> actual-arg
476%type <na> section-subscript
477%type <na> keyword
478%type <na> primary
479%type <na> specification-expr
480%type <v> variable
481%type <v> data-implied-do
482%type <na> substring-range
483%type <v> designator
484%type <na> object-name
485%type <na> object-name-noident
486%type <na> array-element
487%type <na> array-section
488%type <na> scalar-variable-name
489%type <na> scalar-constant
490%type <na> variable-name
491%type <na> opt-subscript
492%type <na> stride
493%type <na> opt-scalar-int-expr
494%type <na> scalar-int-expr
495%type <na> level-1-expr
496%type <na> level-2-expr
497%type <na> level-3-expr
498%type <na> level-4-expr
499%type <na> level-5-expr
500%type <na> ubound
501%type <na> operation
502%type <na> proper_lengspec
503%type <lnn> use_name_list
504%type <lnn> public
505
506%%
507/* R201 : program */
508/*program: line-break
509     | program-unit
510     | program program-unit
511     ;
512*/
513
514input:
515      | input line
516      ;
517line:  line-break
518      | suite_line_list
519      | error {yyerrok;yyclearin;}
520      ;
521line-break: '\n' fin_line
522      {token_since_endofstmt = 0; increment_nbtokens = 0;}
523      | TOK_SEMICOLON
524      | TOK_EOF
525      | line-break '\n' fin_line
526      | line-break TOK_SEMICOLON
527      ;
528suite_line_list :
529        suite_line
530      | suite_line_list TOK_SEMICOLON '\n'
531      | suite_line_list TOK_SEMICOLON suite_line
532      ;
533suite_line:program-unit
534      | TOK_INCLUDE filename fin_line
535        {
536            if (inmoduledeclare == 0 )
537            {
538                pos_end = setposcur();
539                RemoveWordSET_0(fortran_out,pos_curinclude,pos_end-pos_curinclude);
540            }
541        }
542      | TOK_COMMENT
543      ;
544/*
545suite_line:
546        entry fin_line     subroutine, function, module                   
547      | spec fin_line       declaration                                     
548      | TOK_INCLUDE filename fin_line
549        {
550            if (inmoduledeclare == 0 )
551            {
552                pos_end = setposcur();
553                RemoveWordSET_0(fortran_out,pos_curinclude,pos_end-pos_curinclude);
554            }
555        }
556      | execution-part-construct
557      ;
558*/
559
560fin_line: { pos_cur = setposcur(); }
561      ;
562
563/* R202 : program-unit */
564program-unit: main-program
565     | external-subprogram
566     | module
567     ;
568 
569/*R203 : external-subprogram */
570external-subprogram: function-subprogram
571     | subroutine-subprogram
572     ;
573     
574opt_recursive :         { isrecursive = 0; }
575      | TOK_RECURSIVE   { isrecursive = 1; }
576      ;
577
578opt_result :                                { is_result_present = 0; }
579      | TOK_RESULT arglist_after_result     { is_result_present = 1; }
580      ;
581
582name_routine :  TOK_NAME    { strcpy($$, $1); strcpy(subroutinename, $1); }
583      ;
584filename :      TOK_CHAR_CONSTANT { Add_Include_1($1); }
585      ;
586arglist :               { if ( firstpass ) $$=NULL; }
587      | '(' ')'         { if ( firstpass ) $$=NULL; }
588      | '(' {in_complex_literal=0;} args ')'    { if ( firstpass ) $$=$3; }
589      ;
590arglist_after_result:
591      | '(' ')'
592      | '(' {in_complex_literal=0;} args ')'    { if ( firstpass ) Add_SubroutineArgument_Var_1($3); }
593      ;
594args :  arg
595        {
596            if ( firstpass == 1 )
597            {
598                strcpy(nameinttypenameback,nameinttypename);
599                strcpy(nameinttypename,"");
600                curvar = createvar($1,NULL);
601                strcpy(nameinttypename,nameinttypenameback);
602                curlistvar = insertvar(NULL,curvar);
603                $$ = settype("",curlistvar);
604            }
605        }
606      | args ',' arg
607        {
608            if ( firstpass == 1 )
609            {
610                strcpy(nameinttypenameback,nameinttypename);
611                strcpy(nameinttypename,"");
612                curvar = createvar($3,NULL);
613                strcpy(nameinttypename,nameinttypenameback);
614                $$ = insertvar($1,curvar);
615            }
616        }
617      ;
618arg : TOK_NAME  { strcpy($$,$1);  }
619      | '*'     { strcpy($$,"*"); }
620      ;
621
622opt_spec :
623      | access_spec
624        {
625            PublicDeclare = 0 ;
626            PrivateDeclare = 0 ;
627        }
628      ;
629name_intrinsic :
630        TOK_SUM
631      | TOK_TANH
632      | TOK_MAXVAL
633      | TOK_MIN
634      | TOK_MINVAL
635      | TOK_TRIM
636      | TOK_SQRT
637      | TOK_NINT
638      | TOK_FLOAT
639      | TOK_EXP
640      | TOK_COS
641      | TOK_COSH
642      | TOK_ACOS
643      | TOK_SIN
644      | TOK_SINH
645      | TOK_ASIN
646      | TOK_LOG
647      | TOK_TAN
648      | TOK_ATAN
649      | TOK_MOD
650      | TOK_SIGN
651      | TOK_MINLOC
652      | TOK_MAXLOC
653      | TOK_NAME
654      ;
655use_intrinsic_list :
656                               name_intrinsic
657      | use_intrinsic_list ',' name_intrinsic
658      ;
659list_couple :
660                        '(' list_expr ')'
661      | list_couple ',' '(' list_expr ')'
662      ;
663list_expr_equi :
664                           expr_equi
665      | list_expr_equi ',' expr_equi
666      ;
667expr_equi : '(' list_expr_equi1 ')'
668      ;
669list_expr_equi1 :
670                            ident dims
671      | list_expr_equi1 ',' ident dims
672      ;
673list_expr:
674                      expr
675      | list_expr ',' expr
676      ;
677opt_sep:
678      | TOK_FOURDOTS
679      ;
680
681before_function :   TOK_FUNCTION    { functiondeclarationisdone = 1; }
682      ;
683before_parameter :  TOK_PARAMETER   {VariableIsParameter = 1; pos_curparameter = setposcur()-9; }
684      ;
685
686data_stmt :             /* R534 */
687        TOK_DATA data_stmt_set_list
688
689data_stmt_set_list :
690        data_stmt_set
691      | data_stmt_set_list opt_comma data_stmt_set
692
693data_stmt_set :         /* R535 */
694        TOK_NAME TOK_SLASH data_stmt_value_list TOK_SLASH
695        {
696            createstringfromlistname(ligne,$3);
697            if (firstpass == 1) Add_Data_Var_1(&List_Data_Var,$1,ligne);
698            else                Add_Data_Var_1(&List_Data_Var_Cur,$1,ligne);
699        }
700      | datanamelist TOK_SLASH data_stmt_value_list TOK_SLASH
701        {
702            if (firstpass == 1)  Add_Data_Var_Names_01(&List_Data_Var,$1,$3);
703            else                 Add_Data_Var_Names_01(&List_Data_Var_Cur,$1,$3);
704        }
705      | '(' lhs ',' dospec ')' TOK_SLASH data_stmt_value_list TOK_SLASH
706        {
707            createstringfromlistname(ligne,$7);
708            printf("###################################################################################################################\n");
709            printf("## CONV Error : data_implied_do statements (R537) are not yet supported. Please complain to the proper authorities.\n");
710            printf("l.%4d -- data_stmt_set : ( lhs , dospec ) /data_stmt_value_list/ -- lhs=|%s| dospec=|%s| data_stmt_value_list=|%s|\n",
711                line_num_input,$2,$4,ligne);
712            printf("## But, are you SURE you NEED a DATA construct ?\n");
713            printf("###################################################################################################################\n");
714            exit(1);
715        }
716      ;
717
718data_stmt_value_list :
719        expr_data                           { $$ = Insertname(NULL,$1,0); }
720      | expr_data ',' data_stmt_value_list  { $$ = Insertname($3,$1,1);   }
721      ;
722
723save:  before_save varsave
724      | before_save comblock varsave
725      | save opt_comma comblock opt_comma varsave
726      | save ',' varsave
727      ;
728before_save:
729        TOK_SAVE        { pos_cursave = setposcur()-4; }
730      ;
731varsave :
732      | TOK_NAME dims   { if ( ! inside_type_declare ) Add_Save_Var_1($1,$2); }
733      ;
734datanamelist :
735        TOK_NAME                        { $$ = Insertname(NULL,$1,0); }
736      | TOK_NAME '(' expr ')'           { printf("l.%4d -- INSTRUCTION NON TRAITEE : INITIALISATION DE DATA AVEC EXPRESSION\n",line_num_input); exit(0); }
737      | datanamelist ',' datanamelist   { $$ = concat_listname($1,$3); }
738      ;
739expr_data :
740        opt_signe simple_const      { sprintf($$,"%s%s",$1,$2);  }
741      | expr_data '+' expr_data     { sprintf($$,"%s+%s",$1,$3); }
742      | expr_data '-' expr_data     { sprintf($$,"%s-%s",$1,$3); }
743      | expr_data '*' expr_data     { sprintf($$,"%s*%s",$1,$3); }
744      | expr_data '/' expr_data     { sprintf($$,"%s/%s",$1,$3); }
745      ;
746opt_signe :     { strcpy($$,""); }
747      | signe   { strcpy($$,$1); }
748      ;
749namelist :
750        TOK_NAMELIST ident
751      | TOK_NAMELIST comblock ident
752      | namelist opt_comma comblock opt_comma ident
753      | namelist ',' ident
754      ;
755before_dimension :
756        TOK_DIMENSION
757        {
758            positioninblock = 0;
759            pos_curdimension = setposcur()-9;
760        }
761
762dimension :
763        before_dimension opt_comma TOK_NAME dims lengspec
764        {
765            printf("l.%4d -- dimension : before_dimension opt_comma TOK_NAME = |%s| -- MHCHECK\n",line_num_input,$3);
766            if ( inside_type_declare ) break;
767            curvar = createvar($3,$4);
768            CreateAndFillin_Curvar("", curvar);
769            curlistvar=insertvar(NULL, curvar);
770            $$ = settype("",curlistvar);
771            strcpy(vallengspec,"");
772        }
773      | dimension ',' TOK_NAME dims lengspec
774        {
775            printf("l.%4d -- dimension : dimension ',' TOK_NAME dims lengspec = |%s| -- MHCHECK\n",line_num_input,$3);
776            if ( inside_type_declare ) break;
777            curvar = createvar($3,$4);
778            CreateAndFillin_Curvar("", curvar);
779            curlistvar = insertvar($1, curvar);
780            $$ = curlistvar;
781            strcpy(vallengspec,"");
782        }
783      ;
784private :
785        TOK_PRIVATE '\n'
786      | TOK_PRIVATE opt_sep use_name_list
787      ;
788public :
789        TOK_PUBLIC '\n'                     { $$ = (listname *) NULL; }
790      | TOK_PUBLIC opt_sep use_name_list    { $$ = $3; }
791      ;
792use_name_list :
793        TOK_NAME                            { $$ = Insertname(NULL,$1,0); }
794      | TOK_ASSIGNTYPE                      { $$ = Insertname(NULL,$1,0); }
795      | use_name_list ',' TOK_NAME          { $$ = Insertname($1,$3,0);   }
796      | use_name_list ',' TOK_ASSIGNTYPE    { $$ = Insertname($1,$3,0);   }
797      ;
798common :
799        before_common var_common_list
800        {
801            if ( inside_type_declare ) break;
802            pos_end = setposcur();
803            RemoveWordSET_0(fortran_out,pos_curcommon,pos_end-pos_curcommon);
804        }
805      | before_common comblock var_common_list
806        {
807            if ( inside_type_declare ) break;
808            sprintf(charusemodule,"%s",$2);
809            Add_NameOfCommon_1($2,subroutinename);
810            pos_end = setposcur();
811            RemoveWordSET_0(fortran_out,pos_curcommon,pos_end-pos_curcommon);
812        }
813      | common opt_comma comblock opt_comma var_common_list
814        {
815            if ( inside_type_declare ) break;
816            sprintf(charusemodule,"%s",$3);
817            Add_NameOfCommon_1($3,subroutinename);
818            pos_end = setposcur();
819            RemoveWordSET_0(fortran_out,pos_curcommon,pos_end-pos_curcommon);
820        }
821      ;
822before_common :
823        TOK_COMMON              { positioninblock = 0; pos_curcommon = setposcur()-6;   }
824      | TOK_GLOBAL TOK_COMMON   { positioninblock = 0; pos_curcommon = setposcur()-6-7; }
825      ;
826var_common_list :
827        var_common                      { if ( ! inside_type_declare ) Add_Common_var_1(); }
828      | var_common_list ',' var_common  { if ( ! inside_type_declare ) Add_Common_var_1(); }
829      ;
830var_common :
831        TOK_NAME dims
832        {
833            positioninblock = positioninblock + 1 ;
834            strcpy(commonvar,$1);
835            commondim = $2;
836        }
837      ;
838comblock :
839        TOK_DSLASH
840        {
841            strcpy($$,"");
842            positioninblock=0;
843            strcpy(commonblockname,"");
844        }
845      | TOK_SLASH TOK_NAME TOK_SLASH
846        {
847            strcpy($$,$2);
848            positioninblock=0;
849            strcpy(commonblockname,$2);
850        }
851      ;
852opt_comma :
853      | ','
854      ;
855paramlist :
856        paramitem                   { $$=insertvar(NULL,$1); }
857      | paramlist ',' paramitem     { $$=insertvar($1,$3);   }
858      ;
859paramitem :
860        TOK_NAME '=' expr
861        {
862            if ( inside_type_declare ) break;
863            curvar=(variable *) calloc(1,sizeof(variable));
864            Init_Variable(curvar);
865            curvar->v_VariableIsParameter = 1;
866            strcpy(curvar->v_nomvar,$1);
867            strcpy(curvar->v_subroutinename,subroutinename);
868            strcpy(curvar->v_modulename,curmodulename);
869            curvar->v_initialvalue=Insertname(curvar->v_initialvalue,$3,0);
870            strcpy(curvar->v_commoninfile,cur_filename);
871            Save_Length($3,14);
872            $$ = curvar;
873        }
874      ;
875module_proc_stmt :
876        TOK_PROCEDURE proc_name_list
877      ;
878proc_name_list :
879        TOK_NAME
880      | proc_name_list ',' TOK_NAME
881      ;
882implicit :
883        TOK_IMPLICIT TOK_NONE
884        {
885            if ( insubroutinedeclare == 1 )
886            {
887                Add_ImplicitNoneSubroutine_1();
888                pos_end = setposcur();
889                RemoveWordSET_0(fortran_out,pos_end-13,13);
890            }
891        }
892      ;
893dcl:   options TOK_NAME dims lengspec initial_value
894        {
895            if ( ! inside_type_declare )
896            {
897                if (dimsgiven == 1) curvar = createvar($2,curdim);
898                else                curvar = createvar($2,$3);
899                CreateAndFillin_Curvar(DeclType, curvar);
900                curlistvar = insertvar(NULL, curvar);
901                if (!strcasecmp(DeclType,"character"))
902                {
903                    if (c_selectorgiven == 1)
904                    {
905                        strcpy(c_selectordim.first,"1");
906                        strcpy(c_selectordim.last,c_selectorname);
907                        Save_Length(c_selectorname,1);
908                        change_dim_char(insertdim(NULL,c_selectordim),curlistvar);
909                    }
910                }
911                $$=settype(DeclType,curlistvar);
912            }
913            strcpy(vallengspec,"");
914        }
915      | dcl ',' TOK_NAME dims lengspec initial_value
916        {
917            if ( ! inside_type_declare )
918            {
919                if (dimsgiven == 1) curvar = createvar($3, curdim);
920                else                curvar = createvar($3, $4);
921                CreateAndFillin_Curvar($1->var->v_typevar,curvar);
922                strcpy(curvar->v_typevar, $1->var->v_typevar);
923                curvar->v_catvar = get_cat_var(curvar);
924                curlistvar = insertvar($1, curvar);
925                if (!strcasecmp(DeclType,"character"))
926                {
927                    if (c_selectorgiven == 1)
928                    {
929                        strcpy(c_selectordim.first,"1");
930                        strcpy(c_selectordim.last,c_selectorname);
931                        Save_Length(c_selectorname,1);
932                        change_dim_char(insertdim(NULL,c_selectordim),curlistvar);
933                    }
934                }
935                $$=curlistvar;
936            }
937            strcpy(vallengspec,"");
938        }
939      ;
940nodimsgiven : { dimsgiven = 0; }
941      ;
942type:  typespec selector               { strcpy(DeclType,$1);}
943      | before_character c_selector     { strcpy(DeclType,"character");  }
944      | typespec '*' TOK_CSTINT         { strcpy(DeclType,$1); strcpy(nameinttypename,$3);  }
945      | TOK_TYPEPAR attribute ')'       { strcpy(DeclType,"type"); GlobalDeclarationType = 1;  }
946      ;
947c_selector :
948      | '*' TOK_CSTINT              { c_selectorgiven = 1; strcpy(c_selectorname,$2); }
949      | '*' '(' c_attribute ')'     { c_star = 1;}
950      | '(' c_attribute ')'
951      ;
952c_attribute :
953        TOK_NAME clause opt_clause
954      | TOK_NAME '=' clause opt_clause
955      | clause opt_clause
956      ;
957before_character : TOK_CHARACTER    { pos_cur_decl = setposcur()-9; }
958      ;
959typespec :
960        TOK_INTEGER         { strcpy($$,"integer"); pos_cur_decl = setposcur()-7; }
961      | TOK_LOGICAL         { strcpy($$,"logical"); pos_cur_decl = setposcur()-7; }
962      | TOK_REAL            { strcpy($$,"real");    pos_cur_decl = setposcur()-4; }
963      | TOK_COMPLEX         { strcpy($$,"complex"); pos_cur_decl = setposcur()-7; }
964      | TOK_DOUBLECOMPLEX   { strcpy($$,"double complex"); pos_cur_decl = setposcur()-14; }
965      | TOK_DOUBLEPRECISION { pos_cur_decl = setposcur()-16; strcpy($$,"real"); strcpy(nameinttypename,"8"); printf("OK1\n");}
966      ;
967lengspec :
968      | '*' proper_lengspec {strcpy(vallengspec,$2);}
969      ;
970proper_lengspec :
971        expr        { sprintf($$,"*%s",$1); }
972      | '(' '*' ')' { strcpy($$,"*(*)"); }
973      ;
974selector :
975      | '*' proper_selector
976      | '(' attribute ')'
977      ;
978proper_selector : expr
979      | '(' '*' ')'
980      ;
981attribute :
982        TOK_NAME clause
983      | TOK_NAME '=' clause
984        {
985            if ( strstr($3,"0.d0") )
986            {
987                strcpy(nameinttypename,"8");
988                strcpy(NamePrecision,"");
989            }
990            else
991                sprintf(NamePrecision,"%s = %s",$1,$3);
992        }
993      | TOK_NAME        { strcpy(NamePrecision,$1); }
994      | TOK_CSTINT      { strcpy(NamePrecision,$1); }
995      | TOK_ASSIGNTYPE  { strcpy(NamePrecision,$1); }
996      ;
997clause :
998        expr   { strcpy(CharacterSize,$1);  strcpy($$,$1);  }
999      | '*'    { strcpy(CharacterSize,"*"); strcpy($$,"*"); }
1000      | ':'    { strcpy(CharacterSize,":"); strcpy($$,":"); }
1001      ;
1002opt_clause :
1003      | ',' TOK_NAME clause
1004      ;
1005options:
1006      | TOK_FOURDOTS
1007      | ',' attr_spec_list TOK_FOURDOTS
1008      ;
1009attr_spec_list: attr_spec
1010      | attr_spec_list ',' attr_spec
1011      ;
1012attr_spec :
1013        TOK_PARAMETER       { VariableIsParameter = 1; }
1014      | access_spec
1015      | TOK_ALLOCATABLE     { Allocatabledeclare = 1; }
1016      | TOK_DIMENSION dims  { dimsgiven = 1; curdim = $2; }
1017      | TOK_EXTERNAL        { ExternalDeclare = 1; }
1018      | TOK_INTENT '(' intent_spec ')'
1019                            { strcpy(IntentSpec,$3); intent_spec = 0;}
1020      | TOK_INTRINSIC
1021      | TOK_OPTIONAL        { optionaldeclare = 1 ; }
1022      | TOK_POINTER         { pointerdeclare = 1 ; }
1023      | TOK_SAVE            { SaveDeclare = 1 ; }
1024      | TOK_TARGET          { Targetdeclare = 1; }
1025      ;
1026intent_spec :
1027        TOK_IN          { strcpy($$,$1); }
1028      | TOK_OUT         { strcpy($$,$1); }
1029      | TOK_INOUT       { strcpy($$,$1); }
1030      ;
1031access_spec :
1032        TOK_PUBLIC      { PublicDeclare = 1;  }
1033      | TOK_PRIVATE     { PrivateDeclare = 1; }
1034      ;
1035dims :  { $$ = (listdim*) NULL; }
1036      | '(' {in_complex_literal=0;} dimlist ')'
1037        {
1038            $$ = (listdim*) NULL;
1039            if ( inside_type_declare ) break;
1040            if ( created_dimensionlist == 1 || agrif_parentcall == 1 )  $$=$3;
1041        }
1042      ;
1043dimlist :
1044        dim
1045        {
1046            $$ = (listdim*) NULL;
1047            if ( inside_type_declare ) break;
1048            if ( created_dimensionlist == 1 || agrif_parentcall == 1 )  $$=insertdim(NULL,$1);
1049        }
1050      | dimlist ',' dim
1051        {
1052            $$ = (listdim*) NULL;
1053            if ( inside_type_declare ) break;
1054            if ( (!inside_type_declare) && created_dimensionlist == 1 ) $$=insertdim($1,$3);
1055        }
1056      ;
1057dim :   ubound              { strcpy($$.first,"1"); strcpy($$.last,$1); Save_Length($1,1); }
1058      | ':'                 { strcpy($$.first,"");  strcpy($$.last,"");                    }
1059      | expr ':'            { strcpy($$.first,$1);  Save_Length($1,2); strcpy($$.last,""); }
1060      | ':' expr            { strcpy($$.first,"");  strcpy($$.last,$2); Save_Length($2,1); }
1061      | expr ':' ubound     { strcpy($$.first,$1);  Save_Length($1,2); strcpy($$.last,$3); Save_Length($3,1); }
1062      ;
1063ubound :
1064        '*'                 { strcpy($$,"*"); }
1065      | expr                { strcpy($$,$1);  }
1066      ;
1067/*
1068expr:  uexpr               { strcpy($$,$1); }
1069      | complex_const       { strcpy($$,$1); }
1070      | predefinedfunction  { strcpy($$,$1); }
1071      | '(' expr ')'        { sprintf($$,"(%s)",$2); }
1072      ;
1073*/
1074predefinedfunction :
1075        TOK_SUM minmaxlist ')'          { sprintf($$,"SUM(%s)",$2);}
1076      | TOK_MAX minmaxlist ')'          { sprintf($$,"MAX(%s)",$2);}
1077      | TOK_TANH '(' minmaxlist ')'     { sprintf($$,"TANH(%s)",$3);}
1078      | TOK_MAXVAL '(' minmaxlist ')'   { sprintf($$,"MAXVAL(%s)",$3);}
1079      | TOK_MIN minmaxlist ')'          { sprintf($$,"MIN(%s)",$2);}
1080      | TOK_MINVAL '(' minmaxlist ')'   { sprintf($$,"MINVAL(%s)",$3);}
1081      | TOK_TRIM '(' expr ')'           { sprintf($$,"TRIM(%s)",$3);}
1082      | TOK_SQRT expr ')'               { sprintf($$,"SQRT(%s)",$2);}
1083      | TOK_REAL '(' minmaxlist ')'     { sprintf($$,"REAL(%s)",$3);}
1084      | TOK_NINT '(' expr ')'           { sprintf($$,"NINT(%s)",$3);}
1085      | TOK_FLOAT '(' expr ')'          { sprintf($$,"FLOAT(%s)",$3);}
1086      | TOK_EXP '(' expr ')'            { sprintf($$,"EXP(%s)",$3);}
1087      | TOK_COS '(' expr ')'            { sprintf($$,"COS(%s)",$3);}
1088      | TOK_COSH '(' expr ')'           { sprintf($$,"COSH(%s)",$3);}
1089      | TOK_ACOS '(' expr ')'           { sprintf($$,"ACOS(%s)",$3);}
1090      | TOK_SIN '(' expr ')'            { sprintf($$,"SIN(%s)",$3);}
1091      | TOK_SINH '(' expr ')'           { sprintf($$,"SINH(%s)",$3);}
1092      | TOK_ASIN '(' expr ')'           { sprintf($$,"ASIN(%s)",$3);}
1093      | TOK_LOG '(' expr ')'            { sprintf($$,"LOG(%s)",$3);}
1094      | TOK_TAN '(' expr ')'            { sprintf($$,"TAN(%s)",$3);}
1095      | TOK_ATAN '(' expr ')'           { sprintf($$,"ATAN(%s)",$3);}
1096      | TOK_ABS expr ')'                { sprintf($$,"ABS(%s)",$2);}
1097      | TOK_MOD '(' minmaxlist ')'      { sprintf($$,"MOD(%s)",$3);}
1098      | TOK_SIGN minmaxlist ')'         { sprintf($$,"SIGN(%s)",$2);}
1099      | TOK_MINLOC '(' minmaxlist ')'   { sprintf($$,"MINLOC(%s)",$3);}
1100      | TOK_MAXLOC '(' minmaxlist ')'   { sprintf($$,"MAXLOC(%s)",$3);}
1101      ;
1102minmaxlist : expr {strcpy($$,$1);}
1103      | minmaxlist ',' expr     { sprintf($$,"%s,%s",$1,$3); }
1104      ;
1105uexpr : lhs                     { strcpy($$,$1); }
1106      | simple_const            { strcpy($$,$1); }
1107      | expr operation          { sprintf($$,"%s%s",$1,$2); }
1108      | signe expr %prec '*'    { sprintf($$,"%s%s",$1,$2); }
1109      | TOK_NOT expr            { sprintf($$,"%s%s",$1,$2); }
1110      ;
1111signe : '+'        { strcpy($$,"+"); }
1112      | '-'        { strcpy($$,"-"); }
1113      ;
1114
1115operation :
1116        '+' expr %prec '+'          { sprintf($$,"+%s",$2); }
1117      | '-' expr %prec '+'          { sprintf($$,"-%s",$2); }
1118      | '*' expr                    { sprintf($$,"*%s",$2); }
1119      | TOK_DASTER expr             { sprintf($$,"%s%s",$1,$2); }
1120      | TOK_EQ expr %prec TOK_EQ    { sprintf($$,"%s%s",$1,$2); }
1121      | TOK_EQV expr %prec TOK_EQV  { sprintf($$,"%s%s",$1,$2); }
1122      | TOK_GT expr %prec TOK_EQ    { sprintf($$,"%s%s",$1,$2); }
1123      | '>' expr %prec TOK_EQ       { sprintf($$," > %s",$2); }
1124      | '<' expr %prec TOK_EQ       { sprintf($$," < %s",$2); }
1125      | '>''=' expr %prec TOK_EQ    { sprintf($$," >= %s",$3); }
1126      | '<''=' expr %prec TOK_EQ    { sprintf($$," <= %s",$3); }
1127      | TOK_LT expr %prec TOK_EQ    { sprintf($$,"%s%s",$1,$2); }
1128      | TOK_GE expr %prec TOK_EQ    { sprintf($$,"%s%s",$1,$2); }
1129      | TOK_LE expr %prec TOK_EQ    { sprintf($$,"%s%s",$1,$2); }
1130      | TOK_NE expr %prec TOK_EQ    { sprintf($$,"%s%s",$1,$2); }
1131      | TOK_NEQV expr %prec TOK_EQV { sprintf($$,"%s%s",$1,$2); }
1132      | TOK_XOR expr                { sprintf($$,"%s%s",$1,$2); }
1133      | TOK_OR expr                 { sprintf($$,"%s%s",$1,$2); }
1134      | TOK_AND expr                { sprintf($$,"%s%s",$1,$2); }
1135      | TOK_SLASH after_slash       { sprintf($$,"%s",$2); }
1136      | '=' after_equal             { sprintf($$,"%s",$2); }
1137
1138after_slash :                   { strcpy($$,""); }
1139      | expr                    { sprintf($$,"/%s",$1); }
1140      | '=' expr %prec TOK_EQ   { sprintf($$,"/= %s",$2);}
1141      | TOK_SLASH expr          { sprintf($$,"//%s",$2); }
1142      ;
1143after_equal :
1144        '=' expr %prec TOK_EQ   { sprintf($$,"==%s",$2); }
1145      | expr                    { sprintf($$,"= %s",$1); }
1146      ;
1147
1148lhs :   ident                           { strcpy($$,$1); }
1149      | structure_component             { strcpy($$,$1); }
1150      | array_ele_substring_func_ref    { strcpy($$,$1); }
1151      ;
1152
1153beforefunctionuse :
1154        {
1155            agrif_parentcall = 0;
1156            if ( !strcasecmp(identcopy, "Agrif_Parent") )   agrif_parentcall = 1;
1157            if ( Agrif_in_Tok_NAME(identcopy) )
1158            {
1159                inagrifcallargument = 1;
1160                Add_SubroutineWhereAgrifUsed_1(subroutinename, curmodulename);
1161            }
1162        }
1163      ;
1164array_ele_substring_func_ref :
1165        begin_array                                         { strcpy($$,$1); if ( incalldeclare == 0 ) inagrifcallargument = 0;   }
1166      | begin_array substring                               { sprintf($$," %s %s ",$1,$2); }
1167      | structure_component '(' {in_complex_literal=0;} funarglist ')'              { sprintf($$," %s ( %s )",$1,$4); }
1168      | structure_component '(' {in_complex_literal=0;} funarglist ')' substring    { sprintf($$," %s ( %s ) %s ",$1,$4,$6); }
1169      ;
1170begin_array : TOK_LOGICALIF
1171      |  ident '(' {in_complex_literal=0;} funarglist ')'
1172        {
1173            if ( inside_type_declare ) break;
1174            sprintf($$," %s ( %s )",$1,$4);
1175            ModifyTheAgrifFunction_0($4);
1176            agrif_parentcall = 0;
1177        }
1178      ;
1179structure_component :
1180        lhs '%' declare_after_percent lhs
1181        {
1182            sprintf($$," %s %% %s ",$1,$4);
1183            if ( incalldeclare == 0 ) inagrifcallargument = 0;
1184        }
1185      ;
1186/*
1187vec :
1188        TOK_LEFTAB outlist TOK_RIGHTAB   { sprintf($$,"(/%s/)",$2); }
1189      ;
1190*/
1191funarglist :
1192        beforefunctionuse           { strcpy($$," "); }
1193      | beforefunctionuse funargs   { strcpy($$,$2); }
1194      ;
1195funargs :
1196        funarg              {  strcpy($$,$1); }
1197      | funargs ',' funarg  {  sprintf($$,"%s,%s",$1,$3); }
1198      ;
1199funarg :
1200        expr       {strcpy($$,$1);}
1201      | triplet    {strcpy($$,$1);}
1202      ;
1203triplet :
1204        expr ':' expr           {  sprintf($$,"%s :%s",$1,$3);}
1205      | expr ':' expr ':' expr  {  sprintf($$,"%s :%s :%s",$1,$3,$5);}
1206      | ':' expr ':' expr       {  sprintf($$,":%s :%s",$2,$4);}
1207      | ':' ':' expr            {  sprintf($$,": : %s",$3);}
1208      | ':' expr                {  sprintf($$,":%s",$2);}
1209      | expr ':'                {  sprintf($$,"%s :",$1);}
1210      | ':'                     {  sprintf($$,":");}
1211      ;
1212ident: TOK_NAME
1213        {
1214       //  if (indeclaration == 1) break;
1215            if ( afterpercent == 0 )
1216            {
1217                if ( Agrif_in_Tok_NAME($1) ) Add_SubroutineWhereAgrifUsed_1(subroutinename, curmodulename);
1218                if ( !strcasecmp($1,"Agrif_Parent") )   agrif_parentcall = 1;
1219                if ( VariableIsFunction($1) )
1220                {
1221                    if ( inagrifcallargument == 1 )
1222                    {
1223                        if ( !strcasecmp($1,identcopy) )
1224                        {
1225                            strcpy(sameagrifname,identcopy);
1226                            sameagrifargument = 1;
1227                        }
1228                    }
1229                    strcpy(identcopy,$1);
1230                    pointedvar = 0;
1231
1232                    if (variscoupled_0($1)) strcpy(truename, getcoupledname_0($1));
1233                    else                    strcpy(truename, $1);
1234
1235                    if ( VarIsNonGridDepend(truename) == 0 && (! Variableshouldberemoved(truename)) )
1236                    {
1237                        if ( inagrifcallargument == 1 || varispointer_0(truename) == 1 )
1238                        {
1239                            if ( (IsinListe(List_UsedInSubroutine_Var,$1) == 1) || (inagrifcallargument == 1) )
1240                            {
1241                                if (varistyped_0(truename) == 0)    ModifyTheVariableName_0(truename,strlen($1));
1242                            }
1243                        }
1244                        if ( inagrifcallargument != 1 || sameagrifargument ==1 )
1245                        {
1246                            Add_UsedInSubroutine_Var_1(truename);
1247                        }
1248                    }
1249                    NotifyAgrifFunction_0(truename);
1250                }
1251            }
1252            else
1253            {
1254                afterpercent = 0;
1255            }
1256        }
1257      ;
1258simple_const :
1259        TOK_TRUE     { strcpy($$,".TRUE.");}
1260      | TOK_FALSE    { strcpy($$,".FALSE.");}
1261      | TOK_NULL_PTR { strcpy($$,"NULL()"); }
1262      | TOK_CSTINT   { strcpy($$,$1); }
1263      | TOK_CSTREAL  { strcpy($$,$1); }
1264      | TOK_HEXA     { strcpy($$,$1); }
1265      | simple_const TOK_NAME
1266                     { sprintf($$,"%s%s",$1,$2); }
1267      | string_constant opt_substring
1268      ;
1269string_constant :
1270        TOK_CHAR_CONSTANT                   { strcpy($$,$1);}
1271      | string_constant TOK_CHAR_CONSTANT
1272      | TOK_CHAR_MESSAGE                    { strcpy($$,$1);}
1273      | TOK_CHAR_CUT                        { strcpy($$,$1);}
1274      ;
1275opt_substring :     { strcpy($$," ");}
1276      | substring   { strcpy($$,$1);}
1277      ;
1278/*
1279substring :
1280        '(' optexpr ':' optexpr ')' { sprintf($$,"(%s :%s)",$2,$4);}
1281      ;
1282*/
1283optexpr :           { strcpy($$," ");}
1284      | expr        { strcpy($$,$1);}
1285      ;
1286opt_expr :          { strcpy($$," ");}
1287      | expr        { strcpy($$,$1);}
1288      ;
1289initial_value:     { InitialValueGiven = 0; }
1290      | '=' expr
1291        {
1292            if ( inside_type_declare ) break;
1293            strcpy(InitValue,$2);
1294            InitialValueGiven = 1;
1295        }
1296      | TOK_POINT_TO expr
1297        {
1298            if ( inside_type_declare ) break;
1299            strcpy(InitValue,$2);
1300            InitialValueGiven = 2;
1301        }
1302      ;
1303complex_const :
1304        '(' uexpr ',' uexpr ')' {sprintf($$,"(%s,%s)",$2,$4); }
1305      ;
1306
1307only_list :
1308        only_name   {  $$ = $1; }
1309      | only_list ',' only_name
1310        {
1311            /* insert the variable in the list $1                 */
1312            $3->suiv = $1;
1313            $$ = $3;
1314        }
1315      ;
1316only_name :
1317        TOK_NAME TOK_POINT_TO TOK_NAME
1318        {
1319            coupletmp = (listcouple *)calloc(1,sizeof(listcouple));
1320            strcpy(coupletmp->c_namevar,$1);
1321            strcpy(coupletmp->c_namepointedvar,$3);
1322            coupletmp->suiv = NULL;
1323            $$ = coupletmp;
1324            pointedvar = 1;
1325            Add_UsedInSubroutine_Var_1($1);
1326        }
1327      | TOK_NAME
1328        {
1329            coupletmp = (listcouple *)calloc(1,sizeof(listcouple));
1330            strcpy(coupletmp->c_namevar,$1);
1331            strcpy(coupletmp->c_namepointedvar,"");
1332            coupletmp->suiv = NULL;
1333            $$ = coupletmp;
1334        }
1335      ;
1336
1337/* R204 : specification-part */
1338/* opt-implicit-part removed but implicit-stmt and format-stmt added to declaration-construct */
1339specification-part: opt-use-stmt-list opt-declaration-construct-list
1340     ;
1341
1342opt-use-stmt-list:
1343     |use-stmt-list
1344     ;
1345     
1346opt-implicit-part:
1347     |implicit-part
1348     ;
1349
1350implicit-part: opt-implicit-part-stmt-list implicit-stmt
1351     ;
1352     
1353opt-implicit-part-stmt-list:
1354     | implicit-part-stmt-list
1355     ;
1356     
1357implicit-part-stmt-list: implicit-part-stmt
1358     | implicit-part-stmt-list implicit-part-stmt
1359     ;
1360     
1361/* R206: implicit-part-stmt */
1362implicit-part-stmt: implicit-stmt
1363     | parameter-stmt
1364     | format-stmt
1365     ;
1366
1367
1368opt-declaration-construct-list:
1369     |declaration-construct-list
1370     ;
1371     
1372declaration-construct-list:
1373        declaration-construct
1374      | declaration-construct-list declaration-construct
1375      ;
1376     
1377/* R207 : declaration-construct */
1378/* stmt-function-stmt replaced by assignment-stmt due to reduce conflicts */
1379/* because assignment-stmt has been added  */
1380/* Every statement that begins with a variable should be added */
1381/* This include : */
1382/* pointer-assignment-stmt, do-construct */
1383/* implicit-stmt and format-stmt added since implicit-part-stmt has been removed due to conflicts (see R204) */
1384/* ANOTHER SOLUTION TO THE PROBLEM OF STMT-FUNCTION IS NEEDED !!!! */
1385/* BECAUSE ALMOST ALL ACTION-STMT SHOULD BE INCLUDED HERE !!! */
1386
1387declaration-construct: derived-type-def
1388     | parameter-stmt
1389     | format-stmt
1390     | implicit-stmt
1391     | other-specification-stmt
1392     | type-declaration-stmt
1393     | assignment-stmt
1394     | pointer-assignment-stmt
1395     | do-construct
1396     | if-construct
1397     | continue-stmt
1398     | return-stmt
1399     | print-stmt
1400     ;
1401
1402opt-execution-part:
1403     | execution-part
1404     ;
1405
1406/* R208 : execution-part */
1407execution-part: executable-construct opt-execution-part-construct-list
1408     ;
1409
1410opt-execution-part-construct-list:
1411     |execution-part-construct-list
1412     ;
1413
1414execution-part-construct-list:
1415        execution-part-construct
1416      | execution-part-construct-list execution-part-construct
1417      ;
1418
1419/* R209 : execution-part-construct */
1420execution-part-construct: executable-construct
1421      | format-stmt
1422      ;
1423
1424opt-internal-subprogram-part:
1425     | internal-subprogram-part
1426     ;
1427     
1428/* R120 : internal-subprogram-part */
1429internal-subprogram-part: TOK_CONTAINS line-break
1430      opt-internal-subprogram
1431     ;
1432
1433opt-internal-subprogram:
1434     | internal-subprogram-list
1435     ;
1436
1437internal-subprogram-list: internal-subprogram
1438     | internal-subprogram-list internal-subprogram
1439     ;
1440
1441/* R211 : internal-subprogram */
1442internal-subprogram: function-subprogram
1443     | subroutine-subprogram
1444     ;
1445
1446/* R212 : other-specification-stmt */
1447other-specification-stmt: access-stmt
1448     | common-stmt
1449     | data-stmt
1450     | dimension-stmt
1451     | equivalence-stmt
1452     | external-stmt
1453     | intrinsic-stmt
1454     | namelist-stmt
1455     | save-stmt
1456     ;
1457
1458/* R213 : executable-construct */
1459executable-construct:
1460        action-stmt
1461      | do-construct
1462      | case-construct
1463      | if-construct
1464      | where-construct
1465      ;
1466
1467/* R214 : action-stmt */
1468
1469/* normal action-stmt */
1470
1471action-stmt:
1472      allocate-stmt
1473      | assignment-stmt
1474      | call-stmt
1475      | close-stmt
1476      | continue-stmt
1477      | cycle-stmt
1478      | deallocate-stmt
1479      | goto-stmt
1480      | exit-stmt
1481      | flush-stmt
1482      | TOK_CYCLE opt_expr
1483      | TOK_NULLIFY '(' pointer_name_list ')'
1484      | TOK_ENDMODULE opt_name
1485        {
1486            /* if we never meet the contains keyword               */
1487            if ( firstpass == 0 )
1488            {
1489                RemoveWordCUR_0(fortran_out, strlen($2)+11);    // Remove word "end module"
1490                if ( inmoduledeclare && ! aftercontainsdeclare )
1491                {
1492                    Write_Closing_Module(1);
1493                }
1494                fprintf(fortran_out,"\n      end module %s\n", curmodulename);
1495                if ( module_declar && insubroutinedeclare == 0 )
1496                {
1497                    fclose(module_declar);
1498                }
1499            }
1500            inmoduledeclare = 0 ;
1501            inmodulemeet = 0 ;
1502            aftercontainsdeclare = 1;
1503            strcpy(curmodulename, "");
1504            GlobalDeclaration = 0 ;
1505        }
1506      | if-stmt
1507      | inquire-stmt
1508      | open-stmt
1509      | pointer-assignment-stmt
1510      | print-stmt
1511      | read-stmt
1512      | return-stmt
1513      | rewind-stmt
1514      | stop-stmt
1515      | where-stmt
1516      | write-stmt
1517      | arithmetic-if-stmt
1518      ;
1519
1520/* R215 : keyword */
1521keyword: ident
1522     ;
1523
1524scalar-constant: constant
1525    ;
1526
1527/* R304 : constant */
1528
1529constant: literal-constant
1530     | named-constant
1531     ;
1532     
1533/* R305 : literal-constant */
1534literal-constant: int-literal-constant
1535     | real-literal-constant
1536     | logical-literal-constant
1537     | complex-literal-constant
1538     {in_complex_literal=0;}
1539     | char-literal-constant
1540     ;
1541     
1542/* R306 : named-constant */
1543named-constant: ident
1544     ;
1545
1546scalar-int-constant:int-constant
1547     ;
1548
1549/* R307 : int-constant */
1550int-constant: int-literal-constant
1551     | named-constant
1552     ;
1553     
1554/*
1555constant: TOK_CSTINT
1556     | TOK_CSTREAL
1557     | ident
1558     ;
1559*/
1560
1561opt-label:
1562     {strcpy($$,"");}
1563     | label
1564     ;
1565
1566/* R312 : label */
1567label: TOK_LABEL
1568     | TOK_CSTINT
1569     ;
1570
1571opt-label-djview:
1572     {strcpy($$,"");}
1573     | label-djview
1574     {strcpy($$,$1);}
1575     ;
1576     
1577label-djview: TOK_LABEL_DJVIEW
1578     ;
1579
1580/* R401 : type-param-value */
1581type-param-value: scalar-int-expr
1582     | '*'
1583     | ':'
1584     ;
1585
1586/* R402: type-spec */
1587type-spec: intrinsic-type-spec
1588     {strcpy($$,$1);}
1589     | derived-type-spec
1590     {strcpy($$,$1);}
1591     ;
1592
1593/* R403 : declaration-type-spec */
1594declaration-type-spec: {pos_cur_decl=my_position_before;} intrinsic-type-spec
1595     {strcpy($$,$2);}
1596     | TOK_TYPEPAR intrinsic-type-spec ')'
1597     | TOK_TYPEPAR derived-type-spec ')'
1598     {strcpy(DeclType,"type"); GlobalDeclarationType = 1;  }
1599     ;
1600
1601/* R404 : intrinsic-type-spec */
1602intrinsic-type-spec: TOK_INTEGER {in_kind_selector = 1;} opt-kind-selector
1603     {sprintf($$,"%s%s",$1,$[opt-kind-selector]);strcpy(DeclType,$1); in_kind_selector =0;}
1604     | TOK_REAL {in_kind_selector = 1;} opt-kind-selector
1605     {sprintf($$,"%s%s",$1,$[opt-kind-selector]);strcpy(DeclType,$1);in_kind_selector =0;}
1606     | TOK_DOUBLEPRECISION {in_kind_selector = 1;} opt-kind-selector
1607     {sprintf($$,"%s%s",$1,$[opt-kind-selector]);strcpy(DeclType,"real"); strcpy(NamePrecision,"8");in_kind_selector =0;}
1608     | TOK_COMPLEX {in_kind_selector = 1;} opt-kind-selector
1609     {sprintf($$,"%s%s",$1,$[opt-kind-selector]);strcpy(DeclType,$1);in_kind_selector =0;}
1610     | TOK_CHARACTER {in_char_selector = 1;} opt-char-selector
1611     {sprintf($$,"%s%s",$1,$[opt-char-selector]);strcpy(DeclType,$1);in_char_selector = 0;}
1612     | TOK_LOGICAL {in_kind_selector = 1;} opt-kind-selector
1613     {sprintf($$,"%s%s",$1,$[opt-kind-selector]);strcpy(DeclType,$1);in_kind_selector =0;}
1614     ;
1615
1616opt-kind-selector:
1617     {strcpy($$,"");strcpy(NamePrecision,"");}
1618     |kind-selector
1619     {strcpy($$,$1);}
1620     ;
1621     
1622/* R405 : kind-selector */
1623/* Nonstandard extension : * INT */
1624kind-selector: '(' scalar-int-constant-expr ')'
1625     {sprintf($$,"(%s)",$2); strcpy(NamePrecision,$2);}
1626     | '(' TOK_KIND '=' scalar-int-constant-expr ')'
1627     {sprintf($$,"(KIND=%s)",$4); strcpy(NamePrecision,$4);}
1628     | '*' TOK_CSTINT
1629     {sprintf($$,"*%s",$2);strcpy(NamePrecision,$2);}
1630     ;
1631
1632/* R406 : signed-int-literal-constant */
1633/* sign replaced by add-op */
1634
1635signed-int-literal-constant:int-literal-constant
1636     | add-op int-literal-constant
1637     {sprintf($$,"%s%s",$1,$2);}
1638     ;
1639     
1640/* R407 : int-literal-constant */
1641int-literal-constant: TOK_CSTINT
1642     | TOK_CSTINT '_' kind-param
1643     {sprintf($$,"%s_%s",$1,$3);}
1644     ;
1645
1646/*R408 : kind-param */
1647kind-param: TOK_CSTINT
1648     | TOK_NAME
1649     ;
1650
1651opt-sign:
1652     | sign
1653     ;
1654
1655/* R411 : sign */
1656sign:'+'
1657     {strcpy($$,"+");}
1658     | '-'
1659     {strcpy($$,"-");}
1660     ;
1661
1662/* R412 : signed-real-literal-constant */
1663/* sign replaced by add-op */
1664signed-real-literal-constant:real-literal-constant
1665     | add-op real-literal-constant
1666     {sprintf($$,"%s%s",$1,$2);}
1667     ;
1668
1669/* R413 : real-literal-constant */
1670real-literal-constant: TOK_CSTREAL
1671     | TOK_CSTREAL '_' kind-param
1672     {sprintf($$,"%s_%s",$1,$3);};
1673     ;
1674
1675/* R417 : complex-literal-constant */
1676/* in-complex-literal is just here to change default precedence rules ... */
1677
1678complex-literal-constant: '(' real-part TOK_COMMACOMPLEX imag-part ')'
1679     {sprintf($$,"(%s,%s)",$2,$4);}
1680     ;
1681
1682
1683/* R418 : real-part */
1684real-part: signed-int-literal-constant
1685     | signed-real-literal-constant
1686     | ident
1687     ;
1688
1689/* R419 : imag-part */
1690imag-part: signed-int-literal-constant
1691     | signed-real-literal-constant
1692     | named-constant
1693     ;
1694
1695opt-char_length-star:
1696     | '*' char-length
1697     {char_length_toreset = 1;}
1698     ;
1699
1700opt-char-selector:
1701     {strcpy($$,"");}
1702    | char-selector
1703    {strcpy($$,"");}
1704    ;
1705
1706/* R420 : char-selector */
1707char-selector:length-selector
1708    | '(' TOK_LEN '=' type-param-value ',' TOK_KIND '=' scalar-int-constant-expr ')'
1709    | '(' type-param-value ',' scalar-int-constant-expr ')'
1710    | '(' TOK_KIND '=' scalar-int-constant-expr ')'
1711    | '(' TOK_KIND '=' scalar-int-constant-expr ',' TOK_LEN '=' type-param-value ')'
1712    ;
1713
1714/* R421 : length-selector */
1715length-selector: '(' type-param-value ')'
1716     {strcpy(CharacterSize,$2);}
1717     | '(' TOK_LEN '=' type-param-value ')'
1718     {strcpy(CharacterSize,$4);}
1719     | '*' char-length
1720     | '*' char-length ','
1721     ;
1722
1723/* R422 : char-length */
1724char-length: '(' type-param-value ')'
1725     {c_star=1; strcpy(CharacterSize,$2);}
1726     | int-literal-constant
1727     {c_selectorgiven = 1; strcpy(c_selectorname,$1);}
1728     ;
1729
1730/* R423 : char-literal-constant */
1731char-literal-constant: TOK_CHAR_CONSTANT
1732     | TOK_CHAR_MESSAGE
1733     | TOK_CHAR_CUT
1734     ;
1735
1736/* R424 : logical-literal-constant */
1737logical-literal-constant: TOK_TRUE
1738     | TOK_FALSE
1739     ;
1740
1741/* R425 : derived-type-def */
1742derived-type-def: derived-type-stmt { inside_type_declare = 1;} opt-component-part end-type-stmt
1743     { inside_type_declare = 0;}
1744     ;
1745     
1746/* R426 : derived-type-stmt */
1747derived-type-stmt: TOK_TYPE opt-type-attr-spec-list-comma-fourdots TOK_NAME line-break
1748     | TOK_TYPE opt-type-attr-spec-list-comma TOK_NAME '(' type-param-name-list ')' line-break
1749     ;
1750
1751opt-type-attr-spec-list-comma-fourdots:
1752    | opt-type-attr-spec-list-comma TOK_FOURDOTS
1753    ;
1754 
1755 opt-type-attr-spec-list-comma:
1756     | ',' type-attr-spec-list
1757     ;
1758
1759type-attr-spec-list: type-attr-spec
1760     | type-attr-spec-list ',' type-attr-spec
1761     ;
1762
1763/* R427 : type-attr-spec */
1764type-attr-spec: access-spec
1765     ;
1766
1767type-param-name-list: type-param-name
1768     | type-param-name-list ',' type-param-name
1769     ;
1770     
1771type-param-name: TOK_NAME
1772     ;
1773
1774/* R429 : end-type-stmt */
1775end-type-stmt: TOK_ENDTYPE line-break
1776     | TOK_ENDTYPE TOK_NAME line-break
1777     ;
1778
1779opt-component-part:
1780     | component-part
1781     ;
1782
1783/* R434 : component-part */
1784component-part: component-def-stmt
1785    | component-part component-def-stmt
1786    ;
1787
1788/* R435 : component-def-stmt */
1789component-def-stmt: data-component-def-stmt
1790    ;
1791   
1792/* R436 : data-component-def-stmt */
1793data-component-def-stmt: declaration-type-spec opt-component-attr-spec-list-comma-2points component-decl-list line-break
1794     ;
1795
1796opt-component-attr-spec-list-comma-2points:
1797     | TOK_FOURDOTS
1798     | ',' component-attr-spec-list TOK_FOURDOTS
1799     ;
1800
1801component-attr-spec-list: component-attr-spec
1802     | component-attr-spec-list ',' component-attr-spec
1803     ;
1804     
1805/* R437 : component-attr-spec */
1806component-attr-spec: access-spec
1807     | TOK_ALLOCATABLE
1808     | TOK_DIMENSION '(' {in_complex_literal=0;} component-array-spec ')'
1809     | TOK_POINTER
1810     ;
1811
1812component-decl-list: component-decl
1813     | component-decl-list ',' component-decl
1814     ;
1815
1816/* R438 : component-decl */
1817component-decl : ident opt-component-array-spec opt-char_length-star opt-component-initialization
1818       {
1819            PublicDeclare = 0;
1820            PrivateDeclare = 0;
1821            ExternalDeclare = 0;
1822            strcpy(NamePrecision,"");
1823            c_star = 0;
1824            InitialValueGiven = 0 ;
1825            strcpy(IntentSpec,"");
1826            VariableIsParameter =  0 ;
1827            Allocatabledeclare = 0 ;
1828            Targetdeclare = 0 ;
1829            SaveDeclare = 0;
1830            pointerdeclare = 0;
1831            optionaldeclare = 0 ;
1832            dimsgiven=0;
1833            c_selectorgiven=0;
1834            strcpy(nameinttypename,"");
1835            strcpy(c_selectorname,"");
1836            GlobalDeclarationType = 0;
1837         }
1838     ;
1839
1840opt-component-array-spec:
1841     | '(' component-array-spec ')'
1842     ;
1843
1844/* R439 : component-array-spec */
1845component-array-spec: explicit-shape-spec-list
1846     | deferred-shape-spec-list
1847     ;
1848
1849opt-component-initialization:
1850     | component-initialization
1851     ;
1852     
1853/* R442 : component-initialization */
1854component-initialization: '=' constant-expr
1855      | TOK_POINT_TO null-init
1856      | TOK_POINT_TO initial-data-target
1857      ;
1858
1859/* R443 initial-data-target */
1860initial-data-target: designator
1861     {strcpy(my_dim.last,"");}
1862     ;
1863
1864/* R453 : derived-type-spec */
1865derived-type-spec: ident
1866     {strcpy(NamePrecision,$1);}
1867     | ident '(' type-param-spec-list ')'
1868     ;
1869     
1870type-param-spec-list: type-param-spec
1871     | type-param-spec-list ',' type-param-spec
1872     ;
1873
1874/* R454 : type-param-spec */
1875type-param-spec: type-param-value
1876    | keyword '=' type-param-value
1877    ;
1878
1879/* R455 : structure-constructor */
1880structure-constructor: derived-type-spec '(' ')'
1881     | derived-type-spec '(' component-spec-list ')'
1882     ;
1883     
1884component-spec-list: component-spec
1885     | component-spec-list ',' component-spec
1886     ;
1887     
1888/* R456 : component-spec */
1889component-spec: component-data-source
1890     | keyword '=' component-data-source
1891     ;
1892
1893/* R457 : component-data-source */
1894component-data-source: expr
1895     | data-target
1896     | proc-target
1897     ;
1898
1899/* R468 : array-constructor */
1900array-constructor: TOK_LEFTAB ac-spec TOK_RIGHTAB
1901     { sprintf($$,"(/%s/)",$2);}
1902     | lbracket ac-spec rbracket
1903     { sprintf($$,"[%s]",$2); }
1904     ;
1905     
1906/* R469 : ac-spec */
1907/* type-spec TOK_FOURDOTS is removed due to conflicts with part-ref */
1908
1909/*ac-spec: type-spec TOK_FOURDOTS
1910     {sprintf($$,"%s::",$1);}
1911     | ac-value-list
1912     | type-spec TOK_FOURDOTS ac-value-list
1913     {sprintf($$,"%s::%s",$1,$3);}
1914     ;
1915*/
1916
1917ac-spec: ac-value-list
1918     ;
1919     
1920/* R470 : lbracket */
1921lbracket: '['
1922     ;
1923
1924/* R471 : rbracket */
1925rbracket: ']'
1926     ;
1927
1928ac-value-list:
1929        ac-value
1930      | ac-value-list ',' ac-value
1931      {sprintf($$,"%s,%s",$1,$3);}
1932      ;
1933
1934/* R472 : ac-value */
1935ac-value: expr
1936      | ac-implied-do
1937      ;
1938
1939/* R473 : ac-implied-do */
1940ac-implied-do: '(' ac-value-list ',' ac-implied-do-control ')'
1941     {sprintf($$,"(%s,%s)",$2,$4);}
1942     ;
1943
1944/* R474 : ac-implied-do-control */
1945ac-implied-do-control: ac-do-variable '=' scalar-int-expr ',' scalar-int-expr
1946     {sprintf($$,"%s=%s,%s",$1,$3,$5);}
1947     | ac-do-variable '=' scalar-int-expr ',' scalar-int-expr ',' scalar-int-expr
1948     {sprintf($$,"%s=%s,%s,%s",$1,$3,$5,$7);}
1949     ;
1950
1951/* R475 : ac-do-variable */
1952ac-do-variable: do-variable
1953     ;
1954
1955/* R501 : type-declaration-stmt */
1956type-declaration-stmt: {indeclaration=1;} declaration-type-spec opt-attr-spec-construct entity-decl-list
1957        {
1958            /* if the variable is a parameter we can suppose that is*/
1959            /*    value is the same on each grid. It is not useless */
1960            /*    to create a copy of it on each grid               */
1961            if ( ! inside_type_declare )
1962            {
1963                pos_end = setposcur();
1964                //printf("POS = %d %d\n",pos_cur_decl,pos_end);
1965                RemoveWordSET_0(fortran_out,pos_cur_decl,pos_end-pos_cur_decl);
1966                ReWriteDeclarationAndAddTosubroutine_01($[entity-decl-list]);
1967                pos_cur_decl = setposcur();
1968                if ( firstpass == 0 && GlobalDeclaration == 0
1969                                    && insubroutinedeclare == 0 )
1970                {
1971                    fprintf(fortran_out,"\n#include \"Module_Declar_%s.h\"\n", curmodulename);
1972                    sprintf(ligne, "Module_Declar_%s.h", curmodulename);
1973                    module_declar = open_for_write(ligne);
1974                    GlobalDeclaration = 1 ;
1975                    pos_cur_decl = setposcur();
1976                }
1977
1978                if ( firstpass )
1979                {
1980                    Add_Globliste_1($[entity-decl-list]);
1981                    if ( insubroutinedeclare )
1982                    {
1983                        if ( pointerdeclare ) Add_Pointer_Var_From_List_1($[entity-decl-list]);
1984                        Add_Parameter_Var_1($[entity-decl-list]);
1985                    }
1986                    else
1987                        Add_GlobalParameter_Var_1($[entity-decl-list]);
1988
1989                    /* If there's a SAVE declaration in module's subroutines we should    */
1990                    /*    remove it from the subroutines declaration and add it in the    */
1991                    /*    global declarations                                             */
1992                                       
1993                    if ( aftercontainsdeclare && SaveDeclare )
1994                    {
1995                        if ( inmodulemeet ) Add_SubroutineDeclarationSave_Var_1($[entity-decl-list]);
1996                        else                Add_Save_Var_dcl_1($[entity-decl-list]);
1997                    }
1998                }
1999            }
2000            indeclaration = 0;
2001            PublicDeclare = 0;
2002            PrivateDeclare = 0;
2003            ExternalDeclare = 0;
2004            strcpy(NamePrecision,"");
2005            c_star = 0;
2006            InitialValueGiven = 0 ;
2007            strcpy(IntentSpec,"");
2008            VariableIsParameter =  0 ;
2009            Allocatabledeclare = 0 ;
2010            Targetdeclare = 0 ;
2011            SaveDeclare = 0;
2012            pointerdeclare = 0;
2013            optionaldeclare = 0 ;
2014            dimsgiven=0;
2015            c_selectorgiven=0;
2016            strcpy(nameinttypename,"");
2017            strcpy(c_selectorname,"");
2018            strcpy(DeclType,"");
2019            GlobalDeclarationType = 0;
2020        }
2021     line-break
2022     ;
2023
2024opt-attr-spec-construct:
2025     | opt-attr-spec-comma-list TOK_FOURDOTS
2026     ;
2027
2028opt-attr-spec-comma-list:
2029     | attr-spec-comma-list
2030     ;
2031     
2032attr-spec-comma-list:
2033        ',' attr-spec
2034      | attr-spec-comma-list ',' attr-spec
2035      ;
2036
2037/* R502 : attr-spec */
2038attr-spec:access-spec
2039     | TOK_ALLOCATABLE
2040     { Allocatabledeclare = 1; }
2041     | TOK_DIMENSION '(' {in_complex_literal=0;} array-spec ')'
2042     { dimsgiven = 1; curdim = $4; }
2043     | TOK_EXTERNAL
2044     { ExternalDeclare = 1; }
2045     | TOK_INTENT '(' {in_complex_literal=0;} intent-spec ')'
2046     { strcpy(IntentSpec,$4); }
2047     | TOK_INTRINSIC
2048     | TOK_OPTIONAL
2049     { optionaldeclare = 1 ; }
2050     | TOK_PARAMETER
2051     {VariableIsParameter = 1; }
2052     | TOK_POINTER
2053     { pointerdeclare = 1 ; }
2054     | TOK_SAVE
2055     { SaveDeclare = 1 ; }
2056     | TOK_TARGET
2057     { Targetdeclare = 1; }
2058     ;
2059
2060
2061entity-decl-list: entity-decl
2062     {$$=insertvar(NULL,$1);}
2063     | entity-decl-list ',' entity-decl
2064     {$$=insertvar($1,$3);}
2065     ;
2066
2067/* R503 : entity-decl */
2068entity-decl: object-name-noident opt-array-spec-par opt-char_length-star opt-initialization
2069        {
2070            if ( ! inside_type_declare )
2071            {
2072                if (dimsgiven == 1) curvar = createvar($1,curdim);
2073                else                curvar = createvar($1,$2);
2074                CreateAndFillin_Curvar(DeclType, curvar);
2075                strcpy(curvar->v_typevar,DeclType);
2076                curvar->v_catvar = get_cat_var(curvar);
2077               
2078                if (!strcasecmp(DeclType,"character"))
2079                {
2080                    if (c_selectorgiven == 1)
2081                    {
2082                        Save_Length(c_selectorname,1);
2083                        strcpy(curvar->v_dimchar,c_selectorname);
2084                    }
2085                }
2086            }
2087            strcpy(vallengspec,"");
2088            if (char_length_toreset == 1)
2089            {
2090            c_selectorgiven = 0;
2091            c_star = 0;
2092            strcpy(c_selectorname,"");
2093            strcpy(CharacterSize,"");
2094            char_length_toreset = 0;
2095            }
2096            $$=curvar;
2097        }
2098     ;
2099
2100
2101/* R504 : object-name */
2102object-name: ident
2103     ;
2104
2105object-name-noident: TOK_NAME
2106     ;
2107
2108opt-initialization: {InitialValueGiven = 0; }
2109     | initialization
2110     ;
2111
2112/* R505 : initialization */
2113initialization: '=' constant-expr
2114        {
2115            if ( inside_type_declare ) break;
2116            strcpy(InitValue,$2);
2117            InitialValueGiven = 1;
2118        }
2119     | TOK_POINT_TO null-init
2120        {
2121            if ( inside_type_declare ) break;
2122            strcpy(InitValue,$2);
2123            InitialValueGiven = 2;
2124        }
2125     | TOK_POINT_TO initial-data-target
2126        {
2127            if ( inside_type_declare ) break;
2128            strcpy(InitValue,$2);
2129            InitialValueGiven = 2;
2130        }
2131     ;
2132
2133/* R506 : null-init */
2134null-init: function-reference
2135     ;
2136
2137/* R507 : access-spec */
2138access-spec: TOK_PUBLIC
2139     {PublicDeclare = 1;  }
2140     | TOK_PRIVATE
2141     {PrivateDeclare = 1;  }
2142     ;
2143
2144opt-array-spec-par:
2145     {$$=NULL;}
2146     | '(' {in_complex_literal=0;} array-spec ')'
2147     {$$=$3;}
2148     ;
2149
2150/* R514 : array-spec */
2151array-spec: explicit-shape-spec-list
2152     {$$=$1;}
2153     | assumed-shape-spec-list
2154     {$$=$1;}
2155     | deferred-shape-spec-list
2156     {$$=$1;}
2157     | assumed-size-spec
2158     {$$=$1;}
2159     | implied-shape-spec-list
2160     {$$=$1;}
2161     ;
2162
2163explicit-shape-spec-list: explicit-shape-spec
2164        {
2165            $$ = (listdim*) NULL;
2166            if ( inside_type_declare ) break;
2167            if ( created_dimensionlist == 1 || agrif_parentcall == 1 )  $$=insertdim(NULL,$1);
2168        }
2169      | explicit-shape-spec-list ',' explicit-shape-spec
2170        {
2171            $$ = (listdim*) NULL;
2172            if ( inside_type_declare ) break;
2173            if ( (!inside_type_declare) && created_dimensionlist == 1 ) $$=insertdim($1,$3);
2174        }
2175      ;
2176     
2177/* R516 : explicit-shape-spec */
2178explicit-shape-spec: lower-bound ':' upper-bound
2179     {strcpy($$.first,$1);  Save_Length($1,2); strcpy($$.last,$3); Save_Length($3,1); }
2180     |upper-bound
2181     {strcpy($$.first,"1"); strcpy($$.last,$1); Save_Length($1,1);}
2182     ;
2183     
2184/* R517 : lower-bound */
2185lower-bound: specification-expr
2186     {strcpy($$,$1);}
2187     ;
2188     
2189/* R518 : upper-bound */
2190upper-bound: specification-expr
2191     ;
2192
2193assumed-shape-spec-list:
2194        assumed-shape-spec
2195        {
2196            $$ = (listdim*) NULL;
2197            if ( inside_type_declare ) break;
2198            if ( created_dimensionlist == 1 || agrif_parentcall == 1 )  $$=insertdim(NULL,$1);
2199        }
2200      | assumed-shape-spec-list ',' assumed-shape-spec
2201        {
2202            $$ = (listdim*) NULL;
2203            if ( inside_type_declare ) break;
2204            if ( (!inside_type_declare) && created_dimensionlist == 1 ) $$=insertdim($1,$3);
2205        }
2206      ;
2207
2208/* R519 : assumed-shape-spec */
2209assumed-shape-spec : ':'
2210      { strcpy($$.first,"");  strcpy($$.last,"");  }
2211      | lower-bound ':'
2212      { strcpy($$.first,$1);  Save_Length($1,2); strcpy($$.last,""); }
2213      ;
2214
2215deferred-shape-spec-list:
2216        deferred-shape-spec
2217        {
2218            $$ = (listdim*) NULL;
2219            if ( inside_type_declare ) break;
2220            if ( created_dimensionlist == 1 || agrif_parentcall == 1 )  $$=insertdim(NULL,$1);
2221        }
2222      | deferred-shape-spec-list ',' deferred-shape-spec
2223        {
2224            $$ = (listdim*) NULL;
2225            if ( inside_type_declare ) break;
2226            if ( (!inside_type_declare) && created_dimensionlist == 1 ) $$=insertdim($1,$3);
2227        }
2228      ;
2229
2230/* R520 : deferred-shape-spec */
2231deferred-shape-spec: ':'
2232     { strcpy($$.first,"");  strcpy($$.last,"");  }
2233     ;
2234
2235/* R521 : assume-size-spec */
2236assumed-size-spec:opt-explicit-shape-spec-list-comma opt-lower-bound-2points '*'
2237        {
2238            $$ = (listdim*) NULL;
2239            if ( inside_type_declare ) break;
2240            if ( created_dimensionlist == 1 || agrif_parentcall == 1 ) 
2241            {
2242            if (!strcasecmp($2,""))
2243            {
2244            strcpy(my_dim.first,"1");
2245            }
2246            else
2247            {
2248            strcpy(my_dim.first,$2);
2249            }
2250            strcpy(my_dim.last,"*");
2251            $$=insertdim($1,my_dim);
2252            strcpy(my_dim.first,"");
2253            strcpy(my_dim.last,"");
2254            }
2255        }
2256     ;
2257     
2258opt-explicit-shape-spec-list-comma:
2259     {$$ = (listdim *) NULL;}
2260     | explicit-shape-spec-list ','
2261     {$$ = $1;}
2262     ;
2263
2264explicit-shape-spec-list-comma: explicit-shape-spec ','
2265        {
2266            $$ = (listdim*) NULL;
2267            if ( inside_type_declare ) break;
2268            if ( created_dimensionlist == 1 || agrif_parentcall == 1 )  $$=insertdim(NULL,$1);
2269        }
2270     | explicit-shape-spec-list-comma explicit-shape-spec ','
2271        {
2272            $$ = (listdim*) NULL;
2273            if ( inside_type_declare ) break;
2274            if ( (!inside_type_declare) && created_dimensionlist == 1 ) $$=insertdim($1,$2);
2275        }
2276     ;
2277
2278opt-lower-bound-2points:
2279     {strcpy($$,"");}
2280     | lower-bound ':'
2281     {strcpy($$,$1);}
2282     ;
2283
2284implied-shape-spec-list: implied-shape-spec
2285     | implied-shape-spec-list ',' implied-shape-spec
2286     ;
2287
2288/* R522 : implied-shape-spec */
2289implied-shape-spec: opt-lower-bound-2points '*'
2290     ;
2291
2292/* R523 : intent-spec */
2293intent-spec: TOK_IN
2294     { strcpy($$,$1); }
2295     | TOK_OUT
2296     { strcpy($$,$1); }
2297     | TOK_INOUT
2298     { strcpy($$,$1); }
2299     ;
2300
2301/* R524 : access-stmt */
2302access-stmt: access-spec opt-access-id-list
2303     {
2304            if ((firstpass == 0) && (PublicDeclare == 1))
2305            {
2306                if ($2)
2307                {
2308                    removeglobfromlist(&($2));
2309                    pos_end = setposcur();
2310                    RemoveWordSET_0(fortran_out,pos_cur,pos_end-pos_cur);
2311                    writelistpublic($2);
2312                }
2313            }
2314     PublicDeclare = 0;
2315     PrivateDeclare = 0;
2316     }
2317     line-break
2318     ;
2319
2320opt-access-id-list:
2321     {$$=(listname *)NULL;}
2322     | opt-TOK_FOURDOTS access-id-list
2323     {$$=$2;}
2324     ;
2325
2326access-id-list: access-id
2327     {$$=Insertname(NULL,$1,0);}
2328     | access-id-list ',' access-id
2329     {$$=Insertname($1,$3,0);}
2330     ;
2331     
2332/* R525 : access-id */
2333access-id: TOK_NAME
2334     | generic-spec
2335     ;
2336     
2337/* R534 : data-stmt */
2338data-stmt: TOK_DATA data-stmt-set opt-data-stmt-set-nlist
2339        {
2340            /* we should remove the data declaration                */
2341            pos_end = setposcur();
2342            RemoveWordSET_0(fortran_out,pos_curdata,pos_end-pos_curdata);
2343            if ( aftercontainsdeclare == 1  && firstpass == 0 )
2344            {
2345                ReWriteDataStatement_0(fortran_out);
2346                pos_end = setposcur();
2347            }
2348            Init_List_Data_Var();
2349        }
2350        line-break
2351     ;
2352
2353opt-data-stmt-set-nlist:
2354     | data-stmt-set-nlist
2355     ;
2356
2357data-stmt-set-nlist: opt-comma data-stmt-set
2358     | data-stmt-set-nlist opt-comma data-stmt-set
2359     ;
2360
2361/* R535 : data-stmt-set */
2362data-stmt-set: data-stmt-object-list TOK_SLASH data-stmt-value-list TOK_SLASH
2363        {
2364            if (firstpass == 1) 
2365            {
2366            Add_Data_Var_Names_01(&List_Data_Var,$1,$3);
2367            }
2368            else                 Add_Data_Var_Names_01(&List_Data_Var_Cur,$1,$3);
2369        }
2370     ;
2371
2372data-stmt-object-list: data-stmt-object
2373     { $$=insertvar(NULL,$1); }
2374     | data-stmt-object-list ',' data-stmt-object
2375     {
2376     $$ = insertvar($1,$3);
2377     }
2378     ;
2379
2380data-stmt-value-list: data-stmt-value
2381     {$$=Insertname(NULL,$1,0);}
2382     | data-stmt-value-list ',' data-stmt-value
2383     {$$ = Insertname($1,$3,1);   }
2384     ;
2385     
2386/* R536 : data-stmt-object */
2387data-stmt-object: variable
2388     | data-implied-do
2389     ;
2390 
2391/* R537 : data-implied-do */           
2392data-implied-do: '(' data-i-do-object-list ',' data-i-do-variable '=' scalar-int-constant-expr ',' scalar-int-constant-expr ')'
2393     {printf("DOVARIABLE = %s %s %s\n",$4,$6,$8);
2394     printf("AUTRE = %s %s\n",$2->var->v_nomvar,$2->var->v_initialvalue_array);
2395     Insertdoloop($2->var,$4,$6,$8,"");
2396     $$=$2->var;
2397     }
2398     | '(' data-i-do-object-list ',' data-i-do-variable '=' scalar-int-constant-expr ',' scalar-int-constant-expr ',' scalar-int-constant-expr ')'
2399     {
2400     Insertdoloop($2->var,$4,$6,$8,$10);
2401     $$=$2->var;
2402     }
2403     ;
2404
2405data-i-do-object-list: data-i-do-object
2406     {$$=insertvar(NULL,$1);}
2407     | data-i-do-object-list ',' data-i-do-object
2408     {$$ = insertvar($1,$3);}
2409     ;
2410
2411/* R538 : data-i-do-object */
2412data-i-do-object: array-element
2413     | scalar-structure-component
2414     {$$->v_initialvalue_array=Insertname($$->v_initialvalue_array,my_dim.last,0);
2415     strcpy(my_dim.last,"");
2416     }
2417     | data-implied-do
2418     ;
2419
2420/* R539 : data-i-do-variable */
2421data-i-do-variable: do-variable
2422     ;
2423
2424/* R540 : data-stmt-value */
2425/* data-stmt-repeat and first data-stmt-constant inlined */
2426data-stmt-value: scalar-constant-subobject opt-data-stmt-star
2427     {sprintf($$,"%s%s",$1,$2);}
2428     | int-literal-constant opt-data-stmt-star
2429     {sprintf($$,"%s%s",$1,$2);}
2430     | char-literal-constant opt-data-stmt-star
2431     {sprintf($$,"%s%s",$1,$2);}
2432     | signed-int-literal-constant
2433     | signed-real-literal-constant
2434     | null-init
2435     | initial-data-target
2436     | structure-constructor
2437     ;
2438
2439opt-data-stmt-star:
2440     {strcpy($$,"");}
2441     | '*' data-stmt-constant
2442     {sprintf($$,"*%s",$2);}
2443     ;
2444
2445opt-data-stmt-repeat-star:
2446     | data-stmt-repeat '*'
2447     ;
2448
2449/* R541 : data-stmt-repeat */
2450/* scalar-int-constant inlined */
2451
2452data-stmt-repeat: scalar-int-constant
2453     | scalar-int-constant-subobject
2454     ;
2455
2456/* R542 : data-stmt-constant */
2457data-stmt-constant: scalar-constant
2458     | scalar-constant-subobject
2459     | signed-int-literal-constant
2460     | signed-real-literal-constant
2461     | null-init
2462     | initial-data-target
2463     | structure-constructor
2464     ;
2465
2466scalar-int-constant-subobject: int-constant-subobject
2467     ;
2468
2469scalar-constant-subobject: constant-subobject
2470     ;
2471
2472/* R543 : int-constant-subobject */
2473int-constant-subobject: constant-subobject
2474     ;
2475     
2476/* R544 : constant-subobject */
2477constant-subobject: designator
2478     {strcpy(my_dim.last,"");}
2479     ;
2480     
2481/* R545 : dimension-stmt */
2482dimension-stmt: {positioninblock = 0; pos_curdimension = my_position_before;}
2483     TOK_DIMENSION opt-TOK_FOURDOTS array-name-spec-list
2484        {
2485            /* if the variable is a parameter we can suppose that is   */
2486            /*    value is the same on each grid. It is not useless to */
2487            /*    create a copy of it on each grid                     */
2488            if ( ! inside_type_declare )
2489            {
2490                if ( firstpass )
2491                {
2492                    Add_Globliste_1($4);
2493                    /* if variableparamlists has been declared in a subroutine   */
2494                    if ( insubroutinedeclare )     Add_Dimension_Var_1($4);
2495                   
2496                    /* Add it to the List_SubroutineDeclaration_Var list if not present */
2497                    /* NB: if not done, a variable declared with DIMENSION but with no type given */
2498                    /* will not be declared by the conv */
2499                    ReWriteDeclarationAndAddTosubroutine_01($4);
2500                }
2501                else
2502                {
2503                    pos_end = setposcur();
2504                    RemoveWordSET_0(fortran_out,pos_curdimension,pos_end-pos_curdimension);
2505                    ReWriteDeclarationAndAddTosubroutine_01($4);
2506                }
2507            }
2508            PublicDeclare = 0;
2509            PrivateDeclare = 0;
2510            ExternalDeclare = 0;
2511            strcpy(NamePrecision,"");
2512            c_star = 0;
2513            InitialValueGiven = 0 ;
2514            strcpy(IntentSpec,"");
2515            VariableIsParameter =  0 ;
2516            Allocatabledeclare = 0 ;
2517            Targetdeclare = 0 ;
2518            SaveDeclare = 0;
2519            pointerdeclare = 0;
2520            optionaldeclare = 0 ;
2521            dimsgiven=0;
2522            c_selectorgiven=0;
2523            strcpy(nameinttypename,"");
2524            strcpy(c_selectorname,"");
2525        }
2526     line-break
2527     ;
2528     
2529array-name-spec-list: TOK_NAME '(' {in_complex_literal = 0;} array-spec ')'
2530     {
2531        if ( inside_type_declare ) break;
2532        curvar = createvar($1,$4);
2533        CreateAndFillin_Curvar("", curvar);
2534        curlistvar=insertvar(NULL, curvar);
2535        $$ = settype("",curlistvar);
2536        strcpy(vallengspec,"");
2537     }
2538     | array-name-spec-list ',' TOK_NAME '(' {in_complex_literal = 0;} array-spec ')'
2539        {
2540        if ( inside_type_declare ) break;
2541        curvar = createvar($3,$6);
2542        CreateAndFillin_Curvar("", curvar);
2543        curlistvar = insertvar($1, curvar);
2544        $$ = curlistvar;
2545        strcpy(vallengspec,"");
2546        }
2547     ;
2548
2549
2550/* R548 : parameter-stmt */
2551parameter-stmt: TOK_PARAMETER { VariableIsParameter = 1; pos_curparameter = setposcur()-9; } '(' named-constant-def-list ')'
2552        {
2553            if ( ! inside_type_declare )
2554            {
2555                if ( firstpass )
2556                {
2557                    if ( insubroutinedeclare )  Add_Parameter_Var_1($4);
2558                    else                        Add_GlobalParameter_Var_1($4);
2559                }
2560                else
2561                {
2562                    pos_end = setposcur();
2563                    RemoveWordSET_0(fortran_out, pos_curparameter, pos_end-pos_curparameter);
2564                }
2565            }
2566            VariableIsParameter =  0 ;
2567        }
2568        line-break
2569     ;
2570
2571named-constant-def-list: named-constant-def
2572     {$$=insertvar(NULL,$1);}
2573     | named-constant-def-list ',' named-constant-def
2574     {$$=insertvar($1,$3);}
2575     ;
2576
2577/* R549 : named-constant-def */
2578named-constant-def: TOK_NAME '=' constant-expr
2579        {
2580            if ( inside_type_declare ) break;
2581            curvar=(variable *) calloc(1,sizeof(variable));
2582            Init_Variable(curvar);
2583            curvar->v_VariableIsParameter = 1;
2584            strcpy(curvar->v_nomvar,$1);
2585            strcpy(curvar->v_subroutinename,subroutinename);
2586            strcpy(curvar->v_modulename,curmodulename);
2587            curvar->v_initialvalue=Insertname(curvar->v_initialvalue,$3,0);
2588            strcpy(curvar->v_commoninfile,cur_filename);
2589            Save_Length($3,14);
2590            $$ = curvar;
2591        }
2592     ;
2593
2594/* R553 : save-stmt */
2595save-stmt: {pos_cursave = my_position_before;} TOK_SAVE opt-TOK_FOURDOTS opt-saved-entity-list
2596     {
2597     pos_end = setposcur();
2598     RemoveWordSET_0(fortran_out,pos_cursave,pos_end-pos_cursave);
2599     }
2600     line-break
2601     ;
2602
2603opt-TOK_FOURDOTS:
2604     | TOK_FOURDOTS
2605     ;
2606
2607opt-saved-entity-list:
2608     | saved-entity-list
2609     ;
2610
2611saved-entity-list: saved-entity
2612     | saved-entity-list ',' saved-entity
2613     ;
2614
2615/* R554 : saved-entity */
2616saved-entity: object-name
2617     {if ( ! inside_type_declare ) Add_Save_Var_1($1,(listdim*) NULL); }
2618     | proc-pointer-name
2619     | common-block-name
2620     ;
2621
2622/* R555 : proc-pointer-name */
2623proc-pointer-name: ident
2624     ;
2625
2626get_my_position:
2627     {my_position = my_position_before;}
2628     ;
2629
2630/* R560 : implicit-stmt */
2631implicit-stmt: get_my_position TOK_IMPLICIT implicit-spec-list line-break
2632    | get_my_position TOK_IMPLICIT TOK_NONE
2633        {
2634            if ( insubroutinedeclare == 1 )
2635            {
2636                Add_ImplicitNoneSubroutine_1();
2637                pos_end = setposcur();
2638                RemoveWordSET_0(fortran_out,my_position,pos_end-my_position);
2639            }
2640        }
2641    line-break
2642    ;
2643
2644implicit-spec-list: implicit-spec
2645     | implicit-spec-list ',' implicit-spec
2646     ;
2647
2648/*R561 implicit-spec */
2649implicit-spec: declaration-type-spec '(' letter-spec-list ')'
2650    ;
2651
2652letter-spec-list:letter-spec
2653     | letter-spec-list ',' letter-spec
2654     ;
2655     
2656/* R562 : letter-spec */
2657letter-spec: TOK_NAME
2658     | TOK_NAME '-' TOK_NAME
2659     ;
2660
2661/* R563 : namelist-stmt */
2662namelist-stmt: TOK_NAMELIST TOK_SLASH TOK_NAME TOK_SLASH namelist-group-object-list opt-namelist-other line-break
2663     ;
2664
2665opt-namelist-other:
2666     | opt-namelist-other opt-comma TOK_SLASH TOK_NAME TOK_SLASH namelist-group-object-list
2667
2668namelist-group-object-list:namelist-group-object
2669     | namelist-group-object-list ',' namelist-group-object
2670     ;
2671
2672/* R564 : namelist-group-object */
2673namelist-group-object: variable-name
2674    ;
2675
2676/* R565 : equivalence-stmt */
2677equivalence-stmt:  TOK_EQUIVALENCE equivalence-set-list line-break
2678     ;
2679
2680equivalence-set-list:equivalence-set
2681     | equivalence-set-list ',' equivalence-set
2682     ;
2683
2684/* R566 : equivalence-set */
2685equivalence-set: '(' {in_complex_literal=0;} equivalence-object ',' equivalence-object-list ')'
2686     ;
2687
2688equivalence-object-list:equivalence-object
2689     | equivalence-object-list ',' equivalence-object
2690     ;
2691
2692/* R567 : equivalence-object */     
2693equivalence-object: variable-name
2694     | array-element
2695     | substring
2696     ;
2697
2698
2699/* R568 : common-stmt */
2700common-stmt: TOK_COMMON { positioninblock = 0; pos_curcommon = my_position_before; indeclaration=1;} opt-common-block-name common-block-object-list opt-common-block-list
2701     {
2702            indeclaration = 0;
2703            if ( inside_type_declare ) break;
2704            pos_end = setposcur();
2705            RemoveWordSET_0(fortran_out,pos_curcommon,pos_end-pos_curcommon);
2706     }
2707     line-break
2708     ;
2709
2710opt-common-block-name:
2711     | common-block-name
2712     {
2713     if ( inside_type_declare ) break;
2714     sprintf(charusemodule,"%s",$1);
2715     Add_NameOfCommon_1($1,subroutinename);
2716     }
2717     ;
2718     
2719common-block-name:TOK_DSLASH
2720        {
2721            strcpy($$,"");
2722            positioninblock=0;
2723            strcpy(commonblockname,"");
2724        }
2725     | TOK_SLASH TOK_NAME TOK_SLASH
2726        {
2727            strcpy($$,$2);
2728            positioninblock=0;
2729            strcpy(commonblockname,$2);
2730        }
2731      ;
2732
2733opt-comma:
2734     | ','
2735     ;
2736
2737opt-common-block-list:
2738     | opt-common-block-list opt-comma common-block-name
2739     {
2740     if ( inside_type_declare ) break;
2741     sprintf(charusemodule,"%s",$3);
2742     Add_NameOfCommon_1($3,subroutinename);
2743     }
2744     common-block-object-list
2745     ;
2746
2747
2748common-block-object-list: common-block-object
2749     {if ( ! inside_type_declare ) Add_Common_var_1(); }
2750     | common-block-object-list ',' common-block-object
2751     {if ( ! inside_type_declare ) Add_Common_var_1(); }
2752     ;
2753 
2754/* R569 : common-block-object */
2755/* variable-name replaced by TOK_NAME */
2756/* because the corresponding variable do not have to be added to the listofsubroutine_used */
2757
2758common-block-object: TOK_NAME
2759        {
2760            positioninblock = positioninblock + 1 ;
2761            strcpy(commonvar,$1);
2762            commondim = (listdim*) NULL;
2763        }
2764     | TOK_NAME '(' {in_complex_literal=0;} array-spec ')'
2765        {
2766            positioninblock = positioninblock + 1 ;
2767            strcpy(commonvar,$1);
2768            commondim = $4;
2769        }
2770     ;
2771
2772/* R601 : designator */
2773designator: array-element
2774     | array-section
2775     | structure-component
2776     | substring
2777     {$$=createvar($1,NULL);}
2778     ;
2779/* R602 : variable */
2780/*variable: designator
2781       | expr
2782       ;
2783*/
2784
2785scalar-variable: variable
2786     ;
2787     
2788variable: designator
2789       {if (strcmp(my_dim.last,""))
2790       {
2791       $$->v_initialvalue_array=Insertname(NULL,my_dim.last,0);
2792       }
2793       strcpy(my_dim.last,"");
2794       }
2795       ;
2796       
2797scalar-variable-name: variable-name
2798     ;
2799
2800/* R603 : variable-name */
2801variable-name: ident
2802      ;
2803
2804scalar-logical-variable: logical-variable
2805      ;
2806
2807/* R604 : logical-variable */
2808logical-variable: variable
2809      ;
2810
2811/* R605 : char-variable */
2812char-variable: variable
2813       ;
2814
2815scalar-default-char-variable: default-char-variable
2816     ;
2817     
2818/* R606 : default-char-variable */
2819default-char-variable: variable
2820     ;
2821
2822scalar-int-variable: int-variable
2823      ;
2824     
2825int-variable: variable
2826     ;
2827
2828/* R608 : substring */
2829substring: data-ref
2830     | data-ref '(' substring-range ')'
2831     {sprintf($$,"%s(%s)",$1,$3);}
2832     | char-literal-constant '(' substring-range ')'
2833     {sprintf($$,"%s(%s)",$1,$3);}
2834     ;
2835
2836/* R609 : parent-string */
2837/* IS INLINED IN SUBSTRING (R608) */
2838/*
2839parent-string: scalar-variable-name
2840     | array-element
2841     | scalar-structure-component
2842     | scalar-constant
2843     ;
2844*/
2845
2846/* R610 : substring-range */
2847substring-range: opt-scalar-int-expr ':' opt-scalar-int-expr
2848     {sprintf($$,"%s:%s",$1,$3);}
2849     ;
2850
2851/* R611: data-ref */
2852data-ref: part-ref opt-part-ref
2853     {sprintf($$,"%s%s",$1->v_nomvar,$2);}
2854     ;
2855     
2856opt-part-ref:
2857     {strcpy($$,"");}
2858     | opt-part-ref '%' part-ref
2859     {sprintf($$,"%s%%%s",$1,$3->v_nomvar);}
2860     ;
2861
2862/* R612 : part-ref */
2863part-ref:ident
2864     {$$=createvar($1,NULL);}
2865     | ident '(' {in_complex_literal=0;} section-subscript-list ')'
2866     {sprintf(ligne,"%s(%s)",$1,$4);$$=createvar($1,NULL);strcpy(my_dim.last,$4);}
2867     ;
2868     
2869/* $$=createvar($1,insertdim(NULL,my_dim));
2870{strcpy(my_dim.first,"1");strcpy(my_dim.last,$4);$$=createvar($1,insertdim(NULL,my_dim));}
2871} */
2872
2873/*part-name: ident
2874     ;
2875*/
2876
2877scalar-structure-component: structure-component
2878     ;
2879
2880/* R613 : structure-component */
2881structure-component: data-ref
2882     {strcpy(my_dim.last,"");}
2883     ;
2884
2885/* R617 : array-element */
2886array-element: data-ref
2887      {strcpy(my_dim.last,"");}
2888      ;
2889
2890/* R618 : array-section */
2891array-section: data-ref
2892     {strcpy(my_dim.last,"");}
2893     | data-ref '(' substring-range ')'
2894     {strcpy(my_dim.last,"");}
2895      ;
2896
2897/* section-subscript-list can be empty ... */
2898/* in contradiction with the grammar ... */
2899section-subscript-list:
2900      {strcpy($$,"");}
2901      |  section-subscript
2902      {strcpy($$,$1);}
2903      | section-subscript-list ',' section-subscript
2904      {sprintf($$,"%s,%s",$1,$3);}
2905      ;
2906
2907opt-subscript:
2908     {strcpy($$,"");}
2909     | subscript
2910     ;
2911
2912/* R619 : subscript */
2913subscript: scalar-int-expr
2914     ;
2915
2916/* R620 : section-subscript */
2917/*section-subscript: subscript
2918     | subscript-triplet
2919     | vector-subscript
2920     ;
2921*/
2922
2923/* USE OpenFortranParser rules */
2924
2925section-subscript: expr section_subscript_ambiguous
2926     {sprintf($$,"%s%s",$1,$2);}
2927     | ':'
2928     {strcpy($$,":");}
2929     | ':' expr
2930     {sprintf($$,":%s",$2);}
2931     | ':' ':' expr
2932     {sprintf($$,": :%s",$3);}
2933     | ':' expr ':' expr
2934     {sprintf($$,":%s :%s",$2,$4);}
2935     | TOK_FOURDOTS expr
2936     {sprintf($$,"::%s",$2);}
2937     | vector-subscript
2938     | ident '=' expr
2939     {sprintf($$,"%s=%s",$1,$3);}
2940     | ident '=' '*' label
2941     {sprintf($$,"%s=*%s",$1,$4);}
2942     | '*' label
2943     {sprintf($$,"*%s",$2);}
2944     ;
2945
2946section_subscript_ambiguous: ':'
2947     {strcpy($$,":");}
2948     | ':' expr
2949     {sprintf($$,":%s",$2);}
2950     | ':' ':' expr
2951     {sprintf($$,": :%s",$3);}
2952     | ':' expr ':' expr
2953     {sprintf($$,":%s :%s",$2,$4);}
2954     | TOK_FOURDOTS expr
2955     {sprintf($$,"::%s",$2);}
2956     |
2957     {strcpy($$,"");}
2958     ;
2959/* R621 : subscript-triplet */
2960subscript-triplet: opt-subscript ':' opt-subscript
2961     {sprintf($$,"%s:%s",$1,$3);}
2962     | opt-subscript ':' opt-subscript ':' stride
2963     {sprintf($$,"%s:%s:%s",$1,$3,$5);}
2964     ;
2965
2966/* R622 : stride */
2967stride: scalar-int-expr
2968     ;
2969     
2970/* R623 : vector-subscript */
2971vector-subscript: int-expr
2972     ;
2973
2974/* R626 : allocate-stmt */
2975allocate-stmt: TOK_ALLOCATE '(' {in_complex_literal=0;} allocation-list opt-alloc-opt-list-comma ')'
2976     {inallocate = 0;}
2977     line-break
2978     ;
2979
2980opt-type-spec-fourdots:
2981     | type-spec TOK_FOURDOTS
2982     ;
2983
2984opt-alloc-opt-list-comma:
2985     | ',' alloc-opt-list
2986     ;
2987
2988alloc-opt-list:
2989        alloc-opt
2990      | alloc-opt-list ',' alloc-opt
2991      ;
2992     
2993/* R627 : alloc-opt */
2994alloc-opt: TOK_ERRMSG errmsg-variable
2995     | TOK_STAT '=' stat-variable
2996     ;
2997     
2998/* R628 : stat-variable */
2999stat-variable: scalar-int-variable
3000     ;
3001     
3002/* R629 : errmsg-variable */
3003errmsg-variable: scalar-default-char-variable
3004    ;
3005
3006allocation-list:
3007        allocation
3008      | allocation-list ',' allocation
3009      ;
3010 
3011/* R631 allocation */
3012allocation: allocate-object opt-allocate-shape-spec-list-par
3013     ;
3014
3015/* R632 allocate-object */     
3016allocate-object: variable-name
3017     | structure-component
3018     ;
3019
3020opt-allocate-shape-spec-list-par:
3021     | '(' allocate-shape-spec-list ')'
3022     ;
3023
3024allocate-shape-spec-list:
3025        allocate-shape-spec
3026      | allocate-shape-spec-list ',' allocate-shape-spec
3027      ;
3028
3029/* R633 : allocate-shape-spec */
3030allocate-shape-spec: opt-lower-bound-expr upper-bound-expr
3031     ;
3032
3033opt-lower-bound-expr:
3034     | lower-bound-expr ':'
3035     ;
3036
3037/* R634 : lower-bound-expr */
3038lower-bound-expr: scalar-int-expr
3039     ;
3040
3041/* R634 : upper-bound-expr */
3042upper-bound-expr: scalar-int-expr
3043     ;
3044     
3045/* R640 : deallocate-stmt */
3046deallocate-stmt: TOK_DEALLOCATE '(' {in_complex_literal=0;} allocate-object-list opt-dealloc-opt-list-comma ')'
3047     {inallocate = 0;}
3048     line-break
3049     ;
3050
3051allocate-object-list:
3052        allocate-object
3053      | allocate-object-list ',' allocate-object
3054      ;
3055     
3056opt-dealloc-opt-list-comma:
3057     | ',' dealloc-opt-list
3058     ;
3059
3060dealloc-opt-list:
3061        dealloc-opt
3062      | dealloc-opt-list ',' dealloc-opt
3063      ;
3064     
3065/* R641 : dealloc-opt */
3066dealloc-opt: TOK_ERRMSG errmsg-variable
3067     | TOK_STAT '=' stat-variable
3068     ;
3069
3070/* R701 : primary */
3071/* remove type-param-name */
3072/* constant replaced by literal-constant to avoid conflict with designato */
3073/* real-part is added because potential conflicts with complex-literal-constant */
3074
3075primary: 
3076      designator
3077      {
3078      strcpy($$,$1->v_nomvar);
3079      if (strcasecmp(my_dim.last,""))
3080      {
3081      strcat($$,"(");
3082      strcat($$,my_dim.last);
3083      strcat($$,")");
3084      }
3085      }
3086      | literal-constant
3087      | array-constructor
3088      | function-reference
3089      | '(' expr ')'
3090     { sprintf($$,"(%s)",$2);}
3091     ;
3092
3093/* R702 : level-1-expr */
3094level-1-expr: primary
3095      {strcpy(my_dim.last,"");}
3096     ;
3097
3098/* R704 : mult-operand */
3099mult-operand: level-1-expr
3100     | level-1-expr power-op mult-operand
3101     {sprintf($$,"%s**%s",$1,$3);}
3102     ;
3103/* R705 : add-operand */
3104add-operand: mult-operand
3105     | add-operand mult-op mult-operand
3106     { sprintf($$,"%s%s%s",$1,$2,$3); }
3107     ;
3108     
3109/* R706 : level-2-expr */
3110/* add signed-int-literal-constant because potential reduce conflict with add-op add-operand */
3111
3112level-2-expr: add-operand
3113     | add-op add-operand
3114     { sprintf($$,"%s%s",$1,$2); }
3115     | level-2-expr add-op add-operand
3116     { sprintf($$,"%s%s%s",$1,$2,$3); }
3117     | signed-int-literal-constant
3118     | level-2-expr signed-int-literal-constant
3119     { sprintf($$,"%s%s",$1,$2); }
3120     ;
3121     
3122/* R707 : power-op */
3123power-op : TOK_DASTER
3124     ;
3125     
3126/* R708 : mult-op */
3127mult-op : '*'
3128     {strcpy($$,"*");}
3129     | TOK_SLASH
3130     ;
3131     
3132/* R709 : add-op */
3133add-op : '+'
3134     {strcpy($$,"+");}
3135     | '-'
3136     {strcpy($$,"-");}     
3137     ;     
3138
3139/* R710 : level-3-expr */
3140level-3-expr: level-2-expr
3141     | level-3-expr concat-op level-2-expr
3142     { sprintf($$,"%s%s%s",$1,$2,$3); }
3143     ;
3144
3145/* R711 : concat-op */
3146concat-op : TOK_DSLASH
3147     ;
3148/* R712 : level-4-expr */
3149level-4-expr: level-3-expr
3150     | level-3-expr rel-op level-3-expr
3151     { sprintf($$,"%s%s%s",$1,$2,$3); }
3152     ;
3153
3154/* R713 : rel-op */
3155rel-op : TOK_EQ
3156     | TOK_NE
3157     | TOK_LT
3158     | TOK_LE
3159     | TOK_GT
3160     | TOK_GE
3161     | TOK_EQUALEQUAL
3162     | TOK_SLASHEQUAL
3163     | '<'
3164     {strcpy($$,"<");}
3165     | TOK_INFEQUAL
3166     | '>'
3167     {strcpy($$,">");}
3168     | TOK_SUPEQUAL
3169     ;
3170
3171/* R714 : and-operand */
3172/* level-4-expr inlined as level-3-expr */
3173and-operand: level-4-expr
3174     | not-op level-4-expr
3175     { sprintf($$,"%s%s",$1,$2); }
3176     ;
3177
3178
3179/* R715 : or-operand */
3180or-operand: and-operand
3181     | or-operand and-op and-operand
3182     { sprintf($$,"%s%s%s",$1,$2,$3); }
3183     ;
3184
3185
3186/* R716 : equiv-operand */
3187equiv-operand : or-operand
3188     | equiv-operand or-op or-operand
3189     { sprintf($$,"%s%s%s",$1,$2,$3); }
3190     ;
3191
3192/* R717 : level-5-expr */
3193level-5-expr: equiv-operand
3194     | level-5-expr equiv-op equiv-operand
3195     { sprintf($$,"%s%s%s",$1,$2,$3); }
3196     ;
3197
3198/* R718 : not-op */
3199not-op: TOK_NOT
3200     ;
3201     
3202/* R719 : and-op */
3203and-op: TOK_AND
3204     ;
3205     
3206/* R720 : or-op */
3207or-op: TOK_OR
3208     ;
3209
3210/* R721 : equiv-op */
3211equiv-op: TOK_EQV
3212     | TOK_NEQV
3213     ;
3214     
3215/* R722 : expr */
3216expr: level-5-expr
3217     ;
3218
3219scalar-default-char-expr: default-char-expr
3220     ;
3221
3222/* R725 : default-char-expr */
3223default-char-expr : expr
3224       ;
3225
3226/* R726 : int-expr */
3227int-expr: expr
3228       ;
3229
3230opt-scalar-int-expr:
3231     {strcpy($$,"");}
3232     | scalar-int-expr
3233     ;
3234
3235scalar-int-expr: int-expr
3236       ;
3237
3238/* R728 : specification-expr */
3239specification-expr: scalar-int-expr
3240     {
3241     strcpy($$,$1);
3242     }
3243     ;
3244
3245/* R729 : constant-expr */
3246constant-expr: expr
3247     {strcpy($$,$1);}
3248     ;
3249
3250scalar-default-char-constant-expr: default-char-constant-expr
3251     ;
3252     
3253/* R730: default-char-constant-expr */
3254default-char-constant-expr: default-char-expr
3255     ;
3256
3257scalar-int-constant-expr: int-constant-expr
3258     ;
3259
3260/* R731 : int-constant-expr */
3261int-constant-expr: int-expr
3262     ;
3263
3264/* R732 : assignment-stmt */
3265/* cannot use opt-label due to conflicts ... */
3266
3267assignment-stmt: variable '=' expr line-break
3268      | label variable '=' expr line-break
3269      ;
3270
3271/* R733 : pointer-assignment-stmt */
3272
3273/* data-pointer-object and proc-pointer-object replaced by designator */
3274/*pointer-assignment-stmt: data-pointer-object opt-bounds-spec-list-par TOK_POINT_TO data-target line-break
3275     | data-pointer-object '(' bounds-remapping-list ')' TOK_POINT_TO data-target line-break
3276     | proc-pointer-object TOK_POINT_TO proc-target line-break
3277     ;
3278*/
3279
3280pointer-assignment-stmt: designator opt-bounds-spec-list-par TOK_POINT_TO data-target line-break
3281     | designator '(' bounds-remapping-list ')' TOK_POINT_TO data-target line-break
3282     | designator TOK_POINT_TO proc-target line-break
3283     ;
3284     
3285/* R734 : data-pointer-object */
3286data-pointer-object: variable-name
3287     | scalar-variable '%' TOK_NAME
3288     ;
3289
3290opt-bounds-spec-list-par:
3291     | '(' bounds-spec-list ')'
3292     ;
3293
3294bounds-spec-list:
3295        bounds-spec
3296      | bounds-spec-list ',' bounds-spec
3297      ;
3298
3299bounds-remapping-list:
3300        bounds-remapping
3301      | bounds-remapping-list ',' bounds-remapping
3302      ;
3303     
3304/* R735 : bounds-spec */
3305bounds-spec: lower-bound-expr ':'
3306     ;
3307
3308/* R736 : bounds-remapping */
3309bounds-remapping: lower-bound-expr ':' upper-bound-expr
3310     ;
3311     
3312/* R737 : data-target */
3313data-target: variable
3314     ;
3315
3316procedure-component-name: TOK_NAME
3317     ;
3318
3319/* R738 : proc-pointer-object */
3320proc-pointer-object: proc-pointer-name
3321     | proc-component-ref
3322     ;
3323
3324/* R739 : proc-component-ref */
3325proc-component-ref : scalar-variable '%' procedure-component-name
3326     ;
3327     
3328/* R740 : proc-target */
3329proc-target: expr
3330     | procedure-component-name
3331     | proc-component-ref
3332     ;
3333
3334/* R741 : where-stmt */
3335where-stmt: TOK_WHERE '(' mask-expr ')' where-assignment-stmt
3336      ;
3337
3338/* R742 : where-construct */
3339where-construct: where-construct-stmt opt-where-body-construct opt-masked-elsewhere-construct opt-elsewhere-construct end-where-stmt
3340      ;
3341
3342opt-where-body-construct:
3343      | opt-where-body-construct where-body-construct
3344      ;
3345
3346opt-masked-elsewhere-construct :
3347      | opt-masked-elsewhere-construct masked-elsewhere-stmt opt-where-body-construct
3348      ;
3349
3350opt-elsewhere-construct:
3351      | opt-elsewhere-construct elsewhere-stmt opt-where-body-construct
3352      ;
3353
3354/* R743 : where-construct-stmt */
3355where-construct-stmt: TOK_WHERE '(' mask-expr ')' line-break
3356      ;
3357
3358/* R744 : where-body-construct */
3359where-body-construct: where-assignment-stmt
3360      | where-stmt
3361      | where-construct
3362      ;
3363
3364/* R745 : where-assignment-stmt */
3365where-assignment-stmt: assignment-stmt
3366      ;
3367
3368/* R746 : mask-expr */
3369mask-expr: expr
3370      ;
3371
3372/* R747 : masked-elsewhere-stmt */
3373masked-elsewhere-stmt: TOK_ELSEWHEREPAR mask-expr ')' line-break
3374      | TOK_ELSEWHEREPAR mask-expr ')' TOK_NAME line-break
3375      ;
3376
3377/* R748: elsewhere-stmt */
3378elsewhere-stmt: TOK_ELSEWHERE line-break
3379      | TOK_ELSEWHERE TOK_NAME line-break
3380      ;
3381
3382/* R749: end-where-stmt */
3383end-where-stmt:
3384        TOK_ENDWHERE line-break
3385      | TOK_ENDWHERE TOK_NAME line-break
3386      ;
3387
3388/* R752 : forall-header */
3389forall-header :
3390     ;
3391
3392/* R801 : block */
3393block: opt-execution-part-construct
3394      ;
3395
3396opt-execution-part-construct:
3397      | opt-execution-part-construct execution-part-construct
3398      ;
3399
3400/* R813 : do-construct */
3401do-construct:
3402        block-do-construct
3403      | nonblock-do-construct
3404      ;
3405
3406do-construct:
3407        block-do-construct
3408      ;
3409     
3410/* R814 : block-do-construct */
3411
3412block-do-construct: label-do-stmt do-block end-do
3413      | nonlabel-do-stmt do-block end-do
3414      ;
3415
3416/* R815 : do-stmt */
3417/*do-stmt:
3418        label-do-stmt
3419      | nonlabel-do-stmt
3420      ;
3421*/
3422
3423/* R816 : label-do-stmt */
3424label-do-stmt: TOK_NAME ':' TOK_PLAINDO_LABEL line-break
3425      |              TOK_PLAINDO_LABEL line-break
3426      | TOK_NAME ':' TOK_PLAINDO_LABEL loop-control line-break
3427      |              TOK_PLAINDO_LABEL loop-control line-break
3428      ;
3429     
3430label-do-stmt-djview: TOK_NAME ':' TOK_PLAINDO_LABEL_DJVIEW line-break
3431      |              TOK_PLAINDO_LABEL_DJVIEW line-break
3432      | TOK_NAME ':' TOK_PLAINDO_LABEL_DJVIEW loop-control line-break
3433      |              TOK_PLAINDO_LABEL_DJVIEW loop-control line-break
3434      ;
3435     
3436/* R817 : nonlabel-do-stmt */
3437nonlabel-do-stmt: TOK_NAME ':' TOK_PLAINDO line-break
3438      |              TOK_PLAINDO line-break
3439      | TOK_NAME ':' TOK_PLAINDO loop-control line-break
3440      |              TOK_PLAINDO loop-control line-break
3441      ;
3442
3443/* R818 : loop-control */
3444loop-control:
3445        opt_comma do-variable '=' expr ',' expr
3446      | opt_comma do-variable '=' expr ',' expr ',' expr
3447      | opt_comma TOK_WHILE '(' expr ')'
3448      | opt_comma TOK_CONCURRENT forall-header
3449      ;
3450
3451/* R819 : do-variable */
3452do-variable: ident
3453     ;
3454
3455/* R820 : do-block */
3456do-block: block
3457     ;
3458
3459/* R821 : end-do */
3460/*end-do: end-do-stmt
3461     | do-term-action-stmt
3462     ;
3463*/
3464
3465end-do: end-do-stmt
3466     | label-djview continue-stmt
3467     ;
3468
3469/* R822 : end-do-stmt */
3470end-do-stmt: opt-label-djview TOK_ENDDO line-break
3471      | opt-label-djview TOK_ENDDO TOK_NAME line-break
3472      ;
3473
3474/* R823 : nonblock-do-construct */
3475/* only outer-shared-do-construct is used */
3476
3477/*
3478nonblock-do-construct: outer-shared-do-construct
3479      ;
3480*/
3481
3482nonblock-do-construct: action-term-do-construct
3483      | outer-shared-do-construct
3484      ;
3485
3486
3487/* R824 : action-term-do-construct */
3488
3489action-term-do-construct: label-do-stmt do-block do-term-action-stmt
3490      ;
3491     
3492/* R825 : do-body */
3493
3494do-body :
3495      | execution-part-construct do-body
3496      ;
3497
3498/* R826 : do-term-action-stmt */
3499do-term-action-stmt:  label-djview do-term-action-stmt-special
3500      ;
3501
3502/* do-term-action-stmt-special */
3503do-term-action-stmt-special:
3504      allocate-stmt
3505      | assignment-stmt
3506      | call-stmt
3507      | close-stmt
3508      | deallocate-stmt
3509      | flush-stmt
3510      | goto-stmt
3511      | TOK_REWIND after_rewind
3512      | TOK_NULLIFY '(' pointer_name_list ')'
3513      | if-stmt
3514      | inquire-stmt
3515      | open-stmt
3516      | print-stmt
3517      | read-stmt
3518      | rewind-stmt
3519      | where-stmt
3520      | write-stmt
3521      ;
3522
3523
3524/* R827 : outer-shared-do-construct */
3525/* do-body is same as do-block
3526we extend the definition of outer-shared-do-construct
3527a label-do-stmt statement must be followed by a label-do-stmt-djview statement
3528*/
3529
3530outer-shared-do-construct : label-do-stmt do-block label-do-stmt-djview-do-block-list inner-shared-do-construct
3531       | label-do-stmt do-block inner-shared-do-construct
3532       ;
3533
3534label-do-stmt-djview-do-block-list: label-do-stmt-djview do-block
3535       | label-do-stmt-djview-do-block-list label-do-stmt-djview do-block
3536       ;
3537
3538/* R828 : shared-term-do-construct */
3539
3540shared-term-do-construct: outer-shared-do-construct
3541      | inner-shared-do-construct
3542      ;
3543   
3544/* R829 : inner-shared-do-construct */
3545/* do-body is same as do-block */
3546inner-shared-do-construct: label-do-stmt-djview do-block do-term-shared-stmt
3547      ;
3548     
3549/* R830 : do-term-shared-stmt */
3550
3551do-term-shared-stmt: label-djview action-stmt
3552      ;
3553
3554opt-do-construct-name:
3555     | TOK_NAME
3556     ;
3557
3558/* R831 : cycle-stmt */
3559cycle-stmt: TOK_CYCLE opt-do-construct-name line-break
3560     ;
3561
3562/* R832 : if-construct */
3563if-construct: if-then-stmt block opt-else-if-stmt-block opt-else-stmt-block end-if-stmt
3564      ;
3565 
3566opt-else-if-stmt-block: 
3567      | else-if-stmt-block
3568      | opt-else-if-stmt-block else-if-stmt-block
3569      ;
3570
3571else-if-stmt-block: else-if-stmt block
3572      ;
3573
3574opt-else-stmt-block: 
3575      | else-stmt-block
3576      | opt-else-stmt-block else-if-stmt-block
3577      ;
3578
3579else-stmt-block: else-stmt block
3580        ;
3581
3582/* R833 : if-then-stmt */
3583if-then-stmt: TOK_NAME ':' TOK_LOGICALIF_PAR expr ')' TOK_THEN line-break
3584      | label TOK_NAME ':' TOK_LOGICALIF_PAR expr ')' TOK_THEN line-break
3585      | opt-label TOK_LOGICALIF_PAR expr ')' TOK_THEN line-break
3586      ;
3587
3588/* R834 : else-if-stmt */
3589else-if-stmt:TOK_ELSEIF '(' expr ')' TOK_THEN line-break
3590      | TOK_ELSEIF '(' expr ')' TOK_THEN TOK_NAME line-break
3591      ;
3592
3593/* R835 : else-stmt */
3594else-stmt:TOK_ELSE line-break
3595      | TOK_ELSE TOK_NAME line-break
3596      ;
3597
3598/* R836 : end-if-stmt */
3599end-if-stmt:TOK_ENDIF line-break
3600      | TOK_ENDIF TOK_NAME line-break
3601      ;
3602
3603/* R837 : if-stmt */
3604if-stmt: opt-label TOK_LOGICALIF_PAR expr ')' action-stmt
3605        ;
3606
3607/* R838 : case-construct */
3608case-construct: select-case-stmt opt_case-stmt-block end-select-stmt
3609        ;
3610
3611opt_case-stmt-block:
3612        | case-stmt-block
3613        | opt_case-stmt-block case-stmt-block
3614        ;
3615
3616case-stmt-block: case-stmt block
3617        ;
3618
3619/* R839 : select-case-stmt */
3620select-case-stmt :TOK_NAME ':' TOK_SELECTCASE '(' expr ')' {in_select_case_stmt++;} line-break
3621        |              TOK_SELECTCASE '(' expr ')' {in_select_case_stmt++;} line-break
3622        ;
3623
3624/* R840 : case-stmt */
3625case-stmt:TOK_CASE case-selector line-break
3626        | TOK_CASE case-selector TOK_NAME line-break
3627        ;
3628
3629/* R840 : end-select-stmt */
3630end-select-stmt: TOK_ENDSELECT {in_select_case_stmt--;} line-break
3631        | TOK_ENDSELECT TOK_NAME {in_select_case_stmt--;} line-break
3632        ;
3633
3634/* R843 : case-selector */
3635case-selector:
3636          '(' {in_complex_literal=0;} case-value-range-list ')'
3637        | TOK_DEFAULT
3638        ;
3639
3640case-value-range-list:
3641        case-value-range
3642      | case-value-range-list ',' case-value-range
3643      ;
3644
3645/* R844: case-value-range */
3646case-value-range :
3647        case-value
3648      | case-value ':'
3649      | ':' case-value
3650      | case-value ':' case-value
3651      ;
3652
3653/* R845 : case-value */
3654case-value: expr
3655        ;
3656
3657/* R850 : exit-stmt */
3658exit-stmt: TOK_EXIT line-break
3659       | TOK_EXIT TOK_NAME line-break
3660       ;
3661
3662/* R851 : goto-stmt */
3663goto-stmt: TOK_PLAINGOTO label line-break
3664     ;
3665
3666/* R853 arithmetic-if-stmt */
3667arithmetic-if-stmt: opt-label TOK_LOGICALIF_PAR expr ')' label ',' label ',' label line-break
3668     ;
3669
3670/* R854 : continue-stmt */
3671continue-stmt: opt-label TOK_CONTINUE line-break
3672        ;
3673
3674/* R855 : stop-stmt */
3675stop-stmt: TOK_STOP line-break
3676     | TOK_STOP stop-code line-break
3677     ;
3678
3679/* R857 : stop-code */
3680stop-code: scalar-default-char-constant-expr
3681    | scalar-int-constant-expr
3682    ;
3683
3684/* R901 : io-unit */
3685io-unit : file-unit-number
3686        | '*'
3687        | internal-file-variable
3688        ;
3689
3690/* R902 : file-unit-number */
3691file-unit-number : scalar-int-expr
3692        ;
3693
3694/* R902 : internal-file-variable */
3695internal-file-variable : char-variable
3696        ;
3697
3698/* R904 : open-stmt */
3699open-stmt: TOK_OPEN '(' {close_or_connect = 1;} connect-spec-list ')' {close_or_connect = 0;} line-break
3700        ;
3701
3702connect-spec-list: connect-spec
3703         | connect-spec-list ',' connect-spec
3704         ;
3705
3706/* R905 : connect-spec */
3707connect-spec: file-unit-number
3708      | TOK_UNIT file-unit-number
3709      | TOK_ACCESS scalar-default-char-expr
3710      | TOK_ACTION scalar-default-char-expr
3711      | TOK_ERR label
3712      | TOK_FILE file-name-expr
3713      | TOK_FORM scalar-default-char-expr
3714      | TOK_IOSTAT scalar-int-variable
3715      | TOK_POSITION scalar-default-char-expr
3716      | TOK_RECL scalar-int-expr
3717      | TOK_STATUS '=' scalar-default-char-expr
3718      ;
3719
3720/* R906 : file-name-expr */
3721file-name-expr: scalar-default-char-expr
3722     ;
3723
3724/* R907 : iomsg-variable */
3725iomsg-variable: scalar-default-char-variable
3726     ;
3727
3728/* R908 : close-stmt */
3729close-stmt: opt-label TOK_CLOSE '(' {close_or_connect = 1;} close-spec-list ')' line-break
3730        {close_or_connect = 0;}
3731        ;
3732
3733close-spec-list: close-spec
3734         | close-spec-list ',' close-spec
3735         ;
3736
3737/* R909 : close-spec */
3738close-spec: file-unit-number
3739       | TOK_UNIT file-unit-number
3740       | TOK_IOSTAT scalar-int-variable
3741       | TOK_ERR label
3742       | TOK_STATUS '=' scalar-default-char-expr
3743       ;
3744
3745/* R910 : read-stmt */
3746read-stmt: opt-label TOK_READ_PAR io-control-spec-list ')'
3747         {
3748         in_io_control_spec = 0;
3749         }
3750         line-break
3751        | opt-label TOK_READ_PAR io-control-spec-list ')' input-item-list
3752         {
3753         in_io_control_spec = 0;
3754         }
3755         line-break
3756        | opt-label TOK_READ format line-break
3757        | opt-label TOK_READ format ',' input-item-list line-break
3758        ;
3759       
3760/* R911 : write-stmt */
3761write-stmt: opt-label TOK_WRITE_PAR io-control-spec-list ')'
3762         {
3763         in_io_control_spec = 0;
3764         }
3765         line-break
3766        | opt-label TOK_WRITE_PAR io-control-spec-list ')'  output-item-list
3767         {
3768         in_io_control_spec = 0;
3769         }
3770         line-break
3771        ;
3772
3773/* R912 : print-stmt */
3774print-stmt: opt-label TOK_PRINT format line-break
3775        | opt-label TOK_PRINT format ',' output-item-list line-break
3776        ;
3777io-control-spec-list: io-control-spec
3778         | io-control-spec-list ',' io-control-spec
3779         ;
3780
3781namelist-group-name: TOK_NAME
3782         ;
3783
3784/* R913 : io-control-spec */
3785io-control-spec: io-unit
3786         | TOK_UNIT io-unit
3787         | format
3788         | namelist-group-name
3789         | TOK_NML namelist-group-name
3790         | TOK_FMT format
3791         | TOK_END label
3792         | TOK_EOR label
3793         | TOK_ERR label
3794         | TOK_IOSTAT scalar-int-variable
3795         | TOK_REC '=' scalar-int-expr
3796        ;
3797
3798/* R915 : format */
3799format: default-char-expr
3800        | label
3801        | '*'
3802        ;
3803input-item-list:
3804         input-item
3805         | input-item-list ',' input-item
3806         ;
3807/* R916 : input-item */
3808input-item: variable
3809        | io-implied-do
3810        ;
3811
3812output-item-list:
3813         output-item
3814         | output-item-list ',' output-item
3815         ;
3816
3817/* R917 : output-item */
3818output-item: expr
3819        | io-implied-do
3820        ;
3821
3822/* R918 : io-implied-do */
3823io-implied-do : '(' io-implied-do-object-list ',' io-implied-do-control ')'
3824        ;
3825
3826io-implied-do-object-list: io-implied-do-object
3827         | io-implied-do-object-list ',' io-implied-do-object
3828         ;
3829
3830/* R919 : io-implied-do-object */
3831/* input-item removed since possible conflicts (output-item can be variable) */
3832/* io-implied-do-object : input-item
3833        | output-item
3834        ;
3835*/
3836
3837io-implied-do-object : output-item
3838        ;       
3839
3840/* R920 : io-implied-do-control */
3841io-implied-do-control: do-variable '=' scalar-int-expr ',' scalar-int-expr
3842        | do-variable '=' scalar-int-expr ',' scalar-int-expr ',' scalar-int-expr
3843        ;
3844
3845/* R926 : rewind-stmt */
3846rewind-stmt: TOK_REWIND file-unit-number line-break
3847     | TOK_REWIND '(' position-spec-list ')' line-break
3848     ;
3849
3850position-spec-list:
3851        position-spec
3852      | position-spec-list ',' position-spec
3853      ;
3854     
3855/* R927 : position-spec */
3856position-spec: file-unit-number
3857     | TOK_UNIT file-unit-number
3858     | TOK_IOMSG iomsg-variable
3859     | TOK_IOSTAT scalar-int-variable
3860     | TOK_ERR label
3861     ;
3862
3863/* R928 : flush-stmt */
3864flush-stmt: TOK_FLUSH file-unit-number line-break
3865     | TOK_FLUSH '(' flush-spec-list ')' line-break
3866     ;
3867
3868flush-spec-list:
3869        flush-spec
3870      | flush-spec-list ',' flush-spec
3871      ;
3872     
3873/* R929 : flush-spec */
3874flush-spec: file-unit-number
3875     | TOK_UNIT file-unit-number
3876     | TOK_IOSTAT scalar-int-variable
3877     | TOK_IOMSG iomsg-variable
3878     | TOK_ERR label
3879     ;
3880
3881
3882/* R930 : inquire-stmt */
3883inquire-stmt: TOK_INQUIRE set_in_inquire '(' inquire-spec-list ')'
3884     {in_inquire=0;}
3885     line-break
3886     | TOK_INQUIRE set_in_inquire '(' TOK_IOLENGTH scalar-int-variable ')' output-item-list
3887     {in_inquire=0;}
3888     line-break
3889     ;
3890
3891set_in_inquire: {in_inquire=1;} 
3892     ;
3893
3894inquire-spec-list:
3895        inquire-spec
3896      | inquire-spec-list ',' inquire-spec
3897      ;
3898     
3899/* R931 : inquire-spec */
3900inquire-spec: file-unit-number
3901     | TOK_UNIT file-unit-number
3902     | TOK_FILE file-name-expr
3903     | TOK_ACCESS scalar-default-char-variable
3904     | TOK_ACTION scalar-default-char-variable
3905     | TOK_ERR label
3906     | TOK_EXIST scalar-logical-variable
3907     | TOK_IOSTAT scalar-int-variable
3908     | TOK_NAME_EQ '=' scalar-default-char-variable
3909     | TOK_OPENED scalar-logical-variable
3910     | TOK_RECL scalar-int-variable
3911     ;
3912
3913/* R1001 : format-stmt */
3914format-stmt: TOK_LABEL_FORMAT line-break
3915        ;
3916
3917/* R1104 : module */
3918module:module-stmt opt-specification-part opt-module-subprogram-part {pos_endsubroutine=setposcur();} end-module-stmt
3919     ;
3920
3921opt-module-subprogram-part:
3922     | module-subprogram-part
3923     ;
3924
3925/* R1105 : module-stmt */
3926module-stmt : TOK_MODULE TOK_NAME
3927        {
3928            GlobalDeclaration = 0;
3929            strcpy(curmodulename,$2);
3930            strcpy(subroutinename,"");
3931            Add_NameOfModule_1($2);
3932            if ( inmoduledeclare == 0 )
3933            {
3934                /* To know if there are in the module declaration    */
3935                inmoduledeclare = 1;
3936                /* to know if a module has been met                  */
3937                inmodulemeet = 1;
3938                /* to know if we are after the keyword contains      */
3939                aftercontainsdeclare = 0 ;
3940            }
3941        }
3942        line-break
3943     ;
3944
3945/* R1106 : end-module-stmt */
3946end-module-stmt: get_my_position TOK_ENDUNIT opt-tok-module opt-ident
3947        {
3948            /* if we never meet the contains keyword               */
3949            if ( firstpass == 0 )
3950            {
3951                RemoveWordCUR_0(fortran_out, setposcur()-my_position);    // Remove word "end module"
3952                if ( inmoduledeclare && ! aftercontainsdeclare )
3953                {
3954                    Write_Closing_Module(1);
3955                }
3956                fprintf(fortran_out,"\n      end module %s\n", curmodulename);
3957                if ( module_declar && insubroutinedeclare == 0 )
3958                {
3959                    fclose(module_declar);
3960                }
3961            }
3962            inmoduledeclare = 0 ;
3963            inmodulemeet = 0 ;
3964            aftercontainsdeclare = 1;
3965            strcpy(curmodulename, "");
3966            GlobalDeclaration = 0 ;
3967        }
3968        line-break
3969     ;
3970
3971opt-tok-module:
3972     | TOK_MODULE
3973     ;
3974
3975opt-ident:
3976     | TOK_NAME
3977     ;
3978/* R1107 : module-subprogram-part */
3979module-subprogram-part:contains-stmt opt-module-subprogram-list
3980     ;
3981     
3982opt-module-subprogram-list:
3983     | module-subprogram-list
3984     ;
3985     
3986module-subprogram-list: module-subprogram
3987     | module-subprogram-list module-subprogram
3988     ;
3989
3990module-subprogram: function-subprogram
3991     | subroutine-subprogram
3992     ;
3993
3994use-stmt-list:use-stmt
3995     | use-stmt-list use-stmt
3996     ;
3997
3998save_olduse:
3999     {if (firstpass == 0 && oldfortran_out) pos_curuseold = setposcurname(oldfortran_out);}
4000     ;
4001     
4002/* R1109 use-stmt */
4003use-stmt: get_my_position TOK_USE save_olduse opt-module-nature-2points TOK_NAME opt-rename-list
4004    {
4005            if ( firstpass )
4006            {
4007                if ( insubroutinedeclare )
4008                {
4009                    if ($6) {
4010                      Add_CouplePointed_Var_1($5,$6);
4011                      coupletmp = $6;
4012                      strcpy(ligne,"");
4013                      while ( coupletmp )
4014                      {
4015                        strcat(ligne, coupletmp->c_namevar);
4016                        strcat(ligne, " => ");
4017                        strcat(ligne, coupletmp->c_namepointedvar);
4018                        coupletmp = coupletmp->suiv;
4019                        if ( coupletmp ) strcat(ligne,",");
4020                      }
4021                      }
4022                  sprintf(charusemodule,"%s",$5);
4023                }
4024                Add_NameOfModuleUsed_1($5);
4025            }
4026            else
4027            {
4028                if ( insubroutinedeclare )
4029                {
4030                  copyuse_0($5);
4031                    }
4032
4033                if ( inmoduledeclare == 0 )
4034                {
4035                    pos_end = setposcur();
4036                    RemoveWordSET_0(fortran_out,my_position,pos_end-my_position);
4037                }
4038            }
4039    }
4040    line-break
4041    | get_my_position TOK_USE save_olduse opt-module-nature-2points TOK_NAME ',' TOK_ONLY ':' opt-only-list
4042    {
4043            if ( firstpass )
4044            {
4045                if ( insubroutinedeclare )
4046                {
4047                  if ($9)
4048                  {
4049                    Add_CouplePointed_Var_1($5,$9);
4050                    coupletmp = $9;
4051                    strcpy(ligne,"");
4052                    while ( coupletmp )
4053                    {
4054                        strcat(ligne,coupletmp->c_namevar);
4055                        if ( strcasecmp(coupletmp->c_namepointedvar,"") )   strcat(ligne," => ");
4056                        strcat(ligne,coupletmp->c_namepointedvar);
4057                        coupletmp = coupletmp->suiv;
4058                        if ( coupletmp ) strcat(ligne,",");
4059                    }
4060                  }
4061                  sprintf(charusemodule,"%s",$5);
4062                }
4063                Add_NameOfModuleUsed_1($5);
4064            }
4065            else
4066            {
4067                if ( insubroutinedeclare )
4068                    copyuseonly_0($5);
4069
4070                if ( inmoduledeclare == 0 )
4071                {
4072                    pos_end = setposcur();
4073                    RemoveWordSET_0(fortran_out,my_position,pos_end-my_position);
4074                    if ($9)
4075                    {
4076                    if (oldfortran_out)  variableisglobalinmodule($9,$5,oldfortran_out,pos_curuseold);
4077                    }
4078                }
4079                else
4080                {
4081                  if ($9)
4082                  {
4083                    /* if we are in the module declare and if the    */
4084                    /* onlylist is a list of global variable         */
4085                    variableisglobalinmodule($9, $5, fortran_out,my_position);
4086                  }
4087                }
4088            }
4089    }
4090    line-break
4091    ;
4092
4093opt-module-nature-2points:
4094    | TOK_FOURDOTS
4095    | ',' module-nature TOK_FOURDOTS
4096    ;
4097
4098opt-only-list:
4099    {$$=NULL;}
4100    | only-list
4101    {$$=$1;}
4102    ;
4103
4104/* R1101 : main-program */
4105main-program: program-stmt opt-specification-part opt-execution-part opt-internal-subprogram-part end-program-stmt
4106     ;
4107
4108opt-specification-part:
4109     | specification-part
4110     ;
4111
4112opt-execution-part:
4113     | execution-part
4114     ;
4115
4116/* R1102 : program-stmt */
4117program-stmt: TOK_PROGRAM TOK_NAME
4118        {
4119            strcpy(subroutinename,$2);
4120            insubroutinedeclare = 1;
4121            inprogramdeclare = 1;
4122            /* in the second step we should write the head of       */
4123            /*    the subroutine sub_loop_<subroutinename>          */
4124            if ( ! firstpass )
4125                WriteBeginof_SubLoop();
4126        }
4127        line-break
4128     ;
4129
4130/* R1103 : end-program-stmt */
4131end-program-stmt: {pos_endsubroutine=my_position_before;} TOK_ENDUNIT opt-tok-program opt-tok-name
4132     {
4133            insubroutinedeclare = 0;
4134            inprogramdeclare = 0;
4135            pos_cur = setposcur();
4136            closeandcallsubloopandincludeit_0(3);
4137            functiondeclarationisdone = 0;
4138            strcpy(subroutinename,"");     
4139     }     
4140     line-break
4141     ;
4142
4143opt-tok-program:
4144     | TOK_PROGRAM
4145     ;
4146opt-tok-name:
4147     | TOK_NAME
4148     ;
4149/* R1110 : module-nature */
4150module-nature: TOK_INTRINSIC
4151    ;
4152
4153opt-rename-list:
4154    {
4155    $$=NULL;
4156    }
4157    | ',' rename-list
4158    {
4159    $$=$2;
4160    }
4161    ;
4162   
4163rename-list: rename
4164     {
4165     $$=$1;
4166     }
4167     | rename-list ',' rename
4168     {
4169     /* insert the variable in the list $1                 */
4170     $3->suiv = $1;
4171     $$=$3;
4172     }
4173     ;
4174
4175/* R1111: rename */
4176rename: TOK_NAME TOK_POINT_TO TOK_NAME
4177        {
4178            coupletmp = (listcouple *) calloc(1,sizeof(listcouple));
4179            strcpy(coupletmp->c_namevar,$1);
4180            strcpy(coupletmp->c_namepointedvar,$3);
4181            coupletmp->suiv = NULL;
4182            $$ = coupletmp;
4183        }
4184     ;
4185
4186only-list:only
4187     {$$=$1;}
4188     | only-list ',' only
4189        {
4190            /* insert the variable in the list $1                 */
4191            $3->suiv = $1;
4192            $$ = $3;
4193        }
4194     ;
4195
4196/* R1112: only */
4197only:generic-spec
4198        {
4199            coupletmp = (listcouple *)calloc(1,sizeof(listcouple));
4200            strcpy(coupletmp->c_namevar,$1);
4201            strcpy(coupletmp->c_namepointedvar,"");
4202            coupletmp->suiv = NULL;
4203            $$ = coupletmp;
4204        }
4205     | only-use-name
4206        {
4207            coupletmp = (listcouple *)calloc(1,sizeof(listcouple));
4208            strcpy(coupletmp->c_namevar,$1);
4209            strcpy(coupletmp->c_namepointedvar,"");
4210            coupletmp->suiv = NULL;
4211            $$ = coupletmp;
4212        }
4213     | rename
4214     {
4215     $$=$1;
4216     pointedvar = 1;
4217      Add_UsedInSubroutine_Var_1($1->c_namevar);
4218     }
4219     ;
4220/* R1113 : only-use-name */
4221only-use-name: TOK_NAME
4222     ;
4223
4224/* R1207: generic-spec */
4225generic-spec: TOK_NAME
4226     ;
4227
4228/* R1210 : external-stmt */
4229external-stmt: TOK_EXTERNAL external-name-list line-break
4230     | TOK_EXTERNAL TOK_FOURDOTS external-name-list line-break
4231     ;
4232     
4233external-name-list: external-name
4234     | external-name-list ',' external-name
4235     ;
4236     
4237external-name: TOK_NAME
4238     ;
4239
4240/* R1218 : intrinsic-stmt */
4241intrinsic-stmt: TOK_INTRINSIC opt-TOK_FOURDOTS intrinsic-procedure-name-list line-break
4242     ;
4243
4244intrinsic-procedure-name-list:
4245        intrinsic-procedure-name
4246      | intrinsic-procedure-name-list ',' intrinsic-procedure-name
4247      ;
4248     
4249intrinsic-procedure-name: TOK_NAME
4250     ;
4251
4252/* R1219 : function-reference */
4253function-reference: procedure-designator '(' ')'
4254     | procedure-designator '(' {in_complex_literal=0;} actual-arg-spec-list ')'
4255     {sprintf($$,"%s(%s)",$[procedure-designator],$[actual-arg-spec-list]);}
4256     ;
4257
4258/* R1220 :
4259*/
4260call-stmt: before-call-stmt
4261             {
4262            inagrifcallargument = 0 ;
4263            incalldeclare=0;
4264            if ( oldfortran_out && (callagrifinitgrids == 1) && (firstpass == 0) )
4265            {
4266                pos_end = setposcur();
4267                RemoveWordSET_0(fortran_out,pos_curcall,pos_end-pos_curcall);
4268                strcpy(subofagrifinitgrids,subroutinename);
4269            }
4270            Instanciation_0(sameagrifname);
4271        }
4272        line-break
4273     | before-call-stmt '(' ')'
4274             {
4275            inagrifcallargument = 0 ;
4276            incalldeclare=0;
4277            if ( oldfortran_out && (callagrifinitgrids == 1) && (firstpass == 0) )
4278            {
4279                pos_end = setposcur();
4280                RemoveWordSET_0(fortran_out,pos_curcall,pos_end-pos_curcall);
4281                strcpy(subofagrifinitgrids,subroutinename);
4282            }
4283            Instanciation_0(sameagrifname);
4284        }
4285        line-break
4286     | before-call-stmt '(' {in_complex_literal=0;} actual-arg-spec-list ')'
4287        {
4288            inagrifcallargument = 0 ;
4289            incalldeclare=0;
4290            if ( oldfortran_out && (callagrifinitgrids == 1) && (firstpass == 0) )
4291            {
4292                pos_end = setposcur();
4293                RemoveWordSET_0(fortran_out,pos_curcall,pos_end-pos_curcall);
4294                strcpy(subofagrifinitgrids,subroutinename);
4295            }
4296            Instanciation_0(sameagrifname);
4297        }
4298        line-break
4299     ;
4300
4301before-call-stmt: opt-label TOK_CALL {pos_curcall=my_position_before-strlen($[opt-label])-4;} procedure-designator
4302             {
4303            if (!strcasecmp($[procedure-designator],"MPI_Init") )    callmpiinit = 1;
4304            else                                callmpiinit = 0;
4305
4306            if (!strcasecmp($[procedure-designator],"Agrif_Init_Grids") )
4307            {
4308                callagrifinitgrids = 1;
4309                strcpy(meetagrifinitgrids,subroutinename);
4310            }
4311            else
4312            {
4313                callagrifinitgrids = 0;
4314            }
4315            if ( Vartonumber($[procedure-designator]) == 1 )
4316            {
4317                incalldeclare = 0;
4318                inagrifcallargument = 0 ;
4319                Add_SubroutineWhereAgrifUsed_1(subroutinename, curmodulename);
4320            }
4321        }
4322        ;
4323
4324/* R1221 : procedure-designator */
4325procedure-designator: ident
4326     | TOK_FLUSH
4327     | TOK_REAL
4328     ;
4329
4330actual-arg-spec-list:
4331        actual-arg-spec
4332      | actual-arg-spec-list ',' actual-arg-spec
4333      {sprintf($$,"%s,%s",$1,$[actual-arg-spec]);}
4334      ;
4335
4336/* R1222 : actual-arg-spec */
4337actual-arg-spec: actual-arg
4338        {
4339            if ( callmpiinit == 1 )
4340            {
4341                strcpy(mpiinitvar,$1);
4342                if ( firstpass == 1 )  Add_UsedInSubroutine_Var_1 (mpiinitvar);
4343            }
4344        }     
4345     | keyword '=' actual-arg
4346     {sprintf($$,"%s = %s",$1,$3);
4347                 if ( callmpiinit == 1 )
4348            {
4349                strcpy(mpiinitvar,$3);
4350                if ( firstpass == 1 )  Add_UsedInSubroutine_Var_1 (mpiinitvar);
4351            }
4352            }
4353     ;
4354
4355/* R1223 : actual-arg */
4356actual-arg: expr
4357     | variable
4358     {
4359     strcpy($$,$1->v_nomvar);
4360     if ($1->v_initialvalue_array)
4361     {
4362     strcat($$,"(");
4363     strcat($$,$1->v_initialvalue_array->n_name);
4364     strcat($$,")");
4365     }
4366     }
4367     | ident
4368     ;
4369
4370opt-prefix:     {isrecursive = 0;}
4371     | prefix
4372     ;
4373     
4374/* R1225 : prefix */
4375prefix: prefix-spec
4376     | prefix prefix-spec
4377     ;
4378
4379/* R1226 prefix-spec */
4380prefix-spec: declaration-type-spec
4381     {isrecursive = 0; functiondeclarationisdone = 1;}
4382     | TOK_MODULE
4383     {isrecursive = 0;}
4384     | TOK_RECURSIVE
4385     {isrecursive = 1;}
4386     ;
4387
4388/*R1227 : function-subprogram */
4389function-subprogram: function-stmt opt-specification-part opt-execution-part opt-internal-subprogram-part end-function-stmt
4390     ;
4391
4392/* R1228 : function-stmt */
4393function-stmt: opt-prefix TOK_FUNCTION
4394     function-name '(' {in_complex_literal=0;} opt-dummy-arg-list ')' opt-suffix
4395     {
4396            insubroutinedeclare = 1;
4397            suborfun = 0;
4398            /* we should to list of the subroutine argument the  */
4399            /*    name of the function which has to be defined   */
4400            if ( firstpass )
4401            {
4402                Add_SubroutineArgument_Var_1($[opt-dummy-arg-list]);
4403                if ( ! is_result_present )
4404                    Add_FunctionType_Var_1($[function-name]);
4405            }
4406            else
4407            /* in the second step we should write the head of    */
4408            /*    the subroutine sub_loop_<subroutinename>       */
4409               {
4410                if (todebug == 1) fprintf(fortran_out,"      !DEBUG: Avant Writebeginof subloop\n");
4411                WriteBeginof_SubLoop();
4412                if (todebug == 1) fprintf(fortran_out,"      !DEBUG: Apres Writebeginof subloop\n");
4413                }
4414                strcpy(NamePrecision,"");
4415     }
4416     line-break
4417     ;
4418
4419function-name: TOK_NAME
4420     {
4421     if (strcmp(subroutinename,""))
4422     {
4423     strcpy(old_subroutinename,subroutinename); // can occur in internal-subprogram
4424     old_oldfortran_out=oldfortran_out;
4425     }
4426     else
4427     {
4428     old_oldfortran_out=(FILE *)NULL;
4429     }
4430     strcpy($$,$1);strcpy(subroutinename,$1);
4431     }
4432     ;
4433
4434opt-dummy-arg-name-list:
4435     | dummy-arg-name-list
4436     ;
4437
4438dummy-arg-name-list:
4439        dummy-arg-name
4440      | dummy-arg-name-list ',' dummy-arg-name
4441      ;
4442
4443/* R1230 : dummy-arg-name */
4444dummy-arg-name: TOK_NAME
4445     {strcpy($$,$1);}
4446     ;
4447
4448opt-suffix:
4449     {is_result_present = 0; }
4450     | suffix
4451     ;
4452     
4453/* R1231 : suffix */
4454suffix: TOK_RESULT '(' TOK_NAME ')'
4455     {is_result_present = 1;
4456                 if ( firstpass == 1 )
4457            {
4458                strcpy(nameinttypenameback,nameinttypename);
4459                strcpy(nameinttypename,"");
4460                curvar = createvar($3,NULL);
4461                strcpy(nameinttypename,nameinttypenameback);
4462                strcpy(curvar->v_typevar,"");
4463                curlistvar = insertvar(NULL,curvar);
4464                Add_SubroutineArgument_Var_1(curlistvar);
4465            }
4466     }
4467     ;
4468
4469/* R1232 : end-function-stmt */
4470end-function-stmt: get_my_position TOK_ENDUNIT opt-tok-function opt-ident close_subroutine
4471     {strcpy(DeclType, "");}
4472     line-break
4473     ;
4474
4475opt-tok-function:
4476     | TOK_FUNCTION
4477     ;
4478
4479/*R1233 : subroutine-subprogram */
4480subroutine-subprogram: subroutine-stmt opt-specification-part opt-execution-part opt-internal-subprogram-part end-subroutine-stmt
4481     ;
4482     
4483/* R1234 : subroutine-stmt */
4484subroutine-stmt: opt-prefix TOK_SUBROUTINE subroutine-name opt-dummy-arg-list-par
4485        {
4486            insubroutinedeclare = 1;
4487            suborfun = 1;
4488            if ( firstpass )
4489                Add_SubroutineArgument_Var_1($4);
4490            else
4491              {
4492                WriteBeginof_SubLoop();
4493              }
4494        }
4495        line-break
4496     ;
4497
4498
4499subroutine-name: TOK_NAME
4500     {
4501     if (strcmp(subroutinename,""))
4502     {
4503     strcpy(old_subroutinename,subroutinename); // can occur in internal-subprogram
4504     old_oldfortran_out=oldfortran_out;
4505     }
4506     else
4507     {
4508     old_oldfortran_out=(FILE *)NULL;
4509     }
4510     strcpy($$,$1);strcpy(subroutinename,$1);
4511     }
4512     ;
4513
4514/* R1236 : end-subroutine-stmt */
4515
4516end-subroutine-stmt: get_my_position TOK_ENDUNIT opt-tok-subroutine opt-ident close_subroutine
4517     line-break
4518     ;
4519
4520close_subroutine:
4521          {pos_endsubroutine = my_position;
4522            GlobalDeclaration = 0 ;
4523            if ( firstpass == 0 && strcasecmp(subroutinename,"") )
4524            {
4525                if ( module_declar && insubroutinedeclare == 0 )    fclose(module_declar);
4526            }
4527            if ( strcasecmp(subroutinename,"") )
4528            {
4529                if ( inmodulemeet == 1 )
4530                {
4531                    /* we are in a module                                */
4532                    if ( insubroutinedeclare == 1 )
4533                    {
4534                        /* it is like an end subroutine <name>            */
4535                        insubroutinedeclare = 0 ;
4536                        pos_cur = setposcur();
4537                        closeandcallsubloopandincludeit_0(suborfun);
4538                        functiondeclarationisdone = 0;
4539                    }
4540                    else
4541                    {
4542                        /* it is like an end module <name>                */
4543                        inmoduledeclare = 0 ;
4544                        inmodulemeet = 0 ;
4545                    }
4546                }
4547                else
4548                {
4549                    insubroutinedeclare = 0;
4550                    pos_cur = setposcur();
4551                    closeandcallsubloopandincludeit_0(2);
4552                    functiondeclarationisdone = 0;
4553                }
4554            }
4555            strcpy(subroutinename,"");
4556            if (strcmp(old_subroutinename,""))
4557            {
4558            strcpy(subroutinename,old_subroutinename);
4559            strcpy(old_subroutinename,"");
4560            oldfortran_out=old_oldfortran_out;
4561            insubroutinedeclare=1;
4562            }
4563        }
4564        ;
4565opt-tok-subroutine:
4566     | TOK_SUBROUTINE
4567     ;
4568
4569opt-dummy-arg-list-par:
4570     {if (firstpass) $$=NULL;}
4571     | '(' {in_complex_literal=0;} opt-dummy-arg-list ')'
4572     {if (firstpass) $$=$3;}
4573     ;
4574
4575opt-dummy-arg-list:
4576     {if (firstpass) $$=NULL;}
4577     | dummy-arg-list
4578     {if (firstpass) $$=$1;}
4579     ;
4580     
4581dummy-arg-list:
4582        dummy-arg
4583        {
4584            if ( firstpass == 1 )
4585            {
4586                strcpy(nameinttypenameback,nameinttypename);
4587                strcpy(nameinttypename,"");
4588                curvar = createvar($1,NULL);
4589                strcpy(nameinttypename,nameinttypenameback);
4590                curlistvar = insertvar(NULL,curvar);
4591                $$ = settype("",curlistvar);
4592            }
4593        }
4594      | dummy-arg-list ',' dummy-arg
4595        {
4596            if ( firstpass == 1 )
4597            {
4598                strcpy(nameinttypenameback,nameinttypename);
4599                strcpy(nameinttypename,"");
4600                curvar = createvar($3,NULL);
4601                strcpy(nameinttypename,nameinttypenameback);
4602                $$ = insertvar($1,curvar);
4603            }
4604        }
4605      ;
4606     
4607/* R1235: dummy-arg */
4608dummy-arg: dummy-arg-name
4609      {strcpy($$,$1);}
4610      | '*'
4611      {strcpy($$,"*");}
4612      ;
4613     
4614/* R1241 : return-stmt */
4615return-stmt : opt-label TOK_RETURN line-break
4616     | opt-label TOK_RETURN scalar-int-expr line-break
4617     ;
4618
4619/* R1242 : contains-stmt */
4620contains-stmt: opt-label TOK_CONTAINS
4621        {
4622            if ( inside_type_declare ) break;
4623            if ( inmoduledeclare )
4624            {
4625                if ( firstpass == 0 )
4626                {
4627                    RemoveWordCUR_0(fortran_out,9);   // Remove word 'contains'
4628                    Write_Closing_Module(0);
4629                }
4630                inmoduledeclare = 0 ;
4631                aftercontainsdeclare = 1;
4632            }
4633            else if ( insubroutinedeclare )
4634            {
4635                incontainssubroutine = 1;
4636                insubroutinedeclare  = 0;
4637                incontainssubroutine = 0;
4638                functiondeclarationisdone = 0;
4639
4640                if ( firstpass )
4641                    List_ContainsSubroutine = Addtolistnom(subroutinename, List_ContainsSubroutine, 0);
4642                else
4643                    closeandcallsubloop_contains_0();
4644
4645                strcpy(subroutinename, "");
4646            }
4647            else printf("l.%4d -- TOK_CONTAINS -- MHCHECK\n",line_num_input);
4648        }
4649        line-break
4650     ;
4651
4652/* R1243 : stmt-function-stmt */
4653stmt-function-stmt: TOK_NAME '(' opt-dummy-arg-name-list ')' '=' expr line-break
4654     ;
4655
4656opt_name : '\n'  {strcpy($$,"");}
4657      | TOK_NAME {strcpy($$,$1);}
4658      ;
4659
4660before_dims : { created_dimensionlist = 0; }
4661      ;
4662ident_dims :
4663        ident before_dims dims dims
4664        {
4665            created_dimensionlist = 1;
4666            if ( ($3 == NULL) || ($4 == NULL) ) break;
4667            if  ( agrif_parentcall == 1 )
4668            {
4669                ModifyTheAgrifFunction_0($3->dim.last);
4670                agrif_parentcall = 0;
4671                fprintf(fortran_out," = ");
4672            }
4673        }
4674      | ident_dims '%' declare_after_percent ident before_dims dims dims
4675        {
4676            created_dimensionlist = 1;
4677        }
4678      ;
4679int_list :
4680        TOK_CSTINT
4681      | int_list ',' TOK_CSTINT
4682      ;
4683after_ident_dims :
4684        '=' expr
4685      | TOK_POINT_TO expr
4686      ;
4687call :  keywordcall opt_call
4688        {
4689            inagrifcallargument = 0 ;
4690            incalldeclare=0;
4691            if ( oldfortran_out && (callagrifinitgrids == 1) && (firstpass == 0) )
4692            {
4693                pos_end = setposcur();
4694                RemoveWordSET_0(fortran_out,pos_curcall,pos_end-pos_curcall);
4695                strcpy(subofagrifinitgrids,subroutinename);
4696            }
4697            Instanciation_0(sameagrifname);
4698        }
4699      ;
4700opt_call :
4701      | '(' opt_callarglist  ')'
4702      ;
4703opt_callarglist :
4704      | callarglist
4705      ;
4706keywordcall:
4707        before_call TOK_FLUSH
4708      | before_call TOK_NAME
4709        {
4710            if (!strcasecmp($2,"MPI_Init") )    callmpiinit = 1;
4711            else                                callmpiinit = 0;
4712
4713            if (!strcasecmp($2,"Agrif_Init_Grids") )
4714            {
4715                callagrifinitgrids = 1;
4716                strcpy(meetagrifinitgrids,subroutinename);
4717            }
4718            else
4719            {
4720                callagrifinitgrids = 0;
4721            }
4722            if ( Vartonumber($2) == 1 )
4723            {
4724                incalldeclare = 1;
4725                inagrifcallargument = 1 ;
4726                Add_SubroutineWhereAgrifUsed_1(subroutinename, curmodulename);
4727            }
4728        }
4729      ;
4730before_call : TOK_CALL  { pos_curcall=setposcur()-4; }
4731      | label TOK_CALL  { pos_curcall=setposcur()-4; }
4732      ;
4733callarglist :
4734        callarg
4735      | callarglist ',' callarg
4736      ;
4737callarg :
4738        expr
4739        {
4740            if ( callmpiinit == 1 )
4741            {
4742                strcpy(mpiinitvar,$1);
4743                if ( firstpass == 1 )  Add_UsedInSubroutine_Var_1 (mpiinitvar);
4744            }
4745        }
4746      | '*' TOK_CSTINT
4747      ;
4748
4749stop :  TOK_PAUSE
4750      | TOK_STOP
4751      ;
4752
4753option_io_1 :
4754        infmt ',' inlist
4755      | infmt
4756
4757option_io_2 :
4758        ioctl outlist
4759      | ioctl
4760
4761ioctl : '(' ctllist ')'
4762      ;
4763after_rewind :
4764        '(' ident ')'
4765      | '(' TOK_CSTINT ')'
4766      | TOK_CSTINT
4767      | '(' uexpr ')'
4768      | TOK_NAME
4769      ;
4770ctllist :
4771        ioclause
4772      | ctllist ',' ioclause
4773      ;
4774ioclause :
4775        fexpr
4776      | '*'
4777      | TOK_DASTER
4778      | ident expr dims
4779      | ident expr '%' declare_after_percent ident_dims
4780      | ident '(' triplet ')'
4781      | ident '*'
4782      | ident TOK_DASTER
4783      ;
4784
4785declare_after_percent:      { afterpercent = 1; }
4786      ;
4787iofctl :
4788      TOK_FLUSH
4789      ;
4790infmt :  unpar_fexpr
4791      | '*'
4792      ;
4793
4794write_or_inq :
4795        TOK_WRITE
4796      ;
4797
4798fexpr : unpar_fexpr
4799      | '(' fexpr ')'
4800      ;
4801unpar_fexpr :
4802        lhs
4803      | simple_const
4804      | fexpr addop fexpr %prec '+'
4805      | fexpr '*' fexpr
4806      | fexpr TOK_SLASH fexpr
4807      | fexpr TOK_DASTER fexpr
4808      | addop fexpr %prec '*'
4809      | fexpr TOK_DSLASH fexpr
4810      | TOK_FILE expr
4811      | TOK_UNIT expr
4812      | TOK_NML expr
4813      | TOK_FMT expr
4814      | TOK_EXIST expr
4815      | TOK_ERR expr
4816      | TOK_END expr
4817      | TOK_NAME '=' expr
4818      | predefinedfunction
4819      ;
4820addop : '+'
4821      | '-'
4822      ;
4823inlist : inelt
4824      | inlist ',' inelt
4825      ;
4826// opt_lhs :
4827//       | lhs
4828//       ;
4829inelt : //opt_lhs opt_operation
4830        lhs opt_operation
4831      | '(' inlist ')' opt_operation
4832      | predefinedfunction opt_operation
4833      | simple_const opt_operation
4834      | '(' inlist ',' dospec ')'
4835      ;
4836opt_operation :
4837      | operation
4838      | opt_operation operation
4839      ;
4840outlist :
4841        complex_const       { strcpy($$,$1); }
4842      | predefinedfunction  { strcpy($$,$1); }
4843      | uexpr               { strcpy($$,$1); }
4844      | other               { strcpy($$,$1); }
4845      | uexpr   ',' expr    { sprintf($$,"%s,%s",$1,$3); }
4846      | uexpr   ',' other   { sprintf($$,"%s,%s",$1,$3); }
4847      | other   ',' expr    { sprintf($$,"%s,%s",$1,$3); }
4848      | other   ',' other   { sprintf($$,"%s,%s",$1,$3); }
4849      | outlist ',' expr    { sprintf($$,"%s,%s",$1,$3); }
4850      | outlist ',' other   { sprintf($$,"%s,%s",$1,$3); }
4851      ;
4852other :
4853        '(' uexpr   ',' dospec ')'    { sprintf($$,"(%s,%s)",$2,$4); }
4854      | '(' outlist ',' dospec ')'    { sprintf($$,"(%s,%s)",$2,$4); }
4855      | '(' other   ',' dospec ')'    { sprintf($$,"(%s,%s)",$2,$4); }
4856dospec :
4857        TOK_NAME '=' expr ',' expr           { sprintf($$,"%s=%s,%s)",$1,$3,$5);}
4858      | TOK_NAME '=' expr ',' expr ',' expr  { sprintf($$,"%s=%s,%s,%s)",$1,$3,$5,$7);}
4859      ;
4860goto :  TOK_PLAINGOTO '(' expr ',' expr ')' ',' expr
4861      | TOK_PLAINGOTO TOK_CSTINT
4862      ;
4863allocation_list :
4864        allocate_object
4865      | allocation_list ',' allocate_object
4866      ;
4867allocate_object :
4868        lhs     { Add_Allocate_Var_1($1,curmodulename); }
4869      ;
4870allocate_object_list :
4871        allocate_object
4872      | allocate_object_list ',' allocate_object
4873      ;
4874opt_stat_spec :
4875      | ',' TOK_STAT '=' lhs
4876      ;
4877pointer_name_list :
4878        ident
4879      | pointer_name_list ',' ident
4880      ;
4881
4882%%
4883
4884void process_fortran(const char *input_file)
4885{
4886    extern FILE *fortran_in;
4887    extern FILE *fortran_out;
4888
4889    char output_file[LONG_FNAME];
4890    char input_fullpath[LONG_FNAME];
4891
4892    if ( todebug == 1 ) printf("Firstpass == %d \n", firstpass);
4893
4894     yydebug=0;
4895/******************************************************************************/
4896/*  1-  Open input file                                                       */
4897/******************************************************************************/
4898
4899    strcpy(cur_filename, input_file);
4900    sprintf(input_fullpath, "%s/%s", input_dir, input_file);
4901
4902    fortran_in = fopen(input_fullpath, "r");
4903    if (! fortran_in)
4904    {
4905        printf("Error : File %s does not exist\n", input_fullpath);
4906        exit(1);
4907    }
4908
4909/******************************************************************************/
4910/*  2-  Variables initialization                                              */
4911/******************************************************************************/
4912
4913    line_num_input = 1;
4914    PublicDeclare = 0;
4915    PrivateDeclare = 0;
4916    ExternalDeclare = 0;
4917    SaveDeclare = 0;
4918    pointerdeclare = 0;
4919    optionaldeclare = 0;
4920    incalldeclare = 0;
4921    inside_type_declare = 0;
4922    Allocatabledeclare = 0 ;
4923    Targetdeclare = 0 ;
4924    VariableIsParameter =  0 ;
4925    strcpy(NamePrecision,"");
4926    c_star = 0 ;
4927    functiondeclarationisdone = 0;
4928    insubroutinedeclare = 0 ;
4929    strcpy(subroutinename," ");
4930    isrecursive = 0;
4931    InitialValueGiven = 0 ;
4932    GlobalDeclarationType = 0;
4933    inmoduledeclare = 0;
4934    incontainssubroutine = 0;
4935    afterpercent = 0;
4936    aftercontainsdeclare = 1;
4937    strcpy(nameinttypename,"");
4938
4939/******************************************************************************/
4940/*  3-  Parsing of the input file (1 time)                                    */
4941/******************************************************************************/
4942
4943    sprintf(output_file, "%s/%s", output_dir, input_file);
4944
4945    if (firstpass == 0) fortran_out = fopen(output_file,"w");
4946
4947    fortran_parse();
4948
4949    if (firstpass == 0) NewModule_Creation_0();
4950    if (firstpass == 0) fclose(fortran_out);
4951}
Note: See TracBrowser for help on using the repository browser.