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

Last change on this file since 396 was 396, checked in by opalod, 18 years ago

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