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

Last change on this file since 1780 was 1349, checked in by rblod, 15 years ago
Fix Agrif issue with constant character char, see ticket #367
Property svn:eol-style set to `native` Property svn:keywords set to `Author Date Id Revision`
File size: 95.2 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 */
[774]	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	/******************************************************************************/
[774]	33	/* version 1.7 */
[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;
[774]	43	char c_selectorname[LONG_C];
	44	char ligne[LONG_C];
[1200]	45	char truename[LONGNOM];
[774]	46	char identcopy[LONG_C];
[396]	47	int c_selectorgiven=0;
	48	int incom;
	49	listvar *curlistvar;
	50	typedim c_selectordim;
	51	listcouple *coupletmp;
[663]	52	listdim *parcoursdim;
[396]	53	int removeline=0;
[663]	54	listvar *test;
[396]	55	%}
	56
	57	%union {
[774]	58	char nac[LONG_C];
[396]	59	char na[LONGNOM];
	60	listdim *d;
	61	listvar *l;
	62	listnom *ln;
	63	listcouple *lc;
[1200]	64	listname *lnn;
[396]	65	typedim dim1;
	66	variable *v;
	67	}
	68
	69	%left ','
	70	%nonassoc ':'
	71	%right '='
	72	%left TOK_BINARY_OP
[1200]	73	%left TOK_EQV TOK_NEQV
[396]	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
[1200]	85	%token TOK_SEMICOLON
[396]	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
[663]	109	%token TOK_END
	110	%token TOK_ERR
[396]	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
[530]	121	%token TOK_CYCLE
[396]	122	%token TOK_SIN
	123	%token TOK_SINH
	124	%token TOK_ASIN
	125	%token TOK_EQUIVALENCE
[530]	126	%token TOK_BACKSPACE
[396]	127	%token TOK_LOG
	128	%token TOK_TAN
	129	%token TOK_ATAN
[663]	130	%token TOK_RECURSIVE
[396]	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
[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
[774]	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
[1200]	203	%token <nac> TOK_EQV
[774]	204	%token <nac> TOK_GT
	205	%token <nac> TOK_LT
	206	%token <nac> TOK_GE
	207	%token <nac> TOK_NE
[1200]	208	%token <nac> TOK_NEQV
[774]	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 */
[396]	246	/* the mesh */
[774]	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
[396]	253	%token ','
	254	%token ':'
	255	%token '('
[663]	256	%token ')'
[396]	257	%token '['
	258	%token ']'
	259	%token '!'
[663]	260	%token '_'
	261	%token '<'
	262	%token '>'
[396]	263	%type <l> dcl
[663]	264	%type <l> after_type
[530]	265	%type <l> dimension
[396]	266	%type <l> paramlist
[663]	267	%type <l> args
	268	%type <l> arglist
[396]	269	%type <lc> only_list
	270	%type <lc> only_name
	271	%type <lc> rename_list
	272	%type <lc> rename_name
[530]	273	%type <d> dims
	274	%type <d> dimlist
	275	%type <dim1> dim
	276	%type <v> paramitem
[774]	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
[1200]	296	%type <na> attribute
[774]	297	%type <na> complex_const
[396]	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
[663]	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
[396]	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
[1200]	328	%type <lnn> use_name_list
	329	%type <lnn> public
[396]	330
	331	%left TOK_OP
	332	%%
	333	input :
	334	\| input line
	335	;
	336	line : '\n' position
[530]	337	\| thislabel suite_line_list
[396]	338	\| TOK_COMMENT
	339	\| keyword cmnt writedeclar
	340	\| error writedeclar nulcurbuf
[663]	341	{yyerrok;yyclearin;}
[396]	342	;
[530]	343	suite_line_list : suite_line
[1200]	344	\| suite_line_list TOK_SEMICOLON suite_line
[530]	345	;
[1200]	346	suite_line : entry fin_line /* subroutine, function, module */
[396]	347	\| spec fin_line /* declaration */
	348	\| before_include filename fin_line
	349	{
[663]	350	if (inmoduledeclare == 0 )
[396]	351	{
	352	pos_end = setposcur();
[530]	353	RemoveWordSET_0(fortranout,pos_curinclude,
[396]	354	pos_end-pos_curinclude);
	355	}
	356	}
	357	\| exec cmnt writedeclar /* if, do etc ... */
[663]	358	\| instr fin_line /* instruction ident : do i = 1 ... */
[396]	359	;
	360	instr : ident ':'
	361	;
	362	fin_line : position cmnt
	363	;
[663]	364	keyword : TOK_DONOTTREAT
[396]	365	{
[663]	366	/* we should ignore the declaration until the keyword */
	367	/* TOK_ENDDONOTTREAT */
[396]	368	couldaddvariable = 0 ;
[530]	369	RemoveWordCUR_0(fortranout,-20,20);
[396]	370	}
[663]	371	\| TOK_ENDDONOTTREAT
[396]	372	{
	373	couldaddvariable = 1 ;
[530]	374	RemoveWordCUR_0(fortranout,-24,24);
[396]	375	}
	376	\| TOK_OMP
	377	\| TOK_DOLLAR
	378	;
[774]	379	position : {pos_cur = setposcur();}
[396]	380	;
[774]	381	thislabel :
[396]	382	\| TOK_LABEL nulcurbuf
	383	;
[774]	384	cmnt :
[396]	385	\| TOK_COMMENT
	386	;
[774]	387	incomment :
[396]	388	{incom = 1;}
	389	;
[774]	390	nulcurbuf :
[396]	391	{if (incom !=1) {strcpy(curbuf,"");incom=0;}}
	392	;
[663]	393	opt_recursive :
	394	\| TOK_RECURSIVE
	395	;
[774]	396	entry :
[663]	397	\| opt_recursive TOK_SUBROUTINE name_routine arglist
[396]	398	{
[663]	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);
[396]	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> */
[530]	416	writeheadnewsub_0(1);
[396]	417	}
	418	else
	419	{
	420	insubroutinedeclare = 1;
[530]	421	writeheadnewsub_0(1);
[396]	422	}
[663]	423	}
[396]	424	}
	425	\| TOK_PROGRAM name_routine
	426	{
[663]	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	}
[396]	436	strcpy(subroutinename,$2);
	437	/* Common case */
[663]	438	insubroutinedeclare = 1;
	439	/* in the second step we should write the head of */
	440	/* the subroutine sub_loop_<subroutinename> */
	441	writeheadnewsub_0(1);
[396]	442	}
	443	\| TOK_FUNCTION name_routine arglist TOK_RESULT arglist1
	444	{
[663]	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	}
[396]	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 */
[663]	459	Add_SubroutineArgument_Var_1($3);
	460	strcpy(DeclType,"");
[396]	461	/* in the second step we should write the head of */
	462	/* the subroutine sub_loop_<subroutinename> */
[530]	463	writeheadnewsub_0(2);
[396]	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 */
[663]	470	Add_SubroutineArgument_Var_1($3);
	471	strcpy(DeclType,"");
	472	Add_FunctionType_Var_1($2);
[530]	473	writeheadnewsub_0(2);
[396]	474	}
	475	}
	476	\| TOK_FUNCTION name_routine arglist
	477	{
[663]	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	}
[396]	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 */
[663]	492	Add_SubroutineArgument_Var_1($3);
	493	strcpy(DeclType,"");
	494	Add_FunctionType_Var_1($2);
[396]	495	/* in the second step we should write the head of */
	496	/* the subroutine sub_loop_<subroutinename> */
[530]	497	writeheadnewsub_0(2);
[396]	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 */
[663]	504	Add_SubroutineArgument_Var_1($3);
	505	strcpy(DeclType,"");
	506	Add_FunctionType_Var_1($2);
[530]	507	writeheadnewsub_0(2);
[396]	508	}
	509	}
	510	\| TOK_MODULE TOK_NAME
	511	{
[663]	512	GlobalDeclaration = 0;
[396]	513	strcpy(curmodulename,$2);
[663]	514	strcpy(subroutinename,"");
	515	Add_NameOfModule_1($2);
[396]	516	if ( inmoduledeclare == 0 )
[663]	517	{
[396]	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 ;
[663]	524	}
[396]	525	}
	526	;
[663]	527	name_routine : TOK_NAME
	528	{
	529	if ( couldaddvariable == 1 )
	530	{
	531	strcpy($$,$1);strcpy(subroutinename,$1);
	532	}
	533	}
[396]	534	writedeclar :
	535	;
	536	before_include : TOK_INCLUDE
	537	{
[530]	538	pos_curinclude = setposcur()-9;
[663]	539	}
[774]	540	filename : TOK_CHAR_CONSTANT
[396]	541	{
[663]	542	if ( couldaddvariable == 1 ) Add_Include_1($1);
[396]	543	}
	544	;
[774]	545	arglist : {
[663]	546	if ( firstpass == 1 && couldaddvariable == 1) $$=NULL;
	547	}
[396]	548	\| '(' ')' {
[663]	549	if ( firstpass == 1 && couldaddvariable == 1 ) $$=NULL;
[396]	550	}
	551	\| '(' args ')'
	552	{
[663]	553	if ( firstpass == 1 && couldaddvariable == 1 ) $$=$2;
[396]	554	}
	555	;
[663]	556	arglist1:
[396]	557	\| '(' ')'
	558	\| '(' args ')'
	559	{
[663]	560	if ( couldaddvariable == 1 )
	561	{
	562	Add_SubroutineArgument_Var_1($2);
	563	}
[396]	564	}
	565	;
[774]	566	args :arg {
[663]	567	if ( firstpass == 1 && couldaddvariable == 1)
[396]	568	{
[1200]	569	strcpy(nameinttypenameback,nameinttypename);
	570	strcpy(nameinttypename,"");
[663]	571	curvar=createvar($1,NULL);
[1200]	572	strcpy(nameinttypename,nameinttypenameback);
[396]	573	curlistvar=insertvar(NULL,curvar);
[663]	574	$$=settype("",curlistvar);
[396]	575	}
	576	}
[663]	577	\| args ',' arg
[396]	578	{
[663]	579	if ( firstpass == 1 && couldaddvariable == 1)
[396]	580	{
[1200]	581	strcpy(nameinttypenameback,nameinttypename);
	582	strcpy(nameinttypename,"");
[663]	583	curvar=createvar($3,NULL);
[1200]	584	strcpy(nameinttypename,nameinttypenameback);
[396]	585	$$=insertvar($1,curvar);
	586	}
	587	}
	588	;
[774]	589	arg : TOK_NAME {if ( couldaddvariable == 1 ) strcpy($$,$1);}
[663]	590	\| '' {if ( couldaddvariable == 1 ) strcpy($$,"");}
	591	;
[774]	592	spec : type after_type
[396]	593	{
[663]	594	if ( VarTypepar == 1 )
[396]	595	{
[663]	596	couldaddvariable = 1 ;
	597	VarTypepar = 0;
[396]	598	}
	599	}
[663]	600	\| TOK_TYPE opt_spec opt_sep opt_name
	601	{
	602	if ( couldaddvariable == 1 )
	603	{
	604	VarType = 1;
	605	couldaddvariable = 0 ;
	606	}
	607	}
[396]	608	\| TOK_ENDTYPE opt_name
[663]	609	{
	610	if ( VarType == 1 ) couldaddvariable = 1 ;
	611	VarType = 0;
	612	VarTypepar = 0;
	613	}
[396]	614	\| TOK_POINTER list_couple
[663]	615	\| before_parameter '(' paramlist ')'
[396]	616	{
[663]	617	if ( couldaddvariable == 1 )
[396]	618	{
[663]	619	if ( insubroutinedeclare == 0 )
	620	Add_GlobalParameter_Var_1($3);
	621	else Add_Parameter_Var_1($3);
[396]	622	pos_end = setposcur();
[1200]	623	RemoveWordSET_0(fortranout,pos_cur_decl,
[663]	624	pos_end-pos_cur_decl);
[396]	625	}
[663]	626	VariableIsParameter = 0 ;
[396]	627	}
[663]	628	\| before_parameter paramlist
[530]	629	{
[663]	630	if ( couldaddvariable == 1 )
	631	{
	632	if ( insubroutinedeclare == 0 )
	633	Add_GlobalParameter_Var_1($2);
	634	else Add_Parameter_Var_1($2);
[530]	635	pos_end = setposcur();
[663]	636	RemoveWordSET_0(fortranout,pos_cur_decl,
	637	pos_end-pos_cur_decl);
[530]	638	}
[663]	639	VariableIsParameter = 0 ;
[530]	640	}
[396]	641	\| common
	642	\| save
[663]	643	{
	644	pos_end = setposcur();
	645	RemoveWordSET_0(fortranout,pos_cursave,
	646	pos_end-pos_cursave);
	647	}
[396]	648	\| implicit
	649	\| dimension
[530]	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	{
[663]	656	Add_Globliste_1($1);
	657	/* if variableparamlists has been declared in a */
	658	/* subroutine */
[530]	659	if ( insubroutinedeclare == 1 )
	660	{
[663]	661	Add_Dimension_Var_1($1);
[530]	662	}
[663]	663	pos_end = setposcur();
	664	RemoveWordSET_0(fortranout,pos_curdimension,
	665	pos_end-pos_curdimension);
[530]	666	}
[663]	667	/* */
	668	PublicDeclare = 0;
	669	PrivateDeclare = 0;
	670	ExternalDeclare = 0;
	671	strcpy(NamePrecision,"");
[530]	672	c_star = 0;
	673	InitialValueGiven = 0 ;
	674	strcpy(IntentSpec,"");
[663]	675	VariableIsParameter = 0 ;
[530]	676	Allocatabledeclare = 0 ;
	677	SaveDeclare = 0;
	678	pointerdeclare = 0;
	679	optionaldeclare = 0 ;
	680	dimsgiven=0;
	681	c_selectorgiven=0;
[663]	682	strcpy(nameinttypename,"");
	683	strcpy(c_selectorname,"");
[530]	684	}
[396]	685	\| public
[1200]	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	}
[396]	698	\| private
	699	\| use_stat
	700	\| module_proc_stmt
[663]	701	\| interface
[396]	702	\| namelist
[530]	703	\| TOK_BACKSPACE '(' expr ')'
[396]	704	\| TOK_EXTERNAL opt_sep use_name_list
[530]	705	\| TOK_INTRINSIC opt_sep use_intrinsic_list
[663]	706	\| TOK_EQUIVALENCE list_expr_equi
[396]	707	\| before_data data '\n'
	708	{
	709	/* we should remove the data declaration */
[663]	710	if ( couldaddvariable == 1 && aftercontainsdeclare == 0 )
	711	{
[396]	712	pos_end = setposcur();
[530]	713	RemoveWordSET_0(fortranout,pos_curdata,
[396]	714	pos_end-pos_curdata);
[663]	715	}
[396]	716	}
	717	;
[663]	718	opt_spec :
	719	\| access_spec
	720	{
	721	PublicDeclare = 0 ;
	722	PrivateDeclare = 0 ;
	723	}
	724	;
[530]	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
[663]	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	;
[396]	764	list_expr : expr
	765	\| list_expr ',' expr
[663]	766	;
[396]	767	opt_sep :
	768	\| ':' ':'
	769	;
[663]	770	after_type : dcl nodimsgiven
[396]	771	{
[663]	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 */
[396]	775	if ( couldaddvariable == 1 )
	776	{
[663]	777	pos_end = setposcur();
[1200]	778	/*if (insubroutinedeclare == 0)
	779	{ */
	780	RemoveWordSET_0(fortranout,pos_cur_decl,
[663]	781	pos_end-pos_cur_decl);
[1200]	782
	783	/* }
	784	else
	785	{*/
	786	ReWriteDeclarationAndAddTosubroutine_01($1);
	787	pos_cur_decl = setposcur();
	788
	789	/}/
[663]	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);
[1200]	805
[663]	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
[396]	815	/* if variables has been declared in a subroutine */
	816	if ( insubroutinedeclare == 1 )
[1200]	817	{
	818	/* Add_SubroutineDeclaration_Var_1($1);*/
[396]	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 */
[663]	824	if ( aftercontainsdeclare == 1 &&
	825	SaveDeclare == 1 && firstpass == 1 )
[396]	826	{
[663]	827	if ( inmodulemeet == 0 ) Add_Save_Var_dcl_1($1);
	828	else Add_SubroutineDeclarationSave_Var_1($1);
[396]	829	}
	830	}
[663]	831	/* */
	832	PublicDeclare = 0;
	833	PrivateDeclare = 0;
	834	ExternalDeclare = 0;
	835	strcpy(NamePrecision,"");
[396]	836	c_star = 0;
	837	InitialValueGiven = 0 ;
[530]	838	strcpy(IntentSpec,"");
[663]	839	VariableIsParameter = 0 ;
[396]	840	Allocatabledeclare = 0 ;
	841	SaveDeclare = 0;
	842	pointerdeclare = 0;
	843	optionaldeclare = 0 ;
	844	dimsgiven=0;
	845	c_selectorgiven=0;
[663]	846	strcpy(nameinttypename,"");
	847	strcpy(c_selectorname,"");
[396]	848	}
[663]	849	\| before_function name_routine arglist
[396]	850	{
[663]	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	}
[396]	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 */
[663]	865	Add_SubroutineArgument_Var_1($3);
	866	Add_FunctionType_Var_1($2);
[396]	867	/* in the second step we should write the head of */
	868	/* the subroutine sub_loop_<subroutinename> */
[530]	869	writeheadnewsub_0(2);
[396]	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 */
[663]	876	Add_SubroutineArgument_Var_1($3);
	877	Add_FunctionType_Var_1($2);
[396]	878	/* in the second step we should write the head of */
	879	/* the subroutine sub_loop_<subroutinename> */
[530]	880	writeheadnewsub_0(2);
[396]	881	}
[1200]	882	strcpy(nameinttypename,"");
	883
[396]	884	}
	885	;
[663]	886	before_function : TOK_FUNCTION
	887	{
	888	functiondeclarationisdone = 1;
	889	}
	890	;
	891
[396]	892	before_parameter : TOK_PARAMETER
	893	{
[663]	894	VariableIsParameter = 1;
[530]	895	pos_curparameter = setposcur()-9;
[663]	896	}
[396]	897	before_data : TOK_DATA
	898	{
[663]	899	pos_curdata = setposcur()-strlen($1);
[396]	900	}
[774]	901	data : TOK_NAME TOK_SLASH datavallist TOK_SLASH
[396]	902	{
[663]	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	}
[396]	909	}
	910	\| data opt_comma TOK_NAME TOK_SLASH datavallist TOK_SLASH
	911	{
[663]	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	}
[396]	918	}
[530]	919	\| datanamelist TOK_SLASH datavallist TOK_SLASH
	920	{
	921	/*******************************************************/
	922	/*******************************************************/
	923	/*******************************************************/
	924	/*******************************************************/
	925	/*******************************************************/
	926	/*******************************************************/
	927	/*******************************************************/
	928	}
[396]	929	;
	930	datavallist : expr_data
	931	{
[663]	932	if ( couldaddvariable == 1 )
	933	{
	934	strcpy($$,$1);
	935	}
[396]	936	}
[663]	937	\| expr_data ',' datavallist
[396]	938	{
[663]	939	if ( couldaddvariable == 1 )
	940	{
	941	sprintf($$,"%s,%s",$1,$3);
	942	}
[396]	943	}
	944	;
[663]	945
[774]	946	save : before_save varsave
[663]	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	;
[774]	956	varsave :
[663]	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	;
[396]	966	expr_data : opt_signe simple_const
[663]	967	{if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}
[396]	968	\| expr_data '+' expr_data
[663]	969	{if ( couldaddvariable == 1 ) sprintf($$,"%s+%s",$1,$3);}
[396]	970	\| expr_data '-' expr_data
[663]	971	{if ( couldaddvariable == 1 ) sprintf($$,"%s-%s",$1,$3);}
[396]	972	\| expr_data '*' expr_data
[663]	973	{if ( couldaddvariable == 1 ) sprintf($$,"%s*%s",$1,$3);}
[396]	974	\| expr_data '/' expr_data
[663]	975	{if ( couldaddvariable == 1 ) sprintf($$,"%s/%s",$1,$3);}
[396]	976	;
[663]	977	opt_signe :
	978	{if ( couldaddvariable == 1 ) strcpy($$,"");}
[396]	979	\| signe
[663]	980	{if ( couldaddvariable == 1 ) strcpy($$,$1);}
[396]	981	;
[774]	982	namelist : namelist_action after_namelist
[396]	983	;
[663]	984	namelist_action : TOK_NAMELIST ident
[396]	985	\| TOK_NAMELIST comblock ident
	986	\| namelist_action opt_comma comblock opt_comma ident
	987	\| namelist_action ',' ident
	988	;
	989	after_namelist :
	990	;
[774]	991	interface : TOK_INTERFACE opt_name
[396]	992	\| TOK_ENDINTERFACE opt_name
	993	;
[663]	994	before_dimension : TOK_DIMENSION
	995	{
	996	positioninblock=0;
	997	pos_curdimension = setposcur()-9;
	998	}
	999
[774]	1000	dimension : before_dimension opt_comma TOK_NAME dims lengspec
[530]	1001	{
	1002	if ( couldaddvariable == 1 )
	1003	{
	1004	/* */
	1005	curvar=createvar($3,$4);
	1006	/* */
[663]	1007	CreateAndFillin_Curvar("",curvar);
	1008	/* */
	1009	curlistvar=insertvar(NULL,curvar);
	1010	/* */
	1011	$$=settype("",curlistvar);
	1012	/* */
[530]	1013	strcpy(vallengspec,"");
	1014	}
	1015	}
[396]	1016	\| dimension ',' TOK_NAME dims lengspec
[530]	1017	{
	1018	if ( couldaddvariable == 1 )
	1019	{
	1020	/* */
	1021	curvar=createvar($3,$4);
	1022	/* */
[663]	1023	CreateAndFillin_Curvar("",curvar);
	1024	/* */
	1025	curlistvar=insertvar($1,curvar);
	1026	/* */
	1027	$$=curlistvar;
	1028	/* */
[530]	1029	strcpy(vallengspec,"");
	1030	}
	1031	}
[396]	1032	;
[774]	1033	private : TOK_PRIVATE '\n'
[530]	1034	\| TOK_PRIVATE opt_sep use_name_list
[396]	1035	;
[774]	1036	public : TOK_PUBLIC '\n'
[1200]	1037	{
	1038	$$=(listname *)NULL;
	1039	}
[663]	1040	\| TOK_PUBLIC opt_sep use_name_list
[1200]	1041	{
	1042	$$=$3;
	1043	}
[396]	1044	;
[774]	1045	use_name_list : TOK_NAME
[1200]	1046	{
	1047	$$ = Insertname(NULL,$1);
	1048	}
[396]	1049	\| use_name_list ',' TOK_NAME
[1200]	1050	{
	1051	$$ = Insertname($1,$3);
	1052	}
[396]	1053	;
[774]	1054	common : before_common var_common_list
[396]	1055	{
[663]	1056	pos_end = setposcur();
	1057	RemoveWordSET_0(fortranout,pos_curcommon,
[396]	1058	pos_end-pos_curcommon);
	1059	}
	1060	\| before_common comblock var_common_list
	1061	{
	1062	if ( couldaddvariable == 1 )
	1063	{
[530]	1064	sprintf(charusemodule,"%s",$2);
[663]	1065	Add_NameOfCommon_1($2);
	1066	pos_end = setposcur();
	1067	RemoveWordSET_0(fortranout,pos_curcommon,
	1068	pos_end-pos_curcommon);
[396]	1069	}
	1070	}
	1071	\| common opt_comma comblock opt_comma var_common_list
	1072	{
	1073	if ( couldaddvariable == 1 )
	1074	{
[530]	1075	sprintf(charusemodule,"%s",$3);
[663]	1076	Add_NameOfCommon_1($3);
	1077	pos_end = setposcur();
	1078	RemoveWordSET_0(fortranout,pos_curcommon,
	1079	pos_end-pos_curcommon);
[396]	1080	}
	1081	}
	1082	;
	1083	before_common : TOK_COMMON
	1084	{
	1085	positioninblock=0;
[530]	1086	pos_curcommon = setposcur()-6;
[396]	1087	}
[530]	1088	\| TOK_GLOBAL TOK_COMMON
	1089	{
	1090	positioninblock=0;
	1091	pos_curcommon = setposcur()-6-7;
	1092	}
	1093	;
[396]	1094	var_common_list : var_common
	1095	{
[663]	1096	if ( couldaddvariable == 1 ) Add_Common_var_1();
[396]	1097	}
	1098
	1099	\| var_common_list ',' var_common
	1100	{
[663]	1101	if ( couldaddvariable == 1 ) Add_Common_var_1();
[396]	1102	}
[774]	1103	var_common : TOK_NAME dims
[396]	1104	{
[663]	1105	if ( couldaddvariable == 1 )
[396]	1106	{
	1107	positioninblock = positioninblock + 1 ;
	1108	strcpy(commonvar,$1);
	1109	commondim = $2;
	1110	}
	1111	}
	1112	;
[774]	1113	comblock : TOK_DSLASH
[396]	1114	{
[663]	1115	if ( couldaddvariable == 1 )
[396]	1116	{
	1117	strcpy($$,"");
	1118	positioninblock=0;
	1119	strcpy(commonblockname,"");
	1120	}
	1121	}
[663]	1122	\| TOK_SLASH TOK_NAME TOK_SLASH
[396]	1123	{
[663]	1124	if ( couldaddvariable == 1 )
[396]	1125	{
	1126	strcpy($$,$2);
	1127	positioninblock=0;
	1128	strcpy(commonblockname,$2);
	1129	}
	1130	}
	1131	;
[774]	1132	opt_comma :
[396]	1133	\| ','
	1134	;
[774]	1135	paramlist : paramitem
[396]	1136	{
[663]	1137	if ( couldaddvariable == 1 ) $$=insertvar(NULL,$1);
[396]	1138	}
	1139	\| paramlist ',' paramitem
	1140	{
[663]	1141	if ( couldaddvariable == 1 ) $$=insertvar($1,$3);
[396]	1142	}
	1143	;
	1144	paramitem : TOK_NAME '=' expr
	1145	{
[663]	1146	if ( couldaddvariable == 1 )
	1147	{
[396]	1148	curvar=(variable *) malloc(sizeof(variable));
[663]	1149	/* */
	1150	Init_Variable(curvar);
	1151	/* */
	1152	curvar->v_VariableIsParameter=1;
	1153	strcpy(curvar->v_nomvar,$1);
[774]	1154	Save_Length($1,4);
[663]	1155	strcpy(curvar->v_subroutinename,subroutinename);
[774]	1156	Save_Length(subroutinename,11);
[663]	1157	strcpy(curvar->v_modulename,curmodulename);
[774]	1158	Save_Length(curmodulename,6);
[663]	1159	strcpy(curvar->v_initialvalue,$3);
[774]	1160	Save_Length($3,14);
[663]	1161	strcpy(curvar->v_commoninfile,mainfile);
[774]	1162	Save_Length(mainfile,10);
[396]	1163	$$=curvar;
	1164	}
	1165	}
	1166	;
[774]	1167	module_proc_stmt : TOK_PROCEDURE proc_name_list
[396]	1168	;
[774]	1169	proc_name_list : TOK_NAME
[396]	1170	\| proc_name_list ',' TOK_NAME
	1171	;
[774]	1172	implicit : TOK_IMPLICIT TOK_NONE
[396]	1173	{
[663]	1174	if ( insubroutinedeclare == 1 )
[396]	1175	{
[663]	1176	Add_ImplicitNoneSubroutine_1();
	1177	pos_end = setposcur();
	1178	RemoveWordSET_0(fortranout,pos_end-13,
	1179	13);
[396]	1180	}
	1181	}
[530]	1182	\| TOK_IMPLICIT TOK_REAL8
[396]	1183	;
	1184	opt_retour :
	1185	;
	1186	dcl : options opt_retour TOK_NAME dims lengspec initial_value
	1187	{
	1188	if ( couldaddvariable == 1 )
	1189	{
	1190	/* */
[663]	1191	if (dimsgiven == 1)
[396]	1192	{
	1193	curvar=createvar($3,curdim);
	1194	}
	1195	else
	1196	{
	1197	curvar=createvar($3,$4);
	1198	}
	1199	/* */
[663]	1200	CreateAndFillin_Curvar(DeclType,curvar);
[396]	1201	/* */
	1202	curlistvar=insertvar(NULL,curvar);
[663]	1203	if (!strcasecmp(DeclType,"character"))
[396]	1204	{
[663]	1205	if (c_selectorgiven == 1)
[396]	1206	{
	1207	strcpy(c_selectordim.first,"1");
	1208	strcpy(c_selectordim.last,c_selectorname);
[774]	1209	Save_Length(c_selectorname,1);
[396]	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	{
[663]	1222	if (dimsgiven == 1)
[396]	1223	{
	1224	curvar=createvar($4,curdim);
	1225	}
	1226	else
	1227	{
	1228	curvar=createvar($4,$5);
	1229	}
	1230	/* */
[663]	1231	CreateAndFillin_Curvar($1->var->v_typevar,curvar);
[396]	1232	/* */
[663]	1233	strcpy(curvar->v_typevar,($1->var->v_typevar));
[774]	1234	Save_Length($1->var->v_typevar,3);
[663]	1235	/* */
[396]	1236	curlistvar=insertvar($1,curvar);
[663]	1237	if (!strcasecmp(DeclType,"character"))
[396]	1238	{
[663]	1239	if (c_selectorgiven == 1)
[396]	1240	{
	1241	strcpy(c_selectordim.first,"1");
	1242	strcpy(c_selectordim.last,c_selectorname);
[774]	1243	Save_Length(c_selectorname,1);
[396]	1244	change_dim_char
	1245	(insertdim(NULL,c_selectordim),curlistvar);
	1246	}
	1247	}
	1248	$$=curlistvar;
	1249	}
	1250	strcpy(vallengspec,"");
	1251	}
[663]	1252	;
[774]	1253	nodimsgiven : {dimsgiven=0;}
[396]	1254	;
[774]	1255	type : typespec selector
[663]	1256	{strcpy(DeclType,$1);}
	1257	\| before_character c_selector
[396]	1258	{
	1259	strcpy(DeclType,"CHARACTER");
	1260	}
	1261	\| typename '*' TOK_CSTINT
	1262	{
	1263	strcpy(DeclType,$1);
	1264	strcpy(nameinttypename,$3);
	1265	}
[663]	1266	\| before_typepar attribute ')'
	1267	{
	1268	strcpy(DeclType,"TYPE");
	1269	}
[396]	1270	;
[663]	1271	before_typepar : TOK_TYPEPAR
	1272	{
[1200]	1273	/* if ( couldaddvariable == 1 ) VarTypepar = 1 ;
[663]	1274	couldaddvariable = 0 ;
[1200]	1275	pos_cur_decl = setposcur()-5;*/
	1276	pos_cur_decl = setposcur()-5;
[663]	1277	}
	1278	;
[774]	1279	c_selector :
[663]	1280	\| '*' TOK_CSTINT
[396]	1281	{c_selectorgiven=1;strcpy(c_selectorname,$2);}
	1282	\| '*' '(' c_attribute ')' {c_star = 1;}
[663]	1283	\| '(' c_attribute ')'
[396]	1284	;
[774]	1285	c_attribute : TOK_NAME clause opt_clause
[663]	1286	\| TOK_NAME '=' clause opt_clause
	1287	\| clause opt_clause
[396]	1288	;
	1289	before_character : TOK_CHARACTER
	1290	{
[530]	1291	pos_cur_decl = setposcur()-9;
[396]	1292	}
	1293	;
[774]	1294	typespec : typename {strcpy($$,$1);}
[396]	1295	;
[774]	1296	typename : TOK_INTEGER
[396]	1297	{
	1298	strcpy($$,"INTEGER");
[530]	1299	pos_cur_decl = setposcur()-7;
[396]	1300	}
	1301	\| TOK_REAL {
[663]	1302	strcpy($$,"REAL");
[530]	1303	pos_cur_decl = setposcur()-4;
[396]	1304	}
[663]	1305	\| TOK_COMPLEX
[774]	1306	{strcpy($$,"COMPLEX");
	1307	pos_cur_decl = setposcur()-7;}
[663]	1308	\| TOK_DOUBLEPRECISION
	1309	{
	1310	pos_cur_decl = setposcur()-16;
	1311	strcpy($$,"REAL");
	1312	strcpy(nameinttypename,"8");
	1313	}
	1314	\| TOK_DOUBLECOMPLEX
[396]	1315	{strcpy($$,"DOUBLE COMPLEX");}
[663]	1316	\| TOK_LOGICAL
[396]	1317	{
	1318	strcpy($$,"LOGICAL");
[530]	1319	pos_cur_decl = setposcur()-7;
[396]	1320	}
	1321	;
[774]	1322	lengspec :
[530]	1323	\| '*' proper_lengspec {strcpy(vallengspec,$2);}
[396]	1324	;
[774]	1325	proper_lengspec : expr {sprintf($$,"*%s",$1);}
[396]	1326	\| '(' '' ')'{strcpy($$,"(*)");}
	1327	;
[774]	1328	selector :
[396]	1329	\| '*' proper_selector
[663]	1330	\| '(' attribute ')'
[396]	1331	;
[774]	1332	proper_selector : expr
[396]	1333	\| '(' '*' ')'
	1334	;
[774]	1335	attribute : TOK_NAME clause
[663]	1336	\| TOK_NAME '=' clause
[396]	1337	{
[663]	1338	if ( strstr($3,"0.d0") )
	1339	{
	1340	strcpy(nameinttypename,"8");
	1341	sprintf(NamePrecision,"");
	1342	}
	1343	else sprintf(NamePrecision,"%s = %s",$1,$3);
[396]	1344	}
	1345	\| TOK_NAME
	1346	{
[663]	1347	strcpy(NamePrecision,$1);
[396]	1348	}
[530]	1349	\| TOK_CSTINT
	1350	{
[663]	1351	strcpy(NamePrecision,$1);
[530]	1352	}
[396]	1353	;
[774]	1354	clause : expr {strcpy(CharacterSize,$1);
[530]	1355	strcpy($$,$1);}
[396]	1356	\| '' {strcpy(CharacterSize,"");
[663]	1357	strcpy($$,"*");}
[396]	1358	;
[774]	1359	opt_clause :
[396]	1360	\| ',' TOK_NAME clause
	1361	;
[774]	1362	options :
[396]	1363	\| ':' ':'
	1364	\| ',' attr_spec_list ':' ':'
	1365	;
[774]	1366	attr_spec_list : attr_spec
[396]	1367	\| attr_spec_list ',' attr_spec
	1368	;
[774]	1369	attr_spec : TOK_PARAMETER
[396]	1370	{
	1371	VariableIsParameter = 1;
	1372	}
	1373	\| access_spec
[663]	1374	\| TOK_ALLOCATABLE
[396]	1375	{Allocatabledeclare = 1;}
[663]	1376	\| TOK_DIMENSION dims
[396]	1377	{
[663]	1378	dimsgiven=1;
[396]	1379	curdim=$2;
	1380	}
[663]	1381	\| TOK_EXTERNAL
	1382	{ExternalDeclare = 1;}
[774]	1383	\| TOK_INTENT '(' intent_spec ')'
	1384	{strcpy(IntentSpec,$3);}
[396]	1385	\| TOK_INTRINSIC
	1386	\| TOK_OPTIONAL{optionaldeclare = 1 ;}
	1387	\| TOK_POINTER {pointerdeclare = 1 ;}
	1388	\| TOK_SAVE {
[663]	1389	/* if ( inmodulemeet == 1 )
	1390	{*/
[396]	1391	SaveDeclare = 1 ;
[663]	1392	/* }*/
[396]	1393	}
	1394	\| TOK_TARGET
	1395	;
[774]	1396	intent_spec : TOK_IN {strcpy($$,$1);}
	1397	\| TOK_OUT {strcpy($$,$1);}
	1398	\| TOK_INOUT {strcpy($$,$1); }
[396]	1399	;
[774]	1400	access_spec : TOK_PUBLIC
[663]	1401	{PublicDeclare = 1;}
	1402	\| TOK_PRIVATE
	1403	{PrivateDeclare = 1;}
[396]	1404	;
[774]	1405	dims : {if ( created_dimensionlist == 1 )
[663]	1406	{
	1407	$$=(listdim *)NULL;
	1408	}
	1409	}
	1410	\| '(' dimlist ')'
	1411	{if ( created_dimensionlist == 1 \|\|
	1412	agrif_parentcall == 1 ) $$=$2;}
[396]	1413	;
[774]	1414	dimlist : dim {if ( created_dimensionlist == 1 \|\|
[663]	1415	agrif_parentcall == 1 ) $$=insertdim(NULL,$1);}
	1416	\| dimlist ',' dim
	1417	{if ( couldaddvariable == 1 )
	1418	if ( created_dimensionlist == 1 ) $$=insertdim($1,$3);}
	1419	;
[774]	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	}
[396]	1439	\| expr ':' ubound
[774]	1440	{
	1441	strcpy($$.first,$1);
	1442	Save_Length($1,2);
	1443	strcpy($$.last,$3);
	1444	Save_Length($3,1);
	1445	}
[396]	1446	;
[774]	1447	ubound : '' {strcpy($$,"");}
[396]	1448	\| expr {strcpy($$,$1);}
	1449	;
[774]	1450	expr : uexpr {if ( couldaddvariable == 1 ) strcpy($$,$1);}
[663]	1451	\| '(' expr ')'
	1452	{if ( couldaddvariable == 1 ) sprintf($$,"(%s)",$2);}
	1453	\| complex_const
	1454	{if ( couldaddvariable == 1 ) strcpy($$,$1);}
[396]	1455	\| predefinedfunction
[663]	1456	{if ( couldaddvariable == 1 ) strcpy($$,$1);}
[396]	1457	;
[663]	1458
	1459	predefinedfunction : TOK_SUM minmaxlist ')'
[396]	1460	{sprintf($$,"SUM(%s)",$2);}
[530]	1461	\| TOK_MAX minmaxlist ')'
	1462	{sprintf($$,"MAX(%s)",$2);}
[396]	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);}
[530]	1473	\| TOK_SQRT expr ')'
	1474	{sprintf($$,"SQRT(%s)",$2);}
	1475	\| TOK_REAL '(' minmaxlist ')'
[396]	1476	{sprintf($$,"REAL(%s)",$3);}
	1477	\| TOK_NINT '(' expr ')'
[663]	1478	{sprintf($$,"NINT(%s)",$3);}
[396]	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);}
[530]	1501	\| TOK_ABS expr ')'
	1502	{sprintf($$,"ABS(%s)",$2);}
[396]	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);}
[663]	1513	\| minmaxlist ',' expr
	1514	{if ( couldaddvariable == 1 )
	1515	{ strcpy($$,$1);strcat($$,",");strcat($$,$3);}}
[396]	1516	;
[774]	1517	uexpr : lhs {if ( couldaddvariable == 1 ) strcpy($$,$1);}
[663]	1518	\| simple_const
	1519	{if ( couldaddvariable == 1 ) strcpy($$,$1);}
	1520	\| vec
	1521	{if ( couldaddvariable == 1 ) strcpy($$,$1);}
[396]	1522	\| expr operation
[663]	1523	{if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}
[1349]	1524	\| signe expr %prec '*'
[663]	1525	{if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}
	1526	\| TOK_NOT expr
	1527	{if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}
[396]	1528	;
[663]	1529	signe : '+' {if ( couldaddvariable == 1 ) strcpy($$,"+");}
	1530	\| '-' {if ( couldaddvariable == 1 ) strcpy($$,"-");}
[396]	1531	;
[663]	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);}
[1200]	1542	\| TOK_EQV expr %prec TOK_EQV
	1543	{if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}
[663]	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);}
[396]	1556	\| TOK_LE expr %prec TOK_EQ
[663]	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);}
[1200]	1562	\| TOK_NEQV expr %prec TOK_EQV
	1563	{if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);}
[663]	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);}
[396]	1570	\| TOK_SLASH after_slash
[663]	1571	{if ( couldaddvariable == 1 ) sprintf($$,"%s",$2);}
[396]	1572	\| '=' after_equal
[663]	1573	{if ( couldaddvariable == 1 ) sprintf($$,"%s",$2);}
[396]	1574
[530]	1575	after_slash : {strcpy($$,"");}
[663]	1576	\| expr
[396]	1577	{sprintf($$,"/%s",$1);}
[663]	1578	\| '=' expr %prec TOK_EQ
[530]	1579	{sprintf($$,"/= %s",$2);}
[396]	1580	\| TOK_SLASH expr
	1581	{sprintf($$,"//%s",$2);}
	1582	;
[663]	1583	after_equal : '=' expr %prec TOK_EQ
	1584	{if ( couldaddvariable == 1 ) sprintf($$,"==%s",$2);}
[396]	1585	\| expr
[663]	1586	{if ( couldaddvariable == 1 ) sprintf($$,"= %s",$1);}
[396]	1587	;
[663]	1588
[774]	1589	lhs : ident {if ( couldaddvariable == 1 ) strcpy($$,$1);}
[663]	1590	\| structure_component
	1591	{if ( couldaddvariable == 1 ) strcpy($$,$1);}
	1592	\| array_ele_substring_func_ref
	1593	{if ( couldaddvariable == 1 ) strcpy($$,$1);}
[396]	1594	;
	1595	beforefunctionuse : {
	1596	agrif_parentcall =0;
	1597	if (!strcasecmp(identcopy,"Agrif_Parent") )
	1598	agrif_parentcall =1;
[530]	1599	if ( Agrif_in_Tok_NAME(identcopy) == 1 )
[663]	1600	{
[396]	1601	inagrifcallargument = 1;
[663]	1602	Add_SubroutineWhereAgrifUsed_1(subroutinename,
	1603	curmodulename);
[396]	1604	}
	1605	}
	1606	;
[774]	1607	array_ele_substring_func_ref : begin_array
[396]	1608	{
	1609	strcpy($$,$1);
	1610	if ( incalldeclare == 0 ) inagrifcallargument = 0;
	1611	}
[663]	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);}
[396]	1620	;
	1621	begin_array : ident '(' funarglist ')'
	1622	{
[663]	1623	if ( couldaddvariable == 1 )
	1624	{
	1625	sprintf($$," %s ( %s )",$1,$3);
	1626	ModifyTheAgrifFunction_0($3);
	1627	agrif_parentcall =0;
	1628	}
[396]	1629	}
	1630	;
[774]	1631	structure_component : lhs '%' lhs
[396]	1632	{
	1633	sprintf($$," %s %% %s ",$1,$3);
[663]	1634	if ( incalldeclare == 0 ) inagrifcallargument = 0;
[396]	1635	}
	1636	;
[774]	1637	vec : TOK_LEFTAB outlist TOK_RIGHTAB
[663]	1638	{sprintf($$,"(/%s/)",$2);}
[396]	1639	;
[774]	1640	funarglist : beforefunctionuse {strcpy($$," ");}
[663]	1641	\| beforefunctionuse funargs
[396]	1642	{strcpy($$,$2);}
	1643	;
[774]	1644	funargs : funarg {if ( couldaddvariable == 1 ) strcpy($$,$1);}
[663]	1645	\| funargs ',' funarg
	1646	{if ( couldaddvariable == 1 ) sprintf($$,"%s,%s",$1,$3);}
[396]	1647	;
[774]	1648	funarg : expr {strcpy($$,$1);}
[396]	1649	\| triplet {strcpy($$,$1);}
	1650	;
[774]	1651	triplet : expr ':' expr
	1652	{if ( couldaddvariable == 1 ) sprintf($$,"%s :%s",$1,$3);}
[663]	1653	\| expr ':' expr ':' expr
	1654	{if ( couldaddvariable == 1 )
[774]	1655	sprintf($$,"%s :%s :%s",$1,$3,$5);}
[663]	1656	\| ':' expr ':' expr
[774]	1657	{if ( couldaddvariable == 1 ) sprintf($$,":%s :%s",$2,$4);}
[663]	1658	\| ':' ':' expr{if ( couldaddvariable == 1 ) sprintf($$,": : %s",$3);}
	1659	\| ':' expr {if ( couldaddvariable == 1 ) sprintf($$,":%s",$2);}
[774]	1660	\| expr ':' {if ( couldaddvariable == 1 ) sprintf($$,"%s :",$1);}
[663]	1661	\| ':' {if ( couldaddvariable == 1 ) sprintf($$,":");}
[396]	1662	;
[663]	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;
[530]	1673	if ( VariableIsNotFunction($1) == 0 )
[396]	1674	{
[530]	1675	if ( inagrifcallargument == 1 )
[396]	1676	{
[530]	1677	if ( !strcasecmp($1,identcopy) )
	1678	{
	1679	strcpy(sameagrifname,identcopy);
	1680	sameagrifargument = 1;
	1681	}
[396]	1682	}
[530]	1683	strcpy(identcopy,$1);
	1684	pointedvar=0;
[1200]	1685	strcpy(truename,$1);
	1686	if (variscoupled_0($1)) strcpy(truename,getcoupledname_0($1));
	1687	/*
[530]	1688	if ( VarIsNonGridDepend($1) == 0 &&
[663]	1689	Variableshouldberemove($1) == 0 )
[530]	1690	{
	1691	if ( inagrifcallargument == 1 \|\|
	1692	varisallocatable_0($1) == 1 \|\|
	1693	varispointer_0($1) == 1 )
	1694	{
[1200]	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	}
[530]	1705	}
[1200]	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	}
[663]	1711	if ( inagrifcallargument != 1 \|\|
	1712	sameagrifargument ==1 )
	1713	Add_UsedInSubroutine_Var_1($1);
[530]	1714	}
	1715	NotifyAgrifFunction_0($1);
[1200]	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);
[396]	1737	}
[663]	1738	}
	1739	}
[396]	1740	;
[774]	1741	simple_const : TOK_TRUE
[663]	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);}
[396]	1750	\| string_constant opt_substring
	1751	;
[774]	1752	string_constant : TOK_CHAR_CONSTANT
[663]	1753	{if ( couldaddvariable == 1 ) strcpy($$,$1);}
	1754	\| string_constant TOK_CHAR_CONSTANT
	1755	\| TOK_CHAR_MESSAGE
	1756	{if ( couldaddvariable == 1 ) strcpy($$,$1);}
[396]	1757	\| TOK_CHAR_CUT
[663]	1758	{if ( couldaddvariable == 1 ) strcpy($$,$1);}
[396]	1759	;
[774]	1760	opt_substring : {if ( couldaddvariable == 1 ) strcpy($$," ");}
[663]	1761	\| substring {if ( couldaddvariable == 1 ) strcpy($$,$1);}
[396]	1762	;
[774]	1763	substring : '(' optexpr ':' optexpr ')'
	1764	{if ( couldaddvariable == 1 ) sprintf($$,"(%s :%s)",$2,$4);}
[396]	1765	;
[774]	1766	optexpr : {if ( couldaddvariable == 1 ) strcpy($$," ");}
[663]	1767	\| expr {if ( couldaddvariable == 1 ) strcpy($$,$1);}
[396]	1768	;
[774]	1769	opt_expr : '\n' {if ( couldaddvariable == 1 ) strcpy($$," ");}
[663]	1770	\| expr {if ( couldaddvariable == 1 ) strcpy($$,$1);}
[396]	1771	;
[774]	1772	initial_value : {InitialValueGiven = 0;}
[663]	1773	\| before_initial '=' expr
[396]	1774	{
[663]	1775	if ( couldaddvariable == 1 )
	1776	{
	1777	strcpy(InitValue,$3);
	1778	InitialValueGiven = 1;
	1779	}
	1780	}
[396]	1781	;
[530]	1782	before_initial : {pos_curinit = setposcur();}
[396]	1783	;
[774]	1784	complex_const : '(' uexpr ',' uexpr ')'
[663]	1785	{sprintf($$,"(%s,%s)",$2,$4);}
[396]	1786	;
[774]	1787	use_stat : word_use module_name
[396]	1788	{
[663]	1789	if ( couldaddvariable == 1 )
	1790	{
[396]	1791	/* if variables has been declared in a subroutine */
	1792	if (insubroutinedeclare == 1)
	1793	{
[530]	1794	copyuse_0($2);
[396]	1795	}
[530]	1796	sprintf(charusemodule,"%s",$2);
[663]	1797	Add_NameOfModuleUsed_1($2);
[530]	1798
	1799	if ( inmoduledeclare == 0 )
[396]	1800	{
	1801	pos_end = setposcur();
[530]	1802	RemoveWordSET_0(fortranout,pos_curuse,
[396]	1803	pos_end-pos_curuse);
	1804	}
[663]	1805	}
	1806	}
[396]	1807	\| word_use module_name ',' rename_list
	1808	{
[663]	1809	if ( couldaddvariable == 1 )
	1810	{
[396]	1811	if (insubroutinedeclare == 1)
	1812	{
[663]	1813	Add_CouplePointed_Var_1($2,$4);
[396]	1814	}
[663]	1815	if ( firstpass == 1 )
[396]	1816	{
	1817	if ( insubroutinedeclare == 1 )
	1818	{
	1819	coupletmp = $4;
	1820	strcpy(ligne,"");
	1821	while ( coupletmp )
	1822	{
[663]	1823	strcat(ligne,coupletmp->c_namevar);
[396]	1824	strcat(ligne," => ");
[663]	1825	strcat(ligne,coupletmp->c_namepointedvar);
[396]	1826	coupletmp = coupletmp->suiv;
	1827	if ( coupletmp ) strcat(ligne,",");
	1828	}
	1829	sprintf(charusemodule,"%s",$2);
	1830	}
[663]	1831	Add_NameOfModuleUsed_1($2);
[396]	1832	}
[530]	1833	if ( inmoduledeclare == 0 )
[396]	1834	{
	1835	pos_end = setposcur();
[530]	1836	RemoveWordSET_0(fortranout,pos_curuse,
[396]	1837	pos_end-pos_curuse);
	1838	}
[663]	1839	}
	1840	}
[396]	1841	\| word_use module_name ',' TOK_ONLY ':' '\n'
	1842	{
[663]	1843	if ( couldaddvariable == 1 )
	1844	{
[396]	1845	/* if variables has been declared in a subroutine */
	1846	if (insubroutinedeclare == 1)
	1847	{
[530]	1848	copyuseonly_0($2);
[396]	1849	}
[530]	1850	sprintf(charusemodule,"%s",$2);
[663]	1851	Add_NameOfModuleUsed_1($2);
[530]	1852
	1853	if ( inmoduledeclare == 0 )
[396]	1854	{
	1855	pos_end = setposcur();
[530]	1856	RemoveWordSET_0(fortranout,pos_curuse,
[396]	1857	pos_end-pos_curuse);
	1858	}
[663]	1859	}
	1860	}
[396]	1861	\| word_use module_name ',' TOK_ONLY ':' only_list
	1862	{
[663]	1863	if ( couldaddvariable == 1 )
	1864	{
[396]	1865	/* if variables has been declared in a subroutine */
	1866	if (insubroutinedeclare == 1)
	1867	{
[663]	1868	Add_CouplePointed_Var_1($2,$6);
[396]	1869	}
[663]	1870	if ( firstpass == 1 )
[396]	1871	{
	1872	if ( insubroutinedeclare == 1 )
	1873	{
	1874	coupletmp = $6;
	1875	strcpy(ligne,"");
	1876	while ( coupletmp )
	1877	{
[663]	1878	strcat(ligne,coupletmp->c_namevar);
	1879	if ( strcasecmp(coupletmp->c_namepointedvar,"") )
[396]	1880	strcat(ligne," => ");
[663]	1881	strcat(ligne,coupletmp->c_namepointedvar);
[396]	1882	coupletmp = coupletmp->suiv;
	1883	if ( coupletmp ) strcat(ligne,",");
	1884	}
	1885	sprintf(charusemodule,"%s",$2);
	1886	}
[663]	1887	Add_NameOfModuleUsed_1($2);
[396]	1888	}
[530]	1889	if ( firstpass == 0 )
[663]	1890	{
[530]	1891	if ( inmoduledeclare == 0 )
	1892	{
[1200]	1893
	1894	pos_end = setposcur();
[530]	1895	RemoveWordSET_0(fortranout,pos_curuse,
	1896	pos_end-pos_curuse);
[1200]	1897	if (oldfortranout)
	1898	variableisglobalinmodule($6,$2,oldfortranout,pos_curuseold);
	1899
[530]	1900	}
[663]	1901	else
	1902	{
[1200]	1903
[663]	1904	/* if we are in the module declare and if the */
	1905	/* onlylist is a list of global variable */
[1200]	1906	variableisglobalinmodule($6, $2, fortranout,pos_curuse);
[663]	1907	}
[396]	1908	}
[663]	1909	}
	1910	}
[396]	1911	;
	1912	word_use : TOK_USE
	1913	{
[530]	1914	pos_curuse = setposcur()-strlen($1);
[1200]	1915	if (firstpass == 0 && oldfortranout) {
	1916	pos_curuseold = setposcurname(oldfortranout);
	1917	}
[396]	1918	}
	1919	;
[774]	1920	module_name : TOK_NAME
[396]	1921	{strcpy($$,$1);}
	1922	;
[774]	1923	rename_list : rename_name
[396]	1924	{
[663]	1925	if ( couldaddvariable == 1 ) $$ = $1;
	1926	}
[396]	1927	\| rename_list ',' rename_name
	1928	{
[663]	1929	if ( couldaddvariable == 1 )
	1930	{
[396]	1931	/* insert the variable in the list $1 */
	1932	$3->suiv = $1;
	1933	$$ = $3;
[663]	1934	}
[396]	1935	}
	1936	;
[774]	1937	rename_name : TOK_NAME TOK_POINT_TO TOK_NAME
[396]	1938	{
	1939	coupletmp =(listcouple *)malloc(sizeof(listcouple));
[663]	1940	strcpy(coupletmp->c_namevar,$1);
[774]	1941	Save_Length($1,21);
[663]	1942	strcpy(coupletmp->c_namepointedvar,$3);
[774]	1943	Save_Length($3,22);
[396]	1944	coupletmp->suiv = NULL;
	1945	$$ = coupletmp;
	1946	}
	1947	;
[774]	1948	only_list : only_name
[396]	1949	{
[663]	1950	if ( couldaddvariable == 1 ) $$ = $1;
	1951	}
[396]	1952	\| only_list ',' only_name
	1953	{
[663]	1954	if ( couldaddvariable == 1 )
	1955	{
[396]	1956	/* insert the variable in the list $1 */
	1957	$3->suiv = $1;
	1958	$$ = $3;
[663]	1959	}
[396]	1960	}
	1961	;
[774]	1962	only_name : TOK_NAME TOK_POINT_TO TOK_NAME
[396]	1963	{
	1964	coupletmp =(listcouple *)malloc(sizeof(listcouple));
[663]	1965	strcpy(coupletmp->c_namevar,$1);
[774]	1966	Save_Length($1,21);
[663]	1967	strcpy(coupletmp->c_namepointedvar,$3);
[774]	1968	Save_Length($3,22);
[396]	1969	coupletmp->suiv = NULL;
	1970	$$ = coupletmp;
	1971	pointedvar=1;
[663]	1972	Add_UsedInSubroutine_Var_1($1);
[396]	1973	}
	1974	\| TOK_NAME {
	1975	coupletmp =(listcouple *)malloc(sizeof(listcouple));
[663]	1976	strcpy(coupletmp->c_namevar,$1);
[774]	1977	Save_Length($1,21);
[663]	1978	strcpy(coupletmp->c_namepointedvar,"");
[396]	1979	coupletmp->suiv = NULL;
	1980	$$ = coupletmp;
	1981	}
	1982	;
[774]	1983	exec : iffable
[396]	1984	\| TOK_ALLOCATE '(' allocation_list opt_stat_spec ')'
[663]	1985	{
	1986	Add_SubroutineWhereAgrifUsed_1(subroutinename,
	1987	curmodulename);
[1200]	1988	inallocate = 0;
[663]	1989	}
[396]	1990	\| TOK_DEALLOCATE '(' allocate_object_list opt_stat_spec ')'
[663]	1991	{
	1992	Add_SubroutineWhereAgrifUsed_1(subroutinename,
	1993	curmodulename);
[1200]	1994	inallocate = 0;
[663]	1995	}
[396]	1996	\| TOK_NULLIFY '(' pointer_name_list ')'
[663]	1997	\| word_endunit /* end */
[396]	1998	{
[663]	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	{
[396]	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	/* */
[663]	2019	pos_cur = setposcur();
[774]	2020	closeandcallsubloopandincludeit_0(1);
[663]	2021	functiondeclarationisdone = 0;
[396]	2022	}
	2023	else
	2024	{
	2025	/* it is like an end module <name> */
[663]	2026	inmoduledeclare = 0 ;
	2027	inmodulemeet = 0 ;
[396]	2028	}
	2029	}
	2030	else
	2031	{
	2032	insubroutinedeclare = 0;
	2033	/* */
[1200]	2034	pos_cur = setposcur();
[774]	2035	closeandcallsubloopandincludeit_0(2);
[663]	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,"");
[396]	2046	}
[663]	2047	\| word_endprogram opt_name
[396]	2048	{
[663]	2049	if ( couldaddvariable == 1 )
	2050	{
[396]	2051	insubroutinedeclare = 0;
	2052	/* */
[1200]	2053	pos_cur = setposcur();
[774]	2054	closeandcallsubloopandincludeit_0(3);
[663]	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	}
[396]	2064	}
[663]	2065	\| word_endsubroutine opt_name
[396]	2066	{
[663]	2067	if ( couldaddvariable == 1 &&
	2068	strcasecmp(subroutinename,"") )
	2069	{
[396]	2070	insubroutinedeclare = 0;
	2071	/* */
[663]	2072	pos_cur = setposcur();
[1200]	2073
[774]	2074	closeandcallsubloopandincludeit_0(1);
[663]	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	}
[396]	2084	}
[663]	2085	\| word_endfunction opt_name
[396]	2086	{
[663]	2087	if ( couldaddvariable == 1 )
	2088	{
[396]	2089	insubroutinedeclare = 0;
	2090	/* */
[663]	2091	pos_cur = setposcur();
[1200]	2092
[774]	2093	closeandcallsubloopandincludeit_0(0);
[663]	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	}
[396]	2103	}
	2104	\| TOK_ENDMODULE opt_name
	2105	{
[663]	2106	if ( couldaddvariable == 1 )
	2107	{
[396]	2108	/* if we never meet the contains keyword */
[1200]	2109	Remove_Word_end_module_0(strlen($2));
[396]	2110	if ( inmoduledeclare == 1 )
	2111	{
	2112	if ( aftercontainsdeclare == 0 )
	2113	{
[663]	2114	Write_GlobalParameter_Declaration_0();
	2115	Write_NotGridDepend_Declaration_0();
[1200]	2116	Write_GlobalType_Declaration_0();
[663]	2117	Write_Alloc_Subroutine_For_End_0();
[396]	2118	}
	2119	}
[1200]	2120
[663]	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	}
[396]	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
[663]	2144	\| TOK_ELSE
	2145	\| TOK_ENDIF opt_name
	2146	\| TOK_CASE caselist ')'
[396]	2147	\| TOK_SELECTCASE '(' expr ')'
	2148	\| TOK_CASEDEFAULT
	2149	\| TOK_ENDSELECT
	2150	\| TOK_CONTAINS
	2151	{
	2152	if (inmoduledeclare == 1 )
	2153	{
[663]	2154	Remove_Word_Contains_0();
	2155	Write_GlobalParameter_Declaration_0();
[1200]	2156	Write_GlobalType_Declaration_0();
[663]	2157	Write_NotGridDepend_Declaration_0();
	2158	Write_Alloc_Subroutine_0();
	2159	inmoduledeclare = 0 ;
	2160	aftercontainsdeclare = 1;
[396]	2161	}
[663]	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	/* */
[1200]	2171
[663]	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	}
[396]	2183	}
	2184	;
[774]	2185	word_endsubroutine : TOK_ENDSUBROUTINE
[663]	2186	{
	2187	if ( couldaddvariable == 1 )
	2188	{
	2189	strcpy($$,$1);
	2190	pos_endsubroutine = setposcur()-strlen($1);
	2191	functiondeclarationisdone = 0;
	2192	}
	2193	}
	2194	;
[774]	2195	word_endunit : TOK_ENDUNIT
[663]	2196	{
	2197	if ( couldaddvariable == 1 )
	2198	{
	2199	strcpy($$,$1);
	2200	pos_endsubroutine = setposcur()-strlen($1);
	2201	}
	2202	}
	2203	;
[774]	2204	word_endprogram : TOK_ENDPROGRAM
[663]	2205	{
	2206	if ( couldaddvariable == 1 )
	2207	{
	2208	strcpy($$,$1);
	2209	pos_endsubroutine = setposcur()-strlen($1);
	2210	}
	2211	}
	2212	;
[774]	2213	word_endfunction : TOK_ENDFUNCTION
[663]	2214	{
	2215	if ( couldaddvariable == 1 )
	2216	{
	2217	strcpy($$,$1);
	2218	pos_endsubroutine = setposcur()-strlen($1);
	2219	}
	2220	}
	2221	;
[774]	2222	caselist : expr
[396]	2223	\| caselist ',' expr
	2224	\| caselist ':' expr
	2225	;
[663]	2226	boucledo : worddo opt_int do_arg
[396]	2227	\| wordwhile expr
	2228	\| TOK_ENDDO optname
	2229	;
[663]	2230	do_arg :
	2231	\| do_var '=' expr ',' expr
	2232	\| do_var '=' expr ',' expr ',' expr
	2233	opt_int :
	2234	\| TOK_CSTINT opt_comma
[530]	2235	;
[396]	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
[663]	2245	;
[396]	2246
[774]	2247	dotarget :
[396]	2248	\| TOK_CSTINT
	2249	;
	2250
[774]	2251	iffable : TOK_CONTINUE
[530]	2252	\| ident_dims after_ident_dims
[396]	2253	\| goto
	2254	\| io
[663]	2255	\| call
[530]	2256	\| TOK_ALLOCATE '(' allocation_list opt_stat_spec ')'
[663]	2257	{
	2258	Add_SubroutineWhereAgrifUsed_1(subroutinename,
	2259	curmodulename);
[1200]	2260	inallocate = 0;
[663]	2261	}
[530]	2262	\| TOK_DEALLOCATE '(' allocate_object_list opt_stat_spec ')'
[663]	2263	{
	2264	Add_SubroutineWhereAgrifUsed_1(subroutinename,
	2265	curmodulename);
[1200]	2266	inallocate = 0;
[663]	2267	}
[530]	2268	\| TOK_EXIT optexpr
	2269	\| TOK_RETURN opt_expr
	2270	\| TOK_CYCLE opt_expr
[396]	2271	\| stop opt_expr
[530]	2272	\| int_list
[396]	2273	;
[530]	2274	before_dims : {if ( couldaddvariable == 1 ) created_dimensionlist = 0;}
	2275	ident_dims : ident before_dims dims dims
[663]	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	}
[530]	2285	\| ident_dims '%' ident before_dims dims dims
	2286	{created_dimensionlist = 1;}
	2287	int_list : TOK_CSTINT
	2288	\| int_list ',' TOK_CSTINT
	2289	;
[663]	2290	after_ident_dims : '=' expr
	2291	\| TOK_POINT_TO expr
[396]	2292	;
[774]	2293	call : keywordcall opt_call
[396]	2294	{
	2295	inagrifcallargument = 0 ;
	2296	incalldeclare=0;
[663]	2297	if ( oldfortranout &&
	2298	!strcasecmp(meetagrifinitgrids,subroutinename) &&
[396]	2299	firstpass == 0 &&
	2300	callmpiinit == 1)
	2301	{
[1200]	2302	/* pos_end = setposcur();
[530]	2303	RemoveWordSET_0(fortranout,pos_curcall,
[396]	2304	pos_end-pos_curcall);
	2305	fprintf(oldfortranout," Call MPI_Init (%s) \n"
[1200]	2306	,mpiinitvar);*/
[396]	2307	}
[663]	2308	if ( oldfortranout &&
	2309	callagrifinitgrids == 1 &&
[396]	2310	firstpass == 0 )
	2311	{
	2312	pos_end = setposcur();
[530]	2313	RemoveWordSET_0(fortranout,pos_curcall,
[396]	2314	pos_end-pos_curcall);
[663]	2315
[396]	2316	strcpy(subofagrifinitgrids,subroutinename);
	2317	}
[530]	2318	Instanciation_0(sameagrifname);
[396]	2319	}
	2320	;
[663]	2321	opt_call :
[396]	2322	\| '(' opt_callarglist ')'
	2323	;
	2324	opt_callarglist :
	2325	\| callarglist
	2326	;
[663]	2327	keywordcall : before_call TOK_NAME
[396]	2328	{
[663]	2329	if (!strcasecmp($2,"MPI_Init") )
[396]	2330	{
	2331	callmpiinit = 1;
	2332	}
	2333	else
	2334	{
	2335	callmpiinit = 0;
	2336	}
[663]	2337	if (!strcasecmp($2,"Agrif_Init_Grids") )
[396]	2338	{
	2339	callagrifinitgrids = 1;
	2340	strcpy(meetagrifinitgrids,subroutinename);
	2341	}
	2342	else callagrifinitgrids = 0;
[663]	2343	if ( !strcasecmp($2,"Agrif_Open_File") )
[396]	2344	{
[663]	2345	Add_SubroutineWhereAgrifUsed_1(subroutinename,
	2346	curmodulename);
	2347	}
	2348	if ( Vartonumber($2) == 1 )
	2349	{
[396]	2350	incalldeclare=1;
	2351	inagrifcallargument = 1 ;
[663]	2352	Add_SubroutineWhereAgrifUsed_1(subroutinename,
	2353	curmodulename);
[396]	2354	}
	2355	}
	2356	;
	2357	before_call : TOK_CALL
[530]	2358	{pos_curcall=setposcur()-4;}
[774]	2359	callarglist : callarg
[396]	2360	\| callarglist ',' callarg
	2361	;
	2362
[774]	2363	callarg : expr {
[663]	2364	if ( callmpiinit == 1 )
[396]	2365	{
	2366	strcpy(mpiinitvar,$1);
[663]	2367	if ( firstpass == 1 )
[396]	2368	{
[663]	2369	Add_UsedInSubroutine_Var_1 (mpiinitvar);
	2370	/* curvar=createvar($1,NULL);
[396]	2371	curlistvar=insertvar(NULL,curvar);
[663]	2372	List_Subr outineArgument_Var = AddListvarToListvar
	2373	(curlistvar,List_SubroutineAr gument_Var,1);*/
[396]	2374	}
	2375	}
	2376	}
	2377	\| '*' label
	2378	;
	2379
[774]	2380	stop : TOK_PAUSE
[396]	2381	\| TOK_STOP
	2382	;
	2383
[774]	2384	io : iofctl ioctl
[396]	2385	\| read option_read
[1200]	2386	\| write ioctl
	2387	\| write ioctl outlist
[396]	2388	\| TOK_REWIND after_rewind
[663]	2389	\| TOK_FORMAT
[396]	2390	;
[663]	2391	opt_CHAR_INT :
[396]	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	;
[774]	2413	ioctl : '(' ctllist ')'
[663]	2414	\| '(' fexpr ')'
[396]	2415	;
[774]	2416	after_rewind : '(' ident ')'
[663]	2417	\| '(' TOK_CSTINT ')'
	2418	\| TOK_CSTINT
	2419	\| '(' uexpr ')'
[396]	2420	\| TOK_NAME
	2421	;
[774]	2422	ctllist : ioclause
[396]	2423	\| ctllist ',' ioclause
	2424	;
[774]	2425	ioclause : fexpr
[396]	2426	\| '*'
	2427	\| TOK_DASTER
[663]	2428	\| TOK_NAME expr
[530]	2429	\| TOK_NAME expr '%' ident_dims
[396]	2430	\| TOK_NAME '(' triplet ')'
[663]	2431	\| TOK_NAME '*'
	2432	\| TOK_NAME TOK_DASTER
[396]	2433	;
[774]	2434	iofctl : TOK_OPEN
[396]	2435	\| TOK_CLOSE
	2436	;
[774]	2437	infmt : unpar_fexpr
[396]	2438	\| '*'
	2439	;
	2440
[774]	2441	read :TOK_READ
[530]	2442	\| TOK_INQUIRE
[663]	2443	\| TOK_PRINT
[396]	2444	;
[1200]	2445
	2446	write : TOK_WRITE
	2447	;
	2448
[774]	2449	fexpr : unpar_fexpr
[396]	2450	\| '(' fexpr ')'
	2451	;
[774]	2452	unpar_fexpr : lhs
[396]	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
[663]	2462	\| TOK_ERR expr
	2463	\| TOK_END expr
[396]	2464	\| TOK_NAME '=' expr
	2465	;
[774]	2466	addop : '+'
[396]	2467	\| '-'
	2468	;
[774]	2469	inlist : inelt
[396]	2470	\| inlist ',' inelt
	2471	;
[663]	2472	opt_lhs :
[530]	2473	\| lhs
	2474	;
[774]	2475	inelt : opt_lhs opt_operation
[530]	2476	\| '(' inlist ')' opt_operation
	2477	\| predefinedfunction opt_operation
[663]	2478	\| simple_const opt_operation
[396]	2479	\| '(' inlist ',' dospec ')'
	2480	;
[530]	2481	opt_operation :
	2482	\| operation
	2483	\| opt_operation operation
[396]	2484	;
[1200]	2485	outlist : uexpr {if ( couldaddvariable == 1 ) strcpy($$,$1);}
	2486	\| other {if ( couldaddvariable == 1 ) strcpy($$,$1);}
[663]	2487	\| out2 {if ( couldaddvariable == 1 ) strcpy($$,$1);}
	2488	;
[396]	2489	out2: uexpr ',' expr
[663]	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);}
[396]	2503	;
[774]	2504	other : complex_const
[663]	2505	{if ( couldaddvariable == 1 ) strcpy($$,$1);}
	2506	\| '(' expr ')'
	2507	{if ( couldaddvariable == 1 ) sprintf($$," (%s)",$2);}
[396]	2508	\| '(' uexpr ',' dospec ')'
[663]	2509	{if ( couldaddvariable == 1 ) sprintf($$,"(%s,%s)",$2,$4);}
[396]	2510	\| '(' other ',' dospec ')'
[663]	2511	{if ( couldaddvariable == 1 ) sprintf($$,"(%s,%s)",$2,$4);}
[396]	2512	\| '(' out2 ',' dospec ')'
[663]	2513	{if ( couldaddvariable == 1 ) sprintf($$,"(%s,%s)",$2,$4);}
[396]	2514	;
	2515
[774]	2516	dospec : TOK_NAME '=' expr ',' expr
[663]	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);}
[396]	2522	;
[774]	2523	labellist : label
[396]	2524	\| labellist ',' label
	2525	;
[774]	2526	label : TOK_CSTINT
[396]	2527	;
[774]	2528	goto : TOK_PLAINGOTO '(' expr ',' expr ')' ',' expr
[663]	2529	\| TOK_PLAINGOTO label
[396]	2530	;
[774]	2531	allocation_list : allocate_object
[530]	2532	\| ident_dims
[396]	2533	\| allocation_list ',' allocate_object
	2534	;
[774]	2535	allocate_object : ident
[663]	2536	{Add_Allocate_Var_1($1,curmodulename);}
[396]	2537	\| structure_component
	2538	\| array_element
	2539	;
[774]	2540	array_element : ident '(' funargs ')'
[663]	2541	{Add_Allocate_Var_1($1,curmodulename);}
[396]	2542	;
[774]	2543	subscript_list : expr
[663]	2544	\| subscript_list ',' expr
[396]	2545	;
	2546
[774]	2547	allocate_object_list :allocate_object
[396]	2548	\| allocate_object_list ',' allocate_object
	2549	;
[774]	2550	opt_stat_spec :
[396]	2551	\| ',' TOK_STAT '=' ident
	2552	;
[774]	2553	pointer_name_list : ident
[396]	2554	\| pointer_name_list ',' ident
	2555	;
[774]	2556	opt_construct_name :
[396]	2557	\| TOK_NAME
	2558	;
[774]	2559	opt_construct_name_colon :
[396]	2560	\| TOK_CONSTRUCTID ':'
	2561	;
[774]	2562	logif : TOK_LOGICALIF expr ')'
[396]	2563	;
[774]	2564	do_var : ident {strcpy($$,$1);}
[396]	2565	;
	2566	%%
	2567
	2568	void processfortran(char *fichier_entree)
	2569	{
	2570	extern FILE *fortranin;
	2571	extern FILE *fortranout;
[774]	2572	char nomfile[LONG_C];
[396]	2573	int c;
	2574	int confirmyes;
	2575
	2576	/fortrandebug = 1;/
[663]	2577	if ( mark == 1 ) printf("Firstpass == %d \n",firstpass);
[396]	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");
[663]	2585	if (! fortranin)
[396]	2586	{
	2587	printf("Error : File %s does not exist\n",nomfile);
	2588	exit(1);
	2589	}
[663]	2590
[396]	2591	strcpy(curfile,nomfile);
	2592	strcpy(nomfile,commondirout);
[663]	2593	strcat(nomfile,"/");
[396]	2594	strcat(nomfile,fichier_entree);
	2595	strcpy(nomfileoutput,nomfile);
[774]	2596	Save_Length(nomfileoutput,31);
[663]	2597	if (firstpass == 1)
[396]	2598	{
[663]	2599	if (checkexistcommon == 1)
[396]	2600	{
[663]	2601	if (fopen(nomfile,"r"))
[396]	2602	{
	2603	printf("Warning : file %s already exist\n",nomfile);
	2604	confirmyes = 0;
[663]	2605	while (confirmyes==0)
[396]	2606	{
	2607	printf("Override file %s ? [Y/N]\n",nomfile);
	2608	c=getchar();
[663]	2609	getchar();
	2610	if (c==79 \|\| c==110)
[396]	2611	{
	2612	printf("We stop\n");
	2613	exit(1);
	2614	}
[663]	2615	if (c==89 \|\| c==121)
[396]	2616	{
	2617	confirmyes=1;
	2618	}
	2619	}
	2620	}
	2621	}
[663]	2622	}
[396]	2623
	2624	/******************************************************************************/
	2625	/* 2- Variables initialization */
	2626	/******************************************************************************/
	2627
[663]	2628	line_num_fortran_common=1;
[396]	2629	line_num_fortran=1;
[663]	2630	PublicDeclare = 0;
	2631	PrivateDeclare = 0;
	2632	ExternalDeclare = 0;
[396]	2633	SaveDeclare = 0;
	2634	pointerdeclare = 0;
	2635	optionaldeclare = 0;
	2636	incalldeclare = 0;
[663]	2637	VarType = 0;
	2638	VarTypepar = 0;
[396]	2639	Allocatabledeclare = 0 ;
[663]	2640	strcpy(NamePrecision," ");
	2641	VariableIsParameter = 0 ;
	2642	strcpy(NamePrecision,"");
	2643	c_star = 0 ;
	2644	functiondeclarationisdone = 0;
[396]	2645	insubroutinedeclare = 0 ;
[663]	2646	strcpy(subroutinename," ");
	2647	InitialValueGiven = 0 ;
	2648	strcpy(EmptyChar," ");
[396]	2649	inmoduledeclare = 0;
	2650	colnum=0;
	2651	incom=0;
	2652	couldaddvariable=1;
	2653	aftercontainsdeclare = 1;
[1200]	2654	strcpy(nameinttypename,"");
[396]	2655	/* Name of the file without format */
	2656	tmp = strchr(fichier_entree, '.');
[663]	2657	strncpy(curfilename,fichier_entree,strlen(fichier_entree)-strlen(tmp));
[774]	2658	Save_Length(curfilename,30);
[396]	2659	/******************************************************************************/
[663]	2660	/* 3- Parsing of the input file (1 time) */
[396]	2661	/******************************************************************************/
[663]	2662	if (firstpass == 0 )
[530]	2663	{
	2664	fortranout=fopen(nomfileoutput,"w");
[663]	2665
	2666	NewModule_Creation_0();
[530]	2667	}
[396]	2668
	2669	fortranparse();
	2670
	2671	strcpy(curfile,mainfile);
	2672
[530]	2673	if (firstpass == 0 ) fclose(fortranout);
[396]	2674	}

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

Download in other formats:

Original Format