/******************************************************************************/ /* */ /* CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran) */ /* */ /* Copyright or or Copr. Laurent Debreu (Laurent.Debreu@imag.fr) */ /* Cyril Mazauric (Cyril_Mazauric@yahoo.fr) */ /* This software is governed by the CeCILL-C license under French law and */ /* abiding by the rules of distribution of free software. You can use, */ /* modify and/ or redistribute the software under the terms of the CeCILL-C */ /* license as circulated by CEA, CNRS and INRIA at the following URL */ /* "http ://www.cecill.info". */ /* */ /* As a counterpart to the access to the source code and rights to copy, */ /* modify and redistribute granted by the license, users are provided only */ /* with a limited warranty and the software's author, the holder of the */ /* economic rights, and the successive licensors have only limited */ /* liability. */ /* */ /* In this respect, the user's attention is drawn to the risks associated */ /* with loading, using, modifying and/or developing or reproducing the */ /* software by the user in light of its specific status of free software, */ /* that may mean that it is complicated to manipulate, and that also */ /* therefore means that it is reserved for developers and experienced */ /* professionals having in-depth computer knowledge. Users are therefore */ /* encouraged to load and test the software's suitability as regards their */ /* requirements in conditions enabling the security of their systems and/or */ /* data to be ensured and, more generally, to use and operate it in the */ /* same conditions as regards security. */ /* */ /* The fact that you are presently reading this means that you have had */ /* knowledge of the CeCILL-C license and that you accept its terms. */ /******************************************************************************/ /* version 1.7 */ /******************************************************************************/ %{ #define YYMAXDEPTH 1000 #include #include #include #include "decl.h" extern int line_num_input; char c_selectorname[LONG_M]; char ligne[LONG_M]; char truename[LONG_VNAME]; char identcopy[LONG_VNAME]; int c_selectorgiven=0; listvar *curlistvar; int in_select_case_stmt=0; typedim c_selectordim; listcouple *coupletmp; int removeline=0; int token_since_endofstmt = 0; int increment_nbtokens = 1; int in_complex_literal = 0; int close_or_connect = 0; int in_io_control_spec = 0; int intent_spec = 0; long int my_position; long int my_position_before; int suborfun = 0; int indeclaration = 0; int endoffile = 0; int in_inquire = 0; int in_char_selector = 0; int in_kind_selector =0; int char_length_toreset = 0; typedim my_dim; listvar *test; char linebuf1[1024]; char linebuf2[1024]; int fortran_error(const char *s) { if (endoffile == 1) { endoffile = 0; return 0; } printf("%s line %d, file %s culprit = |%s|\n", s, line_num_input, cur_filename, strcat(linebuf1, linebuf2)); exit(1); } %} %union { char na[LONG_M]; listdim *d; listvar *l; listcouple *lc; listname *lnn; typedim dim1; variable *v; } %left ',' %nonassoc ':' %right '=' %left TOK_EQV TOK_NEQV %left TOK_OR TOK_XOR %left TOK_AND %left TOK_NOT %nonassoc TOK_LT TOK_GT TOK_LE TOK_GE TOK_EQ TOK_NE %left TOK_DSLASH %left '+' '-' %left '*' TOK_SLASH %right TOK_DASTER %token TOK_SEMICOLON %token TOK_PARAMETER %token TOK_RESULT %token TOK_ONLY %token TOK_INCLUDE %token TOK_SUBROUTINE %token TOK_PROGRAM %token TOK_FUNCTION %token TOK_LABEL_FORMAT %token TOK_LABEL_CONTINUE %token TOK_LABEL_END_DO %token TOK_MAX %token TOK_TANH %token TOK_COMMENT %token TOK_WHERE %token TOK_ELSEWHEREPAR %token TOK_ELSEWHERE %token TOK_ENDWHERE %token TOK_MAXVAL %token TOK_TRIM %token TOK_NULL_PTR %token TOK_SUM %token TOK_SQRT %token TOK_CASE %token TOK_SELECTCASE %token TOK_FILE %token TOK_REC %token TOK_NAME_EQ %token TOK_IOLENGTH %token TOK_ACCESS %token TOK_ACTION %token TOK_FORM %token TOK_RECL %token TOK_STATUS %token TOK_UNIT %token TOK_OPENED %token TOK_FMT %token TOK_NML %token TOK_END %token TOK_EOR %token TOK_EOF %token TOK_ERR %token TOK_POSITION %token TOK_IOSTAT %token TOK_IOMSG %token TOK_EXIST %token TOK_MIN %token TOK_FLOAT %token TOK_EXP %token TOK_LEN %token TOK_COS %token TOK_COSH %token TOK_ACOS %token TOK_NINT %token TOK_CYCLE %token TOK_SIN %token TOK_SINH %token TOK_ASIN %token TOK_EQUIVALENCE %token TOK_BACKSPACE %token TOK_LOG %token TOK_TAN %token TOK_ATAN %token TOK_RECURSIVE %token TOK_ABS %token TOK_MOD %token TOK_SIGN %token TOK_MINLOC %token TOK_MAXLOC %token TOK_EXIT %token TOK_KIND %token TOK_MOLD %token TOK_SOURCE %token TOK_ERRMSG %token TOK_MINVAL %token TOK_PUBLIC %token TOK_PRIVATE %token TOK_ALLOCATABLE %token TOK_CONTIGUOUS %token TOK_RETURN %token TOK_THEN %token TOK_ELSEIF %token TOK_ELSE %token TOK_ENDIF %token TOK_PRINT %token TOK_PLAINGOTO %token TOK_LOGICALIF %token TOK_LOGICALIF_PAR %token TOK_PLAINDO %token TOK_CONTAINS %token TOK_ENDDO %token TOK_MODULE %token TOK_ENDMODULE %token TOK_WHILE %token TOK_CONCURRENT %token TOK_ALLOCATE %token TOK_OPEN %token TOK_CLOSE %token TOK_INQUIRE %token TOK_WRITE_PAR %token TOK_WRITE %token TOK_FLUSH %token TOK_READ_PAR %token TOK_READ %token TOK_REWIND %token TOK_DEALLOCATE %token TOK_NULLIFY %token TOK_DIMENSION %token TOK_ENDSELECT %token TOK_EXTERNAL %token TOK_INTENT %token TOK_INTRINSIC %token TOK_NAMELIST %token TOK_DEFAULT %token TOK_OPTIONAL %token TOK_POINTER %token TOK_CONTINUE %token TOK_SAVE %token TOK_TARGET %token TOK_IMPLICIT %token TOK_NONE %token TOK_CALL %token TOK_STAT %token TOK_POINT_TO %token TOK_COMMON %token TOK_GLOBAL %token TOK_LEFTAB %token TOK_RIGHTAB %token TOK_PAUSE %token TOK_PROCEDURE %token TOK_STOP %token TOK_FOURDOTS %token TOK_HEXA %token TOK_ASSIGNTYPE %token TOK_OUT %token TOK_INOUT %token TOK_IN %token TOK_USE %token TOK_DSLASH %token TOK_DASTER %token TOK_EQ %token TOK_EQV %token TOK_GT %token TOK_LT %token TOK_GE %token TOK_NE %token TOK_NEQV %token TOK_LE %token TOK_OR %token TOK_XOR %token TOK_NOT %token TOK_AND %token TOK_EQUALEQUAL %token TOK_SLASHEQUAL %token TOK_INFEQUAL %token TOK_SUPEQUAL %token TOK_TRUE %token TOK_FALSE %token TOK_LABEL %token TOK_LABEL_DJVIEW %token TOK_PLAINDO_LABEL_DJVIEW %token TOK_PLAINDO_LABEL %token TOK_TYPE %token TOK_TYPEPAR %token TOK_ENDTYPE %token TOK_COMMACOMPLEX %token TOK_REAL %token TOK_INTEGER %token TOK_LOGICAL %token TOK_DOUBLEPRECISION %token TOK_ENDSUBROUTINE %token TOK_ENDFUNCTION %token TOK_ENDPROGRAM %token TOK_ENDUNIT %token TOK_CHARACTER %token TOK_CHAR_CONSTANT %token TOK_CHAR_CUT %token TOK_DATA %token TOK_CHAR_MESSAGE %token TOK_CSTREAL %token TOK_COMPLEX %token TOK_DOUBLECOMPLEX %token TOK_NAME %token TOK_SLASH %token TOK_CSTINT %token ',' %token ':' %token '(' %token ')' %token '<' %token '>' %type dcl %type dimension %type array-name-spec-list %type paramlist %type args %type declaration-type-spec %type arglist %type only_list %type only-list %type opt-only-list %type only %type only_name %type rename-list %type opt-rename-list %type rename %type dims %type dimlist %type dim %type paramitem %type comblock %type name_routine %type type-param-value %type opt_name %type constant-expr %type ac-implied-do %type subroutine-name %type opt-dummy-arg-list-par %type opt-dummy-arg-list %type dummy-arg-list %type named-constant-def-list %type named-constant-def %type ac-do-variable %type data-i-do-variable %type data-stmt-constant %type do-variable %type ac-implied-do-control %type label %type opt-label %type label-djview %type opt-label-djview %type type %type real-literal-constant %type type-declaration-stmt %type array-spec %type assumed-shape-spec-list %type deferred-shape-spec-list %type assumed-size-spec %type implied-shape-spec-list %type typespec %type null-init %type initial-data-target %type intent-spec %type string_constant %type access-id %type dummy-arg-name %type common-block-name %type function-name %type dummy-arg %type lower-bound %type upper-bound %type scalar-constant-subobject %type opt-data-stmt-star %type simple_const %type opt-char-selector %type char-selector %type ident %type intent_spec %type kind-param %type signe %type scalar-int-constant-expr %type opt_signe %type explicit-shape-spec %type explicit-shape-spec-list %type assumed-shape-spec %type deferred-shape-spec %type filename %type attribute %type complex_const %type begin_array %type clause %type only-use-name %type generic-spec %type arg %type opt-array-spec-par %type opt-explicit-shape-spec-list-comma %type explicit-shape-spec-list-comma %type uexpr %type section_subscript_ambiguous %type minmaxlist %type subscript %type subscript-triplet %type vector-subscript %type lhs %type outlist %type other %type int-constant-expr %type dospec %type expr_data %type structure_component %type array_ele_substring_func_ref %type funarglist %type funarg %type funargs %type triplet %type substring %type opt_substring %type opt_expr %type optexpr %type entity-decl %type entity-decl-list %type data_stmt_value_list %type data-stmt-value-list %type access-id-list %type opt-access-id-list %type data-stmt-value %type data-stmt-object-list %type data-i-do-object-list %type data-stmt-object %type data-i-do-object %type datanamelist %type after_slash %type after_equal %type predefinedfunction %type equiv-op %type or-op %type and-op %type not-op %type equiv-operand %type or-operand %type and-operand %type mult-operand %type rel-op %type concat-op %type add-operand %type add-op %type power-op %type section-subscript-list %type opt-lower-bound-2points %type mult-op %type array-constructor %type expr %type function-reference %type literal-constant %type named-constant %type ac-value-list %type ac-value %type intrinsic-type-spec %type opt-kind-selector %type char-literal-constant %type logical-literal-constant %type real-part %type imag-part %type sign %type signed-int-literal-constant %type int-literal-constant %type signed-real-literal-constant %type complex-literal-constant %type actual-arg-spec-list %type procedure-designator %type constant %type data-ref %type structure-component %type scalar-structure-component %type int-expr %type ac-spec %type type-spec %type derived-type-spec %type part-ref %type opt-part-ref %type actual-arg-spec %type kind-selector %type actual-arg %type section-subscript %type keyword %type primary %type specification-expr %type variable %type data-implied-do %type substring-range %type designator %type object-name %type object-name-noident %type array-element %type array-section %type scalar-variable-name %type scalar-constant %type variable-name %type opt-subscript %type stride %type opt-scalar-int-expr %type scalar-int-expr %type level-1-expr %type level-2-expr %type level-3-expr %type level-4-expr %type level-5-expr %type ubound %type operation %type proper_lengspec %type use_name_list %type public %% /* R201 : program */ /*program: line-break | program-unit | program program-unit ; */ input: | input line ; line: line-break | suite_line_list | error {yyerrok;yyclearin;} ; line-break: '\n' fin_line {token_since_endofstmt = 0; increment_nbtokens = 0;} | TOK_SEMICOLON | TOK_EOF | line-break '\n' fin_line | line-break TOK_SEMICOLON ; suite_line_list : suite_line | suite_line_list TOK_SEMICOLON '\n' | suite_line_list TOK_SEMICOLON suite_line ; suite_line:program-unit | TOK_INCLUDE filename fin_line { if (inmoduledeclare == 0 ) { pos_end = setposcur(); RemoveWordSET_0(fortran_out,pos_curinclude,pos_end-pos_curinclude); } } | TOK_COMMENT ; /* suite_line: entry fin_line subroutine, function, module | spec fin_line declaration | TOK_INCLUDE filename fin_line { if (inmoduledeclare == 0 ) { pos_end = setposcur(); RemoveWordSET_0(fortran_out,pos_curinclude,pos_end-pos_curinclude); } } | execution-part-construct ; */ fin_line: { pos_cur = setposcur(); } ; /* R202 : program-unit */ program-unit: main-program | external-subprogram | module ; /*R203 : external-subprogram */ external-subprogram: function-subprogram | subroutine-subprogram ; opt_recursive : { isrecursive = 0; } | TOK_RECURSIVE { isrecursive = 1; } ; opt_result : { is_result_present = 0; } | TOK_RESULT arglist_after_result { is_result_present = 1; } ; name_routine : TOK_NAME { strcpy($$, $1); strcpy(subroutinename, $1); } ; filename : TOK_CHAR_CONSTANT { Add_Include_1($1); } ; arglist : { if ( firstpass ) $$=NULL; } | '(' ')' { if ( firstpass ) $$=NULL; } | '(' {in_complex_literal=0;} args ')' { if ( firstpass ) $$=$3; } ; arglist_after_result: | '(' ')' | '(' {in_complex_literal=0;} args ')' { if ( firstpass ) Add_SubroutineArgument_Var_1($3); } ; args : arg { if ( firstpass == 1 ) { strcpy(nameinttypenameback,nameinttypename); strcpy(nameinttypename,""); curvar = createvar($1,NULL); strcpy(nameinttypename,nameinttypenameback); curlistvar = insertvar(NULL,curvar); $$ = settype("",curlistvar); } } | args ',' arg { if ( firstpass == 1 ) { strcpy(nameinttypenameback,nameinttypename); strcpy(nameinttypename,""); curvar = createvar($3,NULL); strcpy(nameinttypename,nameinttypenameback); $$ = insertvar($1,curvar); } } ; arg : TOK_NAME { strcpy($$,$1); } | '*' { strcpy($$,"*"); } ; opt_spec : | access_spec { PublicDeclare = 0 ; PrivateDeclare = 0 ; } ; name_intrinsic : TOK_SUM | TOK_TANH | TOK_MAXVAL | TOK_MIN | TOK_MINVAL | TOK_TRIM | TOK_SQRT | TOK_NINT | TOK_FLOAT | TOK_EXP | TOK_COS | TOK_COSH | TOK_ACOS | TOK_SIN | TOK_SINH | TOK_ASIN | TOK_LOG | TOK_TAN | TOK_ATAN | TOK_MOD | TOK_SIGN | TOK_MINLOC | TOK_MAXLOC | TOK_NAME ; use_intrinsic_list : name_intrinsic | use_intrinsic_list ',' name_intrinsic ; list_couple : '(' list_expr ')' | list_couple ',' '(' list_expr ')' ; list_expr_equi : expr_equi | list_expr_equi ',' expr_equi ; expr_equi : '(' list_expr_equi1 ')' ; list_expr_equi1 : ident dims | list_expr_equi1 ',' ident dims ; list_expr: expr | list_expr ',' expr ; opt_sep: | TOK_FOURDOTS ; before_function : TOK_FUNCTION { functiondeclarationisdone = 1; } ; before_parameter : TOK_PARAMETER {VariableIsParameter = 1; pos_curparameter = setposcur()-9; } ; data_stmt : /* R534 */ TOK_DATA data_stmt_set_list data_stmt_set_list : data_stmt_set | data_stmt_set_list opt_comma data_stmt_set data_stmt_set : /* R535 */ TOK_NAME TOK_SLASH data_stmt_value_list TOK_SLASH { createstringfromlistname(ligne,$3); if (firstpass == 1) Add_Data_Var_1(&List_Data_Var,$1,ligne); else Add_Data_Var_1(&List_Data_Var_Cur,$1,ligne); } | datanamelist TOK_SLASH data_stmt_value_list TOK_SLASH { if (firstpass == 1) Add_Data_Var_Names_01(&List_Data_Var,$1,$3); else Add_Data_Var_Names_01(&List_Data_Var_Cur,$1,$3); } | '(' lhs ',' dospec ')' TOK_SLASH data_stmt_value_list TOK_SLASH { createstringfromlistname(ligne,$7); printf("###################################################################################################################\n"); printf("## CONV Error : data_implied_do statements (R537) are not yet supported. Please complain to the proper authorities.\n"); printf("l.%4d -- data_stmt_set : ( lhs , dospec ) /data_stmt_value_list/ -- lhs=|%s| dospec=|%s| data_stmt_value_list=|%s|\n", line_num_input,$2,$4,ligne); printf("## But, are you SURE you NEED a DATA construct ?\n"); printf("###################################################################################################################\n"); exit(1); } ; data_stmt_value_list : expr_data { $$ = Insertname(NULL,$1,0); } | expr_data ',' data_stmt_value_list { $$ = Insertname($3,$1,1); } ; save: before_save varsave | before_save comblock varsave | save opt_comma comblock opt_comma varsave | save ',' varsave ; before_save: TOK_SAVE { pos_cursave = setposcur()-4; } ; varsave : | TOK_NAME dims { if ( ! inside_type_declare ) Add_Save_Var_1($1,$2); } ; datanamelist : TOK_NAME { $$ = Insertname(NULL,$1,0); } | TOK_NAME '(' expr ')' { printf("l.%4d -- INSTRUCTION NON TRAITEE : INITIALISATION DE DATA AVEC EXPRESSION\n",line_num_input); exit(0); } | datanamelist ',' datanamelist { $$ = concat_listname($1,$3); } ; expr_data : opt_signe simple_const { sprintf($$,"%s%s",$1,$2); } | expr_data '+' expr_data { sprintf($$,"%s+%s",$1,$3); } | expr_data '-' expr_data { sprintf($$,"%s-%s",$1,$3); } | expr_data '*' expr_data { sprintf($$,"%s*%s",$1,$3); } | expr_data '/' expr_data { sprintf($$,"%s/%s",$1,$3); } ; opt_signe : { strcpy($$,""); } | signe { strcpy($$,$1); } ; namelist : TOK_NAMELIST ident | TOK_NAMELIST comblock ident | namelist opt_comma comblock opt_comma ident | namelist ',' ident ; before_dimension : TOK_DIMENSION { positioninblock = 0; pos_curdimension = setposcur()-9; } dimension : before_dimension opt_comma TOK_NAME dims lengspec { printf("l.%4d -- dimension : before_dimension opt_comma TOK_NAME = |%s| -- MHCHECK\n",line_num_input,$3); if ( inside_type_declare ) break; curvar = createvar($3,$4); CreateAndFillin_Curvar("", curvar); curlistvar=insertvar(NULL, curvar); $$ = settype("",curlistvar); strcpy(vallengspec,""); } | dimension ',' TOK_NAME dims lengspec { printf("l.%4d -- dimension : dimension ',' TOK_NAME dims lengspec = |%s| -- MHCHECK\n",line_num_input,$3); if ( inside_type_declare ) break; curvar = createvar($3,$4); CreateAndFillin_Curvar("", curvar); curlistvar = insertvar($1, curvar); $$ = curlistvar; strcpy(vallengspec,""); } ; private : TOK_PRIVATE '\n' | TOK_PRIVATE opt_sep use_name_list ; public : TOK_PUBLIC '\n' { $$ = (listname *) NULL; } | TOK_PUBLIC opt_sep use_name_list { $$ = $3; } ; use_name_list : TOK_NAME { $$ = Insertname(NULL,$1,0); } | TOK_ASSIGNTYPE { $$ = Insertname(NULL,$1,0); } | use_name_list ',' TOK_NAME { $$ = Insertname($1,$3,0); } | use_name_list ',' TOK_ASSIGNTYPE { $$ = Insertname($1,$3,0); } ; common : before_common var_common_list { if ( inside_type_declare ) break; pos_end = setposcur(); RemoveWordSET_0(fortran_out,pos_curcommon,pos_end-pos_curcommon); } | before_common comblock var_common_list { if ( inside_type_declare ) break; sprintf(charusemodule,"%s",$2); Add_NameOfCommon_1($2,subroutinename); pos_end = setposcur(); RemoveWordSET_0(fortran_out,pos_curcommon,pos_end-pos_curcommon); } | common opt_comma comblock opt_comma var_common_list { if ( inside_type_declare ) break; sprintf(charusemodule,"%s",$3); Add_NameOfCommon_1($3,subroutinename); pos_end = setposcur(); RemoveWordSET_0(fortran_out,pos_curcommon,pos_end-pos_curcommon); } ; before_common : TOK_COMMON { positioninblock = 0; pos_curcommon = setposcur()-6; } | TOK_GLOBAL TOK_COMMON { positioninblock = 0; pos_curcommon = setposcur()-6-7; } ; var_common_list : var_common { if ( ! inside_type_declare ) Add_Common_var_1(); } | var_common_list ',' var_common { if ( ! inside_type_declare ) Add_Common_var_1(); } ; var_common : TOK_NAME dims { positioninblock = positioninblock + 1 ; strcpy(commonvar,$1); commondim = $2; } ; comblock : TOK_DSLASH { strcpy($$,""); positioninblock=0; strcpy(commonblockname,""); } | TOK_SLASH TOK_NAME TOK_SLASH { strcpy($$,$2); positioninblock=0; strcpy(commonblockname,$2); } ; opt_comma : | ',' ; paramlist : paramitem { $$=insertvar(NULL,$1); } | paramlist ',' paramitem { $$=insertvar($1,$3); } ; paramitem : TOK_NAME '=' expr { if ( inside_type_declare ) break; curvar=(variable *) calloc(1,sizeof(variable)); Init_Variable(curvar); curvar->v_VariableIsParameter = 1; strcpy(curvar->v_nomvar,$1); strcpy(curvar->v_subroutinename,subroutinename); strcpy(curvar->v_modulename,curmodulename); curvar->v_initialvalue=Insertname(curvar->v_initialvalue,$3,0); strcpy(curvar->v_commoninfile,cur_filename); Save_Length($3,14); $$ = curvar; } ; module_proc_stmt : TOK_PROCEDURE proc_name_list ; proc_name_list : TOK_NAME | proc_name_list ',' TOK_NAME ; implicit : TOK_IMPLICIT TOK_NONE { if ( insubroutinedeclare == 1 ) { Add_ImplicitNoneSubroutine_1(); pos_end = setposcur(); RemoveWordSET_0(fortran_out,pos_end-13,13); } } ; dcl: options TOK_NAME dims lengspec initial_value { if ( ! inside_type_declare ) { if (dimsgiven == 1) curvar = createvar($2,curdim); else curvar = createvar($2,$3); CreateAndFillin_Curvar(DeclType, curvar); curlistvar = insertvar(NULL, curvar); if (!strcasecmp(DeclType,"character")) { if (c_selectorgiven == 1) { strcpy(c_selectordim.first,"1"); strcpy(c_selectordim.last,c_selectorname); Save_Length(c_selectorname,1); change_dim_char(insertdim(NULL,c_selectordim),curlistvar); } } $$=settype(DeclType,curlistvar); } strcpy(vallengspec,""); } | dcl ',' TOK_NAME dims lengspec initial_value { if ( ! inside_type_declare ) { if (dimsgiven == 1) curvar = createvar($3, curdim); else curvar = createvar($3, $4); CreateAndFillin_Curvar($1->var->v_typevar,curvar); strcpy(curvar->v_typevar, $1->var->v_typevar); curvar->v_catvar = get_cat_var(curvar); curlistvar = insertvar($1, curvar); if (!strcasecmp(DeclType,"character")) { if (c_selectorgiven == 1) { strcpy(c_selectordim.first,"1"); strcpy(c_selectordim.last,c_selectorname); Save_Length(c_selectorname,1); change_dim_char(insertdim(NULL,c_selectordim),curlistvar); } } $$=curlistvar; } strcpy(vallengspec,""); } ; nodimsgiven : { dimsgiven = 0; } ; type: typespec selector { strcpy(DeclType,$1);} | before_character c_selector { strcpy(DeclType,"character"); } | typespec '*' TOK_CSTINT { strcpy(DeclType,$1); strcpy(nameinttypename,$3); } | TOK_TYPEPAR attribute ')' { strcpy(DeclType,"type"); GlobalDeclarationType = 1; } ; c_selector : | '*' TOK_CSTINT { c_selectorgiven = 1; strcpy(c_selectorname,$2); } | '*' '(' c_attribute ')' { c_star = 1;} | '(' c_attribute ')' ; c_attribute : TOK_NAME clause opt_clause | TOK_NAME '=' clause opt_clause | clause opt_clause ; before_character : TOK_CHARACTER { pos_cur_decl = setposcur()-9; } ; typespec : TOK_INTEGER { strcpy($$,"integer"); pos_cur_decl = setposcur()-7; } | TOK_LOGICAL { strcpy($$,"logical"); pos_cur_decl = setposcur()-7; } | TOK_REAL { strcpy($$,"real"); pos_cur_decl = setposcur()-4; } | TOK_COMPLEX { strcpy($$,"complex"); pos_cur_decl = setposcur()-7; } | TOK_DOUBLECOMPLEX { strcpy($$,"double complex"); pos_cur_decl = setposcur()-14; } | TOK_DOUBLEPRECISION { pos_cur_decl = setposcur()-16; strcpy($$,"real"); strcpy(nameinttypename,"8"); printf("OK1\n");} ; lengspec : | '*' proper_lengspec {strcpy(vallengspec,$2);} ; proper_lengspec : expr { sprintf($$,"*%s",$1); } | '(' '*' ')' { strcpy($$,"*(*)"); } ; selector : | '*' proper_selector | '(' attribute ')' ; proper_selector : expr | '(' '*' ')' ; attribute : TOK_NAME clause | TOK_NAME '=' clause { if ( strstr($3,"0.d0") ) { strcpy(nameinttypename,"8"); strcpy(NamePrecision,""); } else sprintf(NamePrecision,"%s = %s",$1,$3); } | TOK_NAME { strcpy(NamePrecision,$1); } | TOK_CSTINT { strcpy(NamePrecision,$1); } | TOK_ASSIGNTYPE { strcpy(NamePrecision,$1); } ; clause : expr { strcpy(CharacterSize,$1); strcpy($$,$1); } | '*' { strcpy(CharacterSize,"*"); strcpy($$,"*"); } | ':' { strcpy(CharacterSize,":"); strcpy($$,":"); } ; opt_clause : | ',' TOK_NAME clause ; options: | TOK_FOURDOTS | ',' attr_spec_list TOK_FOURDOTS ; attr_spec_list: attr_spec | attr_spec_list ',' attr_spec ; attr_spec : TOK_PARAMETER { VariableIsParameter = 1; } | access_spec | TOK_ALLOCATABLE { Allocatabledeclare = 1; } | TOK_DIMENSION dims { dimsgiven = 1; curdim = $2; } | TOK_EXTERNAL { ExternalDeclare = 1; } | TOK_INTENT '(' intent_spec ')' { strcpy(IntentSpec,$3); intent_spec = 0;} | TOK_INTRINSIC | TOK_CONTIGUOUS { contiguousdeclare = 1 ; } | TOK_OPTIONAL { optionaldeclare = 1 ; } | TOK_POINTER { pointerdeclare = 1 ; } | TOK_SAVE { SaveDeclare = 1 ; } | TOK_TARGET { Targetdeclare = 1; } ; intent_spec : TOK_IN { strcpy($$,$1); } | TOK_OUT { strcpy($$,$1); } | TOK_INOUT { strcpy($$,$1); } ; access_spec : TOK_PUBLIC { PublicDeclare = 1; } | TOK_PRIVATE { PrivateDeclare = 1; } ; dims : { $$ = (listdim*) NULL; } | '(' {in_complex_literal=0;} dimlist ')' { $$ = (listdim*) NULL; if ( inside_type_declare ) break; if ( created_dimensionlist == 1 || agrif_parentcall == 1 ) $$=$3; } ; dimlist : dim { $$ = (listdim*) NULL; if ( inside_type_declare ) break; if ( created_dimensionlist == 1 || agrif_parentcall == 1 ) $$=insertdim(NULL,$1); } | dimlist ',' dim { $$ = (listdim*) NULL; if ( inside_type_declare ) break; if ( (!inside_type_declare) && created_dimensionlist == 1 ) $$=insertdim($1,$3); } ; dim : ubound { strcpy($$.first,"1"); strcpy($$.last,$1); Save_Length($1,1); } | ':' { strcpy($$.first,""); strcpy($$.last,""); } | expr ':' { strcpy($$.first,$1); Save_Length($1,2); strcpy($$.last,""); } | ':' expr { strcpy($$.first,""); strcpy($$.last,$2); Save_Length($2,1); } | expr ':' ubound { strcpy($$.first,$1); Save_Length($1,2); strcpy($$.last,$3); Save_Length($3,1); } ; ubound : '*' { strcpy($$,"*"); } | expr { strcpy($$,$1); } ; /* expr: uexpr { strcpy($$,$1); } | complex_const { strcpy($$,$1); } | predefinedfunction { strcpy($$,$1); } | '(' expr ')' { sprintf($$,"(%s)",$2); } ; */ predefinedfunction : TOK_SUM minmaxlist ')' { sprintf($$,"SUM(%s)",$2);} | TOK_MAX minmaxlist ')' { sprintf($$,"MAX(%s)",$2);} | TOK_TANH '(' minmaxlist ')' { sprintf($$,"TANH(%s)",$3);} | TOK_MAXVAL '(' minmaxlist ')' { sprintf($$,"MAXVAL(%s)",$3);} | TOK_MIN minmaxlist ')' { sprintf($$,"MIN(%s)",$2);} | TOK_MINVAL '(' minmaxlist ')' { sprintf($$,"MINVAL(%s)",$3);} | TOK_TRIM '(' expr ')' { sprintf($$,"TRIM(%s)",$3);} | TOK_SQRT expr ')' { sprintf($$,"SQRT(%s)",$2);} | TOK_REAL '(' minmaxlist ')' { sprintf($$,"REAL(%s)",$3);} | TOK_NINT '(' expr ')' { sprintf($$,"NINT(%s)",$3);} | TOK_FLOAT '(' expr ')' { sprintf($$,"FLOAT(%s)",$3);} | TOK_EXP '(' expr ')' { sprintf($$,"EXP(%s)",$3);} | TOK_COS '(' expr ')' { sprintf($$,"COS(%s)",$3);} | TOK_COSH '(' expr ')' { sprintf($$,"COSH(%s)",$3);} | TOK_ACOS '(' expr ')' { sprintf($$,"ACOS(%s)",$3);} | TOK_SIN '(' expr ')' { sprintf($$,"SIN(%s)",$3);} | TOK_SINH '(' expr ')' { sprintf($$,"SINH(%s)",$3);} | TOK_ASIN '(' expr ')' { sprintf($$,"ASIN(%s)",$3);} | TOK_LOG '(' expr ')' { sprintf($$,"LOG(%s)",$3);} | TOK_TAN '(' expr ')' { sprintf($$,"TAN(%s)",$3);} | TOK_ATAN '(' expr ')' { sprintf($$,"ATAN(%s)",$3);} | TOK_ABS expr ')' { sprintf($$,"ABS(%s)",$2);} | TOK_MOD '(' minmaxlist ')' { sprintf($$,"MOD(%s)",$3);} | TOK_SIGN minmaxlist ')' { sprintf($$,"SIGN(%s)",$2);} | TOK_MINLOC '(' minmaxlist ')' { sprintf($$,"MINLOC(%s)",$3);} | TOK_MAXLOC '(' minmaxlist ')' { sprintf($$,"MAXLOC(%s)",$3);} ; minmaxlist : expr {strcpy($$,$1);} | minmaxlist ',' expr { sprintf($$,"%s,%s",$1,$3); } ; uexpr : lhs { strcpy($$,$1); } | simple_const { strcpy($$,$1); } | expr operation { sprintf($$,"%s%s",$1,$2); } | signe expr %prec '*' { sprintf($$,"%s%s",$1,$2); } | TOK_NOT expr { sprintf($$,"%s%s",$1,$2); } ; signe : '+' { strcpy($$,"+"); } | '-' { strcpy($$,"-"); } ; operation : '+' expr %prec '+' { sprintf($$,"+%s",$2); } | '-' expr %prec '+' { sprintf($$,"-%s",$2); } | '*' expr { sprintf($$,"*%s",$2); } | TOK_DASTER expr { sprintf($$,"%s%s",$1,$2); } | TOK_EQ expr %prec TOK_EQ { sprintf($$,"%s%s",$1,$2); } | TOK_EQV expr %prec TOK_EQV { sprintf($$,"%s%s",$1,$2); } | TOK_GT expr %prec TOK_EQ { sprintf($$,"%s%s",$1,$2); } | '>' expr %prec TOK_EQ { sprintf($$," > %s",$2); } | '<' expr %prec TOK_EQ { sprintf($$," < %s",$2); } | '>''=' expr %prec TOK_EQ { sprintf($$," >= %s",$3); } | '<''=' expr %prec TOK_EQ { sprintf($$," <= %s",$3); } | TOK_LT expr %prec TOK_EQ { sprintf($$,"%s%s",$1,$2); } | TOK_GE expr %prec TOK_EQ { sprintf($$,"%s%s",$1,$2); } | TOK_LE expr %prec TOK_EQ { sprintf($$,"%s%s",$1,$2); } | TOK_NE expr %prec TOK_EQ { sprintf($$,"%s%s",$1,$2); } | TOK_NEQV expr %prec TOK_EQV { sprintf($$,"%s%s",$1,$2); } | TOK_XOR expr { sprintf($$,"%s%s",$1,$2); } | TOK_OR expr { sprintf($$,"%s%s",$1,$2); } | TOK_AND expr { sprintf($$,"%s%s",$1,$2); } | TOK_SLASH after_slash { sprintf($$,"%s",$2); } | '=' after_equal { sprintf($$,"%s",$2); } after_slash : { strcpy($$,""); } | expr { sprintf($$,"/%s",$1); } | '=' expr %prec TOK_EQ { sprintf($$,"/= %s",$2);} | TOK_SLASH expr { sprintf($$,"//%s",$2); } ; after_equal : '=' expr %prec TOK_EQ { sprintf($$,"==%s",$2); } | expr { sprintf($$,"= %s",$1); } ; lhs : ident { strcpy($$,$1); } | structure_component { strcpy($$,$1); } | array_ele_substring_func_ref { strcpy($$,$1); } ; beforefunctionuse : { agrif_parentcall = 0; if ( !strcasecmp(identcopy, "Agrif_Parent") ) agrif_parentcall = 1; if ( Agrif_in_Tok_NAME(identcopy) ) { inagrifcallargument = 1; Add_SubroutineWhereAgrifUsed_1(subroutinename, curmodulename); } } ; array_ele_substring_func_ref : begin_array { strcpy($$,$1); if ( incalldeclare == 0 ) inagrifcallargument = 0; } | begin_array substring { sprintf($$," %s %s ",$1,$2); } | structure_component '(' {in_complex_literal=0;} funarglist ')' { sprintf($$," %s ( %s )",$1,$4); } | structure_component '(' {in_complex_literal=0;} funarglist ')' substring { sprintf($$," %s ( %s ) %s ",$1,$4,$6); } ; begin_array : TOK_LOGICALIF | ident '(' {in_complex_literal=0;} funarglist ')' { if ( inside_type_declare ) break; sprintf($$," %s ( %s )",$1,$4); ModifyTheAgrifFunction_0($4); agrif_parentcall = 0; } ; structure_component : lhs '%' declare_after_percent lhs { sprintf($$," %s %% %s ",$1,$4); if ( incalldeclare == 0 ) inagrifcallargument = 0; } ; /* vec : TOK_LEFTAB outlist TOK_RIGHTAB { sprintf($$,"(/%s/)",$2); } ; */ funarglist : beforefunctionuse { strcpy($$," "); } | beforefunctionuse funargs { strcpy($$,$2); } ; funargs : funarg { strcpy($$,$1); } | funargs ',' funarg { sprintf($$,"%s,%s",$1,$3); } ; funarg : expr {strcpy($$,$1);} | triplet {strcpy($$,$1);} ; triplet : expr ':' expr { sprintf($$,"%s :%s",$1,$3);} | expr ':' expr ':' expr { sprintf($$,"%s :%s :%s",$1,$3,$5);} | ':' expr ':' expr { sprintf($$,":%s :%s",$2,$4);} | ':' ':' expr { sprintf($$,": : %s",$3);} | ':' expr { sprintf($$,":%s",$2);} | expr ':' { sprintf($$,"%s :",$1);} | ':' { sprintf($$,":");} ; ident: TOK_NAME { // if (indeclaration == 1) break; if ( afterpercent == 0 ) { if ( Agrif_in_Tok_NAME($1) ) Add_SubroutineWhereAgrifUsed_1(subroutinename, curmodulename); if ( !strcasecmp($1,"Agrif_Parent") ) agrif_parentcall = 1; if ( VariableIsFunction($1) ) { if ( inagrifcallargument == 1 ) { if ( !strcasecmp($1,identcopy) ) { strcpy(sameagrifname,identcopy); sameagrifargument = 1; } } strcpy(identcopy,$1); pointedvar = 0; if (variscoupled_0($1)) strcpy(truename, getcoupledname_0($1)); else strcpy(truename, $1); if ( VarIsNonGridDepend(truename) == 0 && (! Variableshouldberemoved(truename)) ) { if ( inagrifcallargument == 1 || varispointer_0(truename) == 1 ) { if ( (IsinListe(List_UsedInSubroutine_Var,$1) == 1) || (inagrifcallargument == 1) ) { if (varistyped_0(truename) == 0) ModifyTheVariableName_0(truename,strlen($1)); } } if ( inagrifcallargument != 1 || sameagrifargument ==1 ) { Add_UsedInSubroutine_Var_1(truename); } } NotifyAgrifFunction_0(truename); } } else { afterpercent = 0; } } ; simple_const : TOK_TRUE { strcpy($$,".TRUE.");} | TOK_FALSE { strcpy($$,".FALSE.");} | TOK_NULL_PTR { strcpy($$,"NULL()"); } | TOK_CSTINT { strcpy($$,$1); } | TOK_CSTREAL { strcpy($$,$1); } | TOK_HEXA { strcpy($$,$1); } | simple_const TOK_NAME { sprintf($$,"%s%s",$1,$2); } | string_constant opt_substring ; string_constant : TOK_CHAR_CONSTANT { strcpy($$,$1);} | string_constant TOK_CHAR_CONSTANT | TOK_CHAR_MESSAGE { strcpy($$,$1);} | TOK_CHAR_CUT { strcpy($$,$1);} ; opt_substring : { strcpy($$," ");} | substring { strcpy($$,$1);} ; /* substring : '(' optexpr ':' optexpr ')' { sprintf($$,"(%s :%s)",$2,$4);} ; */ optexpr : { strcpy($$," ");} | expr { strcpy($$,$1);} ; opt_expr : { strcpy($$," ");} | expr { strcpy($$,$1);} ; initial_value: { InitialValueGiven = 0; } | '=' expr { if ( inside_type_declare ) break; strcpy(InitValue,$2); InitialValueGiven = 1; } | TOK_POINT_TO expr { if ( inside_type_declare ) break; strcpy(InitValue,$2); InitialValueGiven = 2; } ; complex_const : '(' uexpr ',' uexpr ')' {sprintf($$,"(%s,%s)",$2,$4); } ; only_list : only_name { $$ = $1; } | only_list ',' only_name { /* insert the variable in the list $1 */ $3->suiv = $1; $$ = $3; } ; only_name : TOK_NAME TOK_POINT_TO TOK_NAME { coupletmp = (listcouple *)calloc(1,sizeof(listcouple)); strcpy(coupletmp->c_namevar,$1); strcpy(coupletmp->c_namepointedvar,$3); coupletmp->suiv = NULL; $$ = coupletmp; pointedvar = 1; Add_UsedInSubroutine_Var_1($1); } | TOK_NAME { coupletmp = (listcouple *)calloc(1,sizeof(listcouple)); strcpy(coupletmp->c_namevar,$1); strcpy(coupletmp->c_namepointedvar,""); coupletmp->suiv = NULL; $$ = coupletmp; } ; /* R204 : specification-part */ /* opt-implicit-part removed but implicit-stmt and format-stmt added to declaration-construct */ specification-part: opt-use-stmt-list opt-declaration-construct-list ; opt-use-stmt-list: |use-stmt-list ; opt-implicit-part: |implicit-part ; implicit-part: opt-implicit-part-stmt-list implicit-stmt ; opt-implicit-part-stmt-list: | implicit-part-stmt-list ; implicit-part-stmt-list: implicit-part-stmt | implicit-part-stmt-list implicit-part-stmt ; /* R206: implicit-part-stmt */ implicit-part-stmt: implicit-stmt | parameter-stmt | format-stmt ; opt-declaration-construct-list: |declaration-construct-list ; declaration-construct-list: declaration-construct | declaration-construct-list declaration-construct ; /* R207 : declaration-construct */ /* stmt-function-stmt replaced by assignment-stmt due to reduce conflicts */ /* because assignment-stmt has been added */ /* Every statement that begins with a variable should be added */ /* This include : */ /* pointer-assignment-stmt, do-construct */ /* implicit-stmt and format-stmt added since implicit-part-stmt has been removed due to conflicts (see R204) */ /* ANOTHER SOLUTION TO THE PROBLEM OF STMT-FUNCTION IS NEEDED !!!! */ /* BECAUSE ALMOST ALL ACTION-STMT SHOULD BE INCLUDED HERE !!! */ declaration-construct: derived-type-def | parameter-stmt | format-stmt | implicit-stmt | other-specification-stmt | type-declaration-stmt | assignment-stmt | pointer-assignment-stmt | do-construct | if-construct | continue-stmt | return-stmt | print-stmt ; opt-execution-part: | execution-part ; /* R208 : execution-part */ execution-part: executable-construct opt-execution-part-construct-list ; opt-execution-part-construct-list: |execution-part-construct-list ; execution-part-construct-list: execution-part-construct | execution-part-construct-list execution-part-construct ; /* R209 : execution-part-construct */ execution-part-construct: executable-construct | format-stmt ; opt-internal-subprogram-part: | internal-subprogram-part ; /* R120 : internal-subprogram-part */ internal-subprogram-part: TOK_CONTAINS line-break opt-internal-subprogram ; opt-internal-subprogram: | internal-subprogram-list ; internal-subprogram-list: internal-subprogram | internal-subprogram-list internal-subprogram ; /* R211 : internal-subprogram */ internal-subprogram: function-subprogram | subroutine-subprogram ; /* R212 : other-specification-stmt */ other-specification-stmt: access-stmt | common-stmt | data-stmt | dimension-stmt | equivalence-stmt | external-stmt | intrinsic-stmt | namelist-stmt | save-stmt ; /* R213 : executable-construct */ executable-construct: action-stmt | do-construct | case-construct | if-construct | where-construct ; /* R214 : action-stmt */ /* normal action-stmt */ action-stmt: allocate-stmt | assignment-stmt | call-stmt | close-stmt | continue-stmt | cycle-stmt | deallocate-stmt | goto-stmt | exit-stmt | flush-stmt | TOK_CYCLE opt_expr | TOK_NULLIFY '(' pointer_name_list ')' | TOK_ENDMODULE opt_name { /* if we never meet the contains keyword */ if ( firstpass == 0 ) { RemoveWordCUR_0(fortran_out, strlen($2)+11); // Remove word "end module" if ( inmoduledeclare && ! aftercontainsdeclare ) { Write_Closing_Module(1); } fprintf(fortran_out,"\n end module %s\n", curmodulename); if ( module_declar && insubroutinedeclare == 0 ) { fclose(module_declar); } } inmoduledeclare = 0 ; inmodulemeet = 0 ; aftercontainsdeclare = 1; strcpy(curmodulename, ""); GlobalDeclaration = 0 ; } | if-stmt | inquire-stmt | open-stmt | pointer-assignment-stmt | print-stmt | read-stmt | return-stmt | rewind-stmt | stop-stmt | where-stmt | write-stmt | arithmetic-if-stmt ; /* R215 : keyword */ keyword: ident ; scalar-constant: constant ; /* R304 : constant */ constant: literal-constant | named-constant ; /* R305 : literal-constant */ literal-constant: int-literal-constant | real-literal-constant | logical-literal-constant | complex-literal-constant {in_complex_literal=0;} | char-literal-constant ; /* R306 : named-constant */ named-constant: ident ; scalar-int-constant:int-constant ; /* R307 : int-constant */ int-constant: int-literal-constant | named-constant ; /* constant: TOK_CSTINT | TOK_CSTREAL | ident ; */ opt-label: {strcpy($$,"");} | label ; /* R312 : label */ label: TOK_LABEL | TOK_CSTINT ; opt-label-djview: {strcpy($$,"");} | label-djview {strcpy($$,$1);} ; label-djview: TOK_LABEL_DJVIEW ; /* R401 : type-param-value */ type-param-value: scalar-int-expr | '*' | ':' ; /* R402: type-spec */ type-spec: intrinsic-type-spec {strcpy($$,$1);} | derived-type-spec {strcpy($$,$1);} ; /* R403 : declaration-type-spec */ declaration-type-spec: {pos_cur_decl=my_position_before;} intrinsic-type-spec {strcpy($$,$2);} | TOK_TYPEPAR intrinsic-type-spec ')' | TOK_TYPEPAR derived-type-spec ')' {strcpy(DeclType,"type"); GlobalDeclarationType = 1; } ; /* R404 : intrinsic-type-spec */ intrinsic-type-spec: TOK_INTEGER {in_kind_selector = 1;} opt-kind-selector {sprintf($$,"%s%s",$1,$[opt-kind-selector]);strcpy(DeclType,$1); in_kind_selector =0;} | TOK_REAL {in_kind_selector = 1;} opt-kind-selector {sprintf($$,"%s%s",$1,$[opt-kind-selector]);strcpy(DeclType,$1);in_kind_selector =0;} | TOK_DOUBLEPRECISION {in_kind_selector = 1;} opt-kind-selector {sprintf($$,"%s%s",$1,$[opt-kind-selector]);strcpy(DeclType,"real"); strcpy(NamePrecision,"8");in_kind_selector =0;} | TOK_COMPLEX {in_kind_selector = 1;} opt-kind-selector {sprintf($$,"%s%s",$1,$[opt-kind-selector]);strcpy(DeclType,$1);in_kind_selector =0;} | TOK_CHARACTER {in_char_selector = 1;} opt-char-selector {sprintf($$,"%s%s",$1,$[opt-char-selector]);strcpy(DeclType,$1);in_char_selector = 0;} | TOK_LOGICAL {in_kind_selector = 1;} opt-kind-selector {sprintf($$,"%s%s",$1,$[opt-kind-selector]);strcpy(DeclType,$1);in_kind_selector =0;} ; opt-kind-selector: {strcpy($$,"");strcpy(NamePrecision,"");} |kind-selector {strcpy($$,$1);} ; /* R405 : kind-selector */ /* Nonstandard extension : * INT */ kind-selector: '(' scalar-int-constant-expr ')' {sprintf($$,"(%s)",$2); strcpy(NamePrecision,$2);} | '(' TOK_KIND '=' scalar-int-constant-expr ')' {sprintf($$,"(KIND=%s)",$4); strcpy(NamePrecision,$4);} | '*' TOK_CSTINT {sprintf($$,"*%s",$2);strcpy(NamePrecision,$2);} ; /* R406 : signed-int-literal-constant */ /* sign replaced by add-op */ signed-int-literal-constant:int-literal-constant | add-op int-literal-constant {sprintf($$,"%s%s",$1,$2);} ; /* R407 : int-literal-constant */ int-literal-constant: TOK_CSTINT | TOK_CSTINT '_' kind-param {sprintf($$,"%s_%s",$1,$3);} ; /*R408 : kind-param */ kind-param: TOK_CSTINT | TOK_NAME ; opt-sign: | sign ; /* R411 : sign */ sign:'+' {strcpy($$,"+");} | '-' {strcpy($$,"-");} ; /* R412 : signed-real-literal-constant */ /* sign replaced by add-op */ signed-real-literal-constant:real-literal-constant | add-op real-literal-constant {sprintf($$,"%s%s",$1,$2);} ; /* R413 : real-literal-constant */ real-literal-constant: TOK_CSTREAL | TOK_CSTREAL '_' kind-param {sprintf($$,"%s_%s",$1,$3);}; ; /* R417 : complex-literal-constant */ /* in-complex-literal is just here to change default precedence rules ... */ complex-literal-constant: '(' real-part TOK_COMMACOMPLEX imag-part ')' {sprintf($$,"(%s,%s)",$2,$4);} ; /* R418 : real-part */ real-part: signed-int-literal-constant | signed-real-literal-constant | ident ; /* R419 : imag-part */ imag-part: signed-int-literal-constant | signed-real-literal-constant | named-constant ; opt-char_length-star: | '*' char-length {char_length_toreset = 1;} ; opt-char-selector: {strcpy($$,"");} | char-selector {strcpy($$,"");} ; /* R420 : char-selector */ char-selector:length-selector | '(' TOK_LEN '=' type-param-value ',' TOK_KIND '=' scalar-int-constant-expr ')' | '(' type-param-value ',' scalar-int-constant-expr ')' | '(' TOK_KIND '=' scalar-int-constant-expr ')' | '(' TOK_KIND '=' scalar-int-constant-expr ',' TOK_LEN '=' type-param-value ')' ; /* R421 : length-selector */ length-selector: '(' type-param-value ')' {strcpy(CharacterSize,$2);} | '(' TOK_LEN '=' type-param-value ')' {strcpy(CharacterSize,$4);} | '*' char-length | '*' char-length ',' ; /* R422 : char-length */ char-length: '(' type-param-value ')' {c_star=1; strcpy(CharacterSize,$2);} | int-literal-constant {c_selectorgiven = 1; strcpy(c_selectorname,$1);} ; /* R423 : char-literal-constant */ char-literal-constant: TOK_CHAR_CONSTANT | TOK_CHAR_MESSAGE | TOK_CHAR_CUT ; /* R424 : logical-literal-constant */ logical-literal-constant: TOK_TRUE | TOK_FALSE ; /* R425 : derived-type-def */ derived-type-def: derived-type-stmt { inside_type_declare = 1;} opt-component-part end-type-stmt { inside_type_declare = 0;} ; /* R426 : derived-type-stmt */ derived-type-stmt: TOK_TYPE opt-type-attr-spec-list-comma-fourdots TOK_NAME line-break | TOK_TYPE opt-type-attr-spec-list-comma TOK_NAME '(' type-param-name-list ')' line-break ; opt-type-attr-spec-list-comma-fourdots: | opt-type-attr-spec-list-comma TOK_FOURDOTS ; opt-type-attr-spec-list-comma: | ',' type-attr-spec-list ; type-attr-spec-list: type-attr-spec | type-attr-spec-list ',' type-attr-spec ; /* R427 : type-attr-spec */ type-attr-spec: access-spec ; type-param-name-list: type-param-name | type-param-name-list ',' type-param-name ; type-param-name: TOK_NAME ; /* R429 : end-type-stmt */ end-type-stmt: TOK_ENDTYPE line-break | TOK_ENDTYPE TOK_NAME line-break ; opt-component-part: | component-part ; /* R434 : component-part */ component-part: component-def-stmt | component-part component-def-stmt ; /* R435 : component-def-stmt */ component-def-stmt: data-component-def-stmt ; /* R436 : data-component-def-stmt */ data-component-def-stmt: declaration-type-spec opt-component-attr-spec-list-comma-2points component-decl-list line-break ; opt-component-attr-spec-list-comma-2points: | TOK_FOURDOTS | ',' component-attr-spec-list TOK_FOURDOTS ; component-attr-spec-list: component-attr-spec | component-attr-spec-list ',' component-attr-spec ; /* R437 : component-attr-spec */ component-attr-spec: access-spec | TOK_ALLOCATABLE | TOK_CONTIGUOUS | TOK_DIMENSION '(' {in_complex_literal=0;} component-array-spec ')' | TOK_POINTER ; component-decl-list: component-decl | component-decl-list ',' component-decl ; /* R438 : component-decl */ component-decl : ident opt-component-array-spec opt-char_length-star opt-component-initialization { PublicDeclare = 0; PrivateDeclare = 0; ExternalDeclare = 0; strcpy(NamePrecision,""); c_star = 0; InitialValueGiven = 0 ; strcpy(IntentSpec,""); VariableIsParameter = 0 ; Allocatabledeclare = 0 ; Targetdeclare = 0 ; SaveDeclare = 0; pointerdeclare = 0; contiguousdeclare = 0 ; optionaldeclare = 0 ; dimsgiven=0; c_selectorgiven=0; strcpy(nameinttypename,""); strcpy(c_selectorname,""); GlobalDeclarationType = 0; } ; opt-component-array-spec: | '(' component-array-spec ')' ; /* R439 : component-array-spec */ component-array-spec: explicit-shape-spec-list | deferred-shape-spec-list ; opt-component-initialization: | component-initialization ; /* R442 : component-initialization */ component-initialization: '=' constant-expr | TOK_POINT_TO null-init | TOK_POINT_TO initial-data-target ; /* R443 initial-data-target */ initial-data-target: designator {strcpy(my_dim.last,"");} ; /* R453 : derived-type-spec */ derived-type-spec: ident {strcpy(NamePrecision,$1);} | ident '(' type-param-spec-list ')' ; type-param-spec-list: type-param-spec | type-param-spec-list ',' type-param-spec ; /* R454 : type-param-spec */ type-param-spec: type-param-value | keyword '=' type-param-value ; /* R455 : structure-constructor */ structure-constructor: derived-type-spec '(' ')' | derived-type-spec '(' component-spec-list ')' ; component-spec-list: component-spec | component-spec-list ',' component-spec ; /* R456 : component-spec */ component-spec: component-data-source | keyword '=' component-data-source ; /* R457 : component-data-source */ component-data-source: expr | data-target | proc-target ; /* R468 : array-constructor */ array-constructor: TOK_LEFTAB ac-spec TOK_RIGHTAB { sprintf($$,"(/%s/)",$2);} | lbracket ac-spec rbracket { sprintf($$,"[%s]",$2); } ; /* R469 : ac-spec */ /* type-spec TOK_FOURDOTS is removed due to conflicts with part-ref */ /*ac-spec: type-spec TOK_FOURDOTS {sprintf($$,"%s::",$1);} | ac-value-list | type-spec TOK_FOURDOTS ac-value-list {sprintf($$,"%s::%s",$1,$3);} ; */ ac-spec: ac-value-list ; /* R470 : lbracket */ lbracket: '[' ; /* R471 : rbracket */ rbracket: ']' ; ac-value-list: ac-value | ac-value-list ',' ac-value {sprintf($$,"%s,%s",$1,$3);} ; /* R472 : ac-value */ ac-value: expr | ac-implied-do ; /* R473 : ac-implied-do */ ac-implied-do: '(' ac-value-list ',' ac-implied-do-control ')' {sprintf($$,"(%s,%s)",$2,$4);} ; /* R474 : ac-implied-do-control */ ac-implied-do-control: ac-do-variable '=' scalar-int-expr ',' scalar-int-expr {sprintf($$,"%s=%s,%s",$1,$3,$5);} | ac-do-variable '=' scalar-int-expr ',' scalar-int-expr ',' scalar-int-expr {sprintf($$,"%s=%s,%s,%s",$1,$3,$5,$7);} ; /* R475 : ac-do-variable */ ac-do-variable: do-variable ; /* R501 : type-declaration-stmt */ type-declaration-stmt: {indeclaration=1;} declaration-type-spec opt-attr-spec-construct entity-decl-list { /* if the variable is a parameter we can suppose that is*/ /* value is the same on each grid. It is not useless */ /* to create a copy of it on each grid */ if ( ! inside_type_declare ) { pos_end = setposcur(); //printf("POS = %d %d\n",pos_cur_decl,pos_end); RemoveWordSET_0(fortran_out,pos_cur_decl,pos_end-pos_cur_decl); ReWriteDeclarationAndAddTosubroutine_01($[entity-decl-list]); pos_cur_decl = setposcur(); if ( firstpass == 0 && GlobalDeclaration == 0 && insubroutinedeclare == 0 ) { fprintf(fortran_out,"\n#include \"Module_Declar_%s.h\"\n", curmodulename); sprintf(ligne, "Module_Declar_%s.h", curmodulename); module_declar = open_for_write(ligne); GlobalDeclaration = 1 ; pos_cur_decl = setposcur(); } if ( firstpass ) { Add_Globliste_1($[entity-decl-list]); if ( insubroutinedeclare ) { if ( pointerdeclare ) Add_Pointer_Var_From_List_1($[entity-decl-list]); Add_Parameter_Var_1($[entity-decl-list]); } else Add_GlobalParameter_Var_1($[entity-decl-list]); /* If there's a SAVE declaration in module's subroutines we should */ /* remove it from the subroutines declaration and add it in the */ /* global declarations */ if ( aftercontainsdeclare && SaveDeclare ) { if ( inmodulemeet ) Add_SubroutineDeclarationSave_Var_1($[entity-decl-list]); else Add_Save_Var_dcl_1($[entity-decl-list]); } } } indeclaration = 0; PublicDeclare = 0; PrivateDeclare = 0; ExternalDeclare = 0; strcpy(NamePrecision,""); c_star = 0; InitialValueGiven = 0 ; strcpy(IntentSpec,""); VariableIsParameter = 0 ; Allocatabledeclare = 0 ; Targetdeclare = 0 ; SaveDeclare = 0; pointerdeclare = 0; contiguousdeclare = 0 ; optionaldeclare = 0 ; dimsgiven=0; c_selectorgiven=0; strcpy(nameinttypename,""); strcpy(c_selectorname,""); strcpy(DeclType,""); GlobalDeclarationType = 0; } line-break ; opt-attr-spec-construct: | opt-attr-spec-comma-list TOK_FOURDOTS ; opt-attr-spec-comma-list: | attr-spec-comma-list ; attr-spec-comma-list: ',' attr-spec | attr-spec-comma-list ',' attr-spec ; /* R502 : attr-spec */ attr-spec:access-spec | TOK_ALLOCATABLE { Allocatabledeclare = 1; } | TOK_CONTIGUOUS { contiguousdeclare = 1 ; } | TOK_DIMENSION '(' {in_complex_literal=0;} array-spec ')' { dimsgiven = 1; curdim = $4; } | TOK_EXTERNAL { ExternalDeclare = 1; } | TOK_INTENT '(' {in_complex_literal=0;} intent-spec ')' { strcpy(IntentSpec,$4); } | TOK_INTRINSIC | TOK_OPTIONAL { optionaldeclare = 1 ; } | TOK_PARAMETER {VariableIsParameter = 1; } | TOK_POINTER { pointerdeclare = 1 ; } | TOK_SAVE { SaveDeclare = 1 ; } | TOK_TARGET { Targetdeclare = 1; } ; entity-decl-list: entity-decl {$$=insertvar(NULL,$1);} | entity-decl-list ',' entity-decl {$$=insertvar($1,$3);} ; /* R503 : entity-decl */ entity-decl: object-name-noident opt-array-spec-par opt-char_length-star opt-initialization { if ( ! inside_type_declare ) { if (dimsgiven == 1) curvar = createvar($1,curdim); else curvar = createvar($1,$2); CreateAndFillin_Curvar(DeclType, curvar); strcpy(curvar->v_typevar,DeclType); curvar->v_catvar = get_cat_var(curvar); if (!strcasecmp(DeclType,"character")) { if (c_selectorgiven == 1) { Save_Length(c_selectorname,1); strcpy(curvar->v_dimchar,c_selectorname); } } } strcpy(vallengspec,""); if (char_length_toreset == 1) { c_selectorgiven = 0; c_star = 0; strcpy(c_selectorname,""); strcpy(CharacterSize,""); char_length_toreset = 0; } $$=curvar; } ; /* R504 : object-name */ object-name: ident ; object-name-noident: TOK_NAME ; opt-initialization: {InitialValueGiven = 0; } | initialization ; /* R505 : initialization */ initialization: '=' constant-expr { if ( inside_type_declare ) break; strcpy(InitValue,$2); InitialValueGiven = 1; } | TOK_POINT_TO null-init { if ( inside_type_declare ) break; strcpy(InitValue,$2); InitialValueGiven = 2; } | TOK_POINT_TO initial-data-target { if ( inside_type_declare ) break; strcpy(InitValue,$2); InitialValueGiven = 2; } ; /* R506 : null-init */ null-init: function-reference ; /* R507 : access-spec */ access-spec: TOK_PUBLIC {PublicDeclare = 1; } | TOK_PRIVATE {PrivateDeclare = 1; } ; opt-array-spec-par: {$$=NULL;} | '(' {in_complex_literal=0;} array-spec ')' {$$=$3;} ; /* R514 : array-spec */ array-spec: explicit-shape-spec-list {$$=$1;} | assumed-shape-spec-list {$$=$1;} | deferred-shape-spec-list {$$=$1;} | assumed-size-spec {$$=$1;} | implied-shape-spec-list {$$=$1;} ; explicit-shape-spec-list: explicit-shape-spec { $$ = (listdim*) NULL; if ( inside_type_declare ) break; if ( created_dimensionlist == 1 || agrif_parentcall == 1 ) $$=insertdim(NULL,$1); } | explicit-shape-spec-list ',' explicit-shape-spec { $$ = (listdim*) NULL; if ( inside_type_declare ) break; if ( (!inside_type_declare) && created_dimensionlist == 1 ) $$=insertdim($1,$3); } ; /* R516 : explicit-shape-spec */ explicit-shape-spec: lower-bound ':' upper-bound {strcpy($$.first,$1); Save_Length($1,2); strcpy($$.last,$3); Save_Length($3,1); } |upper-bound {strcpy($$.first,"1"); strcpy($$.last,$1); Save_Length($1,1);} ; /* R517 : lower-bound */ lower-bound: specification-expr {strcpy($$,$1);} ; /* R518 : upper-bound */ upper-bound: specification-expr ; assumed-shape-spec-list: assumed-shape-spec { $$ = (listdim*) NULL; if ( inside_type_declare ) break; if ( created_dimensionlist == 1 || agrif_parentcall == 1 ) $$=insertdim(NULL,$1); } | assumed-shape-spec-list ',' assumed-shape-spec { $$ = (listdim*) NULL; if ( inside_type_declare ) break; if ( (!inside_type_declare) && created_dimensionlist == 1 ) $$=insertdim($1,$3); } ; /* R519 : assumed-shape-spec */ assumed-shape-spec : ':' { strcpy($$.first,""); strcpy($$.last,""); } | lower-bound ':' { strcpy($$.first,$1); Save_Length($1,2); strcpy($$.last,""); } ; deferred-shape-spec-list: deferred-shape-spec { $$ = (listdim*) NULL; if ( inside_type_declare ) break; if ( created_dimensionlist == 1 || agrif_parentcall == 1 ) $$=insertdim(NULL,$1); } | deferred-shape-spec-list ',' deferred-shape-spec { $$ = (listdim*) NULL; if ( inside_type_declare ) break; if ( (!inside_type_declare) && created_dimensionlist == 1 ) $$=insertdim($1,$3); } ; /* R520 : deferred-shape-spec */ deferred-shape-spec: ':' { strcpy($$.first,""); strcpy($$.last,""); } ; /* R521 : assume-size-spec */ assumed-size-spec:opt-explicit-shape-spec-list-comma opt-lower-bound-2points '*' { $$ = (listdim*) NULL; if ( inside_type_declare ) break; if ( created_dimensionlist == 1 || agrif_parentcall == 1 ) { if (!strcasecmp($2,"")) { strcpy(my_dim.first,"1"); } else { strcpy(my_dim.first,$2); } strcpy(my_dim.last,"*"); $$=insertdim($1,my_dim); strcpy(my_dim.first,""); strcpy(my_dim.last,""); } } ; opt-explicit-shape-spec-list-comma: {$$ = (listdim *) NULL;} | explicit-shape-spec-list ',' {$$ = $1;} ; explicit-shape-spec-list-comma: explicit-shape-spec ',' { $$ = (listdim*) NULL; if ( inside_type_declare ) break; if ( created_dimensionlist == 1 || agrif_parentcall == 1 ) $$=insertdim(NULL,$1); } | explicit-shape-spec-list-comma explicit-shape-spec ',' { $$ = (listdim*) NULL; if ( inside_type_declare ) break; if ( (!inside_type_declare) && created_dimensionlist == 1 ) $$=insertdim($1,$2); } ; opt-lower-bound-2points: {strcpy($$,"");} | lower-bound ':' {strcpy($$,$1);} ; implied-shape-spec-list: implied-shape-spec | implied-shape-spec-list ',' implied-shape-spec ; /* R522 : implied-shape-spec */ implied-shape-spec: opt-lower-bound-2points '*' ; /* R523 : intent-spec */ intent-spec: TOK_IN { strcpy($$,$1); } | TOK_OUT { strcpy($$,$1); } | TOK_INOUT { strcpy($$,$1); } ; /* R524 : access-stmt */ access-stmt: access-spec opt-access-id-list { if ((firstpass == 0) && (PublicDeclare == 1)) { if ($2) { removeglobfromlist(&($2)); pos_end = setposcur(); RemoveWordSET_0(fortran_out,pos_cur,pos_end-pos_cur); writelistpublic($2); } } PublicDeclare = 0; PrivateDeclare = 0; } line-break ; opt-access-id-list: {$$=(listname *)NULL;} | opt-TOK_FOURDOTS access-id-list {$$=$2;} ; access-id-list: access-id {$$=Insertname(NULL,$1,0);} | access-id-list ',' access-id {$$=Insertname($1,$3,0);} ; /* R525 : access-id */ access-id: TOK_NAME | generic-spec ; /* R534 : data-stmt */ data-stmt: TOK_DATA data-stmt-set opt-data-stmt-set-nlist { /* we should remove the data declaration */ pos_end = setposcur(); RemoveWordSET_0(fortran_out,pos_curdata,pos_end-pos_curdata); if ( aftercontainsdeclare == 1 && firstpass == 0 ) { ReWriteDataStatement_0(fortran_out); pos_end = setposcur(); } Init_List_Data_Var(); } line-break ; opt-data-stmt-set-nlist: | data-stmt-set-nlist ; data-stmt-set-nlist: opt-comma data-stmt-set | data-stmt-set-nlist opt-comma data-stmt-set ; /* R535 : data-stmt-set */ data-stmt-set: data-stmt-object-list TOK_SLASH data-stmt-value-list TOK_SLASH { if (firstpass == 1) { Add_Data_Var_Names_01(&List_Data_Var,$1,$3); } else Add_Data_Var_Names_01(&List_Data_Var_Cur,$1,$3); } ; data-stmt-object-list: data-stmt-object { $$=insertvar(NULL,$1); } | data-stmt-object-list ',' data-stmt-object { $$ = insertvar($1,$3); } ; data-stmt-value-list: data-stmt-value {$$=Insertname(NULL,$1,0);} | data-stmt-value-list ',' data-stmt-value {$$ = Insertname($1,$3,1); } ; /* R536 : data-stmt-object */ data-stmt-object: variable | data-implied-do ; /* R537 : data-implied-do */ data-implied-do: '(' data-i-do-object-list ',' data-i-do-variable '=' scalar-int-constant-expr ',' scalar-int-constant-expr ')' {printf("DOVARIABLE = %s %s %s\n",$4,$6,$8); printf("AUTRE = %s %s\n",$2->var->v_nomvar,$2->var->v_initialvalue_array); Insertdoloop($2->var,$4,$6,$8,""); $$=$2->var; } | '(' data-i-do-object-list ',' data-i-do-variable '=' scalar-int-constant-expr ',' scalar-int-constant-expr ',' scalar-int-constant-expr ')' { Insertdoloop($2->var,$4,$6,$8,$10); $$=$2->var; } ; data-i-do-object-list: data-i-do-object {$$=insertvar(NULL,$1);} | data-i-do-object-list ',' data-i-do-object {$$ = insertvar($1,$3);} ; /* R538 : data-i-do-object */ data-i-do-object: array-element | scalar-structure-component {$$->v_initialvalue_array=Insertname($$->v_initialvalue_array,my_dim.last,0); strcpy(my_dim.last,""); } | data-implied-do ; /* R539 : data-i-do-variable */ data-i-do-variable: do-variable ; /* R540 : data-stmt-value */ /* data-stmt-repeat and first data-stmt-constant inlined */ data-stmt-value: scalar-constant-subobject opt-data-stmt-star {sprintf($$,"%s%s",$1,$2);} | int-literal-constant opt-data-stmt-star {sprintf($$,"%s%s",$1,$2);} | char-literal-constant opt-data-stmt-star {sprintf($$,"%s%s",$1,$2);} | signed-int-literal-constant | signed-real-literal-constant | null-init | initial-data-target | structure-constructor ; opt-data-stmt-star: {strcpy($$,"");} | '*' data-stmt-constant {sprintf($$,"*%s",$2);} ; opt-data-stmt-repeat-star: | data-stmt-repeat '*' ; /* R541 : data-stmt-repeat */ /* scalar-int-constant inlined */ data-stmt-repeat: scalar-int-constant | scalar-int-constant-subobject ; /* R542 : data-stmt-constant */ data-stmt-constant: scalar-constant | scalar-constant-subobject | signed-int-literal-constant | signed-real-literal-constant | null-init | initial-data-target | structure-constructor ; scalar-int-constant-subobject: int-constant-subobject ; scalar-constant-subobject: constant-subobject ; /* R543 : int-constant-subobject */ int-constant-subobject: constant-subobject ; /* R544 : constant-subobject */ constant-subobject: designator {strcpy(my_dim.last,"");} ; /* R545 : dimension-stmt */ dimension-stmt: {positioninblock = 0; pos_curdimension = my_position_before;} TOK_DIMENSION opt-TOK_FOURDOTS array-name-spec-list { /* if the variable is a parameter we can suppose that is */ /* value is the same on each grid. It is not useless to */ /* create a copy of it on each grid */ if ( ! inside_type_declare ) { if ( firstpass ) { Add_Globliste_1($4); /* if variableparamlists has been declared in a subroutine */ if ( insubroutinedeclare ) Add_Dimension_Var_1($4); /* Add it to the List_SubroutineDeclaration_Var list if not present */ /* NB: if not done, a variable declared with DIMENSION but with no type given */ /* will not be declared by the conv */ ReWriteDeclarationAndAddTosubroutine_01($4); } else { pos_end = setposcur(); RemoveWordSET_0(fortran_out,pos_curdimension,pos_end-pos_curdimension); ReWriteDeclarationAndAddTosubroutine_01($4); } } PublicDeclare = 0; PrivateDeclare = 0; ExternalDeclare = 0; strcpy(NamePrecision,""); c_star = 0; InitialValueGiven = 0 ; strcpy(IntentSpec,""); VariableIsParameter = 0 ; Allocatabledeclare = 0 ; Targetdeclare = 0 ; SaveDeclare = 0; pointerdeclare = 0; contiguousdeclare = 0 ; optionaldeclare = 0 ; dimsgiven=0; c_selectorgiven=0; strcpy(nameinttypename,""); strcpy(c_selectorname,""); } line-break ; array-name-spec-list: TOK_NAME '(' {in_complex_literal = 0;} array-spec ')' { if ( inside_type_declare ) break; curvar = createvar($1,$4); CreateAndFillin_Curvar("", curvar); curlistvar=insertvar(NULL, curvar); $$ = settype("",curlistvar); strcpy(vallengspec,""); } | array-name-spec-list ',' TOK_NAME '(' {in_complex_literal = 0;} array-spec ')' { if ( inside_type_declare ) break; curvar = createvar($3,$6); CreateAndFillin_Curvar("", curvar); curlistvar = insertvar($1, curvar); $$ = curlistvar; strcpy(vallengspec,""); } ; /* R548 : parameter-stmt */ parameter-stmt: TOK_PARAMETER { VariableIsParameter = 1; pos_curparameter = setposcur()-9; } '(' named-constant-def-list ')' { if ( ! inside_type_declare ) { if ( firstpass ) { if ( insubroutinedeclare ) Add_Parameter_Var_1($4); else Add_GlobalParameter_Var_1($4); } else { pos_end = setposcur(); RemoveWordSET_0(fortran_out, pos_curparameter, pos_end-pos_curparameter); } } VariableIsParameter = 0 ; } line-break ; named-constant-def-list: named-constant-def {$$=insertvar(NULL,$1);} | named-constant-def-list ',' named-constant-def {$$=insertvar($1,$3);} ; /* R549 : named-constant-def */ named-constant-def: TOK_NAME '=' constant-expr { if ( inside_type_declare ) break; curvar=(variable *) calloc(1,sizeof(variable)); Init_Variable(curvar); curvar->v_VariableIsParameter = 1; strcpy(curvar->v_nomvar,$1); strcpy(curvar->v_subroutinename,subroutinename); strcpy(curvar->v_modulename,curmodulename); curvar->v_initialvalue=Insertname(curvar->v_initialvalue,$3,0); strcpy(curvar->v_commoninfile,cur_filename); Save_Length($3,14); $$ = curvar; } ; /* R553 : save-stmt */ save-stmt: {pos_cursave = my_position_before;} TOK_SAVE opt-TOK_FOURDOTS opt-saved-entity-list { pos_end = setposcur(); RemoveWordSET_0(fortran_out,pos_cursave,pos_end-pos_cursave); } line-break ; opt-TOK_FOURDOTS: | TOK_FOURDOTS ; opt-saved-entity-list: | saved-entity-list ; saved-entity-list: saved-entity | saved-entity-list ',' saved-entity ; /* R554 : saved-entity */ saved-entity: object-name {if ( ! inside_type_declare ) Add_Save_Var_1($1,(listdim*) NULL); } | proc-pointer-name | common-block-name ; /* R555 : proc-pointer-name */ proc-pointer-name: ident ; get_my_position: {my_position = my_position_before;} ; /* R560 : implicit-stmt */ implicit-stmt: get_my_position TOK_IMPLICIT implicit-spec-list line-break | get_my_position TOK_IMPLICIT TOK_NONE { if ( insubroutinedeclare == 1 ) { Add_ImplicitNoneSubroutine_1(); pos_end = setposcur(); RemoveWordSET_0(fortran_out,my_position,pos_end-my_position); } } line-break ; implicit-spec-list: implicit-spec | implicit-spec-list ',' implicit-spec ; /*R561 implicit-spec */ implicit-spec: declaration-type-spec '(' letter-spec-list ')' ; letter-spec-list:letter-spec | letter-spec-list ',' letter-spec ; /* R562 : letter-spec */ letter-spec: TOK_NAME | TOK_NAME '-' TOK_NAME ; /* R563 : namelist-stmt */ namelist-stmt: TOK_NAMELIST TOK_SLASH TOK_NAME TOK_SLASH namelist-group-object-list opt-namelist-other line-break ; opt-namelist-other: | opt-namelist-other opt-comma TOK_SLASH TOK_NAME TOK_SLASH namelist-group-object-list namelist-group-object-list:namelist-group-object | namelist-group-object-list ',' namelist-group-object ; /* R564 : namelist-group-object */ namelist-group-object: variable-name ; /* R565 : equivalence-stmt */ equivalence-stmt: TOK_EQUIVALENCE equivalence-set-list line-break ; equivalence-set-list:equivalence-set | equivalence-set-list ',' equivalence-set ; /* R566 : equivalence-set */ equivalence-set: '(' {in_complex_literal=0;} equivalence-object ',' equivalence-object-list ')' ; equivalence-object-list:equivalence-object | equivalence-object-list ',' equivalence-object ; /* R567 : equivalence-object */ equivalence-object: variable-name | array-element | substring ; /* R568 : common-stmt */ common-stmt: TOK_COMMON { positioninblock = 0; pos_curcommon = my_position_before; indeclaration=1;} opt-common-block-name common-block-object-list opt-common-block-list { indeclaration = 0; if ( inside_type_declare ) break; pos_end = setposcur(); RemoveWordSET_0(fortran_out,pos_curcommon,pos_end-pos_curcommon); } line-break ; opt-common-block-name: | common-block-name { if ( inside_type_declare ) break; sprintf(charusemodule,"%s",$1); Add_NameOfCommon_1($1,subroutinename); } ; common-block-name:TOK_DSLASH { strcpy($$,""); positioninblock=0; strcpy(commonblockname,""); } | TOK_SLASH TOK_NAME TOK_SLASH { strcpy($$,$2); positioninblock=0; strcpy(commonblockname,$2); } ; opt-comma: | ',' ; opt-common-block-list: | opt-common-block-list opt-comma common-block-name { if ( inside_type_declare ) break; sprintf(charusemodule,"%s",$3); Add_NameOfCommon_1($3,subroutinename); } common-block-object-list ; common-block-object-list: common-block-object {if ( ! inside_type_declare ) Add_Common_var_1(); } | common-block-object-list ',' common-block-object {if ( ! inside_type_declare ) Add_Common_var_1(); } ; /* R569 : common-block-object */ /* variable-name replaced by TOK_NAME */ /* because the corresponding variable do not have to be added to the listofsubroutine_used */ common-block-object: TOK_NAME { positioninblock = positioninblock + 1 ; strcpy(commonvar,$1); commondim = (listdim*) NULL; } | TOK_NAME '(' {in_complex_literal=0;} array-spec ')' { positioninblock = positioninblock + 1 ; strcpy(commonvar,$1); commondim = $4; } ; /* R601 : designator */ designator: array-element | array-section | structure-component | substring {$$=createvar($1,NULL);} ; /* R602 : variable */ /*variable: designator | expr ; */ scalar-variable: variable ; variable: designator {if (strcmp(my_dim.last,"")) { $$->v_initialvalue_array=Insertname(NULL,my_dim.last,0); } strcpy(my_dim.last,""); } ; scalar-variable-name: variable-name ; /* R603 : variable-name */ variable-name: ident ; scalar-logical-variable: logical-variable ; /* R604 : logical-variable */ logical-variable: variable ; /* R605 : char-variable */ char-variable: variable ; scalar-default-char-variable: default-char-variable ; /* R606 : default-char-variable */ default-char-variable: variable ; scalar-int-variable: int-variable ; int-variable: variable ; /* R608 : substring */ substring: data-ref | data-ref '(' substring-range ')' {sprintf($$,"%s(%s)",$1,$3);} | char-literal-constant '(' substring-range ')' {sprintf($$,"%s(%s)",$1,$3);} ; /* R609 : parent-string */ /* IS INLINED IN SUBSTRING (R608) */ /* parent-string: scalar-variable-name | array-element | scalar-structure-component | scalar-constant ; */ /* R610 : substring-range */ substring-range: opt-scalar-int-expr ':' opt-scalar-int-expr {sprintf($$,"%s:%s",$1,$3);} ; /* R611: data-ref */ data-ref: part-ref opt-part-ref {sprintf($$,"%s%s",$1->v_nomvar,$2);} ; opt-part-ref: {strcpy($$,"");} | opt-part-ref '%' part-ref {sprintf($$,"%s%%%s",$1,$3->v_nomvar);} ; /* R612 : part-ref */ part-ref:ident {$$=createvar($1,NULL);} | ident '(' {in_complex_literal=0;} section-subscript-list ')' {sprintf(ligne,"%s(%s)",$1,$4);$$=createvar($1,NULL);strcpy(my_dim.last,$4);} ; /* $$=createvar($1,insertdim(NULL,my_dim)); {strcpy(my_dim.first,"1");strcpy(my_dim.last,$4);$$=createvar($1,insertdim(NULL,my_dim));} } */ /*part-name: ident ; */ scalar-structure-component: structure-component ; /* R613 : structure-component */ structure-component: data-ref {strcpy(my_dim.last,"");} ; /* R617 : array-element */ array-element: data-ref {strcpy(my_dim.last,"");} ; /* R618 : array-section */ array-section: data-ref {strcpy(my_dim.last,"");} | data-ref '(' substring-range ')' {strcpy(my_dim.last,"");} ; /* section-subscript-list can be empty ... */ /* in contradiction with the grammar ... */ section-subscript-list: {strcpy($$,"");} | section-subscript {strcpy($$,$1);} | section-subscript-list ',' section-subscript {sprintf($$,"%s,%s",$1,$3);} ; opt-subscript: {strcpy($$,"");} | subscript ; /* R619 : subscript */ subscript: scalar-int-expr ; /* R620 : section-subscript */ /*section-subscript: subscript | subscript-triplet | vector-subscript ; */ /* USE OpenFortranParser rules */ section-subscript: expr section_subscript_ambiguous {sprintf($$,"%s%s",$1,$2);} | ':' {strcpy($$,":");} | ':' expr {sprintf($$,":%s",$2);} | ':' ':' expr {sprintf($$,": :%s",$3);} | ':' expr ':' expr {sprintf($$,":%s :%s",$2,$4);} | TOK_FOURDOTS expr {sprintf($$,"::%s",$2);} | vector-subscript | ident '=' expr {sprintf($$,"%s=%s",$1,$3);} | ident '=' '*' label {sprintf($$,"%s=*%s",$1,$4);} | '*' label {sprintf($$,"*%s",$2);} ; section_subscript_ambiguous: ':' {strcpy($$,":");} | ':' expr {sprintf($$,":%s",$2);} | ':' ':' expr {sprintf($$,": :%s",$3);} | ':' expr ':' expr {sprintf($$,":%s :%s",$2,$4);} | TOK_FOURDOTS expr {sprintf($$,"::%s",$2);} | {strcpy($$,"");} ; /* R621 : subscript-triplet */ subscript-triplet: opt-subscript ':' opt-subscript {sprintf($$,"%s:%s",$1,$3);} | opt-subscript ':' opt-subscript ':' stride {sprintf($$,"%s:%s:%s",$1,$3,$5);} ; /* R622 : stride */ stride: scalar-int-expr ; /* R623 : vector-subscript */ vector-subscript: int-expr ; /* R626 : allocate-stmt */ allocate-stmt: TOK_ALLOCATE '(' {in_complex_literal=0;} allocation-list opt-alloc-opt-list-comma ')' {inallocate = 0;} line-break ; opt-type-spec-fourdots: | type-spec TOK_FOURDOTS ; opt-alloc-opt-list-comma: | ',' alloc-opt-list ; alloc-opt-list: alloc-opt | alloc-opt-list ',' alloc-opt ; /* R627 : alloc-opt */ alloc-opt: TOK_ERRMSG errmsg-variable | TOK_STAT '=' stat-variable ; /* R628 : stat-variable */ stat-variable: scalar-int-variable ; /* R629 : errmsg-variable */ errmsg-variable: scalar-default-char-variable ; allocation-list: allocation | allocation-list ',' allocation ; /* R631 allocation */ allocation: allocate-object opt-allocate-shape-spec-list-par ; /* R632 allocate-object */ allocate-object: variable-name | structure-component ; opt-allocate-shape-spec-list-par: | '(' allocate-shape-spec-list ')' ; allocate-shape-spec-list: allocate-shape-spec | allocate-shape-spec-list ',' allocate-shape-spec ; /* R633 : allocate-shape-spec */ allocate-shape-spec: opt-lower-bound-expr upper-bound-expr ; opt-lower-bound-expr: | lower-bound-expr ':' ; /* R634 : lower-bound-expr */ lower-bound-expr: scalar-int-expr ; /* R634 : upper-bound-expr */ upper-bound-expr: scalar-int-expr ; /* R640 : deallocate-stmt */ deallocate-stmt: TOK_DEALLOCATE '(' {in_complex_literal=0;} allocate-object-list opt-dealloc-opt-list-comma ')' {inallocate = 0;} line-break ; allocate-object-list: allocate-object | allocate-object-list ',' allocate-object ; opt-dealloc-opt-list-comma: | ',' dealloc-opt-list ; dealloc-opt-list: dealloc-opt | dealloc-opt-list ',' dealloc-opt ; /* R641 : dealloc-opt */ dealloc-opt: TOK_ERRMSG errmsg-variable | TOK_STAT '=' stat-variable ; /* R701 : primary */ /* remove type-param-name */ /* constant replaced by literal-constant to avoid conflict with designato */ /* real-part is added because potential conflicts with complex-literal-constant */ primary: designator { strcpy($$,$1->v_nomvar); if (strcasecmp(my_dim.last,"")) { strcat($$,"("); strcat($$,my_dim.last); strcat($$,")"); } } | literal-constant | array-constructor | function-reference | '(' expr ')' { sprintf($$,"(%s)",$2);} ; /* R702 : level-1-expr */ level-1-expr: primary {strcpy(my_dim.last,"");} ; /* R704 : mult-operand */ mult-operand: level-1-expr | level-1-expr power-op mult-operand {sprintf($$,"%s**%s",$1,$3);} ; /* R705 : add-operand */ add-operand: mult-operand | add-operand mult-op mult-operand { sprintf($$,"%s%s%s",$1,$2,$3); } ; /* R706 : level-2-expr */ /* add signed-int-literal-constant because potential reduce conflict with add-op add-operand */ level-2-expr: add-operand | add-op add-operand { sprintf($$,"%s%s",$1,$2); } | level-2-expr add-op add-operand { sprintf($$,"%s%s%s",$1,$2,$3); } | signed-int-literal-constant | level-2-expr signed-int-literal-constant { sprintf($$,"%s%s",$1,$2); } ; /* R707 : power-op */ power-op : TOK_DASTER ; /* R708 : mult-op */ mult-op : '*' {strcpy($$,"*");} | TOK_SLASH ; /* R709 : add-op */ add-op : '+' {strcpy($$,"+");} | '-' {strcpy($$,"-");} ; /* R710 : level-3-expr */ level-3-expr: level-2-expr | level-3-expr concat-op level-2-expr { sprintf($$,"%s%s%s",$1,$2,$3); } ; /* R711 : concat-op */ concat-op : TOK_DSLASH ; /* R712 : level-4-expr */ level-4-expr: level-3-expr | level-3-expr rel-op level-3-expr { sprintf($$,"%s%s%s",$1,$2,$3); } ; /* R713 : rel-op */ rel-op : TOK_EQ | TOK_NE | TOK_LT | TOK_LE | TOK_GT | TOK_GE | TOK_EQUALEQUAL | TOK_SLASHEQUAL | '<' {strcpy($$,"<");} | TOK_INFEQUAL | '>' {strcpy($$,">");} | TOK_SUPEQUAL ; /* R714 : and-operand */ /* level-4-expr inlined as level-3-expr */ and-operand: level-4-expr | not-op level-4-expr { sprintf($$,"%s%s",$1,$2); } ; /* R715 : or-operand */ or-operand: and-operand | or-operand and-op and-operand { sprintf($$,"%s%s%s",$1,$2,$3); } ; /* R716 : equiv-operand */ equiv-operand : or-operand | equiv-operand or-op or-operand { sprintf($$,"%s%s%s",$1,$2,$3); } ; /* R717 : level-5-expr */ level-5-expr: equiv-operand | level-5-expr equiv-op equiv-operand { sprintf($$,"%s%s%s",$1,$2,$3); } ; /* R718 : not-op */ not-op: TOK_NOT ; /* R719 : and-op */ and-op: TOK_AND ; /* R720 : or-op */ or-op: TOK_OR ; /* R721 : equiv-op */ equiv-op: TOK_EQV | TOK_NEQV ; /* R722 : expr */ expr: level-5-expr ; scalar-default-char-expr: default-char-expr ; /* R725 : default-char-expr */ default-char-expr : expr ; /* R726 : int-expr */ int-expr: expr ; opt-scalar-int-expr: {strcpy($$,"");} | scalar-int-expr ; scalar-int-expr: int-expr ; /* R728 : specification-expr */ specification-expr: scalar-int-expr { strcpy($$,$1); } ; /* R729 : constant-expr */ constant-expr: expr {strcpy($$,$1);} ; scalar-default-char-constant-expr: default-char-constant-expr ; /* R730: default-char-constant-expr */ default-char-constant-expr: default-char-expr ; scalar-int-constant-expr: int-constant-expr ; /* R731 : int-constant-expr */ int-constant-expr: int-expr ; /* R732 : assignment-stmt */ /* cannot use opt-label due to conflicts ... */ assignment-stmt: variable '=' expr line-break | label variable '=' expr line-break ; /* R733 : pointer-assignment-stmt */ /* data-pointer-object and proc-pointer-object replaced by designator */ /*pointer-assignment-stmt: data-pointer-object opt-bounds-spec-list-par TOK_POINT_TO data-target line-break | data-pointer-object '(' bounds-remapping-list ')' TOK_POINT_TO data-target line-break | proc-pointer-object TOK_POINT_TO proc-target line-break ; */ pointer-assignment-stmt: designator opt-bounds-spec-list-par TOK_POINT_TO data-target line-break | designator '(' bounds-remapping-list ')' TOK_POINT_TO data-target line-break | designator TOK_POINT_TO proc-target line-break ; /* R734 : data-pointer-object */ data-pointer-object: variable-name | scalar-variable '%' TOK_NAME ; opt-bounds-spec-list-par: | '(' bounds-spec-list ')' ; bounds-spec-list: bounds-spec | bounds-spec-list ',' bounds-spec ; bounds-remapping-list: bounds-remapping | bounds-remapping-list ',' bounds-remapping ; /* R735 : bounds-spec */ bounds-spec: lower-bound-expr ':' ; /* R736 : bounds-remapping */ bounds-remapping: lower-bound-expr ':' upper-bound-expr ; /* R737 : data-target */ data-target: variable ; procedure-component-name: TOK_NAME ; /* R738 : proc-pointer-object */ proc-pointer-object: proc-pointer-name | proc-component-ref ; /* R739 : proc-component-ref */ proc-component-ref : scalar-variable '%' procedure-component-name ; /* R740 : proc-target */ proc-target: expr | procedure-component-name | proc-component-ref ; /* R741 : where-stmt */ where-stmt: TOK_WHERE '(' mask-expr ')' where-assignment-stmt ; /* R742 : where-construct */ where-construct: where-construct-stmt opt-where-body-construct opt-masked-elsewhere-construct opt-elsewhere-construct end-where-stmt ; opt-where-body-construct: | opt-where-body-construct where-body-construct ; opt-masked-elsewhere-construct : | opt-masked-elsewhere-construct masked-elsewhere-stmt opt-where-body-construct ; opt-elsewhere-construct: | opt-elsewhere-construct elsewhere-stmt opt-where-body-construct ; /* R743 : where-construct-stmt */ where-construct-stmt: TOK_WHERE '(' mask-expr ')' line-break ; /* R744 : where-body-construct */ where-body-construct: where-assignment-stmt | where-stmt | where-construct ; /* R745 : where-assignment-stmt */ where-assignment-stmt: assignment-stmt ; /* R746 : mask-expr */ mask-expr: expr ; /* R747 : masked-elsewhere-stmt */ masked-elsewhere-stmt: TOK_ELSEWHEREPAR mask-expr ')' line-break | TOK_ELSEWHEREPAR mask-expr ')' TOK_NAME line-break ; /* R748: elsewhere-stmt */ elsewhere-stmt: TOK_ELSEWHERE line-break | TOK_ELSEWHERE TOK_NAME line-break ; /* R749: end-where-stmt */ end-where-stmt: TOK_ENDWHERE line-break | TOK_ENDWHERE TOK_NAME line-break ; /* R752 : forall-header */ forall-header : ; /* R801 : block */ block: opt-execution-part-construct ; opt-execution-part-construct: | opt-execution-part-construct execution-part-construct ; /* R813 : do-construct */ do-construct: block-do-construct | nonblock-do-construct ; do-construct: block-do-construct ; /* R814 : block-do-construct */ block-do-construct: label-do-stmt do-block end-do | nonlabel-do-stmt do-block end-do ; /* R815 : do-stmt */ /*do-stmt: label-do-stmt | nonlabel-do-stmt ; */ /* R816 : label-do-stmt */ label-do-stmt: TOK_NAME ':' TOK_PLAINDO_LABEL line-break | TOK_PLAINDO_LABEL line-break | TOK_NAME ':' TOK_PLAINDO_LABEL loop-control line-break | TOK_PLAINDO_LABEL loop-control line-break ; label-do-stmt-djview: TOK_NAME ':' TOK_PLAINDO_LABEL_DJVIEW line-break | TOK_PLAINDO_LABEL_DJVIEW line-break | TOK_NAME ':' TOK_PLAINDO_LABEL_DJVIEW loop-control line-break | TOK_PLAINDO_LABEL_DJVIEW loop-control line-break ; /* R817 : nonlabel-do-stmt */ nonlabel-do-stmt: TOK_NAME ':' TOK_PLAINDO line-break | TOK_PLAINDO line-break | TOK_NAME ':' TOK_PLAINDO loop-control line-break | TOK_PLAINDO loop-control line-break ; /* R818 : loop-control */ loop-control: opt_comma do-variable '=' expr ',' expr | opt_comma do-variable '=' expr ',' expr ',' expr | opt_comma TOK_WHILE '(' expr ')' | opt_comma TOK_CONCURRENT forall-header ; /* R819 : do-variable */ do-variable: ident ; /* R820 : do-block */ do-block: block ; /* R821 : end-do */ /*end-do: end-do-stmt | do-term-action-stmt ; */ end-do: end-do-stmt | label-djview continue-stmt ; /* R822 : end-do-stmt */ end-do-stmt: opt-label-djview TOK_ENDDO line-break | opt-label-djview TOK_ENDDO TOK_NAME line-break ; /* R823 : nonblock-do-construct */ /* only outer-shared-do-construct is used */ /* nonblock-do-construct: outer-shared-do-construct ; */ nonblock-do-construct: action-term-do-construct | outer-shared-do-construct ; /* R824 : action-term-do-construct */ action-term-do-construct: label-do-stmt do-block do-term-action-stmt ; /* R825 : do-body */ do-body : | execution-part-construct do-body ; /* R826 : do-term-action-stmt */ do-term-action-stmt: label-djview do-term-action-stmt-special ; /* do-term-action-stmt-special */ do-term-action-stmt-special: allocate-stmt | assignment-stmt | call-stmt | close-stmt | deallocate-stmt | flush-stmt | goto-stmt | TOK_REWIND after_rewind | TOK_NULLIFY '(' pointer_name_list ')' | if-stmt | inquire-stmt | open-stmt | print-stmt | read-stmt | rewind-stmt | where-stmt | write-stmt ; /* R827 : outer-shared-do-construct */ /* do-body is same as do-block we extend the definition of outer-shared-do-construct a label-do-stmt statement must be followed by a label-do-stmt-djview statement */ outer-shared-do-construct : label-do-stmt do-block label-do-stmt-djview-do-block-list inner-shared-do-construct | label-do-stmt do-block inner-shared-do-construct ; label-do-stmt-djview-do-block-list: label-do-stmt-djview do-block | label-do-stmt-djview-do-block-list label-do-stmt-djview do-block ; /* R828 : shared-term-do-construct */ shared-term-do-construct: outer-shared-do-construct | inner-shared-do-construct ; /* R829 : inner-shared-do-construct */ /* do-body is same as do-block */ inner-shared-do-construct: label-do-stmt-djview do-block do-term-shared-stmt ; /* R830 : do-term-shared-stmt */ do-term-shared-stmt: label-djview action-stmt ; opt-do-construct-name: | TOK_NAME ; /* R831 : cycle-stmt */ cycle-stmt: TOK_CYCLE opt-do-construct-name line-break ; /* R832 : if-construct */ if-construct: if-then-stmt block opt-else-if-stmt-block opt-else-stmt-block end-if-stmt ; opt-else-if-stmt-block: | else-if-stmt-block | opt-else-if-stmt-block else-if-stmt-block ; else-if-stmt-block: else-if-stmt block ; opt-else-stmt-block: | else-stmt-block | opt-else-stmt-block else-if-stmt-block ; else-stmt-block: else-stmt block ; /* R833 : if-then-stmt */ if-then-stmt: TOK_NAME ':' TOK_LOGICALIF_PAR expr ')' TOK_THEN line-break | label TOK_NAME ':' TOK_LOGICALIF_PAR expr ')' TOK_THEN line-break | opt-label TOK_LOGICALIF_PAR expr ')' TOK_THEN line-break ; /* R834 : else-if-stmt */ else-if-stmt:TOK_ELSEIF '(' expr ')' TOK_THEN line-break | TOK_ELSEIF '(' expr ')' TOK_THEN TOK_NAME line-break ; /* R835 : else-stmt */ else-stmt:TOK_ELSE line-break | TOK_ELSE TOK_NAME line-break ; /* R836 : end-if-stmt */ end-if-stmt:TOK_ENDIF line-break | TOK_ENDIF TOK_NAME line-break ; /* R837 : if-stmt */ if-stmt: opt-label TOK_LOGICALIF_PAR expr ')' action-stmt ; /* R838 : case-construct */ case-construct: select-case-stmt opt_case-stmt-block end-select-stmt ; opt_case-stmt-block: | case-stmt-block | opt_case-stmt-block case-stmt-block ; case-stmt-block: case-stmt block ; /* R839 : select-case-stmt */ select-case-stmt :TOK_NAME ':' TOK_SELECTCASE '(' expr ')' {in_select_case_stmt++;} line-break | TOK_SELECTCASE '(' expr ')' {in_select_case_stmt++;} line-break ; /* R840 : case-stmt */ case-stmt:TOK_CASE case-selector line-break | TOK_CASE case-selector TOK_NAME line-break ; /* R840 : end-select-stmt */ end-select-stmt: TOK_ENDSELECT {in_select_case_stmt--;} line-break | TOK_ENDSELECT TOK_NAME {in_select_case_stmt--;} line-break ; /* R843 : case-selector */ case-selector: '(' {in_complex_literal=0;} case-value-range-list ')' | TOK_DEFAULT ; case-value-range-list: case-value-range | case-value-range-list ',' case-value-range ; /* R844: case-value-range */ case-value-range : case-value | case-value ':' | ':' case-value | case-value ':' case-value ; /* R845 : case-value */ case-value: expr ; /* R850 : exit-stmt */ exit-stmt: TOK_EXIT line-break | TOK_EXIT TOK_NAME line-break ; /* R851 : goto-stmt */ goto-stmt: TOK_PLAINGOTO label line-break ; /* R853 arithmetic-if-stmt */ arithmetic-if-stmt: opt-label TOK_LOGICALIF_PAR expr ')' label ',' label ',' label line-break ; /* R854 : continue-stmt */ continue-stmt: opt-label TOK_CONTINUE line-break ; /* R855 : stop-stmt */ stop-stmt: TOK_STOP line-break | TOK_STOP stop-code line-break ; /* R857 : stop-code */ stop-code: scalar-default-char-constant-expr | scalar-int-constant-expr ; /* R901 : io-unit */ io-unit : file-unit-number | '*' | internal-file-variable ; /* R902 : file-unit-number */ file-unit-number : scalar-int-expr ; /* R902 : internal-file-variable */ internal-file-variable : char-variable ; /* R904 : open-stmt */ open-stmt: TOK_OPEN '(' {close_or_connect = 1;} connect-spec-list ')' {close_or_connect = 0;} line-break ; connect-spec-list: connect-spec | connect-spec-list ',' connect-spec ; /* R905 : connect-spec */ connect-spec: file-unit-number | TOK_UNIT file-unit-number | TOK_ACCESS scalar-default-char-expr | TOK_ACTION scalar-default-char-expr | TOK_ERR label | TOK_FILE file-name-expr | TOK_FORM scalar-default-char-expr | TOK_IOMSG iomsg-variable | TOK_IOSTAT scalar-int-variable | TOK_POSITION scalar-default-char-expr | TOK_RECL scalar-int-expr | TOK_STATUS '=' scalar-default-char-expr ; /* R906 : file-name-expr */ file-name-expr: scalar-default-char-expr ; /* R907 : iomsg-variable */ iomsg-variable: scalar-default-char-variable ; /* R908 : close-stmt */ close-stmt: opt-label TOK_CLOSE '(' {close_or_connect = 1;} close-spec-list ')' line-break {close_or_connect = 0;} ; close-spec-list: close-spec | close-spec-list ',' close-spec ; /* R909 : close-spec */ close-spec: file-unit-number | TOK_UNIT file-unit-number | TOK_IOMSG iomsg-variable | TOK_IOSTAT scalar-int-variable | TOK_ERR label | TOK_STATUS '=' scalar-default-char-expr ; /* R910 : read-stmt */ read-stmt: opt-label TOK_READ_PAR io-control-spec-list ')' { in_io_control_spec = 0; } line-break | opt-label TOK_READ_PAR io-control-spec-list ')' input-item-list { in_io_control_spec = 0; } line-break | opt-label TOK_READ format line-break | opt-label TOK_READ format ',' input-item-list line-break ; /* R911 : write-stmt */ write-stmt: opt-label TOK_WRITE_PAR io-control-spec-list ')' { in_io_control_spec = 0; } line-break | opt-label TOK_WRITE_PAR io-control-spec-list ')' output-item-list { in_io_control_spec = 0; } line-break ; /* R912 : print-stmt */ print-stmt: opt-label TOK_PRINT format line-break | opt-label TOK_PRINT format ',' output-item-list line-break ; io-control-spec-list: io-control-spec | io-control-spec-list ',' io-control-spec ; namelist-group-name: TOK_NAME ; /* R913 : io-control-spec */ io-control-spec: io-unit | TOK_UNIT io-unit | format | namelist-group-name | TOK_NML namelist-group-name | TOK_FMT format | TOK_END label | TOK_EOR label | TOK_ERR label | TOK_IOMSG iomsg-variable | TOK_IOSTAT scalar-int-variable | TOK_REC '=' scalar-int-expr ; /* R915 : format */ format: default-char-expr | label | '*' ; input-item-list: input-item | input-item-list ',' input-item ; /* R916 : input-item */ input-item: variable | io-implied-do ; output-item-list: output-item | output-item-list ',' output-item ; /* R917 : output-item */ output-item: expr | io-implied-do ; /* R918 : io-implied-do */ io-implied-do : '(' io-implied-do-object-list ',' io-implied-do-control ')' ; io-implied-do-object-list: io-implied-do-object | io-implied-do-object-list ',' io-implied-do-object ; /* R919 : io-implied-do-object */ /* input-item removed since possible conflicts (output-item can be variable) */ /* io-implied-do-object : input-item | output-item ; */ io-implied-do-object : output-item ; /* R920 : io-implied-do-control */ io-implied-do-control: do-variable '=' scalar-int-expr ',' scalar-int-expr | do-variable '=' scalar-int-expr ',' scalar-int-expr ',' scalar-int-expr ; /* R926 : rewind-stmt */ rewind-stmt: TOK_REWIND file-unit-number line-break | TOK_REWIND '(' position-spec-list ')' line-break ; position-spec-list: position-spec | position-spec-list ',' position-spec ; /* R927 : position-spec */ position-spec: file-unit-number | TOK_UNIT file-unit-number | TOK_IOMSG iomsg-variable | TOK_IOSTAT scalar-int-variable | TOK_ERR label ; /* R928 : flush-stmt */ flush-stmt: TOK_FLUSH file-unit-number line-break | TOK_FLUSH '(' flush-spec-list ')' line-break ; flush-spec-list: flush-spec | flush-spec-list ',' flush-spec ; /* R929 : flush-spec */ flush-spec: file-unit-number | TOK_UNIT file-unit-number | TOK_IOSTAT scalar-int-variable | TOK_IOMSG iomsg-variable | TOK_ERR label ; /* R930 : inquire-stmt */ inquire-stmt: TOK_INQUIRE set_in_inquire '(' inquire-spec-list ')' {in_inquire=0;} line-break | TOK_INQUIRE set_in_inquire '(' TOK_IOLENGTH scalar-int-variable ')' output-item-list {in_inquire=0;} line-break ; set_in_inquire: {in_inquire=1;} ; inquire-spec-list: inquire-spec | inquire-spec-list ',' inquire-spec ; /* R931 : inquire-spec */ inquire-spec: file-unit-number | TOK_UNIT file-unit-number | TOK_FILE file-name-expr | TOK_ACCESS scalar-default-char-variable | TOK_ACTION scalar-default-char-variable | TOK_ERR label | TOK_EXIST scalar-logical-variable | TOK_IOMSG iomsg-variable | TOK_IOSTAT scalar-int-variable | TOK_NAME_EQ '=' scalar-default-char-variable | TOK_OPENED scalar-logical-variable | TOK_RECL scalar-int-variable ; /* R1001 : format-stmt */ format-stmt: TOK_LABEL_FORMAT line-break ; /* R1104 : module */ module:module-stmt opt-specification-part opt-module-subprogram-part {pos_endsubroutine=setposcur();} end-module-stmt ; opt-module-subprogram-part: | module-subprogram-part ; /* R1105 : module-stmt */ module-stmt : TOK_MODULE TOK_NAME { GlobalDeclaration = 0; strcpy(curmodulename,$2); strcpy(subroutinename,""); Add_NameOfModule_1($2); if ( inmoduledeclare == 0 ) { /* To know if there are in the module declaration */ inmoduledeclare = 1; /* to know if a module has been met */ inmodulemeet = 1; /* to know if we are after the keyword contains */ aftercontainsdeclare = 0 ; } } line-break ; /* R1106 : end-module-stmt */ end-module-stmt: get_my_position TOK_ENDUNIT opt-tok-module opt-ident { /* if we never meet the contains keyword */ if ( firstpass == 0 ) { RemoveWordCUR_0(fortran_out, setposcur()-my_position); // Remove word "end module" if ( inmoduledeclare && ! aftercontainsdeclare ) { Write_Closing_Module(1); } fprintf(fortran_out,"\n end module %s\n", curmodulename); if ( module_declar && insubroutinedeclare == 0 ) { fclose(module_declar); } } inmoduledeclare = 0 ; inmodulemeet = 0 ; aftercontainsdeclare = 1; strcpy(curmodulename, ""); GlobalDeclaration = 0 ; } line-break ; opt-tok-module: | TOK_MODULE ; opt-ident: | TOK_NAME ; /* R1107 : module-subprogram-part */ module-subprogram-part:contains-stmt opt-module-subprogram-list ; opt-module-subprogram-list: | module-subprogram-list ; module-subprogram-list: module-subprogram | module-subprogram-list module-subprogram ; module-subprogram: function-subprogram | subroutine-subprogram ; use-stmt-list:use-stmt | use-stmt-list use-stmt ; save_olduse: {if (firstpass == 0 && oldfortran_out) pos_curuseold = setposcurname(oldfortran_out);} ; /* R1109 use-stmt */ use-stmt: get_my_position TOK_USE save_olduse opt-module-nature-2points TOK_NAME opt-rename-list { if ( firstpass ) { if ( insubroutinedeclare ) { if ($6) { Add_CouplePointed_Var_1($5,$6); coupletmp = $6; strcpy(ligne,""); while ( coupletmp ) { strcat(ligne, coupletmp->c_namevar); strcat(ligne, " => "); strcat(ligne, coupletmp->c_namepointedvar); coupletmp = coupletmp->suiv; if ( coupletmp ) strcat(ligne,","); } } sprintf(charusemodule,"%s",$5); } Add_NameOfModuleUsed_1($5); } else { if ( insubroutinedeclare ) { copyuse_0($5); } if ( inmoduledeclare == 0 ) { pos_end = setposcur(); RemoveWordSET_0(fortran_out,my_position,pos_end-my_position); } } } line-break | get_my_position TOK_USE save_olduse opt-module-nature-2points TOK_NAME ',' TOK_ONLY ':' opt-only-list { if ( firstpass ) { if ( insubroutinedeclare ) { if ($9) { Add_CouplePointed_Var_1($5,$9); coupletmp = $9; strcpy(ligne,""); while ( coupletmp ) { strcat(ligne,coupletmp->c_namevar); if ( strcasecmp(coupletmp->c_namepointedvar,"") ) strcat(ligne," => "); strcat(ligne,coupletmp->c_namepointedvar); coupletmp = coupletmp->suiv; if ( coupletmp ) strcat(ligne,","); } } sprintf(charusemodule,"%s",$5); } Add_NameOfModuleUsed_1($5); } else { if ( insubroutinedeclare ) copyuseonly_0($5); if ( inmoduledeclare == 0 ) { pos_end = setposcur(); RemoveWordSET_0(fortran_out,my_position,pos_end-my_position); if ($9) { if (oldfortran_out) variableisglobalinmodule($9,$5,oldfortran_out,pos_curuseold); } } else { if ($9) { /* if we are in the module declare and if the */ /* onlylist is a list of global variable */ variableisglobalinmodule($9, $5, fortran_out,my_position); } } } } line-break ; opt-module-nature-2points: | TOK_FOURDOTS | ',' module-nature TOK_FOURDOTS ; opt-only-list: {$$=NULL;} | only-list {$$=$1;} ; /* R1101 : main-program */ main-program: program-stmt opt-specification-part opt-execution-part opt-internal-subprogram-part end-program-stmt ; opt-specification-part: | specification-part ; opt-execution-part: | execution-part ; /* R1102 : program-stmt */ program-stmt: TOK_PROGRAM TOK_NAME { strcpy(subroutinename,$2); insubroutinedeclare = 1; inprogramdeclare = 1; /* in the second step we should write the head of */ /* the subroutine sub_loop_ */ if ( ! firstpass ) WriteBeginof_SubLoop(); } line-break ; /* R1103 : end-program-stmt */ end-program-stmt: {pos_endsubroutine=my_position_before;} TOK_ENDUNIT opt-tok-program opt-tok-name { insubroutinedeclare = 0; inprogramdeclare = 0; pos_cur = setposcur(); closeandcallsubloopandincludeit_0(3); functiondeclarationisdone = 0; strcpy(subroutinename,""); } line-break ; opt-tok-program: | TOK_PROGRAM ; opt-tok-name: | TOK_NAME ; /* R1110 : module-nature */ module-nature: TOK_INTRINSIC ; opt-rename-list: { $$=NULL; } | ',' rename-list { $$=$2; } ; rename-list: rename { $$=$1; } | rename-list ',' rename { /* insert the variable in the list $1 */ $3->suiv = $1; $$=$3; } ; /* R1111: rename */ rename: TOK_NAME TOK_POINT_TO TOK_NAME { coupletmp = (listcouple *) calloc(1,sizeof(listcouple)); strcpy(coupletmp->c_namevar,$1); strcpy(coupletmp->c_namepointedvar,$3); coupletmp->suiv = NULL; $$ = coupletmp; } ; only-list:only {$$=$1;} | only-list ',' only { /* insert the variable in the list $1 */ $3->suiv = $1; $$ = $3; } ; /* R1112: only */ only:generic-spec { coupletmp = (listcouple *)calloc(1,sizeof(listcouple)); strcpy(coupletmp->c_namevar,$1); strcpy(coupletmp->c_namepointedvar,""); coupletmp->suiv = NULL; $$ = coupletmp; } | only-use-name { coupletmp = (listcouple *)calloc(1,sizeof(listcouple)); strcpy(coupletmp->c_namevar,$1); strcpy(coupletmp->c_namepointedvar,""); coupletmp->suiv = NULL; $$ = coupletmp; } | rename { $$=$1; pointedvar = 1; Add_UsedInSubroutine_Var_1($1->c_namevar); } ; /* R1113 : only-use-name */ only-use-name: TOK_NAME ; /* R1207: generic-spec */ generic-spec: TOK_NAME ; /* R1210 : external-stmt */ external-stmt: TOK_EXTERNAL external-name-list line-break | TOK_EXTERNAL TOK_FOURDOTS external-name-list line-break ; external-name-list: external-name | external-name-list ',' external-name ; external-name: TOK_NAME ; /* R1218 : intrinsic-stmt */ intrinsic-stmt: TOK_INTRINSIC opt-TOK_FOURDOTS intrinsic-procedure-name-list line-break ; intrinsic-procedure-name-list: intrinsic-procedure-name | intrinsic-procedure-name-list ',' intrinsic-procedure-name ; intrinsic-procedure-name: TOK_NAME ; /* R1219 : function-reference */ function-reference: procedure-designator '(' ')' | procedure-designator '(' {in_complex_literal=0;} actual-arg-spec-list ')' {sprintf($$,"%s(%s)",$[procedure-designator],$[actual-arg-spec-list]);} ; /* R1220 : */ call-stmt: before-call-stmt { inagrifcallargument = 0 ; incalldeclare=0; if ( oldfortran_out && (callagrifinitgrids == 1) && (firstpass == 0) ) { pos_end = setposcur(); RemoveWordSET_0(fortran_out,pos_curcall,pos_end-pos_curcall); strcpy(subofagrifinitgrids,subroutinename); } Instanciation_0(sameagrifname); } line-break | before-call-stmt '(' ')' { inagrifcallargument = 0 ; incalldeclare=0; if ( oldfortran_out && (callagrifinitgrids == 1) && (firstpass == 0) ) { pos_end = setposcur(); RemoveWordSET_0(fortran_out,pos_curcall,pos_end-pos_curcall); strcpy(subofagrifinitgrids,subroutinename); } Instanciation_0(sameagrifname); } line-break | before-call-stmt '(' {in_complex_literal=0;} actual-arg-spec-list ')' { inagrifcallargument = 0 ; incalldeclare=0; if ( oldfortran_out && (callagrifinitgrids == 1) && (firstpass == 0) ) { pos_end = setposcur(); RemoveWordSET_0(fortran_out,pos_curcall,pos_end-pos_curcall); strcpy(subofagrifinitgrids,subroutinename); } Instanciation_0(sameagrifname); } line-break ; before-call-stmt: opt-label TOK_CALL {pos_curcall=my_position_before-strlen($[opt-label])-4;} procedure-designator { if (!strcasecmp($[procedure-designator],"MPI_Init") ) callmpiinit = 1; else callmpiinit = 0; if (!strcasecmp($[procedure-designator],"Agrif_Init_Grids") ) { callagrifinitgrids = 1; strcpy(meetagrifinitgrids,subroutinename); } else { callagrifinitgrids = 0; } if ( Vartonumber($[procedure-designator]) == 1 ) { incalldeclare = 0; inagrifcallargument = 0 ; Add_SubroutineWhereAgrifUsed_1(subroutinename, curmodulename); } } ; /* R1221 : procedure-designator */ procedure-designator: ident | TOK_FLUSH | TOK_REAL ; actual-arg-spec-list: actual-arg-spec | actual-arg-spec-list ',' actual-arg-spec {sprintf($$,"%s,%s",$1,$[actual-arg-spec]);} ; /* R1222 : actual-arg-spec */ actual-arg-spec: actual-arg { if ( callmpiinit == 1 ) { strcpy(mpiinitvar,$1); if ( firstpass == 1 ) Add_UsedInSubroutine_Var_1 (mpiinitvar); } } | keyword '=' actual-arg {sprintf($$,"%s = %s",$1,$3); if ( callmpiinit == 1 ) { strcpy(mpiinitvar,$3); if ( firstpass == 1 ) Add_UsedInSubroutine_Var_1 (mpiinitvar); } } ; /* R1223 : actual-arg */ actual-arg: expr | variable { strcpy($$,$1->v_nomvar); if ($1->v_initialvalue_array) { strcat($$,"("); strcat($$,$1->v_initialvalue_array->n_name); strcat($$,")"); } } | ident ; opt-prefix: {isrecursive = 0;} | prefix ; /* R1225 : prefix */ prefix: prefix-spec | prefix prefix-spec ; /* R1226 prefix-spec */ prefix-spec: declaration-type-spec {isrecursive = 0; functiondeclarationisdone = 1;} | TOK_MODULE {isrecursive = 0;} | TOK_RECURSIVE {isrecursive = 1;} ; /*R1227 : function-subprogram */ function-subprogram: function-stmt opt-specification-part opt-execution-part opt-internal-subprogram-part end-function-stmt ; /* R1228 : function-stmt */ function-stmt: opt-prefix TOK_FUNCTION function-name '(' {in_complex_literal=0;} opt-dummy-arg-list ')' opt-suffix { insubroutinedeclare = 1; suborfun = 0; /* we should to list of the subroutine argument the */ /* name of the function which has to be defined */ if ( firstpass ) { Add_SubroutineArgument_Var_1($[opt-dummy-arg-list]); if ( ! is_result_present ) Add_FunctionType_Var_1($[function-name]); } else /* in the second step we should write the head of */ /* the subroutine sub_loop_ */ { if (todebug == 1) fprintf(fortran_out," !DEBUG: Avant Writebeginof subloop\n"); WriteBeginof_SubLoop(); if (todebug == 1) fprintf(fortran_out," !DEBUG: Apres Writebeginof subloop\n"); } strcpy(NamePrecision,""); } line-break ; function-name: TOK_NAME { if (strcmp(subroutinename,"")) { strcpy(old_subroutinename,subroutinename); // can occur in internal-subprogram old_oldfortran_out=oldfortran_out; } else { old_oldfortran_out=(FILE *)NULL; } strcpy($$,$1);strcpy(subroutinename,$1); } ; opt-dummy-arg-name-list: | dummy-arg-name-list ; dummy-arg-name-list: dummy-arg-name | dummy-arg-name-list ',' dummy-arg-name ; /* R1230 : dummy-arg-name */ dummy-arg-name: TOK_NAME {strcpy($$,$1);} ; opt-suffix: {is_result_present = 0; } | suffix ; /* R1231 : suffix */ suffix: TOK_RESULT '(' TOK_NAME ')' {is_result_present = 1; if ( firstpass == 1 ) { strcpy(nameinttypenameback,nameinttypename); strcpy(nameinttypename,""); curvar = createvar($3,NULL); strcpy(nameinttypename,nameinttypenameback); strcpy(curvar->v_typevar,""); curlistvar = insertvar(NULL,curvar); Add_SubroutineArgument_Var_1(curlistvar); } } ; /* R1232 : end-function-stmt */ end-function-stmt: get_my_position TOK_ENDUNIT opt-tok-function opt-ident close_subroutine {strcpy(DeclType, "");} line-break ; opt-tok-function: | TOK_FUNCTION ; /*R1233 : subroutine-subprogram */ subroutine-subprogram: subroutine-stmt opt-specification-part opt-execution-part opt-internal-subprogram-part end-subroutine-stmt ; /* R1234 : subroutine-stmt */ subroutine-stmt: opt-prefix TOK_SUBROUTINE subroutine-name opt-dummy-arg-list-par { insubroutinedeclare = 1; suborfun = 1; if ( firstpass ) Add_SubroutineArgument_Var_1($4); else { WriteBeginof_SubLoop(); } } line-break ; subroutine-name: TOK_NAME { if (strcmp(subroutinename,"")) { strcpy(old_subroutinename,subroutinename); // can occur in internal-subprogram old_oldfortran_out=oldfortran_out; } else { old_oldfortran_out=(FILE *)NULL; } strcpy($$,$1);strcpy(subroutinename,$1); } ; /* R1236 : end-subroutine-stmt */ end-subroutine-stmt: get_my_position TOK_ENDUNIT opt-tok-subroutine opt-ident close_subroutine line-break ; close_subroutine: {pos_endsubroutine = my_position; GlobalDeclaration = 0 ; if ( firstpass == 0 && strcasecmp(subroutinename,"") ) { if ( module_declar && insubroutinedeclare == 0 ) fclose(module_declar); } if ( strcasecmp(subroutinename,"") ) { if ( inmodulemeet == 1 ) { /* we are in a module */ if ( insubroutinedeclare == 1 ) { /* it is like an end subroutine */ insubroutinedeclare = 0 ; pos_cur = setposcur(); closeandcallsubloopandincludeit_0(suborfun); functiondeclarationisdone = 0; } else { /* it is like an end module */ inmoduledeclare = 0 ; inmodulemeet = 0 ; } } else { insubroutinedeclare = 0; pos_cur = setposcur(); closeandcallsubloopandincludeit_0(2); functiondeclarationisdone = 0; } } strcpy(subroutinename,""); if (strcmp(old_subroutinename,"")) { strcpy(subroutinename,old_subroutinename); strcpy(old_subroutinename,""); oldfortran_out=old_oldfortran_out; insubroutinedeclare=1; } } ; opt-tok-subroutine: | TOK_SUBROUTINE ; opt-dummy-arg-list-par: {if (firstpass) $$=NULL;} | '(' {in_complex_literal=0;} opt-dummy-arg-list ')' {if (firstpass) $$=$3;} ; opt-dummy-arg-list: {if (firstpass) $$=NULL;} | dummy-arg-list {if (firstpass) $$=$1;} ; dummy-arg-list: dummy-arg { if ( firstpass == 1 ) { strcpy(nameinttypenameback,nameinttypename); strcpy(nameinttypename,""); curvar = createvar($1,NULL); strcpy(nameinttypename,nameinttypenameback); curlistvar = insertvar(NULL,curvar); $$ = settype("",curlistvar); } } | dummy-arg-list ',' dummy-arg { if ( firstpass == 1 ) { strcpy(nameinttypenameback,nameinttypename); strcpy(nameinttypename,""); curvar = createvar($3,NULL); strcpy(nameinttypename,nameinttypenameback); $$ = insertvar($1,curvar); } } ; /* R1235: dummy-arg */ dummy-arg: dummy-arg-name {strcpy($$,$1);} | '*' {strcpy($$,"*");} ; /* R1241 : return-stmt */ return-stmt : opt-label TOK_RETURN line-break | opt-label TOK_RETURN scalar-int-expr line-break ; /* R1242 : contains-stmt */ contains-stmt: opt-label TOK_CONTAINS { if ( inside_type_declare ) break; if ( inmoduledeclare ) { if ( firstpass == 0 ) { RemoveWordCUR_0(fortran_out,9); // Remove word 'contains' Write_Closing_Module(0); } inmoduledeclare = 0 ; aftercontainsdeclare = 1; } else if ( insubroutinedeclare ) { incontainssubroutine = 1; insubroutinedeclare = 0; incontainssubroutine = 0; functiondeclarationisdone = 0; if ( firstpass ) List_ContainsSubroutine = Addtolistnom(subroutinename, List_ContainsSubroutine, 0); else closeandcallsubloop_contains_0(); strcpy(subroutinename, ""); } else printf("l.%4d -- TOK_CONTAINS -- MHCHECK\n",line_num_input); } line-break ; /* R1243 : stmt-function-stmt */ stmt-function-stmt: TOK_NAME '(' opt-dummy-arg-name-list ')' '=' expr line-break ; opt_name : '\n' {strcpy($$,"");} | TOK_NAME {strcpy($$,$1);} ; before_dims : { created_dimensionlist = 0; } ; ident_dims : ident before_dims dims dims { created_dimensionlist = 1; if ( ($3 == NULL) || ($4 == NULL) ) break; if ( agrif_parentcall == 1 ) { ModifyTheAgrifFunction_0($3->dim.last); agrif_parentcall = 0; fprintf(fortran_out," = "); } } | ident_dims '%' declare_after_percent ident before_dims dims dims { created_dimensionlist = 1; } ; int_list : TOK_CSTINT | int_list ',' TOK_CSTINT ; after_ident_dims : '=' expr | TOK_POINT_TO expr ; call : keywordcall opt_call { inagrifcallargument = 0 ; incalldeclare=0; if ( oldfortran_out && (callagrifinitgrids == 1) && (firstpass == 0) ) { pos_end = setposcur(); RemoveWordSET_0(fortran_out,pos_curcall,pos_end-pos_curcall); strcpy(subofagrifinitgrids,subroutinename); } Instanciation_0(sameagrifname); } ; opt_call : | '(' opt_callarglist ')' ; opt_callarglist : | callarglist ; keywordcall: before_call TOK_FLUSH | before_call TOK_NAME { if (!strcasecmp($2,"MPI_Init") ) callmpiinit = 1; else callmpiinit = 0; if (!strcasecmp($2,"Agrif_Init_Grids") ) { callagrifinitgrids = 1; strcpy(meetagrifinitgrids,subroutinename); } else { callagrifinitgrids = 0; } if ( Vartonumber($2) == 1 ) { incalldeclare = 1; inagrifcallargument = 1 ; Add_SubroutineWhereAgrifUsed_1(subroutinename, curmodulename); } } ; before_call : TOK_CALL { pos_curcall=setposcur()-4; } | label TOK_CALL { pos_curcall=setposcur()-4; } ; callarglist : callarg | callarglist ',' callarg ; callarg : expr { if ( callmpiinit == 1 ) { strcpy(mpiinitvar,$1); if ( firstpass == 1 ) Add_UsedInSubroutine_Var_1 (mpiinitvar); } } | '*' TOK_CSTINT ; stop : TOK_PAUSE | TOK_STOP ; option_io_1 : infmt ',' inlist | infmt option_io_2 : ioctl outlist | ioctl ioctl : '(' ctllist ')' ; after_rewind : '(' ident ')' | '(' TOK_CSTINT ')' | TOK_CSTINT | '(' uexpr ')' | TOK_NAME ; ctllist : ioclause | ctllist ',' ioclause ; ioclause : fexpr | '*' | TOK_DASTER | ident expr dims | ident expr '%' declare_after_percent ident_dims | ident '(' triplet ')' | ident '*' | ident TOK_DASTER ; declare_after_percent: { afterpercent = 1; } ; iofctl : TOK_FLUSH ; infmt : unpar_fexpr | '*' ; write_or_inq : TOK_WRITE ; fexpr : unpar_fexpr | '(' fexpr ')' ; unpar_fexpr : lhs | simple_const | fexpr addop fexpr %prec '+' | fexpr '*' fexpr | fexpr TOK_SLASH fexpr | fexpr TOK_DASTER fexpr | addop fexpr %prec '*' | fexpr TOK_DSLASH fexpr | TOK_FILE expr | TOK_UNIT expr | TOK_NML expr | TOK_FMT expr | TOK_EXIST expr | TOK_ERR expr | TOK_END expr | TOK_NAME '=' expr | predefinedfunction ; addop : '+' | '-' ; inlist : inelt | inlist ',' inelt ; // opt_lhs : // | lhs // ; inelt : //opt_lhs opt_operation lhs opt_operation | '(' inlist ')' opt_operation | predefinedfunction opt_operation | simple_const opt_operation | '(' inlist ',' dospec ')' ; opt_operation : | operation | opt_operation operation ; outlist : complex_const { strcpy($$,$1); } | predefinedfunction { strcpy($$,$1); } | uexpr { strcpy($$,$1); } | other { strcpy($$,$1); } | uexpr ',' expr { sprintf($$,"%s,%s",$1,$3); } | uexpr ',' other { sprintf($$,"%s,%s",$1,$3); } | other ',' expr { sprintf($$,"%s,%s",$1,$3); } | other ',' other { sprintf($$,"%s,%s",$1,$3); } | outlist ',' expr { sprintf($$,"%s,%s",$1,$3); } | outlist ',' other { sprintf($$,"%s,%s",$1,$3); } ; other : '(' uexpr ',' dospec ')' { sprintf($$,"(%s,%s)",$2,$4); } | '(' outlist ',' dospec ')' { sprintf($$,"(%s,%s)",$2,$4); } | '(' other ',' dospec ')' { sprintf($$,"(%s,%s)",$2,$4); } dospec : TOK_NAME '=' expr ',' expr { sprintf($$,"%s=%s,%s)",$1,$3,$5);} | TOK_NAME '=' expr ',' expr ',' expr { sprintf($$,"%s=%s,%s,%s)",$1,$3,$5,$7);} ; goto : TOK_PLAINGOTO '(' expr ',' expr ')' ',' expr | TOK_PLAINGOTO TOK_CSTINT ; allocation_list : allocate_object | allocation_list ',' allocate_object ; allocate_object : lhs { Add_Allocate_Var_1($1,curmodulename); } ; allocate_object_list : allocate_object | allocate_object_list ',' allocate_object ; opt_stat_spec : | ',' TOK_STAT '=' lhs ; pointer_name_list : ident | pointer_name_list ',' ident ; %% void process_fortran(const char *input_file) { extern FILE *fortran_in; extern FILE *fortran_out; char output_file[LONG_FNAME]; char input_fullpath[LONG_FNAME]; if ( todebug == 1 ) printf("Firstpass == %d \n", firstpass); yydebug=0; /******************************************************************************/ /* 1- Open input file */ /******************************************************************************/ strcpy(cur_filename, input_file); sprintf(input_fullpath, "%s/%s", input_dir, input_file); fortran_in = fopen(input_fullpath, "r"); if (! fortran_in) { printf("Error : File %s does not exist\n", input_fullpath); exit(1); } /******************************************************************************/ /* 2- Variables initialization */ /******************************************************************************/ line_num_input = 1; PublicDeclare = 0; PrivateDeclare = 0; ExternalDeclare = 0; SaveDeclare = 0; pointerdeclare = 0; contiguousdeclare = 0; optionaldeclare = 0; incalldeclare = 0; inside_type_declare = 0; Allocatabledeclare = 0 ; Targetdeclare = 0 ; VariableIsParameter = 0 ; strcpy(NamePrecision,""); c_star = 0 ; functiondeclarationisdone = 0; insubroutinedeclare = 0 ; strcpy(subroutinename," "); isrecursive = 0; InitialValueGiven = 0 ; GlobalDeclarationType = 0; inmoduledeclare = 0; incontainssubroutine = 0; afterpercent = 0; aftercontainsdeclare = 1; strcpy(nameinttypename,""); /******************************************************************************/ /* 3- Parsing of the input file (1 time) */ /******************************************************************************/ sprintf(output_file, "%s/%s", output_dir, input_file); if (firstpass == 0) fortran_out = fopen(output_file,"w"); fortran_parse(); if (firstpass == 0) NewModule_Creation_0(); if (firstpass == 0) fclose(fortran_out); }