Changeset 663 for trunk/AGRIF/LIB/fortran.y
- Timestamp:
- 2007-05-25T18:00:33+02:00 (17 years ago)
- File:
-
- 1 edited
-
trunk/AGRIF/LIB/fortran.y (modified) (101 diffs)
Legend:
- Unmodified
- Added
- Removed
-
trunk/AGRIF/LIB/fortran.y
r530 r663 3 3 /* CONV (converter) for Agrif (Adaptive Grid Refinement In Fortran) */ 4 4 /* */ 5 /* Copyright or ©or Copr. Laurent Debreu (Laurent.Debreu@imag.fr) */6 /* Cyril Mazauric (Cyril .Mazauric@imag.fr)*/5 /* Copyright or or Copr. Laurent Debreu (Laurent.Debreu@imag.fr) */ 6 /* Cyril Mazauric (Cyril_Mazauric@yahoo.fr) */ 7 7 /* This software is governed by the CeCILL-C license under French law and */ 8 8 /* abiding by the rules of distribution of free software. You can use, */ … … 31 31 /* knowledge of the CeCILL-C license and that you accept its terms. */ 32 32 /******************************************************************************/ 33 /* version 1. 0*/33 /* version 1.6 */ 34 34 /******************************************************************************/ 35 35 %{ … … 49 49 typedim c_selectordim; 50 50 listcouple *coupletmp; 51 listdim *parcoursdim; 51 52 int removeline=0; 53 listvar *test; 52 54 %} 53 55 … … 56 58 listdim *d; 57 59 listvar *l; 58 listvarcommon *lcom;59 60 listnom *ln; 60 61 listcouple *lc; … … 81 82 %token TOK_NEXTLINE 82 83 %token TOK_PARAMETER 83 %token TOK_KIND84 84 %token TOK_RESULT 85 85 %token TOK_ONLY … … 103 103 %token TOK_SELECTCASE 104 104 %token TOK_FILE 105 %token TOK_END 106 %token TOK_ERR 105 107 %token TOK_DONOTTREAT 106 108 %token TOK_ENDDONOTTREAT … … 123 125 %token TOK_TAN 124 126 %token TOK_ATAN 127 %token TOK_RECURSIVE 125 128 %token TOK_ABS 126 129 %token TOK_MOD 127 130 %token TOK_SIGN 128 131 %token TOK_MINLOC 129 /*%token TOK_REC*/130 132 %token TOK_MAXLOC 131 133 %token TOK_EXIT … … 168 170 %token TOK_INTENT 169 171 %token TOK_INTRINSIC 170 %token TOK_NAMELIST 171 %token TOK_CASEDEFAULT 172 %token TOK_NAMELIST 173 %token TOK_CASEDEFAULT 172 174 %token TOK_OPTIONAL 173 175 %token TOK_POINTER … … 175 177 %token TOK_SAVE 176 178 %token TOK_TARGET 177 %token TOK_POINT178 %token TOK_DATA179 179 %token TOK_QUOTE 180 180 %token TOK_IMPLICIT … … 185 185 %token TOK_COMMON 186 186 %token TOK_GLOBAL 187 %token TOK_INTERFACE 188 %token TOK_ENDINTERFACE 189 %token TOK_LEFTAB 190 %token TOK_RIGHTAB 187 %token TOK_INTERFACE 188 %token TOK_ENDINTERFACE 189 %token TOK_LEFTAB 190 %token TOK_RIGHTAB 191 191 %token TOK_PAUSE 192 192 %token TOK_PROCEDURE … … 207 207 %token <na> TOK_NOT 208 208 %token <na> TOK_AND 209 %token <na> TOK_TRUE 210 %token <na> TOK_FALSE 209 %token <na> TOK_TRUE 210 %token <na> TOK_FALSE 211 211 %token <na> TOK_LABEL 212 212 %token <na> TOK_TYPE 213 %token <na> TOK_TYPEPAR 213 214 %token <na> TOK_ENDTYPE 214 215 %token <na> TOK_REAL … … 224 225 %token <na> TOK_CHAR_CONSTANT 225 226 %token <na> TOK_CHAR_CUT 227 %token <na> TOK_DATA 226 228 %token <na> TOK_CHAR_INT 227 %token <na> TOK_CHAR_MESSAGE 229 %token <na> TOK_CHAR_MESSAGE 228 230 %token <na> TOK_CSTREAL 229 231 %token <na> TOK_CSTREALDP 230 232 %token <na> TOK_CSTREALQP 231 %token <na> TOK_SFREAL 233 %token <na> TOK_SFREAL 232 234 %token <na> TOK_COMPLEX 233 235 %token <na> TOK_DOUBLECOMPLEX … … 242 244 %token <na> TOK_OP 243 245 %token <na> TOK_CSTINT 244 %token <na> TOK_COMMENT 246 %token <na> TOK_COMMENT 245 247 %token <na> TOK_FILENAME 246 248 %token ',' … … 248 250 %token ':' 249 251 %token '(' 250 %token ')' 252 %token ')' 251 253 %token '[' 252 254 %token ']' 253 255 %token '!' 254 %token '_' 255 %token '<' 256 %token '>' 256 %token '_' 257 %token '<' 258 %token '>' 257 259 %type <l> dcl 260 %type <l> after_type 258 261 %type <l> dimension 259 262 %type <l> paramlist 260 %type <l> args 263 %type <l> args 264 %type <l> arglist 261 265 %type <lc> only_list 262 266 %type <lc> only_name 263 267 %type <lc> rename_list 264 268 %type <lc> rename_name 265 %type <lcom> common266 %type <lcom> var_common267 %type <lcom> var_common_list268 269 %type <d> dims 269 270 %type <d> dimlist … … 286 287 %type <na> simple_const 287 288 %type <na> vec 288 %type <na> outlist 289 %type <na> out2 290 %type <na> other 291 %type <na> dospec 292 %type <na> expr_data 293 %type <na> beforefunctionuse 294 %type <na> ident 295 %type <na> structure_component 296 %type <na> array_ele_substring_func_ref 297 %type <na> funarglist 298 %type <na> funarg 299 %type <na> funargs 300 %type <na> triplet 301 %type <na> substring 302 %type <na> string_constant 303 %type <na> opt_substring 304 %type <na> opt_expr 305 %type <na> optexpr 306 %type <na> datavallist 307 %type <na> after_slash 289 %type <na> outlist 290 %type <na> out2 291 %type <na> other 292 %type <na> dospec 293 %type <na> expr_data 294 %type <na> beforefunctionuse 295 %type <na> ident 296 %type <na> structure_component 297 %type <na> array_ele_substring_func_ref 298 %type <na> funarglist 299 %type <na> funarg 300 %type <na> funargs 301 %type <na> triplet 302 %type <na> substring 303 %type <na> string_constant 304 %type <na> opt_substring 305 %type <na> opt_expr 306 %type <na> optexpr 307 %type <na> datavallist 308 %type <na> after_slash 308 309 %type <na> after_equal 309 310 %type <na> predefinedfunction 310 %type <na> do_var 311 %type <na> do_var 311 312 %type <na> expr 313 %type <na> word_endsubroutine 314 %type <na> word_endfunction 315 %type <na> word_endprogram 316 %type <na> word_endunit 312 317 %type <na> intent_spec 313 318 %type <na> ubound … … 328 333 | keyword cmnt writedeclar 329 334 | error writedeclar nulcurbuf 330 {yyerrok;yyclearin;} 335 {yyerrok;yyclearin;} 331 336 ; 332 337 suite_line_list : suite_line … … 337 342 | before_include filename fin_line 338 343 { 339 if (inmoduledeclare == 0 && 340 couldaddvariable == 1 ) 344 if (inmoduledeclare == 0 ) 341 345 { 342 346 pos_end = setposcur(); … … 346 350 } 347 351 | exec cmnt writedeclar /* if, do etc ... */ 348 | instr fin_line /* instruction ident : do i = 1 ...*/352 | instr fin_line /* instruction ident : do i = 1 ... */ 349 353 ; 350 354 instr : ident ':' … … 352 356 fin_line : position cmnt 353 357 ; 354 keyword : TOK_DONOTTREAT 358 keyword : TOK_DONOTTREAT 355 359 { 356 /* we should ignore the declaration until the keyword */357 /* TOK_ENDDONOTTREAT */360 /* we should ignore the declaration until the keyword */ 361 /* TOK_ENDDONOTTREAT */ 358 362 couldaddvariable = 0 ; 359 363 RemoveWordCUR_0(fortranout,-20,20); 360 364 } 361 | TOK_ENDDONOTTREAT 365 | TOK_ENDDONOTTREAT 362 366 { 363 367 couldaddvariable = 1 ; … … 369 373 position: {pos_cur = setposcur();} 370 374 ; 371 thislabel: 375 thislabel: 372 376 | TOK_LABEL nulcurbuf 373 377 ; … … 381 385 {if (incom !=1) {strcpy(curbuf,"");incom=0;}} 382 386 ; 383 entry: 384 | TOK_SUBROUTINE name_routine arglist 385 { 386 Listofvariableinagriffunction=(listnom *)NULL; 387 strcpy(subroutinename,$2); 387 opt_recursive : 388 | TOK_RECURSIVE 389 ; 390 entry: 391 | opt_recursive TOK_SUBROUTINE name_routine arglist 392 { 393 if ( couldaddvariable == 1 ) 394 { 395 /* open param file */ 396 if ( firstpass == 0 ) 397 { 398 sprintf(ligne,"%s/ParamFile%s.h",nomdir,$3); 399 paramout=fopen(ligne,"w"); 400 if ( retour77 == 0 ) fprintf(paramout,"!\n"); 401 else fprintf(paramout,"C\n"); 402 403 } 404 Add_SubroutineArgument_Var_1($4); 388 405 if ( inmodulemeet == 1 ) 389 406 { 390 tmpdeclaration_everdone = 0;391 paramdeclaration_everdone = 0;392 407 insubroutinedeclare = 1; 393 AddUseAgrifUtil_0();394 408 /* in the second step we should write the head of */ 395 409 /* the subroutine sub_loop_<subroutinename> */ 396 410 writeheadnewsub_0(1); 397 adduseagrifutil = 0 ;398 411 } 399 412 else 400 413 { 401 tmpdeclaration_everdone = 0;402 paramdeclaration_everdone = 0;403 414 insubroutinedeclare = 1; 404 AddUseAgrifUtil_0();405 415 writeheadnewsub_0(1); 406 adduseagrifutil = 0 ;416 } 407 417 } 408 418 } 409 419 | TOK_PROGRAM name_routine 410 420 { 411 Listofvariableinagriffunction=(listnom *)NULL; 421 /* open param file */ 422 if ( firstpass == 0 ) 423 { 424 sprintf(ligne,"%s/ParamFile%s.h",nomdir,$2); 425 paramout=fopen(ligne,"w"); 426 if ( retour77 == 0 ) fprintf(paramout,"!\n"); 427 else fprintf(paramout,"C\n"); 428 429 } 412 430 strcpy(subroutinename,$2); 413 431 /* Common case */ 414 tmpdeclaration_everdone = 0; 415 paramdeclaration_everdone = 0; 416 insubroutinedeclare = 1; 417 AddUseAgrifUtil_0(); 418 /* in the second step we should write the head of */ 419 /* the subroutine sub_loop_<subroutinename> */ 420 writeheadnewsub_0(1); 421 adduseagrifutil = 0 ; 432 insubroutinedeclare = 1; 433 /* in the second step we should write the head of */ 434 /* the subroutine sub_loop_<subroutinename> */ 435 writeheadnewsub_0(1); 422 436 } 423 437 | TOK_FUNCTION name_routine arglist TOK_RESULT arglist1 424 438 { 425 Listofvariableinagriffunction=(listnom *)NULL; 439 /* open param file */ 440 if ( firstpass == 0 ) 441 { 442 sprintf(ligne,"%s/ParamFile%s.h",nomdir,$2); 443 paramout=fopen(ligne,"w"); 444 if ( retour77 == 0 ) fprintf(paramout,"!\n"); 445 else fprintf(paramout,"C\n"); 446 } 426 447 strcpy(subroutinename,$2); 427 448 if ( inmodulemeet == 1 ) 428 449 { 429 tmpdeclaration_everdone = 0;430 paramdeclaration_everdone = 0;431 450 insubroutinedeclare = 1; 432 AddUseAgrifUtil_0();433 451 /* we should to list of the subroutine argument the */ 434 452 /* name of the function which has to be defined */ 435 if ( firstpass == 1 ) 436 { 437 curvar=createvar($2,NULL); 438 curlistvar=insertvar(NULL,curvar); 439 listargsubroutine = AddListvarToListvar(curlistvar,listargsubroutine,1); 440 } 453 Add_SubroutineArgument_Var_1($3); 454 strcpy(DeclType,""); 441 455 /* in the second step we should write the head of */ 442 456 /* the subroutine sub_loop_<subroutinename> */ 443 457 writeheadnewsub_0(2); 444 adduseagrifutil = 0 ;445 458 } 446 459 else 447 460 { 448 tmpdeclaration_everdone = 0;449 paramdeclaration_everdone = 0;450 461 insubroutinedeclare = 1; 451 AddUseAgrifUtil_0();452 462 /* we should to list of the subroutine argument */ 453 463 /* name of the function which has to be defined */ 454 if ( firstpass == 1 ) 455 { 456 curvar=createvar($2,NULL); 457 curlistvar=insertvar(NULL,curvar); 458 listargsubroutine = AddListvarToListvar 459 (curlistvar,listargsubroutine,1); 460 } 464 Add_SubroutineArgument_Var_1($3); 465 strcpy(DeclType,""); 466 Add_FunctionType_Var_1($2); 461 467 writeheadnewsub_0(2); 462 adduseagrifutil = 0 ;463 468 } 464 469 } 465 470 | TOK_FUNCTION name_routine arglist 466 471 { 467 Listofvariableinagriffunction=(listnom *)NULL; 472 /* open param file */ 473 if ( firstpass == 0 ) 474 { 475 sprintf(ligne,"%s/ParamFile%s.h",nomdir,$2); 476 paramout=fopen(ligne,"w"); 477 if ( retour77 == 0 ) fprintf(paramout,"!\n"); 478 else fprintf(paramout,"C\n"); 479 } 468 480 strcpy(subroutinename,$2); 469 481 if ( inmodulemeet == 1 ) 470 482 { 471 tmpdeclaration_everdone = 0;472 paramdeclaration_everdone = 0;473 483 insubroutinedeclare = 1; 474 AddUseAgrifUtil_0();475 484 /* we should to list of the subroutine argument the */ 476 485 /* name of the function which has to be defined */ 477 if ( firstpass == 1 ) 478 { 479 curvar=createvar($2,NULL); 480 curlistvar=insertvar(NULL,curvar); 481 listargsubroutine = AddListvarToListvar 482 (curlistvar,listargsubroutine,1); 483 } 486 Add_SubroutineArgument_Var_1($3); 487 strcpy(DeclType,""); 488 Add_FunctionType_Var_1($2); 484 489 /* in the second step we should write the head of */ 485 490 /* the subroutine sub_loop_<subroutinename> */ 486 491 writeheadnewsub_0(2); 487 adduseagrifutil = 0 ;488 492 } 489 493 else 490 494 { 491 tmpdeclaration_everdone = 0;492 paramdeclaration_everdone = 0;493 495 insubroutinedeclare = 1; 494 AddUseAgrifUtil_0();495 496 /* we should to list of the subroutine argument */ 496 497 /* name of the function which has to be defined */ 497 if ( firstpass == 1 ) 498 { 499 curvar=createvar($2,NULL); 500 curlistvar=insertvar(NULL,curvar); 501 listargsubroutine = AddListvarToListvar 502 (curlistvar,listargsubroutine,1); 503 } 498 Add_SubroutineArgument_Var_1($3); 499 strcpy(DeclType,""); 500 Add_FunctionType_Var_1($2); 504 501 writeheadnewsub_0(2); 505 adduseagrifutil = 0 ;506 502 } 507 503 } 508 504 | TOK_MODULE TOK_NAME 509 505 { 506 GlobalDeclaration = 0; 510 507 strcpy(curmodulename,$2); 511 Add_ModuleTo_Modulelist_1($2); 508 strcpy(subroutinename,""); 509 Add_NameOfModule_1($2); 512 510 if ( inmoduledeclare == 0 ) 513 { 514 /* Alloc should be create ? */ 515 FillInlistmodule_1(); 511 { 516 512 /* To know if there are in the module declaration */ 517 513 inmoduledeclare = 1; … … 520 516 /* to know if we are after the keyword contains */ 521 517 aftercontainsdeclare = 0 ; 522 } 523 /* WE should use Agrif_Util if it is necessary */ 524 AddUseAgrifInModuleDeclaration_0(); 525 } 526 ; 527 name_routine : TOK_NAME {strcpy($$,$1);strcpy(subroutinename,$1);} 518 } 519 } 520 ; 521 name_routine : TOK_NAME 522 { 523 if ( couldaddvariable == 1 ) 524 { 525 strcpy($$,$1);strcpy(subroutinename,$1); 526 } 527 } 528 528 writedeclar : 529 529 ; … … 531 531 { 532 532 pos_curinclude = setposcur()-9; 533 } 533 } 534 534 filename: TOK_CHAR_CONSTANT 535 535 { 536 if ( couldaddvariable == 1 ) 537 { 538 Addincludetothelist_1($1); 539 } 540 } 541 ; 542 arglist: 536 if ( couldaddvariable == 1 ) Add_Include_1($1); 537 } 538 ; 539 arglist: { 540 if ( firstpass == 1 && couldaddvariable == 1) $$=NULL; 541 } 543 542 | '(' ')' { 544 if ( firstpass == 1 ) listargsubroutine=NULL;543 if ( firstpass == 1 && couldaddvariable == 1 ) $$=NULL; 545 544 } 546 545 | '(' args ')' 547 546 { 548 if ( firstpass == 1 ) listargsubroutine=$2;549 } 550 ; 551 arglist1: 547 if ( firstpass == 1 && couldaddvariable == 1 ) $$=$2; 548 } 549 ; 550 arglist1: 552 551 | '(' ')' 553 552 | '(' args ')' 554 553 { 555 listargsubroutine = AddListvarToListvar 556 ($2,listargsubroutine,1); 554 if ( couldaddvariable == 1 ) 555 { 556 Add_SubroutineArgument_Var_1($2); 557 } 557 558 } 558 559 ; 559 560 args:arg { 560 if ( firstpass == 1 )561 { 562 curvar=createvar($1, curdim);561 if ( firstpass == 1 && couldaddvariable == 1) 562 { 563 curvar=createvar($1,NULL); 563 564 curlistvar=insertvar(NULL,curvar); 564 $$=settype( $1,curlistvar);565 } 566 } 567 | args ',' arg 568 { 569 if ( firstpass == 1 )570 { 571 curvar=createvar($3, curdim);565 $$=settype("",curlistvar); 566 } 567 } 568 | args ',' arg 569 { 570 if ( firstpass == 1 && couldaddvariable == 1) 571 { 572 curvar=createvar($3,NULL); 572 573 $$=insertvar($1,curvar); 573 574 } 574 575 } 575 576 ; 576 arg: TOK_NAME { strcpy($$,$1);}577 | '*' { strcpy($$,"*");}578 ; 577 arg: TOK_NAME {if ( couldaddvariable == 1 ) strcpy($$,$1);} 578 | '*' {if ( couldaddvariable == 1 ) strcpy($$,"*");} 579 ; 579 580 spec: type after_type 580 581 { 581 /* remove declaration */ 582 if ( fortran77 == 1 && 583 infunctiondeclare == 0 && 584 commonlist && 585 IsTabvarsUseInArgument_0() == 1 && 586 couldaddvariable == 1 ) 587 { 582 if ( VarTypepar == 1 ) 583 { 584 couldaddvariable = 1 ; 585 VarTypepar = 0; 586 } 587 } 588 | TOK_TYPE opt_spec opt_sep opt_name 589 { 590 if ( couldaddvariable == 1 ) 591 { 592 VarType = 1; 593 couldaddvariable = 0 ; 594 } 595 } 596 | TOK_ENDTYPE opt_name 597 { 598 if ( VarType == 1 ) couldaddvariable = 1 ; 599 VarType = 0; 600 VarTypepar = 0; 601 } 602 | TOK_POINTER list_couple 603 | before_parameter '(' paramlist ')' 604 { 605 if ( couldaddvariable == 1 ) 606 { 607 if ( insubroutinedeclare == 0 ) 608 Add_GlobalParameter_Var_1($3); 609 else Add_Parameter_Var_1($3); 588 610 pos_end = setposcur(); 589 611 RemoveWordSET_0(fortranout,pos_cur_decl, 590 pos_end-pos_cur_decl); 591 } 592 infunctiondeclare = 0 ; 593 } 594 | TOK_TYPE opt_name 595 /* { 596 couldaddvariable = 0; 597 }*/ 598 | TOK_ENDTYPE opt_name 599 /* { 600 couldaddvariable = 1; 601 }*/ 602 | TOK_POINTER list_couple 603 | before_parameter '(' paramlist ')' 604 { 605 AddvartoParamlist_1($3); 606 if ( fortran77 == 1 && 607 commonlist && 608 listvarindoloop && 609 IsTabvarsUseInArgument_0() == 1 ) 610 { 612 pos_end-pos_cur_decl); 613 } 614 VariableIsParameter = 0 ; 615 } 616 | before_parameter paramlist 617 { 618 if ( couldaddvariable == 1 ) 619 { 620 if ( insubroutinedeclare == 0 ) 621 Add_GlobalParameter_Var_1($2); 622 else Add_Parameter_Var_1($2); 611 623 pos_end = setposcur(); 612 RemoveWordSET_0(fortranout,pos_curparameter, 613 pos_end-pos_curparameter); 614 } 615 } 616 | before_parameter paramlist 617 { 618 AddvartoParamlist_1($2); 619 if ( fortran77 == 1 && 620 commonlist && 621 listvarindoloop && 622 IsTabvarsUseInArgument_0() == 1 ) 623 { 624 pos_end = setposcur(); 625 RemoveWordSET_0(fortranout,pos_curparameter, 626 pos_end-pos_curparameter); 627 } 624 RemoveWordSET_0(fortranout,pos_cur_decl, 625 pos_end-pos_cur_decl); 626 } 627 VariableIsParameter = 0 ; 628 628 } 629 629 | common 630 630 | save 631 { 632 pos_end = setposcur(); 633 RemoveWordSET_0(fortranout,pos_cursave, 634 pos_end-pos_cursave); 635 } 631 636 | implicit 632 637 | dimension … … 637 642 if ( couldaddvariable == 1 ) 638 643 { 639 ajoutevar_1($1);640 NonGridDepDeclaration_0($1);641 /* if variables has been declared in a subroutine*/644 Add_Globliste_1($1); 645 /* if variableparamlists has been declared in a */ 646 /* subroutine */ 642 647 if ( insubroutinedeclare == 1 ) 643 648 { 644 ajoutvarofsubroutine_1($1); 645 writesubroutinedeclaration_0($1); 649 Add_Dimension_Var_1($1); 646 650 } 647 } 648 /* Case of common block */ 649 indeclarationvar=0; 650 PublicDeclare = 0; 651 PrivateDeclare = 0; 652 ExternalDeclare = 0; 653 strcpy(NamePrecision,""); 651 pos_end = setposcur(); 652 RemoveWordSET_0(fortranout,pos_curdimension, 653 pos_end-pos_curdimension); 654 } 655 /* */ 656 PublicDeclare = 0; 657 PrivateDeclare = 0; 658 ExternalDeclare = 0; 659 strcpy(NamePrecision,""); 654 660 c_star = 0; 655 661 InitialValueGiven = 0 ; 656 662 strcpy(IntentSpec,""); 657 VariableIsParameter = 0 ; 663 VariableIsParameter = 0 ; 658 664 Allocatabledeclare = 0 ; 659 665 SaveDeclare = 0; … … 662 668 dimsgiven=0; 663 669 c_selectorgiven=0; 664 strcpy(nameinttypename,""); 670 strcpy(nameinttypename,""); 671 strcpy(c_selectorname,""); 665 672 } 666 673 | public … … 668 675 | use_stat 669 676 | module_proc_stmt 670 | interface 677 | interface 671 678 | namelist 672 679 | TOK_BACKSPACE '(' expr ')' 673 680 | TOK_EXTERNAL opt_sep use_name_list 674 681 | TOK_INTRINSIC opt_sep use_intrinsic_list 675 | TOK_EQUIVALENCE '(' list_expr ')'682 | TOK_EQUIVALENCE list_expr_equi 676 683 | before_data data '\n' 677 684 { 678 685 /* we should remove the data declaration */ 679 if (aftercontainsdeclare == 0 )680 {686 if ( couldaddvariable == 1 && aftercontainsdeclare == 0 ) 687 { 681 688 pos_end = setposcur(); 682 689 RemoveWordSET_0(fortranout,pos_curdata, 683 690 pos_end-pos_curdata); 684 }691 } 685 692 } 693 ; 694 opt_spec : 695 | access_spec 696 { 697 PublicDeclare = 0 ; 698 PrivateDeclare = 0 ; 699 } 686 700 ; 687 701 name_intrinsic : TOK_SUM … … 712 726 use_intrinsic_list : name_intrinsic 713 727 | use_intrinsic_list ',' name_intrinsic 714 list_couple : '(' list_expr ')' 715 | list_couple ',' '(' list_expr ')' 728 ; 729 list_couple : '(' list_expr ')' 730 | list_couple ',' '(' list_expr ')' 731 ; 732 list_expr_equi : expr_equi 733 | list_expr_equi ',' expr_equi 734 ; 735 expr_equi : '(' list_expr_equi1 ')' 736 ; 737 list_expr_equi1 : ident dims 738 | list_expr_equi1 ',' ident dims 739 ; 716 740 list_expr : expr 717 741 | list_expr ',' expr 742 ; 718 743 opt_sep : 719 744 | ':' ':' 720 745 ; 721 after_type : dcl nodimsgiven 722 { 723 /* if the variable is a parameter we can suppose that is*/724 /* value is the same on each grid. It is not useless to*/725 /* create a copy of it on each grid*/746 after_type : dcl nodimsgiven 747 { 748 /* if the variable is a parameter we can suppose that is*/ 749 /* value is the same on each grid. It is not useless */ 750 /* to create a copy of it on each grid */ 726 751 if ( couldaddvariable == 1 ) 727 752 { 728 ajoutevar_1($1); 729 if ( VariableIsParameter == 1 ) globparam = 730 AddListvarToListvar($1,globparam,1); 731 NonGridDepDeclaration_0($1); 753 pos_end = setposcur(); 754 RemoveWordSET_0(fortranout,pos_cur_decl, 755 pos_end-pos_cur_decl); 756 if ( firstpass == 0 && 757 GlobalDeclaration == 0 && 758 insubroutinedeclare == 0 ) 759 { 760 sprintf(ligne,"\n#include \"Module_Declar_%s.h\"\n" 761 ,curmodulename); 762 tofich(fortranout,ligne,1); 763 sprintf (ligne, "Module_Declar_%s.h",curmodulename); 764 module_declar = associate(ligne); 765 sprintf (ligne, " "); 766 tofich (module_declar, ligne,1); 767 GlobalDeclaration = 1 ; 768 } 769 $$ = $1; 770 Add_Globliste_1($1); 771 if ( insubroutinedeclare == 0 ) 772 Add_GlobalParameter_Var_1($1); 773 else 774 { 775 if ( pointerdeclare == 1 ) 776 Add_Pointer_Var_From_List_1($1); 777 Add_Parameter_Var_1($1); 778 } 779 732 780 /* if variables has been declared in a subroutine */ 733 781 if ( insubroutinedeclare == 1 ) 734 782 { 735 ajoutvarofsubroutine_1($1); 736 writesubroutinedeclaration_0($1); 783 Add_SubroutineDeclaration_Var_1($1); 737 784 } 738 785 /* If there are a SAVE declarations in module's */ … … 740 787 /* subroutines declaration and add it in the */ 741 788 /* global declarations */ 742 if ( aftercontainsdeclare == 1 ) 789 if ( aftercontainsdeclare == 1 && 790 SaveDeclare == 1 && firstpass == 1 ) 743 791 { 744 ajoutevarsave_1($1); 745 if ( VariableIsParameter == 0 && SaveDeclare == 1) 746 { 747 pos_end = setposcur(); 748 RemoveWordSET_0(fortranout,pos_cur, 749 pos_end-pos_cur); 750 } 792 if ( inmodulemeet == 0 ) Add_Save_Var_dcl_1($1); 793 else Add_SubroutineDeclarationSave_Var_1($1); 751 794 } 752 795 } 753 /* Case of common block */ 754 indeclarationvar=0; 755 PublicDeclare = 0; 756 PrivateDeclare = 0; 757 ExternalDeclare = 0; 758 strcpy(NamePrecision,""); 796 /* */ 797 PublicDeclare = 0; 798 PrivateDeclare = 0; 799 ExternalDeclare = 0; 800 strcpy(NamePrecision,""); 759 801 c_star = 0; 760 802 InitialValueGiven = 0 ; 761 803 strcpy(IntentSpec,""); 762 VariableIsParameter = 0 ; 804 VariableIsParameter = 0 ; 763 805 Allocatabledeclare = 0 ; 764 806 SaveDeclare = 0; … … 767 809 dimsgiven=0; 768 810 c_selectorgiven=0; 769 strcpy(nameinttypename,""); 770 } 771 | TOK_FUNCTION TOK_NAME arglist 772 { 773 infunctiondeclare = 1 ; 774 Listofvariableinagriffunction=(listnom *)NULL; 811 strcpy(nameinttypename,""); 812 strcpy(c_selectorname,""); 813 } 814 | before_function name_routine arglist 815 { 816 /* open param file */ 817 if ( firstpass == 0 ) 818 { 819 sprintf(ligne,"%s/ParamFile%s.h",nomdir,$2); 820 paramout=fopen(ligne,"w"); 821 if ( retour77 == 0 ) fprintf(paramout,"!\n"); 822 else fprintf(paramout,"C\n"); 823 } 775 824 strcpy(subroutinename,$2); 776 825 if ( inmodulemeet == 1 ) 777 826 { 778 tmpdeclaration_everdone = 0;779 paramdeclaration_everdone = 0;780 827 insubroutinedeclare = 1; 781 AddUseAgrifUtil_0();782 828 /* we should to list of the subroutine argument the */ 783 829 /* name of the function which has to be defined */ 784 if ( firstpass == 1 ) 785 { 786 curvar=createvar($2,NULL); 787 strcpy(curvar->typevar,DeclType); 788 curlistvar=insertvar(NULL,curvar); 789 listargsubroutine = AddListvarToListvar 790 (curlistvar,listargsubroutine,1); 791 curvar=createvar($2,NULL); 792 strcpy(curvar->typevar,DeclType); 793 strcpy(curvar->modulename,subroutinename); 794 curlistvar=insertvar(NULL,curvar); 795 varofsubroutineliste = AddListvarToListvar 796 (curlistvar,varofsubroutineliste,1); 797 } 798 if ( firstpass == 0 ) 799 { 800 curvar=createvar($2,NULL); 801 strcpy(curvar->typevar,DeclType); 802 functionlistvar=insertvar(NULL,curvar); 803 } 830 Add_SubroutineArgument_Var_1($3); 831 Add_FunctionType_Var_1($2); 804 832 /* in the second step we should write the head of */ 805 833 /* the subroutine sub_loop_<subroutinename> */ 806 834 writeheadnewsub_0(2); 807 adduseagrifutil = 0 ;808 835 } 809 836 else 810 837 { 811 tmpdeclaration_everdone = 0;812 paramdeclaration_everdone = 0;813 838 insubroutinedeclare = 1; 814 AddUseAgrifUtil_0();815 839 /* we should to list of the subroutine argument the */ 816 840 /* name of the function which has to be defined */ 817 if ( firstpass == 1 ) 818 { 819 curvar=createvar($2,NULL); 820 strcpy(curvar->typevar,DeclType); 821 curlistvar=insertvar(NULL,curvar); 822 listargsubroutine = AddListvarToListvar 823 (curlistvar,listargsubroutine,1); 824 curvar=createvar($2,NULL); 825 strcpy(curvar->typevar,DeclType); 826 strcpy(curvar->modulename,subroutinename); 827 curlistvar=insertvar(NULL,curvar); 828 varofsubroutineliste = AddListvarToListvar 829 (curlistvar,varofsubroutineliste,1); 830 } 841 Add_SubroutineArgument_Var_1($3); 842 Add_FunctionType_Var_1($2); 831 843 /* in the second step we should write the head of */ 832 844 /* the subroutine sub_loop_<subroutinename> */ 833 845 writeheadnewsub_0(2); 834 adduseagrifutil = 0 ; 835 } 836 } 837 ; 846 } 847 } 848 ; 849 before_function : TOK_FUNCTION 850 { 851 functiondeclarationisdone = 1; 852 } 853 ; 854 838 855 before_parameter : TOK_PARAMETER 839 856 { 857 VariableIsParameter = 1; 840 858 pos_curparameter = setposcur()-9; 841 } 859 } 842 860 before_data : TOK_DATA 843 861 { 844 pos_curdata = setposcur()- 4;862 pos_curdata = setposcur()-strlen($1); 845 863 } 846 864 data: TOK_NAME TOK_SLASH datavallist TOK_SLASH 847 865 { 848 sprintf(ligne,"(/ %s /)",$3); 849 CompleteDataList($1,ligne); 866 if ( couldaddvariable == 1 ) 867 { 868 if ( aftercontainsdeclare == 1 ) strcpy(ligne,""); 869 else sprintf(ligne,"(/ %s /)",$3); 870 Add_Data_Var_1($1,ligne); 871 } 850 872 } 851 873 | data opt_comma TOK_NAME TOK_SLASH datavallist TOK_SLASH 852 874 { 853 sprintf(ligne,"(/ %s /)",$5); 854 CompleteDataList($3,ligne); 875 if ( couldaddvariable == 1 ) 876 { 877 if ( aftercontainsdeclare == 1 ) strcpy(ligne,""); 878 else sprintf(ligne,"(/ %s /)",$5); 879 Add_Data_Var_1($3,ligne); 880 } 855 881 } 856 882 | datanamelist TOK_SLASH datavallist TOK_SLASH … … 865 891 } 866 892 ; 893 datavallist : expr_data 894 { 895 if ( couldaddvariable == 1 ) 896 { 897 strcpy($$,$1); 898 } 899 } 900 | expr_data ',' datavallist 901 { 902 if ( couldaddvariable == 1 ) 903 { 904 sprintf($$,"%s,%s",$1,$3); 905 } 906 } 907 ; 908 909 save: before_save varsave 910 | before_save comblock varsave 911 | save opt_comma comblock opt_comma varsave 912 | save ',' varsave 913 ; 914 before_save : TOK_SAVE 915 { 916 pos_cursave = setposcur()-4; 917 } 918 ; 919 varsave: 920 | TOK_NAME dims 921 { 922 if ( couldaddvariable == 1 ) Add_Save_Var_1($1,$2); 923 } 924 ; 867 925 datanamelist : TOK_NAME 868 | datanamelist ',' TOK_NAME 869 ; 870 datavallist : expr_data 871 { 872 strcpy($$,$1); 873 } 874 | expr_data ',' datavallist 875 { 876 sprintf($$,"%s,%s",$1,$3); 877 } 926 | TOK_NAME '(' expr ')' 927 | datanamelist ',' datanamelist 878 928 ; 879 929 expr_data : opt_signe simple_const 880 { sprintf($$,"%s%s",$1,$2);}930 {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);} 881 931 | expr_data '+' expr_data 882 { sprintf($$,"%s+%s",$1,$3);}932 {if ( couldaddvariable == 1 ) sprintf($$,"%s+%s",$1,$3);} 883 933 | expr_data '-' expr_data 884 { sprintf($$,"%s-%s",$1,$3);}934 {if ( couldaddvariable == 1 ) sprintf($$,"%s-%s",$1,$3);} 885 935 | expr_data '*' expr_data 886 { sprintf($$,"%s*%s",$1,$3);}936 {if ( couldaddvariable == 1 ) sprintf($$,"%s*%s",$1,$3);} 887 937 | expr_data '/' expr_data 888 { sprintf($$,"%s/%s",$1,$3);}889 ; 890 opt_signe : 891 { strcpy($$,"");}938 {if ( couldaddvariable == 1 ) sprintf($$,"%s/%s",$1,$3);} 939 ; 940 opt_signe : 941 {if ( couldaddvariable == 1 ) strcpy($$,"");} 892 942 | signe 893 { strcpy($$,$1);}943 {if ( couldaddvariable == 1 ) strcpy($$,$1);} 894 944 ; 895 945 namelist: namelist_action after_namelist 896 946 ; 897 namelist_action : TOK_NAMELIST ident 947 namelist_action : TOK_NAMELIST ident 898 948 | TOK_NAMELIST comblock ident 899 {900 AddNameToListNamelist_1($2);901 }902 949 | namelist_action opt_comma comblock opt_comma ident 903 {904 AddNameToListNamelist_1($3);905 }906 950 | namelist_action ',' ident 907 951 ; … … 911 955 | TOK_ENDINTERFACE opt_name 912 956 ; 913 dimension: TOK_DIMENSION opt_comma TOK_NAME dims lengspec 957 before_dimension : TOK_DIMENSION 958 { 959 positioninblock=0; 960 pos_curdimension = setposcur()-9; 961 } 962 963 dimension: before_dimension opt_comma TOK_NAME dims lengspec 914 964 { 915 965 if ( couldaddvariable == 1 ) 916 966 { 917 if ( inmoduledeclare == 1 || SaveDeclare == 1 )918 {919 if ( AllocShouldMadeInModule() == 1 )920 {921 AllocTo1InModule_1();922 }923 }924 967 /* */ 925 968 curvar=createvar($3,$4); 926 969 /* */ 927 if ( IsVariableReal($3) == 1 ) 928 { 929 /* */ 930 CreateAndFillin_Curvar("REAL",$3,$4,curvar); 931 /* */ 932 curlistvar=insertvar(NULL,curvar); 933 /* */ 934 $$=settype("REAL",curlistvar); 935 } 936 else 937 { 938 /* */ 939 CreateAndFillin_Curvar("INTEGER",$3,$4,curvar); 940 /* */ 941 curlistvar=insertvar(NULL,curvar); 942 /* */ 943 $$=settype("INTEGER",curlistvar); 944 } 970 CreateAndFillin_Curvar("",curvar); 971 /* */ 972 curlistvar=insertvar(NULL,curvar); 973 /* */ 974 $$=settype("",curlistvar); 975 /* */ 945 976 strcpy(vallengspec,""); 946 }947 else948 {949 /* mazauric*/950 977 } 951 978 } … … 957 984 curvar=createvar($3,$4); 958 985 /* */ 959 if ( IsVariableReal($3) == 1 ) 960 { 961 /* */ 962 CreateAndFillin_Curvar("REAL",$3,$4,curvar); 963 /* */ 964 curlistvar=insertvar($1,curvar); 965 /* */ 966 $$=curlistvar; 967 } 968 else 969 { 970 /* */ 971 CreateAndFillin_Curvar("INTEGER",$3,$4,curvar); 972 /* */ 973 curlistvar=insertvar($1,curvar); 974 /* */ 975 $$=curlistvar; 976 } 986 CreateAndFillin_Curvar("",curvar); 987 /* */ 988 curlistvar=insertvar($1,curvar); 989 /* */ 990 $$=curlistvar; 991 /* */ 977 992 strcpy(vallengspec,""); 978 }979 else980 {981 /* mazauric*/982 993 } 983 994 } … … 987 998 ; 988 999 public: TOK_PUBLIC '\n' 989 | TOK_PUBLIC opt_sep use_name_list 990 ; 991 use_name_list: TOK_NAME 1000 | TOK_PUBLIC opt_sep use_name_list 1001 ; 1002 use_name_list: TOK_NAME 992 1003 | use_name_list ',' TOK_NAME 993 1004 ; 994 1005 common: before_common var_common_list 995 1006 { 996 if (fortran77 == 1 && 997 couldaddvariable == 1 ) 998 { 999 pos_end = setposcur(); 1000 RemoveWordSET_0(fortranout,pos_curcommon, 1007 pos_end = setposcur(); 1008 RemoveWordSET_0(fortranout,pos_curcommon, 1001 1009 pos_end-pos_curcommon); 1002 }1003 1010 } 1004 1011 | before_common comblock var_common_list … … 1007 1014 { 1008 1015 sprintf(charusemodule,"%s",$2); 1009 Add_ModuleTo_Modulelist_1($2); 1010 if ( fortran77 == 1 ) 1011 { 1012 pos_end = setposcur(); 1013 RemoveWordSET_0(fortranout,pos_curcommon, 1014 pos_end-pos_curcommon); 1015 } 1016 Add_NameOfCommon_1($2); 1017 pos_end = setposcur(); 1018 RemoveWordSET_0(fortranout,pos_curcommon, 1019 pos_end-pos_curcommon); 1016 1020 } 1017 1021 } … … 1021 1025 { 1022 1026 sprintf(charusemodule,"%s",$3); 1023 Add_ModuleTo_Modulelist_1($3); 1024 if ( fortran77 == 1 ) 1025 { 1026 pos_end = setposcur(); 1027 RemoveWordSET_0(fortranout,pos_curcommon, 1028 pos_end-pos_curcommon); 1029 } 1027 Add_NameOfCommon_1($3); 1028 pos_end = setposcur(); 1029 RemoveWordSET_0(fortranout,pos_curcommon, 1030 pos_end-pos_curcommon); 1030 1031 } 1031 1032 } … … 1044 1045 var_common_list : var_common 1045 1046 { 1046 if ( couldaddvariable == 1 ) Add tolistvarcommon();1047 if ( couldaddvariable == 1 ) Add_Common_var_1(); 1047 1048 } 1048 1049 1049 1050 | var_common_list ',' var_common 1050 1051 { 1051 if ( couldaddvariable == 1 ) Add tolistvarcommon();1052 } 1053 var_common: TOK_NAME dims 1054 { 1055 if ( couldaddvariable == 1 ) 1052 if ( couldaddvariable == 1 ) Add_Common_var_1(); 1053 } 1054 var_common: TOK_NAME dims 1055 { 1056 if ( couldaddvariable == 1 ) 1056 1057 { 1057 1058 positioninblock = positioninblock + 1 ; … … 1061 1062 } 1062 1063 ; 1063 comblock: TOK_DSLASH 1064 { 1065 if ( couldaddvariable == 1 ) 1064 comblock: TOK_DSLASH 1065 { 1066 if ( couldaddvariable == 1 ) 1066 1067 { 1067 1068 strcpy($$,""); … … 1070 1071 } 1071 1072 } 1072 | TOK_SLASH TOK_NAME TOK_SLASH 1073 { 1074 if ( couldaddvariable == 1 ) 1073 | TOK_SLASH TOK_NAME TOK_SLASH 1074 { 1075 if ( couldaddvariable == 1 ) 1075 1076 { 1076 1077 strcpy($$,$2); … … 1080 1081 } 1081 1082 ; 1082 save: TOK_SAVE varsave1083 | TOK_SAVE comblock varsave1084 | save opt_comma comblock opt_comma varsave1085 | save ',' varsave1086 ;1087 varsave:1088 | TOK_NAME before_dims dims1089 {created_dimensionlist = 1;}1090 ;1091 1092 1083 opt_comma: 1093 1084 | ',' … … 1095 1086 paramlist: paramitem 1096 1087 { 1097 if ( firstpass== 1 ) $$=insertvar(NULL,$1);1088 if ( couldaddvariable == 1 ) $$=insertvar(NULL,$1); 1098 1089 } 1099 1090 | paramlist ',' paramitem 1100 1091 { 1101 if ( firstpass== 1 ) $$=insertvar($1,$3);1092 if ( couldaddvariable == 1 ) $$=insertvar($1,$3); 1102 1093 } 1103 1094 ; 1104 1095 paramitem : TOK_NAME '=' expr 1105 1096 { 1106 if ( firstpass== 1 )1107 1097 if ( couldaddvariable == 1 ) 1098 { 1108 1099 curvar=(variable *) malloc(sizeof(variable)); 1109 strcpy(curvar->nomvar,$1); 1110 strcpy(curvar->subroutinename,subroutinename); 1111 strcpy(curvar->modulename,subroutinename); 1112 strcpy(curvar->initialvalue,$3); 1100 /* */ 1101 Init_Variable(curvar); 1102 /* */ 1103 curvar->v_VariableIsParameter=1; 1104 strcpy(curvar->v_nomvar,$1); 1105 strcpy(curvar->v_subroutinename,subroutinename); 1106 strcpy(curvar->v_modulename,curmodulename); 1107 strcpy(curvar->v_initialvalue,$3); 1108 strcpy(curvar->v_commoninfile,mainfile); 1113 1109 $$=curvar; 1114 1110 } … … 1122 1118 implicit: TOK_IMPLICIT TOK_NONE 1123 1119 { 1124 if ( firstpass == 1 && insubroutinedeclare == 1 ) 1125 { 1126 listimplicitnone = Addtolistname 1127 (subroutinename,listimplicitnone); 1128 } 1129 if ( tmpdeclaration_everdone == 1 && 1130 inmoduledeclare == 0 ) 1131 { 1132 pos_end = setposcur(); 1133 RemoveWordSET_0(fortranout,pos_end-13, 1134 13); 1120 if ( insubroutinedeclare == 1 ) 1121 { 1122 Add_ImplicitNoneSubroutine_1(); 1123 pos_end = setposcur(); 1124 RemoveWordSET_0(fortranout,pos_end-13, 1125 13); 1135 1126 } 1136 1127 } … … 1143 1134 if ( couldaddvariable == 1 ) 1144 1135 { 1145 if ( inmoduledeclare == 1 || SaveDeclare == 1 )1146 {1147 if ( AllocShouldMadeInModule() == 1 )1148 {1149 AllocTo1InModule_1();1150 }1151 }1152 1136 /* */ 1153 if (dimsgiven == 1) 1137 if (dimsgiven == 1) 1154 1138 { 1155 1139 curvar=createvar($3,curdim); … … 1160 1144 } 1161 1145 /* */ 1162 CreateAndFillin_Curvar(DeclType, $3,$4,curvar);1146 CreateAndFillin_Curvar(DeclType,curvar); 1163 1147 /* */ 1164 1148 curlistvar=insertvar(NULL,curvar); 1165 if (!strcasecmp(DeclType,"character")) 1149 if (!strcasecmp(DeclType,"character")) 1166 1150 { 1167 if (c_selectorgiven == 1) 1151 if (c_selectorgiven == 1) 1168 1152 { 1169 1153 strcpy(c_selectordim.first,"1"); … … 1175 1159 $$=settype(DeclType,curlistvar); 1176 1160 } 1177 else1178 {1179 /* mazauric*/1180 }1181 1161 strcpy(vallengspec,""); 1182 1162 } … … 1185 1165 if ( couldaddvariable == 1 ) 1186 1166 { 1187 if (dimsgiven == 1) 1167 if (dimsgiven == 1) 1188 1168 { 1189 1169 curvar=createvar($4,curdim); … … 1193 1173 curvar=createvar($4,$5); 1194 1174 } 1195 /* */1196 CreateAndFillin_Curvar($1->var->typevar,$4,$5,curvar);1197 1175 /* */ 1198 strcpy(curvar->typevar,($1->var->typevar)); 1176 CreateAndFillin_Curvar($1->var->v_typevar,curvar); 1177 /* */ 1178 strcpy(curvar->v_typevar,($1->var->v_typevar)); 1199 1179 /* */ 1200 1180 curlistvar=insertvar($1,curvar); 1201 if (!strcasecmp(DeclType,"character")) 1181 if (!strcasecmp(DeclType,"character")) 1202 1182 { 1203 if (c_selectorgiven == 1) 1183 if (c_selectorgiven == 1) 1204 1184 { 1205 1185 strcpy(c_selectordim.first,"1"); … … 1211 1191 $$=curlistvar; 1212 1192 } 1213 else1214 {1215 /* mazauric*/1216 }1217 1193 strcpy(vallengspec,""); 1218 1194 } 1219 ; 1195 ; 1220 1196 nodimsgiven: {dimsgiven=0;} 1221 1197 ; 1222 type:typespec selector 1223 {strcpy(DeclType,$1);indeclarationvar=1;} 1224 | before_character c_selector 1225 { 1226 indeclarationvar=1; 1198 type:typespec selector 1199 {strcpy(DeclType,$1);} 1200 | before_character c_selector 1201 { 1227 1202 strcpy(DeclType,"CHARACTER"); 1228 if (inmoduledeclare == 1 )1229 {1230 AllocShouldMadeTo1InModule_1();1231 }1232 1203 } 1233 1204 | typename '*' TOK_CSTINT 1234 1205 { 1235 indeclarationvar=1;1236 1206 strcpy(DeclType,$1); 1237 1207 strcpy(nameinttypename,$3); 1238 1208 } 1209 | before_typepar attribute ')' 1210 { 1211 strcpy(DeclType,"TYPE"); 1212 } 1213 ; 1214 before_typepar : TOK_TYPEPAR 1215 { 1216 if ( couldaddvariable == 1 ) VarTypepar = 1 ; 1217 couldaddvariable = 0 ; 1218 pos_cur_decl = setposcur()-5; 1219 } 1239 1220 ; 1240 1221 c_selector: 1241 | '*' TOK_CSTINT 1222 | '*' TOK_CSTINT 1242 1223 {c_selectorgiven=1;strcpy(c_selectorname,$2);} 1243 1224 | '*' '(' c_attribute ')' {c_star = 1;} 1244 | '(' c_attribute ')' 1245 ; 1246 c_attribute: TOK_NAME clause opt_clause 1247 | TOK_NAME '=' clause opt_clause 1248 | clause opt_clause 1225 | '(' c_attribute ')' 1226 ; 1227 c_attribute: TOK_NAME clause opt_clause 1228 | TOK_NAME '=' clause opt_clause 1229 | clause opt_clause 1249 1230 ; 1250 1231 before_character : TOK_CHARACTER … … 1255 1236 typespec: typename {strcpy($$,$1);} 1256 1237 ; 1257 typename: TOK_INTEGER 1238 typename: TOK_INTEGER 1258 1239 { 1259 1240 strcpy($$,"INTEGER"); 1260 1241 pos_cur_decl = setposcur()-7; 1261 if (inmoduledeclare == 1 )1262 {1263 AllocShouldMadeTo1InModule_1();1264 }1265 1242 } 1266 1243 | TOK_REAL { 1267 strcpy($$,"REAL"); 1244 strcpy($$,"REAL"); 1268 1245 pos_cur_decl = setposcur()-4; 1269 if (inmoduledeclare == 1 ) 1270 { 1271 AllocShouldMadeTo1InModule_1(); 1272 } 1273 } 1274 | TOK_COMPLEX 1246 } 1247 | TOK_COMPLEX 1275 1248 {strcpy($$,"COMPLEX");} 1276 | TOK_DOUBLEPRECISION 1277 {strcpy($$,"DOUBLE PRECISION");} 1278 | TOK_DOUBLECOMPLEX 1249 | TOK_DOUBLEPRECISION 1250 { 1251 pos_cur_decl = setposcur()-16; 1252 strcpy($$,"REAL"); 1253 strcpy(nameinttypename,"8"); 1254 } 1255 | TOK_DOUBLECOMPLEX 1279 1256 {strcpy($$,"DOUBLE COMPLEX");} 1280 | TOK_LOGICAL 1257 | TOK_LOGICAL 1281 1258 { 1282 1259 strcpy($$,"LOGICAL"); 1283 1260 pos_cur_decl = setposcur()-7; 1284 if (inmoduledeclare == 1 )1285 {1286 AllocShouldMadeTo1InModule_1();1287 }1288 }1289 | TOK_TYPE1290 {1291 pos_cur_decl = setposcur()-5;1292 strcpy($$,"TYPE");1293 1261 } 1294 1262 ; … … 1301 1269 selector: 1302 1270 | '*' proper_selector 1303 | '(' attribute ')' 1271 | '(' attribute ')' 1304 1272 ; 1305 1273 proper_selector: expr 1306 1274 | '(' '*' ')' 1307 1275 ; 1308 attribute: TOK_NAME clause 1309 | TOK_NAME '=' clause 1310 { 1311 sprintf(NamePrecision,"%s = %s",$1,$3); 1276 attribute: TOK_NAME clause 1277 | TOK_NAME '=' clause 1278 { 1279 if ( strstr($3,"0.d0") ) 1280 { 1281 strcpy(nameinttypename,"8"); 1282 sprintf(NamePrecision,""); 1283 } 1284 else sprintf(NamePrecision,"%s = %s",$1,$3); 1312 1285 } 1313 1286 | TOK_NAME 1314 1287 { 1315 strcpy(NamePrecision,$1); 1288 strcpy(NamePrecision,$1); 1316 1289 } 1317 1290 | TOK_CSTINT 1318 1291 { 1319 strcpy(NamePrecision,$1); 1292 strcpy(NamePrecision,$1); 1320 1293 } 1321 1294 ; … … 1323 1296 strcpy($$,$1);} 1324 1297 | '*' {strcpy(CharacterSize,"*"); 1325 strcpy($$,"*");} 1326 ; 1327 opt_clause: 1298 strcpy($$,"*");} 1299 ; 1300 opt_clause: 1328 1301 | ',' TOK_NAME clause 1329 1302 ; … … 1335 1308 | attr_spec_list ',' attr_spec 1336 1309 ; 1337 attr_spec: TOK_PARAMETER 1310 attr_spec: TOK_PARAMETER 1338 1311 { 1339 1312 VariableIsParameter = 1; 1340 if (inmoduledeclare == 1 )1341 {1342 AllocShouldMadeTo0InModule_1();1343 }1344 1313 } 1345 1314 | access_spec 1346 | TOK_ALLOCATABLE 1315 | TOK_ALLOCATABLE 1347 1316 {Allocatabledeclare = 1;} 1348 | TOK_DIMENSION dims 1349 { 1350 dimsgiven=1; 1317 | TOK_DIMENSION dims 1318 { 1319 dimsgiven=1; 1351 1320 curdim=$2; 1352 1321 } 1353 | TOK_EXTERNAL 1354 {ExternalDeclare = 1;} 1322 | TOK_EXTERNAL 1323 {ExternalDeclare = 1;} 1355 1324 | TOK_INTENT intent_spec 1356 1325 {strcpy(IntentSpec,$2);} … … 1359 1328 | TOK_POINTER {pointerdeclare = 1 ;} 1360 1329 | TOK_SAVE { 1361 if ( inmodulemeet == 1 )1362 { 1330 /* if ( inmodulemeet == 1 ) 1331 {*/ 1363 1332 SaveDeclare = 1 ; 1364 Savemeet = 1; 1365 AllocShouldMadeTo1InModule_1(); 1366 } 1333 /* }*/ 1367 1334 } 1368 1335 | TOK_TARGET … … 1371 1338 | TOK_OUT {sprintf($$,"out");} 1372 1339 | TOK_INOUT {sprintf($$,"inout");} 1373 ; 1374 access_spec: TOK_PUBLIC 1375 {PublicDeclare = 1;} 1376 | TOK_PRIVATE 1377 {PrivateDeclare = 1;} 1378 ; 1379 dims: {if ( created_dimensionlist == 1 ) $$=(listdim *)NULL;} 1380 | '(' dimlist ')' 1381 {if ( created_dimensionlist == 1 ) $$=$2;} 1382 ; 1383 dimlist: dim {if ( created_dimensionlist == 1 ) $$=insertdim(NULL,$1);} 1384 | dimlist ',' dim 1385 {if ( created_dimensionlist == 1 ) $$=insertdim($1,$3);} 1340 ; 1341 access_spec: TOK_PUBLIC 1342 {PublicDeclare = 1;} 1343 | TOK_PRIVATE 1344 {PrivateDeclare = 1;} 1345 ; 1346 dims: {if ( created_dimensionlist == 1 ) 1347 { 1348 $$=(listdim *)NULL; 1349 } 1350 } 1351 | '(' dimlist ')' 1352 {if ( created_dimensionlist == 1 || 1353 agrif_parentcall == 1 ) $$=$2;} 1354 ; 1355 dimlist: dim {if ( created_dimensionlist == 1 || 1356 agrif_parentcall == 1 ) $$=insertdim(NULL,$1);} 1357 | dimlist ',' dim 1358 {if ( couldaddvariable == 1 ) 1359 if ( created_dimensionlist == 1 ) $$=insertdim($1,$3);} 1386 1360 ; 1387 1361 dim:ubound {strcpy($$.first,"1");strcpy($$.last,$1);} … … 1395 1369 | expr {strcpy($$,$1);} 1396 1370 ; 1397 expr: uexpr { strcpy($$,$1);}1398 | '(' expr ')' 1399 { sprintf($$,"(%s)",$2);}1400 | complex_const 1401 { strcpy($$,$1);}1371 expr: uexpr {if ( couldaddvariable == 1 ) strcpy($$,$1);} 1372 | '(' expr ')' 1373 {if ( couldaddvariable == 1 ) sprintf($$,"(%s)",$2);} 1374 | complex_const 1375 {if ( couldaddvariable == 1 ) strcpy($$,$1);} 1402 1376 | predefinedfunction 1403 ; 1404 1405 predefinedfunction : TOK_SUM minmaxlist ')' 1377 {if ( couldaddvariable == 1 ) strcpy($$,$1);} 1378 ; 1379 1380 predefinedfunction : TOK_SUM minmaxlist ')' 1406 1381 {sprintf($$,"SUM(%s)",$2);} 1407 1382 | TOK_MAX minmaxlist ')' … … 1422 1397 {sprintf($$,"REAL(%s)",$3);} 1423 1398 | TOK_INT '(' expr ')' 1424 {sprintf($$,"INT(%s)",$3);} 1399 {sprintf($$,"INT(%s)",$3);} 1425 1400 | TOK_NINT '(' expr ')' 1426 {sprintf($$,"NINT(%s)",$3);} 1401 {sprintf($$,"NINT(%s)",$3);} 1427 1402 | TOK_FLOAT '(' expr ')' 1428 1403 {sprintf($$,"FLOAT(%s)",$3);} … … 1459 1434 ; 1460 1435 minmaxlist : expr {strcpy($$,$1);} 1461 | minmaxlist ',' expr 1462 {strcpy($$,$1);strcat($$,",");strcat($$,$3);} 1463 ; 1464 uexpr: lhs {strcpy($$,$1);} 1465 | simple_const 1466 {strcpy($$,$1);} 1467 | vec 1468 {strcpy($$,$1);} 1436 | minmaxlist ',' expr 1437 {if ( couldaddvariable == 1 ) 1438 { strcpy($$,$1);strcat($$,",");strcat($$,$3);}} 1439 ; 1440 uexpr: lhs {if ( couldaddvariable == 1 ) strcpy($$,$1);} 1441 | simple_const 1442 {if ( couldaddvariable == 1 ) strcpy($$,$1);} 1443 | vec 1444 {if ( couldaddvariable == 1 ) strcpy($$,$1);} 1469 1445 | expr operation 1470 { sprintf($$,"%s%s",$1,$2);}1446 {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);} 1471 1447 | signe expr %prec '* ' 1472 { sprintf($$,"%s%s",$1,$2);}1473 | TOK_NOT expr 1474 { sprintf($$,"%s%s",$1,$2);}1475 ; 1476 signe : '+' { strcpy($$,"+");}1477 | '-' { strcpy($$,"-");}1478 ; 1479 operation : '+' expr %prec '+' 1480 { sprintf($$,"+%s",$2);}1481 | '-' expr %prec '+' 1482 { sprintf($$,"-%s",$2);}1483 | '*' expr 1484 { sprintf($$,"*%s",$2);}1485 | TOK_DASTER expr 1486 { sprintf($$,"%s%s",$1,$2);}1487 | TOK_EQ expr %prec TOK_EQ 1488 { sprintf($$,"%s%s",$1,$2);}1489 | TOK_GT expr %prec TOK_EQ 1490 { sprintf($$,"%s%s",$1,$2);}1491 | '>' expr %prec TOK_EQ 1492 { sprintf($$," > %s",$2);}1493 | TOK_LT expr %prec TOK_EQ 1494 { sprintf($$,"%s%s",$1,$2);}1495 | '<' expr %prec TOK_EQ 1496 { sprintf($$," < %s",$2);}1497 | TOK_GE expr %prec TOK_EQ 1498 { sprintf($$,"%s%s",$1,$2);}1499 | '>''=' expr %prec TOK_EQ 1500 { sprintf($$," >= %s",$3);}1448 {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);} 1449 | TOK_NOT expr 1450 {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);} 1451 ; 1452 signe : '+' {if ( couldaddvariable == 1 ) strcpy($$,"+");} 1453 | '-' {if ( couldaddvariable == 1 ) strcpy($$,"-");} 1454 ; 1455 operation : '+' expr %prec '+' 1456 {if ( couldaddvariable == 1 ) sprintf($$,"+%s",$2);} 1457 | '-' expr %prec '+' 1458 {if ( couldaddvariable == 1 ) sprintf($$,"-%s",$2);} 1459 | '*' expr 1460 {if ( couldaddvariable == 1 ) sprintf($$,"*%s",$2);} 1461 | TOK_DASTER expr 1462 {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);} 1463 | TOK_EQ expr %prec TOK_EQ 1464 {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);} 1465 | TOK_GT expr %prec TOK_EQ 1466 {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);} 1467 | '>' expr %prec TOK_EQ 1468 {if ( couldaddvariable == 1 ) sprintf($$," > %s",$2);} 1469 | TOK_LT expr %prec TOK_EQ 1470 {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);} 1471 | '<' expr %prec TOK_EQ 1472 {if ( couldaddvariable == 1 ) sprintf($$," < %s",$2);} 1473 | TOK_GE expr %prec TOK_EQ 1474 {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);} 1475 | '>''=' expr %prec TOK_EQ 1476 {if ( couldaddvariable == 1 ) sprintf($$," >= %s",$3);} 1501 1477 | TOK_LE expr %prec TOK_EQ 1502 { sprintf($$,"%s%s",$1,$2);}1503 | '<''=' expr %prec TOK_EQ 1504 { sprintf($$," <= %s",$3);}1505 | TOK_NE expr %prec TOK_EQ 1506 { sprintf($$,"%s%s",$1,$2);}1507 | TOK_XOR expr 1508 { sprintf($$,"%s%s",$1,$2);}1509 | TOK_OR expr 1510 { sprintf($$,"%s%s",$1,$2);}1511 | TOK_AND expr 1512 { sprintf($$,"%s%s",$1,$2);}1478 {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);} 1479 | '<''=' expr %prec TOK_EQ 1480 {if ( couldaddvariable == 1 ) sprintf($$," <= %s",$3);} 1481 | TOK_NE expr %prec TOK_EQ 1482 {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);} 1483 | TOK_XOR expr 1484 {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);} 1485 | TOK_OR expr 1486 {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);} 1487 | TOK_AND expr 1488 {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);} 1513 1489 | TOK_SLASH after_slash 1514 { sprintf($$,"%s",$2);}1490 {if ( couldaddvariable == 1 ) sprintf($$,"%s",$2);} 1515 1491 | '=' after_equal 1516 { sprintf($$,"%s",$2);}1492 {if ( couldaddvariable == 1 ) sprintf($$,"%s",$2);} 1517 1493 1518 1494 after_slash : {strcpy($$,"");} 1519 | expr 1495 | expr 1520 1496 {sprintf($$,"/%s",$1);} 1521 | '=' expr %prec TOK_EQ 1497 | '=' expr %prec TOK_EQ 1522 1498 {sprintf($$,"/= %s",$2);} 1523 1499 | TOK_SLASH expr 1524 1500 {sprintf($$,"//%s",$2);} 1525 1501 ; 1526 after_equal : '=' expr %prec TOK_EQ 1527 { sprintf($$,"==%s",$2);}1502 after_equal : '=' expr %prec TOK_EQ 1503 {if ( couldaddvariable == 1 ) sprintf($$,"==%s",$2);} 1528 1504 | expr 1529 { sprintf($$,"= %s",$1);}1530 ; 1531 1532 lhs: ident { strcpy($$,$1);}1533 | structure_component 1534 { strcpy($$,$1);}1535 | array_ele_substring_func_ref 1536 { strcpy($$,$1);}1505 {if ( couldaddvariable == 1 ) sprintf($$,"= %s",$1);} 1506 ; 1507 1508 lhs: ident {if ( couldaddvariable == 1 ) strcpy($$,$1);} 1509 | structure_component 1510 {if ( couldaddvariable == 1 ) strcpy($$,$1);} 1511 | array_ele_substring_func_ref 1512 {if ( couldaddvariable == 1 ) strcpy($$,$1);} 1537 1513 ; 1538 1514 beforefunctionuse : { … … 1541 1517 agrif_parentcall =1; 1542 1518 if ( Agrif_in_Tok_NAME(identcopy) == 1 ) 1543 { 1519 { 1544 1520 inagrifcallargument = 1; 1545 AddsubroutineTolistsubwhereagrifused(); 1521 Add_SubroutineWhereAgrifUsed_1(subroutinename, 1522 curmodulename); 1546 1523 } 1547 1524 } … … 1552 1529 if ( incalldeclare == 0 ) inagrifcallargument = 0; 1553 1530 } 1554 | begin_array substring 1555 {sprintf($$," %s %s ",$1,$2);} 1556 | structure_component '(' funarglist ')' 1557 {sprintf($$," %s ( %s )",$1,$3);} 1558 | structure_component '(' funarglist ')' substring 1559 {sprintf($$," %s ( %s ) %s ",$1,$3,$5);} 1531 | begin_array substring 1532 {if ( couldaddvariable == 1 ) sprintf($$," %s %s ",$1,$2);} 1533 | structure_component '(' funarglist ')' 1534 {if ( couldaddvariable == 1 ) 1535 sprintf($$," %s ( %s )",$1,$3);} 1536 | structure_component '(' funarglist ')' substring 1537 {if ( couldaddvariable == 1 ) 1538 sprintf($$," %s ( %s ) %s ",$1,$3,$5);} 1560 1539 ; 1561 1540 begin_array : ident '(' funarglist ')' 1562 1541 { 1563 sprintf($$," %s ( %s )",$1,$3); 1564 ModifyTheAgrifFunction_0($3); 1565 agrif_parentcall =0; 1566 } 1567 ; 1568 structure_component: lhs '%' lhs 1542 if ( couldaddvariable == 1 ) 1543 { 1544 sprintf($$," %s ( %s )",$1,$3); 1545 ModifyTheAgrifFunction_0($3); 1546 agrif_parentcall =0; 1547 } 1548 } 1549 ; 1550 structure_component: lhs '%' lhs 1569 1551 { 1570 1552 sprintf($$," %s %% %s ",$1,$3); 1571 if ( incalldeclare == 0 ) inagrifcallargument = 0;1572 } 1573 ; 1574 vec: TOK_LEFTAB outlist TOK_RIGHTAB 1575 {sprintf($$,"(/%s/)",$2);} 1553 if ( incalldeclare == 0 ) inagrifcallargument = 0; 1554 } 1555 ; 1556 vec: TOK_LEFTAB outlist TOK_RIGHTAB 1557 {sprintf($$,"(/%s/)",$2);} 1576 1558 ; 1577 1559 funarglist: beforefunctionuse {strcpy($$," ");} 1578 | beforefunctionuse funargs 1560 | beforefunctionuse funargs 1579 1561 {strcpy($$,$2);} 1580 1562 ; 1581 funargs: funarg { strcpy($$,$1);}1582 | funargs ',' funarg 1583 { sprintf($$,"%s,%s",$1,$3);}1563 funargs: funarg {if ( couldaddvariable == 1 ) strcpy($$,$1);} 1564 | funargs ',' funarg 1565 {if ( couldaddvariable == 1 ) sprintf($$,"%s,%s",$1,$3);} 1584 1566 ; 1585 1567 funarg: expr {strcpy($$,$1);} 1586 1568 | triplet {strcpy($$,$1);} 1587 1569 ; 1588 triplet: expr ':' expr 1589 {sprintf($$,"%s:%s",$1,$3);} 1590 | expr ':' expr ':' expr 1591 {sprintf($$,"%s:%s:%s",$1,$3,$5);} 1592 | ':' expr ':' expr 1593 {sprintf($$,":%s:%s",$2,$4);} 1594 | ':' ':' expr{sprintf($$,": : %s",$3);} 1595 | ':' expr {sprintf($$,":%s",$2);} 1596 | expr ':' {sprintf($$,"%s:",$1);} 1597 | ':' {sprintf($$,":");} 1598 ; 1599 ident : TOK_NAME { 1570 triplet: expr ':' expr 1571 {if ( couldaddvariable == 1 ) sprintf($$,"%s:%s",$1,$3);} 1572 | expr ':' expr ':' expr 1573 {if ( couldaddvariable == 1 ) 1574 sprintf($$,"%s:%s:%s",$1,$3,$5);} 1575 | ':' expr ':' expr 1576 {if ( couldaddvariable == 1 ) sprintf($$,":%s:%s",$2,$4);} 1577 | ':' ':' expr{if ( couldaddvariable == 1 ) sprintf($$,": : %s",$3);} 1578 | ':' expr {if ( couldaddvariable == 1 ) sprintf($$,":%s",$2);} 1579 | expr ':' {if ( couldaddvariable == 1 ) sprintf($$,"%s:",$1);} 1580 | ':' {if ( couldaddvariable == 1 ) sprintf($$,":");} 1581 ; 1582 ident : TOK_NAME { 1583 if ( couldaddvariable == 1 ) 1584 { 1585 if ( Vartonumber($1) == 1 ) 1586 { 1587 Add_SubroutineWhereAgrifUsed_1(subroutinename, 1588 curmodulename); 1589 } 1590 if (!strcasecmp($1,"Agrif_Parent") ) 1591 agrif_parentcall =1; 1600 1592 if ( VariableIsNotFunction($1) == 0 ) 1601 1593 { … … 1611 1603 pointedvar=0; 1612 1604 if ( VarIsNonGridDepend($1) == 0 && 1613 formatdeclare == 0 1614 ) 1605 Variableshouldberemove($1) == 0 ) 1615 1606 { 1616 1607 if ( inagrifcallargument == 1 || … … 1620 1611 ModifyTheVariableName_0($1); 1621 1612 } 1622 if ( inagrifcallargument != 1 || sameagrifargument ==1 ) 1623 ajoutevarindoloop_1($1); 1613 if ( inagrifcallargument != 1 || 1614 sameagrifargument ==1 ) 1615 Add_UsedInSubroutine_Var_1($1); 1624 1616 } 1625 1617 NotifyAgrifFunction_0($1); 1626 1618 } 1627 } 1628 ; 1629 simple_const: TOK_TRUE 1630 {strcpy($$,".TRUE.");} 1631 | TOK_FALSE {strcpy($$,".FALSE.");} 1632 | TOK_CSTINT {strcpy($$,$1);} 1633 | TOK_CSTREAL {strcpy($$,$1);} 1634 | TOK_CSTREALDP{strcpy($$,$1);} 1635 | TOK_CSTREALQP{strcpy($$,$1);} 1636 | simple_const TOK_NAME 1637 {sprintf($$,"%s%s",$1,$2);} 1619 } 1620 } 1621 ; 1622 simple_const: TOK_TRUE 1623 {if ( couldaddvariable == 1 ) strcpy($$,".TRUE.");} 1624 | TOK_FALSE {if ( couldaddvariable == 1 ) strcpy($$,".FALSE.");} 1625 | TOK_CSTINT {if ( couldaddvariable == 1 ) strcpy($$,$1);} 1626 | TOK_CSTREAL {if ( couldaddvariable == 1 ) strcpy($$,$1);} 1627 | TOK_CSTREALDP{if ( couldaddvariable == 1 ) strcpy($$,$1);} 1628 | TOK_CSTREALQP{if ( couldaddvariable == 1 ) strcpy($$,$1);} 1629 | simple_const TOK_NAME 1630 {if ( couldaddvariable == 1 ) sprintf($$,"%s%s",$1,$2);} 1638 1631 | string_constant opt_substring 1639 1632 ; 1640 string_constant: TOK_CHAR_CONSTANT 1641 { strcpy($$,$1);}1642 | string_constant TOK_CHAR_CONSTANT 1643 | TOK_CHAR_MESSAGE 1644 { strcpy($$,$1);}1633 string_constant: TOK_CHAR_CONSTANT 1634 {if ( couldaddvariable == 1 ) strcpy($$,$1);} 1635 | string_constant TOK_CHAR_CONSTANT 1636 | TOK_CHAR_MESSAGE 1637 {if ( couldaddvariable == 1 ) strcpy($$,$1);} 1645 1638 | TOK_CHAR_CUT 1646 { strcpy($$,$1);}1647 ; 1648 opt_substring: { strcpy($$," ");}1649 | substring { strcpy($$,$1);}1650 ; 1651 substring: '(' optexpr ':' optexpr ')' 1652 { sprintf($$,"(%s:%s)",$2,$4);}1653 ; 1654 optexpr: { strcpy($$," ");}1655 | expr { strcpy($$,$1);}1656 ; 1657 opt_expr: '\n' { strcpy($$," ");}1658 | expr { strcpy($$,$1);}1639 {if ( couldaddvariable == 1 ) strcpy($$,$1);} 1640 ; 1641 opt_substring: {if ( couldaddvariable == 1 ) strcpy($$," ");} 1642 | substring {if ( couldaddvariable == 1 ) strcpy($$,$1);} 1643 ; 1644 substring: '(' optexpr ':' optexpr ')' 1645 {if ( couldaddvariable == 1 ) sprintf($$,"(%s:%s)",$2,$4);} 1646 ; 1647 optexpr: {if ( couldaddvariable == 1 ) strcpy($$," ");} 1648 | expr {if ( couldaddvariable == 1 ) strcpy($$,$1);} 1649 ; 1650 opt_expr: '\n' {if ( couldaddvariable == 1 ) strcpy($$," ");} 1651 | expr {if ( couldaddvariable == 1 ) strcpy($$,$1);} 1659 1652 ; 1660 1653 initial_value: {InitialValueGiven = 0;} 1661 | before_initial '=' expr 1654 | before_initial '=' expr 1662 1655 { 1663 strcpy(InitValue,$3); 1664 InitialValueGiven = 1; 1665 } 1656 if ( couldaddvariable == 1 ) 1657 { 1658 strcpy(InitValue,$3); 1659 InitialValueGiven = 1; 1660 } 1661 } 1666 1662 ; 1667 1663 before_initial : {pos_curinit = setposcur();} 1668 1664 ; 1669 complex_const: '(' uexpr ',' uexpr ')' 1670 {sprintf($$,"(%s,%s)",$2,$4);} 1665 complex_const: '(' uexpr ',' uexpr ')' 1666 {sprintf($$,"(%s,%s)",$2,$4);} 1671 1667 ; 1672 1668 use_stat: word_use module_name 1673 1669 { 1670 if ( couldaddvariable == 1 ) 1671 { 1674 1672 /* if variables has been declared in a subroutine */ 1675 1673 if (insubroutinedeclare == 1) … … 1678 1676 } 1679 1677 sprintf(charusemodule,"%s",$2); 1680 Add moduletothelist_1($2);1678 Add_NameOfModuleUsed_1($2); 1681 1679 1682 1680 if ( inmoduledeclare == 0 ) … … 1686 1684 pos_end-pos_curuse); 1687 1685 } 1688 } 1686 } 1687 } 1689 1688 | word_use module_name ',' rename_list 1690 1689 { 1690 if ( couldaddvariable == 1 ) 1691 { 1691 1692 if (insubroutinedeclare == 1) 1692 1693 { 1693 completelistvarpointtovar_1($2,$4);1694 } 1695 if ( firstpass == 1 ) 1694 Add_CouplePointed_Var_1($2,$4); 1695 } 1696 if ( firstpass == 1 ) 1696 1697 { 1697 1698 if ( insubroutinedeclare == 1 ) … … 1701 1702 while ( coupletmp ) 1702 1703 { 1703 strcat(ligne,coupletmp-> namevar);1704 strcat(ligne,coupletmp->c_namevar); 1704 1705 strcat(ligne," => "); 1705 strcat(ligne,coupletmp-> namepointedvar);1706 strcat(ligne,coupletmp->c_namepointedvar); 1706 1707 coupletmp = coupletmp->suiv; 1707 1708 if ( coupletmp ) strcat(ligne,","); … … 1709 1710 sprintf(charusemodule,"%s",$2); 1710 1711 } 1711 Add moduletothelist_1($2);1712 Add_NameOfModuleUsed_1($2); 1712 1713 } 1713 1714 if ( inmoduledeclare == 0 ) … … 1717 1718 pos_end-pos_curuse); 1718 1719 } 1719 } 1720 } 1721 } 1720 1722 | word_use module_name ',' TOK_ONLY ':' '\n' 1721 1723 { 1724 if ( couldaddvariable == 1 ) 1725 { 1722 1726 /* if variables has been declared in a subroutine */ 1723 1727 if (insubroutinedeclare == 1) … … 1726 1730 } 1727 1731 sprintf(charusemodule,"%s",$2); 1728 Add moduletothelist_1($2);1732 Add_NameOfModuleUsed_1($2); 1729 1733 1730 1734 if ( inmoduledeclare == 0 ) … … 1734 1738 pos_end-pos_curuse); 1735 1739 } 1736 } 1740 } 1741 } 1737 1742 | word_use module_name ',' TOK_ONLY ':' only_list 1738 1743 { 1744 if ( couldaddvariable == 1 ) 1745 { 1739 1746 /* if variables has been declared in a subroutine */ 1740 1747 if (insubroutinedeclare == 1) 1741 1748 { 1742 completelistvarpointtovar_1($2,$6);1749 Add_CouplePointed_Var_1($2,$6); 1743 1750 } 1744 if ( firstpass == 1 ) 1751 if ( firstpass == 1 ) 1745 1752 { 1746 1753 if ( insubroutinedeclare == 1 ) … … 1750 1757 while ( coupletmp ) 1751 1758 { 1752 strcat(ligne,coupletmp-> namevar);1753 if ( strcasecmp(coupletmp->namepointedvar,"") )1759 strcat(ligne,coupletmp->c_namevar); 1760 if ( strcasecmp(coupletmp->c_namepointedvar,"") ) 1754 1761 strcat(ligne," => "); 1755 strcat(ligne,coupletmp-> namepointedvar);1762 strcat(ligne,coupletmp->c_namepointedvar); 1756 1763 coupletmp = coupletmp->suiv; 1757 1764 if ( coupletmp ) strcat(ligne,","); … … 1759 1766 sprintf(charusemodule,"%s",$2); 1760 1767 } 1761 Add moduletothelist_1($2);1768 Add_NameOfModuleUsed_1($2); 1762 1769 } 1763 1770 if ( firstpass == 0 ) 1764 1771 { 1765 1772 if ( inmoduledeclare == 0 ) 1766 1773 { … … 1769 1776 pos_end-pos_curuse); 1770 1777 } 1771 1772 1773 1774 1775 1776 1778 else 1779 { 1780 /* if we are in the module declare and if the */ 1781 /* onlylist is a list of global variable */ 1782 variableisglobalinmodule($6, $2, fortranout); 1783 } 1777 1784 } 1778 } 1785 } 1786 } 1779 1787 ; 1780 1788 word_use : TOK_USE … … 1783 1791 } 1784 1792 ; 1785 module_name: TOK_NAME 1793 module_name: TOK_NAME 1786 1794 {strcpy($$,$1);} 1787 1795 ; 1788 1796 rename_list: rename_name 1789 1797 { 1790 $$ = $1;1791 } 1798 if ( couldaddvariable == 1 ) $$ = $1; 1799 } 1792 1800 | rename_list ',' rename_name 1793 1801 { 1802 if ( couldaddvariable == 1 ) 1803 { 1794 1804 /* insert the variable in the list $1 */ 1795 1805 $3->suiv = $1; 1796 1806 $$ = $3; 1807 } 1797 1808 } 1798 1809 ; … … 1800 1811 { 1801 1812 coupletmp =(listcouple *)malloc(sizeof(listcouple)); 1802 strcpy(coupletmp-> namevar,$1);1803 strcpy(coupletmp-> namepointedvar,$3);1813 strcpy(coupletmp->c_namevar,$1); 1814 strcpy(coupletmp->c_namepointedvar,$3); 1804 1815 coupletmp->suiv = NULL; 1805 1816 $$ = coupletmp; 1806 1817 } 1807 1818 ; 1808 only_list: only_name 1819 only_list: only_name 1809 1820 { 1810 $$ = $1;1811 } 1821 if ( couldaddvariable == 1 ) $$ = $1; 1822 } 1812 1823 | only_list ',' only_name 1813 1824 { 1825 if ( couldaddvariable == 1 ) 1826 { 1814 1827 /* insert the variable in the list $1 */ 1815 1828 $3->suiv = $1; 1816 1829 $$ = $3; 1830 } 1817 1831 } 1818 1832 ; 1819 only_name: TOK_NAME TOK_POINT_TO TOK_NAME 1833 only_name: TOK_NAME TOK_POINT_TO TOK_NAME 1820 1834 { 1821 1835 coupletmp =(listcouple *)malloc(sizeof(listcouple)); 1822 strcpy(coupletmp-> namevar,$1);1823 strcpy(coupletmp-> namepointedvar,$3);1836 strcpy(coupletmp->c_namevar,$1); 1837 strcpy(coupletmp->c_namepointedvar,$3); 1824 1838 coupletmp->suiv = NULL; 1825 1839 $$ = coupletmp; 1826 1840 pointedvar=1; 1827 ajoutevarindoloop_1($1);1841 Add_UsedInSubroutine_Var_1($1); 1828 1842 } 1829 1843 | TOK_NAME { 1830 1844 coupletmp =(listcouple *)malloc(sizeof(listcouple)); 1831 strcpy(coupletmp-> namevar,$1);1832 strcpy(coupletmp-> namepointedvar,"");1845 strcpy(coupletmp->c_namevar,$1); 1846 strcpy(coupletmp->c_namepointedvar,""); 1833 1847 coupletmp->suiv = NULL; 1834 1848 $$ = coupletmp; … … 1837 1851 exec: iffable 1838 1852 | TOK_ALLOCATE '(' allocation_list opt_stat_spec ')' 1853 { 1854 Add_SubroutineWhereAgrifUsed_1(subroutinename, 1855 curmodulename); 1856 } 1839 1857 | TOK_DEALLOCATE '(' allocate_object_list opt_stat_spec ')' 1858 { 1859 Add_SubroutineWhereAgrifUsed_1(subroutinename, 1860 curmodulename); 1861 } 1840 1862 | TOK_NULLIFY '(' pointer_name_list ')' 1841 | TOK_ENDUNIT /* end*/1863 | word_endunit /* end */ 1842 1864 { 1865 GlobalDeclaration = 0 ; 1866 if ( firstpass == 0 && 1867 strcasecmp(subroutinename,"") ) 1868 { 1869 if ( module_declar && insubroutinedeclare == 0 ) 1870 { 1871 fclose(module_declar); 1872 } 1873 } 1874 if ( couldaddvariable == 1 && 1875 strcasecmp(subroutinename,"") ) 1876 { 1843 1877 if ( inmodulemeet == 1 ) 1844 1878 { … … 1848 1882 /* it is like an end subroutine <name> */ 1849 1883 insubroutinedeclare = 0 ; 1850 paramdeclaration_everdone = 0;1851 tmpdeclaration_everdone = 0;1852 1884 /* */ 1853 closeandcallsubloopandincludeit_0(1,$1,""); 1854 /* at the end of the firstpas we should remove */ 1855 /* from the listvarindoloop all variables */ 1856 /* which has not been declared as table in the */ 1857 /* globliste */ 1858 cleanlistvarfordoloop_1(1); 1885 pos_cur = setposcur(); 1886 closeandcallsubloopandincludeit_0(1,$1); 1887 functiondeclarationisdone = 0; 1859 1888 } 1860 1889 else 1861 1890 { 1862 /* if we never meet the contains keyword */1863 if ( inmoduledeclare == 1 )1864 {1865 if ( aftercontainsdeclare == 0 )1866 {1867 CompleteGlobListeWithDatalist_1();1868 addsubroutine_alloc_0(1);1869 }1870 }1871 1891 /* it is like an end module <name> */ 1872 inmoduledeclare = 0 ; 1873 inmodulemeet = 0 ; 1892 inmoduledeclare = 0 ; 1893 inmodulemeet = 0 ; 1874 1894 } 1875 1895 } 1876 1896 else 1877 1897 { 1878 paramdeclaration_everdone = 0;1879 tmpdeclaration_everdone = 0;1880 1898 insubroutinedeclare = 0; 1881 1899 /* */ 1882 closeandcallsubloopandincludeit_0(2,$1,""); 1883 /* it is like end subroutine or end program */ 1884 /* Common case */ 1885 /* at the end of the firstpas we should remove */ 1886 /* from the listvarindoloop all variables which */ 1887 /* has not been declared as table in the */ 1888 /* globliste */ 1889 cleanlistvarfordoloop_1(1); 1890 } 1900 pos_cur = setposcur(); 1901 closeandcallsubloopandincludeit_0(2,$1); 1902 functiondeclarationisdone = 0; 1903 if ( firstpass == 0 ) 1904 { 1905 if ( retour77 == 0 ) fprintf(paramout,"!\n"); 1906 else fprintf(paramout,"C\n"); 1907 fclose(paramout); 1908 } 1909 } 1910 } 1911 strcpy(subroutinename,""); 1891 1912 } 1892 | TOK_ENDPROGRAMopt_name1913 | word_endprogram opt_name 1893 1914 { 1894 tmpdeclaration_everdone = 0;1895 paramdeclaration_everdone = 0;1915 if ( couldaddvariable == 1 ) 1916 { 1896 1917 insubroutinedeclare = 0; 1897 1918 /* */ 1898 closeandcallsubloopandincludeit_0(3,$1,$2); 1899 /* Common case */ 1900 /* at the end of the firstpas we should remove from */ 1901 /* the listvarindoloop all variables which has not */ 1902 /* been declared as table in the globliste */ 1903 cleanlistvarfordoloop_1(3); 1919 pos_cur = setposcur(); 1920 closeandcallsubloopandincludeit_0(3,$1); 1921 functiondeclarationisdone = 0; 1922 if ( firstpass == 0 ) 1923 { 1924 if ( retour77 == 0 ) fprintf(paramout,"!\n"); 1925 else fprintf(paramout,"C\n"); 1926 fclose(paramout); 1927 } 1928 strcpy(subroutinename,""); 1929 } 1904 1930 } 1905 | TOK_ENDSUBROUTINEopt_name1931 | word_endsubroutine opt_name 1906 1932 { 1907 tmpdeclaration_everdone = 0; 1908 paramdeclaration_everdone = 0; 1933 if ( couldaddvariable == 1 && 1934 strcasecmp(subroutinename,"") ) 1935 { 1909 1936 insubroutinedeclare = 0; 1910 1937 /* */ 1911 closeandcallsubloopandincludeit_0(1,$1,$2); 1912 /* Common case */ 1913 /* at the end of the firstpas we should remove from */ 1914 /* the listvarindoloop all variables which has not */ 1915 /* been declared as table in the globliste */ 1916 cleanlistvarfordoloop_1(1); 1938 pos_cur = setposcur(); 1939 closeandcallsubloopandincludeit_0(1,$1); 1940 functiondeclarationisdone = 0; 1941 if ( firstpass == 0 ) 1942 { 1943 if ( retour77 == 0 ) fprintf(paramout,"!\n"); 1944 else fprintf(paramout,"C\n"); 1945 fclose(paramout); 1946 } 1947 strcpy(subroutinename,""); 1948 } 1917 1949 } 1918 | TOK_ENDFUNCTIONopt_name1950 | word_endfunction opt_name 1919 1951 { 1920 tmpdeclaration_everdone = 0;1921 paramdeclaration_everdone = 0;1952 if ( couldaddvariable == 1 ) 1953 { 1922 1954 insubroutinedeclare = 0; 1923 1955 /* */ 1924 closeandcallsubloopandincludeit_0(0,$1,$2); 1925 /* Common case */ 1926 /* at the end of the firstpas we should remove from */ 1927 /* the listvarindoloop all variables which has not */ 1928 /* been declared as table in the globliste */ 1929 cleanlistvarfordoloop_1(0); 1956 pos_cur = setposcur(); 1957 closeandcallsubloopandincludeit_0(0,$1); 1958 functiondeclarationisdone = 0; 1959 if ( firstpass == 0 ) 1960 { 1961 if ( retour77 == 0 ) fprintf(paramout,"!\n"); 1962 else fprintf(paramout,"C\n"); 1963 fclose(paramout); 1964 } 1965 strcpy(subroutinename,""); 1966 } 1930 1967 } 1931 1968 | TOK_ENDMODULE opt_name 1932 1969 { 1970 if ( couldaddvariable == 1 ) 1971 { 1933 1972 /* if we never meet the contains keyword */ 1973 Remove_Word_end_module_0(); 1934 1974 if ( inmoduledeclare == 1 ) 1935 1975 { 1936 1976 if ( aftercontainsdeclare == 0 ) 1937 1977 { 1938 CompleteGlobListeWithDatalist_1(); 1939 addsubroutine_alloc_0(1); 1978 Write_GlobalParameter_Declaration_0(); 1979 Write_NotGridDepend_Declaration_0(); 1980 Write_Alloc_Subroutine_For_End_0(); 1940 1981 } 1941 1982 } 1942 inmoduledeclare = 0 ; 1943 inmodulemeet = 0 ; 1983 inmoduledeclare = 0 ; 1984 inmodulemeet = 0 ; 1985 1986 Write_Word_end_module_0(); 1987 strcpy(curmodulename,""); 1988 aftercontainsdeclare = 1; 1989 if ( firstpass == 0 ) 1990 { 1991 if ( module_declar && insubroutinedeclare == 0) 1992 { 1993 fclose(module_declar); 1994 } 1995 } 1996 GlobalDeclaration = 0 ; 1997 } 1944 1998 } 1945 1999 | boucledo … … 1950 2004 | logif TOK_THEN 1951 2005 | TOK_ELSEIF '(' expr ')' TOK_THEN 1952 | TOK_ELSE 1953 | TOK_ENDIF 1954 | TOK_CASE '('caselist ')'2006 | TOK_ELSE 2007 | TOK_ENDIF opt_name 2008 | TOK_CASE caselist ')' 1955 2009 | TOK_SELECTCASE '(' expr ')' 1956 2010 | TOK_CASEDEFAULT … … 1960 2014 if (inmoduledeclare == 1 ) 1961 2015 { 1962 CompleteGlobListeWithDatalist_1(); 1963 addsubroutine_alloc_0(0); 1964 } 1965 inmoduledeclare = 0 ; 1966 aftercontainsdeclare = 1; 1967 } 1968 ; 1969 2016 Remove_Word_Contains_0(); 2017 Write_GlobalParameter_Declaration_0(); 2018 Write_NotGridDepend_Declaration_0(); 2019 Write_Alloc_Subroutine_0(); 2020 inmoduledeclare = 0 ; 2021 aftercontainsdeclare = 1; 2022 } 2023 else 2024 { 2025 if ( couldaddvariable == 1 ) 2026 { 2027 if ( firstpass == 1 ) List_ContainsSubroutine = 2028 Addtolistnom(subroutinename, 2029 List_ContainsSubroutine,0); 2030 insubroutinedeclare = 0; 2031 /* */ 2032 closeandcallsubloop_contains_0(); 2033 functiondeclarationisdone = 0; 2034 if ( firstpass == 0 ) 2035 { 2036 if ( retour77 == 0 ) fprintf(paramout,"!\n"); 2037 else fprintf(paramout,"C\n"); 2038 fclose(paramout); 2039 } 2040 } 2041 strcpy(subroutinename,""); 2042 } 2043 } 2044 ; 2045 word_endsubroutine: TOK_ENDSUBROUTINE 2046 { 2047 if ( couldaddvariable == 1 ) 2048 { 2049 strcpy($$,$1); 2050 pos_endsubroutine = setposcur()-strlen($1); 2051 functiondeclarationisdone = 0; 2052 } 2053 } 2054 ; 2055 word_endunit: TOK_ENDUNIT 2056 { 2057 if ( couldaddvariable == 1 ) 2058 { 2059 strcpy($$,$1); 2060 pos_endsubroutine = setposcur()-strlen($1); 2061 } 2062 } 2063 ; 2064 word_endprogram: TOK_ENDPROGRAM 2065 { 2066 if ( couldaddvariable == 1 ) 2067 { 2068 strcpy($$,$1); 2069 pos_endsubroutine = setposcur()-strlen($1); 2070 } 2071 } 2072 ; 2073 word_endfunction: TOK_ENDFUNCTION 2074 { 2075 if ( couldaddvariable == 1 ) 2076 { 2077 strcpy($$,$1); 2078 pos_endsubroutine = setposcur()-strlen($1); 2079 } 2080 } 2081 ; 1970 2082 caselist: expr 1971 2083 | caselist ',' expr 1972 2084 | caselist ':' expr 1973 2085 ; 1974 boucledo : worddo opt_int do_var '=' expr ',' expr 1975 | worddo opt_int do_var '=' expr ',' expr ',' expr 2086 boucledo : worddo opt_int do_arg 1976 2087 | wordwhile expr 1977 2088 | TOK_ENDDO optname 1978 2089 ; 1979 opt_int : 1980 | TOK_CSTINT 2090 do_arg : 2091 | do_var '=' expr ',' expr 2092 | do_var '=' expr ',' expr ',' expr 2093 opt_int : 2094 | TOK_CSTINT opt_comma 1981 2095 ; 1982 2096 opt_name : '\n' {strcpy($$,"");} … … 1989 2103 ; 1990 2104 wordwhile :TOK_DOWHILE 1991 ; 2105 ; 1992 2106 1993 2107 dotarget: … … 1999 2113 | goto 2000 2114 | io 2001 | call 2115 | call 2002 2116 | TOK_ALLOCATE '(' allocation_list opt_stat_spec ')' 2117 { 2118 Add_SubroutineWhereAgrifUsed_1(subroutinename, 2119 curmodulename); 2120 } 2003 2121 | TOK_DEALLOCATE '(' allocate_object_list opt_stat_spec ')' 2122 { 2123 Add_SubroutineWhereAgrifUsed_1(subroutinename, 2124 curmodulename); 2125 } 2004 2126 | TOK_EXIT optexpr 2005 2127 | TOK_RETURN opt_expr … … 2010 2132 before_dims : {if ( couldaddvariable == 1 ) created_dimensionlist = 0;} 2011 2133 ident_dims : ident before_dims dims dims 2012 {created_dimensionlist = 1;} 2134 { 2135 created_dimensionlist = 1; 2136 if ( agrif_parentcall == 1 ) 2137 { 2138 ModifyTheAgrifFunction_0($3->dim.last); 2139 agrif_parentcall =0; 2140 fprintf(fortranout," = "); 2141 } 2142 } 2013 2143 | ident_dims '%' ident before_dims dims dims 2014 2144 {created_dimensionlist = 1;} … … 2016 2146 | int_list ',' TOK_CSTINT 2017 2147 ; 2018 after_ident_dims : '=' expr 2019 | TOK_POINT_TO expr 2020 ; 2021 call: keywordcall opt_call 2148 after_ident_dims : '=' expr 2149 | TOK_POINT_TO expr 2150 ; 2151 call: keywordcall opt_call 2022 2152 { 2023 2153 inagrifcallargument = 0 ; 2024 2154 incalldeclare=0; 2025 if ( oldfortranout && 2026 !strcasecmp(meetagrifinitgrids,subroutinename) && 2155 if ( oldfortranout && 2156 !strcasecmp(meetagrifinitgrids,subroutinename) && 2027 2157 firstpass == 0 && 2028 2158 callmpiinit == 1) … … 2034 2164 ,mpiinitvar); 2035 2165 } 2036 if ( oldfortranout && 2037 callagrifinitgrids == 1 && 2166 if ( oldfortranout && 2167 callagrifinitgrids == 1 && 2038 2168 firstpass == 0 ) 2039 2169 { … … 2041 2171 RemoveWordSET_0(fortranout,pos_curcall, 2042 2172 pos_end-pos_curcall); 2043 fprintf(oldfortranout, 2044 " Call Agrif_Init_Grids () \n"); 2173 2045 2174 strcpy(subofagrifinitgrids,subroutinename); 2046 2175 } … … 2048 2177 } 2049 2178 ; 2050 opt_call : 2179 opt_call : 2051 2180 | '(' opt_callarglist ')' 2052 2181 ; … … 2054 2183 | callarglist 2055 2184 ; 2056 keywordcall : before_call TOK_NAME 2185 keywordcall : before_call TOK_NAME 2057 2186 { 2058 if (!strcasecmp($2,"MPI_Init") ) 2187 if (!strcasecmp($2,"MPI_Init") ) 2059 2188 { 2060 2189 callmpiinit = 1; 2061 strcpy(meetmpiinit,subroutinename);2062 2190 } 2063 2191 else … … 2065 2193 callmpiinit = 0; 2066 2194 } 2067 if (!strcasecmp($2,"Agrif_Init_Grids") ) 2195 if (!strcasecmp($2,"Agrif_Init_Grids") ) 2068 2196 { 2069 2197 callagrifinitgrids = 1; … … 2071 2199 } 2072 2200 else callagrifinitgrids = 0; 2073 if ( Vartonumber($2) == 1 ) 2201 if ( !strcasecmp($2,"Agrif_Open_File") ) 2202 { 2203 Add_SubroutineWhereAgrifUsed_1(subroutinename, 2204 curmodulename); 2205 } 2206 if ( Vartonumber($2) == 1 ) 2074 2207 { 2075 2208 incalldeclare=1; 2076 2209 inagrifcallargument = 1 ; 2077 AddsubroutineTolistsubwhereagrifused(); 2210 Add_SubroutineWhereAgrifUsed_1(subroutinename, 2211 curmodulename); 2078 2212 } 2079 2213 } … … 2086 2220 2087 2221 callarg: expr { 2088 if ( callmpiinit == 1 ) 2222 if ( callmpiinit == 1 ) 2089 2223 { 2090 2224 strcpy(mpiinitvar,$1); 2091 if ( firstpass == 1 ) 2225 if ( firstpass == 1 ) 2092 2226 { 2093 curvar=createvar($1,NULL); 2227 Add_UsedInSubroutine_Var_1 (mpiinitvar); 2228 /* curvar=createvar($1,NULL); 2094 2229 curlistvar=insertvar(NULL,curvar); 2095 listargsubroutine= AddListvarToListvar2096 (curlistvar,listargsubroutine,1);2230 List_Subr outineArgument_Var = AddListvarToListvar 2231 (curlistvar,List_SubroutineAr gument_Var,1);*/ 2097 2232 } 2098 2233 } … … 2108 2243 | read option_read 2109 2244 | TOK_REWIND after_rewind 2110 | print option_print 2111 | wordformat debut_format ioctl_format fin_format 2112 {formatdeclare = 0;} 2113 ; 2114 wordformat : TOK_FORMAT 2115 {formatdeclare = 1;} 2116 opt_ioctlformat : 2117 | ioctl_format 2118 ; 2119 opt_ioctl_format : 2120 | ',' ioctl_format 2121 | ',' '*' 2122 ; 2123 debut_format : TOK_LEFTAB opt_comma 2124 | '(' 2125 ; 2126 ioctl_format : format_expr 2127 | ioctl_format ',' format_expr 2128 ; 2129 format_expr : 2130 | uexpr 2131 | TOK_CSTINT TOK_CHAR_INT 2132 | TOK_CSTINT debut_format ioctl_format fin_format 2133 | TOK_SLASH opt_CHAR_INT 2134 | TOK_CHAR_INT TOK_SLASH format_expr 2135 | TOK_SLASH TOK_SLASH 2136 | TOK_CHAR_INT 2137 | '(' format_expr ')' 2138 | '(' uexpr ')' 2139 ; 2140 opt_CHAR_INT : 2245 | TOK_FORMAT 2246 ; 2247 opt_CHAR_INT : 2141 2248 | TOK_CSTINT TOK_NAME 2142 ;2143 fin_format : opt_comma TOK_RIGHTAB opt_comma2144 | ')'2145 2249 ; 2146 2250 idfile : '*' … … 2164 2268 ; 2165 2269 ioctl: '(' ctllist ')' 2166 | '(' fexpr ')' 2270 | '(' fexpr ')' 2167 2271 ; 2168 2272 after_rewind: '(' ident ')' 2273 | '(' TOK_CSTINT ')' 2274 | TOK_CSTINT 2275 | '(' uexpr ')' 2169 2276 | TOK_NAME 2170 2277 ; … … 2172 2279 | ctllist ',' ioclause 2173 2280 ; 2174 ioclause: fexpr 2281 ioclause: fexpr 2175 2282 | '*' 2176 2283 | TOK_DASTER 2177 | TOK_NAME expr 2284 | TOK_NAME expr 2178 2285 | TOK_NAME expr '%' ident_dims 2179 2286 | TOK_NAME '(' triplet ')' 2180 | TOK_NAME '*' 2181 | TOK_NAME TOK_DASTER 2287 | TOK_NAME '*' 2288 | TOK_NAME TOK_DASTER 2182 2289 ; 2183 2290 iofctl: TOK_OPEN … … 2191 2298 | TOK_INQUIRE 2192 2299 | TOK_WRITE 2193 ; 2194 print: TOK_PRINT fexpr 2195 | TOK_PRINT '*' 2300 | TOK_PRINT 2196 2301 ; 2197 2302 fexpr: unpar_fexpr … … 2208 2313 | TOK_FILE expr 2209 2314 | TOK_EXIST expr 2315 | TOK_ERR expr 2316 | TOK_END expr 2210 2317 | TOK_NAME '=' expr 2211 2318 ; … … 2216 2323 | inlist ',' inelt 2217 2324 ; 2218 opt_lhs : 2325 opt_lhs : 2219 2326 | lhs 2220 2327 ; … … 2222 2329 | '(' inlist ')' opt_operation 2223 2330 | predefinedfunction opt_operation 2224 | simple_const opt_operation 2331 | simple_const opt_operation 2225 2332 | '(' inlist ',' dospec ')' 2226 2333 ; … … 2228 2335 | operation 2229 2336 | opt_operation operation 2230 ; 2231 outlist: other { strcpy($$,$1);}2232 | out2 { strcpy($$,$1);}2337 ; 2338 outlist: other {if ( couldaddvariable == 1 ) strcpy($$,$1);} 2339 | out2 {if ( couldaddvariable == 1 ) strcpy($$,$1);} 2233 2340 ; 2234 2341 out2: uexpr ',' expr 2235 { sprintf($$,"%s,%s",$1,$3);}2236 | uexpr ',' other 2237 { sprintf($$,"%s,%s",$1,$3);}2238 | other ',' expr 2239 { sprintf($$,"%s,%s",$1,$3);}2240 | other ',' other 2241 { sprintf($$,"%s,%s",$1,$3);}2242 | out2 ',' expr 2243 { sprintf($$,"%s,%s",$1,$3);}2244 | out2 ',' other 2245 { sprintf($$,"%s,%s",$1,$3);}2246 | uexpr { strcpy($$,$1);}2247 | predefinedfunction { strcpy($$,$1);}2248 ; 2249 other: complex_const 2250 { strcpy($$,$1);}2251 | '(' expr ')' 2252 { sprintf($$," (%s)",$2);}2342 {if ( couldaddvariable == 1 ) sprintf($$,"%s,%s",$1,$3);} 2343 | uexpr ',' other 2344 {if ( couldaddvariable == 1 ) sprintf($$,"%s,%s",$1,$3);} 2345 | other ',' expr 2346 {if ( couldaddvariable == 1 ) sprintf($$,"%s,%s",$1,$3);} 2347 | other ',' other 2348 {if ( couldaddvariable == 1 ) sprintf($$,"%s,%s",$1,$3);} 2349 | out2 ',' expr 2350 {if ( couldaddvariable == 1 ) sprintf($$,"%s,%s",$1,$3);} 2351 | out2 ',' other 2352 {if ( couldaddvariable == 1 ) sprintf($$,"%s,%s",$1,$3);} 2353 | uexpr {if ( couldaddvariable == 1 ) strcpy($$,$1);} 2354 | predefinedfunction {if ( couldaddvariable == 1 ) strcpy($$,$1);} 2355 ; 2356 other: complex_const 2357 {if ( couldaddvariable == 1 ) strcpy($$,$1);} 2358 | '(' expr ')' 2359 {if ( couldaddvariable == 1 ) sprintf($$," (%s)",$2);} 2253 2360 | '(' uexpr ',' dospec ')' 2254 { sprintf($$,"(%s,%s)",$2,$4);}2361 {if ( couldaddvariable == 1 ) sprintf($$,"(%s,%s)",$2,$4);} 2255 2362 | '(' other ',' dospec ')' 2256 { sprintf($$,"(%s,%s)",$2,$4);}2363 {if ( couldaddvariable == 1 ) sprintf($$,"(%s,%s)",$2,$4);} 2257 2364 | '(' out2 ',' dospec ')' 2258 {sprintf($$,"(%s,%s)",$2,$4);} 2259 ; 2260 2261 dospec: TOK_NAME '=' expr ',' expr 2262 {sprintf($$,"%s=%s,%s)",$1,$3,$5);} 2263 | TOK_NAME '=' expr ',' expr ',' expr 2264 {sprintf($$,"%s=%s,%s,%s)",$1,$3,$5,$7);} 2365 {if ( couldaddvariable == 1 ) sprintf($$,"(%s,%s)",$2,$4);} 2366 ; 2367 2368 dospec: TOK_NAME '=' expr ',' expr 2369 {if ( couldaddvariable == 1 ) 2370 sprintf($$,"%s=%s,%s)",$1,$3,$5);} 2371 | TOK_NAME '=' expr ',' expr ',' expr 2372 {if ( couldaddvariable == 1 ) 2373 sprintf($$,"%s=%s,%s,%s)",$1,$3,$5,$7);} 2265 2374 ; 2266 2375 labellist: label … … 2269 2378 label: TOK_CSTINT 2270 2379 ; 2271 goto: TOK_PLAINGOTO label 2380 goto: TOK_PLAINGOTO '(' expr ',' expr ')' ',' expr 2381 | TOK_PLAINGOTO label 2272 2382 ; 2273 2383 allocation_list: allocate_object … … 2276 2386 ; 2277 2387 allocate_object: ident 2278 {Add IdentToTheAllocateList_1($1);}2388 {Add_Allocate_Var_1($1,curmodulename);} 2279 2389 | structure_component 2280 2390 | array_element 2281 2391 ; 2282 array_element: ident '(' funargs ')' 2283 {Add IdentToTheAllocateList_1($1);}2284 ; 2285 subscript_list: expr 2286 | subscript_list ',' expr 2392 array_element: ident '(' funargs ')' 2393 {Add_Allocate_Var_1($1,curmodulename);} 2394 ; 2395 subscript_list: expr 2396 | subscript_list ',' expr 2287 2397 ; 2288 2398 … … 2317 2427 2318 2428 /*fortrandebug = 1;*/ 2429 if ( mark == 1 ) printf("Firstpass == %d \n",firstpass); 2319 2430 /******************************************************************************/ 2320 2431 /* 1- Open input and output files */ 2321 2432 /******************************************************************************/ 2322 strcpy(OriginalFileName,fichier_entree);2323 2433 strcpy(nomfile,commondirin); 2324 2434 strcat(nomfile,"/"); 2325 2435 strcat(nomfile,fichier_entree); 2326 2436 fortranin=fopen( nomfile,"r"); 2327 if (! fortranin) 2437 if (! fortranin) 2328 2438 { 2329 2439 printf("Error : File %s does not exist\n",nomfile); 2330 2440 exit(1); 2331 2441 } 2332 2442 2333 2443 strcpy(curfile,nomfile); 2334 2444 strcpy(nomfile,commondirout); 2335 strcat(nomfile,"/"); 2445 strcat(nomfile,"/"); 2336 2446 strcat(nomfile,fichier_entree); 2337 2447 strcpy(nomfileoutput,nomfile); 2338 if (firstpass == 1) 2448 if (firstpass == 1) 2339 2449 { 2340 if (checkexistcommon == 1) 2450 if (checkexistcommon == 1) 2341 2451 { 2342 if (fopen(nomfile,"r")) 2452 if (fopen(nomfile,"r")) 2343 2453 { 2344 2454 printf("Warning : file %s already exist\n",nomfile); 2345 2455 confirmyes = 0; 2346 while (confirmyes==0) 2456 while (confirmyes==0) 2347 2457 { 2348 2458 printf("Override file %s ? [Y/N]\n",nomfile); 2349 2459 c=getchar(); 2350 getchar(); 2351 if (c==79 || c==110) 2460 getchar(); 2461 if (c==79 || c==110) 2352 2462 { 2353 2463 printf("We stop\n"); 2354 2464 exit(1); 2355 2465 } 2356 if (c==89 || c==121) 2466 if (c==89 || c==121) 2357 2467 { 2358 2468 confirmyes=1; … … 2361 2471 } 2362 2472 } 2363 } 2473 } 2364 2474 2365 2475 /******************************************************************************/ … … 2367 2477 /******************************************************************************/ 2368 2478 2369 line_num_fortran_common=1; 2479 line_num_fortran_common=1; 2370 2480 line_num_fortran=1; 2371 PublicDeclare = 0; 2372 PrivateDeclare = 0; 2373 formatdeclare = 0; 2374 ExternalDeclare = 0; 2481 PublicDeclare = 0; 2482 PrivateDeclare = 0; 2483 ExternalDeclare = 0; 2375 2484 SaveDeclare = 0; 2376 indeclarationvar=0;2377 2485 pointerdeclare = 0; 2378 2486 optionaldeclare = 0; 2379 2487 incalldeclare = 0; 2380 infunctiondeclare = 0 ; 2488 VarType = 0; 2489 VarTypepar = 0; 2381 2490 Allocatabledeclare = 0 ; 2382 strcpy(NamePrecision," "); 2383 VariableIsParameter = 0 ; 2384 strcpy(NamePrecision,""); 2385 c_star = 0 ; 2491 strcpy(NamePrecision," "); 2492 VariableIsParameter = 0 ; 2493 strcpy(NamePrecision,""); 2494 c_star = 0 ; 2495 functiondeclarationisdone = 0; 2386 2496 insubroutinedeclare = 0 ; 2387 strcpy(subroutinename," "); 2388 InitialValueGiven = 0 ; 2389 strcpy(EmptyChar," "); 2497 strcpy(subroutinename," "); 2498 InitialValueGiven = 0 ; 2499 strcpy(EmptyChar," "); 2390 2500 inmoduledeclare = 0; 2391 2501 colnum=0; … … 2395 2505 /* Name of the file without format */ 2396 2506 tmp = strchr(fichier_entree, '.'); 2397 strncpy(curfilename,fichier_entree,strlen(fichier_entree)-strlen(tmp)); 2507 strncpy(curfilename,fichier_entree,strlen(fichier_entree)-strlen(tmp)); 2398 2508 /******************************************************************************/ 2399 /* 2- Parsing of the input file (1 time) */2509 /* 3- Parsing of the input file (1 time) */ 2400 2510 /******************************************************************************/ 2401 if (firstpass == 0 ) 2511 if (firstpass == 0 ) 2402 2512 { 2403 2513 fortranout=fopen(nomfileoutput,"w"); 2404 /* we should add the new module comes from common block */ 2405 if (fortran77 == 1 ) fprintf 2406 (fortranout,"#include \"NewModule_%s.h\" \n",curfilename); 2514 2515 NewModule_Creation_0(); 2407 2516 } 2408 2517
Note: See TracChangeset
for help on using the changeset viewer.
