source: vendors/AGRIF/dev_r14312_MPI_Interface/LEX/fortran.y @ 14351

Last change on this file since 14351 was 14351, checked in by smasson, 9 months ago

dev_r14312_MPI_Interface: update AGRIF branch to accept CONTIGUOUS attribute, #2598

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