New URL for NEMO forge! http://forge.nemo-ocean.eu

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.

fortran.y in trunk/AGRIF/LIB – NEMO

Context Navigation

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

Last change on this file since 663 was 663, checked in by opalod, 17 years ago
RB: update CONV
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 89.1 KB

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

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

Download in other formats:

Original Format