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

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

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