Context Navigation

← Previous Revision
Next Revision →
Blame
Revision Log

fortran.y

Last change on this file was 14975, checked in by jchanut, 3 years 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
43	extern int line_num_input;
44
45	char c_selectorname[LONG_M];
46	char ligne[LONG_M];
47	char truename[LONG_VNAME];
48	char identcopy[LONG_VNAME];
49	int c_selectorgiven=0;
50	listvar *curlistvar;
51	int in_select_case_stmt=0;
52	typedim c_selectordim;
53	listcouple *coupletmp;
54	int removeline=0;
55	int token_since_endofstmt = 0;
56	int increment_nbtokens = 1;
57	int in_complex_literal = 0;
58	int close_or_connect = 0;
59	int in_io_control_spec = 0;
60	int intent_spec = 0;
61	long int my_position;
62	long int my_position_before;
63	int suborfun = 0;
64	int indeclaration = 0;
65	int endoffile = 0;
66	int in_inquire = 0;
67	int in_char_selector = 0;
68	int in_kind_selector =0;
69	int char_length_toreset = 0;
70
71	typedim my_dim;
72
73	listvar *test;
74
75	char linebuf1[1024];
76	char linebuf2[1024];
77
78	int 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
515	input:
516	\| input line
517	;
518	line: line-break
519	\| suite_line_list
520	\| error {yyerrok;yyclearin;}
521	;
522	line-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	;
529	suite_line_list :
530	suite_line
531	\| suite_line_list TOK_SEMICOLON '\n'
532	\| suite_line_list TOK_SEMICOLON suite_line
533	;
534	suite_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	/*
546	suite_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
561	fin_line: { pos_cur = setposcur(); }
562	;
563
564	/* R202 : program-unit */
565	program-unit: main-program
566	\| external-subprogram
567	\| module
568	;
569
570	/R203 : external-subprogram /
571	external-subprogram: function-subprogram
572	\| subroutine-subprogram
573	;
574
575	opt_recursive : { isrecursive = 0; }
576	\| TOK_RECURSIVE { isrecursive = 1; }
577	;
578
579	opt_result : { is_result_present = 0; }
580	\| TOK_RESULT arglist_after_result { is_result_present = 1; }
581	;
582
583	name_routine : TOK_NAME { strcpy($$, $1); strcpy(subroutinename, $1); }
584	;
585	filename : TOK_CHAR_CONSTANT { Add_Include_1($1); }
586	;
587	arglist : { if ( firstpass ) $$=NULL; }
588	\| '(' ')' { if ( firstpass ) $$=NULL; }
589	\| '(' {in_complex_literal=0;} args ')' { if ( firstpass ) $$=$3; }
590	;
591	arglist_after_result:
592	\| '(' ')'
593	\| '(' {in_complex_literal=0;} args ')' { if ( firstpass ) Add_SubroutineArgument_Var_1($3); }
594	;
595	args : 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	;
619	arg : TOK_NAME { strcpy($$,$1); }
620	\| '' { strcpy($$,""); }
621	;
622
623	opt_spec :
624	\| access_spec
625	{
626	PublicDeclare = 0 ;
627	PrivateDeclare = 0 ;
628	}
629	;
630	name_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	;
656	use_intrinsic_list :
657	name_intrinsic
658	\| use_intrinsic_list ',' name_intrinsic
659	;
660	list_couple :
661	'(' list_expr ')'
662	\| list_couple ',' '(' list_expr ')'
663	;
664	list_expr_equi :
665	expr_equi
666	\| list_expr_equi ',' expr_equi
667	;
668	expr_equi : '(' list_expr_equi1 ')'
669	;
670	list_expr_equi1 :
671	ident dims
672	\| list_expr_equi1 ',' ident dims
673	;
674	list_expr:
675	expr
676	\| list_expr ',' expr
677	;
678	opt_sep:
679	\| TOK_FOURDOTS
680	;
681
682	before_function : TOK_FUNCTION { functiondeclarationisdone = 1; }
683	;
684	before_parameter : TOK_PARAMETER {VariableIsParameter = 1; pos_curparameter = setposcur()-9; }
685	;
686
687	data_stmt : /* R534 */
688	TOK_DATA data_stmt_set_list
689
690	data_stmt_set_list :
691	data_stmt_set
692	\| data_stmt_set_list opt_comma data_stmt_set
693
694	data_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
719	data_stmt_value_list :
720	expr_data { $$ = Insertname(NULL,$1,0); }
721	\| expr_data ',' data_stmt_value_list { $$ = Insertname($3,$1,1); }
722	;
723
724	save: before_save varsave
725	\| before_save comblock varsave
726	\| save opt_comma comblock opt_comma varsave
727	\| save ',' varsave
728	;
729	before_save:
730	TOK_SAVE { pos_cursave = setposcur()-4; }
731	;
732	varsave :
733	\| TOK_NAME dims { if ( ! inside_type_declare ) Add_Save_Var_1($1,$2); }
734	;
735	datanamelist :
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	;
740	expr_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	;
747	opt_signe : { strcpy($$,""); }
748	\| signe { strcpy($$,$1); }
749	;
750	namelist :
751	TOK_NAMELIST ident
752	\| TOK_NAMELIST comblock ident
753	\| namelist opt_comma comblock opt_comma ident
754	\| namelist ',' ident
755	;
756	before_dimension :
757	TOK_DIMENSION
758	{
759	positioninblock = 0;
760	pos_curdimension = setposcur()-9;
761	}
762
763	dimension :
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	;
785	private :
786	TOK_PRIVATE '\n'
787	\| TOK_PRIVATE opt_sep use_name_list
788	;
789	public :
790	TOK_PUBLIC '\n' { $$ = (listname *) NULL; }
791	\| TOK_PUBLIC opt_sep use_name_list { $$ = $3; }
792	;
793	use_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	;
799	common :
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	;
823	before_common :
824	TOK_COMMON { positioninblock = 0; pos_curcommon = setposcur()-6; }
825	\| TOK_GLOBAL TOK_COMMON { positioninblock = 0; pos_curcommon = setposcur()-6-7; }
826	;
827	var_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	;
831	var_common :
832	TOK_NAME dims
833	{
834	positioninblock = positioninblock + 1 ;
835	strcpy(commonvar,$1);
836	commondim = $2;
837	}
838	;
839	comblock :
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	;
853	opt_comma :
854	\| ','
855	;
856	paramlist :
857	paramitem { $$=insertvar(NULL,$1); }
858	\| paramlist ',' paramitem { $$=insertvar($1,$3); }
859	;
860	paramitem :
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	;
876	module_proc_stmt :
877	TOK_PROCEDURE proc_name_list
878	;
879	proc_name_list :
880	TOK_NAME
881	\| proc_name_list ',' TOK_NAME
882	;
883	implicit :
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	;
894	dcl: 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	;
941	nodimsgiven : { dimsgiven = 0; }
942	;
943	type: 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	;
948	c_selector :
949	\| '*' TOK_CSTINT { c_selectorgiven = 1; strcpy(c_selectorname,$2); }
950	\| '*' '(' c_attribute ')' { c_star = 1;}
951	\| '(' c_attribute ')'
952	;
953	c_attribute :
954	TOK_NAME clause opt_clause
955	\| TOK_NAME '=' clause opt_clause
956	\| clause opt_clause
957	;
958	before_character : TOK_CHARACTER { pos_cur_decl = setposcur()-9; }
959	;
960	typespec :
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	;
968	lengspec :
969	\| '*' proper_lengspec {strcpy(vallengspec,$2);}
970	;
971	proper_lengspec :
972	expr { sprintf($$,"*%s",$1); }
973	\| '(' '' ')' { strcpy($$,"(*)"); }
974	;
975	selector :
976	\| '*' proper_selector
977	\| '(' attribute ')'
978	;
979	proper_selector : expr
980	\| '(' '*' ')'
981	;
982	attribute :
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	;
998	clause :
999	expr { strcpy(CharacterSize,$1); strcpy($$,$1); }
1000	\| '' { strcpy(CharacterSize,""); strcpy($$,"*"); }
1001	\| ':' { strcpy(CharacterSize,":"); strcpy($$,":"); }
1002	;
1003	opt_clause :
1004	\| ',' TOK_NAME clause
1005	;
1006	options:
1007	\| TOK_FOURDOTS
1008	\| ',' attr_spec_list TOK_FOURDOTS
1009	;
1010	attr_spec_list: attr_spec
1011	\| attr_spec_list ',' attr_spec
1012	;
1013	attr_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	;
1028	intent_spec :
1029	TOK_IN { strcpy($$,$1); }
1030	\| TOK_OUT { strcpy($$,$1); }
1031	\| TOK_INOUT { strcpy($$,$1); }
1032	;
1033	access_spec :
1034	TOK_PUBLIC { PublicDeclare = 1; }
1035	\| TOK_PRIVATE { PrivateDeclare = 1; }
1036	;
1037	dims : { $$ = (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	;
1045	dimlist :
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	;
1059	dim : 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	;
1065	ubound :
1066	'' { strcpy($$,""); }
1067	\| expr { strcpy($$,$1); }
1068	;
1069	/*
1070	expr: uexpr { strcpy($$,$1); }
1071	\| complex_const { strcpy($$,$1); }
1072	\| predefinedfunction { strcpy($$,$1); }
1073	\| '(' expr ')' { sprintf($$,"(%s)",$2); }
1074	;
1075	*/
1076	predefinedfunction :
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	;
1104	minmaxlist : expr {strcpy($$,$1);}
1105	\| minmaxlist ',' expr { sprintf($$,"%s,%s",$1,$3); }
1106	;
1107	uexpr : 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	;
1113	signe : '+' { strcpy($$,"+"); }
1114	\| '-' { strcpy($$,"-"); }
1115	;
1116
1117	operation :
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
1140	after_slash : { strcpy($$,""); }
1141	\| expr { sprintf($$,"/%s",$1); }
1142	\| '=' expr %prec TOK_EQ { sprintf($$,"/= %s",$2);}
1143	\| TOK_SLASH expr { sprintf($$,"//%s",$2); }
1144	;
1145	after_equal :
1146	'=' expr %prec TOK_EQ { sprintf($$,"==%s",$2); }
1147	\| expr { sprintf($$,"= %s",$1); }
1148	;
1149
1150	lhs : ident { strcpy($$,$1); }
1151	\| structure_component { strcpy($$,$1); }
1152	\| array_ele_substring_func_ref { strcpy($$,$1); }
1153	;
1154
1155	beforefunctionuse :
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	;
1166	array_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	;
1172	begin_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	;
1181	structure_component :
1182	lhs '%' declare_after_percent lhs
1183	{
1184	sprintf($$," %s %% %s ",$1,$4);
1185	if ( incalldeclare == 0 ) inagrifcallargument = 0;
1186	}
1187	;
1188	/*
1189	vec :
1190	TOK_LEFTAB outlist TOK_RIGHTAB { sprintf($$,"(/%s/)",$2); }
1191	;
1192	*/
1193	funarglist :
1194	beforefunctionuse { strcpy($$," "); }
1195	\| beforefunctionuse funargs { strcpy($$,$2); }
1196	;
1197	funargs :
1198	funarg { strcpy($$,$1); }
1199	\| funargs ',' funarg { sprintf($$,"%s,%s",$1,$3); }
1200	;
1201	funarg :
1202	expr {strcpy($$,$1);}
1203	\| triplet {strcpy($$,$1);}
1204	;
1205	triplet :
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	;
1214	ident: 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	;
1260	simple_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	;
1271	string_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	;
1277	opt_substring : { strcpy($$," ");}
1278	\| substring { strcpy($$,$1);}
1279	;
1280	/*
1281	substring :
1282	'(' optexpr ':' optexpr ')' { sprintf($$,"(%s :%s)",$2,$4);}
1283	;
1284	*/
1285	optexpr : { strcpy($$," ");}
1286	\| expr { strcpy($$,$1);}
1287	;
1288	opt_expr : { strcpy($$," ");}
1289	\| expr { strcpy($$,$1);}
1290	;
1291	initial_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	;
1305	complex_const :
1306	'(' uexpr ',' uexpr ')' {sprintf($$,"(%s,%s)",$2,$4); }
1307	;
1308
1309	only_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	;
1318	only_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 */
1341	specification-part: opt-use-stmt-list opt-declaration-construct-list
1342	;
1343
1344	opt-use-stmt-list:
1345	\|use-stmt-list
1346	;
1347
1348	opt-implicit-part:
1349	\|implicit-part
1350	;
1351
1352	implicit-part: opt-implicit-part-stmt-list implicit-stmt
1353	;
1354
1355	opt-implicit-part-stmt-list:
1356	\| implicit-part-stmt-list
1357	;
1358
1359	implicit-part-stmt-list: implicit-part-stmt
1360	\| implicit-part-stmt-list implicit-part-stmt
1361	;
1362
1363	/* R206: implicit-part-stmt */
1364	implicit-part-stmt: implicit-stmt
1365	\| parameter-stmt
1366	\| format-stmt
1367	;
1368
1369
1370	opt-declaration-construct-list:
1371	\|declaration-construct-list
1372	;
1373
1374	declaration-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
1389	declaration-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
1404	opt-execution-part:
1405	\| execution-part
1406	;
1407
1408	/* R208 : execution-part */
1409	execution-part: executable-construct opt-execution-part-construct-list
1410	;
1411
1412	opt-execution-part-construct-list:
1413	\|execution-part-construct-list
1414	;
1415
1416	execution-part-construct-list:
1417	execution-part-construct
1418	\| execution-part-construct-list execution-part-construct
1419	;
1420
1421	/* R209 : execution-part-construct */
1422	execution-part-construct: executable-construct
1423	\| format-stmt
1424	;
1425
1426	opt-internal-subprogram-part:
1427	\| internal-subprogram-part
1428	;
1429
1430	/* R120 : internal-subprogram-part */
1431	internal-subprogram-part: TOK_CONTAINS line-break
1432	opt-internal-subprogram
1433	;
1434
1435	opt-internal-subprogram:
1436	\| internal-subprogram-list
1437	;
1438
1439	internal-subprogram-list: internal-subprogram
1440	\| internal-subprogram-list internal-subprogram
1441	;
1442
1443	/* R211 : internal-subprogram */
1444	internal-subprogram: function-subprogram
1445	\| subroutine-subprogram
1446	;
1447
1448	/* R212 : other-specification-stmt */
1449	other-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 */
1461	executable-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
1473	action-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 */
1523	keyword: ident
1524	;
1525
1526	scalar-constant: constant
1527	;
1528
1529	/* R304 : constant */
1530
1531	constant: literal-constant
1532	\| named-constant
1533	;
1534
1535	/* R305 : literal-constant */
1536	literal-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 */
1545	named-constant: ident
1546	;
1547
1548	scalar-int-constant:int-constant
1549	;
1550
1551	/* R307 : int-constant */
1552	int-constant: int-literal-constant
1553	\| named-constant
1554	;
1555
1556	/*
1557	constant: TOK_CSTINT
1558	\| TOK_CSTREAL
1559	\| ident
1560	;
1561	*/
1562
1563	opt-label:
1564	{strcpy($$,"");}
1565	\| label
1566	;
1567
1568	/* R312 : label */
1569	label: TOK_LABEL
1570	\| TOK_CSTINT
1571	;
1572
1573	opt-label-djview:
1574	{strcpy($$,"");}
1575	\| label-djview
1576	{strcpy($$,$1);}
1577	;
1578
1579	label-djview: TOK_LABEL_DJVIEW
1580	;
1581
1582	/* R401 : type-param-value */
1583	type-param-value: scalar-int-expr
1584	\| '*'
1585	\| ':'
1586	;
1587
1588	/* R402: type-spec */
1589	type-spec: intrinsic-type-spec
1590	{strcpy($$,$1);}
1591	\| derived-type-spec
1592	{strcpy($$,$1);}
1593	;
1594
1595	/* R403 : declaration-type-spec */
1596	declaration-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 */
1604	intrinsic-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
1618	opt-kind-selector:
1619	{strcpy($$,"");strcpy(NamePrecision,"");}
1620	\|kind-selector
1621	{strcpy($$,$1);}
1622	;
1623
1624	/* R405 : kind-selector */
1625	/* Nonstandard extension : * INT */
1626	kind-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
1637	signed-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 */
1643	int-literal-constant: TOK_CSTINT
1644	\| TOK_CSTINT '_' kind-param
1645	{sprintf($$,"%s_%s",$1,$3);}
1646	;
1647
1648	/R408 : kind-param /
1649	kind-param: TOK_CSTINT
1650	\| TOK_NAME
1651	;
1652
1653	opt-sign:
1654	\| sign
1655	;
1656
1657	/* R411 : sign */
1658	sign:'+'
1659	{strcpy($$,"+");}
1660	\| '-'
1661	{strcpy($$,"-");}
1662	;
1663
1664	/* R412 : signed-real-literal-constant */
1665	/* sign replaced by add-op */
1666	signed-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 */
1672	real-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
1680	complex-literal-constant: '(' real-part TOK_COMMACOMPLEX imag-part ')'
1681	{sprintf($$,"(%s,%s)",$2,$4);}
1682	;
1683
1684
1685	/* R418 : real-part */
1686	real-part: signed-int-literal-constant
1687	\| signed-real-literal-constant
1688	\| ident
1689	;
1690
1691	/* R419 : imag-part */
1692	imag-part: signed-int-literal-constant
1693	\| signed-real-literal-constant
1694	\| named-constant
1695	;
1696
1697	opt-char_length-star:
1698	\| '*' char-length
1699	{char_length_toreset = 1;}
1700	;
1701
1702	opt-char-selector:
1703	{strcpy($$,"");}
1704	\| char-selector
1705	{strcpy($$,"");}
1706	;
1707
1708	/* R420 : char-selector */
1709	char-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 */
1717	length-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 */
1726	char-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 */
1733	char-literal-constant: TOK_CHAR_CONSTANT
1734	\| TOK_CHAR_MESSAGE
1735	\| TOK_CHAR_CUT
1736	;
1737
1738	/* R424 : logical-literal-constant */
1739	logical-literal-constant: TOK_TRUE
1740	\| TOK_FALSE
1741	;
1742
1743	/* R425 : derived-type-def */
1744	derived-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 */
1749	derived-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
1753	opt-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
1761	type-attr-spec-list: type-attr-spec
1762	\| type-attr-spec-list ',' type-attr-spec
1763	;
1764
1765	/* R427 : type-attr-spec */
1766	type-attr-spec: access-spec
1767	;
1768
1769	type-param-name-list: type-param-name
1770	\| type-param-name-list ',' type-param-name
1771	;
1772
1773	type-param-name: TOK_NAME
1774	;
1775
1776	/* R429 : end-type-stmt */
1777	end-type-stmt: TOK_ENDTYPE line-break
1778	\| TOK_ENDTYPE TOK_NAME line-break
1779	;
1780
1781	opt-component-part:
1782	\| component-part
1783	;
1784
1785	/* R434 : component-part */
1786	component-part: component-def-stmt
1787	\| component-part component-def-stmt
1788	;
1789
1790	/* R435 : component-def-stmt */
1791	component-def-stmt: data-component-def-stmt
1792	;
1793
1794	/* R436 : data-component-def-stmt */
1795	data-component-def-stmt: declaration-type-spec opt-component-attr-spec-list-comma-2points component-decl-list line-break
1796	;
1797
1798	opt-component-attr-spec-list-comma-2points:
1799	\| TOK_FOURDOTS
1800	\| ',' component-attr-spec-list TOK_FOURDOTS
1801	;
1802
1803	component-attr-spec-list: component-attr-spec
1804	\| component-attr-spec-list ',' component-attr-spec
1805	;
1806
1807	/* R437 : component-attr-spec */
1808	component-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
1815	component-decl-list: component-decl
1816	\| component-decl-list ',' component-decl
1817	;
1818
1819	/* R438 : component-decl */
1820	component-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
1844	opt-component-array-spec:
1845	\| '(' component-array-spec ')'
1846	;
1847
1848	/* R439 : component-array-spec */
1849	component-array-spec: explicit-shape-spec-list
1850	\| deferred-shape-spec-list
1851	;
1852
1853	opt-component-initialization:
1854	\| component-initialization
1855	;
1856
1857	/* R442 : component-initialization */
1858	component-initialization: '=' constant-expr
1859	\| TOK_POINT_TO null-init
1860	\| TOK_POINT_TO initial-data-target
1861	;
1862
1863	/* R443 initial-data-target */
1864	initial-data-target: designator
1865	{strcpy(my_dim.last,"");}
1866	;
1867
1868	/* R453 : derived-type-spec */
1869	derived-type-spec: ident
1870	{strcpy(NamePrecision,$1);}
1871	\| ident '(' type-param-spec-list ')'
1872	;
1873
1874	type-param-spec-list: type-param-spec
1875	\| type-param-spec-list ',' type-param-spec
1876	;
1877
1878	/* R454 : type-param-spec */
1879	type-param-spec: type-param-value
1880	\| keyword '=' type-param-value
1881	;
1882
1883	/* R455 : structure-constructor */
1884	structure-constructor: derived-type-spec '(' ')'
1885	\| derived-type-spec '(' component-spec-list ')'
1886	;
1887
1888	component-spec-list: component-spec
1889	\| component-spec-list ',' component-spec
1890	;
1891
1892	/* R456 : component-spec */
1893	component-spec: component-data-source
1894	\| keyword '=' component-data-source
1895	;
1896
1897	/* R457 : component-data-source */
1898	component-data-source: expr
1899	\| data-target
1900	\| proc-target
1901	;
1902
1903	/* R468 : array-constructor */
1904	array-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
1921	ac-spec: ac-value-list
1922	;
1923
1924	/* R470 : lbracket */
1925	lbracket: '['
1926	;
1927
1928	/* R471 : rbracket */
1929	rbracket: ']'
1930	;
1931
1932	ac-value-list:
1933	ac-value
1934	\| ac-value-list ',' ac-value
1935	{sprintf($$,"%s,%s",$1,$3);}
1936	;
1937
1938	/* R472 : ac-value */
1939	ac-value: expr
1940	\| ac-implied-do
1941	;
1942
1943	/* R473 : ac-implied-do */
1944	ac-implied-do: '(' ac-value-list ',' ac-implied-do-control ')'
1945	{sprintf($$,"(%s,%s)",$2,$4);}
1946	;
1947
1948	/* R474 : ac-implied-do-control */
1949	ac-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 */
1956	ac-do-variable: do-variable
1957	;
1958
1959	/* R501 : type-declaration-stmt */
1960	type-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
2029	opt-attr-spec-construct:
2030	\| opt-attr-spec-comma-list TOK_FOURDOTS
2031	;
2032
2033	opt-attr-spec-comma-list:
2034	\| attr-spec-comma-list
2035	;
2036
2037	attr-spec-comma-list:
2038	',' attr-spec
2039	\| attr-spec-comma-list ',' attr-spec
2040	;
2041
2042	/* R502 : attr-spec */
2043	attr-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
2068	entity-decl-list: entity-decl
2069	{$$=insertvar(NULL,$1);}
2070	\| entity-decl-list ',' entity-decl
2071	{$$=insertvar($1,$3);}
2072	;
2073
2074	/* R503 : entity-decl */
2075	entity-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 */
2109	object-name: ident
2110	;
2111
2112	object-name-noident: TOK_NAME
2113	;
2114
2115	opt-initialization: {InitialValueGiven = 0; }
2116	\| initialization
2117	;
2118
2119	/* R505 : initialization */
2120	initialization: '=' 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 */
2141	null-init: function-reference
2142	;
2143
2144	/* R507 : access-spec */
2145	access-spec: TOK_PUBLIC
2146	{PublicDeclare = 1; }
2147	\| TOK_PRIVATE
2148	{PrivateDeclare = 1; }
2149	;
2150
2151	opt-array-spec-par:
2152	{$$=NULL;}
2153	\| '(' {in_complex_literal=0;} array-spec ')'
2154	{$$=$3;}
2155	;
2156
2157	/* R514 : array-spec */
2158	array-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
2170	explicit-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 */
2185	explicit-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 */
2192	lower-bound: specification-expr
2193	{strcpy($$,$1);}
2194	;
2195
2196	/* R518 : upper-bound */
2197	upper-bound: specification-expr
2198	;
2199
2200	assumed-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 */
2216	assumed-shape-spec : ':'
2217	{ strcpy($$.first,""); strcpy($$.last,""); }
2218	\| lower-bound ':'
2219	{ strcpy($$.first,$1); Save_Length($1,2); strcpy($$.last,""); }
2220	;
2221
2222	deferred-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 */
2238	deferred-shape-spec: ':'
2239	{ strcpy($$.first,""); strcpy($$.last,""); }
2240	;
2241
2242	/* R521 : assume-size-spec */
2243	assumed-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
2265	opt-explicit-shape-spec-list-comma:
2266	{$$ = (listdim *) NULL;}
2267	\| explicit-shape-spec-list ','
2268	{$$ = $1;}
2269	;
2270
2271	explicit-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
2285	opt-lower-bound-2points:
2286	{strcpy($$,"");}
2287	\| lower-bound ':'
2288	{strcpy($$,$1);}
2289	;
2290
2291	implied-shape-spec-list: implied-shape-spec
2292	\| implied-shape-spec-list ',' implied-shape-spec
2293	;
2294
2295	/* R522 : implied-shape-spec */
2296	implied-shape-spec: opt-lower-bound-2points '*'
2297	;
2298
2299	/* R523 : intent-spec */
2300	intent-spec: TOK_IN
2301	{ strcpy($$,$1); }
2302	\| TOK_OUT
2303	{ strcpy($$,$1); }
2304	\| TOK_INOUT
2305	{ strcpy($$,$1); }
2306	;
2307
2308	/* R524 : access-stmt */
2309	access-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
2327	opt-access-id-list:
2328	{$$=(listname *)NULL;}
2329	\| opt-TOK_FOURDOTS access-id-list
2330	{$$=$2;}
2331	;
2332
2333	access-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 */
2340	access-id: TOK_NAME
2341	\| generic-spec
2342	;
2343
2344	/* R534 : data-stmt */
2345	data-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
2360	opt-data-stmt-set-nlist:
2361	\| data-stmt-set-nlist
2362	;
2363
2364	data-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 */
2369	data-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
2379	data-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
2387	data-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 */
2394	data-stmt-object: variable
2395	\| data-implied-do
2396	;
2397
2398	/* R537 : data-implied-do */
2399	data-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
2412	data-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 */
2419	data-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 */
2428	data-i-do-variable: do-variable
2429	;
2430
2431	/* R540 : data-stmt-value */
2432	/* data-stmt-repeat and first data-stmt-constant inlined */
2433	data-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
2446	opt-data-stmt-star:
2447	{strcpy($$,"");}
2448	\| '*' data-stmt-constant
2449	{sprintf($$,"*%s",$2);}
2450	;
2451
2452	opt-data-stmt-repeat-star:
2453	\| data-stmt-repeat '*'
2454	;
2455
2456	/* R541 : data-stmt-repeat */
2457	/* scalar-int-constant inlined */
2458
2459	data-stmt-repeat: scalar-int-constant
2460	\| scalar-int-constant-subobject
2461	;
2462
2463	/* R542 : data-stmt-constant */
2464	data-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
2473	scalar-int-constant-subobject: int-constant-subobject
2474	;
2475
2476	scalar-constant-subobject: constant-subobject
2477	;
2478
2479	/* R543 : int-constant-subobject */
2480	int-constant-subobject: constant-subobject
2481	;
2482
2483	/* R544 : constant-subobject */
2484	constant-subobject: designator
2485	{strcpy(my_dim.last,"");}
2486	;
2487
2488	/* R545 : dimension-stmt */
2489	dimension-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
2537	array-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 */
2559	parameter-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
2579	named-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 */
2586	named-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 */
2603	save-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
2611	opt-TOK_FOURDOTS:
2612	\| TOK_FOURDOTS
2613	;
2614
2615	opt-saved-entity-list:
2616	\| saved-entity-list
2617	;
2618
2619	saved-entity-list: saved-entity
2620	\| saved-entity-list ',' saved-entity
2621	;
2622
2623	/* R554 : saved-entity */
2624	saved-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 */
2631	proc-pointer-name: ident
2632	;
2633
2634	get_my_position:
2635	{my_position = my_position_before;}
2636	;
2637
2638	/* R560 : implicit-stmt */
2639	implicit-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
2652	implicit-spec-list: implicit-spec
2653	\| implicit-spec-list ',' implicit-spec
2654	;
2655
2656	/R561 implicit-spec /
2657	implicit-spec: declaration-type-spec '(' letter-spec-list ')'
2658	;
2659
2660	letter-spec-list:letter-spec
2661	\| letter-spec-list ',' letter-spec
2662	;
2663
2664	/* R562 : letter-spec */
2665	letter-spec: TOK_NAME
2666	\| TOK_NAME '-' TOK_NAME
2667	;
2668
2669	/* R563 : namelist-stmt */
2670	namelist-stmt: TOK_NAMELIST TOK_SLASH TOK_NAME TOK_SLASH namelist-group-object-list opt-namelist-other line-break
2671	;
2672
2673	opt-namelist-other:
2674	\| opt-namelist-other opt-comma TOK_SLASH TOK_NAME TOK_SLASH namelist-group-object-list
2675
2676	namelist-group-object-list:namelist-group-object
2677	\| namelist-group-object-list ',' namelist-group-object
2678	;
2679
2680	/* R564 : namelist-group-object */
2681	namelist-group-object: variable-name
2682	;
2683
2684	/* R565 : equivalence-stmt */
2685	equivalence-stmt: TOK_EQUIVALENCE equivalence-set-list line-break
2686	;
2687
2688	equivalence-set-list:equivalence-set
2689	\| equivalence-set-list ',' equivalence-set
2690	;
2691
2692	/* R566 : equivalence-set */
2693	equivalence-set: '(' {in_complex_literal=0;} equivalence-object ',' equivalence-object-list ')'
2694	;
2695
2696	equivalence-object-list:equivalence-object
2697	\| equivalence-object-list ',' equivalence-object
2698	;
2699
2700	/* R567 : equivalence-object */
2701	equivalence-object: variable-name
2702	\| array-element
2703	\| substring
2704	;
2705
2706
2707	/* R568 : common-stmt */
2708	common-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
2718	opt-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
2727	common-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
2741	opt-comma:
2742	\| ','
2743	;
2744
2745	opt-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
2756	common-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
2766	common-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 */
2781	designator: 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
2793	scalar-variable: variable
2794	;
2795
2796	variable: 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
2805	scalar-variable-name: variable-name
2806	;
2807
2808	/* R603 : variable-name */
2809	variable-name: ident
2810	;
2811
2812	scalar-logical-variable: logical-variable
2813	;
2814
2815	/* R604 : logical-variable */
2816	logical-variable: variable
2817	;
2818
2819	/* R605 : char-variable */
2820	char-variable: variable
2821	;
2822
2823	scalar-default-char-variable: default-char-variable
2824	;
2825
2826	/* R606 : default-char-variable */
2827	default-char-variable: variable
2828	;
2829
2830	scalar-int-variable: int-variable
2831	;
2832
2833	int-variable: variable
2834	;
2835
2836	/* R608 : substring */
2837	substring: 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	/*
2847	parent-string: scalar-variable-name
2848	\| array-element
2849	\| scalar-structure-component
2850	\| scalar-constant
2851	;
2852	*/
2853
2854	/* R610 : substring-range */
2855	substring-range: opt-scalar-int-expr ':' opt-scalar-int-expr
2856	{sprintf($$,"%s:%s",$1,$3);}
2857	;
2858
2859	/* R611: data-ref */
2860	data-ref: part-ref opt-part-ref
2861	{sprintf($$,"%s%s",$1->v_nomvar,$2);}
2862	;
2863
2864	opt-part-ref:
2865	{strcpy($$,"");}
2866	\| opt-part-ref '%' part-ref
2867	{sprintf($$,"%s%%%s",$1,$3->v_nomvar);}
2868	;
2869
2870	/* R612 : part-ref */
2871	part-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
2885	scalar-structure-component: structure-component
2886	;
2887
2888	/* R613 : structure-component */
2889	structure-component: data-ref
2890	{strcpy(my_dim.last,"");}
2891	;
2892
2893	/* R617 : array-element */
2894	array-element: data-ref
2895	{strcpy(my_dim.last,"");}
2896	;
2897
2898	/* R618 : array-section */
2899	array-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 ... */
2907	section-subscript-list:
2908	{strcpy($$,"");}
2909	\| section-subscript
2910	{strcpy($$,$1);}
2911	\| section-subscript-list ',' section-subscript
2912	{sprintf($$,"%s,%s",$1,$3);}
2913	;
2914
2915	opt-subscript:
2916	{strcpy($$,"");}
2917	\| subscript
2918	;
2919
2920	/* R619 : subscript */
2921	subscript: 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
2933	section-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
2954	section_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 */
2968	subscript-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 */
2975	stride: scalar-int-expr
2976	;
2977
2978	/* R623 : vector-subscript */
2979	vector-subscript: int-expr
2980	;
2981
2982	/* R626 : allocate-stmt */
2983	allocate-stmt: TOK_ALLOCATE '(' {in_complex_literal=0;} allocation-list opt-alloc-opt-list-comma ')'
2984	{inallocate = 0;}
2985	line-break
2986	;
2987
2988	opt-type-spec-fourdots:
2989	\| type-spec TOK_FOURDOTS
2990	;
2991
2992	opt-alloc-opt-list-comma:
2993	\| ',' alloc-opt-list
2994	;
2995
2996	alloc-opt-list:
2997	alloc-opt
2998	\| alloc-opt-list ',' alloc-opt
2999	;
3000
3001	/* R627 : alloc-opt */
3002	alloc-opt: TOK_ERRMSG errmsg-variable
3003	\| TOK_STAT '=' stat-variable
3004	;
3005
3006	/* R628 : stat-variable */
3007	stat-variable: scalar-int-variable
3008	;
3009
3010	/* R629 : errmsg-variable */
3011	errmsg-variable: scalar-default-char-variable
3012	;
3013
3014	allocation-list:
3015	allocation
3016	\| allocation-list ',' allocation
3017	;
3018
3019	/* R631 allocation */
3020	allocation: allocate-object opt-allocate-shape-spec-list-par
3021	;
3022
3023	/* R632 allocate-object */
3024	allocate-object: variable-name
3025	\| structure-component
3026	;
3027
3028	opt-allocate-shape-spec-list-par:
3029	\| '(' allocate-shape-spec-list ')'
3030	;
3031
3032	allocate-shape-spec-list:
3033	allocate-shape-spec
3034	\| allocate-shape-spec-list ',' allocate-shape-spec
3035	;
3036
3037	/* R633 : allocate-shape-spec */
3038	allocate-shape-spec: opt-lower-bound-expr upper-bound-expr
3039	;
3040
3041	opt-lower-bound-expr:
3042	\| lower-bound-expr ':'
3043	;
3044
3045	/* R634 : lower-bound-expr */
3046	lower-bound-expr: scalar-int-expr
3047	;
3048
3049	/* R634 : upper-bound-expr */
3050	upper-bound-expr: scalar-int-expr
3051	;
3052
3053	/* R640 : deallocate-stmt */
3054	deallocate-stmt: TOK_DEALLOCATE '(' {in_complex_literal=0;} allocate-object-list opt-dealloc-opt-list-comma ')'
3055	{inallocate = 0;}
3056	line-break
3057	;
3058
3059	allocate-object-list:
3060	allocate-object
3061	\| allocate-object-list ',' allocate-object
3062	;
3063
3064	opt-dealloc-opt-list-comma:
3065	\| ',' dealloc-opt-list
3066	;
3067
3068	dealloc-opt-list:
3069	dealloc-opt
3070	\| dealloc-opt-list ',' dealloc-opt
3071	;
3072
3073	/* R641 : dealloc-opt */
3074	dealloc-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
3083	primary:
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 */
3102	level-1-expr: primary
3103	{strcpy(my_dim.last,"");}
3104	;
3105
3106	/* R704 : mult-operand */
3107	mult-operand: level-1-expr
3108	\| level-1-expr power-op mult-operand
3109	{sprintf($$,"%s**%s",$1,$3);}
3110	;
3111	/* R705 : add-operand */
3112	add-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
3120	level-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 */
3131	power-op : TOK_DASTER
3132	;
3133
3134	/* R708 : mult-op */
3135	mult-op : '*'
3136	{strcpy($$,"*");}
3137	\| TOK_SLASH
3138	;
3139
3140	/* R709 : add-op */
3141	add-op : '+'
3142	{strcpy($$,"+");}
3143	\| '-'
3144	{strcpy($$,"-");}
3145	;
3146
3147	/* R710 : level-3-expr */
3148	level-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 */
3154	concat-op : TOK_DSLASH
3155	;
3156	/* R712 : level-4-expr */
3157	level-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 */
3163	rel-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 */
3181	and-operand: level-4-expr
3182	\| not-op level-4-expr
3183	{ sprintf($$,"%s%s",$1,$2); }
3184	;
3185
3186
3187	/* R715 : or-operand */
3188	or-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 */
3195	equiv-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 */
3201	level-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 */
3207	not-op: TOK_NOT
3208	;
3209
3210	/* R719 : and-op */
3211	and-op: TOK_AND
3212	;
3213
3214	/* R720 : or-op */
3215	or-op: TOK_OR
3216	;
3217
3218	/* R721 : equiv-op */
3219	equiv-op: TOK_EQV
3220	\| TOK_NEQV
3221	;
3222
3223	/* R722 : expr */
3224	expr: level-5-expr
3225	;
3226
3227	scalar-default-char-expr: default-char-expr
3228	;
3229
3230	/* R725 : default-char-expr */
3231	default-char-expr : expr
3232	;
3233
3234	/* R726 : int-expr */
3235	int-expr: expr
3236	;
3237
3238	opt-scalar-int-expr:
3239	{strcpy($$,"");}
3240	\| scalar-int-expr
3241	;
3242
3243	scalar-int-expr: int-expr
3244	;
3245
3246	/* R728 : specification-expr */
3247	specification-expr: scalar-int-expr
3248	{
3249	strcpy($$,$1);
3250	}
3251	;
3252
3253	/* R729 : constant-expr */
3254	constant-expr: expr
3255	{strcpy($$,$1);}
3256	;
3257
3258	scalar-default-char-constant-expr: default-char-constant-expr
3259	;
3260
3261	/* R730: default-char-constant-expr */
3262	default-char-constant-expr: default-char-expr
3263	;
3264
3265	scalar-int-constant-expr: int-constant-expr
3266	;
3267
3268	/* R731 : int-constant-expr */
3269	int-constant-expr: int-expr
3270	;
3271
3272	/* R732 : assignment-stmt */
3273	/* cannot use opt-label due to conflicts ... */
3274
3275	assignment-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
3288	pointer-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 */
3294	data-pointer-object: variable-name
3295	\| scalar-variable '%' TOK_NAME
3296	;
3297
3298	opt-bounds-spec-list-par:
3299	\| '(' bounds-spec-list ')'
3300	;
3301
3302	bounds-spec-list:
3303	bounds-spec
3304	\| bounds-spec-list ',' bounds-spec
3305	;
3306
3307	bounds-remapping-list:
3308	bounds-remapping
3309	\| bounds-remapping-list ',' bounds-remapping
3310	;
3311
3312	/* R735 : bounds-spec */
3313	bounds-spec: lower-bound-expr ':'
3314	;
3315
3316	/* R736 : bounds-remapping */
3317	bounds-remapping: lower-bound-expr ':' upper-bound-expr
3318	;
3319
3320	/* R737 : data-target */
3321	data-target: variable
3322	;
3323
3324	procedure-component-name: TOK_NAME
3325	;
3326
3327	/* R738 : proc-pointer-object */
3328	proc-pointer-object: proc-pointer-name
3329	\| proc-component-ref
3330	;
3331
3332	/* R739 : proc-component-ref */
3333	proc-component-ref : scalar-variable '%' procedure-component-name
3334	;
3335
3336	/* R740 : proc-target */
3337	proc-target: expr
3338	\| procedure-component-name
3339	\| proc-component-ref
3340	;
3341
3342	/* R741 : where-stmt */
3343	where-stmt: TOK_WHERE '(' mask-expr ')' where-assignment-stmt
3344	;
3345
3346	/* R742 : where-construct */
3347	where-construct: where-construct-stmt opt-where-body-construct opt-masked-elsewhere-construct opt-elsewhere-construct end-where-stmt
3348	;
3349
3350	opt-where-body-construct:
3351	\| opt-where-body-construct where-body-construct
3352	;
3353
3354	opt-masked-elsewhere-construct :
3355	\| opt-masked-elsewhere-construct masked-elsewhere-stmt opt-where-body-construct
3356	;
3357
3358	opt-elsewhere-construct:
3359	\| opt-elsewhere-construct elsewhere-stmt opt-where-body-construct
3360	;
3361
3362	/* R743 : where-construct-stmt */
3363	where-construct-stmt: TOK_WHERE '(' mask-expr ')' line-break
3364	;
3365
3366	/* R744 : where-body-construct */
3367	where-body-construct: where-assignment-stmt
3368	\| where-stmt
3369	\| where-construct
3370	;
3371
3372	/* R745 : where-assignment-stmt */
3373	where-assignment-stmt: assignment-stmt
3374	;
3375
3376	/* R746 : mask-expr */
3377	mask-expr: expr
3378	;
3379
3380	/* R747 : masked-elsewhere-stmt */
3381	masked-elsewhere-stmt: TOK_ELSEWHEREPAR mask-expr ')' line-break
3382	\| TOK_ELSEWHEREPAR mask-expr ')' TOK_NAME line-break
3383	;
3384
3385	/* R748: elsewhere-stmt */
3386	elsewhere-stmt: TOK_ELSEWHERE line-break
3387	\| TOK_ELSEWHERE TOK_NAME line-break
3388	;
3389
3390	/* R749: end-where-stmt */
3391	end-where-stmt:
3392	TOK_ENDWHERE line-break
3393	\| TOK_ENDWHERE TOK_NAME line-break
3394	;
3395
3396	/* R752 : forall-header */
3397	forall-header :
3398	;
3399
3400	/* R801 : block */
3401	block: opt-execution-part-construct
3402	;
3403
3404	opt-execution-part-construct:
3405	\| opt-execution-part-construct execution-part-construct
3406	;
3407
3408	/* R813 : do-construct */
3409	do-construct:
3410	block-do-construct
3411	\| nonblock-do-construct
3412	;
3413
3414	do-construct:
3415	block-do-construct
3416	;
3417
3418	/* R814 : block-do-construct */
3419
3420	block-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 */
3432	label-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
3438	label-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 */
3445	nonlabel-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 */
3452	loop-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 */
3460	do-variable: ident
3461	;
3462
3463	/* R820 : do-block */
3464	do-block: block
3465	;
3466
3467	/* R821 : end-do */
3468	/*end-do: end-do-stmt
3469	\| do-term-action-stmt
3470	;
3471	*/
3472
3473	end-do: end-do-stmt
3474	\| label-djview continue-stmt
3475	;
3476
3477	/* R822 : end-do-stmt */
3478	end-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	/*
3486	nonblock-do-construct: outer-shared-do-construct
3487	;
3488	*/
3489
3490	nonblock-do-construct: action-term-do-construct
3491	\| outer-shared-do-construct
3492	;
3493
3494
3495	/* R824 : action-term-do-construct */
3496
3497	action-term-do-construct: label-do-stmt do-block do-term-action-stmt
3498	;
3499
3500	/* R825 : do-body */
3501
3502	do-body :
3503	\| execution-part-construct do-body
3504	;
3505
3506	/* R826 : do-term-action-stmt */
3507	do-term-action-stmt: label-djview do-term-action-stmt-special
3508	;
3509
3510	/* do-term-action-stmt-special */
3511	do-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
3534	we extend the definition of outer-shared-do-construct
3535	a label-do-stmt statement must be followed by a label-do-stmt-djview statement
3536	*/
3537
3538	outer-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
3542	label-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
3548	shared-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 */
3554	inner-shared-do-construct: label-do-stmt-djview do-block do-term-shared-stmt
3555	;
3556
3557	/* R830 : do-term-shared-stmt */
3558
3559	do-term-shared-stmt: label-djview action-stmt
3560	;
3561
3562	opt-do-construct-name:
3563	\| TOK_NAME
3564	;
3565
3566	/* R831 : cycle-stmt */
3567	cycle-stmt: TOK_CYCLE opt-do-construct-name line-break
3568	;
3569
3570	/* R832 : if-construct */
3571	if-construct: if-then-stmt block opt-else-if-stmt-block opt-else-stmt-block end-if-stmt
3572	;
3573
3574	opt-else-if-stmt-block:
3575	\| else-if-stmt-block
3576	\| opt-else-if-stmt-block else-if-stmt-block
3577	;
3578
3579	else-if-stmt-block: else-if-stmt block
3580	;
3581
3582	opt-else-stmt-block:
3583	\| else-stmt-block
3584	\| opt-else-stmt-block else-if-stmt-block
3585	;
3586
3587	else-stmt-block: else-stmt block
3588	;
3589
3590	/* R833 : if-then-stmt */
3591	if-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 */
3597	else-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 */
3602	else-stmt:TOK_ELSE line-break
3603	\| TOK_ELSE TOK_NAME line-break
3604	;
3605
3606	/* R836 : end-if-stmt */
3607	end-if-stmt:TOK_ENDIF line-break
3608	\| TOK_ENDIF TOK_NAME line-break
3609	;
3610
3611	/* R837 : if-stmt */
3612	if-stmt: opt-label TOK_LOGICALIF_PAR expr ')' action-stmt
3613	;
3614
3615	/* R838 : case-construct */
3616	case-construct: select-case-stmt opt_case-stmt-block end-select-stmt
3617	;
3618
3619	opt_case-stmt-block:
3620	\| case-stmt-block
3621	\| opt_case-stmt-block case-stmt-block
3622	;
3623
3624	case-stmt-block: case-stmt block
3625	;
3626
3627	/* R839 : select-case-stmt */
3628	select-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 */
3633	case-stmt:TOK_CASE case-selector line-break
3634	\| TOK_CASE case-selector TOK_NAME line-break
3635	;
3636
3637	/* R840 : end-select-stmt */
3638	end-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 */
3643	case-selector:
3644	'(' {in_complex_literal=0;} case-value-range-list ')'
3645	\| TOK_DEFAULT
3646	;
3647
3648	case-value-range-list:
3649	case-value-range
3650	\| case-value-range-list ',' case-value-range
3651	;
3652
3653	/* R844: case-value-range */
3654	case-value-range :
3655	case-value
3656	\| case-value ':'
3657	\| ':' case-value
3658	\| case-value ':' case-value
3659	;
3660
3661	/* R845 : case-value */
3662	case-value: expr
3663	;
3664
3665	/* R850 : exit-stmt */
3666	exit-stmt: TOK_EXIT line-break
3667	\| TOK_EXIT TOK_NAME line-break
3668	;
3669
3670	/* R851 : goto-stmt */
3671	goto-stmt: TOK_PLAINGOTO label line-break
3672	;
3673
3674	/* R853 arithmetic-if-stmt */
3675	arithmetic-if-stmt: opt-label TOK_LOGICALIF_PAR expr ')' label ',' label ',' label line-break
3676	;
3677
3678	/* R854 : continue-stmt */
3679	continue-stmt: opt-label TOK_CONTINUE line-break
3680	;
3681
3682	/* R855 : stop-stmt */
3683	stop-stmt: TOK_STOP line-break
3684	\| TOK_STOP stop-code line-break
3685	;
3686
3687	/* R857 : stop-code */
3688	stop-code: scalar-default-char-constant-expr
3689	\| scalar-int-constant-expr
3690	;
3691
3692	/* R901 : io-unit */
3693	io-unit : file-unit-number
3694	\| '*'
3695	\| internal-file-variable
3696	;
3697
3698	/* R902 : file-unit-number */
3699	file-unit-number : scalar-int-expr
3700	;
3701
3702	/* R902 : internal-file-variable */
3703	internal-file-variable : char-variable
3704	;
3705
3706	/* R904 : open-stmt */
3707	open-stmt: TOK_OPEN '(' {close_or_connect = 1;} connect-spec-list ')' {close_or_connect = 0;} line-break
3708	;
3709
3710	connect-spec-list: connect-spec
3711	\| connect-spec-list ',' connect-spec
3712	;
3713
3714	/* R905 : connect-spec */
3715	connect-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 */
3730	file-name-expr: scalar-default-char-expr
3731	;
3732
3733	/* R907 : iomsg-variable */
3734	iomsg-variable: scalar-default-char-variable
3735	;
3736
3737	/* R908 : close-stmt */
3738	close-stmt: opt-label TOK_CLOSE '(' {close_or_connect = 1;} close-spec-list ')' line-break
3739	{close_or_connect = 0;}
3740	;
3741
3742	close-spec-list: close-spec
3743	\| close-spec-list ',' close-spec
3744	;
3745
3746	/* R909 : close-spec */
3747	close-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 */
3756	read-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 */
3771	write-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 */
3784	print-stmt: opt-label TOK_PRINT format line-break
3785	\| opt-label TOK_PRINT format ',' output-item-list line-break
3786	;
3787	io-control-spec-list: io-control-spec
3788	\| io-control-spec-list ',' io-control-spec
3789	;
3790
3791	namelist-group-name: TOK_NAME
3792	;
3793
3794	/* R913 : io-control-spec */
3795	io-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 */
3810	format: default-char-expr
3811	\| label
3812	\| '*'
3813	;
3814	input-item-list:
3815	input-item
3816	\| input-item-list ',' input-item
3817	;
3818	/* R916 : input-item */
3819	input-item: variable
3820	\| io-implied-do
3821	;
3822
3823	output-item-list:
3824	output-item
3825	\| output-item-list ',' output-item
3826	;
3827
3828	/* R917 : output-item */
3829	output-item: expr
3830	\| io-implied-do
3831	;
3832
3833	/* R918 : io-implied-do */
3834	io-implied-do : '(' io-implied-do-object-list ',' io-implied-do-control ')'
3835	;
3836
3837	io-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
3848	io-implied-do-object : output-item
3849	;
3850
3851	/* R920 : io-implied-do-control */
3852	io-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 */
3857	rewind-stmt: TOK_REWIND file-unit-number line-break
3858	\| TOK_REWIND '(' position-spec-list ')' line-break
3859	;
3860
3861	position-spec-list:
3862	position-spec
3863	\| position-spec-list ',' position-spec
3864	;
3865
3866	/* R927 : position-spec */
3867	position-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 */
3875	flush-stmt: TOK_FLUSH file-unit-number line-break
3876	\| TOK_FLUSH '(' flush-spec-list ')' line-break
3877	;
3878
3879	flush-spec-list:
3880	flush-spec
3881	\| flush-spec-list ',' flush-spec
3882	;
3883
3884	/* R929 : flush-spec */
3885	flush-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 */
3894	inquire-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
3902	set_in_inquire: {in_inquire=1;}
3903	;
3904
3905	inquire-spec-list:
3906	inquire-spec
3907	\| inquire-spec-list ',' inquire-spec
3908	;
3909
3910	/* R931 : inquire-spec */
3911	inquire-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 */
3926	format-stmt: TOK_LABEL_FORMAT line-break
3927	;
3928
3929	/* R1104 : module */
3930	module:module-stmt opt-specification-part opt-module-subprogram-part {pos_endsubroutine=setposcur();} end-module-stmt
3931	;
3932
3933	opt-module-subprogram-part:
3934	\| module-subprogram-part
3935	;
3936
3937	/* R1105 : module-stmt */
3938	module-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 */
3958	end-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
3983	opt-tok-module:
3984	\| TOK_MODULE
3985	;
3986
3987	opt-ident:
3988	\| TOK_NAME
3989	;
3990	/* R1107 : module-subprogram-part */
3991	module-subprogram-part:contains-stmt opt-module-subprogram-list
3992	;
3993
3994	opt-module-subprogram-list:
3995	\| module-subprogram-list
3996	;
3997
3998	module-subprogram-list: module-subprogram
3999	\| module-subprogram-list module-subprogram
4000	;
4001
4002	module-subprogram: function-subprogram
4003	\| subroutine-subprogram
4004	;
4005
4006	use-stmt-list:use-stmt
4007	\| use-stmt-list use-stmt
4008	;
4009
4010	save_olduse:
4011	{if (firstpass == 0 && oldfortran_out) pos_curuseold = setposcurname(oldfortran_out);}
4012	;
4013
4014	/* R1109 use-stmt */
4015	use-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
4105	opt-module-nature-2points:
4106	\| TOK_FOURDOTS
4107	\| ',' module-nature TOK_FOURDOTS
4108	;
4109
4110	opt-only-list:
4111	{$$=NULL;}
4112	\| only-list
4113	{$$=$1;}
4114	;
4115
4116	/* R1101 : main-program */
4117	main-program: program-stmt opt-specification-part opt-execution-part opt-internal-subprogram-part end-program-stmt
4118	;
4119
4120	opt-specification-part:
4121	\| specification-part
4122	;
4123
4124	opt-execution-part:
4125	\| execution-part
4126	;
4127
4128	/* R1102 : program-stmt */
4129	program-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 */
4143	end-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
4155	opt-tok-program:
4156	\| TOK_PROGRAM
4157	;
4158	opt-tok-name:
4159	\| TOK_NAME
4160	;
4161	/* R1110 : module-nature */
4162	module-nature: TOK_INTRINSIC
4163	;
4164
4165	opt-rename-list:
4166	{
4167	$$=NULL;
4168	}
4169	\| ',' rename-list
4170	{
4171	$$=$2;
4172	}
4173	;
4174
4175	rename-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 */
4188	rename: 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
4198	only-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 */
4209	only: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 */
4233	only-use-name: TOK_NAME
4234	;
4235
4236	/* R1207: generic-spec */
4237	generic-spec: TOK_NAME
4238	;
4239
4240	/* R1210 : external-stmt */
4241	external-stmt: TOK_EXTERNAL external-name-list line-break
4242	\| TOK_EXTERNAL TOK_FOURDOTS external-name-list line-break
4243	;
4244
4245	external-name-list: external-name
4246	\| external-name-list ',' external-name
4247	;
4248
4249	external-name: TOK_NAME
4250	;
4251
4252	/* R1218 : intrinsic-stmt */
4253	intrinsic-stmt: TOK_INTRINSIC opt-TOK_FOURDOTS intrinsic-procedure-name-list line-break
4254	;
4255
4256	intrinsic-procedure-name-list:
4257	intrinsic-procedure-name
4258	\| intrinsic-procedure-name-list ',' intrinsic-procedure-name
4259	;
4260
4261	intrinsic-procedure-name: TOK_NAME
4262	;
4263
4264	/* R1219 : function-reference */
4265	function-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	*/
4272	call-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
4313	before-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 */
4337	procedure-designator: ident
4338	\| TOK_FLUSH
4339	\| TOK_REAL
4340	;
4341
4342	actual-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 */
4349	actual-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 */
4368	actual-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
4382	opt-prefix: {isrecursive = 0;}
4383	\| prefix
4384	;
4385
4386	/* R1225 : prefix */
4387	prefix: prefix-spec
4388	\| prefix prefix-spec
4389	;
4390
4391	/* R1226 prefix-spec */
4392	prefix-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 /
4401	function-subprogram: function-stmt opt-specification-part opt-execution-part opt-internal-subprogram-part end-function-stmt
4402	;
4403
4404	/* R1228 : function-stmt */
4405	function-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
4431	function-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
4446	opt-dummy-arg-name-list:
4447	\| dummy-arg-name-list
4448	;
4449
4450	dummy-arg-name-list:
4451	dummy-arg-name
4452	\| dummy-arg-name-list ',' dummy-arg-name
4453	;
4454
4455	/* R1230 : dummy-arg-name */
4456	dummy-arg-name: TOK_NAME
4457	{strcpy($$,$1);}
4458	;
4459
4460	opt-suffix:
4461	{is_result_present = 0; }
4462	\| suffix
4463	;
4464
4465	/* R1231 : suffix */
4466	suffix: 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 */
4482	end-function-stmt: get_my_position TOK_ENDUNIT opt-tok-function opt-ident close_subroutine
4483	{strcpy(DeclType, "");}
4484	line-break
4485	;
4486
4487	opt-tok-function:
4488	\| TOK_FUNCTION
4489	;
4490
4491	/R1233 : subroutine-subprogram /
4492	subroutine-subprogram: subroutine-stmt opt-specification-part opt-execution-part opt-internal-subprogram-part end-subroutine-stmt
4493	;
4494
4495	/* R1234 : subroutine-stmt */
4496	subroutine-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
4511	subroutine-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
4528	end-subroutine-stmt: get_my_position TOK_ENDUNIT opt-tok-subroutine opt-ident close_subroutine
4529	line-break
4530	;
4531
4532	close_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	;
4577	opt-tok-subroutine:
4578	\| TOK_SUBROUTINE
4579	;
4580
4581	opt-dummy-arg-list-par:
4582	{if (firstpass) $$=NULL;}
4583	\| '(' {in_complex_literal=0;} opt-dummy-arg-list ')'
4584	{if (firstpass) $$=$3;}
4585	;
4586
4587	opt-dummy-arg-list:
4588	{if (firstpass) $$=NULL;}
4589	\| dummy-arg-list
4590	{if (firstpass) $$=$1;}
4591	;
4592
4593	dummy-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 */
4620	dummy-arg: dummy-arg-name
4621	{strcpy($$,$1);}
4622	\| '*'
4623	{strcpy($$,"*");}
4624	;
4625
4626	/* R1241 : return-stmt */
4627	return-stmt : opt-label TOK_RETURN line-break
4628	\| opt-label TOK_RETURN scalar-int-expr line-break
4629	;
4630
4631	/* R1242 : contains-stmt */
4632	contains-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 */
4665	stmt-function-stmt: TOK_NAME '(' opt-dummy-arg-name-list ')' '=' expr line-break
4666	;
4667
4668	opt_name : '\n' {strcpy($$,"");}
4669	\| TOK_NAME {strcpy($$,$1);}
4670	;
4671
4672	before_dims : { created_dimensionlist = 0; }
4673	;
4674	ident_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	;
4691	int_list :
4692	TOK_CSTINT
4693	\| int_list ',' TOK_CSTINT
4694	;
4695	after_ident_dims :
4696	'=' expr
4697	\| TOK_POINT_TO expr
4698	;
4699	call : 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	;
4712	opt_call :
4713	\| '(' opt_callarglist ')'
4714	;
4715	opt_callarglist :
4716	\| callarglist
4717	;
4718	keywordcall:
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	;
4742	before_call : TOK_CALL { pos_curcall=setposcur()-4; }
4743	\| label TOK_CALL { pos_curcall=setposcur()-4; }
4744	;
4745	callarglist :
4746	callarg
4747	\| callarglist ',' callarg
4748	;
4749	callarg :
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
4761	stop : TOK_PAUSE
4762	\| TOK_STOP
4763	;
4764
4765	option_io_1 :
4766	infmt ',' inlist
4767	\| infmt
4768
4769	option_io_2 :
4770	ioctl outlist
4771	\| ioctl
4772
4773	ioctl : '(' ctllist ')'
4774	;
4775	after_rewind :
4776	'(' ident ')'
4777	\| '(' TOK_CSTINT ')'
4778	\| TOK_CSTINT
4779	\| '(' uexpr ')'
4780	\| TOK_NAME
4781	;
4782	ctllist :
4783	ioclause
4784	\| ctllist ',' ioclause
4785	;
4786	ioclause :
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
4797	declare_after_percent: { afterpercent = 1; }
4798	;
4799	iofctl :
4800	TOK_FLUSH
4801	;
4802	infmt : unpar_fexpr
4803	\| '*'
4804	;
4805
4806	write_or_inq :
4807	TOK_WRITE
4808	;
4809
4810	fexpr : unpar_fexpr
4811	\| '(' fexpr ')'
4812	;
4813	unpar_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	;
4832	addop : '+'
4833	\| '-'
4834	;
4835	inlist : inelt
4836	\| inlist ',' inelt
4837	;
4838	// opt_lhs :
4839	// \| lhs
4840	// ;
4841	inelt : //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	;
4848	opt_operation :
4849	\| operation
4850	\| opt_operation operation
4851	;
4852	outlist :
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	;
4864	other :
4865	'(' uexpr ',' dospec ')' { sprintf($$,"(%s,%s)",$2,$4); }
4866	\| '(' outlist ',' dospec ')' { sprintf($$,"(%s,%s)",$2,$4); }
4867	\| '(' other ',' dospec ')' { sprintf($$,"(%s,%s)",$2,$4); }
4868	dospec :
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	;
4872	goto : TOK_PLAINGOTO '(' expr ',' expr ')' ',' expr
4873	\| TOK_PLAINGOTO TOK_CSTINT
4874	;
4875	allocation_list :
4876	allocate_object
4877	\| allocation_list ',' allocate_object
4878	;
4879	allocate_object :
4880	lhs { Add_Allocate_Var_1($1,curmodulename); }
4881	;
4882	allocate_object_list :
4883	allocate_object
4884	\| allocate_object_list ',' allocate_object
4885	;
4886	opt_stat_spec :
4887	\| ',' TOK_STAT '=' lhs
4888	;
4889	pointer_name_list :
4890	ident
4891	\| pointer_name_list ',' ident
4892	;
4893
4894	%%
4895
4896	void 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.

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

Context Navigation

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

Download in other formats: