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

Context Navigation

source: branches/TAM_V3_0/AGRIF/LIB/fortran.y @ 3317

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

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

Download in other formats:

Original Format