New URL for NEMO forge!   http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
fortran.y in vendors/AGRIF/dev/LEX – NEMO

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

Last change on this file since 14975 was 14975, checked in by jchanut, 20 months ago

#2638, merge new AGRIF library into trunk

  • Property svn:mime-type set to text/x-csrc
File size: 134.0 KB
Line 
1/******************************************************************************/
2/*                                                                            */
3/*     CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran)       */
4/*                                                                            */
5/* Copyright or   or Copr. Laurent Debreu (Laurent.Debreu@imag.fr)            */
6/*                        Cyril Mazauric (Cyril_Mazauric@yahoo.fr)            */
7/* This software is governed by the CeCILL-C license under French law and     */
8/* abiding by the rules of distribution of free software.  You can  use,      */
9/* modify and/ or redistribute the software under the terms of the CeCILL-C   */
10/* license as circulated by CEA, CNRS and INRIA at the following URL          */
11/* "http ://www.cecill.info".                                                  */
12/*                                                                            */
13/* As a counterpart to the access to the source code and  rights to copy,     */
14/* modify and redistribute granted by the license, users are provided only    */
15/* with a limited warranty  and the software's author,  the holder of the     */
16/* economic rights,  and the successive licensors  have only  limited         */
17/* liability.                                                                 */
18/*                                                                            */
19/* In this respect, the user's attention is drawn to the risks associated     */
20/* with loading,  using,  modifying and/or developing or reproducing the      */
21/* software by the user in light of its specific status of free software,     */
22/* that may mean  that it is complicated to manipulate,  and  that  also      */
23/* therefore means  that it is reserved for developers  and  experienced      */
24/* professionals having in-depth computer knowledge. Users are therefore      */
25/* encouraged to load and test the software's suitability as regards their    */
26/* requirements in conditions enabling the security of their systems and/or   */
27/* data to be ensured and,  more generally, to use and operate it in the      */
28/* same conditions as regards security.                                       */
29/*                                                                            */
30/* The fact that you are presently reading this means that you have had       */
31/* knowledge of the CeCILL-C license and that you accept its terms.           */
32/******************************************************************************/
33/* version 1.7                                                                */
34/******************************************************************************/
35
36%{
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_IOMSG iomsg-variable
3723      | TOK_IOSTAT scalar-int-variable
3724      | TOK_POSITION scalar-default-char-expr
3725      | TOK_RECL scalar-int-expr
3726      | TOK_STATUS '=' scalar-default-char-expr
3727      ;
3728
3729/* R906 : file-name-expr */
3730file-name-expr: scalar-default-char-expr
3731     ;
3732
3733/* R907 : iomsg-variable */
3734iomsg-variable: scalar-default-char-variable
3735     ;
3736
3737/* R908 : close-stmt */
3738close-stmt: opt-label TOK_CLOSE '(' {close_or_connect = 1;} close-spec-list ')' line-break
3739        {close_or_connect = 0;}
3740        ;
3741
3742close-spec-list: close-spec
3743         | close-spec-list ',' close-spec
3744         ;
3745
3746/* R909 : close-spec */
3747close-spec: file-unit-number
3748       | TOK_UNIT file-unit-number
3749       | TOK_IOMSG iomsg-variable
3750       | TOK_IOSTAT scalar-int-variable
3751       | TOK_ERR label
3752       | TOK_STATUS '=' scalar-default-char-expr
3753       ;
3754
3755/* R910 : read-stmt */
3756read-stmt: opt-label TOK_READ_PAR io-control-spec-list ')'
3757         {
3758         in_io_control_spec = 0;
3759         }
3760         line-break
3761        | opt-label TOK_READ_PAR io-control-spec-list ')' input-item-list
3762         {
3763         in_io_control_spec = 0;
3764         }
3765         line-break
3766        | opt-label TOK_READ format line-break
3767        | opt-label TOK_READ format ',' input-item-list line-break
3768        ;
3769       
3770/* R911 : write-stmt */
3771write-stmt: opt-label TOK_WRITE_PAR io-control-spec-list ')'
3772         {
3773         in_io_control_spec = 0;
3774         }
3775         line-break
3776        | opt-label TOK_WRITE_PAR io-control-spec-list ')'  output-item-list
3777         {
3778         in_io_control_spec = 0;
3779         }
3780         line-break
3781        ;
3782
3783/* R912 : print-stmt */
3784print-stmt: opt-label TOK_PRINT format line-break
3785        | opt-label TOK_PRINT format ',' output-item-list line-break
3786        ;
3787io-control-spec-list: io-control-spec
3788         | io-control-spec-list ',' io-control-spec
3789         ;
3790
3791namelist-group-name: TOK_NAME
3792         ;
3793
3794/* R913 : io-control-spec */
3795io-control-spec: io-unit
3796         | TOK_UNIT io-unit
3797         | format
3798         | namelist-group-name
3799         | TOK_NML namelist-group-name
3800         | TOK_FMT format
3801         | TOK_END label
3802         | TOK_EOR label
3803         | TOK_ERR label
3804         | TOK_IOMSG iomsg-variable
3805         | TOK_IOSTAT scalar-int-variable
3806         | TOK_REC '=' scalar-int-expr
3807        ;
3808
3809/* R915 : format */
3810format: default-char-expr
3811        | label
3812        | '*'
3813        ;
3814input-item-list:
3815         input-item
3816         | input-item-list ',' input-item
3817         ;
3818/* R916 : input-item */
3819input-item: variable
3820        | io-implied-do
3821        ;
3822
3823output-item-list:
3824         output-item
3825         | output-item-list ',' output-item
3826         ;
3827
3828/* R917 : output-item */
3829output-item: expr
3830        | io-implied-do
3831        ;
3832
3833/* R918 : io-implied-do */
3834io-implied-do : '(' io-implied-do-object-list ',' io-implied-do-control ')'
3835        ;
3836
3837io-implied-do-object-list: io-implied-do-object
3838         | io-implied-do-object-list ',' io-implied-do-object
3839         ;
3840
3841/* R919 : io-implied-do-object */
3842/* input-item removed since possible conflicts (output-item can be variable) */
3843/* io-implied-do-object : input-item
3844        | output-item
3845        ;
3846*/
3847
3848io-implied-do-object : output-item
3849        ;       
3850
3851/* R920 : io-implied-do-control */
3852io-implied-do-control: do-variable '=' scalar-int-expr ',' scalar-int-expr
3853        | do-variable '=' scalar-int-expr ',' scalar-int-expr ',' scalar-int-expr
3854        ;
3855
3856/* R926 : rewind-stmt */
3857rewind-stmt: TOK_REWIND file-unit-number line-break
3858     | TOK_REWIND '(' position-spec-list ')' line-break
3859     ;
3860
3861position-spec-list:
3862        position-spec
3863      | position-spec-list ',' position-spec
3864      ;
3865     
3866/* R927 : position-spec */
3867position-spec: file-unit-number
3868     | TOK_UNIT file-unit-number
3869     | TOK_IOMSG iomsg-variable
3870     | TOK_IOSTAT scalar-int-variable
3871     | TOK_ERR label
3872     ;
3873
3874/* R928 : flush-stmt */
3875flush-stmt: TOK_FLUSH file-unit-number line-break
3876     | TOK_FLUSH '(' flush-spec-list ')' line-break
3877     ;
3878
3879flush-spec-list:
3880        flush-spec
3881      | flush-spec-list ',' flush-spec
3882      ;
3883     
3884/* R929 : flush-spec */
3885flush-spec: file-unit-number
3886     | TOK_UNIT file-unit-number
3887     | TOK_IOSTAT scalar-int-variable
3888     | TOK_IOMSG iomsg-variable
3889     | TOK_ERR label
3890     ;
3891
3892
3893/* R930 : inquire-stmt */
3894inquire-stmt: TOK_INQUIRE set_in_inquire '(' inquire-spec-list ')'
3895     {in_inquire=0;}
3896     line-break
3897     | TOK_INQUIRE set_in_inquire '(' TOK_IOLENGTH scalar-int-variable ')' output-item-list
3898     {in_inquire=0;}
3899     line-break
3900     ;
3901
3902set_in_inquire: {in_inquire=1;} 
3903     ;
3904
3905inquire-spec-list:
3906        inquire-spec
3907      | inquire-spec-list ',' inquire-spec
3908      ;
3909     
3910/* R931 : inquire-spec */
3911inquire-spec: file-unit-number
3912     | TOK_UNIT file-unit-number
3913     | TOK_FILE file-name-expr
3914     | TOK_ACCESS scalar-default-char-variable
3915     | TOK_ACTION scalar-default-char-variable
3916     | TOK_ERR label
3917     | TOK_EXIST scalar-logical-variable
3918     | TOK_IOMSG iomsg-variable
3919     | TOK_IOSTAT scalar-int-variable
3920     | TOK_NAME_EQ '=' scalar-default-char-variable
3921     | TOK_OPENED scalar-logical-variable
3922     | TOK_RECL scalar-int-variable
3923     ;
3924
3925/* R1001 : format-stmt */
3926format-stmt: TOK_LABEL_FORMAT line-break
3927        ;
3928
3929/* R1104 : module */
3930module:module-stmt opt-specification-part opt-module-subprogram-part {pos_endsubroutine=setposcur();} end-module-stmt
3931     ;
3932
3933opt-module-subprogram-part:
3934     | module-subprogram-part
3935     ;
3936
3937/* R1105 : module-stmt */
3938module-stmt : TOK_MODULE TOK_NAME
3939        {
3940            GlobalDeclaration = 0;
3941            strcpy(curmodulename,$2);
3942            strcpy(subroutinename,"");
3943            Add_NameOfModule_1($2);
3944            if ( inmoduledeclare == 0 )
3945            {
3946                /* To know if there are in the module declaration    */
3947                inmoduledeclare = 1;
3948                /* to know if a module has been met                  */
3949                inmodulemeet = 1;
3950                /* to know if we are after the keyword contains      */
3951                aftercontainsdeclare = 0 ;
3952            }
3953        }
3954        line-break
3955     ;
3956
3957/* R1106 : end-module-stmt */
3958end-module-stmt: get_my_position TOK_ENDUNIT opt-tok-module opt-ident
3959        {
3960            /* if we never meet the contains keyword               */
3961            if ( firstpass == 0 )
3962            {
3963                RemoveWordCUR_0(fortran_out, setposcur()-my_position);    // Remove word "end module"
3964                if ( inmoduledeclare && ! aftercontainsdeclare )
3965                {
3966                    Write_Closing_Module(1);
3967                }
3968                fprintf(fortran_out,"\n      end module %s\n", curmodulename);
3969                if ( module_declar && insubroutinedeclare == 0 )
3970                {
3971                    fclose(module_declar);
3972                }
3973            }
3974            inmoduledeclare = 0 ;
3975            inmodulemeet = 0 ;
3976            aftercontainsdeclare = 1;
3977            strcpy(curmodulename, "");
3978            GlobalDeclaration = 0 ;
3979        }
3980        line-break
3981     ;
3982
3983opt-tok-module:
3984     | TOK_MODULE
3985     ;
3986
3987opt-ident:
3988     | TOK_NAME
3989     ;
3990/* R1107 : module-subprogram-part */
3991module-subprogram-part:contains-stmt opt-module-subprogram-list
3992     ;
3993     
3994opt-module-subprogram-list:
3995     | module-subprogram-list
3996     ;
3997     
3998module-subprogram-list: module-subprogram
3999     | module-subprogram-list module-subprogram
4000     ;
4001
4002module-subprogram: function-subprogram
4003     | subroutine-subprogram
4004     ;
4005
4006use-stmt-list:use-stmt
4007     | use-stmt-list use-stmt
4008     ;
4009
4010save_olduse:
4011     {if (firstpass == 0 && oldfortran_out) pos_curuseold = setposcurname(oldfortran_out);}
4012     ;
4013     
4014/* R1109 use-stmt */
4015use-stmt: get_my_position TOK_USE save_olduse opt-module-nature-2points TOK_NAME opt-rename-list
4016    {
4017            if ( firstpass )
4018            {
4019                if ( insubroutinedeclare )
4020                {
4021                    if ($6) {
4022                      Add_CouplePointed_Var_1($5,$6);
4023                      coupletmp = $6;
4024                      strcpy(ligne,"");
4025                      while ( coupletmp )
4026                      {
4027                        strcat(ligne, coupletmp->c_namevar);
4028                        strcat(ligne, " => ");
4029                        strcat(ligne, coupletmp->c_namepointedvar);
4030                        coupletmp = coupletmp->suiv;
4031                        if ( coupletmp ) strcat(ligne,",");
4032                      }
4033                      }
4034                  sprintf(charusemodule,"%s",$5);
4035                }
4036                Add_NameOfModuleUsed_1($5);
4037            }
4038            else
4039            {
4040                if ( insubroutinedeclare )
4041                {
4042                  copyuse_0($5);
4043                    }
4044
4045                if ( inmoduledeclare == 0 )
4046                {
4047                    pos_end = setposcur();
4048                    RemoveWordSET_0(fortran_out,my_position,pos_end-my_position);
4049                }
4050            }
4051    }
4052    line-break
4053    | get_my_position TOK_USE save_olduse opt-module-nature-2points TOK_NAME ',' TOK_ONLY ':' opt-only-list
4054    {
4055            if ( firstpass )
4056            {
4057                if ( insubroutinedeclare )
4058                {
4059                  if ($9)
4060                  {
4061                    Add_CouplePointed_Var_1($5,$9);
4062                    coupletmp = $9;
4063                    strcpy(ligne,"");
4064                    while ( coupletmp )
4065                    {
4066                        strcat(ligne,coupletmp->c_namevar);
4067                        if ( strcasecmp(coupletmp->c_namepointedvar,"") )   strcat(ligne," => ");
4068                        strcat(ligne,coupletmp->c_namepointedvar);
4069                        coupletmp = coupletmp->suiv;
4070                        if ( coupletmp ) strcat(ligne,",");
4071                    }
4072                  }
4073                  sprintf(charusemodule,"%s",$5);
4074                }
4075                Add_NameOfModuleUsed_1($5);
4076            }
4077            else
4078            {
4079                if ( insubroutinedeclare )
4080                    copyuseonly_0($5);
4081
4082                if ( inmoduledeclare == 0 )
4083                {
4084                    pos_end = setposcur();
4085                    RemoveWordSET_0(fortran_out,my_position,pos_end-my_position);
4086                    if ($9)
4087                    {
4088                    if (oldfortran_out)  variableisglobalinmodule($9,$5,oldfortran_out,pos_curuseold);
4089                    }
4090                }
4091                else
4092                {
4093                  if ($9)
4094                  {
4095                    /* if we are in the module declare and if the    */
4096                    /* onlylist is a list of global variable         */
4097                    variableisglobalinmodule($9, $5, fortran_out,my_position);
4098                  }
4099                }
4100            }
4101    }
4102    line-break
4103    ;
4104
4105opt-module-nature-2points:
4106    | TOK_FOURDOTS
4107    | ',' module-nature TOK_FOURDOTS
4108    ;
4109
4110opt-only-list:
4111    {$$=NULL;}
4112    | only-list
4113    {$$=$1;}
4114    ;
4115
4116/* R1101 : main-program */
4117main-program: program-stmt opt-specification-part opt-execution-part opt-internal-subprogram-part end-program-stmt
4118     ;
4119
4120opt-specification-part:
4121     | specification-part
4122     ;
4123
4124opt-execution-part:
4125     | execution-part
4126     ;
4127
4128/* R1102 : program-stmt */
4129program-stmt: TOK_PROGRAM TOK_NAME
4130        {
4131            strcpy(subroutinename,$2);
4132            insubroutinedeclare = 1;
4133            inprogramdeclare = 1;
4134            /* in the second step we should write the head of       */
4135            /*    the subroutine sub_loop_<subroutinename>          */
4136            if ( ! firstpass )
4137                WriteBeginof_SubLoop();
4138        }
4139        line-break
4140     ;
4141
4142/* R1103 : end-program-stmt */
4143end-program-stmt: {pos_endsubroutine=my_position_before;} TOK_ENDUNIT opt-tok-program opt-tok-name
4144     {
4145            insubroutinedeclare = 0;
4146            inprogramdeclare = 0;
4147            pos_cur = setposcur();
4148            closeandcallsubloopandincludeit_0(3);
4149            functiondeclarationisdone = 0;
4150            strcpy(subroutinename,"");     
4151     }     
4152     line-break
4153     ;
4154
4155opt-tok-program:
4156     | TOK_PROGRAM
4157     ;
4158opt-tok-name:
4159     | TOK_NAME
4160     ;
4161/* R1110 : module-nature */
4162module-nature: TOK_INTRINSIC
4163    ;
4164
4165opt-rename-list:
4166    {
4167    $$=NULL;
4168    }
4169    | ',' rename-list
4170    {
4171    $$=$2;
4172    }
4173    ;
4174   
4175rename-list: rename
4176     {
4177     $$=$1;
4178     }
4179     | rename-list ',' rename
4180     {
4181     /* insert the variable in the list $1                 */
4182     $3->suiv = $1;
4183     $$=$3;
4184     }
4185     ;
4186
4187/* R1111: rename */
4188rename: TOK_NAME TOK_POINT_TO TOK_NAME
4189        {
4190            coupletmp = (listcouple *) calloc(1,sizeof(listcouple));
4191            strcpy(coupletmp->c_namevar,$1);
4192            strcpy(coupletmp->c_namepointedvar,$3);
4193            coupletmp->suiv = NULL;
4194            $$ = coupletmp;
4195        }
4196     ;
4197
4198only-list:only
4199     {$$=$1;}
4200     | only-list ',' only
4201        {
4202            /* insert the variable in the list $1                 */
4203            $3->suiv = $1;
4204            $$ = $3;
4205        }
4206     ;
4207
4208/* R1112: only */
4209only:generic-spec
4210        {
4211            coupletmp = (listcouple *)calloc(1,sizeof(listcouple));
4212            strcpy(coupletmp->c_namevar,$1);
4213            strcpy(coupletmp->c_namepointedvar,"");
4214            coupletmp->suiv = NULL;
4215            $$ = coupletmp;
4216        }
4217     | only-use-name
4218        {
4219            coupletmp = (listcouple *)calloc(1,sizeof(listcouple));
4220            strcpy(coupletmp->c_namevar,$1);
4221            strcpy(coupletmp->c_namepointedvar,"");
4222            coupletmp->suiv = NULL;
4223            $$ = coupletmp;
4224        }
4225     | rename
4226     {
4227     $$=$1;
4228     pointedvar = 1;
4229      Add_UsedInSubroutine_Var_1($1->c_namevar);
4230     }
4231     ;
4232/* R1113 : only-use-name */
4233only-use-name: TOK_NAME
4234     ;
4235
4236/* R1207: generic-spec */
4237generic-spec: TOK_NAME
4238     ;
4239
4240/* R1210 : external-stmt */
4241external-stmt: TOK_EXTERNAL external-name-list line-break
4242     | TOK_EXTERNAL TOK_FOURDOTS external-name-list line-break
4243     ;
4244     
4245external-name-list: external-name
4246     | external-name-list ',' external-name
4247     ;
4248     
4249external-name: TOK_NAME
4250     ;
4251
4252/* R1218 : intrinsic-stmt */
4253intrinsic-stmt: TOK_INTRINSIC opt-TOK_FOURDOTS intrinsic-procedure-name-list line-break
4254     ;
4255
4256intrinsic-procedure-name-list:
4257        intrinsic-procedure-name
4258      | intrinsic-procedure-name-list ',' intrinsic-procedure-name
4259      ;
4260     
4261intrinsic-procedure-name: TOK_NAME
4262     ;
4263
4264/* R1219 : function-reference */
4265function-reference: procedure-designator '(' ')'
4266     | procedure-designator '(' {in_complex_literal=0;} actual-arg-spec-list ')'
4267     {sprintf($$,"%s(%s)",$[procedure-designator],$[actual-arg-spec-list]);}
4268     ;
4269
4270/* R1220 :
4271*/
4272call-stmt: before-call-stmt
4273             {
4274            inagrifcallargument = 0 ;
4275            incalldeclare=0;
4276            if ( oldfortran_out && (callagrifinitgrids == 1) && (firstpass == 0) )
4277            {
4278                pos_end = setposcur();
4279                RemoveWordSET_0(fortran_out,pos_curcall,pos_end-pos_curcall);
4280                strcpy(subofagrifinitgrids,subroutinename);
4281            }
4282            Instanciation_0(sameagrifname);
4283        }
4284        line-break
4285     | before-call-stmt '(' ')'
4286             {
4287            inagrifcallargument = 0 ;
4288            incalldeclare=0;
4289            if ( oldfortran_out && (callagrifinitgrids == 1) && (firstpass == 0) )
4290            {
4291                pos_end = setposcur();
4292                RemoveWordSET_0(fortran_out,pos_curcall,pos_end-pos_curcall);
4293                strcpy(subofagrifinitgrids,subroutinename);
4294            }
4295            Instanciation_0(sameagrifname);
4296        }
4297        line-break
4298     | before-call-stmt '(' {in_complex_literal=0;} actual-arg-spec-list ')'
4299        {
4300            inagrifcallargument = 0 ;
4301            incalldeclare=0;
4302            if ( oldfortran_out && (callagrifinitgrids == 1) && (firstpass == 0) )
4303            {
4304                pos_end = setposcur();
4305                RemoveWordSET_0(fortran_out,pos_curcall,pos_end-pos_curcall);
4306                strcpy(subofagrifinitgrids,subroutinename);
4307            }
4308            Instanciation_0(sameagrifname);
4309        }
4310        line-break
4311     ;
4312
4313before-call-stmt: opt-label TOK_CALL {pos_curcall=my_position_before-strlen($[opt-label])-4;} procedure-designator
4314             {
4315            if (!strcasecmp($[procedure-designator],"MPI_Init") )    callmpiinit = 1;
4316            else                                callmpiinit = 0;
4317
4318            if (!strcasecmp($[procedure-designator],"Agrif_Init_Grids") )
4319            {
4320                callagrifinitgrids = 1;
4321                strcpy(meetagrifinitgrids,subroutinename);
4322            }
4323            else
4324            {
4325                callagrifinitgrids = 0;
4326            }
4327            if ( Vartonumber($[procedure-designator]) == 1 )
4328            {
4329                incalldeclare = 0;
4330                inagrifcallargument = 0 ;
4331                Add_SubroutineWhereAgrifUsed_1(subroutinename, curmodulename);
4332            }
4333        }
4334        ;
4335
4336/* R1221 : procedure-designator */
4337procedure-designator: ident
4338     | TOK_FLUSH
4339     | TOK_REAL
4340     ;
4341
4342actual-arg-spec-list:
4343        actual-arg-spec
4344      | actual-arg-spec-list ',' actual-arg-spec
4345      {sprintf($$,"%s,%s",$1,$[actual-arg-spec]);}
4346      ;
4347
4348/* R1222 : actual-arg-spec */
4349actual-arg-spec: actual-arg
4350        {
4351            if ( callmpiinit == 1 )
4352            {
4353                strcpy(mpiinitvar,$1);
4354                if ( firstpass == 1 )  Add_UsedInSubroutine_Var_1 (mpiinitvar);
4355            }
4356        }     
4357     | keyword '=' actual-arg
4358     {sprintf($$,"%s = %s",$1,$3);
4359                 if ( callmpiinit == 1 )
4360            {
4361                strcpy(mpiinitvar,$3);
4362                if ( firstpass == 1 )  Add_UsedInSubroutine_Var_1 (mpiinitvar);
4363            }
4364            }
4365     ;
4366
4367/* R1223 : actual-arg */
4368actual-arg: expr
4369     | variable
4370     {
4371     strcpy($$,$1->v_nomvar);
4372     if ($1->v_initialvalue_array)
4373     {
4374     strcat($$,"(");
4375     strcat($$,$1->v_initialvalue_array->n_name);
4376     strcat($$,")");
4377     }
4378     }
4379     | ident
4380     ;
4381
4382opt-prefix:     {isrecursive = 0;}
4383     | prefix
4384     ;
4385     
4386/* R1225 : prefix */
4387prefix: prefix-spec
4388     | prefix prefix-spec
4389     ;
4390
4391/* R1226 prefix-spec */
4392prefix-spec: declaration-type-spec
4393     {isrecursive = 0; functiondeclarationisdone = 1;}
4394     | TOK_MODULE
4395     {isrecursive = 0;}
4396     | TOK_RECURSIVE
4397     {isrecursive = 1;}
4398     ;
4399
4400/*R1227 : function-subprogram */
4401function-subprogram: function-stmt opt-specification-part opt-execution-part opt-internal-subprogram-part end-function-stmt
4402     ;
4403
4404/* R1228 : function-stmt */
4405function-stmt: opt-prefix TOK_FUNCTION
4406     function-name '(' {in_complex_literal=0;} opt-dummy-arg-list ')' opt-suffix
4407     {
4408            insubroutinedeclare = 1;
4409            suborfun = 0;
4410            /* we should to list of the subroutine argument the  */
4411            /*    name of the function which has to be defined   */
4412            if ( firstpass )
4413            {
4414                Add_SubroutineArgument_Var_1($[opt-dummy-arg-list]);
4415                if ( ! is_result_present )
4416                    Add_FunctionType_Var_1($[function-name]);
4417            }
4418            else
4419            /* in the second step we should write the head of    */
4420            /*    the subroutine sub_loop_<subroutinename>       */
4421               {
4422                if (todebug == 1) fprintf(fortran_out,"      !DEBUG: Avant Writebeginof subloop\n");
4423                WriteBeginof_SubLoop();
4424                if (todebug == 1) fprintf(fortran_out,"      !DEBUG: Apres Writebeginof subloop\n");
4425                }
4426                strcpy(NamePrecision,"");
4427     }
4428     line-break
4429     ;
4430
4431function-name: TOK_NAME
4432     {
4433     if (strcmp(subroutinename,""))
4434     {
4435     strcpy(old_subroutinename,subroutinename); // can occur in internal-subprogram
4436     old_oldfortran_out=oldfortran_out;
4437     }
4438     else
4439     {
4440     old_oldfortran_out=(FILE *)NULL;
4441     }
4442     strcpy($$,$1);strcpy(subroutinename,$1);
4443     }
4444     ;
4445
4446opt-dummy-arg-name-list:
4447     | dummy-arg-name-list
4448     ;
4449
4450dummy-arg-name-list:
4451        dummy-arg-name
4452      | dummy-arg-name-list ',' dummy-arg-name
4453      ;
4454
4455/* R1230 : dummy-arg-name */
4456dummy-arg-name: TOK_NAME
4457     {strcpy($$,$1);}
4458     ;
4459
4460opt-suffix:
4461     {is_result_present = 0; }
4462     | suffix
4463     ;
4464     
4465/* R1231 : suffix */
4466suffix: TOK_RESULT '(' TOK_NAME ')'
4467     {is_result_present = 1;
4468                 if ( firstpass == 1 )
4469            {
4470                strcpy(nameinttypenameback,nameinttypename);
4471                strcpy(nameinttypename,"");
4472                curvar = createvar($3,NULL);
4473                strcpy(nameinttypename,nameinttypenameback);
4474                strcpy(curvar->v_typevar,"");
4475                curlistvar = insertvar(NULL,curvar);
4476                Add_SubroutineArgument_Var_1(curlistvar);
4477            }
4478     }
4479     ;
4480
4481/* R1232 : end-function-stmt */
4482end-function-stmt: get_my_position TOK_ENDUNIT opt-tok-function opt-ident close_subroutine
4483     {strcpy(DeclType, "");}
4484     line-break
4485     ;
4486
4487opt-tok-function:
4488     | TOK_FUNCTION
4489     ;
4490
4491/*R1233 : subroutine-subprogram */
4492subroutine-subprogram: subroutine-stmt opt-specification-part opt-execution-part opt-internal-subprogram-part end-subroutine-stmt
4493     ;
4494     
4495/* R1234 : subroutine-stmt */
4496subroutine-stmt: opt-prefix TOK_SUBROUTINE subroutine-name opt-dummy-arg-list-par
4497        {
4498            insubroutinedeclare = 1;
4499            suborfun = 1;
4500            if ( firstpass )
4501                Add_SubroutineArgument_Var_1($4);
4502            else
4503              {
4504                WriteBeginof_SubLoop();
4505              }
4506        }
4507        line-break
4508     ;
4509
4510
4511subroutine-name: TOK_NAME
4512     {
4513     if (strcmp(subroutinename,""))
4514     {
4515     strcpy(old_subroutinename,subroutinename); // can occur in internal-subprogram
4516     old_oldfortran_out=oldfortran_out;
4517     }
4518     else
4519     {
4520     old_oldfortran_out=(FILE *)NULL;
4521     }
4522     strcpy($$,$1);strcpy(subroutinename,$1);
4523     }
4524     ;
4525
4526/* R1236 : end-subroutine-stmt */
4527
4528end-subroutine-stmt: get_my_position TOK_ENDUNIT opt-tok-subroutine opt-ident close_subroutine
4529     line-break
4530     ;
4531
4532close_subroutine:
4533          {pos_endsubroutine = my_position;
4534            GlobalDeclaration = 0 ;
4535            if ( firstpass == 0 && strcasecmp(subroutinename,"") )
4536            {
4537                if ( module_declar && insubroutinedeclare == 0 )    fclose(module_declar);
4538            }
4539            if ( strcasecmp(subroutinename,"") )
4540            {
4541                if ( inmodulemeet == 1 )
4542                {
4543                    /* we are in a module                                */
4544                    if ( insubroutinedeclare == 1 )
4545                    {
4546                        /* it is like an end subroutine <name>            */
4547                        insubroutinedeclare = 0 ;
4548                        pos_cur = setposcur();
4549                        closeandcallsubloopandincludeit_0(suborfun);
4550                        functiondeclarationisdone = 0;
4551                    }
4552                    else
4553                    {
4554                        /* it is like an end module <name>                */
4555                        inmoduledeclare = 0 ;
4556                        inmodulemeet = 0 ;
4557                    }
4558                }
4559                else
4560                {
4561                    insubroutinedeclare = 0;
4562                    pos_cur = setposcur();
4563                    closeandcallsubloopandincludeit_0(2);
4564                    functiondeclarationisdone = 0;
4565                }
4566            }
4567            strcpy(subroutinename,"");
4568            if (strcmp(old_subroutinename,""))
4569            {
4570            strcpy(subroutinename,old_subroutinename);
4571            strcpy(old_subroutinename,"");
4572            oldfortran_out=old_oldfortran_out;
4573            insubroutinedeclare=1;
4574            }
4575        }
4576        ;
4577opt-tok-subroutine:
4578     | TOK_SUBROUTINE
4579     ;
4580
4581opt-dummy-arg-list-par:
4582     {if (firstpass) $$=NULL;}
4583     | '(' {in_complex_literal=0;} opt-dummy-arg-list ')'
4584     {if (firstpass) $$=$3;}
4585     ;
4586
4587opt-dummy-arg-list:
4588     {if (firstpass) $$=NULL;}
4589     | dummy-arg-list
4590     {if (firstpass) $$=$1;}
4591     ;
4592     
4593dummy-arg-list:
4594        dummy-arg
4595        {
4596            if ( firstpass == 1 )
4597            {
4598                strcpy(nameinttypenameback,nameinttypename);
4599                strcpy(nameinttypename,"");
4600                curvar = createvar($1,NULL);
4601                strcpy(nameinttypename,nameinttypenameback);
4602                curlistvar = insertvar(NULL,curvar);
4603                $$ = settype("",curlistvar);
4604            }
4605        }
4606      | dummy-arg-list ',' dummy-arg
4607        {
4608            if ( firstpass == 1 )
4609            {
4610                strcpy(nameinttypenameback,nameinttypename);
4611                strcpy(nameinttypename,"");
4612                curvar = createvar($3,NULL);
4613                strcpy(nameinttypename,nameinttypenameback);
4614                $$ = insertvar($1,curvar);
4615            }
4616        }
4617      ;
4618     
4619/* R1235: dummy-arg */
4620dummy-arg: dummy-arg-name
4621      {strcpy($$,$1);}
4622      | '*'
4623      {strcpy($$,"*");}
4624      ;
4625     
4626/* R1241 : return-stmt */
4627return-stmt : opt-label TOK_RETURN line-break
4628     | opt-label TOK_RETURN scalar-int-expr line-break
4629     ;
4630
4631/* R1242 : contains-stmt */
4632contains-stmt: opt-label TOK_CONTAINS
4633        {
4634            if ( inside_type_declare ) break;
4635            if ( inmoduledeclare )
4636            {
4637                if ( firstpass == 0 )
4638                {
4639                    RemoveWordCUR_0(fortran_out,9);   // Remove word 'contains'
4640                    Write_Closing_Module(0);
4641                }
4642                inmoduledeclare = 0 ;
4643                aftercontainsdeclare = 1;
4644            }
4645            else if ( insubroutinedeclare )
4646            {
4647                incontainssubroutine = 1;
4648                insubroutinedeclare  = 0;
4649                incontainssubroutine = 0;
4650                functiondeclarationisdone = 0;
4651
4652                if ( firstpass )
4653                    List_ContainsSubroutine = Addtolistnom(subroutinename, List_ContainsSubroutine, 0);
4654                else
4655                    closeandcallsubloop_contains_0();
4656
4657                strcpy(subroutinename, "");
4658            }
4659            else printf("l.%4d -- TOK_CONTAINS -- MHCHECK\n",line_num_input);
4660        }
4661        line-break
4662     ;
4663
4664/* R1243 : stmt-function-stmt */
4665stmt-function-stmt: TOK_NAME '(' opt-dummy-arg-name-list ')' '=' expr line-break
4666     ;
4667
4668opt_name : '\n'  {strcpy($$,"");}
4669      | TOK_NAME {strcpy($$,$1);}
4670      ;
4671
4672before_dims : { created_dimensionlist = 0; }
4673      ;
4674ident_dims :
4675        ident before_dims dims dims
4676        {
4677            created_dimensionlist = 1;
4678            if ( ($3 == NULL) || ($4 == NULL) ) break;
4679            if  ( agrif_parentcall == 1 )
4680            {
4681                ModifyTheAgrifFunction_0($3->dim.last);
4682                agrif_parentcall = 0;
4683                fprintf(fortran_out," = ");
4684            }
4685        }
4686      | ident_dims '%' declare_after_percent ident before_dims dims dims
4687        {
4688            created_dimensionlist = 1;
4689        }
4690      ;
4691int_list :
4692        TOK_CSTINT
4693      | int_list ',' TOK_CSTINT
4694      ;
4695after_ident_dims :
4696        '=' expr
4697      | TOK_POINT_TO expr
4698      ;
4699call :  keywordcall opt_call
4700        {
4701            inagrifcallargument = 0 ;
4702            incalldeclare=0;
4703            if ( oldfortran_out && (callagrifinitgrids == 1) && (firstpass == 0) )
4704            {
4705                pos_end = setposcur();
4706                RemoveWordSET_0(fortran_out,pos_curcall,pos_end-pos_curcall);
4707                strcpy(subofagrifinitgrids,subroutinename);
4708            }
4709            Instanciation_0(sameagrifname);
4710        }
4711      ;
4712opt_call :
4713      | '(' opt_callarglist  ')'
4714      ;
4715opt_callarglist :
4716      | callarglist
4717      ;
4718keywordcall:
4719        before_call TOK_FLUSH
4720      | before_call TOK_NAME
4721        {
4722            if (!strcasecmp($2,"MPI_Init") )    callmpiinit = 1;
4723            else                                callmpiinit = 0;
4724
4725            if (!strcasecmp($2,"Agrif_Init_Grids") )
4726            {
4727                callagrifinitgrids = 1;
4728                strcpy(meetagrifinitgrids,subroutinename);
4729            }
4730            else
4731            {
4732                callagrifinitgrids = 0;
4733            }
4734            if ( Vartonumber($2) == 1 )
4735            {
4736                incalldeclare = 1;
4737                inagrifcallargument = 1 ;
4738                Add_SubroutineWhereAgrifUsed_1(subroutinename, curmodulename);
4739            }
4740        }
4741      ;
4742before_call : TOK_CALL  { pos_curcall=setposcur()-4; }
4743      | label TOK_CALL  { pos_curcall=setposcur()-4; }
4744      ;
4745callarglist :
4746        callarg
4747      | callarglist ',' callarg
4748      ;
4749callarg :
4750        expr
4751        {
4752            if ( callmpiinit == 1 )
4753            {
4754                strcpy(mpiinitvar,$1);
4755                if ( firstpass == 1 )  Add_UsedInSubroutine_Var_1 (mpiinitvar);
4756            }
4757        }
4758      | '*' TOK_CSTINT
4759      ;
4760
4761stop :  TOK_PAUSE
4762      | TOK_STOP
4763      ;
4764
4765option_io_1 :
4766        infmt ',' inlist
4767      | infmt
4768
4769option_io_2 :
4770        ioctl outlist
4771      | ioctl
4772
4773ioctl : '(' ctllist ')'
4774      ;
4775after_rewind :
4776        '(' ident ')'
4777      | '(' TOK_CSTINT ')'
4778      | TOK_CSTINT
4779      | '(' uexpr ')'
4780      | TOK_NAME
4781      ;
4782ctllist :
4783        ioclause
4784      | ctllist ',' ioclause
4785      ;
4786ioclause :
4787        fexpr
4788      | '*'
4789      | TOK_DASTER
4790      | ident expr dims
4791      | ident expr '%' declare_after_percent ident_dims
4792      | ident '(' triplet ')'
4793      | ident '*'
4794      | ident TOK_DASTER
4795      ;
4796
4797declare_after_percent:      { afterpercent = 1; }
4798      ;
4799iofctl :
4800      TOK_FLUSH
4801      ;
4802infmt :  unpar_fexpr
4803      | '*'
4804      ;
4805
4806write_or_inq :
4807        TOK_WRITE
4808      ;
4809
4810fexpr : unpar_fexpr
4811      | '(' fexpr ')'
4812      ;
4813unpar_fexpr :
4814        lhs
4815      | simple_const
4816      | fexpr addop fexpr %prec '+'
4817      | fexpr '*' fexpr
4818      | fexpr TOK_SLASH fexpr
4819      | fexpr TOK_DASTER fexpr
4820      | addop fexpr %prec '*'
4821      | fexpr TOK_DSLASH fexpr
4822      | TOK_FILE expr
4823      | TOK_UNIT expr
4824      | TOK_NML expr
4825      | TOK_FMT expr
4826      | TOK_EXIST expr
4827      | TOK_ERR expr
4828      | TOK_END expr
4829      | TOK_NAME '=' expr
4830      | predefinedfunction
4831      ;
4832addop : '+'
4833      | '-'
4834      ;
4835inlist : inelt
4836      | inlist ',' inelt
4837      ;
4838// opt_lhs :
4839//       | lhs
4840//       ;
4841inelt : //opt_lhs opt_operation
4842        lhs opt_operation
4843      | '(' inlist ')' opt_operation
4844      | predefinedfunction opt_operation
4845      | simple_const opt_operation
4846      | '(' inlist ',' dospec ')'
4847      ;
4848opt_operation :
4849      | operation
4850      | opt_operation operation
4851      ;
4852outlist :
4853        complex_const       { strcpy($$,$1); }
4854      | predefinedfunction  { strcpy($$,$1); }
4855      | uexpr               { strcpy($$,$1); }
4856      | other               { strcpy($$,$1); }
4857      | uexpr   ',' expr    { sprintf($$,"%s,%s",$1,$3); }
4858      | uexpr   ',' other   { sprintf($$,"%s,%s",$1,$3); }
4859      | other   ',' expr    { sprintf($$,"%s,%s",$1,$3); }
4860      | other   ',' other   { sprintf($$,"%s,%s",$1,$3); }
4861      | outlist ',' expr    { sprintf($$,"%s,%s",$1,$3); }
4862      | outlist ',' other   { sprintf($$,"%s,%s",$1,$3); }
4863      ;
4864other :
4865        '(' uexpr   ',' dospec ')'    { sprintf($$,"(%s,%s)",$2,$4); }
4866      | '(' outlist ',' dospec ')'    { sprintf($$,"(%s,%s)",$2,$4); }
4867      | '(' other   ',' dospec ')'    { sprintf($$,"(%s,%s)",$2,$4); }
4868dospec :
4869        TOK_NAME '=' expr ',' expr           { sprintf($$,"%s=%s,%s)",$1,$3,$5);}
4870      | TOK_NAME '=' expr ',' expr ',' expr  { sprintf($$,"%s=%s,%s,%s)",$1,$3,$5,$7);}
4871      ;
4872goto :  TOK_PLAINGOTO '(' expr ',' expr ')' ',' expr
4873      | TOK_PLAINGOTO TOK_CSTINT
4874      ;
4875allocation_list :
4876        allocate_object
4877      | allocation_list ',' allocate_object
4878      ;
4879allocate_object :
4880        lhs     { Add_Allocate_Var_1($1,curmodulename); }
4881      ;
4882allocate_object_list :
4883        allocate_object
4884      | allocate_object_list ',' allocate_object
4885      ;
4886opt_stat_spec :
4887      | ',' TOK_STAT '=' lhs
4888      ;
4889pointer_name_list :
4890        ident
4891      | pointer_name_list ',' ident
4892      ;
4893
4894%%
4895
4896void process_fortran(const char *input_file)
4897{
4898    extern FILE *fortran_in;
4899    extern FILE *fortran_out;
4900
4901    char output_file[LONG_FNAME];
4902    char input_fullpath[LONG_FNAME];
4903
4904    if ( todebug == 1 ) printf("Firstpass == %d \n", firstpass);
4905
4906     yydebug=0;
4907/******************************************************************************/
4908/*  1-  Open input file                                                       */
4909/******************************************************************************/
4910
4911    strcpy(cur_filename, input_file);
4912    sprintf(input_fullpath, "%s/%s", input_dir, input_file);
4913
4914    fortran_in = fopen(input_fullpath, "r");
4915    if (! fortran_in)
4916    {
4917        printf("Error : File %s does not exist\n", input_fullpath);
4918        exit(1);
4919    }
4920
4921/******************************************************************************/
4922/*  2-  Variables initialization                                              */
4923/******************************************************************************/
4924
4925    line_num_input = 1;
4926    PublicDeclare = 0;
4927    PrivateDeclare = 0;
4928    ExternalDeclare = 0;
4929    SaveDeclare = 0;
4930    pointerdeclare = 0;
4931    contiguousdeclare = 0;
4932    optionaldeclare = 0;
4933    incalldeclare = 0;
4934    inside_type_declare = 0;
4935    Allocatabledeclare = 0 ;
4936    Targetdeclare = 0 ;
4937    VariableIsParameter =  0 ;
4938    strcpy(NamePrecision,"");
4939    c_star = 0 ;
4940    functiondeclarationisdone = 0;
4941    insubroutinedeclare = 0 ;
4942    strcpy(subroutinename," ");
4943    isrecursive = 0;
4944    InitialValueGiven = 0 ;
4945    GlobalDeclarationType = 0;
4946    inmoduledeclare = 0;
4947    incontainssubroutine = 0;
4948    afterpercent = 0;
4949    aftercontainsdeclare = 1;
4950    strcpy(nameinttypename,"");
4951
4952/******************************************************************************/
4953/*  3-  Parsing of the input file (1 time)                                    */
4954/******************************************************************************/
4955
4956    sprintf(output_file, "%s/%s", output_dir, input_file);
4957
4958    if (firstpass == 0) fortran_out = fopen(output_file,"w");
4959
4960    fortran_parse();
4961
4962    if (firstpass == 0) NewModule_Creation_0();
4963    if (firstpass == 0) fclose(fortran_out);
4964}
Note: See TracBrowser for help on using the repository browser.