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

Context Navigation

source: trunk/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.y @ 2715

Last change on this file since 2715 was 2715, checked in by rblod, 13 years ago
First attempt to put dynamic allocation on the trunk
Property svn:keywords set to `Id`
File size: 96.5 KB

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

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

Download in other formats:

Original Format