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 trunk/AGRIF/LIB – NEMO

Context Navigation

source: trunk/AGRIF/LIB/fortran.y @ 663

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

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

Download in other formats:

Original Format