Context Navigation

fortran.y @ 11668

Last change on this file since 11668 was 11668, checked in by acc, 5 years ago

Branch dev_r11615_ENHANCE-04_namelists_as_internalfiles_agrif. Changes to support 2019/dev_r11615_ENHANCE-04_namelists_as_internalfiles developments.
These changes enable sufficient support for allocatable, zero-dimension character variables defined using the:

CHARACTER(LEN=:), ALLOCATABLE :: cstr

syntax. This is supported by:

Adding : as a valid length identifier at line 1028 in fortran.y (and then rebuilding fortran.c and main.c via make -f Makefile.lex)
Adding a carrayu entry to Agrif_Variable_c type in AGRIF_FILES/modtypes.F90 where carrayu is declared as:

character(:) , allocatable

carrayu

Ensuring correct deallocation of carrayu in AGRIF_FILES/modsauv.F90 and AGRIF_FILES/modutil.F90

Substituting carrayu in place of carray0 declarations when character length matches : for zero-dimension variables. This occurs twice in LIB/toamr.c, e.g:

if (!strcasecmp(var->v_dimchar ,":") && var->v_nbdim == 0 )
{
sprintf (tname_2, "%% carrayu");
} else {
sprintf (tname_2, "%% carray%d", var->v_nbdim);
}

Any such character variables must be allocated by the user. Typically this is done with lines such as:

IF ( .NOT. ALLOCATED(cdnambuff) ) ALLOCATE( CHARACTER(LEN=kleng): cdnambuff )

making AGRIF accept the CHARACTER(LEN=kleng) :: construct within the ALLOCATE statement was beyond my skills. Fortunately, for the current purpose, this
isn't necessary since such allocations only occur within utility routines in which the appropriate tabvar has been passed down. So:

!$AGRIF_DO_NOT_TREAT

IF ( .NOT. ALLOCATED(cdnambuff) ) ALLOCATE( CHARACTER(LEN=kleng): cdnambuff )

!$AGRIF_END_DO_NOT_TREAT

avoids the issue.

Property svn:mime-type set to text/x-csrc

File size: 67.6 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	extern char *fortran_text;
45
46	char c_selectorname[LONG_M];
47	char ligne[LONG_M];
48	char truename[LONG_VNAME];
49	char identcopy[LONG_VNAME];
50	int c_selectorgiven=0;
51	listvar *curlistvar;
52	typedim c_selectordim;
53	listcouple *coupletmp;
54	int removeline=0;
55	listvar *test;
56
57	int fortran_error(const char *s)
58	{
59	printf("%s line %d, file %s motclef = \|%s\|\n", s, line_num_input, cur_filename, fortran_text);
60	exit(1);
61	}
62
63	%}
64
65	%union {
66	char na[LONG_M];
67	listdim *d;
68	listvar *l;
69	listcouple *lc;
70	listname *lnn;
71	typedim dim1;
72	variable *v;
73	}
74
75	%left ','
76	%nonassoc ':'
77	%right '='
78	%left TOK_EQV TOK_NEQV
79	%left TOK_OR TOK_XOR
80	%left TOK_AND
81	%left TOK_NOT
82	%nonassoc TOK_LT TOK_GT TOK_LE TOK_GE TOK_EQ TOK_NE
83	%left TOK_DSLASH
84	%left '+' '-'
85	%left '*' TOK_SLASH
86	%right TOK_DASTER
87
88	%token TOK_SEMICOLON
89	%token TOK_PARAMETER
90	%token TOK_RESULT
91	%token TOK_ONLY
92	%token TOK_INCLUDE
93	%token TOK_SUBROUTINE
94	%token TOK_PROGRAM
95	%token TOK_FUNCTION
96	%token TOK_FORMAT
97	%token TOK_MAX
98	%token TOK_TANH
99	%token TOK_WHERE
100	%token TOK_ELSEWHEREPAR
101	%token TOK_ELSEWHERE
102	%token TOK_ENDWHERE
103	%token TOK_MAXVAL
104	%token TOK_TRIM
105	%token TOK_NULL_PTR
106	%token TOK_SUM
107	%token TOK_SQRT
108	%token TOK_CASE
109	%token TOK_SELECTCASE
110	%token TOK_FILE
111	%token TOK_UNIT
112	%token TOK_FMT
113	%token TOK_NML
114	%token TOK_END
115	%token TOK_EOR
116	%token TOK_ERR
117	%token TOK_EXIST
118	%token TOK_MIN
119	%token TOK_FLOAT
120	%token TOK_EXP
121	%token TOK_COS
122	%token TOK_COSH
123	%token TOK_ACOS
124	%token TOK_NINT
125	%token TOK_CYCLE
126	%token TOK_SIN
127	%token TOK_SINH
128	%token TOK_ASIN
129	%token TOK_EQUIVALENCE
130	%token TOK_BACKSPACE
131	%token TOK_LOG
132	%token TOK_TAN
133	%token TOK_ATAN
134	%token TOK_RECURSIVE
135	%token TOK_ABS
136	%token TOK_MOD
137	%token TOK_SIGN
138	%token TOK_MINLOC
139	%token TOK_MAXLOC
140	%token TOK_EXIT
141	%token TOK_MINVAL
142	%token TOK_PUBLIC
143	%token TOK_PRIVATE
144	%token TOK_ALLOCATABLE
145	%token TOK_RETURN
146	%token TOK_THEN
147	%token TOK_ELSEIF
148	%token TOK_ELSE
149	%token TOK_ENDIF
150	%token TOK_PRINT
151	%token TOK_PLAINGOTO
152	%token TOK_LOGICALIF
153	%token TOK_PLAINDO
154	%token TOK_CONTAINS
155	%token TOK_ENDDO
156	%token TOK_MODULE
157	%token TOK_ENDMODULE
158	%token TOK_WHILE
159	%token TOK_CONCURRENT
160	%token TOK_ALLOCATE
161	%token TOK_OPEN
162	%token TOK_CLOSE
163	%token TOK_INQUIRE
164	%token TOK_WRITE
165	%token TOK_FLUSH
166	%token TOK_READ
167	%token TOK_REWIND
168	%token TOK_DEALLOCATE
169	%token TOK_NULLIFY
170	%token TOK_DIMENSION
171	%token TOK_ENDSELECT
172	%token TOK_EXTERNAL
173	%token TOK_INTENT
174	%token TOK_INTRINSIC
175	%token TOK_NAMELIST
176	%token TOK_DEFAULT
177	%token TOK_OPTIONAL
178	%token TOK_POINTER
179	%token TOK_CONTINUE
180	%token TOK_SAVE
181	%token TOK_TARGET
182	%token TOK_IMPLICIT
183	%token TOK_NONE
184	%token TOK_CALL
185	%token TOK_STAT
186	%token TOK_POINT_TO
187	%token TOK_COMMON
188	%token TOK_GLOBAL
189	%token TOK_LEFTAB
190	%token TOK_RIGHTAB
191	%token TOK_PAUSE
192	%token TOK_PROCEDURE
193	%token TOK_STOP
194	%token TOK_REAL8
195	%token TOK_FOURDOTS
196	%token <na> TOK_HEXA
197	%token <na> TOK_ASSIGNTYPE
198	%token <na> TOK_OUT
199	%token <na> TOK_INOUT
200	%token <na> TOK_IN
201	%token <na> TOK_USE
202	%token <na> TOK_DSLASH
203	%token <na> TOK_DASTER
204	%token <na> TOK_EQ
205	%token <na> TOK_EQV
206	%token <na> TOK_GT
207	%token <na> TOK_LT
208	%token <na> TOK_GE
209	%token <na> TOK_NE
210	%token <na> TOK_NEQV
211	%token <na> TOK_LE
212	%token <na> TOK_OR
213	%token <na> TOK_XOR
214	%token <na> TOK_NOT
215	%token <na> TOK_AND
216	%token <na> TOK_TRUE
217	%token <na> TOK_FALSE
218	%token <na> TOK_LABEL
219	%token <na> TOK_TYPE
220	%token <na> TOK_TYPEPAR
221	%token <na> TOK_ENDTYPE
222	%token <na> TOK_REAL
223	%token <na> TOK_INTEGER
224	%token <na> TOK_LOGICAL
225	%token <na> TOK_DOUBLEPRECISION
226	%token <na> TOK_ENDSUBROUTINE
227	%token <na> TOK_ENDFUNCTION
228	%token <na> TOK_ENDPROGRAM
229	%token <na> TOK_ENDUNIT
230	%token <na> TOK_CHARACTER
231	%token <na> TOK_CHAR_CONSTANT
232	%token <na> TOK_CHAR_CUT
233	%token <na> TOK_DATA
234	%token <na> TOK_CHAR_MESSAGE
235	%token <na> TOK_CSTREAL
236	%token <na> TOK_COMPLEX
237	%token <na> TOK_DOUBLECOMPLEX
238	%token <na> TOK_NAME
239	%token <na> TOK_SLASH
240	%token <na> TOK_CSTINT
241	%token ','
242	%token ':'
243	%token '('
244	%token ')'
245	%token '<'
246	%token '>'
247	%type <l> dcl
248	%type <l> after_type
249	%type <l> dimension
250	%type <l> paramlist
251	%type <l> args
252	%type <l> arglist
253	%type <lc> only_list
254	%type <lc> only_name
255	%type <lc> rename_list
256	%type <lc> rename_name
257	%type <d> dims
258	%type <d> dimlist
259	%type <dim1> dim
260	%type <v> paramitem
261	%type <na> comblock
262	%type <na> name_routine
263	%type <na> opt_name
264	%type <na> type
265	%type <na> word_endsubroutine
266	%type <na> word_endfunction
267	%type <na> word_endprogram
268	%type <na> word_endunit
269	%type <na> typespec
270	%type <na> string_constant
271	%type <na> simple_const
272	%type <na> ident
273	%type <na> intent_spec
274	%type <na> signe
275	%type <na> opt_signe
276	%type <na> filename
277	%type <na> attribute
278	%type <na> complex_const
279	%type <na> begin_array
280	%type <na> clause
281	%type <na> arg
282	%type <na> uexpr
283	%type <na> minmaxlist
284	%type <na> lhs
285	%type <na> vec
286	%type <na> outlist
287	%type <na> other
288	%type <na> dospec
289	%type <na> expr_data
290	%type <na> structure_component
291	%type <na> array_ele_substring_func_ref
292	%type <na> funarglist
293	%type <na> funarg
294	%type <na> funargs
295	%type <na> triplet
296	%type <na> substring
297	%type <na> opt_substring
298	%type <na> opt_expr
299	%type <na> optexpr
300	%type <lnn> data_stmt_value_list
301	%type <lnn> datanamelist
302	%type <na> after_slash
303	%type <na> after_equal
304	%type <na> predefinedfunction
305	%type <na> expr
306	%type <na> ubound
307	%type <na> operation
308	%type <na> proper_lengspec
309	%type <lnn> use_name_list
310	%type <lnn> public
311
312	%%
313	input :
314	\| input line
315	;
316	line : line-break
317	\| suite_line_list
318	\| TOK_LABEL suite_line_list
319	\| error {yyerrok;yyclearin;}
320	;
321	line-break:
322	'\n' fin_line
323	\| TOK_SEMICOLON
324	\| line-break '\n' fin_line
325	\| line-break TOK_SEMICOLON
326	\| line-break TOK_LABEL
327	;
328	suite_line_list :
329	suite_line
330	\| suite_line_list TOK_SEMICOLON '\n'
331	\| suite_line_list TOK_SEMICOLON suite_line
332	;
333	suite_line :
334	entry fin_line /* subroutine, function, module */
335	\| spec fin_line /* declaration */
336	\| TOK_INCLUDE filename fin_line
337	{
338	if (inmoduledeclare == 0 )
339	{
340	pos_end = setposcur();
341	RemoveWordSET_0(fortran_out,pos_curinclude,pos_end-pos_curinclude);
342	}
343	}
344	\| execution-part-construct
345	;
346
347	fin_line : { pos_cur = setposcur(); }
348	;
349
350	opt_recursive : { isrecursive = 0; }
351	\| TOK_RECURSIVE { isrecursive = 1; }
352	;
353
354	opt_result : { is_result_present = 0; }
355	\| TOK_RESULT arglist_after_result { is_result_present = 1; }
356	;
357
358	entry : opt_recursive TOK_SUBROUTINE name_routine arglist
359	{
360	insubroutinedeclare = 1;
361	if ( firstpass )
362	Add_SubroutineArgument_Var_1($4);
363	else
364	WriteBeginof_SubLoop();
365	}
366	\| TOK_PROGRAM name_routine
367	{
368	insubroutinedeclare = 1;
369	inprogramdeclare = 1;
370	/* in the second step we should write the head of */
371	/* the subroutine sub_loop_<subroutinename> */
372	if ( ! firstpass )
373	WriteBeginof_SubLoop();
374	}
375	\| opt_recursive TOK_FUNCTION name_routine arglist opt_result
376	{
377	insubroutinedeclare = 1;
378	strcpy(DeclType, "");
379	/* we should to list of the subroutine argument the */
380	/* name of the function which has to be defined */
381	if ( firstpass )
382	{
383	Add_SubroutineArgument_Var_1($4);
384	if ( ! is_result_present )
385	Add_FunctionType_Var_1($3);
386	}
387	else
388	/* in the second step we should write the head of */
389	/* the subroutine sub_loop_<subroutinename> */
390	WriteBeginof_SubLoop();
391	}
392	\| TOK_MODULE TOK_NAME
393	{
394	GlobalDeclaration = 0;
395	strcpy(curmodulename,$2);
396	strcpy(subroutinename,"");
397	Add_NameOfModule_1($2);
398	if ( inmoduledeclare == 0 )
399	{
400	/* To know if there are in the module declaration */
401	inmoduledeclare = 1;
402	/* to know if a module has been met */
403	inmodulemeet = 1;
404	/* to know if we are after the keyword contains */
405	aftercontainsdeclare = 0 ;
406	}
407	}
408	;
409
410	/* R312 : label */
411	label: TOK_CSTINT
412	\| label TOK_CSTINT
413	;
414
415	name_routine : TOK_NAME { strcpy($$, $1); strcpy(subroutinename, $1); }
416	;
417	filename : TOK_CHAR_CONSTANT { Add_Include_1($1); }
418	;
419	arglist : { if ( firstpass ) $$=NULL; }
420	\| '(' ')' { if ( firstpass ) $$=NULL; }
421	\| '(' args ')' { if ( firstpass ) $$=$2; }
422	;
423	arglist_after_result:
424	\| '(' ')'
425	\| '(' args ')' { if ( firstpass ) Add_SubroutineArgument_Var_1($2); }
426	;
427	args : arg
428	{
429	if ( firstpass == 1 )
430	{
431	strcpy(nameinttypenameback,nameinttypename);
432	strcpy(nameinttypename,"");
433	curvar = createvar($1,NULL);
434	strcpy(nameinttypename,nameinttypenameback);
435	curlistvar = insertvar(NULL,curvar);
436	$$ = settype("",curlistvar);
437	}
438	}
439	\| args ',' arg
440	{
441	if ( firstpass == 1 )
442	{
443	strcpy(nameinttypenameback,nameinttypename);
444	strcpy(nameinttypename,"");
445	curvar = createvar($3,NULL);
446	strcpy(nameinttypename,nameinttypenameback);
447	$$ = insertvar($1,curvar);
448	}
449	}
450	;
451	arg : TOK_NAME { strcpy($$,$1); }
452	\| '' { strcpy($$,""); }
453	;
454	spec : type after_type
455	\| TOK_TYPE opt_spec opt_sep opt_name { inside_type_declare = 1; }
456	\| TOK_ENDTYPE opt_name { inside_type_declare = 0; }
457	\| TOK_POINTER list_couple
458	\| before_parameter '(' paramlist ')'
459	{
460	if ( ! inside_type_declare )
461	{
462	if ( firstpass )
463	{
464	if ( insubroutinedeclare ) Add_Parameter_Var_1($3);
465	else Add_GlobalParameter_Var_1($3);
466	}
467	else
468	{
469	pos_end = setposcur();
470	RemoveWordSET_0(fortran_out, pos_cur_decl, pos_end-pos_cur_decl);
471	}
472	}
473	VariableIsParameter = 0 ;
474	}
475	\| before_parameter paramlist
476	{
477	if ( ! inside_type_declare )
478	{
479	if ( firstpass )
480	{
481	if ( insubroutinedeclare ) Add_Parameter_Var_1($2);
482	else Add_GlobalParameter_Var_1($2);
483	}
484	else
485	{
486	pos_end = setposcur();
487	RemoveWordSET_0(fortran_out,pos_cur_decl,pos_end-pos_cur_decl);
488	}
489	}
490	VariableIsParameter = 0 ;
491	}
492	\| common
493	\| save
494	{
495	pos_end = setposcur();
496	RemoveWordSET_0(fortran_out,pos_cursave,pos_end-pos_cursave);
497	}
498	\| implicit
499	\| dimension
500	{
501	/* if the variable is a parameter we can suppose that is */
502	/* value is the same on each grid. It is not useless to */
503	/* create a copy of it on each grid */
504	if ( ! inside_type_declare )
505	{
506	if ( firstpass )
507	{
508	Add_Globliste_1($1);
509	/* if variableparamlists has been declared in a subroutine */
510	if ( insubroutinedeclare ) Add_Dimension_Var_1($1);
511	}
512	else
513	{
514	pos_end = setposcur();
515	RemoveWordSET_0(fortran_out,pos_curdimension,pos_end-pos_curdimension);
516	}
517	}
518	PublicDeclare = 0;
519	PrivateDeclare = 0;
520	ExternalDeclare = 0;
521	strcpy(NamePrecision,"");
522	c_star = 0;
523	InitialValueGiven = 0 ;
524	strcpy(IntentSpec,"");
525	VariableIsParameter = 0 ;
526	Allocatabledeclare = 0 ;
527	Targetdeclare = 0 ;
528	SaveDeclare = 0;
529	pointerdeclare = 0;
530	optionaldeclare = 0 ;
531	dimsgiven=0;
532	c_selectorgiven=0;
533	strcpy(nameinttypename,"");
534	strcpy(c_selectorname,"");
535	}
536	\| public
537	{
538	if (firstpass == 0)
539	{
540	if ($1)
541	{
542	removeglobfromlist(&($1));
543	pos_end = setposcur();
544	RemoveWordSET_0(fortran_out,pos_cur,pos_end-pos_cur);
545	writelistpublic($1);
546	}
547	}
548	}
549	\| private
550	\| use_stat
551	\| module_proc_stmt
552	\| namelist
553	\| TOK_BACKSPACE '(' expr ')'
554	\| TOK_EXTERNAL opt_sep use_name_list
555	\| TOK_INTRINSIC opt_sep use_intrinsic_list
556	\| TOK_EQUIVALENCE list_expr_equi
557	\| data_stmt '\n'
558	{
559	/* we should remove the data declaration */
560	pos_end = setposcur();
561	RemoveWordSET_0(fortran_out,pos_curdata,pos_end-pos_curdata);
562
563	if ( aftercontainsdeclare == 1 && firstpass == 0 )
564	{
565	ReWriteDataStatement_0(fortran_out);
566	pos_end = setposcur();
567	}
568	}
569	;
570	opt_spec :
571	\| access_spec
572	{
573	PublicDeclare = 0 ;
574	PrivateDeclare = 0 ;
575	}
576	;
577	name_intrinsic :
578	TOK_SUM
579	\| TOK_TANH
580	\| TOK_MAXVAL
581	\| TOK_MIN
582	\| TOK_MINVAL
583	\| TOK_TRIM
584	\| TOK_SQRT
585	\| TOK_NINT
586	\| TOK_FLOAT
587	\| TOK_EXP
588	\| TOK_COS
589	\| TOK_COSH
590	\| TOK_ACOS
591	\| TOK_SIN
592	\| TOK_SINH
593	\| TOK_ASIN
594	\| TOK_LOG
595	\| TOK_TAN
596	\| TOK_ATAN
597	\| TOK_MOD
598	\| TOK_SIGN
599	\| TOK_MINLOC
600	\| TOK_MAXLOC
601	\| TOK_NAME
602	;
603	use_intrinsic_list :
604	name_intrinsic
605	\| use_intrinsic_list ',' name_intrinsic
606	;
607	list_couple :
608	'(' list_expr ')'
609	\| list_couple ',' '(' list_expr ')'
610	;
611	list_expr_equi :
612	expr_equi
613	\| list_expr_equi ',' expr_equi
614	;
615	expr_equi : '(' list_expr_equi1 ')'
616	;
617	list_expr_equi1 :
618	ident dims
619	\| list_expr_equi1 ',' ident dims
620	;
621	list_expr :
622	expr
623	\| list_expr ',' expr
624	;
625	opt_sep :
626	\| TOK_FOURDOTS
627	;
628	after_type :
629	dcl nodimsgiven
630	{
631	/* if the variable is a parameter we can suppose that is*/
632	/* value is the same on each grid. It is not useless */
633	/* to create a copy of it on each grid */
634	if ( ! inside_type_declare )
635	{
636	pos_end = setposcur();
637	RemoveWordSET_0(fortran_out,pos_cur_decl,pos_end-pos_cur_decl);
638	ReWriteDeclarationAndAddTosubroutine_01($1);
639	pos_cur_decl = setposcur();
640	if ( firstpass == 0 && GlobalDeclaration == 0
641	&& insubroutinedeclare == 0 )
642	{
643	fprintf(fortran_out,"\n#include \"Module_Declar_%s.h\"\n", curmodulename);
644	sprintf(ligne, "Module_Declar_%s.h", curmodulename);
645	module_declar = open_for_write(ligne);
646	GlobalDeclaration = 1 ;
647	pos_cur_decl = setposcur();
648	}
649	$$ = $1;
650
651	if ( firstpass )
652	{
653	Add_Globliste_1($1);
654	if ( insubroutinedeclare )
655	{
656	if ( pointerdeclare ) Add_Pointer_Var_From_List_1($1);
657	Add_Parameter_Var_1($1);
658	}
659	else
660	Add_GlobalParameter_Var_1($1);
661
662	/* If there's a SAVE declaration in module's subroutines we should */
663	/* remove it from the subroutines declaration and add it in the */
664	/* global declarations */
665	if ( aftercontainsdeclare && SaveDeclare )
666	{
667	if ( inmodulemeet ) Add_SubroutineDeclarationSave_Var_1($1);
668	else Add_Save_Var_dcl_1($1);
669	}
670	}
671	}
672	else
673	{
674	$$ = (listvar *) NULL;
675	}
676	PublicDeclare = 0;
677	PrivateDeclare = 0;
678	ExternalDeclare = 0;
679	strcpy(NamePrecision,"");
680	c_star = 0;
681	InitialValueGiven = 0 ;
682	strcpy(IntentSpec,"");
683	VariableIsParameter = 0 ;
684	Allocatabledeclare = 0 ;
685	Targetdeclare = 0 ;
686	SaveDeclare = 0;
687	pointerdeclare = 0;
688	optionaldeclare = 0 ;
689	dimsgiven=0;
690	c_selectorgiven=0;
691	strcpy(nameinttypename,"");
692	strcpy(c_selectorname,"");
693	GlobalDeclarationType = 0;
694	}
695	\| before_function name_routine arglist
696	{
697	insubroutinedeclare = 1;
698
699	if ( firstpass )
700	{
701	Add_SubroutineArgument_Var_1($3);
702	Add_FunctionType_Var_1($2);
703	}
704	else
705	WriteBeginof_SubLoop();
706
707	strcpy(nameinttypename,"");
708	}
709	;
710	before_function : TOK_FUNCTION { functiondeclarationisdone = 1; }
711	;
712	before_parameter : TOK_PARAMETER { VariableIsParameter = 1; pos_curparameter = setposcur()-9; }
713	;
714
715	data_stmt : /* R534 */
716	TOK_DATA data_stmt_set_list
717
718	data_stmt_set_list :
719	data_stmt_set
720	\| data_stmt_set_list opt_comma data_stmt_set
721
722	data_stmt_set : /* R535 */
723	TOK_NAME TOK_SLASH data_stmt_value_list TOK_SLASH
724	{
725	createstringfromlistname(ligne,$3);
726	if (firstpass == 1) Add_Data_Var_1(&List_Data_Var,$1,ligne);
727	else Add_Data_Var_1(&List_Data_Var_Cur,$1,ligne);
728	}
729	\| datanamelist TOK_SLASH data_stmt_value_list TOK_SLASH
730	{
731	if (firstpass == 1) Add_Data_Var_Names_01(&List_Data_Var,$1,$3);
732	else Add_Data_Var_Names_01(&List_Data_Var_Cur,$1,$3);
733	}
734	\| '(' lhs ',' dospec ')' TOK_SLASH data_stmt_value_list TOK_SLASH
735	{
736	createstringfromlistname(ligne,$7);
737	printf("###################################################################################################################\n");
738	printf("## CONV Error : data_implied_do statements (R537) are not yet supported. Please complain to the proper authorities.\n");
739	printf("l.%4d -- data_stmt_set : ( lhs , dospec ) /data_stmt_value_list/ -- lhs=\|%s\| dospec=\|%s\| data_stmt_value_list=\|%s\|\n",
740	line_num_input,$2,$4,ligne);
741	printf("## But, are you SURE you NEED a DATA construct ?\n");
742	printf("###################################################################################################################\n");
743	exit(1);
744	}
745	;
746
747	data_stmt_value_list :
748	expr_data { $$ = Insertname(NULL,$1,0); }
749	\| expr_data ',' data_stmt_value_list { $$ = Insertname($3,$1,1); }
750	;
751
752	save : before_save varsave
753	\| before_save comblock varsave
754	\| save opt_comma comblock opt_comma varsave
755	\| save ',' varsave
756	;
757	before_save :
758	TOK_SAVE { pos_cursave = setposcur()-4; }
759	;
760	varsave :
761	\| TOK_NAME dims { if ( ! inside_type_declare ) Add_Save_Var_1($1,$2); }
762	;
763	datanamelist :
764	TOK_NAME { $$ = Insertname(NULL,$1,0); }
765	\| TOK_NAME '(' expr ')' { printf("l.%4d -- INSTRUCTION NON TRAITEE : INITIALISATION DE DATA AVEC EXPRESSION\n",line_num_input); exit(0); }
766	\| datanamelist ',' datanamelist { $$ = concat_listname($1,$3); }
767	;
768	expr_data :
769	opt_signe simple_const { sprintf($$,"%s%s",$1,$2); }
770	\| expr_data '+' expr_data { sprintf($$,"%s+%s",$1,$3); }
771	\| expr_data '-' expr_data { sprintf($$,"%s-%s",$1,$3); }
772	\| expr_data '' expr_data { sprintf($$,"%s%s",$1,$3); }
773	\| expr_data '/' expr_data { sprintf($$,"%s/%s",$1,$3); }
774	;
775	opt_signe : { strcpy($$,""); }
776	\| signe { strcpy($$,$1); }
777	;
778	namelist :
779	TOK_NAMELIST ident
780	\| TOK_NAMELIST comblock ident
781	\| namelist opt_comma comblock opt_comma ident
782	\| namelist ',' ident
783	;
784	before_dimension :
785	TOK_DIMENSION
786	{
787	positioninblock = 0;
788	pos_curdimension = setposcur()-9;
789	}
790
791	dimension :
792	before_dimension opt_comma TOK_NAME dims lengspec
793	{
794	printf("l.%4d -- dimension : before_dimension opt_comma TOK_NAME = \|%s\| -- MHCHECK\n",line_num_input,$3);
795	if ( inside_type_declare ) break;
796	curvar = createvar($3,$4);
797	CreateAndFillin_Curvar("", curvar);
798	curlistvar=insertvar(NULL, curvar);
799	$$ = settype("",curlistvar);
800	strcpy(vallengspec,"");
801	}
802	\| dimension ',' TOK_NAME dims lengspec
803	{
804	printf("l.%4d -- dimension : dimension ',' TOK_NAME dims lengspec = \|%s\| -- MHCHECK\n",line_num_input,$3);
805	if ( inside_type_declare ) break;
806	curvar = createvar($3,$4);
807	CreateAndFillin_Curvar("", curvar);
808	curlistvar = insertvar($1, curvar);
809	$$ = curlistvar;
810	strcpy(vallengspec,"");
811	}
812	;
813	private :
814	TOK_PRIVATE '\n'
815	\| TOK_PRIVATE opt_sep use_name_list
816	;
817	public :
818	TOK_PUBLIC '\n' { $$ = (listname *) NULL; }
819	\| TOK_PUBLIC opt_sep use_name_list { $$ = $3; }
820	;
821	use_name_list :
822	TOK_NAME { $$ = Insertname(NULL,$1,0); }
823	\| TOK_ASSIGNTYPE { $$ = Insertname(NULL,$1,0); }
824	\| use_name_list ',' TOK_NAME { $$ = Insertname($1,$3,0); }
825	\| use_name_list ',' TOK_ASSIGNTYPE { $$ = Insertname($1,$3,0); }
826	;
827	common :
828	before_common var_common_list
829	{
830	if ( inside_type_declare ) break;
831	pos_end = setposcur();
832	RemoveWordSET_0(fortran_out,pos_curcommon,pos_end-pos_curcommon);
833	}
834	\| before_common comblock var_common_list
835	{
836	if ( inside_type_declare ) break;
837	sprintf(charusemodule,"%s",$2);
838	Add_NameOfCommon_1($2,subroutinename);
839	pos_end = setposcur();
840	RemoveWordSET_0(fortran_out,pos_curcommon,pos_end-pos_curcommon);
841	}
842	\| common opt_comma comblock opt_comma var_common_list
843	{
844	if ( inside_type_declare ) break;
845	sprintf(charusemodule,"%s",$3);
846	Add_NameOfCommon_1($3,subroutinename);
847	pos_end = setposcur();
848	RemoveWordSET_0(fortran_out,pos_curcommon,pos_end-pos_curcommon);
849	}
850	;
851	before_common :
852	TOK_COMMON { positioninblock = 0; pos_curcommon = setposcur()-6; }
853	\| TOK_GLOBAL TOK_COMMON { positioninblock = 0; pos_curcommon = setposcur()-6-7; }
854	;
855	var_common_list :
856	var_common { if ( ! inside_type_declare ) Add_Common_var_1(); }
857	\| var_common_list ',' var_common { if ( ! inside_type_declare ) Add_Common_var_1(); }
858	;
859	var_common :
860	TOK_NAME dims
861	{
862	positioninblock = positioninblock + 1 ;
863	strcpy(commonvar,$1);
864	commondim = $2;
865	}
866	;
867	comblock :
868	TOK_DSLASH
869	{
870	strcpy($$,"");
871	positioninblock=0;
872	strcpy(commonblockname,"");
873	}
874	\| TOK_SLASH TOK_NAME TOK_SLASH
875	{
876	strcpy($$,$2);
877	positioninblock=0;
878	strcpy(commonblockname,$2);
879	}
880	;
881	opt_comma :
882	\| ','
883	;
884	paramlist :
885	paramitem { $$=insertvar(NULL,$1); }
886	\| paramlist ',' paramitem { $$=insertvar($1,$3); }
887	;
888	paramitem :
889	TOK_NAME '=' expr
890	{
891	if ( inside_type_declare ) break;
892	curvar=(variable *) calloc(1,sizeof(variable));
893	Init_Variable(curvar);
894	curvar->v_VariableIsParameter = 1;
895	strcpy(curvar->v_nomvar,$1);
896	strcpy(curvar->v_subroutinename,subroutinename);
897	strcpy(curvar->v_modulename,curmodulename);
898	strcpy(curvar->v_initialvalue,$3);
899	strcpy(curvar->v_commoninfile,cur_filename);
900	Save_Length($3,14);
901	$$ = curvar;
902	}
903	;
904	module_proc_stmt :
905	TOK_PROCEDURE proc_name_list
906	;
907	proc_name_list :
908	TOK_NAME
909	\| proc_name_list ',' TOK_NAME
910	;
911	implicit :
912	TOK_IMPLICIT TOK_NONE
913	{
914	if ( insubroutinedeclare == 1 )
915	{
916	Add_ImplicitNoneSubroutine_1();
917	pos_end = setposcur();
918	RemoveWordSET_0(fortran_out,pos_end-13,13);
919	}
920	}
921	\| TOK_IMPLICIT TOK_REAL8
922	;
923	dcl : options TOK_NAME dims lengspec initial_value
924	{
925	if ( ! inside_type_declare )
926	{
927	if (dimsgiven == 1) curvar = createvar($2,curdim);
928	else curvar = createvar($2,$3);
929	CreateAndFillin_Curvar(DeclType, curvar);
930	curlistvar = insertvar(NULL, curvar);
931	if (!strcasecmp(DeclType,"character"))
932	{
933	if (c_selectorgiven == 1)
934	{
935	strcpy(c_selectordim.first,"1");
936	strcpy(c_selectordim.last,c_selectorname);
937	Save_Length(c_selectorname,1);
938	change_dim_char(insertdim(NULL,c_selectordim),curlistvar);
939	}
940	}
941	$$=settype(DeclType,curlistvar);
942	}
943	strcpy(vallengspec,"");
944	}
945	\| dcl ',' TOK_NAME dims lengspec initial_value
946	{
947	if ( ! inside_type_declare )
948	{
949	if (dimsgiven == 1) curvar = createvar($3, curdim);
950	else curvar = createvar($3, $4);
951	CreateAndFillin_Curvar($1->var->v_typevar,curvar);
952	strcpy(curvar->v_typevar, $1->var->v_typevar);
953	curvar->v_catvar = get_cat_var(curvar);
954	curlistvar = insertvar($1, curvar);
955	if (!strcasecmp(DeclType,"character"))
956	{
957	if (c_selectorgiven == 1)
958	{
959	strcpy(c_selectordim.first,"1");
960	strcpy(c_selectordim.last,c_selectorname);
961	Save_Length(c_selectorname,1);
962	change_dim_char(insertdim(NULL,c_selectordim),curlistvar);
963	}
964	}
965	$$=curlistvar;
966	}
967	strcpy(vallengspec,"");
968	}
969	;
970	nodimsgiven : { dimsgiven = 0; }
971	;
972	type : typespec selector { strcpy(DeclType,$1); }
973	\| before_character c_selector { strcpy(DeclType,"character"); }
974	\| typespec '*' TOK_CSTINT { strcpy(DeclType,$1); strcpy(nameinttypename,$3); }
975	\| TOK_TYPEPAR attribute ')' { strcpy(DeclType,"type"); GlobalDeclarationType = 1; }
976	;
977	c_selector :
978	\| '*' TOK_CSTINT { c_selectorgiven = 1; strcpy(c_selectorname,$2); }
979	\| '*' '(' c_attribute ')' { c_star = 1;}
980	\| '(' c_attribute ')'
981	;
982	c_attribute :
983	TOK_NAME clause opt_clause
984	\| TOK_NAME '=' clause opt_clause
985	\| clause opt_clause
986	;
987	before_character : TOK_CHARACTER { pos_cur_decl = setposcur()-9; }
988	;
989	typespec :
990	TOK_INTEGER { strcpy($$,"integer"); pos_cur_decl = setposcur()-7; }
991	\| TOK_LOGICAL { strcpy($$,"logical"); pos_cur_decl = setposcur()-7; }
992	\| TOK_REAL { strcpy($$,"real"); pos_cur_decl = setposcur()-4; }
993	\| TOK_COMPLEX { strcpy($$,"complex"); pos_cur_decl = setposcur()-7; }
994	\| TOK_DOUBLECOMPLEX { strcpy($$,"double complex"); pos_cur_decl = setposcur()-14; }
995	\| TOK_DOUBLEPRECISION { pos_cur_decl = setposcur()-16; strcpy($$,"real"); strcpy(nameinttypename,"8"); }
996	;
997	lengspec :
998	\| '*' proper_lengspec {strcpy(vallengspec,$2);}
999	;
1000	proper_lengspec :
1001	expr { sprintf($$,"*%s",$1); }
1002	\| '(' '' ')' { strcpy($$,"(*)"); }
1003	;
1004	selector :
1005	\| '*' proper_selector
1006	\| '(' attribute ')'
1007	;
1008	proper_selector : expr
1009	\| '(' '*' ')'
1010	;
1011	attribute :
1012	TOK_NAME clause
1013	\| TOK_NAME '=' clause
1014	{
1015	if ( strstr($3,"0.d0") )
1016	{
1017	strcpy(nameinttypename,"8");
1018	strcpy(NamePrecision,"");
1019	}
1020	else
1021	sprintf(NamePrecision,"%s = %s",$1,$3);
1022	}
1023	\| TOK_NAME { strcpy(NamePrecision,$1); }
1024	\| TOK_CSTINT { strcpy(NamePrecision,$1); }
1025	\| TOK_ASSIGNTYPE { strcpy(NamePrecision,$1); }
1026	;
1027	clause :
1028	expr { strcpy(CharacterSize,$1); strcpy($$,$1); }
1029	\| '' { strcpy(CharacterSize,""); strcpy($$,"*"); }
1030	\| ':' { strcpy(CharacterSize,":"); strcpy($$,":"); }
1031	;
1032	opt_clause :
1033	\| ',' TOK_NAME clause
1034	;
1035	options :
1036	\| TOK_FOURDOTS
1037	\| ',' attr_spec_list TOK_FOURDOTS
1038	;
1039	attr_spec_list : attr_spec
1040	\| attr_spec_list ',' attr_spec
1041	;
1042	attr_spec :
1043	TOK_PARAMETER { VariableIsParameter = 1; }
1044	\| access_spec
1045	\| TOK_ALLOCATABLE { Allocatabledeclare = 1; }
1046	\| TOK_DIMENSION dims { dimsgiven = 1; curdim = $2; }
1047	\| TOK_EXTERNAL { ExternalDeclare = 1; }
1048	\| TOK_INTENT '(' intent_spec ')'
1049	{ strcpy(IntentSpec,$3); }
1050	\| TOK_INTRINSIC
1051	\| TOK_OPTIONAL { optionaldeclare = 1 ; }
1052	\| TOK_POINTER { pointerdeclare = 1 ; }
1053	\| TOK_SAVE { SaveDeclare = 1 ; }
1054	\| TOK_TARGET { Targetdeclare = 1; }
1055	;
1056	intent_spec :
1057	TOK_IN { strcpy($$,$1); }
1058	\| TOK_OUT { strcpy($$,$1); }
1059	\| TOK_INOUT { strcpy($$,$1); }
1060	;
1061	access_spec :
1062	TOK_PUBLIC { PublicDeclare = 1; }
1063	\| TOK_PRIVATE { PrivateDeclare = 1; }
1064	;
1065	dims : { $$ = (listdim*) NULL; }
1066	\| '(' dimlist ')'
1067	{
1068	$$ = (listdim*) NULL;
1069	if ( inside_type_declare ) break;
1070	if ( created_dimensionlist == 1 \|\| agrif_parentcall == 1 ) $$=$2;
1071	}
1072	;
1073	dimlist :
1074	dim
1075	{
1076	$$ = (listdim*) NULL;
1077	if ( inside_type_declare ) break;
1078	if ( created_dimensionlist == 1 \|\| agrif_parentcall == 1 ) $$=insertdim(NULL,$1);
1079	}
1080	\| dimlist ',' dim
1081	{
1082	$$ = (listdim*) NULL;
1083	if ( inside_type_declare ) break;
1084	if ( (!inside_type_declare) && created_dimensionlist == 1 ) $$=insertdim($1,$3);
1085	}
1086	;
1087	dim : ubound { strcpy($$.first,"1"); strcpy($$.last,$1); Save_Length($1,1); }
1088	\| ':' { strcpy($$.first,""); strcpy($$.last,""); }
1089	\| expr ':' { strcpy($$.first,$1); Save_Length($1,2); strcpy($$.last,""); }
1090	\| ':' expr { strcpy($$.first,""); strcpy($$.last,$2); Save_Length($2,1); }
1091	\| expr ':' ubound { strcpy($$.first,$1); Save_Length($1,2); strcpy($$.last,$3); Save_Length($3,1); }
1092	;
1093	ubound :
1094	'' { strcpy($$,""); }
1095	\| expr { strcpy($$,$1); }
1096	;
1097	expr : uexpr { strcpy($$,$1); }
1098	\| complex_const { strcpy($$,$1); }
1099	\| predefinedfunction { strcpy($$,$1); }
1100	\| '(' expr ')' { sprintf($$,"(%s)",$2); }
1101	;
1102
1103	predefinedfunction :
1104	TOK_SUM minmaxlist ')' { sprintf($$,"SUM(%s)",$2);}
1105	\| TOK_MAX minmaxlist ')' { sprintf($$,"MAX(%s)",$2);}
1106	\| TOK_TANH '(' minmaxlist ')' { sprintf($$,"TANH(%s)",$3);}
1107	\| TOK_MAXVAL '(' minmaxlist ')' { sprintf($$,"MAXVAL(%s)",$3);}
1108	\| TOK_MIN minmaxlist ')' { sprintf($$,"MIN(%s)",$2);}
1109	\| TOK_MINVAL '(' minmaxlist ')' { sprintf($$,"MINVAL(%s)",$3);}
1110	\| TOK_TRIM '(' expr ')' { sprintf($$,"TRIM(%s)",$3);}
1111	\| TOK_SQRT expr ')' { sprintf($$,"SQRT(%s)",$2);}
1112	\| TOK_REAL '(' minmaxlist ')' { sprintf($$,"REAL(%s)",$3);}
1113	\| TOK_NINT '(' expr ')' { sprintf($$,"NINT(%s)",$3);}
1114	\| TOK_FLOAT '(' expr ')' { sprintf($$,"FLOAT(%s)",$3);}
1115	\| TOK_EXP '(' expr ')' { sprintf($$,"EXP(%s)",$3);}
1116	\| TOK_COS '(' expr ')' { sprintf($$,"COS(%s)",$3);}
1117	\| TOK_COSH '(' expr ')' { sprintf($$,"COSH(%s)",$3);}
1118	\| TOK_ACOS '(' expr ')' { sprintf($$,"ACOS(%s)",$3);}
1119	\| TOK_SIN '(' expr ')' { sprintf($$,"SIN(%s)",$3);}
1120	\| TOK_SINH '(' expr ')' { sprintf($$,"SINH(%s)",$3);}
1121	\| TOK_ASIN '(' expr ')' { sprintf($$,"ASIN(%s)",$3);}
1122	\| TOK_LOG '(' expr ')' { sprintf($$,"LOG(%s)",$3);}
1123	\| TOK_TAN '(' expr ')' { sprintf($$,"TAN(%s)",$3);}
1124	\| TOK_ATAN '(' expr ')' { sprintf($$,"ATAN(%s)",$3);}
1125	\| TOK_ABS expr ')' { sprintf($$,"ABS(%s)",$2);}
1126	\| TOK_MOD '(' minmaxlist ')' { sprintf($$,"MOD(%s)",$3);}
1127	\| TOK_SIGN minmaxlist ')' { sprintf($$,"SIGN(%s)",$2);}
1128	\| TOK_MINLOC '(' minmaxlist ')' { sprintf($$,"MINLOC(%s)",$3);}
1129	\| TOK_MAXLOC '(' minmaxlist ')' { sprintf($$,"MAXLOC(%s)",$3);}
1130	;
1131	minmaxlist : expr {strcpy($$,$1);}
1132	\| minmaxlist ',' expr { sprintf($$,"%s,%s",$1,$3); }
1133	;
1134	uexpr : lhs { strcpy($$,$1); }
1135	\| simple_const { strcpy($$,$1); }
1136	\| vec { strcpy($$,$1); }
1137	\| expr operation { sprintf($$,"%s%s",$1,$2); }
1138	\| signe expr %prec '*' { sprintf($$,"%s%s",$1,$2); }
1139	\| TOK_NOT expr { sprintf($$,"%s%s",$1,$2); }
1140	;
1141	signe : '+' { strcpy($$,"+"); }
1142	\| '-' { strcpy($$,"-"); }
1143	;
1144
1145	operation :
1146	'+' expr %prec '+' { sprintf($$,"+%s",$2); }
1147	\| '-' expr %prec '+' { sprintf($$,"-%s",$2); }
1148	\| '' expr { sprintf($$,"%s",$2); }
1149	\| TOK_DASTER expr { sprintf($$,"%s%s",$1,$2); }
1150	\| TOK_EQ expr %prec TOK_EQ { sprintf($$,"%s%s",$1,$2); }
1151	\| TOK_EQV expr %prec TOK_EQV { sprintf($$,"%s%s",$1,$2); }
1152	\| TOK_GT expr %prec TOK_EQ { sprintf($$,"%s%s",$1,$2); }
1153	\| '>' expr %prec TOK_EQ { sprintf($$," > %s",$2); }
1154	\| '<' expr %prec TOK_EQ { sprintf($$," < %s",$2); }
1155	\| '>''=' expr %prec TOK_EQ { sprintf($$," >= %s",$3); }
1156	\| '<''=' expr %prec TOK_EQ { sprintf($$," <= %s",$3); }
1157	\| TOK_LT expr %prec TOK_EQ { sprintf($$,"%s%s",$1,$2); }
1158	\| TOK_GE expr %prec TOK_EQ { sprintf($$,"%s%s",$1,$2); }
1159	\| TOK_LE expr %prec TOK_EQ { sprintf($$,"%s%s",$1,$2); }
1160	\| TOK_NE expr %prec TOK_EQ { sprintf($$,"%s%s",$1,$2); }
1161	\| TOK_NEQV expr %prec TOK_EQV { sprintf($$,"%s%s",$1,$2); }
1162	\| TOK_XOR expr { sprintf($$,"%s%s",$1,$2); }
1163	\| TOK_OR expr { sprintf($$,"%s%s",$1,$2); }
1164	\| TOK_AND expr { sprintf($$,"%s%s",$1,$2); }
1165	\| TOK_SLASH after_slash { sprintf($$,"%s",$2); }
1166	\| '=' after_equal { sprintf($$,"%s",$2); }
1167
1168	after_slash : { strcpy($$,""); }
1169	\| expr { sprintf($$,"/%s",$1); }
1170	\| '=' expr %prec TOK_EQ { sprintf($$,"/= %s",$2);}
1171	\| TOK_SLASH expr { sprintf($$,"//%s",$2); }
1172	;
1173	after_equal :
1174	'=' expr %prec TOK_EQ { sprintf($$,"==%s",$2); }
1175	\| expr { sprintf($$,"= %s",$1); }
1176	;
1177
1178	lhs : ident { strcpy($$,$1); }
1179	\| structure_component { strcpy($$,$1); }
1180	\| array_ele_substring_func_ref { strcpy($$,$1); }
1181	;
1182
1183	beforefunctionuse :
1184	{
1185	agrif_parentcall = 0;
1186	if ( !strcasecmp(identcopy, "Agrif_Parent") ) agrif_parentcall = 1;
1187	if ( Agrif_in_Tok_NAME(identcopy) )
1188	{
1189	inagrifcallargument = 1;
1190	Add_SubroutineWhereAgrifUsed_1(subroutinename, curmodulename);
1191	}
1192	}
1193	;
1194	array_ele_substring_func_ref :
1195	begin_array { strcpy($$,$1); if ( incalldeclare == 0 ) inagrifcallargument = 0; }
1196	\| begin_array substring { sprintf($$," %s %s ",$1,$2); }
1197	\| structure_component '(' funarglist ')' { sprintf($$," %s ( %s )",$1,$3); }
1198	\| structure_component '(' funarglist ')' substring { sprintf($$," %s ( %s ) %s ",$1,$3,$5); }
1199	;
1200	begin_array :
1201	ident '(' funarglist ')'
1202	{
1203	if ( inside_type_declare ) break;
1204	sprintf($$," %s ( %s )",$1,$3);
1205	ModifyTheAgrifFunction_0($3);
1206	agrif_parentcall = 0;
1207	}
1208	;
1209	structure_component :
1210	lhs '%' declare_after_percent lhs
1211	{
1212	sprintf($$," %s %% %s ",$1,$4);
1213	if ( incalldeclare == 0 ) inagrifcallargument = 0;
1214	}
1215	;
1216	vec :
1217	TOK_LEFTAB outlist TOK_RIGHTAB { sprintf($$,"(/%s/)",$2); }
1218	;
1219	funarglist :
1220	beforefunctionuse { strcpy($$," "); }
1221	\| beforefunctionuse funargs { strcpy($$,$2); }
1222	;
1223	funargs :
1224	funarg { strcpy($$,$1); }
1225	\| funargs ',' funarg { sprintf($$,"%s,%s",$1,$3); }
1226	;
1227	funarg :
1228	expr {strcpy($$,$1);}
1229	\| triplet {strcpy($$,$1);}
1230	;
1231	triplet :
1232	expr ':' expr { sprintf($$,"%s :%s",$1,$3);}
1233	\| expr ':' expr ':' expr { sprintf($$,"%s :%s :%s",$1,$3,$5);}
1234	\| ':' expr ':' expr { sprintf($$,":%s :%s",$2,$4);}
1235	\| ':' ':' expr { sprintf($$,": : %s",$3);}
1236	\| ':' expr { sprintf($$,":%s",$2);}
1237	\| expr ':' { sprintf($$,"%s :",$1);}
1238	\| ':' { sprintf($$,":");}
1239	;
1240	ident : TOK_NAME
1241	{
1242	if ( afterpercent == 0 )
1243	{
1244	if ( Agrif_in_Tok_NAME($1) ) Add_SubroutineWhereAgrifUsed_1(subroutinename, curmodulename);
1245	if ( !strcasecmp($1,"Agrif_Parent") ) agrif_parentcall = 1;
1246	if ( VariableIsFunction($1) )
1247	{
1248	if ( inagrifcallargument == 1 )
1249	{
1250	if ( !strcasecmp($1,identcopy) )
1251	{
1252	strcpy(sameagrifname,identcopy);
1253	sameagrifargument = 1;
1254	}
1255	}
1256	strcpy(identcopy,$1);
1257	pointedvar = 0;
1258
1259	if (variscoupled_0($1)) strcpy(truename, getcoupledname_0($1));
1260	else strcpy(truename, $1);
1261
1262	if ( VarIsNonGridDepend(truename) == 0 && (! Variableshouldberemoved(truename)) )
1263	{
1264	if ( inagrifcallargument == 1 \|\| varispointer_0(truename) == 1 )
1265	{
1266	if ( (IsinListe(List_UsedInSubroutine_Var,$1) == 1) \|\| (inagrifcallargument == 1) )
1267	{
1268	if (varistyped_0(truename) == 0) ModifyTheVariableName_0(truename,strlen($1));
1269	}
1270	}
1271	if ( inagrifcallargument != 1 \|\| sameagrifargument ==1 )
1272	{
1273	Add_UsedInSubroutine_Var_1(truename);
1274	}
1275	}
1276	NotifyAgrifFunction_0(truename);
1277	}
1278	}
1279	else
1280	{
1281	afterpercent = 0;
1282	}
1283	}
1284	;
1285	simple_const :
1286	TOK_TRUE { strcpy($$,".TRUE.");}
1287	\| TOK_FALSE { strcpy($$,".FALSE.");}
1288	\| TOK_NULL_PTR { strcpy($$,"NULL()"); }
1289	\| TOK_CSTINT { strcpy($$,$1); }
1290	\| TOK_CSTREAL { strcpy($$,$1); }
1291	\| TOK_HEXA { strcpy($$,$1); }
1292	\| simple_const TOK_NAME
1293	{ sprintf($$,"%s%s",$1,$2); }
1294	\| string_constant opt_substring
1295	;
1296	string_constant :
1297	TOK_CHAR_CONSTANT { strcpy($$,$1);}
1298	\| string_constant TOK_CHAR_CONSTANT
1299	\| TOK_CHAR_MESSAGE { strcpy($$,$1);}
1300	\| TOK_CHAR_CUT { strcpy($$,$1);}
1301	;
1302	opt_substring : { strcpy($$," ");}
1303	\| substring { strcpy($$,$1);}
1304	;
1305	substring :
1306	'(' optexpr ':' optexpr ')' { sprintf($$,"(%s :%s)",$2,$4);}
1307	;
1308	optexpr : { strcpy($$," ");}
1309	\| expr { strcpy($$,$1);}
1310	;
1311	opt_expr :
1312	'\n' { strcpy($$," ");}
1313	\| expr { strcpy($$,$1);}
1314	;
1315	initial_value : { InitialValueGiven = 0; }
1316	\| '=' expr
1317	{
1318	if ( inside_type_declare ) break;
1319	strcpy(InitValue,$2);
1320	InitialValueGiven = 1;
1321	}
1322	\| TOK_POINT_TO expr
1323	{
1324	if ( inside_type_declare ) break;
1325	strcpy(InitValue,$2);
1326	InitialValueGiven = 2;
1327	}
1328	;
1329	complex_const :
1330	'(' uexpr ',' uexpr ')' {sprintf($$,"(%s,%s)",$2,$4); }
1331	;
1332	use_stat :
1333	word_use TOK_NAME
1334	{
1335	/* if variables has been declared in a subroutine */
1336	sprintf(charusemodule, "%s", $2);
1337	if ( firstpass )
1338	{
1339	Add_NameOfModuleUsed_1($2);
1340	}
1341	else
1342	{
1343	if ( insubroutinedeclare )
1344	copyuse_0($2);
1345
1346	if ( inmoduledeclare == 0 )
1347	{
1348	pos_end = setposcur();
1349	RemoveWordSET_0(fortran_out,pos_curuse,pos_end-pos_curuse);
1350	}
1351	}
1352	}
1353	\| word_use TOK_NAME ',' rename_list
1354	{
1355	if ( firstpass )
1356	{
1357	if ( insubroutinedeclare )
1358	{
1359	Add_CouplePointed_Var_1($2,$4);
1360	coupletmp = $4;
1361	strcpy(ligne,"");
1362	while ( coupletmp )
1363	{
1364	strcat(ligne, coupletmp->c_namevar);
1365	strcat(ligne, " => ");
1366	strcat(ligne, coupletmp->c_namepointedvar);
1367	coupletmp = coupletmp->suiv;
1368	if ( coupletmp ) strcat(ligne,",");
1369	}
1370	sprintf(charusemodule,"%s",$2);
1371	}
1372	Add_NameOfModuleUsed_1($2);
1373	}
1374	if ( inmoduledeclare == 0 )
1375	{
1376	pos_end = setposcur();
1377	RemoveWordSET_0(fortran_out,pos_curuse,pos_end-pos_curuse);
1378	}
1379	}
1380	\| word_use TOK_NAME ',' TOK_ONLY ':' '\n'
1381	{
1382	/* if variables has been declared in a subroutine */
1383	sprintf(charusemodule,"%s",$2);
1384	if ( firstpass )
1385	{
1386	Add_NameOfModuleUsed_1($2);
1387	}
1388	else
1389	{
1390	if ( insubroutinedeclare )
1391	copyuseonly_0($2);
1392
1393	if ( inmoduledeclare == 0 )
1394	{
1395	pos_end = setposcur();
1396	RemoveWordSET_0(fortran_out,pos_curuse,pos_end-pos_curuse);
1397	}
1398	}
1399	}
1400	\| word_use TOK_NAME ',' TOK_ONLY ':' only_list
1401	{
1402	/* if variables has been declared in a subroutine */
1403	if ( firstpass )
1404	{
1405	if ( insubroutinedeclare )
1406	{
1407	Add_CouplePointed_Var_1($2,$6);
1408	coupletmp = $6;
1409	strcpy(ligne,"");
1410	while ( coupletmp )
1411	{
1412	strcat(ligne,coupletmp->c_namevar);
1413	if ( strcasecmp(coupletmp->c_namepointedvar,"") ) strcat(ligne," => ");
1414	strcat(ligne,coupletmp->c_namepointedvar);
1415	coupletmp = coupletmp->suiv;
1416	if ( coupletmp ) strcat(ligne,",");
1417	}
1418	sprintf(charusemodule,"%s",$2);
1419	}
1420	Add_NameOfModuleUsed_1($2);
1421	}
1422	else /* if ( firstpass == 0 ) */
1423	{
1424	if ( inmoduledeclare == 0 )
1425	{
1426	pos_end = setposcur();
1427	RemoveWordSET_0(fortran_out,pos_curuse,pos_end-pos_curuse);
1428	if (oldfortran_out) variableisglobalinmodule($6,$2,oldfortran_out,pos_curuseold);
1429	}
1430	else
1431	{
1432	/* if we are in the module declare and if the */
1433	/* onlylist is a list of global variable */
1434	variableisglobalinmodule($6, $2, fortran_out,pos_curuse);
1435	}
1436	}
1437	}
1438	;
1439	word_use :
1440	TOK_USE
1441	{
1442	pos_curuse = setposcur()-strlen($1);
1443	if (firstpass == 0 && oldfortran_out) pos_curuseold = setposcurname(oldfortran_out);
1444	}
1445	;
1446	rename_list :
1447	rename_name
1448	{
1449	$$ = $1;
1450	}
1451	\| rename_list ',' rename_name
1452	{
1453	/* insert the variable in the list $1 */
1454	$3->suiv = $1;
1455	$$ = $3;
1456	}
1457	;
1458	rename_name : TOK_NAME TOK_POINT_TO TOK_NAME
1459	{
1460	coupletmp = (listcouple *) calloc(1,sizeof(listcouple));
1461	strcpy(coupletmp->c_namevar,$1);
1462	strcpy(coupletmp->c_namepointedvar,$3);
1463	coupletmp->suiv = NULL;
1464	$$ = coupletmp;
1465	}
1466	;
1467	only_list :
1468	only_name { $$ = $1; }
1469	\| only_list ',' only_name
1470	{
1471	/* insert the variable in the list $1 */
1472	$3->suiv = $1;
1473	$$ = $3;
1474	}
1475	;
1476	only_name :
1477	TOK_NAME TOK_POINT_TO TOK_NAME
1478	{
1479	coupletmp = (listcouple *)calloc(1,sizeof(listcouple));
1480	strcpy(coupletmp->c_namevar,$1);
1481	strcpy(coupletmp->c_namepointedvar,$3);
1482	coupletmp->suiv = NULL;
1483	$$ = coupletmp;
1484	pointedvar = 1;
1485	Add_UsedInSubroutine_Var_1($1);
1486	}
1487	\| TOK_NAME
1488	{
1489	coupletmp = (listcouple *)calloc(1,sizeof(listcouple));
1490	strcpy(coupletmp->c_namevar,$1);
1491	strcpy(coupletmp->c_namepointedvar,"");
1492	coupletmp->suiv = NULL;
1493	$$ = coupletmp;
1494	}
1495	;
1496
1497	/* R209 : execution-part-construct */
1498	execution-part-construct:
1499	executable-construct
1500	\| format-stmt
1501	;
1502
1503	/* R213 : executable-construct */
1504	executable-construct:
1505	action-stmt
1506	\| do-construct
1507	\| case-construct
1508	\| if-construct
1509	\| where-construct
1510	;
1511
1512	/* R214 : action-stmt */
1513	action-stmt :
1514	TOK_CONTINUE
1515	\| ident_dims after_ident_dims
1516	\| goto
1517	\| call
1518	\| iofctl ioctl
1519	\| read option_read
1520	\| TOK_WRITE ioctl
1521	\| TOK_WRITE ioctl outlist
1522	\| TOK_REWIND after_rewind
1523	\| TOK_ALLOCATE '(' allocation_list opt_stat_spec ')' { inallocate = 0; }
1524	\| TOK_DEALLOCATE '(' allocate_object_list opt_stat_spec ')' { inallocate = 0; }
1525	\| TOK_EXIT optexpr
1526	\| TOK_RETURN opt_expr
1527	\| TOK_CYCLE opt_expr
1528	\| stop opt_expr
1529	\| int_list
1530	\| TOK_NULLIFY '(' pointer_name_list ')'
1531	\| word_endunit
1532	{
1533	GlobalDeclaration = 0 ;
1534	if ( firstpass == 0 && strcasecmp(subroutinename,"") )
1535	{
1536	if ( module_declar && insubroutinedeclare == 0 ) fclose(module_declar);
1537	}
1538	if ( strcasecmp(subroutinename,"") )
1539	{
1540	if ( inmodulemeet == 1 )
1541	{
1542	/* we are in a module */
1543	if ( insubroutinedeclare == 1 )
1544	{
1545	/* it is like an end subroutine <name> */
1546	insubroutinedeclare = 0 ;
1547	pos_cur = setposcur();
1548	closeandcallsubloopandincludeit_0(1);
1549	functiondeclarationisdone = 0;
1550	}
1551	else
1552	{
1553	/* it is like an end module <name> */
1554	inmoduledeclare = 0 ;
1555	inmodulemeet = 0 ;
1556	}
1557	}
1558	else
1559	{
1560	insubroutinedeclare = 0;
1561	pos_cur = setposcur();
1562	closeandcallsubloopandincludeit_0(2);
1563	functiondeclarationisdone = 0;
1564	}
1565	}
1566	strcpy(subroutinename,"");
1567	}
1568	\| word_endprogram opt_name
1569	{
1570	insubroutinedeclare = 0;
1571	inprogramdeclare = 0;
1572	pos_cur = setposcur();
1573	closeandcallsubloopandincludeit_0(3);
1574	functiondeclarationisdone = 0;
1575	strcpy(subroutinename,"");
1576	}
1577	\| word_endsubroutine opt_name
1578	{
1579	if ( strcasecmp(subroutinename,"") )
1580	{
1581	insubroutinedeclare = 0;
1582	pos_cur = setposcur();
1583	closeandcallsubloopandincludeit_0(1);
1584	functiondeclarationisdone = 0;
1585	strcpy(subroutinename,"");
1586	}
1587	}
1588	\| word_endfunction opt_name
1589	{
1590	insubroutinedeclare = 0;
1591	pos_cur = setposcur();
1592	closeandcallsubloopandincludeit_0(0);
1593	functiondeclarationisdone = 0;
1594	strcpy(subroutinename,"");
1595	}
1596	\| TOK_ENDMODULE opt_name
1597	{
1598	/* if we never meet the contains keyword */
1599	if ( firstpass == 0 )
1600	{
1601	RemoveWordCUR_0(fortran_out, strlen($2)+11); // Remove word "end module"
1602	if ( inmoduledeclare && ! aftercontainsdeclare )
1603	{
1604	Write_Closing_Module(1);
1605	}
1606	fprintf(fortran_out,"\n end module %s\n", curmodulename);
1607	if ( module_declar && insubroutinedeclare == 0 )
1608	{
1609	fclose(module_declar);
1610	}
1611	}
1612	inmoduledeclare = 0 ;
1613	inmodulemeet = 0 ;
1614	aftercontainsdeclare = 1;
1615	strcpy(curmodulename, "");
1616	GlobalDeclaration = 0 ;
1617	}
1618	\| if-stmt
1619	\| where-stmt
1620	\| TOK_CONTAINS
1621	{
1622	if ( inside_type_declare ) break;
1623	if ( inmoduledeclare )
1624	{
1625	if ( firstpass == 0 )
1626	{
1627	RemoveWordCUR_0(fortran_out,9); // Remove word 'contains'
1628	Write_Closing_Module(0);
1629	}
1630	inmoduledeclare = 0 ;
1631	aftercontainsdeclare = 1;
1632	}
1633	else if ( insubroutinedeclare )
1634	{
1635	incontainssubroutine = 1;
1636	insubroutinedeclare = 0;
1637	incontainssubroutine = 0;
1638	functiondeclarationisdone = 0;
1639
1640	if ( firstpass )
1641	List_ContainsSubroutine = Addtolistnom(subroutinename, List_ContainsSubroutine, 0);
1642	else
1643	closeandcallsubloop_contains_0();
1644
1645	strcpy(subroutinename, "");
1646	}
1647	else printf("l.%4d -- TOK_CONTAINS -- MHCHECK\n",line_num_input);
1648	}
1649	;
1650
1651	/* R601 : variable */
1652	//variable : expr
1653	// ;
1654
1655	/* R734 : assignment-stmt */
1656	// assignment-stmt: variable '=' expr
1657	// ;
1658	assignment-stmt: expr
1659	;
1660
1661	/* R741 : where-stmt */
1662	where-stmt: TOK_WHERE '(' mask-expr ')' where-assignment-stmt
1663	;
1664
1665	/* R742 : where-construct */
1666	where-construct: where-construct-stmt line-break opt-where-body-construct opt-masked-elsewhere-construct opt-elsewhere-construct end-where-stmt
1667	;
1668
1669	opt-where-body-construct:
1670	\| opt-where-body-construct where-body-construct line-break
1671	;
1672
1673	opt-masked-elsewhere-construct :
1674	\| opt-masked-elsewhere-construct masked-elsewhere-stmt line-break opt-where-body-construct
1675	;
1676
1677	opt-elsewhere-construct:
1678	\| opt-elsewhere-construct elsewhere-stmt line-break opt-where-body-construct
1679	;
1680
1681	/* R743 : where-construct-stmt */
1682	where-construct-stmt:
1683	TOK_WHERE '(' mask-expr ')'
1684	;
1685
1686	/* R744 : where-body-construct */
1687	where-body-construct: where-assignment-stmt
1688	\| where-stmt
1689	\| where-construct
1690	;
1691
1692	/* R745 : where-assignment-stmt */
1693	where-assignment-stmt: assignment-stmt
1694	;
1695
1696	/* R746 : mask-expr */
1697	mask-expr: expr
1698	;
1699
1700	/* R747 : masked-elsewhere-stmt */
1701	masked-elsewhere-stmt:
1702	TOK_ELSEWHEREPAR mask-expr ')'
1703	\| TOK_ELSEWHEREPAR mask-expr ')' TOK_NAME
1704	;
1705
1706	/* R748: elsewhere-stmt */
1707	elsewhere-stmt:
1708	TOK_ELSEWHERE
1709	\| TOK_ELSEWHERE TOK_NAME
1710	;
1711
1712	/* R749: end-where-stmt */
1713	end-where-stmt:
1714	TOK_ENDWHERE
1715	\| TOK_ENDWHERE TOK_NAME
1716	;
1717
1718	/* R752 : forall-header */
1719	forall-header :
1720	;
1721
1722	/* R801 : block */
1723	block:
1724	\|block execution-part-construct
1725	\|block execution-part-construct line-break
1726	;
1727
1728	/* R813 : do-construct */
1729	do-construct:
1730	block-do-construct
1731	;
1732
1733	/* R814 : block-do-construct */
1734	block-do-construct:
1735	do-stmt line-break do-block end-do
1736	;
1737
1738	/* R815 : do-stmt */
1739	do-stmt:
1740	label-do-stmt
1741	\| nonlabel-do-stmt
1742	;
1743
1744	/* R816 : label-do-stmt */
1745	label-do-stmt:
1746	TOK_NAME ':' TOK_PLAINDO label
1747	\| TOK_PLAINDO label
1748	\| TOK_NAME ':' TOK_PLAINDO label loop-control
1749	\| TOK_PLAINDO label loop-control
1750	;
1751
1752	/* R817 : nonlabel-do-stmt */
1753	nonlabel-do-stmt:
1754	TOK_NAME ':' TOK_PLAINDO
1755	\| TOK_PLAINDO
1756	\| TOK_NAME ':' TOK_PLAINDO loop-control
1757	\| TOK_PLAINDO loop-control
1758	;
1759
1760	/* R818 : loop-control */
1761	loop-control:
1762	opt_comma do-variable '=' expr ',' expr
1763	\| opt_comma do-variable '=' expr ',' expr ',' expr
1764	\| opt_comma TOK_WHILE '(' expr ')'
1765	\| opt_comma TOK_CONCURRENT forall-header
1766	;
1767
1768	/* R819 : do-variable */
1769	do-variable : ident
1770	;
1771
1772	/* R820 : do-block */
1773	do-block: block
1774	;
1775
1776	/* R821 : end-do */
1777	end-do: end-do-stmt
1778	\| continue-stmt
1779	;
1780
1781	/* R822 : end-do-stmt */
1782	end-do-stmt:
1783	TOK_ENDDO
1784	\| TOK_ENDDO TOK_NAME
1785	;
1786
1787	/* R832 : if-construct */
1788	if-construct: if-then-stmt line-break block opt-else-if-stmt-block opt-else-stmt-block end-if-stmt
1789	;
1790
1791	opt-else-if-stmt-block:
1792	\| else-if-stmt-block
1793	\| opt-else-if-stmt-block else-if-stmt-block
1794	;
1795
1796	else-if-stmt-block:
1797	else-if-stmt line-break block
1798	;
1799
1800	opt-else-stmt-block:
1801	\| else-stmt-block
1802	\| opt-else-stmt-block else-if-stmt-block
1803	;
1804
1805	else-stmt-block: else-stmt line-break block
1806	;
1807
1808	/* R833 : if-then-stmt */
1809	if-then-stmt:
1810	TOK_NAME ':' TOK_LOGICALIF '(' expr ')' TOK_THEN
1811	\| TOK_LOGICALIF '(' expr ')' TOK_THEN
1812	;
1813
1814	/* R834 : else-if-stmt */
1815	else-if-stmt:
1816	TOK_ELSEIF '(' expr ')' TOK_THEN
1817	\| TOK_ELSEIF '(' expr ')' TOK_THEN TOK_NAME
1818	;
1819
1820	/* R835 : else-stmt */
1821	else-stmt:
1822	TOK_ELSE
1823	\| TOK_ELSE TOK_NAME
1824	;
1825
1826	/* R836 : end-if-stmt */
1827	end-if-stmt:
1828	TOK_ENDIF
1829	\| TOK_ENDIF TOK_NAME
1830	;
1831
1832	/* R837 : if-stmt */
1833	if-stmt: TOK_LOGICALIF '(' expr ')' action-stmt
1834	;
1835
1836	/* R838 : case-construct */
1837	case-construct: select-case-stmt line-break opt_case-stmt-block end-select-stmt
1838	;
1839
1840	opt_case-stmt-block:
1841	\| case-stmt-block
1842	\| opt_case-stmt-block case-stmt-block
1843	;
1844
1845	case-stmt-block: case-stmt line-break block
1846	;
1847
1848	/* R839 : select-case-stmt */
1849	select-case-stmt :
1850	TOK_NAME ':' TOK_SELECTCASE '(' expr ')'
1851	\| TOK_SELECTCASE '(' expr ')'
1852	;
1853
1854	/* R840 : case-stmt */
1855	case-stmt:
1856	TOK_CASE case-selector
1857	\| TOK_CASE case-selector TOK_NAME
1858	;
1859
1860	/* R840 : end-select-stmt */
1861	end-select-stmt:
1862	TOK_ENDSELECT
1863	\| TOK_ENDSELECT TOK_NAME
1864	;
1865
1866	/* R843 : case-selector */
1867	case-selector:
1868	'(' case-value-range-list ')'
1869	\| TOK_DEFAULT
1870	;
1871
1872	case-value-range-list:
1873	case-value-range
1874	\| case-value-range-list ',' case-value-range
1875	;
1876
1877	/* R844: case-value-range */
1878	case-value-range :
1879	case-value
1880	\| case-value ':'
1881	\| ':' case-value
1882	\| case-value ':' case-value
1883	;
1884
1885	/* R845 : case-value */
1886	case-value: expr
1887	;
1888
1889	/* R854 : continue-stmt */
1890	continue-stmt: TOK_CONTINUE
1891	;
1892
1893	/* R1001 : format-stmt */
1894	format-stmt: TOK_FORMAT
1895	;
1896
1897	word_endsubroutine :
1898	TOK_ENDSUBROUTINE
1899	{
1900	strcpy($$,$1);
1901	pos_endsubroutine = setposcur()-strlen($1);
1902	functiondeclarationisdone = 0;
1903	}
1904	;
1905	word_endunit :
1906	TOK_ENDUNIT
1907	{
1908	strcpy($$,$1);
1909	pos_endsubroutine = setposcur()-strlen($1);
1910	}
1911	;
1912	word_endprogram :
1913	TOK_ENDPROGRAM
1914	{
1915	strcpy($$,$1);
1916	pos_endsubroutine = setposcur()-strlen($1);
1917	}
1918	;
1919	word_endfunction :
1920	TOK_ENDFUNCTION
1921	{
1922	strcpy($$,$1);
1923	pos_endsubroutine = setposcur()-strlen($1);
1924	}
1925	;
1926
1927	opt_name : '\n' {strcpy($$,"");}
1928	\| TOK_NAME {strcpy($$,$1);}
1929	;
1930
1931	before_dims : { created_dimensionlist = 0; }
1932	;
1933	ident_dims :
1934	ident before_dims dims dims
1935	{
1936	created_dimensionlist = 1;
1937	if ( ($3 == NULL) \|\| ($4 == NULL) ) break;
1938	if ( agrif_parentcall == 1 )
1939	{
1940	ModifyTheAgrifFunction_0($3->dim.last);
1941	agrif_parentcall = 0;
1942	fprintf(fortran_out," = ");
1943	}
1944	}
1945	\| ident_dims '%' declare_after_percent ident before_dims dims dims
1946	{
1947	created_dimensionlist = 1;
1948	}
1949	;
1950	int_list :
1951	TOK_CSTINT
1952	\| int_list ',' TOK_CSTINT
1953	;
1954	after_ident_dims :
1955	'=' expr
1956	\| TOK_POINT_TO expr
1957	;
1958	call : keywordcall opt_call
1959	{
1960	inagrifcallargument = 0 ;
1961	incalldeclare=0;
1962	if ( oldfortran_out && (callagrifinitgrids == 1) && (firstpass == 0) )
1963	{
1964	pos_end = setposcur();
1965	RemoveWordSET_0(fortran_out,pos_curcall,pos_end-pos_curcall);
1966	strcpy(subofagrifinitgrids,subroutinename);
1967	}
1968	Instanciation_0(sameagrifname);
1969	}
1970	;
1971	opt_call :
1972	\| '(' opt_callarglist ')'
1973	;
1974	opt_callarglist :
1975	\| callarglist
1976	;
1977	keywordcall :
1978	before_call TOK_FLUSH
1979	\| before_call TOK_NAME
1980	{
1981	if (!strcasecmp($2,"MPI_Init") ) callmpiinit = 1;
1982	else callmpiinit = 0;
1983
1984	if (!strcasecmp($2,"Agrif_Init_Grids") )
1985	{
1986	callagrifinitgrids = 1;
1987	strcpy(meetagrifinitgrids,subroutinename);
1988	}
1989	else
1990	{
1991	callagrifinitgrids = 0;
1992	}
1993	if ( Vartonumber($2) == 1 )
1994	{
1995	incalldeclare = 1;
1996	inagrifcallargument = 1 ;
1997	Add_SubroutineWhereAgrifUsed_1(subroutinename, curmodulename);
1998	}
1999	}
2000	;
2001	before_call : TOK_CALL { pos_curcall=setposcur()-4; }
2002	;
2003	callarglist :
2004	callarg
2005	\| callarglist ',' callarg
2006	;
2007	callarg :
2008	expr
2009	{
2010	if ( callmpiinit == 1 )
2011	{
2012	strcpy(mpiinitvar,$1);
2013	if ( firstpass == 1 ) Add_UsedInSubroutine_Var_1 (mpiinitvar);
2014	}
2015	}
2016	\| '*' TOK_CSTINT
2017	;
2018
2019	stop : TOK_PAUSE
2020	\| TOK_STOP
2021	;
2022
2023	option_inlist :
2024	\| inlist
2025	;
2026	option_read :
2027	ioctl option_inlist
2028	\| infmt opt_inlist
2029	;
2030	opt_inlist :
2031	\| ',' inlist
2032	;
2033	ioctl : '(' ctllist ')'
2034	;
2035	after_rewind :
2036	'(' ident ')'
2037	\| '(' TOK_CSTINT ')'
2038	\| TOK_CSTINT
2039	\| '(' uexpr ')'
2040	\| TOK_NAME
2041	;
2042	ctllist :
2043	ioclause
2044	\| ctllist ',' ioclause
2045	;
2046	ioclause :
2047	fexpr
2048	\| '*'
2049	\| TOK_DASTER
2050	\| ident expr dims
2051	\| ident expr '%' declare_after_percent ident_dims
2052	\| ident '(' triplet ')'
2053	\| ident '*'
2054	\| ident TOK_DASTER
2055	;
2056
2057	declare_after_percent: { afterpercent = 1; }
2058	;
2059	iofctl :
2060	TOK_OPEN
2061	\| TOK_CLOSE
2062	\| TOK_FLUSH
2063	;
2064	infmt : unpar_fexpr
2065	\| '*'
2066	;
2067
2068	read : TOK_READ
2069	\| TOK_INQUIRE
2070	\| TOK_PRINT
2071	;
2072
2073	fexpr : unpar_fexpr
2074	\| '(' fexpr ')'
2075	;
2076	unpar_fexpr :
2077	lhs
2078	\| simple_const
2079	\| fexpr addop fexpr %prec '+'
2080	\| fexpr '*' fexpr
2081	\| fexpr TOK_SLASH fexpr
2082	\| fexpr TOK_DASTER fexpr
2083	\| addop fexpr %prec '*'
2084	\| fexpr TOK_DSLASH fexpr
2085	\| TOK_FILE expr
2086	\| TOK_UNIT expr
2087	\| TOK_NML expr
2088	\| TOK_FMT expr
2089	\| TOK_EXIST expr
2090	\| TOK_ERR expr
2091	\| TOK_END expr
2092	\| TOK_NAME '=' expr
2093	\| predefinedfunction
2094	;
2095	addop : '+'
2096	\| '-'
2097	;
2098	inlist : inelt
2099	\| inlist ',' inelt
2100	;
2101	// opt_lhs :
2102	// \| lhs
2103	// ;
2104	inelt : //opt_lhs opt_operation
2105	lhs opt_operation
2106	\| '(' inlist ')' opt_operation
2107	\| predefinedfunction opt_operation
2108	\| simple_const opt_operation
2109	\| '(' inlist ',' dospec ')'
2110	;
2111	opt_operation :
2112	\| operation
2113	\| opt_operation operation
2114	;
2115	outlist :
2116	complex_const { strcpy($$,$1); }
2117	\| predefinedfunction { strcpy($$,$1); }
2118	\| uexpr { strcpy($$,$1); }
2119	\| other { strcpy($$,$1); }
2120	\| uexpr ',' expr { sprintf($$,"%s,%s",$1,$3); }
2121	\| uexpr ',' other { sprintf($$,"%s,%s",$1,$3); }
2122	\| other ',' expr { sprintf($$,"%s,%s",$1,$3); }
2123	\| other ',' other { sprintf($$,"%s,%s",$1,$3); }
2124	\| outlist ',' expr { sprintf($$,"%s,%s",$1,$3); }
2125	\| outlist ',' other { sprintf($$,"%s,%s",$1,$3); }
2126	;
2127	other :
2128	'(' uexpr ',' dospec ')' { sprintf($$,"(%s,%s)",$2,$4); }
2129	\| '(' outlist ',' dospec ')' { sprintf($$,"(%s,%s)",$2,$4); }
2130	\| '(' other ',' dospec ')' { sprintf($$,"(%s,%s)",$2,$4); }
2131	dospec :
2132	TOK_NAME '=' expr ',' expr { sprintf($$,"%s=%s,%s)",$1,$3,$5);}
2133	\| TOK_NAME '=' expr ',' expr ',' expr { sprintf($$,"%s=%s,%s,%s)",$1,$3,$5,$7);}
2134	;
2135	goto : TOK_PLAINGOTO '(' expr ',' expr ')' ',' expr
2136	\| TOK_PLAINGOTO TOK_CSTINT
2137	;
2138	allocation_list :
2139	allocate_object
2140	\| allocation_list ',' allocate_object
2141	;
2142	allocate_object :
2143	lhs { Add_Allocate_Var_1($1,curmodulename); }
2144	;
2145	allocate_object_list :
2146	allocate_object
2147	\| allocate_object_list ',' allocate_object
2148	;
2149	opt_stat_spec :
2150	\| ',' TOK_STAT '=' lhs
2151	;
2152	pointer_name_list :
2153	ident
2154	\| pointer_name_list ',' ident
2155	;
2156
2157	%%
2158
2159	void process_fortran(const char *input_file)
2160	{
2161	extern FILE *fortran_in;
2162	extern FILE *fortran_out;
2163
2164	char output_file[LONG_FNAME];
2165	char input_fullpath[LONG_FNAME];
2166
2167	if ( todebug == 1 ) printf("Firstpass == %d \n", firstpass);
2168
2169	yydebug=0;
2170	/******************************************************************************/
2171	/* 1- Open input file */
2172	/******************************************************************************/
2173
2174	strcpy(cur_filename, input_file);
2175	sprintf(input_fullpath, "%s/%s", input_dir, input_file);
2176
2177	fortran_in = fopen(input_fullpath, "r");
2178	if (! fortran_in)
2179	{
2180	printf("Error : File %s does not exist\n", input_fullpath);
2181	exit(1);
2182	}
2183
2184	/******************************************************************************/
2185	/* 2- Variables initialization */
2186	/******************************************************************************/
2187
2188	line_num_input = 1;
2189	PublicDeclare = 0;
2190	PrivateDeclare = 0;
2191	ExternalDeclare = 0;
2192	SaveDeclare = 0;
2193	pointerdeclare = 0;
2194	optionaldeclare = 0;
2195	incalldeclare = 0;
2196	inside_type_declare = 0;
2197	Allocatabledeclare = 0 ;
2198	Targetdeclare = 0 ;
2199	VariableIsParameter = 0 ;
2200	strcpy(NamePrecision,"");
2201	c_star = 0 ;
2202	functiondeclarationisdone = 0;
2203	insubroutinedeclare = 0 ;
2204	strcpy(subroutinename," ");
2205	isrecursive = 0;
2206	InitialValueGiven = 0 ;
2207	GlobalDeclarationType = 0;
2208	inmoduledeclare = 0;
2209	incontainssubroutine = 0;
2210	afterpercent = 0;
2211	aftercontainsdeclare = 1;
2212	strcpy(nameinttypename,"");
2213
2214	/******************************************************************************/
2215	/* 3- Parsing of the input file (1 time) */
2216	/******************************************************************************/
2217
2218	sprintf(output_file, "%s/%s", output_dir, input_file);
2219
2220	if (firstpass == 0) fortran_out = fopen(output_file,"w");
2221
2222	fortran_parse();
2223
2224	if (firstpass == 0) NewModule_Creation_0();
2225	if (firstpass == 0) fclose(fortran_out);
2226	}

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

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

Context Navigation

source: vendors/AGRIF/dev_r11615_ENHANCE-04_namelists_as_internalfiles_agrif/LEX/fortran.y @ 11668

Download in other formats: