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

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.

fortran.y in vendors/AGRIF/CMEMS_2020/LEX – NEMO

Context Navigation

source: vendors/AGRIF/CMEMS_2020/LEX/fortran.y @ 10725

Last change on this file since 10725 was 10725, checked in by rblod, 5 years ago
Update agrif library and conv see ticket #2129
Property svn:mime-type set to `text/x-csrc`
File size: 133.5 KB

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

Note: See TracBrowser for help on using the repository browser.

Download in other formats: