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

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

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

Context Navigation

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

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

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

Download in other formats: