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

Since March 2022 along with NEMO 4.2 release, the code development moved to a self-hosted GitLab.
This present forge is now archived and remained online for history.
fortran.y in branches/UKMO/dev_r5107_hadgem3_cplfld/trunk/NEMOGCM/EXTERNAL/AGRIF/LIB – NEMO

source: branches/UKMO/dev_r5107_hadgem3_cplfld/trunk/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.y @ 5473

Last change on this file since 5473 was 5473, checked in by cguiavarch, 9 years ago

Clear svn keywords from UKMO/dev_r5107_hadgem3_cplfld

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