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/2014/dev_r4765_CNRS_agrif/NEMOGCM/EXTERNAL/AGRIF/LIB – NEMO

source: branches/2014/dev_r4765_CNRS_agrif/NEMOGCM/EXTERNAL/AGRIF/LIB/fortran.y @ 4779

Last change on this file since 4779 was 4779, checked in by rblod, 10 years ago

Update AGRIF internal routines and conv on branch dev_r4765_CNRS_agrif

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