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

Last change on this file since 774 was 774, checked in by rblod, 16 years ago
Update Agrif, see ticket:#39
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 90.6 KB

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

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

Download in other formats:

Original Format