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 @ 530

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

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

Download in other formats:

Original Format